Annotation of freem_fileman/DDWF.m, revision 1.1
1.1 ! snw 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>