Annotation of freem_fileman/DDWC.m, revision 1.1
1.1 ! snw 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDWC.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman