Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDWF

DDWF.m

Go to the documentation of this file. 
  1. DDWF ;SFISC/MKO-FIND, REPLACE ;8:14 AM  27 Mar 1996
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. NEXT ;Find next occurrence of same text
  1.  N DDWT
  1.  G:$G(DDWFIND)="" FIND
  1.  S DDWT=DDWFIND
  1.  D FINDT(DDWT,$G(DDWFIND(1)))
  1.  Q
  1.  ;
  1. FIND ;Prompt and find text
  1.  N DDWCOD,DDWF,DDWT
  1.  D ASK^DDWG(3,"Find What: ",30,$G(DDWFIND),"","",.DDWT,.DDWCOD)
  1.  Q:DDWT=""
  1.  D FINDT(DDWT,$P($G(DDWCOD),U)="U")
  1.  Q
  1.  ;
  1. FINDT(DDWT,DDWBACK) ;Find DDWT
  1.  D:$D(DDWMARK) UNMARK^DDW7
  1.  S DDWFIND=DDWT,DDWT=$$UC(DDWT)
  1.  I $G(DDWBACK) D
  1.  . S DDWFIND(1)=1 D LOOKB
  1.  E  K DDWFIND(1) D LOOK
  1.  Q
  1.  ;
  1. LOOK ;Look in arrays
  1.  N DDWF,DDWI,DDWX
  1.  S DDWF=$F($$UC(DDWL(DDWRW)),DDWT,DDWC)
  1.  I DDWF D REPOS(DDWRW+DDWA,DDWF,DDWT) Q
  1.  ;
  1.  F DDWI=DDWRW+1:1:DDWMR D  Q:DDWF
  1.  . S DDWX=$F($$UC(DDWL(DDWI)),DDWT)
  1.  . I DDWX D REPOS(DDWI+DDWA,DDWX,DDWT) S DDWF=1
  1.  Q:DDWF
  1.  ;
  1.  D MSG^DDW("Searching ...")
  1.  F DDWI=DDWSTB:-1:1 D  Q:DDWF
  1.  . S DDWX=$F($$UC(^TMP("DDW1",$J,DDWI)),DDWT)
  1.  . I DDWX D
  1.  .. D MSG^DDW()
  1.  .. D REPOS(DDWA+DDWMR+DDWSTB-DDWI+1,DDWX,DDWT)
  1.  .. S DDWF=1
  1.  Q:DDWF
  1.  ;
  1.  D MSG^DDW("Text not found.") H 2
  1.  D MSG^DDW(),CUP(DDWRW,DDWC)
  1.  F  R *DDWX:0 E  Q
  1.  Q
  1.  ;
  1. LOOKB ;Look backward in arrays
  1.  N DDWF,DDWI,DDWX
  1.  S DDWF=$$RF($E($$UC(DDWL(DDWRW)),1,DDWC-1),DDWT)
  1.  I DDWF=DDWC S DDWF=$$RF($E($$UC(DDWL(DDWRW)),1,DDWC-$L(DDWT)-1),DDWT)
  1.  I DDWF D REPOS(DDWRW+DDWA,DDWF,DDWT) Q
  1.  ;
  1.  F DDWI=DDWRW-1:-1:1 D  Q:DDWF
  1.  . S DDWX=$$RF($$UC(DDWL(DDWI)),DDWT)
  1.  . I DDWX D REPOS(DDWI+DDWA,DDWX,DDWT) S DDWF=1
  1.  Q:DDWF
  1.  ;
  1.  D MSG^DDW("Searching ...")
  1.  F DDWI=DDWA:-1:1 D  Q:DDWF
  1.  . S DDWX=$$RF($$UC(^TMP("DDW",$J,DDWI)),DDWT)
  1.  . I DDWX D
  1.  .. D MSG^DDW()
  1.  .. D REPOS(DDWI,DDWX,DDWT)
  1.  .. S DDWF=1
  1.  Q:DDWF
  1.  ;
  1.  D MSG^DDW("Text not found.") H 2
  1.  D MSG^DDW(),CUP(DDWRW,DDWC)
  1.  F  R *DDWX:0 E  Q
  1.  Q
  1.  ;
  1. REPOS(DDWY,DDWX,DDWT) ;Define DDWMARK, paint if on screen
  1.  S DDWMARK=DDWY_U_(DDWX-$L(DDWT))_U_DDWY_U_(DDWX-1)
  1.  I DDWY-DDWA>0,DDWY-DDWA'>DDWMR,DDWX-DDWOFS>0,DDWX-DDWOFS'>IOM D
  1.  . D PAINT^DDW7(DDWMARK,1)
  1.  . D POS(DDWY-DDWA,DDWX,"RN")
  1.  E  D LINE^DDWG(DDWY,DDWX)
  1.  D IND^DDW7(1)
  1.  Q
  1.  ;
  1. UC(X) ;Return uppercase of X
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;
  1. RF(X,T) ;Find last occurrence of T in X
  1.  N Y
  1.  Q:X'[T 0
  1.  S Y=1 F  S Y=$F(X,T,Y) Q:'$F(X,T,Y)
  1.  Q Y
  1.  ;
  1. CUP(Y,X) ;Cursor positioning
  1.  S DY=IOTM+Y-2,DX=X-1 X IOXY
  1.  Q
  1.  ;
  1. POS(R,C,F) ;Pos cursor based on char pos C
  1.  N DDWX
  1.  S:$G(C)="E" C=$L($G(DDWL(R)))+1
  1.  S:$G(F)["N" DDWN=$G(DDWL(R))
  1.  S:$G(F)["R" DDWRW=R,DDWC=C
  1.  ;
  1.  S DDWX=C-DDWOFS
  1.  I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  1.  S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1.  Q