Return to DDWF.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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