source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDW1.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1DDW1 ;SFISC/PD KELTZ-LOAD, SAVE ;1:31 PM 16 Aug 2000
2 ;;22.0;VA FileMan;**18**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5LOAD ;Put up "box" and load document
6 N DDWI,DDWX
7 D BOX
8 ;
9 I $D(DWLC)[0 D
10 . S DWLC=$S($D(@DDWDIC@(0))#2:+$P(@DDWDIC@(0),U,4),1:$O(@DDWDIC@(""),-1))
11 . S:$D(@DDWDIC@(1))#2 $E(DDWBF,4)=1
12 S DDWCNT=$S(DWLC:DWLC,1:1)
13 ;
14 D:DDWCNT>1 MSG^DDW("Loading text ...")
15 F DDWI=DDWCNT:-1:DDWMR+1 D
16 . S DDWSTB=DDWSTB+1
17 . S DDWX=$S('$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
18 . D:DDWX?.E1C.E CTRL
19 . S ^TMP("DDW1",$J,DDWSTB)=DDWX
20 ;
21 F DDWI=1:1:DDWMR D
22 . S DDWX=$S(DDWI>DDWCNT:"",'$E(DDWBF,4):$G(@DDWDIC@(DDWI,0)),1:$G(@DDWDIC@(DDWI)))
23 . D:DDWX?.E1C.E CTRL
24 . S DDWL(DDWI)=DDWX
25 . I DDWC'>IOM,DDWRW'>DDWMR,DDWI'>DDWCNT,DDWX'?." " D
26 .. D CUP(DDWI,1) W $E(DDWX,1,IOM)
27 ;
28 I DDWCNT=1,DDWL(1)?1." " S DDWL(1)=""
29 D:DDWCNT>1 MSG^DDW()
30 ;
31 D:$G(DDWED) MSG^DDW($C(7)_$P(DDGLVID,DDGLDEL,6)_"WARNING: Control characters in the text have been replaced with spaces."_$P(DDGLVID,DDGLDEL,10))
32 ;
33 I DDWRW="B" D
34 . D BOT^DDW3
35 E D LINE^DDWG(DDWRW,DDWC)
36 Q
37 ;
38CTRL ;Strip control characters from DDWX
39 N I
40 S DDWED=1
41 F I=1:1:$L(DDWX) S:$E(DDWX,I)?1C $E(DDWX,I)=" "
42 Q
43 ;
44BOX ;Draw box
45 N DDWX
46 ;
47 I $D(DIWETXT) D
48 . D CUP(-1,1)
49 . W $P(DDGLVID,DDGLDEL)_$E(DIWETXT,1,IOM)_$P(DDGLVID,DDGLDEL,10)
50 ;
51 I $D(DIWESUB) S DDWX=DIWESUB
52 E I $D(DH)#2,$D(DIE) S DDWX=DH
53 S DDWX=$E($G(DDWX),1,30)
54 ;
55 D CUP(0,1) W $TR($J("",IOM)," ","=")
56 I DDWRAP S DX=2 X IOXY W "[ WRAP ]"
57 S DX=12 X IOXY W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
58 S DX=40-($L(DDWX)\2) X IOXY W "< "_$E(DDWX,1,30)_" >"
59 S DX=61 X IOXY W "[ <PF1>H=Help ]"
60 ;
61 D CUP(DDWMR+1,1) W $E(DDWRUL,1,IOM)
62 I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
63 . S DX=DDWLMAR-DDWOFS-1 X IOXY W "<"
64 I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
65 . S DX=DDWRMAR-DDWOFS-1 X IOXY W ">"
66 Q
67 ;
68AUTOTM ;Prompt for autosave time
69 N DDWHLP,DDWANS,DDWCOD
70 S DDWHLP(1)=" Enter the interval in MINUTES you wish to have the Screen Editor"
71 S DDWHLP(2)=" automatically save the text. Enter a number between 0 and 120."
72 S DDWHLP(3)=" A value of 0 means text is NOT automatically saved."
73 D ASK^DDWG(5,"Interval in MINUTES to automatically save text: ",15,+$G(DDWAUTO),"D AUTOVAL^DDW1",.DDWHLP,.DDWANS,.DDWCOD)
74 ;
75 Q:DDWCOD="TO"!(DDWANS=U)
76 I $G(DDWANS) D
77 . S DDWAUTO=DDWANS
78 . S DDWAUTO("H")=$H
79 . S DDWAUTO("S")=DDWAUTO*60
80 E K DDWAUTO
81 Q
82 ;
83AUTOVAL ;Validate autosave time
84 K DDWERR
85 I DDWX?."^"!($P($G(DDWCOD),U)="TO") S DDWX=U Q
86 I $L(DDWX)>15 D
87 . S DDWERR=" Response must not be more than 15 characters in length."
88 I DDWX'=+$P(DDWX,"E") D
89 . S DDWERR=" Response must be numeric."
90 I DDWX>120!(DDWX<0) D
91 . S DDWERR=" Response must be between 0 and 120."
92 Q
93 ;
94AUTOSV ;Autosave
95 I $D(DDWED) K DDWED D SV
96 S DDWAUTO("H")=$H
97 Q
98 ;
99SV ;Called from DDWT1 and AUTOSV
100 D SAVE
101 S:DDWCNT<1 DDWCNT=1
102 I DDWRW+DDWA>DDWCNT D
103 . D POS(DDWCNT-DDWA,"E","RN")
104 E D POS(DDWRW,DDWC)
105 Q
106 ;
107SAVE ;Save document
108 N DDWI,DDWLMEM,DDWLSTB,DDWX
109 D MSG^DDW("Saving text ...") H .5
110 S DDWCNT=0
111 K @DDWDIC
112 ;
113 F DDWI=1:1:DDWA D
114 . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW",$J,DDWI))
115 . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
116 . E S @DDWDIC@(DDWCNT)=DDWX
117 ;
118 S DDWLMEM=999
119 F DDWI=1:1:DDWSTB+1 Q:DDWI>DDWSTB Q:^TMP("DDW1",$J,DDWI)'?." "
120 I DDWI'>DDWSTB S DDWLSTB=DDWI
121 E D
122 . F DDWI=DDWMR:-1:0 Q:'DDWI Q:DDWL(DDWI)'?." "
123 . S DDWLMEM=DDWI
124 ;
125 F DDWI=1:1:$$MIN(DDWLMEM,DDWMR) D
126 . S DDWCNT=DDWCNT+1,DDWX=$$NTS(DDWL(DDWI))
127 . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
128 . E S @DDWDIC@(DDWCNT)=DDWX
129 ;
130 I $D(DDWLSTB) F DDWI=DDWSTB:-1:DDWLSTB D
131 . S DDWCNT=DDWCNT+1,DDWX=$$NTS(^TMP("DDW1",$J,DDWI))
132 . I '$E(DDWBF,4) S @DDWDIC@(DDWCNT,0)=DDWX
133 . E S @DDWDIC@(DDWCNT)=DDWX
134 ;
135 S DWLC=DDWCNT,DWHD=U
136 I DDWCNT,'$E(DDWBF,4) S @DDWDIC@(0)=U_U_DWLC_U_DWLC_U_DT_U
137 D MSG^DDW()
138 Q
139 ;
140QUIT ;If any edits were made, issue confirmation prompt.
141 S DDWFIN=""
142 Q:$G(DDWFLAGS)["Q"!'$D(DDWED)
143 ;
144 N DDWHLP,DDWANS,DDWCOD
145 S DDWHLP(1)=" Enter 'Yes' to save changes and quit."
146 S DDWHLP(2)=" Enter 'No' to discard changes and quit."
147 S DDWHLP(3)=" Enter '^' to return to the editor without saving or quitting."
148 ;
149 D ASK^DDWG(5,"Do you want to save changes? ",3,"","D QUITVAL^DDW1",.DDWHLP,.DDWANS,.DDWCOD)
150 ;
151 I DDWCOD="TO"!(DDWANS=U) K DDWFIN
152 E I DDWANS="Y" D SAVE K DUOUT ;GFT
153 Q
154 ;
155QUITVAL ;Validate responses to the confirmation prompt
156 K DDWERR
157 I DDWX[U!($P(DDWCOD,U)="TO") S DDWX=U Q
158 I DDWX="" S DDWERR=" Response is required. Enter ? for help." Q
159 ;
160 S:DDWX?.E1L.E DDWX=$TR(DDWX,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
161 ;
162 I $P("YES",DDWX)]"",$P("NO",DDWX)]"" D Q
163 . S DDWERR=" Not a valid response. Enter ? for help."
164 ;
165 S DDWX=$E(DDWX)
166 Q
167 ;
168POS(R,C,F) ;Pos cursor based on char pos C
169 N DDWX
170 S:$G(C)="E" C=$L($G(DDWL(R)))+1
171 S:$G(F)["N" DDWN=$G(DDWL(R))
172 S:$G(F)["R" DDWRW=R,DDWC=C
173 ;
174 S DDWX=C-DDWOFS
175 I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
176 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
177 Q
178 ;
179CUP(Y,X) ;Cursor positioning
180 S DY=IOTM+Y-2,DX=X-1 X IOXY
181 Q
182 ;
183MIN(X,Y) ;Return the minimum of X and Y
184 Q $S(X<Y:X,1:Y)
185 ;
186NTS(X) ;Change "" to " "
187 Q $S(X="":" ",1:X)
188 ;
189TR(X,F) ;Strip trailing blanks
190 ;If F["B" return " " if X=""
191 I $G(X)]"" D
192 . N I
193 . F I=$L(X):-1:0 Q:$E(X,I)'=" "
194 . S X=$E(X,1,I)
195 I X="",$G(F)["B" S X=" "
196 Q X
Note: See TracBrowser for help on using the repository browser.