Produced by Araxis Merge on 4/9/2019 7:02:00 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | C:\AraxisMergeCompare\Pri_un\DG_53_952_V23_B7S1 | DG_53_952_V23_B7S1.KID | Wed Mar 20 18:19:26 2019 UTC |
2 | C:\AraxisMergeCompare\Pri_re\MHED P3 Healthshare 2.0-redacted\DG_53_952_V23_B7S1 | DG_53_952_V23_B7S1.KID | Mon Apr 8 20:07:02 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 17958 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | KIDS Distr ibution sa ved on Mar 20, 2019@ 12:12:43 | |
2 | DG*5.3*952 TEST v23 B7S1 | |
3 | **KIDS**:D G*5.3*952^ | |
4 | ||
5 | **INSTALL NAME** | |
6 | DG*5.3*952 | |
7 | "BLD",1025 7,0) | |
8 | DG*5.3*952 ^REGISTRAT ION^0^3190 320^y | |
9 | "BLD",1025 7,1,0) | |
10 | ^^4^4^3190 221^^^ | |
11 | "BLD",1025 7,1,1,0) | |
12 | This patch implement s the "EXP ANDED MH C ARE NON VE TERAN" as a new | |
13 | "BLD",1025 7,1,2,0) | |
14 | eligibilit y code for patient r egistratio n. It is u sed to ide ntify and | |
15 | "BLD",1025 7,1,3,0) | |
16 | track "oth er than ho norably di scharged" service me mbers for emergency | |
17 | "BLD",1025 7,1,4,0) | |
18 | mental hea lth servic es in the VA. | |
19 | "BLD",1025 7,4,0) | |
20 | ^9.64PA^2^ 3 | |
21 | "BLD",1025 7,4,2,0) | |
22 | 2 | |
23 | "BLD",1025 7,4,2,2,0) | |
24 | ^9.641^2^1 | |
25 | "BLD",1025 7,4,2,2,2, 0) | |
26 | PATIENT ( File-top l evel) | |
27 | "BLD",1025 7,4,2,2,2, 1,0) | |
28 | ^9.6411^.5 501^1 | |
29 | "BLD",1025 7,4,2,2,2, 1,.5501,0) | |
30 | EXPANDED M H CARE TYP E | |
31 | "BLD",1025 7,4,2,222) | |
32 | y^n^p^^^^n ^^n | |
33 | "BLD",1025 7,4,2,224) | |
34 | ||
35 | "BLD",1025 7,4,33,0) | |
36 | 33 | |
37 | "BLD",1025 7,4,33,222 ) | |
38 | y^y^f^^^^n | |
39 | "BLD",1025 7,4,33.1,0 ) | |
40 | 33.1 | |
41 | "BLD",1025 7,4,33.1,2 22) | |
42 | y^y^f^^^^n | |
43 | "BLD",1025 7,4,"APDD" ,2,2) | |
44 | ||
45 | "BLD",1025 7,4,"APDD" ,2,2,.5501 ) | |
46 | ||
47 | "BLD",1025 7,4,"B",2, 2) | |
48 | ||
49 | "BLD",1025 7,4,"B",33 ,33) | |
50 | ||
51 | "BLD",1025 7,4,"B",33 .1,33.1) | |
52 | ||
53 | "BLD",1025 7,6) | |
54 | 10^ | |
55 | "BLD",1025 7,6.3) | |
56 | 68 | |
57 | "BLD",1025 7,"INIT") | |
58 | ||
59 | "BLD",1025 7,"KRN",0) | |
60 | ^9.67PA^77 9.2^20 | |
61 | "BLD",1025 7,"KRN",.4 ,0) | |
62 | .4 | |
63 | "BLD",1025 7,"KRN",.4 ,"NM",0) | |
64 | ^9.68A^1^1 | |
65 | "BLD",1025 7,"KRN",.4 ,"NM",1,0) | |
66 | DG OTH PRI NT TEMPLAT E FILE #33.1^33.1 ^0 | |
67 | "BLD",1025 7,"KRN",.4 ,"NM","B", "DG OTH PR INT TEMPLA TE FILE #33.1",1) | |
68 | ||
69 | "BLD",1025 7,"KRN",.4 01,0) | |
70 | .401 | |
71 | "BLD",1025 7,"KRN",.4 01,"NM",0) | |
72 | ^9.68A^^0 | |
73 | "BLD",1025 7,"KRN",.4 02,0) | |
74 | .402 | |
75 | "BLD",1025 7,"KRN",.4 02,"NM",0) | |
76 | ^9.68A^1^1 | |
77 | "BLD",1025 7,"KRN",.4 02,"NM",1, 0) | |
78 | DG LOAD ED IT SCREEN 7 FILE #2^2^0 | |
79 | "BLD",1025 7,"KRN",.4 02,"NM","B ","DG LOAD EDIT SCRE EN 7 FI LE #2",1) | |
80 | ||
81 | "BLD",1025 7,"KRN",.4 03,0) | |
82 | .403 | |
83 | "BLD",1025 7,"KRN",.5 ,0) | |
84 | .5 | |
85 | "BLD",1025 7,"KRN",.8 4,0) | |
86 | .84 | |
87 | "BLD",1025 7,"KRN",3. 6,0) | |
88 | 3.6 | |
89 | "BLD",1025 7,"KRN",3. 8,0) | |
90 | 3.8 | |
91 | "BLD",1025 7,"KRN",9. 2,0) | |
92 | 9.2 | |
93 | "BLD",1025 7,"KRN",9. 8,0) | |
94 | 9.8 | |
95 | "BLD",1025 7,"KRN",9. 8,"NM",0) | |
96 | ^9.68A^19^ 16 | |
97 | "BLD",1025 7,"KRN",9. 8,"NM",2,0 ) | |
98 | DGOTHD^^0^ B71214411 | |
99 | "BLD",1025 7,"KRN",9. 8,"NM",4,0 ) | |
100 | DGOTHD1^^0 ^B61648572 | |
101 | "BLD",1025 7,"KRN",9. 8,"NM",5,0 ) | |
102 | DGOTHD2^^0 ^B18967603 0 | |
103 | "BLD",1025 7,"KRN",9. 8,"NM",6,0 ) | |
104 | DGLOCK1^^0 ^B21160237 | |
105 | "BLD",1025 7,"KRN",9. 8,"NM",7,0 ) | |
106 | DGOTHEDT^^ 0^B2076185 20 | |
107 | "BLD",1025 7,"KRN",9. 8,"NM",8,0 ) | |
108 | DGOTHRPT^^ 0^B1395042 06 | |
109 | "BLD",1025 7,"KRN",9. 8,"NM",9,0 ) | |
110 | DGOTHRP2^^ 0^B3766021 7 | |
111 | "BLD",1025 7,"KRN",9. 8,"NM",10, 0) | |
112 | DGOTHRP1^^ 0^B6607221 0 | |
113 | "BLD",1025 7,"KRN",9. 8,"NM",11, 0) | |
114 | DGOTHRP3^^ 0^B1997178 57 | |
115 | "BLD",1025 7,"KRN",9. 8,"NM",12, 0) | |
116 | DGOTHRI^^0 ^B23726892 3 | |
117 | "BLD",1025 7,"KRN",9. 8,"NM",13, 0) | |
118 | DGOTHRP4^^ 0^B2165806 1 | |
119 | "BLD",1025 7,"KRN",9. 8,"NM",14, 0) | |
120 | DGOTHINQ^^ 0^B2237958 4 | |
121 | "BLD",1025 7,"KRN",9. 8,"NM",15, 0) | |
122 | DGRP7^^0^B 21370530 | |
123 | "BLD",1025 7,"KRN",9. 8,"NM",17, 0) | |
124 | DGRPD^^0^B 106142283 | |
125 | "BLD",1025 7,"KRN",9. 8,"NM",18, 0) | |
126 | DGRPDB^^0^ B24321515 | |
127 | "BLD",1025 7,"KRN",9. 8,"NM",19, 0) | |
128 | DGOTHUT1^^ 0^B2466375 5 | |
129 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGLOCK1" ,6) | |
130 | ||
131 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHD", 2) | |
132 | ||
133 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHD1" ,4) | |
134 | ||
135 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHD2" ,5) | |
136 | ||
137 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHEDT ",7) | |
138 | ||
139 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHINQ ",14) | |
140 | ||
141 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHRI" ,12) | |
142 | ||
143 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHRP1 ",10) | |
144 | ||
145 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHRP2 ",9) | |
146 | ||
147 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHRP3 ",11) | |
148 | ||
149 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHRP4 ",13) | |
150 | ||
151 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHRPT ",8) | |
152 | ||
153 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGOTHUT1 ",19) | |
154 | ||
155 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGRP7",1 5) | |
156 | ||
157 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGRPD",1 7) | |
158 | ||
159 | "BLD",1025 7,"KRN",9. 8,"NM","B" ,"DGRPDB", 18) | |
160 | ||
161 | "BLD",1025 7,"KRN",19 ,0) | |
162 | 19 | |
163 | "BLD",1025 7,"KRN",19 ,"NM",0) | |
164 | ^9.68A^16^ 14 | |
165 | "BLD",1025 7,"KRN",19 ,"NM",1,0) | |
166 | DG REGISTR ATION MENU ^^2 | |
167 | "BLD",1025 7,"KRN",19 ,"NM",2,0) | |
168 | DG OTH MEN U^^0 | |
169 | "BLD",1025 7,"KRN",19 ,"NM",5,0) | |
170 | DG OTH ADD START DT 2ND 90^^0 | |
171 | "BLD",1025 7,"KRN",19 ,"NM",6,0) | |
172 | DG OTH 2ND PERIOD AU THBY EDIT^ ^0 | |
173 | "BLD",1025 7,"KRN",19 ,"NM",7,0) | |
174 | DG OTH EDI T START DA TE^^0 | |
175 | "BLD",1025 7,"KRN",19 ,"NM",8,0) | |
176 | DG OTH HIS TORY AUDIT REPORT^^0 | |
177 | "BLD",1025 7,"KRN",19 ,"NM",9,0) | |
178 | DG OTH ACT IVE 90-DAY PERIOD^^0 | |
179 | "BLD",1025 7,"KRN",19 ,"NM",10,0 ) | |
180 | DG OTH EXC EPTION REP ORT^^0 | |
181 | "BLD",1025 7,"KRN",19 ,"NM",11,0 ) | |
182 | DG OTH REP ORTS MENU^ ^0 | |
183 | "BLD",1025 7,"KRN",19 ,"NM",12,0 ) | |
184 | DG OTH STA TISTICAL R EPORT^^0 | |
185 | "BLD",1025 7,"KRN",19 ,"NM",13,0 ) | |
186 | DG OTH STO P/REACTIVA TE CLOCK^^ 0 | |
187 | "BLD",1025 7,"KRN",19 ,"NM",14,0 ) | |
188 | DG OTH PAT IENT INQUI RY^^0 | |
189 | "BLD",1025 7,"KRN",19 ,"NM",15,0 ) | |
190 | DG OTH INA CT REPORT^ ^0 | |
191 | "BLD",1025 7,"KRN",19 ,"NM",16,0 ) | |
192 | DG OTH AUT H ADDITION AL 90 DAYS ^^0 | |
193 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH 2N D PERIOD A UTHBY EDIT ",6) | |
194 | ||
195 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH AC TIVE 90-DA Y PERIOD", 9) | |
196 | ||
197 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH AD D START DT 2ND 90",5 ) | |
198 | ||
199 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH AU TH ADDITIO NAL 90 DAY S",16) | |
200 | ||
201 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH ED IT START D ATE",7) | |
202 | ||
203 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH EX CEPTION RE PORT",10) | |
204 | ||
205 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH HI STORY AUDI T REPORT", 8) | |
206 | ||
207 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH IN ACT REPORT ",15) | |
208 | ||
209 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH ME NU",2) | |
210 | ||
211 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH PA TIENT INQU IRY",14) | |
212 | ||
213 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH RE PORTS MENU ",11) | |
214 | ||
215 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH ST ATISTICAL REPORT",12 ) | |
216 | ||
217 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG OTH ST OP/REACTIV ATE CLOCK" ,13) | |
218 | ||
219 | "BLD",1025 7,"KRN",19 ,"NM","B", "DG REGIST RATION MEN U",1) | |
220 | ||
221 | "BLD",1025 7,"KRN",19 .1,0) | |
222 | 19.1 | |
223 | "BLD",1025 7,"KRN",19 .1,"NM",0) | |
224 | ^9.68A^1^1 | |
225 | "BLD",1025 7,"KRN",19 .1,"NM",1, 0) | |
226 | DG OTH EDI T^^0 | |
227 | "BLD",1025 7,"KRN",19 .1,"NM","B ","DG OTH EDIT",1) | |
228 | ||
229 | "BLD",1025 7,"KRN",10 1,0) | |
230 | 101 | |
231 | "BLD",1025 7,"KRN",40 9.61,0) | |
232 | 409.61 | |
233 | "BLD",1025 7,"KRN",77 1,0) | |
234 | 771 | |
235 | "BLD",1025 7,"KRN",77 9.2,0) | |
236 | 779.2 | |
237 | "BLD",1025 7,"KRN",87 0,0) | |
238 | 870 | |
239 | "BLD",1025 7,"KRN",89 89.51,0) | |
240 | 8989.51 | |
241 | "BLD",1025 7,"KRN",89 89.52,0) | |
242 | 8989.52 | |
243 | "BLD",1025 7,"KRN",89 94,0) | |
244 | 8994 | |
245 | "BLD",1025 7,"KRN","B ",.4,.4) | |
246 | ||
247 | "BLD",1025 7,"KRN","B ",.401,.40 1) | |
248 | ||
249 | "BLD",1025 7,"KRN","B ",.402,.40 2) | |
250 | ||
251 | "BLD",1025 7,"KRN","B ",.403,.40 3) | |
252 | ||
253 | "BLD",1025 7,"KRN","B ",.5,.5) | |
254 | ||
255 | "BLD",1025 7,"KRN","B ",.84,.84) | |
256 | ||
257 | "BLD",1025 7,"KRN","B ",3.6,3.6) | |
258 | ||
259 | "BLD",1025 7,"KRN","B ",3.8,3.8) | |
260 | ||
261 | "BLD",1025 7,"KRN","B ",9.2,9.2) | |
262 | ||
263 | "BLD",1025 7,"KRN","B ",9.8,9.8) | |
264 | ||
265 | "BLD",1025 7,"KRN","B ",19,19) | |
266 | ||
267 | "BLD",1025 7,"KRN","B ",19.1,19. 1) | |
268 | ||
269 | "BLD",1025 7,"KRN","B ",101,101) | |
270 | ||
271 | "BLD",1025 7,"KRN","B ",409.61,4 09.61) | |
272 | ||
273 | "BLD",1025 7,"KRN","B ",771,771) | |
274 | ||
275 | "BLD",1025 7,"KRN","B ",779.2,77 9.2) | |
276 | ||
277 | "BLD",1025 7,"KRN","B ",870,870) | |
278 | ||
279 | "BLD",1025 7,"KRN","B ",8989.51, 8989.51) | |
280 | ||
281 | "BLD",1025 7,"KRN","B ",8989.52, 8989.52) | |
282 | ||
283 | "BLD",1025 7,"KRN","B ",8994,899 4) | |
284 | ||
285 | "BLD",1025 7,"QUES",0 ) | |
286 | ^9.62^^ | |
287 | "BLD",1025 7,"REQB",0 ) | |
288 | ^9.611^3^3 | |
289 | "BLD",1025 7,"REQB",1 ,0) | |
290 | DG*5.3*314 ^2 | |
291 | "BLD",1025 7,"REQB",2 ,0) | |
292 | DG*5.3*842 ^2 | |
293 | "BLD",1025 7,"REQB",3 ,0) | |
294 | DG*5.3*977 ^2 | |
295 | "BLD",1025 7,"REQB"," B","DG*5.3 *314",1) | |
296 | ||
297 | "BLD",1025 7,"REQB"," B","DG*5.3 *842",2) | |
298 | ||
299 | "BLD",1025 7,"REQB"," B","DG*5.3 *977",3) | |
300 | ||
301 | "FIA",2) | |
302 | PATIENT | |
303 | "FIA",2,0) | |
304 | ^DPT( | |
305 | "FIA",2,0, 0) | |
306 | 2I | |
307 | "FIA",2,0, 1) | |
308 | y^n^p^^^^n ^^n | |
309 | "FIA",2,0, 10) | |
310 | ||
311 | "FIA",2,0, 11) | |
312 | ||
313 | "FIA",2,0, "RLRO") | |
314 | ||
315 | "FIA",2,0, "VR") | |
316 | 5.3^DG | |
317 | "FIA",2,2) | |
318 | 1 | |
319 | "FIA",2,2, .5501) | |
320 | ||
321 | "FIA",33) | |
322 | OTH ELIGIB ILITY CLOC K | |
323 | "FIA",33,0 ) | |
324 | ^DGOTH(33, | |
325 | "FIA",33,0 ,0) | |
326 | 33P | |
327 | "FIA",33,0 ,1) | |
328 | y^y^f^^^^n | |
329 | "FIA",33,0 ,10) | |
330 | ||
331 | "FIA",33,0 ,11) | |
332 | ||
333 | "FIA",33,0 ,"RLRO") | |
334 | ||
335 | "FIA",33,0 ,"VR") | |
336 | 5.3^DG | |
337 | "FIA",33,3 3) | |
338 | 0 | |
339 | "FIA",33,3 3.01) | |
340 | 0 | |
341 | "FIA",33,3 3.02) | |
342 | 0 | |
343 | "FIA",33,3 3.11) | |
344 | 0 | |
345 | "FIA",33.1 ) | |
346 | OTH CLOCK HISTORY | |
347 | "FIA",33.1 ,0) | |
348 | ^DGOTH(33. 1, | |
349 | "FIA",33.1 ,0,0) | |
350 | 33.1P | |
351 | "FIA",33.1 ,0,1) | |
352 | y^y^f^^^^n | |
353 | "FIA",33.1 ,0,10) | |
354 | ||
355 | "FIA",33.1 ,0,11) | |
356 | ||
357 | "FIA",33.1 ,0,"RLRO") | |
358 | ||
359 | "FIA",33.1 ,0,"VR") | |
360 | 5.3^DG | |
361 | "FIA",33.1 ,33.1) | |
362 | 0 | |
363 | "FIA",33.1 ,33.12) | |
364 | 0 | |
365 | "KRN",.4,2 630,-1) | |
366 | 0^1 | |
367 | "KRN",.4,2 630,0) | |
368 | DG OTH PRI NT TEMPLAT E^3190215. 1012^@^33. 1^^@^31903 20 | |
369 | "KRN",.4,2 630,"DXS") | |
370 | 3 | |
371 | "KRN",.4,2 630,"DXS", 1,9) | |
372 | X DXS(1,9. 6) S X=$P( DIP(304),U ,9),DIP(40 4)=$G(X) S X=6,DIP(4 05)=$G(X) S X=9,X=$E (DIP(404), DIP(405),X ) S Y=X,X= DIP(403),X =X_Y_")",Y =X,X=DIP(1 02),X=X_Y S D0=I(0,0 ) | |
373 | "KRN",.4,2 630,"DXS", 1,9.2) | |
374 | S I(0,0)=$ G(D0),DIP( 1)=$S($D(^ DGOTH(33.1 ,D0,0)):^( 0),1:""),D 0=$P(DIP(1 ),U,1) S:' D0!'$D(^DG OTH(33,+D0 ,0)) D0=-1 S D0=D0 S I(100,0)= $G(D0),DIP (101)=$S($ D(^DGOTH(3 3,D0,0)):^ (0),1:"") | |
375 | "KRN",.4,2 630,"DXS", 1,9.3) | |
376 | X DXS(1,9. 2) S X=$P( $G(^DPT(+$ P(DIP(101) ,U,1),0)), U)_" ( ",DIP(102) =$G(X),D0= $P(DIP(1), U,1) S:'D0 !'$D(^DGOT H(33,+D0,0 )) D0=-1 S D0=D0 S I (200,0)=$G (D0) | |
377 | "KRN",.4,2 630,"DXS", 1,9.4) | |
378 | X DXS(1,9. 3) S DIP(2 01)=$S($D( ^DGOTH(33, D0,0)):^(0 ),1:""),DI P(202)=$G( X),D0=$P(D IP(201),U, 1) S:'D0!' $D(^DPT(+D 0,0)) D0=- 1 S D0=D0 S I(300,0) =$G(D0) | |
379 | "KRN",.4,2 630,"DXS", 1,9.5) | |
380 | X DXS(1,9. 4) S DIP(3 04)=$S($D( ^DPT(D0,0) ):^(0),1:" "),DIP(301 )=$G(X),DI P(302)=$G( X),D0=$P(D IP(1),U,1) S:'D0!'$D (^DGOTH(33 ,+D0,0)) D 0=-1 S D0= D0 | |
381 | "KRN",.4,2 630,"DXS", 1,9.6) | |
382 | X DXS(1,9. 5) S DIP(4 01)=$S($D( ^DGOTH(33, D0,0)):^(0 ),1:"") S X=$P($G(^D PT(+$P(DIP (401),U,1) ,0)),U),DI P(402)=$G( X) S X=1,X =$E(DIP(40 2),X),DIP( 403)=$G(X) | |
383 | "KRN",.4,2 630,"DXS", 2,9.2) | |
384 | S I(0,0)=$ G(D0),DIP( 1)=$S($D(^ DGOTH(33.1 ,D0,0)):^( 0),1:""),D 0=$P(DIP(1 ),U,1) S:' D0!'$D(^DG OTH(33,+D0 ,0)) D0=-1 S D0=D0 S I(100,0)= $G(D0),DIP (101)=$S($ D(^DGOTH(3 3,D0,0)):^ (0),1:"") | |
385 | "KRN",.4,2 630,"DXS", 2,9.3) | |
386 | X DXS(2,9. 2) S DIP(1 02)=$G(X), D0=$P(DIP( 101),U,1) S:'D0!'$D( ^DPT(+D0,0 )) D0=-1 S D0=D0 S D IP(201)=$S ($D(^DPT(D 0,0)):^(0) ,1:"") | |
387 | "KRN",.4,2 630,"F",1) | |
388 | ""~"Patien t Name :";X;"";C1 ~X DXS(1,9 ) W X K DI P;X;"";C21 ;Z;"OTH CL OCK_" ("_OTH CLO CK:PATIENT :$E(OTH CL OCK,1)_$E( SSN,6,9)_" )""~ | |
389 | "KRN",.4,2 630,"F",2) | |
390 | "Date of B irth :"; X;"";C1~ | |
391 | "KRN",.4,2 630,"F",3) | |
392 | N DIERR X DXS(2,9.3) S X=$$EXT ERNAL^DIDU (2,.03,"", $P(DIP(201 ),U,3)) S D0=I(0,0) W X K DIP; X;"";C21;Z ;"OTH CLOC K:PATIENT: DOB"~1,""; S~ | |
393 | "KRN",.4,2 630,"F",4) | |
394 | 1,"365 Day s Period : ";X;"";C1~ 1,.01;C19; ""~1,"90 D ays Period :";X;""; C1~1,.02;C 20;""~1,"F ield Updat ed :";X; "";C1~1,.0 3;C21;""~ | |
395 | "KRN",.4,2 630,"F",5) | |
396 | 1,"Previou s Value : ";X;"";C1~ | |
397 | "KRN",.4,2 630,"F",6) | |
398 | 1,S DIP(1) =$S($D(^DG OTH(33.1,D 0,1,D1,0)) :^(0),1:"" ) S X=$P(D IP(1),U,4) ,X=$P(X,". ",1) S Y=X D DT K DI P;C21;"";d ;L18;Z;"DA TE(PREVIOU S VALUE)"~ | |
399 | "KRN",.4,2 630,"F",7) | |
400 | 1,"New Val ue : ";X;"";C1~ | |
401 | "KRN",.4,2 630,"F",8) | |
402 | 1,S DIP(1) =$S($D(^DG OTH(33.1,D 0,1,D1,0)) :^(0),1:"" ) S X=$P(D IP(1),U,5) ,X=$P(X,". ",1) S Y=X D DT K DI P;C21;"";d ;L18;Z;"DA TE(NEW VAL UE)"~ | |
403 | "KRN",.4,2 630,"F",9) | |
404 | 1,"Edited By : ";X;"";C1~ 1,.06;C21; ""~1,"Edit ed Date/Ti me:";X;""; C1~1,.07;C 21;""~1,D RSNMSG^DGO THRPT;X;"" ;Z;"D RSNM SG^DGOTHRP T"~ | |
405 | "KRN",.4,2 630,"H") | |
406 | OTH CLOCK HISTORY Li st | |
407 | "KRN",.402 ,1093,-1) | |
408 | 0^1 | |
409 | "KRN",.402 ,1093,0) | |
410 | DG LOAD ED IT SCREEN 7^3190304. 1104^^2^^^ 3190319 | |
411 | "KRN",.402 ,1093,"%D" ,0) | |
412 | ^.4021^1^1 ^3110428^^ ^^ | |
413 | "KRN",.402 ,1093,"%D" ,1,0) | |
414 | This templ ate is use d to enter /edit data on regist ration scr een 7. | |
415 | "KRN",.402 ,1093,"DIA B",1,1,2.0 5,0) | |
416 | ALL | |
417 | "KRN",.402 ,1093,"DIA B",6,0,2,2 ) | |
418 | PENSION AW ARD EFFECT IVE DATE// /"@" | |
419 | "KRN",.402 ,1093,"DIA B",7,0,2,4 ) | |
420 | PENSION AW ARD REASON ///"@" | |
421 | "KRN",.402 ,1093,"DIA B",8,0,2,2 ) | |
422 | PENSION AW ARD REASON ///"@" | |
423 | "KRN",.402 ,1093,"DR" ,1,2) | |
424 | S:DGDR'["7 01" Y="@70 2";391;D S C7^DGRPV;1 901;.301;S :X'="Y" Y= .293;.302; .3012;.305 ;I $P($G(^ DPT(DFN,.3 61)),U)="V " I $P($G( ^DPT(DFN,. 361)),U,3) ="H" S Y=" @293";.304 ;S:X'="Y" Y=.293;.30 13;S Y=.29 3;@293; | |
425 | "KRN",.402 ,1093,"DR" ,1,2,1) | |
426 | W !,"No ed iting P&T Data, Elig ibility re cord verif ied by HEC ";.293;S:' X Y=.313;. 292;.291;. 313;.314;@ 702;S:DGDR '["702" Y= "@703";.36 205;.36215 ;S:$P($G(^ DPT(DFN,.3 85)),U,11) ="Y" Y="@7 025"; | |
427 | "KRN",.402 ,1093,"DR" ,1,2,2) | |
428 | S:($P($G(^ DPT(DFN,.3 85)),U,10) ="Y")&($P( $G(^DPT(DF N,.362)),U ,14)="N") Y="@7025"; S:$P($G(^D PT(DFN,.38 5)),U,10)= "Y" Y="@70 22";.36235 ;I X="Y" S Y="@7022" ;Q;.3851// /^S X="@"; Q;.3852/// ^S X="@";S Y="@7026" ;@7022; | |
429 | "KRN",.402 ,1093,"DR" ,1,2,3) | |
430 | S:($P($G(^ DPT(DFN,.3 85)),U,10) '="Y") Y=" @7023";D E N^DDIOL("P ension Awa rd Date an d Pension Award Reas on are edi table only if VA Pen sion",""," !!"); | |
431 | "KRN",.402 ,1093,"DR" ,1,2,4) | |
432 | D EN^DDIOL ("Indicato r is Yes a nd Pension Award Rea son is not 'Original Award'. For any"," ","!");D E N^DDIOL("o ther assis tance, use the HEC A lert proce ss.","","! ");@7023;. 3851;I X]" " S Y="@70 24";Q;.385 2///^S X=" @";S Y="@7 026";@7024 ; | |
433 | "KRN",.402 ,1093,"DR" ,1,2,5) | |
434 | .3852;I X= "" S Y="@7 026";I X=$ $GET1^DIQ( 2,DFN,.385 2,"I") S Y ="@7026";I $$GET1^DI Q(27.18,X, .01,"E")'[ "Original Award" D E N^DDIOL("O nly 'Origi nal Award' may be en tered",,"! !") S Y="@ 7024";S Y= "@7026";@7 025; | |
435 | "KRN",.402 ,1093,"DR" ,1,2,6) | |
436 | D EN^DDIOL ("Pension Award Date and Pensi on Award R eason are editable o nly if VA Pension"," ","!!");D EN^DDIOL(" Indicator is Yes and Pension A ward Reaso n is not ' Original A ward'. Fo r any","", "!"); | |
437 | "KRN",.402 ,1093,"DR" ,1,2,7) | |
438 | D EN^DDIOL ("other as sistance, use the HE C Alert pr ocess.","" ,"!");@702 6;.3025;S: (X'="Y")&( $P($G(^DPT (DA,.362)) ,U,12,14)' ["Y") Y=.3 6265;.3629 5;.36265;S :X'="Y" Y= "@703";.36 26;@703;S: DGDR'["703 " Y="@704" ;.361; | |
439 | "KRN",.402 ,1093,"DR" ,1,2,8) | |
440 | D XPANDED^ DGOTHD1(DF N) S Y="@7 027";@7027 ;D AAC1^DG LOCK2 S:DG AAC(1)']"" Y=361;.30 9;361;.323 ;D ^DGYZOD S S:'DGODS Y="@704"; 11500.02;1 1500.03;@7 04;S:DGDR' ["704" Y=" @99";.3731 ;@99; | |
441 | "KRN",.402 ,1093,"DR" ,2,2.0361) | |
442 | .01; | |
443 | "KRN",.402 ,1093,"DR" ,2,2.05) | |
444 | .01:.02 | |
445 | "KRN",.402 ,1093,"ROU ") | |
446 | ^DGRPX7 | |
447 | "KRN",.402 ,1093,"ROU OLD") | |
448 | DGRPX7 | |
449 | "KRN",19,4 25,-1) | |
450 | 2^1 | |
451 | "KRN",19,4 25,0) | |
452 | DG REGISTR ATION MENU ^Registrat ion Menu^^ M^.5^^^^^^ ^114^^1^1 | |
453 | "KRN",19,4 25,10,0) | |
454 | ^19.01PI^3 8^38 | |
455 | "KRN",19,4 25,10,38,0 ) | |
456 | 14642^OTH | |
457 | "KRN",19,4 25,10,38," ^") | |
458 | DG OTH MEN U | |
459 | "KRN",19,4 25,"U") | |
460 | REGISTRATI ON MENU | |
461 | "KRN",19,1 4642,-1) | |
462 | 0^2 | |
463 | "KRN",19,1 4642,0) | |
464 | DG OTH MEN U^Other Th an Honorab le Patient s Menu^^M^ ^^^^^^^ | |
465 | "KRN",19,1 4642,1,0) | |
466 | ^19.06^2^2 ^3190305^^ ^^ | |
467 | "KRN",19,1 4642,1,1,0 ) | |
468 | This menu contains o ptions to manage Oth er Than Ho norable st atus for | |
469 | "KRN",19,1 4642,1,2,0 ) | |
470 | patients. | |
471 | "KRN",19,1 4642,10,0) | |
472 | ^19.01IP^8 ^8 | |
473 | "KRN",19,1 4642,10,1, 0) | |
474 | 14643^^1 | |
475 | "KRN",19,1 4642,10,1, "^") | |
476 | DG OTH AUT H ADDITION AL 90 DAYS | |
477 | "KRN",19,1 4642,10,2, 0) | |
478 | 14644^^2 | |
479 | "KRN",19,1 4642,10,2, "^") | |
480 | DG OTH EDI T START DA TE | |
481 | "KRN",19,1 4642,10,4, 0) | |
482 | 14645^^4 | |
483 | "KRN",19,1 4642,10,4, "^") | |
484 | DG OTH 2ND PERIOD AU THBY EDIT | |
485 | "KRN",19,1 4642,10,5, 0) | |
486 | 14646^^3 | |
487 | "KRN",19,1 4642,10,5, "^") | |
488 | DG OTH ADD START DT 2ND 90 | |
489 | "KRN",19,1 4642,10,6, 0) | |
490 | 14648^^5 | |
491 | "KRN",19,1 4642,10,6, "^") | |
492 | DG OTH REP ORTS MENU | |
493 | "KRN",19,1 4642,10,7, 0) | |
494 | 14668^^6 | |
495 | "KRN",19,1 4642,10,7, "^") | |
496 | DG OTH STO P/REACTIVA TE CLOCK | |
497 | "KRN",19,1 4642,10,8, 0) | |
498 | 14671^^7 | |
499 | "KRN",19,1 4642,10,8, "^") | |
500 | DG OTH PAT IENT INQUI RY | |
501 | "KRN",19,1 4642,99) | |
502 | 65077,3794 4 | |
503 | "KRN",19,1 4642,"U") | |
504 | OTHER THAN HONORABLE PATIENTS | |
505 | "KRN",19,1 4643,-1) | |
506 | 0^16 | |
507 | "KRN",19,1 4643,0) | |
508 | DG OTH AUT H ADDITION AL 90 DAYS ^Start Add itional 90 -Days Peri od^^R^^^^^ ^^^ | |
509 | "KRN",19,1 4643,1,0) | |
510 | ^^2^2^3190 314^ | |
511 | "KRN",19,1 4643,1,1,0 ) | |
512 | This menu option is used to st art and au thorize an additiona l 90-Days | |
513 | "KRN",19,1 4643,1,2,0 ) | |
514 | period for the selec ted patien t. | |
515 | "KRN",19,1 4643,25) | |
516 | AUTH90DS^D GOTHD | |
517 | "KRN",19,1 4643,"U") | |
518 | START ADDI TIONAL 90- DAYS PERIO | |
519 | "KRN",19,1 4644,-1) | |
520 | 0^7 | |
521 | "KRN",19,1 4644,0) | |
522 | DG OTH EDI T START DA TE^Edit 90 -Day Start Date^^R^^ DG OTH EDI T^^^^^^ | |
523 | "KRN",19,1 4644,1,0) | |
524 | ^19.06^2^2 ^3180412^^ ^^ | |
525 | "KRN",19,1 4644,1,1,0 ) | |
526 | Allow user to edit t he start d ate for th e 1st or 2 nd 90-Day period of | |
527 | "KRN",19,1 4644,1,2,0 ) | |
528 | care for t he Other T han Honora ble patien ts. | |
529 | "KRN",19,1 4644,10.1) | |
530 | ||
531 | "KRN",19,1 4644,25) | |
532 | ESTRTDT^DG OTHEDT | |
533 | "KRN",19,1 4644,"U") | |
534 | EDIT 90-DA Y START DA TE | |
535 | "KRN",19,1 4645,-1) | |
536 | 0^6 | |
537 | "KRN",19,1 4645,0) | |
538 | DG OTH 2ND PERIOD AU THBY EDIT^ Update 'Au thorized b y', 2nd 90 days^^R^^ DG OTH EDI T^^^^^^ | |
539 | "KRN",19,1 4645,1,0) | |
540 | ^19.06^1^1 ^3180405^^ ^ | |
541 | "KRN",19,1 4645,1,1,0 ) | |
542 | Allows a s upervisor to edit th e "Authori zed by" fi eld for th e 2nd 90 d ay period of care. | |
543 | "KRN",19,1 4645,25) | |
544 | EDAUTHBY^D GOTHD2 | |
545 | "KRN",19,1 4645,"U") | |
546 | UPDATE 'AU THORIZED B Y', 2ND 90 | |
547 | "KRN",19,1 4646,-1) | |
548 | 0^5 | |
549 | "KRN",19,1 4646,0) | |
550 | DG OTH ADD START DT 2ND 90^Add start dat e 2nd 90 d ays^^R^^^^ ^^^^ | |
551 | "KRN",19,1 4646,1,0) | |
552 | ^19.06^1^1 ^3180409^^ ^ | |
553 | "KRN",19,1 4646,1,1,0 ) | |
554 | Edit the s tart date of the 2nd 90 day pe riod of ca re | |
555 | "KRN",19,1 4646,25) | |
556 | EDSTDT^DGO THD2 | |
557 | "KRN",19,1 4646,"U") | |
558 | ADD START DATE 2ND 9 0 DAYS | |
559 | "KRN",19,1 4647,-1) | |
560 | 0^8 | |
561 | "KRN",19,1 4647,0) | |
562 | DG OTH HIS TORY AUDIT REPORT^Pa tient OTH Audit Hist ory Report ^^R^^^^^^^ ^ | |
563 | "KRN",19,1 4647,1,0) | |
564 | ^^7^7^3190 305^ | |
565 | "KRN",19,1 4647,1,1,0 ) | |
566 | This optio n prints i nformation stored in the OTH C LOCK HISTO RY file | |
567 | "KRN",19,1 4647,1,2,0 ) | |
568 | (#33.1) | |
569 | "KRN",19,1 4647,1,3,0 ) | |
570 | ||
571 | "KRN",19,1 4647,1,4,0 ) | |
572 | The report prints th e patient name, last four(4) d igits of t heir SSN, 365 | |
573 | "KRN",19,1 4647,1,5,0 ) | |
574 | days perio d, 90 Days period, t he field e dited, the old value , the new | |
575 | "KRN",19,1 4647,1,6,0 ) | |
576 | value, the user who made the c hange, and date/time the field was edite d. | |
577 | "KRN",19,1 4647,1,7,0 ) | |
578 | The right margin for this repo rt is 80. | |
579 | "KRN",19,1 4647,25) | |
580 | EN^DGOTHRP T | |
581 | "KRN",19,1 4647,60) | |
582 | ||
583 | "KRN",19,1 4647,63) | |
584 | ||
585 | "KRN",19,1 4647,64) | |
586 | ||
587 | "KRN",19,1 4647,67) | |
588 | ||
589 | "KRN",19,1 4647,99) | |
590 | 64765,7683 9 | |
591 | "KRN",19,1 4647,"U") | |
592 | PATIENT OT H AUDIT HI STORY REPO | |
593 | "KRN",19,1 4648,-1) | |
594 | 0^11 | |
595 | "KRN",19,1 4648,0) | |
596 | DG OTH REP ORTS MENU^ Other than honorable reports^^ M^^^^^^^^ | |
597 | "KRN",19,1 4648,10,0) | |
598 | ^19.01IP^5 ^5 | |
599 | "KRN",19,1 4648,10,1, 0) | |
600 | 14647^^1 | |
601 | "KRN",19,1 4648,10,1, "^") | |
602 | DG OTH HIS TORY AUDIT REPORT | |
603 | "KRN",19,1 4648,10,2, 0) | |
604 | 14649^^2 | |
605 | "KRN",19,1 4648,10,2, "^") | |
606 | DG OTH EXC EPTION REP ORT | |
607 | "KRN",19,1 4648,10,3, 0) | |
608 | 14651^^3 | |
609 | "KRN",19,1 4648,10,3, "^") | |
610 | DG OTH ACT IVE 90-DAY PERIOD | |
611 | "KRN",19,1 4648,10,4, 0) | |
612 | 14667^^4 | |
613 | "KRN",19,1 4648,10,4, "^") | |
614 | DG OTH STA TISTICAL R EPORT | |
615 | "KRN",19,1 4648,10,5, 0) | |
616 | 14672^^5 | |
617 | "KRN",19,1 4648,10,5, "^") | |
618 | DG OTH INA CT REPORT | |
619 | "KRN",19,1 4648,99) | |
620 | 64875,3648 6 | |
621 | "KRN",19,1 4648,"U") | |
622 | OTHER THAN HONORABLE REPORTS | |
623 | "KRN",19,1 4649,-1) | |
624 | 0^10 | |
625 | "KRN",19,1 4649,0) | |
626 | DG OTH EXC EPTION REP ORT^Except ion Report s, OTH Pts ^^R^^^^^^^ ^ | |
627 | "KRN",19,1 4649,1,0) | |
628 | ^19.06^3^3 ^3180815^^ | |
629 | "KRN",19,1 4649,1,1,0 ) | |
630 | These are the other than honor able patie nts that a re not cur rently | |
631 | "KRN",19,1 4649,1,2,0 ) | |
632 | eligible f or care at this time . It has s everal rep ort option s to assis t in | |
633 | "KRN",19,1 4649,1,3,0 ) | |
634 | managing t he program . | |
635 | "KRN",19,1 4649,25) | |
636 | REPORT^DGO THRP1 | |
637 | "KRN",19,1 4649,"U") | |
638 | EXCEPTION REPORTS, O TH PTS | |
639 | "KRN",19,1 4651,-1) | |
640 | 0^9 | |
641 | "KRN",19,1 4651,0) | |
642 | DG OTH ACT IVE 90-DAY PERIOD^Ac tive 90-Da y Period O TH Patient Report^^R ^^^^^^^^ | |
643 | "KRN",19,1 4651,1,0) | |
644 | ^^12^12^31 80518^ | |
645 | "KRN",19,1 4651,1,1,0 ) | |
646 | This optio n generate s a report that prin ts a listi ng of all Other Than | |
647 | "KRN",19,1 4651,1,2,0 ) | |
648 | Honorable patients w ith ACTIVE 90-Day pe riod of ca re. The us er is prom pted | |
649 | "KRN",19,1 4651,1,3,0 ) | |
650 | to enter t he date ra nge for in clusion on the repor t. The re port can b e | |
651 | "KRN",19,1 4651,1,4,0 ) | |
652 | sorted by the follow ing: | |
653 | "KRN",19,1 4651,1,5,0 ) | |
654 | ||
655 | "KRN",19,1 4651,1,6,0 ) | |
656 | 1. Sort b y Patient Name | |
657 | "KRN",19,1 4651,1,7,0 ) | |
658 | 2. Sort b y Period | |
659 | "KRN",19,1 4651,1,8,0 ) | |
660 | 3. Sort b y Days Rem aining | |
661 | "KRN",19,1 4651,1,9,0 ) | |
662 | ||
663 | "KRN",19,1 4651,1,10, 0) | |
664 | The listin g shows Pa tient Name , Last Fou r of their SSN, Peri od, Start | |
665 | "KRN",19,1 4651,1,11, 0) | |
666 | Date, End Date, Days Left, and Authorize d By. | |
667 | "KRN",19,1 4651,1,12, 0) | |
668 | Report pri nts in 80 column for mat. | |
669 | "KRN",19,1 4651,25) | |
670 | REPORT1^DG OTHRPT | |
671 | "KRN",19,1 4651,"U") | |
672 | ACTIVE 90- DAY PERIOD OTH PATIE | |
673 | "KRN",19,1 4667,-1) | |
674 | 0^12 | |
675 | "KRN",19,1 4667,0) | |
676 | DG OTH STA TISTICAL R EPORT^OTH Patient St atistics R eport^^R^^ ^^^^^^ | |
677 | "KRN",19,1 4667,1,0) | |
678 | ^^2^2^3180 612^ | |
679 | "KRN",19,1 4667,1,1,0 ) | |
680 | This optio n generate s a statis tical repo rt that wi ll display a listing of | |
681 | "KRN",19,1 4667,1,2,0 ) | |
682 | Other Than Honorable patients treated un der OTH au thority. | |
683 | "KRN",19,1 4667,25) | |
684 | ENSTAT^DGO THRPT | |
685 | "KRN",19,1 4667,"U") | |
686 | OTH PATIEN T STATISTI CS REPORT | |
687 | "KRN",19,1 4668,-1) | |
688 | 0^13 | |
689 | "KRN",19,1 4668,0) | |
690 | DG OTH STO P/REACTIVA TE CLOCK^I nactivate or Reactiv ate OTH Pt Countdown Clock^^R^ ^DG OTH ED IT^^^^^^ | |
691 | "KRN",19,1 4668,1,0) | |
692 | ^19.06^2^2 ^3190305^^ | |
693 | "KRN",19,1 4668,1,1,0 ) | |
694 | This optio n allow us er to manu ally inact ivate/re-a ctivate Ot her Than | |
695 | "KRN",19,1 4668,1,2,0 ) | |
696 | Honorable patient co untdown cl ock. | |
697 | "KRN",19,1 4668,25) | |
698 | EN^DGOTHRI | |
699 | "KRN",19,1 4668,"U") | |
700 | INACTIVATE OR REACTI VATE OTH P | |
701 | "KRN",19,1 4671,-1) | |
702 | 0^14 | |
703 | "KRN",19,1 4671,0) | |
704 | DG OTH PAT IENT INQUI RY^Patient Inquiry - Other Tha n Honorabl e^^R^^^^^^ ^^ | |
705 | "KRN",19,1 4671,1,0) | |
706 | ^^1^1^3180 814^ | |
707 | "KRN",19,1 4671,1,1,0 ) | |
708 | Allows use r to do an inquiry o n a single Other Tha n Honorabl e patient. | |
709 | "KRN",19,1 4671,25) | |
710 | EN^DGOTHIN Q | |
711 | "KRN",19,1 4671,"U") | |
712 | PATIENT IN QUIRY - OT HER THAN H | |
713 | "KRN",19,1 4672,-1) | |
714 | 0^15 | |
715 | "KRN",19,1 4672,0) | |
716 | DG OTH INA CT REPORT^ Inactivate d/Reactiva ted Report , OTH Pts^ ^R^^^^^^^^ | |
717 | "KRN",19,1 4672,1,0) | |
718 | ^^2^2^3190 305^ | |
719 | "KRN",19,1 4672,1,1,0 ) | |
720 | Report to show patie nt that we re inactiv ated and r eactivated for Other | |
721 | "KRN",19,1 4672,1,2,0 ) | |
722 | than Honor able patie nts. | |
723 | "KRN",19,1 4672,25) | |
724 | INACRPT^DG OTHRP1 | |
725 | "KRN",19,1 4672,"U") | |
726 | INACTIVATE D/REACTIVA TED REPORT | |
727 | "KRN",19.1 ,737,-1) | |
728 | 0^1 | |
729 | "KRN",19.1 ,737,0) | |
730 | DG OTH EDI T^OTH 90-D AY EDIT | |
731 | "KRN",19.1 ,737,1,0) | |
732 | ^19.11^2^2 ^3180326^ | |
733 | "KRN",19.1 ,737,1,1,0 ) | |
734 | Allow user to edit t he start d ate and au thorized b y for the 1st or 2nd | |
735 | "KRN",19.1 ,737,1,2,0 ) | |
736 | 90-Day per iod of car e for the Other Than Honorable patients. | |
737 | "MBREQ") | |
738 | 0 | |
739 | "ORD",3,19 .1) | |
740 | 19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1 | |
741 | "ORD",3,19 .1,0) | |
742 | SECURITY K EY | |
743 | "ORD",5,.4 ) | |
744 | .4;5;;;EDE OUT^DIFROM SO(.4,DA," ",XPDA);FP RE^DIFROMS I(.4,"",XP DA);EPRE^D IFROMSI(.4 ,DA,$E("N" ,$G(XPDNEW )),XPDA,"" ,OLDA);;EP OST^DIFROM SI(.4,DA," ",XPDA);DE L^DIFROMSK (.4,"",%) | |
745 | "ORD",5,.4 ,0) | |
746 | PRINT TEMP LATE | |
747 | "ORD",7,.4 02) | |
748 | .402;7;;;E DEOUT^DIFR OMSO(.402, DA,"",XPDA );FPRE^DIF ROMSI(.402 ,"",XPDA); EPRE^DIFRO MSI(.402,D A,$E("N",$ G(XPDNEW)) ,XPDA,"",O LDA);;EPOS T^DIFROMSI (.402,DA," ",XPDA);DE L^DIFROMSK (.402,"",% ) | |
749 | "ORD",7,.4 02,0) | |
750 | INPUT TEMP LATE | |
751 | "ORD",18,1 9) | |
752 | 19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA | |
753 | "ORD",18,1 9,0) | |
754 | OPTION | |
755 | "PKG",114, -1) | |
756 | 1^1 | |
757 | "PKG",114, 0) | |
758 | REGISTRATI ON^DG^PATI ENT REGIST RATION, AD MISSION, D ISCHARGE, EMBOSSER | |
759 | "PKG",114, 22,0) | |
760 | ^9.49I^1^1 | |
761 | "PKG",114, 22,1,0) | |
762 | 5.3^293081 3^2930821 | |
763 | "PKG",114, 22,1,"PAH" ,1,0) | |
764 | 952^319032 0^52082465 2 | |
765 | "PKG",114, 22,1,"PAH" ,1,1,0) | |
766 | ^^4^4^3190 320 | |
767 | "PKG",114, 22,1,"PAH" ,1,1,1,0) | |
768 | This patch implement s the "EXP ANDED MH C ARE NON VE TERAN" as a new | |
769 | "PKG",114, 22,1,"PAH" ,1,1,2,0) | |
770 | eligibilit y code for patient r egistratio n. It is u sed to ide ntify and | |
771 | "PKG",114, 22,1,"PAH" ,1,1,3,0) | |
772 | track "oth er than ho norably di scharged" service me mbers for emergency | |
773 | "PKG",114, 22,1,"PAH" ,1,1,4,0) | |
774 | mental hea lth servic es in the VA. | |
775 | "QUES","XP F1",0) | |
776 | Y | |
777 | "QUES","XP F1","??") | |
778 | ^D REP^XPD H | |
779 | "QUES","XP F1","A") | |
780 | Shall I wr ite over y our |FLAG| File | |
781 | "QUES","XP F1","B") | |
782 | YES | |
783 | "QUES","XP F1","M") | |
784 | D XPF1^XPD IQ | |
785 | "QUES","XP F2",0) | |
786 | Y | |
787 | "QUES","XP F2","??") | |
788 | ^D DTA^XPD H | |
789 | "QUES","XP F2","A") | |
790 | Want my da ta |FLAG| yours | |
791 | "QUES","XP F2","B") | |
792 | YES | |
793 | "QUES","XP F2","M") | |
794 | D XPF2^XPD IQ | |
795 | "QUES","XP I1",0) | |
796 | YO | |
797 | "QUES","XP I1","??") | |
798 | ^D INHIBIT ^XPDH | |
799 | "QUES","XP I1","A") | |
800 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
801 | "QUES","XP I1","B") | |
802 | NO | |
803 | "QUES","XP I1","M") | |
804 | D XPI1^XPD IQ | |
805 | "QUES","XP M1",0) | |
806 | PO^VA(200, :EM | |
807 | "QUES","XP M1","??") | |
808 | ^D MG^XPDH | |
809 | "QUES","XP M1","A") | |
810 | Enter the Coordinato r for Mail Group '|F LAG|' | |
811 | "QUES","XP M1","B") | |
812 | ||
813 | "QUES","XP M1","M") | |
814 | D XPM1^XPD IQ | |
815 | "QUES","XP O1",0) | |
816 | Y | |
817 | "QUES","XP O1","??") | |
818 | ^D MENU^XP DH | |
819 | "QUES","XP O1","A") | |
820 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
821 | "QUES","XP O1","B") | |
822 | NO | |
823 | "QUES","XP O1","M") | |
824 | D XPO1^XPD IQ | |
825 | "QUES","XP Z1",0) | |
826 | Y | |
827 | "QUES","XP Z1","??") | |
828 | ^D OPT^XPD H | |
829 | "QUES","XP Z1","A") | |
830 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
831 | "QUES","XP Z1","B") | |
832 | NO | |
833 | "QUES","XP Z1","M") | |
834 | D XPZ1^XPD IQ | |
835 | "QUES","XP Z2",0) | |
836 | Y | |
837 | "QUES","XP Z2","??") | |
838 | ^D RTN^XPD H | |
839 | "QUES","XP Z2","A") | |
840 | Want to MO VE routine s to other CPUs | |
841 | "QUES","XP Z2","B") | |
842 | NO | |
843 | "QUES","XP Z2","M") | |
844 | D XPZ2^XPD IQ | |
845 | "RTN") | |
846 | 16 | |
847 | "RTN","DGL OCK1") | |
848 | 0^6^B21160 237 | |
849 | "RTN","DGL OCK1",1,0) | |
850 | DGLOCK1 ;A LB/MRL - P ATIENT FIL E DATA EDI T CHECK ;2 8 JUL 86 | |
851 | "RTN","DGL OCK1",2,0) | |
852 | ;;5.3;Reg istration; **121,314, 952**;Aug 13, 1993;B uild 68 | |
853 | "RTN","DGL OCK1",3,0) | |
854 | AOD ;AO De lete | |
855 | "RTN","DGL OCK1",4,0) | |
856 | I $D(^DPT (DFN,.321) ),$P(^(.32 1),U,2)="Y " W !?4,*7 ,"Can't de lete as lo ng as Agen t Orange e xposure is indicated ." K X | |
857 | "RTN","DGL OCK1",5,0) | |
858 | Q | |
859 | "RTN","DGL OCK1",6,0) | |
860 | COMD ;Comb at Delete | |
861 | "RTN","DGL OCK1",7,0) | |
862 | I $D(^DPT (DFN,.52)) ,$P(^(.52) ,U,11)="Y" W !?4,*7, "Can't del ete as lon g as Comba t Service is indicat ed." K X | |
863 | "RTN","DGL OCK1",8,0) | |
864 | Q | |
865 | "RTN","DGL OCK1",9,0) | |
866 | INED ;Inel igible Del ete | |
867 | "RTN","DGL OCK1",10,0 ) | |
868 | I $D(^DPT (DFN,.15)) ,$P(^(.15) ,U,2)]"" W !?4,*7,"C an't delet e this fie ld as long as 'INELI GIBLE DATE ' is on fi le." K X | |
869 | "RTN","DGL OCK1",11,0 ) | |
870 | Q | |
871 | "RTN","DGL OCK1",12,0 ) | |
872 | IRD ;ION R ad Delete | |
873 | "RTN","DGL OCK1",13,0 ) | |
874 | I $D(^DPT (DFN,.321) ),$P(^(.32 1),U,3)="Y " W !?4,*7 ,"Can't de lete as lo ng as Ioni zing Radia tion expos ure is ind icated." K X | |
875 | "RTN","DGL OCK1",14,0 ) | |
876 | Q | |
877 | "RTN","DGL OCK1",15,0 ) | |
878 | POWD ;POW Delete | |
879 | "RTN","DGL OCK1",16,0 ) | |
880 | I $D(^DPT (DFN,.52)) ,$P(^(.52) ,U,5)="Y" W !?4,*7," Still iden tified as former POW ...Change status to delete." K X | |
881 | "RTN","DGL OCK1",17,0 ) | |
882 | Q | |
883 | "RTN","DGL OCK1",18,0 ) | |
884 | TADD ;Temp Add Delet e | |
885 | "RTN","DGL OCK1",19,0 ) | |
886 | I $D(^DPT (DFN,.121) ),$P(^(.12 1),U,9)="Y " W !?4,*7 ,"Answer N O to the ' WANT TO EN TER TEMPOR ARY ADDRES S' prompt, then dele te." K X | |
887 | "RTN","DGL OCK1",20,0 ) | |
888 | Q | |
889 | "RTN","DGL OCK1",21,0 ) | |
890 | VND ;Viet Svc Delete | |
891 | "RTN","DGL OCK1",22,0 ) | |
892 | I $D(^DPT (DFN,.321) ),$P(^(.32 1),U,1)="Y " W !?4,*7 ,"Can't de lete as lo ng as Viet nam Servic e is still indicated ." K X | |
893 | "RTN","DGL OCK1",23,0 ) | |
894 | Q | |
895 | "RTN","DGL OCK1",24,0 ) | |
896 | SVDEL ;Pan ama, Grena da, Lebano n, Persian Gulf Svc Delete | |
897 | "RTN","DGL OCK1",25,0 ) | |
898 | ;DGX = pi ece positi on of corr esponding service in dicated? f ield | |
899 | "RTN","DGL OCK1",26,0 ) | |
900 | I $D(^DPT (DFN,.322) ),$P(^(.32 2),U,DGX)= "Y" W !?4, *7,"Can't delete as long as ", $S(DGX=1:" Lebanon",D GX=4:"Gren ada",DGX=7 :"Panama", 1:"Persian Gulf")," is still i ndicated." K X | |
901 | "RTN","DGL OCK1",27,0 ) | |
902 | K DGX | |
903 | "RTN","DGL OCK1",28,0 ) | |
904 | Q | |
905 | "RTN","DGL OCK1",29,0 ) | |
906 | EC S DGEC= $S('$D(^DP T(DFN,.36) ):"",$D(^D IC(8,+$P(^ DPT(DFN,.3 6),U,1),0) ):$P(^(0), U,9),1:"") I DGEC=5 W !?4,*7," Eligibilit y Code is 'NSC'...Ca n't be YES ." K X,DGE C Q | |
907 | "RTN","DGL OCK1",30,0 ) | |
908 | K DGEC Q | |
909 | "RTN","DGL OCK1",31,0 ) | |
910 | POS ;Scree n | |
911 | "RTN","DGL OCK1",32,0 ) | |
912 | K DGEC D SV1^DGLOCK I $D(X) S DIC("S")= "I '$P(^(0 ),""^"",8) ,$D(^DPT(D A,.36)),$D (^DIC(21,+ Y,""E"",+$ P(^(.36),U ,1)))" D ^ DIC K DIC S DIC=DIE, X=+Y K:Y<0 X D:'$D(X ) POSH I $ D(X),$D(^D IC(21,X,0) ),$P(^(0), U,7)]"" D POS1 Q | |
913 | "RTN","DGL OCK1",33,0 ) | |
914 | Q | |
915 | "RTN","DGL OCK1",34,0 ) | |
916 | POS1 S XX= $P(^DIC(21 ,X,0),U,7) I $P(^DPT (DA,0),U,3 )]"" I $P( ^(0),U,3)' >XX!($D(^X USEC("DG E LIGIBILITY ",DUZ))) K XX Q | |
917 | "RTN","DGL OCK1",35,0 ) | |
918 | W !?5,*7, "Applicant is too yo ung to hav e served i n that per iod of ser vice.",!?5 ,"See your superviso r if you r equire ass istance." K X,XX Q | |
919 | "RTN","DGL OCK1",36,0 ) | |
920 | POSH S DGE C=$S('$D(^ DPT(DFN,.3 6)):"",$D( ^DIC(8,+$P (^(.36),U, 1),0)):$P( ^(0),U,1), 1:"") W !? 5,"Current Eligibili ty Code" W :DGEC]"" " : ",DGEC I DGEC']"" W " is not defined. Must be d efined in order",!?5 ,"to enter a POS." | |
921 | "RTN","DGL OCK1",37,0 ) | |
922 | K DGEC Q | |
923 | "RTN","DGL OCK1",38,0 ) | |
924 | SC S DGSCO N=$S('$D(^ DPT(DFN,.3 )):0,$P(^( .3),U,1)=" Y":1,1:0) I 'DGSCON W !?4,*7," Not possib le, applic ant is not service-c onnected." K X,DGSCO N Q | |
925 | "RTN","DGL OCK1",39,0 ) | |
926 | K DGSCON Q | |
927 | "RTN","DGL OCK1",40,0 ) | |
928 | ; | |
929 | "RTN","DGL OCK1",41,0 ) | |
930 | ECD ;prima ry eligibi lity code input tran sform | |
931 | "RTN","DGL OCK1",42,0 ) | |
932 | ; | |
933 | "RTN","DGL OCK1",43,0 ) | |
934 | N DGNODE, DGPC,DGSER ,DGVT,DGXX | |
935 | "RTN","DGL OCK1",44,0 ) | |
936 | S DGVT=$G (^DPT(DFN, "VET")),DG SER=$S('$D (^DPT(DFN, .3)):0,$P( ^(.3),U,1) ="Y":1,1:0 ) | |
937 | "RTN","DGL OCK1",45,0 ) | |
938 | I DGVT']" " K X W !? 4,*7,"'VET ERAN (Y/N) ' prompt m ust be ans wered to s elect an E ligibility Code'" Q | |
939 | "RTN","DGL OCK1",46,0 ) | |
940 | ;screen o ut all ent ries with the wrong "veteran" type, and inactive a nd those t hat can be selected only as ad ditional | |
941 | "RTN","DGL OCK1",47,0 ) | |
942 | S DIC("S" )="I $P(^D IC(8,+Y,0) ,U,5)=DGVT ,'$P(^(0), U,7)" I DG VT="N" G E CDS | |
943 | "RTN","DGL OCK1",48,0 ) | |
944 | I DGSER S DGPC=$S(+ $P(^DPT(DF N,.3),U,2) >49:1,1:0) ,DGXX=$S(D GPC:1,1:3) ,DIC("S")= DIC("S")_" ,($P(^(0), U,9)="_DGX X_")" G EC DS ;sc onl y | |
945 | "RTN","DGL OCK1",49,0 ) | |
946 | I $P($G(^ DPT(DFN,.5 2)),"^",5) ="Y" S DIC ("S")=DIC( "S")_",($P (^(0),U,9) =18)" G EC DS ;pow on ly | |
947 | "RTN","DGL OCK1",50,0 ) | |
948 | S DGXX="^ 1^3^18^" ; no sc<50, sc 50-100 , pow | |
949 | "RTN","DGL OCK1",51,0 ) | |
950 | I $P($G(^ DPT(DFN,.5 3)),U)="Y" S DIC("S" )=DIC("S") _",($P(^(0 ),U,9)=22) " G ECDS ; checks for PH Indica tor | |
951 | "RTN","DGL OCK1",52,0 ) | |
952 | S DGXX=DG XX_"22^" ; adds PH to DGXX stri ng | |
953 | "RTN","DGL OCK1",53,0 ) | |
954 | S DGNODE= $G(^DPT(DF N,.362)) | |
955 | "RTN","DGL OCK1",54,0 ) | |
956 | I $P(DGNO DE,"^",12) '="Y" S DG XX=DGXX_"2 ^" | |
957 | "RTN","DGL OCK1",55,0 ) | |
958 | I $P(DGNO DE,"^",14) '="Y" S DG XX=DGXX_"4 ^" | |
959 | "RTN","DGL OCK1",56,0 ) | |
960 | I $P(DGNO DE,"^",13) '="Y" S DG XX=DGXX_"1 5^" | |
961 | "RTN","DGL OCK1",57,0 ) | |
962 | F I=12:1: 14 I $P(DG NODE,"^",I )="Y" S DG XX=DGXX_"5 ^"_$S(I'=1 4:"4^",1:" ") | |
963 | "RTN","DGL OCK1",58,0 ) | |
964 | I $P($G(^ DPT(DFN,0) ),"^",3)>2 200101 S D GXX=DGXX_" 16^17^" ; WWI or mex ican borde r only | |
965 | "RTN","DGL OCK1",59,0 ) | |
966 | S DIC("S" )=DIC("S") _",("""_DG XX_"""'[(U _$P(^(0),U ,9)_U))" | |
967 | "RTN","DGL OCK1",60,0 ) | |
968 | ECDS D ^DI C K DIC S DIC=DIE,X= +Y K:Y<0 X | |
969 | "RTN","DGL OCK1",61,0 ) | |
970 | ; | |
971 | "RTN","DGL OCK1",62,0 ) | |
972 | ;catastro phic disab ility can not be pri mary | |
973 | "RTN","DGL OCK1",63,0 ) | |
974 | I $G(X),$ $NATNAME^D GENELA(X)= "CATASTROP HICALLY DI SABLED" K X Q | |
975 | "RTN","DGL OCK1",64,0 ) | |
976 | ; | |
977 | "RTN","DGL OCK1",65,0 ) | |
978 | Q | |
979 | "RTN","DGO THD") | |
980 | 0^2^B71214 411 | |
981 | "RTN","DGO THD",1,0) | |
982 | DGOTHD ;SL C/SS,RM - OTHD (OTHE R THAN HON ORABLE DIS CHARGE) AP Is ;Feb 14 , 2019@09: 57 | |
983 | "RTN","DGO THD",2,0) | |
984 | ;;5.3;Reg istration; **977,952* *;Aug 13, 1993;Build 68 | |
985 | "RTN","DGO THD",3,0) | |
986 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
987 | "RTN","DGO THD",4,0) | |
988 | ; | |
989 | "RTN","DGO THD",5,0) | |
990 | ; Las t Edited: SHRPE/RM - Feb 14, 2 019@09:57 | |
991 | "RTN","DGO THD",6,0) | |
992 | ; | |
993 | "RTN","DGO THD",7,0) | |
994 | ;ICR F or | |
995 | "RTN","DGO THD",8,0) | |
996 | ;10043 E LIG^VADPT | |
997 | "RTN","DGO THD",9,0) | |
998 | Q | |
999 | "RTN","DGO THD",10,0) | |
1000 | ; | |
1001 | "RTN","DGO THD",11,0) | |
1002 | ;ask for the starti ng date fo r the OTH clock | |
1003 | "RTN","DGO THD",12,0) | |
1004 | ;called f rom [DG LO AD EDIT SC REEN 7] | |
1005 | "RTN","DGO THD",13,0) | |
1006 | STRDATE(DG DFN) ; | |
1007 | "RTN","DGO THD",14,0) | |
1008 | I '$G(DGD FN) Q | |
1009 | "RTN","DGO THD",15,0) | |
1010 | N DGSTRDT ,Y | |
1011 | "RTN","DGO THD",16,0) | |
1012 | I '$$ISOT HD(DGDFN) Q | |
1013 | "RTN","DGO THD",17,0) | |
1014 | I $$HASCL OCK^DGOTHD 2(DGDFN) Q | |
1015 | "RTN","DGO THD",18,0) | |
1016 | I $$GET1^ DIQ(2,DGDF N,.5501,"I ")'="OTH-9 0" Q | |
1017 | "RTN","DGO THD",19,0) | |
1018 | D STRDATE 1(DGDFN) ; B2S3 | |
1019 | "RTN","DGO THD",20,0) | |
1020 | D FRSTCLC K^DGOTHD1( DGDFN,DGST RDT) | |
1021 | "RTN","DGO THD",21,0) | |
1022 | Q | |
1023 | "RTN","DGO THD",22,0) | |
1024 | ; | |
1025 | "RTN","DGO THD",23,0) | |
1026 | STRDATE1(D GDFN) ; | |
1027 | "RTN","DGO THD",24,0) | |
1028 | N DGLOOP | |
1029 | "RTN","DGO THD",25,0) | |
1030 | S DGLOOP= 0 | |
1031 | "RTN","DGO THD",26,0) | |
1032 | F D Q:D GLOOP=1 | |
1033 | "RTN","DGO THD",27,0) | |
1034 | . S DGSTR DT=$$ASKDT ^DGOTHD2(" Enter star t date for 1ST 90-Da y OTH cloc k: ","T"," DA^::EX",1 ) | |
1035 | "RTN","DGO THD",28,0) | |
1036 | . I DGSTR DT'>0 S DG LOOP=1 Q | |
1037 | "RTN","DGO THD",29,0) | |
1038 | . I $$FMD IFF^XLFDT( DT,DGSTRDT )>90 W !!, " The dat e entered cannot be more than 90 days in the past. ",! Q | |
1039 | "RTN","DGO THD",30,0) | |
1040 | . I DGSTR DT>DT W !! ," A futu re date ca nnot be en tered.",! Q | |
1041 | "RTN","DGO THD",31,0) | |
1042 | . S DGLOO P=1 | |
1043 | "RTN","DGO THD",32,0) | |
1044 | Q | |
1045 | "RTN","DGO THD",33,0) | |
1046 | ; | |
1047 | "RTN","DGO THD",34,0) | |
1048 | ASKREQDT(M AXDT) ; pr ompt for d ate reques t submitte d | |
1049 | "RTN","DGO THD",35,0) | |
1050 | ; | |
1051 | "RTN","DGO THD",36,0) | |
1052 | ; MAXDT = latest al lowed date (required ) | |
1053 | "RTN","DGO THD",37,0) | |
1054 | ; | |
1055 | "RTN","DGO THD",38,0) | |
1056 | ; returns date in i nternal FM format or 0 on user exit | |
1057 | "RTN","DGO THD",39,0) | |
1058 | ; | |
1059 | "RTN","DGO THD",40,0) | |
1060 | N DIR,DIR UT,DIROUT, DTOUT,DUOU T,X,Y | |
1061 | "RTN","DGO THD",41,0) | |
1062 | S DIR(0)= "D^:"_MAXD T_":ESTX" | |
1063 | "RTN","DGO THD",42,0) | |
1064 | S DIR("A" )="Date re quest subm itted" | |
1065 | "RTN","DGO THD",43,0) | |
1066 | S DIR("?" ,1)="Enter the date authorizat ion reques t was subm itted." | |
1067 | "RTN","DGO THD",44,0) | |
1068 | S DIR("?" ,2)="This date must be in the past. Time entry is allowed." | |
1069 | "RTN","DGO THD",45,0) | |
1070 | S DIR("?" )="Latest allowed da te/time is "_$$FMTE^ XLFDT(MAXD T) | |
1071 | "RTN","DGO THD",46,0) | |
1072 | D ^DIR | |
1073 | "RTN","DGO THD",47,0) | |
1074 | I $D(DTOU T)!$D(DUOU T) Q 0 | |
1075 | "RTN","DGO THD",48,0) | |
1076 | Q +Y | |
1077 | "RTN","DGO THD",49,0) | |
1078 | ; | |
1079 | "RTN","DGO THD",50,0) | |
1080 | ASKAUAP() ; prompt f or authori zation app roved | |
1081 | "RTN","DGO THD",51,0) | |
1082 | ; | |
1083 | "RTN","DGO THD",52,0) | |
1084 | ; returns "Y" for a pproved, " N" for not approved, "P" for p ending, or "" on use r exit | |
1085 | "RTN","DGO THD",53,0) | |
1086 | ; | |
1087 | "RTN","DGO THD",54,0) | |
1088 | N DIR,DIR UT,DIROUT, DTOUT,DUOU T,X,Y | |
1089 | "RTN","DGO THD",55,0) | |
1090 | S DIR(0)= "SA^Y:Yes; N:No;P:Pen ding" | |
1091 | "RTN","DGO THD",56,0) | |
1092 | S DIR("A" )="Authori zation app roved (Y/N /P): " | |
1093 | "RTN","DGO THD",57,0) | |
1094 | D ^DIR | |
1095 | "RTN","DGO THD",58,0) | |
1096 | I $D(DTOU T)!$D(DUOU T) Q "" | |
1097 | "RTN","DGO THD",59,0) | |
1098 | Q Y | |
1099 | "RTN","DGO THD",60,0) | |
1100 | ; | |
1101 | "RTN","DGO THD",61,0) | |
1102 | ASKAUBY() ; prompt f or authori zed by | |
1103 | "RTN","DGO THD",62,0) | |
1104 | ; | |
1105 | "RTN","DGO THD",63,0) | |
1106 | ; returns name of t he user se lected or "" on user exit | |
1107 | "RTN","DGO THD",64,0) | |
1108 | ; | |
1109 | "RTN","DGO THD",65,0) | |
1110 | N DIR,DIR UT,DIROUT, DTOUT,DUOU T,X,Y | |
1111 | "RTN","DGO THD",66,0) | |
1112 | S DIR(0)= "FA^1:60" | |
1113 | "RTN","DGO THD",67,0) | |
1114 | S DIR("A" )="Authori zed by: " | |
1115 | "RTN","DGO THD",68,0) | |
1116 | S DIR("?" )="Free te xt name, 1 to 60 cha racters in length." | |
1117 | "RTN","DGO THD",69,0) | |
1118 | D ^DIR | |
1119 | "RTN","DGO THD",70,0) | |
1120 | I $D(DTOU T)!$D(DUOU T) Q "" | |
1121 | "RTN","DGO THD",71,0) | |
1122 | Q Y | |
1123 | "RTN","DGO THD",72,0) | |
1124 | ; | |
1125 | "RTN","DGO THD",73,0) | |
1126 | ASKAURDT(M AXDT) ; pr ompt for a uthorizati on receive d date | |
1127 | "RTN","DGO THD",74,0) | |
1128 | ; | |
1129 | "RTN","DGO THD",75,0) | |
1130 | ; MAXDT = latest al lowed date (required ) | |
1131 | "RTN","DGO THD",76,0) | |
1132 | ; | |
1133 | "RTN","DGO THD",77,0) | |
1134 | ; returns date in i nternal FM format or 0 on user exit | |
1135 | "RTN","DGO THD",78,0) | |
1136 | ; | |
1137 | "RTN","DGO THD",79,0) | |
1138 | N DIR,DIR UT,DIROUT, DTOUT,DUOU T,X,Y | |
1139 | "RTN","DGO THD",80,0) | |
1140 | S DIR(0)= "D^:"_MAXD T_":ESTX" | |
1141 | "RTN","DGO THD",81,0) | |
1142 | S DIR("A" )="Authori zation rec eived date " | |
1143 | "RTN","DGO THD",82,0) | |
1144 | S DIR("?" ,1)="Enter the date authorizat ion was re ceived." | |
1145 | "RTN","DGO THD",83,0) | |
1146 | S DIR("?" ,2)="This date must be in the past. Time entry is allowed." | |
1147 | "RTN","DGO THD",84,0) | |
1148 | S DIR("?" )="Latest allowed da te/time is "_$$FMTE^ XLFDT(MAXD T) | |
1149 | "RTN","DGO THD",85,0) | |
1150 | D ^DIR | |
1151 | "RTN","DGO THD",86,0) | |
1152 | I $D(DTOU T)!$D(DUOU T) Q 0 | |
1153 | "RTN","DGO THD",87,0) | |
1154 | Q +Y | |
1155 | "RTN","DGO THD",88,0) | |
1156 | ; | |
1157 | "RTN","DGO THD",89,0) | |
1158 | ASKSTDT(MI NDT,MAXDT) ; prompt for period start dat e | |
1159 | "RTN","DGO THD",90,0) | |
1160 | ; | |
1161 | "RTN","DGO THD",91,0) | |
1162 | ; MINDT = earliest allowed da te (requir ed) | |
1163 | "RTN","DGO THD",92,0) | |
1164 | ; MAXDT = latest al lowed date (required ) | |
1165 | "RTN","DGO THD",93,0) | |
1166 | ; | |
1167 | "RTN","DGO THD",94,0) | |
1168 | ; returns date in i nternal FM format or 0 on user exit | |
1169 | "RTN","DGO THD",95,0) | |
1170 | ; | |
1171 | "RTN","DGO THD",96,0) | |
1172 | N DIR,DIR UT,DIROUT, DTOUT,DUOU T,X,Y | |
1173 | "RTN","DGO THD",97,0) | |
1174 | N MAXDTE, MINDTE | |
1175 | "RTN","DGO THD",98,0) | |
1176 | ; get min and max d ates in ex ternal for mat | |
1177 | "RTN","DGO THD",99,0) | |
1178 | S MINDTE= $$FMTE^XLF DT(MINDT), MAXDTE=$$F MTE^XLFDT( MAXDT) | |
1179 | "RTN","DGO THD",100,0 ) | |
1180 | S DIR(0)= "D^"_MINDT _":"_MAXDT _":ESTX" | |
1181 | "RTN","DGO THD",101,0 ) | |
1182 | S DIR("A" )="Period start date ("_MINDTE _" - "_MAX DTE_")" | |
1183 | "RTN","DGO THD",102,0 ) | |
1184 | S DIR("B" )=MINDTE | |
1185 | "RTN","DGO THD",103,0 ) | |
1186 | S DIR("?" ,1)="Enter the start date of t his 90 day period. T ime entry is allowed ." | |
1187 | "RTN","DGO THD",104,0 ) | |
1188 | S DIR("?" ,2)="Earli est allowe d date/tim e is "_MIN DTE | |
1189 | "RTN","DGO THD",105,0 ) | |
1190 | S DIR("?" )="Latest allowed da te/time is "_MAXDTE | |
1191 | "RTN","DGO THD",106,0 ) | |
1192 | D ^DIR | |
1193 | "RTN","DGO THD",107,0 ) | |
1194 | I $D(DTOU T)!$D(DUOU T) Q 0 | |
1195 | "RTN","DGO THD",108,0 ) | |
1196 | Q +Y | |
1197 | "RTN","DGO THD",109,0 ) | |
1198 | ; | |
1199 | "RTN","DGO THD",110,0 ) | |
1200 | ASKAUCMT() ; prompt for author ization co mment | |
1201 | "RTN","DGO THD",111,0 ) | |
1202 | ; | |
1203 | "RTN","DGO THD",112,0 ) | |
1204 | ; returns entered c omment or "" on user exit | |
1205 | "RTN","DGO THD",113,0 ) | |
1206 | ; | |
1207 | "RTN","DGO THD",114,0 ) | |
1208 | N DIR,DIR UT,DIROUT, DTOUT,DUOU T,X,Y | |
1209 | "RTN","DGO THD",115,0 ) | |
1210 | S DIR(0)= "FA^1:60" | |
1211 | "RTN","DGO THD",116,0 ) | |
1212 | S DIR("A" )="Authori zation com ment: " | |
1213 | "RTN","DGO THD",117,0 ) | |
1214 | S DIR("?" )="Free te xt comment , 1 to 60 characters in length ." | |
1215 | "RTN","DGO THD",118,0 ) | |
1216 | D ^DIR | |
1217 | "RTN","DGO THD",119,0 ) | |
1218 | I $D(DTOU T)!$D(DUOU T) Q "" | |
1219 | "RTN","DGO THD",120,0 ) | |
1220 | Q Y | |
1221 | "RTN","DGO THD",121,0 ) | |
1222 | ; | |
1223 | "RTN","DGO THD",122,0 ) | |
1224 | DISPERR(DG ERR) ; dis play error message | |
1225 | "RTN","DGO THD",123,0 ) | |
1226 | ; | |
1227 | "RTN","DGO THD",124,0 ) | |
1228 | ; DGERR - message t o display | |
1229 | "RTN","DGO THD",125,0 ) | |
1230 | ; | |
1231 | "RTN","DGO THD",126,0 ) | |
1232 | W !!,"Err or while f iling OTH data:",!,D GERR | |
1233 | "RTN","DGO THD",127,0 ) | |
1234 | Q | |
1235 | "RTN","DGO THD",128,0 ) | |
1236 | ; | |
1237 | "RTN","DGO THD",129,0 ) | |
1238 | AUTH90DS ; authorize additiona l 90 days period | |
1239 | "RTN","DGO THD",130,0 ) | |
1240 | ; entry p oint for " Start Addi tional 90- Days Perio d" option | |
1241 | "RTN","DGO THD",131,0 ) | |
1242 | ; | |
1243 | "RTN","DGO THD",132,0 ) | |
1244 | ; data en tered is s aved in OT HDATA stri ng as foll ows: | |
1245 | "RTN","DGO THD",133,0 ) | |
1246 | ; p1 = 3 65 days pe riod # to be filed | |
1247 | "RTN","DGO THD",134,0 ) | |
1248 | ; p2 = 9 0 days per iod # to b e filed | |
1249 | "RTN","DGO THD",135,0 ) | |
1250 | ; p3 = d ate reques t submitte d | |
1251 | "RTN","DGO THD",136,0 ) | |
1252 | ; p4 = a uthorized by (name) | |
1253 | "RTN","DGO THD",137,0 ) | |
1254 | ; p5 = a uthorizati on receive d date | |
1255 | "RTN","DGO THD",138,0 ) | |
1256 | ; p6 = s tart date of this 90 days peri od | |
1257 | "RTN","DGO THD",139,0 ) | |
1258 | ; p7 = a uthorizati on comment | |
1259 | "RTN","DGO THD",140,0 ) | |
1260 | ; p8 = e ntered by (name) | |
1261 | "RTN","DGO THD",141,0 ) | |
1262 | ; p9 = f acility (f ile 4 ien) | |
1263 | "RTN","DGO THD",142,0 ) | |
1264 | ; | |
1265 | "RTN","DGO THD",143,0 ) | |
1266 | N DAYS,DG DFN,DGFRES ,DGIEN33,D TSTR,EDT,M AXDT,MINDT ,NUM365,NU M90,OTHDAT A,SDT,STOP ,Z | |
1267 | "RTN","DGO THD",144,0 ) | |
1268 | ;keep ask ing for pa tient sele ction unti l empty in put | |
1269 | "RTN","DGO THD",145,0 ) | |
1270 | S STOP=0 F W ! S D GIEN33=$$S ELPAT^DGOT HD2(.Z),DG DFN=+$G(Z( 0)) Q:DGIE N33'>0!(DG DFN'>0) D | |
1271 | "RTN","DGO THD",146,0 ) | |
1272 | .W @IOF D HEADER(DG DFN) ; dis play heade r | |
1273 | "RTN","DGO THD",147,0 ) | |
1274 | .K OTHDAT A,Z S Z=$$ LASTPRD^DG OTHUT1(DGI EN33),NUM3 65=$P(Z,U) ,NUM90=$P( Z,U,3) ; g et data fo r the last clock per iod | |
1275 | "RTN","DGO THD",148,0 ) | |
1276 | .W !!,"36 5 Days Per iod: ",$S( NUM365>0:N UM365,1:"N one") | |
1277 | "RTN","DGO THD",149,0 ) | |
1278 | .W !,"90 Days Peri od: ",$S(N UM90>0:NUM 90,1:"None ") | |
1279 | "RTN","DGO THD",150,0 ) | |
1280 | .S DTSTR= $$GET365DT ^DGOTHUT1( DGIEN33,$P (Z,U,2)) ; get dates for the l ast 365 da y period | |
1281 | "RTN","DGO THD",151,0 ) | |
1282 | .; find o ut which 3 65 day per iod we're going to u se | |
1283 | "RTN","DGO THD",152,0 ) | |
1284 | .S OTHDAT A=$S($$FMD IFF^XLFDT( DT,$P(DTST R,U,2))>0: NUM365+1,1 :NUM365) | |
1285 | "RTN","DGO THD",153,0 ) | |
1286 | .; find o ut which 9 0 day peri od we're g oing to us e | |
1287 | "RTN","DGO THD",154,0 ) | |
1288 | .S $P(OTH DATA,U,2)= $S(OTHDATA =NUM365:NU M90+1,1:1) | |
1289 | "RTN","DGO THD",155,0 ) | |
1290 | .S DTSTR= $$GET90DT^ DGOTHUT1(D GIEN33,$P( Z,U,2),$P( Z,U,4)) ; get dates for the la st 90 day period | |
1291 | "RTN","DGO THD",156,0 ) | |
1292 | .S SDT=$P (DTSTR,U), EDT=$P(DTS TR,U,2),DA YS=$P(DTST R,U,3) | |
1293 | "RTN","DGO THD",157,0 ) | |
1294 | .I SDT>0 W !!,"The most recen t period s tarted on ",$$FMTE^X LFDT(SDT), " and end" ,$S(EDT<DT :"ed on "_ $$FMTE^XLF DT(EDT),ED T>DT:"s on "_$$FMTE^ XLFDT(EDT) ,1:"s toda y") | |
1295 | "RTN","DGO THD",158,0 ) | |
1296 | .W !!,"Da ys Remaini ng: ",$S(S DT>0:DAYS, 1:"N/A") | |
1297 | "RTN","DGO THD",159,0 ) | |
1298 | .; displa y confirma tion promp t if curre nt 90 day period is greater th an 2 (last 90 day pe riod is gr eater than 1) | |
1299 | "RTN","DGO THD",160,0 ) | |
1300 | .I NUM90> 1 D Q:STO P | |
1301 | "RTN","DGO THD",161,0 ) | |
1302 | ..W !!,"P atient has received 180 days o r more of care" | |
1303 | "RTN","DGO THD",162,0 ) | |
1304 | ..I $$YES NO^DGOTHD2 ("Do you w ish to con tinue (Y/N )",,1)'=1 S STOP=1 | |
1305 | "RTN","DGO THD",163,0 ) | |
1306 | ..Q | |
1307 | "RTN","DGO THD",164,0 ) | |
1308 | .; put cu rrent user and facil ity into O THDATA | |
1309 | "RTN","DGO THD",165,0 ) | |
1310 | .S $P(OTH DATA,U,8)= $$UP^XLFST R($$NAME^X USER(DUZ," F")) | |
1311 | "RTN","DGO THD",166,0 ) | |
1312 | .S $P(OTH DATA,U,9)= $P($$SITE^ VASITE(),U ) | |
1313 | "RTN","DGO THD",167,0 ) | |
1314 | .; prompt for Date request su bmitted | |
1315 | "RTN","DGO THD",168,0 ) | |
1316 | .S Z=$$AS KREQDT(DT) I Z'>0 Q | |
1317 | "RTN","DGO THD",169,0 ) | |
1318 | .S $P(OTH DATA,U,3)= Z | |
1319 | "RTN","DGO THD",170,0 ) | |
1320 | .; prompt for Autho rization a pproval | |
1321 | "RTN","DGO THD",171,0 ) | |
1322 | .S Z=$$AS KAUAP() I Z="" Q | |
1323 | "RTN","DGO THD",172,0 ) | |
1324 | .; if pen ding, file data and quit | |
1325 | "RTN","DGO THD",173,0 ) | |
1326 | .I Z="P" S DGFRES=$ $FILEPRD^D GOTHUT1(DG DFN,OTHDAT A) D:'+DGF RES DISPER R($P(DGFRE S,U,2)) Q | |
1327 | "RTN","DGO THD",174,0 ) | |
1328 | .; if no, ask for a uthorizati on comment , file dat a and quit | |
1329 | "RTN","DGO THD",175,0 ) | |
1330 | .I Z="N" D Q | |
1331 | "RTN","DGO THD",176,0 ) | |
1332 | ..S Z=$$A SKAUCMT() I Z="" Q | |
1333 | "RTN","DGO THD",177,0 ) | |
1334 | ..S $P(OT HDATA,U,7) =Z | |
1335 | "RTN","DGO THD",178,0 ) | |
1336 | ..S DGFRE S=$$FILEPR D^DGOTHUT1 (DGDFN,OTH DATA) | |
1337 | "RTN","DGO THD",179,0 ) | |
1338 | ..I '+DGF RES D DISP ERR($P(DGF RES,U,2)) | |
1339 | "RTN","DGO THD",180,0 ) | |
1340 | ..Q | |
1341 | "RTN","DGO THD",181,0 ) | |
1342 | .; prompt for autho rized by | |
1343 | "RTN","DGO THD",182,0 ) | |
1344 | .S Z=$$AS KAUBY() I Z="" Q | |
1345 | "RTN","DGO THD",183,0 ) | |
1346 | .S $P(OTH DATA,U,4)= Z | |
1347 | "RTN","DGO THD",184,0 ) | |
1348 | .; prompt for autho rization r eceived da te | |
1349 | "RTN","DGO THD",185,0 ) | |
1350 | .S Z=$$AS KAURDT(DT) I Z'>0 Q | |
1351 | "RTN","DGO THD",186,0 ) | |
1352 | .S $P(OTH DATA,U,5)= Z | |
1353 | "RTN","DGO THD",187,0 ) | |
1354 | .; calcul ate date r ange for t he next pr ompt | |
1355 | "RTN","DGO THD",188,0 ) | |
1356 | .; earlie st date al lowed is t he end dat e of the l ast 90 day s period + 1 | |
1357 | "RTN","DGO THD",189,0 ) | |
1358 | .; latest date is t he start d ate of the last 90 d ays period + 365 | |
1359 | "RTN","DGO THD",190,0 ) | |
1360 | .S MINDT= $S(EDT>0:$ $FMADD^XLF DT($P(EDT, "."),1),1: DT) | |
1361 | "RTN","DGO THD",191,0 ) | |
1362 | .S MAXDT= $$FMADD^XL FDT($S(SDT >0:$P(SDT, "."),1:DT) ,365) | |
1363 | "RTN","DGO THD",192,0 ) | |
1364 | .; prompt for perio d start da te | |
1365 | "RTN","DGO THD",193,0 ) | |
1366 | .S Z=$$AS KSTDT(MIND T,MAXDT) I Z'>0 Q | |
1367 | "RTN","DGO THD",194,0 ) | |
1368 | .S $P(OTH DATA,U,6)= Z | |
1369 | "RTN","DGO THD",195,0 ) | |
1370 | .; file d ata | |
1371 | "RTN","DGO THD",196,0 ) | |
1372 | .S DGFRES =$$FILEPRD ^DGOTHUT1( DGDFN,OTHD ATA) | |
1373 | "RTN","DGO THD",197,0 ) | |
1374 | .I '+DGFR ES D DISPE RR($P(DGFR ES,U,2)) Q | |
1375 | "RTN","DGO THD",198,0 ) | |
1376 | .W !!,"Th e patient has been a uthorized for an add itional 90 Days peri od" | |
1377 | "RTN","DGO THD",199,0 ) | |
1378 | .W !,"wit h the star ting date of ",$$FMT E^XLFDT($P (OTHDATA,U ,6)) | |
1379 | "RTN","DGO THD",200,0 ) | |
1380 | .Q | |
1381 | "RTN","DGO THD",201,0 ) | |
1382 | Q | |
1383 | "RTN","DGO THD",202,0 ) | |
1384 | ; | |
1385 | "RTN","DGO THD",203,0 ) | |
1386 | ;calculat e the defa ult 2nd 90 -Day date range | |
1387 | "RTN","DGO THD",204,0 ) | |
1388 | GETSTDT(DG DAT,DGRES) ; | |
1389 | "RTN","DGO THD",205,0 ) | |
1390 | ; Input: | |
1391 | "RTN","DGO THD",206,0 ) | |
1392 | ; DGAD T - The en d date of the 1st pe riod + 1 d ay | |
1393 | "RTN","DGO THD",207,0 ) | |
1394 | ; | |
1395 | "RTN","DGO THD",208,0 ) | |
1396 | ; Output : | |
1397 | "RTN","DGO THD",209,0 ) | |
1398 | ; Funct ion Value - Second 9 0-Day star t date in FM format on success , 0 on fai lure | |
1399 | "RTN","DGO THD",210,0 ) | |
1400 | ; | |
1401 | "RTN","DGO THD",211,0 ) | |
1402 | N DGSTDT, DGDIFF,DGS TRTDT,DGEN DDT ;func tion value | |
1403 | "RTN","DGO THD",212,0 ) | |
1404 | S DGSTDT= 0 | |
1405 | "RTN","DGO THD",213,0 ) | |
1406 | I +$G(DGD AT)>0 D | |
1407 | "RTN","DGO THD",214,0 ) | |
1408 | . S DGDAT =+$$FMTH^X LFDT(DGDAT ) | |
1409 | "RTN","DGO THD",215,0 ) | |
1410 | . S DGSTR TDT=$P(DGR ES,U,3) | |
1411 | "RTN","DGO THD",216,0 ) | |
1412 | . S DGEND DT=$P(DGRE S,U,4) | |
1413 | "RTN","DGO THD",217,0 ) | |
1414 | . S DGDIF F=363-($$F MDIFF^XLFD T(DGENDDT, DGSTRTDT,1 )) | |
1415 | "RTN","DGO THD",218,0 ) | |
1416 | . S DGSTD T=+$$HTFM^ XLFDT(DGDA T+DGDIFF) | |
1417 | "RTN","DGO THD",219,0 ) | |
1418 | Q DGSTDT | |
1419 | "RTN","DGO THD",220,0 ) | |
1420 | ; | |
1421 | "RTN","DGO THD",221,0 ) | |
1422 | ; | |
1423 | "RTN","DGO THD",222,0 ) | |
1424 | ;Function ality: | |
1425 | "RTN","DGO THD",223,0 ) | |
1426 | ; Impleme nts ICR# 6 873 | |
1427 | "RTN","DGO THD",224,0 ) | |
1428 | ; This fu nction is called fro m GET^OROT HCL to sup port | |
1429 | "RTN","DGO THD",225,0 ) | |
1430 | ; the "OR OTHD CLOC K GET" RPC | |
1431 | "RTN","DGO THD",226,0 ) | |
1432 | ;It check s if the p atient is eligible f or OTHD | |
1433 | "RTN","DGO THD",227,0 ) | |
1434 | ;and retu rns the OT HD status on the giv en date | |
1435 | "RTN","DGO THD",228,0 ) | |
1436 | ; | |
1437 | "RTN","DGO THD",229,0 ) | |
1438 | ; | |
1439 | "RTN","DGO THD",230,0 ) | |
1440 | ;Paramete rs: | |
1441 | "RTN","DGO THD",231,0 ) | |
1442 | ; DGDFN - the patie nt's IEN i n the file (#2) | |
1443 | "RTN","DGO THD",232,0 ) | |
1444 | ; DGDATE - the date to calcul ate status | |
1445 | "RTN","DGO THD",233,0 ) | |
1446 | ; default = DT (toda y) | |
1447 | "RTN","DGO THD",234,0 ) | |
1448 | ; | |
1449 | "RTN","DGO THD",235,0 ) | |
1450 | ;Return v alues: | |
1451 | "RTN","DGO THD",236,0 ) | |
1452 | ; | |
1453 | "RTN","DGO THD",237,0 ) | |
1454 | ;return 0 | |
1455 | "RTN","DGO THD",238,0 ) | |
1456 | ; if pat ient is no t eligible for OTHD in registr ation | |
1457 | "RTN","DGO THD",239,0 ) | |
1458 | ; if pat ient does not have a n entry in the OTHD clock file (#33) | |
1459 | "RTN","DGO THD",240,0 ) | |
1460 | ; | |
1461 | "RTN","DGO THD",241,0 ) | |
1462 | ; | |
1463 | "RTN","DGO THD",242,0 ) | |
1464 | OTHDCLCK(D GDFN,DGDAT E) ; | |
1465 | "RTN","DGO THD",243,0 ) | |
1466 | ;check th e version of CPRS is V31b | |
1467 | "RTN","DGO THD",244,0 ) | |
1468 | ; | |
1469 | "RTN","DGO THD",245,0 ) | |
1470 | ;If it is CPRS 31b then | |
1471 | "RTN","DGO THD",246,0 ) | |
1472 | Q $$OTHCL 31B^DGOTHC LK(DGDFN,D GDATE) | |
1473 | "RTN","DGO THD",247,0 ) | |
1474 | ;If it is CPRS EP < TBD> | |
1475 | "RTN","DGO THD",248,0 ) | |
1476 | ;Q OTHCLE P^DGOTHCLK (DGDFN,DGD ATE) | |
1477 | "RTN","DGO THD",249,0 ) | |
1478 | ; | |
1479 | "RTN","DGO THD",250,0 ) | |
1480 | ; | |
1481 | "RTN","DGO THD",251,0 ) | |
1482 | ;Function ality: | |
1483 | "RTN","DGO THD",252,0 ) | |
1484 | ; checks OTHD eligi bility | |
1485 | "RTN","DGO THD",253,0 ) | |
1486 | ; | |
1487 | "RTN","DGO THD",254,0 ) | |
1488 | ;Paramete rs: | |
1489 | "RTN","DGO THD",255,0 ) | |
1490 | ; DFN - p atient's I EN in the file (#2) | |
1491 | "RTN","DGO THD",256,0 ) | |
1492 | ; | |
1493 | "RTN","DGO THD",257,0 ) | |
1494 | ;Return v alues: | |
1495 | "RTN","DGO THD",258,0 ) | |
1496 | ; 0 - not eligible for OTHD | |
1497 | "RTN","DGO THD",259,0 ) | |
1498 | ; 1 - eli gible for OTHD | |
1499 | "RTN","DGO THD",260,0 ) | |
1500 | ; | |
1501 | "RTN","DGO THD",261,0 ) | |
1502 | ISOTHD(DFN ) ; | |
1503 | "RTN","DGO THD",262,0 ) | |
1504 | N VAEL,DG IEN,DGOTHD | |
1505 | "RTN","DGO THD",263,0 ) | |
1506 | D ELIG^VA DPT | |
1507 | "RTN","DGO THD",264,0 ) | |
1508 | S DGIEN=0 ,DGOTHD=0 | |
1509 | "RTN","DGO THD",265,0 ) | |
1510 | I +VAEL(1 )>0,$P($G( ^DIC(8,+VA EL(1),0)), "^",9)=23 S DGOTHD=1 | |
1511 | "RTN","DGO THD",266,0 ) | |
1512 | Q DGOTHD | |
1513 | "RTN","DGO THD",267,0 ) | |
1514 | ; | |
1515 | "RTN","DGO THD",268,0 ) | |
1516 | HEADER(DFN ) ; | |
1517 | "RTN","DGO THD",269,0 ) | |
1518 | N DDASH,D GNAME,DGDO B,VADM | |
1519 | "RTN","DGO THD",270,0 ) | |
1520 | D DEM^VAD PT ;get pa tient demo graphics | |
1521 | "RTN","DGO THD",271,0 ) | |
1522 | S DGNAME= VADM(1),DG DOB=$P(VAD M(3),U,2) | |
1523 | "RTN","DGO THD",272,0 ) | |
1524 | W ?24,"ST ART ADDITI ONAL 90-DA Y PERIOD" | |
1525 | "RTN","DGO THD",273,0 ) | |
1526 | W !,"Pati ent Name: ",DGNAME,? 60,"DOB: " ,DGDOB | |
1527 | "RTN","DGO THD",274,0 ) | |
1528 | S $P(DDAS H,"=",81)= "" W !,DDA SH,! ;writ e dash lin es | |
1529 | "RTN","DGO THD",275,0 ) | |
1530 | Q | |
1531 | "RTN","DGO THD",276,0 ) | |
1532 | ; | |
1533 | "RTN","DGO THD",277,0 ) | |
1534 | ;retrieve the defau lt EXPANDE D MH CARE TYPE | |
1535 | "RTN","DGO THD",278,0 ) | |
1536 | GETEXPMH(D FN) ; | |
1537 | "RTN","DGO THD",279,0 ) | |
1538 | ; Input: | |
1539 | "RTN","DGO THD",280,0 ) | |
1540 | ; DFN - Patient IEN | |
1541 | "RTN","DGO THD",281,0 ) | |
1542 | ; | |
1543 | "RTN","DGO THD",282,0 ) | |
1544 | ; Output : | |
1545 | "RTN","DGO THD",283,0 ) | |
1546 | ; EXPA NDED MH CA RE TYPE (F ile #2,Fie ld #.5501) | |
1547 | "RTN","DGO THD",284,0 ) | |
1548 | ; | |
1549 | "RTN","DGO THD",285,0 ) | |
1550 | N VAEL | |
1551 | "RTN","DGO THD",286,0 ) | |
1552 | D ELIG^VA DPT | |
1553 | "RTN","DGO THD",287,0 ) | |
1554 | Q $P($G(V AEL(10)),U ,2) | |
1555 | "RTN","DGO THD",288,0 ) | |
1556 | ; | |
1557 | "RTN","DGO THD",289,0 ) | |
1558 | ;this is called by RPC "GET E XPANDED MH CARE TYPE " | |
1559 | "RTN","DGO THD",290,0 ) | |
1560 | GETEXPR(RE T,DFN) ; | |
1561 | "RTN","DGO THD",291,0 ) | |
1562 | ; Input: | |
1563 | "RTN","DGO THD",292,0 ) | |
1564 | ; DFN - Patient IEN | |
1565 | "RTN","DGO THD",293,0 ) | |
1566 | ; | |
1567 | "RTN","DGO THD",294,0 ) | |
1568 | ; Output : | |
1569 | "RTN","DGO THD",295,0 ) | |
1570 | ; RET - EXPANDED MH CARE T YPE | |
1571 | "RTN","DGO THD",296,0 ) | |
1572 | ; | |
1573 | "RTN","DGO THD",297,0 ) | |
1574 | S RET=$$G ETEXPMH(DF N) | |
1575 | "RTN","DGO THD",298,0 ) | |
1576 | Q | |
1577 | "RTN","DGO THD",299,0 ) | |
1578 | ; | |
1579 | "RTN","DGO THD1") | |
1580 | 0^4^B61648 572 | |
1581 | "RTN","DGO THD1",1,0) | |
1582 | DGOTHD1 ;S LC/SS,MKN, RM - OTHD (OTHER THA N HONORABL E DISCHARG E) APIs ;1 2/27/17 | |
1583 | "RTN","DGO THD1",2,0) | |
1584 | ;;5.3;Reg istration; **977,952* *;Aug 13, 1993;Build 68 | |
1585 | "RTN","DGO THD1",3,0) | |
1586 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
1587 | "RTN","DGO THD1",4,0) | |
1588 | ; | |
1589 | "RTN","DGO THD1",5,0) | |
1590 | Q | |
1591 | "RTN","DGO THD1",6,0) | |
1592 | ; | |
1593 | "RTN","DGO THD1",7,0) | |
1594 | ;ICR# T YPE DESCRIPTIO N | |
1595 | "RTN","DGO THD1",8,0) | |
1596 | ;----- - --- ---------- ---------- - | |
1597 | "RTN","DGO THD1",9,0) | |
1598 | ;10103 S up ^XLFDT: $$ FMADD,$$FM TE,$$FMDIF F,$$HTFM | |
1599 | "RTN","DGO THD1",10,0 ) | |
1600 | ;10061 S up ^VADPT: EL IG | |
1601 | "RTN","DGO THD1",11,0 ) | |
1602 | ;10142 S up ^DDIOL: EN | |
1603 | "RTN","DGO THD1",12,0 ) | |
1604 | ; 2053 S up ^DIE : FI LE | |
1605 | "RTN","DGO THD1",13,0 ) | |
1606 | ; 2056 S up ^DIQ : GE T1 | |
1607 | "RTN","DGO THD1",14,0 ) | |
1608 | ; | |
1609 | "RTN","DGO THD1",15,0 ) | |
1610 | ;set 90 d ays clock with autho rization | |
1611 | "RTN","DGO THD1",16,0 ) | |
1612 | SETAUTH(DG DFN,DGSTRD T,DG365N,D GCL90N,DGA UDUZ,DGAUD T,DGAUTHRZ DBY) ; | |
1613 | "RTN","DGO THD1",17,0 ) | |
1614 | N DGIEN33 ,DGIEN365 | |
1615 | "RTN","DGO THD1",18,0 ) | |
1616 | ;does the patient h ave the cl ock? | |
1617 | "RTN","DGO THD1",19,0 ) | |
1618 | S DGIEN33 =$$HASCLOC K^DGOTHD2( DGDFN) I D GIEN33'>0 Q -1 ; No clock rec ord | |
1619 | "RTN","DGO THD1",20,0 ) | |
1620 | S DGIEN36 5=$$CHCK36 5^DGOTHD2( DGIEN33,DG 365N) | |
1621 | "RTN","DGO THD1",21,0 ) | |
1622 | I DGIEN36 5<0 Q -1 ; OTH cloc k entry in the file #33 doesn' t exist | |
1623 | "RTN","DGO THD1",22,0 ) | |
1624 | I DGIEN36 5=0 Q -2 ; this 365 clock doe s not exis t | |
1625 | "RTN","DGO THD1",23,0 ) | |
1626 | ;create 9 0 days clo ck | |
1627 | "RTN","DGO THD1",24,0 ) | |
1628 | S DGIEN90 =$$CR90CLK ^DGOTHD2(+ DGIEN33,+D GIEN365,DG CL90N,DGST RDT,DGAUDU Z,DGAUDT,D GAUTHRZDBY ) | |
1629 | "RTN","DGO THD1",25,0 ) | |
1630 | ;if error then retu rn error | |
1631 | "RTN","DGO THD1",26,0 ) | |
1632 | I DGIEN90 <0 Q DGIEN 90 | |
1633 | "RTN","DGO THD1",27,0 ) | |
1634 | Q 1 | |
1635 | "RTN","DGO THD1",28,0 ) | |
1636 | ; | |
1637 | "RTN","DGO THD1",29,0 ) | |
1638 | ; | |
1639 | "RTN","DGO THD1",30,0 ) | |
1640 | ;Set the very first clock | |
1641 | "RTN","DGO THD1",31,0 ) | |
1642 | ;Paramete rs: | |
1643 | "RTN","DGO THD1",32,0 ) | |
1644 | ; DGDFN - patient I EN | |
1645 | "RTN","DGO THD1",33,0 ) | |
1646 | ; DGSTRTD T - starti ng date | |
1647 | "RTN","DGO THD1",34,0 ) | |
1648 | ;Return v alues: | |
1649 | "RTN","DGO THD1",35,0 ) | |
1650 | ; <0 if e rror | |
1651 | "RTN","DGO THD1",36,0 ) | |
1652 | ; 1 if ev erything w as created properly | |
1653 | "RTN","DGO THD1",37,0 ) | |
1654 | FRSTCLCK(D GDFN,DGSTR DT) ; | |
1655 | "RTN","DGO THD1",38,0 ) | |
1656 | N DGIEN33 ,DGIEN365, DGIEN90 | |
1657 | "RTN","DGO THD1",39,0 ) | |
1658 | ;does the patient h ave the cl ock? | |
1659 | "RTN","DGO THD1",40,0 ) | |
1660 | S DGIEN33 =$$HASCLOC K^DGOTHD2( DGDFN) I D GIEN33>0 Q -2 ; alr eady has c lock | |
1661 | "RTN","DGO THD1",41,0 ) | |
1662 | ;if not t hen create it | |
1663 | "RTN","DGO THD1",42,0 ) | |
1664 | I DGIEN33 =0 S DGIEN 33=$$CROTH CLK^DGOTHD 2(DGDFN) | |
1665 | "RTN","DGO THD1",43,0 ) | |
1666 | ;if error then retu rn error | |
1667 | "RTN","DGO THD1",44,0 ) | |
1668 | I DGIEN33 <0 Q DGIEN 33 | |
1669 | "RTN","DGO THD1",45,0 ) | |
1670 | ;create t he very fi rst 365 da ys clock | |
1671 | "RTN","DGO THD1",46,0 ) | |
1672 | S DGIEN36 5=$$CR365C LK^DGOTHD2 (+DGIEN33, 1,DGSTRDT) | |
1673 | "RTN","DGO THD1",47,0 ) | |
1674 | ;if error then retu rn error | |
1675 | "RTN","DGO THD1",48,0 ) | |
1676 | I DGIEN36 5<0 Q DGIE N365 | |
1677 | "RTN","DGO THD1",49,0 ) | |
1678 | ;create t he very fi rst 90 day s clock | |
1679 | "RTN","DGO THD1",50,0 ) | |
1680 | S DGIEN90 =$$CR90CLK ^DGOTHD2(+ DGIEN33,+D GIEN365,1, DGSTRDT) | |
1681 | "RTN","DGO THD1",51,0 ) | |
1682 | ;if error then retu rn error | |
1683 | "RTN","DGO THD1",52,0 ) | |
1684 | I DGIEN90 <0 Q DGIEN 90 | |
1685 | "RTN","DGO THD1",53,0 ) | |
1686 | Q 1 | |
1687 | "RTN","DGO THD1",54,0 ) | |
1688 | ; | |
1689 | "RTN","DGO THD1",55,0 ) | |
1690 | ;Build 6 Sprint 3 | |
1691 | "RTN","DGO THD1",56,0 ) | |
1692 | ;DG*5.3*9 52 | |
1693 | "RTN","DGO THD1",57,0 ) | |
1694 | ;prompt f or EXPANDE D MH CARE TYPE | |
1695 | "RTN","DGO THD1",58,0 ) | |
1696 | ;called f rom input template [ DG LOAD ED IT SCREEN 7] | |
1697 | "RTN","DGO THD1",59,0 ) | |
1698 | XPANDED(DG DFN) ; | |
1699 | "RTN","DGO THD1",60,0 ) | |
1700 | ; | |
1701 | "RTN","DGO THD1",61,0 ) | |
1702 | ; Input : | |
1703 | "RTN","DGO THD1",62,0 ) | |
1704 | ; DGDFN - Patient IEN | |
1705 | "RTN","DGO THD1",63,0 ) | |
1706 | ; Output: | |
1707 | "RTN","DGO THD1",64,0 ) | |
1708 | ; 1. Dis play warni ng message related t o the pati ent's | |
1709 | "RTN","DGO THD1",65,0 ) | |
1710 | ; pri mary eligi bility cod e EXPANDED MH CARE N ON-VETERAN S | |
1711 | "RTN","DGO THD1",66,0 ) | |
1712 | ; and its 90-Da y clock st atus | |
1713 | "RTN","DGO THD1",67,0 ) | |
1714 | ; 2. Cre ate a new entry in f ield #.550 1 node #.5 5 in Patie nt File (# 2) | |
1715 | "RTN","DGO THD1",68,0 ) | |
1716 | ; 3. Cre ate 365-Da y and 90-D ay Countdo wn clock i n file #33 | |
1717 | "RTN","DGO THD1",69,0 ) | |
1718 | ; | |
1719 | "RTN","DGO THD1",70,0 ) | |
1720 | Q:'$G(DGD FN) | |
1721 | "RTN","DGO THD1",71,0 ) | |
1722 | N EMHCNV, DGMSG,DGQU IT,DGARR,D GIEN33,DGC LCK,DGLS36 5D,DGLS365 I,DGPTST | |
1723 | "RTN","DGO THD1",72,0 ) | |
1724 | S EMHCNV= $$ISOTHD^D GOTHD(DGDF N) ;check if primar y eligibil ity is EXP ANDED MH C ARE NON-VE TERANS | |
1725 | "RTN","DGO THD1",73,0 ) | |
1726 | Q:'EMHCNV | |
1727 | "RTN","DGO THD1",74,0 ) | |
1728 | ;display EXPANDED M H CARE wa rning | |
1729 | "RTN","DGO THD1",75,0 ) | |
1730 | S DGMSG(1 )=" " | |
1731 | "RTN","DGO THD1",76,0 ) | |
1732 | S DGMSG(2 )=" This code is us ed ONLY fo r Other Th an Honorab le veteran s seeking" | |
1733 | "RTN","DGO THD1",77,0 ) | |
1734 | S DGMSG(3 )=" emerg ent mental healthcar e prior to VBA ADJUD ICATION." | |
1735 | "RTN","DGO THD1",78,0 ) | |
1736 | S DGMSG(4 )=" " | |
1737 | "RTN","DGO THD1",79,0 ) | |
1738 | D EN^DDIO L(.DGMSG) | |
1739 | "RTN","DGO THD1",80,0 ) | |
1740 | ;check if patient's clock has been prev iously adj udicated/i nactivated | |
1741 | "RTN","DGO THD1",81,0 ) | |
1742 | I $D(^DGO TH(33,"B", DGDFN)) S DGIEN33=$$ HASCLOCK^D GOTHD2(DGD FN) D Q:D GQUIT'=1 | |
1743 | "RTN","DGO THD1",82,0 ) | |
1744 | . D GETS^ DIQ(33,DGI EN33_","," .01;.02;.0 3;.06;1*", "IE","DGAR R") | |
1745 | "RTN","DGO THD1",83,0 ) | |
1746 | . S DGPTS T=$$STATUS ^DGOTHRI(. DGARR) ;OT H patient clock stat us | |
1747 | "RTN","DGO THD1",84,0 ) | |
1748 | . D CLOCK ^DGOTHRP2( DGIEN33) | |
1749 | "RTN","DGO THD1",85,0 ) | |
1750 | . I '$$GE T1^DIQ(33, DGIEN33_", ",.02,"I") D Q:DGQU IT'=1 | |
1751 | "RTN","DGO THD1",86,0 ) | |
1752 | . . ;disp lay patien t's clock status | |
1753 | "RTN","DGO THD1",87,0 ) | |
1754 | . . D WAR N2(DGDFN,. DGARR) | |
1755 | "RTN","DGO THD1",88,0 ) | |
1756 | . . ;do n ot allow u ser to re- enter EXPA NDED MH CA RE NON-VET ERANS if a lready adj udicated | |
1757 | "RTN","DGO THD1",89,0 ) | |
1758 | . . I +$G (DGARR(33, DGIEN33_", ",.06,"I") ) D Q | |
1759 | "RTN","DGO THD1",90,0 ) | |
1760 | . . . W ! ," >>> Co ntact your superviso r if you w ant to pro ceed this action.",! | |
1761 | "RTN","DGO THD1",91,0 ) | |
1762 | . . . D P REVSEL(DGD FN) | |
1763 | "RTN","DGO THD1",92,0 ) | |
1764 | . . . S D GQUIT=0 | |
1765 | "RTN","DGO THD1",93,0 ) | |
1766 | . . S DGQ UIT=$$YESN O^DGOTHD2( "Do you wa nt to cont inue editi ng patient 's primary eligibili ty code (Y /N)",,1) W ! | |
1767 | "RTN","DGO THD1",94,0 ) | |
1768 | . . ;put back the p revious pr imary elig ibility co de of the patient | |
1769 | "RTN","DGO THD1",95,0 ) | |
1770 | . . D:DGQ UIT'=1 PRE VSEL(DGDFN ) | |
1771 | "RTN","DGO THD1",96,0 ) | |
1772 | . S DGQUI T=1 | |
1773 | "RTN","DGO THD1",97,0 ) | |
1774 | ; | |
1775 | "RTN","DGO THD1",98,0 ) | |
1776 | ;prompt f or EXPANDE D MH CARE TYPE | |
1777 | "RTN","DGO THD1",99,0 ) | |
1778 | ;Create a new entry in field #.5501 nod e #.55 in Patient Fi le (#2) | |
1779 | "RTN","DGO THD1",100, 0) | |
1780 | ;DGEMHC = 0 No en try create d | |
1781 | "RTN","DGO THD1",101, 0) | |
1782 | ;DGEMHC = 1 Creat e/Change E XPANDED MH CARE TYPE entry | |
1783 | "RTN","DGO THD1",102, 0) | |
1784 | N DGEMHC | |
1785 | "RTN","DGO THD1",103, 0) | |
1786 | S DGEMHC= $$EMHCTYP( DGDFN) | |
1787 | "RTN","DGO THD1",104, 0) | |
1788 | D:DGEMHC UPDTEMHT(D GDFN) | |
1789 | "RTN","DGO THD1",105, 0) | |
1790 | K DGARR | |
1791 | "RTN","DGO THD1",106, 0) | |
1792 | ;Create 3 65-Day and 90-Day Co untdown cl ock in fil e #33 | |
1793 | "RTN","DGO THD1",107, 0) | |
1794 | D STRDATE ^DGOTHD(DG DFN) | |
1795 | "RTN","DGO THD1",108, 0) | |
1796 | Q | |
1797 | "RTN","DGO THD1",109, 0) | |
1798 | ; | |
1799 | "RTN","DGO THD1",110, 0) | |
1800 | EMHCTYP(DG DFN) ;prom pt for EXP ANDED MH C ARE TYPE | |
1801 | "RTN","DGO THD1",111, 0) | |
1802 | ;field #. 5501 node #.55 in Pa tient File (#2) | |
1803 | "RTN","DGO THD1",112, 0) | |
1804 | ; Input : | |
1805 | "RTN","DGO THD1",113, 0) | |
1806 | ; DGDFN - Patient IEN | |
1807 | "RTN","DGO THD1",114, 0) | |
1808 | ; Output: | |
1809 | "RTN","DGO THD1",115, 0) | |
1810 | ; 0 - No entry cre ated | |
1811 | "RTN","DGO THD1",116, 0) | |
1812 | ; 1 - Cr eate/Chang e EXPANDED MH CARE T YPE entry | |
1813 | "RTN","DGO THD1",117, 0) | |
1814 | ; | |
1815 | "RTN","DGO THD1",118, 0) | |
1816 | N DA,DGDI RB,DGDEL,D GMSG,DIR,D TOUT,DUOUT ,DIROUT,DI RUT | |
1817 | "RTN","DGO THD1",119, 0) | |
1818 | N DGRSN,D ONE,FILE,F IELD | |
1819 | "RTN","DGO THD1",120, 0) | |
1820 | S FILE=2, FIELD=.550 1,DGDEL=0 | |
1821 | "RTN","DGO THD1",121, 0) | |
1822 | S DIR(0)= FILE_","_F IELD_"AO", DONE=0 S:D GDFN DA=DG DFN | |
1823 | "RTN","DGO THD1",122, 0) | |
1824 | S DGDIRB= $$GET1^DIQ (2,DFN_"," ,.5501,"I" ) | |
1825 | "RTN","DGO THD1",123, 0) | |
1826 | I DGDIRB= "OTH-90",$ $GET1^DIQ( 33,$$HASCL OCK^DGOTHD 2(DGDFN)_" ,",.02,"I" ) S DGDEL= 1 | |
1827 | "RTN","DGO THD1",124, 0) | |
1828 | S DIR("B" )=$S(DGDIR B'="":$$OT HSOC^DGOTH D1(DGDIRB) ,1:"EMERGE NT MH OTH" ) | |
1829 | "RTN","DGO THD1",125, 0) | |
1830 | F D Q:D ONE | |
1831 | "RTN","DGO THD1",126, 0) | |
1832 | . ;keep p rompting u ntil user enter a va lid entry | |
1833 | "RTN","DGO THD1",127, 0) | |
1834 | . D ^DIR | |
1835 | "RTN","DGO THD1",128, 0) | |
1836 | . I $D(DT OUT) D PRE VSEL(DGDFN ) S DONE=1 Q ;remov e primary EXPANDED i f in EXPAN DED MH CAR E TYPE pro mpt timed- out | |
1837 | "RTN","DGO THD1",129, 0) | |
1838 | . I $D(DU OUT)!$D(DI ROUT) W !, " Exit no t allowed. This is a required response.? ?",! Q | |
1839 | "RTN","DGO THD1",130, 0) | |
1840 | . I $D(DI RUT) D Q | |
1841 | "RTN","DGO THD1",131, 0) | |
1842 | . . I DGD EL D DELMS G(DGDFN,DG DIRB,1) Q | |
1843 | "RTN","DGO THD1",132, 0) | |
1844 | . . W !," No Expan ded MH Car e Type fou nd." | |
1845 | "RTN","DGO THD1",133, 0) | |
1846 | . . W !," Nothing to delete. ",! | |
1847 | "RTN","DGO THD1",134, 0) | |
1848 | . ; | |
1849 | "RTN","DGO THD1",135, 0) | |
1850 | . I Y'="O TH-90",DGD EL D WARN1 Q | |
1851 | "RTN","DGO THD1",136, 0) | |
1852 | . ;prompt for the r eason why user react ivate pati ent's 90-d ay clock | |
1853 | "RTN","DGO THD1",137, 0) | |
1854 | . W ! | |
1855 | "RTN","DGO THD1",138, 0) | |
1856 | . I Y="OT H-90",$$HA SCLOCK^DGO THD2(DGDFN ),'$$GET1^ DIQ(33,$$H ASCLOCK^DG OTHD2(DGDF N)_",",.02 ,"I") D Q | |
1857 | "RTN","DGO THD1",139, 0) | |
1858 | . . S DGR SN=$$REASO N(2) | |
1859 | "RTN","DGO THD1",140, 0) | |
1860 | . . D INR E(DGRSN,2) | |
1861 | "RTN","DGO THD1",141, 0) | |
1862 | . S (DONE ,DGQUIT)=1 | |
1863 | "RTN","DGO THD1",142, 0) | |
1864 | K DIR | |
1865 | "RTN","DGO THD1",143, 0) | |
1866 | Q DGQUIT | |
1867 | "RTN","DGO THD1",144, 0) | |
1868 | ; | |
1869 | "RTN","DGO THD1",145, 0) | |
1870 | UPDTEMHT(D GDFN) ;set the assoc iated EXPA NDED MH CA RE TYPE | |
1871 | "RTN","DGO THD1",146, 0) | |
1872 | N DGFDA | |
1873 | "RTN","DGO THD1",147, 0) | |
1874 | I $$CHCKP AT^DGOTHD2 (DGDFN)'>0 Q -2 ;pa tient does not exist | |
1875 | "RTN","DGO THD1",148, 0) | |
1876 | S DGFDA(2 ,DGDFN_"," ,.5501)=Y | |
1877 | "RTN","DGO THD1",149, 0) | |
1878 | D FILE^DI E("K","DGF DA","DGERR ") | |
1879 | "RTN","DGO THD1",150, 0) | |
1880 | Q | |
1881 | "RTN","DGO THD1",151, 0) | |
1882 | ; | |
1883 | "RTN","DGO THD1",152, 0) | |
1884 | OTHSOC(EMH CT) ;Extra ct OTHER T HAN HONORA BLE set of codes | |
1885 | "RTN","DGO THD1",153, 0) | |
1886 | ; | |
1887 | "RTN","DGO THD1",154, 0) | |
1888 | ; Input : EMHCT - T he interna l set of c ode value | |
1889 | "RTN","DGO THD1",155, 0) | |
1890 | ; Output: The exter nal set of code valu e | |
1891 | "RTN","DGO THD1",156, 0) | |
1892 | ; | |
1893 | "RTN","DGO THD1",157, 0) | |
1894 | N DGERR,I ,DGOTHSOC, YY | |
1895 | "RTN","DGO THD1",158, 0) | |
1896 | S DGOTHSO C=$$GET1^D ID(2,.5501 ,,"SET OF CODES",,"D GERR") | |
1897 | "RTN","DGO THD1",159, 0) | |
1898 | Q:$D(DGER R) | |
1899 | "RTN","DGO THD1",160, 0) | |
1900 | F I=1:1:$ L(DGOTHSOC ,";") S YY =$P(DGOTHS OC,";",I) Q:YY="" S DGOTHSOC( $P(YY,":") )=$P(YY,": ",2) | |
1901 | "RTN","DGO THD1",161, 0) | |
1902 | Q DGOTHSO C(EMHCT) | |
1903 | "RTN","DGO THD1",162, 0) | |
1904 | ; | |
1905 | "RTN","DGO THD1",163, 0) | |
1906 | EMHCT(DGDF N) ;EXPAND ED MH CARE TYPE 'OTH ' in Patie nt file #2 | |
1907 | "RTN","DGO THD1",164, 0) | |
1908 | Q:'$G(DGD FN) | |
1909 | "RTN","DGO THD1",165, 0) | |
1910 | N DGFDART ,DGOTHERR | |
1911 | "RTN","DGO THD1",166, 0) | |
1912 | S DGFDART ($J,2,DGDF N_",",.550 1)="" | |
1913 | "RTN","DGO THD1",167, 0) | |
1914 | D FILE^DI E("U","DGF DART($J)", "DGOTHERR" ) | |
1915 | "RTN","DGO THD1",168, 0) | |
1916 | I $D(DGOT HERR) W !! ,"An error occurred during fil ing." | |
1917 | "RTN","DGO THD1",169, 0) | |
1918 | Q | |
1919 | "RTN","DGO THD1",170, 0) | |
1920 | ; | |
1921 | "RTN","DGO THD1",171, 0) | |
1922 | PREVSEL(DG DFN) ;put back the p atient's p revious pr imary elig ibility co de | |
1923 | "RTN","DGO THD1",172, 0) | |
1924 | N DGFDART ,DGOTHERR | |
1925 | "RTN","DGO THD1",173, 0) | |
1926 | S DGFDART ($J,2,DGDF N_",",.361 )=$S(DGPRV SEL>0:DGPR VSEL,1:"") | |
1927 | "RTN","DGO THD1",174, 0) | |
1928 | D FILE^DI E("U","DGF DART($J)", "DGOTHERR" ) | |
1929 | "RTN","DGO THD1",175, 0) | |
1930 | I $D(DGOT HERR) W !! ,"An error occurred during fil ing." | |
1931 | "RTN","DGO THD1",176, 0) | |
1932 | Q | |
1933 | "RTN","DGO THD1",177, 0) | |
1934 | ; | |
1935 | "RTN","DGO THD1",178, 0) | |
1936 | EMHELG(DGD FN) ;Is EX PANDE MH C ARE NON-VE TERANS the patient's primary e ligibility ? | |
1937 | "RTN","DGO THD1",179, 0) | |
1938 | ; Input : | |
1939 | "RTN","DGO THD1",180, 0) | |
1940 | ; DGDF N - Patien t IEN | |
1941 | "RTN","DGO THD1",181, 0) | |
1942 | ; Returne d: | |
1943 | "RTN","DGO THD1",182, 0) | |
1944 | ; 1 - Yes (P rim Eligib ility = EX PANDE MH C ARE NON-VE TERANS) | |
1945 | "RTN","DGO THD1",183, 0) | |
1946 | ; 0 - No | |
1947 | "RTN","DGO THD1",184, 0) | |
1948 | ; | |
1949 | "RTN","DGO THD1",185, 0) | |
1950 | Q $P($G(^ DIC(8,+$G( ^DPT(+$G(D FN),.36)), 0)),"^",9) =23 | |
1951 | "RTN","DGO THD1",186, 0) | |
1952 | ; | |
1953 | "RTN","DGO THD1",187, 0) | |
1954 | REASON(COD E) ;prompt user to p rovide rea son for in activating or reacti vating the clock | |
1955 | "RTN","DGO THD1",188, 0) | |
1956 | ;CODE: | |
1957 | "RTN","DGO THD1",189, 0) | |
1958 | ; 1 for I NACTIVATIO N 0 | |
1959 | "RTN","DGO THD1",190, 0) | |
1960 | ; 2 for R EACTIVATIO N 1 | |
1961 | "RTN","DGO THD1",191, 0) | |
1962 | N DGRSN | |
1963 | "RTN","DGO THD1",192, 0) | |
1964 | S DGRSN=$ $ANSWER^DG OTHRPT("Pl ease provi de reason for "_$S(C ODE=1:"INA CTIVATION" ,1:"REACTI VATION")_" (Required )","","F^5 :60^K:X="" ""!(X=""" ")!(X?1E) X","^D HEL P^DGOTHRI( 5)") | |
1965 | "RTN","DGO THD1",193, 0) | |
1966 | Q $S(DGRS N=-1:"",1: DGRSN) | |
1967 | "RTN","DGO THD1",194, 0) | |
1968 | ; | |
1969 | "RTN","DGO THD1",195, 0) | |
1970 | INRE(DGRSN ,CODE) ;in activate/r eactivate 90-Day clo ck | |
1971 | "RTN","DGO THD1",196, 0) | |
1972 | I DGRSN=" " D Q | |
1973 | "RTN","DGO THD1",197, 0) | |
1974 | . S DONE= 1,DGQUIT=0 | |
1975 | "RTN","DGO THD1",198, 0) | |
1976 | . W !!," No Reason Provided. <NO ACTIO N TAKEN>", ! | |
1977 | "RTN","DGO THD1",199, 0) | |
1978 | . I CODE> 1 D PREVSE L(DGDFN) | |
1979 | "RTN","DGO THD1",200, 0) | |
1980 | ;inactiva te clock | |
1981 | "RTN","DGO THD1",201, 0) | |
1982 | D STRE^DG OTHRI(DGIE N33,"",.DG ARR,DGLS36 5I,DGCLCK, $S(CODE=1: 0,1:1),DGR SN,"",DGPT ST) | |
1983 | "RTN","DGO THD1",202, 0) | |
1984 | S (DONE,D GQUIT)=1 | |
1985 | "RTN","DGO THD1",203, 0) | |
1986 | W !!," T his patien t 90-Day c ountdown c lock is "_ $S(CODE=1: "INACTIVAT ED",1:"REA CTIVATED") ,! | |
1987 | "RTN","DGO THD1",204, 0) | |
1988 | Q | |
1989 | "RTN","DGO THD1",205, 0) | |
1990 | ; | |
1991 | "RTN","DGO THD1",206, 0) | |
1992 | DELMSG(DGD FN,DGDIRB, CODE) ;Del ete or cha nging not allowed | |
1993 | "RTN","DGO THD1",207, 0) | |
1994 | S DGMSG(1 )=" " | |
1995 | "RTN","DGO THD1",208, 0) | |
1996 | S DGMSG(2 )=" Expan ded MH Car e Type '"_ $$OTHSOC^D GOTHD1(DGD IRB)_"' ca n't be "_$ S(CODE=1:" deleted",1 :"changed" )_"." | |
1997 | "RTN","DGO THD1",209, 0) | |
1998 | S DGMSG(3 )=$$MSG90( ) | |
1999 | "RTN","DGO THD1",210, 0) | |
2000 | S DGMSG(4 )=" " | |
2001 | "RTN","DGO THD1",211, 0) | |
2002 | D EN^DDIO L(.DGMSG) | |
2003 | "RTN","DGO THD1",212, 0) | |
2004 | K DGMSG | |
2005 | "RTN","DGO THD1",213, 0) | |
2006 | Q | |
2007 | "RTN","DGO THD1",214, 0) | |
2008 | ; | |
2009 | "RTN","DGO THD1",215, 0) | |
2010 | MSG90() ;w arning mes sage fo 90 -Day | |
2011 | "RTN","DGO THD1",216, 0) | |
2012 | Q " This patient c urrently h as an ACTI VE 90-Day countdown clock." | |
2013 | "RTN","DGO THD1",217, 0) | |
2014 | ; | |
2015 | "RTN","DGO THD1",218, 0) | |
2016 | WARN1 ;War n user abo ut the sta tus of the patient O TH clock | |
2017 | "RTN","DGO THD1",219, 0) | |
2018 | S DGOTHMS G(1)=" " | |
2019 | "RTN","DGO THD1",220, 0) | |
2020 | S DGOTHMS G(2)=$$MSG 90() | |
2021 | "RTN","DGO THD1",221, 0) | |
2022 | S DGOTHMS G(3)=" Pl ease inact ivate the clock via ""Inactiva te or Reac tivate OTH " | |
2023 | "RTN","DGO THD1",222, 0) | |
2024 | S DGOTHMS G(4)=" Pt Countdown Clock"" o ption." | |
2025 | "RTN","DGO THD1",223, 0) | |
2026 | S DGOTHMS G(5)=" " | |
2027 | "RTN","DGO THD1",224, 0) | |
2028 | D EN^DDIO L(.DGOTHMS G,"","!") | |
2029 | "RTN","DGO THD1",225, 0) | |
2030 | Q | |
2031 | "RTN","DGO THD1",226, 0) | |
2032 | ; | |
2033 | "RTN","DGO THD1",227, 0) | |
2034 | WARN2(DGDF N,DGARR) ; | |
2035 | "RTN","DGO THD1",228, 0) | |
2036 | N DGIEN33 | |
2037 | "RTN","DGO THD1",229, 0) | |
2038 | S DGIEN33 =$$HASCLOC K^DGOTHD2( DGDFN)_"," | |
2039 | "RTN","DGO THD1",230, 0) | |
2040 | S DGOTHMS G(1)=" Pa tient's 90 -Day count down clock was previ ously "_$S (+$G(DGARR (33,DGIEN3 3,.06,"I") ):"ADJUDIC ATED",1:"I NACTIVATED ") | |
2041 | "RTN","DGO THD1",231, 0) | |
2042 | S DGOTHMS G(2)=" on : "_$S(+$G (DGARR(33, DGIEN33,.0 3,"I")):$$ FMTE^XLFDT (DGARR(33, DGIEN33,.0 3,"I")),1: $$FMTE^XLF DT(DGARR(3 3,DGIEN33, .06,"I"))) | |
2043 | "RTN","DGO THD1",232, 0) | |
2044 | S DGOTHMS G(3)=" " | |
2045 | "RTN","DGO THD1",233, 0) | |
2046 | D EN^DDIO L(.DGOTHMS G,"","!") | |
2047 | "RTN","DGO THD1",234, 0) | |
2048 | Q | |
2049 | "RTN","DGO THD1",235, 0) | |
2050 | ; | |
2051 | "RTN","DGO THD1",236, 0) | |
2052 | TRUE() ;de cide if pr imary elig ibilty cod e will be deleted | |
2053 | "RTN","DGO THD1",237, 0) | |
2054 | I DFN'=DA ,$P($G(^DI C(8,DA,0)) ,"^",9)=23 Q 1 | |
2055 | "RTN","DGO THD1",238, 0) | |
2056 | Q 0 | |
2057 | "RTN","DGO THD1",239, 0) | |
2058 | ; | |
2059 | "RTN","DGO THD2") | |
2060 | 0^5^B18967 6030 | |
2061 | "RTN","DGO THD2",1,0) | |
2062 | DGOTHD2 ;S LC/SS,RM,R ED - OTHD (OTHER THA N HONORABL E DISCHARG E) APIs ;1 2/27/17 | |
2063 | "RTN","DGO THD2",2,0) | |
2064 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
2065 | "RTN","DGO THD2",3,0) | |
2066 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
2067 | "RTN","DGO THD2",4,0) | |
2068 | ; Las t Edited: SHRPE/RED - May 2, 2 018 15:11 | |
2069 | "RTN","DGO THD2",5,0) | |
2070 | ; | |
2071 | "RTN","DGO THD2",6,0) | |
2072 | ; IA: 1 0103 ^XL FDT (suppo rted) - [ $$FMADD^XL FDT, $$FMT E^XLFDT , $$NOW^XLFD T] | |
2073 | "RTN","DGO THD2",7,0) | |
2074 | ; 1 0015 ^DI Q (suppo rted) - [ GETS^DIQ] | |
2075 | "RTN","DGO THD2",8,0) | |
2076 | ; 1 0026 ^DI R (suppo rted) | |
2077 | "RTN","DGO THD2",9,0) | |
2078 | ; 2053 ^DI E (suppo rted) - [ FILE^DIE, UPDATE^DIE ] | |
2079 | "RTN","DGO THD2",10,0 ) | |
2080 | ; 1 0000 ^%D TC (suppo rted) - [ NOW^%DTC] | |
2081 | "RTN","DGO THD2",11,0 ) | |
2082 | Q | |
2083 | "RTN","DGO THD2",12,0 ) | |
2084 | ; | |
2085 | "RTN","DGO THD2",13,0 ) | |
2086 | ;create t he new OTH clock | |
2087 | "RTN","DGO THD2",14,0 ) | |
2088 | ;DGDFN - patient's IEN | |
2089 | "RTN","DGO THD2",15,0 ) | |
2090 | ;returns | |
2091 | "RTN","DGO THD2",16,0 ) | |
2092 | ;IEN of t he file #3 3 | |
2093 | "RTN","DGO THD2",17,0 ) | |
2094 | ;or -1^er ror messag e | |
2095 | "RTN","DGO THD2",18,0 ) | |
2096 | CROTHCLK(D GDFN) ; | |
2097 | "RTN","DGO THD2",19,0 ) | |
2098 | N DGVALS, DGIEN33 | |
2099 | "RTN","DGO THD2",20,0 ) | |
2100 | I $$CHCKP AT(DGDFN)' >0 Q -2 ; patient do es not exi st | |
2101 | "RTN","DGO THD2",21,0 ) | |
2102 | S DGVALS( .01)=DGDFN | |
2103 | "RTN","DGO THD2",22,0 ) | |
2104 | S DGVALS( .02)=1 ;se t to ACTIV E | |
2105 | "RTN","DGO THD2",23,0 ) | |
2106 | S DGIEN=$ $INSREC(33 ,"",.DGVAL S) | |
2107 | "RTN","DGO THD2",24,0 ) | |
2108 | Q DGIEN | |
2109 | "RTN","DGO THD2",25,0 ) | |
2110 | ; | |
2111 | "RTN","DGO THD2",26,0 ) | |
2112 | ;create t he new 365 days cloc k | |
2113 | "RTN","DGO THD2",27,0 ) | |
2114 | ;DGIEN33 - IEN of t he file #3 3 | |
2115 | "RTN","DGO THD2",28,0 ) | |
2116 | ;CLCKNO - clock # | |
2117 | "RTN","DGO THD2",29,0 ) | |
2118 | ;DGSTRDT - start da te | |
2119 | "RTN","DGO THD2",30,0 ) | |
2120 | CR365CLK(D GIEN33,CLC KNO,DGSTRD T) ; | |
2121 | "RTN","DGO THD2",31,0 ) | |
2122 | N IEN365, DGVALS | |
2123 | "RTN","DGO THD2",32,0 ) | |
2124 | S IEN365= $$CHCK365( DGIEN33,CL CKNO) | |
2125 | "RTN","DGO THD2",33,0 ) | |
2126 | I IEN365< 0 Q -1 ; OTH clock entry in t he file #3 3 doesn't exist | |
2127 | "RTN","DGO THD2",34,0 ) | |
2128 | I IEN365> 0 Q -2 ; this 365 c lock alrea dy exists | |
2129 | "RTN","DGO THD2",35,0 ) | |
2130 | S DGVALS( .01)=CLCKN O | |
2131 | "RTN","DGO THD2",36,0 ) | |
2132 | S DGVALS( .02)=DGSTR DT ;start date | |
2133 | "RTN","DGO THD2",37,0 ) | |
2134 | S DGIEN=$ $INSREC(33 .01,DGIEN3 3,.DGVALS) | |
2135 | "RTN","DGO THD2",38,0 ) | |
2136 | Q DGIEN | |
2137 | "RTN","DGO THD2",39,0 ) | |
2138 | ; | |
2139 | "RTN","DGO THD2",40,0 ) | |
2140 | ;create t he new 90 days clock | |
2141 | "RTN","DGO THD2",41,0 ) | |
2142 | ;DGIEN33 - ien file #33 | |
2143 | "RTN","DGO THD2",42,0 ) | |
2144 | ;DGI3301 - ien subfile #3 3.01 | |
2145 | "RTN","DGO THD2",43,0 ) | |
2146 | ;CLCKNO - 90 d ays clock # | |
2147 | "RTN","DGO THD2",44,0 ) | |
2148 | ;DGSTRDT - star t date, if negative or zero th en do not set the st art date | |
2149 | "RTN","DGO THD2",45,0 ) | |
2150 | ;DGAUDUZ - user entered t he authori zation | |
2151 | "RTN","DGO THD2",46,0 ) | |
2152 | ;DGAUDT - auth orization date | |
2153 | "RTN","DGO THD2",47,0 ) | |
2154 | ;DGAUTHRZ DBY - the person who approved and author ized the 2 nd 90-Day period | |
2155 | "RTN","DGO THD2",48,0 ) | |
2156 | CR90CLK(DG IEN33,DGI3 301,CLCKNO ,DGSTRDT,D GAUDUZ,DGA UDT,DGAUTH RZDBY) ; | |
2157 | "RTN","DGO THD2",49,0 ) | |
2158 | N IEN90,D GVALS | |
2159 | "RTN","DGO THD2",50,0 ) | |
2160 | S IEN90=$ $CHCK90(DG IEN33,DGI3 301,CLCKNO ) | |
2161 | "RTN","DGO THD2",51,0 ) | |
2162 | I IEN90<0 Q -1 ; O TH clock e ntry in th e file #33 doesn't e xist | |
2163 | "RTN","DGO THD2",52,0 ) | |
2164 | I IEN90>0 Q -2 ; t his 90 clo ck already exists | |
2165 | "RTN","DGO THD2",53,0 ) | |
2166 | S DGVALS( .01)=CLCKN O | |
2167 | "RTN","DGO THD2",54,0 ) | |
2168 | I DGSTRDT >0 S DGVAL S(.02)=DGS TRDT ;star t date | |
2169 | "RTN","DGO THD2",55,0 ) | |
2170 | I $G(DGAU DUZ)>0 S D GVALS(.03) =+DGAUDUZ ;the user entered th e authoriz ation | |
2171 | "RTN","DGO THD2",56,0 ) | |
2172 | S DGVALS( .05)=$S($G (DUZ)>0:$$ GET1^DIQ(2 00,DUZ,.01 ),1:"POSTM ASTER") ;t he user na me, otherw ise - POST MASTER | |
2173 | "RTN","DGO THD2",57,0 ) | |
2174 | S DGVALS( .06)=$$DT^ XLFDT ;now | |
2175 | "RTN","DGO THD2",58,0 ) | |
2176 | I $D(DGAU THRZDBY) S DGVALS(.0 7)=DGAUTHR ZDBY ;Auth orized By | |
2177 | "RTN","DGO THD2",59,0 ) | |
2178 | S DGVALS( .08)=$$GET SITE(.DUZ) ;get the user's cu rrent faci lity numbe r | |
2179 | "RTN","DGO THD2",60,0 ) | |
2180 | S DGIEN=$ $INSREC(33 .11,DGI330 1_","_DGIE N33,.DGVAL S) | |
2181 | "RTN","DGO THD2",61,0 ) | |
2182 | Q DGIEN | |
2183 | "RTN","DGO THD2",62,0 ) | |
2184 | ; | |
2185 | "RTN","DGO THD2",63,0 ) | |
2186 | ;Get the user's cur rent facil ity number . If not found, it will | |
2187 | "RTN","DGO THD2",64,0 ) | |
2188 | ;return t he facilit y number o f the prim ary facili ty. | |
2189 | "RTN","DGO THD2",65,0 ) | |
2190 | GETSITE(DU Z) ; | |
2191 | "RTN","DGO THD2",66,0 ) | |
2192 | ;Input: | |
2193 | "RTN","DGO THD2",67,0 ) | |
2194 | ; DU Z array, p ass by ref erence | |
2195 | "RTN","DGO THD2",68,0 ) | |
2196 | ;Output: | |
2197 | "RTN","DGO THD2",69,0 ) | |
2198 | ; Fu nction Val ue - facil ity number | |
2199 | "RTN","DGO THD2",70,0 ) | |
2200 | N FACILIT Y | |
2201 | "RTN","DGO THD2",71,0 ) | |
2202 | S FACILIT Y="" | |
2203 | "RTN","DGO THD2",72,0 ) | |
2204 | S:DUZ'=.5 FACILITY= DUZ(2) | |
2205 | "RTN","DGO THD2",73,0 ) | |
2206 | I 'FACILI TY S FACIL ITY=+$$SIT E^VASITE() | |
2207 | "RTN","DGO THD2",74,0 ) | |
2208 | Q FACILIT Y | |
2209 | "RTN","DGO THD2",75,0 ) | |
2210 | ; | |
2211 | "RTN","DGO THD2",76,0 ) | |
2212 | ;check if the patie nt has 2nd period au thorizatio n | |
2213 | "RTN","DGO THD2",77,0 ) | |
2214 | ;DGIEN33 - ien file #33 | |
2215 | "RTN","DGO THD2",78,0 ) | |
2216 | ;DGI3301 - ien subf ile #33.01 | |
2217 | "RTN","DGO THD2",79,0 ) | |
2218 | ;CLCKNO - 90 days c lock # | |
2219 | "RTN","DGO THD2",80,0 ) | |
2220 | HAS2AUTH(D GIEN33,DGI 3301,CLCKN O) ; | |
2221 | "RTN","DGO THD2",81,0 ) | |
2222 | N DGIEN90 ,DGRETDAT | |
2223 | "RTN","DGO THD2",82,0 ) | |
2224 | S DGIEN90 =$$CHCK90( DGIEN33,DG I3301,CLCK NO) | |
2225 | "RTN","DGO THD2",83,0 ) | |
2226 | I DGIEN90 '>0 Q -1 ; OTH cloc k entry in the file #33 doesn' t exist | |
2227 | "RTN","DGO THD2",84,0 ) | |
2228 | S DGRETDA T=$G(^DGOT H(33,DGIEN 33,1,DGI33 01,1,DGIEN 90,0)) | |
2229 | "RTN","DGO THD2",85,0 ) | |
2230 | Q $P(DGRE TDAT,U,3,4 ) | |
2231 | "RTN","DGO THD2",86,0 ) | |
2232 | ; | |
2233 | "RTN","DGO THD2",87,0 ) | |
2234 | ;does the patient h ave clock? | |
2235 | "RTN","DGO THD2",88,0 ) | |
2236 | ;DGDFN - patient IE N | |
2237 | "RTN","DGO THD2",89,0 ) | |
2238 | HASCLOCK(D GDFN) ; | |
2239 | "RTN","DGO THD2",90,0 ) | |
2240 | Q +$O(^DG OTH(33,"B" ,DGDFN,0)) | |
2241 | "RTN","DGO THD2",91,0 ) | |
2242 | ; | |
2243 | "RTN","DGO THD2",92,0 ) | |
2244 | ;how many 365 days clock the patient ha s? | |
2245 | "RTN","DGO THD2",93,0 ) | |
2246 | ;DGIEN33 - ien of # 33 | |
2247 | "RTN","DGO THD2",94,0 ) | |
2248 | CLCKS365(D GIEN33) ; | |
2249 | "RTN","DGO THD2",95,0 ) | |
2250 | Q $O(^DGO TH(33,DGIE N33,1,"B", 99),-1) | |
2251 | "RTN","DGO THD2",96,0 ) | |
2252 | ; | |
2253 | "RTN","DGO THD2",97,0 ) | |
2254 | ;returns | |
2255 | "RTN","DGO THD2",98,0 ) | |
2256 | ;-1 : if OTH clock entry in t he file #3 3 doesn't exist | |
2257 | "RTN","DGO THD2",99,0 ) | |
2258 | ;0 : if 365 days c lock with the number CLCKNO do esn't exis t | |
2259 | "RTN","DGO THD2",100, 0) | |
2260 | ;>0 : IEN of the 36 5 days clo ck with th e number C LCKNO | |
2261 | "RTN","DGO THD2",101, 0) | |
2262 | CHCK365(DG IEN33,CLCK NO) ; | |
2263 | "RTN","DGO THD2",102, 0) | |
2264 | I +$D(^DG OTH(33,DGI EN33,0))'> 0 Q -1 ;c lock doesn 't exist | |
2265 | "RTN","DGO THD2",103, 0) | |
2266 | Q +$O(^DG OTH(33,DGI EN33,1,"B" ,CLCKNO,0) ) | |
2267 | "RTN","DGO THD2",104, 0) | |
2268 | ; | |
2269 | "RTN","DGO THD2",105, 0) | |
2270 | ;returns | |
2271 | "RTN","DGO THD2",106, 0) | |
2272 | ;-1 : if OTH clock entry in t he file #3 3 doesn't exist | |
2273 | "RTN","DGO THD2",107, 0) | |
2274 | ;0 : if 90 days cl ock with t he number CLCKNO doe sn't exist | |
2275 | "RTN","DGO THD2",108, 0) | |
2276 | ;>0 : IEN of the 90 days cloc k with the number CL CKNO | |
2277 | "RTN","DGO THD2",109, 0) | |
2278 | CHCK90(DGI EN33,DGI33 01,CLCKNO) ; | |
2279 | "RTN","DGO THD2",110, 0) | |
2280 | I +$D(^DG OTH(33,DGI EN33,0))'> 0 Q -1 ;c lock doesn 't exist | |
2281 | "RTN","DGO THD2",111, 0) | |
2282 | I +$D(^DG OTH(33,DGI EN33,1,DGI 3301,0))'> 0 Q -1 ;c lock doesn 't exist | |
2283 | "RTN","DGO THD2",112, 0) | |
2284 | Q +$O(^DG OTH(33,DGI EN33,1,DGI 3301,1,"B" ,CLCKNO,0) ) | |
2285 | "RTN","DGO THD2",113, 0) | |
2286 | ;check DF N | |
2287 | "RTN","DGO THD2",114, 0) | |
2288 | CHCKPAT(DG DFN) ; | |
2289 | "RTN","DGO THD2",115, 0) | |
2290 | Q +$D(^DP T(DGDFN,0) ) | |
2291 | "RTN","DGO THD2",116, 0) | |
2292 | ; | |
2293 | "RTN","DGO THD2",117, 0) | |
2294 | ;get pati ent IEN by ien of th e file #33 | |
2295 | "RTN","DGO THD2",118, 0) | |
2296 | GETPAT(DGI EN33) ; | |
2297 | "RTN","DGO THD2",119, 0) | |
2298 | Q $P($G(^ DGOTH(33,D GIEN33,0)) ,U) | |
2299 | "RTN","DGO THD2",120, 0) | |
2300 | ; | |
2301 | "RTN","DGO THD2",121, 0) | |
2302 | ;input: | |
2303 | "RTN","DGO THD2",122, 0) | |
2304 | ;DGPROM - prompt te xt | |
2305 | "RTN","DGO THD2",123, 0) | |
2306 | ;DGDFVL - default v alue (opti onal) | |
2307 | "RTN","DGO THD2",124, 0) | |
2308 | ;returns: | |
2309 | "RTN","DGO THD2",125, 0) | |
2310 | ; "respon se^" | |
2311 | "RTN","DGO THD2",126, 0) | |
2312 | PROMPT(DGP ROM,DGDFVL ) ; | |
2313 | "RTN","DGO THD2",127, 0) | |
2314 | N DGRET,D IR,X,Y,DIR UT,DIROUT, DTOUT,DUOU T | |
2315 | "RTN","DGO THD2",128, 0) | |
2316 | S DGRET=" ^" | |
2317 | "RTN","DGO THD2",129, 0) | |
2318 | S DIR(0)= "F^::2",DI R("A")=DGP ROM | |
2319 | "RTN","DGO THD2",130, 0) | |
2320 | I $L($G(D GDFVL))>0 S DIR("B") =$G(DGDFVL ) | |
2321 | "RTN","DGO THD2",131, 0) | |
2322 | D ^DIR I $D(DIRUT) Q "^" | |
2323 | "RTN","DGO THD2",132, 0) | |
2324 | S $P(DGRE T,U)=Y | |
2325 | "RTN","DGO THD2",133, 0) | |
2326 | Q DGRET | |
2327 | "RTN","DGO THD2",134, 0) | |
2328 | ; | |
2329 | "RTN","DGO THD2",135, 0) | |
2330 | ASKDT(DGPR OM,DGDFVL, DGDIR0,DGL VL) ; | |
2331 | "RTN","DGO THD2",136, 0) | |
2332 | ; Input: | |
2333 | "RTN","DGO THD2",137, 0) | |
2334 | ; DGPRO M - prompt text | |
2335 | "RTN","DGO THD2",138, 0) | |
2336 | ; DGDFV L - defaul t value (o ptional) | |
2337 | "RTN","DGO THD2",139, 0) | |
2338 | ; DGDIR O - DIR(0) string | |
2339 | "RTN","DGO THD2",140, 0) | |
2340 | ; DGLVL | |
2341 | "RTN","DGO THD2",141, 0) | |
2342 | ; 1 - if the question comes from the 1st 9 0-day ques tion | |
2343 | "RTN","DGO THD2",142, 0) | |
2344 | ; 2 - if the question comes from the 2nd 9 0-day ques tion | |
2345 | "RTN","DGO THD2",143, 0) | |
2346 | ; Output : | |
2347 | "RTN","DGO THD2",144, 0) | |
2348 | ; Funct ion value - Internal value ret urned from ^DIR | |
2349 | "RTN","DGO THD2",145, 0) | |
2350 | ; | |
2351 | "RTN","DGO THD2",146, 0) | |
2352 | N DIR,DIR UT,DIROUT, DUOUT,DTOU T,XX,Y | |
2353 | "RTN","DGO THD2",147, 0) | |
2354 | S DIR(0)= DGDIR0 | |
2355 | "RTN","DGO THD2",148, 0) | |
2356 | S DIR("A" )=DGPROM | |
2357 | "RTN","DGO THD2",149, 0) | |
2358 | S DIR("B" )=DGDFVL | |
2359 | "RTN","DGO THD2",150, 0) | |
2360 | I DGLVL=1 D | |
2361 | "RTN","DGO THD2",151, 0) | |
2362 | . S DIR(" ?")="^D HE LP3^DGOTHD 2" | |
2363 | "RTN","DGO THD2",152, 0) | |
2364 | . S DIR(" ??")=DIR(" ?") | |
2365 | "RTN","DGO THD2",153, 0) | |
2366 | I DGLVL=2 D | |
2367 | "RTN","DGO THD2",154, 0) | |
2368 | . S DIR(" ?")="^D HE LP1^DGOTHD 2" | |
2369 | "RTN","DGO THD2",155, 0) | |
2370 | . S DIR(" ??")="^D H ELP2^DGOTH D2" | |
2371 | "RTN","DGO THD2",156, 0) | |
2372 | D ^DIR | |
2373 | "RTN","DGO THD2",157, 0) | |
2374 | Q:$D(DUOU T)!($D(DTO UT)) "^" | |
2375 | "RTN","DGO THD2",158, 0) | |
2376 | Q $S(X="@ ":"@",1:Y\ 1) | |
2377 | "RTN","DGO THD2",159, 0) | |
2378 | ;Q Y\1 | |
2379 | "RTN","DGO THD2",160, 0) | |
2380 | ; | |
2381 | "RTN","DGO THD2",161, 0) | |
2382 | ; | |
2383 | "RTN","DGO THD2",162, 0) | |
2384 | ; Ask | |
2385 | "RTN","DGO THD2",163, 0) | |
2386 | ; Input: | |
2387 | "RTN","DGO THD2",164, 0) | |
2388 | ; DGQSTR - questio n | |
2389 | "RTN","DGO THD2",165, 0) | |
2390 | ; DGDFL - default answer | |
2391 | "RTN","DGO THD2",166, 0) | |
2392 | ; DGLVL | |
2393 | "RTN","DGO THD2",167, 0) | |
2394 | ; 1 - if the q uestion co mes from a uthorizing the oth c lock | |
2395 | "RTN","DGO THD2",168, 0) | |
2396 | ; 2 - if the q uestion co mes from s tarting th e oth cloc k | |
2397 | "RTN","DGO THD2",169, 0) | |
2398 | ; Output: | |
2399 | "RTN","DGO THD2",170, 0) | |
2400 | ; 1 YES | |
2401 | "RTN","DGO THD2",171, 0) | |
2402 | ; 0 NO | |
2403 | "RTN","DGO THD2",172, 0) | |
2404 | ; -1 if c ancelled | |
2405 | "RTN","DGO THD2",173, 0) | |
2406 | YESNO(DGQS TR,DGDFL,D GLVL) ; De fault - YE S | |
2407 | "RTN","DGO THD2",174, 0) | |
2408 | N DIR,Y,D UOUT,DIROU T,DIRUT,DT OUT | |
2409 | "RTN","DGO THD2",175, 0) | |
2410 | S DIR(0)= "Y" | |
2411 | "RTN","DGO THD2",176, 0) | |
2412 | S DIR("A" )=DGQSTR | |
2413 | "RTN","DGO THD2",177, 0) | |
2414 | I DGLVL=2 S DIR("A" ,1)="" | |
2415 | "RTN","DGO THD2",178, 0) | |
2416 | S:$L($G(D GDFL)) DIR ("B")=DGDF L | |
2417 | "RTN","DGO THD2",179, 0) | |
2418 | D ^DIR | |
2419 | "RTN","DGO THD2",180, 0) | |
2420 | Q $S($G(D UOUT)!$G(D UOUT)!(Y=" ^"):-1,1:Y ) | |
2421 | "RTN","DGO THD2",181, 0) | |
2422 | ; | |
2423 | "RTN","DGO THD2",182, 0) | |
2424 | ; | |
2425 | "RTN","DGO THD2",183, 0) | |
2426 | ;date in external f ormat | |
2427 | "RTN","DGO THD2",184, 0) | |
2428 | DATE(X) ; | |
2429 | "RTN","DGO THD2",185, 0) | |
2430 | N Y S Y=" " I $G(X)? 7N.E S Y=$ E(X,4,5)_" /"_$E(X,6, 7)_"/"_$E( X,2,3) | |
2431 | "RTN","DGO THD2",186, 0) | |
2432 | Q Y | |
2433 | "RTN","DGO THD2",187, 0) | |
2434 | ; | |
2435 | "RTN","DGO THD2",188, 0) | |
2436 | ;This pro cedure is used to pe rform a pa tient look up for an existing p atient in the (#33) file. | |
2437 | "RTN","DGO THD2",189, 0) | |
2438 | ;Paramete rs: | |
2439 | "RTN","DGO THD2",190, 0) | |
2440 | ; None | |
2441 | "RTN","DGO THD2",191, 0) | |
2442 | ;Returns: | |
2443 | "RTN","DGO THD2",192, 0) | |
2444 | ; in DGPA T array wh ere | |
2445 | "RTN","DGO THD2",193, 0) | |
2446 | ; DGPAT = IEN of p atient in PATIENT (# 33) file o n success, -1 on fai lure | |
2447 | "RTN","DGO THD2",194, 0) | |
2448 | ; DGPAT( 0) = zero node of en try select ed | |
2449 | "RTN","DGO THD2",195, 0) | |
2450 | ; return value IEN of patient in PATIEN T (#33) fi le on succ ess, -1 on failure | |
2451 | "RTN","DGO THD2",196, 0) | |
2452 | SELPAT(DGP AT) ; | |
2453 | "RTN","DGO THD2",197, 0) | |
2454 | ;- int in put vars f or ^DIC ca ll | |
2455 | "RTN","DGO THD2",198, 0) | |
2456 | N DIC,DTO UT,DUPOT,X ,Y | |
2457 | "RTN","DGO THD2",199, 0) | |
2458 | S DIC="^D GOTH(33,", DIC(0)="AE MQZV" | |
2459 | "RTN","DGO THD2",200, 0) | |
2460 | ;screen o ut all tha t are not ACTIVE | |
2461 | "RTN","DGO THD2",201, 0) | |
2462 | S DIC("S" )="I $P(^( 0),U,2)=1" | |
2463 | "RTN","DGO THD2",202, 0) | |
2464 | ;- lookup patient | |
2465 | "RTN","DGO THD2",203, 0) | |
2466 | D ^DIC K DIC | |
2467 | "RTN","DGO THD2",204, 0) | |
2468 | ;- result of lookup | |
2469 | "RTN","DGO THD2",205, 0) | |
2470 | S DGPAT=Y | |
2471 | "RTN","DGO THD2",206, 0) | |
2472 | ;- if suc cess, setu p return a rray using output va rs from ^D IC call | |
2473 | "RTN","DGO THD2",207, 0) | |
2474 | I (+DGPAT >0) D Q + Y | |
2475 | "RTN","DGO THD2",208, 0) | |
2476 | . S DGPAT =+Y ;pa tient ien | |
2477 | "RTN","DGO THD2",209, 0) | |
2478 | . S DGPAT (0)=$G(Y(0 )) ;ze ro node of patient i n (#33) fi le | |
2479 | "RTN","DGO THD2",210, 0) | |
2480 | Q -1 | |
2481 | "RTN","DGO THD2",211, 0) | |
2482 | ; | |
2483 | "RTN","DGO THD2",212, 0) | |
2484 | ;/** | |
2485 | "RTN","DGO THD2",213, 0) | |
2486 | ;Creates a new entr y (or node for multi ple with . 01 field) | |
2487 | "RTN","DGO THD2",214, 0) | |
2488 | ; | |
2489 | "RTN","DGO THD2",215, 0) | |
2490 | ;DGFILE - file/subf ile number | |
2491 | "RTN","DGO THD2",216, 0) | |
2492 | ;DGIEN - ien of the parent fi le entry i n which th e new subf ile entry will be in serted | |
2493 | "RTN","DGO THD2",217, 0) | |
2494 | ;DGZFDA - array wit h values f or the fie lds | |
2495 | "RTN","DGO THD2",218, 0) | |
2496 | ; format for DGZFDA : | |
2497 | "RTN","DGO THD2",219, 0) | |
2498 | ; DGZFDA( .01)=value for #.01 field | |
2499 | "RTN","DGO THD2",220, 0) | |
2500 | ; DGZFDA( 3)=value f or #3 fiel d | |
2501 | "RTN","DGO THD2",221, 0) | |
2502 | ;DGRECNO -(optional ) specify IEN if you want spec ific value | |
2503 | "RTN","DGO THD2",222, 0) | |
2504 | ; Note: " " then the system wi ll assign the entry number its elf. | |
2505 | "RTN","DGO THD2",223, 0) | |
2506 | ;DGFLGS - FLAGS par ameter for UPDATE^DI E | |
2507 | "RTN","DGO THD2",224, 0) | |
2508 | ;DGLCKGL - fully sp ecified gl obal refer ence to lo ck | |
2509 | "RTN","DGO THD2",225, 0) | |
2510 | ;DGLCKTM - time out for LOCK, if LOCKTI ME=0 then the functi on will no t lock the file | |
2511 | "RTN","DGO THD2",226, 0) | |
2512 | ;DGNEWRE - optional , flag = i f 1 then a llow to cr eate a new top level record | |
2513 | "RTN","DGO THD2",227, 0) | |
2514 | ; | |
2515 | "RTN","DGO THD2",228, 0) | |
2516 | ;output : | |
2517 | "RTN","DGO THD2",229, 0) | |
2518 | ; positiv e number - record # created | |
2519 | "RTN","DGO THD2",230, 0) | |
2520 | ; <=0 - f ailure^err or message | |
2521 | "RTN","DGO THD2",231, 0) | |
2522 | ; | |
2523 | "RTN","DGO THD2",232, 0) | |
2524 | ;Example: | |
2525 | "RTN","DGO THD2",233, 0) | |
2526 | ;top leve l: | |
2527 | "RTN","DGO THD2",234, 0) | |
2528 | ;S DGVALS (.01)="OTH D" W $$INS REC^DG5395 2(8.1,"",. DGVALS,,,, ,1) | |
2529 | "RTN","DGO THD2",235, 0) | |
2530 | ;2nd leve l: | |
2531 | "RTN","DGO THD2",236, 0) | |
2532 | ;K DGVALS S DGVALS( .01)=1 W $ $INSREC^DG OTHD2(33.0 1,"8",.DGV ALS) | |
2533 | "RTN","DGO THD2",237, 0) | |
2534 | ;3rd leve l: | |
2535 | "RTN","DGO THD2",238, 0) | |
2536 | ;K DGVALS S DGVALS( .01)=1 W $ $INSREC^DG OTHD2(33.1 1,"1,8",.D GVALS) | |
2537 | "RTN","DGO THD2",239, 0) | |
2538 | INSREC(DGF ILE,DGIEN, DGZFDA,DGR ECNO,DGFLG S,DGLCKGL, DGLCKTM,DG NEWRE) ;*/ | |
2539 | "RTN","DGO THD2",240, 0) | |
2540 | I ('$G(DG FILE)) Q " 0^Invalid parameter" | |
2541 | "RTN","DGO THD2",241, 0) | |
2542 | I +$G(DGN EWRE)=0 I $G(DGRECNO )>0,'$G(DG IEN) Q "0^ Invalid pa rameter" | |
2543 | "RTN","DGO THD2",242, 0) | |
2544 | N DGSSI,D GIENS,DGER R,DGFDA,DI ERR | |
2545 | "RTN","DGO THD2",243, 0) | |
2546 | N DGLOCK S DGLOCK=0 | |
2547 | "RTN","DGO THD2",244, 0) | |
2548 | I '$G(DGR ECNO) N DG RECNO S DG RECNO=$G(D GRECNO) | |
2549 | "RTN","DGO THD2",245, 0) | |
2550 | I DGIEN'= "" S DGIEN S="+1,"_DG IEN_"," I $L(DGRECNO )>0 S DGSS I(1)=+DGRE CNO | |
2551 | "RTN","DGO THD2",246, 0) | |
2552 | I DGIEN=" " S DGIENS ="+1," I $ L(DGRECNO) >0 S DGSSI (1)=+DGREC NO | |
2553 | "RTN","DGO THD2",247, 0) | |
2554 | M DGFDA(D GFILE,DGIE NS)=DGZFDA | |
2555 | "RTN","DGO THD2",248, 0) | |
2556 | I $L($G(D GLCKGL)) L +@DGLCKGL :(+$G(DGLC KTM)) S DG LOCK=$T I 'DGLOCK Q -2 ;lock failure | |
2557 | "RTN","DGO THD2",249, 0) | |
2558 | D UPDATE^ DIE($G(DGF LGS),"DGFD A","DGSSI" ,"DGERR") | |
2559 | "RTN","DGO THD2",250, 0) | |
2560 | I DGLOCK L -@DGLCKG L | |
2561 | "RTN","DGO THD2",251, 0) | |
2562 | I $D(DGER R) Q "-1^" _$G(DGERR( "DIERR",1, "TEXT",1), "Update Er ror") | |
2563 | "RTN","DGO THD2",252, 0) | |
2564 | Q +$G(DGS SI(1)) | |
2565 | "RTN","DGO THD2",253, 0) | |
2566 | ; | |
2567 | "RTN","DGO THD2",254, 0) | |
2568 | ;2nd 90-D ay period start date help text | |
2569 | "RTN","DGO THD2",255, 0) | |
2570 | HELP2 ; | |
2571 | "RTN","DGO THD2",256, 0) | |
2572 | ; | |
2573 | "RTN","DGO THD2",257, 0) | |
2574 | W !!,"The default d ate displa yed "_$S(D GPRT<0:"be low ",1:"i n the prom pt ")_"is the end da te of the " | |
2575 | "RTN","DGO THD2",258, 0) | |
2576 | W !,"1st 90-Day per iod + 1 da y.",! | |
2577 | "RTN","DGO THD2",259, 0) | |
2578 | HELP1 W ! | |
2579 | "RTN","DGO THD2",260, 0) | |
2580 | I DGPRT<0 ,X'="?",X' ="??" W "N ot a valid date.",! | |
2581 | "RTN","DGO THD2",261, 0) | |
2582 | W "The st art date e ntered for the 2nd 9 0 Day peri od must fa ll within " | |
2583 | "RTN","DGO THD2",262, 0) | |
2584 | W !,"the specified date range displayed .",! | |
2585 | "RTN","DGO THD2",263, 0) | |
2586 | I DGPRT<0 D DTRANGE ^DGOTHEDT( $G(DGDTMIN ),$G(DGDTM AX)) W ! | |
2587 | "RTN","DGO THD2",264, 0) | |
2588 | Q | |
2589 | "RTN","DGO THD2",265, 0) | |
2590 | ; | |
2591 | "RTN","DGO THD2",266, 0) | |
2592 | HELP3 ;dis play help text for 1 st 90-Day period | |
2593 | "RTN","DGO THD2",267, 0) | |
2594 | I $G(Y)<1 ,X'="?",X' ="??" W !, " You hav e entered an invalid date, ple ase enter a valid da te." Q | |
2595 | "RTN","DGO THD2",268, 0) | |
2596 | W !," Th e date ent ered canno t be more than 90 da ys in the past." | |
2597 | "RTN","DGO THD2",269, 0) | |
2598 | W !," A future dat e cannot b e entered. " | |
2599 | "RTN","DGO THD2",270, 0) | |
2600 | Q | |
2601 | "RTN","DGO THD2",271, 0) | |
2602 | ; | |
2603 | "RTN","DGO THD2",272, 0) | |
2604 | ;Prompt t he user to enter the name of t he person | |
2605 | "RTN","DGO THD2",273, 0) | |
2606 | ;who auth orized the 2nd 90-da y period | |
2607 | "RTN","DGO THD2",274, 0) | |
2608 | ASKAUTH(DG PROM) ; | |
2609 | "RTN","DGO THD2",275, 0) | |
2610 | ; Input: | |
2611 | "RTN","DGO THD2",276, 0) | |
2612 | ; DGPRO M - prompt text | |
2613 | "RTN","DGO THD2",277, 0) | |
2614 | ; | |
2615 | "RTN","DGO THD2",278, 0) | |
2616 | ; Output : | |
2617 | "RTN","DGO THD2",279, 0) | |
2618 | ; Funct ion value - Internal value ret urned from ^DIR | |
2619 | "RTN","DGO THD2",280, 0) | |
2620 | ; | |
2621 | "RTN","DGO THD2",281, 0) | |
2622 | N X,Y,DIR ,DIROUT,DI RUT,DTOUT, DUOUT | |
2623 | "RTN","DGO THD2",282, 0) | |
2624 | S DIR(0)= "33.11,.07 ^^^" ; K:X ="" "" X" | |
2625 | "RTN","DGO THD2",283, 0) | |
2626 | S DIR("A" )=DGPROM | |
2627 | "RTN","DGO THD2",284, 0) | |
2628 | D ^DIR | |
2629 | "RTN","DGO THD2",285, 0) | |
2630 | Q $S($D(D UOUT):-1,$ D(DTOUT):- 1,$D(DIROU T):-1,Y=" ":-1,1:$P( Y,U)) | |
2631 | "RTN","DGO THD2",286, 0) | |
2632 | ; | |
2633 | "RTN","DGO THD2",287, 0) | |
2634 | ; | |
2635 | "RTN","DGO THD2",288, 0) | |
2636 | EDAUTHBY ; Option nam e: DG OTH AUTHORIZE 2ND 90 DA YS | |
2637 | "RTN","DGO THD2",289, 0) | |
2638 | ;Edit 2nd Authorize d period, Authorized by field -- B 2S3 RED | |
2639 | "RTN","DGO THD2",290, 0) | |
2640 | N DGARR,D GSTRDT,DGI EN33,DGAUT ,DGAUTHBY, DGAUTHRZDB Y,FDB,DGOT MSG,DGNOW, DGLOOP,DG2 STRT,DGOTM SG | |
2641 | "RTN","DGO THD2",291, 0) | |
2642 | W ! D CHE CKPT Q:$G( DGIEN33)<0 | |
2643 | "RTN","DGO THD2",292, 0) | |
2644 | D GETS^DI Q(33,DGIEN 33_",",".0 1;.02;.03; 1*","I","D GARR") | |
2645 | "RTN","DGO THD2",293, 0) | |
2646 | I '$D(DGA RR(33.11," 2,1,"_DGIE N33_",",.0 7,"I")) W !!,?5,"Sor ry, this p atient has no 2nd au thorized p eriod of c are" Q | |
2647 | "RTN","DGO THD2",294, 0) | |
2648 | S DGSTRDT =$G(DGARR( 33.11,"2,1 ,"_DGIEN33 _",",.02," I")) | |
2649 | "RTN","DGO THD2",295, 0) | |
2650 | S DGSTDT1 =$G(DGARR( 33.11,"1,1 ,"_DGIEN33 _",",.02," I")),DGSTD T2=$G(DGAR R(33.11,"2 ,1,"_DGIEN 33_",",.02 ,"I")),DGM AXDT=$$FMA DD^XLFDT(D GSTDT1,364 ) | |
2651 | "RTN","DGO THD2",296, 0) | |
2652 | I DGSTDT2 '="",(DGST DT2+90)<DT W !!,?5," Patients 2 nd authori zed period of care h ad ended" Q | |
2653 | "RTN","DGO THD2",297, 0) | |
2654 | ;Edit the Authorize d by field | |
2655 | "RTN","DGO THD2",298, 0) | |
2656 | S DGAUT=$ G(DGARR(33 .11,"2,1," _DGIEN33_" ,",.07,"I" )) | |
2657 | "RTN","DGO THD2",299, 0) | |
2658 | I DGAUT=" " W !,"You must use 'Authorize the 2nd 9 0 days per iod' to au thorize th is period first,",!, ?5,"it can not be add ed here" Q | |
2659 | "RTN","DGO THD2",300, 0) | |
2660 | S DIR("A" )="Authori zed By",DI R("B")=$G( DGARR(33.1 1,"2,1,"_D GIEN33_"," ,.07,"I")) | |
2661 | "RTN","DGO THD2",301, 0) | |
2662 | S DIR(0)= "FU^0:60" D ^DIR K D IR | |
2663 | "RTN","DGO THD2",302, 0) | |
2664 | S DGAUTHR Z=Y I DGAU THRZ=-1!($ L(DGAUTHRZ )<5!($L(DG AUTHRZ)>60 )) W !,?5, "Invalid e ntry (Must be 5-60 c haracters) , quitting " Q | |
2665 | "RTN","DGO THD2",303, 0) | |
2666 | Q:$D(DGAU THRZ)=""!( DGAUT=DGAU THRZ) ;Q uit if no changes or NULL entr y | |
2667 | "RTN","DGO THD2",304, 0) | |
2668 | D NOW^%DT C S DGNOW= % | |
2669 | "RTN","DGO THD2",305, 0) | |
2670 | S FDB(33. 11,"2,1,"_ DGIEN33_", ",.05)=DUZ ,FDB(33.11 ,"2,1,"_DG IEN33_",", .06)=$P(DG NOW,"."),F DB(33.11," 2,1,"_DGIE N33_",",.0 7)=DGAUTHR Z | |
2671 | "RTN","DGO THD2",306, 0) | |
2672 | L +^DGOTH (33,DGIEN3 3):$S($G(D ILOCKTM):D ILOCKTM,1: 5) I '$T W !,"Unable to lock O TH CLOCK f ile, try a gain later " Q ;Try to lock f ile entry | |
2673 | "RTN","DGO THD2",307, 0) | |
2674 | D FILE^DI E("U","FDB ","DGOTMSG ") | |
2675 | "RTN","DGO THD2",308, 0) | |
2676 | L -^DGOTH (33,DGIEN3 3) | |
2677 | "RTN","DGO THD2",309, 0) | |
2678 | I $D(DGOT MSG) W !," -1^Problem s saving n ew authori zed by ent ry" Q ;Er ror occurr ed | |
2679 | "RTN","DGO THD2",310, 0) | |
2680 | W !!,?5," 2nd 90 day period of care Auth orized by, changed t o: ",DGAUT HRZ | |
2681 | "RTN","DGO THD2",311, 0) | |
2682 | ;Audit th e file ent ry | |
2683 | "RTN","DGO THD2",312, 0) | |
2684 | N OLDVALU E,NEWVALUE S OLDVALU E=DGAUT,NE WVALUE=DGA UTHRZ,CLCK NO=2 D RDA UDIT(2,OLD VALUE,NEWV ALUE) | |
2685 | "RTN","DGO THD2",313, 0) | |
2686 | ;end or A udit | |
2687 | "RTN","DGO THD2",314, 0) | |
2688 | Q | |
2689 | "RTN","DGO THD2",315, 0) | |
2690 | ; | |
2691 | "RTN","DGO THD2",316, 0) | |
2692 | ; | |
2693 | "RTN","DGO THD2",317, 0) | |
2694 | EDSTDT ; Op tion: DG OTH ADD ST ART DT 2ND 90 | |
2695 | "RTN","DGO THD2",318, 0) | |
2696 | ;Edit 2nd Authorize d start da te -- B2S3 RED | |
2697 | "RTN","DGO THD2",319, 0) | |
2698 | N DGARR,D GSTDT,DGST DT1,DGSTDT 2,DGIEN33, DGAUT,DGAU THBY,DGAUT HRZ,FDB,DG OTMSG,DGNO W,DGLOOP,D G2STRT,DGM INDT,DGMAX DT,DGSTDT2 N | |
2699 | "RTN","DGO THD2",320, 0) | |
2700 | W ! D CHE CKPT Q:$G( DGIEN33)<0 | |
2701 | "RTN","DGO THD2",321, 0) | |
2702 | D GETS^DI Q(33,DGIEN 33_",",".0 1;.02;.03; 1*","I","D GARR") | |
2703 | "RTN","DGO THD2",322, 0) | |
2704 | I '$D(DGA RR(33.11," 2,1,"_DGIE N33_",",.0 7,"I")) W !,?5,"This patient h as no 2nd authorized period of care" Q | |
2705 | "RTN","DGO THD2",323, 0) | |
2706 | S DGAUT=$ G(DGARR(33 .11,"2,1," _DGIEN33_" ,",.07,"I" )) | |
2707 | "RTN","DGO THD2",324, 0) | |
2708 | I DGAUT=" " W !,?5," This perio d of care has not be en authori zed,",!,?5 ,"you cann ot enter a start dat e until it 's authori zed" Q | |
2709 | "RTN","DGO THD2",325, 0) | |
2710 | S DGSTDT1 =$G(DGARR( 33.11,"1,1 ,"_DGIEN33 _",",.02," I")),DGSTD T2=$G(DGAR R(33.11,"2 ,1,"_DGIEN 33_",",.02 ,"I")),DGM AXDT=$$FMA DD^XLFDT(D GSTDT1,364 ) | |
2711 | "RTN","DGO THD2",326, 0) | |
2712 | S DGMINDT =$$FMADD^X LFDT(DGSTD T1,91) | |
2713 | "RTN","DGO THD2",327, 0) | |
2714 | I DGSTDT2 '="" W !!, ?2,"This d ate is une ditable wi th this op tion, exis ting date is: ",$$F MTE^XLFDT( DGSTDT2) Q | |
2715 | "RTN","DGO THD2",328, 0) | |
2716 | I DGSTDT2 '="",DGSTD T2<DT W !, ?5,"Patien ts 2nd aut horized pe riod of ca re had end ed" Q | |
2717 | "RTN","DGO THD2",329, 0) | |
2718 | N DIR,DTO UT,DIROUT, Y,X,DUOUT, DGLOOP S D GLOOP=0 | |
2719 | "RTN","DGO THD2",330, 0) | |
2720 | F D Q:D GLOOP | |
2721 | "RTN","DGO THD2",331, 0) | |
2722 | . S DIR(0 )="DAO^::E X",DIR("A" )=" Enter a start d ate for pe riod 2: " ,DIR("B")= $$FMTE^XLF DT(DGMINDT ) | |
2723 | "RTN","DGO THD2",332, 0) | |
2724 | . S DIR(" A",1)=" Date must be between : "_$$FMTE ^XLFDT(DGM INDT)_" - "_$$FMTE^X LFDT(DGMAX DT),DIR("A ",2)="" D ^DIR | |
2725 | "RTN","DGO THD2",333, 0) | |
2726 | . I $D(DU OUT)!$D(DT OUT)!$D(DI ROUT)!(Y=" ") S DGLO OP=1 Q | |
2727 | "RTN","DGO THD2",334, 0) | |
2728 | . I Y<DGM INDT!(Y>DG MAXDT) W ! !,?20," N ot a valid date" K Y H 2 Q ; Don't allo w dates if below min imum or gr eater than maximum | |
2729 | "RTN","DGO THD2",335, 0) | |
2730 | . I $G(Y) '="" S DGL OOP=1 Q | |
2731 | "RTN","DGO THD2",336, 0) | |
2732 | Q:'($G(Y) ) | |
2733 | "RTN","DGO THD2",337, 0) | |
2734 | S DGSTDT2 N=Y D NOW^ %DTC S DGN OW=% ;Ad ded the ne w start da te, leavin g the old start date intact, i t should a lways be N ULL | |
2735 | "RTN","DGO THD2",338, 0) | |
2736 | S FDB(33. 11,"2,1,"_ DGIEN33_", ",.05)=DUZ ,FDB(33.11 ,"2,1,"_DG IEN33_",", .06)=$P(DG NOW,"."),F DB(33.11," 2,1,"_DGIE N33_",",.0 2)=DGSTDT2 N | |
2737 | "RTN","DGO THD2",339, 0) | |
2738 | L +^DGOTH (33,DGIEN3 3):$S($G(D ILOCKTM):D ILOCKTM,1: 5) I '$T W !,"Unable to lock O TH CLOCK f ile, try a gain later " Q | |
2739 | "RTN","DGO THD2",340, 0) | |
2740 | D FILE^DI E("U","FDB ","DGOTMSG ") | |
2741 | "RTN","DGO THD2",341, 0) | |
2742 | L -^DGOTH (33,DGIEN3 3) | |
2743 | "RTN","DGO THD2",342, 0) | |
2744 | I $D(DGOT MSG) W !,? 5,"-1^Prob lems savin g new auth orized by entry" Q | |
2745 | "RTN","DGO THD2",343, 0) | |
2746 | W !!,?5," 2nd 90 day period of care star t date, ch anged to: ",Y(0) | |
2747 | "RTN","DGO THD2",344, 0) | |
2748 | ;Audit en try | |
2749 | "RTN","DGO THD2",345, 0) | |
2750 | N OLDVALU E,NEWVALUE S OLDVALU E=DGSTDT2, NEWVALUE=D GSTDT2N,CL CKNO=2 D R DAUDIT(1,O LDVALUE,NE WVALUE) | |
2751 | "RTN","DGO THD2",346, 0) | |
2752 | ;end of A udit | |
2753 | "RTN","DGO THD2",347, 0) | |
2754 | Q | |
2755 | "RTN","DGO THD2",348, 0) | |
2756 | ; | |
2757 | "RTN","DGO THD2",349, 0) | |
2758 | CHECKPT ; Used by E DAUTHBY an d EDSTDT | |
2759 | "RTN","DGO THD2",350, 0) | |
2760 | ; Get Pt, quit if f ound | |
2761 | "RTN","DGO THD2",351, 0) | |
2762 | N DG365,D G90,DGRES | |
2763 | "RTN","DGO THD2",352, 0) | |
2764 | S (DGIEN3 3,DGLOOP)= 0 F D Q: DGLOOP=1 | |
2765 | "RTN","DGO THD2",353, 0) | |
2766 | . S DGIEN 33=$$SELPA T^DGOTHD2( .DGARR) | |
2767 | "RTN","DGO THD2",354, 0) | |
2768 | . I DGARR <1 S DGLOO P=1 Q | |
2769 | "RTN","DGO THD2",355, 0) | |
2770 | . I $P(DG ARR(0),U,2 )'=1!(DGIE N33<0) S D GLOOP=1 Q | |
2771 | "RTN","DGO THD2",356, 0) | |
2772 | . I $P(DG ARR(0),U,3 )=1 W !,?5 ,"VBA ADJU DICATION h as been CO MPLETED",! ,?8,"Pleas e select a nother pat ient.",! S DGIEN33=- 1 Q | |
2773 | "RTN","DGO THD2",357, 0) | |
2774 | . S DGDFN =$$GETPAT^ DGOTHD2(DG IEN33),DGR ES=$$OTHDC LCK^DGOTHD (DGDFN,DT) | |
2775 | "RTN","DGO THD2",358, 0) | |
2776 | . I DGRES <0 W !!,"E rror"_$S($ L($P(DGRES ,U,2))>0:" : "_$P(DGR ES,U,2),1: ""),!,"Ple ase select another p atient." Q | |
2777 | "RTN","DGO THD2",359, 0) | |
2778 | . I DGRES =0 W !!,"P atient is not eligib le for OTH .",!,"Plea se select another pa tient." Q | |
2779 | "RTN","DGO THD2",360, 0) | |
2780 | . S DG365 =$P(DGRES, U,1) I DG3 65>1 W !!, ?5,"Patien t has more than one 365 days O TH periods !",!,?5,"A uthorizati on can be entered on ly for the last 365 days perio d." Q | |
2781 | "RTN","DGO THD2",361, 0) | |
2782 | . S DG90= $P(DGRES,U ,2) ;I DG9 0=2 W !!,? 5,"The pat ient is in the secon d 90 day p eriod at t he moment. ",!,?5,"Pl ease selec t another patient." Q | |
2783 | "RTN","DGO THD2",362, 0) | |
2784 | . I DG90= 3 W !!,?5, "Patient h as used bo th periods in this 3 65 day per iod.",!,?5 ,"Please s elect anot her patien t." Q | |
2785 | "RTN","DGO THD2",363, 0) | |
2786 | . S DGLOO P=1 | |
2787 | "RTN","DGO THD2",364, 0) | |
2788 | Q | |
2789 | "RTN","DGO THD2",365, 0) | |
2790 | RDAUDIT(DG FIELD,OLDV ALUE,NEWVA LUE) ; Us ed by EDAU THBY and E DSTDT | |
2791 | "RTN","DGO THD2",366, 0) | |
2792 | ;Audit ch anges to f ile #33 to file #33. 1 | |
2793 | "RTN","DGO THD2",367, 0) | |
2794 | N DGVALS, DGHSTIEN | |
2795 | "RTN","DGO THD2",368, 0) | |
2796 | S DGHSTIE N=+$O(^DGO TH(33.1,"B ",DGARR,0) ) | |
2797 | "RTN","DGO THD2",369, 0) | |
2798 | I DGHSTIE N=0 S DGVA LS(.01)=DG IEN33 D IN SREC(33.1, "",.DGVALS ) S DGHSTI EN=+$O(^DG OTH(33.1," B",DGARR,0 )) | |
2799 | "RTN","DGO THD2",370, 0) | |
2800 | N DGVALS | |
2801 | "RTN","DGO THD2",371, 0) | |
2802 | S DGVALS( .01)=DGARR ("33.01"," 1,"_DGIEN3 3_",",".01 ","I"),DGV ALS(.02)=C LCKNO,DGVA LS(.03)=DG FIELD ;up dated fiel d number | |
2803 | "RTN","DGO THD2",372, 0) | |
2804 | S DGVALS( .04)=OLDVA LUE,DGVALS (.05)=NEWV ALUE,DGVAL S(.06)=$S( $G(DUZ)>0: +DUZ,1:.5) ,DGVALS(.0 7)=$$NOW^X LFDT() | |
2805 | "RTN","DGO THD2",373, 0) | |
2806 | D INSREC( 33.12,DGHS TIEN,.DGVA LS) | |
2807 | "RTN","DGO THD2",374, 0) | |
2808 | Q | |
2809 | "RTN","DGO THEDT") | |
2810 | 0^7^B20761 8520 | |
2811 | "RTN","DGO THEDT",1,0 ) | |
2812 | DGOTHEDT ; SLC/RM - O THD (OTHER THAN HONO RABLE DISC HARGE) API s ;March 2 7,2018@16: 38 | |
2813 | "RTN","DGO THEDT",2,0 ) | |
2814 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
2815 | "RTN","DGO THEDT",3,0 ) | |
2816 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
2817 | "RTN","DGO THEDT",4,0 ) | |
2818 | ; | |
2819 | "RTN","DGO THEDT",5,0 ) | |
2820 | ; Las t Edited: SHRPE/RM - May 02, 2 018 16:08 | |
2821 | "RTN","DGO THEDT",6,0 ) | |
2822 | ; | |
2823 | "RTN","DGO THEDT",7,0 ) | |
2824 | ; ICR# T YPE DESCRIPTIO N | |
2825 | "RTN","DGO THEDT",8,0 ) | |
2826 | ;----- - --- ---------- ---------- ---------- - | |
2827 | "RTN","DGO THEDT",9,0 ) | |
2828 | ; 2056 Sup GETS^DIQ | |
2829 | "RTN","DGO THEDT",10, 0) | |
2830 | ; 10103 Sup ^XLFDT: $$ FMTE, $$NO W, $$FMADD , $$FMDIFF | |
2831 | "RTN","DGO THEDT",11, 0) | |
2832 | ; 10061 Sup DEM^VADPT | |
2833 | "RTN","DGO THEDT",12, 0) | |
2834 | ; 10026 Sup ^DIR | |
2835 | "RTN","DGO THEDT",13, 0) | |
2836 | ; 6873 Cont Sub $$OTHDCLCK ^DGOTHD | |
2837 | "RTN","DGO THEDT",14, 0) | |
2838 | Q | |
2839 | "RTN","DGO THEDT",15, 0) | |
2840 | ; | |
2841 | "RTN","DGO THEDT",16, 0) | |
2842 | ;Allow us er to edit the start date for 1st/2nd 90 -Day perio d. | |
2843 | "RTN","DGO THEDT",17, 0) | |
2844 | ;This is only limi ted to use rs who hav e appropri ate | |
2845 | "RTN","DGO THEDT",18, 0) | |
2846 | ;security access fo r menu opt ion "ESDT Edit 90- Day Start Date". | |
2847 | "RTN","DGO THEDT",19, 0) | |
2848 | ;Entry po int DG OTH EDIT STAR T DATE opt ion | |
2849 | "RTN","DGO THEDT",20, 0) | |
2850 | ;B2S3 | |
2851 | "RTN","DGO THEDT",21, 0) | |
2852 | ; | |
2853 | "RTN","DGO THEDT",22, 0) | |
2854 | ESTRTDT ; | |
2855 | "RTN","DGO THEDT",23, 0) | |
2856 | ; | |
2857 | "RTN","DGO THEDT",24, 0) | |
2858 | N DGLOOP | |
2859 | "RTN","DGO THEDT",25, 0) | |
2860 | S DGLOOP= 0 | |
2861 | "RTN","DGO THEDT",26, 0) | |
2862 | ;keep ask ing until empty inpu t | |
2863 | "RTN","DGO THEDT",27, 0) | |
2864 | F D Q:D GLOOP=1 | |
2865 | "RTN","DGO THEDT",28, 0) | |
2866 | . N DGARR ,DGSTRDT,D GIEN33,DFN ,DGRES,DGL S365D,DGLS 365I,DGN,D GAUTH | |
2867 | "RTN","DGO THEDT",29, 0) | |
2868 | . N DGSTR DT,DG90A,D GLVL,DGDFV L,DGANSWR, I,DGERR | |
2869 | "RTN","DGO THEDT",30, 0) | |
2870 | . W ! | |
2871 | "RTN","DGO THEDT",31, 0) | |
2872 | . S DGIEN 33=$$SELPA T^DGOTHD2( .DGARR) | |
2873 | "RTN","DGO THEDT",32, 0) | |
2874 | . I DGIEN 33<0 S DGL OOP=1 Q | |
2875 | "RTN","DGO THEDT",33, 0) | |
2876 | . S DFN=$ $GETPAT^DG OTHD2(DGIE N33) | |
2877 | "RTN","DGO THEDT",34, 0) | |
2878 | . ; | |
2879 | "RTN","DGO THEDT",35, 0) | |
2880 | . I '$$IS OTHD^DGOTH D(DFN) D Q | |
2881 | "RTN","DGO THEDT",36, 0) | |
2882 | . . D HEA DER(DFN) | |
2883 | "RTN","DGO THEDT",37, 0) | |
2884 | . . W !!, "Patient i s not elig ible for O TH.",! | |
2885 | "RTN","DGO THEDT",38, 0) | |
2886 | . ; | |
2887 | "RTN","DGO THEDT",39, 0) | |
2888 | . D GETS^ DIQ(33,DGI EN33_","," .01;.02;.0 3;1*","I", "DGARR","D GERR") | |
2889 | "RTN","DGO THEDT",40, 0) | |
2890 | . ; | |
2891 | "RTN","DGO THEDT",41, 0) | |
2892 | . I $G(DG ARR(33,DGI EN33_",",. 02,"I"))'= 1 D Q | |
2893 | "RTN","DGO THEDT",42, 0) | |
2894 | . . D HEA DER(DFN) | |
2895 | "RTN","DGO THEDT",43, 0) | |
2896 | . . W !!, "The patie nt's OTH c lock has b een inacti vated." | |
2897 | "RTN","DGO THEDT",44, 0) | |
2898 | . ; | |
2899 | "RTN","DGO THEDT",45, 0) | |
2900 | . I $G(DG ARR(33,DGI EN33_",",. 03,"I"))=1 D Q | |
2901 | "RTN","DGO THEDT",46, 0) | |
2902 | . . D HEA DER(DFN) | |
2903 | "RTN","DGO THEDT",47, 0) | |
2904 | . . W !!, "VBA ADJUD ICATION ha s been COM PLETED" | |
2905 | "RTN","DGO THEDT",48, 0) | |
2906 | . ; | |
2907 | "RTN","DGO THEDT",49, 0) | |
2908 | . S DGLS3 65D=+$O(^D GOTH(33,DG IEN33,1,"B ",999),-1) | |
2909 | "RTN","DGO THEDT",50, 0) | |
2910 | . S DGLS3 65I=+$O(^D GOTH(33,DG IEN33,1,"B ",DGLS365D ,0)) | |
2911 | "RTN","DGO THEDT",51, 0) | |
2912 | . S DGN=0 F S DGN= +$O(^DGOTH (33,DGIEN3 3,1,DGLS36 5I,1,"B",D GN)) Q:DGN =0 D | |
2913 | "RTN","DGO THEDT",52, 0) | |
2914 | . . S DG9 0A(DGN)=+$ O(^DGOTH(3 3,DGIEN33, 1,DGLS365I ,1,"B",DGN ,0)) | |
2915 | "RTN","DGO THEDT",53, 0) | |
2916 | . S DGSTR DT=-1 | |
2917 | "RTN","DGO THEDT",54, 0) | |
2918 | . ; | |
2919 | "RTN","DGO THEDT",55, 0) | |
2920 | . ;No 365 -Day clock started o r | |
2921 | "RTN","DGO THEDT",56, 0) | |
2922 | . ;1st 90 -Day not s tarted or missing | |
2923 | "RTN","DGO THEDT",57, 0) | |
2924 | . I (DGLS 365D'>0)!( '$D(DG90A( 1))) D Q | |
2925 | "RTN","DGO THEDT",58, 0) | |
2926 | . . D HEA DER(DFN) | |
2927 | "RTN","DGO THEDT",59, 0) | |
2928 | . . W !!, "The patie nts 1st 90 -Day perio d has not started.", !! | |
2929 | "RTN","DGO THEDT",60, 0) | |
2930 | . . Q:$$S TDTYN(0,1) '=1 | |
2931 | "RTN","DGO THEDT",61, 0) | |
2932 | . . W ! | |
2933 | "RTN","DGO THEDT",62, 0) | |
2934 | . . D STR DATE1^DGOT HD(DFN) | |
2935 | "RTN","DGO THEDT",63, 0) | |
2936 | . . I DGL S365D'>0 S DGLVL=1 | |
2937 | "RTN","DGO THEDT",64, 0) | |
2938 | . . I '$D (DG90A(1)) ,DGLS365D> 0 S DGLVL= 2 | |
2939 | "RTN","DGO THEDT",65, 0) | |
2940 | . . Q:DGS TRDT<0 | |
2941 | "RTN","DGO THEDT",66, 0) | |
2942 | . . D SET CLOCK(DFN, DGSTRDT,DG IEN33,DGLV L) | |
2943 | "RTN","DGO THEDT",67, 0) | |
2944 | . ; | |
2945 | "RTN","DGO THEDT",68, 0) | |
2946 | . S DGRES =$$OTHDCLC K^DGOTHD(D FN,DT) | |
2947 | "RTN","DGO THEDT",69, 0) | |
2948 | . I DGRES <0 W !!,"E rror"_$S($ L($P(DGRES ,U,2))>0:" : "_$P(DGR ES,U,2),1: ""),!,"Ple ase select another p atient.",! Q | |
2949 | "RTN","DGO THEDT",70, 0) | |
2950 | . W @IOF | |
2951 | "RTN","DGO THEDT",71, 0) | |
2952 | . ; | |
2953 | "RTN","DGO THEDT",72, 0) | |
2954 | . ;Start Date edit: users wit h DG OTH E DIT securi ty key are allowed | |
2955 | "RTN","DGO THEDT",73, 0) | |
2956 | . ;to mak e changes for the 90 -Day OTH C LOCK start date | |
2957 | "RTN","DGO THEDT",74, 0) | |
2958 | . ; | |
2959 | "RTN","DGO THEDT",75, 0) | |
2960 | . ;First 90-day edi t only | |
2961 | "RTN","DGO THEDT",76, 0) | |
2962 | . I $D(DG 90A(1)),'$ D(DG90A(2) ) D DSPLY6 (1,DGRES,D FN,DGIEN33 ,DGLS365I, .DG90A) Q | |
2963 | "RTN","DGO THEDT",77, 0) | |
2964 | . ;1st or 2nd 90-Da y Edit | |
2965 | "RTN","DGO THEDT",78, 0) | |
2966 | . I $D(DG 90A(1)),$D (DG90A(2)) D Q | |
2967 | "RTN","DGO THEDT",79, 0) | |
2968 | . . I $P( DGRES,U,3) '="",$P(DG RES,U,5)=0 ,$P(DGRES, U,6)'="",$ P(DGRES,U, 8)=0 D Q ;both per iod expire d | |
2969 | "RTN","DGO THEDT",80, 0) | |
2970 | . . . D H EADER(DFN) W !! | |
2971 | "RTN","DGO THEDT",81, 0) | |
2972 | . . . F I =1:1:2 D | |
2973 | "RTN","DGO THEDT",82, 0) | |
2974 | . . . . I I=2 W !! | |
2975 | "RTN","DGO THEDT",83, 0) | |
2976 | . . . . D DSPLY4(I) ,DSPLY5(DG RES,I) | |
2977 | "RTN","DGO THEDT",84, 0) | |
2978 | . . . W ! !,"Not edi table. Bot h 1st and 2nd 90-Day OTH clock expired." | |
2979 | "RTN","DGO THEDT",85, 0) | |
2980 | . . I $P( DGRES,U,6) ="",$P(DGR ES,U,9)'=" " D DSPLY6 (1,DGRES,D FN,DGIEN33 ,DGLS365I, .DG90A) Q ;period 2 has been authorized without s tarting da te | |
2981 | "RTN","DGO THEDT",86, 0) | |
2982 | . . I $P( DGRES,U,5) =0,$P(DGRE S,U,6)'="" ,$P(DGRES, U,8)<90 D DSPLY7(DGR ES,DFN,DGI EN33,DGLS3 65I,.DG90A ) Q ;peri od 1 expir ed, edit o nly the 2n d 90-Day O TH | |
2983 | "RTN","DGO THEDT",87, 0) | |
2984 | . . I $P( DGRES,U,6) '="",$P(DG RES,U,9)'= "" D DSPLY 7(DGRES,DF N,DGIEN33, DGLS365I,. DG90A) Q ;period 1 is read-o nly, perio d 2 has be en authori zed with s tarting da te | |
2985 | "RTN","DGO THEDT",88, 0) | |
2986 | . . D DSP LY1(DFN,DG RES,.DG90A ,DGIEN33,D GLS365I) ; edit both periods | |
2987 | "RTN","DGO THEDT",89, 0) | |
2988 | . ; | |
2989 | "RTN","DGO THEDT",90, 0) | |
2990 | . S DGLOO P=1 | |
2991 | "RTN","DGO THEDT",91, 0) | |
2992 | Q | |
2993 | "RTN","DGO THEDT",92, 0) | |
2994 | ; | |
2995 | "RTN","DGO THEDT",93, 0) | |
2996 | ; Input: | |
2997 | "RTN","DGO THEDT",94, 0) | |
2998 | ; CLCKN O - clock # | |
2999 | "RTN","DGO THEDT",95, 0) | |
3000 | ; DGLVL | |
3001 | "RTN","DGO THEDT",96, 0) | |
3002 | ; 1 - if the question comes from the 1st 9 0-day ques tion | |
3003 | "RTN","DGO THEDT",97, 0) | |
3004 | ; 2 - if the question comes from the 2nd 9 0-day ques tion | |
3005 | "RTN","DGO THEDT",98, 0) | |
3006 | ; Output: | |
3007 | "RTN","DGO THEDT",99, 0) | |
3008 | ; 1 YES | |
3009 | "RTN","DGO THEDT",100 ,0) | |
3010 | ; 0 NO | |
3011 | "RTN","DGO THEDT",101 ,0) | |
3012 | ; -1 if cancelled | |
3013 | "RTN","DGO THEDT",102 ,0) | |
3014 | ; | |
3015 | "RTN","DGO THEDT",103 ,0) | |
3016 | STDTYN(CLC KNO,DGLVL) ; | |
3017 | "RTN","DGO THEDT",104 ,0) | |
3018 | Q $$YESNO ^DGOTHD2(" Do you wan t to set t he"_$S(CLC KNO>0:" ne w ",1:" ") _"start da te for the "_$S(DGLV L=1:"1st", 1:"2nd")_" OTH perio d (Y/N)",, DGLVL) | |
3019 | "RTN","DGO THEDT",105 ,0) | |
3020 | ; | |
3021 | "RTN","DGO THEDT",106 ,0) | |
3022 | ; Input: | |
3023 | "RTN","DGO THEDT",107 ,0) | |
3024 | ; DFN - Patien t's IEN | |
3025 | "RTN","DGO THEDT",108 ,0) | |
3026 | ; DGRES - contai ns the OTH 90-Day pe riod data | |
3027 | "RTN","DGO THEDT",109 ,0) | |
3028 | ; = p1^p2^ p3^p4^p5^p 6^p7^p8^p9 | |
3029 | "RTN","DGO THEDT",110 ,0) | |
3030 | ; DG90A - pass b y referenc e | |
3031 | "RTN","DGO THEDT",111 ,0) | |
3032 | ; - determ ine if pat ient has O TH day clo ck (1 or 2 ) started | |
3033 | "RTN","DGO THEDT",112 ,0) | |
3034 | ; DGAUT H - Author ized BY | |
3035 | "RTN","DGO THEDT",113 ,0) | |
3036 | ; | |
3037 | "RTN","DGO THEDT",114 ,0) | |
3038 | DSPLY1(DFN ,DGRES,DG9 0A,DGAUTH, DGIEN33,DG LS365I) ; | |
3039 | "RTN","DGO THEDT",115 ,0) | |
3040 | ; | |
3041 | "RTN","DGO THEDT",116 ,0) | |
3042 | S DGANSWR =$$DSPLY2( DFN,DGRES, .DG90A,$P( DGRES,U,9) ) | |
3043 | "RTN","DGO THEDT",117 ,0) | |
3044 | Q:DGANSWR <0 | |
3045 | "RTN","DGO THEDT",118 ,0) | |
3046 | I DGANSWR =1 S DGDFV L=$S($P(DG RES,U,3)'= "":$$FMTE^ XLFDT($P(D GRES,U,3)) ,1:"T") | |
3047 | "RTN","DGO THEDT",119 ,0) | |
3048 | I DGANSWR =2 S DGDFV L=$$FMTE^X LFDT($P(DG RES,U,6)) | |
3049 | "RTN","DGO THEDT",120 ,0) | |
3050 | ;D HELP1( DGANSWR),H ELP2(DGANS WR) | |
3051 | "RTN","DGO THEDT",121 ,0) | |
3052 | S DGSTRDT =$$ASKSTDT (DFN,DGDFV L,DGANSWR) | |
3053 | "RTN","DGO THEDT",122 ,0) | |
3054 | I DGSTRDT >0 D UPDTC LCK(DGANSW R,DGIEN33, DGLS365I,D GSTRDT,.DG 90A) | |
3055 | "RTN","DGO THEDT",123 ,0) | |
3056 | Q | |
3057 | "RTN","DGO THEDT",124 ,0) | |
3058 | ; | |
3059 | "RTN","DGO THEDT",125 ,0) | |
3060 | DSPLY2(DFN ,DGRES,DG9 0A,DGAUTH) ; | |
3061 | "RTN","DGO THEDT",126 ,0) | |
3062 | ; | |
3063 | "RTN","DGO THEDT",127 ,0) | |
3064 | N X,Y,DIR ,DIROUT,DI RUT,DTOUT, DUOUT | |
3065 | "RTN","DGO THEDT",128 ,0) | |
3066 | ; | |
3067 | "RTN","DGO THEDT",129 ,0) | |
3068 | D HEADER( DFN) | |
3069 | "RTN","DGO THEDT",130 ,0) | |
3070 | S DIR("A" )="Select 90-Day Per iod" | |
3071 | "RTN","DGO THEDT",131 ,0) | |
3072 | S DIR("?? ")="^D EST DTHLP^DGOT HEDT(DFN,D GRES,DGAUT H)" | |
3073 | "RTN","DGO THEDT",132 ,0) | |
3074 | I $D(DG90 A(1)) D DS PLY3(1,DGR ES,DGAUTH) | |
3075 | "RTN","DGO THEDT",133 ,0) | |
3076 | I $D(DG90 A(2)),DGAU TH'="",$P( DGRES,U,6) '="" D DSP LY3(2,DGRE S,DGAUTH) | |
3077 | "RTN","DGO THEDT",134 ,0) | |
3078 | D ^DIR | |
3079 | "RTN","DGO THEDT",135 ,0) | |
3080 | Q $S($D(D UOUT):-1,$ D(DTOUT):- 1,$D(DIROU T):-1,X="" :-1,1:$P(Y ,U)) | |
3081 | "RTN","DGO THEDT",136 ,0) | |
3082 | ; | |
3083 | "RTN","DGO THEDT",137 ,0) | |
3084 | DSPLY3(CLC KNO,DGRES, DGAUTH) ; | |
3085 | "RTN","DGO THEDT",138 ,0) | |
3086 | ; | |
3087 | "RTN","DGO THEDT",139 ,0) | |
3088 | W !! | |
3089 | "RTN","DGO THEDT",140 ,0) | |
3090 | I CLCKNO= 1 S DIR(0) ="SO^1:Fir st 90-Day Start Date Edit^" | |
3091 | "RTN","DGO THEDT",141 ,0) | |
3092 | I CLCKNO= 2 D | |
3093 | "RTN","DGO THEDT",142 ,0) | |
3094 | . I $P(DG RES,U,5)=0 ,$P(DGRES, U,6)'="",$ P(DGRES,U, 8)<90 S DI R(0)="SO^2 :Second 90 -Day Start Date Edit ^" Q | |
3095 | "RTN","DGO THEDT",143 ,0) | |
3096 | . S DIR(0 )="SO^1:Fi rst 90-Day Start Dat e Edit;2:S econd 90-D ay Start D ate Edit^" | |
3097 | "RTN","DGO THEDT",144 ,0) | |
3098 | S DIR(0)= DIR(0)_"K: +X'=X!(X>" _CLCKNO_") X" | |
3099 | "RTN","DGO THEDT",145 ,0) | |
3100 | S DIR("B" )=CLCKNO | |
3101 | "RTN","DGO THEDT",146 ,0) | |
3102 | D DSPLY4( CLCKNO) | |
3103 | "RTN","DGO THEDT",147 ,0) | |
3104 | D DSPLY5( DGRES,CLCK NO) | |
3105 | "RTN","DGO THEDT",148 ,0) | |
3106 | Q | |
3107 | "RTN","DGO THEDT",149 ,0) | |
3108 | ; | |
3109 | "RTN","DGO THEDT",150 ,0) | |
3110 | DSPLY4(CLC KNO) ; | |
3111 | "RTN","DGO THEDT",151 ,0) | |
3112 | I CLCKNO= 1 W " 36 5 Day Peri od: ",DGLS 365D,!,"1s t 90-Day P eriod:" | |
3113 | "RTN","DGO THEDT",152 ,0) | |
3114 | I CLCKNO= 2 W !!,"2n d 90-Day P eriod:" | |
3115 | "RTN","DGO THEDT",153 ,0) | |
3116 | I CLCKNO= 3 W !!,"3r d 90-Day P eriod:" | |
3117 | "RTN","DGO THEDT",154 ,0) | |
3118 | I CLCKNO= 4 W !!,"4t h 90-Day P eriod:" | |
3119 | "RTN","DGO THEDT",155 ,0) | |
3120 | I CLCKNO= 5 W !!,"5t h 90-Day P eriod:" | |
3121 | "RTN","DGO THEDT",156 ,0) | |
3122 | Q | |
3123 | "RTN","DGO THEDT",157 ,0) | |
3124 | ; | |
3125 | "RTN","DGO THEDT",158 ,0) | |
3126 | DSPLY5(DGR ES,CLCKNO) ; | |
3127 | "RTN","DGO THEDT",159 ,0) | |
3128 | N OTHSMRY ,SEQ | |
3129 | "RTN","DGO THEDT",160 ,0) | |
3130 | I CLCKNO= 1 D | |
3131 | "RTN","DGO THEDT",161 ,0) | |
3132 | . S OTHSM RY(CLCKNO, 1)=$S($P(D GRES,U,3)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 1))) ;star t date | |
3133 | "RTN","DGO THEDT",162 ,0) | |
3134 | . S OTHSM RY(CLCKNO, 2)=$S($P(D GRES,U,3)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 2))) ;end date | |
3135 | "RTN","DGO THEDT",163 ,0) | |
3136 | . S OTHSM RY(CLCKNO, 3)=$S($P(D GRES,U,3)= "":" ",1:$ $FMTE^XLFD T($P(DGRES ,U,3))) ;d ays remain ing | |
3137 | "RTN","DGO THEDT",164 ,0) | |
3138 | ; | |
3139 | "RTN","DGO THEDT",165 ,0) | |
3140 | I CLCKNO= 2,$P(DGRES ,U,4)'="" D | |
3141 | "RTN","DGO THEDT",166 ,0) | |
3142 | . S OTHSM RY(CLCKNO, 1)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 4))) ;star t date | |
3143 | "RTN","DGO THEDT",167 ,0) | |
3144 | . S OTHSM RY(CLCKNO, 2)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 5))) ;end date | |
3145 | "RTN","DGO THEDT",168 ,0) | |
3146 | . S OTHSM RY(CLCKNO, 3)=$S($P(D GRES,U,6)= "":" ",1:$ $FMTE^XLFD T($P(DGRES ,U,6))) ;d ays remain ing | |
3147 | "RTN","DGO THEDT",169 ,0) | |
3148 | ; | |
3149 | "RTN","DGO THEDT",170 ,0) | |
3150 | I CLCKNO= 3,$P(DGRES ,U,7)'="" D | |
3151 | "RTN","DGO THEDT",171 ,0) | |
3152 | . S OTHSM RY(CLCKNO, 1)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 7))) ;star t date | |
3153 | "RTN","DGO THEDT",172 ,0) | |
3154 | . S OTHSM RY(CLCKNO, 2)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 8))) ;end date | |
3155 | "RTN","DGO THEDT",173 ,0) | |
3156 | . S OTHSM RY(CLCKNO, 3)=$S($P(D GRES,U,6)= "":" ",1:$ $FMTE^XLFD T($P(DGRES ,U,9))) ;d ays remain ing | |
3157 | "RTN","DGO THEDT",174 ,0) | |
3158 | ; | |
3159 | "RTN","DGO THEDT",175 ,0) | |
3160 | I CLCKNO= 4,$P(DGRES ,U,10)'="" D | |
3161 | "RTN","DGO THEDT",176 ,0) | |
3162 | . S OTHSM RY(CLCKNO, 1)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 10))) ;sta rt date | |
3163 | "RTN","DGO THEDT",177 ,0) | |
3164 | . S OTHSM RY(CLCKNO, 2)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 11))) ;end date | |
3165 | "RTN","DGO THEDT",178 ,0) | |
3166 | . S OTHSM RY(CLCKNO, 3)=$S($P(D GRES,U,6)= "":" ",1:$ $FMTE^XLFD T($P(DGRES ,U,12))) ; days remai ning | |
3167 | "RTN","DGO THEDT",179 ,0) | |
3168 | ; | |
3169 | "RTN","DGO THEDT",180 ,0) | |
3170 | I CLCKNO= 5,$P(DGRES ,U,13)'="" D | |
3171 | "RTN","DGO THEDT",181 ,0) | |
3172 | . S OTHSM RY(CLCKNO, 1)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 13))) ;sta rt date | |
3173 | "RTN","DGO THEDT",182 ,0) | |
3174 | . S OTHSM RY(CLCKNO, 2)=$S($P(D GRES,U,6)= "":"< None Specified >",1:$$FM TE^XLFDT($ P(DGRES,U, 14))) ;end date | |
3175 | "RTN","DGO THEDT",183 ,0) | |
3176 | . S OTHSM RY(CLCKNO, 3)=$S($P(D GRES,U,6)= "":" ",1:$ $FMTE^XLFD T($P(DGRES ,U,15))) ; days remai ning | |
3177 | "RTN","DGO THEDT",184 ,0) | |
3178 | ; | |
3179 | "RTN","DGO THEDT",185 ,0) | |
3180 | S SEQ="" F S SEQ=$ O(OTHSMRY( CLCKNO,SEQ )) Q:SEQ=" " D | |
3181 | "RTN","DGO THEDT",186 ,0) | |
3182 | . I SEQ=1 W !,"Star t Date: ", OTHSMRY(CL CKNO,SEQ) | |
3183 | "RTN","DGO THEDT",187 ,0) | |
3184 | . I SEQ=2 W ?30,"En d Date: ", OTHSMRY(CL CKNO,SEQ) | |
3185 | "RTN","DGO THEDT",188 ,0) | |
3186 | . I SEQ=3 W ?60,"Da ys Remaini ng: ",$S($ P(^DGOTH(3 3,DGIEN33, 0),"^",6)= "":OTHSMRY (CLCKNO,SE Q),1:"0") | |
3187 | "RTN","DGO THEDT",189 ,0) | |
3188 | . Q | |
3189 | "RTN","DGO THEDT",190 ,0) | |
3190 | . I CLCKN O=1,SEQ=3 D | |
3191 | "RTN","DGO THEDT",191 ,0) | |
3192 | . . I $P( DGRES,U,5) =0,$P(DGRE S,U,6)'="" ,$P(DGRES, U,8)>0,$P( DGRES,U,8) <90 D Q | |
3193 | "RTN","DGO THEDT",192 ,0) | |
3194 | . . . W ! !," NOTE: 1st 90-Day Pe riod is un editable." | |
3195 | "RTN","DGO THEDT",193 ,0) | |
3196 | . . . W ! ," 2nd 90-Day OTH clock has been auth orized." | |
3197 | "RTN","DGO THEDT",194 ,0) | |
3198 | . . I $P( DGRES,U,6) '="",$P(DG RES,U,8)'= 0,$P(DGRES ,U,9)'="" D | |
3199 | "RTN","DGO THEDT",195 ,0) | |
3200 | . . . W ! !," N OTE: 1st 90-Day Pe riod is re ad-only" | |
3201 | "RTN","DGO THEDT",196 ,0) | |
3202 | . . . W ! ," 2nd 90-Day Per iod has be en authori zed" | |
3203 | "RTN","DGO THEDT",197 ,0) | |
3204 | K OTHSMRY | |
3205 | "RTN","DGO THEDT",198 ,0) | |
3206 | Q | |
3207 | "RTN","DGO THEDT",199 ,0) | |
3208 | ; | |
3209 | "RTN","DGO THEDT",200 ,0) | |
3210 | DSPLY6(CLC KNO,DGRES, DFN,DGIEN3 3,DGLS365I ,DG90A) ; | |
3211 | "RTN","DGO THEDT",201 ,0) | |
3212 | ; | |
3213 | "RTN","DGO THEDT",202 ,0) | |
3214 | S DGDFVL= $S($P(DGRE S,U,3)'="" :$$FMTE^XL FDT($P(DGR ES,U,3)),1 :"T") | |
3215 | "RTN","DGO THEDT",203 ,0) | |
3216 | D HEADER( DFN) | |
3217 | "RTN","DGO THEDT",204 ,0) | |
3218 | W !! | |
3219 | "RTN","DGO THEDT",205 ,0) | |
3220 | D DSPLY4( CLCKNO),DS PLY5(DGRES ,CLCKNO) | |
3221 | "RTN","DGO THEDT",206 ,0) | |
3222 | W ! | |
3223 | "RTN","DGO THEDT",207 ,0) | |
3224 | ;D HELP1( CLCKNO),HE LP2(CLCKNO ) | |
3225 | "RTN","DGO THEDT",208 ,0) | |
3226 | I CLCKNO= 1,$P(DGRES ,U,3)>0,$P (DGRES,U,5 )=0 D Q:$ $STDTYN(1, 1)'=1 | |
3227 | "RTN","DGO THEDT",209 ,0) | |
3228 | . W !!,"W ARNING:"," '",$P(DGRE S,U,5),"'" ," Days Re maining fo r 1st 90-D ay Period" ,! | |
3229 | "RTN","DGO THEDT",210 ,0) | |
3230 | S DGSTRDT =$$ASKSTDT (DFN,DGDFV L,CLCKNO) | |
3231 | "RTN","DGO THEDT",211 ,0) | |
3232 | I DGSTRDT >0 D UPDTC LCK(CLCKNO ,DGIEN33,D GLS365I,DG STRDT,.DG9 0A) | |
3233 | "RTN","DGO THEDT",212 ,0) | |
3234 | Q | |
3235 | "RTN","DGO THEDT",213 ,0) | |
3236 | ; | |
3237 | "RTN","DGO THEDT",214 ,0) | |
3238 | DSPLY7(DGR ES,DFN,DGI EN33,DGLS3 65I,DG90A) ; | |
3239 | "RTN","DGO THEDT",215 ,0) | |
3240 | ; | |
3241 | "RTN","DGO THEDT",216 ,0) | |
3242 | D HEADER( DFN) W !! | |
3243 | "RTN","DGO THEDT",217 ,0) | |
3244 | F I=1:1:2 D | |
3245 | "RTN","DGO THEDT",218 ,0) | |
3246 | . I I=2 W !! | |
3247 | "RTN","DGO THEDT",219 ,0) | |
3248 | . D DSPLY 4(I),DSPLY 5(DGRES,I) | |
3249 | "RTN","DGO THEDT",220 ,0) | |
3250 | ;D HELP1( 2),HELP2(I ) | |
3251 | "RTN","DGO THEDT",221 ,0) | |
3252 | S DGDFVL= $$FMTE^XLF DT($P(DGRE S,U,6)) | |
3253 | "RTN","DGO THEDT",222 ,0) | |
3254 | S DGSTRDT =$$ASKSTDT (DFN,DGDFV L,2) | |
3255 | "RTN","DGO THEDT",223 ,0) | |
3256 | I DGSTRDT >0 D UPDTC LCK(2,DGIE N33,DGLS36 5I,DGSTRDT ,.DG90A) | |
3257 | "RTN","DGO THEDT",224 ,0) | |
3258 | Q | |
3259 | "RTN","DGO THEDT",225 ,0) | |
3260 | ; | |
3261 | "RTN","DGO THEDT",226 ,0) | |
3262 | ESTDTHLP(D FN,DGRES,D GAUTH) ; | |
3263 | "RTN","DGO THEDT",227 ,0) | |
3264 | ; | |
3265 | "RTN","DGO THEDT",228 ,0) | |
3266 | N I | |
3267 | "RTN","DGO THEDT",229 ,0) | |
3268 | W !! | |
3269 | "RTN","DGO THEDT",230 ,0) | |
3270 | D HEADER( DFN) | |
3271 | "RTN","DGO THEDT",231 ,0) | |
3272 | W !! | |
3273 | "RTN","DGO THEDT",232 ,0) | |
3274 | I $D(DG90 A(1)),'$D( DG90A(2)) D | |
3275 | "RTN","DGO THEDT",233 ,0) | |
3276 | . D DSPLY 4(1),DSPLY 5(DGRES,1) | |
3277 | "RTN","DGO THEDT",234 ,0) | |
3278 | . I DGAUT H="",$P(DG RES,U,6)=" ",$P(DGRES ,U,5)=0 D AUTHMSG(1) | |
3279 | "RTN","DGO THEDT",235 ,0) | |
3280 | . I DGAUT H'="",$P(D GRES,U,6)= "" D DSPLY 4(2),AUTHM SG(2) | |
3281 | "RTN","DGO THEDT",236 ,0) | |
3282 | ; | |
3283 | "RTN","DGO THEDT",237 ,0) | |
3284 | I $D(DG90 A(1)),$D(D G90A(2)) D | |
3285 | "RTN","DGO THEDT",238 ,0) | |
3286 | . F I=1:1 :2 D | |
3287 | "RTN","DGO THEDT",239 ,0) | |
3288 | . . I I=2 W !! | |
3289 | "RTN","DGO THEDT",240 ,0) | |
3290 | . . D DSP LY4(I) | |
3291 | "RTN","DGO THEDT",241 ,0) | |
3292 | . . I DGA UTH="",$P( DGRES,U,6) ="" D DSPL Y4(2),AUTH MSG(1) | |
3293 | "RTN","DGO THEDT",242 ,0) | |
3294 | . . I DGA UTH'="",$P (DGRES,U,6 )="" D DSP LY4(2),AUT HMSG(2) | |
3295 | "RTN","DGO THEDT",243 ,0) | |
3296 | . . E D DSPLY5(DGR ES,I) | |
3297 | "RTN","DGO THEDT",244 ,0) | |
3298 | Q | |
3299 | "RTN","DGO THEDT",245 ,0) | |
3300 | ; | |
3301 | "RTN","DGO THEDT",246 ,0) | |
3302 | HELP1(CLCK NO) ; | |
3303 | "RTN","DGO THEDT",247 ,0) | |
3304 | ; | |
3305 | "RTN","DGO THEDT",248 ,0) | |
3306 | N I | |
3307 | "RTN","DGO THEDT",249 ,0) | |
3308 | I CLCKNO= 1 D | |
3309 | "RTN","DGO THEDT",250 ,0) | |
3310 | . W !!,"P eriod 1 st art date s hould be l ess than t he Period 1 end date " | |
3311 | "RTN","DGO THEDT",251 ,0) | |
3312 | . W !,"Pe riod 1 end date shou ld be less than the 2 Period s tart date" | |
3313 | "RTN","DGO THEDT",252 ,0) | |
3314 | . W !,"Pe riod 1 edi t allowed only if Pe riod 2 has not start ed" | |
3315 | "RTN","DGO THEDT",253 ,0) | |
3316 | . W !,"Pe riod 1 is read-only if period 2 is autho rized with a start d ate" | |
3317 | "RTN","DGO THEDT",254 ,0) | |
3318 | ; | |
3319 | "RTN","DGO THEDT",255 ,0) | |
3320 | I CLCKNO= 2 D | |
3321 | "RTN","DGO THEDT",256 ,0) | |
3322 | . W !!,"P eriod 2 st art date s hould be l ess than t he Period 2 end date " | |
3323 | "RTN","DGO THEDT",257 ,0) | |
3324 | . W !,"Au thorizatio n required to enter a start da te for per iod 2" | |
3325 | "RTN","DGO THEDT",258 ,0) | |
3326 | I CLCKNO= "" F I=1:1 :2 D HELP1 (I) I I=2 D HELP2(CL CKNO) | |
3327 | "RTN","DGO THEDT",259 ,0) | |
3328 | Q | |
3329 | "RTN","DGO THEDT",260 ,0) | |
3330 | ; | |
3331 | "RTN","DGO THEDT",261 ,0) | |
3332 | HELP2(CLCK NO) ; | |
3333 | "RTN","DGO THEDT",262 ,0) | |
3334 | ; | |
3335 | "RTN","DGO THEDT",263 ,0) | |
3336 | W !!,"OTH 90-Day Pe riod of ca re cannot overlap",! | |
3337 | "RTN","DGO THEDT",264 ,0) | |
3338 | W !,"No e dits allow ed if both periods 1 and 2 hav e zero day s remainin g" | |
3339 | "RTN","DGO THEDT",265 ,0) | |
3340 | W !,"No e dit allowe d if the d ate is inv alid - Exa mple June 31st" | |
3341 | "RTN","DGO THEDT",266 ,0) | |
3342 | I CLCKNO= 2 D | |
3343 | "RTN","DGO THEDT",267 ,0) | |
3344 | . W !!,"T he start d ate entere d for the 2nd 90-Day period mu st fall" | |
3345 | "RTN","DGO THEDT",268 ,0) | |
3346 | . W !,"wi thin the e arliest an d latest d ate range specified. ",! | |
3347 | "RTN","DGO THEDT",269 ,0) | |
3348 | Q | |
3349 | "RTN","DGO THEDT",270 ,0) | |
3350 | ; | |
3351 | "RTN","DGO THEDT",271 ,0) | |
3352 | AUTHMSG(MS GNO) ; | |
3353 | "RTN","DGO THEDT",272 ,0) | |
3354 | ; | |
3355 | "RTN","DGO THEDT",273 ,0) | |
3356 | I MSGNO=1 D | |
3357 | "RTN","DGO THEDT",274 ,0) | |
3358 | . W !," Autho rization R equired." | |
3359 | "RTN","DGO THEDT",275 ,0) | |
3360 | . W !," Patie nt is NOT eligible f or care at this time ." | |
3361 | "RTN","DGO THEDT",276 ,0) | |
3362 | . W !," If yo u wish to authorized the 2nd 9 0-Day peri od," | |
3363 | "RTN","DGO THEDT",277 ,0) | |
3364 | . W !," Go to option AU TH Autho rize the 2 nd 90 days period." | |
3365 | "RTN","DGO THEDT",278 ,0) | |
3366 | ; | |
3367 | "RTN","DGO THEDT",279 ,0) | |
3368 | I MSGNO=2 D | |
3369 | "RTN","DGO THEDT",280 ,0) | |
3370 | . W !!," This selection is not ed itable." | |
3371 | "RTN","DGO THEDT",281 ,0) | |
3372 | . W !," The 2nd 90-Day OTH perio d has been authorize d without a starting date." | |
3373 | "RTN","DGO THEDT",282 ,0) | |
3374 | . W !," Go t o option A ST2 Add start date 2nd 90 da ys" | |
3375 | "RTN","DGO THEDT",283 ,0) | |
3376 | Q | |
3377 | "RTN","DGO THEDT",284 ,0) | |
3378 | ; | |
3379 | "RTN","DGO THEDT",285 ,0) | |
3380 | HEADER(DFN ) ; | |
3381 | "RTN","DGO THEDT",286 ,0) | |
3382 | ; | |
3383 | "RTN","DGO THEDT",287 ,0) | |
3384 | N DDASH,D GNAME,DGDO B,VADM | |
3385 | "RTN","DGO THEDT",288 ,0) | |
3386 | D DEM^VAD PT ;get pa tient demo graphics | |
3387 | "RTN","DGO THEDT",289 ,0) | |
3388 | S DGNAME= VADM(1),DG DOB=$P(VAD M(3),U,2) | |
3389 | "RTN","DGO THEDT",290 ,0) | |
3390 | W ?19,"OT HER THAN H ONORABLE 9 0-DAY PERI OD EDIT" | |
3391 | "RTN","DGO THEDT",291 ,0) | |
3392 | W !,"Pati ent Name: ",DGNAME,? 60,"DOB: " ,DGDOB | |
3393 | "RTN","DGO THEDT",292 ,0) | |
3394 | S $P(DDAS H,"=",81)= "" W !,DDA SH ;write dash lines | |
3395 | "RTN","DGO THEDT",293 ,0) | |
3396 | W !!,"OTH ER THAN HO NORABLE ST ATUS:" | |
3397 | "RTN","DGO THEDT",294 ,0) | |
3398 | Q | |
3399 | "RTN","DGO THEDT",295 ,0) | |
3400 | ; | |
3401 | "RTN","DGO THEDT",296 ,0) | |
3402 | SETCLOCK(D FN,DGSTRDT ,DGIEN33,C LCKNO) ; | |
3403 | "RTN","DGO THEDT",297 ,0) | |
3404 | ; | |
3405 | "RTN","DGO THEDT",298 ,0) | |
3406 | N DGIEN90 ,DGIEN365 | |
3407 | "RTN","DGO THEDT",299 ,0) | |
3408 | ;create 3 65-day clo ck | |
3409 | "RTN","DGO THEDT",300 ,0) | |
3410 | I CLCKNO= 1 D I DGI EN365<0 Q DGIEN365 | |
3411 | "RTN","DGO THEDT",301 ,0) | |
3412 | . S DGIEN 365=$$CR36 5CLK^DGOTH D2(+DGIEN3 3,1,DGSTRD T) | |
3413 | "RTN","DGO THEDT",302 ,0) | |
3414 | I CLCKNO= 2 S DGIEN3 65=1 ;365 days subfi le has bee n created | |
3415 | "RTN","DGO THEDT",303 ,0) | |
3416 | ;create 9 0-day cloc k | |
3417 | "RTN","DGO THEDT",304 ,0) | |
3418 | S DGIEN90 =$$CR90CLK ^DGOTHD2(+ DGIEN33,+D GIEN365,1, DGSTRDT) | |
3419 | "RTN","DGO THEDT",305 ,0) | |
3420 | ;if error then retu rn error | |
3421 | "RTN","DGO THEDT",306 ,0) | |
3422 | I DGIEN90 <0 Q DGIEN 90 | |
3423 | "RTN","DGO THEDT",307 ,0) | |
3424 | Q 1 | |
3425 | "RTN","DGO THEDT",308 ,0) | |
3426 | ; | |
3427 | "RTN","DGO THEDT",309 ,0) | |
3428 | UPDTCLCK(C LCKNO,DGIE N33,DGLS36 5I,DGSTRDT ,DG90A) ; | |
3429 | "RTN","DGO THEDT",310 ,0) | |
3430 | ; | |
3431 | "RTN","DGO THEDT",311 ,0) | |
3432 | N FILENO, DGFDART,DG IENS,DGOTH ERR,DGOTH3 31,DGHSTIE N,DGFLG | |
3433 | "RTN","DGO THEDT",312 ,0) | |
3434 | S DGFLG=0 | |
3435 | "RTN","DGO THEDT",313 ,0) | |
3436 | I DGSTRDT >0 D | |
3437 | "RTN","DGO THEDT",314 ,0) | |
3438 | . I CLCKN O=1,DGSTRD T=$P(DGRES ,U,3) S DG FLG=1 | |
3439 | "RTN","DGO THEDT",315 ,0) | |
3440 | . I CLCKN O=2,DGSTRD T=$P(DGRES ,U,6) S DG FLG=1 | |
3441 | "RTN","DGO THEDT",316 ,0) | |
3442 | Q:DGFLG>0 | |
3443 | "RTN","DGO THEDT",317 ,0) | |
3444 | S FILENO= 33.11 | |
3445 | "RTN","DGO THEDT",318 ,0) | |
3446 | S DGOTH33 1=-1 | |
3447 | "RTN","DGO THEDT",319 ,0) | |
3448 | S DGIENS= DG90A(CLCK NO)_","_+D GLS365I_", "_+DGIEN33 _"," | |
3449 | "RTN","DGO THEDT",320 ,0) | |
3450 | S DGFDART ($J,FILENO ,DGIENS,.0 1)=CLCKNO | |
3451 | "RTN","DGO THEDT",321 ,0) | |
3452 | S DGFDART ($J,FILENO ,DGIENS,.0 2)=DGSTRDT | |
3453 | "RTN","DGO THEDT",322 ,0) | |
3454 | I CLCKNO= 2 D | |
3455 | "RTN","DGO THEDT",323 ,0) | |
3456 | . S DGFDA RT($J,FILE NO,DGIENS, .03)=$S($G (DUZ)>0:+D UZ,1:.5) | |
3457 | "RTN","DGO THEDT",324 ,0) | |
3458 | . S DGFDA RT($J,FILE NO,DGIENS, .04)=$$NOW ^XLFDT() | |
3459 | "RTN","DGO THEDT",325 ,0) | |
3460 | S DGFDART ($J,FILENO ,DGIENS,.0 5)=$S($G(D UZ)>0:+DUZ ,1:.5) | |
3461 | "RTN","DGO THEDT",326 ,0) | |
3462 | S DGFDART ($J,FILENO ,DGIENS,.0 6)=$$NOW^X LFDT() | |
3463 | "RTN","DGO THEDT",327 ,0) | |
3464 | D FILE^DI E("U","DGF DART($J)", "DGOTHERR" ) | |
3465 | "RTN","DGO THEDT",328 ,0) | |
3466 | I $D(DGOT HERR) W !! ,"An error occurred during fil ing the ne w start da te." Q | |
3467 | "RTN","DGO THEDT",329 ,0) | |
3468 | W !!,CLCK NO,$S(CLCK NO=1:"st", 1:"nd")," 90-Day OTH period st art date c hanged to: ",$$FMTE^ XLFDT(DGST RDT),!! | |
3469 | "RTN","DGO THEDT",330 ,0) | |
3470 | ;create n ew/update OTH patien t history record | |
3471 | "RTN","DGO THEDT",331 ,0) | |
3472 | S DGOTH33 1=$G(^DGOT H(33.1,0)) | |
3473 | "RTN","DGO THEDT",332 ,0) | |
3474 | Q:DGOTH33 1="" | |
3475 | "RTN","DGO THEDT",333 ,0) | |
3476 | S DGHSTIE N=+$O(^DGO TH(33.1,"B ",DGARR,0) ) | |
3477 | "RTN","DGO THEDT",334 ,0) | |
3478 | D INSNWRE C(DGHSTIEN ,DGARR,CLC KNO,DGRES, DGSTRDT,+D GLS365I) | |
3479 | "RTN","DGO THEDT",335 ,0) | |
3480 | Q | |
3481 | "RTN","DGO THEDT",336 ,0) | |
3482 | ; | |
3483 | "RTN","DGO THEDT",337 ,0) | |
3484 | INSNWREC(D GHSTIEN,DG ARR,CLCKNO ,DGRES,DGS TRDT,DGLS3 65I) ; | |
3485 | "RTN","DGO THEDT",338 ,0) | |
3486 | N DGVALS | |
3487 | "RTN","DGO THEDT",339 ,0) | |
3488 | ;create n ew OTH his tory recor d | |
3489 | "RTN","DGO THEDT",340 ,0) | |
3490 | I DGHSTIE N=0 D | |
3491 | "RTN","DGO THEDT",341 ,0) | |
3492 | . S DGVAL S(.01)=DGA RR | |
3493 | "RTN","DGO THEDT",342 ,0) | |
3494 | . D INSRE C^DGOTHD2( 33.1,"",.D GVALS) | |
3495 | "RTN","DGO THEDT",343 ,0) | |
3496 | . S DGHST IEN=+$O(^D GOTH(33.1, "B",DGARR, 0)) | |
3497 | "RTN","DGO THEDT",344 ,0) | |
3498 | N DGVALS | |
3499 | "RTN","DGO THEDT",345 ,0) | |
3500 | S DGVALS( .01)=DGLS3 65I | |
3501 | "RTN","DGO THEDT",346 ,0) | |
3502 | S DGVALS( .02)=CLCKN O | |
3503 | "RTN","DGO THEDT",347 ,0) | |
3504 | S DGVALS( .03)=1 ;'1 ' FOR STAR T DATE | |
3505 | "RTN","DGO THEDT",348 ,0) | |
3506 | I CLCKNO= 1 S DGVALS (.04)=$P(D GRES,U,3) | |
3507 | "RTN","DGO THEDT",349 ,0) | |
3508 | I CLCKNO= 2 S DGVALS (.04)=$P(D GRES,U,6) | |
3509 | "RTN","DGO THEDT",350 ,0) | |
3510 | Q:DGVALS( .04)=DGSTR DT | |
3511 | "RTN","DGO THEDT",351 ,0) | |
3512 | S DGVALS( .05)=DGSTR DT | |
3513 | "RTN","DGO THEDT",352 ,0) | |
3514 | S DGVALS( .06)=$S($G (DUZ)>0:+D UZ,1:.5) | |
3515 | "RTN","DGO THEDT",353 ,0) | |
3516 | S DGVALS( .07)=$$NOW ^XLFDT() | |
3517 | "RTN","DGO THEDT",354 ,0) | |
3518 | D INSREC^ DGOTHD2(33 .12,DGHSTI EN,.DGVALS ) | |
3519 | "RTN","DGO THEDT",355 ,0) | |
3520 | Q | |
3521 | "RTN","DGO THEDT",356 ,0) | |
3522 | ; | |
3523 | "RTN","DGO THEDT",357 ,0) | |
3524 | ASKSTDT(DG DFN,DGDFVL ,DGCLCKNO) ; | |
3525 | "RTN","DGO THEDT",358 ,0) | |
3526 | ; | |
3527 | "RTN","DGO THEDT",359 ,0) | |
3528 | N DGLOOP2 ,DGDTMIN,D GDTMAX,DGS TDT,DGDIR0 ,DGPRT | |
3529 | "RTN","DGO THEDT",360 ,0) | |
3530 | S DGLOOP2 =0,(DGSTDT ,DGPRT)=-1 | |
3531 | "RTN","DGO THEDT",361 ,0) | |
3532 | S (DGDTMI N,DGDTMAX) ="" | |
3533 | "RTN","DGO THEDT",362 ,0) | |
3534 | S DGDIR0= "DO^::EX" | |
3535 | "RTN","DGO THEDT",363 ,0) | |
3536 | I DGCLCKN O=2 D | |
3537 | "RTN","DGO THEDT",364 ,0) | |
3538 | . S DGDTM IN=$$FMADD ^XLFDT($P( DGRES,U,4) ,1) | |
3539 | "RTN","DGO THEDT",365 ,0) | |
3540 | . S DGDTM AX=$$GETST DT^DGOTHD( DGDTMIN,DG RES) | |
3541 | "RTN","DGO THEDT",366 ,0) | |
3542 | . I DGDFV L="" S DGD FVL=$$FMTE ^XLFDT(DGD TMIN) | |
3543 | "RTN","DGO THEDT",367 ,0) | |
3544 | . W !! D DTRANGE(DG DTMIN,DGDT MAX) | |
3545 | "RTN","DGO THEDT",368 ,0) | |
3546 | ; | |
3547 | "RTN","DGO THEDT",369 ,0) | |
3548 | W ! | |
3549 | "RTN","DGO THEDT",370 ,0) | |
3550 | F D Q:D GLOOP2=1 | |
3551 | "RTN","DGO THEDT",371 ,0) | |
3552 | . S DGSTD T=$$ASKDT^ DGOTHD2("E nter new s tart date for "_$S(D GCLCKNO=1: "1st",1:"2 nd")_" 90- Day OTH pe riod",DGDF VL,DGDIR0, DGCLCKNO) | |
3553 | "RTN","DGO THEDT",372 ,0) | |
3554 | . I DGSTD T="@" W !! ,"Could no t delete s tart date. ",!,"Delet ing the st art date w ill inacti vate the 9 0-Day OTH clock.",! Q | |
3555 | "RTN","DGO THEDT",373 ,0) | |
3556 | . I DGSTD T'>0 S DGL OOP2=1 Q | |
3557 | "RTN","DGO THEDT",374 ,0) | |
3558 | . I DGCLC KNO=1 D | |
3559 | "RTN","DGO THEDT",375 ,0) | |
3560 | . . I $P( DGRES,U,3) '="",$P(DG RES,U,6)'= "",$$FMADD ^XLFDT(DGS TDT,365)>D GDTMAX D Q | |
3561 | "RTN","DGO THEDT",376 ,0) | |
3562 | . . . W ! !,"Not a v alid date. ",!,"In or der to use the start date you entered," | |
3563 | "RTN","DGO THEDT",377 ,0) | |
3564 | . . . W ! ,"you must first edi t the 2nd 90-Day sta rt date.", !!,"The da te you ent ered overl ap the 2nd 90-Day Pe riod" | |
3565 | "RTN","DGO THEDT",378 ,0) | |
3566 | . . . W ! ,"This is not allowe d.",!! | |
3567 | "RTN","DGO THEDT",379 ,0) | |
3568 | . . ; | |
3569 | "RTN","DGO THEDT",380 ,0) | |
3570 | . . I $$F MDIFF^XLFD T(DT,DGSTD T)>90 W !! ,"Not a va lid date." ,!,"The da te you ent ered canno t be more than 90 da ys in the past.",! Q | |
3571 | "RTN","DGO THEDT",381 ,0) | |
3572 | . . ; | |
3573 | "RTN","DGO THEDT",382 ,0) | |
3574 | . . I DGS TDT>DT W ! !,"Not a v alid date. A future date canno t be enter ed.",! Q | |
3575 | "RTN","DGO THEDT",383 ,0) | |
3576 | . . S DGL OOP2=1 | |
3577 | "RTN","DGO THEDT",384 ,0) | |
3578 | . ; | |
3579 | "RTN","DGO THEDT",385 ,0) | |
3580 | . I DGCLC KNO=2 D | |
3581 | "RTN","DGO THEDT",386 ,0) | |
3582 | . . I DGS TDT<=$P(DG RES,U,4) D Q | |
3583 | "RTN","DGO THEDT",387 ,0) | |
3584 | . . . W ! !,"Not a v alid date. ",!,"The d ate you en tered fall s within t he 1st 90- Day Period .",!,"This is not al lowed.",! | |
3585 | "RTN","DGO THEDT",388 ,0) | |
3586 | . . . D D TRANGE(DGD TMIN,DGDTM AX) W ! | |
3587 | "RTN","DGO THEDT",389 ,0) | |
3588 | . . I DGS TDT>DGDTMA X W ! D HE LP1^DGOTHD 2 Q | |
3589 | "RTN","DGO THEDT",390 ,0) | |
3590 | . . S DGL OOP2=1 | |
3591 | "RTN","DGO THEDT",391 ,0) | |
3592 | Q DGSTDT | |
3593 | "RTN","DGO THEDT",392 ,0) | |
3594 | ; | |
3595 | "RTN","DGO THEDT",393 ,0) | |
3596 | DTRANGE(DG DTMIN,DGDT MAX) ; | |
3597 | "RTN","DGO THEDT",394 ,0) | |
3598 | W !,"Date Range: ", $$FMTE^XLF DT(DGDTMIN )," - ",$$ FMTE^XLFDT (DGDTMAX) | |
3599 | "RTN","DGO THEDT",395 ,0) | |
3600 | Q | |
3601 | "RTN","DGO THEDT",396 ,0) | |
3602 | ; | |
3603 | "RTN","DGO THINQ") | |
3604 | 0^14^B2237 9584 | |
3605 | "RTN","DGO THINQ",1,0 ) | |
3606 | DGOTHINQ ; SLC/RM - O THD (OTHER THAN HONO RABLE DISC HARGE) API s ;August 03,2018@13 :16 | |
3607 | "RTN","DGO THINQ",2,0 ) | |
3608 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
3609 | "RTN","DGO THINQ",3,0 ) | |
3610 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3611 | "RTN","DGO THINQ",4,0 ) | |
3612 | ; | |
3613 | "RTN","DGO THINQ",5,0 ) | |
3614 | ; Las t Edited: SHRPE/RM - August 03 ,2018 13:1 6 | |
3615 | "RTN","DGO THINQ",6,0 ) | |
3616 | ; | |
3617 | "RTN","DGO THINQ",7,0 ) | |
3618 | ; ICR# T YPE DESCRIPTIO N | |
3619 | "RTN","DGO THINQ",8,0 ) | |
3620 | ;----- - --- ---------- ---------- ---------- - | |
3621 | "RTN","DGO THINQ",9,0 ) | |
3622 | ; 2056 Sup GETS^DIQ,G ET1^DIQ | |
3623 | "RTN","DGO THINQ",10, 0) | |
3624 | ; 10103 Sup ^XLFDT: $$ FMTE, $$NO W, $$FMADD , $$FMDIFF | |
3625 | "RTN","DGO THINQ",11, 0) | |
3626 | ; 10061 Sup DEM^VADPT | |
3627 | "RTN","DGO THINQ",12, 0) | |
3628 | ; 10026 Sup ^DIR | |
3629 | "RTN","DGO THINQ",13, 0) | |
3630 | ; 6873 Cont Sub $$OTHDCLCK ^DGOTHD | |
3631 | "RTN","DGO THINQ",14, 0) | |
3632 | Q | |
3633 | "RTN","DGO THINQ",15, 0) | |
3634 | ; | |
3635 | "RTN","DGO THINQ",16, 0) | |
3636 | ;This opt ion will d isplay the Other Tha n Honorabl e | |
3637 | "RTN","DGO THINQ",17, 0) | |
3638 | ;Patient count down clock dem ographics | |
3639 | "RTN","DGO THINQ",18, 0) | |
3640 | ;Entry po int DG OTH PATIENT I NQ option | |
3641 | "RTN","DGO THINQ",19, 0) | |
3642 | ;B4S1 | |
3643 | "RTN","DGO THINQ",20, 0) | |
3644 | ; | |
3645 | "RTN","DGO THINQ",21, 0) | |
3646 | EN ; | |
3647 | "RTN","DGO THINQ",22, 0) | |
3648 | N DGLOOP | |
3649 | "RTN","DGO THINQ",23, 0) | |
3650 | S DGLOOP= 0 | |
3651 | "RTN","DGO THINQ",24, 0) | |
3652 | ; | |
3653 | "RTN","DGO THINQ",25, 0) | |
3654 | F D Q:D GLOOP=1 | |
3655 | "RTN","DGO THINQ",26, 0) | |
3656 | . N DGIEN 33,DFN,DGA RR,DG90A,D GPTST,DGPT NM,DGFLG,D GSTAT,DGRE S | |
3657 | "RTN","DGO THINQ",27, 0) | |
3658 | . N DGLS3 65D,DGLS36 5I | |
3659 | "RTN","DGO THINQ",28, 0) | |
3660 | . S (DGFL G,DGSTAT)= 0 | |
3661 | "RTN","DGO THINQ",29, 0) | |
3662 | . W ! | |
3663 | "RTN","DGO THINQ",30, 0) | |
3664 | . S DGPTN M=$$SELPAT ^DGOTHRI(. DGARR),DGI EN33=DGARR | |
3665 | "RTN","DGO THINQ",31, 0) | |
3666 | . I DGIEN 33<0 S DGL OOP=1 Q | |
3667 | "RTN","DGO THINQ",32, 0) | |
3668 | . S DFN=$ $GETPAT^DG OTHD2(DGIE N33) | |
3669 | "RTN","DGO THINQ",33, 0) | |
3670 | . W @IOF | |
3671 | "RTN","DGO THINQ",34, 0) | |
3672 | . ;D GETS ^DIQ(33,DG IEN33_",", ".01;.02;. 03;.06;.07 ;.08;.09;1 *","EI","D GARR","DGE RR") | |
3673 | "RTN","DGO THINQ",35, 0) | |
3674 | . D GETS^ DIQ(33,DGI EN33_","," .01;.02;.0 6;1*","EI" ,"DGARR"," DGERR") | |
3675 | "RTN","DGO THINQ",36, 0) | |
3676 | . S DGSTA T=$$STATUS ^DGOTHRI(. DGARR) | |
3677 | "RTN","DGO THINQ",37, 0) | |
3678 | . I '$$IS OTHD^DGOTH D(DFN) D Q | |
3679 | "RTN","DGO THINQ",38, 0) | |
3680 | . . D HEA DER(DFN,DG STAT) | |
3681 | "RTN","DGO THINQ",39, 0) | |
3682 | . . W !!, "Patient i s not elig ible for O TH.",! | |
3683 | "RTN","DGO THINQ",40, 0) | |
3684 | . D CLOCK ^DGOTHRP2( DGIEN33) | |
3685 | "RTN","DGO THINQ",41, 0) | |
3686 | . I ('$D( DG90A))!(' $D(DG90A(1 ))) D Q | |
3687 | "RTN","DGO THINQ",42, 0) | |
3688 | . . D HEA DER(DFN,DG STAT) | |
3689 | "RTN","DGO THINQ",43, 0) | |
3690 | . . W !!, "The patie nt's 1st 9 0-Day peri od has not started." ,! | |
3691 | "RTN","DGO THINQ",44, 0) | |
3692 | . . W !," Please go to 'Edit 9 0-Day Star t Date' op tion,",!," if you wis h to start the 1st 9 0-Day peri od.",!! | |
3693 | "RTN","DGO THINQ",45, 0) | |
3694 | . S DGRES =$$RESULT^ DGOTHRP3(. DGARR,.DG9 0A,DGIEN33 ) | |
3695 | "RTN","DGO THINQ",46, 0) | |
3696 | . I DGRES <0 D Q | |
3697 | "RTN","DGO THINQ",47, 0) | |
3698 | . . W !!, "Error"_$S ($L($P(DGR ES,U,2))>0 :": "_$P(D GRES,U,2), 1:""),!,"P lease sele ct another patient." ,! | |
3699 | "RTN","DGO THINQ",48, 0) | |
3700 | . I $D(DG 90A(1)),'$ D(DG90A(2) ) D Q | |
3701 | "RTN","DGO THINQ",49, 0) | |
3702 | . . D HEA DER(DFN,DG STAT) W !! | |
3703 | "RTN","DGO THINQ",50, 0) | |
3704 | . . D DSP LY4^DGOTHE DT(1),DSPL Y5^DGOTHED T(DGRES,1) | |
3705 | "RTN","DGO THINQ",51, 0) | |
3706 | . . I 23[ DGSTAT D M SG(DGSTAT, .DGARR,DGI EN33) Q | |
3707 | "RTN","DGO THINQ",52, 0) | |
3708 | . . I $P( DGRES,U,3) <1 D | |
3709 | "RTN","DGO THINQ",53, 0) | |
3710 | . . . W ! !," >> 1st 90-Da y Period o f care has been auth orized wit hout a sta rting date .",! | |
3711 | "RTN","DGO THINQ",54, 0) | |
3712 | . I $D(DG 90A(1)),$D (DG90A(2)) D | |
3713 | "RTN","DGO THINQ",55, 0) | |
3714 | . . ;I $P (DGRES,U,3 )'="",$P(D GRES,U,5)= 0,$P(DGRES ,U,6)'="", $P(DGRES,U ,8)=0 D Q ;both pe riod expir ed | |
3715 | "RTN","DGO THINQ",56, 0) | |
3716 | . . I $P( DGRES,U,$L (DGRES,U)) =0 D Q ; last perio d expired | |
3717 | "RTN","DGO THINQ",57, 0) | |
3718 | . . . D H EADER(DFN, DGSTAT) W !! | |
3719 | "RTN","DGO THINQ",58, 0) | |
3720 | . . . D P RNTD(DGRES ) | |
3721 | "RTN","DGO THINQ",59, 0) | |
3722 | . . . S D GFLG=1 | |
3723 | "RTN","DGO THINQ",60, 0) | |
3724 | . . . I 2 3[DGSTAT D MSG(DGSTA T,.DGARR,D GIEN33) Q | |
3725 | "RTN","DGO THINQ",61, 0) | |
3726 | . . . ;W !!,"Not ed itable. Bo th 1st and 2nd 90-Da y OTH cloc k expired. " | |
3727 | "RTN","DGO THINQ",62, 0) | |
3728 | . . . W ! !,"Not edi table. the last 90-D ay OTH clo ck expired ." | |
3729 | "RTN","DGO THINQ",63, 0) | |
3730 | . . I $P( DGRES,U,6) ="",$P(DGR ES,U,9)'=" " D Q | |
3731 | "RTN","DGO THINQ",64, 0) | |
3732 | . . . D H EADER(DFN, DGSTAT) W !! | |
3733 | "RTN","DGO THINQ",65, 0) | |
3734 | . . . D P RNTD(DGRES ) | |
3735 | "RTN","DGO THINQ",66, 0) | |
3736 | . . . S D GFLG=1 | |
3737 | "RTN","DGO THINQ",67, 0) | |
3738 | . . . I 2 3[DGSTAT D MSG(DGSTA T,.DGARR,D GIEN33) Q | |
3739 | "RTN","DGO THINQ",68, 0) | |
3740 | . . . I $ P(DGRES,U, 9)'="" D | |
3741 | "RTN","DGO THINQ",69, 0) | |
3742 | . . . . W !! D DSPL Y4^DGOTHED T(2),DSPLY 5^DGOTHEDT (DGRES,2) | |
3743 | "RTN","DGO THINQ",70, 0) | |
3744 | . . . . W !!," > > 2nd 90-D ay Period of care ha s been aut horized wi thout a st arting dat e.",! | |
3745 | "RTN","DGO THINQ",71, 0) | |
3746 | . . . . W !," Please go to 'Add s tart date 2nd 90 day s' option" ,!," if you wi sh to add the 2nd 90 -Day perio d start da te.",! | |
3747 | "RTN","DGO THINQ",72, 0) | |
3748 | . Q:DGFLG | |
3749 | "RTN","DGO THINQ",73, 0) | |
3750 | . D HEADE R(DFN,DGST AT) W !! | |
3751 | "RTN","DGO THINQ",74, 0) | |
3752 | . D PRNTD (DGRES) | |
3753 | "RTN","DGO THINQ",75, 0) | |
3754 | . I 23[DG STAT D MSG (DGSTAT,.D GARR,DGIEN 33) | |
3755 | "RTN","DGO THINQ",76, 0) | |
3756 | Q | |
3757 | "RTN","DGO THINQ",77, 0) | |
3758 | ; | |
3759 | "RTN","DGO THINQ",78, 0) | |
3760 | PRNTD(DGRE S) ;print OTH patien t count do wn clock d emographic s | |
3761 | "RTN","DGO THINQ",79, 0) | |
3762 | N I,DGCLC K | |
3763 | "RTN","DGO THINQ",80, 0) | |
3764 | S DGCLCK= +$O(DG90A( 9),-1) | |
3765 | "RTN","DGO THINQ",81, 0) | |
3766 | F I=1:1:D GCLCK D | |
3767 | "RTN","DGO THINQ",82, 0) | |
3768 | . D DSPLY 4^DGOTHEDT (I),DSPLY5 ^DGOTHEDT( DGRES,I) | |
3769 | "RTN","DGO THINQ",83, 0) | |
3770 | Q | |
3771 | "RTN","DGO THINQ",84, 0) | |
3772 | ; | |
3773 | "RTN","DGO THINQ",85, 0) | |
3774 | MSG(DGSTAT ,DGARR,DGI EN33) ;dis play inact ivation/ad judication message | |
3775 | "RTN","DGO THINQ",86, 0) | |
3776 | N DGRSN,D GLSDT,DGRS NIN | |
3777 | "RTN","DGO THINQ",87, 0) | |
3778 | W ! | |
3779 | "RTN","DGO THINQ",88, 0) | |
3780 | ;S DGRSN= DGARR(33,D GIEN33_"," ,.09,"E") ; (no lo nger avail able) | |
3781 | "RTN","DGO THINQ",89, 0) | |
3782 | S DGLSDT= $O(^DGOTH( 33,3,2,"B" ,"A"),-1), DGRSNIN=$O (^DGOTH(33 ,3,2,"B",D GLSDT,999) ,-1) | |
3783 | "RTN","DGO THINQ",90, 0) | |
3784 | S DGRSN=$ $GET1^DIQ( 33.02,DGRS NIN_","_DG IEN33_",", ".04") | |
3785 | "RTN","DGO THINQ",91, 0) | |
3786 | I DGRSN=" " S DGRSN= "Not Provi ded" | |
3787 | "RTN","DGO THINQ",92, 0) | |
3788 | I 2[DGSTA T W !," A djudicatio n Date: ", $$FMTE^XLF DT(DGARR(3 3,DGIEN33_ ",",.06,"I ")) | |
3789 | "RTN","DGO THINQ",93, 0) | |
3790 | I 3[DGSTA T W !," *** INA CTIVE *** " ;,$$F MTE^XLFDT( DGARR(33,D GIEN33_"," ,.08,"I")) (We nolon ger have t his data f ield) | |
3791 | "RTN","DGO THINQ",94, 0) | |
3792 | W ?45,"Re ason: ",DG RSN ;$E(D GRSN,1,55) ,!,?21,$E( DGRSN,56,$ L(DGRSN)) | |
3793 | "RTN","DGO THINQ",95, 0) | |
3794 | Q | |
3795 | "RTN","DGO THINQ",96, 0) | |
3796 | ; | |
3797 | "RTN","DGO THINQ",97, 0) | |
3798 | HEADER(DFN ,DGSTAT) ; | |
3799 | "RTN","DGO THINQ",98, 0) | |
3800 | ; | |
3801 | "RTN","DGO THINQ",99, 0) | |
3802 | N DDASH,D GNAME,DGDO B,VADM,DGS SN | |
3803 | "RTN","DGO THINQ",100 ,0) | |
3804 | D DEM^VAD PT ;get pa tient demo graphics | |
3805 | "RTN","DGO THINQ",101 ,0) | |
3806 | S DGNAME= VADM(1),DG DOB=$P(VAD M(3),U,2), DGSSN=$P($ P(VADM(2), U,2),"-",3 ) | |
3807 | "RTN","DGO THINQ",102 ,0) | |
3808 | W ?19,"OT HER THAN H ONORABLE P ATIENT INQ UIRY" | |
3809 | "RTN","DGO THINQ",103 ,0) | |
3810 | W !,"Pati ent Name: ",DGNAME,? 45,"DOB: " ,DGDOB,?68 ,"PID: ",D GSSN | |
3811 | "RTN","DGO THINQ",104 ,0) | |
3812 | S $P(DDAS H,"=",81)= "" W !,DDA SH ;write dash lines | |
3813 | "RTN","DGO THINQ",105 ,0) | |
3814 | I ('$D(DG 90A))!('$D (DG90A(1)) ) Q | |
3815 | "RTN","DGO THINQ",106 ,0) | |
3816 | W "OTHER THAN HONOR ABLE STATU S: **",$S( DGSTAT=1:" ACTIVE/NO T ADJUDICA TED",DGSTA T=2:" ADJU DICATED",D GSTAT=3:" INACTIVE", 1:"")," ** " | |
3817 | "RTN","DGO THINQ",107 ,0) | |
3818 | Q | |
3819 | "RTN","DGO THINQ",108 ,0) | |
3820 | ; | |
3821 | "RTN","DGO THRI") | |
3822 | 0^12^B2372 68923 | |
3823 | "RTN","DGO THRI",1,0) | |
3824 | DGOTHRI ;S LC/RM - OT HD (OTHER THAN HONOR ABLE DISCH ARGE) APIs ;April 27 ,2018@21:0 8 | |
3825 | "RTN","DGO THRI",2,0) | |
3826 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
3827 | "RTN","DGO THRI",3,0) | |
3828 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3829 | "RTN","DGO THRI",4,0) | |
3830 | ; | |
3831 | "RTN","DGO THRI",5,0) | |
3832 | ; Las t Edited: SHRPE/RM - July 05, 2018 15:50 | |
3833 | "RTN","DGO THRI",6,0) | |
3834 | ; | |
3835 | "RTN","DGO THRI",7,0) | |
3836 | ; ICR# T YPE DESCR IPTION | |
3837 | "RTN","DGO THRI",8,0) | |
3838 | ;----- - --- ----- ---------- ---------- ------ | |
3839 | "RTN","DGO THRI",9,0) | |
3840 | ; 10006 Sup ^DIC | |
3841 | "RTN","DGO THRI",10,0 ) | |
3842 | ; 10103 Sup ^XLFD T:$$FMTE, $$NOW | |
3843 | "RTN","DGO THRI",11,0 ) | |
3844 | ; 10026 Sup ^DIR | |
3845 | "RTN","DGO THRI",12,0 ) | |
3846 | ; 10015 Sup GETS^ DIQ | |
3847 | "RTN","DGO THRI",13,0 ) | |
3848 | ; 10061 Sup ^VADP T: 4 , KVA R, KVA | |
3849 | "RTN","DGO THRI",14,0 ) | |
3850 | ; 2053 Sup ^DIE: FILE, UPDA TE | |
3851 | "RTN","DGO THRI",15,0 ) | |
3852 | Q | |
3853 | "RTN","DGO THRI",16,0 ) | |
3854 | ; | |
3855 | "RTN","DGO THRI",17,0 ) | |
3856 | EN ;entry for DG OTH STOP/REAC TIVATE CLO CK patient count dow n clock | |
3857 | "RTN","DGO THRI",18,0 ) | |
3858 | ; | |
3859 | "RTN","DGO THRI",19,0 ) | |
3860 | N DGFIRST ;first OT H patient DFN | |
3861 | "RTN","DGO THRI",20,0 ) | |
3862 | N DGERR ;error me ssage arra y | |
3863 | "RTN","DGO THRI",21,0 ) | |
3864 | N DGARR ;array fo r file 33 data | |
3865 | "RTN","DGO THRI",22,0 ) | |
3866 | N DGSORT ;array or report pa rameters | |
3867 | "RTN","DGO THRI",23,0 ) | |
3868 | N DGSEL ;help tex t var | |
3869 | "RTN","DGO THRI",24,0 ) | |
3870 | N DGLIST ;temp glo bal name u sed for OT H-90 repor t | |
3871 | "RTN","DGO THRI",25,0 ) | |
3872 | N DGLOOP | |
3873 | "RTN","DGO THRI",26,0 ) | |
3874 | N DGLN | |
3875 | "RTN","DGO THRI",27,0 ) | |
3876 | ; | |
3877 | "RTN","DGO THRI",28,0 ) | |
3878 | ;check fo r EMERGENT OTH KEY | |
3879 | "RTN","DGO THRI",29,0 ) | |
3880 | I '$D(^XU SEC("DG OT H EDIT",DU Z)) D Q | |
3881 | "RTN","DGO THRI",30,0 ) | |
3882 | . W !?2," >>> Emerge nt OTH Key is requir ed for you to INACTI VATE or RE ACTIVATE t he clock." ,*7 | |
3883 | "RTN","DGO THRI",31,0 ) | |
3884 | . I $$ANS WER^DGOTHR PT("Enter RETURN to continue", "","E") | |
3885 | "RTN","DGO THRI",32,0 ) | |
3886 | ; | |
3887 | "RTN","DGO THRI",33,0 ) | |
3888 | ;check fo r database | |
3889 | "RTN","DGO THRI",34,0 ) | |
3890 | S DGFIRST =$P(+$O(^D GOTH(33,"B ","")),"," ) ;first O TH DFN | |
3891 | "RTN","DGO THRI",35,0 ) | |
3892 | I 'DGFIRS T D Q | |
3893 | "RTN","DGO THRI",36,0 ) | |
3894 | . W !?2," >>> No 'Ot her Than H onorable' Patient Re cord have been found .",*7 | |
3895 | "RTN","DGO THRI",37,0 ) | |
3896 | . I $$ANS WER^DGOTHR PT("Enter RETURN to continue", "","E") | |
3897 | "RTN","DGO THRI",38,0 ) | |
3898 | W @IOF | |
3899 | "RTN","DGO THRI",39,0 ) | |
3900 | D HDR1 | |
3901 | "RTN","DGO THRI",40,0 ) | |
3902 | S DGLOOP= 0 | |
3903 | "RTN","DGO THRI",41,0 ) | |
3904 | S DGLIST= $NA(^TMP(" OTH90",$J) ) | |
3905 | "RTN","DGO THRI",42,0 ) | |
3906 | K @DGLIST | |
3907 | "RTN","DGO THRI",43,0 ) | |
3908 | ;keep ask ing until empty inpu t | |
3909 | "RTN","DGO THRI",44,0 ) | |
3910 | F D Q:D GLOOP=1 | |
3911 | "RTN","DGO THRI",45,0 ) | |
3912 | . N DGIEN 33,DFN,DGA RR,DGPTNM, DGADJYN,DG LOOP2,DGLS 365D,DGERR ,DGASK,DGP TST | |
3913 | "RTN","DGO THRI",46,0 ) | |
3914 | . N DGLS3 65I,DGRAIN ,DGADJDT,D GRES,DGCLC K,DGDFN,DG OTHPT,DGVB A,DG90A,DG RET | |
3915 | "RTN","DGO THRI",47,0 ) | |
3916 | . S DGLN= 1 | |
3917 | "RTN","DGO THRI",48,0 ) | |
3918 | . W ! | |
3919 | "RTN","DGO THRI",49,0 ) | |
3920 | . S (DGAD JYN,DGADJD T,DGRAIN,D GPTST,DGOT HPT,DGVBA, DGLS365D,D GLS365I)=0 | |
3921 | "RTN","DGO THRI",50,0 ) | |
3922 | . S DGPTN M=$$SELPAT (.DGARR),D GIEN33=DGA RR | |
3923 | "RTN","DGO THRI",51,0 ) | |
3924 | . I DGIEN 33<0 S DGL OOP=1 Q | |
3925 | "RTN","DGO THRI",52,0 ) | |
3926 | . D CLOCK ^DGOTHRP2( DGIEN33) | |
3927 | "RTN","DGO THRI",53,0 ) | |
3928 | . I ('$D( DG90A))!(' $D(DG90A(1 ))) D Q | |
3929 | "RTN","DGO THRI",54,0 ) | |
3930 | . . W !!, " The pat ients 1st 90-Day per iod has no t started. ",!! | |
3931 | "RTN","DGO THRI",55,0 ) | |
3932 | . ;check the curren t status o f the OTH patient | |
3933 | "RTN","DGO THRI",56,0 ) | |
3934 | . I DGLS3 65D'>0 D Q | |
3935 | "RTN","DGO THRI",57,0 ) | |
3936 | . . W !!, " No 365 days clock started f or the sel ected pati ent" | |
3937 | "RTN","DGO THRI",58,0 ) | |
3938 | . . W !!, " Please select ano ther patie nt." | |
3939 | "RTN","DGO THRI",59,0 ) | |
3940 | . S DGDFN =+DGARR(0) | |
3941 | "RTN","DGO THRI",60,0 ) | |
3942 | . D GETS^ DIQ(33,DGI EN33_","," .01;.02;.0 3;.04;.05; .06;1*","E I","DGARR" ,"DGERR") | |
3943 | "RTN","DGO THRI",61,0 ) | |
3944 | . ;get th e OTH cloc k for the patient | |
3945 | "RTN","DGO THRI",62,0 ) | |
3946 | . D RESUL T^DGOTHRP3 (.DGARR,.D G90A,DGIEN 33) | |
3947 | "RTN","DGO THRI",63,0 ) | |
3948 | . S DGPTS T=$$STATUS (.DGARR) ; OTH patien t clock st atus | |
3949 | "RTN","DGO THRI",64,0 ) | |
3950 | . ;displa y patient demographi cs | |
3951 | "RTN","DGO THRI",65,0 ) | |
3952 | . S DGOTH PT=$$DEMOG (DGDFN,.DG RET,.DGARR ,DGPTST) | |
3953 | "RTN","DGO THRI",66,0 ) | |
3954 | . I DGOTH PT<1 K @DG LIST Q | |
3955 | "RTN","DGO THRI",67,0 ) | |
3956 | . ; RE-AC TIVATE OTH Patient | |
3957 | "RTN","DGO THRI",68,0 ) | |
3958 | . S DGRSN ="Not Prov ided" | |
3959 | "RTN","DGO THRI",69,0 ) | |
3960 | . I 23[DG PTST D K @DGLIST Q | |
3961 | "RTN","DGO THRI",70,0 ) | |
3962 | . . W ! | |
3963 | "RTN","DGO THRI",71,0 ) | |
3964 | . . S DGA SK="Do you "_$S(DGPTS T=2:" stil l ",1:" ") _"want to RE-ACTIVAT E this pat ient (Y/N) " | |
3965 | "RTN","DGO THRI",72,0 ) | |
3966 | . . S DGR AIN=$$ANSW ER^DGOTHRP T(DGASK,"" ,"YO","^D HELP^DGOTH RI(4)") | |
3967 | "RTN","DGO THRI",73,0 ) | |
3968 | . . I $G( DGRAIN)<1 W !!,"<No action tak en.>" Q | |
3969 | "RTN","DGO THRI",74,0 ) | |
3970 | . . I DGR AIN>0 D | |
3971 | "RTN","DGO THRI",75,0 ) | |
3972 | . . . S D GLOOP2=0 | |
3973 | "RTN","DGO THRI",76,0 ) | |
3974 | . . . F D Q:DGLOO P2=1 | |
3975 | "RTN","DGO THRI",77,0 ) | |
3976 | . . . . W ! S DGRSN =$$ASKRSN( 1) | |
3977 | "RTN","DGO THRI",78,0 ) | |
3978 | . . . . I DGRSN=-1 S DGLOOP2= 1 Q | |
3979 | "RTN","DGO THRI",79,0 ) | |
3980 | . . . . S DGLOOP2=1 | |
3981 | "RTN","DGO THRI",80,0 ) | |
3982 | . . . I D GRSN=-1 W !!," Reac tivation f ailed: Rea ctivation reason mis sing.",!!, "<No actio n taken.>" Q | |
3983 | "RTN","DGO THRI",81,0 ) | |
3984 | . . . D S TRE(DGIEN3 3,DGADJDT, .DGARR,DGL S365I,DGCL CK,1,DGRSN ,"",DGPTST ) ;1 to re activate, otherwise 0 | |
3985 | "RTN","DGO THRI",82,0 ) | |
3986 | . . . W ! !!," The Other Than Honorable countdown clock for patient " ,DGPTNM,!, " has bee n "_$S(DGP TST=2:"RES TORED",1:" RE-ACTIVAT ED")_".",! | |
3987 | "RTN","DGO THRI",83,0 ) | |
3988 | . ; | |
3989 | "RTN","DGO THRI",84,0 ) | |
3990 | . ;VBA AD JUDICATION STATUS | |
3991 | "RTN","DGO THRI",85,0 ) | |
3992 | . I DGPTS T=1 D | |
3993 | "RTN","DGO THRI",86,0 ) | |
3994 | . . W ! | |
3995 | "RTN","DGO THRI",87,0 ) | |
3996 | . . S DGA DJYN=$$ANS WER^DGOTHR PT("Did yo u receive Adjudicati on Status notice for this pati ent (Y/N)" ,"","YO"," ^D HELP^DG OTHRI(2)") | |
3997 | "RTN","DGO THRI",88,0 ) | |
3998 | . . I DGA DJYN>0 D | |
3999 | "RTN","DGO THRI",89,0 ) | |
4000 | . . . ;pr ompt the s ource of t he VBA adj udication informatio n | |
4001 | "RTN","DGO THRI",90,0 ) | |
4002 | . . . ;1 - VBA Adju dication l etter/emai l received by Regist ration sta ff | |
4003 | "RTN","DGO THRI",91,0 ) | |
4004 | . . . ;2 - VBA lett er receive d by the P atient | |
4005 | "RTN","DGO THRI",92,0 ) | |
4006 | . . . ;3 - Other | |
4007 | "RTN","DGO THRI",93,0 ) | |
4008 | . . . S D GVBA=$$VBA SRCE | |
4009 | "RTN","DGO THRI",94,0 ) | |
4010 | . . . I D GVBA<1 W ! !,"<No act ion taken. >" Q | |
4011 | "RTN","DGO THRI",95,0 ) | |
4012 | . . . I D GVBA>0 D | |
4013 | "RTN","DGO THRI",96,0 ) | |
4014 | . . . . S DGVBA=$P( DGSORT("DG VBAS"),U) | |
4015 | "RTN","DGO THRI",97,0 ) | |
4016 | . . . . W ! | |
4017 | "RTN","DGO THRI",98,0 ) | |
4018 | . . . . I 12[DGVBA S DGRSN=$$ ASKRSN(2) | |
4019 | "RTN","DGO THRI",99,0 ) | |
4020 | . . . . E S DGRSN= $$ASKRSN(3 ) | |
4021 | "RTN","DGO THRI",100, 0) | |
4022 | . . . . I DGRSN=-1 W !!,"<No action tak en.>" Q | |
4023 | "RTN","DGO THRI",101, 0) | |
4024 | . . . . I (DGRSN=" "!(DGRSN=" ")),DGVBA> 0 S DGRSN= $P(DGSORT( "DGVBAS"), U,2) | |
4025 | "RTN","DGO THRI",102, 0) | |
4026 | . . . . S DGLOOP2=0 | |
4027 | "RTN","DGO THRI",103, 0) | |
4028 | . . . . F D Q:DGL OOP2=1 | |
4029 | "RTN","DGO THRI",104, 0) | |
4030 | . . . . . W ! | |
4031 | "RTN","DGO THRI",105, 0) | |
4032 | . . . . . S DGADJDT =$$ANSWER^ DGOTHRPT(" Enter Adju dication D ate for th is patient ","T","D^: :EX","^D H ELP^DGOTHR I(3)") | |
4033 | "RTN","DGO THRI",106, 0) | |
4034 | . . . . . I DGADJDT <0 S DGLOO P2=1 W !!, " <No act ion taken. >" Q | |
4035 | "RTN","DGO THRI",107, 0) | |
4036 | . . . . . I DGADJDT >DT W !!," A future date cann ot be ente red.",! Q | |
4037 | "RTN","DGO THRI",108, 0) | |
4038 | . . . . . ; adjudic ation date should no t go beyon d the OTH Patient st art date | |
4039 | "RTN","DGO THRI",109, 0) | |
4040 | . . . . . I DGADJDT <$P(DGRES, U,3) W ! S X="" D HE LP^DGOTHRI (3) Q | |
4041 | "RTN","DGO THRI",110, 0) | |
4042 | . . . . . I DGADJDT >0 D | |
4043 | "RTN","DGO THRI",111, 0) | |
4044 | . . . . . . D STRE( DGIEN33,DG ADJDT,.DGA RR,DGLS365 I,DGCLCK,0 ,DGRSN,DGV BA,DGPTST) | |
4045 | "RTN","DGO THRI",112, 0) | |
4046 | . . . . . . S DGLN= DGLN+1,@DG LIST@(DGLN ,0)=" " | |
4047 | "RTN","DGO THRI",113, 0) | |
4048 | . . . . . . S DGLN= DGLN+1,@DG LIST@(DGLN ,0)=" Adj udication complete f or patient "_DGPTNM | |
4049 | "RTN","DGO THRI",114, 0) | |
4050 | . . . . . . W !! D WRITE | |
4051 | "RTN","DGO THRI",115, 0) | |
4052 | . . . . . . S DGLN= DGLN+1,@DG LIST@(DGLN ,0)=" " | |
4053 | "RTN","DGO THRI",116, 0) | |
4054 | . . . . . . S DGLN= DGLN+1,@DG LIST@(DGLN ,0)=" The Other Tha n Honorabl e countdow n clock ha s been INA CTIVATED." | |
4055 | "RTN","DGO THRI",117, 0) | |
4056 | . . . . . . W ! D W RITE | |
4057 | "RTN","DGO THRI",118, 0) | |
4058 | . . . . . . S DGLN= DGLN+1,@DG LIST@(DGLN ,0)=" " | |
4059 | "RTN","DGO THRI",119, 0) | |
4060 | . . . . . . W ! D I NACTMS2,SN DMAIL | |
4061 | "RTN","DGO THRI",120, 0) | |
4062 | . . . . . . S DGLN= DGLN+1,@DG LIST@(DGLN ,0)=" " | |
4063 | "RTN","DGO THRI",121, 0) | |
4064 | . . . . . S DGLOOP2 =1 | |
4065 | "RTN","DGO THRI",122, 0) | |
4066 | . . . . . W ! | |
4067 | "RTN","DGO THRI",123, 0) | |
4068 | . ; | |
4069 | "RTN","DGO THRI",124, 0) | |
4070 | . I DGADJ YN=-1!(DGA DJYN="") K @DGLIST Q | |
4071 | "RTN","DGO THRI",125, 0) | |
4072 | . ; INACT IVATE OTH Patient | |
4073 | "RTN","DGO THRI",126, 0) | |
4074 | . I 'DGAD JYN,'DGADJ DT D ;use r did not received a ny Adjudic ation stat us notice for the pa tient | |
4075 | "RTN","DGO THRI",127, 0) | |
4076 | . . W ! | |
4077 | "RTN","DGO THRI",128, 0) | |
4078 | . . S DGR AIN=$$ANSW ER^DGOTHRP T("Do you want to IN ACTIVATE t his patien t (Y/N)"," ","YO","^D HELP^DGOT HRI(4)") | |
4079 | "RTN","DGO THRI",129, 0) | |
4080 | . . I DGR AIN>0 D | |
4081 | "RTN","DGO THRI",130, 0) | |
4082 | . . . W ! S DGRSN=$ $ANSWER^DG OTHRPT("Pl ease provi de reason for INACTI VATION (Op tional)"," ","FO^1:60 ","^D HELP ^DGOTHRI(5 )") | |
4083 | "RTN","DGO THRI",131, 0) | |
4084 | . . . Q:D GRSN=-1 | |
4085 | "RTN","DGO THRI",132, 0) | |
4086 | . . . I D GRSN<1,DGV BA>0 S DGR SN=$P(DGSO RT("DGVBAS "),U,2) | |
4087 | "RTN","DGO THRI",133, 0) | |
4088 | . . . D S TRE(DGIEN3 3,DGADJDT, .DGARR,DGL S365I,DGCL CK,0,DGRSN ,DGVBA,DGP TST) ;0 to inactivat e | |
4089 | "RTN","DGO THRI",134, 0) | |
4090 | . . . W ! D INACTMS 1(DGPTNM) W ".",!! D INACTMS2 | |
4091 | "RTN","DGO THRI",135, 0) | |
4092 | . . . ;se nd a copy of the pat ient to th e user reg arding the inactivat ion via em ail | |
4093 | "RTN","DGO THRI",136, 0) | |
4094 | . . . D S NDMAIL | |
4095 | "RTN","DGO THRI",137, 0) | |
4096 | . K @DGLI ST | |
4097 | "RTN","DGO THRI",138, 0) | |
4098 | Q | |
4099 | "RTN","DGO THRI",139, 0) | |
4100 | ; | |
4101 | "RTN","DGO THRI",140, 0) | |
4102 | VBASRCE() ;prompt th e source o f the VBA adjudicati on informa tion | |
4103 | "RTN","DGO THRI",141, 0) | |
4104 | ; | |
4105 | "RTN","DGO THRI",142, 0) | |
4106 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO,DGF YQ | |
4107 | "RTN","DGO THRI",143, 0) | |
4108 | S DGDIRA= "Select th e source o f the VBA Adjudicati on" | |
4109 | "RTN","DGO THRI",144, 0) | |
4110 | S DGDIRB= "" | |
4111 | "RTN","DGO THRI",145, 0) | |
4112 | S DGDIRH= "Enter the source of the VBA A djudicatio n" | |
4113 | "RTN","DGO THRI",146, 0) | |
4114 | S DGDIRO= "SO^1:VBA Adjudicati on letter/ email rece ived by Re gistration staff;2:V BA Adjudic ation lett er receive d by the p atient;3:O ther" | |
4115 | "RTN","DGO THRI",147, 0) | |
4116 | S DGASK=$ $ANSWER^DG OTHRPT(DGD IRA,DGDIRB ,DGDIRO,DG DIRH) | |
4117 | "RTN","DGO THRI",148, 0) | |
4118 | I DGASK>0 S DGSORT( "DGVBAS")= DGASK_U_$S (DGASK=1:" VBA Adjudi cation let ter/email received b y Registra tion staff ",DGASK=2: "VBA Adjud ication le tter recei ved by the patient", DGASK=3:"O THER",1:"" ) | |
4119 | "RTN","DGO THRI",149, 0) | |
4120 | Q DGASK>0 | |
4121 | "RTN","DGO THRI",150, 0) | |
4122 | ; | |
4123 | "RTN","DGO THRI",151, 0) | |
4124 | ASKRSN(RSN NUM) ;prom pt user to provide r eason for reactivati on/inactiv ation | |
4125 | "RTN","DGO THRI",152, 0) | |
4126 | I RSNNUM= 1 S DGRSN= $$ANSWER^D GOTHRPT("P lease prov ide reason for REACT IVATION (R equired)", "","F^1:60 ^K:X="" "" !(X="""")! (X?1E) X", "^D HELP^D GOTHRI(5)" ) | |
4127 | "RTN","DGO THRI",153, 0) | |
4128 | I RSNNUM= 2 S DGRSN= $$ANSWER^D GOTHRPT("P lease prov ide Adjudi cation Det ails (Opti onal)","", "FO^1:60", "^D HELP^D GOTHRI(5)" ) | |
4129 | "RTN","DGO THRI",154, 0) | |
4130 | I RSNNUM= 3 S DGRSN= $$ANSWER^D GOTHRPT("P lease prov ide Adjudi cation Det ails (Requ ired)","", "F^1:60^K: X="" ""!(X ="""")!(X? 1E) X","^D HELP^DGOT HRI(5)") | |
4131 | "RTN","DGO THRI",155, 0) | |
4132 | Q DGRSN | |
4133 | "RTN","DGO THRI",156, 0) | |
4134 | ; | |
4135 | "RTN","DGO THRI",157, 0) | |
4136 | HDR1 ; | |
4137 | "RTN","DGO THRI",158, 0) | |
4138 | W !,?9,"* ********** ********** ********** ********** ********** ********** *" | |
4139 | "RTN","DGO THRI",159, 0) | |
4140 | W !,?9,"* This opti on will RE ACTIVATE o r INACTIVA TE Other T han *" | |
4141 | "RTN","DGO THRI",160, 0) | |
4142 | W !,?9,"* Honorable patient c ount down clock in t he OTH Eli gibility *" | |
4143 | "RTN","DGO THRI",161, 0) | |
4144 | W !,?9,"* Clock fil e. *" | |
4145 | "RTN","DGO THRI",162, 0) | |
4146 | W !,?9,"* *" | |
4147 | "RTN","DGO THRI",163, 0) | |
4148 | W !,?9,"* NOTE: Ina ctivating the Other Than Honor able patie nt count *" | |
4149 | "RTN","DGO THRI",164, 0) | |
4150 | W !,?9,"* dow n clock wi ll have a significan t effect o n the *" | |
4151 | "RTN","DGO THRI",165, 0) | |
4152 | W !,?9,"* tre atment of the patien t's episod e of care. Make *" | |
4153 | "RTN","DGO THRI",166, 0) | |
4154 | W !,?9,"* sur e you have the prope r authoriz ation to i nactivate *" | |
4155 | "RTN","DGO THRI",167, 0) | |
4156 | W !,?9,"* the patient's count dow n clock. *" | |
4157 | "RTN","DGO THRI",168, 0) | |
4158 | W !,?9,"* ********** ********** ********** ********** ********** ********** *" | |
4159 | "RTN","DGO THRI",169, 0) | |
4160 | Q | |
4161 | "RTN","DGO THRI",170, 0) | |
4162 | ; | |
4163 | "RTN","DGO THRI",171, 0) | |
4164 | SELPAT(DGP AT) ; | |
4165 | "RTN","DGO THRI",172, 0) | |
4166 | ;- input vars for ^ DIC call | |
4167 | "RTN","DGO THRI",173, 0) | |
4168 | N DIC,DTO UT,DUOUT,X ,Y | |
4169 | "RTN","DGO THRI",174, 0) | |
4170 | S DIC="^D GOTH(33,", DIC(0)="AE MQZV" | |
4171 | "RTN","DGO THRI",175, 0) | |
4172 | S DIC("?P ARAM",33," INDEX")=.0 1 | |
4173 | "RTN","DGO THRI",176, 0) | |
4174 | ;- lookup patient | |
4175 | "RTN","DGO THRI",177, 0) | |
4176 | D ^DIC K DIC | |
4177 | "RTN","DGO THRI",178, 0) | |
4178 | ;- result of lookup | |
4179 | "RTN","DGO THRI",179, 0) | |
4180 | S DGPAT=Y | |
4181 | "RTN","DGO THRI",180, 0) | |
4182 | ;- if suc cess, setu p return a rray using output va rs from ^D IC call | |
4183 | "RTN","DGO THRI",181, 0) | |
4184 | I (+DGPAT >0) D Q Y (0,0) ;pa tient name | |
4185 | "RTN","DGO THRI",182, 0) | |
4186 | . S DGPAT =+Y ;pa tient ien | |
4187 | "RTN","DGO THRI",183, 0) | |
4188 | . S DGPAT (0)=$G(Y(0 )) ;ze ro node of patient i n (#33) fi le | |
4189 | "RTN","DGO THRI",184, 0) | |
4190 | Q -1 | |
4191 | "RTN","DGO THRI",185, 0) | |
4192 | ; | |
4193 | "RTN","DGO THRI",186, 0) | |
4194 | DEMOG(DGDF N,DGRET,DG ARR,DGPTST ) ;display patient d emographic s | |
4195 | "RTN","DGO THRI",187, 0) | |
4196 | ; | |
4197 | "RTN","DGO THRI",188, 0) | |
4198 | N DGASK,D DASH,DFN,D GSTATE,DGE RR,VA,VADM ,VAPA | |
4199 | "RTN","DGO THRI",189, 0) | |
4200 | S DDASH=" ",$P(DDASH ,"_",80)=" " | |
4201 | "RTN","DGO THRI",190, 0) | |
4202 | S DFN=DGD FN | |
4203 | "RTN","DGO THRI",191, 0) | |
4204 | D 4^VADPT ;extract patient DE M and ADD | |
4205 | "RTN","DGO THRI",192, 0) | |
4206 | W @IOF | |
4207 | "RTN","DGO THRI",193, 0) | |
4208 | S @DGLIST @(DGLN,0)= " " | |
4209 | "RTN","DGO THRI",194, 0) | |
4210 | S DGLN=DG LN+1 | |
4211 | "RTN","DGO THRI",195, 0) | |
4212 | S @DGLIST @(DGLN,0)= "EMERGENT OTHER THAN HONORABLE PATIENT C LOCK FILE" | |
4213 | "RTN","DGO THRI",196, 0) | |
4214 | D WRITE | |
4215 | "RTN","DGO THRI",197, 0) | |
4216 | S DGLN=DG LN+1 | |
4217 | "RTN","DGO THRI",198, 0) | |
4218 | S @DGLIST @(DGLN,0)= DDASH | |
4219 | "RTN","DGO THRI",199, 0) | |
4220 | D WRITE | |
4221 | "RTN","DGO THRI",200, 0) | |
4222 | S DGLN=DG LN+1 | |
4223 | "RTN","DGO THRI",201, 0) | |
4224 | S @DGLIST @(DGLN,0)= " Name: "_$ E($G(VADM( 1)),1,25) | |
4225 | "RTN","DGO THRI",202, 0) | |
4226 | S @DGLIST @(DGLN,0)= @DGLIST@(D GLN,0)_" Status: "_" ** " _$S(DGPTST =1:"ACTIVE ",DGPTST=2 :"ADJUDICA TED",DGPTS T=3:"INACT IVE",1:"") _" **" | |
4227 | "RTN","DGO THRI",203, 0) | |
4228 | D WRITE | |
4229 | "RTN","DGO THRI",204, 0) | |
4230 | S DGLN=DG LN+1 | |
4231 | "RTN","DGO THRI",205, 0) | |
4232 | S @DGLIST @(DGLN,0)= " Sex : "_$ P($G(VADM( 5)),U,2) | |
4233 | "RTN","DGO THRI",206, 0) | |
4234 | D WRITE | |
4235 | "RTN","DGO THRI",207, 0) | |
4236 | S DGLN=DG LN+1 | |
4237 | "RTN","DGO THRI",208, 0) | |
4238 | S @DGLIST @(DGLN,0)= "Date of B irth: "_$ P($G(VADM( 3)),U,2) | |
4239 | "RTN","DGO THRI",209, 0) | |
4240 | D WRITE | |
4241 | "RTN","DGO THRI",210, 0) | |
4242 | S DGLN=DG LN+1 | |
4243 | "RTN","DGO THRI",211, 0) | |
4244 | S @DGLIST @(DGLN,0)= " SSN: "_$ G(VA("PID" )) | |
4245 | "RTN","DGO THRI",212, 0) | |
4246 | D WRITE | |
4247 | "RTN","DGO THRI",213, 0) | |
4248 | S DGLN=DG LN+1 | |
4249 | "RTN","DGO THRI",214, 0) | |
4250 | S @DGLIST @(DGLN,0)= " " | |
4251 | "RTN","DGO THRI",215, 0) | |
4252 | ;display current OT H countdow n clock | |
4253 | "RTN","DGO THRI",216, 0) | |
4254 | I $D(DGRE T) D DSPCL CK(.DGRET) | |
4255 | "RTN","DGO THRI",217, 0) | |
4256 | S DGLN=DG LN+1 | |
4257 | "RTN","DGO THRI",218, 0) | |
4258 | S @DGLIST @(DGLN,0)= DDASH | |
4259 | "RTN","DGO THRI",219, 0) | |
4260 | D WRITE | |
4261 | "RTN","DGO THRI",220, 0) | |
4262 | ; | |
4263 | "RTN","DGO THRI",221, 0) | |
4264 | I 13[DGPT ST D | |
4265 | "RTN","DGO THRI",222, 0) | |
4266 | . W !,"Ch eck displa yed data b efore proc eeding." | |
4267 | "RTN","DGO THRI",223, 0) | |
4268 | . I DGPTS T=3 W ! D INACTMS1(D GPTNM) | |
4269 | "RTN","DGO THRI",224, 0) | |
4270 | . I '+$$E MHELG^DGOT HD1(DGDFN) !($$GET1^D IQ(2,DGDFN ,.5501,"I" )'="OTH-90 ") D INACT MS3 S DGAS K=0 Q | |
4271 | "RTN","DGO THRI",225, 0) | |
4272 | . W ! S D GASK=$$ANS WER^DGOTHR PT("Is thi s the pati ent to be updated (Y /N)","","Y O","^D HEL P^DGOTHRI( 1)") | |
4273 | "RTN","DGO THRI",226, 0) | |
4274 | E D VBAM SG(.DGARR) S DGASK=1 | |
4275 | "RTN","DGO THRI",227, 0) | |
4276 | D KVAR^VA DPT,KVA^VA DPT | |
4277 | "RTN","DGO THRI",228, 0) | |
4278 | Q DGASK>0 | |
4279 | "RTN","DGO THRI",229, 0) | |
4280 | ; | |
4281 | "RTN","DGO THRI",230, 0) | |
4282 | WRITE ; | |
4283 | "RTN","DGO THRI",231, 0) | |
4284 | W @DGLIST @(DGLN,0), ! | |
4285 | "RTN","DGO THRI",232, 0) | |
4286 | Q | |
4287 | "RTN","DGO THRI",233, 0) | |
4288 | ; | |
4289 | "RTN","DGO THRI",234, 0) | |
4290 | STATUS(DGA RR) ;displ ay OTH pat ient clock status | |
4291 | "RTN","DGO THRI",235, 0) | |
4292 | N DGPSTAT | |
4293 | "RTN","DGO THRI",236, 0) | |
4294 | ;ACTIVE | |
4295 | "RTN","DGO THRI",237, 0) | |
4296 | I $G(DGAR R(33,DGIEN 33_",",.02 ,"I"))=1,' +$G(DGARR( 33,DGIEN33 _",",.06," I")) S DGP STAT=1 | |
4297 | "RTN","DGO THRI",238, 0) | |
4298 | ;VBA ADJU DICATION C OMPLETE | |
4299 | "RTN","DGO THRI",239, 0) | |
4300 | I '$G(DGA RR(33,DGIE N33_",",.0 2,"I")),+$ G(DGARR(33 ,DGIEN33_" ,",.06,"I" )) S DGPST AT=2 | |
4301 | "RTN","DGO THRI",240, 0) | |
4302 | ;INACTIVE | |
4303 | "RTN","DGO THRI",241, 0) | |
4304 | I '$G(DGA RR(33,DGIE N33_",",.0 2,"I")),'+ $G(DGARR(3 3,DGIEN33_ ",",.06,"I ")) S DGPS TAT=3 | |
4305 | "RTN","DGO THRI",242, 0) | |
4306 | Q DGPSTAT | |
4307 | "RTN","DGO THRI",243, 0) | |
4308 | ; | |
4309 | "RTN","DGO THRI",244, 0) | |
4310 | DSPCLCK(DG RET) ;disp lay 365-Da y clock ov erview of the patien t | |
4311 | "RTN","DGO THRI",245, 0) | |
4312 | ; | |
4313 | "RTN","DGO THRI",246, 0) | |
4314 | N I,DG365 ,DG90,TEXT | |
4315 | "RTN","DGO THRI",247, 0) | |
4316 | S TEXT="3 65-Day" | |
4317 | "RTN","DGO THRI",248, 0) | |
4318 | S TEXT=" "_$$B LDSTR("365 -Day",TEXT ,1,8) | |
4319 | "RTN","DGO THRI",249, 0) | |
4320 | S TEXT=$$ BLDSTR("90 -Day",TEXT ,17,9) | |
4321 | "RTN","DGO THRI",250, 0) | |
4322 | S TEXT=$$ BLDSTR("St art Date", TEXT,27,13 ) | |
4323 | "RTN","DGO THRI",251, 0) | |
4324 | S TEXT=$$ BLDSTR("En d Date",TE XT,41,16) | |
4325 | "RTN","DGO THRI",252, 0) | |
4326 | S TEXT=$$ BLDSTR("Da ys Remaini ng",TEXT,5 5,19) | |
4327 | "RTN","DGO THRI",253, 0) | |
4328 | S DGLN=DG LN+1 | |
4329 | "RTN","DGO THRI",254, 0) | |
4330 | S @DGLIST @(DGLN,0)= TEXT | |
4331 | "RTN","DGO THRI",255, 0) | |
4332 | W !,@DGLI ST@(DGLN,0 ) | |
4333 | "RTN","DGO THRI",256, 0) | |
4334 | S TEXT="= ======" | |
4335 | "RTN","DGO THRI",257, 0) | |
4336 | S TEXT=" "_$$B LDSTR("=== ====",TEXT ,1,8) | |
4337 | "RTN","DGO THRI",258, 0) | |
4338 | S TEXT=$$ BLDSTR("== ====",TEXT ,17,9) | |
4339 | "RTN","DGO THRI",259, 0) | |
4340 | S TEXT=$$ BLDSTR("== ========", TEXT,27,13 ) | |
4341 | "RTN","DGO THRI",260, 0) | |
4342 | S TEXT=$$ BLDSTR("== ========", TEXT,41,16 ) | |
4343 | "RTN","DGO THRI",261, 0) | |
4344 | S TEXT=$$ BLDSTR("== ========== ==",TEXT,5 5,19) | |
4345 | "RTN","DGO THRI",262, 0) | |
4346 | S DGLN=DG LN+1 | |
4347 | "RTN","DGO THRI",263, 0) | |
4348 | S @DGLIST @(DGLN,0)= TEXT | |
4349 | "RTN","DGO THRI",264, 0) | |
4350 | W !,@DGLI ST@(DGLN,0 ) | |
4351 | "RTN","DGO THRI",265, 0) | |
4352 | S DGLN=DG LN+1 | |
4353 | "RTN","DGO THRI",266, 0) | |
4354 | S @DGLIST @(DGLN,0)= " "_$$BLDSTR (DGLS365D, "",1,2) | |
4355 | "RTN","DGO THRI",267, 0) | |
4356 | W !,@DGLI ST@(DGLN,0 ) | |
4357 | "RTN","DGO THRI",268, 0) | |
4358 | ; | |
4359 | "RTN","DGO THRI",269, 0) | |
4360 | S DG90="" F S DG90 =$O(DGRET( DGLS365D,D G90)) Q:DG 90="" D | |
4361 | "RTN","DGO THRI",270, 0) | |
4362 | . S DGRET =DGRET(DGL S365D,DG90 ) | |
4363 | "RTN","DGO THRI",271, 0) | |
4364 | . S TEXT= $$BLDSTR(D G90," ",9, 2) | |
4365 | "RTN","DGO THRI",272, 0) | |
4366 | . S TEXT= $$BLDSTR($ $FMTE^XLFD T($P(DGRET ,U),"5Z"), TEXT,16,10 ) | |
4367 | "RTN","DGO THRI",273, 0) | |
4368 | . S TEXT= $$BLDSTR($ $FMTE^XLFD T($P(DGRET ,U,2),"5Z" ),TEXT,30, 10) | |
4369 | "RTN","DGO THRI",274, 0) | |
4370 | . S TEXT= $$BLDSTR($ P(DGRET,U, 3),TEXT,49 ,4) | |
4371 | "RTN","DGO THRI",275, 0) | |
4372 | . I DG90> 1 S DGLN=D GLN+1 W ?1 1 | |
4373 | "RTN","DGO THRI",276, 0) | |
4374 | . W TEXT, ! | |
4375 | "RTN","DGO THRI",277, 0) | |
4376 | . S @DGLI ST@(DGLN,0 )=" "_TEXT | |
4377 | "RTN","DGO THRI",278, 0) | |
4378 | Q | |
4379 | "RTN","DGO THRI",279, 0) | |
4380 | ; | |
4381 | "RTN","DGO THRI",280, 0) | |
4382 | VBAMSG(DGA RR) ;displ ay VBA adj udication message | |
4383 | "RTN","DGO THRI",281, 0) | |
4384 | ; | |
4385 | "RTN","DGO THRI",282, 0) | |
4386 | W !!,"**T he VBA adj udication for this p atient has been comp leted: "_D GARR(33,DG IEN33_",", .06,"E")_" ." | |
4387 | "RTN","DGO THRI",283, 0) | |
4388 | Q | |
4389 | "RTN","DGO THRI",284, 0) | |
4390 | ; | |
4391 | "RTN","DGO THRI",285, 0) | |
4392 | INACTMS1(D GPTNM) ;di splay inac tive messa ge | |
4393 | "RTN","DGO THRI",286, 0) | |
4394 | S DGLN=DG LN+1,@DGLI ST@(DGLN,0 )=" " | |
4395 | "RTN","DGO THRI",287, 0) | |
4396 | S DGLN=DG LN+1 | |
4397 | "RTN","DGO THRI",288, 0) | |
4398 | S @DGLIST @(DGLN,0)= " The Oth er Than Ho norable co untdown cl ock for pa tient "_DG PTNM | |
4399 | "RTN","DGO THRI",289, 0) | |
4400 | W !,@DGLI ST@(DGLN,0 ),! | |
4401 | "RTN","DGO THRI",290, 0) | |
4402 | S DGLN=DG LN+1 | |
4403 | "RTN","DGO THRI",291, 0) | |
4404 | S @DGLIST @(DGLN,0)= " was INA CTIVATED o n "_DGARR( 33,DGIEN33 _",",.03," E")_"." | |
4405 | "RTN","DGO THRI",292, 0) | |
4406 | W @DGLIST @(DGLN,0) | |
4407 | "RTN","DGO THRI",293, 0) | |
4408 | S DGLN=DG LN+1,@DGLI ST@(DGLN,0 )=" " | |
4409 | "RTN","DGO THRI",294, 0) | |
4410 | Q | |
4411 | "RTN","DGO THRI",295, 0) | |
4412 | ; | |
4413 | "RTN","DGO THRI",296, 0) | |
4414 | INACTMS2 ; display in active mes sage | |
4415 | "RTN","DGO THRI",297, 0) | |
4416 | W " The patient's countdown clock will no longer be displa yed in CPR S.",! | |
4417 | "RTN","DGO THRI",298, 0) | |
4418 | S DGLN=DG LN+1 | |
4419 | "RTN","DGO THRI",299, 0) | |
4420 | S @DGLIST @(DGLN,0)= " *** IMM EDIATE ACT ION NEEDED ***" | |
4421 | "RTN","DGO THRI",300, 0) | |
4422 | W !,@DGLI ST@(DGLN,0 ) | |
4423 | "RTN","DGO THRI",301, 0) | |
4424 | S DGLN=DG LN+1 | |
4425 | "RTN","DGO THRI",302, 0) | |
4426 | S @DGLIST @(DGLN,0)= " Go back to Regist ration ELI GIBILITY S TATUS DATA , SCREEN 7 " | |
4427 | "RTN","DGO THRI",303, 0) | |
4428 | W !,@DGLI ST@(DGLN,0 ) | |
4429 | "RTN","DGO THRI",304, 0) | |
4430 | S DGLN=DG LN+1 | |
4431 | "RTN","DGO THRI",305, 0) | |
4432 | S @DGLIST @(DGLN,0)= " and upd ate the pa tient's pr imary elig ibility co de to" | |
4433 | "RTN","DGO THRI",306, 0) | |
4434 | W !,@DGLI ST@(DGLN,0 ) | |
4435 | "RTN","DGO THRI",307, 0) | |
4436 | S DGLN=DG LN+1 | |
4437 | "RTN","DGO THRI",308, 0) | |
4438 | S @DGLIST @(DGLN,0)= " its adj udicated e ligibility ." | |
4439 | "RTN","DGO THRI",309, 0) | |
4440 | W !,@DGLI ST@(DGLN,0 ),! | |
4441 | "RTN","DGO THRI",310, 0) | |
4442 | Q | |
4443 | "RTN","DGO THRI",311, 0) | |
4444 | ; | |
4445 | "RTN","DGO THRI",312, 0) | |
4446 | INACTMS3 ; display in active mes sage | |
4447 | "RTN","DGO THRI",313, 0) | |
4448 | ;user is not allowe d to react ivate cloc k without primary el igibility code of | |
4449 | "RTN","DGO THRI",314, 0) | |
4450 | ;EXPANDED MH CARE N ON-VETERAN S and EXPA NDED MH CA RE TYPE "O TH-90" | |
4451 | "RTN","DGO THRI",315, 0) | |
4452 | W !!," T his patien t's countd own clock CANNOT BE REACTIVATE D." | |
4453 | "RTN","DGO THRI",316, 0) | |
4454 | W !!," P lease revi ew the pat ient's eli gibility o n Registra tion" | |
4455 | "RTN","DGO THRI",317, 0) | |
4456 | W !," EL IGIBILITY STATUS DAT A, SCREEN 7." | |
4457 | "RTN","DGO THRI",318, 0) | |
4458 | Q | |
4459 | "RTN","DGO THRI",319, 0) | |
4460 | ; | |
4461 | "RTN","DGO THRI",320, 0) | |
4462 | STRE(DGIEN 33,DGADJDT ,DGARR,DGL S365I,DGCL CK,DGRAIN, DGRSN,DGVB A,DGPTST) ;stop/reac tivate OTH patient c ount down clock | |
4463 | "RTN","DGO THRI",321, 0) | |
4464 | ; | |
4465 | "RTN","DGO THRI",322, 0) | |
4466 | N FILENO, DGFDART,DG IENS,DGOTH ERR,DGOTH3 31,DGHSTIE N,DGFLG | |
4467 | "RTN","DGO THRI",323, 0) | |
4468 | S FILENO= 33 | |
4469 | "RTN","DGO THRI",324, 0) | |
4470 | ;change P T status f rom ACTIVE to INACTI VE or vice versa | |
4471 | "RTN","DGO THRI",325, 0) | |
4472 | S DGFDART ($J,FILENO ,DGIEN33_" ,",.02)=DG RAIN | |
4473 | "RTN","DGO THRI",326, 0) | |
4474 | S DGFDART ($J,FILENO ,DGIEN33_" ,",.03)=$$ DT^XLFDT ; actual re- activation /inactivat ion date | |
4475 | "RTN","DGO THRI",327, 0) | |
4476 | S DGFDART ($J,FILENO ,DGIEN33_" ,",.04)=DG RSN ;reaso n/comment for re-act ivation/in activation | |
4477 | "RTN","DGO THRI",328, 0) | |
4478 | S DGFDART ($J,FILENO ,DGIEN33_" ,",.05)=$S (DGPTST=2: "",DGADJDT >0:DGVBA,1 :"") | |
4479 | "RTN","DGO THRI",329, 0) | |
4480 | S DGFDART ($J,FILENO ,DGIEN33_" ,",.06)=$S (DGPTST=2: "",DGADJDT >0:DGADJDT ,1:"") | |
4481 | "RTN","DGO THRI",330, 0) | |
4482 | D FILE^DI E("U","DGF DART($J)", "DGOTHERR" ) | |
4483 | "RTN","DGO THRI",331, 0) | |
4484 | I $D(DGOT HERR) W !! ,"An error occurred during fil ing." Q | |
4485 | "RTN","DGO THRI",332, 0) | |
4486 | ;create n ew/update OTH patien t history record | |
4487 | "RTN","DGO THRI",333, 0) | |
4488 | S DGOTH33 1=$G(^DGOT H(33.1,0)) | |
4489 | "RTN","DGO THRI",334, 0) | |
4490 | Q:DGOTH33 1="" | |
4491 | "RTN","DGO THRI",335, 0) | |
4492 | S DGHSTIE N=+$O(^DGO TH(33.1,"B ",DGIEN33, 0)) | |
4493 | "RTN","DGO THRI",336, 0) | |
4494 | D INSNWRE C(DGHSTIEN ,.DGARR,DG ADJDT,DGLS 365I,DGCLC K,DGRAIN,D GRSN,DGPTS T) | |
4495 | "RTN","DGO THRI",337, 0) | |
4496 | Q | |
4497 | "RTN","DGO THRI",338, 0) | |
4498 | ; | |
4499 | "RTN","DGO THRI",339, 0) | |
4500 | INSNWREC(D GHSTIEN,DG ARR,DGADJD T,DGLS365I ,DGCLCK,DG RAIN,DGRSN ,DGPTST) ; | |
4501 | "RTN","DGO THRI",340, 0) | |
4502 | N DGVALS | |
4503 | "RTN","DGO THRI",341, 0) | |
4504 | ;create n ew OTH his tory recor d | |
4505 | "RTN","DGO THRI",342, 0) | |
4506 | I DGHSTIE N=0 D | |
4507 | "RTN","DGO THRI",343, 0) | |
4508 | . S DGVAL S(.01)=DGI EN33 | |
4509 | "RTN","DGO THRI",344, 0) | |
4510 | . D INSRE C^DGOTHD2( 33.1,"",.D GVALS) | |
4511 | "RTN","DGO THRI",345, 0) | |
4512 | . S DGHST IEN=+$O(^D GOTH(33.1, "B",DGIEN3 3,0)) | |
4513 | "RTN","DGO THRI",346, 0) | |
4514 | N DGVALS, I | |
4515 | "RTN","DGO THRI",347, 0) | |
4516 | S DGVALS( .01)=DGLS3 65I | |
4517 | "RTN","DGO THRI",348, 0) | |
4518 | S DGVALS( .02)=DGCLC K | |
4519 | "RTN","DGO THRI",349, 0) | |
4520 | I DGPTST= 1 D | |
4521 | "RTN","DGO THRI",350, 0) | |
4522 | . I +$G(D GARR(33,DG IEN33_",", .03,"I")) S DGPTST=3 Q | |
4523 | "RTN","DGO THRI",351, 0) | |
4524 | . I DGADJ DT>0 F I=4 :1:6 D FLD UPDTD(I) | |
4525 | "RTN","DGO THRI",352, 0) | |
4526 | I DGPTST= 2 F I=4:1: 5 D FLDUPD TD(I) | |
4527 | "RTN","DGO THRI",353, 0) | |
4528 | I DGPTST= 3 D FLDUPD TD(4) | |
4529 | "RTN","DGO THRI",354, 0) | |
4530 | Q | |
4531 | "RTN","DGO THRI",355, 0) | |
4532 | ; | |
4533 | "RTN","DGO THRI",356, 0) | |
4534 | FLDUPDTD(S CODE) ;fie ld updated | |
4535 | "RTN","DGO THRI",357, 0) | |
4536 | ; | |
4537 | "RTN","DGO THRI",358, 0) | |
4538 | I SCODE=4 D | |
4539 | "RTN","DGO THRI",359, 0) | |
4540 | . S DGVAL S(.03)=4 ; Field upda ted is OTH Patient S tatus | |
4541 | "RTN","DGO THRI",360, 0) | |
4542 | . S DGVAL S(.04)=DGA RR(33,DGIE N33_",",.0 2,"E") | |
4543 | "RTN","DGO THRI",361, 0) | |
4544 | . S DGVAL S(.05)=$S( DGRAIN:"AC TIVE",1:"I NACTIVE") | |
4545 | "RTN","DGO THRI",362, 0) | |
4546 | . S DGVAL S(.08)=$S( $G(DGRSN)= "":"Not Pr ovided",1: DGRSN) | |
4547 | "RTN","DGO THRI",363, 0) | |
4548 | ; | |
4549 | "RTN","DGO THRI",364, 0) | |
4550 | I SCODE=5 D | |
4551 | "RTN","DGO THRI",365, 0) | |
4552 | . S DGVAL S(.03)=5 ; Field upda ted is VBA ADJUDICAT ION STATUS | |
4553 | "RTN","DGO THRI",366, 0) | |
4554 | . S DGVAL S(.04)=$S( DGARR(33,D GIEN33_"," ,.06,"I")= "":"ADJUDI CATION PEN DING",1:"A DJUDICATIO N COMPLETE D") | |
4555 | "RTN","DGO THRI",367, 0) | |
4556 | . S DGVAL S(.05)=$S( DGADJDT>0: "ADJUDICAT ION COMPLE TED",1:"AD JUDICATION PENDING") | |
4557 | "RTN","DGO THRI",368, 0) | |
4558 | . S DGVAL S(.08)=$P( DGSORT("DG VBAS"),U,2 ) | |
4559 | "RTN","DGO THRI",369, 0) | |
4560 | ; | |
4561 | "RTN","DGO THRI",370, 0) | |
4562 | I SCODE=6 D | |
4563 | "RTN","DGO THRI",371, 0) | |
4564 | . S DGVAL S(.03)=6 ; Field upda ted is VBA ADJUDICAT ION DATE | |
4565 | "RTN","DGO THRI",372, 0) | |
4566 | . S DGVAL S(.04)=$S( DGARR(33,D GIEN33_"," ,.06,"I")= "":DGADJDT ,1:DGARR(3 3,DGIEN33_ ",",.06,"I ")) | |
4567 | "RTN","DGO THRI",373, 0) | |
4568 | . S DGVAL S(.05)=DGA DJDT | |
4569 | "RTN","DGO THRI",374, 0) | |
4570 | . S DGVAL S(.08)=$P( DGSORT("DG VBAS"),U,2 ) | |
4571 | "RTN","DGO THRI",375, 0) | |
4572 | ; | |
4573 | "RTN","DGO THRI",376, 0) | |
4574 | D EDTBY | |
4575 | "RTN","DGO THRI",377, 0) | |
4576 | D INSREC^ DGOTHD2(33 .12,DGHSTI EN,.DGVALS ) | |
4577 | "RTN","DGO THRI",378, 0) | |
4578 | Q | |
4579 | "RTN","DGO THRI",379, 0) | |
4580 | ; | |
4581 | "RTN","DGO THRI",380, 0) | |
4582 | EDTBY ; | |
4583 | "RTN","DGO THRI",381, 0) | |
4584 | S DGVALS( .06)=$S($G (DUZ)>0:$$ GET1^DIQ(2 00,DUZ,.01 ),1:"POSTM ASTER") | |
4585 | "RTN","DGO THRI",382, 0) | |
4586 | S DGVALS( .07)=$$NOW ^XLFDT | |
4587 | "RTN","DGO THRI",383, 0) | |
4588 | Q | |
4589 | "RTN","DGO THRI",384, 0) | |
4590 | ; | |
4591 | "RTN","DGO THRI",385, 0) | |
4592 | HELP(DGSEL ) ;provide extended DIR("?") h elp text. | |
4593 | "RTN","DGO THRI",386, 0) | |
4594 | ; | |
4595 | "RTN","DGO THRI",387, 0) | |
4596 | I X'="?", X'="??" W !," Not a valid ans wer.",! | |
4597 | "RTN","DGO THRI",388, 0) | |
4598 | I DGSEL=1 D | |
4599 | "RTN","DGO THRI",389, 0) | |
4600 | . W !," Enter 'Y' - if this is the pat ient you a re looking to be upd ated." | |
4601 | "RTN","DGO THRI",390, 0) | |
4602 | I DGSEL=2 D | |
4603 | "RTN","DGO THRI",391, 0) | |
4604 | . W !," Enter 'Y' - if you r eceived in formation regarding" | |
4605 | "RTN","DGO THRI",392, 0) | |
4606 | . W !," the pati ent's Adju dication S tatus." | |
4607 | "RTN","DGO THRI",393, 0) | |
4608 | I DGSEL=3 D | |
4609 | "RTN","DGO THRI",394, 0) | |
4610 | . W !," Enter the actual adj udication date based on the in formation you receiv ed" | |
4611 | "RTN","DGO THRI",395, 0) | |
4612 | . W !," regarding the patien t's Adjudi cation Sta tus." | |
4613 | "RTN","DGO THRI",396, 0) | |
4614 | . W !!," The adjud ication da te should not be pri or to the patient's" | |
4615 | "RTN","DGO THRI",397, 0) | |
4616 | . W !," 1st 90-Day period of care star t date." | |
4617 | "RTN","DGO THRI",398, 0) | |
4618 | I DGSEL=4 D | |
4619 | "RTN","DGO THRI",399, 0) | |
4620 | . W !," Enter 'Y' - if this is the pat ient you w ould like to INACTIV ATE/REACTI VATE." | |
4621 | "RTN","DGO THRI",400, 0) | |
4622 | I DGSEL=5 D | |
4623 | "RTN","DGO THRI",401, 0) | |
4624 | . W !," Answer mus t be 1-60 characters in length .",! | |
4625 | "RTN","DGO THRI",402, 0) | |
4626 | . W !," Enter the reason or details fo r reactiva tion/inact ivation of the",!," OTH patie nt's count down clock ." | |
4627 | "RTN","DGO THRI",403, 0) | |
4628 | . W !," For exampl e: VBA Adj udication Reference number, ty pe of adju dication, etc." | |
4629 | "RTN","DGO THRI",404, 0) | |
4630 | I 124[DGS EL W !!," Otherwise , enter 'N '" | |
4631 | "RTN","DGO THRI",405, 0) | |
4632 | Q | |
4633 | "RTN","DGO THRI",406, 0) | |
4634 | ; | |
4635 | "RTN","DGO THRI",407, 0) | |
4636 | SNDMAIL ;s end mail t o DUZ | |
4637 | "RTN","DGO THRI",408, 0) | |
4638 | ; | |
4639 | "RTN","DGO THRI",409, 0) | |
4640 | N X,MES,Z TRTN,ZTDES C,ZTIO,ZTD TH,ZTREQ,Z TSK,ZTSAVE | |
4641 | "RTN","DGO THRI",410, 0) | |
4642 | N DIFROM, XMDUZ,XMSU B,XMTEXT,X MY | |
4643 | "RTN","DGO THRI",411, 0) | |
4644 | W !," A copy of th is informa tion has b een forwar ded to you r email" | |
4645 | "RTN","DGO THRI",412, 0) | |
4646 | W !," fo r referenc e." | |
4647 | "RTN","DGO THRI",413, 0) | |
4648 | S XMSUB=" URGENT: UP DATE PRIMA RY ELIGIBI LITY FOR P ATIENT "_D GPTNM | |
4649 | "RTN","DGO THRI",414, 0) | |
4650 | S XMDUZ="
|
|
4651 | "RTN","DGO THRI",415, 0) | |
4652 | S XMTEXT= "^TMP(""OT H90"",$J," | |
4653 | "RTN","DGO THRI",416, 0) | |
4654 | S (XMY(DU Z),XMY(.5) )="" | |
4655 | "RTN","DGO THRI",417, 0) | |
4656 | D NOW^%DT C S Y=% D DD^%DT | |
4657 | "RTN","DGO THRI",418, 0) | |
4658 | D ^XMD | |
4659 | "RTN","DGO THRI",419, 0) | |
4660 | Q | |
4661 | "RTN","DGO THRI",420, 0) | |
4662 | ; | |
4663 | "RTN","DGO THRI",421, 0) | |
4664 | BLDSTR(NST R,STR,COL, NSL) ;buil d a string | |
4665 | "RTN","DGO THRI",422, 0) | |
4666 | Q $E(STR_ $J("",COL- 1),1,COL-1 )_$E(NSTR_ $J("",NSL) ,1,NSL)_$E (STR,COL+N SL,999) | |
4667 | "RTN","DGO THRI",423, 0) | |
4668 | ; | |
4669 | "RTN","DGO THRP1") | |
4670 | 0^10^B6607 2210 | |
4671 | "RTN","DGO THRP1",1,0 ) | |
4672 | DGOTHRP1 ; SLC/RED - OTHD (OTHE R THAN HON ORABLE DIS CHARGE) Re ports ;May 9,2018@05 :08 | |
4673 | "RTN","DGO THRP1",2,0 ) | |
4674 | ;;5.3;Reg istration; **952**;Ma y 9, 2018; Build 68 | |
4675 | "RTN","DGO THRP1",3,0 ) | |
4676 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4677 | "RTN","DGO THRP1",4,0 ) | |
4678 | ; | |
4679 | "RTN","DGO THRP1",5,0 ) | |
4680 | ; Las t Edited: SHRPE/RED - August 1 5, 2018 15 :00 | |
4681 | "RTN","DGO THRP1",6,0 ) | |
4682 | ; | |
4683 | "RTN","DGO THRP1",7,0 ) | |
4684 | ; | |
4685 | "RTN","DGO THRP1",8,0 ) | |
4686 | ; IA: 1 0103 ^XL FDT (sup) - [$$FMAD D^XLFDT, $ $FMTE^XLFD T , $$NOW^ XLFDT] | |
4687 | "RTN","DGO THRP1",9,0 ) | |
4688 | ; 10015 ^ DIQ (su p) - [GET S^DIQ] | |
4689 | "RTN","DGO THRP1",10, 0) | |
4690 | ; 10026 ^DIR (su p) | |
4691 | "RTN","DGO THRP1",11, 0) | |
4692 | ; 10061 PID^VADPT (sup) | |
4693 | "RTN","DGO THRP1",12, 0) | |
4694 | ; 10063 ^%ZTLOAD ( sup) | |
4695 | "RTN","DGO THRP1",13, 0) | |
4696 | ; 10089 ^%ZISC (s up) | |
4697 | "RTN","DGO THRP1",14, 0) | |
4698 | ; | |
4699 | "RTN","DGO THRP1",15, 0) | |
4700 | Q ; No D irect acce ss | |
4701 | "RTN","DGO THRP1",16, 0) | |
4702 | ; | |
4703 | "RTN","DGO THRP1",17, 0) | |
4704 | REPORT ; Access by Option nam e: DG OTH EXCEPTION REPORT | |
4705 | "RTN","DGO THRP1",18, 0) | |
4706 | ; | |
4707 | "RTN","DGO THRP1",19, 0) | |
4708 | N DGIEN,D GARR,DGIEN 33,DGTYPE, DASH,DGQUI T,DGART,DG CNT,PAGE,E XIT,DGSP1, DGEP1,DGSP 2,DGEP2,DG LOOP,DGDAY 1,DGDAY2,D GEND | |
4709 | "RTN","DGO THRP1",20, 0) | |
4710 | N HDR,HDR 1,HDR2,X,D GNAME,DTOU T,DUOUT,PO P,ZTDESC,Z TRTN,ZTSAV E,ZTSK,PID | |
4711 | "RTN","DGO THRP1",21, 0) | |
4712 | S DASH="" ,$P(DASH," -",81)="", EXIT=0,PAG E=1 | |
4713 | "RTN","DGO THRP1",22, 0) | |
4714 | S DGARR=$ NA(^TMP($J ,"DGOTHRP1 ")) K @DGA RR | |
4715 | "RTN","DGO THRP1",23, 0) | |
4716 | S @DGARR@ (0)="OTH E XCEPTION R EPORT" | |
4717 | "RTN","DGO THRP1",24, 0) | |
4718 | K DIRUT,Y ,DIR ; Exc eption rep ort prompt | |
4719 | "RTN","DGO THRP1",25, 0) | |
4720 | S DIR(0)= "S^1:1st 9 0 day peri od has exp ired, no A uth for 2n d period;2 :Both 90 d ay periods have expi red;3:Repo rt of pati ents witho ut a start date (1st ) period o f care;4:2 nd 90 day period is authorized but never started" | |
4721 | "RTN","DGO THRP1",26, 0) | |
4722 | S DIR("A" )="Other t han honora ble except ion report type" | |
4723 | "RTN","DGO THRP1",27, 0) | |
4724 | D ^DIR K DIR Q:$D(D IRUT) | |
4725 | "RTN","DGO THRP1",28, 0) | |
4726 | S DGTYPE= Y,DGQUIT=" " | |
4727 | "RTN","DGO THRP1",29, 0) | |
4728 | Q:DGTYPE= U | |
4729 | "RTN","DGO THRP1",30, 0) | |
4730 | S HDR="Ot her than H onorable E xception R eport" | |
4731 | "RTN","DGO THRP1",31, 0) | |
4732 | S HDR1=Y( 0) | |
4733 | "RTN","DGO THRP1",32, 0) | |
4734 | S HDR2="P rinted Dat e/Time: "_ $$FMTE^XLF DT($$NOW^X LFDT(),1) | |
4735 | "RTN","DGO THRP1",33, 0) | |
4736 | S DGEND=D T | |
4737 | "RTN","DGO THRP1",34, 0) | |
4738 | D DEV ;A llow queue ing | |
4739 | "RTN","DGO THRP1",35, 0) | |
4740 | ; | |
4741 | "RTN","DGO THRP1",36, 0) | |
4742 | EN ; Repor t entry po int if Que ued | |
4743 | "RTN","DGO THRP1",37, 0) | |
4744 | S (DGIEN3 3,DGIEN,DG LOOP,DGCNT )=0 | |
4745 | "RTN","DGO THRP1",38, 0) | |
4746 | F S DGIE N33=$O(^DG OTH(33,DGI EN33)) Q:' DGIEN33!(E XIT) D | |
4747 | "RTN","DGO THRP1",39, 0) | |
4748 | . K DGART D GETS^DI Q(33,DGIEN 33_",",".0 1;.02;.03; 1*","IE"," DGART") | |
4749 | "RTN","DGO THRP1",40, 0) | |
4750 | . Q:DGART (33,DGIEN3 3_",",.03, "I") ;Adj udication was comple ted | |
4751 | "RTN","DGO THRP1",41, 0) | |
4752 | . S DGSP1 =$G(DGART( 33.11,"1,1 ,"_DGIEN33 _",",.02," I")),DGEP1 =$$FMADD^X LFDT(DGSP1 ,90) ;End date Peri od #1 | |
4753 | "RTN","DGO THRP1",42, 0) | |
4754 | . I DGEP1 <0 S DGEP1 ="" | |
4755 | "RTN","DGO THRP1",43, 0) | |
4756 | . I DGTYP E'=3,'DGSP 1 Q | |
4757 | "RTN","DGO THRP1",44, 0) | |
4758 | . S DGSP2 =$G(DGART( 33.11,"2,1 ,"_DGIEN33 _",",.02," I")),DGEP2 =$$FMADD^X LFDT(DGSP2 ,90) ;End date Peri od #2 | |
4759 | "RTN","DGO THRP1",45, 0) | |
4760 | . I DGEP2 <0 S DGEP2 ="" | |
4761 | "RTN","DGO THRP1",46, 0) | |
4762 | . K PID S PID=$$GET 1^DIQ(2,DG ART(33,DGI EN33_",",. 01,"I"),". 0905","E") | |
4763 | "RTN","DGO THRP1",47, 0) | |
4764 | . ;S DFN= DGART(33,D GIEN33_"," ,.01,"I") D PID^VADP T6 S PID=$ S(VA("BID" )]"":VA("B ID"),1:"UN KNOWN") K VA("PID") | |
4765 | "RTN","DGO THRP1",48, 0) | |
4766 | . S DGDAY 1=$S(DGEP1 <DT:"0",DG SP1>DT:"90 ",1:$$FMDI FF^XLFDT(D GEP1,DT,1) ) | |
4767 | "RTN","DGO THRP1",49, 0) | |
4768 | . S DGDAY 2=$S(DGSP2 ="":"",DGE P2<DT:"",D GSP2>DT:"9 0",1:$$FMD IFF^XLFDT( DGEP2,DT,1 )) | |
4769 | "RTN","DGO THRP1",50, 0) | |
4770 | . D @DGTY PE S DGLOO P=DGLOOP+1 | |
4771 | "RTN","DGO THRP1",51, 0) | |
4772 | . K DGART | |
4773 | "RTN","DGO THRP1",52, 0) | |
4774 | . Q | |
4775 | "RTN","DGO THRP1",53, 0) | |
4776 | Q:EXIT | |
4777 | "RTN","DGO THRP1",54, 0) | |
4778 | D PRINT | |
4779 | "RTN","DGO THRP1",55, 0) | |
4780 | W !,"Tota l ",$S(DGC NT=1:"pati ent",1:"pa tients")," found on this repor t: ",DGCNT ,! | |
4781 | "RTN","DGO THRP1",56, 0) | |
4782 | I DGCNT=0 D HDR W ! ?5," No re cords were found usi ng the rep ort criter ia.",!! | |
4783 | "RTN","DGO THRP1",57, 0) | |
4784 | I $E(IOST ,1,1)="C-" R !!,"END OF REPORT ...PRESS R ETURN TO C ONTINUE",X :DTIME W @ IOF | |
4785 | "RTN","DGO THRP1",58, 0) | |
4786 | D ^%ZISC K @DGARR | |
4787 | "RTN","DGO THRP1",59, 0) | |
4788 | Q | |
4789 | "RTN","DGO THRP1",60, 0) | |
4790 | 1 ; 1st 90 day period has expir ed, no Aut h for 2nd period | |
4791 | "RTN","DGO THRP1",61, 0) | |
4792 | I DGLOOP= 0 D HDR | |
4793 | "RTN","DGO THRP1",62, 0) | |
4794 | I $G(DGAR T(33.11,"2 ,1,"_DGIEN 33_",",.07 ,"I"))'="" S DGLOOP= DGLOOP+1 Q | |
4795 | "RTN","DGO THRP1",63, 0) | |
4796 | I DGEP1>D T Q | |
4797 | "RTN","DGO THRP1",64, 0) | |
4798 | D BUILD S DGCNT=DGC NT+1 | |
4799 | "RTN","DGO THRP1",65, 0) | |
4800 | Q | |
4801 | "RTN","DGO THRP1",66, 0) | |
4802 | 2 ; Both 90 day perio ds have ex pired | |
4803 | "RTN","DGO THRP1",67, 0) | |
4804 | I DGLOOP= 0 D HDR | |
4805 | "RTN","DGO THRP1",68, 0) | |
4806 | I DGDAY2 S DGLOOP=D GLOOP+1 Q | |
4807 | "RTN","DGO THRP1",69, 0) | |
4808 | I 'DGSP2 S DGLOOP=D GLOOP+1 Q | |
4809 | "RTN","DGO THRP1",70, 0) | |
4810 | D BUILD S DGCNT=DGC NT+1 | |
4811 | "RTN","DGO THRP1",71, 0) | |
4812 | Q | |
4813 | "RTN","DGO THRP1",72, 0) | |
4814 | ; | |
4815 | "RTN","DGO THRP1",73, 0) | |
4816 | 3 ; Report of patien ts without a start d ate for 1s t period o f care | |
4817 | "RTN","DGO THRP1",74, 0) | |
4818 | I DGLOOP= 0 D HDR | |
4819 | "RTN","DGO THRP1",75, 0) | |
4820 | I DGSP1 S DGLOOP=DG LOOP+1 Q | |
4821 | "RTN","DGO THRP1",76, 0) | |
4822 | ;I DGSP1& '$D(DGART( 33.11,"2,1 ,"_DGIEN33 _",")) S D GLOOP=DGLO OP+1 Q | |
4823 | "RTN","DGO THRP1",77, 0) | |
4824 | D BUILD S DGCNT=DGC NT+1 | |
4825 | "RTN","DGO THRP1",78, 0) | |
4826 | Q | |
4827 | "RTN","DGO THRP1",79, 0) | |
4828 | ; | |
4829 | "RTN","DGO THRP1",80, 0) | |
4830 | 4 ; 2nd 90 day perio d is autho rized but never star ted | |
4831 | "RTN","DGO THRP1",81, 0) | |
4832 | I DGLOOP= 0 D HDR | |
4833 | "RTN","DGO THRP1",82, 0) | |
4834 | I $G(DGAR T(33.11,"2 ,1,"_DGIEN 33_",",.07 ,"I")),DGS P2 S DGLOO P=DGLOOP+1 Q | |
4835 | "RTN","DGO THRP1",83, 0) | |
4836 | I $G(DGAR T(33.11,"2 ,1,"_DGIEN 33_",",.07 ,"I")),DGS P2<DT S DG LOOP=DGLOO P+1 Q | |
4837 | "RTN","DGO THRP1",84, 0) | |
4838 | I DGDAY2, DGDAY2<90 S DGLOOP=D GLOOP+1 Q | |
4839 | "RTN","DGO THRP1",85, 0) | |
4840 | I '$D(DGA RT(33.11," 2,1,"_DGIE N33_",",.0 7,"I")) S DGLOOP=DGL OOP+1 Q | |
4841 | "RTN","DGO THRP1",86, 0) | |
4842 | I DGSP2'= "",DGSP2<( DT+1) S DG LOOP=DGLOO P+1 Q | |
4843 | "RTN","DGO THRP1",87, 0) | |
4844 | D BUILD S DGCNT=DGC NT+1 | |
4845 | "RTN","DGO THRP1",88, 0) | |
4846 | Q | |
4847 | "RTN","DGO THRP1",89, 0) | |
4848 | ; | |
4849 | "RTN","DGO THRP1",90, 0) | |
4850 | HDR ; | |
4851 | "RTN","DGO THRP1",91, 0) | |
4852 | U IO | |
4853 | "RTN","DGO THRP1",92, 0) | |
4854 | W @IOF,?( 80-$L(HDR) /2),HDR,?7 2,"PAGE "_ PAGE,!?(80 -$L(HDR1)/ 2),HDR1,!? (80-$L(HDR 2)/2),HDR2 ,! | |
4855 | "RTN","DGO THRP1",93, 0) | |
4856 | W !,"Pati ent Name", ?32,"PID", ?45,"Perio d",?55,"St art Date", ?70,"End D ate" ;I D GTYPE=4 W ?70,"Days Left" | |
4857 | "RTN","DGO THRP1",94, 0) | |
4858 | W !,DASH S PAGE=PAG E+1 | |
4859 | "RTN","DGO THRP1",95, 0) | |
4860 | Q | |
4861 | "RTN","DGO THRP1",96, 0) | |
4862 | ; | |
4863 | "RTN","DGO THRP1",97, 0) | |
4864 | DEV ; | |
4865 | "RTN","DGO THRP1",98, 0) | |
4866 | N DIR,DIR UT,Y | |
4867 | "RTN","DGO THRP1",99, 0) | |
4868 | W ! S %Z IS="Q" D ^ %ZIS I POP Q | |
4869 | "RTN","DGO THRP1",100 ,0) | |
4870 | I $D(IO(" Q")) D D ^%ZTLOAD K IO("Q"),Z TSK Q | |
4871 | "RTN","DGO THRP1",101 ,0) | |
4872 | . S ZTDES C="Other t han Honora ble Except ion Report ",ZTRTN="E N^DGOTHRP1 " | |
4873 | "RTN","DGO THRP1",102 ,0) | |
4874 | . S ZTSAV E("DGTYPE" )="",ZTSAV E("HDR")=" ",ZTSAVE(" HDR1")="", ZTSAVE("HD R2")="",ZT SAVE("ZTRE Q")="@" | |
4875 | "RTN","DGO THRP1",103 ,0) | |
4876 | I $G(ZTSK ) W !!,"Re port compi lation has started w ith task# ",ZTSK,"." ,! S DIR(0 )="E" D ^D IR K DIR | |
4877 | "RTN","DGO THRP1",104 ,0) | |
4878 | Q | |
4879 | "RTN","DGO THRP1",105 ,0) | |
4880 | ; | |
4881 | "RTN","DGO THRP1",106 ,0) | |
4882 | BUILD ; Builds arr ay - ^TMP( $J,"DGOTHR P1",DGNAME ,SUBSCRIPT ) | |
4883 | "RTN","DGO THRP1",107 ,0) | |
4884 | S DGNAME= $E(DGART(3 3,DGIEN33_ ",",.01,"E "),1,28) | |
4885 | "RTN","DGO THRP1",108 ,0) | |
4886 | S @DGARR@ (DGNAME,1) =DGNAME_U_ PID_U_"1"_ U_$$FMTE^X LFDT(DGSP1 ,"5Z")_U_$ $FMTE^XLFD T(DGEP1,"5 Z") | |
4887 | "RTN","DGO THRP1",109 ,0) | |
4888 | I DGTYPE' =3 S @DGAR R@(DGNAME, 2)="2"_U_$ S(DGSP2:$$ FMTE^XLFDT (DGSP2,"5Z "),1:"No s tart date" )_U_$$FMTE ^XLFDT(DGE P2,"5Z") I DGTYPE=4 S $P(@DGAR R@(DGNAME, 2),U,4)=DG DAY2 | |
4889 | "RTN","DGO THRP1",110 ,0) | |
4890 | Q | |
4891 | "RTN","DGO THRP1",111 ,0) | |
4892 | PRINT ; | |
4893 | "RTN","DGO THRP1",112 ,0) | |
4894 | N I S I=1 F S I=$O (@DGARR@(I )) Q:I=""! (EXIT) D | |
4895 | "RTN","DGO THRP1",113 ,0) | |
4896 | . I $Y+4> IOSL D | |
4897 | "RTN","DGO THRP1",114 ,0) | |
4898 | ..W ! | |
4899 | "RTN","DGO THRP1",115 ,0) | |
4900 | .. I $E(I OST,1,2)=" C-" S DIR( 0)="E" K D IRUT D ^DI R | |
4901 | "RTN","DGO THRP1",116 ,0) | |
4902 | .. I $D(D IRUT)!$D(D UOUT)!$D(D TOUT) S EX IT=1 Q ;U ser exited the repor t | |
4903 | "RTN","DGO THRP1",117 ,0) | |
4904 | .. D HDR | |
4905 | "RTN","DGO THRP1",118 ,0) | |
4906 | . W !,$P( @DGARR@(I, 1),U),?32, $P(@DGARR@ (I,1),U,2) ,?48,$P(@D GARR@(I,1) ,U,3),?55, $P(@DGARR@ (I,1),U,4) ,?70,$P(@D GARR@(I,1) ,U,5) ;I D GTYPE=4 W ?74,$P(@DG ARR@(I,1), U,6) | |
4907 | "RTN","DGO THRP1",119 ,0) | |
4908 | . I 13'[D GTYPE W !? 48,$P(@DGA RR@(I,2),U ),?55,$P(@ DGARR@(I,2 ),U,2),?70 ,$P(@DGARR @(I,2),U,3 ) ;I DGTYP E=4 W ?74, $P(@DGARR@ (I,2),U,4) Q | |
4909 | "RTN","DGO THRP1",120 ,0) | |
4910 | . W ! | |
4911 | "RTN","DGO THRP1",121 ,0) | |
4912 | Q | |
4913 | "RTN","DGO THRP1",122 ,0) | |
4914 | ; | |
4915 | "RTN","DGO THRP1",123 ,0) | |
4916 | INACRPT ; | |
4917 | "RTN","DGO THRP1",124 ,0) | |
4918 | N DGIEN,D GART,DGIEN 33,DGINTDT ,DGDTEND,D GSTDT,PID, DG331,DGIN A0,PAGE,EX IT,DGTIME | |
4919 | "RTN","DGO THRP1",125 ,0) | |
4920 | S (DGIEN3 3,DGIEN,DG LOOP,DGCNT ,DGINTDT,E XIT)=0 | |
4921 | "RTN","DGO THRP1",126 ,0) | |
4922 | D DATESEL ;get da te selecti on for rep ort | |
4923 | "RTN","DGO THRP1",127 ,0) | |
4924 | Q:EXIT | |
4925 | "RTN","DGO THRP1",128 ,0) | |
4926 | D INADEV | |
4927 | "RTN","DGO THRP1",129 ,0) | |
4928 | ; | |
4929 | "RTN","DGO THRP1",130 ,0) | |
4930 | INAEN ; En try point if Queued | |
4931 | "RTN","DGO THRP1",131 ,0) | |
4932 | I $E(IOST )="C" D WA IT^DICD | |
4933 | "RTN","DGO THRP1",132 ,0) | |
4934 | K DGARR | |
4935 | "RTN","DGO THRP1",133 ,0) | |
4936 | F S DGIE N33=$O(^DG OTH(33,DGI EN33)) Q:' DGIEN33 D | |
4937 | "RTN","DGO THRP1",134 ,0) | |
4938 | . K DGART D GETS^DI Q(33,DGIEN 33_",",".0 1;.02;.03; 1*","IE"," DGART") | |
4939 | "RTN","DGO THRP1",135 ,0) | |
4940 | . I DGART (33,DGIEN3 3_",",.02, "I")'=0 ; No inactiv ation/reac tivation d ate on fil e | |
4941 | "RTN","DGO THRP1",136 ,0) | |
4942 | . S DGINT DT=$G(DGAR T(33,DGIEN 33_",",.03 ,"I")) | |
4943 | "RTN","DGO THRP1",137 ,0) | |
4944 | . I DGINT DT<DGSTDT! (DGINTDT>D GDTEND) Q | |
4945 | "RTN","DGO THRP1",138 ,0) | |
4946 | . S DG331 ="",DG331= $O(^DGOTH( 33.1,"B",D GIEN33,0)) | |
4947 | "RTN","DGO THRP1",139 ,0) | |
4948 | . Q:DG331 ="" | |
4949 | "RTN","DGO THRP1",140 ,0) | |
4950 | . S PID=$ $GET1^DIQ( 2,DGART(33 ,DGIEN33_" ,",.01,"I" ),".0905", "E") | |
4951 | "RTN","DGO THRP1",141 ,0) | |
4952 | . K DGINA 0 S X=.8 F S X=$O(^ DGOTH(33.1 ,DG331,1,X )) Q:'X D | |
4953 | "RTN","DGO THRP1",142 ,0) | |
4954 | .. Q:$P(^ DGOTH(33.1 ,DG331,1,X ,0),U,3)'= 4 | |
4955 | "RTN","DGO THRP1",143 ,0) | |
4956 | .. S DGIN A0=^DGOTH( 33.1,DG331 ,1,X,0) Q: $G(DGINA0) ="" | |
4957 | "RTN","DGO THRP1",144 ,0) | |
4958 | .. K DGTI ME S DGTIM E=$P($$FMT E^XLFDT($P (DGINA0,U, 7),"5Z")," :",1,2) | |
4959 | "RTN","DGO THRP1",145 ,0) | |
4960 | .. S DGAR R(DGART(33 ,DGIEN33_" ,",.01,"E" ),X)=$E(DG ART(33,DGI EN33_",",. 01,"E"),1, 22)_U_PID_ U_$P(DGINA 0,U,5)_U_D GTIME_U_$P (DGINA0,U, 6) | |
4961 | "RTN","DGO THRP1",146 ,0) | |
4962 | I $D(DGAR R)=0 W !," No patient s found fo r this tim e frame",! Q | |
4963 | "RTN","DGO THRP1",147 ,0) | |
4964 | W # S PAG E=1 D PRTH DR,PRTINA W !!,?15," <END OF RE PORT>",!! | |
4965 | "RTN","DGO THRP1",148 ,0) | |
4966 | Q | |
4967 | "RTN","DGO THRP1",149 ,0) | |
4968 | PRTHDR ; | |
4969 | "RTN","DGO THRP1",150 ,0) | |
4970 | W @IOF,!? 12,"INACTI VATE/REACT IVATE, OTH PT CLOCK REPORT",?7 0,"Page: " ,PAGE | |
4971 | "RTN","DGO THRP1",151 ,0) | |
4972 | W !?12,"S elected da te range: ",$$FMTE^X LFDT(DGSTD T,"5Z")," to ",$$FMT E^XLFDT(DG DTEND,"5Z" ) | |
4973 | "RTN","DGO THRP1",152 ,0) | |
4974 | W !,"Pati ent",?23," PID",?30," I/R",?40," Date Time" ,?55,"Edit ed by",! | |
4975 | "RTN","DGO THRP1",153 ,0) | |
4976 | F DASH=1: 1:75 W "-" | |
4977 | "RTN","DGO THRP1",154 ,0) | |
4978 | Q | |
4979 | "RTN","DGO THRP1",155 ,0) | |
4980 | PRTINA ; | |
4981 | "RTN","DGO THRP1",156 ,0) | |
4982 | N I,J S I ="",(EXIT, J)=0 | |
4983 | "RTN","DGO THRP1",157 ,0) | |
4984 | F S I=$O (DGARR(I)) Q:I=""!(E XIT) D | |
4985 | "RTN","DGO THRP1",158 ,0) | |
4986 | . F S J= $O(DGARR(I ,J)) Q:'J D | |
4987 | "RTN","DGO THRP1",159 ,0) | |
4988 | ..I $Y+4> IOSL D Q: EXIT | |
4989 | "RTN","DGO THRP1",160 ,0) | |
4990 | ...K DTOU T,DIRUT | |
4991 | "RTN","DGO THRP1",161 ,0) | |
4992 | ...I $E(I OST,1,2)=" C-" S DIR( 0)="E" D ^ DIR K DIR | |
4993 | "RTN","DGO THRP1",162 ,0) | |
4994 | ...I $G(D IRUT) S EX IT=1 G EXI T ;User e xited the report | |
4995 | "RTN","DGO THRP1",163 ,0) | |
4996 | ...S PAGE =PAGE+1 D PRTHDR | |
4997 | "RTN","DGO THRP1",164 ,0) | |
4998 | .. Q:EXIT | |
4999 | "RTN","DGO THRP1",165 ,0) | |
5000 | .. W !,$P (DGARR(I,J ),U),?23,$ P(DGARR(I, J),U,2),?3 1,$S($E($P (DGARR(I,J ),U,3),1)= "A":"R",1: $E($P(DGAR R(I,J),U,3 ),1)),?36, $P(DGARR(I ,J),U,4),? 55,$E($$GE T1^DIQ(200 ,$P(DGARR( I,J),U,5)_ ",",.01),1 ,20) | |
5001 | "RTN","DGO THRP1",166 ,0) | |
5002 | Q | |
5003 | "RTN","DGO THRP1",167 ,0) | |
5004 | ; | |
5005 | "RTN","DGO THRP1",168 ,0) | |
5006 | DATESEL ; select st arting and ending da tes in day s | |
5007 | "RTN","DGO THRP1",169 ,0) | |
5008 | ; return s DGSTDT a nd DGDTEND | |
5009 | "RTN","DGO THRP1",170 ,0) | |
5010 | N %,%DT,% H,%I,DEFAU LT,X,Y,DES CR | |
5011 | "RTN","DGO THRP1",171 ,0) | |
5012 | STARTDT S DESCR="" | |
5013 | "RTN","DGO THRP1",172 ,0) | |
5014 | S Y=$E(DT ,1,5)_"01" D DD^%DT S DEFAULT= Y | |
5015 | "RTN","DGO THRP1",173 ,0) | |
5016 | S %DT("A" )="Start w ith "_$S(D ESCR'="":D ESCR_" ",1 :"")_"Date : ",%DT="A EP",%DT(0) =-DT D ^%D T I Y<0,X' ="^" W !? 25,"A date is requir ed" G STAR TDT | |
5017 | "RTN","DGO THRP1",174 ,0) | |
5018 | I X="^" W !!?20,"Ex iting as p er request " S EXIT=1 Q ; Vari able X con tains the actual ent ry from th e User. | |
5019 | "RTN","DGO THRP1",175 ,0) | |
5020 | I $E(Y,6, 7)="00" S Y=$E(Y,1,5 )_"01" | |
5021 | "RTN","DGO THRP1",176 ,0) | |
5022 | S DGSTDT= Y | |
5023 | "RTN","DGO THRP1",177 ,0) | |
5024 | S Y=DT D DD^%DT S D EFAULT=Y | |
5025 | "RTN","DGO THRP1",178 ,0) | |
5026 | S %DT("A" )=" End w ith "_$S(D ESCR'="":D ESCR_" ",1 :"")_"Date : ",%DT("B ")=DEFAULT ,%DT="AEP" ,%DT(0)=-D T D ^%DT I Y<0 Q | |
5027 | "RTN","DGO THRP1",179 ,0) | |
5028 | I $E(Y,6, 7)="00" S Y=$E(Y,1,5 )_"01" | |
5029 | "RTN","DGO THRP1",180 ,0) | |
5030 | I Y<DGSTD T W !,"END DATE MUST BE GREATE R THAN OR EQUAL TO T HE START D ATE.",! G STARTDT | |
5031 | "RTN","DGO THRP1",181 ,0) | |
5032 | S DGDTEND =Y,Y=DGSTD T D DD^%DT | |
5033 | "RTN","DGO THRP1",182 ,0) | |
5034 | Q | |
5035 | "RTN","DGO THRP1",183 ,0) | |
5036 | INADEV ; | |
5037 | "RTN","DGO THRP1",184 ,0) | |
5038 | N DIR,DIR UT,Y | |
5039 | "RTN","DGO THRP1",185 ,0) | |
5040 | W ! S %Z IS="Q" D ^ %ZIS I POP Q | |
5041 | "RTN","DGO THRP1",186 ,0) | |
5042 | I $D(IO(" Q")) D D ^%ZTLOAD K IO("Q"),Z TSK Q | |
5043 | "RTN","DGO THRP1",187 ,0) | |
5044 | . S ZTDES C="Other t han Honora ble Except ion Inacti vation rep ort",ZTRTN ="INAEN^DG OTHRP1" | |
5045 | "RTN","DGO THRP1",188 ,0) | |
5046 | . S ZTSAV E("DGSTDT" )="",ZTSAV E("DGDTEND ")="",ZTSA VE("ZTREQ" )="@" | |
5047 | "RTN","DGO THRP1",189 ,0) | |
5048 | I $G(ZTSK ) W !!,"Re port compi lation has started w ith task# ",ZTSK,"." ,! S DIR(0 )="E" D ^D IR K DIR | |
5049 | "RTN","DGO THRP1",190 ,0) | |
5050 | Q | |
5051 | "RTN","DGO THRP1",191 ,0) | |
5052 | EXIT ; | |
5053 | "RTN","DGO THRP1",192 ,0) | |
5054 | Q | |
5055 | "RTN","DGO THRP1",193 ,0) | |
5056 | ; | |
5057 | "RTN","DGO THRP1",194 ,0) | |
5058 | ;END OF D GOTHRP1 | |
5059 | "RTN","DGO THRP2") | |
5060 | 0^9^B37660 217 | |
5061 | "RTN","DGO THRP2",1,0 ) | |
5062 | DGOTHRP2 ; SLC/RM - O TH PATIENT PERIOD ST ATUS REPOR T CONT. ;M AY 8, 2018 @5:15 | |
5063 | "RTN","DGO THRP2",2,0 ) | |
5064 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
5065 | "RTN","DGO THRP2",3,0 ) | |
5066 | ;;Per VA Directive 6402, this routine s hould not be modifie d | |
5067 | "RTN","DGO THRP2",4,0 ) | |
5068 | ; | |
5069 | "RTN","DGO THRP2",5,0 ) | |
5070 | ; Las t Edited: SHRPE/RM - MAY 8, 20 18 17:15 | |
5071 | "RTN","DGO THRP2",6,0 ) | |
5072 | ; | |
5073 | "RTN","DGO THRP2",7,0 ) | |
5074 | ; ICR# TY PE DE SCRIPTION | |
5075 | "RTN","DGO THRP2",8,0 ) | |
5076 | ;----- -- -- -- ---------- --------- | |
5077 | "RTN","DGO THRP2",9,0 ) | |
5078 | ;10024 Su p WA IT^DICD | |
5079 | "RTN","DGO THRP2",10, 0) | |
5080 | ;10063 Su p $$ S^%ZTLOAD | |
5081 | "RTN","DGO THRP2",11, 0) | |
5082 | ;10086 Su p HO ME^%ZIS | |
5083 | "RTN","DGO THRP2",12, 0) | |
5084 | ;10089 Su p ^% ZISC | |
5085 | "RTN","DGO THRP2",13, 0) | |
5086 | ;10103 Su p ^X LFDT: $$FM TE, $$NOW | |
5087 | "RTN","DGO THRP2",14, 0) | |
5088 | ;10112 Su p $$ SITE^VASIT E | |
5089 | "RTN","DGO THRP2",15, 0) | |
5090 | ;10015/20 56 Sup G ETS^DIQ | |
5091 | "RTN","DGO THRP2",16, 0) | |
5092 | ;10026 Su p ^D IR | |
5093 | "RTN","DGO THRP2",17, 0) | |
5094 | ;6873 Co nt Sub $$ OTHDCLCK^D GOTHD | |
5095 | "RTN","DGO THRP2",18, 0) | |
5096 | ; | |
5097 | "RTN","DGO THRP2",19, 0) | |
5098 | ;This rou tine will be used to display o r print Ot her Than H onorable | |
5099 | "RTN","DGO THRP2",20, 0) | |
5100 | ;Active 9 0-Day Peri od Status | |
5101 | "RTN","DGO THRP2",21, 0) | |
5102 | ; | |
5103 | "RTN","DGO THRP2",22, 0) | |
5104 | ; INPUT: DGSORT() - see comm ents at th e top of r outine DGO THRPT for | |
5105 | "RTN","DGO THRP2",23, 0) | |
5106 | ; explanati on of DGSO RT array | |
5107 | "RTN","DGO THRP2",24, 0) | |
5108 | ; | |
5109 | "RTN","DGO THRP2",25, 0) | |
5110 | ; Output: A format ted report of Other Than Honor able | |
5111 | "RTN","DGO THRP2",26, 0) | |
5112 | ; Active 9 0-Day Peri od Status | |
5113 | "RTN","DGO THRP2",27, 0) | |
5114 | ; | |
5115 | "RTN","DGO THRP2",28, 0) | |
5116 | ;- no dir ect entry | |
5117 | "RTN","DGO THRP2",29, 0) | |
5118 | Q | |
5119 | "RTN","DGO THRP2",30, 0) | |
5120 | ; | |
5121 | "RTN","DGO THRP2",31, 0) | |
5122 | START ; co mpile and print repo rt | |
5123 | "RTN","DGO THRP2",32, 0) | |
5124 | I $E(IOST )="C" D WA IT^DICD | |
5125 | "RTN","DGO THRP2",33, 0) | |
5126 | N HERE S HERE=$$SIT E^VASITE ; extract th e IEN and facility n ame | |
5127 | "RTN","DGO THRP2",34, 0) | |
5128 | N TRM S T RM=($E(IOS T)="C") | |
5129 | "RTN","DGO THRP2",35, 0) | |
5130 | N DGLIST ;temp glob al name us ed for rep ort list | |
5131 | "RTN","DGO THRP2",36, 0) | |
5132 | S DGLIST= $NA(^TMP(" DGOTHR2",$ J)) | |
5133 | "RTN","DGO THRP2",37, 0) | |
5134 | K @DGLIST | |
5135 | "RTN","DGO THRP2",38, 0) | |
5136 | D LOOP(.D GSORT,DGLI ST) | |
5137 | "RTN","DGO THRP2",39, 0) | |
5138 | D PRINT(. DGSORT,DGL IST) | |
5139 | "RTN","DGO THRP2",40, 0) | |
5140 | K @DGLIST | |
5141 | "RTN","DGO THRP2",41, 0) | |
5142 | W !! | |
5143 | "RTN","DGO THRP2",42, 0) | |
5144 | D EXIT | |
5145 | "RTN","DGO THRP2",43, 0) | |
5146 | Q | |
5147 | "RTN","DGO THRP2",44, 0) | |
5148 | ; | |
5149 | "RTN","DGO THRP2",45, 0) | |
5150 | LOOP(DGSOR T,DGLIST) ; | |
5151 | "RTN","DGO THRP2",46, 0) | |
5152 | N DGDFN,D GDIEN,DGQ, DGRES,DGIE N,DGOLD,DG TOTAL | |
5153 | "RTN","DGO THRP2",47, 0) | |
5154 | ;loop var iable poin ter flag x -ref file to run rep ort | |
5155 | "RTN","DGO THRP2",48, 0) | |
5156 | S (DGDFN, DGIEN,DGOL D)="",(DGT OTAL,DGQ)= 0 | |
5157 | "RTN","DGO THRP2",49, 0) | |
5158 | F S DGDF N=$O(^DGOT H(33,"B",D GDFN)) Q:D GDFN="" D | |
5159 | "RTN","DGO THRP2",50, 0) | |
5160 | . N DGARR ,DGIEN33,D FN,DGRES,D GPTSTAT,DG 90A,DGERR, DGLS365D,D GLS365I | |
5161 | "RTN","DGO THRP2",51, 0) | |
5162 | . S DGRES =$$OTHDCLC K^DGOTHD(D GDFN,DT) | |
5163 | "RTN","DGO THRP2",52, 0) | |
5164 | . ;quit i f | |
5165 | "RTN","DGO THRP2",53, 0) | |
5166 | . ; - mis sing 365 o r 90 Day p eriod | |
5167 | "RTN","DGO THRP2",54, 0) | |
5168 | . ; - VBA ADJUDICAT ION has be en COMPLET ED | |
5169 | "RTN","DGO THRP2",55, 0) | |
5170 | . ; - OTH D clock ha s been ina ctivated | |
5171 | "RTN","DGO THRP2",56, 0) | |
5172 | . ; - OTH ER THAN HO NORABLE el igibility has been r emoved | |
5173 | "RTN","DGO THRP2",57, 0) | |
5174 | . Q:$P(DG RES,U)<1 | |
5175 | "RTN","DGO THRP2",58, 0) | |
5176 | . S DGIEN 33=$O(^DGO TH(33,"B", DGDFN,0)) | |
5177 | "RTN","DGO THRP2",59, 0) | |
5178 | . D GETS^ DIQ(33,DGI EN33_","," .01;.02;.0 3;1*","EI" ,"DGARR"," DGERR") | |
5179 | "RTN","DGO THRP2",60, 0) | |
5180 | . S DFN=$ G(DGARR(33 ,DGIEN33_" ,",.01,"I" )) | |
5181 | "RTN","DGO THRP2",61, 0) | |
5182 | . D CLOCK (DGIEN33) | |
5183 | "RTN","DGO THRP2",62, 0) | |
5184 | . I $P(DG SORT("DGST ATUS"),U)= 1 D ACTIVE (.DGSORT,D GLIST,DGRE S,DFN,DGIE N33,.DGARR ,.DG90A) | |
5185 | "RTN","DGO THRP2",63, 0) | |
5186 | Q | |
5187 | "RTN","DGO THRP2",64, 0) | |
5188 | ; | |
5189 | "RTN","DGO THRP2",65, 0) | |
5190 | CLOCK(DGIE N33) ; | |
5191 | "RTN","DGO THRP2",66, 0) | |
5192 | N DGN | |
5193 | "RTN","DGO THRP2",67, 0) | |
5194 | S DGLS365 D=+$O(^DGO TH(33,DGIE N33,1,"B", 999),-1) | |
5195 | "RTN","DGO THRP2",68, 0) | |
5196 | S DGLS365 I=+$O(^DGO TH(33,DGIE N33,1,"B", DGLS365D,0 )) | |
5197 | "RTN","DGO THRP2",69, 0) | |
5198 | S DGN=0 F S DGN=+$ O(^DGOTH(3 3,DGIEN33, 1,DGLS365I ,1,"B",DGN )) Q:DGN=0 D | |
5199 | "RTN","DGO THRP2",70, 0) | |
5200 | . S DG90A (DGN)=+$O( ^DGOTH(33, DGIEN33,1, DGLS365I,1 ,"B",DGN,0 )) | |
5201 | "RTN","DGO THRP2",71, 0) | |
5202 | . S DGCLC K=DGN | |
5203 | "RTN","DGO THRP2",72, 0) | |
5204 | Q | |
5205 | "RTN","DGO THRP2",73, 0) | |
5206 | ; | |
5207 | "RTN","DGO THRP2",74, 0) | |
5208 | ACTIVE(DGS ORT,DGLIST ,DGRES,DFN ,DGIEN33,D GARR,DG90A ) ; | |
5209 | "RTN","DGO THRP2",75, 0) | |
5210 | N DGPTNM, DGSSN,DGAU TH,DGIENS, I,DGTMP,DG SSN,DGERR | |
5211 | "RTN","DGO THRP2",76, 0) | |
5212 | S DGPTNM= DGARR(33,D GIEN33_"," ,.01,"E") | |
5213 | "RTN","DGO THRP2",77, 0) | |
5214 | S DGSSN=$ $GET1^DIQ( 2,DFN_",", .0905,""," DGERR") | |
5215 | "RTN","DGO THRP2",78, 0) | |
5216 | ; | |
5217 | "RTN","DGO THRP2",79, 0) | |
5218 | I $D(DG90 A(1)) D | |
5219 | "RTN","DGO THRP2",80, 0) | |
5220 | . I $P(DG RES,U,5)>0 ,$$FIRST(D GRES) D | |
5221 | "RTN","DGO THRP2",81, 0) | |
5222 | . . S DGI ENS=DG90A( 1)_","_$P( DGRES,U)_" ,"_+DGIEN3 3_"," | |
5223 | "RTN","DGO THRP2",82, 0) | |
5224 | . . S DGA UTH=$S($G( DGARR(33.1 1,DGIENS,. 07,"E"))=" ":"N/A",1: $G(DGARR(3 3.11,DGIEN S,.07,"E") )) | |
5225 | "RTN","DGO THRP2",83, 0) | |
5226 | . . S DGT MP=1_U_DGS SN_U_$$FMT E^XLFDT($P (DGRES,U,3 ),"5Z")_U_ $$FMTE^XLF DT($P(DGRE S,U,4),"5Z ")_U_$P(DG RES,U,5)_U _DGAUTH | |
5227 | "RTN","DGO THRP2",84, 0) | |
5228 | . . D SOR T(DGTMP,DG PTNM,1,DGR ES) | |
5229 | "RTN","DGO THRP2",85, 0) | |
5230 | I $D(DG90 A(2)) D | |
5231 | "RTN","DGO THRP2",86, 0) | |
5232 | . I $P(DG RES,U,8)>0 ,$$SECOND( DGRES) D | |
5233 | "RTN","DGO THRP2",87, 0) | |
5234 | . . S DGI ENS=DG90A( 2)_","_$P( DGRES,U)_" ,"_+DGIEN3 3_"," | |
5235 | "RTN","DGO THRP2",88, 0) | |
5236 | . . S DGA UTH=$S($G( DGARR(33.1 1,DGIENS,. 07,"E"))=" ":"N/A",1: $G(DGARR(3 3.11,DGIEN S,.07,"E") )) | |
5237 | "RTN","DGO THRP2",89, 0) | |
5238 | . . S DGT MP=2_U_DGS SN_U_$$FMT E^XLFDT($P (DGRES,U,6 ),"5Z")_U_ $$FMTE^XLF DT($P(DGRE S,U,7),"5Z ")_U_$P(DG RES,U,8)_U _DGAUTH | |
5239 | "RTN","DGO THRP2",90, 0) | |
5240 | . . D SOR T(DGTMP,DG PTNM,2,DGR ES) | |
5241 | "RTN","DGO THRP2",91, 0) | |
5242 | Q | |
5243 | "RTN","DGO THRP2",92, 0) | |
5244 | ; | |
5245 | "RTN","DGO THRP2",93, 0) | |
5246 | SORT(DGTMP ,DGPTNM,DG CLCK,DGRES ) ; | |
5247 | "RTN","DGO THRP2",94, 0) | |
5248 | I $P(DGSO RT("DGSRTB Y"),U)=1 S @DGLIST@( DGPTNM,DGC LCK)=DGTMP | |
5249 | "RTN","DGO THRP2",95, 0) | |
5250 | I $P(DGSO RT("DGSRTB Y"),U)=2 S @DGLIST@( DGCLCK,DGP TNM)=DGTMP | |
5251 | "RTN","DGO THRP2",96, 0) | |
5252 | I $P(DGSO RT("DGSRTB Y"),U)=3 D | |
5253 | "RTN","DGO THRP2",97, 0) | |
5254 | . I DGCLC K=1 S @DGL IST@($P(DG RES,U,5),D GPTNM)=DGT MP | |
5255 | "RTN","DGO THRP2",98, 0) | |
5256 | . I DGCLC K=2 S @DGL IST@($P(DG RES,U,8),D GPTNM)=DGT MP | |
5257 | "RTN","DGO THRP2",99, 0) | |
5258 | I DGOLD'= DGPTNM S D GTOTAL=DGT OTAL+1,DGO LD=DGPTNM | |
5259 | "RTN","DGO THRP2",100 ,0) | |
5260 | I DGTOTAL >0 S @DGLI ST@("DGTOT AL")=DGTOT AL | |
5261 | "RTN","DGO THRP2",101 ,0) | |
5262 | Q | |
5263 | "RTN","DGO THRP2",102 ,0) | |
5264 | ; | |
5265 | "RTN","DGO THRP2",103 ,0) | |
5266 | FIRST(DGRE S) ;check if dates f all within the Begin and End d ates | |
5267 | "RTN","DGO THRP2",104 ,0) | |
5268 | Q DGSORT( "DGBEG")<= $P(DGRES,U ,4)&(DGSOR T("DGEND") >=$P(DGRES ,U,4)) | |
5269 | "RTN","DGO THRP2",105 ,0) | |
5270 | ; | |
5271 | "RTN","DGO THRP2",106 ,0) | |
5272 | SECOND(DGR ES) ;check if dates fall withi n the Begi n and End dates | |
5273 | "RTN","DGO THRP2",107 ,0) | |
5274 | Q DGSORT( "DGBEG")<= $P(DGRES,U ,7)&(DGSOR T("DGEND") >=$P(DGRES ,U,7)) | |
5275 | "RTN","DGO THRP2",108 ,0) | |
5276 | ; | |
5277 | "RTN","DGO THRP2",109 ,0) | |
5278 | PRINT(DGSO RT,DGLIST) ;output r eport | |
5279 | "RTN","DGO THRP2",110 ,0) | |
5280 | N DGPAGE, DDASH,DGQ, DGSUB1,DGS UB2,DGSUB3 ,DGSTR,DGO LD,DGTOTAL | |
5281 | "RTN","DGO THRP2",111 ,0) | |
5282 | S (DGQ,DG PAGE,DGTOT AL)=0,$P(D DASH,"-",8 1)="" | |
5283 | "RTN","DGO THRP2",112 ,0) | |
5284 | S DGTOTAL =$G(@DGLIS T@("DGTOTA L")) | |
5285 | "RTN","DGO THRP2",113 ,0) | |
5286 | I $O(@DGL IST@(""))= "" D Q | |
5287 | "RTN","DGO THRP2",114 ,0) | |
5288 | . D HEAD | |
5289 | "RTN","DGO THRP2",115 ,0) | |
5290 | . W !!," >>> No Rec ord were f ound using the repor t criteria .",! | |
5291 | "RTN","DGO THRP2",116 ,0) | |
5292 | ; | |
5293 | "RTN","DGO THRP2",117 ,0) | |
5294 | ; loop an d print re port | |
5295 | "RTN","DGO THRP2",118 ,0) | |
5296 | S (DGSUB1 ,DGSUB2,DG SUB3,DGSTR ,DGOLD)="" | |
5297 | "RTN","DGO THRP2",119 ,0) | |
5298 | D HEAD | |
5299 | "RTN","DGO THRP2",120 ,0) | |
5300 | F S DGSU B1=$O(@DGL IST@(DGSUB 1)) Q:DGSU B1="" D Q:DGQ | |
5301 | "RTN","DGO THRP2",121 ,0) | |
5302 | . F S DG SUB2=$O(@D GLIST@(DGS UB1,DGSUB2 )) Q:DGSUB 2="" D Q :DGQ | |
5303 | "RTN","DGO THRP2",122 ,0) | |
5304 | . . S DGS TR=$G(@DGL IST@(DGSUB 1,DGSUB2)) | |
5305 | "RTN","DGO THRP2",123 ,0) | |
5306 | . . W ! | |
5307 | "RTN","DGO THRP2",124 ,0) | |
5308 | . . I $Y> (IOSL-4) D PAUSE(.DG Q) Q:DGQ D HEAD W ! | |
5309 | "RTN","DGO THRP2",125 ,0) | |
5310 | . . I $P( DGSORT("DG SRTBY"),U) =1,DGSUB1' =DGOLD W $ E(DGSUB1,1 ,19),?21,$ P(DGSTR,U, 2) S DGOLD =DGSUB1 | |
5311 | "RTN","DGO THRP2",126 ,0) | |
5312 | . . I $P( DGSORT("DG SRTBY"),U) =2!($P(DGS ORT("DGSRT BY"),U)=3) ,DGSUB2'=D GOLD W $E( DGSUB2,1,1 9),?21,$P( DGSTR,U,2) S DGOLD=D GSUB2 | |
5313 | "RTN","DGO THRP2",127 ,0) | |
5314 | . . W ?28 ,$P(DGSTR, U),?32,$P( DGSTR,U,3) ,?44,$P(DG STR,U,4),? 56,$P(DGST R,U,5),?62 ,$E($P(DGS TR,U,6),1, 15) | |
5315 | "RTN","DGO THRP2",128 ,0) | |
5316 | . Q:DGQ | |
5317 | "RTN","DGO THRP2",129 ,0) | |
5318 | W !!,"Tot al Active OTH Patien ts from ", $$FMTE^XLF DT($G(DGSO RT("DGBEG" )),"5Z") | |
5319 | "RTN","DGO THRP2",130 ,0) | |
5320 | W " to ", $$FMTE^XLF DT($G(DGSO RT("DGEND" )),"5Z")," :",$J($S(D GTOTAL>0:D GTOTAL,1:0 ),6),! | |
5321 | "RTN","DGO THRP2",131 ,0) | |
5322 | Q | |
5323 | "RTN","DGO THRP2",132 ,0) | |
5324 | ; | |
5325 | "RTN","DGO THRP2",133 ,0) | |
5326 | HEAD ;Prin t/Display Page Heade r | |
5327 | "RTN","DGO THRP2",134 ,0) | |
5328 | I $D(ZTQU EUED),$$S^ %ZTLOAD S (ZTSTOP,DG Q)=1 Q | |
5329 | "RTN","DGO THRP2",135 ,0) | |
5330 | N DGFACLT Y | |
5331 | "RTN","DGO THRP2",136 ,0) | |
5332 | I TRM!('T RM&DGPAGE) W @IOF | |
5333 | "RTN","DGO THRP2",137 ,0) | |
5334 | S DGPAGE= $G(DGPAGE) +1 | |
5335 | "RTN","DGO THRP2",138 ,0) | |
5336 | S DGFACLT Y="Facilit y: "_$P(HE RE,U,2) | |
5337 | "RTN","DGO THRP2",139 ,0) | |
5338 | W ?71,"Pa ge:",?77,D GPAGE | |
5339 | "RTN","DGO THRP2",140 ,0) | |
5340 | W !,?80-$ L(ZTDESC)\ 2,$G(ZTDES C),!,?80-$ L(DGFACLTY )\2,DGFACL TY | |
5341 | "RTN","DGO THRP2",141 ,0) | |
5342 | W !,"Date Range:",? 12,$$FMTE^ XLFDT(DGSO RT("DGBEG" ),"5Z")_" TO "_$$FMT E^XLFDT(DG SORT("DGEN D"),"5Z") | |
5343 | "RTN","DGO THRP2",142 ,0) | |
5344 | W ?48,"So rted By:", ?59,$E($P( $G(DGSORT( "DGSRTBY") ),U,2),9,$ L($P($G(DG SORT("DGSR TBY")),U,2 ))) | |
5345 | "RTN","DGO THRP2",143 ,0) | |
5346 | W !,"Stat us :",? 12,$P($G(D GSORT("DGS TATUS")),U ,2) | |
5347 | "RTN","DGO THRP2",144 ,0) | |
5348 | W ?48,"Pr inted :", ?59,$$FMTE ^XLFDT($$N OW^XLFDT," MP") | |
5349 | "RTN","DGO THRP2",145 ,0) | |
5350 | W !,DDASH | |
5351 | "RTN","DGO THRP2",146 ,0) | |
5352 | W !,"PATI ENT NAME", ?21,"PID", ?27,"PRD", ?32,"START DATE",?44 ,"END DATE ",?56,"DAY S",?62,"AU THORIZED B Y" | |
5353 | "RTN","DGO THRP2",147 ,0) | |
5354 | W !,?56," LEFT" | |
5355 | "RTN","DGO THRP2",148 ,0) | |
5356 | W !,DDASH | |
5357 | "RTN","DGO THRP2",149 ,0) | |
5358 | Q | |
5359 | "RTN","DGO THRP2",150 ,0) | |
5360 | ; | |
5361 | "RTN","DGO THRP2",151 ,0) | |
5362 | PAUSE(DGQ) ; pause s creen disp lay | |
5363 | "RTN","DGO THRP2",152 ,0) | |
5364 | ; Input: | |
5365 | "RTN","DGO THRP2",153 ,0) | |
5366 | ; DGQ - v ar used to quit repo rt process ing to use r CRT | |
5367 | "RTN","DGO THRP2",154 ,0) | |
5368 | ; Output: | |
5369 | "RTN","DGO THRP2",155 ,0) | |
5370 | ; DGQ - p assed by r eference - 0 = Conti nue, 1 = Q uit | |
5371 | "RTN","DGO THRP2",156 ,0) | |
5372 | ; | |
5373 | "RTN","DGO THRP2",157 ,0) | |
5374 | I $G(DGPA GE)>0,TRM K DIR S DI R(0)="E" D ^DIR K DI R S:+Y=0 D GQ=1 | |
5375 | "RTN","DGO THRP2",158 ,0) | |
5376 | Q | |
5377 | "RTN","DGO THRP2",159 ,0) | |
5378 | ; | |
5379 | "RTN","DGO THRP2",160 ,0) | |
5380 | EXIT ; | |
5381 | "RTN","DGO THRP2",161 ,0) | |
5382 | I $D(ZTQU EUED) S ZT REQ="@" ; tell TaskM an to dele te Task lo g entry | |
5383 | "RTN","DGO THRP2",162 ,0) | |
5384 | I '$D(ZTQ UEUED) D | |
5385 | "RTN","DGO THRP2",163 ,0) | |
5386 | . I 'TRM, $Y>0 W @IO F | |
5387 | "RTN","DGO THRP2",164 ,0) | |
5388 | . K %ZIS, POP | |
5389 | "RTN","DGO THRP2",165 ,0) | |
5390 | . D ^%ZIS C,HOME^%ZI S | |
5391 | "RTN","DGO THRP2",166 ,0) | |
5392 | Q | |
5393 | "RTN","DGO THRP3") | |
5394 | 0^11^B1997 17857 | |
5395 | "RTN","DGO THRP3",1,0 ) | |
5396 | DGOTHRP3 ; SLC/RM - O TH PATIENT PERIOD ST ATUS REPOR T CONT. ;M AY 8, 2018 @5:15 | |
5397 | "RTN","DGO THRP3",2,0 ) | |
5398 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
5399 | "RTN","DGO THRP3",3,0 ) | |
5400 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
5401 | "RTN","DGO THRP3",4,0 ) | |
5402 | ; | |
5403 | "RTN","DGO THRP3",5,0 ) | |
5404 | ; Las t Edited: SHRPE/RM - MAY 8, 20 18 17:15 | |
5405 | "RTN","DGO THRP3",6,0 ) | |
5406 | ; | |
5407 | "RTN","DGO THRP3",7,0 ) | |
5408 | ; ICR# TY PE DE SCRIPTION | |
5409 | "RTN","DGO THRP3",8,0 ) | |
5410 | ;----- -- -- -- ---------- --------- | |
5411 | "RTN","DGO THRP3",9,0 ) | |
5412 | ;10024 Su p WA IT^DICD | |
5413 | "RTN","DGO THRP3",10, 0) | |
5414 | ;10063 Su p $$ S^%ZTLOAD | |
5415 | "RTN","DGO THRP3",11, 0) | |
5416 | ;10086 Su p HO ME^%ZIS | |
5417 | "RTN","DGO THRP3",12, 0) | |
5418 | ;10089 Su p ^% ZISC | |
5419 | "RTN","DGO THRP3",13, 0) | |
5420 | ;10103 Su p ^X LFDT: $$FM TE, $$NOW | |
5421 | "RTN","DGO THRP3",14, 0) | |
5422 | ;10112 Su p $$ SITE^VASIT E | |
5423 | "RTN","DGO THRP3",15, 0) | |
5424 | ;10015 Su p GE TS^DIQ | |
5425 | "RTN","DGO THRP3",16, 0) | |
5426 | ;10026 Su p ^D IR | |
5427 | "RTN","DGO THRP3",17, 0) | |
5428 | ;6873 Co nt Sub $$ OTHDCLCK^D GOTHD | |
5429 | "RTN","DGO THRP3",18, 0) | |
5430 | ; | |
5431 | "RTN","DGO THRP3",19, 0) | |
5432 | ;This rou tine will be used to display o r print Ot her Than H onorable | |
5433 | "RTN","DGO THRP3",20, 0) | |
5434 | ;patient treated un der OTH au thority. | |
5435 | "RTN","DGO THRP3",21, 0) | |
5436 | ; | |
5437 | "RTN","DGO THRP3",22, 0) | |
5438 | ; INPUT: DGSORT() - see comm ents at th e top of r outine DGO THRPT for | |
5439 | "RTN","DGO THRP3",23, 0) | |
5440 | ; explanati on of DGSO RT array | |
5441 | "RTN","DGO THRP3",24, 0) | |
5442 | ; | |
5443 | "RTN","DGO THRP3",25, 0) | |
5444 | ; Output: A format ted report of Other Than Honor able Stati stical Rep ort | |
5445 | "RTN","DGO THRP3",26, 0) | |
5446 | ; | |
5447 | "RTN","DGO THRP3",27, 0) | |
5448 | ;- no dir ect entry | |
5449 | "RTN","DGO THRP3",28, 0) | |
5450 | Q | |
5451 | "RTN","DGO THRP3",29, 0) | |
5452 | ; | |
5453 | "RTN","DGO THRP3",30, 0) | |
5454 | START ; co mpile and print repo rt | |
5455 | "RTN","DGO THRP3",31, 0) | |
5456 | I $E(IOST )="C" D WA IT^DICD | |
5457 | "RTN","DGO THRP3",32, 0) | |
5458 | N HERE S HERE=$$SIT E^VASITE ; extract th e IEN and facility n ame | |
5459 | "RTN","DGO THRP3",33, 0) | |
5460 | N TRM S T RM=($E(IOS T)="C") | |
5461 | "RTN","DGO THRP3",34, 0) | |
5462 | N DGLIST ;temp glob al name us ed for rep ort list | |
5463 | "RTN","DGO THRP3",35, 0) | |
5464 | N DGQRT ;array or report pa rameters f or quarter s | |
5465 | "RTN","DGO THRP3",36, 0) | |
5466 | S DGLIST= $NA(^TMP(" DGOTHST",$ J)) | |
5467 | "RTN","DGO THRP3",37, 0) | |
5468 | N DGCNT,D GNET | |
5469 | "RTN","DGO THRP3",38, 0) | |
5470 | K @DGLIST | |
5471 | "RTN","DGO THRP3",39, 0) | |
5472 | S (DGCNT, DGNET)=0 | |
5473 | "RTN","DGO THRP3",40, 0) | |
5474 | D LOOP(.D GSORT,DGLI ST) | |
5475 | "RTN","DGO THRP3",41, 0) | |
5476 | D PRINT1( .DGSORT,DG LIST,.DGCN T) ;by mon th or all month in t he quarter s | |
5477 | "RTN","DGO THRP3",42, 0) | |
5478 | K @DGLIST | |
5479 | "RTN","DGO THRP3",43, 0) | |
5480 | W ! | |
5481 | "RTN","DGO THRP3",44, 0) | |
5482 | D EXIT^DG OTHRP2 | |
5483 | "RTN","DGO THRP3",45, 0) | |
5484 | Q | |
5485 | "RTN","DGO THRP3",46, 0) | |
5486 | ; | |
5487 | "RTN","DGO THRP3",47, 0) | |
5488 | LOOP(DGSOR T,DGLIST) ; | |
5489 | "RTN","DGO THRP3",48, 0) | |
5490 | I 123[$P( DGSORT("DG MON"),U) D LOOP2(.DG SORT,DGLIS T) Q ;by month | |
5491 | "RTN","DGO THRP3",49, 0) | |
5492 | I 4[$P(DG SORT("DGMO N"),U) D L OOP1(.DGSO RT,DGLIST) Q ;all m onth in th e quarter | |
5493 | "RTN","DGO THRP3",50, 0) | |
5494 | I 5[$P(DG SORT("DGMO N"),U) D L OOP3(.DGSO RT,DGLIST) ;fiscal year | |
5495 | "RTN","DGO THRP3",51, 0) | |
5496 | Q | |
5497 | "RTN","DGO THRP3",52, 0) | |
5498 | ; | |
5499 | "RTN","DGO THRP3",53, 0) | |
5500 | LOOP1(DGSO RT,DGLIST) ; | |
5501 | "RTN","DGO THRP3",54, 0) | |
5502 | ; If 4[$P (DGSORT("D GMON"),U) | |
5503 | "RTN","DGO THRP3",55, 0) | |
5504 | ; - Th en, build DGSORT("DG BEG") and DGSORT("DG END") | |
5505 | "RTN","DGO THRP3",56, 0) | |
5506 | ; fo r each mon th on the fly | |
5507 | "RTN","DGO THRP3",57, 0) | |
5508 | N DGMON,I I | |
5509 | "RTN","DGO THRP3",58, 0) | |
5510 | S II="" F S II=$O( DGSORT("DG MON",II)) Q:II="" D | |
5511 | "RTN","DGO THRP3",59, 0) | |
5512 | . S DGMON =$$CALRNGE ^DGOTHRPT( .DGSORT,"" ,II) | |
5513 | "RTN","DGO THRP3",60, 0) | |
5514 | . S DGSOR T("DGBEG") =$P(DGMON, U) | |
5515 | "RTN","DGO THRP3",61, 0) | |
5516 | . S DGSOR T("DGEND") =$P(DGMON, U,2) | |
5517 | "RTN","DGO THRP3",62, 0) | |
5518 | . D LOOP2 (.DGSORT,D GLIST) | |
5519 | "RTN","DGO THRP3",63, 0) | |
5520 | Q | |
5521 | "RTN","DGO THRP3",64, 0) | |
5522 | ; | |
5523 | "RTN","DGO THRP3",65, 0) | |
5524 | LOOP2(DGSO RT,DGLIST) ; | |
5525 | "RTN","DGO THRP3",66, 0) | |
5526 | N DGDFN,D GDIEN,DGQ, DGRES,DGIE N,DGOLD,DG QNUM | |
5527 | "RTN","DGO THRP3",67, 0) | |
5528 | ;loop var iable poin ter flag x -ref file to run rep ort | |
5529 | "RTN","DGO THRP3",68, 0) | |
5530 | S (DGDFN, DGIEN,DGOL D)="",DGQ= 0 | |
5531 | "RTN","DGO THRP3",69, 0) | |
5532 | F S DGDF N=$O(^DGOT H(33,"B",D GDFN)) Q:D GDFN="" D | |
5533 | "RTN","DGO THRP3",70, 0) | |
5534 | . N DGARR ,DGIEN33,D FN,DGRES,D GPTSTAT,DG 90A,DGOSTA T | |
5535 | "RTN","DGO THRP3",71, 0) | |
5536 | . S DGIEN 33=$O(^DGO TH(33,"B", DGDFN,0)), (DGRES,DGO STAT)=0 | |
5537 | "RTN","DGO THRP3",72, 0) | |
5538 | . D CLOCK ^DGOTHRP2( DGIEN33) | |
5539 | "RTN","DGO THRP3",73, 0) | |
5540 | . Q:'$D(D G90A) ;no 90 days p eriods for the 365 d ays period | |
5541 | "RTN","DGO THRP3",74, 0) | |
5542 | . Q:'$D(D G90A(1)) ;missing t he 1st 90 days perio d for the 365 days p eriod | |
5543 | "RTN","DGO THRP3",75, 0) | |
5544 | . D GETS^ DIQ(33,DGI EN33_","," .01;.02;.0 3;.06;.07; .08;.09;1* ","EI","DG ARR","DGER R") | |
5545 | "RTN","DGO THRP3",76, 0) | |
5546 | . S DGRES =$$RESULT( .DGARR,.DG 90A,DGIEN3 3) | |
5547 | "RTN","DGO THRP3",77, 0) | |
5548 | . S DGRES =$$INEXRPT (DGRES,.DG SORT,.DG90 A) | |
5549 | "RTN","DGO THRP3",78, 0) | |
5550 | . Q:DGRES <1 | |
5551 | "RTN","DGO THRP3",79, 0) | |
5552 | . S DFN=$ G(DGARR(33 ,DGIEN33_" ,",.01,"I" )) | |
5553 | "RTN","DGO THRP3",80, 0) | |
5554 | . D SORT( .DGSORT,DG LIST,DGRES ,DFN,DGIEN 33,.DGARR, .DG90A) | |
5555 | "RTN","DGO THRP3",81, 0) | |
5556 | Q | |
5557 | "RTN","DGO THRP3",82, 0) | |
5558 | ; | |
5559 | "RTN","DGO THRP3",83, 0) | |
5560 | LOOP3(DGSO RT,DGLIST) ;Fiscal y ear detail | |
5561 | "RTN","DGO THRP3",84, 0) | |
5562 | ; If 5[$P (DGSORT("D GMON"),U) | |
5563 | "RTN","DGO THRP3",85, 0) | |
5564 | ; - Th en, build DGSORT("DG BEG") and DGSORT("DG END") | |
5565 | "RTN","DGO THRP3",86, 0) | |
5566 | ; fo r each mon th in the quarter on the fly | |
5567 | "RTN","DGO THRP3",87, 0) | |
5568 | N DGMON,D GQRTR,M,Q | |
5569 | "RTN","DGO THRP3",88, 0) | |
5570 | S Q="" F S Q=$O(DG SORT("DGMO N",Q)) Q:Q ="" D | |
5571 | "RTN","DGO THRP3",89, 0) | |
5572 | . S M="" F S M=$O( DGSORT("DG MON",Q,M)) Q:M="" D | |
5573 | "RTN","DGO THRP3",90, 0) | |
5574 | . . S DGM ON=$$CALRN GE^DGOTHRP T(.DGSORT, Q,M) | |
5575 | "RTN","DGO THRP3",91, 0) | |
5576 | . . S DGS ORT("DGBEG ")=$P(DGMO N,U) | |
5577 | "RTN","DGO THRP3",92, 0) | |
5578 | . . S DGS ORT("DGEND ")=$P(DGMO N,U,2) | |
5579 | "RTN","DGO THRP3",93, 0) | |
5580 | . . S DGQ RTR=Q | |
5581 | "RTN","DGO THRP3",94, 0) | |
5582 | . . D LOO P2(.DGSORT ,DGLIST) | |
5583 | "RTN","DGO THRP3",95, 0) | |
5584 | Q | |
5585 | "RTN","DGO THRP3",96, 0) | |
5586 | ; | |
5587 | "RTN","DGO THRP3",97, 0) | |
5588 | RESULT(DGA RR,DG90A,D GIEN33) ;g et the res ult for OT H patient | |
5589 | "RTN","DGO THRP3",98, 0) | |
5590 | ; | |
5591 | "RTN","DGO THRP3",99, 0) | |
5592 | N DGIENS, DGDATE,DGP 1,I,II | |
5593 | "RTN","DGO THRP3",100 ,0) | |
5594 | S DGRES=" " | |
5595 | "RTN","DGO THRP3",101 ,0) | |
5596 | S DGDATE= $S($G(DGDA TE)>0:DGDA TE,1:DT) | |
5597 | "RTN","DGO THRP3",102 ,0) | |
5598 | F I=1:1:D GLS365D D | |
5599 | "RTN","DGO THRP3",103 ,0) | |
5600 | . S DGRET (I)="" | |
5601 | "RTN","DGO THRP3",104 ,0) | |
5602 | . F II=1: 1:DGCLCK D | |
5603 | "RTN","DGO THRP3",105 ,0) | |
5604 | . . N DGS DT,DGENDT, DGDIFF | |
5605 | "RTN","DGO THRP3",106 ,0) | |
5606 | . . S DGI ENS=DG90A( II)_","_+D GLS365I_", "_+DGIEN33 _"," | |
5607 | "RTN","DGO THRP3",107 ,0) | |
5608 | . . S DGS DT=DGARR(3 3.11,DGIEN S,.02,"I") ;start da te | |
5609 | "RTN","DGO THRP3",108 ,0) | |
5610 | . . S DGE NDT=$$FMAD D^XLFDT(DG SDT,90) ;e nd date | |
5611 | "RTN","DGO THRP3",109 ,0) | |
5612 | . . ;days remaining | |
5613 | "RTN","DGO THRP3",110 ,0) | |
5614 | . . S DGD IFF=$S(DGD ATE<DGSDT: $$FMDIFF^X LFDT(DGEND T,DGSDT,1) ,DGDATE=DG SDT!(DGDAT E>DGSDT):$ $FMDIFF^XL FDT(DGENDT ,DGDATE,1) ,1:0) | |
5615 | "RTN","DGO THRP3",111 ,0) | |
5616 | . . I DGD IFF<0 S DG DIFF=0 | |
5617 | "RTN","DGO THRP3",112 ,0) | |
5618 | . . S DGR ES=DGRES_D GSDT_U_DGE NDT_U_DGDI FF_U | |
5619 | "RTN","DGO THRP3",113 ,0) | |
5620 | . . S DGR ET(I,II)=D GSDT_U_DGE NDT_U_DGDI FF | |
5621 | "RTN","DGO THRP3",114 ,0) | |
5622 | . . ;dete rmine whic h clock is considere d "active" within th e current 365-Day pe riod | |
5623 | "RTN","DGO THRP3",115 ,0) | |
5624 | . . I DGD IFF>0,DGDI FF<90 S DG RET(I)=II | |
5625 | "RTN","DGO THRP3",116 ,0) | |
5626 | Q DGRES | |
5627 | "RTN","DGO THRP3",117 ,0) | |
5628 | ; | |
5629 | "RTN","DGO THRP3",118 ,0) | |
5630 | INEXRPT(DG RES,DGSORT ,DG90A) ; | |
5631 | "RTN","DGO THRP3",119 ,0) | |
5632 | ;check if OTH Patie nt will be included or | |
5633 | "RTN","DGO THRP3",120 ,0) | |
5634 | ;excluded into the statistica l report | |
5635 | "RTN","DGO THRP3",121 ,0) | |
5636 | N DGPTST, DGINDT,DGP RD1,DGPRD2 ,DG5,DGP8, DGOK1,DGOK 2 | |
5637 | "RTN","DGO THRP3",122 ,0) | |
5638 | S (DGPTST ,DGPRD1,DG PRD2,DGIND T,DGP8,DGO K1,DGOK2)= 0 | |
5639 | "RTN","DGO THRP3",123 ,0) | |
5640 | I $D(DG90 A(1)),$$PO CDT(DGRES, .DGSORT,3, 4) S DGPRD 1=1 ;withi n or equal to the da te range s pecified b y the user | |
5641 | "RTN","DGO THRP3",124 ,0) | |
5642 | I $D(DG90 A(2)),$$PO CDT(DGRES, .DGSORT,6, 7) S DGPRD 2=1 ;withi n or equal to the da te range s pecified b y the user | |
5643 | "RTN","DGO THRP3",125 ,0) | |
5644 | I 'DGPRD1 ,'DGPRD2 Q 0 | |
5645 | "RTN","DGO THRP3",126 ,0) | |
5646 | ; 1 = Act ive | |
5647 | "RTN","DGO THRP3",127 ,0) | |
5648 | ; 2 = Adj udicated | |
5649 | "RTN","DGO THRP3",128 ,0) | |
5650 | ; 3 = Ina ctivated w /o adjudic ation | |
5651 | "RTN","DGO THRP3",129 ,0) | |
5652 | S DGPTST= $$STATUS^D GOTHRI(.DG ARR) ;OTH patient cl ock status | |
5653 | "RTN","DGO THRP3",130 ,0) | |
5654 | ;get the inactivati on date if there is one | |
5655 | "RTN","DGO THRP3",131 ,0) | |
5656 | I 23[DGPT ST D | |
5657 | "RTN","DGO THRP3",132 ,0) | |
5658 | . S DGIND T=$G(DGARR (33,DGIEN3 3_",",.06, "I")) ;mea ns patient received adjudicati on | |
5659 | "RTN","DGO THRP3",133 ,0) | |
5660 | . I DGIND T="" S DGI NDT=$G(DGA RR(33,DGIE N33_",",.0 8,"I")) ;m eans patie nt get ina ctivated w ithout adj udication | |
5661 | "RTN","DGO THRP3",134 ,0) | |
5662 | ;compare the beg an d end date of the 90 -day perio d of care to the ina ctivation date. | |
5663 | "RTN","DGO THRP3",135 ,0) | |
5664 | ;if inact ivation da te is with in or equa l to the b eg and end date of t he 90-day period of care | |
5665 | "RTN","DGO THRP3",136 ,0) | |
5666 | ;include the patien t into the statistic al report | |
5667 | "RTN","DGO THRP3",137 ,0) | |
5668 | I DGPRD1 D | |
5669 | "RTN","DGO THRP3",138 ,0) | |
5670 | . I 23[DG PTST D | |
5671 | "RTN","DGO THRP3",139 ,0) | |
5672 | . . I (DG INDT>=$P(D GRES,U,3)) &(DGINDT<= $P(DGRES,U ,4))&($$CH KINDT) S D GOK1=1 | |
5673 | "RTN","DGO THRP3",140 ,0) | |
5674 | . . I (DG INDT>$P(DG RES,U,4))& (DGINDT<$P (DGRES,U,6 ))&($$CHKI NDT) S DGO K1=1 | |
5675 | "RTN","DGO THRP3",141 ,0) | |
5676 | . . I DGI NDT>=$P(DG RES,U,6)&( $$CHKINDT) S DGOK1=1 | |
5677 | "RTN","DGO THRP3",142 ,0) | |
5678 | . I 1[DGP TST S DGOK 1=1 | |
5679 | "RTN","DGO THRP3",143 ,0) | |
5680 | ; | |
5681 | "RTN","DGO THRP3",144 ,0) | |
5682 | I DGPRD2 D | |
5683 | "RTN","DGO THRP3",145 ,0) | |
5684 | . I 23[DG PTST D | |
5685 | "RTN","DGO THRP3",146 ,0) | |
5686 | . . I DGI NDT>=$P(DG RES,U,6)&( $$CHKINDT) S DGOK2=1 | |
5687 | "RTN","DGO THRP3",147 ,0) | |
5688 | . I 1[DGP TST S DGOK 2=1 | |
5689 | "RTN","DGO THRP3",148 ,0) | |
5690 | S DGRES=D GRES_U_DGI NDT_U_DGOK 1_U_DGOK2 | |
5691 | "RTN","DGO THRP3",149 ,0) | |
5692 | Q DGRES | |
5693 | "RTN","DGO THRP3",150 ,0) | |
5694 | ; | |
5695 | "RTN","DGO THRP3",151 ,0) | |
5696 | CHKINDT() ; | |
5697 | "RTN","DGO THRP3",152 ,0) | |
5698 | ;check th e inactiva tion date if it fall s within t he date ra nge. | |
5699 | "RTN","DGO THRP3",153 ,0) | |
5700 | ;If not, do not dis play the O TH Patient name. | |
5701 | "RTN","DGO THRP3",154 ,0) | |
5702 | I (DGINDT >=(DGSORT( "DGBEG"))) Q 1 | |
5703 | "RTN","DGO THRP3",155 ,0) | |
5704 | Q 0 | |
5705 | "RTN","DGO THRP3",156 ,0) | |
5706 | ; | |
5707 | "RTN","DGO THRP3",157 ,0) | |
5708 | POCDT(DGRE S,DGSORT,D GP1,DGP2) ; | |
5709 | "RTN","DGO THRP3",158 ,0) | |
5710 | ;check if period of care date s fall wit hin the da te range s pecified b y the user | |
5711 | "RTN","DGO THRP3",159 ,0) | |
5712 | N OK | |
5713 | "RTN","DGO THRP3",160 ,0) | |
5714 | S OK=0 | |
5715 | "RTN","DGO THRP3",161 ,0) | |
5716 | S:$P(DGRE S,U,DGP1)> =(DGSORT(" DGBEG"))&( $P(DGRES,U ,DGP1)<=(D GSORT("DGE ND"))) OK= 1 | |
5717 | "RTN","DGO THRP3",162 ,0) | |
5718 | S:$P(DGRE S,U,DGP2)> =(DGSORT(" DGBEG"))&( $P(DGRES,U ,DGP2)<=(D GSORT("DGE ND"))) OK= 1 | |
5719 | "RTN","DGO THRP3",163 ,0) | |
5720 | S:$P(DGRE S,U,DGP1)< =(DGSORT(" DGEND"))&( $P(DGRES,U ,DGP2)>=(D GSORT("DGE ND"))) OK= 1 | |
5721 | "RTN","DGO THRP3",164 ,0) | |
5722 | Q OK | |
5723 | "RTN","DGO THRP3",165 ,0) | |
5724 | ; | |
5725 | "RTN","DGO THRP3",166 ,0) | |
5726 | SORT(DGSOR T,DGLIST,D GRES,DFN,D GIEN33,DGA RR,DG90A) ; | |
5727 | "RTN","DGO THRP3",167 ,0) | |
5728 | N DGPTNM, DGSSN,DGAU TH,DGIENS, I,DGTMP,DG SSN,DGSTAT ,DGVBA,DGM ON,DGERR | |
5729 | "RTN","DGO THRP3",168 ,0) | |
5730 | S DGPTNM= DGARR(33,D GIEN33_"," ,.01,"E") | |
5731 | "RTN","DGO THRP3",169 ,0) | |
5732 | S DGSSN=$ $GET1^DIQ( 2,DFN_",", .0905,""," DGERR") | |
5733 | "RTN","DGO THRP3",170 ,0) | |
5734 | ; | |
5735 | "RTN","DGO THRP3",171 ,0) | |
5736 | ;DGRES $P ^10: | |
5737 | "RTN","DGO THRP3",172 ,0) | |
5738 | ; 0 - in dicates pa tient is a ctive | |
5739 | "RTN","DGO THRP3",173 ,0) | |
5740 | ; >0 - in dicates pa tient has been inact ivated (wi ll contain FM date) | |
5741 | "RTN","DGO THRP3",174 ,0) | |
5742 | ;DGRES $P ^11 and $P ^12 : | |
5743 | "RTN","DGO THRP3",175 ,0) | |
5744 | ; 1 indic ates to di splay the 1st/2nd 90 -Day POC | |
5745 | "RTN","DGO THRP3",176 ,0) | |
5746 | ; 0 not d isplay | |
5747 | "RTN","DGO THRP3",177 ,0) | |
5748 | I $P(DGRE S,U,11) D | |
5749 | "RTN","DGO THRP3",178 ,0) | |
5750 | . S DGIEN S=DG90A(1) _","_$P(DG RES,U)_"," _+DGIEN33_ "," | |
5751 | "RTN","DGO THRP3",179 ,0) | |
5752 | . S DGAUT H=$S($G(DG ARR(33.11, DGIENS,.07 ,"E"))="": "N/A",1:$G (DGARR(33. 11,DGIENS, .07,"E"))) | |
5753 | "RTN","DGO THRP3",180 ,0) | |
5754 | . S DGTMP =1_U_DGSSN _U_$$FMTE^ XLFDT($P(D GRES,U,3), "5Z")_U_$$ FMTE^XLFDT ($P(DGRES, U,4),"5Z") _U_$P(DGRE S,U,5)_U_D GAUTH | |
5755 | "RTN","DGO THRP3",181 ,0) | |
5756 | . S DGTMP =DGTMP_U_$ S($P(DGRES ,U,10)>0:$ $FMTE^XLFD T($P(DGRES ,U,10),"5Z "),1:"") | |
5757 | "RTN","DGO THRP3",182 ,0) | |
5758 | . D BLD(D GTMP,DGPTN M,$P(DGRES ,U,3),.DGS ORT,1,DFN) ;display the 1st 90 -Day | |
5759 | "RTN","DGO THRP3",183 ,0) | |
5760 | ; | |
5761 | "RTN","DGO THRP3",184 ,0) | |
5762 | I $P(DGRE S,U,12) D | |
5763 | "RTN","DGO THRP3",185 ,0) | |
5764 | . S DGIEN S=DG90A(2) _","_$P(DG RES,U)_"," _+DGIEN33_ "," | |
5765 | "RTN","DGO THRP3",186 ,0) | |
5766 | . S DGAUT H=$S($G(DG ARR(33.11, DGIENS,.07 ,"E"))="": "N/A",1:$G (DGARR(33. 11,DGIENS, .07,"E"))) | |
5767 | "RTN","DGO THRP3",187 ,0) | |
5768 | . S DGTMP =2_U_DGSSN _U_$$FMTE^ XLFDT($P(D GRES,U,6), "5Z")_U_$$ FMTE^XLFDT ($P(DGRES, U,7),"5Z") _U_$P(DGRE S,U,8)_U_D GAUTH | |
5769 | "RTN","DGO THRP3",188 ,0) | |
5770 | . S DGTMP =DGTMP_U_$ S($P(DGRES ,U,10)>0:$ $FMTE^XLFD T($P(DGRES ,U,10),"5Z "),1:"") | |
5771 | "RTN","DGO THRP3",189 ,0) | |
5772 | . D BLD(D GTMP,DGPTN M,$P(DGRES ,U,6),.DGS ORT,2,DFN) ;display the 2nd 90 -Day | |
5773 | "RTN","DGO THRP3",190 ,0) | |
5774 | Q | |
5775 | "RTN","DGO THRP3",191 ,0) | |
5776 | ; | |
5777 | "RTN","DGO THRP3",192 ,0) | |
5778 | BLD(DGTMP, DGPTNM,DGS TDT,DGSORT ,DGCLCK,DF N) ; | |
5779 | "RTN","DGO THRP3",193 ,0) | |
5780 | D MONCNT( .DGSORT,DG TMP,DGPTNM ,DGSTDT,DG CLCK,DFN) | |
5781 | "RTN","DGO THRP3",194 ,0) | |
5782 | Q | |
5783 | "RTN","DGO THRP3",195 ,0) | |
5784 | ; | |
5785 | "RTN","DGO THRP3",196 ,0) | |
5786 | MONCNT(DGS ORT,DGTMP, DGPTNM,DGS TDT,DGCLCK ,DFN) ; | |
5787 | "RTN","DGO THRP3",197 ,0) | |
5788 | ;build an d count th e new and old oth pa tients by monthly | |
5789 | "RTN","DGO THRP3",198 ,0) | |
5790 | N DGMON,D GVASSN | |
5791 | "RTN","DGO THRP3",199 ,0) | |
5792 | S DGMON=+ $E(DGSTDT, 4,5) | |
5793 | "RTN","DGO THRP3",200 ,0) | |
5794 | I DGSORT( "DGBEG")<= DGSTDT,(DG SORT("DGEN D"))>=DGST DT D | |
5795 | "RTN","DGO THRP3",201 ,0) | |
5796 | . D BLDNE W(DGPTNM,D GMON,DGCLC K,DGTMP) | |
5797 | "RTN","DGO THRP3",202 ,0) | |
5798 | . S DGCNT ("NEW")=$G (DGCNT("NE W"))+1 | |
5799 | "RTN","DGO THRP3",203 ,0) | |
5800 | . I 45[$P (DGSORT("D GMON"),U) S DGCNT("N EW",DGMON) =$G(DGCNT( "NEW",DGMO N))+1 | |
5801 | "RTN","DGO THRP3",204 ,0) | |
5802 | E D | |
5803 | "RTN","DGO THRP3",205 ,0) | |
5804 | . I $P(DG RES,U,11), $P(DGRES,U ,12) D BLD NEW(DGPTNM ,+$E($P(DG RES,U,4),4 ,5),DGCLCK ,DGTMP) Q | |
5805 | "RTN","DGO THRP3",206 ,0) | |
5806 | . D BLDOL D(DGPTNM,D GMON,DGCLC K,DGTMP) | |
5807 | "RTN","DGO THRP3",207 ,0) | |
5808 | . S DGCNT ("OLD")=$G (DGCNT("OL D"))+1 | |
5809 | "RTN","DGO THRP3",208 ,0) | |
5810 | . I 45[$P (DGSORT("D GMON"),U) D | |
5811 | "RTN","DGO THRP3",209 ,0) | |
5812 | . . I DGC LCK=1 S DG MON=+$E($P (DGRES,U,4 ),4,5) | |
5813 | "RTN","DGO THRP3",210 ,0) | |
5814 | . . I DGC LCK=2 S DG MON=+$E($P (DGRES,U,7 ),4,5) | |
5815 | "RTN","DGO THRP3",211 ,0) | |
5816 | . . S DGC NT("OLD",+ $E(DGSORT( "DGBEG"),4 ,5))=$G(DG CNT("OLD", +$E(DGSORT ("DGBEG"), 4,5)))+1 | |
5817 | "RTN","DGO THRP3",212 ,0) | |
5818 | S DGCNT=$ G(DGCNT("N EW"))+$G(D GCNT("OLD" )) | |
5819 | "RTN","DGO THRP3",213 ,0) | |
5820 | I 5[$P(DG SORT("DGMO N"),U) D | |
5821 | "RTN","DGO THRP3",214 ,0) | |
5822 | . D DEM^V ADPT | |
5823 | "RTN","DGO THRP3",215 ,0) | |
5824 | . I '$D(D GNET($P(VA DM(2),U),D GPTNM)) D | |
5825 | "RTN","DGO THRP3",216 ,0) | |
5826 | . . S DGN ET($P(VADM (2),U),DGP TNM)="" | |
5827 | "RTN","DGO THRP3",217 ,0) | |
5828 | . . S DGN ET=DGNET+1 | |
5829 | "RTN","DGO THRP3",218 ,0) | |
5830 | Q | |
5831 | "RTN","DGO THRP3",219 ,0) | |
5832 | ; | |
5833 | "RTN","DGO THRP3",220 ,0) | |
5834 | BLDNEW(DGP TNM,DGMON, DGCLCK,DGT MP) ; | |
5835 | "RTN","DGO THRP3",221 ,0) | |
5836 | S @DGLIST @("NEW",$S (1234[$P(D GSORT("DGM ON"),U):$P (DGSORT("D GQTR"),U), 1:DGQRTR), DGMON,DGPT NM,DGCLCK) =DGTMP | |
5837 | "RTN","DGO THRP3",222 ,0) | |
5838 | Q | |
5839 | "RTN","DGO THRP3",223 ,0) | |
5840 | ; | |
5841 | "RTN","DGO THRP3",224 ,0) | |
5842 | BLDOLD(DGP TNM,DGMON, DGCLCK,DGT MP) ; | |
5843 | "RTN","DGO THRP3",225 ,0) | |
5844 | I DGCLCK= 1 S DGMON= +$E($P(DGR ES,U,4),4, 5) | |
5845 | "RTN","DGO THRP3",226 ,0) | |
5846 | I DGCLCK= 2 S DGMON= +$E($P(DGR ES,U,7),4, 5) | |
5847 | "RTN","DGO THRP3",227 ,0) | |
5848 | S @DGLIST @("OLD",$S (1234[$P(D GSORT("DGM ON"),U):$P (DGSORT("D GQTR"),U), 1:DGQRTR), +$E(DGSORT ("DGBEG"), 4,5),DGPTN M,DGCLCK)= DGTMP | |
5849 | "RTN","DGO THRP3",228 ,0) | |
5850 | Q | |
5851 | "RTN","DGO THRP3",229 ,0) | |
5852 | ; | |
5853 | "RTN","DGO THRP3",230 ,0) | |
5854 | PRINT1(DGS ORT,DGLIST ,DGCNT) ;d isplay by month or m onth in th e quarter | |
5855 | "RTN","DGO THRP3",231 ,0) | |
5856 | N DGPAGE, DDASH,DGFL G,DGQ,DGST DT,DGPTNM, DGSTR,DGOL D,DGMON | |
5857 | "RTN","DGO THRP3",232 ,0) | |
5858 | N DGPR1,D GPR2,DGSTA T,DGMNAME, DGP1TOT,DG P2TOT,DGQR TR,DGC1,DG C2 | |
5859 | "RTN","DGO THRP3",233 ,0) | |
5860 | S (DGQ,DG PAGE)=0,(D DASH,DGLN) ="",$P(DDA SH,"-",81) ="" | |
5861 | "RTN","DGO THRP3",234 ,0) | |
5862 | I $O(@DGL IST@(""))= "" D Q | |
5863 | "RTN","DGO THRP3",235 ,0) | |
5864 | . D HEAD | |
5865 | "RTN","DGO THRP3",236 ,0) | |
5866 | . W !!," >>> No Rec ords were found usin g the repo rt criteri a.",! | |
5867 | "RTN","DGO THRP3",237 ,0) | |
5868 | ; loop an d display report | |
5869 | "RTN","DGO THRP3",238 ,0) | |
5870 | S (DGPR1, DGPR2,DGC1 ,DGC2,DGP1 TOT,DGP2TO T)=0 | |
5871 | "RTN","DGO THRP3",239 ,0) | |
5872 | S (DGCLCK ,DGPTNM,DG STR,DGOLD, DGMON,DGST AT,DGMNAME ,DGQRTR)=" " | |
5873 | "RTN","DGO THRP3",240 ,0) | |
5874 | F S DGST AT=$O(@DGL IST@(DGSTA T)) Q:DGST AT="" D Q:DGQ | |
5875 | "RTN","DGO THRP3",241 ,0) | |
5876 | . F S DG QRTR=$O(@D GLIST@(DGS TAT,DGQRTR )) Q:DGQRT R="" D Q :DGQ | |
5877 | "RTN","DGO THRP3",242 ,0) | |
5878 | . . ; | |
5879 | "RTN","DGO THRP3",243 ,0) | |
5880 | . . I 123 4[$P(DGSOR T("DGMON") ,U) D | |
5881 | "RTN","DGO THRP3",244 ,0) | |
5882 | . . . F S DGMON=$O (@DGLIST@( DGSTAT,DGQ RTR,DGMON) ) Q:DGMON= "" D Q:D GQ | |
5883 | "RTN","DGO THRP3",245 ,0) | |
5884 | . . . . I 123[$P(DG SORT("DGMO N"),U) S D GMNAME=$P( DGSORT("DG MON"),U,2) D HEAD | |
5885 | "RTN","DGO THRP3",246 ,0) | |
5886 | . . . . I 45[$P(DGS ORT("DGMON "),U) D | |
5887 | "RTN","DGO THRP3",247 ,0) | |
5888 | . . . . . S DGMNAME =$P(DGSORT ("DGMON",D GMON),U) | |
5889 | "RTN","DGO THRP3",248 ,0) | |
5890 | . . . . . I DGSTAT= "OLD" Q | |
5891 | "RTN","DGO THRP3",249 ,0) | |
5892 | . . . . . D HEAD | |
5893 | "RTN","DGO THRP3",250 ,0) | |
5894 | . . . . W ! D SUBHE AD(DGSTAT, DGMNAME) | |
5895 | "RTN","DGO THRP3",251 ,0) | |
5896 | . . . . D PRINT2 | |
5897 | "RTN","DGO THRP3",252 ,0) | |
5898 | . . ; | |
5899 | "RTN","DGO THRP3",253 ,0) | |
5900 | . . I 5[$ P(DGSORT(" DGMON"),U) D | |
5901 | "RTN","DGO THRP3",254 ,0) | |
5902 | . . . I D GSTAT="OLD " Q | |
5903 | "RTN","DGO THRP3",255 ,0) | |
5904 | . . . F S DGMON=$O (DGSORT("D GMON",DGQR TR,DGMON)) Q:DGMON=" " D Q:DG Q | |
5905 | "RTN","DGO THRP3",256 ,0) | |
5906 | . . . . S DGMNAME=$ P(DGSORT(" DGMON",DGQ RTR,DGMON) ,U) | |
5907 | "RTN","DGO THRP3",257 ,0) | |
5908 | . . . . D HEAD | |
5909 | "RTN","DGO THRP3",258 ,0) | |
5910 | . . . . W ! D SUBHE AD(DGSTAT, DGMNAME) | |
5911 | "RTN","DGO THRP3",259 ,0) | |
5912 | . . . . D PRINT2 | |
5913 | "RTN","DGO THRP3",260 ,0) | |
5914 | . . Q:DGQ | |
5915 | "RTN","DGO THRP3",261 ,0) | |
5916 | . Q:DGQ | |
5917 | "RTN","DGO THRP3",262 ,0) | |
5918 | ; | |
5919 | "RTN","DGO THRP3",263 ,0) | |
5920 | I DGQ W:$ D(ZTQUEUED ) !!,"REPO RT STOPPED AT USER R EQUEST" Q | |
5921 | "RTN","DGO THRP3",264 ,0) | |
5922 | N DGLN,DG TOTQ,DGTOT P1,DGTOTP2 ,DGGRND | |
5923 | "RTN","DGO THRP3",265 ,0) | |
5924 | S DGLN="" | |
5925 | "RTN","DGO THRP3",266 ,0) | |
5926 | I $E(IOST )'="C" W ! | |
5927 | "RTN","DGO THRP3",267 ,0) | |
5928 | S (DGTOTQ ,DGTOTP1,D GTOTP2,DGG RND)=0 | |
5929 | "RTN","DGO THRP3",268 ,0) | |
5930 | I 123[$P( DGSORT("DG MON"),U) D MRPTSUM ;monthly r eport summ ary | |
5931 | "RTN","DGO THRP3",269 ,0) | |
5932 | ;quarterl y report s ummary | |
5933 | "RTN","DGO THRP3",270 ,0) | |
5934 | I 45[$P(D GSORT("DGM ON"),U) D CONT^DGOTH RP4(.DGSOR T) | |
5935 | "RTN","DGO THRP3",271 ,0) | |
5936 | W !!!,"<E ND OF REPO RT>" | |
5937 | "RTN","DGO THRP3",272 ,0) | |
5938 | Q | |
5939 | "RTN","DGO THRP3",273 ,0) | |
5940 | ; | |
5941 | "RTN","DGO THRP3",274 ,0) | |
5942 | PRINT2 ; | |
5943 | "RTN","DGO THRP3",275 ,0) | |
5944 | F S DGPT NM=$O(@DGL IST@(DGSTA T,DGQRTR,D GMON,DGPTN M)) Q:DGPT NM="" D Q:DGQ | |
5945 | "RTN","DGO THRP3",276 ,0) | |
5946 | . F S DG CLCK=$O(@D GLIST@(DGS TAT,DGQRTR ,DGMON,DGP TNM,DGCLCK )) Q:DGCLC K="" D Q :DGQ | |
5947 | "RTN","DGO THRP3",277 ,0) | |
5948 | . . S DGS TR=@DGLIST @(DGSTAT,D GQRTR,DGMO N,DGPTNM,D GCLCK) | |
5949 | "RTN","DGO THRP3",278 ,0) | |
5950 | . . I 45[ $P(DGSORT( "DGMON"),U ),DGSTAT=" OLD" Q | |
5951 | "RTN","DGO THRP3",279 ,0) | |
5952 | . . W ! | |
5953 | "RTN","DGO THRP3",280 ,0) | |
5954 | . . I $Y> (IOSL-4) D PAUSE^DGO THRP2(.DGQ ) Q:DGQ D HEAD W ! | |
5955 | "RTN","DGO THRP3",281 ,0) | |
5956 | . . I DGP TNM'=DGOLD D | |
5957 | "RTN","DGO THRP3",282 ,0) | |
5958 | . . . W $ E(DGPTNM,1 ,20),?23,$ P(DGSTR,U, 2) | |
5959 | "RTN","DGO THRP3",283 ,0) | |
5960 | . . . I 1 23[$P(DGSO RT("DGMON" ),U) D | |
5961 | "RTN","DGO THRP3",284 ,0) | |
5962 | . . . . ; D CALCFS(D GSTR,DGSTA T) ;calcu late how m any are in first and second 90 -day | |
5963 | "RTN","DGO THRP3",285 ,0) | |
5964 | . . . . ; count inac tivated OT H patients by month | |
5965 | "RTN","DGO THRP3",286 ,0) | |
5966 | . . . . D CALCIN(DG STR,DGSTAT ,DGMON) | |
5967 | "RTN","DGO THRP3",287 ,0) | |
5968 | . . . S D GOLD=DGPTN M ;display the name and PID on ly once | |
5969 | "RTN","DGO THRP3",288 ,0) | |
5970 | . . W ?31 ,$P(DGSTR, U),?37,$P( DGSTR,U,3) ,?49,$P(DG STR,U,4),? 61,$S($P(D GSTR,U,7)' ="":$J("N/ A",4),1:$J ($P(DGSTR, U,5),4)) | |
5971 | "RTN","DGO THRP3",289 ,0) | |
5972 | . D CALCF S(DGSTR,DG STAT) ;ca lculate ho w many are in first and second 90-day | |
5973 | "RTN","DGO THRP3",290 ,0) | |
5974 | . I 45[$P (DGSORT("D GMON"),U) D CALCIN(D GSTR,DGSTA T,DGMON) ; count inac tivated OT H patients by month in the qua rter | |
5975 | "RTN","DGO THRP3",291 ,0) | |
5976 | . I 45[$P (DGSORT("D GMON"),U), DGSTAT="OL D" Q | |
5977 | "RTN","DGO THRP3",292 ,0) | |
5978 | . W ?68,$ P(DGSTR,U, 7) | |
5979 | "RTN","DGO THRP3",293 ,0) | |
5980 | . Q:DGQ | |
5981 | "RTN","DGO THRP3",294 ,0) | |
5982 | ; | |
5983 | "RTN","DGO THRP3",295 ,0) | |
5984 | Q:DGQ | |
5985 | "RTN","DGO THRP3",296 ,0) | |
5986 | I DGCNT,D GSTAT="NEW " D | |
5987 | "RTN","DGO THRP3",297 ,0) | |
5988 | . N DGTIT | |
5989 | "RTN","DGO THRP3",298 ,0) | |
5990 | . S DGTIT ="New for "_DGMNAME_ " " | |
5991 | "RTN","DGO THRP3",299 ,0) | |
5992 | . W !!!,D GTIT,$J("= ",5) | |
5993 | "RTN","DGO THRP3",300 ,0) | |
5994 | . I 123[$ P(DGSORT(" DGMON"),U) D | |
5995 | "RTN","DGO THRP3",301 ,0) | |
5996 | . . W $S( $G(DGCNT(D GSTAT))>0: $J(DGCNT(D GSTAT),6), 1:$J(0,6)) ,! | |
5997 | "RTN","DGO THRP3",302 ,0) | |
5998 | . . D PAU SE^DGOTHRP 2(.DGQ) Q: DGQ | |
5999 | "RTN","DGO THRP3",303 ,0) | |
6000 | . E W $S ($G(DGCNT( DGSTAT,DGM ON))>0:$J( DGCNT(DGST AT,DGMON), $S($L(DGMN AME)<=5:9, ($L(DGMNAM E)>5)&($L( DGMNAME)<= 7):6,1:6)) ,1:$J(0,6) ) | |
6001 | "RTN","DGO THRP3",304 ,0) | |
6002 | . Q:DGQ | |
6003 | "RTN","DGO THRP3",305 ,0) | |
6004 | Q:DGQ | |
6005 | "RTN","DGO THRP3",306 ,0) | |
6006 | I 4[$P(DG SORT("DGMO N"),U),DGS TAT="OLD" Q | |
6007 | "RTN","DGO THRP3",307 ,0) | |
6008 | ;if user select fis cal year, before dis playing th e next mon th | |
6009 | "RTN","DGO THRP3",308 ,0) | |
6010 | ;check if the curre nt month e valuated h as a carry over entr y | |
6011 | "RTN","DGO THRP3",309 ,0) | |
6012 | I 5[$P(DG SORT("DGMO N"),U),$D( @DGLIST@(" OLD",DGQRT R,DGMON)) D | |
6013 | "RTN","DGO THRP3",310 ,0) | |
6014 | . W ! D P AUSE^DGOTH RP2(.DGQ) Q:DGQ | |
6015 | "RTN","DGO THRP3",311 ,0) | |
6016 | . D PRINT FY^DGOTHRP 4(.DGSORT, .DGLIST,DG QRTR,DGMON ,DGQ,DGMNA ME) | |
6017 | "RTN","DGO THRP3",312 ,0) | |
6018 | . Q:DGQ | |
6019 | "RTN","DGO THRP3",313 ,0) | |
6020 | Q:DGQ | |
6021 | "RTN","DGO THRP3",314 ,0) | |
6022 | I (DGSTAT ="OLD")!(4 5[$P(DGSOR T("DGMON") ,U)) D | |
6023 | "RTN","DGO THRP3",315 ,0) | |
6024 | . S DGTIT ="Carry ov er for "_D GMNAME | |
6025 | "RTN","DGO THRP3",316 ,0) | |
6026 | . I 123[$ P(DGSORT(" DGMON"),U) W !!!,DGT IT,":",$J( DGCNT("OLD "),10),! | |
6027 | "RTN","DGO THRP3",317 ,0) | |
6028 | . I 45[$P (DGSORT("D GMON"),U) D | |
6029 | "RTN","DGO THRP3",318 ,0) | |
6030 | . . W !,D GTIT,$J("= ",5) | |
6031 | "RTN","DGO THRP3",319 ,0) | |
6032 | . . I $D( DGCNT("OLD ",DGMON)) W $J(DGCNT ("OLD",DGM ON),$S($L( DGMNAME)<= 5:9,($L(DG MNAME)>5)& ($L(DGMNAM E)<=7):6,1 :6)) | |
6033 | "RTN","DGO THRP3",320 ,0) | |
6034 | . . E W $J(0,$S($L (DGMNAME)< =5:9,($L(D GMNAME)>5) &($L(DGMNA ME)<=7):6, 1:6)) | |
6035 | "RTN","DGO THRP3",321 ,0) | |
6036 | . . W ! | |
6037 | "RTN","DGO THRP3",322 ,0) | |
6038 | . . I 5[$ P(DGSORT(" DGMON"),U) Q | |
6039 | "RTN","DGO THRP3",323 ,0) | |
6040 | . . S $P( DGLN,"=",3 5)="" | |
6041 | "RTN","DGO THRP3",324 ,0) | |
6042 | . . W DGL N,!,"TOTAL ",$J(DGCNT (DGSTAT,DG MON)+$G(DG CNT("OLD", DGMON)),$S ($L(DGMNAM E)<=8:29,1 :28)),! | |
6043 | "RTN","DGO THRP3",325 ,0) | |
6044 | . D PAUSE ^DGOTHRP2( .DGQ) | |
6045 | "RTN","DGO THRP3",326 ,0) | |
6046 | . Q:DGQ | |
6047 | "RTN","DGO THRP3",327 ,0) | |
6048 | Q | |
6049 | "RTN","DGO THRP3",328 ,0) | |
6050 | ; | |
6051 | "RTN","DGO THRP3",329 ,0) | |
6052 | CALCFS(DGS TR,DGSTAT) ; | |
6053 | "RTN","DGO THRP3",330 ,0) | |
6054 | ;calculat e how many OTH patie nts that w ill start | |
6055 | "RTN","DGO THRP3",331 ,0) | |
6056 | ;treatmen t in the f irst and s econd 90-D ay | |
6057 | "RTN","DGO THRP3",332 ,0) | |
6058 | I DGSTAT= "OLD" D | |
6059 | "RTN","DGO THRP3",333 ,0) | |
6060 | . I $P(DG STR,U)=1 S DGC1=DGC1 +1 | |
6061 | "RTN","DGO THRP3",334 ,0) | |
6062 | . I $P(DG STR,U)=2 S DGC2=DGC2 +1 | |
6063 | "RTN","DGO THRP3",335 ,0) | |
6064 | E D | |
6065 | "RTN","DGO THRP3",336 ,0) | |
6066 | . I $P(DG STR,U)=1 S DGPR1=DGP R1+1 | |
6067 | "RTN","DGO THRP3",337 ,0) | |
6068 | . I $P(DG STR,U)=2 S DGPR2=DGP R2+1 | |
6069 | "RTN","DGO THRP3",338 ,0) | |
6070 | S DGP1TOT =DGPR1+DGC 1 | |
6071 | "RTN","DGO THRP3",339 ,0) | |
6072 | S DGP2TOT =DGPR2+DGC 2 | |
6073 | "RTN","DGO THRP3",340 ,0) | |
6074 | Q | |
6075 | "RTN","DGO THRP3",341 ,0) | |
6076 | ; | |
6077 | "RTN","DGO THRP3",342 ,0) | |
6078 | CALCIN(DGS TR,DGSTAT, DGMON) ;ca lculate in activated OTH patien ts | |
6079 | "RTN","DGO THRP3",343 ,0) | |
6080 | I $P(DGST R,U,7)'="" D | |
6081 | "RTN","DGO THRP3",344 ,0) | |
6082 | . I 123[$ P(DGSORT(" DGMON"),U) D | |
6083 | "RTN","DGO THRP3",345 ,0) | |
6084 | . . I DGS TAT="OLD" S DGCNT("I NCRY")=$G( DGCNT("INC RY"))+1 | |
6085 | "RTN","DGO THRP3",346 ,0) | |
6086 | . . E S DGCNT("INN EW")=$G(DG CNT("INNEW "))+1 | |
6087 | "RTN","DGO THRP3",347 ,0) | |
6088 | . I 45[$P (DGSORT("D GMON"),U) S DGCNT("I N",DGMON)= $G(DGCNT(" IN",DGMON) )+1 | |
6089 | "RTN","DGO THRP3",348 ,0) | |
6090 | Q | |
6091 | "RTN","DGO THRP3",349 ,0) | |
6092 | ; | |
6093 | "RTN","DGO THRP3",350 ,0) | |
6094 | MRPTSUM ;m onthly rep ort summar y | |
6095 | "RTN","DGO THRP3",351 ,0) | |
6096 | D HEAD | |
6097 | "RTN","DGO THRP3",352 ,0) | |
6098 | W !!,"New ly Registe red OTH Pa tients for the month of ",DGMN AME,":" | |
6099 | "RTN","DGO THRP3",353 ,0) | |
6100 | W !!,"REP ORT SUMMAR Y:" | |
6101 | "RTN","DGO THRP3",354 ,0) | |
6102 | W !!,?26, "1st 90-Da y",?40,"2n d 90-Day", ?54,"TOTAL ",?69,"INA CTIVATED" | |
6103 | "RTN","DGO THRP3",355 ,0) | |
6104 | S $P(DGLN ,"=",11)=" " W !,?26, DGLN,?40,D GLN,?54,"= ====" | |
6105 | "RTN","DGO THRP3",356 ,0) | |
6106 | S $P(DGLN ,"=",12)=" " W ?69,DG LN | |
6107 | "RTN","DGO THRP3",357 ,0) | |
6108 | W !!,"New for ",DGM NAME,":",? 26,$J(DGPR 1,6),?40,$ J(DGPR2,6) | |
6109 | "RTN","DGO THRP3",358 ,0) | |
6110 | W ?54,$S( $G(DGCNT(" NEW"))>0:$ J(DGCNT("N EW"),5),1: $J(0,5)) | |
6111 | "RTN","DGO THRP3",359 ,0) | |
6112 | W ?69,$S( $G(DGCNT(" INNEW"))>0 :$J(DGCNT( "INNEW"),6 ),1:$J(0,6 )) | |
6113 | "RTN","DGO THRP3",360 ,0) | |
6114 | W !,"Carr y over for ",DGMNAME ,":",?25,$ J(DGC1,7), ?39,$J(DGC 2,7) | |
6115 | "RTN","DGO THRP3",361 ,0) | |
6116 | W ?53,$S( $G(DGCNT(" OLD"))>0:$ J(DGCNT("O LD"),6),1: $J(0,6)) | |
6117 | "RTN","DGO THRP3",362 ,0) | |
6118 | W ?69,$S( $G(DGCNT(" INCRY"))>0 :$J(DGCNT( "INCRY"),6 ),1:$J(0,6 )) | |
6119 | "RTN","DGO THRP3",363 ,0) | |
6120 | W !,DDASH | |
6121 | "RTN","DGO THRP3",364 ,0) | |
6122 | W !,"TOTA L",?26,$J( DGP1TOT,6) ,?40,$J(DG P2TOT,6),? 54,$J(DGCN T,5),?69,$ J($G(DGCNT ("INNEW")) +$G(DGCNT( "INCRY")), 6) | |
6123 | "RTN","DGO THRP3",365 ,0) | |
6124 | Q | |
6125 | "RTN","DGO THRP3",366 ,0) | |
6126 | ; | |
6127 | "RTN","DGO THRP3",367 ,0) | |
6128 | MONAME ;Mo nth Name | |
6129 | "RTN","DGO THRP3",368 ,0) | |
6130 | ;;1^Janua ry | |
6131 | "RTN","DGO THRP3",369 ,0) | |
6132 | ;;2^Febru ary | |
6133 | "RTN","DGO THRP3",370 ,0) | |
6134 | ;;3^March | |
6135 | "RTN","DGO THRP3",371 ,0) | |
6136 | ;;4^April | |
6137 | "RTN","DGO THRP3",372 ,0) | |
6138 | ;;5^May | |
6139 | "RTN","DGO THRP3",373 ,0) | |
6140 | ;;6^June | |
6141 | "RTN","DGO THRP3",374 ,0) | |
6142 | ;;7^July | |
6143 | "RTN","DGO THRP3",375 ,0) | |
6144 | ;;8^Augus t | |
6145 | "RTN","DGO THRP3",376 ,0) | |
6146 | ;;9^Septe mber | |
6147 | "RTN","DGO THRP3",377 ,0) | |
6148 | ;;10^Octo ber | |
6149 | "RTN","DGO THRP3",378 ,0) | |
6150 | ;;11^Nove mber | |
6151 | "RTN","DGO THRP3",379 ,0) | |
6152 | ;;12^Dece mber | |
6153 | "RTN","DGO THRP3",380 ,0) | |
6154 | Q | |
6155 | "RTN","DGO THRP3",381 ,0) | |
6156 | ; | |
6157 | "RTN","DGO THRP3",382 ,0) | |
6158 | HEAD ;Prin t/Display Page Heade r Detail | |
6159 | "RTN","DGO THRP3",383 ,0) | |
6160 | I $D(ZTQU EUED),$$S^ %ZTLOAD S (ZTSTOP,DG Q)=1 Q | |
6161 | "RTN","DGO THRP3",384 ,0) | |
6162 | N DGFACLT Y,DGPRD | |
6163 | "RTN","DGO THRP3",385 ,0) | |
6164 | I TRM!('T RM&DGPAGE) W @IOF | |
6165 | "RTN","DGO THRP3",386 ,0) | |
6166 | S DGPAGE= $G(DGPAGE) +1 | |
6167 | "RTN","DGO THRP3",387 ,0) | |
6168 | S DGFACLT Y="Facilit y: "_$P(HE RE,U,2) | |
6169 | "RTN","DGO THRP3",388 ,0) | |
6170 | W !,?80-$ L(ZTDESC)\ 2,$G(ZTDES C),?71,"Pa ge:",?77,D GPAGE | |
6171 | "RTN","DGO THRP3",389 ,0) | |
6172 | W !,?80-$ L(DGFACLTY )\2,DGFACL TY ;facili ty | |
6173 | "RTN","DGO THRP3",390 ,0) | |
6174 | S DGPRD=" Report Per iod: "_$S( 123[$P(DGS ORT("DGMON "),U):"Mon th of "_$P (DGSORT("D GMON"),U,2 ),1:$P(DGS ORT("DGMON "),U,2)) | |
6175 | "RTN","DGO THRP3",391 ,0) | |
6176 | W !,?80-$ L(DGPRD)\2 ,DGPRD | |
6177 | "RTN","DGO THRP3",392 ,0) | |
6178 | W !,"Date Range:",? 12,DGDTRNG E | |
6179 | "RTN","DGO THRP3",393 ,0) | |
6180 | W ?45,"Da te Printed :",?59,$$F MTE^XLFDT( $$NOW^XLFD T,"MP") | |
6181 | "RTN","DGO THRP3",394 ,0) | |
6182 | W !,DDASH | |
6183 | "RTN","DGO THRP3",395 ,0) | |
6184 | W !,"PATI ENT NAME", ?23,"PID", ?29,"PERIO D",?37,"ST ART DATE", ?49,"END D ATE",?61," DAYS",?68, "INACTIVAT ION" | |
6185 | "RTN","DGO THRP3",396 ,0) | |
6186 | W !,?61," LEFT",?68, "DATE" | |
6187 | "RTN","DGO THRP3",397 ,0) | |
6188 | W !,DDASH | |
6189 | "RTN","DGO THRP3",398 ,0) | |
6190 | Q | |
6191 | "RTN","DGO THRP3",399 ,0) | |
6192 | ; | |
6193 | "RTN","DGO THRP3",400 ,0) | |
6194 | SUBHEAD(DG STAT,DGMNA ME) ;displ ay sub hea der | |
6195 | "RTN","DGO THRP3",401 ,0) | |
6196 | I 4[$P(DG SORT("DGMO N"),U),DGS TAT="OLD" Q | |
6197 | "RTN","DGO THRP3",402 ,0) | |
6198 | W !,$S(DG STAT="OLD" :"Carry-ov er OTH Pat ients for ",1:"OTH P atients th at started treatment in ") | |
6199 | "RTN","DGO THRP3",403 ,0) | |
6200 | W DGMNAME _":" | |
6201 | "RTN","DGO THRP3",404 ,0) | |
6202 | W ! | |
6203 | "RTN","DGO THRP3",405 ,0) | |
6204 | Q | |
6205 | "RTN","DGO THRP3",406 ,0) | |
6206 | ; | |
6207 | "RTN","DGO THRP3",407 ,0) | |
6208 | HELP ;prov ide extend ed DIR("?" ) help tex t. | |
6209 | "RTN","DGO THRP3",408 ,0) | |
6210 | ; | |
6211 | "RTN","DGO THRP3",409 ,0) | |
6212 | I X'="?", X'="??" W !," Not a valid fis cal year." ,! | |
6213 | "RTN","DGO THRP3",410 ,0) | |
6214 | W !," En ter the fi scal year in this fo rmat: YY o r YYYY" | |
6215 | "RTN","DGO THRP3",411 ,0) | |
6216 | Q | |
6217 | "RTN","DGO THRP3",412 ,0) | |
6218 | ; | |
6219 | "RTN","DGO THRP4") | |
6220 | 0^13^B2165 8061 | |
6221 | "RTN","DGO THRP4",1,0 ) | |
6222 | DGOTHRP4 ; SLC/RM - O TH PATIENT PERIOD ST ATUS REPOR T CONT. ;J uly 20, 20 18@5:15 | |
6223 | "RTN","DGO THRP4",2,0 ) | |
6224 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
6225 | "RTN","DGO THRP4",3,0 ) | |
6226 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
6227 | "RTN","DGO THRP4",4,0 ) | |
6228 | ; | |
6229 | "RTN","DGO THRP4",5,0 ) | |
6230 | ; Las t Edited: SHRPE/RM - July 20, 2018 5:15 | |
6231 | "RTN","DGO THRP4",6,0 ) | |
6232 | ; | |
6233 | "RTN","DGO THRP4",7,0 ) | |
6234 | ; ICR# TY PE DE SCRIPTION | |
6235 | "RTN","DGO THRP4",8,0 ) | |
6236 | ;----- -- -- -- ---------- --------- | |
6237 | "RTN","DGO THRP4",9,0 ) | |
6238 | ;10024 Su p WA IT^DICD | |
6239 | "RTN","DGO THRP4",10, 0) | |
6240 | ;10063 Su p $$ S^%ZTLOAD | |
6241 | "RTN","DGO THRP4",11, 0) | |
6242 | ;10086 Su p HO ME^%ZIS | |
6243 | "RTN","DGO THRP4",12, 0) | |
6244 | ;10089 Su p ^% ZISC | |
6245 | "RTN","DGO THRP4",13, 0) | |
6246 | ;10103 Su p ^X LFDT: $$FM TE, $$NOW | |
6247 | "RTN","DGO THRP4",14, 0) | |
6248 | ;10112 Su p $$ SITE^VASIT E | |
6249 | "RTN","DGO THRP4",15, 0) | |
6250 | ;10015 Su p GE TS^DIQ | |
6251 | "RTN","DGO THRP4",16, 0) | |
6252 | ;10026 Su p ^D IR | |
6253 | "RTN","DGO THRP4",17, 0) | |
6254 | ;6873 Co nt Sub $$ OTHDCLCK^D GOTHD | |
6255 | "RTN","DGO THRP4",18, 0) | |
6256 | ; | |
6257 | "RTN","DGO THRP4",19, 0) | |
6258 | ;- no dir ect entry | |
6259 | "RTN","DGO THRP4",20, 0) | |
6260 | Q | |
6261 | "RTN","DGO THRP4",21, 0) | |
6262 | ; | |
6263 | "RTN","DGO THRP4",22, 0) | |
6264 | CONT(DGSOR T) ;Statis tical Repo rt continu ation | |
6265 | "RTN","DGO THRP4",23, 0) | |
6266 | N DGMON,D GQRTR,DGNW TOT,DGCRYT OT,DGINTOT ,DGFYAR,DG CARY,DGLN | |
6267 | "RTN","DGO THRP4",24, 0) | |
6268 | ;quarterl y report s ummary | |
6269 | "RTN","DGO THRP4",25, 0) | |
6270 | I 4[$P(DG SORT("DGMO N"),U) D | |
6271 | "RTN","DGO THRP4",26, 0) | |
6272 | . D QRPTH D | |
6273 | "RTN","DGO THRP4",27, 0) | |
6274 | . S DGMON ="" F S D GMON=$O(DG SORT("DGMO N",DGMON)) Q:DGMON=" " D | |
6275 | "RTN","DGO THRP4",28, 0) | |
6276 | . . D QRP TSUM | |
6277 | "RTN","DGO THRP4",29, 0) | |
6278 | . D QRPTS UM1 | |
6279 | "RTN","DGO THRP4",30, 0) | |
6280 | ;fiscal y ear report summary | |
6281 | "RTN","DGO THRP4",31, 0) | |
6282 | I 5[$P(DG SORT("DGMO N"),U) D | |
6283 | "RTN","DGO THRP4",32, 0) | |
6284 | . N I,DGL N | |
6285 | "RTN","DGO THRP4",33, 0) | |
6286 | . D QRPTH D | |
6287 | "RTN","DGO THRP4",34, 0) | |
6288 | . S (DGQR TR,DGMON)= "" | |
6289 | "RTN","DGO THRP4",35, 0) | |
6290 | . W ! | |
6291 | "RTN","DGO THRP4",36, 0) | |
6292 | . S DGQRT R="" F S DGQRTR=$O( DGSORT("DG MON",DGQRT R)) Q:DGQR TR="" D | |
6293 | "RTN","DGO THRP4",37, 0) | |
6294 | . . W !," FY QUARTER ",DGQRTR, ":" | |
6295 | "RTN","DGO THRP4",38, 0) | |
6296 | . . S (DG NWTOT,DGCR YTOT,DGINT OT)=0 | |
6297 | "RTN","DGO THRP4",39, 0) | |
6298 | . . S DGM ON="" F S DGMON=$O( DGSORT("DG MON",DGQRT R,DGMON)) Q:DGMON="" D | |
6299 | "RTN","DGO THRP4",40, 0) | |
6300 | . . . D Q RPTSUM | |
6301 | "RTN","DGO THRP4",41, 0) | |
6302 | . . D QRP TSUM1 | |
6303 | "RTN","DGO THRP4",42, 0) | |
6304 | . . W ! | |
6305 | "RTN","DGO THRP4",43, 0) | |
6306 | . I $D(DG FYAR) D | |
6307 | "RTN","DGO THRP4",44, 0) | |
6308 | . . W !!, "FISCAL YE AR OVER AL L SUMMARY: ",! | |
6309 | "RTN","DGO THRP4",45, 0) | |
6310 | . . F I=1 :1:4 D | |
6311 | "RTN","DGO THRP4",46, 0) | |
6312 | . . . W ! ,"FY QUART ER ",I | |
6313 | "RTN","DGO THRP4",47, 0) | |
6314 | . . . W ? 20,$J($P(D GFYAR(I),U ),4),?30,$ J($P(DGFYA R(I),U,2), 6) | |
6315 | "RTN","DGO THRP4",48, 0) | |
6316 | . . . W ? 44,$J($P(D GFYAR(I),U ,3),5),?69 ,$J($P(DGF YAR(I),U,4 ),6) | |
6317 | "RTN","DGO THRP4",49, 0) | |
6318 | . . S $P( DGLN,"=",8 1)="" | |
6319 | "RTN","DGO THRP4",50, 0) | |
6320 | . . W !,D GLN,"TOTAL INACTIVAT ED FOR THE YEAR:",?6 9,$J(DGCNT ("IN"),6) | |
6321 | "RTN","DGO THRP4",51, 0) | |
6322 | . . ;W !! ,"TOTAL OC CURRENCE O F TREATMEN TS:",!!,?2 0,"New",?3 0,"Carry O ver",?44," TOTAL" | |
6323 | "RTN","DGO THRP4",52, 0) | |
6324 | . . ;W !, ?20,"----" ,?30,"---- ------",?4 4,"-----" | |
6325 | "RTN","DGO THRP4",53, 0) | |
6326 | . . ;W !? 20,$J(DGCN T("NEW"),4 ),?30,$J(D GCNT("OLD" ),6),?44,$ J(DGCNT,5) | |
6327 | "RTN","DGO THRP4",54, 0) | |
6328 | . . ;W !! ,"ADJUSTME NT**",?44, $J(($G(DGC NT)-$G(DGN ET)),5) | |
6329 | "RTN","DGO THRP4",55, 0) | |
6330 | . . ;N DG LN S $P(DG LN,"-",50) ="" W !,DG LN | |
6331 | "RTN","DGO THRP4",56, 0) | |
6332 | . . W !!, "TOTAL NUM BER OF UNI QUE PATIEN TS TREATED FOR ",DGD TRNGE,": ",$J($G(DG NET),3) | |
6333 | "RTN","DGO THRP4",57, 0) | |
6334 | . . ;W !! ,"** These patients are only c ounted onc e:" | |
6335 | "RTN","DGO THRP4",58, 0) | |
6336 | . . ;W !, " Pati ents recei ving an ad ditional 9 0 Days of Care" | |
6337 | "RTN","DGO THRP4",59, 0) | |
6338 | . . ;W !, " Carr y-Over Pat ients" | |
6339 | "RTN","DGO THRP4",60, 0) | |
6340 | Q | |
6341 | "RTN","DGO THRP4",61, 0) | |
6342 | ; | |
6343 | "RTN","DGO THRP4",62, 0) | |
6344 | QRPTHD ;qu arterly/fi scal repor t subheade r | |
6345 | "RTN","DGO THRP4",63, 0) | |
6346 | N DGLN | |
6347 | "RTN","DGO THRP4",64, 0) | |
6348 | D HEAD^DG OTHRP3 | |
6349 | "RTN","DGO THRP4",65, 0) | |
6350 | W !!,"REP ORT SUMMAR Y FOR ",DG DTRNGE,":" | |
6351 | "RTN","DGO THRP4",66, 0) | |
6352 | W !!,"Mon th",?20,"N ew",?30,"C arry Over" ,?44,"TOTA L",?69,"IN ACTIVATED" | |
6353 | "RTN","DGO THRP4",67, 0) | |
6354 | S $P(DGLN ,"=",10)=" " W !,DGLN ,?20,"==== ",?30,DGLN ,?44,"==== =" | |
6355 | "RTN","DGO THRP4",68, 0) | |
6356 | S $P(DGLN ,"=",12)=" " W ?69,DG LN | |
6357 | "RTN","DGO THRP4",69, 0) | |
6358 | Q | |
6359 | "RTN","DGO THRP4",70, 0) | |
6360 | ; | |
6361 | "RTN","DGO THRP4",71, 0) | |
6362 | QRPTSUM ;q uarterly r eport summ ary | |
6363 | "RTN","DGO THRP4",72, 0) | |
6364 | N DGNEW,D GCARY | |
6365 | "RTN","DGO THRP4",73, 0) | |
6366 | S DGNEW=$ S($G(DGCNT ("NEW",DGM ON))>0:DGC NT("NEW",D GMON),1:0) | |
6367 | "RTN","DGO THRP4",74, 0) | |
6368 | S DGCARY= $S($G(DGCN T("OLD",DG MON))>0:DG CNT("OLD", DGMON),1:0 ) | |
6369 | "RTN","DGO THRP4",75, 0) | |
6370 | S DGNWTOT =$G(DGNWTO T)+$G(DGCN T("NEW",DG MON)) | |
6371 | "RTN","DGO THRP4",76, 0) | |
6372 | S DGCRYTO T=$G(DGCRY TOT)+$G(DG CNT("OLD", DGMON)) | |
6373 | "RTN","DGO THRP4",77, 0) | |
6374 | S DGINTOT =$G(DGINTO T)+$G(DGCN T("IN",DGM ON)) | |
6375 | "RTN","DGO THRP4",78, 0) | |
6376 | W ! | |
6377 | "RTN","DGO THRP4",79, 0) | |
6378 | I 4[$P(DG SORT("DGMO N"),U) W $ P(DGSORT(" DGMON",DGM ON),U) | |
6379 | "RTN","DGO THRP4",80, 0) | |
6380 | I 5[$P(DG SORT("DGMO N"),U) W " ",$P(DGS ORT("DGMON ",DGQRTR,D GMON),U) | |
6381 | "RTN","DGO THRP4",81, 0) | |
6382 | W ?20,$J( DGNEW,4),? 30,$J(DGCA RY,6),?44, $J(DGNEW+D GCARY,5),? 69,$S($G(D GCNT("IN", DGMON))>0: $J(DGCNT(" IN",DGMON) ,6),1:$J(0 ,6)) | |
6383 | "RTN","DGO THRP4",82, 0) | |
6384 | Q | |
6385 | "RTN","DGO THRP4",83, 0) | |
6386 | ; | |
6387 | "RTN","DGO THRP4",84, 0) | |
6388 | QRPTSUM1 ; display gr and total for quarte rly/fiscal quarterly report su mmary | |
6389 | "RTN","DGO THRP4",85, 0) | |
6390 | N DGLN | |
6391 | "RTN","DGO THRP4",86, 0) | |
6392 | S $P(DGLN ,"=",81)=" " | |
6393 | "RTN","DGO THRP4",87, 0) | |
6394 | W !,DGLN | |
6395 | "RTN","DGO THRP4",88, 0) | |
6396 | W !,"TOTA L",?20,$J( DGNWTOT,4) ,?30,$J(DG CRYTOT,6) | |
6397 | "RTN","DGO THRP4",89, 0) | |
6398 | W ?44,$S( 4[$P(DGSOR T("DGMON") ,U):$J(DGC NT,5),1:$J ($G(DGNWTO T)+$G(DGCR YTOT),5)) | |
6399 | "RTN","DGO THRP4",90, 0) | |
6400 | W ?69,$J( DGINTOT,6) | |
6401 | "RTN","DGO THRP4",91, 0) | |
6402 | I 5[$P(DG SORT("DGMO N"),U) D | |
6403 | "RTN","DGO THRP4",92, 0) | |
6404 | . S DGFYA R(DGQRTR)= DGNWTOT_U_ DGCRYTOT_U _($G(DGNWT OT)+$G(DGC RYTOT))_U_ DGINTOT | |
6405 | "RTN","DGO THRP4",93, 0) | |
6406 | . S DGCNT ("IN")=$G( DGCNT("IN" ))+DGINTOT | |
6407 | "RTN","DGO THRP4",94, 0) | |
6408 | Q | |
6409 | "RTN","DGO THRP4",95, 0) | |
6410 | ; | |
6411 | "RTN","DGO THRP4",96, 0) | |
6412 | PRINTFY(DG SORT,DGLIS T,DGQRTR,D GMON,DGQ,D GMNAME) ;p rint/displ ay carry o ver OTH pa tients | |
6413 | "RTN","DGO THRP4",97, 0) | |
6414 | N DGSTAT, DGPTNM,DGC LCK,DGSTR, DGOLD | |
6415 | "RTN","DGO THRP4",98, 0) | |
6416 | S DGSTAT= "OLD",(DGO LD,DGPTNM, DGCLCK,DGS TR)="" | |
6417 | "RTN","DGO THRP4",99, 0) | |
6418 | D HEAD^DG OTHRP3 | |
6419 | "RTN","DGO THRP4",100 ,0) | |
6420 | W ! D SUB HEAD^DGOTH RP3(DGSTAT ,DGMNAME) | |
6421 | "RTN","DGO THRP4",101 ,0) | |
6422 | F S DGPT NM=$O(@DGL IST@(DGSTA T,DGQRTR,D GMON,DGPTN M)) Q:DGPT NM="" D Q:DGQ | |
6423 | "RTN","DGO THRP4",102 ,0) | |
6424 | . F S DG CLCK=$O(@D GLIST@(DGS TAT,DGQRTR ,DGMON,DGP TNM,DGCLCK )) Q:DGCLC K="" D Q :DGQ | |
6425 | "RTN","DGO THRP4",103 ,0) | |
6426 | . . S DGS TR=@DGLIST @(DGSTAT,D GQRTR,DGMO N,DGPTNM,D GCLCK) | |
6427 | "RTN","DGO THRP4",104 ,0) | |
6428 | . . W ! | |
6429 | "RTN","DGO THRP4",105 ,0) | |
6430 | . . I $Y> (IOSL-4) D PAUSE^DGO THRP2(.DGQ ) Q:DGQ D HEAD^DGOT HRP3 W ! | |
6431 | "RTN","DGO THRP4",106 ,0) | |
6432 | . . I DGP TNM'=DGOLD D | |
6433 | "RTN","DGO THRP4",107 ,0) | |
6434 | . . . W $ E(DGPTNM,1 ,20),?23,$ P(DGSTR,U, 2) | |
6435 | "RTN","DGO THRP4",108 ,0) | |
6436 | . . . S D GOLD=DGPTN M ;display the name and PID on ly once | |
6437 | "RTN","DGO THRP4",109 ,0) | |
6438 | . . W ?31 ,$P(DGSTR, U),?37,$P( DGSTR,U,3) ,?49,$P(DG STR,U,4),? 61,$S($P(D GSTR,U,7)' ="":$J("N/ A",4),1:$J ($P(DGSTR, U,5),4)) | |
6439 | "RTN","DGO THRP4",110 ,0) | |
6440 | . W ?68,$ P(DGSTR,U, 7) | |
6441 | "RTN","DGO THRP4",111 ,0) | |
6442 | . D CALCI N^DGOTHRP3 (DGSTR,DGS TAT,DGMON) ;count i nactivated OTH patie nts by mon th in the quarter | |
6443 | "RTN","DGO THRP4",112 ,0) | |
6444 | . Q:DGQ | |
6445 | "RTN","DGO THRP4",113 ,0) | |
6446 | W !! | |
6447 | "RTN","DGO THRP4",114 ,0) | |
6448 | Q | |
6449 | "RTN","DGO THRP4",115 ,0) | |
6450 | ; | |
6451 | "RTN","DGO THRPT") | |
6452 | 0^8^B13950 4206 | |
6453 | "RTN","DGO THRPT",1,0 ) | |
6454 | DGOTHRPT ; SLC/RM - O THD (OTHER THAN HONO RABLE DISC HARGE) API s ;April 2 7,2018@21: 08 | |
6455 | "RTN","DGO THRPT",2,0 ) | |
6456 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
6457 | "RTN","DGO THRPT",3,0 ) | |
6458 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
6459 | "RTN","DGO THRPT",4,0 ) | |
6460 | ; | |
6461 | "RTN","DGO THRPT",5,0 ) | |
6462 | ; Las t Edited: SHRPE/RM - May 02, 2 018 15:50 | |
6463 | "RTN","DGO THRPT",6,0 ) | |
6464 | ; | |
6465 | "RTN","DGO THRPT",7,0 ) | |
6466 | ; ICR# T YPE DESCR IPTION | |
6467 | "RTN","DGO THRPT",8,0 ) | |
6468 | ;----- - --- ----- ---------- ---------- ------ | |
6469 | "RTN","DGO THRPT",9,0 ) | |
6470 | ; 10010 Sup EN1^D IP | |
6471 | "RTN","DGO THRPT",10, 0) | |
6472 | ; 10006 Sup ^DIC | |
6473 | "RTN","DGO THRPT",11, 0) | |
6474 | ; 10086 Sup HOME^ %ZIS | |
6475 | "RTN","DGO THRPT",12, 0) | |
6476 | ; 10103 Sup ^XLFD T:$$FMTE, $$NOW, $$F MADD | |
6477 | "RTN","DGO THRPT",13, 0) | |
6478 | ; 1519 Sup EN^XU TMDEVQ | |
6479 | "RTN","DGO THRPT",14, 0) | |
6480 | ; 10026 Sup ^DIR | |
6481 | "RTN","DGO THRPT",15, 0) | |
6482 | Q | |
6483 | "RTN","DGO THRPT",16, 0) | |
6484 | ; | |
6485 | "RTN","DGO THRPT",17, 0) | |
6486 | ;Entry po int DG OTH HISTORY A UDIT REPOR T option | |
6487 | "RTN","DGO THRPT",18, 0) | |
6488 | ;B2S4 | |
6489 | "RTN","DGO THRPT",19, 0) | |
6490 | ; | |
6491 | "RTN","DGO THRPT",20, 0) | |
6492 | EN ; | |
6493 | "RTN","DGO THRPT",21, 0) | |
6494 | N DGLOOP | |
6495 | "RTN","DGO THRPT",22, 0) | |
6496 | S DGLOOP= 0 | |
6497 | "RTN","DGO THRPT",23, 0) | |
6498 | ;keep ask ing until empty inpu t | |
6499 | "RTN","DGO THRPT",24, 0) | |
6500 | F D Q:D GLOOP=1 | |
6501 | "RTN","DGO THRPT",25, 0) | |
6502 | . N DGIEN 33,DFN,L,F LDS,BY,DHD ,FR,TO,DGA RR | |
6503 | "RTN","DGO THRPT",26, 0) | |
6504 | . W ! | |
6505 | "RTN","DGO THRPT",27, 0) | |
6506 | . S DGIEN 33=$$SELPA T(.DGARR) | |
6507 | "RTN","DGO THRPT",28, 0) | |
6508 | . I DGIEN 33<0 S DGL OOP=1 Q | |
6509 | "RTN","DGO THRPT",29, 0) | |
6510 | . S L=0,D IC="^DGOTH (33.1," | |
6511 | "RTN","DGO THRPT",30, 0) | |
6512 | . S FLDS= "[DG OTH P RINT TEMPL ATE]" | |
6513 | "RTN","DGO THRPT",31, 0) | |
6514 | . S BY="@ .01" | |
6515 | "RTN","DGO THRPT",32, 0) | |
6516 | . S DHD=" OTHER THAN HONORABLE AUDIT HIS TORY REPOR T" | |
6517 | "RTN","DGO THRPT",33, 0) | |
6518 | . S (FR(1 ),TO(1))=D GIEN33 | |
6519 | "RTN","DGO THRPT",34, 0) | |
6520 | . D EN1^D IP | |
6521 | "RTN","DGO THRPT",35, 0) | |
6522 | Q | |
6523 | "RTN","DGO THRPT",36, 0) | |
6524 | ; | |
6525 | "RTN","DGO THRPT",37, 0) | |
6526 | SELPAT(DGP AT) ; | |
6527 | "RTN","DGO THRPT",38, 0) | |
6528 | ;- int in put vars f or ^DIC ca ll | |
6529 | "RTN","DGO THRPT",39, 0) | |
6530 | N DIC,DTO UT,DUOUT,X ,Y | |
6531 | "RTN","DGO THRPT",40, 0) | |
6532 | S DIC="^D GOTH(33.1, ",DIC(0)=" AEMQZV" | |
6533 | "RTN","DGO THRPT",41, 0) | |
6534 | S DIC("?P ARAM",33.1 ,"INDEX")= .01 | |
6535 | "RTN","DGO THRPT",42, 0) | |
6536 | ;- lookup patient | |
6537 | "RTN","DGO THRPT",43, 0) | |
6538 | D ^DIC K DIC | |
6539 | "RTN","DGO THRPT",44, 0) | |
6540 | ;- result of lookup | |
6541 | "RTN","DGO THRPT",45, 0) | |
6542 | S DGPAT=Y | |
6543 | "RTN","DGO THRPT",46, 0) | |
6544 | ;- if suc cess, setu p return a rray using output va rs from ^D IC call | |
6545 | "RTN","DGO THRPT",47, 0) | |
6546 | I (+DGPAT >0) D Q Y (0,0) ;pa tient name | |
6547 | "RTN","DGO THRPT",48, 0) | |
6548 | . S DGPAT =+Y ;pa tient ien | |
6549 | "RTN","DGO THRPT",49, 0) | |
6550 | . S DGPAT (0)=$G(Y(0 )) ;ze ro node of patient i n (#33.1) file | |
6551 | "RTN","DGO THRPT",50, 0) | |
6552 | Q -1 | |
6553 | "RTN","DGO THRPT",51, 0) | |
6554 | ; | |
6555 | "RTN","DGO THRPT",52, 0) | |
6556 | RSNMSG ;di splay reas on | |
6557 | "RTN","DGO THRPT",53, 0) | |
6558 | W !,?0 W "Reason :" | |
6559 | "RTN","DGO THRPT",54, 0) | |
6560 | W ?20 S Y =$P(X,U,8) S Y(0)=Y S:Y="" Y=" N/A" W $E( Y,1,60) | |
6561 | "RTN","DGO THRPT",55, 0) | |
6562 | Q | |
6563 | "RTN","DGO THRPT",56, 0) | |
6564 | ; | |
6565 | "RTN","DGO THRPT",57, 0) | |
6566 | ;Entry po int for DG OTH ACTIV E 90-DAY P ERIOD opti on | |
6567 | "RTN","DGO THRPT",58, 0) | |
6568 | ;B3S1 | |
6569 | "RTN","DGO THRPT",59, 0) | |
6570 | REPORT1 ; | |
6571 | "RTN","DGO THRPT",60, 0) | |
6572 | ;This sub routine wi ll be used for selec ting sort parameters | |
6573 | "RTN","DGO THRPT",61, 0) | |
6574 | ;to displ ay all act ive OTH pa tients | |
6575 | "RTN","DGO THRPT",62, 0) | |
6576 | ; | |
6577 | "RTN","DGO THRPT",63, 0) | |
6578 | ;Reports can be sor ted by: | |
6579 | "RTN","DGO THRPT",64, 0) | |
6580 | ; 1) Name | |
6581 | "RTN","DGO THRPT",65, 0) | |
6582 | ; 2) Peri od | |
6583 | "RTN","DGO THRPT",66, 0) | |
6584 | ; 3) Days Remaining | |
6585 | "RTN","DGO THRPT",67, 0) | |
6586 | ; | |
6587 | "RTN","DGO THRPT",68, 0) | |
6588 | ;The foll owing repo rting sort array wil l be built by user p rompts: | |
6589 | "RTN","DGO THRPT",69, 0) | |
6590 | ; DGSORT( "DGBEG") = BEGINNING DATE (int ernal File Man date) | |
6591 | "RTN","DGO THRPT",70, 0) | |
6592 | ; DGSORT( "DGEND") = ENDING DA TE (intern al FileMan date) | |
6593 | "RTN","DGO THRPT",71, 0) | |
6594 | ; DGSORT( "DGSRTBY") = SORT BY | |
6595 | "RTN","DGO THRPT",72, 0) | |
6596 | ; DGSORT( "DGSTATUS" ) = OTH Pa tient Stat us to repo rt on | |
6597 | "RTN","DGO THRPT",73, 0) | |
6598 | ; 1^Activ e Period | |
6599 | "RTN","DGO THRPT",74, 0) | |
6600 | ; | |
6601 | "RTN","DGO THRPT",75, 0) | |
6602 | ; prompts for repor t selectio n sorts | |
6603 | "RTN","DGO THRPT",76, 0) | |
6604 | ; Input: none | |
6605 | "RTN","DGO THRPT",77, 0) | |
6606 | ; Output: Report ge nerated us ing user s elected pa rameters | |
6607 | "RTN","DGO THRPT",78, 0) | |
6608 | ; | |
6609 | "RTN","DGO THRPT",79, 0) | |
6610 | N DGFIRST ;first O TH patient DFN | |
6611 | "RTN","DGO THRPT",80, 0) | |
6612 | N DGSEL ;help te xt var | |
6613 | "RTN","DGO THRPT",81, 0) | |
6614 | N DGSORT ;array o r report p arameters | |
6615 | "RTN","DGO THRPT",82, 0) | |
6616 | N ZTSAVE ;open ar ray refere nce of inp ut paramet ers used b y tasking | |
6617 | "RTN","DGO THRPT",83, 0) | |
6618 | N ZTDESC ;contain s the free -text desc ription of your task that you passed to the Progra m Interfac e. | |
6619 | "RTN","DGO THRPT",84, 0) | |
6620 | N ZTQUEUE D ;backgro und execut ion | |
6621 | "RTN","DGO THRPT",85, 0) | |
6622 | N ZTREQ ;post-ex ecution | |
6623 | "RTN","DGO THRPT",86, 0) | |
6624 | N ZTSTOP | |
6625 | "RTN","DGO THRPT",87, 0) | |
6626 | ; | |
6627 | "RTN","DGO THRPT",88, 0) | |
6628 | ;check fo r database | |
6629 | "RTN","DGO THRPT",89, 0) | |
6630 | S DGFIRST =$P(+$O(^D GOTH(33,"B ","")),"," ) ;first O TH DFN | |
6631 | "RTN","DGO THRPT",90, 0) | |
6632 | I 'DGFIRS T D Q | |
6633 | "RTN","DGO THRPT",91, 0) | |
6634 | . W !?2," >>> No Oth er Than Ho norable Pa tient Reco rd have be en found." ,*7 | |
6635 | "RTN","DGO THRPT",92, 0) | |
6636 | . I $$ANS WER("Enter RETURN to continue" ,"","E") | |
6637 | "RTN","DGO THRPT",93, 0) | |
6638 | ; | |
6639 | "RTN","DGO THRPT",94, 0) | |
6640 | W @IOF | |
6641 | "RTN","DGO THRPT",95, 0) | |
6642 | W !,"This option ge nerates a report tha t will dis play a lis ting of al l" | |
6643 | "RTN","DGO THRPT",96, 0) | |
6644 | W !,"Othe r Than Hon orable pat ients with ACTIVE 90 -Day perio d of care. " | |
6645 | "RTN","DGO THRPT",97, 0) | |
6646 | W !!,"OTH ER THAN HO NORABLE AC TIVE 90-DA Y PERIOD R EPORT" | |
6647 | "RTN","DGO THRPT",98, 0) | |
6648 | S DGSORT( "DGSTATUS" )="1^Activ e Period" ;defaulted to only d isplay all active 90 -Day perio d | |
6649 | "RTN","DGO THRPT",99, 0) | |
6650 | ;prompt f or beginni ng date | |
6651 | "RTN","DGO THRPT",100 ,0) | |
6652 | I '$$DATE BEG Q | |
6653 | "RTN","DGO THRPT",101 ,0) | |
6654 | ; | |
6655 | "RTN","DGO THRPT",102 ,0) | |
6656 | ;prompt f or ending date | |
6657 | "RTN","DGO THRPT",103 ,0) | |
6658 | I '$$DATE END Q | |
6659 | "RTN","DGO THRPT",104 ,0) | |
6660 | ; | |
6661 | "RTN","DGO THRPT",105 ,0) | |
6662 | ;prompt s ort by: | |
6663 | "RTN","DGO THRPT",106 ,0) | |
6664 | ; 1) Pati ent Name | |
6665 | "RTN","DGO THRPT",107 ,0) | |
6666 | ; 2) Peri od | |
6667 | "RTN","DGO THRPT",108 ,0) | |
6668 | ; 3) Days Remaining | |
6669 | "RTN","DGO THRPT",109 ,0) | |
6670 | I '$$SORT BY Q | |
6671 | "RTN","DGO THRPT",110 ,0) | |
6672 | ; | |
6673 | "RTN","DGO THRPT",111 ,0) | |
6674 | ;prompt f or device | |
6675 | "RTN","DGO THRPT",112 ,0) | |
6676 | W ! | |
6677 | "RTN","DGO THRPT",113 ,0) | |
6678 | S ZTSAVE( "DGSORT(") ="" | |
6679 | "RTN","DGO THRPT",114 ,0) | |
6680 | S X="OTHE R THAN HON ORABLE ACT IVE 90-DAY PERIOD RE PORT" | |
6681 | "RTN","DGO THRPT",115 ,0) | |
6682 | D EN^XUTM DEVQ("STAR T^DGOTHRP2 ",X,.ZTSAV E) | |
6683 | "RTN","DGO THRPT",116 ,0) | |
6684 | D HOME^%Z IS | |
6685 | "RTN","DGO THRPT",117 ,0) | |
6686 | Q | |
6687 | "RTN","DGO THRPT",118 ,0) | |
6688 | ; | |
6689 | "RTN","DGO THRPT",119 ,0) | |
6690 | DATEBEG() ;prompt fo r beginnin g date | |
6691 | "RTN","DGO THRPT",120 ,0) | |
6692 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO,DGB EGDT | |
6693 | "RTN","DGO THRPT",121 ,0) | |
6694 | W ! | |
6695 | "RTN","DGO THRPT",122 ,0) | |
6696 | S DGDIRA= "Enter Beg inning Dat e" | |
6697 | "RTN","DGO THRPT",123 ,0) | |
6698 | S DGDIRB= "" | |
6699 | "RTN","DGO THRPT",124 ,0) | |
6700 | S DGDIRH= "^D HELP^D GOTHRPT(1) " | |
6701 | "RTN","DGO THRPT",125 ,0) | |
6702 | S DGBEGDT =$$FMADD^X LFDT(DT,-8 9) | |
6703 | "RTN","DGO THRPT",126 ,0) | |
6704 | S DGDIRO= "DO^"_DGBE GDT_":"_DT _":EX" | |
6705 | "RTN","DGO THRPT",127 ,0) | |
6706 | S DGASK=$ $ANSWER(DG DIRA,DGDIR B,DGDIRO,D GDIRH) | |
6707 | "RTN","DGO THRPT",128 ,0) | |
6708 | I DGASK>0 S DGSORT( "DGBEG")=D GASK | |
6709 | "RTN","DGO THRPT",129 ,0) | |
6710 | Q DGASK>0 | |
6711 | "RTN","DGO THRPT",130 ,0) | |
6712 | ; | |
6713 | "RTN","DGO THRPT",131 ,0) | |
6714 | DATEEND() ;prompt fo r ending d ate | |
6715 | "RTN","DGO THRPT",132 ,0) | |
6716 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO,DGD TEND | |
6717 | "RTN","DGO THRPT",133 ,0) | |
6718 | W ! | |
6719 | "RTN","DGO THRPT",134 ,0) | |
6720 | S DGDIRA= "Enter End ing Date" | |
6721 | "RTN","DGO THRPT",135 ,0) | |
6722 | S DGDIRB= "" | |
6723 | "RTN","DGO THRPT",136 ,0) | |
6724 | S DGDIRH= "^D HELP^D GOTHRPT(2) " | |
6725 | "RTN","DGO THRPT",137 ,0) | |
6726 | S DGDTEND =$$FMADD^X LFDT(DGSOR T("DGBEG") ,364) | |
6727 | "RTN","DGO THRPT",138 ,0) | |
6728 | S DGDIRO= "DO^"_$$FM ADD^XLFDT( DT,1)_":"_ DGDTEND_": EX" | |
6729 | "RTN","DGO THRPT",139 ,0) | |
6730 | S DGASK=$ $ANSWER(DG DIRA,DGDIR B,DGDIRO,D GDIRH) | |
6731 | "RTN","DGO THRPT",140 ,0) | |
6732 | I DGASK>0 S DGSORT( "DGEND")=D GASK | |
6733 | "RTN","DGO THRPT",141 ,0) | |
6734 | Q DGASK>0 | |
6735 | "RTN","DGO THRPT",142 ,0) | |
6736 | ; | |
6737 | "RTN","DGO THRPT",143 ,0) | |
6738 | SORTBY() ; prompt for sort by | |
6739 | "RTN","DGO THRPT",144 ,0) | |
6740 | ; 1) Pati ent Name | |
6741 | "RTN","DGO THRPT",145 ,0) | |
6742 | ; 2) Peri od | |
6743 | "RTN","DGO THRPT",146 ,0) | |
6744 | ; 3) Days Remaining | |
6745 | "RTN","DGO THRPT",147 ,0) | |
6746 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO | |
6747 | "RTN","DGO THRPT",148 ,0) | |
6748 | W ! | |
6749 | "RTN","DGO THRPT",149 ,0) | |
6750 | S DGDIRA= "Print Rep ort Sorted By" | |
6751 | "RTN","DGO THRPT",150 ,0) | |
6752 | S DGDIRB= "" | |
6753 | "RTN","DGO THRPT",151 ,0) | |
6754 | S DGDIRH= "Enter one of the so rts select ions to re port on" | |
6755 | "RTN","DGO THRPT",152 ,0) | |
6756 | S DGDIRO= "SO^1:Sort by Patien t Name;2:S ort by Per iod;3:Sort by Days R emaining" | |
6757 | "RTN","DGO THRPT",153 ,0) | |
6758 | S DGASK=$ $ANSWER(DG DIRA,DGDIR B,DGDIRO,D GDIRH) | |
6759 | "RTN","DGO THRPT",154 ,0) | |
6760 | I DGASK>0 S DGSORT( "DGSRTBY") =DGASK_U_$ S(DGASK=1: "Sort by P atient Nam e",DGASK=2 :"Sort by Period",DG ASK=3:"Sor t by Days Remaining" ,1:"") | |
6761 | "RTN","DGO THRPT",155 ,0) | |
6762 | Q DGASK>0 | |
6763 | "RTN","DGO THRPT",156 ,0) | |
6764 | ; | |
6765 | "RTN","DGO THRPT",157 ,0) | |
6766 | ANSWER(DGD IRA,DGDIRB ,DGDIR0,DG DIRH) ; | |
6767 | "RTN","DGO THRPT",158 ,0) | |
6768 | ; Input | |
6769 | "RTN","DGO THRPT",159 ,0) | |
6770 | ; DGDIR0 - DIR(0) s tring | |
6771 | "RTN","DGO THRPT",160 ,0) | |
6772 | ; DGDIRA - DIR("A") string | |
6773 | "RTN","DGO THRPT",161 ,0) | |
6774 | ; DGDIRB - DIR("B") string | |
6775 | "RTN","DGO THRPT",162 ,0) | |
6776 | ; DGDIRH - DIR("?") string | |
6777 | "RTN","DGO THRPT",163 ,0) | |
6778 | ; Output | |
6779 | "RTN","DGO THRPT",164 ,0) | |
6780 | ; Functio n Value - Internal v alue retur ned from ^ DIR or -1 if user | |
6781 | "RTN","DGO THRPT",165 ,0) | |
6782 | ; up-arro ws, double up-arrows or the re ad times o ut. | |
6783 | "RTN","DGO THRPT",166 ,0) | |
6784 | N X,Y,Z,D IR,DIROUT, DIRUT,DTOU T,DUOUT | |
6785 | "RTN","DGO THRPT",167 ,0) | |
6786 | I $D(DGDI R0) S DIR( 0)=DGDIR0 | |
6787 | "RTN","DGO THRPT",168 ,0) | |
6788 | I $D(DGDI RA) S DIR( "A")=DGDIR A | |
6789 | "RTN","DGO THRPT",169 ,0) | |
6790 | I $G(DGDI RB)]"" S D IR("B")=DG DIRB | |
6791 | "RTN","DGO THRPT",170 ,0) | |
6792 | I $D(DGDI RH) S DIR( "?")=DGDIR H,DIR("??" )=DGDIRH | |
6793 | "RTN","DGO THRPT",171 ,0) | |
6794 | D ^DIR | |
6795 | "RTN","DGO THRPT",172 ,0) | |
6796 | S Z=$S($D (DTOUT):-2 ,$D(DUOUT) :-1,$D(DIR OUT):-1,1: "") | |
6797 | "RTN","DGO THRPT",173 ,0) | |
6798 | I Z="" S Z=$S(Y=-1: "",X="@":" @",1:$P(Y, U)) Q Z | |
6799 | "RTN","DGO THRPT",174 ,0) | |
6800 | I $D(DTOU T)!$D(DUOU T)!$D(DIRO UT) Q -1 | |
6801 | "RTN","DGO THRPT",175 ,0) | |
6802 | Q $S(X="@ ":"@",1:$P (Y,U)) | |
6803 | "RTN","DGO THRPT",176 ,0) | |
6804 | ; | |
6805 | "RTN","DGO THRPT",177 ,0) | |
6806 | HELP(DGSEL ) ;provide extended DIR("?") h elp text. | |
6807 | "RTN","DGO THRPT",178 ,0) | |
6808 | ; | |
6809 | "RTN","DGO THRPT",179 ,0) | |
6810 | ; Input: DGSEL - pr ompt var f or help te xt word se lection | |
6811 | "RTN","DGO THRPT",180 ,0) | |
6812 | ; Output: none | |
6813 | "RTN","DGO THRPT",181 ,0) | |
6814 | ; | |
6815 | "RTN","DGO THRPT",182 ,0) | |
6816 | I X'="?", X'="??" W !," Not a valid dat e.",! | |
6817 | "RTN","DGO THRPT",183 ,0) | |
6818 | N X S X=$ S(DGSEL=1: "earliest" ,1:"latest ") | |
6819 | "RTN","DGO THRPT",184 ,0) | |
6820 | I DGSEL=1 D | |
6821 | "RTN","DGO THRPT",185 ,0) | |
6822 | . W !," Beginning Date canno t be more than 90 da ys from to day." | |
6823 | "RTN","DGO THRPT",186 ,0) | |
6824 | . W !," Beginning Date canno t be a fut ure date." | |
6825 | "RTN","DGO THRPT",187 ,0) | |
6826 | I DGSEL=2 D | |
6827 | "RTN","DGO THRPT",188 ,0) | |
6828 | . W !," Ending Dat e is today 's date + 1 day. The latest en ding date was " | |
6829 | "RTN","DGO THRPT",189 ,0) | |
6830 | . W !," calculated by adding 364 days from the B eginning D ate entere d by the u ser. " | |
6831 | "RTN","DGO THRPT",190 ,0) | |
6832 | W !!," E nter the " _X_" date to include in the re port." | |
6833 | "RTN","DGO THRPT",191 ,0) | |
6834 | W !," Pl ease enter a date fr om the spe cified dat e range di splayed." | |
6835 | "RTN","DGO THRPT",192 ,0) | |
6836 | Q | |
6837 | "RTN","DGO THRPT",193 ,0) | |
6838 | ; | |
6839 | "RTN","DGO THRPT",194 ,0) | |
6840 | ;Entry po int DG OTH STATISTIC AL REPORT | |
6841 | "RTN","DGO THRPT",195 ,0) | |
6842 | ;B3S2 | |
6843 | "RTN","DGO THRPT",196 ,0) | |
6844 | ENSTAT ; | |
6845 | "RTN","DGO THRPT",197 ,0) | |
6846 | N DGFIRST ;first O TH patient DFN | |
6847 | "RTN","DGO THRPT",198 ,0) | |
6848 | N DGSORT ;array o r report p arameters | |
6849 | "RTN","DGO THRPT",199 ,0) | |
6850 | N ZTSAVE ;open ar ray refere nce of inp ut paramet ers used b y tasking | |
6851 | "RTN","DGO THRPT",200 ,0) | |
6852 | N ZTDESC ;contain s the free -text desc ription of your task that you passed to the Progra m Interfac e. | |
6853 | "RTN","DGO THRPT",201 ,0) | |
6854 | N ZTQUEUE D ;backgro und execut ion | |
6855 | "RTN","DGO THRPT",202 ,0) | |
6856 | N ZTREQ ;post-ex ecution | |
6857 | "RTN","DGO THRPT",203 ,0) | |
6858 | N ZTSTOP | |
6859 | "RTN","DGO THRPT",204 ,0) | |
6860 | N DGQMON | |
6861 | "RTN","DGO THRPT",205 ,0) | |
6862 | N DGDTRNG E ;statist ical repor t date ran ge | |
6863 | "RTN","DGO THRPT",206 ,0) | |
6864 | ;check fo r database | |
6865 | "RTN","DGO THRPT",207 ,0) | |
6866 | S DGFIRST =$P(+$O(^D GOTH(33,"B ","")),"," ) ;first O TH DFN | |
6867 | "RTN","DGO THRPT",208 ,0) | |
6868 | I 'DGFIRS T D Q | |
6869 | "RTN","DGO THRPT",209 ,0) | |
6870 | . W !?2," >>> No Oth er Than Ho norable Pa tient Reco rd have be en found." ,*7 | |
6871 | "RTN","DGO THRPT",210 ,0) | |
6872 | . I $$ANS WER^DGOTHR PT("Enter RETURN to continue", "","E") | |
6873 | "RTN","DGO THRPT",211 ,0) | |
6874 | ; | |
6875 | "RTN","DGO THRPT",212 ,0) | |
6876 | W @IOF | |
6877 | "RTN","DGO THRPT",213 ,0) | |
6878 | W "OTHER THAN HONOR ABLE STATI STICAL REP ORT",! | |
6879 | "RTN","DGO THRPT",214 ,0) | |
6880 | W !,"This option ge nerates a statistica l report t hat will d isplay a l isting of" | |
6881 | "RTN","DGO THRPT",215 ,0) | |
6882 | W !,"Othe r Than Hon orable pat ients by:" | |
6883 | "RTN","DGO THRPT",216 ,0) | |
6884 | ;prompt f or fiscal year | |
6885 | "RTN","DGO THRPT",217 ,0) | |
6886 | I '$$FISC AL,'$D(DGS ORT("DGFSC L")) Q | |
6887 | "RTN","DGO THRPT",218 ,0) | |
6888 | ; | |
6889 | "RTN","DGO THRPT",219 ,0) | |
6890 | ;prompt b y Quarter or Fiscal Year (All Quarters) | |
6891 | "RTN","DGO THRPT",220 ,0) | |
6892 | I DGSORT( "DGFSCL")> 0,'$$QRTRA LL Q | |
6893 | "RTN","DGO THRPT",221 ,0) | |
6894 | ; | |
6895 | "RTN","DGO THRPT",222 ,0) | |
6896 | I 1234[$P (DGSORT("D GQTR"),U) D Q:DGQMO N<1 | |
6897 | "RTN","DGO THRPT",223 ,0) | |
6898 | . ;prompt month in the quarte r or all q uarters | |
6899 | "RTN","DGO THRPT",224 ,0) | |
6900 | . S DGQMO N=$$MQ(.DG SORT) | |
6901 | "RTN","DGO THRPT",225 ,0) | |
6902 | . Q:DGQMO N<1 | |
6903 | "RTN","DGO THRPT",226 ,0) | |
6904 | . D DTRAN GE | |
6905 | "RTN","DGO THRPT",227 ,0) | |
6906 | ; | |
6907 | "RTN","DGO THRPT",228 ,0) | |
6908 | ;prompt f or Summary or Detail if user s elect Fisc al Year (A ll Quarter s) | |
6909 | "RTN","DGO THRPT",229 ,0) | |
6910 | I 5[$P(DG SORT("DGQT R"),U) D F SCLYR | |
6911 | "RTN","DGO THRPT",230 ,0) | |
6912 | ;prompt f or device | |
6913 | "RTN","DGO THRPT",231 ,0) | |
6914 | W ! | |
6915 | "RTN","DGO THRPT",232 ,0) | |
6916 | S ZTSAVE( "DGSORT(") ="" | |
6917 | "RTN","DGO THRPT",233 ,0) | |
6918 | S X="OTHE R THAN HON ORABLE STA TISTICAL R EPORT" | |
6919 | "RTN","DGO THRPT",234 ,0) | |
6920 | D EN^XUTM DEVQ("STAR T^DGOTHRP3 ",X,.ZTSAV E) | |
6921 | "RTN","DGO THRPT",235 ,0) | |
6922 | D HOME^%Z IS | |
6923 | "RTN","DGO THRPT",236 ,0) | |
6924 | Q | |
6925 | "RTN","DGO THRPT",237 ,0) | |
6926 | ; | |
6927 | "RTN","DGO THRPT",238 ,0) | |
6928 | FISCAL() ; prompt for fiscal ye ar | |
6929 | "RTN","DGO THRPT",239 ,0) | |
6930 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO,X | |
6931 | "RTN","DGO THRPT",240 ,0) | |
6932 | W ! | |
6933 | "RTN","DGO THRPT",241 ,0) | |
6934 | S DGDIRA= "Enter Fis cal Year" | |
6935 | "RTN","DGO THRPT",242 ,0) | |
6936 | S DGDIRB= "" | |
6937 | "RTN","DGO THRPT",243 ,0) | |
6938 | S DGDIRH= "^D HELP^D GOTHRP3" | |
6939 | "RTN","DGO THRPT",244 ,0) | |
6940 | S DGDIRO= "DO^::AE" | |
6941 | "RTN","DGO THRPT",245 ,0) | |
6942 | S DGASK=$ $ANSWER(DG DIRA,DGDIR B,DGDIRO,D GDIRH) | |
6943 | "RTN","DGO THRPT",246 ,0) | |
6944 | I (+$E(DG ASK,4,5))! (+$E(DGASK ,6,7)) W ! S (X,DGAS K)="" D HE LP^DGOTHRP 3 D FISCAL | |
6945 | "RTN","DGO THRPT",247 ,0) | |
6946 | I DGASK>0 S DGSORT( "DGFSCL")= DGASK | |
6947 | "RTN","DGO THRPT",248 ,0) | |
6948 | Q DGASK>0 | |
6949 | "RTN","DGO THRPT",249 ,0) | |
6950 | ; | |
6951 | "RTN","DGO THRPT",250 ,0) | |
6952 | QRTRALL() ;prompt fo r statisti cal report to print | |
6953 | "RTN","DGO THRPT",251 ,0) | |
6954 | ; | |
6955 | "RTN","DGO THRPT",252 ,0) | |
6956 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO,DGF YQ | |
6957 | "RTN","DGO THRPT",253 ,0) | |
6958 | S DGDIRA= "Select re porting pe riod " | |
6959 | "RTN","DGO THRPT",254 ,0) | |
6960 | S DGDIRB= "" | |
6961 | "RTN","DGO THRPT",255 ,0) | |
6962 | S DGDIRH= "Enter one of the se lections t o report o n" | |
6963 | "RTN","DGO THRPT",256 ,0) | |
6964 | S DGDIRO= "SO^1:FY Q uarter 1 ( Oct-Nov-De c);2:FY Qu arter 2 (J an-Feb-Mar );3:FY Qua rter 3 (Ap r-May-Jun) ;4:FY Quar ter 4 (Jul -Aug-Sep); 5:Fiscal Y ear (All Quarters)" | |
6965 | "RTN","DGO THRPT",257 ,0) | |
6966 | S DGASK=$ $ANSWER^DG OTHRPT(DGD IRA,DGDIRB ,DGDIRO,DG DIRH) | |
6967 | "RTN","DGO THRPT",258 ,0) | |
6968 | S DGFYQ=$ S(DGASK=1: "FY Quarte r 1",DGASK =2:"FY Qua rter 2",DG ASK=3:"FY Quarter 3" ,DGASK=4:" FY Quarter 4",DGASK= 5:"Fiscal Year (All Quarters)" ,1:"") | |
6969 | "RTN","DGO THRPT",259 ,0) | |
6970 | I DGASK>0 S DGSORT( "DGQTR")=D GASK_U_DGF YQ | |
6971 | "RTN","DGO THRPT",260 ,0) | |
6972 | Q DGASK>0 | |
6973 | "RTN","DGO THRPT",261 ,0) | |
6974 | ; | |
6975 | "RTN","DGO THRPT",262 ,0) | |
6976 | MQ(DGSORT) ;prompt m onth in th e quarter | |
6977 | "RTN","DGO THRPT",263 ,0) | |
6978 | ; | |
6979 | "RTN","DGO THRPT",264 ,0) | |
6980 | N DGASK,D GDIRA,DGDI RB,DGDIRH, DGDIRO,DGF YQ,DGMIN,D GMAX,I,DGM ON,DGCNT | |
6981 | "RTN","DGO THRPT",265 ,0) | |
6982 | S DGDIRA= "Select th e month of the Quart er or All" | |
6983 | "RTN","DGO THRPT",266 ,0) | |
6984 | S DGDIRB= "" | |
6985 | "RTN","DGO THRPT",267 ,0) | |
6986 | S DGDIRH= "Enter one of the se lections t o report o n" | |
6987 | "RTN","DGO THRPT",268 ,0) | |
6988 | S DGMIN=$ E($P($P($T (DATES+$P( DGSORT("DG QTR"),U)), ";;",2),"^ "),1,2) | |
6989 | "RTN","DGO THRPT",269 ,0) | |
6990 | S DGMAX=$ E($P($P($T (DATES+$P( DGSORT("DG QTR"),U)), ";;",2),"^ ",2),1,2) | |
6991 | "RTN","DGO THRPT",270 ,0) | |
6992 | S DGCNT=0 | |
6993 | "RTN","DGO THRPT",271 ,0) | |
6994 | F I=DGMIN :1:DGMAX D | |
6995 | "RTN","DGO THRPT",272 ,0) | |
6996 | . S DGCNT =DGCNT+1 | |
6997 | "RTN","DGO THRPT",273 ,0) | |
6998 | . S DGMON (DGCNT)=$P ($P($T(MON AME+I^DGOT HRP3),";;" ,2),"^",2) _U_I | |
6999 | "RTN","DGO THRPT",274 ,0) | |
7000 | S DGDIRO= "SO^1:"_$P (DGMON(1), U)_";2:"_$ P(DGMON(2) ,U)_";3:"_ $P(DGMON(3 ),U)_";4:A ll Months in the Qua rter" | |
7001 | "RTN","DGO THRPT",275 ,0) | |
7002 | S DGASK=$ $ANSWER^DG OTHRPT(DGD IRA,DGDIRB ,DGDIRO,DG DIRH) | |
7003 | "RTN","DGO THRPT",276 ,0) | |
7004 | I DGASK>0 D | |
7005 | "RTN","DGO THRPT",277 ,0) | |
7006 | . S DGSOR T("DGMON") =DGASK_U_$ S(123[DGAS K:DGMON(DG ASK),1:"Al l Months i n the Quar ter") | |
7007 | "RTN","DGO THRPT",278 ,0) | |
7008 | . I 4[DGA SK D | |
7009 | "RTN","DGO THRPT",279 ,0) | |
7010 | . . F I=1 :1:3 S DGS ORT("DGMON ",$P(DGMON (I),U,2))= DGMON(I) | |
7011 | "RTN","DGO THRPT",280 ,0) | |
7012 | Q DGASK>0 | |
7013 | "RTN","DGO THRPT",281 ,0) | |
7014 | ; | |
7015 | "RTN","DGO THRPT",282 ,0) | |
7016 | DTRANGE ;c alculate m onthly dat e range | |
7017 | "RTN","DGO THRPT",283 ,0) | |
7018 | ;print by monthly | |
7019 | "RTN","DGO THRPT",284 ,0) | |
7020 | N I | |
7021 | "RTN","DGO THRPT",285 ,0) | |
7022 | I 123[$P( DGSORT("DG MON"),U) D | |
7023 | "RTN","DGO THRPT",286 ,0) | |
7024 | . S DGMON =$E(DGSORT ("DGFSCL") ,1,3)-$S($ P(DGSORT(" DGQTR"),U) =1:1,1:0) | |
7025 | "RTN","DGO THRPT",287 ,0) | |
7026 | . S DGMON =DGMON_$S( $P(DGSORT( "DGMON"),U ,3)<=9:"0" _$P(DGSORT ("DGMON"), U,3),1:$P( DGSORT("DG MON"),U,3) )_"00" | |
7027 | "RTN","DGO THRPT",288 ,0) | |
7028 | . S DGMON =$$MONTH(D GMON) | |
7029 | "RTN","DGO THRPT",289 ,0) | |
7030 | . S DGSOR T("DGBEG") =$P(DGMON, U) | |
7031 | "RTN","DGO THRPT",290 ,0) | |
7032 | . S DGSOR T("DGEND") =$P(DGMON, U,2) | |
7033 | "RTN","DGO THRPT",291 ,0) | |
7034 | E D | |
7035 | "RTN","DGO THRPT",292 ,0) | |
7036 | . ;all mo nth in the quarter r ange | |
7037 | "RTN","DGO THRPT",293 ,0) | |
7038 | . S DGSOR T("DGBEG") =$E(DGSORT ("DGFSCL") ,1,3)-$S($ P(DGSORT(" DGQTR"),U) =1:1,1:0)_ $P($P($T(D ATES+$P(DG SORT("DGQT R"),U)),"; ;",2),"^") | |
7039 | "RTN","DGO THRPT",294 ,0) | |
7040 | . S DGSOR T("DGEND") =$E(DGSORT ("DGFSCL") ,1,3)-$S($ P(DGSORT(" DGQTR"),U) =1:1,1:0)_ $P($P($T(D ATES+$P(DG SORT("DGQT R"),U)),"; ;",2),"^", 2) | |
7041 | "RTN","DGO THRPT",295 ,0) | |
7042 | D MSG(.DG SORT) | |
7043 | "RTN","DGO THRPT",296 ,0) | |
7044 | ; | |
7045 | "RTN","DGO THRPT",297 ,0) | |
7046 | Q | |
7047 | "RTN","DGO THRPT",298 ,0) | |
7048 | ; | |
7049 | "RTN","DGO THRPT",299 ,0) | |
7050 | CALRNGE(DG SORT,Q,M) ;calculate date rang e by month | |
7051 | "RTN","DGO THRPT",300 ,0) | |
7052 | I 4[$P(DG SORT("DGMO N"),U) D | |
7053 | "RTN","DGO THRPT",301 ,0) | |
7054 | . S DGMON =$E(DGSORT ("DGFSCL") ,1,3)-$S($ P(DGSORT(" DGQTR"),U) =1:1,1:0) | |
7055 | "RTN","DGO THRPT",302 ,0) | |
7056 | . S DGMON =DGMON_$S( $P(DGSORT( "DGMON",M) ,U,2)<=9:" 0"_$P(DGSO RT("DGMON" ,M),U,2),1 :$P(DGSORT ("DGMON",M ),U,2))_"0 0" | |
7057 | "RTN","DGO THRPT",303 ,0) | |
7058 | I 5[$P(DG SORT("DGMO N"),U) D | |
7059 | "RTN","DGO THRPT",304 ,0) | |
7060 | . S DGMON =$E(DGSORT ("DGFSCL") ,1,3)-$S($ G(Q)=1:1,1 :0) | |
7061 | "RTN","DGO THRPT",305 ,0) | |
7062 | . S DGMON =DGMON_$S( $P(DGSORT( "DGMON",Q, M),U,2)<=9 :"0"_$P(DG SORT("DGMO N",Q,M),U, 2),1:$P(DG SORT("DGMO N",Q,M),U, 2))_"00" | |
7063 | "RTN","DGO THRPT",306 ,0) | |
7064 | S DGMON=$ $MONTH(DGM ON) | |
7065 | "RTN","DGO THRPT",307 ,0) | |
7066 | Q DGMON | |
7067 | "RTN","DGO THRPT",308 ,0) | |
7068 | ; | |
7069 | "RTN","DGO THRPT",309 ,0) | |
7070 | FSCLYR ;ca lculate fi scal year date range | |
7071 | "RTN","DGO THRPT",310 ,0) | |
7072 | N I,II,DG MIN,DGMAX | |
7073 | "RTN","DGO THRPT",311 ,0) | |
7074 | S DGSORT( "DGBEG")=$ E(DGSORT(" DGFSCL"),1 ,3)-1_$P($ P($T(DATES +1),";;",2 ),"^") | |
7075 | "RTN","DGO THRPT",312 ,0) | |
7076 | S DGSORT( "DGEND")=$ E(DGSORT(" DGFSCL"),1 ,3)_$P($P( $T(DATES+4 ),";;",2), "^",2) | |
7077 | "RTN","DGO THRPT",313 ,0) | |
7078 | ;create S DGSORT("D GMON") arr ay for the whole fis cal year | |
7079 | "RTN","DGO THRPT",314 ,0) | |
7080 | S DGSORT( "DGMON")=D GSORT("DGQ TR") | |
7081 | "RTN","DGO THRPT",315 ,0) | |
7082 | F I=1:1:4 D | |
7083 | "RTN","DGO THRPT",316 ,0) | |
7084 | . K DGSOR T("DGQTR") | |
7085 | "RTN","DGO THRPT",317 ,0) | |
7086 | . S DGSOR T("DGQTR") =I | |
7087 | "RTN","DGO THRPT",318 ,0) | |
7088 | . S DGMIN =$E($P($P( $T(DATES+$ P(DGSORT(" DGQTR"),U) ),";;",2), "^"),1,2) | |
7089 | "RTN","DGO THRPT",319 ,0) | |
7090 | . S DGMAX =$E($P($P( $T(DATES+$ P(DGSORT(" DGQTR"),U) ),";;",2), "^",2),1,2 ) | |
7091 | "RTN","DGO THRPT",320 ,0) | |
7092 | . F II=DG MIN:1:DGMA X S DGSORT ("DGMON",I ,II)=$P($P ($T(MONAME +II^DGOTHR P3),";;",2 ),"^",2)_U _II | |
7093 | "RTN","DGO THRPT",321 ,0) | |
7094 | D MSG(.DG SORT) | |
7095 | "RTN","DGO THRPT",322 ,0) | |
7096 | Q | |
7097 | "RTN","DGO THRPT",323 ,0) | |
7098 | ; | |
7099 | "RTN","DGO THRPT",324 ,0) | |
7100 | MSG(DGSORT ) ; | |
7101 | "RTN","DGO THRPT",325 ,0) | |
7102 | S DGDTRNG E=$$FMTE^X LFDT(DGSOR T("DGBEG") ,5)_" TO " _$$FMTE^XL FDT(DGSORT ("DGEND"), 5) | |
7103 | "RTN","DGO THRPT",326 ,0) | |
7104 | W !!,"Sta tistical D ate Range Selected: ",$$FMTE^X LFDT(DGSOR T("DGBEG") ,1)," to " ,$$FMTE^XL FDT(DGSORT ("DGEND"), 1) | |
7105 | "RTN","DGO THRPT",327 ,0) | |
7106 | Q | |
7107 | "RTN","DGO THRPT",328 ,0) | |
7108 | ; | |
7109 | "RTN","DGO THRPT",329 ,0) | |
7110 | DATES ;sto re date ra nges for e ach quarte r | |
7111 | "RTN","DGO THRPT",330 ,0) | |
7112 | ;;1001^12 31 | |
7113 | "RTN","DGO THRPT",331 ,0) | |
7114 | ;;0101^03 31 | |
7115 | "RTN","DGO THRPT",332 ,0) | |
7116 | ;;0401^06 30 | |
7117 | "RTN","DGO THRPT",333 ,0) | |
7118 | ;;0701^09 30 | |
7119 | "RTN","DGO THRPT",334 ,0) | |
7120 | Q | |
7121 | "RTN","DGO THRPT",335 ,0) | |
7122 | ; | |
7123 | "RTN","DGO THRPT",336 ,0) | |
7124 | MONTH(DGRR DT) ; Pass in a date (default = today's date) | |
7125 | "RTN","DGO THRPT",337 ,0) | |
7126 | ; this fu nction ret urns the f irst and l ast dates of the mon th | |
7127 | "RTN","DGO THRPT",338 ,0) | |
7128 | N DGRRMST ,DGRRMND | |
7129 | "RTN","DGO THRPT",339 ,0) | |
7130 | S:'$D(DGR RDT) DGRRD T=DT | |
7131 | "RTN","DGO THRPT",340 ,0) | |
7132 | S DGRRMST =$E(DGRRDT ,1,5)_"01" | |
7133 | "RTN","DGO THRPT",341 ,0) | |
7134 | S DGRRMND =$$SCH^XLF DT("1M(1)" ,DGRRMST)\ 1 | |
7135 | "RTN","DGO THRPT",342 ,0) | |
7136 | Q DGRRMST _U_DGRRMND | |
7137 | "RTN","DGO THRPT",343 ,0) | |
7138 | ; | |
7139 | "RTN","DGO THRPT",344 ,0) | |
7140 | FY(DGRRDT) ; Pass in a date (d efault = t oday's dat e), | |
7141 | "RTN","DGO THRPT",345 ,0) | |
7142 | ; and thi s function returns w hat FY we are in, | |
7143 | "RTN","DGO THRPT",346 ,0) | |
7144 | ; followe d by the F Y start da te and FY end date. | |
7145 | "RTN","DGO THRPT",347 ,0) | |
7146 | ; ie. S X =$$FY^DGOT HST(305020 8) results in X="FY 2005^30410 00^3051000 " | |
7147 | "RTN","DGO THRPT",348 ,0) | |
7148 | N DGRRST, DGRRND | |
7149 | "RTN","DGO THRPT",349 ,0) | |
7150 | S:'$D(DGR RDT) DGRRD T=DT | |
7151 | "RTN","DGO THRPT",350 ,0) | |
7152 | S DGRRST= $E(DGRRDT, 1,3)-($E(D GRRDT,4,5) <10)_"1000 " | |
7153 | "RTN","DGO THRPT",351 ,0) | |
7154 | S DGRRND= $E(DGRRST, 1,3)+1_"10 00" | |
7155 | "RTN","DGO THRPT",352 ,0) | |
7156 | Q "FY "_( 1701+$E(DG RRST,1,3)) _U_DGRRST_ U_DGRRND | |
7157 | "RTN","DGO THRPT",353 ,0) | |
7158 | ; | |
7159 | "RTN","DGO THUT1") | |
7160 | 0^19^B2466 3755 | |
7161 | "RTN","DGO THUT1",1,0 ) | |
7162 | DGOTHUT1 ; SHRPE/YMG - OTHD (OT HER THAN H ONORABLE D ISCHARGE) APIs ; 03/ 12/19 | |
7163 | "RTN","DGO THUT1",2,0 ) | |
7164 | ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 68 | |
7165 | "RTN","DGO THUT1",3,0 ) | |
7166 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7167 | "RTN","DGO THUT1",4,0 ) | |
7168 | ; | |
7169 | "RTN","DGO THUT1",5,0 ) | |
7170 | Q | |
7171 | "RTN","DGO THUT1",6,0 ) | |
7172 | ; | |
7173 | "RTN","DGO THUT1",7,0 ) | |
7174 | LASTPRD(DG IEN33) ; f ind last 3 65 and 90 day period s | |
7175 | "RTN","DGO THUT1",8,0 ) | |
7176 | ; | |
7177 | "RTN","DGO THUT1",9,0 ) | |
7178 | ; DGIEN33 - file 33 ien | |
7179 | "RTN","DGO THUT1",10, 0) | |
7180 | ; | |
7181 | "RTN","DGO THUT1",11, 0) | |
7182 | ; returns the follo wing strin g delimite d by "^" ( if data ca n't be fou nd, corres ponding pi ece is set to 0): | |
7183 | "RTN","DGO THUT1",12, 0) | |
7184 | ; p1 = # of the la st 365 day period | |
7185 | "RTN","DGO THUT1",13, 0) | |
7186 | ; p2 = i en (in sub -file 33.0 1) of the last 365 d ay period | |
7187 | "RTN","DGO THUT1",14, 0) | |
7188 | ; p3 = # of the la st 90 day period | |
7189 | "RTN","DGO THUT1",15, 0) | |
7190 | ; p4 = i en (in sub -file 33.1 1) of the last 90 da y period | |
7191 | "RTN","DGO THUT1",16, 0) | |
7192 | ; | |
7193 | "RTN","DGO THUT1",17, 0) | |
7194 | N IEN3301 ,IEN3311,L ST365,LST9 0,RES | |
7195 | "RTN","DGO THUT1",18, 0) | |
7196 | S RES="0^ 0^0^0" I $ G(DGIEN33) >0,$D(^DGO TH(33,DGIE N33))>0 D | |
7197 | "RTN","DGO THUT1",19, 0) | |
7198 | .S LST365 =+$O(^DGOT H(33,DGIEN 33,1,"B"," "),-1),IEN 3301=+$O(^ DGOTH(33,D GIEN33,1," B",LST365, "")) | |
7199 | "RTN","DGO THUT1",20, 0) | |
7200 | .I IEN330 1>0 D | |
7201 | "RTN","DGO THUT1",21, 0) | |
7202 | ..S $P(RE S,U)=LST36 5,$P(RES,U ,2)=IEN330 1 | |
7203 | "RTN","DGO THUT1",22, 0) | |
7204 | ..S LST90 =+$O(^DGOT H(33,DGIEN 33,1,IEN33 01,1,"B"," "),-1) | |
7205 | "RTN","DGO THUT1",23, 0) | |
7206 | ..S IEN33 11=+$O(^DG OTH(33,DGI EN33,1,IEN 3301,1,"B" ,LST90,"") ) | |
7207 | "RTN","DGO THUT1",24, 0) | |
7208 | ..S $P(RE S,U,3)=LST 90,$P(RES, U,4)=IEN33 11 | |
7209 | "RTN","DGO THUT1",25, 0) | |
7210 | ..Q | |
7211 | "RTN","DGO THUT1",26, 0) | |
7212 | .Q | |
7213 | "RTN","DGO THUT1",27, 0) | |
7214 | Q RES | |
7215 | "RTN","DGO THUT1",28, 0) | |
7216 | ; | |
7217 | "RTN","DGO THUT1",29, 0) | |
7218 | GET90DT(DG IEN33,DGIE N3301,DGIE N3311) ; r eturn date s info for a given 9 0 day peri od | |
7219 | "RTN","DGO THUT1",30, 0) | |
7220 | ; | |
7221 | "RTN","DGO THUT1",31, 0) | |
7222 | ; DGIEN33 - file 33 ien | |
7223 | "RTN","DGO THUT1",32, 0) | |
7224 | ; DGIEN33 01 - sub-f ile 33.01 ien | |
7225 | "RTN","DGO THUT1",33, 0) | |
7226 | ; DGIEN33 11 - sub-f ile 33.11 ien | |
7227 | "RTN","DGO THUT1",34, 0) | |
7228 | ; | |
7229 | "RTN","DGO THUT1",35, 0) | |
7230 | ; returns the follo wing strin g delimite d by "^" ( if data ca n't be fou nd, corres ponding pi ece is set to 0): | |
7231 | "RTN","DGO THUT1",36, 0) | |
7232 | ; p1 = s tart date (internal FM format) | |
7233 | "RTN","DGO THUT1",37, 0) | |
7234 | ; p2 = e nd date (i nternal FM format) | |
7235 | "RTN","DGO THUT1",38, 0) | |
7236 | ; p3 = d ays left i n this per iod | |
7237 | "RTN","DGO THUT1",39, 0) | |
7238 | ; | |
7239 | "RTN","DGO THUT1",40, 0) | |
7240 | N DAYS,ED T,SDT | |
7241 | "RTN","DGO THUT1",41, 0) | |
7242 | S (DAYS,E DT)=0 | |
7243 | "RTN","DGO THUT1",42, 0) | |
7244 | S SDT=+$$ GET1^DIQ(3 3.11,DGIEN 3311_","_D GIEN3301_" ,"_DGIEN33 _",",.02," I") | |
7245 | "RTN","DGO THUT1",43, 0) | |
7246 | I SDT D | |
7247 | "RTN","DGO THUT1",44, 0) | |
7248 | .S EDT=$$ FMADD^XLFD T(SDT,90), DAYS=$$FMD IFF^XLFDT( EDT,DT,1) | |
7249 | "RTN","DGO THUT1",45, 0) | |
7250 | .S DAYS=$ S(DAYS<0:0 ,DAYS>90:9 0,1:DAYS) | |
7251 | "RTN","DGO THUT1",46, 0) | |
7252 | .Q | |
7253 | "RTN","DGO THUT1",47, 0) | |
7254 | Q SDT_U_E DT_U_DAYS | |
7255 | "RTN","DGO THUT1",48, 0) | |
7256 | ; | |
7257 | "RTN","DGO THUT1",49, 0) | |
7258 | GET365DT(D GIEN33,DGI EN3301) ; return dat es info fo r a given 365 day pe riod | |
7259 | "RTN","DGO THUT1",50, 0) | |
7260 | ; | |
7261 | "RTN","DGO THUT1",51, 0) | |
7262 | ; DGIEN33 - file 33 ien | |
7263 | "RTN","DGO THUT1",52, 0) | |
7264 | ; DGIEN33 01 - sub-f ile 33.01 ien | |
7265 | "RTN","DGO THUT1",53, 0) | |
7266 | ; | |
7267 | "RTN","DGO THUT1",54, 0) | |
7268 | ; returns the follo wing strin g delimite d by "^" ( if data ca n't be fou nd, corres ponding pi ece is set to 0): | |
7269 | "RTN","DGO THUT1",55, 0) | |
7270 | ; p1 = s tart date (internal FM format) | |
7271 | "RTN","DGO THUT1",56, 0) | |
7272 | ; p2 = e nd date (i nternal FM format) | |
7273 | "RTN","DGO THUT1",57, 0) | |
7274 | ; | |
7275 | "RTN","DGO THUT1",58, 0) | |
7276 | N EDT,SDT | |
7277 | "RTN","DGO THUT1",59, 0) | |
7278 | S EDT=0 | |
7279 | "RTN","DGO THUT1",60, 0) | |
7280 | S SDT=+$$ GET1^DIQ(3 3.01,DGIEN 3301_","_D GIEN33_"," ,.02,"I") | |
7281 | "RTN","DGO THUT1",61, 0) | |
7282 | I SDT S E DT=$$FMADD ^XLFDT(SDT ,365) | |
7283 | "RTN","DGO THUT1",62, 0) | |
7284 | Q SDT_U_E DT | |
7285 | "RTN","DGO THUT1",63, 0) | |
7286 | ; | |
7287 | "RTN","DGO THUT1",64, 0) | |
7288 | LOCK(DGIEN 33) ; lock entry in file 33 | |
7289 | "RTN","DGO THUT1",65, 0) | |
7290 | ; | |
7291 | "RTN","DGO THUT1",66, 0) | |
7292 | ; DGIEN33 - file 33 ien of th e entry to lock | |
7293 | "RTN","DGO THUT1",67, 0) | |
7294 | ; | |
7295 | "RTN","DGO THUT1",68, 0) | |
7296 | ; returns 1 if lock was succe ssful, 0 o therwise | |
7297 | "RTN","DGO THUT1",69, 0) | |
7298 | ; | |
7299 | "RTN","DGO THUT1",70, 0) | |
7300 | N RES | |
7301 | "RTN","DGO THUT1",71, 0) | |
7302 | S RES=0 | |
7303 | "RTN","DGO THUT1",72, 0) | |
7304 | I +$G(DGI EN33) L +^ DGOTH(33,D GIEN33):5 S RES=$T | |
7305 | "RTN","DGO THUT1",73, 0) | |
7306 | Q RES | |
7307 | "RTN","DGO THUT1",74, 0) | |
7308 | ; | |
7309 | "RTN","DGO THUT1",75, 0) | |
7310 | UNLOCK(DGI EN33) ; un lock entry in file 3 3 | |
7311 | "RTN","DGO THUT1",76, 0) | |
7312 | ; | |
7313 | "RTN","DGO THUT1",77, 0) | |
7314 | ; DGIEN33 - file 33 ien of th e entry to unlock | |
7315 | "RTN","DGO THUT1",78, 0) | |
7316 | ; | |
7317 | "RTN","DGO THUT1",79, 0) | |
7318 | I +$G(DGI EN33) L -^ DGOTH(33,D GIEN33) | |
7319 | "RTN","DGO THUT1",80, 0) | |
7320 | Q | |
7321 | "RTN","DGO THUT1",81, 0) | |
7322 | ; | |
7323 | "RTN","DGO THUT1",82, 0) | |
7324 | FILEPRD(DG DFN,DATAST R) ; file data into file 33 | |
7325 | "RTN","DGO THUT1",83, 0) | |
7326 | ; | |
7327 | "RTN","DGO THUT1",84, 0) | |
7328 | ; creates new entri es in sub- files 33.0 1 and/or 3 3.11 if ne cessary, t hen files data passe d in DATAS TR | |
7329 | "RTN","DGO THUT1",85, 0) | |
7330 | ; will on ly file da ta into an existing top level entry in f ile 33 | |
7331 | "RTN","DGO THUT1",86, 0) | |
7332 | ; | |
7333 | "RTN","DGO THUT1",87, 0) | |
7334 | ; DGDFN - patient D FN | |
7335 | "RTN","DGO THUT1",88, 0) | |
7336 | ; DATASTR - string delimited by "^", as follows: | |
7337 | "RTN","DGO THUT1",89, 0) | |
7338 | ; p1 = 3 65 days pe riod # to be filed - required | |
7339 | "RTN","DGO THUT1",90, 0) | |
7340 | ; p2 = 9 0 days per iod # to b e filed - required | |
7341 | "RTN","DGO THUT1",91, 0) | |
7342 | ; p3 = d ate reques t submitte d | |
7343 | "RTN","DGO THUT1",92, 0) | |
7344 | ; p4 = a uthorized by (name) | |
7345 | "RTN","DGO THUT1",93, 0) | |
7346 | ; p5 = a uthorizati on receive d date | |
7347 | "RTN","DGO THUT1",94, 0) | |
7348 | ; p6 = s tart date of this 90 days peri od | |
7349 | "RTN","DGO THUT1",95, 0) | |
7350 | ; p7 = a uthorizati on comment | |
7351 | "RTN","DGO THUT1",96, 0) | |
7352 | ; p8 = e ntered by (name) - r equired | |
7353 | "RTN","DGO THUT1",97, 0) | |
7354 | ; p9 = f acility (f ile 4 ien) - require d | |
7355 | "RTN","DGO THUT1",98, 0) | |
7356 | ; | |
7357 | "RTN","DGO THUT1",99, 0) | |
7358 | ; returns 1 on succ ess, "0 ^ [error mes sage]" on failure | |
7359 | "RTN","DGO THUT1",100 ,0) | |
7360 | ; | |
7361 | "RTN","DGO THUT1",101 ,0) | |
7362 | N DGERR,D GFDA,IEN33 ,IEN365,IE N90,IENARY ,IENS,NUM3 65,NUM90,R ES | |
7363 | "RTN","DGO THUT1",102 ,0) | |
7364 | ; | |
7365 | "RTN","DGO THUT1",103 ,0) | |
7366 | S RES=1 | |
7367 | "RTN","DGO THUT1",104 ,0) | |
7368 | I +$G(DGD FN)'>0 S R ES="0^Inva lid DFN" G FILEPRDX | |
7369 | "RTN","DGO THUT1",105 ,0) | |
7370 | ; get fil e 33 ien t o file dat a into | |
7371 | "RTN","DGO THUT1",106 ,0) | |
7372 | S IEN33=+ $O(^DGOTH( 33,"B",DGD FN,"")) I IEN33'>0 S RES="0^Un able to fi nd an entr y in file 33 for thi s patient" G FILEPRD X | |
7373 | "RTN","DGO THUT1",107 ,0) | |
7374 | ; try to lock entry | |
7375 | "RTN","DGO THUT1",108 ,0) | |
7376 | I '$$LOCK (IEN33) S RES="0^Una ble to loc k entry in file 33 ( ien = "_IE N33_")" G FILEPRDX | |
7377 | "RTN","DGO THUT1",109 ,0) | |
7378 | ; get sub -file 33.0 1 ien, cre ate new en try if nec essary | |
7379 | "RTN","DGO THUT1",110 ,0) | |
7380 | S NUM365= +$P(DATAST R,U) I NUM 365'>0 S R ES="0^Inva lid 365 da y period n umber" G F ILEPRDX | |
7381 | "RTN","DGO THUT1",111 ,0) | |
7382 | S IEN365= +$O(^DGOTH (33,IEN33, 1,"B",NUM3 65,"")) I IEN365'>0 D | |
7383 | "RTN","DGO THUT1",112 ,0) | |
7384 | .; no exi sting entr y for this 365 day p eriod - cr eate a new one | |
7385 | "RTN","DGO THUT1",113 ,0) | |
7386 | .S IENS=" +1,"_IEN33 _"," | |
7387 | "RTN","DGO THUT1",114 ,0) | |
7388 | .S DGFDA( 33.01,IENS ,.01)=NUM3 65 | |
7389 | "RTN","DGO THUT1",115 ,0) | |
7390 | .I $P(DAT ASTR,U,6)> 0 S DGFDA( 33.01,IENS ,.02)=$P(D ATASTR,U,6 ) ; make s tart date of new 365 day perio d the same as starti ng date of 90 day pe riod we're filing | |
7391 | "RTN","DGO THUT1",116 ,0) | |
7392 | .D UPDATE ^DIE(,"DGF DA","IENAR Y","DGERR" ) | |
7393 | "RTN","DGO THUT1",117 ,0) | |
7394 | .S IEN365 =+$G(IENAR Y(1)) | |
7395 | "RTN","DGO THUT1",118 ,0) | |
7396 | .K DGFDA, IENARY | |
7397 | "RTN","DGO THUT1",119 ,0) | |
7398 | .Q | |
7399 | "RTN","DGO THUT1",120 ,0) | |
7400 | I $D(DGER R) S RES=" 0^"_$G(DGE RR("DIERR" ,1,"TEXT", 1)) G FILE PRDX | |
7401 | "RTN","DGO THUT1",121 ,0) | |
7402 | ; get sub -file 33.1 1 ien, cre ate new en try if nec essary | |
7403 | "RTN","DGO THUT1",122 ,0) | |
7404 | S NUM90=+ $P(DATASTR ,U,2) I NU M90'>0 S R ES="0^Inva lid 90 day period nu mber" G FI LEPRDX | |
7405 | "RTN","DGO THUT1",123 ,0) | |
7406 | S IEN90=+ $O(^DGOTH( 33,IEN33,1 ,IEN365,1, "B",NUM90, "")) I IEN 90'>0 D | |
7407 | "RTN","DGO THUT1",124 ,0) | |
7408 | .; no exi sting entr y for this 90 day pe riod - cre ate a new one | |
7409 | "RTN","DGO THUT1",125 ,0) | |
7410 | .S IENS=" +1,"_IEN36 5_","_IEN3 3_"," | |
7411 | "RTN","DGO THUT1",126 ,0) | |
7412 | .S DGFDA( 33.11,IENS ,.01)=NUM9 0 | |
7413 | "RTN","DGO THUT1",127 ,0) | |
7414 | .D UPDATE ^DIE(,"DGF DA","IENAR Y","DGERR" ) | |
7415 | "RTN","DGO THUT1",128 ,0) | |
7416 | .S IEN90= +$G(IENARY (1)) | |
7417 | "RTN","DGO THUT1",129 ,0) | |
7418 | .K DGFDA, IENARY | |
7419 | "RTN","DGO THUT1",130 ,0) | |
7420 | .Q | |
7421 | "RTN","DGO THUT1",131 ,0) | |
7422 | I $D(DGER R) S RES=" 0^"_$G(DGE RR("DIERR" ,1,"TEXT", 1)) G FILE PRDX | |
7423 | "RTN","DGO THUT1",132 ,0) | |
7424 | ; file da ta | |
7425 | "RTN","DGO THUT1",133 ,0) | |
7426 | S IENS=IE N90_","_IE N365_","_I EN33_"," | |
7427 | "RTN","DGO THUT1",134 ,0) | |
7428 | I +$P(DAT ASTR,U,6) S DGFDA(33 .11,IENS,. 02)=$P(DAT ASTR,U,6) | |
7429 | "RTN","DGO THUT1",135 ,0) | |
7430 | I +$P(DAT ASTR,U,5) D | |
7431 | "RTN","DGO THUT1",136 ,0) | |
7432 | .S DGFDA( 33.11,IENS ,.03)=$E($ P(DATASTR, U,8),1,60) | |
7433 | "RTN","DGO THUT1",137 ,0) | |
7434 | .S DGFDA( 33.11,IENS ,.04)=$P(D ATASTR,U,5 ) | |
7435 | "RTN","DGO THUT1",138 ,0) | |
7436 | .Q | |
7437 | "RTN","DGO THUT1",139 ,0) | |
7438 | S DGFDA(3 3.11,IENS, .05)=$E($P (DATASTR,U ,8),1,60) | |
7439 | "RTN","DGO THUT1",140 ,0) | |
7440 | S DGFDA(3 3.11,IENS, .06)=$$NOW ^XLFDT() | |
7441 | "RTN","DGO THUT1",141 ,0) | |
7442 | I $P(DATA STR,U,4)'= "" S DGFDA (33.11,IEN S,.07)=$E( $P(DATASTR ,U,4),1,60 ) | |
7443 | "RTN","DGO THUT1",142 ,0) | |
7444 | S DGFDA(3 3.11,IENS, .08)=$P(DA TASTR,U,9) | |
7445 | "RTN","DGO THUT1",143 ,0) | |
7446 | I $P(DATA STR,U,7)'= "" S DGFDA (33.11,IEN S,.09)=$E( $P(DATASTR ,U,7),1,60 ) | |
7447 | "RTN","DGO THUT1",144 ,0) | |
7448 | I +$P(DAT ASTR,U,3) S DGFDA(33 .11,IENS,. 1)=$P(DATA STR,U,3) | |
7449 | "RTN","DGO THUT1",145 ,0) | |
7450 | D FILE^DI E(,"DGFDA" ,"DGERR") | |
7451 | "RTN","DGO THUT1",146 ,0) | |
7452 | I $D(DGER R) S RES=" 0^"_$G(DGE RR("DIERR" ,1,"TEXT", 1)) | |
7453 | "RTN","DGO THUT1",147 ,0) | |
7454 | ; | |
7455 | "RTN","DGO THUT1",148 ,0) | |
7456 | FILEPRDX ; exit poin t | |
7457 | "RTN","DGO THUT1",149 ,0) | |
7458 | ; unlock entry | |
7459 | "RTN","DGO THUT1",150 ,0) | |
7460 | D UNLOCK( IEN33) | |
7461 | "RTN","DGO THUT1",151 ,0) | |
7462 | Q RES | |
7463 | "RTN","DGR P7") | |
7464 | 0^15^B2137 0530 | |
7465 | "RTN","DGR P7",1,0) | |
7466 | DGRP7 ;ALB /MRL,CKN,E RC - REGIS TRATION SC REEN 7/ELI GIBILITY I NFORMATION ;7/25/06 12:06pm | |
7467 | "RTN","DGR P7",2,0) | |
7468 | ;;5.3;Reg istration; **528,653, 688,842,95 2**;Aug 13 , 1993;Bui ld 68 | |
7469 | "RTN","DGR P7",3,0) | |
7470 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7471 | "RTN","DGR P7",4,0) | |
7472 | ; | |
7473 | "RTN","DGR P7",5,0) | |
7474 | N DGCASH, DGMBCK,DGO THMSG,DGPR VSEL | |
7475 | "RTN","DGR P7",6,0) | |
7476 | ;DG*5.3*9 52 add .55 into DRPG array | |
7477 | "RTN","DGR P7",7,0) | |
7478 | S DGRPS=7 D H^DGRPU F I=0,.29 ,.3,.31,.3 2,.321,.36 ,.362,.385 ,.55,"TYPE ","VET" S DGRP(I)=$S ($D(^DPT(D FN,I)):^(I ),1:"") | |
7479 | "RTN","DGR P7",8,0) | |
7480 | S (DGRPW, Z)=1 D WW^ DGRPV W " Pati ent Type: " S DGRPX= DGRP("TYPE "),Z=$S($D (^DG(391,+ DGRPX,0)): $P(^(0),"^ ",1),1:DGR PU),Z1=34 D WW1^DGRP V W "Veter an: " S DG RPX=DGRP(" VET"),(X,Z 1)=1 D YN | |
7481 | "RTN","DGR P7",9,0) | |
7482 | W !?9,"Sv c Connecte d: " S DGR PX=DGRP(.3 ),X=1,Z1=3 1,DGNA=$S( $P(DGRP("V ET"),"^",1 )="Y":0,1: 1) D YN2 W "SC Perce nt: " W:$E (Z)'="Y" " N/A" I $E( Z)="Y" D | |
7483 | "RTN","DGR P7",10,0) | |
7484 | .S X=$P(D GRPX,"^",2 ) W $S(X=" ":"UNANSWE RED",1:+X_ "%") | |
7485 | "RTN","DGR P7",11,0) | |
7486 | .S X=$P(D GRP(.3),"^ ",1),DGNA= $S(X'="Y": 1,1:0) | |
7487 | "RTN","DGR P7",12,0) | |
7488 | .W !?9,"S C Award Da te: ",$$DA TENP^DG101 0P0(DGRPX, 12) W ?53, "Unemploya ble: " S X =5,Z1=0 D YN2 | |
7489 | "RTN","DGR P7",13,0) | |
7490 | .W !?19," P&T: " S X =4,Z1=23 D YN2 I $P( DGRP(.3),U ,4)["Y" W "P&T Effec tive Date: " W:$P(DG RP(.3),U,1 3)']"" "UN ANSWERED" I $P(DGRP( .3),U,13)] "" S Y=$P( DGRP(.3),U ,13) D DD^ %DT W $G(Y ) | |
7491 | "RTN","DGR P7",14,0) | |
7492 | W !?9,"Ra ted Incomp .: " S X=$ $YN2^DG101 0P0(DGRP(. 29),12) W X D:X["Y" | |
7493 | "RTN","DGR P7",15,0) | |
7494 | .W " Da te (CIVIL) : ",$$DATE NP^DG1010P 0(DGRP(.29 ),2) | |
7495 | "RTN","DGR P7",16,0) | |
7496 | .W " D ate (VA): ",$$DATENP ^DG1010P0( DGRP(.29), 1) | |
7497 | "RTN","DGR P7",17,0) | |
7498 | S DGRPX=D GRP(.31) W !?10,"Cla im Number: ",$S($P(D GRPX,"^",3 )]"":$P(DG RPX,"^",3) ,1:DGRPU), !?11,"Fold er Loc.: " ,$$POINT^D G1010P0(DG RP(.31),4, 4) | |
7499 | "RTN","DGR P7",18,0) | |
7500 | S Z=2 D W W^DGRPV ;m onetary be nefits sec tion | |
7501 | "RTN","DGR P7",19,0) | |
7502 | W " Aid & Attenda nce: " S Z =$$YN2^DG1 010P0(DGRP (.362),12) D MBCK S Z1=31 D WW 1^DGRPV | |
7503 | "RTN","DGR P7",20,0) | |
7504 | W "Houseb ound: ",$$ YN2^DG1010 P0(DGRP(.3 62),13) D MBCK | |
7505 | "RTN","DGR P7",21,0) | |
7506 | W !?12,"V A Pension: " S Z=$$Y N2^DG1010P 0(DGRP(.36 2),14) D M BCK S Z1=2 5 D WW1^DG RPV | |
7507 | "RTN","DGR P7",22,0) | |
7508 | I $P(DGRP (.362),"^" ,14)]"" D ;DG*5.3*8 42 | |
7509 | "RTN","DGR P7",23,0) | |
7510 | .I DGRPV= 1 D DISPPE N^DGRP7CP Q | |
7511 | "RTN","DGR P7",24,0) | |
7512 | .I ($P(DG RP(.362)," ^",14)="N" )&($P(DGRP (.385),"^" ,3)]"") W "Pension A /T Date: " _$$DATENP^ DG1010P0(D GRP(.385), 3) Q | |
7513 | "RTN","DGR P7",25,0) | |
7514 | .I ($P(DG RP(.362)," ^",14)="Y" )&($P(DGRP (.385),"^" ,1)]"") W "Pension A /T Date: " _$$DATENP^ DG1010P0(D GRP(.385), 1) Q | |
7515 | "RTN","DGR P7",26,0) | |
7516 | W !?9,"VA Disabilit y: ",$$YN2 ^DG1010P0( DGRP(.3),1 1) D MBCK | |
7517 | "RTN","DGR P7",27,0) | |
7518 | W !?4,"To tal Check Amount: " S X=$$DISP ^DG1010P0( DGRP(.362) ,20,'DGMBC K) W $S(X: "$"_X,1:X) | |
7519 | "RTN","DGR P7",28,0) | |
7520 | W !?10,"G I Insuranc e: " S Z=$ $YN2^DG101 0P0(DGRP(. 362),17) S Z1=35 D W W1^DGRPV | |
7521 | "RTN","DGR P7",29,0) | |
7522 | W "Amount : " S X=$$ DISP^DG101 0P0(DGRP(. 362),6) W $S(X:"$"_X ,1:X) | |
7523 | "RTN","DGR P7",30,0) | |
7524 | S Z=3 D W W^DGRPV S DGRPE=+DGR P(.36),Z=$ S($D(^DIC( 8,+DGRPE,0 )):$P(^(0) ,"^",1),1: DGRPU) | |
7525 | "RTN","DGR P7",31,0) | |
7526 | ;DG*5.3*9 52 | |
7527 | "RTN","DGR P7",32,0) | |
7528 | ;if the p rimary eli gibility c ode is EXP ANDED MH C ARE | |
7529 | "RTN","DGR P7",33,0) | |
7530 | ;concaten ate expand ed mental healthcare type when displayin g the prim ary eligib ility code | |
7531 | "RTN","DGR P7",34,0) | |
7532 | ;Vista Re gistration screen 7 | |
7533 | "RTN","DGR P7",35,0) | |
7534 | I $D(^DIC (8,+DGRPE, 0)),$P(^(0 ),"^",9)=2 3,$G(DGRP( .55))'="" S Z=Z_" - "_$E($$OTH SOC^DGOTHD 1($G(DGRP( .55))),1,2 4),(DGPRVS EL,DGOTHMS G)=0 | |
7535 | "RTN","DGR P7",36,0) | |
7536 | W " Prim ary Elig C ode: ",Z D AAC1^DGLO CK2 I DGAA C(1)]"" W !?8,"Agenc y/Country: ",$S($D(^ DIC(35,+$P (DGRP(.3), "^",9),0)) :$P(^(0)," ^",1),1:DG RPU) | |
7537 | "RTN","DGR P7",37,0) | |
7538 | W !?4,"Ot her Elig C ode(s): " S I1="" F I=0:0 S I= $O(^DPT("A EL",DFN,I) ) Q:'I I $D(^DIC(8, +I,0)),I'= DGRPE S I1 =I1+1 W:I1 >1 !?24 W $P(^(0),"^ ",1) | |
7539 | "RTN","DGR P7",38,0) | |
7540 | W:'I1 "NO ADDITIONA L ELIGIBIL ITIES IDEN TIFIED" | |
7541 | "RTN","DGR P7",39,0) | |
7542 | S DGRPX=+ $P(DGRP(.3 2),"^",3) W !?5,"Per iod of Ser vice: ",$S ($D(^DIC(2 1,+DGRPX,0 )):$P(^(0) ,"^",1),1: DGRPU) | |
7543 | "RTN","DGR P7",40,0) | |
7544 | D ^DGYZOD S G:'DGODS CONT S DG RPX=$S($D( ^DPT(DFN," ODS")):^(" ODS"),1:"" ) W !?6,"R ecalled to Duty: ",$ S($P(DGRPX ,"^",2)=1: "FROM NATI ONAL GUARD S",$P(DGRP X,"^",2)=2 :"FROM RES ERVES",$P( DGRPX,"^", 2)=0:"NO", 1:DGRPU) | |
7545 | "RTN","DGR P7",41,0) | |
7546 | W !?18,"R ank: ",$S( $D(^DIC(25 002.1,+$P( DGRPX,"^", 3),0)):$P( ^(0),"^",1 ),1:DGRPU) | |
7547 | "RTN","DGR P7",42,0) | |
7548 | CONT ; | |
7549 | "RTN","DGR P7",43,0) | |
7550 | ;display Combat Vet Eligibili ty, if pre sent | |
7551 | "RTN","DGR P7",44,0) | |
7552 | N DGCV,SH AD | |
7553 | "RTN","DGR P7",45,0) | |
7554 | S SHAD=$P (DGRP(.321 ),"^",15) ;SHAD Ind icator | |
7555 | "RTN","DGR P7",46,0) | |
7556 | S DGCV=$$ CVEDT^DGCV (DFN) I +$ G(DGCV)=1 D | |
7557 | "RTN","DGR P7",47,0) | |
7558 | . W !,"<3 .1> Combat Vet Elig. : " | |
7559 | "RTN","DGR P7",48,0) | |
7560 | . W $S($P (DGCV,U,3) =1:"ELIGIB LE",$P(DGC V,U,3)=0:" EXPIRED",1 :"") | |
7561 | "RTN","DGR P7",49,0) | |
7562 | . I $P($G (DGCV),U,2 )]"" D | |
7563 | "RTN","DGR P7",50,0) | |
7564 | . . S Y=$ P(DGCV,U,2 ) D DD^%DT | |
7565 | "RTN","DGR P7",51,0) | |
7566 | . . W " E nd Date: " _Y | |
7567 | "RTN","DGR P7",52,0) | |
7568 | . I SHAD= 1 W ?56,"< 3.2>Proj 1 12/SHAD: Y ES" ;Only display i f YES | |
7569 | "RTN","DGR P7",53,0) | |
7570 | ; | |
7571 | "RTN","DGR P7",54,0) | |
7572 | I (+$G(DG CV)'=1)&(S HAD=1) W ! ,?56,"<3.2 >Proj 112/ SHAD: YES" | |
7573 | "RTN","DGR P7",55,0) | |
7574 | ; | |
7575 | "RTN","DGR P7",56,0) | |
7576 | ;print sc disabilit ies (per p atient) | |
7577 | "RTN","DGR P7",57,0) | |
7578 | W ! S Z=4 D WW^DGRP V W " Serv ice Connec ted Condit ions as st ated by ap plicant" S X="",$P(X ,"-",52)=" " W !?4,X | |
7579 | "RTN","DGR P7",58,0) | |
7580 | W !?4 S I 3=0 F I=0: 0 S I=$O(^ DPT(DFN,.3 73,I)) Q:' I S I1=$P (^(I,0),"^ ",1)_" ("_ +$P(^(0)," ^",2)_"%), ",I3=I W: (79-$X)<$L (I1) !?4 W I1 | |
7581 | "RTN","DGR P7",59,0) | |
7582 | W:'I3 ?4, "NONE STAT ED" | |
7583 | "RTN","DGR P7",60,0) | |
7584 | Q K DGAAC, DGNA,DGODS ,DGRP,DGRP E,DGRPX,I, I1,I2,I3,X ,X1,Z,Z1 | |
7585 | "RTN","DGR P7",61,0) | |
7586 | G ^DGRPP | |
7587 | "RTN","DGR P7",62,0) | |
7588 | YN S Z=$S( $P(DGRPX," ^",X)="Y": "YES",$P(D GRPX,"^",X )="N":"NO" ,$P(DGRPX, "^",X)="U" :"UNKNOWN" ,1:"UNANSW ERED") D W W1^DGRPV | |
7589 | "RTN","DGR P7",63,0) | |
7590 | Q | |
7591 | "RTN","DGR P7",64,0) | |
7592 | YN2 S Z=$S (DGNA:"N/A ",$P(DGRPX ,"^",X)="Y ":"YES",$P (DGRPX,"^" ,X)="N":"N O",$P(DGRP X,"^",X)=" U":"UNKNOW N",1:"UNAN SWERED") D WW1^DGRPV | |
7593 | "RTN","DGR P7",65,0) | |
7594 | Q | |
7595 | "RTN","DGR P7",66,0) | |
7596 | MBCK ;flag for any M B Y/N fiel ds = yes | |
7597 | "RTN","DGR P7",67,0) | |
7598 | S DGMBCK= $S($G(DGMB CK):1,(X=" Y"):1,1:0) | |
7599 | "RTN","DGR P7",68,0) | |
7600 | Q | |
7601 | "RTN","DGR PD") | |
7602 | 0^17^B1061 42283 | |
7603 | "RTN","DGR PD",1,0) | |
7604 | DGRPD ;ALB /MRL,MLR,J AN,LBD,EG, BRM,JRC,BA J,JAM-PATI ENT INQUIR Y (NEW) ;J uly 09, 20 14 12:16p m | |
7605 | "RTN","DGR PD",2,0) | |
7606 | ;;5.3;Reg istration; **109,124, 121,57,161 ,149,286,3 58,436,445 ,489,498,5 06,513,518 ,550,545,5 68,585,677 ,703,688,8 87,907,925 ,936,940,9 41,952**;A ug 13, 199 3;Build 68 | |
7607 | "RTN","DGR PD",3,0) | |
7608 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7609 | "RTN","DGR PD",4,0) | |
7610 | ; | |
7611 | "RTN","DGR PD",5,0) | |
7612 | ; *286* N ewing vari ables X,Y in OKLINE subroutine | |
7613 | "RTN","DGR PD",6,0) | |
7614 | ; *358* I f a patien t is on a domiciliar y ward, do n't displa y MEANS | |
7615 | "RTN","DGR PD",7,0) | |
7616 | ; TEST re quired/Med ication Co payment Ex emption me ssages | |
7617 | "RTN","DGR PD",8,0) | |
7618 | ; *436* I f an inpat ient is no t on a dom iciliary w ard, don't display | |
7619 | "RTN","DGR PD",9,0) | |
7620 | ; Medicat ion Copaym ent Exempt ion messag e | |
7621 | "RTN","DGR PD",10,0) | |
7622 | ; *545* A dd death i nformation near the remarks fi eld | |
7623 | "RTN","DGR PD",11,0) | |
7624 | ; *677* A dded Emerg ency Respo nse | |
7625 | "RTN","DGR PD",12,0) | |
7626 | ; *688* M odified to display C ountry and Foreign A ddress | |
7627 | "RTN","DGR PD",13,0) | |
7628 | ; *936* M odified to display H ealth Bene fit Plans | |
7629 | "RTN","DGR PD",14,0) | |
7630 | ; *940* # 879316,#87 9318 - Dis play Perma nent & Tot al Disable d Status | |
7631 | "RTN","DGR PD",15,0) | |
7632 | ; *941* # 887088 - R edesign of Inquiry S creen layo ut for dis playing th e addresse s | |
7633 | "RTN","DGR PD",16,0) | |
7634 | ; | |
7635 | "RTN","DGR PD",17,0) | |
7636 | ; Integra tion Agree ments: | |
7637 | "RTN","DGR PD",18,0) | |
7638 | ; 6138 - DGHBPUTL A PI | |
7639 | "RTN","DGR PD",19,0) | |
7640 | ; | |
7641 | "RTN","DGR PD",20,0) | |
7642 | SEL K DFN, DGRPOUT W ! S DIC="^ DPT(",DIC( 0)="AEQMZ" D ^DIC G Q:Y'>0 S D FN=+Y N Y W ! S DIR( 0)="E" D ^ DIR G SEL: $D(DTOUT)! ($D(DUOUT) ) D EN G S EL | |
7643 | "RTN","DGR PD",21,0) | |
7644 | EN ;call t o display patient in quiry - in put DFN | |
7645 | "RTN","DGR PD",22,0) | |
7646 | ;MPI/PD C HANGE | |
7647 | "RTN","DGR PD",23,0) | |
7648 | S DGCMOR= "UNSPECIFI ED",DGMPI= $G(^DPT(+D FN,"MPI")) | |
7649 | "RTN","DGR PD",24,0) | |
7650 | K DGRPOUT ,DGHOW S D GABBRV=$S( $D(^DG(43, 1,0)):+$P( ^(0),"^",3 8),1:0),DG RPU="UNSPE CIFIED" D DEM^VADPT, HDR^DGRPD1 | |
7651 | "RTN","DGR PD",25,0) | |
7652 | ;JAM begi n changes Patch DG*5 .3*941 add .115 and new addres s fields l ayout | |
7653 | "RTN","DGR PD",26,0) | |
7654 | ;DG*5.3*9 52 add .55 into DRPG array | |
7655 | "RTN","DGR PD",27,0) | |
7656 | F I=0,.11 ,.13,.121, .122,.31,. 32,.36,.36 1,.141,.3, .115,.55 S DGRP(I)=$ S($D(^DPT( DFN,I)):^( I),1:"") | |
7657 | "RTN","DGR PD",28,0) | |
7658 | ;jam DG*5 .3*925 RM# 788099 cha nge labels to "Perma nent Maili ng Address " and "Tem porary Mai ling Addre ss" | |
7659 | "RTN","DGR PD",29,0) | |
7660 | ; | |
7661 | "RTN","DGR PD",30,0) | |
7662 | W " Resid ential Add ress: " | |
7663 | "RTN","DGR PD",31,0) | |
7664 | W ?40,"Pe rmanent Ma iling Addr ess: " | |
7665 | "RTN","DGR PD",32,0) | |
7666 | S DGAD=.1 15,(DGA1,D GA2)=1 D A L^DGRPU(35 ) S DGAD=. 11,DGA1=1, DGA2=2 D A L^DGRPU(35 ) | |
7667 | "RTN","DGR PD",33,0) | |
7668 | W !?5 | |
7669 | "RTN","DGR PD",34,0) | |
7670 | N Z,Z1 | |
7671 | "RTN","DGR PD",35,0) | |
7672 | S Z1=39,Z =$S($D(DGA (1)):DGA(1 ),1:"NONE ON FILE") D WW1^DGRP V W $S($D( DGA(2)):DG A(2),1:"NO PERMANENT MAILING A DDRESS") | |
7673 | "RTN","DGR PD",36,0) | |
7674 | ; loop th rough DGA array begi nning with DGA(2) an d print da ta at ?5 ( odds) and ?44 (evens ) | |
7675 | "RTN","DGR PD",37,0) | |
7676 | S I=2 F I 1=0:0 S I= $O(DGA(I)) Q:I="" W :(I#2)!($X >40) !?5 W :'(I#2) ?4 4 W DGA(I) | |
7677 | "RTN","DGR PD",38,0) | |
7678 | N DGCC | |
7679 | "RTN","DGR PD",39,0) | |
7680 | S DGCC=$$ COUNTY^DGR PCADD(.DGR P,.115) ; print Coun ty if appl icable | |
7681 | "RTN","DGR PD",40,0) | |
7682 | W !?5,"Co unty: "_DG CC | |
7683 | "RTN","DGR PD",41,0) | |
7684 | S DGCC=$$ COUNTY^DGR PCADD(.DGR P,.11) ; p rint Count y if appli cable | |
7685 | "RTN","DGR PD",42,0) | |
7686 | W ?44,"Co unty: "_DG CC | |
7687 | "RTN","DGR PD",43,0) | |
7688 | W !?6,"Ph one: ",$S( $P(DGRP(.1 3),U,1)]"" :$P(DGRP(. 13),U,1),1 :DGRPU) | |
7689 | "RTN","DGR PD",44,0) | |
7690 | W ?42,"Ba d Addr: ", $$EXTERNAL ^DILFD(2,. 121,"",$P( DGRP(.11), U,16)) | |
7691 | "RTN","DGR PD",45,0) | |
7692 | W !?5,"Of fice: ",$S ($P(DGRP(. 13),U,2)]" ":$P(DGRP( .13),U,2), 1:DGRPU) | |
7693 | "RTN","DGR PD",46,0) | |
7694 | W ?46,"Ce ll: ",$S($ P(DGRP(.13 ),U,4)]"": $P(DGRP(.1 3),U,4),1: DGRPU) | |
7695 | "RTN","DGR PD",47,0) | |
7696 | W !?44,"E -mail: ",$ S($P(DGRP( .13),U,3)] "":$P(DGRP (.13),U,3) ,1:DGRPU) | |
7697 | "RTN","DGR PD",48,0) | |
7698 | W !! | |
7699 | "RTN","DGR PD",49,0) | |
7700 | K DGA,DGA 1,DGA2 | |
7701 | "RTN","DGR PD",50,0) | |
7702 | I $P(DGRP (.121),"^" ,9)="Y" S DGAD=.121, (DGA1,DGA2 )=1 D AL^D GRPU(30) | |
7703 | "RTN","DGR PD",51,0) | |
7704 | N CONACT | |
7705 | "RTN","DGR PD",52,0) | |
7706 | ; set Con fidential Active Fla g | |
7707 | "RTN","DGR PD",53,0) | |
7708 | S CONACT= $P(DGRP(.1 41),"^",9) | |
7709 | "RTN","DGR PD",54,0) | |
7710 | I CONACT= "Y" D | |
7711 | "RTN","DGR PD",55,0) | |
7712 | .; check the begin/ end dates, set activ e flag to NO and do not displa y if outsi de the dat e range | |
7713 | "RTN","DGR PD",56,0) | |
7714 | .N DGCABE G,DGCAEND, DGI | |
7715 | "RTN","DGR PD",57,0) | |
7716 | .S DGCABE G=$P(DGRP( .141),U,7) ,DGCAEND=$ P(DGRP(.14 1),U,8) | |
7717 | "RTN","DGR PD",58,0) | |
7718 | .I 'DGCAB EG!(DGCABE G>DT)!(DGC AEND&(DGCA END<DT)) S CONACT="N " Q | |
7719 | "RTN","DGR PD",59,0) | |
7720 | .S DGAD=. 141,DGA1=1 ,DGA2=2 D AL^DGRPU(3 0) | |
7721 | "RTN","DGR PD",60,0) | |
7722 | W " Tempo rary Maili ng Address : " | |
7723 | "RTN","DGR PD",61,0) | |
7724 | W ?40,"Co nfidential Mailing A ddress: " | |
7725 | "RTN","DGR PD",62,0) | |
7726 | W !?5 | |
7727 | "RTN","DGR PD",63,0) | |
7728 | W $S($D(D GA(1)):DGA (1),1:"NO TEMPORARY MAILING AD DRESS") W ?44,$S($D( DGA(2)):DG A(2),1:"NO NE ON FILE ") | |
7729 | "RTN","DGR PD",64,0) | |
7730 | ; loop th rough DGA array begi nning with DGA(2) an d print da ta at ?5 ( odds) and ?44 (evens ) | |
7731 | "RTN","DGR PD",65,0) | |
7732 | S I=2 F I 1=0:0 S I= $O(DGA(I)) Q:I="" W :(I#2)!($X >40) !?5 W :'(I#2) ?4 4 W DGA(I) | |
7733 | "RTN","DGR PD",66,0) | |
7734 | W ! | |
7735 | "RTN","DGR PD",67,0) | |
7736 | I $D(DGA( 1)) D | |
7737 | "RTN","DGR PD",68,0) | |
7738 | .S DGCC=$ $COUNTY^DG RPCADD(.DG RP,.121) ; print Cou nty if app licable | |
7739 | "RTN","DGR PD",69,0) | |
7740 | .W ?5,"Co unty: "_DG CC | |
7741 | "RTN","DGR PD",70,0) | |
7742 | I $D(DGA( 2)) D | |
7743 | "RTN","DGR PD",71,0) | |
7744 | .S DGCC=$ $COUNTY^DG RPCADD(.DG RP,.141) ; print Cou nty if app licable | |
7745 | "RTN","DGR PD",72,0) | |
7746 | .W ?44,"C ounty: "_D GCC | |
7747 | "RTN","DGR PD",73,0) | |
7748 | ;W !?2,"C ASS Cert: "_$S($P(DG RP(.121),U ,15)="Y":" Certified" ,$P(DGRP(. 121),U,15) ="F":"Fail ed",1:"NC" ) | |
7749 | "RTN","DGR PD",74,0) | |
7750 | ;W ?41,"C ASS Cert: "_$S($P(DG RP(.141),U ,17)="Y":" Certified" ,$P(DGRP(. 141),U,17) ="F":"Fail ed",1:"NC" ) | |
7751 | "RTN","DGR PD",75,0) | |
7752 | W !?6,"Ph one: ",$S( $P(DGRP(.1 21),U,9)'= "Y":"NOT A PPLICABLE" ,$P(DGRP(. 121),U,10) ]"":$P(DGR P(.121),U, 10),1:DGRP U) | |
7753 | "RTN","DGR PD",76,0) | |
7754 | W ?45,"Ph one: ",$S( $P(DGRP(.1 41),U,9)'= "Y":"NOT A PPLICABLE" ,CONACT'=" Y":"NOT AP PLICABLE", $P(DGRP(.1 3),U,15)]" ":$P(DGRP( .13),U,15) ,1:DGRPU) | |
7755 | "RTN","DGR PD",77,0) | |
7756 | S X="NOT APPLICABLE " | |
7757 | "RTN","DGR PD",78,0) | |
7758 | I $P(DGRP (.121),U,9 )="Y" D | |
7759 | "RTN","DGR PD",79,0) | |
7760 | .S Y=$P(D GRP(.121), U,7) X:Y]" " ^DD("DD" ) | |
7761 | "RTN","DGR PD",80,0) | |
7762 | .S X=$S(Y ]"":Y,1:DG RPU)_"-",Y =$P(DGRP(. 121),U,8) X:Y]"" ^DD ("DD") | |
7763 | "RTN","DGR PD",81,0) | |
7764 | .S X=X_$S (Y]"":Y,1: DGRPU) | |
7765 | "RTN","DGR PD",82,0) | |
7766 | N DGACT,D GTYP,DGCAN ,DGBEG,DGE ND,DGZ,DGX X,DGX,DGTY PNAM,DGCAT | |
7767 | "RTN","DGR PD",83,0) | |
7768 | W !?2,"Fr om/To: ",X | |
7769 | "RTN","DGR PD",84,0) | |
7770 | S DGX="NO T APPLICAB LE" | |
7771 | "RTN","DGR PD",85,0) | |
7772 | I CONACT= "Y" D | |
7773 | "RTN","DGR PD",86,0) | |
7774 | .S (DGZ,D GX)="" F D GI=7,8 S D GZ=$P(DGRP (.141),"^" ,DGI),Y=DG Z D | |
7775 | "RTN","DGR PD",87,0) | |
7776 | ..I DGI=7 X:Y]"" ^D D("DD") S DGBEG=Y,DG X=Y | |
7777 | "RTN","DGR PD",88,0) | |
7778 | ..I DGI=8 X:Y]"" ^D D("DD") S DGEND=Y,DG X=DGX_"-"_ $S(Y]"":Y, 1:"UNANSWE RED") | |
7779 | "RTN","DGR PD",89,0) | |
7780 | W ?43,"Fr om/To: "_D GX | |
7781 | "RTN","DGR PD",90,0) | |
7782 | W !?41,"C onfidentia l Address Categories : " I $D(^ DPT(DFN,.1 4)) D | |
7783 | "RTN","DGR PD",91,0) | |
7784 | .; If not active, d o not disp lay catego ries | |
7785 | "RTN","DGR PD",92,0) | |
7786 | .I CONACT '="Y" Q | |
7787 | "RTN","DGR PD",93,0) | |
7788 | .S DGCAT= $$GET1^DID (2.141,.01 ,"","POINT ER","","DG ERR") | |
7789 | "RTN","DGR PD",94,0) | |
7790 | .S DGX="" ,DGCAN="" F S DGCAN =$O(^DPT(D FN,.14,DGC AN)) Q:DGC AN="" D | |
7791 | "RTN","DGR PD",95,0) | |
7792 | ..Q:'$D(^ DPT(DFN,.1 4,DGCAN,0) ) | |
7793 | "RTN","DGR PD",96,0) | |
7794 | ..S DGTYP =$P(^DPT(D FN,.14,DGC AN,0),"^", 1),DGACT=$ P(^DPT(DFN ,.14,DGCAN ,0),"^",2) | |
7795 | "RTN","DGR PD",97,0) | |
7796 | ..S DGACT =$S(DGACT= "Y":"Activ e",DGACT=" N":"Inacti ve",1:"Una nswered") | |
7797 | "RTN","DGR PD",98,0) | |
7798 | ..S DGTYP NAM="" F D GI=1:1 S D GTYPNAM=$P (DGCAT,";" ,DGI) Q:DG TYPNAM="" D | |
7799 | "RTN","DGR PD",99,0) | |
7800 | ...I DGTY PNAM[DGTYP S DGTYPNA M=$P(DGTYP NAM,":",2) ,DGX=DGTYP NAM_"("_DG ACT_")"_", "_DGX | |
7801 | "RTN","DGR PD",100,0) | |
7802 | S DGXX="" F DGI=1:1 S DGXX=$P (DGX,",",D GI) Q:DGXX ="" D | |
7803 | "RTN","DGR PD",101,0) | |
7804 | .W !?42,D GXX | |
7805 | "RTN","DGR PD",102,0) | |
7806 | ; | |
7807 | "RTN","DGR PD",103,0) | |
7808 | I '$$OKLI NE^DGRPD1( 16) G Q | |
7809 | "RTN","DGR PD",104,0) | |
7810 | N DGEMER S DGEMER=$ $EXTERNAL^ DILFD(2,.1 81,"",$P($ G(^DPT(DFN ,.18)),"^" )) | |
7811 | "RTN","DGR PD",105,0) | |
7812 | W:DGEMER] "" !?32,"E mergency R esponse: " ,DGEMER | |
7813 | "RTN","DGR PD",106,0) | |
7814 | I 'DGABBR V W !!?4," POS: ",$S( $D(^DIC(21 ,+$P(DGRP( .32),"^",3 ),0)):$P(^ (0),"^",1) ,1:DGRPU), ?42,"Claim #: ",$S($ P(DGRP(.31 ),"^",3)]" ":$P(DGRP( .31),"^",3 ),1:"UNSPE CIFIED") | |
7815 | "RTN","DGR PD",107,0) | |
7816 | I 'DGABBR V W !?2,"R elig: ",$S ($D(^DIC(1 3,+$P(DGRP (0),"^",8) ,0)):$P(^( 0),"^",1), 1:DGRPU),? 46,"Birth Sex: ",$S( $P(VADM(5) ,"^",2)]"" :$P(VADM(5 ),"^",2),1 :"UNSPECIF IED") ; DG *5.3*907 | |
7817 | "RTN","DGR PD",108,0) | |
7818 | I 'DGABBR V W ! D | |
7819 | "RTN","DGR PD",109,0) | |
7820 | .N RACE,E THNIC,PTR, VAL,X,DIWL ,DIWR,DIWF | |
7821 | "RTN","DGR PD",110,0) | |
7822 | .K ^UTILI TY($J,"W") | |
7823 | "RTN","DGR PD",111,0) | |
7824 | .S PTR=0 F S PTR=+ $O(^DPT(DF N,.02,PTR) ) Q:'PTR D | |
7825 | "RTN","DGR PD",112,0) | |
7826 | ..S VAL=+ $G(^DPT(DF N,.02,PTR, 0)) | |
7827 | "RTN","DGR PD",113,0) | |
7828 | ..Q:$$INA CTIVE^DGUT L4(VAL,1) | |
7829 | "RTN","DGR PD",114,0) | |
7830 | ..S VAL=$ $PTR2TEXT^ DGUTL4(VAL ,1) S:+$O( ^DPT(DFN,. 02,PTR)) V AL=VAL_", " | |
7831 | "RTN","DGR PD",115,0) | |
7832 | ..S X=VAL ,DIWL=0,DI WR=30,DIWF ="" D ^DIW P | |
7833 | "RTN","DGR PD",116,0) | |
7834 | .M RACE=^ UTILITY($J ,"W",0) S: $G(RACE(1, 0))="" RAC E(1,0)="UN ANSWERED" | |
7835 | "RTN","DGR PD",117,0) | |
7836 | .K ^UTILI TY($J,"W") | |
7837 | "RTN","DGR PD",118,0) | |
7838 | .S PTR=0 F S PTR=+ $O(^DPT(DF N,.06,PTR) ) Q:'PTR D | |
7839 | "RTN","DGR PD",119,0) | |
7840 | ..S VAL=+ $G(^DPT(DF N,.06,PTR, 0)) | |
7841 | "RTN","DGR PD",120,0) | |
7842 | ..Q:$$INA CTIVE^DGUT L4(VAL,2) | |
7843 | "RTN","DGR PD",121,0) | |
7844 | ..S VAL=$ $PTR2TEXT^ DGUTL4(VAL ,2) S:+$O( ^DPT(DFN,. 06,PTR)) V AL=VAL_", " | |
7845 | "RTN","DGR PD",122,0) | |
7846 | ..S X=VAL ,DIWL=0,DI WR=30,DIWF ="" D ^DIW P | |
7847 | "RTN","DGR PD",123,0) | |
7848 | .M ETHNIC =^UTILITY( $J,"W",0) S:$G(ETHNI C(1,0))="" ETHNIC(1, 0)="UNANSW ERED" | |
7849 | "RTN","DGR PD",124,0) | |
7850 | .K ^UTILI TY($J,"W") | |
7851 | "RTN","DGR PD",125,0) | |
7852 | .W ?3,"Ra ce: ",RACE (1,0),?40, "Ethnicity : ",ETHNIC (1,0) | |
7853 | "RTN","DGR PD",126,0) | |
7854 | .F X=2:1 Q:'$D(RACE (X,0))&'$D (ETHNIC(X, 0)) W !,? 9,$G(RACE( X,0)),?51, $G(ETHNIC( X,0)) | |
7855 | "RTN","DGR PD",127,0) | |
7856 | I '$$OKLI NE^DGRPD1( 16) G Q | |
7857 | "RTN","DGR PD",128,0) | |
7858 | D LANGUAG E | |
7859 | "RTN","DGR PD",129,0) | |
7860 | I '$$OKLI NE^DGRPD1( 10) G Q | |
7861 | "RTN","DGR PD",130,0) | |
7862 | ;display cv status #4156 | |
7863 | "RTN","DGR PD",131,0) | |
7864 | N DGCV S DGCV=$$CVE DT^DGCV(+D FN) | |
7865 | "RTN","DGR PD",132,0) | |
7866 | W !!,?2," Combat Vet Status: " _$S($P(DGC V,U,3)=1:" ELIGIBLE", $P(DGCV,U, 3)="":"NOT ELIGIBLE" ,1:"EXPIRE D") I DGCV >0 W ?45," End Date: "_$$FMTE^X LFDT($P(DG CV,U,2),"5 DZ") | |
7867 | "RTN","DGR PD",133,0) | |
7868 | ;display primary el igibility | |
7869 | "RTN","DGR PD",134,0) | |
7870 | S X1=DGRP (.36),X=$P (DGRP(.361 ),"^",1) W !,"Primar y Eligibil ity: ",$S( $D(^DIC(8, +X1,0)):$P (^(0),"^", 1)_" ("_$S (X="V":"VE RIFIED",X= "P":"PENDI NG VERIFIC ATION",X=" R":"PENDIN G REVERIFI CATION",1: "NOT VERIF IED")_")", 1:DGRPU) | |
7871 | "RTN","DGR PD",135,0) | |
7872 | ;*952 to display th e Expanded MH Care T ype | |
7873 | "RTN","DGR PD",136,0) | |
7874 | I $D(^DIC (8,+X1,0)) ,$P(^(0)," ^",9)=23,$ G(DGRP(.55 ))'="" W ! ,"Expanded MH Care T ype: ",$$O THSOC^DGOT HD1($G(DGR P(.55))) | |
7875 | "RTN","DGR PD",137,0) | |
7876 | W !,"Othe r Eligibil ities: " F I=0:0 S I =$O(^DIC(8 ,I)) Q:'I I $D(^DIC (8,I,0)),I '=+X1 S X= $P(^(0),"^ ",1)_", " I $D(^DPT( "AEL",DFN, I)) W:$X+$ L(X)>79 !? 21 W X | |
7877 | "RTN","DGR PD",138,0) | |
7878 | I '$$OKLI NE^DGRPD1( 16) G Q | |
7879 | "RTN","DGR PD",139,0) | |
7880 | ;employab ility stat us | |
7881 | "RTN","DGR PD",140,0) | |
7882 | W !?6,"Un employable : ",$S($P( DGRP(.3),U ,5)="Y":"Y ES",1:"NO" ) | |
7883 | "RTN","DGR PD",141,0) | |
7884 | I '$$OKLI NE^DGRPD1( 19) G Q | |
7885 | "RTN","DGR PD",142,0) | |
7886 | ; KUM DG* 5.3*940 RM #879316,# 879318 - D isplay Per manent & T otal Disab led status | |
7887 | "RTN","DGR PD",143,0) | |
7888 | W !?6,"Pe rmanent & Total Disa bled: ",$S ($P(DGRP(. 3),U,4)="Y ":"YES",1: "NO") | |
7889 | "RTN","DGR PD",144,0) | |
7890 | I '$$OKLI NE^DGRPD1( 19) G Q | |
7891 | "RTN","DGR PD",145,0) | |
7892 | ;display the catast rophic dis ability re view date if there i s one | |
7893 | "RTN","DGR PD",146,0) | |
7894 | D CATDIS^ DGRPD1 | |
7895 | "RTN","DGR PD",147,0) | |
7896 | I $G(DGPR FLG)=1 G Q :'$$OKLINE ^DGRPD1(19 ) D | |
7897 | "RTN","DGR PD",148,0) | |
7898 | . N DGPDT ,DGPTM | |
7899 | "RTN","DGR PD",149,0) | |
7900 | . W !,$$R EPEAT^XLFS TR("-",78) | |
7901 | "RTN","DGR PD",150,0) | |
7902 | . S DGPDT ="",DGPDT= $O(^DGS(41 .41,"ADC", DFN,DGPDT) ,-1) | |
7903 | "RTN","DGR PD",151,0) | |
7904 | . W !,"[P RE-REGISTE R DATE:] " _$S(DGPDT] "":$$FMTE^ XLFDT(DGPD T,"1D"),1: "NONE ON F ILE") | |
7905 | "RTN","DGR PD",152,0) | |
7906 | . S DGPTM =$$PCTEAM^ DGSDUTL(DF N) | |
7907 | "RTN","DGR PD",153,0) | |
7908 | . I $P(DG PTM,U,2)]" " W !,"[PR IMARY CARE TEAM:] "_ $P(DGPTM,U ,2) | |
7909 | "RTN","DGR PD",154,0) | |
7910 | . W !,$$R EPEAT^XLFS TR("-",78) | |
7911 | "RTN","DGR PD",155,0) | |
7912 | ; Check i f patient is an inpa tient and on a DOM w ard | |
7913 | "RTN","DGR PD",156,0) | |
7914 | ; If inpa tient is o n a DOM wa rd, don't display MT or CP mes sages | |
7915 | "RTN","DGR PD",157,0) | |
7916 | ; If inpa tient is N OT on a DO M ward, do n't displa y CP messa ge | |
7917 | "RTN","DGR PD",158,0) | |
7918 | N DGDOM,D GDOM1,VAHO W,VAROOT,V AINDT,VAIP ,VAERR | |
7919 | "RTN","DGR PD",159,0) | |
7920 | G Q:'$$OK LINE^DGRPD 1(16) | |
7921 | "RTN","DGR PD",160,0) | |
7922 | D DOM^DGM TR | |
7923 | "RTN","DGR PD",161,0) | |
7924 | I '$G(DGD OM) D | |
7925 | "RTN","DGR PD",162,0) | |
7926 | .D DIS^DG MTU(DFN) | |
7927 | "RTN","DGR PD",163,0) | |
7928 | .D IN5^VA DPT | |
7929 | "RTN","DGR PD",164,0) | |
7930 | .I $G(VAI P(1))="" D DISP^IBAR XEU(DFN,DT ,3,1) | |
7931 | "RTN","DGR PD",165,0) | |
7932 | ;I 'DGABB RV,$E(IOST ,1,2)="C-" F I=$Y:1: 20 W ! | |
7933 | "RTN","DGR PD",166,0) | |
7934 | D DIS^EAS ECU(DFN) ; Added for LTC III (D G*5.3*518) | |
7935 | "RTN","DGR PD",167,0) | |
7936 | S VAIP("L ")="" | |
7937 | "RTN","DGR PD",168,0) | |
7938 | I $$OKLIN E^DGRPD1(1 4) D INP | |
7939 | "RTN","DGR PD",169,0) | |
7940 | I '$G(DGR POUT),($$O KLINE^DGRP D1(10)) D SA ;*KNR* | |
7941 | "RTN","DGR PD",170,0) | |
7942 | ;MPI/PD C HANGE | |
7943 | "RTN","DGR PD",171,0) | |
7944 | Q D KVA^VA DPT K %DT, D0,D1,DGA, DGA1,DGA2, DGABBRV,DG AD,DGCC,DG CMOR,DGDOM ,DGLOCATN, DGMPI,DGRP ,DGRPU,DGS ,DGST,DGXF R0,DIC,DIR ,DTOUT,DUO UT,DIRUT,D IROUT,I,I1 ,L,LDM,POP ,SDCT,VA,X ,X1,Y Q | |
7945 | "RTN","DGR PD",172,0) | |
7946 | ; | |
7947 | "RTN","DGR PD",173,0) | |
7948 | INP S VAIP ("D")="L" D INP^DGPM V10 | |
7949 | "RTN","DGR PD",174,0) | |
7950 | S DGPMT=0 | |
7951 | "RTN","DGR PD",175,0) | |
7952 | D CS^DGPM V10 K DGPM T,DGPMIFN K:'$D(DGSW ITCH) DGPM VI,DGPMDCD Q | |
7953 | "RTN","DGR PD",176,0) | |
7954 | SA F I=0:0 S I=$O(^D GS(41.1,"B ",DFN,I)) G CL:'I S X=^DGS(41. 1,I,0) I $ P(X,"^",2) >(DT-1),$P (X,"^",13) ']"",'$P(X ,"^",17) S L=$P(X,"^ ",2) D:$$O KLINE^DGRP D1(17) SAA Q:$G(DGRP OUT) | |
7955 | "RTN","DGR PD",177,0) | |
7956 | Q | |
7957 | "RTN","DGR PD",178,0) | |
7958 | SAA ;Sched uled Admit Data | |
7959 | "RTN","DGR PD",179,0) | |
7960 | W !!?14," Scheduled Admit" | |
7961 | "RTN","DGR PD",180,0) | |
7962 | W:$D(^DIC (42,+$P(X, U,8),0)) " on ward " _$P(^(0),U ) | |
7963 | "RTN","DGR PD",181,0) | |
7964 | W:$D(^DIC (45.7,+$P( X,U,9),0)) " for tre ating spec ialty "_$P (^(0),U) | |
7965 | "RTN","DGR PD",182,0) | |
7966 | W " on "_ $$FMTE^XLF DT(L,"5DZ" ) | |
7967 | "RTN","DGR PD",183,0) | |
7968 | Q ;SAA | |
7969 | "RTN","DGR PD",184,0) | |
7970 | ; | |
7971 | "RTN","DGR PD",185,0) | |
7972 | CL G FA:$O (^DPT(DFN, "DE",0))=" " S SDCT=0 F I=0:0 S I=$O(^DPT (DFN,"DE", I)) Q:'I I $D(^(I,0 )),$P(^(0) ,"^",2)'=" I",$O(^(0) ) S SDCT=S DCT+1 W:SD CT=1 !!,"C urrently e nrolled in " W:$X>50 !?22 W $S ($D(^SC(+^ (0),0)):$P (^(0),"^", 1)_", ",1: "") | |
7973 | "RTN","DGR PD",186,0) | |
7974 | ; | |
7975 | "RTN","DGR PD",187,0) | |
7976 | FA ; | |
7977 | "RTN","DGR PD",188,0) | |
7978 | N DGARRAY ,SDCNT | |
7979 | "RTN","DGR PD",189,0) | |
7980 | S DGARRAY ("FLDS")=" 1;2;3;18", DGARRAY(4) =DFN,DGARR AY(1)=DT,D GARRAY("SO RT")="P" | |
7981 | "RTN","DGR PD",190,0) | |
7982 | S SDCNT=$ $SDAPI^SDA MA301(.DGA RRAY),CT=0 W !!,"Fut ure Appoin tments: " | |
7983 | "RTN","DGR PD",191,0) | |
7984 | ;if there is lower subscripts hanging f rom the 10 1 node, | |
7985 | "RTN","DGR PD",192,0) | |
7986 | ;then it is a valid appointme nt, otherw ise it is | |
7987 | "RTN","DGR PD",193,0) | |
7988 | ;an error eg 01/20/ 2005 | |
7989 | "RTN","DGR PD",194,0) | |
7990 | ;G:'$$OKL INE^DGRPD1 (13) RMK ; *///* | |
7991 | "RTN","DGR PD",195,0) | |
7992 | I $D(^TMP ($J,"SDAMA 301",101)) =1 W "Appo intment Da tabase is Unavailabl e" G RMK | |
7993 | "RTN","DGR PD",196,0) | |
7994 | I $O(^TMP ($J,"SDAMA 301",DFN,D T))'>0 W " NONE" G RM K | |
7995 | "RTN","DGR PD",197,0) | |
7996 | ; | |
7997 | "RTN","DGR PD",198,0) | |
7998 | W ?22,"Da te",?33,"T ime",?39," Clinic",!? 22 F I=22: 1:75 W "=" | |
7999 | "RTN","DGR PD",199,0) | |
8000 | F FA=DT:0 S FA=$O(^ TMP($J,"SD AMA301",DF N,FA)) G R MK:'FA D Q:CT>5 | |
8001 | "RTN","DGR PD",200,0) | |
8002 | .N STAT S STAT=$P($ P(^TMP($J, "SDAMA301" ,DFN,FA),U ,3),";") | |
8003 | "RTN","DGR PD",201,0) | |
8004 | .S C=+$P( ^TMP($J,"S DAMA301",D FN,FA),U,2 ) I STAT'[ "C" D | |
8005 | "RTN","DGR PD",202,0) | |
8006 | ..D COV | |
8007 | "RTN","DGR PD",203,0) | |
8008 | ..N DGAPP T S DGAPPT =$$FMTE^XL FDT($E(FA, 1,12),"5Z" ) | |
8009 | "RTN","DGR PD",204,0) | |
8010 | ..W !?22, $P(DGAPPT, "@"),?33,$ P(DGAPPT," @",2) | |
8011 | "RTN","DGR PD",205,0) | |
8012 | ..W ?39,$ P($P(^TMP( $J,"SDAMA3 01",DFN,FA ),U,2),";" ,2)," ",CO V | |
8013 | "RTN","DGR PD",206,0) | |
8014 | ..Q | |
8015 | "RTN","DGR PD",207,0) | |
8016 | I $O(^TMP ($J,"SDAMA 301",DFN,F A))>0 W !, "See Sched uling opti ons for ad ditional a ppointment s." | |
8017 | "RTN","DGR PD",208,0) | |
8018 | RMK I '$G( DGRPOUT),( $$OKLINE^D GRPD1(15)) W !!,"Rem arks: ",$P (^DPT(DFN, 0),"^",10) ;*///* | |
8019 | "RTN","DGR PD",209,0) | |
8020 | D GETS^DI Q(2,DFN_", ",".351;.3 53;.354;.3 55","E","P DTHINFO") | |
8021 | "RTN","DGR PD",210,0) | |
8022 | W !! | |
8023 | "RTN","DGR PD",211,0) | |
8024 | W "Date o f Death In formation" | |
8025 | "RTN","DGR PD",212,0) | |
8026 | W !,?5,"D ate of Dea th: ",$G(P DTHINFO(2, DFN_",",.3 51,"E")) | |
8027 | "RTN","DGR PD",213,0) | |
8028 | W !,?5,"S ource of N otificatio n: ",$G(PD THINFO(2,D FN_",",.35 3,"E")) | |
8029 | "RTN","DGR PD",214,0) | |
8030 | W !,?5,"U pdated Dat e/Time: ", $G(PDTHINF O(2,DFN_", ",.354,"E" )) | |
8031 | "RTN","DGR PD",215,0) | |
8032 | W !,?5,"L ast Edited By: ",$G( PDTHINFO(2 ,DFN_",",. 355,"E")), ! | |
8033 | "RTN","DGR PD",216,0) | |
8034 | I $$OKLIN E^DGRPD1(1 4) D EC^DG RPD1 | |
8035 | "RTN","DGR PD",217,0) | |
8036 | ; KUM DG* 5.3*936 Ca ll tag to display He alth Benef it Plans a ssigned to Veteran | |
8037 | "RTN","DGR PD",218,0) | |
8038 | D HBP | |
8039 | "RTN","DGR PD",219,0) | |
8040 | K DGARRAY ,SDCNT,^TM P($J,"SDAM A301"),ADM ,L,TRN,DIS ,SSN,FA,C, COV,NOW,CT ,DGD,DGD1, I ;Y kille d after dg hinqky | |
8041 | "RTN","DGR PD",220,0) | |
8042 | Q | |
8043 | "RTN","DGR PD",221,0) | |
8044 | ; KUM DG* 5.3*936 Di splay Heal th Benefit Plans ass igned to V eteran | |
8045 | "RTN","DGR PD",222,0) | |
8046 | HBP W !!," Health Ben efit Plans Currently Assigned to Veteran :" | |
8047 | "RTN","DGR PD",223,0) | |
8048 | N DGHBP,H BP,DGCOUNT | |
8049 | "RTN","DGR PD",224,0) | |
8050 | S DGCOUNT =0 | |
8051 | "RTN","DGR PD",225,0) | |
8052 | D GETHBP^ DGHBPUTL(D FN) | |
8053 | "RTN","DGR PD",226,0) | |
8054 | S DGHBP=" " F S DGH BP=$O(HBP( "CUR",DGHB P)) Q:DGHB P="" D | |
8055 | "RTN","DGR PD",227,0) | |
8056 | .W !,?3,D GHBP | |
8057 | "RTN","DGR PD",228,0) | |
8058 | .S DGCOUN T=DGCOUNT+ 1 | |
8059 | "RTN","DGR PD",229,0) | |
8060 | I DGCOUNT =0 W !,?3, "None" | |
8061 | "RTN","DGR PD",230,0) | |
8062 | Q | |
8063 | "RTN","DGR PD",231,0) | |
8064 | ; | |
8065 | "RTN","DGR PD",232,0) | |
8066 | COV S COV= $S(+$P(^TM P($J,"SDAM A301",DFN, FA),U,18)= 7:" (Colla teral) ",1 :"") | |
8067 | "RTN","DGR PD",233,0) | |
8068 | S COV=COV _$S(STAT[" NT":" * NO ACTION TA KEN *",STA T["N":" * NO-SHOW *" ,1:""),CT= CT+1 Q | |
8069 | "RTN","DGR PD",234,0) | |
8070 | Q | |
8071 | "RTN","DGR PD",235,0) | |
8072 | ; | |
8073 | "RTN","DGR PD",236,0) | |
8074 | OREN S XQO RQUIT=1 Q: '$D(ORVP) S DFN=+OR VP D EN R !!,"Press RETURN to CONTINUE: ",X:DTIME | |
8075 | "RTN","DGR PD",237,0) | |
8076 | Q | |
8077 | "RTN","DGR PD",238,0) | |
8078 | LANGUAGE ; Get langu age data * ///* | |
8079 | "RTN","DGR PD",239,0) | |
8080 | S DGLANGD T=9999999, (DGPRFLAN, DGLANG0)=" " | |
8081 | "RTN","DGR PD",240,0) | |
8082 | S DGLANGD T=$O(^DPT( DFN,.207," B",DGLANGD T),-1) | |
8083 | "RTN","DGR PD",241,0) | |
8084 | I DGLANGD T="" G L1 | |
8085 | "RTN","DGR PD",242,0) | |
8086 | S DGLANGD A=$O(^DPT( DFN,.207," B",DGLANGD T,0)) | |
8087 | "RTN","DGR PD",243,0) | |
8088 | S DGLANG0 =$G(^DPT(D FN,.207,DG LANGDA,0)) ,Y=$P(DGLA NG0,U),DGP RFLAN=$P(D GLANG0,U,2 ) | |
8089 | "RTN","DGR PD",244,0) | |
8090 | S Y=DGLAN GDT X ^DD( "DD") S DG LANGDT=Y | |
8091 | "RTN","DGR PD",245,0) | |
8092 | L1 W !!,"L anguage Da te/Time: " ,$S(DGLANG DT="":"UNA NSWERED",1 :DGLANGDT) ,! | |
8093 | "RTN","DGR PD",246,0) | |
8094 | W ?1,"Pre ferred Lan guage: ",$ S(DGPRFLAN ="":"UNANS WERED",1:D GPRFLAN) | |
8095 | "RTN","DGR PD",247,0) | |
8096 | K DGLANGD T,DGPRFLAN ,DGLANG0,D GLANGDA | |
8097 | "RTN","DGR PD",248,0) | |
8098 | Q | |
8099 | "RTN","DGR PDB") | |
8100 | 0^18^B2432 1515 | |
8101 | "RTN","DGR PDB",1,0) | |
8102 | DGRPDB ;AL B/AAS,JAN, ERC,PHH - VIEW ONLY SCREEN TO DETERMINE BILLING EL IGIBILITY ;3/23/06 8 :16am | |
8103 | "RTN","DGR PDB",2,0) | |
8104 | ;;5.3;Reg istration; **26,50,35 8,570,631, 709,713,74 9,952**;Au g 13, 1993 ;Build 68 | |
8105 | "RTN","DGR PDB",3,0) | |
8106 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
8107 | "RTN","DGR PDB",4,0) | |
8108 | ; | |
8109 | "RTN","DGR PDB",5,0) | |
8110 | % S:'$D(DG QUIT) DGQU IT=0 | |
8111 | "RTN","DGR PDB",6,0) | |
8112 | G:DGQUIT END S DIC= "^DPT(",DI C(0)="AEQM N" D ^DIC G:+Y<1 END S DFN=+Y D EN | |
8113 | "RTN","DGR PDB",7,0) | |
8114 | G % | |
8115 | "RTN","DGR PDB",8,0) | |
8116 | ; | |
8117 | "RTN","DGR PDB",9,0) | |
8118 | EN ;entry with DFN d efined. | |
8119 | "RTN","DGR PDB",10,0) | |
8120 | Q:'$D(DFN ) D HOME^ %ZIS,2^VAD PT,HDR | |
8121 | "RTN","DGR PDB",11,0) | |
8122 | D MT,AOIR ,ELIG,DIS | |
8123 | "RTN","DGR PDB",12,0) | |
8124 | N DGINS | |
8125 | "RTN","DGR PDB",13,0) | |
8126 | I $$INSUR ^IBBAPI(DF N,"","AR", .DGINS,1) | |
8127 | "RTN","DGR PDB",14,0) | |
8128 | S C="",C= $O(DGINS(" IBBAPI","I NSUR",C),- 1),C=+C+6 | |
8129 | "RTN","DGR PDB",15,0) | |
8130 | D:($Y>(IO SL-C)) PAU SE,HDR:'DG QUIT Q:DGQ UIT D INS ,PAUSE | |
8131 | "RTN","DGR PDB",16,0) | |
8132 | Q | |
8133 | "RTN","DGR PDB",17,0) | |
8134 | ; | |
8135 | "RTN","DGR PDB",18,0) | |
8136 | ELIG ;elig ibility co de(s) | |
8137 | "RTN","DGR PDB",19,0) | |
8138 | W !!," Pr imary Elig . Code: ", $P(VAEL(1) ,"^",2)," -- ",$S( VAEL(8)']" ":"NOT VER IFIED",1:$ P(VAEL(8), "^",2)) | |
8139 | "RTN","DGR PDB",20,0) | |
8140 | I VAEL(8) ]"" S Y=$S ($D(^DPT(D FN,.361)): $P(^(.361) ,"^",2),1: "") W " " D DT^DIQ | |
8141 | "RTN","DGR PDB",21,0) | |
8142 | ;DG*5.3*9 52 to disp lay the Ex panded MH Care Type | |
8143 | "RTN","DGR PDB",22,0) | |
8144 | ;if patie nt's prima ry eligibi lity is EX PANDED MH CARE NON-V ETERANS | |
8145 | "RTN","DGR PDB",23,0) | |
8146 | I +VAEL(1 )>0,$P($G( ^DIC(8,+VA EL(1),0)), "^",9)=23 W !,"Expan ded MH Car e Type: ", $$OTHSOC^D GOTHD1(^DP T(DFN,.55) ) | |
8147 | "RTN","DGR PDB",24,0) | |
8148 | W !,"Othe r Elig. Co de(s): " I $D(VAEL(1 ))>9 S I1= 0 F I=0:0 S I=$O(VAE L(1,I)) Q: 'I S I1=I 1+1 W:I1>1 !?21 W $P (VAEL(1,I) ,"^",2) | |
8149 | "RTN","DGR PDB",25,0) | |
8150 | E W "NO ADDITIONAL ELIGIBILI TIES IDENT IFIED" | |
8151 | "RTN","DGR PDB",26,0) | |
8152 | Q | |
8153 | "RTN","DGR PDB",27,0) | |
8154 | ; | |
8155 | "RTN","DGR PDB",28,0) | |
8156 | DIS ;rated disabilit ies - Inte gration Ag reement #7 00 | |
8157 | "RTN","DGR PDB",29,0) | |
8158 | ; | |
8159 | "RTN","DGR PDB",30,0) | |
8160 | ; This i s called f rom the FE E and MCCR package!! ! | |
8161 | "RTN","DGR PDB",31,0) | |
8162 | ; | |
8163 | "RTN","DGR PDB",32,0) | |
8164 | ; Input: DFN as I EN of PATI ENT file | |
8165 | "RTN","DGR PDB",33,0) | |
8166 | ; VAEL arr ay (if no passed, it is set) o f eligibil ity info | |
8167 | "RTN","DGR PDB",34,0) | |
8168 | ; | |
8169 | "RTN","DGR PDB",35,0) | |
8170 | I '$D(VAE L) D ELIG^ VADPT S DG KVAR=1 | |
8171 | "RTN","DGR PDB",36,0) | |
8172 | W:'+VAEL( 3) !!," S ervice Con nected: NO " W:+VAEL( 3) !!," SC P ercent: ", $P(VAEL(3) ,"^",2)_"% " | |
8173 | "RTN","DGR PDB",37,0) | |
8174 | N DGQUIT | |
8175 | "RTN","DGR PDB",38,0) | |
8176 | W !," Rat ed Disabil ities: " I 'VAEL(4), $S('$D(^DG (391,+VAEL (6),0)):1, $P(^(0),"^ ",2):0,1:1 ) W "NOT A VETERAN" G DISQ | |
8177 | "RTN","DGR PDB",39,0) | |
8178 | S I3=0 F I=0:0 S I= $O(^DPT(DF N,.372,I)) Q:'I!($G( DGQUIT)=1) D | |
8179 | "RTN","DGR PDB",40,0) | |
8180 | . S I1=^( I,0),I2=$S ($D(^DIC(3 1,+I1,0)): $P(^(0),"^ ",1)_" ("_ +$P(I1,"^" ,2)_"%-"_$ S($P(I1,"^ ",3):"SC", $P(I1,"^", 3)']"":"no t specifie d",1:"NSC" )_")",1:"" ),I3=I3+1 | |
8181 | "RTN","DGR PDB",41,0) | |
8182 | . I $Y>(I OSL-3) D P AUSE I $G( DGQUIT)=0 W @IOF | |
8183 | "RTN","DGR PDB",42,0) | |
8184 | . I $G(DG QUIT)=1 Q | |
8185 | "RTN","DGR PDB",43,0) | |
8186 | . W:I3>1 !?21 W I2 | |
8187 | "RTN","DGR PDB",44,0) | |
8188 | W:'I3 "NO NE STATED" | |
8189 | "RTN","DGR PDB",45,0) | |
8190 | DISQ I $D( DGKVAR) D KVAR^VADPT K DGKVAR | |
8191 | "RTN","DGR PDB",46,0) | |
8192 | K I,I1,I2 ,I3 | |
8193 | "RTN","DGR PDB",47,0) | |
8194 | Q | |
8195 | "RTN","DGR PDB",48,0) | |
8196 | ; | |
8197 | "RTN","DGR PDB",49,0) | |
8198 | INS ;insur ance infor mation | |
8199 | "RTN","DGR PDB",50,0) | |
8200 | ; | |
8201 | "RTN","DGR PDB",51,0) | |
8202 | ; This i s called f orm the FE E package! !! | |
8203 | "RTN","DGR PDB",52,0) | |
8204 | ; | |
8205 | "RTN","DGR PDB",53,0) | |
8206 | ; Input: DFN as I EN of PATI ENT file | |
8207 | "RTN","DGR PDB",54,0) | |
8208 | ; DGINSDT as date to compute i nsurance f lag as of (default D T) | |
8209 | "RTN","DGR PDB",55,0) | |
8210 | ; | |
8211 | "RTN","DGR PDB",56,0) | |
8212 | Q:'$D(DFN ) | |
8213 | "RTN","DGR PDB",57,0) | |
8214 | W !!," Health In surance: " | |
8215 | "RTN","DGR PDB",58,0) | |
8216 | S Z=$$INS UR^IBBAPI( DFN,$S($D( DGINSDT):D GINSDT,1:D T)) | |
8217 | "RTN","DGR PDB",59,0) | |
8218 | W $S(Z:"Y ES",1:"NO" ) | |
8219 | "RTN","DGR PDB",60,0) | |
8220 | D DISP^DG IBDSP | |
8221 | "RTN","DGR PDB",61,0) | |
8222 | INSQ K I,I 1,DGX,Z | |
8223 | "RTN","DGR PDB",62,0) | |
8224 | Q | |
8225 | "RTN","DGR PDB",63,0) | |
8226 | ; | |
8227 | "RTN","DGR PDB",64,0) | |
8228 | IN ; Old c ode | |
8229 | "RTN","DGR PDB",65,0) | |
8230 | Q | |
8231 | "RTN","DGR PDB",66,0) | |
8232 | ; | |
8233 | "RTN","DGR PDB",67,0) | |
8234 | AOIR ;Agen t Orange/i onizing ra diation | |
8235 | "RTN","DGR PDB",68,0) | |
8236 | N DGEC,NT A | |
8237 | "RTN","DGR PDB",69,0) | |
8238 | S DGX=$S( $D(^DPT(DF N,.321)):^ (.321),1:" ") | |
8239 | "RTN","DGR PDB",70,0) | |
8240 | F I=2,3 S X=$P(DGX, "^",I) W:I =2 !," A/O Exp.: " W :I=3 "ION Rad.: " W $S(X="Y":" YES",X="N" :"NO",X="U ":"UNKNOWN ",1:"NOT A NSWERED"), " " | |
8241 | "RTN","DGR PDB",71,0) | |
8242 | S X=$G(^D PT(DFN,.38 )),X1=$P(X ,"^",1) W "Medicaid Elig: ",$S (X1="":"NO T ANSWERED ",'X1:"NO" ,1:"YES") I ($X+15)' >IOM W " - " S Y=$P( X,"^",2) D D^DIQ W $ P(Y,"@") | |
8243 | "RTN","DGR PDB",72,0) | |
8244 | S DGEC=$S ($D(^DPT(D FN,.322)): ^DPT(DFN,. 322),1:"") | |
8245 | "RTN","DGR PDB",73,0) | |
8246 | S X=$P(DG EC,U,13) W !," Env Cont am.: " W $ S(X="Y":"Y ES",X="N": "NO",X="U" :"UNKNOWN" ,1:"NOT AN SWERED")," " | |
8247 | "RTN","DGR PDB",74,0) | |
8248 | S NTA=$S( $$GETCUR^D GNTAPI(DFN ,"DGNTARR" )>0:DGNTAR R("INTRP") ,1:"") | |
8249 | "RTN","DGR PDB",75,0) | |
8250 | K DGNTARR | |
8251 | "RTN","DGR PDB",76,0) | |
8252 | W "N/T Ra dium: " W $S(NTA'="" :NTA,1:"NO T ANSWERED ") | |
8253 | "RTN","DGR PDB",77,0) | |
8254 | Q | |
8255 | "RTN","DGR PDB",78,0) | |
8256 | ; | |
8257 | "RTN","DGR PDB",79,0) | |
8258 | PAUSE F J= 1:1 Q:($Y> (IOSL-3)) W ! | |
8259 | "RTN","DGR PDB",80,0) | |
8260 | S DGX1="" I $E(IOST ,1,2)["C-" N DIR S D IR(0)="E" D ^DIR S D GQUIT='Y | |
8261 | "RTN","DGR PDB",81,0) | |
8262 | Q | |
8263 | "RTN","DGR PDB",82,0) | |
8264 | ; | |
8265 | "RTN","DGR PDB",83,0) | |
8266 | HDR ;Scree n Header | |
8267 | "RTN","DGR PDB",84,0) | |
8268 | W @IOF I $P(VAEL(6) ,"^",2)]"" S DGTYPE= $P(VAEL(6) ,"^",2) | |
8269 | "RTN","DGR PDB",85,0) | |
8270 | W $P(VADM (1),"^",1) ,?32,VA("P ID"),?47,$ P(VADM(3), "^",2) S X =$S($D(DGT YPE):$P(DG TYPE,"^",1 ),1:"PATIE NT TYPE UN KNOWN"),X1 =79-$L(X) W ?X1,X | |
8271 | "RTN","DGR PDB",86,0) | |
8272 | S X="",$P (X,"=",80) ="" W !,X Q | |
8273 | "RTN","DGR PDB",87,0) | |
8274 | Q | |
8275 | "RTN","DGR PDB",88,0) | |
8276 | ; | |
8277 | "RTN","DGR PDB",89,0) | |
8278 | MT I '$O(^ DGMT(408.3 1,"AD",1,D FN,0)) W ! ," Means Test Statu s: NOT IN MEANS TES T FILE" Q | |
8279 | "RTN","DGR PDB",90,0) | |
8280 | ;if patie nt is on a DOM ward, don't dis play Means Test requ ired messa ge | |
8281 | "RTN","DGR PDB",91,0) | |
8282 | D DOM^DGM TR D:'$G(D GDOM) DIS^ DGMTU(DFN) K DGDOM | |
8283 | "RTN","DGR PDB",92,0) | |
8284 | Q | |
8285 | "RTN","DGR PDB",93,0) | |
8286 | ; | |
8287 | "RTN","DGR PDB",94,0) | |
8288 | END D KVAR ^VADPT | |
8289 | "RTN","DGR PDB",95,0) | |
8290 | K A,C,I,I 1,I2,I3,J, DIC,DIR,DF N,DGA1,DGM T,DGMTL,DG MTLA,DGX,D GX1,DGT,DG TYPE,DGQUI T,DGMTLL,X ,X1,VAROOT ,VA,Y,Z | |
8291 | "RTN","DGR PDB",96,0) | |
8292 | Q | |
8293 | "RTN","DGR PDB",97,0) | |
8294 | ; | |
8295 | "RTN","DGR PDB",98,0) | |
8296 | RDIS(DGDFN ,DGARR) ;A PI to retu rn all Rat ed Disabil ities from the | |
8297 | "RTN","DGR PDB",99,0) | |
8298 | ;Patient file for a patient u sing an ar ray. Retu rned in de scending S ervice Con nected per cent. | |
8299 | "RTN","DGR PDB",100,0 ) | |
8300 | ; | |
8301 | "RTN","DGR PDB",101,0 ) | |
8302 | ; Integra tion Agree ment #4807 | |
8303 | "RTN","DGR PDB",102,0 ) | |
8304 | ; | |
8305 | "RTN","DGR PDB",103,0 ) | |
8306 | ;Input DGD FN - IEN o f patient file (requ ired) | |
8307 | "RTN","DGR PDB",104,0 ) | |
8308 | ;Input/Ou tput DGA RR - name of array f or returne d disabili ty info (r equired) | |
8309 | "RTN","DGR PDB",105,0 ) | |
8310 | ; pie ce 1 - Dis ability IE N (in file 31) | |
8311 | "RTN","DGR PDB",106,0 ) | |
8312 | ; pie ce 2 - Dis ability % | |
8313 | "RTN","DGR PDB",107,0 ) | |
8314 | ; pie ce 3 - SC? (1,0) | |
8315 | "RTN","DGR PDB",108,0 ) | |
8316 | ; pie ce 4 - ext remity aff ected | |
8317 | "RTN","DGR PDB",109,0 ) | |
8318 | ; pie ce 5 - ori ginal effe ctive date | |
8319 | "RTN","DGR PDB",110,0 ) | |
8320 | ; pie ce 6 - cur rent effec tive date | |
8321 | "RTN","DGR PDB",111,0 ) | |
8322 | ;Output 1 =successfu l and arra y returned with data | |
8323 | "RTN","DGR PDB",112,0 ) | |
8324 | ; 0 =unsuccess ful and no array | |
8325 | "RTN","DGR PDB",113,0 ) | |
8326 | ; | |
8327 | "RTN","DGR PDB",114,0 ) | |
8328 | N DGARR1, DGC,DGCC,D GERR,DGNOD E,DGCT,DGE ,DGEE | |
8329 | "RTN","DGR PDB",115,0 ) | |
8330 | K DGW,DGA RR | |
8331 | "RTN","DGR PDB",116,0 ) | |
8332 | I $G(DGDF N)']"" Q 0 | |
8333 | "RTN","DGR PDB",117,0 ) | |
8334 | I '$D(^DP T(DGDFN,0) ) Q 0 | |
8335 | "RTN","DGR PDB",118,0 ) | |
8336 | D GETS^DI Q(2,DGDFN, ".3721*"," I","DGARR1 ","DGERR") | |
8337 | "RTN","DGR PDB",119,0 ) | |
8338 | I $D(DGER R) Q 0 | |
8339 | "RTN","DGR PDB",120,0 ) | |
8340 | S DGCC=0 | |
8341 | "RTN","DGR PDB",121,0 ) | |
8342 | S DGCC=$O (^DPT(DGDF N,.372,DGC C)) | |
8343 | "RTN","DGR PDB",122,0 ) | |
8344 | I 'DGCC Q 0 | |
8345 | "RTN","DGR PDB",123,0 ) | |
8346 | S DGC="" | |
8347 | "RTN","DGR PDB",124,0 ) | |
8348 | F S DGC= $O(DGARR1( 2.04,DGC)) Q:DGC']"" D | |
8349 | "RTN","DGR PDB",125,0 ) | |
8350 | . S DGNOD E=DGC | |
8351 | "RTN","DGR PDB",126,0 ) | |
8352 | . S DGARR (DGC)=DGAR R1(2.04,DG NODE,.01," I")_"^"_DG ARR1(2.04, DGNODE,2," I")_"^"_DG ARR1(2.04, DGNODE,3," I")_"^"_DG ARR1(2.04, DGNODE,4," I")_"^"_DG ARR1(2.04, DGNODE,5," I")_"^"_DG ARR1(2.04, DGNODE,6," I") | |
8353 | "RTN","DGR PDB",127,0 ) | |
8354 | S DGE="" | |
8355 | "RTN","DGR PDB",128,0 ) | |
8356 | F S DGE= $O(DGARR(D GE)) Q:'DG E D | |
8357 | "RTN","DGR PDB",129,0 ) | |
8358 | . I $P(DG ARR(DGE),U ,2)="" S $ P(DGARR(DG E),U,2)=0 | |
8359 | "RTN","DGR PDB",130,0 ) | |
8360 | . S DGW($ P(DGARR(DG E),U,2),$P (DGE,",",1 ))=DGARR(D GE) | |
8361 | "RTN","DGR PDB",131,0 ) | |
8362 | S DGE="", DGCT=1 | |
8363 | "RTN","DGR PDB",132,0 ) | |
8364 | K DGARR | |
8365 | "RTN","DGR PDB",133,0 ) | |
8366 | F S DGE= $O(DGW(DGE ),-1) Q:DG E']"" D | |
8367 | "RTN","DGR PDB",134,0 ) | |
8368 | . F DGEE= 0:0 S DGEE =$O(DGW(DG E,DGEE)) Q :DGEE'>0 D | |
8369 | "RTN","DGR PDB",135,0 ) | |
8370 | . . S DGA RR(DGCT)=D GW(DGE,DGE E) S DGCT= DGCT+1 | |
8371 | "RTN","DGR PDB",136,0 ) | |
8372 | K DGW | |
8373 | "RTN","DGR PDB",137,0 ) | |
8374 | Q 1 | |
8375 | "RTN","DGR PDB",138,0 ) | |
8376 | ; | |
8377 | "SEC","^DI C",33,33,0 ,"AUDIT") | |
8378 | @ | |
8379 | "SEC","^DI C",33,33,0 ,"DD") | |
8380 | @ | |
8381 | "SEC","^DI C",33,33,0 ,"DEL") | |
8382 | @ | |
8383 | "SEC","^DI C",33,33,0 ,"LAYGO") | |
8384 | @ | |
8385 | "SEC","^DI C",33,33,0 ,"RD") | |
8386 | @ | |
8387 | "SEC","^DI C",33,33,0 ,"WR") | |
8388 | @ | |
8389 | "SEC","^DI C",33.1,33 .1,0,"AUDI T") | |
8390 | @ | |
8391 | "SEC","^DI C",33.1,33 .1,0,"DD") | |
8392 | @ | |
8393 | "SEC","^DI C",33.1,33 .1,0,"DEL" ) | |
8394 | @ | |
8395 | "SEC","^DI C",33.1,33 .1,0,"LAYG O") | |
8396 | @ | |
8397 | "SEC","^DI C",33.1,33 .1,0,"RD") | |
8398 | @ | |
8399 | "SEC","^DI C",33.1,33 .1,0,"WR") | |
8400 | @ | |
8401 | "VER") | |
8402 | 8.0^22.2 | |
8403 | "^DD",2,2, .5501,0) | |
8404 | EXPANDED M H CARE TYP E^RS^OTH-9 0:EMERGENT MH OTH;OT H-CMBT:COM BAT MH OTH ;OTH-MST:M ST MH OTH; ^.55;1^Q | |
8405 | "^DD",2,2, .5501,3) | |
8406 | Enter the expanded m ental heal th care ty pe justify ing the EX PANDED MH CARE eligi bility rul ing. | |
8407 | "^DD",2,2, .5501,21,0 ) | |
8408 | ^^2^2^3190 208^ | |
8409 | "^DD",2,2, .5501,21,1 ,0) | |
8410 | This field stores th e EXPANDED MH CARE T YPE which indicates the expand ed | |
8411 | "^DD",2,2, .5501,21,2 ,0) | |
8412 | emergent h ealth care authority that the patient sh ould be tr eated unde r. | |
8413 | "^DD",2,2, .5501,23,0 ) | |
8414 | ^^2^2^3190 208^ | |
8415 | "^DD",2,2, .5501,23,1 ,0) | |
8416 | The value stored in this field should ma tch the el igibility factor typ e | |
8417 | "^DD",2,2, .5501,23,2 ,0) | |
8418 | set up in the Enroll ment syste m. | |
8419 | "^DD",2,2, .5501,"DT" ) | |
8420 | 3190318 | |
8421 | "^DD",33,3 3,0) | |
8422 | FIELD^^2^8 | |
8423 | "^DD",33,3 3,0,"DT") | |
8424 | 3190315 | |
8425 | "^DD",33,3 3,0,"IX"," B",33,.01) | |
8426 | ||
8427 | "^DD",33,3 3,0,"NM"," OTH ELIGIB ILITY CLOC K") | |
8428 | ||
8429 | "^DD",33,3 3,0,"PT",3 3.1,.01) | |
8430 | ||
8431 | "^DD",33,3 3,0,"VRPK" ) | |
8432 | DG | |
8433 | "^DD",33,3 3,.01,0) | |
8434 | PATIENT^RP 2'^DPT(^0; 1^Q | |
8435 | "^DD",33,3 3,.01,1,0) | |
8436 | ^.1 | |
8437 | "^DD",33,3 3,.01,1,1, 0) | |
8438 | 33^B | |
8439 | "^DD",33,3 3,.01,1,1, 1) | |
8440 | S ^DGOTH(3 3,"B",$E(X ,1,30),DA) ="" | |
8441 | "^DD",33,3 3,.01,1,1, 2) | |
8442 | K ^DGOTH(3 3,"B",$E(X ,1,30),DA) | |
8443 | "^DD",33,3 3,.01,3) | |
8444 | Select the patient w ith OTH el igibility clock. | |
8445 | "^DD",33,3 3,.01,21,0 ) | |
8446 | ^.001^2^2^ 3180207^^ | |
8447 | "^DD",33,3 3,.01,21,1 ,0) | |
8448 | Patient wi th OTH 90 DAYS ELIGI BILITY tha t receives mental he alth care in | |
8449 | "^DD",33,3 3,.01,21,2 ,0) | |
8450 | the VA fac ility. | |
8451 | "^DD",33,3 3,.01,23,0 ) | |
8452 | ^.001^1^1^ 3180207^^^ ^ | |
8453 | "^DD",33,3 3,.01,23,1 ,0) | |
8454 | Pointer to the PATIE NT file (# 2). | |
8455 | "^DD",33,3 3,.01,"DT" ) | |
8456 | 3190307 | |
8457 | "^DD",33,3 3,.02,0) | |
8458 | OTH STATUS ^S^0:INACT IVE;1:ACTI VE;^0;2^Q | |
8459 | "^DD",33,3 3,.02,3) | |
8460 | Enter stat us of the OTH clock for the pa tient. | |
8461 | "^DD",33,3 3,.02,21,0 ) | |
8462 | ^.001^1^1^ 3180206^^ | |
8463 | "^DD",33,3 3,.02,21,1 ,0) | |
8464 | The curren t status o f the OTH clock for the patien t. | |
8465 | "^DD",33,3 3,.02,"DT" ) | |
8466 | 3190307 | |
8467 | "^DD",33,3 3,.03,0) | |
8468 | LAST OTH S TATUS CHAN GE DATE^D^ ^0;3^S %DT ="ESTX" D ^%DT S X=Y K:Y<1 X | |
8469 | "^DD",33,3 3,.03,3) | |
8470 | Enter the reactivati on/inactiv ation date for the O TH patient . | |
8471 | "^DD",33,3 3,.03,21,0 ) | |
8472 | ^^2^2^3190 227^ | |
8473 | "^DD",33,3 3,.03,21,1 ,0) | |
8474 | This field captures the reacti vation/ina ctivation of the Oth er Than | |
8475 | "^DD",33,3 3,.03,21,2 ,0) | |
8476 | Honorable countdown clock. | |
8477 | "^DD",33,3 3,.03,"DT" ) | |
8478 | 3190307 | |
8479 | "^DD",33,3 3,.04,0) | |
8480 | LAST OTH S TATUS CHAN GE REASON^ FJ60^^0;4^ K:$L(X)>60 !($L(X)<1) X | |
8481 | "^DD",33,3 3,.04,3) | |
8482 | Enter the reason for inactivat ion/reacti vation of the OTH pa tient's co untdown cl ock. Answe r must be 1 to 60 ch aracters i n length. | |
8483 | "^DD",33,3 3,.04,21,0 ) | |
8484 | ^^2^2^3190 227^ | |
8485 | "^DD",33,3 3,.04,21,1 ,0) | |
8486 | This field will capt ure the re ason/comme nt for rea ctivation/ inactivati on | |
8487 | "^DD",33,3 3,.04,21,2 ,0) | |
8488 | of the Oth er Than Ho norable pa tient coun tdown cloc k. | |
8489 | "^DD",33,3 3,.04,"DT" ) | |
8490 | 3190307 | |
8491 | "^DD",33,3 3,.05,0) | |
8492 | VBA ADJUDI CATION SOU RCE^S^1:VB A Adjudica tion Lette r/Email Re ceived by Registrati on Staff;2 :VBA Adjud ication Le tter Recei ved by the Patient;3 :Other;^0; 5^Q | |
8493 | "^DD",33,3 3,.05,3) | |
8494 | Enter the source of informatio n of the V BA Adjucat ion for th e OTH pati ent. | |
8495 | "^DD",33,3 3,.05,21,0 ) | |
8496 | ^^2^2^3190 227^ | |
8497 | "^DD",33,3 3,.05,21,1 ,0) | |
8498 | This field captures the source of inform ation of t he VBA Adj udication for | |
8499 | "^DD",33,3 3,.05,21,2 ,0) | |
8500 | the Other Than Honor able patie nt. | |
8501 | "^DD",33,3 3,.05,"DT" ) | |
8502 | 3190227 | |
8503 | "^DD",33,3 3,.06,0) | |
8504 | VBA ADJUDI CATION DAT E^D^^0;6^S %DT="EX" D ^%DT S X =Y K:X<1 X | |
8505 | "^DD",33,3 3,.06,3) | |
8506 | Enter the actual VBA Adjudicat ion Date f or the OTH Patient. | |
8507 | "^DD",33,3 3,.06,21,0 ) | |
8508 | ^^3^3^3180 705^ | |
8509 | "^DD",33,3 3,.06,21,1 ,0) | |
8510 | This field capture t he actual VBA Adjudi cation Dat e for the Other Than | |
8511 | "^DD",33,3 3,.06,21,2 ,0) | |
8512 | Honorable patient. E ntering a date in th is field i nactivate the patien t's | |
8513 | "^DD",33,3 3,.06,21,3 ,0) | |
8514 | countdown clock. | |
8515 | "^DD",33,3 3,.06,"DT" ) | |
8516 | 3180705 | |
8517 | "^DD",33,3 3,1,0) | |
8518 | OTH 365 DA YS CLOCK^3 3.01^^1;0 | |
8519 | "^DD",33,3 3,1,21,0) | |
8520 | ^.001^1^1^ 3190227^^^ ^ | |
8521 | "^DD",33,3 3,1,21,1,0 ) | |
8522 | This multi ple contai ns data fo r tracking 365 days clock stat us. | |
8523 | "^DD",33,3 3,1,"DT") | |
8524 | 3180207 | |
8525 | "^DD",33,3 3,2,0) | |
8526 | ELIGIBILIT Y CHANGES^ 33.02DA^^2 ;0 | |
8527 | "^DD",33,3 3,2,21,0) | |
8528 | ^^1^1^3190 307^ | |
8529 | "^DD",33,3 3,2,21,1,0 ) | |
8530 | This multi ple contai ns history of OTH el igibility changes. | |
8531 | "^DD",33,3 3.01,0) | |
8532 | OTH 365 DA YS CLOCK S UB-FIELD^^ .02^3 | |
8533 | "^DD",33,3 3.01,0,"DT ") | |
8534 | 3190304 | |
8535 | "^DD",33,3 3.01,0,"IX ","B",33.0 1,.01) | |
8536 | ||
8537 | "^DD",33,3 3.01,0,"NM ","OTH 365 DAYS CLOC K") | |
8538 | ||
8539 | "^DD",33,3 3.01,0,"UP ") | |
8540 | 33 | |
8541 | "^DD",33,3 3.01,.01,0 ) | |
8542 | 365 DAYS P ERIOD NUMB ER^MNJ3,0^ ^0;1^K:+X' =X!(X>100) !(X<1)!(X? .E1"."1.N) X | |
8543 | "^DD",33,3 3.01,.01,1 ,0) | |
8544 | ^.1 | |
8545 | "^DD",33,3 3.01,.01,1 ,1,0) | |
8546 | 33.01^B | |
8547 | "^DD",33,3 3.01,.01,1 ,1,1) | |
8548 | S ^DGOTH(3 3,DA(1),1, "B",$E(X,1 ,30),DA)=" " | |
8549 | "^DD",33,3 3.01,.01,1 ,1,2) | |
8550 | K ^DGOTH(3 3,DA(1),1, "B",$E(X,1 ,30),DA) | |
8551 | "^DD",33,3 3.01,.01,3 ) | |
8552 | Type a num ber betwee n 1 and 10 0, 0 decim al digits. | |
8553 | "^DD",33,3 3.01,.01,2 1,0) | |
8554 | ^^2^2^3180 207^ | |
8555 | "^DD",33,3 3.01,.01,2 1,1,0) | |
8556 | This the s equential number of the OTH el igibility 365 days c lock for | |
8557 | "^DD",33,3 3.01,.01,2 1,2,0) | |
8558 | the patien t. | |
8559 | "^DD",33,3 3.01,.01," DT") | |
8560 | 3190227 | |
8561 | "^DD",33,3 3.01,.02,0 ) | |
8562 | START DATE ^D^^0;2^S %DT="EX" D ^%DT S X= Y K:Y<1 X | |
8563 | "^DD",33,3 3.01,.02,3 ) | |
8564 | Enter the date when the 365 da ys clock s tarted. | |
8565 | "^DD",33,3 3.01,.02,2 1,0) | |
8566 | ^.001^1^1^ 3180206^^^ | |
8567 | "^DD",33,3 3.01,.02,2 1,1,0) | |
8568 | Date when the 365 da ys clock s tarted. | |
8569 | "^DD",33,3 3.01,.02," DT") | |
8570 | 3180206 | |
8571 | "^DD",33,3 3.01,1,0) | |
8572 | OTH 90 DAY S CLOCK^33 .11^^1;0 | |
8573 | "^DD",33,3 3.01,1,21, 0) | |
8574 | ^.001^1^1^ 3190227^^^ ^ | |
8575 | "^DD",33,3 3.01,1,21, 1,0) | |
8576 | This multi ple contai ns data fo r tracking 90 days c lock statu s. | |
8577 | "^DD",33,3 3.01,1,"DT ") | |
8578 | 3180207 | |
8579 | "^DD",33,3 3.02,0) | |
8580 | ELIGIBILIT Y CHANGES SUB-FIELD^ ^.07^7 | |
8581 | "^DD",33,3 3.02,0,"DT ") | |
8582 | 3190307 | |
8583 | "^DD",33,3 3.02,0,"IX ","B",33.0 2,.01) | |
8584 | ||
8585 | "^DD",33,3 3.02,0,"NM ","ELIGIBI LITY CHANG ES") | |
8586 | ||
8587 | "^DD",33,3 3.02,0,"UP ") | |
8588 | 33 | |
8589 | "^DD",33,3 3.02,.01,0 ) | |
8590 | DATE OF CH ANGE^D^^0; 1^S %DT="E STXR" D ^% DT S X=Y K :X<1 X | |
8591 | "^DD",33,3 3.02,.01,1 ,0) | |
8592 | ^.1 | |
8593 | "^DD",33,3 3.02,.01,1 ,1,0) | |
8594 | 33.02^B | |
8595 | "^DD",33,3 3.02,.01,1 ,1,1) | |
8596 | S ^DGOTH(3 3,DA(1),2, "B",$E(X,1 ,30),DA)=" " | |
8597 | "^DD",33,3 3.02,.01,1 ,1,2) | |
8598 | K ^DGOTH(3 3,DA(1),2, "B",$E(X,1 ,30),DA) | |
8599 | "^DD",33,3 3.02,.01,3 ) | |
8600 | Enter the date of th is eligibi lity chang e. | |
8601 | "^DD",33,3 3.02,.01,2 1,0) | |
8602 | ^^1^1^3190 307^ | |
8603 | "^DD",33,3 3.02,.01,2 1,1,0) | |
8604 | Date of th e eligibil ity change . | |
8605 | "^DD",33,3 3.02,.01," DT") | |
8606 | 3190307 | |
8607 | "^DD",33,3 3.02,.02,0 ) | |
8608 | ELIGIBILIT Y CODE^P8' ^DIC(8,^0; 2^Q | |
8609 | "^DD",33,3 3.02,.02,3 ) | |
8610 | Select eli gibility c ode. | |
8611 | "^DD",33,3 3.02,.02,2 1,0) | |
8612 | ^^1^1^3190 307^ | |
8613 | "^DD",33,3 3.02,.02,2 1,1,0) | |
8614 | New eligib ility code for this patient. | |
8615 | "^DD",33,3 3.02,.02," DT") | |
8616 | 3190307 | |
8617 | "^DD",33,3 3.02,.03,0 ) | |
8618 | ELIGIBILIT Y FACTOR T YPE^S^OTH- 90:EMERGEN T MH OTH;O TH-COMBAT: COMBAT MH OTH;OTH-MS T:MST MH O TH;^0;3^Q | |
8619 | "^DD",33,3 3.02,.03,3 ) | |
8620 | Select eli gibility f actor type . | |
8621 | "^DD",33,3 3.02,.03,2 1,0) | |
8622 | ^^1^1^3190 307^ | |
8623 | "^DD",33,3 3.02,.03,2 1,1,0) | |
8624 | Eligibilit y factor t ype for OT H eligibil ities. | |
8625 | "^DD",33,3 3.02,.03,2 3,0) | |
8626 | ^^1^1^3190 307^ | |
8627 | "^DD",33,3 3.02,.03,2 3,1,0) | |
8628 | Same set o f codes as field 2/. 5501 | |
8629 | "^DD",33,3 3.02,.03," DT") | |
8630 | 3190307 | |
8631 | "^DD",33,3 3.02,.04,0 ) | |
8632 | CHANGE REA SON^S^0:IN ITIAL REGI STRATION;1 :VBA ADJUD ICATION;2: OTH AUTHOR ITY CHANGE ;3:CORRECT ION;^0;4^Q | |
8633 | "^DD",33,3 3.02,.04,3 ) | |
8634 | Select rea son for th is eligibi lity chang e. | |
8635 | "^DD",33,3 3.02,.04,2 1,0) | |
8636 | ^^1^1^3190 307^ | |
8637 | "^DD",33,3 3.02,.04,2 1,1,0) | |
8638 | Reason for this elig ibility ch ange. | |
8639 | "^DD",33,3 3.02,.04," DT") | |
8640 | 3190307 | |
8641 | "^DD",33,3 3.02,.05,0 ) | |
8642 | COMMENT^FJ 60^^0;5^K: $L(X)>60!( $L(X)<1) X | |
8643 | "^DD",33,3 3.02,.05,3 ) | |
8644 | Answer mus t be 1-60 characters in length . | |
8645 | "^DD",33,3 3.02,.05,2 1,0) | |
8646 | ^^1^1^3190 307^ | |
8647 | "^DD",33,3 3.02,.05,2 1,1,0) | |
8648 | Comment fo r this eli gibility c hange. | |
8649 | "^DD",33,3 3.02,.05," DT") | |
8650 | 3190307 | |
8651 | "^DD",33,3 3.02,.06,0 ) | |
8652 | ENTERED BY ^FJ60^^0;6 ^K:$L(X)>6 0!($L(X)<5 ) X | |
8653 | "^DD",33,3 3.02,.06,3 ) | |
8654 | Answer mus t be 5-60 characters in length . | |
8655 | "^DD",33,3 3.02,.06,2 1,0) | |
8656 | ^^1^1^3190 307^ | |
8657 | "^DD",33,3 3.02,.06,2 1,1,0) | |
8658 | Name of th e person w ho changed eligibili ty for thi s patient. | |
8659 | "^DD",33,3 3.02,.06," DT") | |
8660 | 3190307 | |
8661 | "^DD",33,3 3.02,.07,0 ) | |
8662 | FACILITY^P 4'^DIC(4,^ 0;7^Q | |
8663 | "^DD",33,3 3.02,.07,3 ) | |
8664 | Select fac ility wher e this eli gibility c hange was made. | |
8665 | "^DD",33,3 3.02,.07,2 1,0) | |
8666 | ^^2^2^3190 307^ | |
8667 | "^DD",33,3 3.02,.07,2 1,1,0) | |
8668 | Facility w here this eligibilit y change w as made. T his field being blan k | |
8669 | "^DD",33,3 3.02,.07,2 1,2,0) | |
8670 | means that change or iginated f rom Enroll ment Syste m. | |
8671 | "^DD",33,3 3.02,.07," DT") | |
8672 | 3190307 | |
8673 | "^DD",33,3 3.11,0) | |
8674 | OTH 90 DAY S CLOCK SU B-FIELD^^. 1^10 | |
8675 | "^DD",33,3 3.11,0,"DT ") | |
8676 | 3190315 | |
8677 | "^DD",33,3 3.11,0,"IX ","B",33.1 1,.01) | |
8678 | ||
8679 | "^DD",33,3 3.11,0,"NM ","OTH 90 DAYS CLOCK ") | |
8680 | ||
8681 | "^DD",33,3 3.11,0,"UP ") | |
8682 | 33.01 | |
8683 | "^DD",33,3 3.11,.01,0 ) | |
8684 | 90 DAYS PE RIOD NUMBE R^MNJ2,0^^ 0;1^K:+X'= X!(X>99)!( X<1)!(X?.E 1"."1.N) X | |
8685 | "^DD",33,3 3.11,.01,1 ,0) | |
8686 | ^.1 | |
8687 | "^DD",33,3 3.11,.01,1 ,1,0) | |
8688 | 33.11^B | |
8689 | "^DD",33,3 3.11,.01,1 ,1,1) | |
8690 | S ^DGOTH(3 3,DA(2),1, DA(1),1,"B ",$E(X,1,3 0),DA)="" | |
8691 | "^DD",33,3 3.11,.01,1 ,1,2) | |
8692 | K ^DGOTH(3 3,DA(2),1, DA(1),1,"B ",$E(X,1,3 0),DA) | |
8693 | "^DD",33,3 3.11,.01,3 ) | |
8694 | Type a num ber betwee n 1 and 99 , 0 decima l digits. | |
8695 | "^DD",33,3 3.11,.01,2 1,0) | |
8696 | ^^2^2^3180 207^ | |
8697 | "^DD",33,3 3.11,.01,2 1,1,0) | |
8698 | This the s equential number of the OTH el igibility 90 days cl ock for | |
8699 | "^DD",33,3 3.11,.01,2 1,2,0) | |
8700 | the patien t. | |
8701 | "^DD",33,3 3.11,.01," DT") | |
8702 | 3190227 | |
8703 | "^DD",33,3 3.11,.02,0 ) | |
8704 | START DATE ^D^^0;2^S %DT="EX" D ^%DT S X= Y K:Y<1 X | |
8705 | "^DD",33,3 3.11,.02,3 ) | |
8706 | Enter the date when the 90 day s clock st arted. | |
8707 | "^DD",33,3 3.11,.02,2 1,0) | |
8708 | ^^3^3^3180 327^ | |
8709 | "^DD",33,3 3.11,.02,2 1,1,0) | |
8710 | The date w hen the 90 days cloc k started. | |
8711 | "^DD",33,3 3.11,.02,2 1,2,0) | |
8712 | A future d ate cannot be entere d and cann ot be more than 90 d ays in the | |
8713 | "^DD",33,3 3.11,.02,2 1,3,0) | |
8714 | past. | |
8715 | "^DD",33,3 3.11,.02," DT") | |
8716 | 3180411 | |
8717 | "^DD",33,3 3.11,.03,0 ) | |
8718 | AUTHORIZAT ION ENTERE D BY^FJ60^ ^0;3^K:$L( X)>60!($L( X)<5) X | |
8719 | "^DD",33,3 3.11,.03,3 ) | |
8720 | Answer mus t be 5-60 characters in length . | |
8721 | "^DD",33,3 3.11,.03,2 1,0) | |
8722 | ^^1^1^3190 301^^^ | |
8723 | "^DD",33,3 3.11,.03,2 1,1,0) | |
8724 | The user w ho entered the autho rization f or the 90 days perio d. | |
8725 | "^DD",33,3 3.11,.03," DT") | |
8726 | 3190301 | |
8727 | "^DD",33,3 3.11,.04,0 ) | |
8728 | AUTHORIZAT ION RECEIV ED DATE^RD ^^0;4^S %D T="ESTX" D ^%DT S X= Y K:X<1 X | |
8729 | "^DD",33,3 3.11,.04,3 ) | |
8730 | Enter a da te when th e authoriz ation was signed. | |
8731 | "^DD",33,3 3.11,.04,2 1,0) | |
8732 | ^^1^1^3190 315^^ | |
8733 | "^DD",33,3 3.11,.04,2 1,1,0) | |
8734 | The date w hen the ad ditional 9 0 days per iod was au thorized. | |
8735 | "^DD",33,3 3.11,.04," DT") | |
8736 | 3190315 | |
8737 | "^DD",33,3 3.11,.05,0 ) | |
8738 | ENTERED OR EDITED BY ^FJ60^^0;5 ^K:$L(X)>6 0!($L(X)<5 ) X | |
8739 | "^DD",33,3 3.11,.05,3 ) | |
8740 | Answer mus t be 5-60 characters in length . | |
8741 | "^DD",33,3 3.11,.05,2 1,0) | |
8742 | ^^1^1^3190 301^^ | |
8743 | "^DD",33,3 3.11,.05,2 1,1,0) | |
8744 | The user w ho created or edited last time the 90 da ys clock. | |
8745 | "^DD",33,3 3.11,.05," DT") | |
8746 | 3190301 | |
8747 | "^DD",33,3 3.11,.06,0 ) | |
8748 | DATE ENTER ED OR EDIT ED^D^^0;6^ S %DT="EST X" D ^%DT S X=Y K:Y< 1 X | |
8749 | "^DD",33,3 3.11,.06,3 ) | |
8750 | Enter the date and t ime when t he 90 days clock was entered o r edited l ast time. | |
8751 | "^DD",33,3 3.11,.06,2 1,0) | |
8752 | ^^1^1^3180 206^ | |
8753 | "^DD",33,3 3.11,.06,2 1,1,0) | |
8754 | The date a nd time wh en the 90 days clock was enter ed or edit ed last ti me. | |
8755 | "^DD",33,3 3.11,.06," DT") | |
8756 | 3180206 | |
8757 | "^DD",33,3 3.11,.07,0 ) | |
8758 | AUTHORIZED BY^RFJ60^ ^0;7^K:$L( X)>60!($L( X)<5) X | |
8759 | "^DD",33,3 3.11,.07,. 009,1,0) | |
8760 | ENTER FROM 1 TO 60 C HARACTERS OF FREE TE XT | |
8761 | "^DD",33,3 3.11,.07,3 ) | |
8762 | Answer mus t be 5-60 characters in length . | |
8763 | "^DD",33,3 3.11,.07,2 1,0) | |
8764 | ^^1^1^3190 301^^^ | |
8765 | "^DD",33,3 3.11,.07,2 1,1,0) | |
8766 | The person who appro ved and au thorized t he second day period . | |
8767 | "^DD",33,3 3.11,.07," DT") | |
8768 | 3190301 | |
8769 | "^DD",33,3 3.11,.08,0 ) | |
8770 | FACILITY^P 4'^DIC(4,^ 0;8^Q | |
8771 | "^DD",33,3 3.11,.08,3 ) | |
8772 | Select the facility where this period wa s started. | |
8773 | "^DD",33,3 3.11,.08,2 1,0) | |
8774 | ^^1^1^3190 304^ | |
8775 | "^DD",33,3 3.11,.08,2 1,1,0) | |
8776 | Facility w here this 90-day per iod was st arted. | |
8777 | "^DD",33,3 3.11,.08," DT") | |
8778 | 3190304 | |
8779 | "^DD",33,3 3.11,.09,0 ) | |
8780 | AUTHORIZAT ION COMMEN T^FJ60^^0; 9^K:$L(X)> 60!($L(X)< 1) X | |
8781 | "^DD",33,3 3.11,.09,3 ) | |
8782 | Answer mus t be 1-60 characters in length . | |
8783 | "^DD",33,3 3.11,.09,2 1,0) | |
8784 | ^^1^1^3190 314^ | |
8785 | "^DD",33,3 3.11,.09,2 1,1,0) | |
8786 | Comment is required if authori zation was not provi ded. | |
8787 | "^DD",33,3 3.11,.09," DT") | |
8788 | 3190314 | |
8789 | "^DD",33,3 3.11,.1,0) | |
8790 | DATE REQUE ST SUBMITT ED^D^^0;10 ^S %DT="ES TX" D ^%DT S X=Y K:Y <1 X | |
8791 | "^DD",33,3 3.11,.1,3) | |
8792 | Enter the date of au thorizatio n request submission . | |
8793 | "^DD",33,3 3.11,.1,21 ,0) | |
8794 | ^^1^1^3190 227^ | |
8795 | "^DD",33,3 3.11,.1,21 ,1,0) | |
8796 | Date of au thorizatio n request submission for this 90 day per iod. | |
8797 | "^DD",33,3 3.11,.1,"D T") | |
8798 | 3190227 | |
8799 | "^DD",33.1 ,33.1,0) | |
8800 | FIELD^^1^2 | |
8801 | "^DD",33.1 ,33.1,0,"D T") | |
8802 | 3190315 | |
8803 | "^DD",33.1 ,33.1,0,"I X","B",33. 1,.01) | |
8804 | ||
8805 | "^DD",33.1 ,33.1,0,"N M","OTH CL OCK HISTOR Y") | |
8806 | ||
8807 | "^DD",33.1 ,33.1,0,"V RPK") | |
8808 | DG | |
8809 | "^DD",33.1 ,33.1,.01, 0) | |
8810 | OTH CLOCK^ RP33^DGOTH (33,^0;1^Q | |
8811 | "^DD",33.1 ,33.1,.01, 1,0) | |
8812 | ^.1 | |
8813 | "^DD",33.1 ,33.1,.01, 1,1,0) | |
8814 | 33.1^B | |
8815 | "^DD",33.1 ,33.1,.01, 1,1,1) | |
8816 | S ^DGOTH(3 3.1,"B",$E (X,1,30),D A)="" | |
8817 | "^DD",33.1 ,33.1,.01, 1,1,2) | |
8818 | K ^DGOTH(3 3.1,"B",$E (X,1,30),D A) | |
8819 | "^DD",33.1 ,33.1,.01, 3) | |
8820 | Enter the Other Than Honorable patient n ame whom y ou would l ike to vie w audit hi story chan ges. | |
8821 | "^DD",33.1 ,33.1,.01, 21,0) | |
8822 | ^^2^2^3180 813^ | |
8823 | "^DD",33.1 ,33.1,.01, 21,1,0) | |
8824 | This field contains the name o f the pati ent whose Other Than Honorable | |
8825 | "^DD",33.1 ,33.1,.01, 21,2,0) | |
8826 | demographi c informat ion has be en modifie d. | |
8827 | "^DD",33.1 ,33.1,.01, 23,0) | |
8828 | ^.001^1^1^ 3180425^^^ | |
8829 | "^DD",33.1 ,33.1,.01, 23,1,0) | |
8830 | The pointe r to the O TH ELIGIBI LITY CLOCK FILE (#33 ). | |
8831 | "^DD",33.1 ,33.1,.01, "DT") | |
8832 | 3180813 | |
8833 | "^DD",33.1 ,33.1,1,0) | |
8834 | HISTORY RE CORD^33.12 ^^1;0 | |
8835 | "^DD",33.1 ,33.1,1,21 ,0) | |
8836 | ^.001^2^2^ 3180425^^ | |
8837 | "^DD",33.1 ,33.1,1,21 ,1,0) | |
8838 | This multi ple stored records o f changes made for c ertain fie lds of the | |
8839 | "^DD",33.1 ,33.1,1,21 ,2,0) | |
8840 | OTH ELIGIB ILITY CLOC K FILE (#3 3). | |
8841 | "^DD",33.1 ,33.12,0) | |
8842 | HISTORY RE CORD SUB-F IELD^^.08^ 8 | |
8843 | "^DD",33.1 ,33.12,0," DT") | |
8844 | 3190315 | |
8845 | "^DD",33.1 ,33.12,0," IX","B",33 .12,.01) | |
8846 | ||
8847 | "^DD",33.1 ,33.12,0," NM","HISTO RY RECORD" ) | |
8848 | ||
8849 | "^DD",33.1 ,33.12,0," UP") | |
8850 | 33.1 | |
8851 | "^DD",33.1 ,33.12,.01 ,0) | |
8852 | 365 DAYS P ERIOD^MNJ2 ,0^^0;1^K: +X'=X!(X>9 9)!(X<1)!( X?.E1"."1N .N) X | |
8853 | "^DD",33.1 ,33.12,.01 ,1,0) | |
8854 | ^.1 | |
8855 | "^DD",33.1 ,33.12,.01 ,1,1,0) | |
8856 | 33.12^B | |
8857 | "^DD",33.1 ,33.12,.01 ,1,1,1) | |
8858 | S ^DGOTH(3 3.1,DA(1), 1,"B",$E(X ,1,30),DA) ="" | |
8859 | "^DD",33.1 ,33.12,.01 ,1,1,2) | |
8860 | K ^DGOTH(3 3.1,DA(1), 1,"B",$E(X ,1,30),DA) | |
8861 | "^DD",33.1 ,33.12,.01 ,3) | |
8862 | Type a num ber betwee n 1 and 99 , 0 decima l digits. | |
8863 | "^DD",33.1 ,33.12,.01 ,21,0) | |
8864 | ^.001^1^1^ 3180425^^ | |
8865 | "^DD",33.1 ,33.12,.01 ,21,1,0) | |
8866 | The number of the 36 5 days per iod, for w hich the d ata was up dated. | |
8867 | "^DD",33.1 ,33.12,.01 ,"DT") | |
8868 | 3180425 | |
8869 | "^DD",33.1 ,33.12,.02 ,0) | |
8870 | 90 DAYS PE RIOD^NJ1,0 ^^0;2^K:+X '=X!(X>2)! (X<1)!(X?. E1"."1N.N) X | |
8871 | "^DD",33.1 ,33.12,.02 ,3) | |
8872 | Enter the number of the 90 day s period f or the upd ate. | |
8873 | "^DD",33.1 ,33.12,.02 ,21,0) | |
8874 | ^.001^1^1^ 3180425^^ | |
8875 | "^DD",33.1 ,33.12,.02 ,21,1,0) | |
8876 | The number of the 90 days peri od, for wh ich the da ta was upd ated. | |
8877 | "^DD",33.1 ,33.12,.02 ,"DT") | |
8878 | 3180425 | |
8879 | "^DD",33.1 ,33.12,.03 ,0) | |
8880 | FIELD UPDA TED^S^1:ST ART DATE;2 :AUTHORIZE D BY;3:AUT H. RECEIVE D DATE;4:O TH PATIENT STATUS;5: VBA ADJUDI CATION STA TUS;6:VBA ADJUDICATI ON DATE;7: AUTH. EFFE CTIVE DATE ;8:AUTH. C OMMENT;9:D ATE REQUES T SUBMITTE D;^0;3^Q | |
8881 | "^DD",33.1 ,33.12,.03 ,3) | |
8882 | Select the field tha t was upda ted. | |
8883 | "^DD",33.1 ,33.12,.03 ,21,0) | |
8884 | ^.001^1^1^ 3180425^^ | |
8885 | "^DD",33.1 ,33.12,.03 ,21,1,0) | |
8886 | The field that was u pdated. | |
8887 | "^DD",33.1 ,33.12,.03 ,"DT") | |
8888 | 3190315 | |
8889 | "^DD",33.1 ,33.12,.04 ,0) | |
8890 | PREVIOUS V ALUE^FJ60^ ^0;4^K:$L( X)>60!($L( X)<1) X | |
8891 | "^DD",33.1 ,33.12,.04 ,3) | |
8892 | Answer mus t be 1-60 characters in length . | |
8893 | "^DD",33.1 ,33.12,.04 ,21,0) | |
8894 | ^^1^1^3180 425^ | |
8895 | "^DD",33.1 ,33.12,.04 ,21,1,0) | |
8896 | The previo us value. | |
8897 | "^DD",33.1 ,33.12,.04 ,23,0) | |
8898 | ^^1^1^3180 425^ | |
8899 | "^DD",33.1 ,33.12,.04 ,23,1,0) | |
8900 | The previo us values in free te xt format. | |
8901 | "^DD",33.1 ,33.12,.04 ,"DT") | |
8902 | 3180425 | |
8903 | "^DD",33.1 ,33.12,.05 ,0) | |
8904 | NEW VALUE^ FJ60^^0;5^ K:$L(X)>60 !($L(X)<1) X | |
8905 | "^DD",33.1 ,33.12,.05 ,3) | |
8906 | Answer mus t be 1-60 characters in length . | |
8907 | "^DD",33.1 ,33.12,.05 ,21,0) | |
8908 | ^^1^1^3180 425^ | |
8909 | "^DD",33.1 ,33.12,.05 ,21,1,0) | |
8910 | The new va lue. | |
8911 | "^DD",33.1 ,33.12,.05 ,23,0) | |
8912 | ^^1^1^3180 425^ | |
8913 | "^DD",33.1 ,33.12,.05 ,23,1,0) | |
8914 | The new va lue in the free text format. | |
8915 | "^DD",33.1 ,33.12,.05 ,"DT") | |
8916 | 3180425 | |
8917 | "^DD",33.1 ,33.12,.06 ,0) | |
8918 | EDITED BY USER^P200' ^VA(200,^0 ;6^Q | |
8919 | "^DD",33.1 ,33.12,.06 ,3) | |
8920 | Select the person wh o made the changes. | |
8921 | "^DD",33.1 ,33.12,.06 ,21,0) | |
8922 | ^^1^1^3180 430^ | |
8923 | "^DD",33.1 ,33.12,.06 ,21,1,0) | |
8924 | The person who made the change s. | |
8925 | "^DD",33.1 ,33.12,.06 ,"DT") | |
8926 | 3180430 | |
8927 | "^DD",33.1 ,33.12,.07 ,0) | |
8928 | EDITED DAT E/TIME^D^^ 0;7^S %DT= "EST" D ^% DT S X=Y K :X<1 X | |
8929 | "^DD",33.1 ,33.12,.07 ,3) | |
8930 | Enter the date/time when the c hanges wer e made. | |
8931 | "^DD",33.1 ,33.12,.07 ,21,0) | |
8932 | ^^1^1^3180 813^ | |
8933 | "^DD",33.1 ,33.12,.07 ,21,1,0) | |
8934 | The date/t ime when t he changes were made . | |
8935 | "^DD",33.1 ,33.12,.07 ,"DT") | |
8936 | 3180813 | |
8937 | "^DD",33.1 ,33.12,.08 ,0) | |
8938 | CHANGE REA SON^FJ60^^ 0;8^K:$L(X )>60!($L(X )<1) X | |
8939 | "^DD",33.1 ,33.12,.08 ,3) | |
8940 | Enter the reason for inactivat ion/reacti vation of the OTH pa tient's co untdown cl ock. Answe r must be 1 to 60 ch aracters i n length. | |
8941 | "^DD",33.1 ,33.12,.08 ,21,0) | |
8942 | ^^2^2^3180 705^ | |
8943 | "^DD",33.1 ,33.12,.08 ,21,1,0) | |
8944 | This field capture t he reason for reacti vation/ina ctivation of the Oth er | |
8945 | "^DD",33.1 ,33.12,.08 ,21,2,0) | |
8946 | Than Honor able patie nt countdo wn clock. | |
8947 | "^DD",33.1 ,33.12,.08 ,"DT") | |
8948 | 3180905 | |
8949 | "^DIC",33, 33,0) | |
8950 | OTH ELIGIB ILITY CLOC K^33 | |
8951 | "^DIC",33, 33,0,"GL") | |
8952 | ^DGOTH(33, | |
8953 | "^DIC",33, 33,"%",0) | |
8954 | ^1.005^^0 | |
8955 | "^DIC",33, 33,"%D",0) | |
8956 | ^1.001^3^3 ^3180207^^ | |
8957 | "^DIC",33, 33,"%D",1, 0) | |
8958 | This file contains d ata requir ed for tra cking the status of the | |
8959 | "^DIC",33, 33,"%D",2, 0) | |
8960 | eligibilit y for emer gency Ment al Health care for p atients wi th Other T han | |
8961 | "^DIC",33, 33,"%D",3, 0) | |
8962 | Honorable Discharge type. | |
8963 | "^DIC",33, "B","OTH E LIGIBILITY CLOCK",33 ) | |
8964 | ||
8965 | "^DIC",33. 1,33.1,0) | |
8966 | OTH CLOCK HISTORY^33 .1 | |
8967 | "^DIC",33. 1,33.1,0," GL") | |
8968 | ^DGOTH(33. 1, | |
8969 | "^DIC",33. 1,33.1,"%" ,0) | |
8970 | ^1.005^^0 | |
8971 | "^DIC",33. 1,33.1,"%D ",0) | |
8972 | ^^2^2^3180 425^ | |
8973 | "^DIC",33. 1,33.1,"%D ",1,0) | |
8974 | The file k eeps the h istory of who and wh en made ch anges to c ertain fie lds | |
8975 | "^DIC",33. 1,33.1,"%D ",2,0) | |
8976 | of the OTH ELIGIBILI TY CLOCK F ILE (#33). | |
8977 | "^DIC",33. 1,"B","OTH CLOCK HIS TORY",33.1 ) | |
8978 | ||
8979 | **END** | |
8980 | **END** |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.