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