Return to DDWC.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDWC	;SFISC/MKO-CHANGE (REPLACE) ;09:24 AM  27 Aug 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: CHG	;Change
    5: 	N DDWOPT
    6: 	D SETUP^DDWC1
    7: 	F  D PROC Q:DDWOPT=-1
    8: 	D RESTORE^DDWC1
    9: 	K DDWCHG(1)
   10: 	Q
   11: 	;
   12: PROC	;Main procedure
   13: 	N DDWCOD,DDWT
   14: 	;
   15: 	D:$D(DDWMARK) UNMARK^DDW7
   16: 	D EN^DIR0(IOTM+DDWMR,14,30,"",$G(DDWFIND),100,"","","AKTW",.DDWT,.DDWCOD)
   17: 	I DDWT=""!(DDWCOD="TO") S DDWOPT=-1 Q
   18: 	S DDWFIND=DDWT,DDWT=$$UC(DDWT)
   19: 	;
   20: 	K DDWCHG(1)
   21: 	D EN^DIR0(IOTM+DDWMR+1,14,30,"",$G(DDWCHG),100,"","","AKTW",.DDWCHG,.DDWCOD)
   22: 	I DDWCOD="TO" S DDWOPT=-1 Q
   23: 	S:DDWCHG?1L.E DDWCHG(1)=$$UC($E(DDWCHG))_$E(DDWCHG,2,999)
   24: 	;
   25: 	F  D OPT Q:DDWOPT]""
   26: 	Q
   27: 	;
   28: OPT	;Prompt for and process option
   29: 	W $P(DDGLVID,DDGLDEL,6)
   30: 	F  D  Q:DDWOPT]""
   31: 	. D CUP(DDWMR+4,15) W " "_$C(8)
   32: 	. R DDWOPT#1:DTIME E  S DDWOPT="Q" Q
   33: 	. I DDWOPT=U S DDWOPT="Q"
   34: 	. I DDWOPT="" S DDWOPT="E" Q
   35: 	. I DDWOPT="?" S DDWOPT="H" Q
   36: 	. S DDWOPT=$$UC(DDWOPT)
   37: 	. I "^F^R^A^Q^"'[(U_DDWOPT_U) W $C(7) S DDWOPT=""
   38: 	D CUP(DDWMR+4,15) W $P(DDGLVID,DDGLDEL,10)_" "
   39: 	D @DDWOPT
   40: 	Q
   41: 	;
   42: F	;Find next
   43: 	D FINDT^DDWF(DDWFIND)
   44: 	S DDWOPT=""
   45: 	Q
   46: 	;
   47: R	;Replace
   48: 	N DDWE
   49: 	I '$D(DDWMARK) D CERR Q
   50: 	D RS(.DDWE) Q:$G(DDWE)
   51: 	D F
   52: 	Q
   53: 	;
   54: RS(DDWE)	;Change selected text
   55: 	N DDWDIF
   56: 	S DDWDIF=$L(DDWCHG)-$P(DDWMARK,U,4)+$P(DDWMARK,U,2)-1
   57: 	I $L(DDWN)+DDWDIF>245 D  Q
   58: 	. S DDWE=1,DDWOPT=""
   59: 	. D MSG($C(7)_"Unable to change text.  Resultant line is too long.")
   60: 	;
   61: 	S DDWE=0
   62: 	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)
   63: 	S DDWL(DDWRW)=DDWN
   64: 	D CUP(DDWRW,1) W $P(DDGLCLR,DDGLDEL)_$E(DDWN,1+DDWOFS,IOM+DDWOFS)
   65: 	K DDWMARK D IND^DDW7()
   66: 	D POS(DDWRW,DDWC+DDWDIF,"R")
   67: 	Q
   68: 	;
   69: A	;Change all
   70: 	N DDWE,DDWF,DDWI,DDWND,DDWX
   71: 	D MSG^DDW("Changing text ...")
   72: 	I $D(DDWMARK) D RS(.DDWE) G:$G(DDWE) AEND
   73: 	;
   74: 	S DDWX=$F($$UC(DDWL(DDWRW)),DDWT,DDWC)
   75: 	I DDWX D
   76: 	. S DDWL(DDWRW)=$$REP(DDWL(DDWRW),DDWFIND,.DDWCHG,DDWX,.DDWE),DDWF=1
   77: 	. S:$G(DDWE) DDWE=DDWRW+DDWA_U_DDWE
   78: 	;
   79: 	I '$G(DDWE) F DDWI=DDWRW+1:1:DDWMR D  Q:$G(DDWE)
   80: 	. S DDWX=$F($$UC(DDWL(DDWI)),DDWT)
   81: 	. S:DDWX DDWL(DDWI)=$$REP(DDWL(DDWI),DDWFIND,.DDWCHG,DDWX,.DDWE),DDWF=1
   82: 	. S:$G(DDWE) DDWE=DDWI+DDWA_U_DDWE
   83: 	;
   84: 	I '$G(DDWE) F DDWI=DDWSTB:-1:1 D  Q:$G(DDWE)
   85: 	. S DDWND=^TMP("DDW1",$J,DDWI)
   86: 	. S DDWX=$F($$UC(DDWND),DDWT)
   87: 	. S:DDWX ^TMP("DDW1",$J,DDWI)=$$REP(DDWND,DDWFIND,.DDWCHG,DDWX,.DDWE),DDWF=1
   88: 	. S:$G(DDWE) DDWE=DDWA+DDWMR+DDWSTB-DDWI+1_U_DDWE
   89: 	;
   90: 	I $G(DDWF) D
   91: 	. D:$G(DDWE) MSG^DDW($C(7)_"Unable to complete replacement.  A resultant line is too long.") H 2
   92: 	. F DDWI=1:1:$$MIN(DDWMR,DDWCNT-DDWA) D
   93: 	.. D CUP(DDWI,1)
   94: 	.. W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
   95: 	. D:$G(DDWE) LINE^DDWG(+DDWE,1),POS(DDWRW,$P(DDWE,U,2),"R")
   96: 	E  D MSG^DDW("Text not found.") H 2 D FLUSH
   97: 	;
   98: AEND	D MSG^DDW(),CUP(DDWRW,DDWC)
   99: 	S DDWOPT=$S($G(DDWE):-1,1:"")
  100: 	Q
  101: 	;
  102: REP(DDWND,DDWFIND,DDWCHG,DDWX,DDWE)	;String replacement of DDWND
  103: 	N DDWDIF,DDWFST,DDWSV
  104: 	S DDWDIF=$L(DDWCHG)-$L(DDWFIND)
  105: 	F  D  Q:'DDWX!$G(DDWE)
  106: 	. S DDWSV=DDWND,DDWFST=DDWX-$L(DDWFIND)
  107: 	. I $L(DDWND)+DDWDIF>245 S DDWE=DDWFST Q
  108: 	. S $E(DDWND,DDWFST,DDWX-1)=$S($E(DDWND,DDWFST)?1U:$G(DDWCHG(1),DDWCHG),1:DDWCHG)
  109: 	. S DDWX=DDWX+DDWDIF
  110: 	. S DDWX=$F($$UC(DDWND),DDWFIND,DDWX)
  111: 	Q $S($G(DDWE):DDWSV,1:DDWND)
  112: 	;
  113: E	;Edit Find
  114: 	D FLUSH
  115: 	Q
  116: 	;
  117: Q	;Quit option
  118: 	D FLUSH
  119: 	S DDWOPT=-1
  120: 	Q
  121: 	;
  122: H	;Help
  123: 	D MSG("Press the highlighted letter of one of the Options.")
  124: 	S DDWOPT=""
  125: 	Q
  126: 	;
  127: CERR	;The Change options are disabled
  128: 	D MSG($C(7)_"You must Find the text before you can Change it.")
  129: 	S DDWOPT=""
  130: 	Q
  131: 	;
  132: MSG(DDWX)	;
  133: 	D CUP(DDWMR+5,1) W $P(DDGLCLR,DDGLDEL)_$G(DDWX) H 2
  134: 	D CUP(DDWMR+5,1) W $P(DDGLCLR,DDGLDEL)
  135: 	D FLUSH
  136: 	Q
  137: 	;
  138: FLUSH	;Flush read buffer
  139: 	N DDWX F  R *DDWX:0 E  Q
  140: 	Q
  141: 	;
  142: UC(X)	;Return uppercase of X
  143: 	Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  144: 	;
  145: MIN(X,Y)	;
  146: 	Q $S(X<Y:X,1:Y)
  147: 	;
  148: CUP(Y,X)	;Pos cursor
  149: 	S DY=IOTM+Y-2,DX=X-1 X IOXY
  150: 	Q
  151: 	;
  152: POS(R,C,F)	;Pos cursor based on char pos C
  153: 	N DDWX
  154: 	S:$G(C)="E" C=$L($G(DDWL(R)))+1
  155: 	S:$G(F)["N" DDWN=$G(DDWL(R))
  156: 	S:$G(F)["R" DDWRW=R,DDWC=C
  157: 	;
  158: 	S DDWX=C-DDWOFS
  159: 	I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  160: 	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  161: 	Q