File:  [Coherent Logic Development] / freem_fileman / USER / DDWF.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDWF	;SFISC/MKO-FIND, REPLACE ;08:31 AM  22 Jun 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: NEXT	;Find next occurrence of same text
    6: 	N DDWT
    7: 	G:$G(DDWFIND)="" FIND
    8: 	S DDWT=DDWFIND
    9: 	D FINDT(DDWT,$G(DDWFIND(1)))
   10: 	Q
   11: 	;
   12: FIND	;Prompt and find text
   13: 	N DDWCOD,DDWF,DDWT
   14: 	D ASK^DDWG(3,"Find What: ",30,$G(DDWFIND),"","",.DDWT,.DDWCOD)
   15: 	Q:DDWT=""
   16: 	D FINDT(DDWT,$P($G(DDWCOD),U)="U")
   17: 	Q
   18: 	;
   19: FINDT(DDWT,DDWBACK)	;Find DDWT
   20: 	D:$D(DDWMARK) UNMARK^DDW7
   21: 	S DDWFIND=DDWT,DDWT=$$UC(DDWT)
   22: 	I $G(DDWBACK) D
   23: 	. S DDWFIND(1)=1 D LOOKB
   24: 	E  K DDWFIND(1) D LOOK
   25: 	Q
   26: 	;
   27: LOOK	;Look in arrays
   28: 	N DDWF,DDWI,DDWX
   29: 	S DDWF=$F($$UC(DDWL(DDWRW)),DDWT,DDWC)
   30: 	I DDWF D REPOS(DDWRW+DDWA,DDWF) Q
   31: 	;
   32: 	F DDWI=DDWRW+1:1:DDWMR D  Q:DDWF
   33: 	. S DDWX=$F($$UC(DDWL(DDWI)),DDWT)
   34: 	. I DDWX D REPOS(DDWI+DDWA,DDWX) S DDWF=1
   35: 	Q:DDWF
   36: 	;
   37: 	D MSG^DDW("Searching ...")
   38: 	F DDWI=DDWSTB:-1:1 D  Q:DDWF
   39: 	. S DDWX=$F($$UC(^TMP("DDW1",$J,DDWI)),DDWT)
   40: 	. I DDWX D
   41: 	.. D MSG^DDW()
   42: 	.. D REPOS(DDWA+DDWMR+DDWSTB-DDWI+1,DDWX)
   43: 	.. S DDWF=1
   44: 	Q:DDWF
   45: 	;
   46: 	D MSG^DDW("Text not found.") H 2
   47: 	D MSG^DDW(),CUP(DDWRW,DDWC)
   48: 	F  R *DDWX:0 E  Q
   49: 	Q
   50: 	;
   51: LOOKB	;Look backward in arrays
   52: 	N DDWF,DDWI,DDWX
   53: 	S DDWF=$$RF($E($$UC(DDWL(DDWRW)),1,DDWC-1),DDWT)
   54: 	I DDWF=DDWC S DDWF=$$RF($E($$UC(DDWL(DDWRW)),1,DDWC-$L(DDWT)-1),DDWT)
   55: 	I DDWF D REPOS(DDWRW+DDWA,DDWF) Q
   56: 	;
   57: 	F DDWI=DDWRW-1:-1:1 D  Q:DDWF
   58: 	. S DDWX=$$RF($$UC(DDWL(DDWI)),DDWT)
   59: 	. I DDWX D REPOS(DDWI+DDWA,DDWX) S DDWF=1
   60: 	Q:DDWF
   61: 	;
   62: 	D MSG^DDW("Searching ...")
   63: 	F DDWI=DDWA:-1:1 D  Q:DDWF
   64: 	. S DDWX=$$RF($$UC(^TMP("DDW",$J,DDWI)),DDWT)
   65: 	. I DDWX D
   66: 	.. D MSG^DDW()
   67: 	.. D REPOS(DDWI,DDWX)
   68: 	.. S DDWF=1
   69: 	Q:DDWF
   70: 	;
   71: 	D MSG^DDW("Text not found.") H 2
   72: 	D MSG^DDW(),CUP(DDWRW,DDWC)
   73: 	F  R *DDWX:0 E  Q
   74: 	Q
   75: 	;
   76: REPOS(DDWY,DDWX)	;Define DDWMARK, paint if on screen
   77: 	S DDWMARK=DDWY_U_(DDWX-$L(DDWT))_U_DDWY_U_(DDWX-1)
   78: 	I DDWY-DDWA>0,DDWY-DDWA'>DDWMR,DDWX-DDWOFS>0,DDWX-DDWOFS'>IOM D
   79: 	. D PAINT^DDW7(DDWMARK,1)
   80: 	. D POS(DDWY-DDWA,DDWX,"RN")
   81: 	E  D LINE^DDWG(DDWY,DDWX)
   82: 	D IND^DDW7(1)
   83: 	Q
   84: 	;
   85: UC(X)	;Return uppercase of X
   86: 	Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
   87: 	;
   88: RF(X,T)	;Find last occurrence of T in X
   89: 	N Y
   90: 	Q:X'[T 0
   91: 	S Y=1 F  S Y=$F(X,T,Y) Q:'$F(X,T,Y)
   92: 	Q Y
   93: 	;
   94: CUP(Y,X)	;Cursor positioning
   95: 	S DY=IOTM+Y-2,DX=X-1 X IOXY
   96: 	Q
   97: 	;
   98: POS(R,C,F)	;Pos cursor based on char pos C
   99: 	N DDWX
  100: 	S:$G(C)="E" C=$L($G(DDWL(R)))+1
  101: 	S:$G(F)["N" DDWN=$G(DDWL(R))
  102: 	S:$G(F)["R" DDWRW=R,DDWC=C
  103: 	;
  104: 	S DDWX=C-DDWOFS
  105: 	I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  106: 	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  107: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>