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

DDWC.m

Go to the documentation of this file. 
  1. DDWC ;SFISC/MKO-CHANGE (REPLACE) ;3:36 PM  5 Jul 1996
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. CHG ;Change
  1.  N DDWOPT
  1.  D SETUP^DDWC1
  1.  F  D PROC Q:DDWOPT=-1
  1.  D RESTORE^DDWC1
  1.  K DDWCHG(1)
  1.  Q
  1.  ;
  1. PROC ;Main procedure
  1.  N DDWCOD,DDWT
  1.  ;
  1.  D:$D(DDWMARK) UNMARK^DDW7
  1.  D EN^DIR0(IOTM+DDWMR,14,30,"",$G(DDWFIND),100,"","","AKTW",.DDWT,.DDWCOD)
  1.  I DDWT=""!($P(DDWCOD,U)="TO") S DDWOPT=-1 Q
  1.  S DDWFIND=DDWT,DDWT=$$UC(DDWT)
  1.  ;
  1.  K DDWCHG(1)
  1.  D EN^DIR0(IOTM+DDWMR+1,14,30,"",$G(DDWCHG),100,"","","AKTW",.DDWCHG,.DDWCOD)
  1.  I $P(DDWCOD,U)="TO" S DDWOPT=-1 Q
  1.  S:DDWCHG?1L.E DDWCHG(1)=$$UC($E(DDWCHG))_$E(DDWCHG,2,999)
  1.  ;
  1.  F  D OPT Q:DDWOPT]""
  1.  Q
  1.  ;
  1. OPT ;Prompt for and process option
  1.  W $P(DDGLVID,DDGLDEL,6)
  1.  F  D  Q:DDWOPT]""
  1.  . D CUP(DDWMR+4,15) W " "_$C(8)
  1.  . R DDWOPT#1:DTIME E  S DDWOPT="Q" Q
  1.  . I DDWOPT=U S DDWOPT="Q"
  1.  . I DDWOPT="" S DDWOPT="E" Q
  1.  . I DDWOPT="?" S DDWOPT="H" Q
  1.  . S DDWOPT=$$UC(DDWOPT)
  1.  . I "^F^R^A^Q^"'[(U_DDWOPT_U) W $C(7) S DDWOPT=""
  1.  D CUP(DDWMR+4,15) W $P(DDGLVID,DDGLDEL,10)_" "
  1.  D @DDWOPT
  1.  Q
  1.  ;
  1. F ;Find next
  1.  D FINDT^DDWF(DDWFIND)
  1.  S DDWOPT=""
  1.  Q
  1.  ;
  1. R ;Replace
  1.  N DDWE
  1.  I '$D(DDWMARK) D CERR Q
  1.  D RS(.DDWE) Q:$G(DDWE)
  1.  D F
  1.  Q
  1.  ;
  1. RS(DDWE) ;Change selected text
  1.  N DDWDIF
  1.  S DDWDIF=$L(DDWCHG)-$P(DDWMARK,U,4)+$P(DDWMARK,U,2)-1
  1.  I $L(DDWN)+DDWDIF>245 D  Q
  1.  . S DDWE=1,DDWOPT=""
  1.  . D MSG($C(7)_"Unable to change text.  Resultant line is too long.")
  1.  ;
  1.  S DDWE=0,DDWED=1
  1.  S $E(DDWN,$P(DDWMARK,U,2),$P(DDWMARK,U,4))=$S($E(DDWN,$P(DDWMARK,U,2))?1U:$G(DDWCHG(1),DDWCHG),1:DDWCHG)
  1.  S DDWL(DDWRW)=DDWN
  1.  D CUP(DDWRW,1) W $P(DDGLCLR,DDGLDEL)_$E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  K DDWMARK D IND^DDW7()
  1.  D POS(DDWRW,DDWC+DDWDIF,"R")
  1.  Q
  1.  ;
  1. A ;Change all
  1.  N DDWE,DDWF,DDWI,DDWND,DDWX
  1.  D MSG^DDW("Changing text ...")
  1.  I $D(DDWMARK) D RS(.DDWE) G:$G(DDWE) AEND
  1.  ;
  1.  S DDWX=$F($$UC(DDWL(DDWRW)),DDWT,DDWC)
  1.  I DDWX D
  1.  . S DDWL(DDWRW)=$$REP(DDWL(DDWRW),DDWFIND,.DDWCHG,DDWX,.DDWE),DDWF=1
  1.  . S:$G(DDWE) DDWE=DDWRW+DDWA_U_DDWE
  1.  ;
  1.  I '$G(DDWE) F DDWI=DDWRW+1:1:DDWMR D  Q:$G(DDWE)
  1.  . S DDWX=$F($$UC(DDWL(DDWI)),DDWT)
  1.  . S:DDWX DDWL(DDWI)=$$REP(DDWL(DDWI),DDWFIND,.DDWCHG,DDWX,.DDWE),DDWF=1
  1.  . S:$G(DDWE) DDWE=DDWI+DDWA_U_DDWE
  1.  ;
  1.  I '$G(DDWE) F DDWI=DDWSTB:-1:1 D  Q:$G(DDWE)
  1.  . S DDWND=^TMP("DDW1",$J,DDWI)
  1.  . S DDWX=$F($$UC(DDWND),DDWT)
  1.  . S:DDWX ^TMP("DDW1",$J,DDWI)=$$REP(DDWND,DDWFIND,.DDWCHG,DDWX,.DDWE),DDWF=1
  1.  . S:$G(DDWE) DDWE=DDWA+DDWMR+DDWSTB-DDWI+1_U_DDWE
  1.  ;
  1.  I $G(DDWF) D
  1.  . D:$G(DDWE) MSG^DDW($C(7)_"Unable to complete replacement.  A resultant line is too long.") H 2
  1.  . F DDWI=1:1:$$MIN(DDWMR,DDWCNT-DDWA) D
  1.  .. D CUP(DDWI,1)
  1.  .. W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
  1.  . D:$G(DDWE) LINE^DDWG(+DDWE,1),POS(DDWRW,$P(DDWE,U,2),"R")
  1.  E  D MSG^DDW("Text not found.") H 2 D FLUSH
  1.  ;
  1. AEND D MSG^DDW(),CUP(DDWRW,DDWC)
  1.  S DDWOPT=$S($G(DDWE):-1,1:"")
  1.  Q
  1.  ;
  1. REP(DDWND,DDWFIND,DDWCHG,DDWX,DDWE) ;String replacement of DDWND
  1.  N DDWDIF,DDWFST,DDWSV
  1.  S DDWDIF=$L(DDWCHG)-$L(DDWFIND)
  1.  F  D  Q:'DDWX!$G(DDWE)
  1.  . S DDWSV=DDWND,DDWFST=DDWX-$L(DDWFIND)
  1.  . I $L(DDWND)+DDWDIF>245 S DDWE=DDWFST Q
  1.  . S $E(DDWND,DDWFST,DDWX-1)=$S($E(DDWND,DDWFST)?1U:$G(DDWCHG(1),DDWCHG),1:DDWCHG)
  1.  . S DDWX=DDWX+DDWDIF
  1.  . S DDWX=$F($$UC(DDWND),DDWFIND,DDWX)
  1.  Q $S($G(DDWE):DDWSV,1:DDWND)
  1.  ;
  1. E ;Edit Find
  1.  D FLUSH
  1.  Q
  1.  ;
  1. Q ;Quit option
  1.  D FLUSH
  1.  S DDWOPT=-1
  1.  Q
  1.  ;
  1. H ;Help
  1.  D MSG("Press the highlighted letter of one of the Options.")
  1.  S DDWOPT=""
  1.  Q
  1.  ;
  1. CERR ;The Change options are disabled
  1.  D MSG($C(7)_"You must Find the text before you can Change it.")
  1.  S DDWOPT=""
  1.  Q
  1.  ;
  1. MSG(DDWX) ;
  1.  D CUP(DDWMR+5,1) W $P(DDGLCLR,DDGLDEL)_$G(DDWX) H 2
  1.  D CUP(DDWMR+5,1) W $P(DDGLCLR,DDGLDEL)
  1.  D FLUSH
  1.  Q
  1.  ;
  1. FLUSH ;Flush read buffer
  1.  N DDWX F  R *DDWX:0 E  Q
  1.  Q
  1.  ;
  1. UC(X) ;Return uppercase of X
  1.  Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1.  ;
  1. MIN(X,Y) ;
  1.  Q $S(X<Y:X,1:Y)
  1.  ;
  1. CUP(Y,X) ;Pos cursor
  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