Annotation of freem_fileman/USER/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>