Produced by Araxis Merge on 2/19/2019 12:21:04 PM Central Standard 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\EPIP combined\PSJ_5.0_332-PSO_7.0_492-PSS_1.0_216 | PSJ_5.0_332.KID | Tue Feb 12 16:40:59 2019 UTC |
2 | C:\AraxisMergeCompare\Pri_re\EPIP combined\PSJ_5.0_332-PSO_7.0_492-PSS_1.0_216 | PSJ_5.0_332.KID | Tue Feb 12 18:40:48 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 11906 |
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 | Packman Ma il Message : | |
2 | ========== ========== = | |
3 | ||
4 | $END TXT | |
5 | $KID PSJ*5 .0*332 | |
6 | **INSTALL NAME** | |
7 | PSJ*5.0*33 2 | |
8 | "BLD",9866 ,0) | |
9 | PSJ*5.0*33 2^INPATIEN T MEDICATI ONS^0^3190 204^y | |
10 | "BLD",9866 ,1,0) | |
11 | ^^11^11^31 81004^^ | |
12 | "BLD",9866 ,1,1,0) | |
13 | PSJ*5.0*33 2 is a cob ined build with PSO* 7.0*492 an d PSS*1.0* 217. This | |
14 | "BLD",9866 ,1,2,0) | |
15 | combined b uild addre sses the f ollowing N SR's: | |
16 | "BLD",9866 ,1,3,0) | |
17 | ||
18 | "BLD",9866 ,1,4,0) | |
19 | 20170 313 | |
20 | "BLD",9866 ,1,5,0) | |
21 | 20170 315 | |
22 | "BLD",9866 ,1,6,0) | |
23 | 20150 709 | |
24 | "BLD",9866 ,1,7,0) | |
25 | 20150 308 | |
26 | "BLD",9866 ,1,8,0) | |
27 | 20140 904 | |
28 | "BLD",9866 ,1,9,0) | |
29 | 20150 905 | |
30 | "BLD",9866 ,1,10,0) | |
31 | 20150 421 | |
32 | "BLD",9866 ,1,11,0) | |
33 | 20160 804 | |
34 | "BLD",9866 ,4,0) | |
35 | ^9.64PA^59 .5^1 | |
36 | "BLD",9866 ,4,59.5,0) | |
37 | 59.5 | |
38 | "BLD",9866 ,4,59.5,2, 0) | |
39 | ^9.641^59. 5^1 | |
40 | "BLD",9866 ,4,59.5,2, 59.5,0) | |
41 | IV ROOM ( File-top l evel) | |
42 | "BLD",9866 ,4,59.5,2, 59.5,1,0) | |
43 | ^9.6411^.1 07^1 | |
44 | "BLD",9866 ,4,59.5,2, 59.5,1,.10 7,0) | |
45 | HEADER LAB EL | |
46 | "BLD",9866 ,4,59.5,22 2) | |
47 | y^y^p^^^^n ^^n | |
48 | "BLD",9866 ,4,59.5,22 4) | |
49 | ||
50 | "BLD",9866 ,4,"APDD", 59.5,59.5) | |
51 | ||
52 | "BLD",9866 ,4,"APDD", 59.5,59.5, .107) | |
53 | ||
54 | "BLD",9866 ,4,"B",59. 5,59.5) | |
55 | ||
56 | "BLD",9866 ,6.3) | |
57 | 8 | |
58 | "BLD",9866 ,"ABPKG") | |
59 | n | |
60 | "BLD",9866 ,"INID") | |
61 | ^ | |
62 | "BLD",9866 ,"INIT") | |
63 | ||
64 | "BLD",9866 ,"KRN",0) | |
65 | ^9.67PA^77 9.2^20 | |
66 | "BLD",9866 ,"KRN",.4, 0) | |
67 | .4 | |
68 | "BLD",9866 ,"KRN",.40 1,0) | |
69 | .401 | |
70 | "BLD",9866 ,"KRN",.40 2,0) | |
71 | .402 | |
72 | "BLD",9866 ,"KRN",.40 3,0) | |
73 | .403 | |
74 | "BLD",9866 ,"KRN",.5, 0) | |
75 | .5 | |
76 | "BLD",9866 ,"KRN",.84 ,0) | |
77 | .84 | |
78 | "BLD",9866 ,"KRN",3.6 ,0) | |
79 | 3.6 | |
80 | "BLD",9866 ,"KRN",3.8 ,0) | |
81 | 3.8 | |
82 | "BLD",9866 ,"KRN",9.2 ,0) | |
83 | 9.2 | |
84 | "BLD",9866 ,"KRN",9.8 ,0) | |
85 | 9.8 | |
86 | "BLD",9866 ,"KRN",9.8 ,"NM",0) | |
87 | ^9.68A^26^ 22 | |
88 | "BLD",9866 ,"KRN",9.8 ,"NM",1,0) | |
89 | PSGPER0^^0 ^B35728238 | |
90 | "BLD",9866 ,"KRN",9.8 ,"NM",2,0) | |
91 | PSGPER2^^0 ^B31133994 | |
92 | "BLD",9866 ,"KRN",9.8 ,"NM",3,0) | |
93 | PSGPEN^^0^ B59188020 | |
94 | "BLD",9866 ,"KRN",9.8 ,"NM",6,0) | |
95 | PSIVLBL1^^ 0^B4557405 5 | |
96 | "BLD",9866 ,"KRN",9.8 ,"NM",7,0) | |
97 | PSIVLBRP^^ 0^B1956974 7 | |
98 | "BLD",9866 ,"KRN",9.8 ,"NM",8,0) | |
99 | PSJDIN^^0^ B46714111 | |
100 | "BLD",9866 ,"KRN",9.8 ,"NM",10,0 ) | |
101 | PSGPER^^0^ B21024384 | |
102 | "BLD",9866 ,"KRN",9.8 ,"NM",11,0 ) | |
103 | PSGIEN^^0^ B2583050 | |
104 | "BLD",9866 ,"KRN",9.8 ,"NM",12,0 ) | |
105 | PSIVHYPR^^ 0^B4637520 7 | |
106 | "BLD",9866 ,"KRN",9.8 ,"NM",13,0 ) | |
107 | PSIVHYPL^^ 0^B4897182 3 | |
108 | "BLD",9866 ,"KRN",9.8 ,"NM",14,0 ) | |
109 | PSIVLABL^^ 0^B4482821 9 | |
110 | "BLD",9866 ,"KRN",9.8 ,"NM",16,0 ) | |
111 | PSGZEBL^^0 ^B26551662 | |
112 | "BLD",9866 ,"KRN",9.8 ,"NM",17,0 ) | |
113 | PSGFILED^^ 0^B2843875 2 | |
114 | "BLD",9866 ,"KRN",9.8 ,"NM",18,0 ) | |
115 | PSGZEB1^^0 ^B395705 | |
116 | "BLD",9866 ,"KRN",9.8 ,"NM",19,0 ) | |
117 | PSGZEB2^^0 ^B168513 | |
118 | "BLD",9866 ,"KRN",9.8 ,"NM",20,0 ) | |
119 | PSGBOX1^^0 ^B1887534 | |
120 | "BLD",9866 ,"KRN",9.8 ,"NM",21,0 ) | |
121 | PSGBOX5^^0 ^B26184006 | |
122 | "BLD",9866 ,"KRN",9.8 ,"NM",22,0 ) | |
123 | PSGBOX6^^0 ^B19745461 | |
124 | "BLD",9866 ,"KRN",9.8 ,"NM",23,0 ) | |
125 | PSGBOX7^^0 ^B21697273 6 | |
126 | "BLD",9866 ,"KRN",9.8 ,"NM",24,0 ) | |
127 | PSGBOX9^^0 ^B14433212 | |
128 | "BLD",9866 ,"KRN",9.8 ,"NM",25,0 ) | |
129 | PSIVLABR^^ 0^B4009744 6 | |
130 | "BLD",9866 ,"KRN",9.8 ,"NM",26,0 ) | |
131 | PSIVORLB^^ 0^B1653118 2 | |
132 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGBOX1", 20) | |
133 | ||
134 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGBOX5", 21) | |
135 | ||
136 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGBOX6", 22) | |
137 | ||
138 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGBOX7", 23) | |
139 | ||
140 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGBOX9", 24) | |
141 | ||
142 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGFILED" ,17) | |
143 | ||
144 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGIEN",1 1) | |
145 | ||
146 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGPEN",3 ) | |
147 | ||
148 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGPER",1 0) | |
149 | ||
150 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGPER0", 1) | |
151 | ||
152 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGPER2", 2) | |
153 | ||
154 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGZEB1", 18) | |
155 | ||
156 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGZEB2", 19) | |
157 | ||
158 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSGZEBL", 16) | |
159 | ||
160 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVHYPL" ,13) | |
161 | ||
162 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVHYPR" ,12) | |
163 | ||
164 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVLABL" ,14) | |
165 | ||
166 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVLABR" ,25) | |
167 | ||
168 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVLBL1" ,6) | |
169 | ||
170 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVLBRP" ,7) | |
171 | ||
172 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSIVORLB" ,26) | |
173 | ||
174 | "BLD",9866 ,"KRN",9.8 ,"NM","B", "PSJDIN",8 ) | |
175 | ||
176 | "BLD",9866 ,"KRN",19, 0) | |
177 | 19 | |
178 | "BLD",9866 ,"KRN",19, "NM",0) | |
179 | ^9.68A^4^3 | |
180 | "BLD",9866 ,"KRN",19, "NM",2,0) | |
181 | PSGBOX SWI SS LOG SEN D PL^^0 | |
182 | "BLD",9866 ,"KRN",19, "NM",3,0) | |
183 | PSGBOX SWI SS LOG SFT P RETX^^0 | |
184 | "BLD",9866 ,"KRN",19, "NM",4,0) | |
185 | PSGBOX SWI SS LOG MAI N^^0 | |
186 | "BLD",9866 ,"KRN",19, "NM","B"," PSGBOX SWI SS LOG MAI N",4) | |
187 | ||
188 | "BLD",9866 ,"KRN",19, "NM","B"," PSGBOX SWI SS LOG SEN D PL",2) | |
189 | ||
190 | "BLD",9866 ,"KRN",19, "NM","B"," PSGBOX SWI SS LOG SFT P RETX",3) | |
191 | ||
192 | "BLD",9866 ,"KRN",19. 1,0) | |
193 | 19.1 | |
194 | "BLD",9866 ,"KRN",19. 1,"NM",0) | |
195 | ^9.68A^^ | |
196 | "BLD",9866 ,"KRN",101 ,0) | |
197 | 101 | |
198 | "BLD",9866 ,"KRN",409 .61,0) | |
199 | 409.61 | |
200 | "BLD",9866 ,"KRN",771 ,0) | |
201 | 771 | |
202 | "BLD",9866 ,"KRN",779 .2,0) | |
203 | 779.2 | |
204 | "BLD",9866 ,"KRN",870 ,0) | |
205 | 870 | |
206 | "BLD",9866 ,"KRN",898 9.51,0) | |
207 | 8989.51 | |
208 | "BLD",9866 ,"KRN",898 9.51,"NM", 0) | |
209 | ^9.68A^6^4 | |
210 | "BLD",9866 ,"KRN",898 9.51,"NM", 3,0) | |
211 | PSG PRE-EX REPORT ZE BRA LABELS ^^0 | |
212 | "BLD",9866 ,"KRN",898 9.51,"NM", 4,0) | |
213 | PSG BOX FI RST DOSE I NT ON^^0 | |
214 | "BLD",9866 ,"KRN",898 9.51,"NM", 5,0) | |
215 | PSG BOX SF TP CFG NAM E^^0 | |
216 | "BLD",9866 ,"KRN",898 9.51,"NM", 6,0) | |
217 | PSG BOX SF TP SAVE FI LE^^0 | |
218 | "BLD",9866 ,"KRN",898 9.51,"NM", "B","PSG B OX FIRST D OSE INT ON ",4) | |
219 | ||
220 | "BLD",9866 ,"KRN",898 9.51,"NM", "B","PSG B OX SFTP CF G NAME",5) | |
221 | ||
222 | "BLD",9866 ,"KRN",898 9.51,"NM", "B","PSG B OX SFTP SA VE FILE",6 ) | |
223 | ||
224 | "BLD",9866 ,"KRN",898 9.51,"NM", "B","PSG P RE-EX REPO RT ZEBRA L ABELS",3) | |
225 | ||
226 | "BLD",9866 ,"KRN",898 9.52,0) | |
227 | 8989.52 | |
228 | "BLD",9866 ,"KRN",898 9.52,"NM", 0) | |
229 | ^9.68A^1^1 | |
230 | "BLD",9866 ,"KRN",898 9.52,"NM", 1,0) | |
231 | PSG KERNEL PARAMETER S^^0 | |
232 | "BLD",9866 ,"KRN",898 9.52,"NM", "B","PSG K ERNEL PARA METERS",1) | |
233 | ||
234 | "BLD",9866 ,"KRN",899 4,0) | |
235 | 8994 | |
236 | "BLD",9866 ,"KRN",899 4,"NM",0) | |
237 | ^9.68A^^ | |
238 | "BLD",9866 ,"KRN","B" ,.4,.4) | |
239 | ||
240 | "BLD",9866 ,"KRN","B" ,.401,.401 ) | |
241 | ||
242 | "BLD",9866 ,"KRN","B" ,.402,.402 ) | |
243 | ||
244 | "BLD",9866 ,"KRN","B" ,.403,.403 ) | |
245 | ||
246 | "BLD",9866 ,"KRN","B" ,.5,.5) | |
247 | ||
248 | "BLD",9866 ,"KRN","B" ,.84,.84) | |
249 | ||
250 | "BLD",9866 ,"KRN","B" ,3.6,3.6) | |
251 | ||
252 | "BLD",9866 ,"KRN","B" ,3.8,3.8) | |
253 | ||
254 | "BLD",9866 ,"KRN","B" ,9.2,9.2) | |
255 | ||
256 | "BLD",9866 ,"KRN","B" ,9.8,9.8) | |
257 | ||
258 | "BLD",9866 ,"KRN","B" ,19,19) | |
259 | ||
260 | "BLD",9866 ,"KRN","B" ,19.1,19.1 ) | |
261 | ||
262 | "BLD",9866 ,"KRN","B" ,101,101) | |
263 | ||
264 | "BLD",9866 ,"KRN","B" ,409.61,40 9.61) | |
265 | ||
266 | "BLD",9866 ,"KRN","B" ,771,771) | |
267 | ||
268 | "BLD",9866 ,"KRN","B" ,779.2,779 .2) | |
269 | ||
270 | "BLD",9866 ,"KRN","B" ,870,870) | |
271 | ||
272 | "BLD",9866 ,"KRN","B" ,8989.51,8 989.51) | |
273 | ||
274 | "BLD",9866 ,"KRN","B" ,8989.52,8 989.52) | |
275 | ||
276 | "BLD",9866 ,"KRN","B" ,8994,8994 ) | |
277 | ||
278 | "BLD",9866 ,"QUES",0) | |
279 | ^9.62^^ | |
280 | "BLD",9866 ,"REQB",0) | |
281 | ^9.611^2^2 | |
282 | "BLD",9866 ,"REQB",1, 0) | |
283 | PSJ*5.0*35 7^1 | |
284 | "BLD",9866 ,"REQB",2, 0) | |
285 | PSS*1.0*21 6^1 | |
286 | "BLD",9866 ,"REQB","B ","PSJ*5.0 *357",1) | |
287 | ||
288 | "BLD",9866 ,"REQB","B ","PSS*1.0 *216",2) | |
289 | ||
290 | "FIA",59.5 ) | |
291 | IV ROOM | |
292 | "FIA",59.5 ,0) | |
293 | ^PS(59.5, | |
294 | "FIA",59.5 ,0,0) | |
295 | 59.5 | |
296 | "FIA",59.5 ,0,1) | |
297 | y^y^p^^^^n ^^n | |
298 | "FIA",59.5 ,0,10) | |
299 | ||
300 | "FIA",59.5 ,0,11) | |
301 | ||
302 | "FIA",59.5 ,0,"RLRO") | |
303 | ||
304 | "FIA",59.5 ,0,"VR") | |
305 | 5.0^PSJ | |
306 | "FIA",59.5 ,59.5) | |
307 | 1 | |
308 | "FIA",59.5 ,59.5,.107 ) | |
309 | ||
310 | "KRN",19,2 922120,-1) | |
311 | 0^3 | |
312 | "KRN",19,2 922120,0) | |
313 | PSGBOX SWI SS LOG SFT P RETX^Ret ransmit Fa iled SFTP Background Job^^R^^^ ^^^^^ | |
314 | "KRN",19,2 922120,1,0 ) | |
315 | ^19.06^4^4 ^3180920^^ | |
316 | "KRN",19,2 922120,1,1 ,0) | |
317 | This optio n should b e queued t o run ever y five min utes. It monitors | |
318 | "KRN",19,2 922120,1,2 ,0) | |
319 | ^XTMP("PSG BOX7_QUEUE ") and wil l try to r etransmit any file i n there. | |
320 | "KRN",19,2 922120,1,3 ,0) | |
321 | Once the f ile is suc cessfully transmitte d, then it is delete d from | |
322 | "KRN",19,2 922120,1,4 ,0) | |
323 | the queue. | |
324 | "KRN",19,2 922120,25) | |
325 | TQMON^PSGB OX9 | |
326 | "KRN",19,2 922120,200 .9) | |
327 | y | |
328 | "KRN",19,2 922120,"U" ) | |
329 | RETRANSMIT FAILED SF TP BACKGRO | |
330 | "KRN",19,2 922121,-1) | |
331 | 0^4 | |
332 | "KRN",19,2 922121,0) | |
333 | PSGBOX SWI SS LOG MAI N^SWISS IN TERFACE LO G^^M^^^^^^ ^^ | |
334 | "KRN",19,2 922121,1,0 ) | |
335 | ^19.06^1^1 ^3181015^^ ^ | |
336 | "KRN",19,2 922121,1,1 ,0) | |
337 | Main menu for Swiss Log dispen se interfa ce. | |
338 | "KRN",19,2 922121,10, 0) | |
339 | ^19.01IP^2 ^2 | |
340 | "KRN",19,2 922121,99) | |
341 | 64869,4532 5 | |
342 | "KRN",19,2 922121,99. 1) | |
343 | 62700,1750 2 | |
344 | "KRN",19,2 922121,"U" ) | |
345 | SWISS INTE RFACE LOG | |
346 | "KRN",19,2 922123,-1) | |
347 | 0^2 | |
348 | "KRN",19,2 922123,0) | |
349 | PSGBOX SWI SS LOG SEN D PL^Send Pick List to Swiss L og^^R^^^^^ ^^^ | |
350 | "KRN",19,2 922123,1,0 ) | |
351 | ^19.06^1^1 ^3180809^^ | |
352 | "KRN",19,2 922123,1,1 ,0) | |
353 | This will transmit a pick list to Swiss Log. | |
354 | "KRN",19,2 922123,25) | |
355 | PSGBOX5 | |
356 | "KRN",19,2 922123,"U" ) | |
357 | SEND PICK LIST TO SW ISS LOG | |
358 | "KRN",8989 .51,905,-1 ) | |
359 | 0^3 | |
360 | "KRN",8989 .51,905,0) | |
361 | PSG PRE-EX REPORT ZE BRA LABELS ^Pre-excha nge report ZEBRA lab els^1^Divi sion^PRE-E XCHANGE | |
362 | REPORT ZEB RA LABELS? ^0 | |
363 | "KRN",8989 .51,905,1) | |
364 | Y^0:NO,1:Y ES^Enter Y es to use the Zebra Label prin ter for pr e-exchange labels, N o to skip. | |
365 | "KRN",8989 .51,905,6) | |
366 | P^4^Select the divis ion which you log in to. | |
367 | "KRN",8989 .51,905,20 ,0) | |
368 | ^8989.512^ 3^3^318103 1^^^^ | |
369 | "KRN",8989 .51,905,20 ,1,0) | |
370 | This param eter allow s a Zebra Label Prin ter to be used for p rinting | |
371 | "KRN",8989 .51,905,20 ,2,0) | |
372 | Pre-Exchan ge Report labels. I f set to N o, this pa rameter wi ll print | |
373 | "KRN",8989 .51,905,20 ,3,0) | |
374 | the report to an 8-1 /2 x 11" s heet of pa per. | |
375 | "KRN",8989 .51,905,30 ,0) | |
376 | ^8989.513I ^2^2 | |
377 | "KRN",8989 .51,905,30 ,1,0) | |
378 | 10^4.2 | |
379 | "KRN",8989 .51,905,30 ,2,0) | |
380 | 1^4 | |
381 | "KRN",8989 .51,920,0) | |
382 | PSG BOX FA IL QUE EXP IRY TIME^B oxPicker I nterface Q ueue entry expiry^^^ Time in se conds | |
383 | "KRN",8989 .51,920,1) | |
384 | N^0:14400^ Value in s econds bef ore an ent ry in the failed que ue expires . | |
385 | "KRN",8989 .51,920,20 ,0) | |
386 | ^^9^9^3180 809^ | |
387 | "KRN",8989 .51,920,20 ,1,0) | |
388 | This is th e number o f seconds an entry i n the fail ed queue w ill stay | |
389 | "KRN",8989 .51,920,20 ,2,0) | |
390 | until the entry is c onsidered expired. Tasked opt ion PSGBOX 5 SWISS | |
391 | "KRN",8989 .51,920,20 ,3,0) | |
392 | LOG SFTP R ETX will a ttempt to retransmit any entri es in the failed | |
393 | "KRN",8989 .51,920,20 ,4,0) | |
394 | queue as l ong as the entry has not expir ed. Expir ation time is | |
395 | "KRN",8989 .51,920,20 ,5,0) | |
396 | counted fr om the tim e the entr y was firs t added to the queue . | |
397 | "KRN",8989 .51,920,20 ,6,0) | |
398 | ||
399 | "KRN",8989 .51,920,20 ,7,0) | |
400 | A time of 0 (zero) w ill disabl e the fail ed queue. | |
401 | "KRN",8989 .51,920,20 ,8,0) | |
402 | ||
403 | "KRN",8989 .51,920,20 ,9,0) | |
404 | Maximum ti me is 14,4 00 seconds (4 hours) . | |
405 | "KRN",8989 .51,920,30 ,0) | |
406 | ^8989.513I ^1^1 | |
407 | "KRN",8989 .51,920,30 ,1,0) | |
408 | 10^4.2 | |
409 | "KRN",8989 .51,921,-1 ) | |
410 | 0^4 | |
411 | "KRN",8989 .51,921,0) | |
412 | PSG BOX FI RST DOSE I NT ON^BoxP icker Firs t Dose Int erface Swi tch^0^^(A) ctive or ( I)nactive? | |
413 | "KRN",8989 .51,921,1) | |
414 | S^0:Inacti ve;1:Activ e^Enter A to send fi rst dose t o ADM. | |
415 | "KRN",8989 .51,921,20 ,0) | |
416 | ^8989.512^ 2^2^318082 8^^^ | |
417 | "KRN",8989 .51,921,20 ,1,0) | |
418 | Triggers t he interfa ce to send first dos e orders t o the Auto mated | |
419 | "KRN",8989 .51,921,20 ,2,0) | |
420 | Dispensing Machine i n XML form at. | |
421 | "KRN",8989 .51,921,30 ,0) | |
422 | ^8989.513I ^1^1 | |
423 | "KRN",8989 .51,921,30 ,1,0) | |
424 | 10^4.2 | |
425 | "KRN",8989 .51,922,-1 ) | |
426 | 0^5 | |
427 | "KRN",8989 .51,922,0) | |
428 | PSG BOX SF TP CFG NAM E^Swiss Lo g SFTP Con figuration Name^^^Co nfiguratio n Name | |
429 | "KRN",8989 .51,922,1) | |
430 | F^3:20^Ent er the nam e of the S FTP config uration. | |
431 | "KRN",8989 .51,922,20 ,0) | |
432 | ^^2^2^3180 814^ | |
433 | "KRN",8989 .51,922,20 ,1,0) | |
434 | The name o f the SFTP configura tion in or der to tra nsmit orde rs from Vi sta | |
435 | "KRN",8989 .51,922,20 ,2,0) | |
436 | to Swiss L og. | |
437 | "KRN",8989 .51,922,30 ,0) | |
438 | ^8989.513I ^1^1 | |
439 | "KRN",8989 .51,922,30 ,1,0) | |
440 | 10^4.2 | |
441 | "KRN",8989 .51,923,-1 ) | |
442 | 0^6 | |
443 | "KRN",8989 .51,923,0) | |
444 | PSG BOX SF TP SAVE FI LE^Swiss L og Save Tx 'd File^^^ Save after successfu l transmis sion | |
445 | "KRN",8989 .51,923,1) | |
446 | S^0:NO;1:Y ES^Determi nes if a f ile should be saved after tran smission. | |
447 | "KRN",8989 .51,923,20 ,0) | |
448 | ^^19^19^31 80828^ | |
449 | "KRN",8989 .51,923,20 ,1,0) | |
450 | This deter mines whet her the SF TP'd file should be automatica lly saved | |
451 | "KRN",8989 .51,923,20 ,2,0) | |
452 | after tran smission. Set this to YES to save the f ile; set t o NO to de lete | |
453 | "KRN",8989 .51,923,20 ,3,0) | |
454 | the file. | |
455 | "KRN",8989 .51,923,20 ,4,0) | |
456 | ||
457 | "KRN",8989 .51,923,20 ,5,0) | |
458 | During SFT P, the ord er to be t ransmitted is placed on the ho st file sy stem | |
459 | "KRN",8989 .51,923,20 ,6,0) | |
460 | in the cur rent worki ng directo ry defined by the Ke rnel site parameters | |
461 | "KRN",8989 .51,923,20 ,7,0) | |
462 | ($$PWD^%ZI SH). Afte r transmis sion, this parameter determine s if the f ile | |
463 | "KRN",8989 .51,923,20 ,8,0) | |
464 | should be saved or n ot. By de fault, suc cessfully transmitte d files wi ll | |
465 | "KRN",8989 .51,923,20 ,9,0) | |
466 | automatica lly be del eted. | |
467 | "KRN",8989 .51,923,20 ,10,0) | |
468 | ||
469 | "KRN",8989 .51,923,20 ,11,0) | |
470 | If the par ameter PSO BOX FAIL QUE EXPIRY TIME is g reater tha n 0 (zero) , | |
471 | "KRN",8989 .51,923,20 ,12,0) | |
472 | and a file fails to transmit, then the f ailed file is automa tically | |
473 | "KRN",8989 .51,923,20 ,13,0) | |
474 | retained u ntil proce ssed by th e failed q ueued job. | |
475 | "KRN",8989 .51,923,20 ,14,0) | |
476 | ||
477 | "KRN",8989 .51,923,20 ,15,0) | |
478 | If you are troublesh ooting thi s interfac e, then yo u may wish to | |
479 | "KRN",8989 .51,923,20 ,16,0) | |
480 | change thi s paramete r to YES u ntil the p roblem is resolved. This | |
481 | "KRN",8989 .51,923,20 ,17,0) | |
482 | way, you c an examine all the o rders hand led by thi s interfac e. Once t he | |
483 | "KRN",8989 .51,923,20 ,18,0) | |
484 | problem is resolved, you will need to ch ange this parameter to NO and then | |
485 | "KRN",8989 .51,923,20 ,19,0) | |
486 | also manua lly delete any files that were created b y this int erface. | |
487 | "KRN",8989 .51,923,30 ,0) | |
488 | ^8989.513I ^1^1 | |
489 | "KRN",8989 .51,923,30 ,1,0) | |
490 | 10^4.2 | |
491 | "KRN",8989 .51,936,0) | |
492 | PSG ATC SE TUP PROMPT ^Dispense Drug ATC s etup promp t^0^^Multi ple ATCs t o setup?^0 | |
493 | "KRN",8989 .51,936,1) | |
494 | S^0:No;1:Y es^Enter 1 for Yes, 0 for No | |
495 | "KRN",8989 .51,936,6) | |
496 | ^ | |
497 | "KRN",8989 .51,936,20 ,0) | |
498 | ^8989.512^ 5^5^318122 6^^^^ | |
499 | "KRN",8989 .51,936,20 ,1,0) | |
500 | This param eter allow s each sit e to set u p the defa ult prompt for setti ng | |
501 | "KRN",8989 .51,936,20 ,2,0) | |
502 | the DISPEN SE DRUG/AT C SET UP o ption when selecting Multiple or One ATC . | |
503 | "KRN",8989 .51,936,20 ,3,0) | |
504 | A value of M allows setting up multiple ATCs when defining i t with a | |
505 | "KRN",8989 .51,936,20 ,4,0) | |
506 | Dispense D rug. Conve rsely, O a llows the set up of one ATC fo r dispense | |
507 | "KRN",8989 .51,936,20 ,5,0) | |
508 | drugs. | |
509 | "KRN",8989 .51,936,30 ,0) | |
510 | ^8989.513I ^3^1 | |
511 | "KRN",8989 .51,936,30 ,3,0) | |
512 | 1^4.2 | |
513 | "KRN",8989 .52,127,-1 ) | |
514 | 0^1 | |
515 | "KRN",8989 .52,127,0) | |
516 | PSG KERNEL PARAMETER S^UNIT DOS E KERNEL P ARAMETERS | |
517 | "KRN",8989 .52,127,10 ,0) | |
518 | ^8989.521I A^7^6 | |
519 | "KRN",8989 .52,127,10 ,2,0) | |
520 | 1^PSG ATC SETUP PROM PT | |
521 | "KRN",8989 .52,127,10 ,3,0) | |
522 | 2^PSG BOX FIRST DOSE INT ON | |
523 | "KRN",8989 .52,127,10 ,4,0) | |
524 | 3^PSG BOX SFTP CFG N AME | |
525 | "KRN",8989 .52,127,10 ,5,0) | |
526 | 4^PSG BOX SFTP SAVE FILE | |
527 | "KRN",8989 .52,127,10 ,6,0) | |
528 | 5^PSG BOX FAIL QUE E XPIRY TIME | |
529 | "KRN",8989 .52,127,10 ,7,0) | |
530 | 6^PSG PRE- EX REPORT ZEBRA LABE LS | |
531 | "MBREQ") | |
532 | 0 | |
533 | "ORD",18,1 9) | |
534 | 19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA | |
535 | "ORD",18,1 9,0) | |
536 | OPTION | |
537 | "ORD",20,8 989.51) | |
538 | 8989.51;20 ;;;PAR1E1^ XPDTA2;PAR 1F1^XPDIA3 ;PAR1E1^XP DIA3;PAR1F 2^XPDIA3;; PAR1DEL^XP DIA3(%) | |
539 | "ORD",20,8 989.51,0) | |
540 | PARAMETER DEFINITION | |
541 | "ORD",21,8 989.52) | |
542 | 8989.52;21 ;1;;PAR2E1 ^XPDTA2;PA R2F1^XPDIA 3;PAR2E1^X PDIA3;PAR2 F2^XPDIA3; ;PAR2DEL^X PDIA3(%) | |
543 | "ORD",21,8 989.52,0) | |
544 | PARAMETER TEMPLATE | |
545 | "PKG",221, -1) | |
546 | 1^1 | |
547 | "PKG",221, 0) | |
548 | INPATIENT MEDICATION S^PSJ^UNIT DOSE AND IVS | |
549 | "PKG",221, 22,0) | |
550 | ^9.49I^1^1 | |
551 | "PKG",221, 22,1,0) | |
552 | 5.0^297121 5^2981113^ 1 | |
553 | "PKG",221, 22,1,"PAH" ,1,0) | |
554 | 332^319020 4^52073644 7 | |
555 | "PKG",221, 22,1,"PAH" ,1,1,0) | |
556 | ^^11^11^31 90204 | |
557 | "PKG",221, 22,1,"PAH" ,1,1,1,0) | |
558 | PSJ*5.0*33 2 is a cob ined build with PSO* 7.0*492 an d PSS*1.0* 217. This | |
559 | "PKG",221, 22,1,"PAH" ,1,1,2,0) | |
560 | combined b uild addre sses the f ollowing N SR's: | |
561 | "PKG",221, 22,1,"PAH" ,1,1,3,0) | |
562 | ||
563 | "PKG",221, 22,1,"PAH" ,1,1,4,0) | |
564 | 20170 313 | |
565 | "PKG",221, 22,1,"PAH" ,1,1,5,0) | |
566 | 20170 315 | |
567 | "PKG",221, 22,1,"PAH" ,1,1,6,0) | |
568 | 20150 709 | |
569 | "PKG",221, 22,1,"PAH" ,1,1,7,0) | |
570 | 20150 308 | |
571 | "PKG",221, 22,1,"PAH" ,1,1,8,0) | |
572 | 20140 904 | |
573 | "PKG",221, 22,1,"PAH" ,1,1,9,0) | |
574 | 20150 905 | |
575 | "PKG",221, 22,1,"PAH" ,1,1,10,0) | |
576 | 20150 421 | |
577 | "PKG",221, 22,1,"PAH" ,1,1,11,0) | |
578 | 20160 804 | |
579 | "QUES","XP F1",0) | |
580 | Y | |
581 | "QUES","XP F1","??") | |
582 | ^D REP^XPD H | |
583 | "QUES","XP F1","A") | |
584 | Shall I wr ite over y our |FLAG| File | |
585 | "QUES","XP F1","B") | |
586 | YES | |
587 | "QUES","XP F1","M") | |
588 | D XPF1^XPD IQ | |
589 | "QUES","XP F2",0) | |
590 | Y | |
591 | "QUES","XP F2","??") | |
592 | ^D DTA^XPD H | |
593 | "QUES","XP F2","A") | |
594 | Want my da ta |FLAG| yours | |
595 | "QUES","XP F2","B") | |
596 | YES | |
597 | "QUES","XP F2","M") | |
598 | D XPF2^XPD IQ | |
599 | "QUES","XP I1",0) | |
600 | YO | |
601 | "QUES","XP I1","??") | |
602 | ^D INHIBIT ^XPDH | |
603 | "QUES","XP I1","A") | |
604 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
605 | "QUES","XP I1","B") | |
606 | NO | |
607 | "QUES","XP I1","M") | |
608 | D XPI1^XPD IQ | |
609 | "QUES","XP M1",0) | |
610 | PO^VA(200, :EM | |
611 | "QUES","XP M1","??") | |
612 | ^D MG^XPDH | |
613 | "QUES","XP M1","A") | |
614 | Enter the Coordinato r for Mail Group '|F LAG|' | |
615 | "QUES","XP M1","B") | |
616 | ||
617 | "QUES","XP M1","M") | |
618 | D XPM1^XPD IQ | |
619 | "QUES","XP O1",0) | |
620 | Y | |
621 | "QUES","XP O1","??") | |
622 | ^D MENU^XP DH | |
623 | "QUES","XP O1","A") | |
624 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
625 | "QUES","XP O1","B") | |
626 | NO | |
627 | "QUES","XP O1","M") | |
628 | D XPO1^XPD IQ | |
629 | "QUES","XP Z1",0) | |
630 | Y | |
631 | "QUES","XP Z1","??") | |
632 | ^D OPT^XPD H | |
633 | "QUES","XP Z1","A") | |
634 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
635 | "QUES","XP Z1","B") | |
636 | NO | |
637 | "QUES","XP Z1","M") | |
638 | D XPZ1^XPD IQ | |
639 | "QUES","XP Z2",0) | |
640 | Y | |
641 | "QUES","XP Z2","??") | |
642 | ^D RTN^XPD H | |
643 | "QUES","XP Z2","A") | |
644 | Want to MO VE routine s to other CPUs | |
645 | "QUES","XP Z2","B") | |
646 | NO | |
647 | "QUES","XP Z2","M") | |
648 | D XPZ2^XPD IQ | |
649 | "RTN") | |
650 | 22 | |
651 | "RTN","PSG BOX1") | |
652 | 0^20^B1887 534^n/a | |
653 | "RTN","PSG BOX1",1,0) | |
654 | PSGBOX1 ;E PIP/WLC - USER INTER FACE FOR P RE-EXCHANG E TRANSMIS SIONS; 29 Nov 2018 12:12 PM ; | |
655 | 15 Jan 201 9 8:55 AM | |
656 | "RTN","PSG BOX1",2,0) | |
657 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;16 DEC 97;Bui ld 8 | |
658 | "RTN","PSG BOX1",3,0) | |
659 | ; | |
660 | "RTN","PSG BOX1",4,0) | |
661 | ORDSAVE(PS GBDFN,PSGB ORDN,PSGBP XDS) ;Call ed from PS GPEN to sa ve order w ith pre-ex ch activit y | |
662 | "RTN","PSG BOX1",5,0) | |
663 | N | |
664 | PSGBDTRC,P SGBII,PSGB NODE,PSGBF DA,PSGBIEN ,PSGBIENS, PSGBIENR,P SGBLOGN,PS GBOREF,PSG BFDTX, | |
665 | Y,X,% | |
666 | "RTN","PSG BOX1",6,0) | |
667 | Q:'PSGBDF N | |
668 | "RTN","PSG BOX1",7,0) | |
669 | Q:'PSGBOR DN | |
670 | "RTN","PSG BOX1",8,0) | |
671 | I '$$ORDA CT(PSGBDFN ,+PSGBORDN ) Q | |
672 | "RTN","PSG BOX1",9,0) | |
673 | ; | |
674 | "RTN","PSG BOX1",10,0 ) | |
675 | D ORDFDQ( PSGBDFN,PS GBORDN) ;q ueue off j ob to ENFD ^PSGBOX7 | |
676 | "RTN","PSG BOX1",11,0 ) | |
677 | Q | |
678 | "RTN","PSG BOX1",12,0 ) | |
679 | ; | |
680 | "RTN","PSG BOX1",13,0 ) | |
681 | ORDACT(PSG BDFN,PSGBO RDN) ;Retu rn 1 if or der is act ive | |
682 | "RTN","PSG BOX1",14,0 ) | |
683 | ; ICR # 4 826 - ^PSS 55 API | |
684 | "RTN","PSG BOX1",15,0 ) | |
685 | N PSGBACT V,PSGBSTOP ,PSGBOSTS | |
686 | "RTN","PSG BOX1",16,0 ) | |
687 | S PSGBACT V=0 | |
688 | "RTN","PSG BOX1",17,0 ) | |
689 | D PSS431^ PSS55(PSGB DFN,PSGBOR DN,,,"RET" ) | |
690 | "RTN","PSG BOX1",18,0 ) | |
691 | S PSGBOST S=$G(^TMP( $J,"RET",P SGBORDN,28 )) | |
692 | "RTN","PSG BOX1",19,0 ) | |
693 | D PSS433^ PSS55(PSGB DFN,"RET1" ) | |
694 | "RTN","PSG BOX1",20,0 ) | |
695 | S PSGBSTO P=$G(^TMP( $J,"RET1", PSGBORDN,3 4)) | |
696 | "RTN","PSG BOX1",21,0 ) | |
697 | I | |
698 | $S($P(PSGB OSTS,U,1)= "A":1,$P(P SGBOSTS,U, 1)="R":1,$ P(PSGBOSTS ,U,1)="RE" :1,1:0),(P SGBSTOP'<$ $NO | |
699 | W^XLFDT) S PSGBACTV= 1 | |
700 | "RTN","PSG BOX1",22,0 ) | |
701 | Q PSGBACT V | |
702 | "RTN","PSG BOX1",23,0 ) | |
703 | ; | |
704 | "RTN","PSG BOX1",24,0 ) | |
705 | ORDFDQ(PSB DFN,PSBORD N) ;Queue off first dose job | |
706 | "RTN","PSG BOX1",25,0 ) | |
707 | ;N ZTIO,Z TDESC,ZTRT N,ZTSAVE,Z TDTH,ZTSK, IOP | |
708 | "RTN","PSG BOX1",26,0 ) | |
709 | ;S ZTIO=" " | |
710 | "RTN","PSG BOX1",27,0 ) | |
711 | ;S ZTDESC ="FIRST DO SE TRANSMI SSION REAL TIME" | |
712 | "RTN","PSG BOX1",28,0 ) | |
713 | ;S ZTRTN= "ENQFD^PSG BOX7" | |
714 | "RTN","PSG BOX1",29,0 ) | |
715 | ;S ZTDTH= $$NOW^XLFD T | |
716 | "RTN","PSG BOX1",30,0 ) | |
717 | ;F PSGBII ="PSGBDFN" ,"PSGBORDN " S ZTSAVE (PSGBII)=" " | |
718 | "RTN","PSG BOX1",31,0 ) | |
719 | ;D ^%ZTLO AD | |
720 | "RTN","PSG BOX1",32,0 ) | |
721 | D ENQFD^P SGBOX7 Q | |
722 | "RTN","PSG BOX1",33,0 ) | |
723 | ; | |
724 | "RTN","PSG BOX5") | |
725 | 0^21^B2618 4006^n/a | |
726 | "RTN","PSG BOX5",1,0) | |
727 | PSGBOX5 ;E PIP/WLC - SEND PICK LIST MENU ENTRY POIN T; 29 Nov 2018 12:1 8 PM ; 29 Nov 2018 12:51 | |
728 | PM | |
729 | "RTN","PSG BOX5",2,0) | |
730 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;16 DEC 97;Bui ld 8 | |
731 | "RTN","PSG BOX5",3,0) | |
732 | ;Cloned f rom PSGTAP with patc h 10 and m odified as follows: | |
733 | "RTN","PSG BOX5",4,0) | |
734 | ;- Send t o a differ ent interf ace routin e dependin g upon dev ice select ed | |
735 | "RTN","PSG BOX5",5,0) | |
736 | ;- Select ion of dif ferent dev ice if sen t previous ly | |
737 | "RTN","PSG BOX5",6,0) | |
738 | ;PSGTAP ; BIR/CML3-S END PICK L IST TO TRA VENOL'S AT C 212 (DRI VER) ; 05 May 98 / 1 0:25 AM | |
739 | "RTN","PSG BOX5",7,0) | |
740 | ;;5.0; IN PATIENT ME DICATIONS ;**10**;16 DEC 97 | |
741 | "RTN","PSG BOX5",8,0) | |
742 | ; | |
743 | "RTN","PSG BOX5",9,0) | |
744 | EN ; | |
745 | "RTN","PSG BOX5",10,0 ) | |
746 | D ENCV^PS GSETU I $D (XQUIT) Q | |
747 | "RTN","PSG BOX5",11,0 ) | |
748 | ; | |
749 | "RTN","PSG BOX5",12,0 ) | |
750 | ASK ; | |
751 | "RTN","PSG BOX5",13,0 ) | |
752 | R !!,"Sel ect WARD G ROUP or PI CK LIST: " ,X:DTIME W :'$T $C(7) S:'$T X=" ^" G:"^"[X OUT I X=+ X D NL | |
753 | G:'$D(X) A SK I Y D E N1 G ASK | |
754 | "RTN","PSG BOX5",14,0 ) | |
755 | I X?1."?" W !!?2,"S elect a Wa rd Group f or which a pick list has been run that y ou wish to send",!," to the | |
756 | ATC.",!?2, "You may a lso direct ly select a Pick Lis t by numbe r, which p rints in t he upper", !,"left co rner of | |
757 | each pick list." G A SK | |
758 | "RTN","PSG BOX5",15,0 ) | |
759 | K DIC S D IC="^PS(57 .5,",DIC(0 )="EIMQZ", DIC("S")=" I $P(^(0), ""^"",2)=" "P""" D ^D IC K DIC I Y S | |
760 | PSGPLWG=+Y ,PSGPLGF=" A" D AD I $D(X) F D ^PSGPLG Q :'PSGPLG D EN1 Q:OK | |
761 | "RTN","PSG BOX5",16,0 ) | |
762 | G ASK | |
763 | "RTN","PSG BOX5",17,0 ) | |
764 | ; | |
765 | "RTN","PSG BOX5",18,0 ) | |
766 | OUT ; | |
767 | "RTN","PSG BOX5",19,0 ) | |
768 | D ENKV^PS GSETU K | |
769 | A,BLKS,C,D ,DAT,DIC,G ,I1,I2,ND, O,P,PID,PL ,PN,PND,PS GIOP,PSGPL G,PSGPLGF, PSGPLWG,PS GPLWGN,PSG S | |
770 | PD,Q,QUIT, R,S,ST,T,T M,W | |
771 | "RTN","PSG BOX5",20,0 ) | |
772 | Q | |
773 | "RTN","PSG BOX5",21,0 ) | |
774 | ; | |
775 | "RTN","PSG BOX5",22,0 ) | |
776 | EN1 ; | |
777 | "RTN","PSG BOX5",23,0 ) | |
778 | S OK=0 I '$$LOCK^PS GPLUTL(PSG PLG,"PSGTA P") W $C(7 ),!!,"This PICK LIST is curren tly being accessed | |
779 | by another task." Q | |
780 | "RTN","PSG BOX5",24,0 ) | |
781 | I $P($G(^ PS(53.5,PS GPLG,0))," ^",12) S P SGID=$P(^( 0),"^",12) ,PSGOD=$$E NDTC^PSGMI (PSGID) D I Y<1 | |
782 | D EN2 Q | |
783 | "RTN","PSG BOX5",25,0 ) | |
784 | .;Replace ATC with generic te rm | |
785 | "RTN","PSG BOX5",26,0 ) | |
786 | .;W !! S DIR(0)="Y^ A",DIR("A" )="Pick Li st #"_PSGP LG_" was q ueued to t he ATC for "_PSGOD_" . Send | |
787 | again",DIR ("B")="N" D ^DIR K D IR | |
788 | "RTN","PSG BOX5",27,0 ) | |
789 | .W !! S D IR(0)="Y^A ",DIR("A") ="Pick Lis t #"_PSGPL G_" was qu eued to th e dispensi ng machine for | |
790 | "_PSGOD_". Send aga in",DIR("B ")="N" D ^ DIR K DIR | |
791 | "RTN","PSG BOX5",28,0 ) | |
792 | S X=$G(^P S(53.5,PSG PLG,0)),Y= $O(^(0))=" ",X=$P(X," ^",11)&'$P (X,"^",9), %=1 | |
793 | "RTN","PSG BOX5",29,0 ) | |
794 | I X!Y W $ C(7) F W !!,"THIS P ICK LIST H AS NO",$S( Y:" DATA." ,1:"T RUN TO COMPLET ION."),!," Do you | |
795 | wish to co ntinue" S %=2 D YN^D ICN G:% EN 2 W !!?2," Enter 'YES ' to send this pick list to th e ATC. En ter | |
796 | 'NO' (or ' ^') to not ",!,"send it." | |
797 | "RTN","PSG BOX5",30,0 ) | |
798 | ;Call loc al queuing routine | |
799 | "RTN","PSG BOX5",31,0 ) | |
800 | G:%'=1 EN 2 | |
801 | "RTN","PSG BOX5",32,0 ) | |
802 | D QSFTP | |
803 | "RTN","PSG BOX5",33,0 ) | |
804 | Q | |
805 | "RTN","PSG BOX5",34,0 ) | |
806 | G:%'=1 EN 2 K %ZIS S %ZIS="NQ" ,PSGION=IO N,IOP="`"_ PSGIOP_";2 55" D ^%ZI S I POP S IOP=PSGION D | |
807 | ^%ZIS K IO P W $C(7), !!?10,"THE ATC MACHI NE IS NOT FOUND!" G EN2 | |
808 | "RTN","PSG BOX5",35,0 ) | |
809 | S PSGTAPR =0 I $D(^P S(53.55,PS GPLG,0)),$ P(^(0),"^" ,2),$O(^(1 ,0)) F W !!,"This p ick list h ad been | |
810 | previously started, but did no t run to c ompletion. ",!,"Do yo u want to restart it where it left off" S %=0 D | |
811 | YN^DICN I 1 Q:% D | |
812 | "RTN","PSG BOX5",36,0 ) | |
813 | .W !!?2," Enter 'YES ' to resta rt the pic k list fro m where it previousl y stopped. Enter",! ,"'NO' to start this | |
814 | pick list from the b eginning." W:%Y'?1." ?" " (A r esponse is required. )" | |
815 | "RTN","PSG BOX5",37,0 ) | |
816 | I G:%<0 EN2 S PSGT APR=%=1 | |
817 | "RTN","PSG BOX5",38,0 ) | |
818 | S X=0,X=$ O(^PS(59.7 ,X)),PSGTI R=$S($P($G (^(X,26)), "^",2)=1:" ENQ^PSGTAP 1",1:"ENQ^ PSGTAP0") | |
819 | "RTN","PSG BOX5",39,0 ) | |
820 | K PSGTID, ZTSAVE S Z TDESC="PIC K LIST TO | |
821 | ATC",(ZTSA VE("PSGPLG "),ZTSAVE( "PSGSPD"), ZTSAVE("PS GTAPR"),ZT SAVE("PSGP LWG"))="" D | |
822 | ENTSK^PSGT I | |
823 | "RTN","PSG BOX5",40,0 ) | |
824 | I $D(ZTSK ) W "...SE NT!" S OK= 1 I $D(ZTS K("D"))#2 S %H=ZTSK( "D") D YMD ^%DTC S | |
825 | $P(^PS(53. 5,PSGPLG,0 ),"^",12)= X+% | |
826 | "RTN","PSG BOX5",41,0 ) | |
827 | ; | |
828 | "RTN","PSG BOX5",42,0 ) | |
829 | EN2 ; | |
830 | "RTN","PSG BOX5",43,0 ) | |
831 | I $D(PSGP LG) D UNLO CK^PSGPLUT L(PSGPLG," PSGTAP") | |
832 | "RTN","PSG BOX5",44,0 ) | |
833 | Q | |
834 | "RTN","PSG BOX5",45,0 ) | |
835 | ; | |
836 | "RTN","PSG BOX5",46,0 ) | |
837 | NL ; numer ic look-up | |
838 | "RTN","PSG BOX5",47,0 ) | |
839 | S Y=$G(^P S(53.5,X,0 )) I $S('Y :1,'$P(Y," ^",2):1,1: '$D(^PS(53 .5,"AB",$P (Y,"^",2), +$P(Y,"^", 3),X))) S Y=0 Q | |
840 | "RTN","PSG BOX5",48,0 ) | |
841 | S | |
842 | PSGPLG=X,X =^PS(53.5, PSGPLG,0), Y=$$ENDTC^ PSGMI($P(X ,"^",3)),P SGPLWG=$P( X,"^",2),P SGPLWGN=$S | |
843 | ('$D(^PS(5 7.5,PSGPLW G,0)):PSGP LWG_";PS(5 7.5,",$P(^ (0),"^")]" ":$P(^(0), "^"),1:PSG PLWG_";PS( 57.5,"), | |
844 | PSGOD=$$EN DTC^PSGMI( $P(X,"^",4 )) | |
845 | "RTN","PSG BOX5",49,0 ) | |
846 | W !?5,"Wa rd Group: ",PSGPLWGN ,!?5,Y," thru ",PS GOD | |
847 | "RTN","PSG BOX5",50,0 ) | |
848 | ; | |
849 | "RTN","PSG BOX5",51,0 ) | |
850 | AD ; ATC d evice | |
851 | "RTN","PSG BOX5",52,0 ) | |
852 | S X=$G(^P S(57.5,PSG PLWG,3)) | |
853 | "RTN","PSG BOX5",53,0 ) | |
854 | Q | |
855 | "RTN","PSG BOX5",54,0 ) | |
856 | S X=$G(^P S(57.5,PSG PLWG,3)) I $P(X,"^", 3)="" W $C (7),!!?3," THIS WARD GROUP DOES NOT HAVE AN | |
857 | ATC DEVICE DESIGNATE D FOR IT." K X | |
858 | "RTN","PSG BOX5",55,0 ) | |
859 | S:$D(X) P SGIOP=$P(X ,"^",3),PS GSPD=$P(X, "^",2),Y=1 Q | |
860 | "RTN","PSG BOX5",56,0 ) | |
861 | ; | |
862 | "RTN","PSG BOX5",57,0 ) | |
863 | QSFTP ;Que ue for SFT P | |
864 | "RTN","PSG BOX5",58,0 ) | |
865 | N ZTIO,PS GTAPR,ZTSA VE,ZTDESC, ZTRTN,ZTSK ,PSGBRDEV, IOP | |
866 | "RTN","PSG BOX5",59,0 ) | |
867 | K %ZIS | |
868 | "RTN","PSG BOX5",60,0 ) | |
869 | S ZTIO="" | |
870 | "RTN","PSG BOX5",61,0 ) | |
871 | S PSGBRDE V=+$$FIND1 ^DIC(3.5,, "X","PSGBO X SFTP RES OURCE") | |
872 | "RTN","PSG BOX5",62,0 ) | |
873 | I +PSGBRD EV S ZTIO= "`"_PSGBRD EV | |
874 | "RTN","PSG BOX5",63,0 ) | |
875 | S PSGTAPR =0 | |
876 | "RTN","PSG BOX5",64,0 ) | |
877 | S ZTDESC= "PICK LIST TO SWISSL OG" | |
878 | "RTN","PSG BOX5",65,0 ) | |
879 | S ZTRTN=" ENQ^PSGBOX 6" | |
880 | "RTN","PSG BOX5",66,0 ) | |
881 | S (ZTSAVE ("PSGPLG") ,ZTSAVE("P SGSPD"),ZT SAVE("PSGT APR"),ZTSA VE("PSGPLW G"))="" | |
882 | "RTN","PSG BOX5",67,0 ) | |
883 | D ^%ZTLOA D | |
884 | "RTN","PSG BOX5",68,0 ) | |
885 | I $D(ZTSK ) W "...TA SK "_ZTSK_ " SENT!" S OK=1 I $D (ZTSK("D") )#2 S %H=Z TSK("D") D YMD^%DTC S | |
886 | $P(^PS(53. 5,PSGPLG,0 ),"^",12)= X+% | |
887 | "RTN","PSG BOX5",69,0 ) | |
888 | G EN2 | |
889 | "RTN","PSG BOX6") | |
890 | 0^22^B1974 5461^n/a | |
891 | "RTN","PSG BOX6",1,0) | |
892 | PSGBOX6 ;E PIP/WLC - SEND PICK LIST TO SW ISS LOG ; 29 Nov 201 8 1:06 PM | |
893 | "RTN","PSG BOX6",2,0) | |
894 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;DEC 16,1997;B uild 8 | |
895 | "RTN","PSG BOX6",3,0) | |
896 | S1 ; | |
897 | "RTN","PSG BOX6",4,0) | |
898 | W $C(48) F Q=1:1:75 R *X:$S(Q <15:1,1:5) G:X=49 S1 I X=48 Q | |
899 | "RTN","PSG BOX6",5,0) | |
900 | E S QUIT =1 Q | |
901 | "RTN","PSG BOX6",6,0) | |
902 | W A F Q=1 :1:75 R *X :$S(Q<15:1 ,1:5) G:X= 49 S1 I X= 48 Q | |
903 | "RTN","PSG BOX6",7,0) | |
904 | S:'$T QUI T=1 Q | |
905 | "RTN","PSG BOX6",8,0) | |
906 | ; | |
907 | "RTN","PSG BOX6",9,0) | |
908 | S2 ; | |
909 | "RTN","PSG BOX6",10,0 ) | |
910 | W $C(48) F Q=1:1:75 R X:$S(Q< 15:1,1:5) G:$A(X)=49 S2 I $A(X )=48 Q | |
911 | "RTN","PSG BOX6",11,0 ) | |
912 | E S QUIT =1 Q | |
913 | "RTN","PSG BOX6",12,0 ) | |
914 | W A F Q=1 :1:75 R X: $S(Q<15:1, 1:5) G:$A( X)=49 S2 I $A(X)=48 Q | |
915 | "RTN","PSG BOX6",13,0 ) | |
916 | S:'$T QUI T=1 Q | |
917 | "RTN","PSG BOX6",14,0 ) | |
918 | Q | |
919 | "RTN","PSG BOX6",15,0 ) | |
920 | ; | |
921 | "RTN","PSG BOX6",16,0 ) | |
922 | ENQ ; | |
923 | "RTN","PSG BOX6",17,0 ) | |
924 | N ATCFF,D NUNIT | |
925 | "RTN","PSG BOX6",18,0 ) | |
926 | F Q:$$LO CK^PSGPLUT L(PSGPLG," PSGTAP") | |
927 | "RTN","PSG BOX6",19,0 ) | |
928 | F L +^PS (53.55,PSG PLG):1 Q:$ T | |
929 | "RTN","PSG BOX6",20,0 ) | |
930 | D NOW^%DT C S %=%_"0 0000000000 00",DAT=$E (%,4,5)_$E (%,6,7)_$E (%,2,3)_$E (%,9,10)_$ E(%,11,12) I | |
931 | PSGPLG<0 S QUIT=0 G QUIT | |
932 | "RTN","PSG BOX6",21,0 ) | |
933 | I PSGTAPR S ND=$P($ G(^PS(53.5 5,PSGPLG,0 )),"^",2) I ND,$O(^( 1,0)) G QU IT | |
934 | "RTN","PSG BOX6",22,0 ) | |
935 | I $D(^PS( 53.55,PSGP LG)) S DIK ="^PS(53.5 5,",DA=PSG PLG D ^DIK | |
936 | "RTN","PSG BOX6",23,0 ) | |
937 | S (DINUM, X)=PSGPLG, DIC="^PS(5 3.55,",DIC (0)="L" K DD,DO D FI LE^DICN I Y'>0 S QUI T=0 G QUIT | |
938 | "RTN","PSG BOX6",24,0 ) | |
939 | S ^PS(53. 55,PSGPLG, 1,0)="^53. 56A",BLKS= " | |
940 | ",G=PSGPLG ,(DD,PSGOR D,PSJJORD, ND,P,R,S,T ,W,O,D)="" | |
941 | "RTN","PSG BOX6",25,0 ) | |
942 | S ATCFF=+ $P($G(^PS( 59.7,1,26) ),"^",7) | |
943 | "RTN","PSG BOX6",26,0 ) | |
944 | F S T=$O (^PS(53.5, "AC",G,T)) Q:T="" F S W=$O(^ PS(53.5,"A C",G,T,W)) Q:W="" F S | |
945 | R=$O(^PS(5 3.5,"AC",G ,T,W,R)) Q :R="" F S P=$O(^PS (53.5,"AC" ,G,T,W,R,P )) Q:P="" D ; | |
946 | "RTN","PSG BOX6",27,0 ) | |
947 | .S (DFN,P SGP)=+$P(P ,"^",2) D PID^VADPT S | |
948 | PND=$S($D( ^DPT(PSGP, 0)):^(0),1 :0),PL=$E( $S($D(^(.1 )):^(.1),1 :"N/F")_BL KS,1,12),P N=$E($P(PN D,"^")_B | |
949 | LKS,1,20), PID=$E(VA( "PID")_BLK S,1,12),S= "A" | |
950 | "RTN","PSG BOX6",28,0 ) | |
951 | .F S S=$ O(^PS(53.5 ,"AC",G,T, W,R,P,S)) Q:"Z"[S F S PSGORD =$O(^PS(53 .5,"AC",G, T,W,R,P,S, PSGORD)) | |
952 | Q:PSGORD=" " S O=$P( PSGORD,"^" ,2) D | |
953 | "RTN","PSG BOX6",29,0 ) | |
954 | ..S ON=+$ G(^PS(53.5 ,G,1,PSGP, 1,O,0)) F S DD=$O(^ PS(53.5,"A C",G,T,W,R ,P,S,PSGOR D,DD)) Q:D D="" S | |
955 | D=+$P(DD," ^",2),C=$G (^PS(53.5, G,1,PSGP,1 ,O,1,D,0)) ,D=$P(C,"^ "),C=$S($P (C,"^",3)] "":+$P(C," ^",3),1:$P ( | |
956 | C,"^",2)) I C>0,C?1. 3N D ; | |
957 | "RTN","PSG BOX6",30,0 ) | |
958 | ...S DN=$ G(^PS(55,P SGP,5,ON,1 ,D,0)) | |
959 | "RTN","PSG BOX6",31,0 ) | |
960 | ...S DNUN IT=$P(DN," ^",2) I DN UNIT#1,ATC FF,+DNUNIT S DNUNIT= (DNUNIT\1) +1 | |
961 | "RTN","PSG BOX6",32,0 ) | |
962 | ...;I DN, '(DNUNIT#1 ),$S('$P(D N,"^",3):1 ,1:DT<$P(D N,"^",3)) S A=$P($G( ^PSDRUG(+D N,8.5)),"^ ",2) I | |
963 | A]"",$D(^( 212,"AC",P SGPLWG)) D ;origina l | |
964 | "RTN","PSG BOX6",33,0 ) | |
965 | ...I DN,' (DNUNIT#1) ,$S('$P(DN ,"^",3):1, 1:DT<$P(DN ,"^",3)) S A=$P($G(^ PSDRUG(+DN ,8.5)),"^" ,2) I A]"" | |
966 | D ;new | |
967 | "RTN","PSG BOX6",34,0 ) | |
968 | ....S A=$ E(A_BLKS,1 ,15) I C>9 9 F ND=ND+ 1:1 S ^PS( 53.55,PSGP LG,1,ND,0) =PN_PID_PL _"BAT"_A_" 1 | |
969 | ^099",C=C- 99 Q:C<100 | |
970 | "RTN","PSG BOX6",35,0 ) | |
971 | ....Q:C<1 S:$L(C)< 3 C=$E("00 0",1,3-$L( C))_C S | |
972 | ND=ND+1,^P S(53.55,PS GPLG,1,ND, 0)=PN_PID_ PL_"BAT"_A _"1 ^"_C Q ;origina l | |
973 | "RTN","PSG BOX6",36,0 ) | |
974 | N PSGBTXE R,PSGBGCNT | |
975 | "RTN","PSG BOX6",37,0 ) | |
976 | D BINIT^P SGBOX7(.PS GBGCNT) | |
977 | "RTN","PSG BOX6",38,0 ) | |
978 | S T="" | |
979 | "RTN","PSG BOX6",39,0 ) | |
980 | F S T=$O (^PS(53.5, "AC",G,T)) Q:T="" S W="" F S W=$O(^PS( 53.5,"AC", G,T,W)) Q: W="" S R= "" F S | |
981 | R=$O(^PS(5 3.5,"AC",G ,T,W,R)) Q :R="" S P ="" F S P =$O(^PS(53 .5,"AC",G, T,W,R,P)) Q:P="" D ; | |
982 | "RTN","PSG BOX6",40,0 ) | |
983 | .S (DFN,P SGP)=+$P(P ,"^",2) | |
984 | "RTN","PSG BOX6",41,0 ) | |
985 | .S S="" | |
986 | "RTN","PSG BOX6",42,0 ) | |
987 | .F S S=$ O(^PS(53.5 ,"AC",G,T, W,R,P,S)) Q:"Z"[S S PSGORD="" F S | |
988 | PSGORD=$O( ^PS(53.5," AC",G,T,W, R,P,S,PSGO RD)) Q:PSG ORD="" S O=$P(PSGOR D,"^",2) D | |
989 | "RTN","PSG BOX6",43,0 ) | |
990 | ..S ON=+$ G(^PS(53.5 ,G,1,PSGP, 1,O,0)) | |
991 | "RTN","PSG BOX6",44,0 ) | |
992 | ..S DD="" ;R1/APC Need to re set DD or else will skip order s with sam e OI | |
993 | "RTN","PSG BOX6",45,0 ) | |
994 | ..K PSGBD DRG | |
995 | "RTN","PSG BOX6",46,0 ) | |
996 | ..;Only d o the firs t non-zero dispense drug since PSGBOX7 w ill build labels for all dispe nse drugs in the | |
997 | order | |
998 | "RTN","PSG BOX6",47,0 ) | |
999 | ..F S DD =$O(^PS(53 .5,"AC",G, T,W,R,P,S, PSGORD,DD) ) Q:DD="" S | |
1000 | D=+$P(DD," ^",2),C=$G (^PS(53.5, G,1,PSGP,1 ,O,1,D,0)) ,D=$P(C,"^ "),C=$S($P (C,"^",3)] "":+$P(C," ^",3),1:$P ( | |
1001 | C,"^",2)) I C>0,C?1. 3N D ; | |
1002 | "RTN","PSG BOX6",48,0 ) | |
1003 | ...;D BLD ORD^PSGBOX 7(.PSGBGCN T,DFN,ON," CART",+C_U _$P(D,U,1) ) | |
1004 | "RTN","PSG BOX6",49,0 ) | |
1005 | ...S DN=$ G(^PS(55,P SGP,5,ON,1 ,D,0)) | |
1006 | "RTN","PSG BOX6",50,0 ) | |
1007 | ...Q:'$P( DN,U,1) | |
1008 | "RTN","PSG BOX6",51,0 ) | |
1009 | ...Q:$S(' $P(DN,"^", 3):0,1:$P( DN,"^",3)' >DT) | |
1010 | "RTN","PSG BOX6",52,0 ) | |
1011 | ...S PSGB DDRG($P(DN ,U,1))=C ; W !,P,"~", PSGORD,"~" ,DD,"~",C, "*" | |
1012 | "RTN","PSG BOX6",53,0 ) | |
1013 | ..I $O(PS GBDDRG(0)) D BLDORD^ PSGBOX7(.P SGBGCNT,DF N,ON,"CART ",$NA(PSGB DDRG)) | |
1014 | "RTN","PSG BOX6",54,0 ) | |
1015 | D BCLOSE^ PSGBOX7(.P SGBGCNT) | |
1016 | "RTN","PSG BOX6",55,0 ) | |
1017 | S PSGBTXE R=$$BSEND^ PSGBOX7("C ART") | |
1018 | "RTN","PSG BOX6",56,0 ) | |
1019 | D BCLEAN^ PSGBOX7 | |
1020 | "RTN","PSG BOX6",57,0 ) | |
1021 | I +PSGBTX ER D MMERR PL^PSGBOX7 (PSGPLG,PS GPLWG,PSGB TXER) | |
1022 | "RTN","PSG BOX6",58,0 ) | |
1023 | S QUIT=$O (^PS(53.55 ,PSGPLG,1, 0)) G:'QUI T QUIT S ^ (0)="^53.5 6A^"_ND_"^ "_ND,ND=0 | |
1024 | "RTN","PSG BOX6",59,0 ) | |
1025 | ; | |
1026 | "RTN","PSG BOX6",60,0 ) | |
1027 | QUIT ; | |
1028 | "RTN","PSG BOX6",61,0 ) | |
1029 | I 'QUIT S DIK="^PS( 53.55,",DA =PSGPLG D ^DIK | |
1030 | "RTN","PSG BOX6",62,0 ) | |
1031 | L -^PS(53 .55,PSGPLG ) | |
1032 | "RTN","PSG BOX6",63,0 ) | |
1033 | D UNLOCK^ PSGPLUTL(P SGPLG,"PSG TAP") D ^% ZISC Q | |
1034 | "RTN","PSG BOX7") | |
1035 | 0^23^B2169 72736^n/a | |
1036 | "RTN","PSG BOX7",1,0) | |
1037 | PSGBOX7 ;E PIP/WLC - GATHER ORD ER PARTS, FORMAT XML ; 29 Nov 2018 1:06 PM | |
1038 | "RTN","PSG BOX7",2,0) | |
1039 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;DEC 16, 1997; Build 8 | |
1040 | "RTN","PSG BOX7",3,0) | |
1041 | ; IA# Usage Component | |
1042 | "RTN","PSG BOX7",4,0) | |
1043 | ; ------- ---------- ---------- | |
1044 | "RTN","PSG BOX7",5,0) | |
1045 | ; 4826 Supported PSS431^PS S55, PSS43 2^PSS55 | |
1046 | "RTN","PSG BOX7",6,0) | |
1047 | ; 10061 Supported DEM^VADPT , IN5^VADP T | |
1048 | "RTN","PSG BOX7",7,0) | |
1049 | ; 10070 Supported XMD | |
1050 | "RTN","PSG BOX7",8,0) | |
1051 | ; Unsuppp orted DRGD ISP^PSJLMU T1 | |
1052 | "RTN","PSG BOX7",9,0) | |
1053 | ; Unsuppo rted $$ENM RN^PSGMI | |
1054 | "RTN","PSG BOX7",10,0 ) | |
1055 | ; | |
1056 | "RTN","PSG BOX7",11,0 ) | |
1057 | ENQFD ;Fir st dose or ders queue d entry po int | |
1058 | "RTN","PSG BOX7",12,0 ) | |
1059 | N PSGBERR N,PSGBGCNT | |
1060 | "RTN","PSG BOX7",13,0 ) | |
1061 | Q:'$G(PSG BDFN) | |
1062 | "RTN","PSG BOX7",14,0 ) | |
1063 | Q:'$G(PSG BORDN) | |
1064 | "RTN","PSG BOX7",15,0 ) | |
1065 | D BINIT(. PSGBGCNT) | |
1066 | "RTN","PSG BOX7",16,0 ) | |
1067 | D BLDORD( .PSGBGCNT, PSGBDFN,PS GBORDN,"FD ","") | |
1068 | "RTN","PSG BOX7",17,0 ) | |
1069 | D BCLOSE( .PSGBGCNT) | |
1070 | "RTN","PSG BOX7",18,0 ) | |
1071 | S PSGBERR N=$$BSEND( "FD") | |
1072 | "RTN","PSG BOX7",19,0 ) | |
1073 | D BCLEAN | |
1074 | "RTN","PSG BOX7",20,0 ) | |
1075 | I PSGBERR N D MMERRF D(PSGBDFN, PSGBORDN,P SGBERRN) | |
1076 | "RTN","PSG BOX7",21,0 ) | |
1077 | Q | |
1078 | "RTN","PSG BOX7",22,0 ) | |
1079 | ; | |
1080 | "RTN","PSG BOX7",23,0 ) | |
1081 | ENEUD(PSGB DFN,PSGBOR DN,PSGBEUD ) ;Extra u nits dispe nsed, call ed from PS GBOX8 | |
1082 | "RTN","PSG BOX7",24,0 ) | |
1083 | N ZTIO,ZT SAVE,ZTDES C,ZTRTN,ZT SK,PSGBII, PSGBRDEV,I OP | |
1084 | "RTN","PSG BOX7",25,0 ) | |
1085 | Q:PSGBORD N'["U" ;o nly unit d ose | |
1086 | "RTN","PSG BOX7",26,0 ) | |
1087 | S PSGBORD N=+PSGBORD N | |
1088 | "RTN","PSG BOX7",27,0 ) | |
1089 | K %ZIS | |
1090 | "RTN","PSG BOX7",28,0 ) | |
1091 | S ZTIO="" | |
1092 | "RTN","PSG BOX7",29,0 ) | |
1093 | S PSGBRDE V=+$$FIND1 ^DIC(3.5,, "X","PSGBO X SFTP RES OURCE") | |
1094 | "RTN","PSG BOX7",30,0 ) | |
1095 | I +PSGBRD EV S ZTIO= "`"_PSGBRD EV | |
1096 | "RTN","PSG BOX7",31,0 ) | |
1097 | S ZTDESC= "EXTRA UNI TS DISPENS ED TO SWIS SLOG" | |
1098 | "RTN","PSG BOX7",32,0 ) | |
1099 | S ZTRTN=" ENQEUD^PSG BOX7" | |
1100 | "RTN","PSG BOX7",33,0 ) | |
1101 | F PSGBII= "PSGBDFN", "PSGBORDN" ,"PSGBEUD" S ZTSAVE( PSGBII)="" | |
1102 | "RTN","PSG BOX7",34,0 ) | |
1103 | D ^%ZTLOA D | |
1104 | "RTN","PSG BOX7",35,0 ) | |
1105 | I '$D(ZTS K) W "...E xtra units task FAIL ED!" | |
1106 | "RTN","PSG BOX7",36,0 ) | |
1107 | Q | |
1108 | "RTN","PSG BOX7",37,0 ) | |
1109 | ; | |
1110 | "RTN","PSG BOX7",38,0 ) | |
1111 | ENQEUD ;Qu eued entry point for extra uni ts dispens ed | |
1112 | "RTN","PSG BOX7",39,0 ) | |
1113 | N PSGBERR N,PSGBGCNT | |
1114 | "RTN","PSG BOX7",40,0 ) | |
1115 | Q:'$G(PSG BDFN) | |
1116 | "RTN","PSG BOX7",41,0 ) | |
1117 | Q:'$G(PSG BORDN) | |
1118 | "RTN","PSG BOX7",42,0 ) | |
1119 | Q:'$G(PSG BEUD) | |
1120 | "RTN","PSG BOX7",43,0 ) | |
1121 | D BINIT(. PSGBGCNT) | |
1122 | "RTN","PSG BOX7",44,0 ) | |
1123 | D BLDORD( .PSGBGCNT, PSGBDFN,PS GBORDN,"EU D",PSGBEUD ) | |
1124 | "RTN","PSG BOX7",45,0 ) | |
1125 | D BCLOSE( .PSGBGCNT) | |
1126 | "RTN","PSG BOX7",46,0 ) | |
1127 | S PSGBERR N=$$BSEND( "EUD") | |
1128 | "RTN","PSG BOX7",47,0 ) | |
1129 | D BCLEAN | |
1130 | "RTN","PSG BOX7",48,0 ) | |
1131 | I PSGBERR N D MMERRF D(PSGBDFN, PSGBORDN,P SGBERRN) | |
1132 | "RTN","PSG BOX7",49,0 ) | |
1133 | Q | |
1134 | "RTN","PSG BOX7",50,0 ) | |
1135 | ; | |
1136 | "RTN","PSG BOX7",51,0 ) | |
1137 | BINIT(PSGB GCNT) ;Ini tialize ba tch interf ace | |
1138 | "RTN","PSG BOX7",52,0 ) | |
1139 | S PSGBGCN T=0 | |
1140 | "RTN","PSG BOX7",53,0 ) | |
1141 | K ^TMP("P SGBOX7",$J ,"TRANS") | |
1142 | "RTN","PSG BOX7",54,0 ) | |
1143 | D SETNODE (.PSGBGCNT ,"<batch>" ) | |
1144 | "RTN","PSG BOX7",55,0 ) | |
1145 | Q | |
1146 | "RTN","PSG BOX7",56,0 ) | |
1147 | ; | |
1148 | "RTN","PSG BOX7",57,0 ) | |
1149 | BCLOSE(PSG BGCNT) ;Cl ose a batc h | |
1150 | "RTN","PSG BOX7",58,0 ) | |
1151 | D SETNODE (.PSGBGCNT ,"</batch> ") | |
1152 | "RTN","PSG BOX7",59,0 ) | |
1153 | Q | |
1154 | "RTN","PSG BOX7",60,0 ) | |
1155 | ; | |
1156 | "RTN","PSG BOX7",61,0 ) | |
1157 | BSEND(PSGB URGY) ;Sen d batch | |
1158 | "RTN","PSG BOX7",62,0 ) | |
1159 | N PSGBNOW ,PSGBPREF, PSGBX,PSGB FILE,PSGBD ELA,PSGBSF TP,PSGBEDI R,PSGBFNUM ,PSGBSAVF | |
1160 | "RTN","PSG BOX7",63,0 ) | |
1161 | ;Don't se nd empty b atches | |
1162 | "RTN","PSG BOX7",64,0 ) | |
1163 | I $O(^TMP ("PSGBOX7" ,$J,"TRANS ","A"),-1) <3 Q 0 | |
1164 | "RTN","PSG BOX7",65,0 ) | |
1165 | S PSGBFNU M=$$FILECT R | |
1166 | "RTN","PSG BOX7",66,0 ) | |
1167 | S PSGBFNU M=$E("0000 0"_PSGBFNU M,$L(PSGBF NUM),6+$L( PSGBFNUM)) | |
1168 | "RTN","PSG BOX7",67,0 ) | |
1169 | S PSGBNOW =$P($H,"," ,1) | |
1170 | "RTN","PSG BOX7",68,0 ) | |
1171 | S PSGBNOW =+$E(DT,4) _$E(DT,5)_ $E(DT,6)_$ E(DT,7) | |
1172 | "RTN","PSG BOX7",69,0 ) | |
1173 | S | |
1174 | PSGBPREF=$ S(PSGBURGY ="CART":"C ART",PSGBU RGY="FD":" FDOS",PSGB URGY="EUD" :"FDOS",1: "UNKN | |
1175 | ") | |
1176 | "RTN","PSG BOX7",70,0 ) | |
1177 | S PSGBFIL E=PSGBPREF _PSGBNOW_P SGBFNUM_$J _".TXT" | |
1178 | "RTN","PSG BOX7",71,0 ) | |
1179 | S PSGBEDI R=$$PWD^%Z ISH | |
1180 | "RTN","PSG BOX7",72,0 ) | |
1181 | S PSGBX=$ $GTF^%ZISH ($NA(^TMP( "PSGBOX7", $J,"TRANS" ,1)),4,PSG BEDIR,PSGB FILE) | |
1182 | "RTN","PSG BOX7",73,0 ) | |
1183 | I 'PSGBX Q "70;Crea tion of tr ansmission file fail ed" | |
1184 | "RTN","PSG BOX7",74,0 ) | |
1185 | S PSGBSFT P=$$SFTP^P SGBOX9(PSG BFILE) | |
1186 | "RTN","PSG BOX7",75,0 ) | |
1187 | I +PSGBSF TP D TQADD ^PSGBOX9(P SGBFILE) | |
1188 | "RTN","PSG BOX7",76,0 ) | |
1189 | S PSGBSAV F=$$GET^XP AR("SYS"," PSG BOX SF TP SAVE FI LE",1,"I") | |
1190 | "RTN","PSG BOX7",77,0 ) | |
1191 | I 'PSGBSF TP,'PSGBSA VF D | |
1192 | "RTN","PSG BOX7",78,0 ) | |
1193 | .K PSGBDE LA | |
1194 | "RTN","PSG BOX7",79,0 ) | |
1195 | .S PSGBDE LA(PSGBFIL E)="" | |
1196 | "RTN","PSG BOX7",80,0 ) | |
1197 | .S PSGBX= $$DEL^%ZIS H(PSGBEDIR ,$NA(PSGBD ELA)) | |
1198 | "RTN","PSG BOX7",81,0 ) | |
1199 | Q PSGBSFT P | |
1200 | "RTN","PSG BOX7",82,0 ) | |
1201 | ; | |
1202 | "RTN","PSG BOX7",83,0 ) | |
1203 | FILECTR() ;Get count er | |
1204 | "RTN","PSG BOX7",84,0 ) | |
1205 | N PSGBCT, PSGBENDT | |
1206 | "RTN","PSG BOX7",85,0 ) | |
1207 | L +^XTMP( "PSGBOX7_F ILECOUNTER ",0):5 | |
1208 | "RTN","PSG BOX7",86,0 ) | |
1209 | I '$T Q $ P($H,",",2 ) | |
1210 | "RTN","PSG BOX7",87,0 ) | |
1211 | S PSGBEND T=$P($G(^X TMP("PSGBO X7_FILECOU NTER",0)), U,1) | |
1212 | "RTN","PSG BOX7",88,0 ) | |
1213 | ;Reset co unter ever y day | |
1214 | "RTN","PSG BOX7",89,0 ) | |
1215 | I PSGBEND T'>DT D | |
1216 | "RTN","PSG BOX7",90,0 ) | |
1217 | .S ^XTMP( "PSGBOX7_F ILECOUNTER ",0)=$$FMA DD^XLFDT(D T,1)_U_DT | |
1218 | "RTN","PSG BOX7",91,0 ) | |
1219 | .S ^XTMP( "PSGBOX7_F ILECOUNTER ","COUNT") =0 | |
1220 | "RTN","PSG BOX7",92,0 ) | |
1221 | S PSGBCT= $G(^XTMP(" PSGBOX7_FI LECOUNTER" ,"COUNT")) | |
1222 | "RTN","PSG BOX7",93,0 ) | |
1223 | S PSGBCT= PSGBCT+1 | |
1224 | "RTN","PSG BOX7",94,0 ) | |
1225 | S ^XTMP(" PSGBOX7_FI LECOUNTER" ,"COUNT")= PSGBCT | |
1226 | "RTN","PSG BOX7",95,0 ) | |
1227 | L -^XTMP( "PSGBOX7_F ILECOUNTER ",0) | |
1228 | "RTN","PSG BOX7",96,0 ) | |
1229 | Q PSGBCT | |
1230 | "RTN","PSG BOX7",97,0 ) | |
1231 | ; | |
1232 | "RTN","PSG BOX7",98,0 ) | |
1233 | BCLEAN ;Cl ean up bat ch interfa ce | |
1234 | "RTN","PSG BOX7",99,0 ) | |
1235 | ;K ^TMP(" PSGBOX7",$ J,"TRANS") | |
1236 | "RTN","PSG BOX7",100, 0) | |
1237 | Q | |
1238 | "RTN","PSG BOX7",101, 0) | |
1239 | ; | |
1240 | "RTN","PSG BOX7",102, 0) | |
1241 | BLDORD(PSG BGCNT,PSGB DFN,PSGBOR DN,PSGBURG Y,PSGBPLUN ) ;Build o ne order's XML messa ge | |
1242 | "RTN","PSG BOX7",103, 0) | |
1243 | N PSGBII, PSGBCTLB,P SGBRXFO | |
1244 | "RTN","PSG BOX7",104, 0) | |
1245 | K PSGBRXF O | |
1246 | "RTN","PSG BOX7",105, 0) | |
1247 | S PSGBCTL B=0 | |
1248 | "RTN","PSG BOX7",106, 0) | |
1249 | I PSGBURG Y="CART" D RXINFO($N A(PSGBRXFO ),PSGBDFN, PSGBORDN,P SGBURGY,$N A(@PSGBPLU N)) | |
1250 | "RTN","PSG BOX7",107, 0) | |
1251 | I PSGBURG Y'="CART" D RXINFO($ NA(PSGBRXF O),PSGBDFN ,PSGBORDN, PSGBURGY) | |
1252 | "RTN","PSG BOX7",108, 0) | |
1253 | Q:$$RXSKI P($NA(PSGB RXFO(PSGBO RDN)),PSGB URGY)>9 | |
1254 | "RTN","PSG BOX7",109, 0) | |
1255 | S PSGBII= 0 | |
1256 | "RTN","PSG BOX7",110, 0) | |
1257 | F S PSGB II=$O(PSGB RXFO(PSGBO RDN,"DDRG" ,PSGBII)) Q:'PSGBII D | |
1258 | "RTN","PSG BOX7",111, 0) | |
1259 | .I +PSGBR XFO(PSGBOR DN,"DDIA", PSGBII),DT >PSGBRXFO( "DDIA",PSG BII) D Q ;No inact ive | |
1260 | "RTN","PSG BOX7",112, 0) | |
1261 | ..S PSGBR XFO(PSGBOR DN,"DDCT") =PSGBRXFO( PSGBORDN," DDCT")-1 | |
1262 | "RTN","PSG BOX7",113, 0) | |
1263 | .I +$$ISC S(PSGBRXFO (PSGBORDN, "DDSH",PSG BII)) D Q ;No cont rolled sub stances | |
1264 | "RTN","PSG BOX7",114, 0) | |
1265 | ..S PSGBR XFO(PSGBOR DN,"DDCT") =PSGBRXFO( PSGBORDN," DDCT")-1 | |
1266 | "RTN","PSG BOX7",115, 0) | |
1267 | .S PSGBCT LB=PSGBCTL B+1 | |
1268 | "RTN","PSG BOX7",116, 0) | |
1269 | .D BLDHEA D(.PSGBGCN T,PSGBCTLB ,PSGBURGY, PSGBII) | |
1270 | "RTN","PSG BOX7",117, 0) | |
1271 | .D BLDDIS P(.PSGBGCN T,PSGBII,P SGBURGY) | |
1272 | "RTN","PSG BOX7",118, 0) | |
1273 | .D SETNOD E(.PSGBGCN T,"</order info>",,,1 ) | |
1274 | "RTN","PSG BOX7",119, 0) | |
1275 | Q | |
1276 | "RTN","PSG BOX7",120, 0) | |
1277 | ; | |
1278 | "RTN","PSG BOX7",121, 0) | |
1279 | BLDHEAD(PS GBGCNT,PSG BLBNU,PSGB URGY,PSGBD DRGI) ;Bui ld everyth ing but di spense dru g | |
1280 | "RTN","PSG BOX7",122, 0) | |
1281 | N PSGBII, PSGBTMPX,P SGBLBNM | |
1282 | "RTN","PSG BOX7",123, 0) | |
1283 | D SETNODE (.PSGBGCNT ,"<orderin fo>",,,1) | |
1284 | "RTN","PSG BOX7",124, 0) | |
1285 | ; | |
1286 | "RTN","PSG BOX7",125, 0) | |
1287 | D SETNODE (.PSGBGCNT ,"<patient >",,,2) | |
1288 | "RTN","PSG BOX7",126, 0) | |
1289 | D SETNODE (.PSGBGCNT ,"<name>", $P(PSGBRXF O(PSGBORDN ,"PATN"),U ,2),"</nam e>",3) | |
1290 | "RTN","PSG BOX7",127, 0) | |
1291 | D SETNODE (.PSGBGCNT ,"<ssn>",$ P(PSGBRXFO (PSGBORDN, "PID"),U,1 ),"</ssn>" ,3) | |
1292 | "RTN","PSG BOX7",128, 0) | |
1293 | D | |
1294 | SETNODE(.P SGBGCNT,"< last4>",$E ($P(PSGBRX FO(PSGBORD N,"PATN"), U,2),1)_$P ($P(PSGBRX FO(PSGBO | |
1295 | RDN,"PID") ,U,2),"-", 3),"</last 4>",3) | |
1296 | "RTN","PSG BOX7",129, 0) | |
1297 | D SETNODE (.PSGBGCNT ,"</patien t>",,,2) | |
1298 | "RTN","PSG BOX7",130, 0) | |
1299 | ; | |
1300 | "RTN","PSG BOX7",131, 0) | |
1301 | D SETNODE (.PSGBGCNT ,"<locatio n>",,,2) | |
1302 | "RTN","PSG BOX7",132, 0) | |
1303 | D SETNODE (.PSGBGCNT ,"<ward>", $P(PSGBRXF O(PSGBORDN ,"WGRP"),U ,2),"</war d>",3) | |
1304 | "RTN","PSG BOX7",133, 0) | |
1305 | D SETNODE (.PSGBGCNT ,"<roombed >",$P(PSGB RXFO(PSGBO RDN,"RMBD" ),U,2),"</ roombed>", 3) | |
1306 | "RTN","PSG BOX7",134, 0) | |
1307 | D SETNODE (.PSGBGCNT ,"</locati on>",,,2) | |
1308 | "RTN","PSG BOX7",135, 0) | |
1309 | ; | |
1310 | "RTN","PSG BOX7",136, 0) | |
1311 | D SETNODE (.PSGBGCNT ,"<ordernu mber>",PSG BRXFO(PSGB ORDN,"ORDN "),"</orde rnumber>", 2) | |
1312 | "RTN","PSG BOX7",137, 0) | |
1313 | ; | |
1314 | "RTN","PSG BOX7",138, 0) | |
1315 | D SETNODE (.PSGBGCNT ,"<dosage> ",PSGBRXFO (PSGBORDN, "DOSE"),"< /dosage>", 2) | |
1316 | "RTN","PSG BOX7",139, 0) | |
1317 | S PSGBTMP X=$$ENMRN^ PSGMI($P(P SGBRXFO(PS GBORDN,"RO UT"),U,1)) | |
1318 | "RTN","PSG BOX7",140, 0) | |
1319 | D SETNODE (.PSGBGCNT ,"<route>" ,PSGBTMPX, "</route>" ,2) | |
1320 | "RTN","PSG BOX7",141, 0) | |
1321 | D SETNODE (.PSGBGCNT ,"<schedul e>",$P(PSG BRXFO(PSGB ORDN,"SCH" ),U,1),"</ schedule>" ,2) | |
1322 | "RTN","PSG BOX7",142, 0) | |
1323 | ; | |
1324 | "RTN","PSG BOX7",143, 0) | |
1325 | D | |
1326 | SETNODE(.P SGBGCNT,"< schedulety pe>",$P(PS GBRXFO(PSG BORDN,"SCH T"),U,1)," </schedule type>",2) | |
1327 | "RTN","PSG BOX7",144, 0) | |
1328 | D SETNODE (.PSGBGCNT ,"<adminti me>",PSGBR XFO(PSGBOR DN,"ADTM") ,"</admint ime>",2) | |
1329 | "RTN","PSG BOX7",145, 0) | |
1330 | S PSGBTMP X=$$DTC($P (PSGBRXFO( PSGBORDN," DTBG"),U,1 ),2) | |
1331 | "RTN","PSG BOX7",146, 0) | |
1332 | D SETNODE (.PSGBGCNT ,"<startti me>",PSGBT MPX,"</sta rttime>",2 ) | |
1333 | "RTN","PSG BOX7",147, 0) | |
1334 | S PSGBTMP X=$$DTC($P (PSGBRXFO( PSGBORDN," DTED"),U,1 ),2) | |
1335 | "RTN","PSG BOX7",148, 0) | |
1336 | D SETNODE (.PSGBGCNT ,"<stoptim e>",PSGBTM PX,"</stop time>",2) | |
1337 | "RTN","PSG BOX7",149, 0) | |
1338 | S PSGBII= 0 | |
1339 | "RTN","PSG BOX7",150, 0) | |
1340 | F S PSGB II=$O(PSGB RXFO(PSGBO RDN,"SIG", PSGBII)) Q :'PSGBII D | |
1341 | "RTN","PSG BOX7",151, 0) | |
1342 | .D SETNOD E(.PSGBGCN T,"<sig>", PSGBRXFO(P SGBORDN,"S IG",PSGBII ),"</sig>" ,2) | |
1343 | "RTN","PSG BOX7",152, 0) | |
1344 | D SETNODE (.PSGBGCNT ,"<priorit y>",PSGBRX FO(PSGBORD N,"PRIO"), "</priorit y>",2) | |
1345 | "RTN","PSG BOX7",153, 0) | |
1346 | D | |
1347 | SETNODE(.P SGBGCNT,"< urgency>", $S(PSGBURG Y="CART":" cart",PSGB URGY="FD": "firstdose ",PSGBURG | |
1348 | Y="EUD":"f irstdose", 1:""),"</u rgency>",2 ) | |
1349 | "RTN","PSG BOX7",154, 0) | |
1350 | ; | |
1351 | "RTN","PSG BOX7",155, 0) | |
1352 | S PSGBII= 0 | |
1353 | "RTN","PSG BOX7",156, 0) | |
1354 | F S PSGB II=$O(PSGB RXFO(PSGBO RDN,"SPIN" ,PSGBII)) Q:'PSGBII D | |
1355 | "RTN","PSG BOX7",157, 0) | |
1356 | .D | |
1357 | SETNODE(.P SGBGCNT,"< specialins tructions> ",PSGBRXFO (PSGBORDN, "SPIN",PSG BII),"</sp ecialinstr uctio | |
1358 | ns>",2) | |
1359 | "RTN","PSG BOX7",158, 0) | |
1360 | ; | |
1361 | "RTN","PSG BOX7",159, 0) | |
1362 | ;Add labe l counter if more th an 1 dispe nse drug | |
1363 | "RTN","PSG BOX7",160, 0) | |
1364 | I PSGBRXF O(PSGBORDN ,"DDCT")>1 D | |
1365 | "RTN","PSG BOX7",161, 0) | |
1366 | .S PSGBLB NM="Label" | |
1367 | "RTN","PSG BOX7",162, 0) | |
1368 | .I $P(PSG BRXFO(PSGB ORDN,"DDRG ",PSGBDDRG I),U,1)["F " S PSGBLB NM="Fract" | |
1369 | "RTN","PSG BOX7",163, 0) | |
1370 | .D SETNOD E(.PSGBGCN T,"<labeli nfo>","~~~ ~ "_PSGBLB NM_" "_PSG BLBNU_" of | |
1371 | "_PSGBRXFO (PSGBORDN, "DDCT")_" ~~~~","</l abelinfo>" ,2) | |
1372 | "RTN","PSG BOX7",164, 0) | |
1373 | ;Add frac tional msg for singl e labels | |
1374 | "RTN","PSG BOX7",165, 0) | |
1375 | I PSGBRXF O(PSGBORDN ,"DDCT")=1 D | |
1376 | "RTN","PSG BOX7",166, 0) | |
1377 | .Q:$P(PSG BRXFO(PSGB ORDN,"DDRG ",PSGBDDRG I),U,1)'[" F" | |
1378 | "RTN","PSG BOX7",167, 0) | |
1379 | .D SETNOD E(.PSGBGCN T,"<labeli nfo>","~~~ ~ Fraction al ~~~~"," </labelinf o>",2) | |
1380 | "RTN","PSG BOX7",168, 0) | |
1381 | Q | |
1382 | "RTN","PSG BOX7",169, 0) | |
1383 | ; | |
1384 | "RTN","PSG BOX7",170, 0) | |
1385 | BLDDISP(PS GBGCNT,PSG BDDRGI,PSG BURGY) ;Bu ild dispen se drug XM L | |
1386 | "RTN","PSG BOX7",171, 0) | |
1387 | D SETNODE (.PSGBGCNT ,"<dispens edrug>",,, 2) | |
1388 | "RTN","PSG BOX7",172, 0) | |
1389 | D SETNODE (.PSGBGCNT ,"<name>", $P(PSGBRXF O(PSGBORDN ,"DDRG",PS GBDDRGI),U ,2),"</nam e>",3) | |
1390 | "RTN","PSG BOX7",173, 0) | |
1391 | I PSGBURG Y="CART" D | |
1392 | "RTN","PSG BOX7",174, 0) | |
1393 | .D SETNOD E(.PSGBGCN T,"<quanti ty>",PSGBR XFO(PSGBOR DN,"DDUN", PSGBDDRGI) ,"</quanti ty>",3) | |
1394 | "RTN","PSG BOX7",175, 0) | |
1395 | I (PSGBUR GY="FD")!( PSGBURGY=" EUD") D | |
1396 | "RTN","PSG BOX7",176, 0) | |
1397 | .D SETNOD E(.PSGBGCN T,"<quanti ty>",PSGBR XFO(PSGBOR DN,"DDPX", PSGBDDRGI) ,"</quanti ty>",3) | |
1398 | "RTN","PSG BOX7",177, 0) | |
1399 | D SETNODE (.PSGBGCNT ,"<ien>",$ P(PSGBRXFO (PSGBORDN, "DDRG",PSG BDDRGI),U, 1),"</ien> ",3) | |
1400 | "RTN","PSG BOX7",178, 0) | |
1401 | D SETNODE (.PSGBGCNT ,"</dispen sedrug>",, ,2) | |
1402 | "RTN","PSG BOX7",179, 0) | |
1403 | Q | |
1404 | "RTN","PSG BOX7",180, 0) | |
1405 | ; | |
1406 | "RTN","PSG BOX7",181, 0) | |
1407 | RXINFO(PSG BINFO,PSGB DFN,PSGBOR DN,PSGBURG Y,PSGBPLUN ) ;Order i nfo | |
1408 | "RTN","PSG BOX7",182, 0) | |
1409 | N | |
1410 | DFN,VADM,V AIP,PSGBII ,PSGBDDCT, PSGBSIG,PS GBADMS,PSG BDDUP,PSGB DRGI,PSGBW GRP,PSGBWR DB, | |
1411 | PSGBLGRP,P SGBSPHD,PS GBLINC | |
1412 | "RTN","PSG BOX7",183, 0) | |
1413 | ;Init | |
1414 | "RTN","PSG BOX7",184, 0) | |
1415 | F | |
1416 | PSGBII="OR DN","PATN" ,"SCHT","S TAT","SCH" ,"SCHT","R OUT","PID" ,"WARD","R MBD","WGRP ","DTBG"," | |
1417 | DTED","PID ","ADTM"," DDCT","SIG " S @PSGBI NFO@(PSGBO RDN,PSGBII )="" | |
1418 | "RTN","PSG BOX7",185, 0) | |
1419 | ; | |
1420 | "RTN","PSG BOX7",186, 0) | |
1421 | K ^TMP($J ,"PSGBORDN ") | |
1422 | "RTN","PSG BOX7",187, 0) | |
1423 | D PSS431^ PSS55(PSGB DFN,PSGBOR DN,,,"PSGB ORDN") | |
1424 | "RTN","PSG BOX7",188, 0) | |
1425 | S @PSGBIN FO@(PSGBOR DN,"ORDN") =PSGBORDN | |
1426 | "RTN","PSG BOX7",189, 0) | |
1427 | S @PSGBIN FO@(PSGBOR DN,"PATN") =^TMP($J," PSGBORDN", PSGBORDN,. 5) | |
1428 | "RTN","PSG BOX7",190, 0) | |
1429 | S @PSGBIN FO@(PSGBOR DN,"SCHT") =^TMP($J," PSGBORDN", PSGBORDN,7 ) | |
1430 | "RTN","PSG BOX7",191, 0) | |
1431 | S @PSGBIN FO@(PSGBOR DN,"STAT") =^TMP($J," PSGBORDN", PSGBORDN,2 8) | |
1432 | "RTN","PSG BOX7",192, 0) | |
1433 | S @PSGBIN FO@(PSGBOR DN,"ROUT") =^TMP($J," PSGBORDN", PSGBORDN,3 ) | |
1434 | "RTN","PSG BOX7",193, 0) | |
1435 | ; | |
1436 | "RTN","PSG BOX7",194, 0) | |
1437 | S PSGBDDC T=0 | |
1438 | "RTN","PSG BOX7",195, 0) | |
1439 | S PSGBII= 0 F S PSG BII=$O(^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII) ) Q:'PSGBI I D | |
1440 | "RTN","PSG BOX7",196, 0) | |
1441 | .I PSGBUR GY="CART" D | |
1442 | "RTN","PSG BOX7",197, 0) | |
1443 | ..S PSGBD RGI=$P(^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII, .01),U,1) | |
1444 | "RTN","PSG BOX7",198, 0) | |
1445 | ..Q:'$G(@ PSGBPLUN@( PSGBDRGI)) | |
1446 | "RTN","PSG BOX7",199, 0) | |
1447 | ..;Conver t number o f pick lis t units to number of cart admi nistration s | |
1448 | "RTN","PSG BOX7",200, 0) | |
1449 | ..S PSGBD DUP=^TMP($ J,"PSGBORD N",PSGBORD N,"DDRUG", PSGBII,.02 ) ;units p er dose | |
1450 | "RTN","PSG BOX7",201, 0) | |
1451 | ..I PSGBD DUP#1,+PSG BDDUP S PS GBDDUP=(PS GBDDUP\1)+ 1 ;round u p | |
1452 | "RTN","PSG BOX7",202, 0) | |
1453 | ..;S PSGB ADMS=$S(+$ G(PSGBPLUN ):PSGBPLUN \PSGBDDUP, 1:1) ;numb er of admi nistration s | |
1454 | "RTN","PSG BOX7",203, 0) | |
1455 | ..S PSGBA DMS=$S('PS GBDDUP:0,1 :@PSGBPLUN @(PSGBDRGI )\PSGBDDUP ) | |
1456 | "RTN","PSG BOX7",204, 0) | |
1457 | ..;S:'$G( PSGBADMS) PSGBADMS=1 | |
1458 | "RTN","PSG BOX7",205, 0) | |
1459 | ..;Whole tablets | |
1460 | "RTN","PSG BOX7",206, 0) | |
1461 | ..I +(^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII, .02)\1) D | |
1462 | "RTN","PSG BOX7",207, 0) | |
1463 | ...D RXIN FODD(.PSGB DDCT,PSGBI I) | |
1464 | "RTN","PSG BOX7",208, 0) | |
1465 | ...S | |
1466 | @PSGBINFO@ (PSGBORDN, "DDUN",PSG BDDCT)=@PS GBINFO@(PS GBORDN,"DD UN",PSGBDD CT)\1*PSG | |
1467 | BADMS ;Who le tablets | |
1468 | "RTN","PSG BOX7",209, 0) | |
1469 | ..;Fracti onal table ts | |
1470 | "RTN","PSG BOX7",210, 0) | |
1471 | ..I +(^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII, .02)#1) D | |
1472 | "RTN","PSG BOX7",211, 0) | |
1473 | ...D RXIN FODD(.PSGB DDCT,PSGBI I) | |
1474 | "RTN","PSG BOX7",212, 0) | |
1475 | ...S @PSG BINFO@(PSG BORDN,"DDU N",PSGBDDC T)=PSGBADM S | |
1476 | "RTN","PSG BOX7",213, 0) | |
1477 | ...S | |
1478 | $P(@PSGBIN FO@(PSGBOR DN,"DDRG", PSGBDDCT), U,1)=$P(@P SGBINFO@(P SGBORDN,"D DRG",PSGBD D | |
1479 | CT),U,1)_" F" | |
1480 | "RTN","PSG BOX7",214, 0) | |
1481 | .; | |
1482 | "RTN","PSG BOX7",215, 0) | |
1483 | .I (PSGBU RGY="FD") D | |
1484 | "RTN","PSG BOX7",216, 0) | |
1485 | ..;Conver t number o f units to number of pre-excha nge admini strations | |
1486 | "RTN","PSG BOX7",217, 0) | |
1487 | ..S PSGBD DUP=^TMP($ J,"PSGBORD N",PSGBORD N,"DDRUG", PSGBII,.02 ) ;units p er dose | |
1488 | "RTN","PSG BOX7",218, 0) | |
1489 | ..I PSGBD DUP#1,+PSG BDDUP S PS GBDDUP=(PS GBDDUP\1)+ 1 ;round u p | |
1490 | "RTN","PSG BOX7",219, 0) | |
1491 | ..I 'PSGB DDUP S PSG BADMS=0 | |
1492 | "RTN","PSG BOX7",220, 0) | |
1493 | ..E D | |
1494 | "RTN","PSG BOX7",221, 0) | |
1495 | ...I PSGB URGY="FD" S PSGBADMS =^TMP($J," PSGBORDN", PSGBORDN," DDRUG",PSG BII,.09)\P SGBDDUP | |
1496 | "RTN","PSG BOX7",222, 0) | |
1497 | ...;I PSG BURGY="EUD " S | |
1498 | PSGBADMS=^ TMP($J,"PS GBORDN",PS GBORDN,"DD RUG",PSGBI I,.11)\PSG BDDUP | |
1499 | "RTN","PSG BOX7",223, 0) | |
1500 | ..;Whole tablets | |
1501 | "RTN","PSG BOX7",224, 0) | |
1502 | ..I +(^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII, .02)\1) D | |
1503 | "RTN","PSG BOX7",225, 0) | |
1504 | ...D RXIN FODD(.PSGB DDCT,PSGBI I) | |
1505 | "RTN","PSG BOX7",226, 0) | |
1506 | ...S | |
1507 | @PSGBINFO@ (PSGBORDN, "DDPX",PSG BDDCT)=@PS GBINFO@(PS GBORDN,"DD UN",PSGBDD CT)\1*PSG | |
1508 | BADMS ;Who le tablets | |
1509 | "RTN","PSG BOX7",227, 0) | |
1510 | ..;Fracti onal table ts | |
1511 | "RTN","PSG BOX7",228, 0) | |
1512 | ..I +(^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII, .02)#1) D | |
1513 | "RTN","PSG BOX7",229, 0) | |
1514 | ...D RXIN FODD(.PSGB DDCT,PSGBI I) | |
1515 | "RTN","PSG BOX7",230, 0) | |
1516 | ...S @PSG BINFO@(PSG BORDN,"DDP X",PSGBDDC T)=PSGBADM S | |
1517 | "RTN","PSG BOX7",231, 0) | |
1518 | ...S | |
1519 | $P(@PSGBIN FO@(PSGBOR DN,"DDRG", PSGBDDCT), U,1)=$P(@P SGBINFO@(P SGBORDN,"D DRG",PSGBD D | |
1520 | CT),U,1)_" F" | |
1521 | "RTN","PSG BOX7",232, 0) | |
1522 | .; | |
1523 | "RTN","PSG BOX7",233, 0) | |
1524 | .I PSGBUR GY="EUD" D | |
1525 | "RTN","PSG BOX7",234, 0) | |
1526 | ..Q:'^TMP ($J,"PSGBO RDN",PSGBO RDN,"DDRUG ",PSGBII,. 11) | |
1527 | "RTN","PSG BOX7",235, 0) | |
1528 | ..D RXINF ODD(.PSGBD DCT,PSGBII ) | |
1529 | "RTN","PSG BOX7",236, 0) | |
1530 | ..S | |
1531 | @PSGBINFO@ (PSGBORDN, "DDPX",PSG BDDCT)=^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBII, .11) | |
1532 | "RTN","PSG BOX7",237, 0) | |
1533 | ; | |
1534 | "RTN","PSG BOX7",238, 0) | |
1535 | S @PSGBIN FO@(PSGBOR DN,"DDCT") =PSGBDDCT | |
1536 | "RTN","PSG BOX7",239, 0) | |
1537 | ; | |
1538 | "RTN","PSG BOX7",240, 0) | |
1539 | K ^TMP($J ,"PSGBORDN ") | |
1540 | "RTN","PSG BOX7",241, 0) | |
1541 | D PSS432^ PSS55(PSGB DFN,PSGBOR DN,"PSGBOR DN") | |
1542 | "RTN","PSG BOX7",242, 0) | |
1543 | S @PSGBIN FO@(PSGBOR DN,"SCH")= ^TMP($J,"P SGBORDN",P SGBORDN,26 ) | |
1544 | "RTN","PSG BOX7",243, 0) | |
1545 | ; | |
1546 | "RTN","PSG BOX7",244, 0) | |
1547 | ;Fields n ot availab le by DBIA | |
1548 | "RTN","PSG BOX7",245, 0) | |
1549 | S @PSGBIN FO@(PSGBOR DN,"DTBG") =$$GET1^DI Q(55.06,PS GBORDN_"," _PSGBDFN_" ,",10,"I") | |
1550 | "RTN","PSG BOX7",246, 0) | |
1551 | S @PSGBIN FO@(PSGBOR DN,"DTED") =$$GET1^DI Q(55.06,PS GBORDN_"," _PSGBDFN_" ,",34,"I") | |
1552 | "RTN","PSG BOX7",247, 0) | |
1553 | S @PSGBIN FO@(PSGBOR DN,"ADTM") =$$GET1^DI Q(55.06,PS GBORDN_"," _PSGBDFN_" ,",41,"I") | |
1554 | "RTN","PSG BOX7",248, 0) | |
1555 | S @PSGBIN FO@(PSGBOR DN,"DOSE") =$$GET1^DI Q(55.06,PS GBORDN_"," _PSGBDFN_" ,",109,"I" ) | |
1556 | "RTN","PSG BOX7",249, 0) | |
1557 | S @PSGBIN FO@(PSGBOR DN,"PRIO") =$$GET1^DI Q(55.06,PS GBORDN_"," _PSGBDFN_" ,",.24) | |
1558 | "RTN","PSG BOX7",250, 0) | |
1559 | I @PSGBIN FO@(PSGBOR DN,"PRIO") ="" S @PSG BINFO@(PSG BORDN,"PRI O")="ROUTI NE" | |
1560 | "RTN","PSG BOX7",251, 0) | |
1561 | S @PSGBIN FO@(PSGBOR DN,"SPIN", 1)=$$GET1^ DIQ(55.06, PSGBORDN_" ,"_PSGBDFN _",",8,"I" ) | |
1562 | "RTN","PSG BOX7",252, 0) | |
1563 | ; | |
1564 | "RTN","PSG BOX7",253, 0) | |
1565 | S DFN=PSG BDFN | |
1566 | "RTN","PSG BOX7",254, 0) | |
1567 | D DEM^VAD PT | |
1568 | "RTN","PSG BOX7",255, 0) | |
1569 | S @PSGBIN FO@(PSGBOR DN,"PID")= VADM(2) | |
1570 | "RTN","PSG BOX7",256, 0) | |
1571 | S VAIP("D ")=$$NOW^X LFDT ;6/20 11:35AM | |
1572 | "RTN","PSG BOX7",257, 0) | |
1573 | D IN5^VAD PT | |
1574 | "RTN","PSG BOX7",258, 0) | |
1575 | S @PSGBIN FO@(PSGBOR DN,"WARD") =VAIP(5) | |
1576 | "RTN","PSG BOX7",259, 0) | |
1577 | S @PSGBIN FO@(PSGBOR DN,"RMBD") =VAIP(6) | |
1578 | "RTN","PSG BOX7",260, 0) | |
1579 | ;Convert ward name to base na me | |
1580 | "RTN","PSG BOX7",261, 0) | |
1581 | I +VAIP(5 ) D | |
1582 | "RTN","PSG BOX7",262, 0) | |
1583 | .S PSGBWR DB=$P($P(V AIP(5),U,2 ),")",1)_$ S($P(VAIP( 5),U,2)[") ":")",1:"" ) | |
1584 | "RTN","PSG BOX7",263, 0) | |
1585 | .S @PSGBI NFO@(PSGBO RDN,"RMBD" )=$P(VAIP( 6),U,1)_U_ PSGBWRDB_" "_$P(VAIP (6),U,2) | |
1586 | "RTN","PSG BOX7",264, 0) | |
1587 | ; | |
1588 | "RTN","PSG BOX7",265, 0) | |
1589 | ;Ward gro up | |
1590 | "RTN","PSG BOX7",266, 0) | |
1591 | S @PSGBIN FO@(PSGBOR DN,"WGRP") ="" | |
1592 | "RTN","PSG BOX7",267, 0) | |
1593 | S PSGBWGR P=$$FIND1^ DIC(57.5," ","QX",+VA IP(5),"AB" ) | |
1594 | "RTN","PSG BOX7",268, 0) | |
1595 | I +PSGBWG RP S | |
1596 | @PSGBINFO@ (PSGBORDN, "WGRP")=PS GBWGRP_U_$ $GET1^DIQ( 57.5,PSGBW GRP,.01) | |
1597 | "RTN","PSG BOX7",269, 0) | |
1598 | I 'PSGBWG RP S @PSGB INFO@(PSGB ORDN,"WGRP ")=@PSGBIN FO@(PSGBOR DN,"WARD") | |
1599 | "RTN","PSG BOX7",270, 0) | |
1600 | ;S @PSGBI NFO@(PSGBO RDN,"ATCD" )=+$$GET1^ DIQ(57.5,+ @PSGBINFO@ (PSGBORDN, "WGRP"),32 ,"I") | |
1601 | "RTN","PSG BOX7",271, 0) | |
1602 | ; | |
1603 | "RTN","PSG BOX7",272, 0) | |
1604 | ;IMO loca tions | |
1605 | "RTN","PSG BOX7",273, 0) | |
1606 | I '@PSGBI NFO@(PSGBO RDN,"WARD" ) D | |
1607 | "RTN","PSG BOX7",274, 0) | |
1608 | .S PSGBLI NC=$$GET1^ DIQ(55.06, PSGBORDN_" ,"_PSGBDFN _",",130," I") | |
1609 | "RTN","PSG BOX7",275, 0) | |
1610 | .S PSGBLG RP=$$FIND1 ^DIC(57.8, "","QX",+P SGBLINC,"A C") | |
1611 | "RTN","PSG BOX7",276, 0) | |
1612 | .S @PSGBI NFO@(PSGBO RDN,"WARD" )=0_U_$E($ $GET1^DIQ( 44,PSGBLIN C,.01),1,2 0) | |
1613 | "RTN","PSG BOX7",277, 0) | |
1614 | .I +PSGBL GRP D | |
1615 | "RTN","PSG BOX7",278, 0) | |
1616 | ..S @PSGB INFO@(PSGB ORDN,"WGRP ")=PSGBLGR P_U_$$GET1 ^DIQ(57.8, PSGBLGRP,. 01) | |
1617 | "RTN","PSG BOX7",279, 0) | |
1618 | ..S @PSGB INFO@(PSGB ORDN,"RMBD ")=0_U_$P( @PSGBINFO@ (PSGBORDN, "WGRP"),U, 2) | |
1619 | "RTN","PSG BOX7",280, 0) | |
1620 | .I 'PSGBL GRP D | |
1621 | "RTN","PSG BOX7",281, 0) | |
1622 | ..S @PSGB INFO@(PSGB ORDN,"WGRP ")=@PSGBIN FO@(PSGBOR DN,"WARD") | |
1623 | "RTN","PSG BOX7",282, 0) | |
1624 | ..S @PSGB INFO@(PSGB ORDN,"RMBD ")=@PSGBIN FO@(PSGBOR DN,"WARD") | |
1625 | "RTN","PSG BOX7",283, 0) | |
1626 | ; | |
1627 | "RTN","PSG BOX7",284, 0) | |
1628 | ;Special instructio ns | |
1629 | "RTN","PSG BOX7",285, 0) | |
1630 | ;D GET1^D IQ(55.06,P SGBORDN_", "_PSGBDFN, "135","",$ NA(PSGBDAT D),$NA(PSG BDERR)) | |
1631 | "RTN","PSG BOX7",286, 0) | |
1632 | ;S PSGBII =0 | |
1633 | "RTN","PSG BOX7",287, 0) | |
1634 | ;F S PSG BII=$O(PSG BDATD(PSGB II)) Q:PSG BII="" D | |
1635 | "RTN","PSG BOX7",288, 0) | |
1636 | ;.S @PSGB INFO@(PSGB ORDN,"SPIN ",PSGBII)= PSGBDATD(P SGBII) | |
1637 | "RTN","PSG BOX7",289, 0) | |
1638 | ; | |
1639 | "RTN","PSG BOX7",290, 0) | |
1640 | K PSGBSIG | |
1641 | "RTN","PSG BOX7",291, 0) | |
1642 | D DRGDISP ^PSJLMUT1( PSGBDFN,PS GBORDN_"U" ,100,100,. PSGBSIG,0) | |
1643 | "RTN","PSG BOX7",292, 0) | |
1644 | S PSGBII= 1 | |
1645 | "RTN","PSG BOX7",293, 0) | |
1646 | F S PSGB II=$O(PSGB SIG(PSGBII )) Q:'PSGB II D | |
1647 | "RTN","PSG BOX7",294, 0) | |
1648 | .S @PSGBI NFO@(PSGBO RDN,"SIG", PSGBII)=$G (PSGBSIG(P SGBII)) | |
1649 | "RTN","PSG BOX7",295, 0) | |
1650 | ; | |
1651 | "RTN","PSG BOX7",296, 0) | |
1652 | ;Activity log to fi nd service corrected orders | |
1653 | "RTN","PSG BOX7",297, 0) | |
1654 | K ^TMP("P SJ",$J) | |
1655 | "RTN","PSG BOX7",298, 0) | |
1656 | Q | |
1657 | "RTN","PSG BOX7",299, 0) | |
1658 | ; | |
1659 | "RTN","PSG BOX7",300, 0) | |
1660 | RXINFODD(P SGBDDCT,PS GBDDII) ;D ispense dr ug nodes | |
1661 | "RTN","PSG BOX7",301, 0) | |
1662 | S PSGBDDC T=PSGBDDCT +1 | |
1663 | "RTN","PSG BOX7",302, 0) | |
1664 | S | |
1665 | @PSGBINFO@ (PSGBORDN, "DDRG",PSG BDDCT)=^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBDDI I,. | |
1666 | 01) | |
1667 | "RTN","PSG BOX7",303, 0) | |
1668 | S | |
1669 | @PSGBINFO@ (PSGBORDN, "DDUN",PSG BDDCT)=^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBDDI I, | |
1670 | .02) | |
1671 | "RTN","PSG BOX7",304, 0) | |
1672 | S | |
1673 | @PSGBINFO@ (PSGBORDN, "DDIA",PSG BDDCT)=^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBDDI I,. | |
1674 | 03) | |
1675 | "RTN","PSG BOX7",305, 0) | |
1676 | S | |
1677 | @PSGBINFO@ (PSGBORDN, "DDPX",PSG BDDCT)=^TM P($J,"PSGB ORDN",PSGB ORDN,"DDRU G",PSGBDDI I,. | |
1678 | 09) | |
1679 | "RTN","PSG BOX7",306, 0) | |
1680 | S | |
1681 | @PSGBINFO@ (PSGBORDN, "DDMN",PSG BDDCT)=$$G ET1^DIQ(50 ,+@PSGBINF O@(PSGBORD N,"DDRG",P | |
1682 | SGBDDCT),2 12.2) | |
1683 | "RTN","PSG BOX7",307, 0) | |
1684 | S | |
1685 | @PSGBINFO@ (PSGBORDN, "DDSH",PSG BDDCT)=$$G ET1^DIQ(50 ,+@PSGBINF O@(PSGBORD N,"DDRG",P S | |
1686 | GBDDCT),3) | |
1687 | "RTN","PSG BOX7",308, 0) | |
1688 | Q | |
1689 | "RTN","PSG BOX7",309, 0) | |
1690 | ; | |
1691 | "RTN","PSG BOX7",310, 0) | |
1692 | RXSKIP(PSG BINFO,PSGB URGY) ;Che ck if shou ld be incl uded. . 0= Ok 1-10=Sk ip 11-19=D elete | |
1693 | "RTN","PSG BOX7",311, 0) | |
1694 | N PSGBX,P SGBRET | |
1695 | "RTN","PSG BOX7",312, 0) | |
1696 | S PSGBRET =0 | |
1697 | "RTN","PSG BOX7",313, 0) | |
1698 | I PSGBURG Y="CART" D | |
1699 | "RTN","PSG BOX7",314, 0) | |
1700 | .;I $P(@P SGBINFO@(" SCHT"),U,1 )="F" S PS GBRET=10 | |
1701 | "RTN","PSG BOX7",315, 0) | |
1702 | .I @PSGBI NFO@("SCH" )["PRN" S PSGBRET=11 | |
1703 | "RTN","PSG BOX7",316, 0) | |
1704 | .I $P(@PS GBINFO@("S CHT"),U,1) ="P" S PSG BRET=11 | |
1705 | "RTN","PSG BOX7",317, 0) | |
1706 | .I @PSGBI NFO@("SCH" )="OC" S P SGBRET=12 | |
1707 | "RTN","PSG BOX7",318, 0) | |
1708 | .I $P(@PS GBINFO@("S CHT"),U,1) ="OC" S PS GBRET=12 | |
1709 | "RTN","PSG BOX7",319, 0) | |
1710 | .I $P(@PS GBINFO@("S CHT"),U,1) ="R" S PSG BRET=13 | |
1711 | "RTN","PSG BOX7",320, 0) | |
1712 | Q:+PSGBRE T PSGBRET | |
1713 | "RTN","PSG BOX7",321, 0) | |
1714 | ; | |
1715 | "RTN","PSG BOX7",322, 0) | |
1716 | S PSGBX=$ P(@PSGBINF O@("STAT") ,U,1) | |
1717 | "RTN","PSG BOX7",323, 0) | |
1718 | I PSGBURG Y="CART" D | |
1719 | "RTN","PSG BOX7",324, 0) | |
1720 | .I $S(PSG BX="A":0,P SGBX="R":0 ,PSGBX="RE ":0,1:1) S PSGBRET=1 3 | |
1721 | "RTN","PSG BOX7",325, 0) | |
1722 | Q:+PSGBRE T PSGBRET | |
1723 | "RTN","PSG BOX7",326, 0) | |
1724 | Q PSGBRET | |
1725 | "RTN","PSG BOX7",327, 0) | |
1726 | ; | |
1727 | "RTN","PSG BOX7",328, 0) | |
1728 | DTC(PSGBDT IN,PSGBFRM T) ;Date/t ime conver ter | |
1729 | "RTN","PSG BOX7",329, 0) | |
1730 | Q $TR($$F MTE^XLFDT( $E(PSGBDTI N,1,12),PS GBFRMT),"@ "," ") | |
1731 | "RTN","PSG BOX7",330, 0) | |
1732 | ; | |
1733 | "RTN","PSG BOX7",331, 0) | |
1734 | SETNODE(PS GBNDCT,PSG BBEGN,PSGB VALU,PSGBE NDN,PSGBTA BS) ;Set n ode | |
1735 | "RTN","PSG BOX7",332, 0) | |
1736 | N PSGBLIN E,PSGBSPAC | |
1737 | "RTN","PSG BOX7",333, 0) | |
1738 | S PSGBSPA C="" | |
1739 | "RTN","PSG BOX7",334, 0) | |
1740 | I +$G(PSG BTABS) D | |
1741 | "RTN","PSG BOX7",335, 0) | |
1742 | .S PSGBSP AC=$E(" ",1,PSGB TABS*3) | |
1743 | "RTN","PSG BOX7",336, 0) | |
1744 | S PSGBLIN E=$G(PSGBB EGN)_$$ENC ODE($G(PSG BVALU))_$G (PSGBENDN) | |
1745 | "RTN","PSG BOX7",337, 0) | |
1746 | S PSGBNDC T=PSGBNDCT +1 | |
1747 | "RTN","PSG BOX7",338, 0) | |
1748 | S ^TMP("P SGBOX7",$J ,"TRANS",P SGBNDCT)=P SGBSPAC_PS GBLINE | |
1749 | "RTN","PSG BOX7",339, 0) | |
1750 | Q | |
1751 | "RTN","PSG BOX7",340, 0) | |
1752 | ; | |
1753 | "RTN","PSG BOX7",341, 0) | |
1754 | ENCODE(PSG BVAL0) ;En code inval id XML cha rs | |
1755 | "RTN","PSG BOX7",342, 0) | |
1756 | N PSGBSPE C | |
1757 | "RTN","PSG BOX7",343, 0) | |
1758 | S PSGBSPE C("<")="&l t;" | |
1759 | "RTN","PSG BOX7",344, 0) | |
1760 | S PSGBSPE C(">")="&g t;" | |
1761 | "RTN","PSG BOX7",345, 0) | |
1762 | S PSGBSPE C("""")="& quot;" | |
1763 | "RTN","PSG BOX7",346, 0) | |
1764 | S PSGBSPE C("'")="&a pos;" | |
1765 | "RTN","PSG BOX7",347, 0) | |
1766 | S PSGBSPE C("&")="&a mp;" | |
1767 | "RTN","PSG BOX7",348, 0) | |
1768 | Q $$REPLA CE^XLFSTR( PSGBVAL0,. PSGBSPEC) | |
1769 | "RTN","PSG BOX7",349, 0) | |
1770 | ; | |
1771 | "RTN","PSG BOX7",350, 0) | |
1772 | ISCS(PSGBC ODE) ;Retu rn 1 if co ntrolled s ub | |
1773 | "RTN","PSG BOX7",351, 0) | |
1774 | I $S(PSGB CODE["1":1 ,PSGBCODE[ "2":1,PSGB CODE["3":1 ,PSGBCODE[ "4":1,PSGB CODE["5":1 ,1:0) Q 1 | |
1775 | "RTN","PSG BOX7",352, 0) | |
1776 | Q 0 | |
1777 | "RTN","PSG BOX7",353, 0) | |
1778 | ; | |
1779 | "RTN","PSG BOX7",354, 0) | |
1780 | MMERRFD(PS GBDFN,PSGB ORDN,PSGBE RR) ;Tx er ror notifi cation fir st dose | |
1781 | "RTN","PSG BOX7",355, 0) | |
1782 | N XMDUZ,X MMG,XMSUB, XMTEXT,XMY ,XMZ,PSGBP ATN,PSGBSS N,PSGBOI,V ADM,DFN | |
1783 | "RTN","PSG BOX7",356, 0) | |
1784 | S DFN=+PS GBDFN | |
1785 | "RTN","PSG BOX7",357, 0) | |
1786 | D DEM^VAD PT | |
1787 | "RTN","PSG BOX7",358, 0) | |
1788 | S PSGBPAT N=VADM(1) | |
1789 | "RTN","PSG BOX7",359, 0) | |
1790 | S PSGBSSN =$E(VADM(2 ),6,9) | |
1791 | "RTN","PSG BOX7",360, 0) | |
1792 | S PSGBOI= $$GET1^DIQ (55.06,PSG BORDN_","_ PSGBDFN_", ",108) | |
1793 | "RTN","PSG BOX7",361, 0) | |
1794 | S XMSUB=" Swiss Log Tx Error: "_PSGBPATN _" ("_PSGB SSN_") "_P SGBOI | |
1795 | "RTN","PSG BOX7",362, 0) | |
1796 | S XMDUZ=D UZ | |
1797 | "RTN","PSG BOX7",363, 0) | |
1798 | S XMTEXT= "PSGBMSG(" | |
1799 | "RTN","PSG BOX7",364, 0) | |
1800 | S PSGBMSG (1)="This order fail ed transmi ssion to S wiss Log I MS:" | |
1801 | "RTN","PSG BOX7",365, 0) | |
1802 | S PSGBMSG (2)=" " | |
1803 | "RTN","PSG BOX7",366, 0) | |
1804 | S PSGBMSG (3)=" Pat ient: : "_PSGB PATN_" ("_ PSGBSSN_") " | |
1805 | "RTN","PSG BOX7",367, 0) | |
1806 | S PSGBMSG (4)=" Ord erable Ite m : "_PSGB OI | |
1807 | "RTN","PSG BOX7",368, 0) | |
1808 | S PSGBMSG (5)=" Ord er Number : "_PSGB ORDN | |
1809 | "RTN","PSG BOX7",369, 0) | |
1810 | S PSGBMSG (6)=" Err or : "_PSGB ERR | |
1811 | "RTN","PSG BOX7",370, 0) | |
1812 | S XMY("G. PSGBOX SWI SS LOG TX ERROR")="" | |
1813 | "RTN","PSG BOX7",371, 0) | |
1814 | D ^XMD | |
1815 | "RTN","PSG BOX7",372, 0) | |
1816 | Q | |
1817 | "RTN","PSG BOX7",373, 0) | |
1818 | ; | |
1819 | "RTN","PSG BOX7",374, 0) | |
1820 | MMERRPL(PS GBPLGI,PSG BPLWG,PSGB ERR) ;Tx e rror notif ication pi ck list | |
1821 | "RTN","PSG BOX7",375, 0) | |
1822 | N XMDUZ,X MMG,XMSUB, XMTEXT,XMY ,XMZ,PSGBP LWN,PSGBMS G | |
1823 | "RTN","PSG BOX7",376, 0) | |
1824 | S PSGBPLW N=$$GET1^D IQ(57.5,PS GBPLWG,.01 ) | |
1825 | "RTN","PSG BOX7",377, 0) | |
1826 | S XMSUB=" Swiss Log Tx Error: "_PSGBPLWN _" PICK LI ST #"_PSGB PLGI | |
1827 | "RTN","PSG BOX7",378, 0) | |
1828 | S XMDUZ=D UZ | |
1829 | "RTN","PSG BOX7",379, 0) | |
1830 | S XMTEXT= "PSGBMSG(" | |
1831 | "RTN","PSG BOX7",380, 0) | |
1832 | S PSGBMSG (1)="This pick list failed tra nsmission to Swiss L og IMS:" | |
1833 | "RTN","PSG BOX7",381, 0) | |
1834 | S PSGBMSG (2)=" " | |
1835 | "RTN","PSG BOX7",382, 0) | |
1836 | S PSGBMSG (3)=" War d : "_PSGBPLWN | |
1837 | "RTN","PSG BOX7",383, 0) | |
1838 | S PSGBMSG (4)=" Dat e Range : "_$$FMTE^X LFDT($$GET 1^DIQ(53.5 ,PSGBPLGI, .03,"I")," 2")_" to | |
1839 | "_$$FMTE^X LFDT($$GET 1^DIQ(53.5 ,PSGBPLGI, .04,"I")," 2") | |
1840 | "RTN","PSG BOX7",384, 0) | |
1841 | S PSGBMSG (5)=" Err or : "_PSGBERR | |
1842 | "RTN","PSG BOX7",385, 0) | |
1843 | S XMY("G. PSGBOX SWI SS LOG TX ERROR")="" | |
1844 | "RTN","PSG BOX7",386, 0) | |
1845 | D ^XMD | |
1846 | "RTN","PSG BOX7",387, 0) | |
1847 | Q | |
1848 | "RTN","PSG BOX7",388, 0) | |
1849 | ; | |
1850 | "RTN","PSG BOX9") | |
1851 | 0^24^B1443 3212^n/a | |
1852 | "RTN","PSG BOX9",1,0) | |
1853 | PSGBOX9 ;E PIP/WLC SW ISS LOG IN TERFACE SF TP ; 29 No v 2018 1: 07 PM | |
1854 | "RTN","PSG BOX9",2,0) | |
1855 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;DEC 16, 1997; Build 8 | |
1856 | "RTN","PSG BOX9",3,0) | |
1857 | ; ICR Us age Component | |
1858 | "RTN","PSG BOX9",4,0) | |
1859 | ; --- -- --- --------- | |
1860 | "RTN","PSG BOX9",5,0) | |
1861 | ; 2320 S upported ^%ZISH | |
1862 | "RTN","PSG BOX9",6,0) | |
1863 | ; | |
1864 | "RTN","PSG BOX9",7,0) | |
1865 | SFTP(PSGBF ILE) ; Cre ate .DAT f ile to tra nsfer file (s). Retur ns 0 if su ccess. | |
1866 | "RTN","PSG BOX9",8,0) | |
1867 | N PSGBERR ,PSGBCFGN, PSGBFARR | |
1868 | "RTN","PSG BOX9",9,0) | |
1869 | S PSGBERR =0 | |
1870 | "RTN","PSG BOX9",10,0 ) | |
1871 | S PSGBCFG N=$$GET^XP AR("SYS"," PSG BOX SF TP CFG NAM E",1,"I") | |
1872 | "RTN","PSG BOX9",11,0 ) | |
1873 | I ($T(^R1 XTFTP2)]"" ),(PSGBCFG N]"") D | |
1874 | "RTN","PSG BOX9",12,0 ) | |
1875 | .S PSGBFA RR("DATA_F ILE",1)=PS GBFILE | |
1876 | "RTN","PSG BOX9",13,0 ) | |
1877 | .S PSGBER R='$$FTPCF G^R1XTFTP2 (PSGBCFGN, .PSGBFARR) | |
1878 | "RTN","PSG BOX9",14,0 ) | |
1879 | .I PSGBER R S PSGBER R="71;FTPC FG API cal l failed" | |
1880 | "RTN","PSG BOX9",15,0 ) | |
1881 | I ($T(^R1 XTFTP2)="" )!(PSGBCFG N="") D Q PSGBERR | |
1882 | "RTN","PSG BOX9",16,0 ) | |
1883 | .S PSGBER R=$$SFTPHC (PSGBFILE, $E($P(PSGB FILE,".",1 ),5,$L(PSG BFILE))) | |
1884 | "RTN","PSG BOX9",17,0 ) | |
1885 | Q PSGBERR | |
1886 | "RTN","PSG BOX9",18,0 ) | |
1887 | ; | |
1888 | "RTN","PSG BOX9",19,0 ) | |
1889 | SFTPHC(PSG BFILE,PSGB SUFX) ; Cr eate .DAT file to tr ansfer fil e(s); Hard Code versi on | |
1890 | "RTN","PSG BOX9",20,0 ) | |
1891 | N PSGBEDI R,PSGBEDIL ,POP,PSGBO UTF,PSGBER R,PSGBXPV1 ,PSGBPV | |
1892 | "RTN","PSG BOX9",21,0 ) | |
1893 | S PSGBERR =0 | |
1894 | "RTN","PSG BOX9",22,0 ) | |
1895 | S PSGBEDI R=$$PWD^%Z ISH | |
1896 | "RTN","PSG BOX9",23,0 ) | |
1897 | S PSGBEDI L="/"_$TR( PSGBEDIR," []:","//") | |
1898 | "RTN","PSG BOX9",24,0 ) | |
1899 | S PSGBOUT F="PSGBOX9 _"_PSGBSUF X_"FTP" | |
1900 | "RTN","PSG BOX9",25,0 ) | |
1901 | D SFTPCLE A(PSGBEDIR ,PSGBOUTF) | |
1902 | "RTN","PSG BOX9",26,0 ) | |
1903 | ;Create F TP data fi le | |
1904 | "RTN","PSG BOX9",27,0 ) | |
1905 | D OPEN^%Z ISH("FILE1 ",PSGBEDIR ,PSGBOUTF_ ".DAT","W" ) | |
1906 | "RTN","PSG BOX9",28,0 ) | |
1907 | S:POP PSG BERR="90;C reate scri pt file fa iled" | |
1908 | "RTN","PSG BOX9",29,0 ) | |
1909 | Q:+PSGBER R PSGBERR | |
1910 | "RTN","PSG BOX9",30,0 ) | |
1911 | D USE^%ZI SUTL("FILE 1") | |
1912 | "RTN","PSG BOX9",31,0 ) | |
1913 | W "lcd "_ PSGBEDIR,! | |
1914 | "RTN","PSG BOX9",32,0 ) | |
1915 | W "cd inb ound",! | |
1916 | "RTN","PSG BOX9",33,0 ) | |
1917 | W "put "_ PSGBFILE,! | |
1918 | "RTN","PSG BOX9",34,0 ) | |
1919 | W "exit", ! ; Exit FTP | |
1920 | "RTN","PSG BOX9",35,0 ) | |
1921 | D CLOSE^% ZISH("FILE 1") | |
1922 | "RTN","PSG BOX9",36,0 ) | |
1923 | ;Create C OM file | |
1924 | "RTN","PSG BOX9",37,0 ) | |
1925 | D OPEN^%Z ISH("FILE2 ",PSGBEDIR ,PSGBOUTF_ ".COM","W" ) | |
1926 | "RTN","PSG BOX9",38,0 ) | |
1927 | D USE^%ZI SUTL("FILE 2") | |
1928 | "RTN","PSG BOX9",39,0 ) | |
1929 | W "$ SET VERIFY=(PR OCEDURE,IM AGE)",! | |
1930 | "RTN","PSG BOX9",40,0 ) | |
1931 | W "$ SET DEFAULT SF C_HFS$:[XE ROX_POSTCA RD.PCARD]" ,! | |
1932 | "RTN","PSG BOX9",41,0 ) | |
1933 | W "$ sftp -""B"" "_ PSGBEDIL_P SGBOUTF_". DAT - | |
1934 | oIdentityF ile=/sfc_h fs$/xerox_ postcard/p card/ssh2/ identifica tion. secV istaUser@ IP #22",! | |
1935 | "RTN","PSG BOX9",42,0 ) | |
1936 | W "$ EXIT 3",! | |
1937 | "RTN","PSG BOX9",43,0 ) | |
1938 | D CLOSE^% ZISH("FILE 2") | |
1939 | "RTN","PSG BOX9",44,0 ) | |
1940 | ;Execute COM | |
1941 | "RTN","PSG BOX9",45,0 ) | |
1942 | S PSGBXPV 1="S PSGBP V=$ZF(- | |
1943 | 1,""@"_PSG BEDIR_PSGB OUTF_".COM /OUTPUT="_ PSGBEDIR_P SGBOUTF_". LOG"")" | |
1944 | "RTN","PSG BOX9",46,0 ) | |
1945 | X PSGBXPV 1 ; Run t he .COM fi le to tran sfer files | |
1946 | "RTN","PSG BOX9",47,0 ) | |
1947 | ;Error fl ag logic | |
1948 | "RTN","PSG BOX9",48,0 ) | |
1949 | I PSGBPV= -1 S PSGBE RR="91;Cal lout faile d" ; This error is generated if failure during xf er occurs | |
1950 | "RTN","PSG BOX9",49,0 ) | |
1951 | ;Clean up | |
1952 | "RTN","PSG BOX9",50,0 ) | |
1953 | D SFTPCLE A(PSGBEDIR ,PSGBOUTF) | |
1954 | "RTN","PSG BOX9",51,0 ) | |
1955 | Q PSGBERR | |
1956 | "RTN","PSG BOX9",52,0 ) | |
1957 | ; | |
1958 | "RTN","PSG BOX9",53,0 ) | |
1959 | SFTPCLEA(P SGBEDIR,PS GBOUTF) ;C lean up fi les | |
1960 | "RTN","PSG BOX9",54,0 ) | |
1961 | N PSGBFIL E,PSGBX | |
1962 | "RTN","PSG BOX9",55,0 ) | |
1963 | S PSGBFIL E(PSGBOUTF _".DAT")=" " | |
1964 | "RTN","PSG BOX9",56,0 ) | |
1965 | S PSGBFIL E(PSGBOUTF _".COM")=" " | |
1966 | "RTN","PSG BOX9",57,0 ) | |
1967 | S PSGBFIL E(PSGBOUTF _".LOG")=" " | |
1968 | "RTN","PSG BOX9",58,0 ) | |
1969 | S PSGBX=$ $DEL^%ZISH (PSGBEDIR, $NA(PSGBFI LE)) | |
1970 | "RTN","PSG BOX9",59,0 ) | |
1971 | Q | |
1972 | "RTN","PSG BOX9",60,0 ) | |
1973 | ; | |
1974 | "RTN","PSG BOX9",61,0 ) | |
1975 | TQADD(PSGB FILE) ;Add failed jo b to task queue | |
1976 | "RTN","PSG BOX9",62,0 ) | |
1977 | N PSGBEXP Y | |
1978 | "RTN","PSG BOX9",63,0 ) | |
1979 | Q:$G(PSGB FILE)="" | |
1980 | "RTN","PSG BOX9",64,0 ) | |
1981 | S PSGBEXP Y=$$GET^XP AR("SYS"," PSG BOX FA IL QUE EXP IRY TIME", 1,"I") | |
1982 | "RTN","PSG BOX9",65,0 ) | |
1983 | I 'PSGBEX PY D TQDEL F(PSGBFILE ) Q | |
1984 | "RTN","PSG BOX9",66,0 ) | |
1985 | L +^XTMP( "PSGBOX7_Q UEUE",0):5 | |
1986 | "RTN","PSG BOX9",67,0 ) | |
1987 | S ^XTMP(" PSGBOX7_QU EUE",0)=$$ FMADD^XLFD T(DT,1)_U_ DT | |
1988 | "RTN","PSG BOX9",68,0 ) | |
1989 | L -^XTMP( "PSGBOX7_Q UEUE",0) | |
1990 | "RTN","PSG BOX9",69,0 ) | |
1991 | S ^XTMP(" PSGBOX7_QU EUE",PSGBF ILE)=U_U_$ $NOW^XLFDT | |
1992 | "RTN","PSG BOX9",70,0 ) | |
1993 | Q | |
1994 | "RTN","PSG BOX9",71,0 ) | |
1995 | ; | |
1996 | "RTN","PSG BOX9",72,0 ) | |
1997 | TQMON ;Mon itor task queue | |
1998 | "RTN","PSG BOX9",73,0 ) | |
1999 | N PSGBII, PSGBERR,PS GBEXPY | |
2000 | "RTN","PSG BOX9",74,0 ) | |
2001 | L +^XTMP( "PSGBOX7_Q UEUE","RUN NING"):20 ;Only run one job a t a time | |
2002 | "RTN","PSG BOX9",75,0 ) | |
2003 | Q:'$T | |
2004 | "RTN","PSG BOX9",76,0 ) | |
2005 | S PSGBEXP Y=+$$GET^X PAR("SYS", "PSG BOX F AIL QUE EX PIRY TIME" ,1,"I") | |
2006 | "RTN","PSG BOX9",77,0 ) | |
2007 | S PSGBII= 0 | |
2008 | "RTN","PSG BOX9",78,0 ) | |
2009 | F S PSGB II=$O(^XTM P("PSGBOX7 _QUEUE",PS GBII)) Q:P SGBII="" D | |
2010 | "RTN","PSG BOX9",79,0 ) | |
2011 | .I $$FMDI FF^XLFDT($ $NOW^XLFDT ,$P(^XTMP( "PSGBOX7_Q UEUE",PSGB II),U,3),2 )>PSGBEXPY D Q | |
2012 | "RTN","PSG BOX9",80,0 ) | |
2013 | ..K ^XTMP ("PSGBOX7_ QUEUE",PSG BII) | |
2014 | "RTN","PSG BOX9",81,0 ) | |
2015 | ..D TQDEL F(PSGBII) | |
2016 | "RTN","PSG BOX9",82,0 ) | |
2017 | .S PSGBER R=$$SFTP(P SGBII) | |
2018 | "RTN","PSG BOX9",83,0 ) | |
2019 | .I 'PSGBE RR D Q | |
2020 | "RTN","PSG BOX9",84,0 ) | |
2021 | ..K ^XTMP ("PSGBOX7_ QUEUE",PSG BII) | |
2022 | "RTN","PSG BOX9",85,0 ) | |
2023 | ..D TQDEL F(PSGBII) | |
2024 | "RTN","PSG BOX9",86,0 ) | |
2025 | .S $P(^XT MP("PSGBOX 7_QUEUE",P SGBII),U,4 )=$$NOW^XL FDT | |
2026 | "RTN","PSG BOX9",87,0 ) | |
2027 | L -^XTMP( "PSGBOX7_Q UEUE","RUN NING") | |
2028 | "RTN","PSG BOX9",88,0 ) | |
2029 | Q | |
2030 | "RTN","PSG BOX9",89,0 ) | |
2031 | ; | |
2032 | "RTN","PSG BOX9",90,0 ) | |
2033 | TQDELF(PSG BFILE) ;De lete sftp hfs file | |
2034 | "RTN","PSG BOX9",91,0 ) | |
2035 | N PSGBSAV F,PSGBX,PS GBDELA | |
2036 | "RTN","PSG BOX9",92,0 ) | |
2037 | S PSGBSAV F=$$GET^XP AR("SYS"," PSG BOX SF TP SAVE FI LE",1,"I") | |
2038 | "RTN","PSG BOX9",93,0 ) | |
2039 | Q:+PSGBSA VF | |
2040 | "RTN","PSG BOX9",94,0 ) | |
2041 | S PSGBDEL A(PSGBFILE )="" | |
2042 | "RTN","PSG BOX9",95,0 ) | |
2043 | S PSGBX=$ $DEL^%ZISH ($$PWD^%ZI SH,$NA(PSG BDELA)) | |
2044 | "RTN","PSG BOX9",96,0 ) | |
2045 | Q | |
2046 | "RTN","PSG FILED") | |
2047 | 0^17^B2843 8752^B2500 6038 | |
2048 | "RTN","PSG FILED",1,0 ) | |
2049 | PSGFILED ; BIR/CML3-V ARIOUS FIL ES' UPKEEP ; 31 Jan 2019 4:22 PM | |
2050 | "RTN","PSG FILED",2,0 ) | |
2051 | ;;5.0;INP ATIENT MED ICATIONS;* *20,50,63, 119,110,11 1,112,154, 184,181,25 7,363,332* *;16 DEC | |
2052 | 97;Build 8 | |
2053 | "RTN","PSG FILED",3,0 ) | |
2054 | ; | |
2055 | "RTN","PSG FILED",4,0 ) | |
2056 | ; Referen ce to ^PS( 50.606 sup ported by DBIA# 2174 . | |
2057 | "RTN","PSG FILED",5,0 ) | |
2058 | ; Referen ce to ^PSD RUG suppor ted by DBI A# 2192. | |
2059 | "RTN","PSG FILED",6,0 ) | |
2060 | ; Referen ce to ^PS( 59.7 is su pported by DBIA# 218 1. | |
2061 | "RTN","PSG FILED",7,0 ) | |
2062 | ; Referen ce to ^PS( 51 is supp orted by D BIA# 2176. | |
2063 | "RTN","PSG FILED",8,0 ) | |
2064 | ; Referen ce to ^PS( 51.2 is su pported by DBIA# 217 8. | |
2065 | "RTN","PSG FILED",9,0 ) | |
2066 | ; Referen ce to ^PS( 55 is supp orted by D BIA# 2191. | |
2067 | "RTN","PSG FILED",10, 0) | |
2068 | ; | |
2069 | "RTN","PSG FILED",11, 0) | |
2070 | DONE D ENK V^PSGSETU K D0,D1,D2 ,PSGRBS Q | |
2071 | "RTN","PSG FILED",12, 0) | |
2072 | ; | |
2073 | "RTN","PSG FILED",13, 0) | |
2074 | GED ; gene ric edit | |
2075 | "RTN","PSG FILED",14, 0) | |
2076 | S DA=+Y,D R=".01;1" W ! D ^DIE Q | |
2077 | "RTN","PSG FILED",15, 0) | |
2078 | ; | |
2079 | "RTN","PSG FILED",16, 0) | |
2080 | ENAT ; tea m file | |
2081 | "RTN","PSG FILED",17, 0) | |
2082 | F S DIC= "^PS(57.7, ",DIC(0)=" QEAMIL",DL AYGO=57.7, DIC("A")=" Select WAR D: " W ! D ^DIC K | |
2083 | DIC,DLAYGO Q:Y'>0 S DA=+Y,DIE ="^PS(57.7 ,",DR="[PS JUMATE]" D ^DIE | |
2084 | "RTN","PSG FILED",18, 0) | |
2085 | G DONE | |
2086 | "RTN","PSG FILED",19, 0) | |
2087 | ; | |
2088 | "RTN","PSG FILED",20, 0) | |
2089 | ENAS ; sch edules fil e - no lon ger used | |
2090 | "RTN","PSG FILED",21, 0) | |
2091 | ; | |
2092 | "RTN","PSG FILED",22, 0) | |
2093 | ENMR ; med route fil e | |
2094 | "RTN","PSG FILED",23, 0) | |
2095 | NEW MRNO, MR K DIE,D IC,DR,Y | |
2096 | "RTN","PSG FILED",24, 0) | |
2097 | F S DIC= "^PS(51.2, ",DIC(0)=" QEAMIL",DL AYGO=51.2 W ! D ^DIC K DIC,DLA YGO Q:+Y'> 0 S | |
2098 | MRNO=+Y,MR =$P(Y,U,2) ,DA=+Y,DIE ="^PS(51.2 ,",DR=".01 ;1;3;4" D ^DIE D DF | |
2099 | "RTN","PSG FILED",25, 0) | |
2100 | G DONE | |
2101 | "RTN","PSG FILED",26, 0) | |
2102 | ; | |
2103 | "RTN","PSG FILED",27, 0) | |
2104 | ENWG ; war d group fi le | |
2105 | "RTN","PSG FILED",28, 0) | |
2106 | F S DIC= "^PS(57.5, ",DIC(0)=" QEAMIL",DL AYGO=57.5 W ! D ^DIC K DA,DIC, DR Q:+Y'>0 S | |
2107 | DA=+Y,DIE= "^PS(57.5, ",DR="[PSJ U WG]" D ^ DIE | |
2108 | "RTN","PSG FILED",29, 0) | |
2109 | G DONE | |
2110 | "RTN","PSG FILED",30, 0) | |
2111 | ; | |
2112 | "RTN","PSG FILED",31, 0) | |
2113 | ENMI ; med ication in struction file | |
2114 | "RTN","PSG FILED",32, 0) | |
2115 | F S DIC= "^PS(51,", DIC(0)="QE AMIL",DLAY GO=51 W ! D ^DIC K D IC Q:+Y'>0 S | |
2116 | DIE="^PS(5 1,",DA=+Y, DR=".01;1; 30" D ^DIE | |
2117 | "RTN","PSG FILED",33, 0) | |
2118 | G DONE | |
2119 | "RTN","PSG FILED",34, 0) | |
2120 | ; | |
2121 | "RTN","PSG FILED",35, 0) | |
2122 | ENDRG ; st andard dru g fields | |
2123 | "RTN","PSG FILED",36, 0) | |
2124 | D NOW^%DT C S PSGDT= % F S DIC ="^PSDRUG( ",DIC(0)=" AEIMOQ",DI C("A")="Se lect DISPE NSE DRUG: " | |
2125 | W ! D ^DIC K DIC Q:+ Y'>0 D DE | |
2126 | "RTN","PSG FILED",37, 0) | |
2127 | K PSIUA,P SIUDA,PSIU X G DONE | |
2128 | "RTN","PSG FILED",38, 0) | |
2129 | ; | |
2130 | "RTN","PSG FILED",39, 0) | |
2131 | DE ; | |
2132 | "RTN","PSG FILED",40, 0) | |
2133 | I $D(^PSD RUG(+Y,"I" )),^("I"), ^("I")<PSG DT W $C(7) ,$C(7),!!? 3,"*** WAR NING, THIS DRUG IS I NACTIVE. | |
2134 | ***",! | |
2135 | "RTN","PSG FILED",41, 0) | |
2136 | W ! S DIE ="^PSDRUG( ",(DA,PSIU DA)=+Y,DR= "[PSJ FILE D]" | |
2137 | "RTN","PSG FILED",42, 0) | |
2138 | S PSIUX=" U^UNIT DOS E PHARMACY ^1" D ^PSG IU,^DIE:PS IUA'["^" K DA,DIE,DR Q | |
2139 | "RTN","PSG FILED",43, 0) | |
2140 | ; | |
2141 | "RTN","PSG FILED",44, 0) | |
2142 | ENOSE ; or der set en ter/edit | |
2143 | "RTN","PSG FILED",45, 0) | |
2144 | K DIC F S DLAYGO=5 3.2,DIC="^ PS(53.2,", DIC(0)="QE AML",DIC(" A")="Selec t ORDER SE T: " W ! D ^DIC K | |
2145 | DIC Q:Y'>0 S DA=+Y S DIE="^PS (53.2,",DR ="[PSJUOSE ]" D ^DIE K | |
2146 | D0,D1,DA,D IE,DR,PSGN EDFD,PSGS0 XT,PSGS0Y | |
2147 | "RTN","PSG FILED",46, 0) | |
2148 | G DONE | |
2149 | "RTN","PSG FILED",47, 0) | |
2150 | ; | |
2151 | "RTN","PSG FILED",48, 0) | |
2152 | RBCHK ; us ed to vali date room- bed | |
2153 | "RTN","PSG FILED",49, 0) | |
2154 | ;No longe r used. | |
2155 | "RTN","PSG FILED",50, 0) | |
2156 | ;F Z0=0:0 S Z0=$O(^ PS(57.7,DA (2),1,Z0)) Q:'Z0 I Z0'=DA(1), $D(^(Z0,1, "B",X)) W !?19,X," i s already under | |
2157 | ",$S('$D(^ PS(57.7,DA (2),1,Z0,0 )):"anothe r team ("_ Z0_")!",$P (^(0),"^") ]"":$P(^(0 ),"^")_"!" ,1:"anothe r | |
2158 | team ("_Z0 _")!") Q | |
2159 | "RTN","PSG FILED",51, 0) | |
2160 | ;I 'Z0,$D (^DIC(42,D A(2),2,+$O (^DIC(42,D A(2),2,"B" ,$P(X,"-") ,0)),1,"B" ,$P(X,"-", 2))) K Z0 Q | |
2161 | "RTN","PSG FILED",52, 0) | |
2162 | ;K X,Z0 Q | |
2163 | "RTN","PSG FILED",53, 0) | |
2164 | ; | |
2165 | "RTN","PSG FILED",54, 0) | |
2166 | RBQ ; show room-beds for a war d | |
2167 | "RTN","PSG FILED",55, 0) | |
2168 | ;No longe r used. | |
2169 | "RTN","PSG FILED",56, 0) | |
2170 | Q | |
2171 | "RTN","PSG FILED",57, 0) | |
2172 | ; | |
2173 | "RTN","PSG FILED",58, 0) | |
2174 | RBNP W """ ^"" TO STO P: " R Z3: DTIME W:'$ T $C(7) S: '$T Z3="^" W $C(13), " ",$C(13 ) Q | |
2175 | "RTN","PSG FILED",59, 0) | |
2176 | ; | |
2177 | "RTN","PSG FILED",60, 0) | |
2178 | ENPPD ; ed it pharmac y patient data | |
2179 | "RTN","PSG FILED",61, 0) | |
2180 | ; W !!?3, "...This o ption is s till under developme nt...",! Q | |
2181 | "RTN","PSG FILED",62, 0) | |
2182 | ; | |
2183 | "RTN","PSG FILED",63, 0) | |
2184 | ENCPDD ; e dit patien t's defaul t stop dat e (wall) | |
2185 | "RTN","PSG FILED",64, 0) | |
2186 | D ENCV^PS GSETU I $D (XQUIT) Q | |
2187 | "RTN","PSG FILED",65, 0) | |
2188 | F D ENAO ^PSGGAO Q: PSGP'>0 D | |
2189 | "RTN","PSG FILED",66, 0) | |
2190 | .S WDN=$P ($G(^DPT(P SGP,.1))," ^") W:WDN= "" !!?2,"T he patient is not cu rrently on a ward." | |
2191 | "RTN","PSG FILED",67, 0) | |
2192 | .I WDN]"" S WD=$O(^ DIC(42,"B" ,WDN,0)),W D=$O(^PS(5 9.6,"B",+W D,0)) I | |
2193 | $S('WD:1,1 :'$P($G(^P S(59.6,WD, 0)),"^",4) ) S X="PLE ASE NOTE: The 'SAME STOP DATE' parameter for the | |
2194 | ward ("_WD N_") is no t turned o n. Any da te entered here will be ignore d " | |
2195 | "RTN","PSG FILED",68, 0) | |
2196 | .I S X=X _"until th e paramete r is turne d on for t his ward." W $C(7),! !?2 F Y=1: 1:$L(X," " ) S X(1)=$ P(X," | |
2197 | ",Y) W:$L( X(1))+$X>7 8 ! W X(1) ," " | |
2198 | "RTN","PSG FILED",69, 0) | |
2199 | .S DA=PSG P,DR="62.0 1T",DIE="^ PS(55," W !! D ^DIE | |
2200 | "RTN","PSG FILED",70, 0) | |
2201 | K WD,WDN G DONE | |
2202 | "RTN","PSG FILED",71, 0) | |
2203 | ; | |
2204 | "RTN","PSG FILED",72, 0) | |
2205 | ENSYS ; ed it system file | |
2206 | "RTN","PSG FILED",73, 0) | |
2207 | ;/S DIE=" ^PS(59.7," ,DA=1,DR=" 21;26;26.3 ;26.4;26.2 ;20.412ALL OW THE CHA NGE OF ORD ER TYPES O N | |
2208 | ORDERS FRO M OERR;32" | |
2209 | "RTN","PSG FILED",74, 0) | |
2210 | N RPDDEF | |
2211 | "RTN","PSG FILED",75, 0) | |
2212 | S RPDDEF= 0 | |
2213 | "RTN","PSG FILED",76, 0) | |
2214 | D ;For R apid picki ng list | |
2215 | "RTN","PSG FILED",77, 0) | |
2216 | .N PCKVAL | |
2217 | "RTN","PSG FILED",78, 0) | |
2218 | .D LIST^D IC(59.7,"" ,"",,,,,,, ,"PCKVAL") | |
2219 | "RTN","PSG FILED",79, 0) | |
2220 | .S RPDDEF =$$GET1^DI Q(59.7,PCK VAL("DILIS T",2,1)_", ",29.3,"E" ) | |
2221 | "RTN","PSG FILED",80, 0) | |
2222 | S DIE="^P S(59.7,",D A=1,DR="21 ;26;26.3;2 6.4;26.2;2 6.5;26.6;2 6.7;26.8;3 4;27;27.1" | |
2223 | "RTN","PSG FILED",81, 0) | |
2224 | S DR="21; 26;26.3;26 .4;26.2;26 .5;26.6;26 .7;29.3//" _$S(RPDDEF ]"":RPDDEF ,1:"NO")_" ;I X'=1 S | |
2225 | Y=""@1"";2 9.1;29.2;@ 1;26.8;34; 27;27.1" | |
2226 | "RTN","PSG FILED",82, 0) | |
2227 | W ! D ^DI E | |
2228 | "RTN","PSG FILED",83, 0) | |
2229 | W !!,"Edi ting KERNE L Paramete rs...",!! | |
2230 | "RTN","PSG FILED",84, 0) | |
2231 | D TEDH^XP AREDIT("PS G KERNEL P ARAMETERS" ,"B") K DI E,DA,DR W ! | |
2232 | "RTN","PSG FILED",85, 0) | |
2233 | Q | |
2234 | "RTN","PSG FILED",86, 0) | |
2235 | ; | |
2236 | "RTN","PSG FILED",87, 0) | |
2237 | ENPLSP ; e dit pick l ist site p arameters | |
2238 | "RTN","PSG FILED",88, 0) | |
2239 | ; | |
2240 | "RTN","PSG FILED",89, 0) | |
2241 | ENCS ; cha nge curren t site & p arameters | |
2242 | "RTN","PSG FILED",90, 0) | |
2243 | I $D(PSJS YSW0)#2 W !!,"Curren t site: ", $P(PSJSYSW 0,"^") | |
2244 | "RTN","PSG FILED",91, 0) | |
2245 | S PSGCSF= 1 D ^PSGSE T,ENKV^PSG SETU W:$D( XQUIT) !!? 5,"(The In patient si te you are currently working | |
2246 | under has not change d.)" K PSG CSF,PSGORS ET,XQUIT Q | |
2247 | "RTN","PSG FILED",92, 0) | |
2248 | ; | |
2249 | "RTN","PSG FILED",93, 0) | |
2250 | DF ; Add/e dit Med ro ute, instr uction... to the Dos age form f ile. | |
2251 | "RTN","PSG FILED",94, 0) | |
2252 | S DIR("A" )="Would y ou like to update th e Dosage F orm file" | |
2253 | "RTN","PSG FILED",95, 0) | |
2254 | S DIR("?" )="If your answer is Yes, you will be ab le to Add/ edit the M ed routes, Instructi ons, Verb, Noun | |
2255 | and Prepos ition that associate with this Dosage fo rm." | |
2256 | "RTN","PSG FILED",96, 0) | |
2257 | S DIR(0)= "Y",DIR("B ")="Y" D ^ DIR Q:Y'=1 | |
2258 | "RTN","PSG FILED",97, 0) | |
2259 | NEW Y,DFN O K DIE,DI C,DA,DR | |
2260 | "RTN","PSG FILED",98, 0) | |
2261 | F S DIC= "^PS(50.60 6,",DIC(0) ="QEAMI" D ^DIC Q:+Y '>0 S DFN O=+Y D | |
2262 | "RTN","PSG FILED",99, 0) | |
2263 | . I $G(MR )]"",'$D(^ PS(50.606, DFNO,"MR", "B",MRNO)) S DIE="^P S(50.606," ,DR="1///" _MR,DA=DFN O D | |
2264 | ^DIE | |
2265 | "RTN","PSG FILED",100 ,0) | |
2266 | . K DIE,D IC,DR,MR S DIE="^PS( 50.606,",D R="1;3;4;5 ",DA=DFNO D ^DIE | |
2267 | "RTN","PSG FILED",101 ,0) | |
2268 | ;. K DIE, DIC,DR,MR S DIE="^PS (50.606,", DR="1;2;3; 4;5",DA=DF NO D ^DIE | |
2269 | "RTN","PSG FILED",102 ,0) | |
2270 | Q | |
2271 | "RTN","PSG FILED",103 ,0) | |
2272 | ENCD ;edit Clinic De finitions file | |
2273 | "RTN","PSG FILED",104 ,0) | |
2274 | N CLINICS ,CLINFLG S CLINICS=" " | |
2275 | "RTN","PSG FILED",105 ,0) | |
2276 | F K DIC S DIC="^PS (53.46,",D IC(0)="AEL MQ",DIC("A ")="Select CLINIC: " ,DLAYGO=53 .46 D ^DIC K DIC | |
2277 | Q:Y<0 D | |
2278 | "RTN","PSG FILED",106 ,0) | |
2279 | . S DIE=" ^PS(53.46, ",DA=+Y,CL INICS(DA)= "",DR="1;2 ;3;6" D ^D IE K DIE,D A,DR | |
2280 | "RTN","PSG FILED",107 ,0) | |
2281 | D IMO^PSJ IMO1(.CLIN ICS) | |
2282 | "RTN","PSG FILED",108 ,0) | |
2283 | Q | |
2284 | "RTN","PSG FILED",109 ,0) | |
2285 | ; | |
2286 | "RTN","PSG FILED",110 ,0) | |
2287 | ENCG ; war d group fi le0 | |
2288 | "RTN","PSG FILED",111 ,0) | |
2289 | F S DIC= "^PS(57.8, ",DIC(0)=" QEAMIL",DL AYGO=57.8 W ! D ^DIC K DA,DIC, DR Q:+Y'>0 S | |
2290 | DA=+Y,DIE= "^PS(57.8, ",DR=".01; 1" D ^DIE | |
2291 | "RTN","PSG FILED",112 ,0) | |
2292 | G DONE | |
2293 | "RTN","PSG FILED",113 ,0) | |
2294 | ; | |
2295 | "RTN","PSG IEN") | |
2296 | 0^11^B2583 050^n/a | |
2297 | "RTN","PSG IEN",1,0) | |
2298 | PSGIEN ;BP /RCC - Pri nt Drug IE N Numbers on Pre-Exc hange Repo rts; 02 Oc t 2018 11 :10 AM ; 2 9 Nov | |
2299 | 2018 1:20 PM | |
2300 | "RTN","PSG IEN",2,0) | |
2301 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;16 DEC 97;Bui ld 8 | |
2302 | "RTN","PSG IEN",3,0) | |
2303 | Q ;calle d at line tag | |
2304 | "RTN","PSG IEN",4,0) | |
2305 | ;From DD S+5^PSGPER 0 & from D DS+5^PSGPE R2 | |
2306 | "RTN","PSG IEN",5,0) | |
2307 | 1 S ND1=$G (^PS(55,DF N,5,ON,1,+ ND,0)),UD= $P(ND1,"^" ,2),PSGIEN =+ND1,PSGI EN=" (ien: | |
2308 | "_PSGIEN_" )",ND1=$$E NDDN^PSGMI (+ND1),SND 1=$E(ND1,1 ,20)_"^"_+ ND,ND=$P(N D,"^",2) | |
2309 | "RTN","PSG IEN",6,0) | |
2310 | Q | |
2311 | "RTN","PSG IEN",7,0) | |
2312 | ; | |
2313 | "RTN","PSG IEN",8,0) | |
2314 | 2 ;From DD S+5^PSGPER 0 | |
2315 | "RTN","PSG IEN",9,0) | |
2316 | S | |
2317 | ^TMP("PSGP ER",$J,WD, SPN,SDN,SN D1)=ND1_"^ "_UD_"^"_N D,$P(^TMP( "PSGPER",$ J,WD,SPN,S DN,SND | |
2318 | 1),U,20)=P SGIEN | |
2319 | "RTN","PSG IEN",10,0) | |
2320 | Q | |
2321 | "RTN","PSG IEN",11,0) | |
2322 | ; | |
2323 | "RTN","PSG IEN",12,0) | |
2324 | 3 ;From PR T+3^PSGPER 0 & from P RT+3^PSGPE R0 | |
2325 | "RTN","PSG IEN",13,0) | |
2326 | I 1 S PDN =$P(PX,"^" ),UD=$P(PX ,"^",2),PS GIEN=$P(PX ,"^",20),P X=$P(PX,"^ ",3) W | |
2327 | !?10,PDN,P SGIEN,?62, $J($S('UD: 1,$E(UD)=" .":0_UD,1: UD),5),?72 ,$J(PX,5) Q | |
2328 | "RTN","PSG IEN",14,0) | |
2329 | Q | |
2330 | "RTN","PSG IEN",15,0) | |
2331 | ; | |
2332 | "RTN","PSG IEN",16,0) | |
2333 | 4 ;From DD S+8^PSGPER 2 | |
2334 | "RTN","PSG IEN",17,0) | |
2335 | S | |
2336 | ^TMP("PSGP ERP",$J,WD ,SPN,SDN,S ND1)=ND1_" ^"_UD_"^"_ ND,$P(^TMP ("PSGPERP" ,$J,WD,SPN ,SDN,S | |
2337 | ND1),U,20) =PSGIEN | |
2338 | "RTN","PSG IEN",18,0) | |
2339 | Q | |
2340 | "RTN","PSG IEN",19,0) | |
2341 | ; | |
2342 | "RTN","PSG PEN") | |
2343 | 0^3^B59188 020^B57889 018 | |
2344 | "RTN","PSG PEN",1,0) | |
2345 | PSGPEN ;BI R/CML3 - F IND DEFAUL T FOR PRE- EXCHANGE N EEDS ; 02 Oct 2018 11:11 AM | |
2346 | "RTN","PSG PEN",2,0) | |
2347 | ;;5.0;INP ATIENT MED ICATIONS;* *30,37,50, 58,115,110 ,127,129,3 23,317,357 ,332**;16 DEC 97;Bui ld 8 | |
2348 | "RTN","PSG PEN",3,0) | |
2349 | ; | |
2350 | "RTN","PSG PEN",4,0) | |
2351 | ; Referen ces to ^PS D(58.8 sup ported by DBIA #2283 . | |
2352 | "RTN","PSG PEN",5,0) | |
2353 | ; Referen ces to ^PS I(58.1 sup ported by DBIA #2284 . | |
2354 | "RTN","PSG PEN",6,0) | |
2355 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
2356 | "RTN","PSG PEN",7,0) | |
2357 | ; Referen ce to ^PSD RUG is sup ported by DBIA #2192 . | |
2358 | "RTN","PSG PEN",8,0) | |
2359 | ; Referen ce to ^PS( 59.7 is su pported by DBIA #218 1. | |
2360 | "RTN","PSG PEN",9,0) | |
2361 | ; | |
2362 | "RTN","PSG PEN",10,0) | |
2363 | EN(PSGPENO ) ; | |
2364 | "RTN","PSG PEN",11,0) | |
2365 | S PSGPENO =+PSGPENO | |
2366 | "RTN","PSG PEN",12,0) | |
2367 | N PSJPADE | |
2368 | "RTN","PSG PEN",13,0) | |
2369 | S PSJPADE =$$PADE($G (PSJPWD),P SGP,PSGPEN O_"U") ; PADE check - PSJ*5*3 17 | |
2370 | "RTN","PSG PEN",14,0) | |
2371 | N PSJSITE ,PSJPRN,PS JCLO,ND8 S PSJCLO=0, ND8=0 S PS JSITE=0,PS JSITE=$O(^ PS(59.7,PS JSITE)) I | |
2372 | $P($G(^(PS JSITE,26)) ,U,5)=1 S PSJPRN=1 | |
2373 | "RTN","PSG PEN",15,0) | |
2374 | D NOW^%DT C S PSGDT= %,DT=$$DT^ XLFDT,PSGP EN="" S | |
2375 | ND=$G(^PS( 55,PSGP,5, PSGPENO,0) ),ND8=$G(^ PS(55,PSGP ,5,PSGPENO ,8)) | |
2376 | "RTN","PSG PEN",16,0) | |
2377 | S:$P(ND8, "^",2) PSJ CLO=1 | |
2378 | "RTN","PSG PEN",17,0) | |
2379 | S PSGPENW S=0 I PSJP WD,'PSJCLO F Q=0:0 S Q=$O(^PS( 55,PSGP,5, PSGPENO,1, Q)) Q:'Q S ND=$G(^( Q,0)) | |
2380 | I ND,'$P(N D,"^",3),( $D(^PSI(58 .1,"D",+ND ,PSJPWD))! $D(^PSD(58 .8,"D",+ND ,PSJPWD))) S PSGPENW S=1 Q | |
2381 | "RTN","PSG PEN",18,0) | |
2382 | I PSGPENW S F Q=0:0 S Q=$O(^PS (55,PSGP,5 ,PSGPENO,1 ,Q)) Q:'Q S ND=$G(^ (Q,0)) I N D,'$P(ND," ^",3) | |
2383 | S:'$D(^PSI (58.1,"D", +ND,PSJPWD ))&'$D(^PS D(58.8,"D" ,+ND,PSJPW D)) PSGPEN WS=0 Q:'PS GPENWS S | |
2384 | $P(PSGPENW S,"^",2)=1 | |
2385 | "RTN","PSG PEN",19,0) | |
2386 | I PSJPADE &'PSGPENWS W !!,"The dispense drug",$S(P SJPADE>1:" s",1:"")," for this order | |
2387 | ",$S(PSJPA DE>1:"are" ,1:"is a") ," PADE it em",$S(PSJ PADE>1:"s" ,1:""),"." S PSGPEN= 0 | |
2388 | "RTN","PSG PEN",20,0) | |
2389 | I PSJPADE &PSGPENWS W !!,"The dispense d rug",$S(PS JPADE>1:"s ",1:"")," for this o rder | |
2390 | ",$S(PSJPA DE>1:"are" ,1:"is a") ," WARD ST OCK/PADE i tem",$S(PS JPADE>1:"s ",1:""),". " S PSGPEN =0 | |
2391 | "RTN","PSG PEN",21,0) | |
2392 | I PSGPENW S&'PSJPADE W !!,"The dispense drug",$E(" s",$P(PSGP ENWS,"^",2 ))," for t his order | |
2393 | ",$S($P(PS GPENWS,"^" ,2):"are", 1:"is a"), " WARD STO CK item",$ E("s",$P(P SGPENWS,"^ ",2)),"." S | |
2394 | PSGPEN=0 | |
2395 | "RTN","PSG PEN",22,0) | |
2396 | I 'PSGPEN WS,PSJPWD, 'PSJPADE S | |
2397 | WG=+$O(^PS (57.5,"AB" ,PSJPWD,0) ),PSGPLS=$ P($G(^PS(5 5,PSGP,5,P SGPENO,2)) ,"^",2) I PSGPLS D | |
2398 | "RTN","PSG PEN",23,0) | |
2399 | .S PSGPLF =$O(^PS(53 .5,"AB",WG ,PSGDT)) | |
2400 | "RTN","PSG PEN",24,0) | |
2401 | .N RNDT,P SJRNOS S | |
2402 | RNDT=$$LAS TREN^PSJLM PRI(PSGP,$ S($G(PSJOR D)["P":PSJ ORD,1:"")) ,PSJRNOS=$ P(RNDT,"^" ,4) I | |
2403 | PSJRNOS,'$ G(PSJREN) S PSGPLS=P SJRNOS | |
2404 | "RTN","PSG PEN",25,0) | |
2405 | .I $G(PSJ REN),$G(PS JORD)["U" S PSJRNOS= $P(^PS(55, PSGP,5,+PS JORD,2),"^ ",4) S | |
2406 | PSGPLS=$S( PSJRNOS>PS GDT:PSJRNO S,1:$$DATE 2^PSJUTL2( PSGDT)) | |
2407 | "RTN","PSG PEN",26,0) | |
2408 | .D:'PSGPL F GF I PSG PLF S PSGP LO=PSGPENO D NCE,^PS GPL0 S:PSG PLC'<0 PSG PEN=PSGPLC | |
2409 | "RTN","PSG PEN",27,0) | |
2410 | I $G(PSGP RIO)="DONE " S PSGPEN =0 | |
2411 | "RTN","PSG PEN",28,0) | |
2412 | ; | |
2413 | "RTN","PSG PEN",29,0) | |
2414 | UPDD ; | |
2415 | "RTN","PSG PEN",30,0) | |
2416 | N DIR,PSG PEXU S DIR (0)="NOA^0 :9999:0",D IR("A")="P re-Exchang e DOSES: " ,DIR("?")= "^D DH^PSG PEN" | |
2417 | S:PSGPEN]" " DIR("B") =PSGPEN W ! D ^DIR S :Y PSGPEXU =+Y | |
2418 | "RTN","PSG PEN",31,0) | |
2419 | ;N X S X= $$GET^XPAR ("SYS","PS G BOX FIRS T DOSE INT ON",1,"I" ) I X D | |
2420 | ORDSAVE^PS GBOX1(PSGP ,PSGPENO,Y ) | |
2421 | "RTN","PSG PEN",32,0) | |
2422 | G:'Y DONE S PSGY=+Y W !!,"... updating d ispense dr ugs..." | |
2423 | "RTN","PSG PEN",33,0) | |
2424 | F FQ=0:0 S FQ=$O(^P S(55,PSGP, 5,PSGPENO, 1,FQ)) Q:' FQ S ND=$ G(^(FQ,0)) ,$P(^(0)," ^",9)="" I | |
2425 | ND,'$P(ND, "^",3) D D D | |
2426 | "RTN","PSG PEN",34,0) | |
2427 | N X S X=$ $GET^XPAR( "SYS","PSG BOX FIRST DOSE INT ON",1,"I") I X D | |
2428 | ORDSAVE^PS GBOX1(PSGP ,PSGPENO,P SGPEXU) | |
2429 | "RTN","PSG PEN",35,0) | |
2430 | ; | |
2431 | "RTN","PSG PEN",36,0) | |
2432 | DONE ; | |
2433 | "RTN","PSG PEN",37,0) | |
2434 | I $P(PSJS YSW0,"^",2 9)="",$$DE FON^PSGPER 1 S $P(PSJ SYSW0,"^", 29)=0 | |
2435 | "RTN","PSG PEN",38,0) | |
2436 | K PSGID,P SGMAR,PSGO D,PSGPLC,P SGPLF,PSGP LO,PSGPLS, PSGPLUD,WG S:$G(PSJR EN) DUOUT= 0 Q | |
2437 | "RTN","PSG PEN",39,0) | |
2438 | ; | |
2439 | "RTN","PSG PEN",40,0) | |
2440 | NCE ; | |
2441 | "RTN","PSG PEN",41,0) | |
2442 | W !!,"The next cart exchange is ",$$END TC^PSGMI(P SGPLF),! Q | |
2443 | "RTN","PSG PEN",42,0) | |
2444 | ; | |
2445 | "RTN","PSG PEN",43,0) | |
2446 | GF ; | |
2447 | "RTN","PSG PEN",44,0) | |
2448 | S QQ=0 F Q=0:0 S Q= $O(^PS(53. 5,"AB",WG, Q)) Q:'Q S QQ=Q | |
2449 | "RTN","PSG PEN",45,0) | |
2450 | I QQ S QQ =$O(^PS(53 .5,"AB",WG ,QQ,0)) I QQ,$D(^PS( 53.5,QQ,0) ) S QQ=$P( ^(0),"^",4 ) I QQ>PSG DT S | |
2451 | PSGPLF=QQ | |
2452 | "RTN","PSG PEN",46,0) | |
2453 | Q | |
2454 | "RTN","PSG PEN",47,0) | |
2455 | ; | |
2456 | "RTN","PSG PEN",48,0) | |
2457 | DD ; | |
2458 | "RTN","PSG PEN",49,0) | |
2459 | N DA S DR G=$S($P(ND ,"^")="":" NOT FOUND" ,'$D(^PSDR UG(+ND,0)) :"NOT FOUN D | |
2460 | ("_$P(ND," ^")_")",$P (^(0),"^") ]"":$P(^(0 ),"^"),1:$ P(ND,"^")_ ";PSDRUG(" ),UD=$S('$ P(ND,"^",2 ):1,1:$P(N | |
2461 | D,"^",2)) | |
2462 | "RTN","PSG PEN",50,0) | |
2463 | W !,"..." ,DRG,?45," U/D: ",UD, "..." | |
2464 | "RTN","PSG PEN",51,0) | |
2465 | S PSGDA=P SGY I | |
2466 | 'PSGPENWS, 'PSJCLO,ND ,PSJPWD,($ D(^PSI(58. 1,"D",+ND, PSJPWD))!$ D(^PSD(58. 8,"D",+ND, PSJPWD))) D | |
2467 | PSGPENWS Q :'PSGDA | |
2468 | "RTN","PSG PEN",52,0) | |
2469 | K DA,DR S PSGDA=$S( UD#1:(PSGD A*((UD\1)+ 1)),1:PSGD A*UD) | |
2470 | "RTN","PSG PEN",53,0) | |
2471 | S DIE="^P S(55,"_PSG P_",5,"_PS GPENO_",1, ",DA(2)=PS GP,DA(1)=P SGPENO,DA= FQ,DR=".09 ////"_PSGD A | |
2472 | D ^DIE | |
2473 | "RTN","PSG PEN",54,0) | |
2474 | S PSGPXN= $G(PSGPXN) | |
2475 | "RTN","PSG PEN",55,0) | |
2476 | D:'PSGPXN | |
2477 | "RTN","PSG PEN",56,0) | |
2478 | .D NOW^%D TC L +^PS( 53.4,0):0 S ND=$G(^P S(53.4,0)) S:ND="" N D="PRE-EXC HANGE NEED S^53.4P" F | |
2479 | PSGPXN=$P( ND,"^",3)+ 1:1 I '$D( ^PS(53.4,P SGPXN)) L +^PS(53.4, PSGPXN):0 I S | |
2480 | ^PS(53.4,0 )=$P(ND,"^ ",1,2)_"^" _PSGPXN_"^ "_($P(ND," ^",4)+1) L -^PS(53.4 ,0) Q | |
2481 | "RTN","PSG PEN",57,0) | |
2482 | .S ^PS(53 .4,PSGPXN, 0)=DUZ_"^" _%,^PS(53. 4,"B",DUZ, PSGPXN)="" ,^PS(53.4, "AUD",DUZ, %,PSGPXN)= "" L | |
2483 | -^PS(53.4, PSGPXN) Q | |
2484 | "RTN","PSG PEN",58,0) | |
2485 | I $D(^PS( 53.4,PSGPX N,1,PSGP,1 ,PSGPENO,1 ,FQ,0)) S $P(^(0),"^ ",2)=$P(^( 0),"^",2)+ PSGDA Q | |
2486 | "RTN","PSG PEN",59,0) | |
2487 | ; naked r eference b elow refer s to line above | |
2488 | "RTN","PSG PEN",60,0) | |
2489 | S ^(0)=FQ _"^"_PSGDA I $D(^PS( 53.4,PSGPX N,1,PSGP,1 ,PSGPENO,1 ,0)) S | |
2490 | $P(^(0),"^ ",3,4)=FQ_ "^"_($P(^( 0),"^",4)+ 1) Q | |
2491 | "RTN","PSG PEN",61,0) | |
2492 | ; naked r eference b elow refer s to line above | |
2493 | "RTN","PSG PEN",62,0) | |
2494 | S ^(0)="^ 53.401101A ^"_FQ_"^1" Q:$D(^PS( 53.4,PSGPX N,1,PSGP,1 ,PSGPENO,0 )) S ^(0) =PSGPENO | |
2495 | "RTN","PSG PEN",63,0) | |
2496 | I $D(^PS( 53.4,PSGPX N,1,PSGP,1 ,0)) S $P( ^(0),"^",3 ,4)=PSGPEN O_"^"_($P( ^(0),"^",4 )+1) Q | |
2497 | "RTN","PSG PEN",64,0) | |
2498 | ; naked r eference b elow is fr om line ab ove | |
2499 | "RTN","PSG PEN",65,0) | |
2500 | S ^(0)="^ 53.4011A^" _PSGPENO_" ^1" Q:$D(^ PS(53.4,PS GPXN,1,PSG P,0)) S ^ (0)=PSGP | |
2501 | "RTN","PSG PEN",66,0) | |
2502 | I $D(^PS( 53.4,PSGPX N,1,0)) S $P(^(0),"^ ",3,4)=PSG P_"^"_($P( ^(0),"^",4 )+1) Q | |
2503 | "RTN","PSG PEN",67,0) | |
2504 | ; naked r eference b elow is fr om line ab ove | |
2505 | "RTN","PSG PEN",68,0) | |
2506 | S ^(0)="^ 53.401PA^" _PSGP_"^1" Q | |
2507 | "RTN","PSG PEN",69,0) | |
2508 | ; | |
2509 | "RTN","PSG PEN",70,0) | |
2510 | DH ; | |
2511 | "RTN","PSG PEN",71,0) | |
2512 | W !!?2,"E nter a num ber from 0 to 9999, 0 decimal digits." | |
2513 | "RTN","PSG PEN",72,0) | |
2514 | W !!?2,"E nter the n umber DOSE S needed f or this or der until the next c art exchan ge.",!,"Th is will be the | |
2515 | number of times the order will be admini stered to the patien t",!,"from the start of the or der until the | |
2516 | next cart exchange." | |
2517 | "RTN","PSG PEN",73,0) | |
2518 | W !!?2,"P LEASE NOTE that this is DOSES, and NOT U NITS. The doses ent ered will be",!,"con verted to | |
2519 | units for each dispe nse drug o f this ord er, as eac h dispense drug",!," may have a different units per | |
2520 | dose." Q | |
2521 | "RTN","PSG PEN",74,0) | |
2522 | ; | |
2523 | "RTN","PSG PEN",75,0) | |
2524 | PSGPENWS ; | |
2525 | "RTN","PSG PEN",76,0) | |
2526 | W !,"This dispense drug is a WARD STOCK item." | |
2527 | "RTN","PSG PEN",77,0) | |
2528 | W !,"Woul d you like to:",!?3, "1 - Enter 0 (no) do ses needed for this dispense d rug.",!?3, "2 - Enter | |
2529 | ",PSGDA," doses need ed for thi s dispense drug.",!? 3,"3 - Ent er another amount as the doses needed fo r | |
2530 | this dispe nse drug." | |
2531 | "RTN","PSG PEN",78,0) | |
2532 | K DIR S D IR(0)="SA^ 1:0 (no) d oses;2:"_P SGDA_" dos es;3:anoth er amount" ,DIR("A")= "Select AC TION: | |
2533 | ",DIR("?") ="^D WH^PS GPEN" W ! D ^DIR I Y =1!'Y S PS GDA=0 Q | |
2534 | "RTN","PSG PEN",79,0) | |
2535 | Q:Y=2 K DIR S DIR( 0)="NA^0:9 999:0",DIR ("A")="Pre -Exchange DOSES for this dispe nse drug: | |
2536 | ",DIR("?") ="^D WDH^P SGPEN" W ! D ^DIR S PSGDA=+Y Q | |
2537 | "RTN","PSG PEN",80,0) | |
2538 | ; | |
2539 | "RTN","PSG PEN",81,0) | |
2540 | WH ; | |
2541 | "RTN","PSG PEN",82,0) | |
2542 | S Q="This dispense drug ("_DR G_") is a ward stock item. Se lect:" | |
2543 | "RTN","PSG PEN",83,0) | |
2544 | W !! F Q1 =1:1:$L(Q, " ") S Q2= $P(Q," ",Q 1) W:$X+$L (Q2)>78 ! W Q2," " | |
2545 | "RTN","PSG PEN",84,0) | |
2546 | W !?3,"1 to enter 0 (no) pre- exchange d oses for t his dispen se drug.", !?3,"2 to enter ",PS GDA," dose s for | |
2547 | this dispe nse drug." ,!?3,"3 to enter ano ther amoun t for this dispense drug." Q | |
2548 | "RTN","PSG PEN",85,0) | |
2549 | ; | |
2550 | "RTN","PSG PEN",86,0) | |
2551 | WDH ; | |
2552 | "RTN","PSG PEN",87,0) | |
2553 | W !!?2,"E nter a num ber from 0 to 9999, 0 decimal digits. I f you ente r an '^' t o exit",!, "NO pre-ex change | |
2554 | doses will be entere d for this dispense drug." Q | |
2555 | "RTN","PSG PEN",88,0) | |
2556 | ; | |
2557 | "RTN","PSG PEN",89,0) | |
2558 | PADE(PSJPW D,PSGP,PSG ORD) ; Ph armacy Aut omation Di spensing E quipment ( PADE) chec k - PSJ*5* 317 | |
2559 | "RTN","PSG PEN",90,0) | |
2560 | ; INPUT: PSJPWD = W ard locati on | |
2561 | "RTN","PSG PEN",91,0) | |
2562 | ; PSGP = P atient DFN | |
2563 | "RTN","PSG PEN",92,0) | |
2564 | ; PSGORD = O rder numbe r | |
2565 | "RTN","PSG PEN",93,0) | |
2566 | ; OUTPUT: PADE = Ca n this ord er be disp ensed via PADE? | |
2567 | "RTN","PSG PEN",94,0) | |
2568 | ; | |
2569 | "RTN","PSG PEN",95,0) | |
2570 | N PADE,DF N,PSJDDND, PSJWDFLG | |
2571 | "RTN","PSG PEN",96,0) | |
2572 | I '$G(PSJ PWD)!'$G(P SGP)!'$G(P SGORD) Q " " | |
2573 | "RTN","PSG PEN",97,0) | |
2574 | S PADE="" ,DFN=$G(PS GP) | |
2575 | "RTN","PSG PEN",98,0) | |
2576 | ; Check D EFAULT 0 O N PADE PRE -EXCHANGE parameter | |
2577 | "RTN","PSG PEN",99,0) | |
2578 | D GETS^DI Q(59.6,+$G (PSJSYSW), 8,"I","PSJ WDFLG") | |
2579 | "RTN","PSG PEN",100,0 ) | |
2580 | I $G(PSJW DFLG("59.6 ",+$G(PSJS YSW)_",",8 ,"I")) D | |
2581 | "RTN","PSG PEN",101,0 ) | |
2582 | .N PSJPDL OC,PSJORCL ,PSJCLNK | |
2583 | "RTN","PSG PEN",102,0 ) | |
2584 | .; If cli nic order, quit if c linic loca tion is no t linked t o PADE | |
2585 | "RTN","PSG PEN",103,0 ) | |
2586 | .S | |
2587 | PSJORCL=$S ($G(PSGORD )["P":$G(^ PS(53.1,+$ G(PSGORD), "DSS")),$G (PSGORD)[" U":$G(^PS( 55,+$G(PSG P | |
2588 | ),5,+$G(PS GORD),8)), $G(PSGORD) ["V":$G(^P S(55,+$G(P SGP),"IV", +$G(PSGORD ),"DSS")), 1:"") | |
2589 | "RTN","PSG PEN",104,0 ) | |
2590 | .I PSJORC L,$P(PSJOR CL,"^",2) S PSJCLNK= $$PADECL^P SJPAD50(+$ G(PSJORCL) ) Q:'PSJCL NK | |
2591 | "RTN","PSG PEN",105,0 ) | |
2592 | .I '$G(PS JCLNK) Q:' $$PADEWD^P SJPAD50(PS JPWD) ; Quit if pa tient loca tion not l inked to P ADE | |
2593 | "RTN","PSG PEN",106,0 ) | |
2594 | .S | |
2595 | PSJPDLOC=$ S($G(PSGOR D)["P":+$G (^PS(53.1, +PSGORD,"D SS"))_"C", $G(PSGORD) ["U":+$G(^ PS(55,+$G( D | |
2596 | FN),5,+$G( PSGORD),8) )_"C",1:"" ) | |
2597 | "RTN","PSG PEN",107,0 ) | |
2598 | .S:'PSJPD LOC PSJPDL OC=+$G(PSJ PWD) | |
2599 | "RTN","PSG PEN",108,0 ) | |
2600 | .N PADEFL AG,DDCNT S PADEFLAG= 1 | |
2601 | "RTN","PSG PEN",109,0 ) | |
2602 | .I $G(PSG ORD)["U" S Q=0 F DDC NT=0:1 S Q =$O(^PS(55 ,+$G(PSGP) ,5,+PSGORD ,1,Q)) Q:' Q!'PADEFLA G S | |
2603 | PSJDDND=$G (^(Q,0)) D | |
2604 | "RTN","PSG PEN",110,0 ) | |
2605 | ..S PADEF LAG=+$$DRG QTY^PSJPAD SI(+PSJDDN D,$S(PSJPD LOC["C":"C L",1:"WD") ,+PSJPDLOC ) | |
2606 | "RTN","PSG PEN",111,0 ) | |
2607 | .I $G(PSG ORD)'["U" S Q=0 F DD CNT=0:1 S Q=$O(^PS(5 3.45,+$G(P SJSYSP),2, Q)) Q:'Q!' PADEFLAG S | |
2608 | PSJDDND=$G (^(Q,0)) D | |
2609 | "RTN","PSG PEN",112,0 ) | |
2610 | ..S PADEF LAG=+$$DRG QTY^PSJPAD SI(+PSJDDN D,$S(PSJPD LOC["C":"C L",1:"WD") ,+PSJPDLOC ) | |
2611 | "RTN","PSG PEN",113,0 ) | |
2612 | .I DDCNT, PADEFLAG S PADE=DDCN T | |
2613 | "RTN","PSG PEN",114,0 ) | |
2614 | Q PADE | |
2615 | "RTN","PSG PER") | |
2616 | 0^10^B2102 4384^B1833 2674 | |
2617 | "RTN","PSG PER",1,0) | |
2618 | PSGPER ;BI R/CML3-PRI NTS PRE-EX CHANGE NEE DS REPORT ; 04 Feb 2 019 11:08 AM | |
2619 | "RTN","PSG PER",2,0) | |
2620 | ;;5.0;INP ATIENT MED ICATIONS;* *95,115,12 7,133,279, 332**;16 D EC 97;Buil d 8 | |
2621 | "RTN","PSG PER",3,0) | |
2622 | ; | |
2623 | "RTN","PSG PER",4,0) | |
2624 | EN ; Entry point | |
2625 | "RTN","PSG PER",5,0) | |
2626 | S PSGPERR F=0,POP=0 N PSGPRCLD ,PSGCURCL S PSGPRCLD ="" D DEFC L^PSGPER1( PSGPXN,.PS GPRCLD) | |
2627 | "RTN","PSG PER",6,0) | |
2628 | N PSGPRTY P,PSGPRCL | |
2629 | "RTN","PSG PER",7,0) | |
2630 | I $G(PSGP RCLD("WARD ")) S PSGP RTYP="PSGP ERP" D DEV K PSGPRCL D("WARD") | |
2631 | "RTN","PSG PER",8,0) | |
2632 | I POP D P OP G:%=1 E N D OUT Q | |
2633 | "RTN","PSG PER",9,0) | |
2634 | I $D(PSGP RCLD)>1 S PSGPRTYP=" PSGPERPC" S PSGCURCL ="" F S | |
2635 | PSGCURCL=$ O(PSGPRCLD ("DEV",PSG CURCL)) Q: PSGCURCL=" " D DEV | |
2636 | "RTN","PSG PER",10,0) | |
2637 | D OUT | |
2638 | "RTN","PSG PER",11,0) | |
2639 | Q | |
2640 | "RTN","PSG PER",12,0) | |
2641 | DEV ; Sele ct Device | |
2642 | "RTN","PSG PER",13,0) | |
2643 | S PSGION= ION | |
2644 | "RTN","PSG PER",14,0) | |
2645 | D DEV1 | |
2646 | "RTN","PSG PER",15,0) | |
2647 | Q | |
2648 | "RTN","PSG PER",16,0) | |
2649 | DEV1 ; Get default d evice, sel ect and va lidate dev ice | |
2650 | "RTN","PSG PER",17,0) | |
2651 | N PSGFG S PSGFG=0 | |
2652 | "RTN","PSG PER",18,0) | |
2653 | Q:'$$DEFO N^PSGPER1 | |
2654 | "RTN","PSG PER",19,0) | |
2655 | N RPTLBL | |
2656 | "RTN","PSG PER",20,0) | |
2657 | S RPTLBL= "Pre-Excha nge Report " | |
2658 | "RTN","PSG PER",21,0) | |
2659 | W !!,$S($ $GET^XPAR( "DIV","PSG PRE-EX RE PORT ZEBRA LABELS"," `"_DUZ(2)) :"PRE-EXCH ANGE | |
2660 | LABELS",1: "PRE-EXCHA NGE UNITS REPORT") | |
2661 | "RTN","PSG PER",22,0) | |
2662 | I ($G(PSG CURCL)="") S D=$S($G (PSGPXDEV) :PSGPXDEV, 1:$P(PSJSY SW0,U,29)) | |
2663 | "RTN","PSG PER",23,0) | |
2664 | I $L($G(P SGCURCL)) S D=$G(PSG PRCLD("DEV ",PSGCURCL )) | |
2665 | "RTN","PSG PER",24,0) | |
2666 | S:D="" D= "HOME" S I OP=$S(D:"` "_D,1:D) K %ZIS S %Z IS="NQ" D ^%ZIS S D= $G(ION) | |
2667 | "RTN","PSG PER",25,0) | |
2668 | K IOP,%ZI S,IO("Q") S %ZIS="Q" ,%ZIS("A") ="Select D EVICE for "_$S($G(PS GPRCLD("WA RD")):"War d | |
2669 | "_$G(^DPT( DFN,.1)),$ G(PSGCURCL )]"":"Clin ic "_PSGCU RCL,1:"")_ ": | |
2670 | ",%ZIS("B" )=$S(($G(P SGCURCL)]" "):$G(PSGP RCLD("DEV" ,PSGCURCL) ),1:D) | |
2671 | "RTN","PSG PER",26,0) | |
2672 | D ^%ZIS K %ZIS I PO P D POP G: %=1 DEV1 | |
2673 | "RTN","PSG PER",27,0) | |
2674 | I D'=$G(I ON) D CURD EF | |
2675 | "RTN","PSG PER",28,0) | |
2676 | I $$GET^X PAR("DIV", "PSG PRE-E X REPORT Z EBRA LABEL S","`"_DUZ (2)) D | |
2677 | "RTN","PSG PER",29,0) | |
2678 | . K ZTSAV E S PSGTIR ="^PSGZEBL ",ZTDESC=" PRE-EXCHAN GE UNITS L ABELS" | |
2679 | "RTN","PSG PER",30,0) | |
2680 | . S ZTDTH =$H,ZTSAVE ("PSGPXN") ="",ZTSAVE ("PSGPRTYP ")="" | |
2681 | "RTN","PSG PER",31,0) | |
2682 | . S ZTSAV E("PSGCURC L")="",ZTS AVE("DFN") ="" | |
2683 | "RTN","PSG PER",32,0) | |
2684 | . D ENTSK ^PSGTI G:' $D(ZTSK) D EV1 K ZTSK | |
2685 | "RTN","PSG PER",33,0) | |
2686 | E K ZTSA VE S PSGTI R="^PSGPER 0",ZTDESC= "PRE-EXCHA NGE UNITS | |
2687 | REPORT",ZT DTH=$H,ZTS AVE("PSGPX N")="",ZTS AVE("PSGPR TYP")="",Z TSAVE("PSG CURCL")="" ,ZTSAVE(" | |
2688 | DFN")="" D ENTSK^PSG TI G:'$D(Z TSK) DEV1 K ZTSK | |
2689 | "RTN","PSG PER",34,0) | |
2690 | D ENP^PSG PER0:'$G(P SGPXPT),EN PAT^PSGPER 0:$G(PSGPX PT),AG | |
2691 | "RTN","PSG PER",35,0) | |
2692 | I %=1 S P SGPERRF=1 G DEV1 | |
2693 | "RTN","PSG PER",36,0) | |
2694 | Q | |
2695 | "RTN","PSG PER",37,0) | |
2696 | ; | |
2697 | "RTN","PSG PER",38,0) | |
2698 | OUT ; Clea n up on th e way out | |
2699 | "RTN","PSG PER",39,0) | |
2700 | D TASKPRG E^PSGPER1( PSGPXN) | |
2701 | "RTN","PSG PER",40,0) | |
2702 | K PSGPERR F,PSGPXN | |
2703 | "RTN","PSG PER",41,0) | |
2704 | Q:$G(PSJC OM)!$G(PSJ PREX) | |
2705 | "RTN","PSG PER",42,0) | |
2706 | N PSJSYSW 0,PSGVBW,P SJPWD,PSJS YSL D Q | |
2707 | "RTN","PSG PER",43,0) | |
2708 | . D:'$G(P SGPXPT) EN IVKV^PSGSE TU | |
2709 | "RTN","PSG PER",44,0) | |
2710 | Q | |
2711 | "RTN","PSG PER",45,0) | |
2712 | ; | |
2713 | "RTN","PSG PER",46,0) | |
2714 | POP ; Abor t? | |
2715 | "RTN","PSG PER",47,0) | |
2716 | S %=2 W:' PSGPERRF ! !,"IF A DE VICE IS NO T CHOSEN, NO REPORT WILL BE RU N AND THE DATA WILL NO | |
2717 | LONGER BE RETRIEVABL E THROUGH THIS REPOR T." | |
2718 | "RTN","PSG PER",48,0) | |
2719 | I 'PSGPER RF F W !, "Do you wa nt another chance to choose a device" S %=1 D YN^D ICN Q:% W | |
2720 | !?3,"Enter 'YES' to choose a d evice to p rint. Ent er 'NO' to quit now. " | |
2721 | "RTN","PSG PER",49,0) | |
2722 | I %'=1 S IOP=PSGION D ^%ZIS S %=2 | |
2723 | "RTN","PSG PER",50,0) | |
2724 | Q | |
2725 | "RTN","PSG PER",51,0) | |
2726 | ; | |
2727 | "RTN","PSG PER",52,0) | |
2728 | AG ; | |
2729 | "RTN","PSG PER",53,0) | |
2730 | F W !!," DO YOU NEE D TO PRINT THIS REPO RT AGAIN" S %=2 D YN ^DICN Q:% D AGMSG | |
2731 | "RTN","PSG PER",54,0) | |
2732 | Q | |
2733 | "RTN","PSG PER",55,0) | |
2734 | ; | |
2735 | "RTN","PSG PER",56,0) | |
2736 | AGMSG ; | |
2737 | "RTN","PSG PER",57,0) | |
2738 | I %Y'?1." ?" W $C(7) ," ANSWER 'YES' OR 'NO' (Entr y required )" Q | |
2739 | "RTN","PSG PER",58,0) | |
2740 | W !," En ter 'YES' to print t his report again. E nter 'NO' (or an '^' ) to quit" ,!,"now. PLEASE NOT E that you | |
2741 | will NOT b e able to retrieve t his data a t a later" ,!,"date. You shoul d print th is informa tion now." Q | |
2742 | "RTN","PSG PER",59,0) | |
2743 | CURDEF ; | |
2744 | "RTN","PSG PER",60,0) | |
2745 | Q:$G(PSGP XDEV)=0 | |
2746 | "RTN","PSG PER",61,0) | |
2747 | K DIC,DR, DA,X,Y,DIE S DIC="^% ZIS(1,",DI C(0)="SOX" ,X=ION D ^ DIC Q:'($G (Y)>0) | |
2748 | "RTN","PSG PER",62,0) | |
2749 | N D,DN S D=+$G(Y),D N=$P($G(Y) ,"^",2) | |
2750 | "RTN","PSG PER",63,0) | |
2751 | F W !!," Keep ",ION ," as the PRE-EXCHAN GE REPORT DEVICE for this sess ion" S %=0 D YN^DICN S | |
2752 | PSGPXDEV=$ S(%=1:D,1: 0) Q:% D DEFMSG | |
2753 | "RTN","PSG PER",64,0) | |
2754 | I $G(Y) S :($G(PSGCU RCL)="") $ P(PSJSYSW0 ,"^",29)=+ Y I ($G(PS GCURCL)]"" ) N CLIEN S | |
2755 | CLIEN=$O(^ SC("B",PSG CURCL,"")) I CLIEN S | |
2756 | $P(PSJSYSW 0("CLINIC" ,CLIEN,1), "^")=D,PSG PRCLD("DEV ",PSGCURCL )=DN | |
2757 | "RTN","PSG PER",65,0) | |
2758 | K DIC,DR, DA,X,Y,DIE | |
2759 | "RTN","PSG PER",66,0) | |
2760 | Q | |
2761 | "RTN","PSG PER",67,0) | |
2762 | ; | |
2763 | "RTN","PSG PER",68,0) | |
2764 | DEFMSG ; | |
2765 | "RTN","PSG PER",69,0) | |
2766 | I %Y'?1." ?" W !,$C( 7)," A NSWER 'YES ' OR 'NO' (Entry req uired)" Q | |
2767 | "RTN","PSG PER",70,0) | |
2768 | W !!," E nter 'YES' to make " ,ION," the PRE-EXCHA NGE REPORT default D EVICE" | |
2769 | "RTN","PSG PER",71,0) | |
2770 | W !," fo r the curr ent sessio n. PLEASE NOTE that this will override t he ward" | |
2771 | "RTN","PSG PER",72,0) | |
2772 | W !," de fault PRE- EXCHANGE R EPORT DEVI CE for thi s session only." | |
2773 | "RTN","PSG PER",73,0) | |
2774 | Q | |
2775 | "RTN","PSG PER0") | |
2776 | 0^1^B35728 238^B34370 854 | |
2777 | "RTN","PSG PER0",1,0) | |
2778 | PSGPER0 ;B IR/CML3-PR INTS PRE-E XCHANGE NE EDS REPORT ; 26 Jul 2018 10:3 8 AM | |
2779 | "RTN","PSG PER0",2,0) | |
2780 | ;;5.0;INP ATIENT MED ICATIONS;* *58,82,95, 115,279,33 2**;16 DEC 97;Build 8 | |
2781 | "RTN","PSG PER0",3,0) | |
2782 | ; | |
2783 | "RTN","PSG PER0",4,0) | |
2784 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
2785 | "RTN","PSG PER0",5,0) | |
2786 | ; Referen ce to $$GE T1^DIQ sup ported by DBIA 2056 | |
2787 | "RTN","PSG PER0",6,0) | |
2788 | ; Referen ce to PSS4 31^PSS55 s upported b y DBIA 482 6 | |
2789 | "RTN","PSG PER0",7,0) | |
2790 | ; | |
2791 | "RTN","PSG PER0",8,0) | |
2792 | ENQ ; | |
2793 | "RTN","PSG PER0",9,0) | |
2794 | D ENP:'$G (PSGPXPT), ENPAT:$G(P SGPXPT) | |
2795 | "RTN","PSG PER0",10,0 ) | |
2796 | D TASKPRG E^PSGPER1( PSGPXN) | |
2797 | "RTN","PSG PER0",11,0 ) | |
2798 | K DA,DIK, PSGPXN | |
2799 | "RTN","PSG PER0",12,0 ) | |
2800 | Q | |
2801 | "RTN","PSG PER0",13,0 ) | |
2802 | ; | |
2803 | "RTN","PSG PER0",14,0 ) | |
2804 | ENPAT ; | |
2805 | "RTN","PSG PER0",15,0 ) | |
2806 | Q:'$G(DFN ) | |
2807 | "RTN","PSG PER0",16,0 ) | |
2808 | N PSGPRSU B S PSGPRS UB=$S($G(P SGPRTYP)=" PSGPERPC": "PSGPERPC" ,1:"PSGPER ") | |
2809 | "RTN","PSG PER0",17,0 ) | |
2810 | K ^TMP("P SGPER",$J) ,^TMP("PSG PERPC",$J) U IO D PA T,DONE | |
2811 | "RTN","PSG PER0",18,0 ) | |
2812 | Q | |
2813 | "RTN","PSG PER0",19,0 ) | |
2814 | ; | |
2815 | "RTN","PSG PER0",20,0 ) | |
2816 | ENP ; | |
2817 | "RTN","PSG PER0",21,0 ) | |
2818 | K ^TMP("P SGPER",$J) U IO | |
2819 | "RTN","PSG PER0",22,0 ) | |
2820 | N PSGPRSU B S PSGPRS UB=$S($G(P SGPRTYP)=" PSGPERPC": "PSGPERPC" ,1:"PSGPER ") | |
2821 | "RTN","PSG PER0",23,0 ) | |
2822 | F DFN=0:0 S DFN=$O( ^PS(53.4,P SGPXN,1,DF N)) Q:'DFN U IO D P AT,DONE | |
2823 | "RTN","PSG PER0",24,0 ) | |
2824 | Q | |
2825 | "RTN","PSG PER0",25,0 ) | |
2826 | ; | |
2827 | "RTN","PSG PER0",26,0 ) | |
2828 | PAT ; | |
2829 | "RTN","PSG PER0",27,0 ) | |
2830 | D PID^VAD PT,GWR F O N=0:0 S ON =$O(^PS(53 .4,PSGPXN, 1,DFN,1,ON )) Q:ON="" D ONI F DD=0:0 S | |
2831 | DD=$O(^PS( 53.4,PSGPX N,1,DFN,1, ON,1,DD)) Q:'DD I $ D(^(DD,0)) S ND=^(0) D DDS | |
2832 | "RTN","PSG PER0",28,0 ) | |
2833 | D NOW^%DT C S %=$$EN DTC^PSGMI( %),(BORD,F ,L)="",$P( L,"- | |
2834 | ",81)="",$ P(BORD,"#" ,25)="",T= IO'=IO(0)! ($E(IOST)' ="C"),RF=$ S(T:0,1:0) D:'RF HEA DER S | |
2835 | (DN,DDN,NP ,WD)="" | |
2836 | "RTN","PSG PER0",29,0 ) | |
2837 | F S WD=$ O(^TMP(PSG PRSUB,$J,W D)) Q:WD=" " S PI="" F S F=0, PI=$O(^TMP (PSGPRSUB, $J,WD,PI)) | |
2838 | Q:PI="" S RB=^(PI) D | |
2839 | "RTN","PSG PER0",30,0 ) | |
2840 | .Q:'$$NSY NC^PSGPER2 (PSGPRSUB, WD,$G(PSGC URCL)) | |
2841 | "RTN","PSG PER0",31,0 ) | |
2842 | .D PPI F S F=1,DN= $O(^TMP(PS GPRSUB,$J, WD,PI,DN)) Q:DN="" S PX=^(DN) D OP F S | |
2843 | DDN=$O(^TM P(PSGPRSUB ,$J,WD,PI, DN,DDN)) Q :DDN="" S PX=^(DDN) D PRT | |
2844 | "RTN","PSG PER0",32,0 ) | |
2845 | .I $O(^TM P(PSGPRSUB ,$J,WD,PI) )]"" S F=" " D NP | |
2846 | "RTN","PSG PER0",33,0 ) | |
2847 | W:T&($Y) @IOF,@IOF D ^%ZISC | |
2848 | "RTN","PSG PER0",34,0 ) | |
2849 | Q | |
2850 | "RTN","PSG PER0",35,0 ) | |
2851 | ; | |
2852 | "RTN","PSG PER0",36,0 ) | |
2853 | DONE ; | |
2854 | "RTN","PSG PER0",37,0 ) | |
2855 | K | |
2856 | ^TMP(PSGPR SUB,$J),BO RD,DN,DD,D O,DRG,DRGS ,F,L,MR,ND ,ND0,ND2,N D4,NP,ON,P I,PDN,PN,P X,RB,RF, | |
2857 | SCH,SDN,SN ,SND1,SPN, STOP,STRT, T,UD,VD,VU ,W,WD,X,XL ,Y,DDN,I2, ND1,PSG25, PSG26,PSGE B,PSGEBN, | |
2858 | PSGNODE,PS GOAT,PSGST AT | |
2859 | "RTN","PSG PER0",38,0 ) | |
2860 | K | |
2861 | DONE,FIL,N F,PDM,PDRG ,PSGACTO,P SGDA,PSGNE FDO,PSGNES DO,PSGPEN, PSGPENWS,P SGY,PSIVAC ,PSIV | |
2862 | CT,PSIVE,P SIVEXAM,PS IVUP,PSIVW AT,PSJH,PS JNOO,PSJNO ON | |
2863 | "RTN","PSG PER0",39,0 ) | |
2864 | Q | |
2865 | "RTN","PSG PER0",40,0 ) | |
2866 | ; | |
2867 | "RTN","PSG PER0",41,0 ) | |
2868 | NP ; | |
2869 | "RTN","PSG PER0",42,0 ) | |
2870 | I 'T K DI R S DIR(0) ="E" W ! D ^DIR S:'Y WD="zzz" W:Y $C(13) ,# Q | |
2871 | "RTN","PSG PER0",43,0 ) | |
2872 | ; | |
2873 | "RTN","PSG PER0",44,0 ) | |
2874 | HEADER ; | |
2875 | "RTN","PSG PER0",45,0 ) | |
2876 | ; PSJ*5.0 *332 | |
2877 | "RTN","PSG PER0",46,0 ) | |
2878 | S PSGPN=$ G(PN)_"("_ $G(SN)_")" | |
2879 | "RTN","PSG PER0",47,0 ) | |
2880 | S PSGRB=$ G(RB) | |
2881 | "RTN","PSG PER0",48,0 ) | |
2882 | S PSGWD=$ S(WD'="zz" :WD,1:"NOT FOUND") | |
2883 | "RTN","PSG PER0",49,0 ) | |
2884 | ; END PS J*5.0*332 changes | |
2885 | "RTN","PSG PER0",50,0 ) | |
2886 | W:$Y @IOF W !?20,"P RE-EXCHANG E UNITS RE PORT - ",% | |
2887 | "RTN","PSG PER0",51,0 ) | |
2888 | W !!,$S(( $G(PSGCURC L)]""):"Cl inic",1:"W ard"),?32, "Room- | |
2889 | bed",!,"Pa tient",!?5 ,"Order",? 64,"Priori ty",!?20," Dispense D rug",?64," U/D",?72," Needs",!,L | |
2890 | "RTN","PSG PER0",52,0 ) | |
2891 | W:F !!,$S (WD'="zz": WD,1:"NOT FOUND"),?3 2,RB,!,PN_ " ("_SN_" )" | |
2892 | "RTN","PSG PER0",53,0 ) | |
2893 | Q | |
2894 | "RTN","PSG PER0",54,0 ) | |
2895 | ; | |
2896 | "RTN","PSG PER0",55,0 ) | |
2897 | GWR ; | |
2898 | "RTN","PSG PER0",56,0 ) | |
2899 | D PID^VAD PT | |
2900 | "RTN","PSG PER0",57,0 ) | |
2901 | S WD=$G(^ DPT(DFN,.1 )),RB=$G(^ (.101)),PN =$P($G(^(0 )),"^") S: WD="" WD=" zz" S:RB=" " RB="NOT | |
2902 | FOUND" S:P N="" PN=DF N_";DPT(" | |
2903 | "RTN","PSG PER0",58,0 ) | |
2904 | S SPN=$E( PN,1,20)_" ^"_DFN,^TM P(PSGPRSUB ,$J,WD,SPN )=PN_"^"_R B_"^"_VA(" BID") Q | |
2905 | "RTN","PSG PER0",59,0 ) | |
2906 | ; | |
2907 | "RTN","PSG PER0",60,0 ) | |
2908 | ONI ; | |
2909 | "RTN","PSG PER0",61,0 ) | |
2910 | S | |
2911 | ND=$G(^PS( 55,DFN,5,O N,0)),DN=$ G(^(.2)),S CH=$P($G(^ (2)),"^"), MR=$P(ND," ^",3),ND=$ $ENNPN^PSG M | |
2912 | I($P(ND,"^ ",2)),DO=$ P(DN,"^",2 ),DN=$P(DN ,"^") I DN ="" S DN=" zz" | |
2913 | "RTN","PSG PER0",62,0 ) | |
2914 | E S DN=$ $ENPDN^PSG MI(DN) | |
2915 | "RTN","PSG PER0",63,0 ) | |
2916 | I ($$CLIN IC^PSJO1(D FN,+ON_"U" )]"") Q:(P SGPRSUB'=" PSGPERPC") N CLINIC S | |
2917 | CLINIC=+$G (^PS(55,DF N,5,+ON,8) ) I CLINIC S CLINIC= $P($G(^SC( +CLINIC,0) ),"^") I ( CLINIC]"") S | |
2918 | WD=CLINIC, ^TMP("PSGP ERPC",$J,W D,SPN)=PN_ "^^"_VA("B ID") D | |
2919 | "RTN","PSG PER0",64,0 ) | |
2920 | .I $D(^TM P(PSGPRSUB ,$J,"zz",S PN)),($O(^ TMP(PSGPRS UB,$J,"zz" ,SPN,""))= "") K | |
2921 | ^TMP(PSGPR SUB,$J,"zz ",SPN) | |
2922 | "RTN","PSG PER0",65,0 ) | |
2923 | S:MR]"" M R=$$ENMRN^ PSGMI(MR) S | |
2924 | SDN=$E(DN, 1,20)_"^"_ ON,^TMP(PS GPRSUB,$J, WD,SPN,SDN )=DN_"^"_D O_"^"_MR_" ^"_SCH_"^" _$P(N | |
2925 | D,"^",2)_" ^"_$$GET1^ DIQ(55.06, ON_","_DFN _",",.24," E") ; ** 332 ** | |
2926 | "RTN","PSG PER0",66,0 ) | |
2927 | S ^TMP($J ,"PSGPRKIL L",PSGPXN, DFN,ON)="" | |
2928 | "RTN","PSG PER0",67,0 ) | |
2929 | Q | |
2930 | "RTN","PSG PER0",68,0 ) | |
2931 | ; | |
2932 | "RTN","PSG PER0",69,0 ) | |
2933 | DDS ; | |
2934 | "RTN","PSG PER0",70,0 ) | |
2935 | Q:'$$NSYN C^PSGPER2( PSGPRSUB,W D,$G(PSGCU RCL)) | |
2936 | "RTN","PSG PER0",71,0 ) | |
2937 | I ($$CLIN IC^PSJO1(D FN,+ON_"U" )]"") Q:(P SGPRSUB'=" PSGPERPC") | |
2938 | "RTN","PSG PER0",72,0 ) | |
2939 | ;S | |
2940 | ND1=$G(^PS (55,DFN,5, ON,1,+ND,0 )),UD=$P(N D1,"^",2), ND1=$$ENDD N^PSGMI(+N D1),SND1=$ E(ND1,1, | |
2941 | 20)_"^"_+N D,ND=$P(ND ,"^",2) | |
2942 | "RTN","PSG PER0",73,0 ) | |
2943 | D 1^PSGIE N ; ** 33 2 ** | |
2944 | "RTN","PSG PER0",74,0 ) | |
2945 | I ND#1 S ND=(ND\1)+ 1 | |
2946 | "RTN","PSG PER0",75,0 ) | |
2947 | ;S ^TMP(P SGPRSUB,$J ,WD,SPN,SD N,SND1)=ND 1_"^"_UD_" ^"_ND | |
2948 | "RTN","PSG PER0",76,0 ) | |
2949 | D 2^PSGIE N ; ** 33 2 ** | |
2950 | "RTN","PSG PER0",77,0 ) | |
2951 | Q | |
2952 | "RTN","PSG PER0",78,0 ) | |
2953 | ; | |
2954 | "RTN","PSG PER0",79,0 ) | |
2955 | PPI ; | |
2956 | "RTN","PSG PER0",80,0 ) | |
2957 | S DFN=$P( PI,"^",2), PN=$P(RB," ^"),SN=$P( RB,"^",3), RB=$P(RB," ^",2) I 'R F,$Y+6>IOS L D NP Q:N P["^" | |
2958 | "RTN","PSG PER0",81,0 ) | |
2959 | W !!,$S(W D'="zz":WD ,1:"NOT FO UND"),?32, RB,!,PN," ("_SN_")" Q | |
2960 | "RTN","PSG PER0",82,0 ) | |
2961 | ; | |
2962 | "RTN","PSG PER0",83,0 ) | |
2963 | OP ; | |
2964 | "RTN","PSG PER0",84,0 ) | |
2965 | S PDN=$P( PX,"^"),DO =$P(PX,"^" ,2),MR=$P( PX,"^",3), SCH=$P(PX, "^",4) | |
2966 | "RTN","PSG PER0",85,0 ) | |
2967 | W !?5,PDN ," ",DO," ",MR,$S(MR ]"":" ",1: ""),SCH | |
2968 | "RTN","PSG PER0",86,0 ) | |
2969 | W ?64,$P( PX,"^",6) ; ** 332 ** | |
2970 | "RTN","PSG PER0",87,0 ) | |
2971 | Q | |
2972 | "RTN","PSG PER0",88,0 ) | |
2973 | PRT ; find order inf o and prin t same | |
2974 | "RTN","PSG PER0",89,0 ) | |
2975 | I 'RF,$Y+ 4>IOSL D N P Q:NP="^" | |
2976 | "RTN","PSG PER0",90,0 ) | |
2977 | I 1 D 3^P SGIEN Q ; ** 332 ** | |
2978 | "RTN","PSG PER0",91,0 ) | |
2979 | S | |
2980 | ON=$P(DN," ^",2),ND=$ G(^PS(55,D FN,5,ON,0) ),ND2=$G(^ (2)),ND4=$ G(^(4)),Y= $P($G(^(6) ),"^"),ND0 =$G( | |
2981 | ^(.1)),DO= $P(ND0,"^" ,2) | |
2982 | "RTN","PSG PER0",92,0 ) | |
2983 | S DRG=$$E NDDN^PSGMI ($P(ND0,"^ ")),MR=$$E NMRN^PSGMI (MR) ; | |
2984 | ,DRGS=$P($ G(^(+$O(^P S(55,DFN,5 ,ON,1,0)), 0)),"^") | |
2985 | "RTN","PSG PER0",93,0 ) | |
2986 | I 'RF W | |
2987 | !?5,DRG,?4 7,DO,?65,$ J($S('UD:1 ,UD=.5:"1/ 2",UD=.25: "1/4",UD?1 ".".N:0_UD ,1:UD),5), ?75,$J(+PX ,5) Q | |
2988 | "RTN","PSG PER0",94,0 ) | |
2989 | ; | |
2990 | "RTN","PSG PER0",95,0 ) | |
2991 | S | |
2992 | SCH=$P(ND2 ,"^"),STRT =$P(ND2,"^ ",2),STOP= $P(ND2,"^" ,4),VU=$P( ND4,"^",3) ,VD=$P(ND4 ,"^",4),VU =$P | |
2993 | ($G(^VA(20 0,+VU,0)), "^",2) S:V U="" VU=$P (ND4,"^",3 ) | |
2994 | "RTN","PSG PER0",96,0 ) | |
2995 | F Q="STRT ","STOP"," VD" S @Q=$ $ENDTC^PSG MI(@Q) | |
2996 | "RTN","PSG PER0",97,0 ) | |
2997 | W:$Y @IOF W !!?6,BO RD_" PRE- EXCHANGE M ED "_BORD ,!?6,"#",? 73,"#",!?6 ,"# | |
2998 | ",PN,?50,$ S(($G(PSGC URCL)]""): "Clinic: " ,1:"Ward: "),WD,?73, "#",!?6,"# ("_SN_") ",?52,"RB: | |
2999 | "_RB,?73," #",!?6,"#" ,?73,"#" | |
3000 | "RTN","PSG PER0",98,0 ) | |
3001 | W !?6,"# "_DRG,?46 ,"START: " _STRT,?73, "#",!?6,"# "_$S(DRG S]"":"("_D RGS_")",1: ""),?47,"S TOP: | |
3002 | "_STOP,?73 ,"#",!?6," # GIVE: " _$S(DO]"": " "_DO,1:" ")_$S(MR]" ":" "_MR,1 :"")_$S(SC H]"":" | |
3003 | "_SCH,1:"" ),?73,"#" | |
3004 | "RTN","PSG PER0",99,0 ) | |
3005 | S XL=0 I Y="" W !?6 ,"#",?73," #",!?6,"# (NO SPECI AL INSTRUC TIONS)" | |
3006 | "RTN","PSG PER0",100, 0) | |
3007 | E W !?6, "#",?73,"# ",!?6,"# " S Y=$$ ENSET^PSGS ICHK(Y) F Q=1:1:$L(Y ," ") S X= $P(Y," ",Q ) | |
3008 | S:$X+$L(X) >72 XL=XL+ 1 W:$X+$L( X)>72 ?73, "#",!?6,"# " W X_" " | |
3009 | "RTN","PSG PER0",101, 0) | |
3010 | W ?73,"#" ,!?6,"#",? 73,"#",!,? 6,"#",?43, "VERIFIED: "_VD,?73, "#",!?6,"# ",?49,"BY: | |
3011 | "_VU,?73," #",!?6,"#" ,?38,"SEND TO FLOOR: "_PX,?73, "#" | |
3012 | "RTN","PSG PER0",102, 0) | |
3013 | S XL=2-XL I XL>0 F Q=1:1:XL W !?6,"#",? 73,"#" | |
3014 | "RTN","PSG PER0",103, 0) | |
3015 | W !?6,"#" ,?73,"#",! ?6,"#",?36 ,"________ _______ ________ _______ # ",!?6,"#", ?36,"FILLE D | |
3016 | BY",?56,"C HECKED BY" ,?73,"#",! ?6,BORD_BO RD_$E(BORD ,1,20) Q | |
3017 | "RTN","PSG PER2") | |
3018 | 0^2^B31133 994^B31489 798 | |
3019 | "RTN","PSG PER2",1,0) | |
3020 | PSGPER2 ;B IR/CML3-PR INTS PRE-E XCHANGE NE EDS REPORT ; 20 Sep 2018 12:4 3 PM | |
3021 | "RTN","PSG PER2",2,0) | |
3022 | ;;5.0;INP ATIENT MED ICATIONS;* *80,115,27 9,332**;16 DEC 97;Bu ild 8 | |
3023 | "RTN","PSG PER2",3,0) | |
3024 | ; | |
3025 | "RTN","PSG PER2",4,0) | |
3026 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
3027 | "RTN","PSG PER2",5,0) | |
3028 | ; | |
3029 | "RTN","PSG PER2",6,0) | |
3030 | ENQ ; Task ed entry p oint | |
3031 | "RTN","PSG PER2",7,0) | |
3032 | D ENP | |
3033 | "RTN","PSG PER2",8,0) | |
3034 | D TASKPRG E^PSGPER1( PSGPXN) | |
3035 | "RTN","PSG PER2",9,0) | |
3036 | K DA,DIK, PSGPXN | |
3037 | "RTN","PSG PER2",10,0 ) | |
3038 | Q | |
3039 | "RTN","PSG PER2",11,0 ) | |
3040 | ; | |
3041 | "RTN","PSG PER2",12,0 ) | |
3042 | ENP ; | |
3043 | "RTN","PSG PER2",13,0 ) | |
3044 | N PSGPRSU B S PSGPRS UB=$S($G(P SGPRTYP)=" PSGPERPC": "PSGPERPC" ,1:"PSGPER P") | |
3045 | "RTN","PSG PER2",14,0 ) | |
3046 | K ^TMP("P SGPERP",$J ),^TMP("PS GPERPC",$J ) U IO | |
3047 | "RTN","PSG PER2",15,0 ) | |
3048 | F DFN=0:0 S DFN=$O( ^PS(53.4,P SGPXN,1,DF N)) Q:'DFN D PID^VA DPT,GWR F ON=0:0 S | |
3049 | ON=$O(^PS( 53.4,PSGPX N,1,DFN,1, ON)) Q:'ON D ONI F DD=0:0 S | |
3050 | DD=$O(^PS( 53.4,PSGPX N,1,DFN,1, ON,1,DD)) Q:'DD I $ D(^(DD,0)) S ND=^(0) D DDS | |
3051 | "RTN","PSG PER2",16,0 ) | |
3052 | D NOW^%DT C S %=$$EN DTC^PSGMI( %),(BORD,F ,L)="",$P( L,"- | |
3053 | ",81)="",$ P(BORD,"#" ,25)="",T= IO'=IO(0)! ($E(IOST)' ="C"),RF=$ S(T:0,1:0) D:'RF HEA DER S | |
3054 | (DN,DDN,NP ,WD)="" | |
3055 | "RTN","PSG PER2",17,0 ) | |
3056 | F S WD=$ O(^TMP(PSG PRSUB,$J,W D)) Q:WD=" " S PI="" F S F=0, PI=$O(^TMP (PSGPRSUB, $J,WD,PI)) | |
3057 | Q:PI="" S RB=$G(^(P I)) D | |
3058 | "RTN","PSG PER2",18,0 ) | |
3059 | .Q:'$$NSY NC(PSGPRSU B,WD,$G(PS GCURCL)) | |
3060 | "RTN","PSG PER2",19,0 ) | |
3061 | .D PPI F S F=1,DN= $O(^TMP(PS GPRSUB,$J, WD,PI,DN)) Q:DN="" S PX=^(DN) D OP F S | |
3062 | DDN=$O(^TM P(PSGPRSUB ,$J,WD,PI, DN,DDN)) Q :DDN="" S PX=^(DDN) D PRT | |
3063 | "RTN","PSG PER2",20,0 ) | |
3064 | .I $O(^TM P(PSGPRSUB ,$J,WD,PI) )]"" S F=" " D NP | |
3065 | "RTN","PSG PER2",21,0 ) | |
3066 | W:T&($Y) @IOF,@IOF D ^%ZISC | |
3067 | "RTN","PSG PER2",22,0 ) | |
3068 | ; | |
3069 | "RTN","PSG PER2",23,0 ) | |
3070 | DONE ; | |
3071 | "RTN","PSG PER2",24,0 ) | |
3072 | K | |
3073 | ^TMP(PSGPR SUB,$J),BO RD,DN,DD,D O,DRG,DRGS ,F,L,MR,ND ,ND0,ND2,N D4,NP,ON,P I,PDN,PN,P X,RB,RF, | |
3074 | SCH,SDN,SN ,SND1,SPN, STOP,STRT, T,UD,VD,VU ,W,WD,X,XL ,Y,DDN,I2, ND1,PSG25, PSG26,PSGE B,PSGEBN, | |
3075 | PSGNODE,PS GOAT,PSGST AT | |
3076 | "RTN","PSG PER2",25,0 ) | |
3077 | K | |
3078 | DONE,FIL,N F,PDM,PDRG ,PSGACTO,P SGDA,PSGNE FDO,PSGNES DO,PSGPEN, PSGPENWS,P SGY,PSIVAC ,PSIV | |
3079 | CT,PSIVE,P SIVEXAM,PS IVUP,PSIVW AT,PSJH,PS JNOO,PSJNO ON | |
3080 | "RTN","PSG PER2",26,0 ) | |
3081 | Q | |
3082 | "RTN","PSG PER2",27,0 ) | |
3083 | ; | |
3084 | "RTN","PSG PER2",28,0 ) | |
3085 | NP ; | |
3086 | "RTN","PSG PER2",29,0 ) | |
3087 | I 'T K DI R S DIR(0) ="E" W ! D ^DIR S:'Y WD="zzz" W:Y $C(13) ,# Q | |
3088 | "RTN","PSG PER2",30,0 ) | |
3089 | ; | |
3090 | "RTN","PSG PER2",31,0 ) | |
3091 | HEADER ; | |
3092 | "RTN","PSG PER2",32,0 ) | |
3093 | W:$Y @IOF W !?20,"P RE-EXCHANG E UNITS RE PORT - ",% | |
3094 | "RTN","PSG PER2",33,0 ) | |
3095 | W !!,$S(( $G(PSGCURC L)]""):"Cl inic",1:"W ard"),?32, "Room- | |
3096 | bed",!,"Pa tient",!?5 ,"Order",? 64,"Priori ty",!?20," Dispense D rug",?64," U/D",?72," Needs",!,L | |
3097 | "RTN","PSG PER2",34,0 ) | |
3098 | W:F !!,$S (WD'="zz": WD,1:"NOT FOUND"),?3 2,RB,!,PN_ " ("_SN_" )" Q | |
3099 | "RTN","PSG PER2",35,0 ) | |
3100 | ; | |
3101 | "RTN","PSG PER2",36,0 ) | |
3102 | GWR ; | |
3103 | "RTN","PSG PER2",37,0 ) | |
3104 | D PID^VAD PT | |
3105 | "RTN","PSG PER2",38,0 ) | |
3106 | S WD=$G(^ DPT(DFN,.1 )),RB=$G(^ (.101)),PN =$P($G(^(0 )),"^") S: WD="" WD=" zz" S:RB=" " RB="NOT | |
3107 | FOUND" S:P N="" PN=DF N_";DPT(" | |
3108 | "RTN","PSG PER2",39,0 ) | |
3109 | S SPN=$E( PN,1,20)_" ^"_DFN,^TM P(PSGPRSUB ,$J,WD,SPN )=PN_"^"_R B_"^"_VA(" BID") Q | |
3110 | "RTN","PSG PER2",40,0 ) | |
3111 | ; | |
3112 | "RTN","PSG PER2",41,0 ) | |
3113 | ONI ; | |
3114 | "RTN","PSG PER2",42,0 ) | |
3115 | S | |
3116 | ND=$G(^PS( 55,DFN,5,O N,0)),DN=$ G(^(.2)),S CH=$P($G(^ (2)),"^"), MR=$P(ND," ^",3),ND=$ $ENNPN^PSG M | |
3117 | I($P(ND,"^ ",2)),DO=$ P(DN,"^",2 ),DN=$P(DN ,"^") I DN ="" S DN=" zz" | |
3118 | "RTN","PSG PER2",43,0 ) | |
3119 | E S DN=$ $ENPDN^PSG MI(DN) | |
3120 | "RTN","PSG PER2",44,0 ) | |
3121 | I $G(^PS( 55,DFN,5,+ ON,8)) Q:( PSGPRSUB'= "PSGPERPC" ) N CLINI C S CLINIC =+^(8) I C LINIC S | |
3122 | CLINIC=$P( $G(^SC(+CL INIC,0))," ^") I (CLI NIC]"") S | |
3123 | WD=CLINIC, ^TMP("PSGP ERPC",$J,W D,SPN)=PN_ "^^"_VA("B ID") D | |
3124 | "RTN","PSG PER2",45,0 ) | |
3125 | .I $D(^TM P(PSGPRSUB ,$J,"zz",S PN)),($O(^ TMP(PSGPRS UB,$J,"zz" ,SPN,""))= "") K | |
3126 | ^TMP(PSGPR SUB,$J,"zz ",SPN) | |
3127 | "RTN","PSG PER2",46,0 ) | |
3128 | S:MR]"" M R=$$ENMRN^ PSGMI(MR) S | |
3129 | SDN=$E(DN, 1,20)_"^"_ ON,^TMP(PS GPRSUB,$J, WD,SPN,SDN )=DN_"^"_D O_"^"_MR_" ^"_SCH_"^" _$P(N | |
3130 | D,"^",2)_" ^"_$$GET1^ DIQ(55.06, ON_","_DFN _",",.24) | |
3131 | "RTN","PSG PER2",47,0 ) | |
3132 | S ^TMP($J ,"PSGPRKIL L",PSGPXN, DFN,ON)="" | |
3133 | "RTN","PSG PER2",48,0 ) | |
3134 | Q | |
3135 | "RTN","PSG PER2",49,0 ) | |
3136 | ; | |
3137 | "RTN","PSG PER2",50,0 ) | |
3138 | DDS ; | |
3139 | "RTN","PSG PER2",51,0 ) | |
3140 | Q:'$$NSYN C(PSGPRSUB ,WD,$G(PSG CURCL)) | |
3141 | "RTN","PSG PER2",52,0 ) | |
3142 | I $G(^PS( 55,DFN,5,+ ON,8)) Q:( PSGPRSUB'= "PSGPERPC" ) | |
3143 | "RTN","PSG PER2",53,0 ) | |
3144 | ; PSJ*5.0 *332 Begin Mods | |
3145 | "RTN","PSG PER2",54,0 ) | |
3146 | ;S | |
3147 | ND1=$G(^PS (55,DFN,5, ON,1,+ND,0 )),UD=$P(N D1,"^",2), ND1=$$ENDD N^PSGMI(+N D1),SND1=$ E(ND1,1, | |
3148 | 20)_"^"_+N D,ND=$P(ND ,"^",2) | |
3149 | "RTN","PSG PER2",55,0 ) | |
3150 | D 1^PSGIE N | |
3151 | "RTN","PSG PER2",56,0 ) | |
3152 | I ND#1 S ND=(ND\1)+ 1 | |
3153 | "RTN","PSG PER2",57,0 ) | |
3154 | ;S ^TMP(P SGPRSUB,$J ,WD,SPN,SD N,SND1)=ND 1_"^"_UD_" ^"_ND | |
3155 | "RTN","PSG PER2",58,0 ) | |
3156 | D 4^PSGIE N | |
3157 | "RTN","PSG PER2",59,0 ) | |
3158 | ; PSJ*5.0 *332 End M ods | |
3159 | "RTN","PSG PER2",60,0 ) | |
3160 | Q | |
3161 | "RTN","PSG PER2",61,0 ) | |
3162 | ; | |
3163 | "RTN","PSG PER2",62,0 ) | |
3164 | PPI ; | |
3165 | "RTN","PSG PER2",63,0 ) | |
3166 | S DFN=$P( PI,"^",2), PN=$P(RB," ^"),SN=$P( RB,"^",3), RB=$P(RB," ^",2) I 'R F,$Y+6>IOS L D NP Q:N P["^" | |
3167 | "RTN","PSG PER2",64,0 ) | |
3168 | W !!,$S(W D'="zz":WD ,1:"NOT FO UND"),?32, RB,!,PN," ("_SN_")" Q | |
3169 | "RTN","PSG PER2",65,0 ) | |
3170 | ; | |
3171 | "RTN","PSG PER2",66,0 ) | |
3172 | OP ; | |
3173 | "RTN","PSG PER2",67,0 ) | |
3174 | S PDN=$P( PX,"^"),DO =$P(PX,"^" ,2),MR=$P( PX,"^",3), SCH=$P(PX, "^",4) | |
3175 | "RTN","PSG PER2",68,0 ) | |
3176 | W !?5,PDN ," ",DO," ",MR,$S(MR ]"":" ",1: ""),SCH | |
3177 | "RTN","PSG PER2",69,0 ) | |
3178 | W ?64,$P( PX,"^",6) | |
3179 | "RTN","PSG PER2",70,0 ) | |
3180 | Q | |
3181 | "RTN","PSG PER2",71,0 ) | |
3182 | PRT ; find order inf o and prin t same | |
3183 | "RTN","PSG PER2",72,0 ) | |
3184 | I 'RF,$Y+ 4>IOSL D N P Q:NP="^" | |
3185 | "RTN","PSG PER2",73,0 ) | |
3186 | ;I 1 S PD N=$P(PX,"^ "),UD=$P(P X,"^",2),P X=$P(PX,"^ ",3) W | |
3187 | !?20,PDN,? 62,$J($S(' UD:1,$E(UD )=".":0_UD ,1:UD),5), ?72,$J(PX, 5) Q | |
3188 | "RTN","PSG PER2",74,0 ) | |
3189 | I 1 D 3^P SGIEN ; ** 332 ** | |
3190 | "RTN","PSG PER2",75,0 ) | |
3191 | S | |
3192 | ON=$P(DN," ^",2),ND=$ G(^PS(55,D FN,5,ON,0) ),ND2=$G(^ (2)),ND4=$ G(^(4)),Y= $P($G(^(6) ),"^"),ND0 =$G( | |
3193 | ^(.1)),DO= $P(ND0,"^" ,2) | |
3194 | "RTN","PSG PER2",76,0 ) | |
3195 | S DRG=$$E NDDN^PSGMI ($P(ND0,"^ ")),MR=$$E NMRN^PSGMI (MR) ; | |
3196 | ,DRGS=$P($ G(^(+$O(^P S(55,DFN,5 ,ON,1,0)), 0)),"^") | |
3197 | "RTN","PSG PER2",77,0 ) | |
3198 | I 'RF W | |
3199 | !?5,DRG,?4 7,DO,?65,$ J($S('UD:1 ,UD=.5:"1/ 2",UD=.25: "1/4",UD?1 ".".N:0_UD ,1:UD),5), ?75,$J(+PX ,5) Q | |
3200 | "RTN","PSG PER2",78,0 ) | |
3201 | ; | |
3202 | "RTN","PSG PER2",79,0 ) | |
3203 | S | |
3204 | SCH=$P(ND2 ,"^"),STRT =$P(ND2,"^ ",2),STOP= $P(ND2,"^" ,4),VU=$P( ND4,"^",3) ,VD=$P(ND4 ,"^",4),VU =$P | |
3205 | ($G(^VA(20 0,+VU,0)), "^",2) S:V U="" VU=$P (ND4,"^",3 ) | |
3206 | "RTN","PSG PER2",80,0 ) | |
3207 | F Q="STRT ","STOP"," VD" S @Q=$ $ENDTC^PSG MI(@Q) | |
3208 | "RTN","PSG PER2",81,0 ) | |
3209 | W:$Y @IOF W !!?6,BO RD_" PRE- EXCHANGE M ED "_BORD ,!?6,"#",? 73,"#",!?6 ,"# | |
3210 | ",PN,?50,$ S(($G(PSGC URCL)]""): "Clinic: " ,1:"Ward: "),WD,?73, "#",!?6,"# ("_SN_") ",?52,"RB: | |
3211 | "_RB,?73," #",!?6,"#" ,?73,"#" | |
3212 | "RTN","PSG PER2",82,0 ) | |
3213 | W !?6,"# "_DRG,?46 ,"START: " _STRT,?73, "#",!?6,"# "_$S(DRG S]"":"("_D RGS_")",1: ""),?47,"S TOP: | |
3214 | "_STOP,?73 ,"#",!?6," # GIVE: " _$S(DO]"": " "_DO,1:" ")_$S(MR]" ":" "_MR,1 :"")_$S(SC H]"":" | |
3215 | "_SCH,1:"" ),?73,"#" | |
3216 | "RTN","PSG PER2",83,0 ) | |
3217 | S XL=0 I Y="" W !?6 ,"#",?73," #",!?6,"# (NO SPECI AL INSTRUC TIONS)" | |
3218 | "RTN","PSG PER2",84,0 ) | |
3219 | E W !?6, "#",?73,"# ",!?6,"# " S Y=$$ ENSET^PSGS ICHK(Y) F Q=1:1:$L(Y ," ") S X= $P(Y," ",Q ) | |
3220 | S:$X+$L(X) >72 XL=XL+ 1 W:$X+$L( X)>72 ?73, "#",!?6,"# " W X_" " | |
3221 | "RTN","PSG PER2",85,0 ) | |
3222 | W ?73,"#" ,!?6,"#",? 73,"#",!,? 6,"#",?43, "VERIFIED: "_VD,?73, "#",!?6,"# ",?49,"BY: | |
3223 | "_VU,?73," #",!?6,"#" ,?38,"SEND TO FLOOR: "_PX,?73, "#" | |
3224 | "RTN","PSG PER2",86,0 ) | |
3225 | S XL=2-XL I XL>0 F Q=1:1:XL W !?6,"#",? 73,"#" | |
3226 | "RTN","PSG PER2",87,0 ) | |
3227 | W !?6,"#" ,?73,"#",! ?6,"#",?36 ,"________ _______ ________ _______ # ",!?6,"#", ?36,"FILLE D | |
3228 | BY",?56,"C HECKED BY" ,?73,"#",! ?6,BORD_BO RD_$E(BORD ,1,20) Q | |
3229 | "RTN","PSG PER2",88,0 ) | |
3230 | ; | |
3231 | "RTN","PSG PER2",89,0 ) | |
3232 | NSYNC(PSGP RSUB,WD,PS GCURCL) ; Don't prin t ward ord ers and cl inic order s together | |
3233 | "RTN","PSG PER2",90,0 ) | |
3234 | Q:((PSGPR SUB="PSGPE RPC")&(WD' =$G(PSGCUR CL))) 0 | |
3235 | "RTN","PSG PER2",91,0 ) | |
3236 | Q:((PSGPR SUB'="PSGP ERPC")&($G (PSGCURCL) ]"")) 0 | |
3237 | "RTN","PSG PER2",92,0 ) | |
3238 | Q 1 | |
3239 | "RTN","PSG ZEB1") | |
3240 | 0^18^B3957 05^n/a | |
3241 | "RTN","PSG ZEB1",1,0) | |
3242 | PSGZEB1 ;; EPIP/WLC - ZEBRA PRE -EXCHANGE LABEL PRIN T (CONT) ; 29 Nov 20 18 1:22 P M | |
3243 | "RTN","PSG ZEB1",2,0) | |
3244 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;16 DEC 1997;B uild 8 | |
3245 | "RTN","PSG ZEB1",3,0) | |
3246 | SRXIEN(RXI EN) ; Stor ing Rx IEN | |
3247 | "RTN","PSG ZEB1",4,0) | |
3248 | S:'$D(PSG RXIEN) PSG RXIEN=RXIE N | |
3249 | "RTN","PSG ZEB1",5,0) | |
3250 | Q | |
3251 | "RTN","PSG ZEB1",6,0) | |
3252 | ; | |
3253 | "RTN","PSG ZEB1",7,0) | |
3254 | SHDR ; Sto ring Patie nt name (P N), SSN (S N), room a nd bed (RB ), Ward (W D) | |
3255 | "RTN","PSG ZEB1",8,0) | |
3256 | S PSGPN=$ G(PN)_" (" _$G(SN)_") " | |
3257 | "RTN","PSG ZEB1",9,0) | |
3258 | S PSGRB=$ G(RB) | |
3259 | "RTN","PSG ZEB1",10,0 ) | |
3260 | S PSGWD=$ S(WD'="zz" :WD,1:"NOT FOUND") | |
3261 | "RTN","PSG ZEB1",11,0 ) | |
3262 | Q | |
3263 | "RTN","PSG ZEB1",12,0 ) | |
3264 | ; | |
3265 | "RTN","PSG ZEB2") | |
3266 | 0^19^B1685 13^n/a | |
3267 | "RTN","PSG ZEB2",1,0) | |
3268 | PSGZEB2 ;E PIP/WLC - ZEBRA PRE- EXCHANGE L ABEL PRINT (CONT); 0 2 Oct 2018 11:14 AM ; 29 Nov 2018 | |
3269 | 1:23 PM | |
3270 | "RTN","PSG ZEB2",2,0) | |
3271 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;16- DEC-1997;B uild 8 | |
3272 | "RTN","PSG ZEB2",3,0) | |
3273 | ; | |
3274 | "RTN","PSG ZEB2",4,0) | |
3275 | ; Descrip tion: Use d only for Zebra lab el printer | |
3276 | "RTN","PSG ZEB2",5,0) | |
3277 | ; | |
3278 | "RTN","PSG ZEB2",6,0) | |
3279 | ZEBST(X,Y, TEXT) ; | |
3280 | "RTN","PSG ZEB2",7,0) | |
3281 | W !,"^FO" _X_","_Y_" ^A0N,30,20 ^FD"_TEXT_ "^FS" | |
3282 | "RTN","PSG ZEB2",8,0) | |
3283 | Q | |
3284 | "RTN","PSG ZEB2",9,0) | |
3285 | ; | |
3286 | "RTN","PSG ZEB2",10,0 ) | |
3287 | ZEBFI ; Ze bra printe r Format I nitializat ion or Sta rt of labe l | |
3288 | "RTN","PSG ZEB2",11,0 ) | |
3289 | W "^XA",! ,"^LH0,0^F S",! | |
3290 | "RTN","PSG ZEB2",12,0 ) | |
3291 | Q | |
3292 | "RTN","PSG ZEB2",13,0 ) | |
3293 | ; | |
3294 | "RTN","PSG ZEB2",14,0 ) | |
3295 | ZEBEL ; Ze bra printe r end of l abel | |
3296 | "RTN","PSG ZEB2",15,0 ) | |
3297 | W !,"^XZ" ,! | |
3298 | "RTN","PSG ZEB2",16,0 ) | |
3299 | Q | |
3300 | "RTN","PSG ZEB2",17,0 ) | |
3301 | ; | |
3302 | "RTN","PSG ZEBL") | |
3303 | 0^16^B2655 1662^n/a | |
3304 | "RTN","PSG ZEBL",1,0) | |
3305 | PSGZEBL ;E PIP/WLC - ZEBRA PRE- EXCHANGE L ABEL PRINT : 02 Oct 2018 11:1 5 AM ; 29 Nov 2018 1:23 | |
3306 | PM | |
3307 | "RTN","PSG ZEBL",2,0) | |
3308 | ;;5.0;INP ATIENT MED ICATIONS;* *332**;16- DEC-1997;B uild 8 | |
3309 | "RTN","PSG ZEBL",3,0) | |
3310 | ; | |
3311 | "RTN","PSG ZEBL",4,0) | |
3312 | ; | |
3313 | "RTN","PSG ZEBL",5,0) | |
3314 | ; | |
3315 | "RTN","PSG ZEBL",6,0) | |
3316 | ENQ ; | |
3317 | "RTN","PSG ZEBL",7,0) | |
3318 | N PSGZI,P SGZIMX,PSG ZIS,PSGSHD R | |
3319 | "RTN","PSG ZEBL",8,0) | |
3320 | N IXC S I XC=1 K ^XT MP("PSGPSG 0") | |
3321 | "RTN","PSG ZEBL",9,0) | |
3322 | S PSGZI=3 20,PSGZIMX =640,PSGZI S=320,PSGS HDR=0 | |
3323 | "RTN","PSG ZEBL",10,0 ) | |
3324 | ; | |
3325 | "RTN","PSG ZEBL",11,0 ) | |
3326 | D ENP:'$G (PSGPXPT), ENPAT:$G(P SGPXPT) S DIK="^PS(5 3.4,",DA=P SGPXN D ^D IK | |
3327 | "RTN","PSG ZEBL",12,0 ) | |
3328 | K DA,DIK, PSGPXN Q | |
3329 | "RTN","PSG ZEBL",13,0 ) | |
3330 | ; | |
3331 | "RTN","PSG ZEBL",14,0 ) | |
3332 | ENPAT ; | |
3333 | "RTN","PSG ZEBL",15,0 ) | |
3334 | N PSGZI,P SGZIMX,PSG ZIS,PSGSHD R | |
3335 | "RTN","PSG ZEBL",16,0 ) | |
3336 | N IXC S I XC=1 K ^XT MP("PSGPSG 0") | |
3337 | "RTN","PSG ZEBL",17,0 ) | |
3338 | S PSGZI=3 20,PSGZIMX =640,PSGZI S=320,PSGS HDR=0 | |
3339 | "RTN","PSG ZEBL",18,0 ) | |
3340 | Q:'$G(DFN ) | |
3341 | "RTN","PSG ZEBL",19,0 ) | |
3342 | ; | |
3343 | "RTN","PSG ZEBL",20,0 ) | |
3344 | K ^TMP("P SGPER",$J) U IO D PA T,DONE | |
3345 | "RTN","PSG ZEBL",21,0 ) | |
3346 | Q | |
3347 | "RTN","PSG ZEBL",22,0 ) | |
3348 | ; | |
3349 | "RTN","PSG ZEBL",23,0 ) | |
3350 | ENP ; | |
3351 | "RTN","PSG ZEBL",24,0 ) | |
3352 | N PSGZI,P SGZIMX,PSG ZIS,PSGSHD R | |
3353 | "RTN","PSG ZEBL",25,0 ) | |
3354 | N IXC S I XC=1 K ^XT MP("PSGPSG 0") | |
3355 | "RTN","PSG ZEBL",26,0 ) | |
3356 | S PSGZI=3 20,PSGZIMX =640,PSGZI S=320,PSGS HDR=0 | |
3357 | "RTN","PSG ZEBL",27,0 ) | |
3358 | K ^TMP("P SGPER",$J) U IO | |
3359 | "RTN","PSG ZEBL",28,0 ) | |
3360 | ; | |
3361 | "RTN","PSG ZEBL",29,0 ) | |
3362 | F DFN=0:0 S DFN=$O( ^PS(53.4,P SGPXN,1,DF N)) Q:'DFN D PAT,DO NE | |
3363 | "RTN","PSG ZEBL",30,0 ) | |
3364 | Q | |
3365 | "RTN","PSG ZEBL",31,0 ) | |
3366 | ; | |
3367 | "RTN","PSG ZEBL",32,0 ) | |
3368 | PAT ; | |
3369 | "RTN","PSG ZEBL",33,0 ) | |
3370 | D PID^VAD PT,GWR F O N=0:0 S ON =$O(^PS(53 .4,PSGPXN, 1,DFN,1,ON )) Q:'ON D ONI F DD =0:0 S | |
3371 | DD=$O(^PS( 53.4,PSGPX N,1,DFN,1, ON,1,DD)) Q:'DD I $ D(^(DD,0)) S ND=^(0) D DDS | |
3372 | "RTN","PSG ZEBL",34,0 ) | |
3373 | D NOW^%DT C | |
3374 | "RTN","PSG ZEBL",35,0 ) | |
3375 | S %=$$END TC^PSGMI(% ),(BORD,F, L)="",$P(L ,"-",81)=" " | |
3376 | "RTN","PSG ZEBL",36,0 ) | |
3377 | S $P(BORD ,"#",25)=" " | |
3378 | "RTN","PSG ZEBL",37,0 ) | |
3379 | S T=IO'=I O(0)!($E(I OST)'="C") ,RF=$S(T:0 ,1:0) D:'R F HDR S (D N,DDN,NP,W D)="" | |
3380 | "RTN","PSG ZEBL",38,0 ) | |
3381 | F S WD=$ O(^TMP("PS GPER",$J,W D)) Q:WD=" " S PI="" F S F=0, PI=$O(^TMP ("PSGPER", $J,WD,PI)) | |
3382 | Q:PI="" S RB=^(PI) D | |
3383 | "RTN","PSG ZEBL",39,0 ) | |
3384 | . D PPI F S F=1,DN =$O(^TMP(" PSGPER",$J ,WD,PI,DN) ) Q:DN="" S PX=^(DN ) D OP S D DN="" F S | |
3385 | DDN=$O(^TM P("PSGPER" ,$J,WD,PI, DN,DDN)) Q :DDN="" S PX=^(DDN) D PRT | |
3386 | "RTN","PSG ZEBL",40,0 ) | |
3387 | . D ZEBEL I $O(^TMP ("PSGPER", $J,WD,PI)) ]"" S F="" D NP | |
3388 | "RTN","PSG ZEBL",41,0 ) | |
3389 | W:T&($Y) @IOF,@IOF D ^%ZISC | |
3390 | "RTN","PSG ZEBL",42,0 ) | |
3391 | Q | |
3392 | "RTN","PSG ZEBL",43,0 ) | |
3393 | ; | |
3394 | "RTN","PSG ZEBL",44,0 ) | |
3395 | DONE ; | |
3396 | "RTN","PSG ZEBL",45,0 ) | |
3397 | K | |
3398 | ^TMP("PSGP ER",$J),BO RD,DN,DD,D O,DRG,DRGS ,F,L,MR,ND ,ND0,ND2,N D4,NP,ON,P I,PDN,PN,P X,RB,RF,S | |
3399 | CH,SDN,SN, SND1,SPN,S TOP,STRT,T ,UD,VD,VU, W,WD,X,XL, Y,DDN,I2,N D1,OSG25,P SG26,PSGEB ,PSGEBN,P | |
3400 | SGNODE,PSG OAT,PSGSTA T | |
3401 | "RTN","PSG ZEBL",46,0 ) | |
3402 | K | |
3403 | DONE,FIL,N F,PDM,PDRG ,PSGACTO,P SGDA,PSGNE FDO,PSGNES DO,PSGPEN, PSGPENWS,P SGY,PSJVAC ,PSIV | |
3404 | CT,PSIVE,P SIVEXAM,PS IVUP,PSIVW AT,PSJH,PS JNOO,PSJNO ON | |
3405 | "RTN","PSG ZEBL",47,0 ) | |
3406 | Q | |
3407 | "RTN","PSG ZEBL",48,0 ) | |
3408 | ; | |
3409 | "RTN","PSG ZEBL",49,0 ) | |
3410 | NP ; | |
3411 | "RTN","PSG ZEBL",50,0 ) | |
3412 | I $G(T)=" " K DIR S DIR(0)="E" W ! D ^DI R S:'Y WD= "zzz" W:Y $C(13),# Q | |
3413 | "RTN","PSG ZEBL",51,0 ) | |
3414 | ; | |
3415 | "RTN","PSG ZEBL",52,0 ) | |
3416 | HEADER ; | |
3417 | "RTN","PSG ZEBL",53,0 ) | |
3418 | W:$Y @IOF W !?20,"P RE-EXCHANG E UNITS RE PORT - ",% | |
3419 | "RTN","PSG ZEBL",54,0 ) | |
3420 | W !!,"War d",?32,"Ro om-bed",!, "Patient", !?5,"Order ",!?20,"Di spense Dru g",?64,"U/ D",?72,"Ne eds",!,L | |
3421 | "RTN","PSG ZEBL",55,0 ) | |
3422 | W:F !!,$S (WD'="zz": WD,1:"NOT FOUND"),?3 2,RB,!,PN_ " ("_SN_" )" Q | |
3423 | "RTN","PSG ZEBL",56,0 ) | |
3424 | Q | |
3425 | "RTN","PSG ZEBL",57,0 ) | |
3426 | ; | |
3427 | "RTN","PSG ZEBL",58,0 ) | |
3428 | HDR ;Print header | |
3429 | "RTN","PSG ZEBL",59,0 ) | |
3430 | ; Gets pa tient ward , patient name, room bed and s tores them in local variables | |
3431 | "RTN","PSG ZEBL",60,0 ) | |
3432 | S PSGPN=$ G(PN),PSGS N=$G(SN),P SGRB=$G(RB ) | |
3433 | "RTN","PSG ZEBL",61,0 ) | |
3434 | S PSGWD=$ S(WD'="zz" :WD,1:"NOT FOUND") | |
3435 | "RTN","PSG ZEBL",62,0 ) | |
3436 | S PSGDT=% | |
3437 | "RTN","PSG ZEBL",63,0 ) | |
3438 | D HDR2 | |
3439 | "RTN","PSG ZEBL",64,0 ) | |
3440 | Q | |
3441 | "RTN","PSG ZEBL",65,0 ) | |
3442 | ; | |
3443 | "RTN","PSG ZEBL",66,0 ) | |
3444 | HDR2 ;; Pr int header | |
3445 | "RTN","PSG ZEBL",67,0 ) | |
3446 | D ZEBFI | |
3447 | "RTN","PSG ZEBL",68,0 ) | |
3448 | D ZEBST(5 0,120,PSGW D_"-"_PSGR B) | |
3449 | "RTN","PSG ZEBL",69,0 ) | |
3450 | D ZEBST(5 0,160,PSGP N_" - *"_P SGSN) | |
3451 | "RTN","PSG ZEBL",70,0 ) | |
3452 | D ZEBST(5 0,240,"PRE -EXCHANGE UNITS REPO RT - "_P SGDT) | |
3453 | "RTN","PSG ZEBL",71,0 ) | |
3454 | Q | |
3455 | "RTN","PSG ZEBL",72,0 ) | |
3456 | ; | |
3457 | "RTN","PSG ZEBL",73,0 ) | |
3458 | GWR ; | |
3459 | "RTN","PSG ZEBL",74,0 ) | |
3460 | S WD=$G(^ DPT(DFN,.1 )),RB=$G(^ (.101)),PN =$P($G(^(0 )),"^") S: WD="" WD=" zz" S:RB=" " RB="NOT | |
3461 | FOUND" S:P N="" PN=DF N_";DPT(" | |
3462 | "RTN","PSG ZEBL",75,0 ) | |
3463 | S SPN=$E( PN,1,20)_" ^"_DFN,^TM P("PSGPER" ,$J,WD,SPN )=PN_"^"_R B_"^"_VA(" BID") Q | |
3464 | "RTN","PSG ZEBL",76,0 ) | |
3465 | ; | |
3466 | "RTN","PSG ZEBL",77,0 ) | |
3467 | ONI ; | |
3468 | "RTN","PSG ZEBL",78,0 ) | |
3469 | S | |
3470 | ND=$G(^PS( 55,DFN,5,O N,0)),DN=$ G(^(.2)),S CH=$P($G(^ (2)),"^"), MR=$P(ND," ^",3),ND=$ $ENNPN^PSG M | |
3471 | I($P(ND,"^ ",2)),DO=$ P(DN,"^",2 ),DN=$P(DN ,"^") I DN ="" S DN=" zz" | |
3472 | "RTN","PSG ZEBL",79,0 ) | |
3473 | E S DN=$ $ENPDN^PSG MI(DN) | |
3474 | "RTN","PSG ZEBL",80,0 ) | |
3475 | S:MR]"" M R=$$ENMRN^ PSGMI(MR) S | |
3476 | SDN=$E(DN, 1,20)_"^"_ ON,^TMP("P SGPER",$J, WD,SPN,SDN )=DN_"^"_D O_"^"_MR_" ^"_SCH_"^" _$P(ND | |
3477 | ,"^",2) Q | |
3478 | "RTN","PSG ZEBL",81,0 ) | |
3479 | ; | |
3480 | "RTN","PSG ZEBL",82,0 ) | |
3481 | DDS ; | |
3482 | "RTN","PSG ZEBL",83,0 ) | |
3483 | D SRXIEN^ PSGZEB1(+$ G(^PS(55,D FN,5,ON,1, +ND,0))) | |
3484 | "RTN","PSG ZEBL",84,0 ) | |
3485 | S | |
3486 | ND1=$G(^PS (55,DFN,5, ON,1,+ND,0 )),UD=$P(N D1,"^",2), ND1=$$ENDD N^PSGMI(+N D1),SND1=$ E(ND1,1, | |
3487 | 20)_"^"_+N D,ND=$P(ND ,"^",2) | |
3488 | "RTN","PSG ZEBL",85,0 ) | |
3489 | I ND#1 S ND=(ND\1)+ 1 | |
3490 | "RTN","PSG ZEBL",86,0 ) | |
3491 | S ^TMP("P SGPER",$J, WD,SPN,SDN ,SND1)=ND1 _"^"_UD_"^ "_ND_U_PSG RXIEN | |
3492 | "RTN","PSG ZEBL",87,0 ) | |
3493 | Q | |
3494 | "RTN","PSG ZEBL",88,0 ) | |
3495 | ; | |
3496 | "RTN","PSG ZEBL",89,0 ) | |
3497 | PPI ; gets patient s sn and pla ce it loca l variable | |
3498 | "RTN","PSG ZEBL",90,0 ) | |
3499 | S DFN=$P( PI,"^",2), PN=$P(RB," ^"),SN=$P( RB,"^",3), RB=$P(RB," ^",2) I 'R F,$Y+6>IOS L D NP Q:N P["^" | |
3500 | "RTN","PSG ZEBL",91,0 ) | |
3501 | S PSGPN=$ G(PN),PSGS N=$G(SN),P SGRB=$G(RB ) | |
3502 | "RTN","PSG ZEBL",92,0 ) | |
3503 | S PSGWD=$ S(WD'="zz" :WD,1:"NOT FOUND") | |
3504 | "RTN","PSG ZEBL",93,0 ) | |
3505 | D ZEBST(5 0,120,PSGW D_" - "_PS GRB) | |
3506 | "RTN","PSG ZEBL",94,0 ) | |
3507 | D ZEBST(5 0,160,PSGP N_" - *"_P SGSN) | |
3508 | "RTN","PSG ZEBL",95,0 ) | |
3509 | D ZEBST(5 0,240,"PRE -EXCHANGE UNITS REPO RT - "_P SGDT) | |
3510 | "RTN","PSG ZEBL",96,0 ) | |
3511 | Q | |
3512 | "RTN","PSG ZEBL",97,0 ) | |
3513 | ; | |
3514 | "RTN","PSG ZEBL",98,0 ) | |
3515 | OP ; | |
3516 | "RTN","PSG ZEBL",99,0 ) | |
3517 | S PX=$G(P X),PDN=$P( PX,"^"),DO =$P(PX,"^" ,2),MR=$P( PX,"^",3), SCH=$P(PX, "^",4) | |
3518 | "RTN","PSG ZEBL",100, 0) | |
3519 | S IXC=IXC +1 | |
3520 | "RTN","PSG ZEBL",101, 0) | |
3521 | I (PSGSHD R>0) D ZEB EL,HDR2 S PSGSHDR=0, PSGZI=PSGZ IS | |
3522 | "RTN","PSG ZEBL",102, 0) | |
3523 | D ZEBST(5 0,PSGZI,"" _PDN) S PS GZI=PSGZI+ 40 | |
3524 | "RTN","PSG ZEBL",103, 0) | |
3525 | D ZEBST(5 0,PSGZI,"" _DO) S PSG ZI=PSGZI+4 0 | |
3526 | "RTN","PSG ZEBL",104, 0) | |
3527 | D ZEBST(5 0,PSGZI,"" _SCH) S PS GZI=PSGZI+ 40 | |
3528 | "RTN","PSG ZEBL",105, 0) | |
3529 | Q | |
3530 | "RTN","PSG ZEBL",106, 0) | |
3531 | ; | |
3532 | "RTN","PSG ZEBL",107, 0) | |
3533 | PRT ; find order inf o and prin t same | |
3534 | "RTN","PSG ZEBL",108, 0) | |
3535 | I $G(RF)= "",$Y+4>IO SL D NP Q: NP="^" | |
3536 | "RTN","PSG ZEBL",109, 0) | |
3537 | D SRXIEN^ PSGZEB1($P (PX,"^",4) ) | |
3538 | "RTN","PSG ZEBL",110, 0) | |
3539 | I 1 S PDN =$P(PX,"^" ),UD=$P(PX ,"^",2),PX =$P(PX,"^" ,3) D | |
3540 | "RTN","PSG ZEBL",111, 0) | |
3541 | . S PSGDO =$J($S('UD :1,$E(UD)= ".":0_UD,1 :UD),5) | |
3542 | "RTN","PSG ZEBL",112, 0) | |
3543 | . I PSGZI >PSGZIMX D ZEBEL,HDR 2 S PSGZI= PSGZIS | |
3544 | "RTN","PSG ZEBL",113, 0) | |
3545 | . D ZEBST (50,PSGZI, PDN_" ("_P SGRXIEN_") ") S PSGZI =PSGZI+40 | |
3546 | "RTN","PSG ZEBL",114, 0) | |
3547 | . I PSGZI >PSGZIMX D ZEBEL,HDR 2 S PSGZI= PSGZIS | |
3548 | "RTN","PSG ZEBL",115, 0) | |
3549 | . D ZEBST (50,PSGZI, "U/D:"_PSG DO) | |
3550 | "RTN","PSG ZEBL",116, 0) | |
3551 | . D ZEBST (250,PSGZI ,"NEEDS:"_ $J(PX,5)) | |
3552 | "RTN","PSG ZEBL",117, 0) | |
3553 | . S PSGZI =PSGZI+40, PSGSHDR=1 | |
3554 | "RTN","PSG ZEBL",118, 0) | |
3555 | Q | |
3556 | "RTN","PSG ZEBL",119, 0) | |
3557 | ; | |
3558 | "RTN","PSG ZEBL",120, 0) | |
3559 | ZEBST(X,Y, TEXT) ; | |
3560 | "RTN","PSG ZEBL",121, 0) | |
3561 | D ZEBST^P SGZEB2(X,Y ,TEXT) | |
3562 | "RTN","PSG ZEBL",122, 0) | |
3563 | Q | |
3564 | "RTN","PSG ZEBL",123, 0) | |
3565 | ; | |
3566 | "RTN","PSG ZEBL",124, 0) | |
3567 | ZEBEL ; | |
3568 | "RTN","PSG ZEBL",125, 0) | |
3569 | D ZEBEL^P SGZEB2 | |
3570 | "RTN","PSG ZEBL",126, 0) | |
3571 | Q | |
3572 | "RTN","PSG ZEBL",127, 0) | |
3573 | ; | |
3574 | "RTN","PSG ZEBL",128, 0) | |
3575 | ZEBFI ; | |
3576 | "RTN","PSG ZEBL",129, 0) | |
3577 | D ZEBFI^P SGZEB2 | |
3578 | "RTN","PSG ZEBL",130, 0) | |
3579 | Q | |
3580 | "RTN","PSG ZEBL",131, 0) | |
3581 | ; | |
3582 | "RTN","PSI VHYPL") | |
3583 | 0^13^B4897 1823^B4937 8868 | |
3584 | "RTN","PSI VHYPL",1,0 ) | |
3585 | PSIVHYPL ; BIR/PR-PRI NT OUT LAB ELS ; 20 S ep 2018 1 1:20 AM | |
3586 | "RTN","PSI VHYPL",2,0 ) | |
3587 | ;;5.0;INP ATIENT MED ICATIONS;* *58,96,128 ,178,184,2 79,332**;1 6 DEC 97;B uild 8 | |
3588 | "RTN","PSI VHYPL",3,0 ) | |
3589 | ; | |
3590 | "RTN","PSI VHYPL",4,0 ) | |
3591 | ; Referen ce to ^%ZI S(2 is sup ported by DBIA 3435. | |
3592 | "RTN","PSI VHYPL",5,0 ) | |
3593 | ; Referen ce to ^PS( 52.6 is su pported by DBIA 1231 . | |
3594 | "RTN","PSI VHYPL",6,0 ) | |
3595 | ; Referen ce to ^PS( 52.7 is su pported by DBIA 2173 . | |
3596 | "RTN","PSI VHYPL",7,0 ) | |
3597 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
3598 | "RTN","PSI VHYPL",8,0 ) | |
3599 | ; Referen ce to ^PS( 50.4 is su pported by DBIA 2175 . | |
3600 | "RTN","PSI VHYPL",9,0 ) | |
3601 | ; Referen ce to ^PS( 51.2 is su pported by DBIA 2178 . | |
3602 | "RTN","PSI VHYPL",10, 0) | |
3603 | ; | |
3604 | "RTN","PSI VHYPL",11, 0) | |
3605 | ;NEEDS DF N, ON AND PSIVNOL (T otal numbe r of label s to print ) and | |
3606 | "RTN","PSI VHYPL",12, 0) | |
3607 | ;PSIVCT - $D(PSIVCT ) NO COUNT LABEL | |
3608 | "RTN","PSI VHYPL",13, 0) | |
3609 | SSWARD ;Ge t patient SS# and wa rd locatio n | |
3610 | "RTN","PSI VHYPL",14, 0) | |
3611 | N X0,PSJI O,I,PSIVCL AB | |
3612 | "RTN","PSI VHYPL",15, 0) | |
3613 | S I=0 F S I=$O(^%Z IS(2,IOST( 0),55,I)) Q:'I S X0 =^(I,0),PS JIO($P(X0, "^"))=^(1) | |
3614 | "RTN","PSI VHYPL",16, 0) | |
3615 | S PSJIO=$ S('$D(PSJI O):0,1:1) | |
3616 | "RTN","PSI VHYPL",17, 0) | |
3617 | N PSIVCLI N,PSIVCLDT S PSIVCLI N=+$G(^PS( 55,DFN,"IV ",+ON,"DSS ")) S:'(PS IVCLIN>0) PSIVCLIN=" " I | |
3618 | PSIVCLIN D | |
3619 | "RTN","PSI VHYPL",18, 0) | |
3620 | .S PSIVCL DT=$P(PSIV CLIN,"^",2 ) S $P(PSI VCLIN,"^", 2)=$P($G(^ SC(+PSIVCL IN,0)),"^" ) | |
3621 | "RTN","PSI VHYPL",19, 0) | |
3622 | I $G(PSIV CLIN) S PS IVCLAB=$P( $G(^SC(+PS IVCLIN,0)) ,"^",2) | |
3623 | "RTN","PSI VHYPL",20, 0) | |
3624 | D ENIV^PS JAC S | |
3625 | VADM(2)=$E (VADM(2),6 ,9),PSIVWD =$S(+VAIN( 4):$P(VAIN (4),U,2),$ G(PSIVCLIN )&($G(PSIV CLAB)]""): PSIV | |
3626 | CLAB,$G(PS IVCLIN)&($ P($G(PSIVC LIN),"^",2 )]""):$P(P SIVCLIN,"^ ",2),1:"* OPT *") | |
3627 | "RTN","PSI VHYPL",21, 0) | |
3628 | I PSIVWD= "",$P($G(^ PS(55,DFN, "IV",+ON,0 )),"^",22) S | |
3629 | PSIVWD=$P( $G(^DIC(42 ,+$P($G(^P S(55,DFN," IV",+ON,0) ),"^",22), 0)),"^") | |
3630 | "RTN","PSI VHYPL",22, 0) | |
3631 | G:PSIVNOL <1 Q D SET P,^PSIVHYP S | |
3632 | PSIVRM=$P( PSIVSITE,U ,13),P16=$ P($G(^PS(5 5,DFN,"IV" ,+ON,9)),U ,3) S:PSIV RM<1 PSIVR M=30 I | |
3633 | $D(PSIVCT) ,PSIVCT'=1 K PSIVCT | |
3634 | "RTN","PSI VHYPL",23, 0) | |
3635 | I PSJIO,$ G(PSJIO("F I"))]"" X PSJIO("FI" ) | |
3636 | "RTN","PSI VHYPL",24, 0) | |
3637 | I $P(PSIV SITE,U,7) D | |
3638 | "RTN","PSI VHYPL",25, 0) | |
3639 | . S PSIVF LAG=1,(LIN E,PSIV1)=0 ,PSIV2=PSI VNOL,PSIVN OL=0 D RE | |
3640 | "RTN","PSI VHYPL",26, 0) | |
3641 | . S PSIVR P="",PSIVR T="" | |
3642 | "RTN","PSI VHYPL",27, 0) | |
3643 | . I $D(^P S(55,DFN," IV",+ON,.2 )) S PSIVR P=$P(^PS(5 5,DFN,"IV" ,+ON,.2),U ,3) D | |
3644 | "RTN","PSI VHYPL",28, 0) | |
3645 | .. I PSIV 1'>0!'$P(P SIVSITE,U, 3)!($P(PSI VSITE,U,3) =1&(P(4)'= "P"))!($P( PSIVSITE,U ,3)=2&("AH "'[P(4))) Q | |
3646 | ;QUIT IF " DOSE DUE A T" LINE IS SET TO NO T PRINT | |
3647 | "RTN","PSI VHYPL",29, 0) | |
3648 | .. S PSIV RT=$P(^PS( 51.2,PSIVR P,0),U,1) | |
3649 | "RTN","PSI VHYPL",30, 0) | |
3650 | .. S X="R OUTE: "_PS IVRT D:X]" " PMR | |
3651 | "RTN","PSI VHYPL",31, 0) | |
3652 | . S X="So lution: __ __________ ___" D PRN TL S X="Ad ditive: __ __________ ___" D PRN TL | |
3653 | "RTN","PSI VHYPL",32, 0) | |
3654 | . S PSIVN OL=PSIV2 | |
3655 | "RTN","PSI VHYPL",33, 0) | |
3656 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
3657 | "RTN","PSI VHYPL",34, 0) | |
3658 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
3659 | "RTN","PSI VHYPL",35, 0) | |
3660 | I '$D(PSI VCT) D NOW ^%DTC S | |
3661 | Y=%,$P(^PS (55,DFN,"I V",+ON,9), U,1,2)=Y_" ^"_PSIVNOL ,$P(^(9),U ,3)=$P(^(9 ),U,3)+PSI VNOL | |
3662 | "RTN","PSI VHYPL",36, 0) | |
3663 | K PSIVFLA G,PSIVSH | |
3664 | "RTN","PSI VHYPL",37, 0) | |
3665 | START F PS IV1=1:1:PS IVNOL D | |
3666 | "RTN","PSI VHYPL",38, 0) | |
3667 | . S LINE= 0 D RE | |
3668 | "RTN","PSI VHYPL",39, 0) | |
3669 | . Q:$D(PS IVFLAG) | |
3670 | "RTN","PSI VHYPL",40, 0) | |
3671 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
3672 | "RTN","PSI VHYPL",41, 0) | |
3673 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
3674 | "RTN","PSI VHYPL",42, 0) | |
3675 | I PSJIO,$ G(PSJIO("F E"))]"" X PSJIO("FE" ) | |
3676 | "RTN","PSI VHYPL",43, 0) | |
3677 | D:'$D(PSI VCT) ^PSIV STAT | |
3678 | "RTN","PSI VHYPL",44, 0) | |
3679 | Q K | |
3680 | HYPL,LINE, MESS,P16,P DATE,PDOSE ,PSIV,PSIV A,PSIV1,PS IV2,PSIVCT ,PSIVDOSE, PSIVFLAG,P SIVRM,PSIV W | |
3681 | D,TVOL,HYP LPRT,PSIME SS Q | |
3682 | "RTN","PSI VHYPL",45, 0) | |
3683 | RE I PSIV1 S:P(15)>2 880!('P(15 )) P(15)=2 880 S P(16 )=P16+PSIV 1#(1440/P( 15)+.5\1) S:'P(16) | |
3684 | P(16)=1440 /P(15)+.5\ 1 | |
3685 | "RTN","PSI VHYPL",46, 0) | |
3686 | K DO | |
3687 | "RTN","PSI VHYPL",47, 0) | |
3688 | I PSJIO,$ G(PSJIO("S L"))]"" X PSJIO("SL" ) | |
3689 | "RTN","PSI VHYPL",48, 0) | |
3690 | I PSIV1 S PSJBCID=$ $BCMA^PSIV BCID(DFN,O N,$D(PSIVC T),$G(PSIV 1),$G(PSIV 2),$G(PSIV NOL)) D | |
3691 | BARCODE | |
3692 | "RTN","PSI VHYPL",49, 0) | |
3693 | S X="["_$ P(^PS(55,D FN,"IV",+O N,0),U)_"] "_" "_VADM (2)_" "_P SIVWD_" | |
3694 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
3695 | "RTN","PSI VHYPL",50, 0) | |
3696 | I ($G(PSI VCLIN)>0), $L($G(PSIV RM)),'$G(V AIN(4)) N PSJTRNC S PSJTRNC=$L (X)-+$G(PS IVRM) I | |
3697 | PSJTRNC>0, ($L(PSIVWD )>PSJTRNC) D | |
3698 | "RTN","PSI VHYPL",51, 0) | |
3699 | . S X="[" _$P(^PS(55 ,DFN,"IV", +ON,0),U)_ "]"_" "_VA DM(2)_" " _$E(PSIVWD ,1,$L(PSIV WD)-PSJTRN C)_" | |
3700 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
3701 | "RTN","PSI VHYPL",52, 0) | |
3702 | D PRNTL | |
3703 | "RTN","PSI VHYPL",53, 0) | |
3704 | S X=VADM( 1) S:$P(PS IVSITE,U,9 ) X=X_" " _$S(VAIN(5 )]"":VAIN( 5),1:"NF") D PRNTL S X=" " D P RNTL | |
3705 | "RTN","PSI VHYPL",54, 0) | |
3706 | D:$P(PSIV SITE,U,12) TVOL | |
3707 | "RTN","PSI VHYPL",55, 0) | |
3708 | S X="",$P (X,"=",PSI VRM-1)="" D PRNTL | |
3709 | "RTN","PSI VHYPL",56, 0) | |
3710 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(^PS (55,DFN,"I V",+ON,"AD ",PSIV)) Q :'PSIV S | |
3711 | Y=^(PSIV,0 ),X=$S($D( ^PS(52.6,+ Y,0)):$P(^ (0),U),1:" *********" )_" "_$P( Y,U,2)_" " S:$P(Y,U, 3)]"" X=X_ " | |
3712 | ("_$P(Y,U, 3)_")" D | |
3713 | "RTN","PSI VHYPL",57, 0) | |
3714 | . D PRNTL | |
3715 | "RTN","PSI VHYPL",58, 0) | |
3716 | . D MESS | |
3717 | "RTN","PSI VHYPL",59, 0) | |
3718 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(^PS (55,DFN,"I V",+ON,"SO L",PSIV)) Q:'PSIV S | |
3719 | PSIV=PSIV_ "^"_+^(PSI V,0),YY=^( 0) D | |
3720 | "RTN","PSI VHYPL",60, 0) | |
3721 | . D SOL1, PRNTL | |
3722 | "RTN","PSI VHYPL",61, 0) | |
3723 | . S X=$P( ^PS(52.7,$ P(PSIV,U,2 ),0),U,4) I X]"" S X =" "_X D PRNTL | |
3724 | "RTN","PSI VHYPL",62, 0) | |
3725 | G:$D(PSIV FLAG) SOL | |
3726 | "RTN","PSI VHYPL",63, 0) | |
3727 | F PSIV=0: 0 S PSIV=$ O(^PS(55,D FN,"IV",+O N,"SOL",PS IV)) Q:'PS IV S PSIV =PSIV_"^"_ +^(PSIV,0) ,YY=^(0) D | |
3728 | "RTN","PSI VHYPL",64, 0) | |
3729 | . D SOL1, PRNTL I PS IV1 D UP3^ PSIVBCID(D FN,PSJBLN, PSIV,YY) | |
3730 | "RTN","PSI VHYPL",65, 0) | |
3731 | . S X=$P( ^PS(52.7,$ P(PSIV,U,2 ),0),U,4) I X]"" S X =" "_X D PRNTL | |
3732 | "RTN","PSI VHYPL",66, 0) | |
3733 | F I=0:0 S I=$O(HYPL (I)) Q:'I S PSIV="" D | |
3734 | "RTN","PSI VHYPL",67, 0) | |
3735 | . F I=I:0 S PSIV=$O (HYPL(I,PS IV)) Q:PSI V="" S Y= "",X=0 D | |
3736 | "RTN","PSI VHYPL",68, 0) | |
3737 | .. X "F Z Z=0:0 S Y= $O(HYPL(I, PSIV,Y)) Q :Y="""" I Y=""ALL"" !(Y=""***" ")!(Y[P(16 )) S | |
3738 | X=X+$P(HYP L(I,PSIV,Y ),U),PSIVP =HYPL(I,PS IV,Y) D UP D" | |
3739 | "RTN","PSI VHYPL",69, 0) | |
3740 | .. I X D HYP | |
3741 | "RTN","PSI VHYPL",70, 0) | |
3742 | K HYPAD | |
3743 | "RTN","PSI VHYPL",71, 0) | |
3744 | SOL S X="" ,$P(X,"=", PSIVRM-1)= "" D PRNTL | |
3745 | "RTN","PSI VHYPL",72, 0) | |
3746 | S X=" " D PRNTL I | |
3747 | PSIV1'>0!' $P(PSIVSIT E,U,3)!($P (PSIVSITE, U,3)=1&(P( 4)'="P"))! ($P(PSIVSI TE,U,3)=2& ("AH"'[P(4 ))) G | |
3748 | MEDRT | |
3749 | "RTN","PSI VHYPL",73, 0) | |
3750 | S:'$D(PSI VDOSE) PSI VDOSE="" S X=$P(PSIV DOSE," ",P SIV1) D:$E (X)="." CO NVER^PSIVL ABL S X="D ose | |
3751 | due at: "_ $S(X="":"_ _______",1 :$E(X,4,5) _"/"_$E(X, 6,7)_"/"_$ E(X,2,3)_" "_$E(X#1_ "000",2,5) ) D PRNTL | |
3752 | "RTN","PSI VHYPL",74, 0) | |
3753 | ; | |
3754 | "RTN","PSI VHYPL",75, 0) | |
3755 | MEDRT ;Fin d Medicati on Route | |
3756 | "RTN","PSI VHYPL",76, 0) | |
3757 | S PSIVRP= "",PSIVRT= "" | |
3758 | "RTN","PSI VHYPL",77, 0) | |
3759 | I $D(^PS( 55,DFN,"IV ",+ON,.2)) S PSIVRP= $P(^PS(55, DFN,"IV",+ ON,.2),U,3 ) D | |
3760 | "RTN","PSI VHYPL",78, 0) | |
3761 | .S PSIVRT =$P(^PS(51 .2,PSIVRP, 0),U,1) | |
3762 | "RTN","PSI VHYPL",79, 0) | |
3763 | .S X="ROU TE: "_PSIV RT D:X]"" PMR | |
3764 | "RTN","PSI VHYPL",80, 0) | |
3765 | ; | |
3766 | "RTN","PSI VHYPL",81, 0) | |
3767 | INF S X=$P (P(8),"@") D:X]"" PR NTL | |
3768 | "RTN","PSI VHYPL",82, 0) | |
3769 | I $D(^PS( 55,DFN,"IV ",+ON,3)) S X=$P(^(3 ),U) D:X]" " PRNTL | |
3770 | "RTN","PSI VHYPL",83, 0) | |
3771 | S X=P(9) D:X]"" PRN TL | |
3772 | "RTN","PSI VHYPL",84, 0) | |
3773 | S X=P(11) D:X]"" PR NTL | |
3774 | "RTN","PSI VHYPL",85, 0) | |
3775 | ;PSJ*5*18 4 - Displa y all mess ages if mo re than on e additive has a mes sage. | |
3776 | "RTN","PSI VHYPL",86, 0) | |
3777 | I $D(MESS ) S PSIMES S="" F S PSIMESS=$O (MESS(PSIM ESS)) Q:PS IMESS="" S X=PSIMES S D PRNTL | |
3778 | "RTN","PSI VHYPL",87, 0) | |
3779 | I $D(^PS( 59.5,PSIVS N,4)) S Y= ^(4) F PSI V=1:1 S X= $P(Y,U,PSI V) Q:X="" D PRNTL | |
3780 | "RTN","PSI VHYPL",88, 0) | |
3781 | S X=PSIV1 _"["_PSIVN OL_"]" D P RNTL | |
3782 | "RTN","PSI VHYPL",89, 0) | |
3783 | Q | |
3784 | "RTN","PSI VHYPL",90, 0) | |
3785 | PRNTL N I F LINE=LIN E+1:1 D Q :$L(X)<1 | |
3786 | "RTN","PSI VHYPL",91, 0) | |
3787 | . I LINE> PSIVSITE D | |
3788 | "RTN","PSI VHYPL",92, 0) | |
3789 | .. S LINE =1 | |
3790 | "RTN","PSI VHYPL",93, 0) | |
3791 | .. I 'PSJ IO D Q | |
3792 | "RTN","PSI VHYPL",94, 0) | |
3793 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
3794 | "RTN","PSI VHYPL",95, 0) | |
3795 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
3796 | "RTN","PSI VHYPL",96, 0) | |
3797 | . K ZZ | |
3798 | "RTN","PSI VHYPL",97, 0) | |
3799 | . F I="ST ","STF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
3800 | "RTN","PSI VHYPL",98, 0) | |
3801 | . W $E(X, 1,PSIVRM) | |
3802 | "RTN","PSI VHYPL",99, 0) | |
3803 | . F I="ET F","ET" I $G(PSJIO(I ))]"" X PS JIO(I) | |
3804 | "RTN","PSI VHYPL",100 ,0) | |
3805 | . I 'PSJI O W ! | |
3806 | "RTN","PSI VHYPL",101 ,0) | |
3807 | . S X=$E( X,PSIVRM+1 ,999) | |
3808 | "RTN","PSI VHYPL",102 ,0) | |
3809 | Q | |
3810 | "RTN","PSI VHYPL",103 ,0) | |
3811 | PMR ; Prin t Med Rout e on label | |
3812 | "RTN","PSI VHYPL",104 ,0) | |
3813 | ; | |
3814 | "RTN","PSI VHYPL",105 ,0) | |
3815 | F LINE=LI NE+1:1 D Q:$L(X)<1 | |
3816 | "RTN","PSI VHYPL",106 ,0) | |
3817 | . I LINE> PSIVSITE D | |
3818 | "RTN","PSI VHYPL",107 ,0) | |
3819 | .. S LINE =1 | |
3820 | "RTN","PSI VHYPL",108 ,0) | |
3821 | .. I 'PSJ IO D Q | |
3822 | "RTN","PSI VHYPL",109 ,0) | |
3823 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
3824 | "RTN","PSI VHYPL",110 ,0) | |
3825 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
3826 | "RTN","PSI VHYPL",111 ,0) | |
3827 | . K ZZ | |
3828 | "RTN","PSI VHYPL",112 ,0) | |
3829 | . ; | |
3830 | "RTN","PSI VHYPL",113 ,0) | |
3831 | . F I="ST ","STF","S M","SMF" I $G(PSJIO( I))]"" X P SJIO(I) | |
3832 | "RTN","PSI VHYPL",114 ,0) | |
3833 | . W $E(X, 1,PSIVRM) | |
3834 | "RTN","PSI VHYPL",115 ,0) | |
3835 | . F I="ET F","ET","E MF","EM" I $G(PSJIO( I))]"" X P SJIO(I) | |
3836 | "RTN","PSI VHYPL",116 ,0) | |
3837 | . I 'PSJI O W ! | |
3838 | "RTN","PSI VHYPL",117 ,0) | |
3839 | . S X=$E( X,PSIVRM+1 ,999) | |
3840 | "RTN","PSI VHYPL",118 ,0) | |
3841 | Q | |
3842 | "RTN","PSI VHYPL",119 ,0) | |
3843 | TVOL ; | |
3844 | "RTN","PSI VHYPL",120 ,0) | |
3845 | S PSIV=TV OL F X=0:0 S X=$O(^P S(55,DFN," IV",+ON,"A D",X)) Q:' X S X=X_" ^"_^(X,0) | |
3846 | S:$P(X,U,4 )[P(16)!($ P(X,U,4)=" ")!'PSIV1 | |
3847 | PSIV=PSIV+ $S($P(^PS( 52.6,$P(X, U,2),0),U, 10):$P(X,U ,3)/$P(^(0 ),U,10),1: 0) | |
3848 | "RTN","PSI VHYPL",121 ,0) | |
3849 | S X="Tota l Volume: "_(PSIV+.5 \1) D PRNT L | |
3850 | "RTN","PSI VHYPL",122 ,0) | |
3851 | Q | |
3852 | "RTN","PSI VHYPL",123 ,0) | |
3853 | SOL1 S X=$ S($D(^PS(5 2.7,$P(PSI V,U,2),0)) :$P(^(0),U )_" | |
3854 | "_$P(^PS(5 5,DFN,"IV" ,+ON,"SOL" ,+PSIV,0), U,2),1:"** ********") Q | |
3855 | "RTN","PSI VHYPL",124 ,0) | |
3856 | HYP ; | |
3857 | "RTN","PSI VHYPL",125 ,0) | |
3858 | I PSIV="* " S X="*** Error in "_$S(I=50. 4:"electro lyte",I=52 .7:"soluti on",1:"add itive") D PRNTL Q | |
3859 | "RTN","PSI VHYPL",126 ,0) | |
3860 | S | |
3861 | PSIVA=$S(I =50.4:PSIV ,I=52.7:+$ G(^PS(55,D FN,"IV",+O N,"SOL",PS IV,0)),1:+ $G(^PS(55, DFN,"IV",+ ON,"AD", | |
3862 | PSIV,0))) | |
3863 | "RTN","PSI VHYPL",127 ,0) | |
3864 | S X=$S($D (^PS(I,PSI VA,0)):$P( ^(0),U),1: "Undefined | |
3865 | "_$S(I=50. 4:"electro lyte",I=52 .7:"soluti on",1:"add itive"))_" | |
3866 | "_$S(X<1:" 0"_(X+.005 \.01/100), 1:(X+.005\ .01/100))_ " "_$P($P( HYPL(I,PSI V,$O(HYPL( I,PSIV,"") )),U)," ", 2) | |
3867 | "RTN","PSI VHYPL",128 ,0) | |
3868 | D PRNTL | |
3869 | "RTN","PSI VHYPL",129 ,0) | |
3870 | Q | |
3871 | "RTN","PSI VHYPL",130 ,0) | |
3872 | SETP S Y=^ PS(55,DFN, "IV",+ON,0 ) F X=1:1: 23 S P(X)= $P(Y,U,X) | |
3873 | "RTN","PSI VHYPL",131 ,0) | |
3874 | Q | |
3875 | "RTN","PSI VHYPL",132 ,0) | |
3876 | MESS ;PSJ* 5*184 -mak e MESS a l ocal array so all me ssages dis play for a ll additiv es. | |
3877 | "RTN","PSI VHYPL",133 ,0) | |
3878 | I $P(^PS( 52.6,+Y,0) ,U,9)]"" S MESS($P(^ PS(52.6,+Y ,0),U,9))= "" | |
3879 | "RTN","PSI VHYPL",134 ,0) | |
3880 | Q | |
3881 | "RTN","PSI VHYPL",135 ,0) | |
3882 | UPD N X,Y, PSIVEL,PSI VAD | |
3883 | "RTN","PSI VHYPL",136 ,0) | |
3884 | S PSIVEL= $P(PSIVP," ^",2) | |
3885 | "RTN","PSI VHYPL",137 ,0) | |
3886 | I I=50.4 F PSIVAD=0 :0 S PSIVA D=$O(HYPLR PT(PSIVEL, "AD",PSIVA D)) Q:'PSI VAD D | |
3887 | "RTN","PSI VHYPL",138 ,0) | |
3888 | .I $D(HYP AD(+PSIVAD )) Q | |
3889 | "RTN","PSI VHYPL",139 ,0) | |
3890 | .S YY=$G( ^PS(55,DFN ,"IV",+ON, "AD",+PSIV AD,0)) | |
3891 | "RTN","PSI VHYPL",140 ,0) | |
3892 | .S HYPAD( +PSIVAD)=" " | |
3893 | "RTN","PSI VHYPL",141 ,0) | |
3894 | .I +$P(YY ,U,3),(+$P (YY,U,3)'= P(16)) Q | |
3895 | "RTN","PSI VHYPL",142 ,0) | |
3896 | .D UP2^PS IVBCID(DFN ,PSJBLN,PS IV,YY) | |
3897 | "RTN","PSI VHYPL",143 ,0) | |
3898 | I I'=50.4 S YY=$G(^ PS(55,DFN, "IV",+ON," AD",+PSIV, 0)) D UP2^ PSIVBCID(D FN,PSJBLN, PSIV,YY) | |
3899 | "RTN","PSI VHYPL",144 ,0) | |
3900 | Q | |
3901 | "RTN","PSI VHYPL",145 ,0) | |
3902 | BARCODE D PSET^%ZISP | |
3903 | "RTN","PSI VHYPL",146 ,0) | |
3904 | I 'PSJIO D | |
3905 | "RTN","PSI VHYPL",147 ,0) | |
3906 | . I IOBAR ON]"" W @I OBARON | |
3907 | "RTN","PSI VHYPL",148 ,0) | |
3908 | . W PSJBC ID | |
3909 | "RTN","PSI VHYPL",149 ,0) | |
3910 | . I IOBAR OFF]"" W @ IOBAROFF | |
3911 | "RTN","PSI VHYPL",150 ,0) | |
3912 | . W ! | |
3913 | "RTN","PSI VHYPL",151 ,0) | |
3914 | I PSJIO D | |
3915 | "RTN","PSI VHYPL",152 ,0) | |
3916 | . F I="SB ","SBF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
3917 | "RTN","PSI VHYPL",153 ,0) | |
3918 | . W PSJBC ID | |
3919 | "RTN","PSI VHYPL",154 ,0) | |
3920 | . F I="EB F","EB" I $G(PSJIO(I ))]"" X PS JIO(I) | |
3921 | "RTN","PSI VHYPL",155 ,0) | |
3922 | Q | |
3923 | "RTN","PSI VHYPR") | |
3924 | 0^12^B4637 5207^B4640 5814 | |
3925 | "RTN","PSI VHYPR",1,0 ) | |
3926 | PSIVHYPR ; BIR/PR-REP RINT LABEL S ; 20 Sep 2018 11: 21 AM | |
3927 | "RTN","PSI VHYPR",2,0 ) | |
3928 | ;;5.0;INP ATIENT MED ICATIONS;* *58,88,96, 178,184,27 9,332**;16 DEC 97;Bu ild 8 | |
3929 | "RTN","PSI VHYPR",3,0 ) | |
3930 | ; | |
3931 | "RTN","PSI VHYPR",4,0 ) | |
3932 | ; Referen ce to ^%ZI S(2 is sup ported by DBIA 3435. | |
3933 | "RTN","PSI VHYPR",5,0 ) | |
3934 | ; Referen ce to ^PS( 50.4 is su pported by DBIA 2175 . | |
3935 | "RTN","PSI VHYPR",6,0 ) | |
3936 | ; Referen ce to ^PS( 52.6 is su pported by DBIA 1231 . | |
3937 | "RTN","PSI VHYPR",7,0 ) | |
3938 | ; Referen ce to ^PS( 52.7 is su pported by DBIA 2173 . | |
3939 | "RTN","PSI VHYPR",8,0 ) | |
3940 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
3941 | "RTN","PSI VHYPR",9,0 ) | |
3942 | ; Referen ce to ^PS( 51.2 is su pported by DBIA 2178 . | |
3943 | "RTN","PSI VHYPR",10, 0) | |
3944 | ; | |
3945 | "RTN","PSI VHYPR",11, 0) | |
3946 | ;NEEDS DF N, ON AND PSIVNOL (T otal numbe r of label s to print ) and | |
3947 | "RTN","PSI VHYPR",12, 0) | |
3948 | ;PSIVCT - $D(PSIVCT ) NO COUNT LABEL | |
3949 | "RTN","PSI VHYPR",13, 0) | |
3950 | SSWARD ;Ge t patient SS# and wa rd locatio n | |
3951 | "RTN","PSI VHYPR",14, 0) | |
3952 | N X0,PSJI O,I,PSIVCL AB | |
3953 | "RTN","PSI VHYPR",15, 0) | |
3954 | S I=0 F S I=$O(^%Z IS(2,IOST( 0),55,I)) Q:'I S X0 =^(I,0),PS JIO($P(X0, "^"))=^(1) | |
3955 | "RTN","PSI VHYPR",16, 0) | |
3956 | S PSJIO=$ S('$D(PSJI O):0,1:1) | |
3957 | "RTN","PSI VHYPR",17, 0) | |
3958 | N PSIVCLI N S PSIVCL IN=+$G(^PS (55,DFN,"I V",+ON,"DS S")) I PSI VCLIN S | |
3959 | $P(PSIVCLI N,"^",2)=$ P($G(^SC(+ PSIVCLIN,0 )),"^") | |
3960 | "RTN","PSI VHYPR",18, 0) | |
3961 | I $G(PSIV CLIN) S PS IVCLAB=$P( $G(^SC(+PS IVCLIN,0)) ,"^",2) | |
3962 | "RTN","PSI VHYPR",19, 0) | |
3963 | D ENIV^PS JAC S | |
3964 | VADM(2)=$E (VADM(2),6 ,9),PSIVWD =$S(+VAIN( 4):$P(VAIN (4),U,2),$ G(PSIVCLIN )&($G(PSIV CLAB)]""): PSIV | |
3965 | CLAB,$G(PS IVCLIN)&($ P($G(PSIVC LIN),"^",2 )]""):$P(P SIVCLIN,"^ ",2),1:"* OPT *") | |
3966 | "RTN","PSI VHYPR",20, 0) | |
3967 | I PSIVWD= "",$P($G(^ PS(55,DFN, "IV",+ON,0 )),"^",22) S | |
3968 | PSIVWD=$P( $G(^DIC(42 ,+$P($G(^P S(55,DFN," IV",+ON,0) ),"^",22), 0)),"^") | |
3969 | "RTN","PSI VHYPR",21, 0) | |
3970 | ;;NEW PSI VNOL,PSIV1 S (PSIVNO L,PSIV1)=1 | |
3971 | "RTN","PSI VHYPR",22, 0) | |
3972 | NEW PSIV1 S PSIV1=1 | |
3973 | "RTN","PSI VHYPR",23, 0) | |
3974 | G:PSIVNOL <1 Q D SET P,PSIVHYP S PSIVRM=$ P(PSIVSITE ,U,13),P16 =$P($G(^PS (55,DFN,"I V",+ON,9)) ,U,3) | |
3975 | S:PSIVRM<1 PSIVRM=30 I $D(PSIV CT),PSIVCT '=1 K PSIV CT | |
3976 | "RTN","PSI VHYPR",24, 0) | |
3977 | I PSJIO,$ G(PSJIO("F I"))]"" X PSJIO("FI" ) | |
3978 | "RTN","PSI VHYPR",25, 0) | |
3979 | ;PSJRPHD is defined in REPRT^ PSIVLBRP | |
3980 | "RTN","PSI VHYPR",26, 0) | |
3981 | I $P(PSIV SITE,U,7), '$D(PSJRPH D) D | |
3982 | "RTN","PSI VHYPR",27, 0) | |
3983 | . S PSIVF LAG=1,(LIN E,PSIV1)=0 ,PSIV2=PSI VNOL,PSIVN OL=0 D RE | |
3984 | "RTN","PSI VHYPR",28, 0) | |
3985 | . S PSIVR P="",PSIVR T="" | |
3986 | "RTN","PSI VHYPR",29, 0) | |
3987 | . I $D(^P S(55,DFN," IV",+ON,.2 )) S PSIVR P=$P(^PS(5 5,DFN,"IV" ,+ON,.2),U ,3) D | |
3988 | "RTN","PSI VHYPR",30, 0) | |
3989 | .. I PSIV 1'>0!'$P(P SIVSITE,U, 3)!($P(PSI VSITE,U,3) =1&(P(4)'= "P"))!($P( PSIVSITE,U ,3)=2&("AH "'[P(4))) Q | |
3990 | ;QUIT IF " DOSE DUE A T" IS SET TO NOT PRI NT | |
3991 | "RTN","PSI VHYPR",31, 0) | |
3992 | .. S PSIV RT=$P(^PS( 51.2,PSIVR P,0),U,1) | |
3993 | "RTN","PSI VHYPR",32, 0) | |
3994 | .. S X="R OUTE: "_PS IVRT D:X]" " PMR | |
3995 | "RTN","PSI VHYPR",33, 0) | |
3996 | . S X="So lution: __ __________ ___" D PRN TL S X="Ad ditive: __ __________ ___" D PRN TL | |
3997 | "RTN","PSI VHYPR",34, 0) | |
3998 | . S PSIVN OL=PSIV2 | |
3999 | "RTN","PSI VHYPR",35, 0) | |
4000 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
4001 | "RTN","PSI VHYPR",36, 0) | |
4002 | . I PSJIO F I="EL", "FE" I $G( PSJIO(I))] "" X PSJIO (I) | |
4003 | "RTN","PSI VHYPR",37, 0) | |
4004 | I '$D(PSI VCT) D NOW ^%DTC S | |
4005 | Y=%,$P(^PS (55,DFN,"I V",+ON,9), U,1,2)=Y_" ^"_PSIVNOL ,$P(^(9),U ,3)=$P(^(9 ),U,3)+1 | |
4006 | "RTN","PSI VHYPR",38, 0) | |
4007 | K PSIVFLA G,PSIVSH | |
4008 | "RTN","PSI VHYPR",39, 0) | |
4009 | START S PS IV1=1,LINE =0 D RE D | |
4010 | "RTN","PSI VHYPR",40, 0) | |
4011 | . Q:$D(PS IVFLAG) | |
4012 | "RTN","PSI VHYPR",41, 0) | |
4013 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
4014 | "RTN","PSI VHYPR",42, 0) | |
4015 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
4016 | "RTN","PSI VHYPR",43, 0) | |
4017 | I PSJIO,$ G(PSJIO("F E"))]"" X PSJIO("FE" ) | |
4018 | "RTN","PSI VHYPR",44, 0) | |
4019 | ;;D:'$D(P SIVCT) ^PS IVSTAT | |
4020 | "RTN","PSI VHYPR",45, 0) | |
4021 | I '$D(PSI VCT) D ^PS IVSTAT S P (16)=P(16) +PSIVNOL | |
4022 | "RTN","PSI VHYPR",46, 0) | |
4023 | Q K | |
4024 | HYPL,LINE, MESS,P16,P DATE,PDOSE ,PSIV,PSIV A,PSIV1,PS IV2,PSIVCT ,PSIVDOSE, PSIVFLAG,P SIVRM,PSIV W | |
4025 | D,TVOL,PSI MESS Q | |
4026 | "RTN","PSI VHYPR",47, 0) | |
4027 | RE ;I PSIV 1 S:P(15)> 2880!('P(1 5)) P(15)= 2880 S P(1 6)=P16+PSI V1#(1440/P (15)+.5\1) S:'P(16) | |
4028 | P(16)=1440 /P(15)+.5\ 1 | |
4029 | "RTN","PSI VHYPR",48, 0) | |
4030 | I PSJIO,$ G(PSJIO("S L"))]"" X PSJIO("SL" ) | |
4031 | "RTN","PSI VHYPR",49, 0) | |
4032 | I PSIV1 D BARCODE | |
4033 | "RTN","PSI VHYPR",50, 0) | |
4034 | S X="["_$ P(^PS(55,D FN,"IV",+O N,0),U)_"] "_" "_VADM (2)_" "_P SIVWD_" | |
4035 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
4036 | "RTN","PSI VHYPR",51, 0) | |
4037 | D | |
4038 | "RTN","PSI VHYPR",52, 0) | |
4039 | .N PSJICW ,TMPX,TMPX 1,TMPX2 S TMPX=X,TMP X1="" I $L (TMPX)>(PS IVRM-1) F PSJICW=1:1 :$L(TMPX," | |
4040 | ") S TMPX1 =TMPX1_$S( PSJICW=1:" ",1:" ")_$ P(TMPX," " ,PSJICW) I $L(TMPX1) +$L($P(TMP X," | |
4041 | ",PSJICW+1 ))>(PSIVRM -1) S X=TM PX1 D PRNT L S TMPX1= "",X="" | |
4042 | "RTN","PSI VHYPR",53, 0) | |
4043 | .I TMPX1] "" S X=TMP X1 | |
4044 | "RTN","PSI VHYPR",54, 0) | |
4045 | .D PRNTL | |
4046 | "RTN","PSI VHYPR",55, 0) | |
4047 | S X=VADM( 1) S:$P(PS IVSITE,U,9 ) X=X_" " _$S(VAIN(5 )]"":VAIN( 5),1:"NF") D PRNTL S X=" " D P RNTL | |
4048 | "RTN","PSI VHYPR",56, 0) | |
4049 | D:$P(PSIV SITE,U,12) TVOL | |
4050 | "RTN","PSI VHYPR",57, 0) | |
4051 | S X="",$P (X,"=",PSI VRM-1)="" D PRNTL | |
4052 | "RTN","PSI VHYPR",58, 0) | |
4053 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(^PS (55,DFN,"I V",+ON,"AD ",PSIV)) Q :'PSIV S | |
4054 | Y=^(PSIV,0 ),X=$S($D( ^PS(52.6,+ Y,0)):$P(^ (0),U),1:" *********" )_" "_$P(Y ,U,2)_" " S:$P(Y,U,3 )]"" X=X_" | |
4055 | ("_$P(Y,U, 3)_")" D | |
4056 | "RTN","PSI VHYPR",59, 0) | |
4057 | . D PRNTL ,MESS | |
4058 | "RTN","PSI VHYPR",60, 0) | |
4059 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(^PS (55,DFN,"I V",+ON,"SO L",PSIV)) Q:'PSIV S | |
4060 | PSIV=PSIV_ "^"_+^(PSI V,0),YY=^( 0) D | |
4061 | "RTN","PSI VHYPR",61, 0) | |
4062 | . D SOL1, PRNTL | |
4063 | "RTN","PSI VHYPR",62, 0) | |
4064 | . S X=$P( ^PS(52.7,$ P(PSIV,U,2 ),0),U,4) I X]"" S X =" "_X D PRNTL | |
4065 | "RTN","PSI VHYPR",63, 0) | |
4066 | G:$D(PSIV FLAG) SOL | |
4067 | "RTN","PSI VHYPR",64, 0) | |
4068 | F PSIV=0: 0 S PSIV=$ O(^PS(55,D FN,"IVBCMA ",PSJIDNO, "SOL",PSIV )) Q:'PSIV S | |
4069 | PSIV=PSIV_ "^"_+^(PSI V,0),YY=^( 0) D | |
4070 | "RTN","PSI VHYPR",65, 0) | |
4071 | . D SOL1, PRNTL | |
4072 | "RTN","PSI VHYPR",66, 0) | |
4073 | . S X=$P( ^PS(52.7,$ P(PSIV,U,2 ),0),U,4) I X]"" S X =" "_X D PRNTL | |
4074 | "RTN","PSI VHYPR",67, 0) | |
4075 | F I=0:0 S I=$O(HYPL (I)) Q:'I S PSIV="" F I=I:0 S PSIV=$O(H YPL(I,PSIV )) Q:PSIV= "" D | |
4076 | "RTN","PSI VHYPR",68, 0) | |
4077 | . F Z="" S Z=$O(HYP L(I,PSIV,Z )) Q:Z="" S | |
4078 | PSIVA=$S(I =50.4:PSIV ,I=52.7:+^ PS(55,DFN, "IVBCMA",P SJIDNO,"SO L",+$P(HYP L(I,PSIV,Z ),U,2),0), 1:+^PS(5 | |
4079 | 5,DFN,"IVB CMA",PSJID NO,"AD",+$ P(HYPL(I,P SIV,Z),U,2 ),0)) D HY P | |
4080 | "RTN","PSI VHYPR",69, 0) | |
4081 | SOL S X="" ,$P(X,"=", PSIVRM-1)= "" D PRNTL | |
4082 | "RTN","PSI VHYPR",70, 0) | |
4083 | S X=" " D PRNTL I | |
4084 | PSIV1'>0!' $P(PSIVSIT E,U,3)!($P (PSIVSITE, U,3)=1&(P( 4)'="P"))! ($P(PSIVSI TE,U,3)=2& ("AH"'[P(4 ))) G | |
4085 | MEDRT | |
4086 | "RTN","PSI VHYPR",71, 0) | |
4087 | S:'$D(PSI VDOSE) PSI VDOSE="" S X=$P(PSIV DOSE," ",P SIV1) D:$E (X)="." CO NVER^PSIVL ABL S X="D ose | |
4088 | due at: "_ $S(X="":"_ _______",1 :$E(X,4,5) _"/"_$E(X, 6,7)_"/"_$ E(X,2,3)_" "_$E(X#1_ "000",2,5) ) D PRNTL | |
4089 | "RTN","PSI VHYPR",72, 0) | |
4090 | ; | |
4091 | "RTN","PSI VHYPR",73, 0) | |
4092 | MEDRT ;Fin d Medicati on Route | |
4093 | "RTN","PSI VHYPR",74, 0) | |
4094 | S PSIVRP= "",PSIVRT= "" | |
4095 | "RTN","PSI VHYPR",75, 0) | |
4096 | I $D(^PS( 55,DFN,"IV ",+ON,.2)) S PSIVRP= $P(^PS(55, DFN,"IV",+ ON,.2),U,3 ) D | |
4097 | "RTN","PSI VHYPR",76, 0) | |
4098 | .S PSIVRT =$P(^PS(51 .2,PSIVRP, 0),U,1) | |
4099 | "RTN","PSI VHYPR",77, 0) | |
4100 | .S X="ROU TE: "_PSIV RT D:X]"" PMR | |
4101 | "RTN","PSI VHYPR",78, 0) | |
4102 | ; | |
4103 | "RTN","PSI VHYPR",79, 0) | |
4104 | INF S X=$P (P(8),"@") D:X]"" PR NTL | |
4105 | "RTN","PSI VHYPR",80, 0) | |
4106 | I $D(^PS( 55,DFN,"IV ",+ON,3)) S X=$P(^(3 ),U) D:X]" " PRNTL | |
4107 | "RTN","PSI VHYPR",81, 0) | |
4108 | S X=P(9) D:X]"" PRN TL | |
4109 | "RTN","PSI VHYPR",82, 0) | |
4110 | S X=P(11) D:X]"" PR NTL | |
4111 | "RTN","PSI VHYPR",83, 0) | |
4112 | ;PSJ*5*18 4 - Displa y all mess ages if mo re than on e additive has a mes sage. | |
4113 | "RTN","PSI VHYPR",84, 0) | |
4114 | I $D(MESS ) S PSIMES S="" F S PSIMESS=$O (MESS(PSIM ESS)) Q:PS IMESS="" S X=PSIMES S D PRNTL | |
4115 | "RTN","PSI VHYPR",85, 0) | |
4116 | I $D(^PS( 59.5,PSIVS N,4)) S Y= ^(4) F PSI V=1:1 S X= $P(Y,U,PSI V) Q:X="" D PRNTL | |
4117 | "RTN","PSI VHYPR",86, 0) | |
4118 | S X=$S('+ $G(PSIV1): "0[0]",1:P SIVBAG) D PRNTL | |
4119 | "RTN","PSI VHYPR",87, 0) | |
4120 | Q | |
4121 | "RTN","PSI VHYPR",88, 0) | |
4122 | PRNTL N I F LINE=LIN E+1:1 D Q :$L(X)<1 | |
4123 | "RTN","PSI VHYPR",89, 0) | |
4124 | . I LINE> PSIVSITE D | |
4125 | "RTN","PSI VHYPR",90, 0) | |
4126 | .. S LINE =1 | |
4127 | "RTN","PSI VHYPR",91, 0) | |
4128 | .. I 'PSJ IO D Q | |
4129 | "RTN","PSI VHYPR",92, 0) | |
4130 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
4131 | "RTN","PSI VHYPR",93, 0) | |
4132 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4133 | "RTN","PSI VHYPR",94, 0) | |
4134 | . K ZZ | |
4135 | "RTN","PSI VHYPR",95, 0) | |
4136 | . F I="ST ","STF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4137 | "RTN","PSI VHYPR",96, 0) | |
4138 | . W $E(X, 1,PSIVRM) | |
4139 | "RTN","PSI VHYPR",97, 0) | |
4140 | . F I="ET F","ET" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4141 | "RTN","PSI VHYPR",98, 0) | |
4142 | . I 'PSJI O W ! | |
4143 | "RTN","PSI VHYPR",99, 0) | |
4144 | . S X=$E( X,PSIVRM+1 ,999) | |
4145 | "RTN","PSI VHYPR",100 ,0) | |
4146 | Q | |
4147 | "RTN","PSI VHYPR",101 ,0) | |
4148 | PMR ; Prin t Med Rout e on label | |
4149 | "RTN","PSI VHYPR",102 ,0) | |
4150 | F LINE=LI NE+1:1 D Q:$L(X)<1 | |
4151 | "RTN","PSI VHYPR",103 ,0) | |
4152 | . I LINE> PSIVSITE D | |
4153 | "RTN","PSI VHYPR",104 ,0) | |
4154 | .. S LINE =1 | |
4155 | "RTN","PSI VHYPR",105 ,0) | |
4156 | .. I 'PSJ IO D Q | |
4157 | "RTN","PSI VHYPR",106 ,0) | |
4158 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
4159 | "RTN","PSI VHYPR",107 ,0) | |
4160 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4161 | "RTN","PSI VHYPR",108 ,0) | |
4162 | . K ZZ | |
4163 | "RTN","PSI VHYPR",109 ,0) | |
4164 | . ; | |
4165 | "RTN","PSI VHYPR",110 ,0) | |
4166 | . F I="ST ","STF","S M","SMF" I $G(PSJIO( I))]"" X P SJIO(I) | |
4167 | "RTN","PSI VHYPR",111 ,0) | |
4168 | . W $E(X, 1,PSIVRM) | |
4169 | "RTN","PSI VHYPR",112 ,0) | |
4170 | . F I="ET F","ET","E MF","EM" I $G(PSJIO( I))]"" X P SJIO(I) | |
4171 | "RTN","PSI VHYPR",113 ,0) | |
4172 | . I 'PSJI O W ! | |
4173 | "RTN","PSI VHYPR",114 ,0) | |
4174 | . S X=$E( X,PSIVRM+1 ,999) | |
4175 | "RTN","PSI VHYPR",115 ,0) | |
4176 | Q | |
4177 | "RTN","PSI VHYPR",116 ,0) | |
4178 | ; | |
4179 | "RTN","PSI VHYPR",117 ,0) | |
4180 | TVOL ; | |
4181 | "RTN","PSI VHYPR",118 ,0) | |
4182 | S PSIV=TV OL F X=0:0 S X=$O(^P S(55,DFN," IVBCMA",PS JIDNO,"AD" ,X)) Q:'X S X=X_"^" _^(X,0) | |
4183 | S:$P(X,U,4 )[P(16)!($ P(X,U,4)=" ")!'PSIV1 | |
4184 | PSIV=PSIV+ $S($P(^PS( 52.6,$P(X, U,2),0),U, 10):$P(X,U ,3)/$P(^(0 ),U,10),1: 0) | |
4185 | "RTN","PSI VHYPR",119 ,0) | |
4186 | S X="Tota l Volume: "_(PSIV+.5 \1) D PRNT L | |
4187 | "RTN","PSI VHYPR",120 ,0) | |
4188 | Q | |
4189 | "RTN","PSI VHYPR",121 ,0) | |
4190 | SOL1 S X=$ S($D(^PS(5 2.7,$P(PSI V,U,2),0)) :$P(^(0),U )_" | |
4191 | "_$P(^PS(5 5,DFN,"IVB CMA",PSJID NO,"SOL",+ PSIV,0),U, 2),1:"**** ******") Q | |
4192 | "RTN","PSI VHYPR",122 ,0) | |
4193 | HYP ; | |
4194 | "RTN","PSI VHYPR",123 ,0) | |
4195 | I PSIV="* " S X="*** Error in "_$S(I=50. 4:"electro lyte",I=52 .7:"soluti on",1:"add itive") D PRNTL Q | |
4196 | "RTN","PSI VHYPR",124 ,0) | |
4197 | S X=+HYPL (I,PSIV,Z) | |
4198 | "RTN","PSI VHYPR",125 ,0) | |
4199 | S X=$S($D (^PS(I,PSI VA,0)):$P( ^(0),U),1: "Undefined | |
4200 | "_$S(I=50. 4:"electro lyte",I=52 .7:"soluti on",1:"add itive"))_" "_(X+.005 \.01/100)_ " | |
4201 | "_$P($P(HY PL(I,PSIV, Z),U)," ", 2) | |
4202 | "RTN","PSI VHYPR",126 ,0) | |
4203 | D PRNTL | |
4204 | "RTN","PSI VHYPR",127 ,0) | |
4205 | Q | |
4206 | "RTN","PSI VHYPR",128 ,0) | |
4207 | SETP S Y=^ PS(55,DFN, "IV",+ON,0 ) F X=1:1: 23 S P(X)= $P(Y,U,X) | |
4208 | "RTN","PSI VHYPR",129 ,0) | |
4209 | Q | |
4210 | "RTN","PSI VHYPR",130 ,0) | |
4211 | MESS ;PSJ* 5*184 -mak e MESS a l ocal array so all me ssages dis play for a ll additiv es. | |
4212 | "RTN","PSI VHYPR",131 ,0) | |
4213 | I $P(^PS( 52.6,+Y,0) ,U,9)]"" S MESS($P(^ PS(52.6,+Y ,0),U,9))= "" | |
4214 | "RTN","PSI VHYPR",132 ,0) | |
4215 | Q | |
4216 | "RTN","PSI VHYPR",133 ,0) | |
4217 | BARCODE D PSET^%ZISP | |
4218 | "RTN","PSI VHYPR",134 ,0) | |
4219 | I 'PSJIO D | |
4220 | "RTN","PSI VHYPR",135 ,0) | |
4221 | . I IOBAR ON]"" W @I OBARON | |
4222 | "RTN","PSI VHYPR",136 ,0) | |
4223 | . W PSJBC ID | |
4224 | "RTN","PSI VHYPR",137 ,0) | |
4225 | . I IOBAR OFF]"" W @ IOBAROFF | |
4226 | "RTN","PSI VHYPR",138 ,0) | |
4227 | . W ! | |
4228 | "RTN","PSI VHYPR",139 ,0) | |
4229 | I PSJIO D | |
4230 | "RTN","PSI VHYPR",140 ,0) | |
4231 | . F I="SB ","SBF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4232 | "RTN","PSI VHYPR",141 ,0) | |
4233 | . W PSJBC ID | |
4234 | "RTN","PSI VHYPR",142 ,0) | |
4235 | . F I="EB F","EB" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4236 | "RTN","PSI VHYPR",143 ,0) | |
4237 | Q | |
4238 | "RTN","PSI VHYPR",144 ,0) | |
4239 | PSIVHYP ; | |
4240 | "RTN","PSI VHYPR",145 ,0) | |
4241 | K HYPL S TVOL=0 F Z =52.6,52.7 F DRG=0:0 S | |
4242 | DRG=$O(^PS (55,DFN,"I VBCMA",PSJ IDNO,$S(Z= 52.6:"AD", 1:"SOL"),D RG)) Q:'DR G S | |
4243 | DRG=DRG_"^ "_^(DRG,0) S $P(DRG, "^",4)="AL L" D DRG^P SIVHYP | |
4244 | "RTN","PSI VHYPR",146 ,0) | |
4245 | S TVOL=TV OL+.5\1 K EL,DRG,NAD ,Z | |
4246 | "RTN","PSI VHYPR",147 ,0) | |
4247 | Q | |
4248 | "RTN","PSI VLABL") | |
4249 | 0^14^B4482 8219^B4387 6425 | |
4250 | "RTN","PSI VLABL",1,0 ) | |
4251 | PSIVLABL ; BIR/PR - P RINT OUT L ABELS ; 20 Sep 2018 11:21 AM | |
4252 | "RTN","PSI VLABL",2,0 ) | |
4253 | ;;5.0;INP ATIENT MED ICATIONS;* *58,82,104 ,127,178,1 84,273,279 ,331,332** ;16 DEC 97 ;Build 8 | |
4254 | "RTN","PSI VLABL",3,0 ) | |
4255 | ; | |
4256 | "RTN","PSI VLABL",4,0 ) | |
4257 | ; Referen ce to ^%ZI S(2 is sup ported by DBIA 3435. | |
4258 | "RTN","PSI VLABL",5,0 ) | |
4259 | ; Referen ce to ^PS( 52.6 is su pported by DBIA 1231 . | |
4260 | "RTN","PSI VLABL",6,0 ) | |
4261 | ; Referen ce to ^PS( 52.7 is su pported by DBIA 2173 . | |
4262 | "RTN","PSI VLABL",7,0 ) | |
4263 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
4264 | "RTN","PSI VLABL",8,0 ) | |
4265 | ; Referen ce to ^PS( 51.2 is su pported by DBIA 2178 . | |
4266 | "RTN","PSI VLABL",9,0 ) | |
4267 | ; | |
4268 | "RTN","PSI VLABL",10, 0) | |
4269 | ;Needs DF N,ON, and PSIVNOL NO TE: If PSI VCT is def ined then we do | |
4270 | "RTN","PSI VLABL",11, 0) | |
4271 | ;not coun t labels i n the STAT s file or increment cummulativ e doses or | |
4272 | "RTN","PSI VLABL",12, 0) | |
4273 | ;the last fill fiel d. | |
4274 | "RTN","PSI VLABL",13, 0) | |
4275 | ;PSIVCT w ill be def ined if re printing s cheduled l abels, the suspense | |
4276 | "RTN","PSI VLABL",14, 0) | |
4277 | ;list, or if printi ng individ ual labels and they do not cou nt. | |
4278 | "RTN","PSI VLABL",15, 0) | |
4279 | ; | |
4280 | "RTN","PSI VLABL",16, 0) | |
4281 | DEM ;Get d emographic s and see if label i s example only | |
4282 | "RTN","PSI VLABL",17, 0) | |
4283 | N X0,PSJI O,I,PSIVCL IN,PSIVCLD T,PSIVCLAB ,PSIVNCNT | |
4284 | "RTN","PSI VLABL",18, 0) | |
4285 | S PSIVNCN T=0 ; ini tialize he ader label count | |
4286 | "RTN","PSI VLABL",19, 0) | |
4287 | S I=0 F S I=$O(^%Z IS(2,IOST( 0),55,I)) Q:'I S X0 =$G(^(I,0) ) I X0]"" S PSJIO($P (X0,"^"))= ^(1) | |
4288 | "RTN","PSI VLABL",20, 0) | |
4289 | S PSJIO=$ S('$D(PSJI O):0,1:1) | |
4290 | "RTN","PSI VLABL",21, 0) | |
4291 | S PSIVCLI N=$G(^PS(5 5,DFN,"IV" ,+ON,"DSS" )) S:'(PSI VCLIN>0) P SIVCLIN="" I PSIVCLI N D | |
4292 | "RTN","PSI VLABL",22, 0) | |
4293 | .S PSIVCL DT=$P(PSIV CLIN,"^",2 ) S $P(PSI VCLIN,"^", 2)=$P($G(^ SC(+PSIVCL IN,0)),"^" ) | |
4294 | "RTN","PSI VLABL",23, 0) | |
4295 | I $G(PSIV CLIN) S PS IVCLAB=$P( $G(^SC(+PS IVCLIN,0)) ,"^",2) | |
4296 | "RTN","PSI VLABL",24, 0) | |
4297 | D ENIV^PS JAC,NOW^%D TC S PSIVN OW=$$ENDTC ^PSGMI(%), VADM(2)=$E (VADM(2),6 ,9) | |
4298 | "RTN","PSI VLABL",25, 0) | |
4299 | S | |
4300 | PSIVWD=$S( (+VAIN(4)& '$G(PSIVCL DT)):$P(VA IN(4),U,2) ,$G(PSIVCL IN)&($G(PS IVCLAB)]"" ):PSIVCLAB ,$G(P | |
4301 | SIVCLIN)&( $P($G(PSIV CLIN),"^", 2)]""):$P( PSIVCLIN," ^",2),1:"* OPT *") I $D(PSIVEX AM) G ENX | |
4302 | "RTN","PSI VLABL",26, 0) | |
4303 | ; | |
4304 | "RTN","PSI VLABL",27, 0) | |
4305 | G:PSIVNOL <1 Q D SET P S PSIVRM =$P(PSIVSI TE,U,13),P 16=$P($G(^ PS(55,DFN, "IV",+ON,9 )),U,3) | |
4306 | S:PSIVRM<1 PSIVRM=30 I $D(PSIV CT),PSIVCT '=1 K PSIV CT | |
4307 | "RTN","PSI VLABL",28, 0) | |
4308 | I PSJIO,$ G(PSJIO("F I"))]"" X PSJIO("FI" ) | |
4309 | "RTN","PSI VLABL",29, 0) | |
4310 | I $P(PSIV SITE,U,7) N PSIVLCN, PSIVLOOP S PSIVLCN=$ P(PSIVSITE ,U,7) F PS IVLOOP=1:1 :PSIVLCN D | |
4311 | "RTN","PSI VLABL",30, 0) | |
4312 | . S PSIVF LAG=1,(LIN E,PSIV1)=0 ,PSIV2=PSI VNOL,PSIVN OL=0 D RE | |
4313 | "RTN","PSI VLABL",31, 0) | |
4314 | . S PSIVR P="",PSIVR T="" | |
4315 | "RTN","PSI VLABL",32, 0) | |
4316 | . I $D(^P S(55,DFN," IV",+ON,.2 )) S PSIVR P=$P(^PS(5 5,DFN,"IV" ,+ON,.2),U ,3) D | |
4317 | "RTN","PSI VLABL",33, 0) | |
4318 | .. I PSIV 1'>0!'$P(P SIVSITE,U, 3)!($P(PSI VSITE,U,3) =1&(P(4)'= "P"))!($P( PSIVSITE,U ,3)=2&("AH "'[P(4))) Q | |
4319 | ;DO NOT PR INT ROUTE IF "DOSE D UE AT" IS SET TO NOT PRINT. | |
4320 | "RTN","PSI VLABL",34, 0) | |
4321 | .. S PSIV RT=$P(^PS( 51.2,PSIVR P,0),U,1) | |
4322 | "RTN","PSI VLABL",35, 0) | |
4323 | .. S X="R OUTE: "_PS IVRT D:X]" " PMR | |
4324 | "RTN","PSI VLABL",36, 0) | |
4325 | . S X="So lution: __ __________ ___" D P S X="Additi ve: ______ _________" D P | |
4326 | "RTN","PSI VLABL",37, 0) | |
4327 | . S PSIVN OL=PSIV2 | |
4328 | "RTN","PSI VLABL",38, 0) | |
4329 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
4330 | "RTN","PSI VLABL",39, 0) | |
4331 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
4332 | "RTN","PSI VLABL",40, 0) | |
4333 | I '$D(PSI VCT) D NOW ^%DTC S | |
4334 | Y=%,$P(^PS (55,DFN,"I V",+ON,9), U,1,2)=Y_" ^"_PSIVNOL ,$P(^(9),U ,3)=$P(^(9 ),U,3)+PSI VNOL | |
4335 | "RTN","PSI VLABL",41, 0) | |
4336 | K PSIVFLA G,PSIVSH G START | |
4337 | "RTN","PSI VLABL",42, 0) | |
4338 | SETP S Y=^ PS(55,DFN, "IV",+ON,0 ) F X=1:1: 23 S P(X)= $P(Y,U,X) | |
4339 | "RTN","PSI VLABL",43, 0) | |
4340 | Q | |
4341 | "RTN","PSI VLABL",44, 0) | |
4342 | ENX ;Print example l abel | |
4343 | "RTN","PSI VLABL",45, 0) | |
4344 | D SETP S PSIVFLAG=1 ,PSIVRM=$P (PSIVSITE, U,13) S:PS IVRM<1 PSI VRM=30 | |
4345 | "RTN","PSI VLABL",46, 0) | |
4346 | START F PS IV1=1:1:PS IVNOL D | |
4347 | "RTN","PSI VLABL",47, 0) | |
4348 | . S LINE= 0 D RE | |
4349 | "RTN","PSI VLABL",48, 0) | |
4350 | . Q:$D(PS IVFLAG) | |
4351 | "RTN","PSI VLABL",49, 0) | |
4352 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
4353 | "RTN","PSI VLABL",50, 0) | |
4354 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
4355 | "RTN","PSI VLABL",51, 0) | |
4356 | I PSJIO,$ G(PSJIO("F E"))]"" X PSJIO("FE" ) | |
4357 | "RTN","PSI VLABL",52, 0) | |
4358 | D:'$D(PSI VCT) ^PSIV STAT | |
4359 | "RTN","PSI VLABL",53, 0) | |
4360 | Q K | |
4361 | PSIV,PSIVD OSE,PSIVWD ,P16,LINE, MESS,PSIVC T,PSIV2,PS IVFLAG,PSI VRM,PSIV1, PDOSE,PDAT E,XX1,XX2, B | |
4362 | AG,CX,PSIM ESS Q | |
4363 | "RTN","PSI VLABL",54, 0) | |
4364 | RE ; | |
4365 | "RTN","PSI VLABL",55, 0) | |
4366 | K DO | |
4367 | "RTN","PSI VLABL",56, 0) | |
4368 | ;*273 - B ottle valu es for che mo admixtu re IVs | |
4369 | "RTN","PSI VLABL",57, 0) | |
4370 | N PSIVADT YPE I (P(4 )="A")!($P ($G(^PS(55 ,DFN,"IV", +ON,0)),U, 23)="A") S PSIVADTYP E=1 | |
4371 | "RTN","PSI VLABL",58, 0) | |
4372 | I PSIV1,$ G(PSIVADTY PE)!(P(5)= 0) S P(16) =PSIV1 I $ G(PSIVT)]" " D | |
4373 | "RTN","PSI VLABL",59, 0) | |
4374 | . S:P(15) >2880!('P( 15)) P(15) =2880 S P( 16)=P16+PS IV1#(1440/ P(15)+.5\1 ) S:'P(16) P(16)=PSI V1 | |
4375 | "RTN","PSI VLABL",60, 0) | |
4376 | I PSIV1 S PSJBCID=$ $BCMA^PSIV BCID(DFN,O N,$D(PSIVC T),$G(PSIV 1),$G(PSIV 2),$G(PSIV NOL)) | |
4377 | "RTN","PSI VLABL",61, 0) | |
4378 | ;* Only i f prt from ward or m an list th en store B CMA ID to set xref f or | |
4379 | "RTN","PSI VLABL",62, 0) | |
4380 | ;* reprin t later | |
4381 | "RTN","PSI VLABL",63, 0) | |
4382 | I PSIV1,$ G(PSIVWMFL ) S PSIVID ($P(PSJBCI D,"V",2))= "" | |
4383 | "RTN","PSI VLABL",64, 0) | |
4384 | I PSJIO,$ G(PSJIO("S L"))]"" X PSJIO("SL" ) | |
4385 | "RTN","PSI VLABL",65, 0) | |
4386 | I PSIV1 D BARCODE | |
4387 | "RTN","PSI VLABL",66, 0) | |
4388 | S X="["_$ P(^PS(55,D FN,"IV",+O N,0),U)_"] "_" "_VADM (2)_" "_P SIVWD_" | |
4389 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
4390 | "RTN","PSI VLABL",67, 0) | |
4391 | I ($G(PSI VCLIN)>0), $L($G(PSIV RM)),'$G(V AIN(4)) N PSJTRNC S PSJTRNC=$L (X)-+$G(PS IVRM) I | |
4392 | PSJTRNC>0, ($L(PSIVWD )>PSJTRNC) D | |
4393 | "RTN","PSI VLABL",68, 0) | |
4394 | . S X="[" _$P(^PS(55 ,DFN,"IV", +ON,0),U)_ "]"_" "_VA DM(2)_" " _$E(PSIVWD ,1,$L(PSIV WD)-PSJTRN C)_" | |
4395 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
4396 | "RTN","PSI VLABL",69, 0) | |
4397 | D P | |
4398 | "RTN","PSI VLABL",70, 0) | |
4399 | S X=VADM( 1) S:$P(PS IVSITE,U,9 ) X=X_" " _$S(VAIN(5 )]"":VAIN( 5),1:"NF") D P S X=" " D P | |
4400 | "RTN","PSI VLABL",71, 0) | |
4401 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(^PS (55,DFN,"I V",+ON,"AD ",PSIV)) Q :'PSIV S | |
4402 | Y=^(PSIV,0 ),X=$S($D( ^PS(52.6,+ Y,0)):$P(^ (0),"^"),1 :"******** *")_" "_$P (Y,U,2)_" " S:$P(Y,U ,3)]"" X=X _" | |
4403 | ("_$P(Y,U, 3)_")" D | |
4404 | "RTN","PSI VLABL",72, 0) | |
4405 | . D P | |
4406 | "RTN","PSI VLABL",73, 0) | |
4407 | . ;I PSIV 1 S YY=Y D UP2^PSIVB CID(DFN,PS JBLN,PSIV, YY) S Y=YY | |
4408 | "RTN","PSI VLABL",74, 0) | |
4409 | . D MESS | |
4410 | "RTN","PSI VLABL",75, 0) | |
4411 | G:$D(PSIV FLAG) SOL | |
4412 | "RTN","PSI VLABL",76, 0) | |
4413 | ; IV BOTT LE functio nality, 3r d piece of PS(55,DFN ,"IV",+ON, "AD",PSIV, 0) dictate s labels p er LABEL R UN | |
4414 | on which t he additiv e will pri nt | |
4415 | "RTN","PSI VLABL",77, 0) | |
4416 | F PSIV=0: 0 S PSIV=$ O(^PS(55,D FN,"IV",+O N,"AD",PSI V)) Q:'PSI V S | |
4417 | Y=^(PSIV,0 ),X=$S($D( ^PS(52.6,+ Y,0)):$P(^ (0),U),1:" ********") _" "_$P(Y, U,2) I | |
4418 | ","_$P(Y,U ,3)_","[(" ,"_P(16)_" ,")!('$P(Y ,U,3)) D | |
4419 | "RTN","PSI VLABL",78, 0) | |
4420 | . D P | |
4421 | "RTN","PSI VLABL",79, 0) | |
4422 | . I PSIV1 S YY=Y D UP2^PSIVBC ID(DFN,PSJ BLN,PSIV,Y Y) S Y=YY | |
4423 | "RTN","PSI VLABL",80, 0) | |
4424 | . D MESS | |
4425 | "RTN","PSI VLABL",81, 0) | |
4426 | ; | |
4427 | "RTN","PSI VLABL",82, 0) | |
4428 | SOL F PSIV =0:0 S PSI V=$O(^PS(5 5,DFN,"IV" ,+ON,"SOL" ,PSIV)) Q: 'PSIV S | |
4429 | PSIV=PSIV_ "^"_+^(PSI V,0),YY=^( 0) D | |
4430 | "RTN","PSI VLABL",83, 0) | |
4431 | . D SOL1, P I PSIV1 D UP3^PSIV BCID(DFN,P SJBLN,PSIV ,YY) | |
4432 | "RTN","PSI VLABL",84, 0) | |
4433 | . S X=$P( ^PS(52.7,$ P(PSIV,U,2 ),0),U,4) I X]"" S X =" "_X D P | |
4434 | "RTN","PSI VLABL",85, 0) | |
4435 | I P(23)'= ""!(P(4)=" S") S X="I n Syringe: "_$E($P(^ PS(55,DFN, "IV",+ON,2 ),U,4),1,2 5) D:P(4)= "S"!(P(23) ="S") | |
4436 | P S X="*CA UTION* - C HEMOTHERAP Y" D:P(23) '="" P | |
4437 | "RTN","PSI VLABL",86, 0) | |
4438 | S X=" " D P I | |
4439 | PSIV1'>0!' $P(PSIVSIT E,U,3)!($P (PSIVSITE, U,3)=1&(P( 4)'="P"))! ($P(PSIVSI TE,U,3)=2& ("AH"'[P(4 ))) G | |
4440 | MEDRT | |
4441 | "RTN","PSI VLABL",87, 0) | |
4442 | S:'$D(PSI VDOSE) PSI VDOSE="" S X=$P(PSIV DOSE," ",P SIV1) D:$E (X)="." CO NVER S X=" Dose due a t: | |
4443 | "_$S(X="": "________" ,1:$E(X,4, 5)_"/"_$E( X,6,7)_"/" _$E(X,2,3) _" "_$E(X# 1_"000",2, 5)) D P | |
4444 | "RTN","PSI VLABL",88, 0) | |
4445 | ; | |
4446 | "RTN","PSI VLABL",89, 0) | |
4447 | MEDRT ;Fin d Medicati on Route | |
4448 | "RTN","PSI VLABL",90, 0) | |
4449 | S PSIVRP= "",PSIVRT= "" | |
4450 | "RTN","PSI VLABL",91, 0) | |
4451 | I $D(^PS( 55,DFN,"IV ",+ON,.2)) S PSIVRP= $P(^PS(55, DFN,"IV",+ ON,.2),U,3 ) D | |
4452 | "RTN","PSI VLABL",92, 0) | |
4453 | .S PSIVRT =$P(^PS(51 .2,PSIVRP, 0),U,1) | |
4454 | "RTN","PSI VLABL",93, 0) | |
4455 | .S X="ROU TE: "_PSIV RT D:X]"" PMR | |
4456 | "RTN","PSI VLABL",94, 0) | |
4457 | ; | |
4458 | "RTN","PSI VLABL",95, 0) | |
4459 | INF S X=$P (P(8),"@") D:X]"" P | |
4460 | "RTN","PSI VLABL",96, 0) | |
4461 | I $D(^PS( 55,DFN,"IV ",+ON,3)) S X=$P(^(3 ),"^") D:X ]"" P | |
4462 | "RTN","PSI VLABL",97, 0) | |
4463 | S X=P(9) D:X]"" P | |
4464 | "RTN","PSI VLABL",98, 0) | |
4465 | S X=P(11) D:X]"" P | |
4466 | "RTN","PSI VLABL",99, 0) | |
4467 | ;PSJ*5*18 4 - Displa y all mess ages if mo re than on e additive has a mes sage. | |
4468 | "RTN","PSI VLABL",100 ,0) | |
4469 | I $D(MESS ) S PSIMES S="" F S PSIMESS=$O (MESS(PSIM ESS)) Q:PS IMESS="" S X=PSIMES S D P | |
4470 | "RTN","PSI VLABL",101 ,0) | |
4471 | I $D(^PS( 59.5,PSIVS N,4)) S Y= ^(4) F PSI V=1:1 S X= $P(Y,U,PSI V) Q:X="" D P | |
4472 | "RTN","PSI VLABL",102 ,0) | |
4473 | S X=PSIV1 _"["_$S(PS IV1:PSIVNO L,1:PSIV2) _"]"_" "_ $S('PSIV1: PSIVNOW,1: "") D P | |
4474 | "RTN","PSI VLABL",103 ,0) | |
4475 | Q | |
4476 | "RTN","PSI VLABL",104 ,0) | |
4477 | ; | |
4478 | "RTN","PSI VLABL",105 ,0) | |
4479 | P F LINE=L INE+1:1 D Q:$L(X)<1 | |
4480 | "RTN","PSI VLABL",106 ,0) | |
4481 | . I LINE> PSIVSITE D | |
4482 | "RTN","PSI VLABL",107 ,0) | |
4483 | .. S LINE =1 | |
4484 | "RTN","PSI VLABL",108 ,0) | |
4485 | .. I 'PSJ IO D Q | |
4486 | "RTN","PSI VLABL",109 ,0) | |
4487 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
4488 | "RTN","PSI VLABL",110 ,0) | |
4489 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4490 | "RTN","PSI VLABL",111 ,0) | |
4491 | . K ZZ | |
4492 | "RTN","PSI VLABL",112 ,0) | |
4493 | . F I="ST ","STF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4494 | "RTN","PSI VLABL",113 ,0) | |
4495 | . W $E(X, 1,PSIVRM) | |
4496 | "RTN","PSI VLABL",114 ,0) | |
4497 | . F I="ET F","ET" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4498 | "RTN","PSI VLABL",115 ,0) | |
4499 | . I 'PSJI O W ! | |
4500 | "RTN","PSI VLABL",116 ,0) | |
4501 | . S X=$E( X,PSIVRM+1 ,999) | |
4502 | "RTN","PSI VLABL",117 ,0) | |
4503 | Q | |
4504 | "RTN","PSI VLABL",118 ,0) | |
4505 | PMR ; Prin t Med Rout e on label | |
4506 | "RTN","PSI VLABL",119 ,0) | |
4507 | ; | |
4508 | "RTN","PSI VLABL",120 ,0) | |
4509 | F LINE=LI NE+1:1 D Q:$L(X)<1 | |
4510 | "RTN","PSI VLABL",121 ,0) | |
4511 | . I LINE> PSIVSITE D | |
4512 | "RTN","PSI VLABL",122 ,0) | |
4513 | .. S LINE =1 | |
4514 | "RTN","PSI VLABL",123 ,0) | |
4515 | .. I 'PSJ IO D Q | |
4516 | "RTN","PSI VLABL",124 ,0) | |
4517 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
4518 | "RTN","PSI VLABL",125 ,0) | |
4519 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4520 | "RTN","PSI VLABL",126 ,0) | |
4521 | . K ZZ | |
4522 | "RTN","PSI VLABL",127 ,0) | |
4523 | . ; | |
4524 | "RTN","PSI VLABL",128 ,0) | |
4525 | . F I="ST ","STF","S M","SMF" I $G(PSJIO( I))]"" X P SJIO(I) | |
4526 | "RTN","PSI VLABL",129 ,0) | |
4527 | . W $E(X, 1,PSIVRM) | |
4528 | "RTN","PSI VLABL",130 ,0) | |
4529 | . F I="ET F","ET","E MF","EM" I $G(PSJIO( I))]"" X P SJIO(I) | |
4530 | "RTN","PSI VLABL",131 ,0) | |
4531 | . I 'PSJI O W ! | |
4532 | "RTN","PSI VLABL",132 ,0) | |
4533 | . S X=$E( X,PSIVRM+1 ,999) | |
4534 | "RTN","PSI VLABL",133 ,0) | |
4535 | Q | |
4536 | "RTN","PSI VLABL",134 ,0) | |
4537 | ; | |
4538 | "RTN","PSI VLABL",135 ,0) | |
4539 | SOL1 S X=$ S($D(^PS(5 2.7,$P(PSI V,U,2),0)) :$P(^(0)," ^")_" | |
4540 | "_$P(^PS(5 5,DFN,"IV" ,+ON,"SOL" ,+PSIV,0), U,2),1:"** ********") Q | |
4541 | "RTN","PSI VLABL",136 ,0) | |
4542 | MESS ;PSJ* 5*184 -mak e MESS a l ocal array so all me ssages dis play for a ll additiv es. | |
4543 | "RTN","PSI VLABL",137 ,0) | |
4544 | I $P(^PS( 52.6,+Y,0) ,U,9)]"" S MESS($P(^ PS(52.6,+Y ,0),U,9))= "" | |
4545 | "RTN","PSI VLABL",138 ,0) | |
4546 | Q | |
4547 | "RTN","PSI VLABL",139 ,0) | |
4548 | CONVER ;Ex pand dose to date.do se and set in X | |
4549 | "RTN","PSI VLABL",140 ,0) | |
4550 | I P(15)>1 440 S X=$$ CONVER1^PS IVORE2($P( PSIVDOSE," "),P(15), (PSIV1-1)) Q | |
4551 | "RTN","PSI VLABL",141 ,0) | |
4552 | S PDOSE=X S:PSIV1=2 PDATE=$E( $P(PSIVDOS E," "),1,7 ) | |
4553 | "RTN","PSI VLABL",142 ,0) | |
4554 | I $P(PSIV DOSE," ",P SIV1-1)#1' <PDOSE!(P( 15)>1440) S:$D(X1) X X1=X1 S:$D (X2) XX2=X 2 S X1=PDA TE,X2=1 | |
4555 | D C^%DTC S PDATE=X,X =X_PDOSE S :$D(XX1) X 1=XX1 S:$D (XX2) X2=X X2 Q | |
4556 | "RTN","PSI VLABL",143 ,0) | |
4557 | S X=PDATE _PDOSE | |
4558 | "RTN","PSI VLABL",144 ,0) | |
4559 | Q | |
4560 | "RTN","PSI VLABL",145 ,0) | |
4561 | BARCODE D PSET^%ZISP | |
4562 | "RTN","PSI VLABL",146 ,0) | |
4563 | I 'PSJIO D | |
4564 | "RTN","PSI VLABL",147 ,0) | |
4565 | . I IOBAR ON]"" W @I OBARON | |
4566 | "RTN","PSI VLABL",148 ,0) | |
4567 | . W PSJBC ID | |
4568 | "RTN","PSI VLABL",149 ,0) | |
4569 | . I IOBAR OFF]"" W @ IOBAROFF | |
4570 | "RTN","PSI VLABL",150 ,0) | |
4571 | . W ! | |
4572 | "RTN","PSI VLABL",151 ,0) | |
4573 | I PSJIO D | |
4574 | "RTN","PSI VLABL",152 ,0) | |
4575 | . F I="SB ","SBF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4576 | "RTN","PSI VLABL",153 ,0) | |
4577 | . W PSJBC ID | |
4578 | "RTN","PSI VLABL",154 ,0) | |
4579 | . F I="EB F","EB" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4580 | "RTN","PSI VLABL",155 ,0) | |
4581 | Q | |
4582 | "RTN","PSI VLABR") | |
4583 | 0^25^B4009 7446^B4012 5605 | |
4584 | "RTN","PSI VLABR",1,0 ) | |
4585 | PSIVLABR ; BIR/PR-REP RINT LABEL S ; 22 Jan 2019 9:2 9 AM | |
4586 | "RTN","PSI VLABR",2,0 ) | |
4587 | ;;5.0;INP ATIENT MED ICATIONS;* *58,82,178 ,184,279,3 31,332**;1 6 DEC 97;B uild 8 | |
4588 | "RTN","PSI VLABR",3,0 ) | |
4589 | ; | |
4590 | "RTN","PSI VLABR",4,0 ) | |
4591 | ; Referen ce to ^%ZI S(2 is sup ported by DBIA 3435. | |
4592 | "RTN","PSI VLABR",5,0 ) | |
4593 | ; Referen ce to ^PS( 52.6 is su pported by DBIA 1231 . | |
4594 | "RTN","PSI VLABR",6,0 ) | |
4595 | ; Referen ce to ^PS( 52.7 is su pported by DBIA 2173 . | |
4596 | "RTN","PSI VLABR",7,0 ) | |
4597 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
4598 | "RTN","PSI VLABR",8,0 ) | |
4599 | ; Referen ce to ^PS( 51.2 is su pported by DBIA 2178 . | |
4600 | "RTN","PSI VLABR",9,0 ) | |
4601 | ; | |
4602 | "RTN","PSI VLABR",10, 0) | |
4603 | ;Needs DF N,ON, and PSIVNOL NO TE: If PSI VCT is def ined then we do | |
4604 | "RTN","PSI VLABR",11, 0) | |
4605 | ;not coun t labels i n the STAT s file or increment cummulativ e doses or | |
4606 | "RTN","PSI VLABR",12, 0) | |
4607 | ;the last fill fiel d. | |
4608 | "RTN","PSI VLABR",13, 0) | |
4609 | ;PSIVCT w ill be def ined if re printing s cheduled l abels, the suspense | |
4610 | "RTN","PSI VLABR",14, 0) | |
4611 | ;list, or if printi ng individ ual labels and they do not cou nt. | |
4612 | "RTN","PSI VLABR",15, 0) | |
4613 | ; | |
4614 | "RTN","PSI VLABR",16, 0) | |
4615 | DEM ;Get d emographic s and see if label i s example only | |
4616 | "RTN","PSI VLABR",17, 0) | |
4617 | N X0,PSJI O,I,PSIVCL AB | |
4618 | "RTN","PSI VLABR",18, 0) | |
4619 | S I=0 F S I=$O(^%Z IS(2,IOST( 0),55,I)) Q:'I S X0 =$G(^(I,0) ) I X0]"" S PSJIO($P (X0,"^"))= ^(1) | |
4620 | "RTN","PSI VLABR",19, 0) | |
4621 | S PSJIO=$ S('$D(PSJI O):0,1:1) | |
4622 | "RTN","PSI VLABR",20, 0) | |
4623 | N PSIVCLI N,PSIVCLDT S PSIVCLI N=$G(^PS(5 5,DFN,"IV" ,+ON,"DSS" )) S:'(PSI VCLIN>0) P SIVCLIN="" I | |
4624 | PSIVCLIN D | |
4625 | "RTN","PSI VLABR",21, 0) | |
4626 | .S PSIVCL DT=$P(PSIV CLIN,"^",2 ) S $P(PSI VCLIN,"^", 2)=$P($G(^ SC(+PSIVCL IN,0)),"^" ) | |
4627 | "RTN","PSI VLABR",22, 0) | |
4628 | I $G(PSIV CLIN) S PS IVCLAB=$P( $G(^SC(+PS IVCLIN,0)) ,"^",2) | |
4629 | "RTN","PSI VLABR",23, 0) | |
4630 | D ENIV^PS JAC,NOW^%D TC S PSIVN OW=$$ENDTC ^PSGMI(%), VADM(2)=$E (VADM(2),6 ,9) | |
4631 | "RTN","PSI VLABR",24, 0) | |
4632 | S | |
4633 | PSIVWD=$S( (+VAIN(4)& '$G(PSIVCL DT)):$P(VA IN(4),U,2) ,$G(PSIVCL IN)&($G(PS IVCLAB)]"" ):PSIVCLAB ,$G(P | |
4634 | SIVCLIN)&( $P($G(PSIV CLIN),"^", 2)]""):$P( PSIVCLIN," ^",2),1:"* OPT *") I $D(PSIVEX AM) G ENX | |
4635 | "RTN","PSI VLABR",25, 0) | |
4636 | ; | |
4637 | "RTN","PSI VLABR",26, 0) | |
4638 | ;;NEW PSI VNOL,PSIV1 S (PSIVNO L,PSIV1)=1 | |
4639 | "RTN","PSI VLABR",27, 0) | |
4640 | NEW PSIV1 S PSIV1=1 | |
4641 | "RTN","PSI VLABR",28, 0) | |
4642 | G:PSIVNOL <1 Q D SET P S PSIVRM =$P(PSIVSI TE,U,13),P 16=$P($G(^ PS(55,DFN, "IV",+ON,9 )),U,3) | |
4643 | S:PSIVRM<1 PSIVRM=30 I $D(PSIV CT),PSIVCT '=1 K PSIV CT | |
4644 | "RTN","PSI VLABR",29, 0) | |
4645 | I PSJIO,$ G(PSJIO("F I"))]"" X PSJIO("FI" ) | |
4646 | "RTN","PSI VLABR",30, 0) | |
4647 | ;PSJRPHD is defined in REPRT^ PSIVLBRP s o header o nly print once. | |
4648 | "RTN","PSI VLABR",31, 0) | |
4649 | I $P(PSIV SITE,U,7), '$D(PSJRPH D) D | |
4650 | "RTN","PSI VLABR",32, 0) | |
4651 | . S PSIVF LAG=1,(LIN E,PSIV1)=0 ,PSIV2=PSI VNOL,PSIVN OL=0 D RE | |
4652 | "RTN","PSI VLABR",33, 0) | |
4653 | . S PSIVR P="",PSIVR T="" | |
4654 | "RTN","PSI VLABR",34, 0) | |
4655 | . I $D(^P S(55,DFN," IV",+ON,.2 )) S PSIVR P=$P(^PS(5 5,DFN,"IV" ,+ON,.2),U ,3) D | |
4656 | "RTN","PSI VLABR",35, 0) | |
4657 | .. I PSIV 1'>0!'$P(P SIVSITE,U, 3)!($P(PSI VSITE,U,3) =1&(P(4)'= "P"))!($P( PSIVSITE,U ,3)=2&("AH "'[P(4))) Q | |
4658 | ;QUIT IF " DOSE DUE A T" IS SET TO NOT PRI NT | |
4659 | "RTN","PSI VLABR",36, 0) | |
4660 | .. S PSIV RT=$P(^PS( 51.2,PSIVR P,0),U,1) | |
4661 | "RTN","PSI VLABR",37, 0) | |
4662 | .. S X="R OUTE: "_PS IVRT D:X]" " PMR | |
4663 | "RTN","PSI VLABR",38, 0) | |
4664 | . S X="So lution: __ __________ ___" D P S X="Additi ve: ______ _________" D P | |
4665 | "RTN","PSI VLABR",39, 0) | |
4666 | . S PSIVN OL=PSIV2 | |
4667 | "RTN","PSI VLABR",40, 0) | |
4668 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
4669 | "RTN","PSI VLABR",41, 0) | |
4670 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
4671 | "RTN","PSI VLABR",42, 0) | |
4672 | ;;I '$D(P SIVCT) D N OW^%DTC S | |
4673 | Y=%,$P(^PS (55,DFN,"I V",+ON,9), U,1,2)=Y_" ^"_PSIVNOL ,$P(^(9),U ,3)=$P(^(9 ),U,3)+PSI VNOL | |
4674 | "RTN","PSI VLABR",43, 0) | |
4675 | I '$D(PSI VCT) D NOW ^%DTC S | |
4676 | Y=%,$P(^PS (55,DFN,"I V",+ON,9), U,1,2)=Y_" ^"_PSIVNOL ,$P(^(9),U ,3)=$P(^(9 ),U,3)+1 | |
4677 | "RTN","PSI VLABR",44, 0) | |
4678 | K PSIVFLA G,PSIVSH G START | |
4679 | "RTN","PSI VLABR",45, 0) | |
4680 | SETP S Y=^ PS(55,DFN, "IV",+ON,0 ) F X=1:1: 23 S P(X)= $P(Y,U,X) | |
4681 | "RTN","PSI VLABR",46, 0) | |
4682 | Q | |
4683 | "RTN","PSI VLABR",47, 0) | |
4684 | ENX ;Print example l abel | |
4685 | "RTN","PSI VLABR",48, 0) | |
4686 | D SETP S PSIVFLAG=1 ,PSIVRM=$P (PSIVSITE, U,13) S:PS IVRM<1 PSI VRM=30 | |
4687 | "RTN","PSI VLABR",49, 0) | |
4688 | START S PS IV1=1,LINE =0 D RE D | |
4689 | "RTN","PSI VLABR",50, 0) | |
4690 | . Q:$D(PS IVFLAG) | |
4691 | "RTN","PSI VLABR",51, 0) | |
4692 | . I 'PSJI O F LINE=L INE+1:1:(P SIVSITE+$P (PSIVSITE, U,16)) W ! | |
4693 | "RTN","PSI VLABR",52, 0) | |
4694 | . I PSJIO ,$G(PSJIO( "EL"))]"" X PSJIO("E L") | |
4695 | "RTN","PSI VLABR",53, 0) | |
4696 | I PSJIO,$ G(PSJIO("F E"))]"" X PSJIO("FE" ) | |
4697 | "RTN","PSI VLABR",54, 0) | |
4698 | D:'$D(PSI VCT) ^PSIV STAT | |
4699 | "RTN","PSI VLABR",55, 0) | |
4700 | Q K | |
4701 | PSIV,PSIVD OSE,PSIVCT ,PSIVWD,P1 6,LINE,MES S,PSIV2,PS IVFLAG,PSI VRM,PSIV1, PDOSE,PDAT E,XX1,XX2, B | |
4702 | AG,CX,PSIM ESS Q | |
4703 | "RTN","PSI VLABR",56, 0) | |
4704 | RE ; | |
4705 | "RTN","PSI VLABR",57, 0) | |
4706 | ;NEED THE CODE BELO W? | |
4707 | "RTN","PSI VLABR",58, 0) | |
4708 | ;;I PSIV1 ,P(4)="A"! (P(5)=0) S :P(15)>288 0!('P(15)) P(15)=288 0 S P(16)= P16+PSIV1# (1440/P(15 )+.5\1) | |
4709 | S:'P(16) P (16)=PSIV1 | |
4710 | "RTN","PSI VLABR",59, 0) | |
4711 | I PSJIO,$ G(PSJIO("S L"))]"" X PSJIO("SL" ) | |
4712 | "RTN","PSI VLABR",60, 0) | |
4713 | I PSIV1 D BARCODE | |
4714 | "RTN","PSI VLABR",61, 0) | |
4715 | S X="["_$ P(^PS(55,D FN,"IV",+O N,0),U)_"] "_" "_VADM (2)_" "_P SIVWD_" | |
4716 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
4717 | "RTN","PSI VLABR",62, 0) | |
4718 | I ($G(PSI VCLIN)>0), $L($G(PSIV RM)),'$G(V AIN(4)) N PSJTRNC S PSJTRNC=$L (X)-+$G(PS IVRM) I | |
4719 | PSJTRNC>0, ($L(PSIVWD )>PSJTRNC) D | |
4720 | "RTN","PSI VLABR",63, 0) | |
4721 | . S X="[" _$P(^PS(55 ,DFN,"IV", +ON,0),U)_ "]"_" "_VA DM(2)_" " _$E(PSIVWD ,1,$L(PSIV WD)-PSJTRN C)_" | |
4722 | "_$E(DT,4, 5)_"/"_$E( DT,6,7)_"/ "_$E(DT,2, 3) | |
4723 | "RTN","PSI VLABR",64, 0) | |
4724 | D P | |
4725 | "RTN","PSI VLABR",65, 0) | |
4726 | ;D | |
4727 | "RTN","PSI VLABR",66, 0) | |
4728 | ;.N PSJIC W,TMPX,TMP X1,TMPX2 S TMPX=X,TM PX1="" I $ L(TMPX)>(P SIVRM-1) F PSJICW=1: 1:$L(TMPX, " | |
4729 | ") S TMPX1 =TMPX1_$S( PSJICW=1:" ",1:" ")_$ P(TMPX," " ,PSJICW) I $L(TMPX1) +$L($P(TMP X," | |
4730 | ",PSJICW+1 ))>(PSIVRM -1) S X=TM PX1 D P S TMPX1="",X ="" | |
4731 | "RTN","PSI VLABR",67, 0) | |
4732 | ;.I TMPX1 ]"" S X=TM PX1 D P | |
4733 | "RTN","PSI VLABR",68, 0) | |
4734 | S X=VADM( 1) S:$P(PS IVSITE,U,9 ) X=X_" " _$S(VAIN(5 )]"":VAIN( 5),1:"NF") D P S X=" " D P | |
4735 | "RTN","PSI VLABR",69, 0) | |
4736 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(^PS (55,DFN,"I V",+ON,"AD ",PSIV)) Q :'PSIV S | |
4737 | Y=^(PSIV,0 ),X=$S($D( ^PS(52.6,+ Y,0)):$P(^ (0),"^"),1 :"******** *")_" "_$P (Y,U,2)_" " S:$P(Y,U ,3)]"" X=X _" | |
4738 | ("_$P(Y,U, 3)_")" D | |
4739 | "RTN","PSI VLABR",70, 0) | |
4740 | . D P,MES S | |
4741 | "RTN","PSI VLABR",71, 0) | |
4742 | G:$D(PSIV FLAG) SOL | |
4743 | "RTN","PSI VLABR",72, 0) | |
4744 | F PSIV=0: 0 S PSIV=$ O(^PS(55,D FN,"IVBCMA ",PSJIDNO, "AD",PSIV) ) Q:'PSIV S | |
4745 | Y=^(PSIV,0 ),X=$S($D( ^PS(52.6,+ Y,0)):$P(^ (0),U),1:" ********") _" "_$P(Y, U,2) D | |
4746 | "RTN","PSI VLABR",73, 0) | |
4747 | . D P,MES S | |
4748 | "RTN","PSI VLABR",74, 0) | |
4749 | SOL F PSIV =0:0 S PSI V=$O(^PS(5 5,DFN,"IVB CMA",PSJID NO,"SOL",P SIV)) Q:'P SIV S | |
4750 | PSIV=PSIV_ "^"_+^(PSI V,0),YY=^( 0) D | |
4751 | "RTN","PSI VLABR",75, 0) | |
4752 | . D SOL1, P | |
4753 | "RTN","PSI VLABR",76, 0) | |
4754 | . S X=$P( ^PS(52.7,$ P(PSIV,U,2 ),0),U,4) I X]"" S X =" "_X D P | |
4755 | "RTN","PSI VLABR",77, 0) | |
4756 | I P(23)'= ""!(P(4)=" S") S X="I n Syringe: "_$E($P(^ PS(55,DFN, "IV",+ON,2 ),U,4),1,2 5) D:P(4)= "S"!(P(23) ="S") | |
4757 | P S X="*CA UTION* - C HEMOTHERAP Y" D:P(23) '="" P | |
4758 | "RTN","PSI VLABR",78, 0) | |
4759 | S X=" " D P I | |
4760 | PSIV1'>0!' $P(PSIVSIT E,U,3)!($P (PSIVSITE, U,3)=1&(P( 4)'="P"))! ($P(PSIVSI TE,U,3)=2& ("AH"'[P(4 ))) G | |
4761 | MEDRT | |
4762 | "RTN","PSI VLABR",79, 0) | |
4763 | S:'$D(PSI VDOSE) PSI VDOSE="" S X=$P(PSIV DOSE," ",P SIV1) D:$E (X)="." CO NVER S X=" Dose due a t: | |
4764 | "_$S(X="": "________" ,1:$E(X,4, 5)_"/"_$E( X,6,7)_"/" _$E(X,2,3) _" "_$E(X# 1_"000",2, 5)) D P | |
4765 | "RTN","PSI VLABR",80, 0) | |
4766 | ; | |
4767 | "RTN","PSI VLABR",81, 0) | |
4768 | MEDRT ;Fin d Medicati on Route | |
4769 | "RTN","PSI VLABR",82, 0) | |
4770 | S PSIVRP= "",PSIVRT= "" | |
4771 | "RTN","PSI VLABR",83, 0) | |
4772 | I $D(^PS( 55,DFN,"IV ",+ON,.2)) S PSIVRP= $P(^PS(55, DFN,"IV",+ ON,.2),U,3 ) D | |
4773 | "RTN","PSI VLABR",84, 0) | |
4774 | .S PSIVRT =$P(^PS(51 .2,PSIVRP, 0),U,1) | |
4775 | "RTN","PSI VLABR",85, 0) | |
4776 | .S X="ROU TE: "_PSIV RT D:X]"" PMR | |
4777 | "RTN","PSI VLABR",86, 0) | |
4778 | ; | |
4779 | "RTN","PSI VLABR",87, 0) | |
4780 | INF S X=$P (P(8),"@") D:X]"" P | |
4781 | "RTN","PSI VLABR",88, 0) | |
4782 | I $D(^PS( 55,DFN,"IV ",+ON,3)) S X=$P(^(3 ),"^") D:X ]"" P | |
4783 | "RTN","PSI VLABR",89, 0) | |
4784 | S X=P(9) D:X]"" P | |
4785 | "RTN","PSI VLABR",90, 0) | |
4786 | S X=P(11) D:X]"" P | |
4787 | "RTN","PSI VLABR",91, 0) | |
4788 | ;PSJ*5*18 4 - Displa y all mess ages if mo re than on e additive has a mes sage. | |
4789 | "RTN","PSI VLABR",92, 0) | |
4790 | I $D(MESS ) S PSIMES S="" F S PSIMESS=$O (MESS(PSIM ESS)) Q:PS IMESS="" S X=PSIMES S D P | |
4791 | "RTN","PSI VLABR",93, 0) | |
4792 | I $D(^PS( 59.5,PSIVS N,4)) S Y= ^(4) F PSI V=1:1 S X= $P(Y,U,PSI V) Q:X="" D P | |
4793 | "RTN","PSI VLABR",94, 0) | |
4794 | ;S X=PSIV 1_"["_$S(P SIV1:PSIVN OL,1:PSIV2 )_"]"_" " _$S('PSIV1 :PSIVNOW,1 :"") D P | |
4795 | "RTN","PSI VLABR",95, 0) | |
4796 | S X=PSIVB AG D P | |
4797 | "RTN","PSI VLABR",96, 0) | |
4798 | Q | |
4799 | "RTN","PSI VLABR",97, 0) | |
4800 | P F LINE=L INE+1:1 D Q:$L(X)<1 | |
4801 | "RTN","PSI VLABR",98, 0) | |
4802 | . I LINE> PSIVSITE D | |
4803 | "RTN","PSI VLABR",99, 0) | |
4804 | .. S LINE =1 | |
4805 | "RTN","PSI VLABR",100 ,0) | |
4806 | .. I 'PSJ IO D Q | |
4807 | "RTN","PSI VLABR",101 ,0) | |
4808 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
4809 | "RTN","PSI VLABR",102 ,0) | |
4810 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4811 | "RTN","PSI VLABR",103 ,0) | |
4812 | . K ZZ | |
4813 | "RTN","PSI VLABR",104 ,0) | |
4814 | . F I="ST ","STF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4815 | "RTN","PSI VLABR",105 ,0) | |
4816 | . W $E(X, 1,PSIVRM) | |
4817 | "RTN","PSI VLABR",106 ,0) | |
4818 | . F I="ET F","ET" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4819 | "RTN","PSI VLABR",107 ,0) | |
4820 | . I 'PSJI O W ! | |
4821 | "RTN","PSI VLABR",108 ,0) | |
4822 | . S X=$E( X,PSIVRM+1 ,999) | |
4823 | "RTN","PSI VLABR",109 ,0) | |
4824 | Q | |
4825 | "RTN","PSI VLABR",110 ,0) | |
4826 | PMR ; Prin t Med Rout e on label | |
4827 | "RTN","PSI VLABR",111 ,0) | |
4828 | ; | |
4829 | "RTN","PSI VLABR",112 ,0) | |
4830 | F LINE=LI NE+1:1 D Q:$L(X)<1 | |
4831 | "RTN","PSI VLABR",113 ,0) | |
4832 | . I LINE> PSIVSITE D | |
4833 | "RTN","PSI VLABR",114 ,0) | |
4834 | .. S LINE =1 | |
4835 | "RTN","PSI VLABR",115 ,0) | |
4836 | .. I 'PSJ IO D Q | |
4837 | "RTN","PSI VLABR",116 ,0) | |
4838 | ... F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,"^",16) W ! | |
4839 | "RTN","PSI VLABR",117 ,0) | |
4840 | .. F I="E L","SL" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4841 | "RTN","PSI VLABR",118 ,0) | |
4842 | . K ZZ | |
4843 | "RTN","PSI VLABR",119 ,0) | |
4844 | . ; | |
4845 | "RTN","PSI VLABR",120 ,0) | |
4846 | . F I="ST ","STF","S M","SMF" I $G(PSJIO( I))]"" X P SJIO(I) | |
4847 | "RTN","PSI VLABR",121 ,0) | |
4848 | . W $E(X, 1,PSIVRM) | |
4849 | "RTN","PSI VLABR",122 ,0) | |
4850 | . F I="ET F","ET","E MF","EM" I $G(PSJIO( I))]"" X P SJIO(I) | |
4851 | "RTN","PSI VLABR",123 ,0) | |
4852 | . I 'PSJI O W ! | |
4853 | "RTN","PSI VLABR",124 ,0) | |
4854 | . S X=$E( X,PSIVRM+1 ,999) | |
4855 | "RTN","PSI VLABR",125 ,0) | |
4856 | Q | |
4857 | "RTN","PSI VLABR",126 ,0) | |
4858 | SOL1 S X=$ S($D(^PS(5 2.7,$P(PSI V,U,2),0)) :$P(^(0)," ^")_" | |
4859 | "_$P(^PS(5 5,DFN,"IVB CMA",PSJID NO,"SOL",+ PSIV,0),U, 2),1:"**** ******") Q | |
4860 | "RTN","PSI VLABR",127 ,0) | |
4861 | MESS ;PSJ* 5*184 -mak e MESS a l ocal array so all me ssages dis play for a ll additiv es. | |
4862 | "RTN","PSI VLABR",128 ,0) | |
4863 | I $P(^PS( 52.6,+Y,0) ,U,9)]"" S MESS($P(^ PS(52.6,+Y ,0),U,9))= "" | |
4864 | "RTN","PSI VLABR",129 ,0) | |
4865 | Q | |
4866 | "RTN","PSI VLABR",130 ,0) | |
4867 | CONVER ;Ex pand dose to date.do se and set in X | |
4868 | "RTN","PSI VLABR",131 ,0) | |
4869 | I P(15)>1 440 S X=$$ CONVER1^PS IVORE2($P( PSIVDOSE," "),P(15), (PSIV1-1)) Q | |
4870 | "RTN","PSI VLABR",132 ,0) | |
4871 | S PDOSE=X S:PSIV1=2 PDATE=$E( $P(PSIVDOS E," "),1,7 ) | |
4872 | "RTN","PSI VLABR",133 ,0) | |
4873 | I $P(PSIV DOSE," ",P SIV1-1)#1' <PDOSE!(P( 15)>1440) S:$D(X1) X X1=X1 S:$D (X2) XX2=X 2 S X1=PDA TE,X2=1 | |
4874 | D C^%DTC S PDATE=X,X =X_PDOSE S :$D(XX1) X 1=XX1 S:$D (XX2) X2=X X2 Q | |
4875 | "RTN","PSI VLABR",134 ,0) | |
4876 | S X=PDATE _PDOSE | |
4877 | "RTN","PSI VLABR",135 ,0) | |
4878 | Q | |
4879 | "RTN","PSI VLABR",136 ,0) | |
4880 | BARCODE D PSET^%ZISP | |
4881 | "RTN","PSI VLABR",137 ,0) | |
4882 | I 'PSJIO D | |
4883 | "RTN","PSI VLABR",138 ,0) | |
4884 | . I IOBAR ON]"" W @I OBARON | |
4885 | "RTN","PSI VLABR",139 ,0) | |
4886 | . W PSJBC ID | |
4887 | "RTN","PSI VLABR",140 ,0) | |
4888 | . I IOBAR OFF]"" W @ IOBAROFF | |
4889 | "RTN","PSI VLABR",141 ,0) | |
4890 | . W ! | |
4891 | "RTN","PSI VLABR",142 ,0) | |
4892 | I PSJIO D | |
4893 | "RTN","PSI VLABR",143 ,0) | |
4894 | . F I="SB ","SBF" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4895 | "RTN","PSI VLABR",144 ,0) | |
4896 | . W PSJBC ID | |
4897 | "RTN","PSI VLABR",145 ,0) | |
4898 | . F I="EB F","EB" I $G(PSJIO(I ))]"" X PS JIO(I) | |
4899 | "RTN","PSI VLABR",146 ,0) | |
4900 | Q | |
4901 | "RTN","PSI VLBL1") | |
4902 | 0^6^B45574 055^B42809 676 | |
4903 | "RTN","PSI VLBL1",1,0 ) | |
4904 | PSIVLBL1 ; BIR/RGY-PR INT LABEL FROM WARD LIST ; 24 Oct 2017 9:08 AM | |
4905 | "RTN","PSI VLBL1",2,0 ) | |
4906 | ;;5.0;INP ATIENT MED ICATIONS;* *69,58,81, 97,104,279 ,332**;16 DEC 97;Bui ld 8 | |
4907 | "RTN","PSI VLBL1",3,0 ) | |
4908 | ; | |
4909 | "RTN","PSI VLBL1",4,0 ) | |
4910 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
4911 | "RTN","PSI VLBL1",5,0 ) | |
4912 | ; Referen ce to ^%DT is suppor ted by DBI A 10003. | |
4913 | "RTN","PSI VLBL1",6,0 ) | |
4914 | ; Referen ce to ^%ZI S is suppo rted by DB IA 10086. | |
4915 | "RTN","PSI VLBL1",7,0 ) | |
4916 | ; Referen ce to ^%ZT LOAD is su pported by DBIA 1006 3. | |
4917 | "RTN","PSI VLBL1",8,0 ) | |
4918 | ; Referen ce to ^DIC N is suppo rted by DB IA 10009. | |
4919 | "RTN","PSI VLBL1",9,0 ) | |
4920 | ; Referen ce to ^DIR is suppor ted by DBI A 10026. | |
4921 | "RTN","PSI VLBL1",10, 0) | |
4922 | ; Referen ce to ^VAL M1 is supp orted by D BIA 10116. | |
4923 | "RTN","PSI VLBL1",11, 0) | |
4924 | ; Referen ce to ^%ZO SF("TEST") is suppor ted by DBI A 10096 | |
4925 | "RTN","PSI VLBL1",12, 0) | |
4926 | ; | |
4927 | "RTN","PSI VLBL1",13, 0) | |
4928 | START S Y= 1 W !!,"Sc hedule lab els for DA TE: TODAY/ /" R X:DTI ME S:'$T X ="^" S:X=" " X="T" Q: X["^" I | |
4929 | X'["?" S % DT="EX" D ^%DT | |
4930 | "RTN","PSI VLBL1",14, 0) | |
4931 | G:Y<1 STA RT | |
4932 | "RTN","PSI VLBL1",15, 0) | |
4933 | I X["?" S HELP="LBL 1" D ^PSIV HLP S X="? " D ^%DT G START | |
4934 | "RTN","PSI VLBL1",16, 0) | |
4935 | ASK S PSIV DT=Y\1 D ^ PSIVWL1 G QUIT:'$D(P SIVOD)!('$ D(PSIVCD)) | |
4936 | "RTN","PSI VLBL1",17, 0) | |
4937 | I PSIVPL' =ION D QUE G QUIT | |
4938 | "RTN","PSI VLBL1",18, 0) | |
4939 | DEQ ; | |
4940 | "RTN","PSI VLBL1",19, 0) | |
4941 | L +^PS(55 ,"PSIVWL", PSIVSN):1 E W:$Y @I OF W !!,"* *** WARNIN G --- LABE LS NOT",!, " RUN, W ARD | |
4942 | LIST IN PR OGRESS" G QUIT | |
4943 | "RTN","PSI VLBL1",20, 0) | |
4944 | S PSIVT=" " F PSIVLB L1=0:0 S P SIVT=$O(PS IVOD(PSIVT )) Q:PSIVT ="" S WRD ="" D | |
4945 | @("LBL"_$S ($D(^PS(55 ,"PSIVWLM" ,PSIVSN,PS IVT_PSIVOD (PSIVT))): "M",1:"W") ) | |
4946 | "RTN","PSI VLBL1",21, 0) | |
4947 | I $G(PSJR PFLG) D | |
4948 | "RTN","PSI VLBL1",22, 0) | |
4949 | . W !!,"* ** NOTE ** *" | |
4950 | "RTN","PSI VLBL1",23, 0) | |
4951 | . W !!,"S chedule la bels had a lready pri nted for t he selecte d manufact uring time ." | |
4952 | "RTN","PSI VLBL1",24, 0) | |
4953 | . W !,"Pl ease use t he Reprint Scheduled Labels op tion inste ad.",! | |
4954 | "RTN","PSI VLBL1",25, 0) | |
4955 | . K PSJRP FLG | |
4956 | "RTN","PSI VLBL1",26, 0) | |
4957 | QUIT L -^P S(55,"PSIV WL",PSIVSN ) S:$D(ZTQ UEUED) ZTR EQ="@" K | |
4958 | %,%DT,%T,D ,DFN,I,JJ, NOFLG,ON,P ,PSCT,PSIV ,PSIVCD,PS IVDT,PSIVD OSE,PSIVMT ,PSIVOD,PS IVNOL,PSIV T, | |
4959 | VAERR,WRD, X,X1,X2,Y, Z,ZTSK,OIX 1,OIX2 | |
4960 | "RTN","PSI VLBL1",27, 0) | |
4961 | Q | |
4962 | "RTN","PSI VLBL1",28, 0) | |
4963 | LBLM ; | |
4964 | "RTN","PSI VLBL1",29, 0) | |
4965 | N OIX1,OI X2 I '$D(^ PS(55,"PSI VWLM",PSIV SN,PSIVT_P SIVOD(PSIV T),PSIVT)) D DESC(PS IVT) Q | |
4966 | "RTN","PSI VLBL1",30, 0) | |
4967 | S OIX1=0 F S OIX1= $O(^PS(55, "PSIVWLM", PSIVSN,PSI VT_PSIVOD( PSIVT),PSI VT,OIX1)) Q:OIX1="" S | |
4968 | OIX2=0 F S OIX2=$O( ^PS(55,"PS IVWLM",PSI VSN,PSIVT_ PSIVOD(PSI VT),PSIVT, OIX1,OIX2) ) Q:OIX2=" " D | |
4969 | LBLM1 | |
4970 | "RTN","PSI VLBL1",31, 0) | |
4971 | K JX Q | |
4972 | "RTN","PSI VLBL1",32, 0) | |
4973 | LBLM1 ; | |
4974 | "RTN","PSI VLBL1",33, 0) | |
4975 | S NOFLG=1 N DFNX,ON X | |
4976 | "RTN","PSI VLBL1",34, 0) | |
4977 | S DFNX=0 F S DFNX= $O(^PS(55, "PSIVWLM", PSIVSN,PSI VT_PSIVOD( PSIVT),PSI VT,OIX1,OI X2,DFNX)) | |
4978 | Q:'DFNX D | |
4979 | "RTN","PSI VLBL1",35, 0) | |
4980 | . S DFN=+ DFNX D ENI V^PSJAC S DFN=DFNX,O NX=0 F S | |
4981 | ONX=$O(^PS (55,"PSIVW LM",PSIVSN ,PSIVT_PSI VOD(PSIVT) ,PSIVT,OIX 1,OIX2,DFN ,ONX)) Q:' ONX D | |
4982 | "RTN","PSI VLBL1",36, 0) | |
4983 | .. S ON=+ ONX,WRD=$P (^(+ON),"^ ",2),X1=OI X1,X2=OIX2 D MEOW | |
4984 | "RTN","PSI VLBL1",37, 0) | |
4985 | ; naked r eference o n line abo ve refers to the ^PS (55,"PSIVW LM" refere nce on the line prec eding the | |
4986 | naked refe rence | |
4987 | "RTN","PSI VLBL1",38, 0) | |
4988 | D:NOFLG D ESC(PSIVT) | |
4989 | "RTN","PSI VLBL1",39, 0) | |
4990 | Q | |
4991 | "RTN","PSI VLBL1",40, 0) | |
4992 | LBLW ; loo p through ward lists | |
4993 | "RTN","PSI VLBL1",41, 0) | |
4994 | N DFNX,ON X,WRDX | |
4995 | "RTN","PSI VLBL1",42, 0) | |
4996 | S NOFLG=1 S WRDX=0 F S WRDX= $O(^PS(55, "PSIVWL",P SIVSN,WRDX )) Q:WRDX= "" D | |
4997 | "RTN","PSI VLBL1",43, 0) | |
4998 | . S WRD=W RDX S DFNX =0 F S DF NX=$O(^PS( 55,"PSIVWL ",PSIVSN,W RD,PSIVT_P SIVOD(PSIV T),DFNX)) | |
4999 | Q:'DFNX D | |
5000 | "RTN","PSI VLBL1",44, 0) | |
5001 | .. S DFN= +DFNX D EN IV^PSJAC S DFN=DFNX S ONX=0 F S | |
5002 | ONX=$O(^PS (55,"PSIVW L",PSIVSN, WRD,PSIVT_ PSIVOD(PSI VT),DFN,ON X)) Q:'ONX S ON=+ON X D MEOW | |
5003 | "RTN","PSI VLBL1",45, 0) | |
5004 | D:NOFLG D ESC(PSIVT) | |
5005 | "RTN","PSI VLBL1",46, 0) | |
5006 | Q | |
5007 | "RTN","PSI VLBL1",47, 0) | |
5008 | MEOWRPT ;R eprint fro m man/ward list | |
5009 | "RTN","PSI VLBL1",48, 0) | |
5010 | I '$O(^PS (55,"PSIVW L",PSIVSN, WRD,PSIVT_ PSIVOD(PSI VT),DFN,+O N,0)) D ME OW Q | |
5011 | "RTN","PSI VLBL1",49, 0) | |
5012 | S PSIVWMF L=1 ;this flag indic ate prt/re prt from w ar/man lis t | |
5013 | "RTN","PSI VLBL1",50, 0) | |
5014 | NEW PSJID ,PSIVOID,P SIVID,X,XX | |
5015 | "RTN","PSI VLBL1",51, 0) | |
5016 | F PSJID=0 :0 S PSJID =$O(^PS(55 ,"PSIVWL", PSIVSN,WRD ,PSIVT_PSI VOD(PSIVT) ,DFN,+ON,P SJID)) Q:' PSJID | |
5017 | D REPRT | |
5018 | "RTN","PSI VLBL1",52, 0) | |
5019 | ; | |
5020 | "RTN","PSI VLBL1",53, 0) | |
5021 | ; Kill ol d ID and s et newly r eprinted I D. | |
5022 | "RTN","PSI VLBL1",54, 0) | |
5023 | ; | |
5024 | "RTN","PSI VLBL1",55, 0) | |
5025 | F X=0:0 S X=$O(PSIV OID(X)) Q: 'X D | |
5026 | "RTN","PSI VLBL1",56, 0) | |
5027 | . K ^PS(5 5,"PSIVWL" ,PSIVSN,WR D,PSIVT_PS IVOD(PSIVT ),DFN,+ON, X) | |
5028 | "RTN","PSI VLBL1",57, 0) | |
5029 | F X=0:0 S X=$O(PSIV ID(X)) Q:' X D | |
5030 | "RTN","PSI VLBL1",58, 0) | |
5031 | . S ^PS(5 5,"PSIVWL" ,PSIVSN,WR D,PSIVT_PS IVOD(PSIVT ),DFN,+ON, X)="" | |
5032 | "RTN","PSI VLBL1",59, 0) | |
5033 | K PSIVWMF L,PSIVOID, PSIVID | |
5034 | "RTN","PSI VLBL1",60, 0) | |
5035 | Q | |
5036 | "RTN","PSI VLBL1",61, 0) | |
5037 | REPRT ; Re print labe ls using e xisting bc ma ID | |
5038 | "RTN","PSI VLBL1",62, 0) | |
5039 | S PSIVOID (PSJID)="" | |
5040 | "RTN","PSI VLBL1",63, 0) | |
5041 | NEW PSJLB S XX=$G(^ PS(55,DFN, "IVBCMA",P SJID,0)) Q :XX="" | |
5042 | "RTN","PSI VLBL1",64, 0) | |
5043 | F X=1:1:9 S PSJLB(X )=$P(XX,U, X) | |
5044 | "RTN","PSI VLBL1",65, 0) | |
5045 | I $S(PSJL B(4)="C":1 ,PSJLB(4)= "G":1,PSJL B(4)="I":1 ,PSJLB(7)' ="":1,PSJL B(9):1,1:0 ) Q | |
5046 | "RTN","PSI VLBL1",66, 0) | |
5047 | S PSIVCTD =0,PSIVCT= 1,PSIVNOL= 1,P(4)=$P( ^PS(55,DFN ,"IV",+ON, 0),"^",4) | |
5048 | "RTN","PSI VLBL1",67, 0) | |
5049 | D REPRT^P SIVLBRP(DF N_"V"_PSJI D) | |
5050 | "RTN","PSI VLBL1",68, 0) | |
5051 | Q | |
5052 | "RTN","PSI VLBL1",69, 0) | |
5053 | MEOW ; Pri nt labels | |
5054 | "RTN","PSI VLBL1",70, 0) | |
5055 | S | |
5056 | PSIVCT=1,P SIVNOL=+^P S(55,"PSIV WL",PSIVSN ,WRD,PSIVT _PSIVOD(PS IVT),DFN,+ ON),P16=$P (^(+ON),"^ " | |
5057 | ,3),PSIVDO SE=$P(^(+O N),"^",2) I '$P(^(+O N),"^",4) S $P(^(+ON ),"^",4)=1 K PSIVCT | |
5058 | "RTN","PSI VLBL1",71, 0) | |
5059 | I PSIVNOL =0 K PSIVD OSE,PSIVCT ,PSIVWMFL, PSIVID Q | |
5060 | "RTN","PSI VLBL1",72, 0) | |
5061 | N PSJSCH, PSJST,A,PS JOK | |
5062 | "RTN","PSI VLBL1",73, 0) | |
5063 | S PSJSCH= $P(^PS(55, DFN,"IV",+ ON,0),"^", 9),PSJST=$ $ONE^PSJBC MA(DFN,ON, PSJSCH) | |
5064 | "RTN","PSI VLBL1",74, 0) | |
5065 | S PSJOK=1 I PSJST=" O" S A=0 F S A=$O(^ PS(55,DFN, "IV",+ON," LAB",A)) Q :A="" I $ P($G(^(A,0 )),"^",3)= 1 | |
5066 | S PSJOK=0 Q | |
5067 | "RTN","PSI VLBL1",75, 0) | |
5068 | Q:'PSJOK | |
5069 | "RTN","PSI VLBL1",76, 0) | |
5070 | Q:"HOD"[$ P(^PS(55,D FN,"IV",+O N,0),"^",1 7) | |
5071 | "RTN","PSI VLBL1",77, 0) | |
5072 | I $O(^PS( 55,"PSIVWL ",PSIVSN,W RD,PSIVT_P SIVOD(PSIV T),DFN,ON, 0)) D Q | |
5073 | "RTN","PSI VLBL1",78, 0) | |
5074 | . S NOFLG =0,PSJRPFL G=1 | |
5075 | "RTN","PSI VLBL1",79, 0) | |
5076 | S PSIVWMF L=1 | |
5077 | "RTN","PSI VLBL1",80, 0) | |
5078 | S IONOFF= "",P(4)=$P (^PS(55,DF N,"IV",+ON ,0),"^",4) ,ACTION=1, TRACK=2 D ^PSIVLTR D | |
5079 | ^PSIVHYPL: P(4)="H",^ PSIVLABL:" APSC"[P(4) | |
5080 | "RTN","PSI VLBL1",81, 0) | |
5081 | I $D(PSIV ID) S X=0 F S X=$O( PSIVID(X)) Q:'X D | |
5082 | "RTN","PSI VLBL1",82, 0) | |
5083 | . S ^PS(5 5,"PSIVWL" ,PSIVSN,WR D,PSIVT_PS IVOD(PSIVT ),DFN,ON,X )="" | |
5084 | "RTN","PSI VLBL1",83, 0) | |
5085 | S NOFLG=0 | |
5086 | "RTN","PSI VLBL1",84, 0) | |
5087 | K PSIVDOS E,PSIVCT,P SIVWMFL,PS IVID Q | |
5088 | "RTN","PSI VLBL1",85, 0) | |
5089 | ; | |
5090 | "RTN","PSI VLBL1",86, 0) | |
5091 | QUE S ZTIO =PSIVPL,ZT DESC="PRIN T SCHEDULE D IV | |
5092 | LABELS",ZT RTN="DEQ^P SIVLBL1",P SIVT="",ZT SAVE("PSJS YSP0")="" | |
5093 | "RTN","PSI VLBL1",87, 0) | |
5094 | F I=0:0 S PSIVT=$O( PSIVMT(PSI VT)) Q:PSI VT="" S | |
5095 | (ZTSAVE("P SIVCD("""_ PSIVT_""") "),ZTSAVE( "PSIVMT("" "_PSIVT_"" ")"),ZTSAV E("PSIVOD( """_PSIVT_ """)")) | |
5096 | ="" | |
5097 | "RTN","PSI VLBL1",88, 0) | |
5098 | F X="PSIV SN","PSIVS ITE","PSJS YSW0","PSJ SYSU","ION OFF" S ZTS AVE(X)="" | |
5099 | "RTN","PSI VLBL1",89, 0) | |
5100 | D ^%ZTLOA D W:$D(ZTS K) !,"Queu ed." Q | |
5101 | "RTN","PSI VLBL1",90, 0) | |
5102 | ; | |
5103 | "RTN","PSI VLBL1",91, 0) | |
5104 | ENLBLI ;Pr int indivi dual label s. | |
5105 | "RTN","PSI VLBL1",92, 0) | |
5106 | D FULL^VA LM1 | |
5107 | "RTN","PSI VLBL1",93, 0) | |
5108 | S PSJORD= ON D ENNH^ PSIVORV2(O N) | |
5109 | "RTN","PSI VLBL1",94, 0) | |
5110 | I ON'["V" W !!,$C(7 ),$C(7),"Y ou may not print lab els for a pending or der." W ! K DIR S DI R(0)="E" D ^DIR | |
5111 | K DIR G Q | |
5112 | "RTN","PSI VLBL1",95, 0) | |
5113 | A1 ; | |
5114 | "RTN","PSI VLBL1",96, 0) | |
5115 | I "EDP"[$ P(^PS(55,D FN,"IV",+O N,0),U,17) W !,$C(7) ,$C(7),"WA RNING, thi s order is not | |
5116 | active.",! ,"Continue " S %=2 D YN^DICN G: %=2!(%=-1) Q G:%=0 A 1 | |
5117 | "RTN","PSI VLBL1",97, 0) | |
5118 | D PAUSE^V ALM1 | |
5119 | "RTN","PSI VLBL1",98, 0) | |
5120 | S PSIVLBT P=1,PSJMOR E=0 D EN^V ALM("PSJ L M IV LABEL S") G Q | |
5121 | "RTN","PSI VLBL1",99, 0) | |
5122 | LBLBEG R ! !,"Number of labels to print: ",X:DTIME Q:'$T!("^" [X) S:X[" ?" HELP="N OL" D:X["? " ^PSIVHLP 1 | |
5123 | G:X["?" LB LBEG K:X'= +X!(X>10)! (X<1)!(X?. E1"."1N.N) X W:'$D(X ) $C(7),$C (7),"??" G :'$D(X) LB LBEG S | |
5124 | PSIVNOL=+X ,PSIVCT=1 | |
5125 | "RTN","PSI VLBL1",100 ,0) | |
5126 | ; | |
5127 | "RTN","PSI VLBL1",101 ,0) | |
5128 | USAGE ; | |
5129 | "RTN","PSI VLBL1",102 ,0) | |
5130 | W !,"Coun t as daily usage" S %=1 D YN^D ICN G:%=-1 Q K:%=1 P SIVCT I %= 0 S HELP=" NCILBL" D | |
5131 | ^PSIVHLP1 G USAGE | |
5132 | "RTN","PSI VLBL1",103 ,0) | |
5133 | S P16=$S( '$D(PSIVCT ):$P(^PS(5 5,DFN,"IV" ,+ON,0),"^ ",16),1:0) S:'$D(PSI VCT) $P(^( 0),"^",16) =P16+X | |
5134 | "RTN","PSI VLBL1",104 ,0) | |
5135 | S IONOFF= "",IOP=PSI VPL,%ZIS=" NQ" D ^%ZI S G:POP Q I IO=IO(0) ,($E(IOST) ="C") W !! ! D DEQIA, Q D | |
5136 | HOME^%ZIS Q | |
5137 | "RTN","PSI VLBL1",105 ,0) | |
5138 | D HOME^%Z IS | |
5139 | "RTN","PSI VLBL1",106 ,0) | |
5140 | W ! S ZTD TH=$H,ZTIO =PSIVPL,ZT DESC="PRIN T INDIVIDU AL IV LABE LS",ZTRTN= "DEQIA^PSI VLBL1" F | |
5141 | X="IONOFF" ,"P16","PS IVAC","PSI VNOL","PSI VSN","PSIV SITE","DFN ","ON","PS JSYSW0","P SJSYSU","P SJSY | |
5142 | SP0" S ZTS AVE(X)="" | |
5143 | "RTN","PSI VLBL1",107 ,0) | |
5144 | S:$D(PSIV CT) ZTSAVE ("PSIVCT") ="" D ^%ZT LOAD W:$D( ZTSK) !,"Q ueued." | |
5145 | "RTN","PSI VLBL1",108 ,0) | |
5146 | Q ;K | |
5147 | %,IONOFF,O N,ORNS,ORP V,ORSTOP,O RSTRT,ORST S,ORVP,P,P SIVC,PSIVR EA,J,N,N2, ORIFN,P17, SCHED,PSI | |
5148 | VDOSE,PSIV NOL,PSIVNO W,VAERR | |
5149 | "RTN","PSI VLBL1",109 ,0) | |
5150 | K | |
5151 | %,IONOFF,O RNS,ORPV,O RSTOP,ORST RT,ORSTS,O RVP,PSIVC, PSIVREA,J, N,N2,ORIFN ,P17,SCHED ,PSIVDOSE | |
5152 | ,PSIVNOL,P SIVNOW,VAE RR | |
5153 | "RTN","PSI VLBL1",110 ,0) | |
5154 | Q | |
5155 | "RTN","PSI VLBL1",111 ,0) | |
5156 | DEQIA ; | |
5157 | "RTN","PSI VLBL1",112 ,0) | |
5158 | K PSIVDOS E S P(4)=$ P(^PS(55,D FN,"IV",+O N,0),"^",4 ) | |
5159 | "RTN","PSI VLBL1",113 ,0) | |
5160 | S ACTION= 1,TRACK=1 D ^PSIVLTR | |
5161 | "RTN","PSI VLBL1",114 ,0) | |
5162 | S X="VEFS KCIV" X ^% ZOSF("TEST ") I $TEST D ;check for Scrip tPro inter face PSJ*5 .0*332 | |
5163 | "RTN","PSI VLBL1",115 ,0) | |
5164 | . S (VEFS PRT,VEFSIV P)=1,ROU=" NEW^VEFSKC IV" D @ROU K ROU | |
5165 | "RTN","PSI VLBL1",116 ,0) | |
5166 | . S (VEFS PRT,VEFSIV P)="" | |
5167 | "RTN","PSI VLBL1",117 ,0) | |
5168 | . I $G(^V EFSAL6("R" ))=Q S ^VE FSALG6(DFN ,ON,"DEQIA PRIVLBL1" )=$H | |
5169 | "RTN","PSI VLBL1",118 ,0) | |
5170 | ; | |
5171 | "RTN","PSI VLBL1",119 ,0) | |
5172 | D ^PSIVHY PL:P(4)="H ",^PSIVLAB L:"APSC"[P (4) S:$D(Z TQUEUED) Z TREQ="@" | |
5173 | "RTN","PSI VLBL1",120 ,0) | |
5174 | Q | |
5175 | "RTN","PSI VLBL1",121 ,0) | |
5176 | DESC(X) ;E xpand the IV type. | |
5177 | "RTN","PSI VLBL1",122 ,0) | |
5178 | NEW XX,Y, DESC,X1,X2 S Y=$$COD ES^PSIVUTL (X,55.01,. 04) | |
5179 | "RTN","PSI VLBL1",123 ,0) | |
5180 | S XX="*** NO "_Y_" D ATA***" | |
5181 | "RTN","PSI VLBL1",124 ,0) | |
5182 | NEW MARX D TXT^PSGM UTL(XX,$P( PSIVSITE,U ,13)) | |
5183 | "RTN","PSI VLBL1",125 ,0) | |
5184 | F XX=1:1: (+PSIVSITE +$P(PSIVSI TE,U,16)) W:XX>2 $G (MARX(XX-2 )) W ! | |
5185 | "RTN","PSI VLBL1",126 ,0) | |
5186 | Q | |
5187 | "RTN","PSI VLBRP") | |
5188 | 0^7^B19569 747^B15941 220 | |
5189 | "RTN","PSI VLBRP",1,0 ) | |
5190 | PSIVLBRP ; BIR/MV - R EPRINT LAB ELS FOR AN ORDER ; 0 6 Nov 2017 8:48 AM | |
5191 | "RTN","PSI VLBRP",2,0 ) | |
5192 | ;;5.0;INP ATIENT MED ICATIONS;* *58,97,250 ,332**;16 DEC 97;Bui ld 8 | |
5193 | "RTN","PSI VLBRP",3,0 ) | |
5194 | ; | |
5195 | "RTN","PSI VLBRP",4,0 ) | |
5196 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
5197 | "RTN","PSI VLBRP",5,0 ) | |
5198 | ; | |
5199 | "RTN","PSI VLBRP",6,0 ) | |
5200 | EN(PSJIDLS T) ; | |
5201 | "RTN","PSI VLBRP",7,0 ) | |
5202 | I '$D(PSJ IDLST) W ! ,"No label s are avai lable" D P AUSE^VALM1 Q | |
5203 | "RTN","PSI VLBRP",8,0 ) | |
5204 | NEW DIR,P SIVCTD | |
5205 | "RTN","PSI VLBRP",9,0 ) | |
5206 | S PSIVCT= 1 | |
5207 | "RTN","PSI VLBRP",10, 0) | |
5208 | W !!,"Cou nt as dail y usage" S %=1 D YN^ DICN Q:%=- 1 S PSIVC TD=$S(%=1: 1,1:0) | |
5209 | "RTN","PSI VLBRP",11, 0) | |
5210 | I PSIVCTD =1 K PSIVC T | |
5211 | "RTN","PSI VLBRP",12, 0) | |
5212 | S PSJY=$$ PROMPT() | |
5213 | "RTN","PSI VLBRP",13, 0) | |
5214 | Q:PSJY="" | |
5215 | "RTN","PSI VLBRP",14, 0) | |
5216 | ;*PSJ*5*2 50 | |
5217 | "RTN","PSI VLBRP",15, 0) | |
5218 | N PSJSEL, PSJSEL1,PS JID,PSJSOL ,PSJSOLERR ,PSJERRLST | |
5219 | "RTN","PSI VLBRP",16, 0) | |
5220 | S PSJERRL ST="" | |
5221 | "RTN","PSI VLBRP",17, 0) | |
5222 | F PSJSEL= 1:1 S PSJS EL1=$P(PSJ Y,",",PSJS EL) Q:PSJS EL1="" D | |
5223 | "RTN","PSI VLBRP",18, 0) | |
5224 | . S PSJID =$G(PSJIDL ST(PSJSEL1 )) Q:PSJID ="" | |
5225 | "RTN","PSI VLBRP",19, 0) | |
5226 | . S PSJID NO=$P(PSJI D,"V",2) | |
5227 | "RTN","PSI VLBRP",20, 0) | |
5228 | . F PSJSO L=0:0 S PS JSOL=$O(^P S(55,DFN," IVBCMA",PS JIDNO,"SOL ",PSJSOL)) Q:'PSJSOL D | |
5229 | "RTN","PSI VLBRP",21, 0) | |
5230 | . . I $G( ^PS(55,DFN ,"IVBCMA", PSJIDNO,"S OL",PSJSOL ,0))'=$G(^ PS(55,DFN, "IV",+ON," SOL",PSJSO L,0)) S | |
5231 | PSJSOLERR= 1,PSJERRLS T=PSJERRLS T_$S(PSJER RLST="":PS JID,1:", " _PSJID) | |
5232 | "RTN","PSI VLBRP",22, 0) | |
5233 | I $G(PSJS OLERR) D F ULL^VALM1 S DIR("A", 1)="Soluti on on labe l(s) "_PSJ ERRLST_" d oes not ma tch | |
5234 | current or der." S DI R("A")="En ter RETURN to contin ue" S DIR( 0)="FO" D ^DIR Q | |
5235 | "RTN","PSI VLBRP",23, 0) | |
5236 | ;*END PSJ *5*250 | |
5237 | "RTN","PSI VLBRP",24, 0) | |
5238 | D PRT | |
5239 | "RTN","PSI VLBRP",25, 0) | |
5240 | Q | |
5241 | "RTN","PSI VLBRP",26, 0) | |
5242 | PROMPT() ; | |
5243 | "RTN","PSI VLBRP",27, 0) | |
5244 | W ! | |
5245 | "RTN","PSI VLBRP",28, 0) | |
5246 | S DIR(0)= "LOA^1:"_P SJIDLST,DI R("A")="Se lect from 1 - "_PSJI DLST_" or <RETURN> t o select b y BCMA ID: | |
5247 | " D ^DIR | |
5248 | "RTN","PSI VLBRP",29, 0) | |
5249 | K DIR | |
5250 | "RTN","PSI VLBRP",30, 0) | |
5251 | S PSJY=Y | |
5252 | "RTN","PSI VLBRP",31, 0) | |
5253 | I PSJY="" S DIR(0)= "FOA^1:50^ S X=$$UP^X LFSTR(X) K :'$D(PSJID LST(X)) X" ,DIR("A")= "Enter a B CMA ID: " | |
5254 | D ^DIR S P SJY=$$UP^X LFSTR(Y) | |
5255 | "RTN","PSI VLBRP",32, 0) | |
5256 | K DIR | |
5257 | "RTN","PSI VLBRP",33, 0) | |
5258 | W !! | |
5259 | "RTN","PSI VLBRP",34, 0) | |
5260 | Q PSJY | |
5261 | "RTN","PSI VLBRP",35, 0) | |
5262 | DEQIA ; | |
5263 | "RTN","PSI VLBRP",36, 0) | |
5264 | S PSIVNOL =0 | |
5265 | "RTN","PSI VLBRP",37, 0) | |
5266 | F PSJSEL= 1:1 S PSJS EL1=$P(PSJ Y,",",PSJS EL) Q:PSJS EL1="" S PSIVNOL=PS IVNOL+1 | |
5267 | "RTN","PSI VLBRP",38, 0) | |
5268 | F PSJSEL= 1:1 S PSJS EL1=$P(PSJ Y,",",PSJS EL) Q:PSJS EL1="" D | |
5269 | "RTN","PSI VLBRP",39, 0) | |
5270 | . S:'PSIV CTD PSIVCT =1 | |
5271 | "RTN","PSI VLBRP",40, 0) | |
5272 | . S PSJID =$G(PSJIDL ST(PSJSEL1 )) Q:PSJID ="" D REP RT(PSJID) | |
5273 | "RTN","PSI VLBRP",41, 0) | |
5274 | K PSJRPHD | |
5275 | "RTN","PSI VLBRP",42, 0) | |
5276 | Q | |
5277 | "RTN","PSI VLBRP",43, 0) | |
5278 | REPRT(PSJI D) ; | |
5279 | "RTN","PSI VLBRP",44, 0) | |
5280 | S PSJNEWI D=$$BCMA^P SIVBCID(DF N,ON,$D(PS IVCT),$G(P SIV1),$G(P SIV2),$G(P SIVNOL)) | |
5281 | "RTN","PSI VLBRP",45, 0) | |
5282 | I PSJNEWI D="" W !," Can't get a new BCMA ID. Try again" Q | |
5283 | "RTN","PSI VLBRP",46, 0) | |
5284 | S PSJIDNO =$P(PSJID, "V",2) | |
5285 | "RTN","PSI VLBRP",47, 0) | |
5286 | S PSIVBAG =$P($G(^PS (55,DFN,"I VBCMA",PSJ IDNO,0)),U ,8) | |
5287 | "RTN","PSI VLBRP",48, 0) | |
5288 | N DA,DR,D IE,DIC | |
5289 | "RTN","PSI VLBRP",49, 0) | |
5290 | ;S DIC(0) ="L",DA=Y, DA(1)=DFN, X=PSJNEWID ,DIC="^PS( 55,"_DA(1) _",""IVBCM A""," D FI LE^DICN | |
5291 | "RTN","PSI VLBRP",50, 0) | |
5292 | K DA,DR,D IE S DIE=" ^PS(55,"_D FN_",""IVB CMA"",",DA =$P(PSJNEW ID,"V",2), DA(1)=DFN D NOW^%DTC | |
5293 | "RTN","PSI VLBRP",51, 0) | |
5294 | ;S DR=".0 2////"_+ON _";3////"_ PSIVCTD_"; 4////"_$E( %,1,12)_"; 6////"_PSI VBAG D ^DI E | |
5295 | "RTN","PSI VLBRP",52, 0) | |
5296 | S DR="6// //"_PSIVBA G D ^DIE | |
5297 | "RTN","PSI VLBRP",53, 0) | |
5298 | K DA,DR,D IE,DIC | |
5299 | "RTN","PSI VLBRP",54, 0) | |
5300 | S PSJNEWI D=$P(PSJNE WID,"V",2) | |
5301 | "RTN","PSI VLBRP",55, 0) | |
5302 | F PSJAD=0 :0 S PSJAD =$O(^PS(55 ,DFN,"IVBC MA",PSJIDN O,"AD",PSJ AD)) Q:'PS JAD D | |
5303 | "RTN","PSI VLBRP",56, 0) | |
5304 | . S PSJAD X=$G(^PS(5 5,DFN,"IVB CMA",PSJID NO,"AD",PS JAD,0)) | |
5305 | "RTN","PSI VLBRP",57, 0) | |
5306 | . D UP2^P SIVBCID(DF N,PSJNEWID ,PSJAD,PSJ ADX) | |
5307 | "RTN","PSI VLBRP",58, 0) | |
5308 | F PSJSOL= 0:0 S PSJS OL=$O(^PS( 55,DFN,"IV BCMA",PSJI DNO,"SOL", PSJSOL)) Q :'PSJSOL D | |
5309 | "RTN","PSI VLBRP",59, 0) | |
5310 | . S PSJSO LX=$G(^PS( 55,DFN,"IV BCMA",PSJI DNO,"SOL", PSJSOL,0)) | |
5311 | "RTN","PSI VLBRP",60, 0) | |
5312 | . D UP3^P SIVBCID(DF N,PSJNEWID ,PSJSOL,PS JSOLX) | |
5313 | "RTN","PSI VLBRP",61, 0) | |
5314 | K DA,DR,D IE,DIC | |
5315 | "RTN","PSI VLBRP",62, 0) | |
5316 | S DA=PSJI DNO,DA(1)= DFN,DIE="^ PS(55,"_DA (1)_",""IV BCMA""," | |
5317 | "RTN","PSI VLBRP",63, 0) | |
5318 | S DR="5// //RP" D ^D IE | |
5319 | "RTN","PSI VLBRP",64, 0) | |
5320 | K DA,DR,D IE,DIC | |
5321 | "RTN","PSI VLBRP",65, 0) | |
5322 | D ^PSIVHY PR:P(4)="H ",^PSIVLAB R:"APSC"[P (4) S:$D(Z TQUEUED) Z TREQ="@" | |
5323 | "RTN","PSI VLBRP",66, 0) | |
5324 | ;PSJRPHD is defined so ^PSIVL ABR won't print the header for sub-label s. | |
5325 | "RTN","PSI VLBRP",67, 0) | |
5326 | S PSJRPHD =1 | |
5327 | "RTN","PSI VLBRP",68, 0) | |
5328 | S X="VEFS KCIV" X ^% ZOSF("TEST ") I $TEST D ;check for Scrip tPro inter face PSJ*5 .0*332 | |
5329 | "RTN","PSI VLBRP",69, 0) | |
5330 | . S (VEFS PRT,VEFSIV P)=1 N XX S XX="NEW^ VEFSKCIV" D @XX | |
5331 | "RTN","PSI VLBRP",70, 0) | |
5332 | . S (VEFS PRT,VEFSIV P)="" | |
5333 | "RTN","PSI VLBRP",71, 0) | |
5334 | . I $G(^V EFSAL6("R" ))=Q S ^VE FSALG6(DFN ,ON,"DEQIA PRIVLBL1" )=$H | |
5335 | "RTN","PSI VLBRP",72, 0) | |
5336 | ; | |
5337 | "RTN","PSI VLBRP",73, 0) | |
5338 | ;If repri nting from war/man l ist, store new BCMA ID. | |
5339 | "RTN","PSI VLBRP",74, 0) | |
5340 | S:$G(PSIV WMFL) PSIV ID(PSJNEWI D)="" | |
5341 | "RTN","PSI VLBRP",75, 0) | |
5342 | Q | |
5343 | "RTN","PSI VLBRP",76, 0) | |
5344 | PRT ; | |
5345 | "RTN","PSI VLBRP",77, 0) | |
5346 | S X="VEFS KCIV" X ^% ZOSF("TEST ") I $TEST D ;check for Scrip tPro inter face PSJ*5 .0*332 | |
5347 | "RTN","PSI VLBRP",78, 0) | |
5348 | . S (VEFS PRT,VEFSIV P)=1 N XX S XX="NEW^ VEFSKCIV" D @XX | |
5349 | "RTN","PSI VLBRP",79, 0) | |
5350 | . S (VEFS PRT,VEFSIV P)="" | |
5351 | "RTN","PSI VLBRP",80, 0) | |
5352 | . I $G(^V EFSAL6("R" ))=Q S ^VE FSALG6(DFN ,ON,"DEQIA PRIVLBL1" )=$H | |
5353 | "RTN","PSI VLBRP",81, 0) | |
5354 | ; | |
5355 | "RTN","PSI VLBRP",82, 0) | |
5356 | S IONOFF= "",IOP=PSI VPL,%ZIS=" NQ" D ^%ZI S G:POP Q I IO=IO(0) ,($E(IOST) ="C") W !! ! D DEQIA, Q D | |
5357 | HOME^%ZIS Q | |
5358 | "RTN","PSI VLBRP",83, 0) | |
5359 | D HOME^%Z IS | |
5360 | "RTN","PSI VLBRP",84, 0) | |
5361 | W ! S ZTD TH=$H,ZTIO =PSIVPL,ZT DESC="REPR INT INDIVI DUAL IV LA BELS",ZTRT N="DEQIA^P SIVLBRP" F | |
5362 | X="IONOFF" ,"P16","PS IVAC","PSI VSN","PSIV SITE","DFN ","ON","PS JSYSW0","P SJSYSU","P SJSYSP0"," PSJID | |
5363 | LST(","P(" ,"PSJY","P SIVCTD" S ZTSAVE(X)= "" | |
5364 | "RTN","PSI VLBRP",85, 0) | |
5365 | S:$D(PSIV CT) ZTSAVE ("PSIVCT") ="" D ^%ZT LOAD W:$D( ZTSK) !,"Q ueued." | |
5366 | "RTN","PSI VLBRP",86, 0) | |
5367 | Q | |
5368 | "RTN","PSI VLBRP",87, 0) | |
5369 | Q ; | |
5370 | "RTN","PSI VLBRP",88, 0) | |
5371 | Q | |
5372 | "RTN","PSI VORLB") | |
5373 | 0^26^B1653 1182^B1655 4015 | |
5374 | "RTN","PSI VORLB",1,0 ) | |
5375 | PSIVORLB ; BIR/MLM-PR INT OUT LA BELS ; 25 Jan 2019 8:40 AM | |
5376 | "RTN","PSI VORLB",2,0 ) | |
5377 | ;;5.0;INP ATIENT MED ICATIONS;* *58,184,27 9,332**;16 DEC 97;Bu ild 8 | |
5378 | "RTN","PSI VORLB",3,0 ) | |
5379 | ; | |
5380 | "RTN","PSI VORLB",4,0 ) | |
5381 | ; Referen ce to ^PS( 52.6 is su pported by DBIA 1231 . | |
5382 | "RTN","PSI VORLB",5,0 ) | |
5383 | ; Referen ce to ^PS( 52.7 is su pported by DBIA 2173 . | |
5384 | "RTN","PSI VORLB",6,0 ) | |
5385 | ; | |
5386 | "RTN","PSI VORLB",7,0 ) | |
5387 | ENX ;Print example l abel | |
5388 | "RTN","PSI VORLB",8,0 ) | |
5389 | I ($G(VAI N(4))="") D CLINIC^P SIVOREN | |
5390 | "RTN","PSI VORLB",9,0 ) | |
5391 | D FULL^VA LM1 | |
5392 | "RTN","PSI VORLB",10, 0) | |
5393 | S PSIVFLA G=1,PSIVRM =$P(PSIVSI TE,U,13) S :PSIVRM<1 PSIVRM=30 D:$E(P("OT "))="I" OR FLDS^PSIVE DT1 | |
5394 | W:$E(P("OT "))'="I" ! ,"Med Rout e: ",$P(P( "MR"),U,2) ,! | |
5395 | "RTN","PSI VORLB",11, 0) | |
5396 | START F PS IV1=1:1:PS IVNOL S LI NE=0 D RE I '$D(PSIV FLAG) F | |
5397 | LINE=LINE+ 1:1:(PSIVS ITE+$P(PSI VSITE,U,16 )) W ! | |
5398 | "RTN","PSI VORLB",12, 0) | |
5399 | Q K | |
5400 | PSIVDOSE,P 16,LINE,ME SS,PSIVCT, PSIV2,PSIV FLAG,PSIVR M,PSIV1,PD OSE,PDATE, XX1,XX2,BA G,CX,PSIME S | |
5401 | S,PSIVCLAB Q | |
5402 | "RTN","PSI VORLB",13, 0) | |
5403 | RE ; | |
5404 | "RTN","PSI VORLB",14, 0) | |
5405 | D:'$D(VAD M(2)) DEM^ VADPT | |
5406 | "RTN","PSI VORLB",15, 0) | |
5407 | I PSIV1,P (4)="A"!(P (5)=0) S:P (15)>2880! ('P(15)) P (15)=2880 S P(16)=P1 6+PSIV1#(1 440/P(15)+ .5\1) | |
5408 | S:'P(16) P (16)=1440/ P(15)+.5\1 | |
5409 | "RTN","PSI VORLB",16, 0) | |
5410 | W DFN,! | |
5411 | "RTN","PSI VORLB",17, 0) | |
5412 | N PSIVCLI N,PSIVCLDT S | |
5413 | PSIVCLIN=$ S($G(P("CL IN")):P("C LIN"),($G( ON55)["V") :+$G(^PS(5 5,DFN,"IV" ,+ON55,"DS S")),($G(O N55)["P | |
5414 | "):+$G(^PS (53.1,+ON5 5,"DSS")), 1:"") S:'( PSIVCLIN>0 ) PSIVCLIN ="" I PSIV CLIN D | |
5415 | "RTN","PSI VORLB",18, 0) | |
5416 | .S PSIVCL DT=$P(PSIV CLIN,"^",2 ) S $P(PSI VCLIN,"^", 2)=$P($G(^ SC(+PSIVCL IN,0)),"^" ) | |
5417 | "RTN","PSI VORLB",19, 0) | |
5418 | I $G(PSIV CLIN) N PS IVCLAB S P SIVCLAB=$P ($G(^SC(+P SIVCLIN,0) ),"^",2) | |
5419 | "RTN","PSI VORLB",20, 0) | |
5420 | S X=$S(P( "PON")["V" :"["_+P("P ON")_"]",1 :"")_$P($P (VADM(2),U ,2),"-",3) D | |
5421 | "RTN","PSI VORLB",21, 0) | |
5422 | .S X=X_" | |
5423 | "_$S($G(PS IVCLIN)&($ G(PSIVCLAB )]""):PSIV CLAB,$G(PS IVCLIN)&($ P(PSIVCLIN ,"^",2)'=" "):$P(PSIV CLIN,"^" | |
5424 | ,2),+VAIN( 4):$P(VAIN (4),U,2),1 :" *OPT*") _" "_$E(D T,4,5)_"/" _$E(DT,6,7 )_"/"_$E(D T,2,3) | |
5425 | "RTN","PSI VORLB",22, 0) | |
5426 | D P | |
5427 | "RTN","PSI VORLB",23, 0) | |
5428 | S X=VADM( 1) S:$P(PS IVSITE,U,9 ) X=X_" " _$S(VAIN(5 )]"":VAIN( 5),1:"NF") D P S X=" " D P | |
5429 | "RTN","PSI VORLB",24, 0) | |
5430 | I $D(PSIV FLAG) F PS IV=0:0 S P SIV=$O(DRG ("AD",PSIV )) Q:'PSIV S | |
5431 | Y=DRG("AD" ,PSIV),X=$ S($P(Y,U,2 )]"":$P(Y, U,2),1:"** *******")_ " "_$P(Y,U ,3)_" " S: $P(Y,U,4)] "" X=X_" | |
5432 | ("_$P(Y,U, 4)_")" D P ,MESS | |
5433 | "RTN","PSI VORLB",25, 0) | |
5434 | G:$D(PSIV FLAG) SOL | |
5435 | "RTN","PSI VORLB",26, 0) | |
5436 | F PSIV=0: 0 S PSIV=$ O(DRG("AD" ,PSIV)) Q: 'PSIV S | |
5437 | Y=DRG("AD" ,PSIV),X=$ S($P(Y,U,2 )]"":$P(Y, U,2),1:"** ******")_" "_$P(Y,U, 3) I | |
5438 | ","_$P(Y,U ,4)_","[(" ,"_P(16)_" ,")!('$P(Y ,U,4)) D P ,MESS | |
5439 | "RTN","PSI VORLB",27, 0) | |
5440 | SOL F PSIV =0:0 S PSI V=$O(DRG(" SOL",PSIV) ) Q:'PSIV S Y=DRG(" SOL",PSIV) D SOL1,P S | |
5441 | X=$P(^PS(5 2.7,+$P(Y, U),0),U,4) I X]"" S X=" "_X D P | |
5442 | "RTN","PSI VORLB",28, 0) | |
5443 | I P(23)'= ""!(P(4)=" S") S X="I n Syringe: "_$E(P("S YRS"),1,25 ) D:P(4)=" S"!(P(23)= "S") P S X ="*CAUTION * - | |
5444 | CHEMOTHERA PY" D:P(23 )'="" P | |
5445 | "RTN","PSI VORLB",29, 0) | |
5446 | S X=" " D P I | |
5447 | PSIV1'>0!' $P(PSIVSIT E,U,3)!($P (PSIVSITE, U,3)=1&(P( 4)'="P"))! ($P(PSIVSI TE,U,3)=2& ("AH"'[P(4 ))) G INF | |
5448 | "RTN","PSI VORLB",30, 0) | |
5449 | S:'$D(PSI VDOSE) PSI VDOSE="" S X=$P(PSIV DOSE," ",P SIV1) D:$E (X)="." CO NVER S X=" Dose due a t: | |
5450 | "_$S(X="": "________" ,1:$E(X,4, 5)_"/"_$E( X,6,7)_"/" _$E(X,2,3) _" "_$E(X# 1_"000",2, 5)) D P | |
5451 | "RTN","PSI VORLB",31, 0) | |
5452 | INF S X=$P (P(8),"@") D:X]"" P I P("OPI") ]"" S X=$P (P("OPI"), "^") D P | |
5453 | "RTN","PSI VORLB",32, 0) | |
5454 | S X=P(9) D:X]"" P | |
5455 | "RTN","PSI VORLB",33, 0) | |
5456 | S X=P(11) D:X]"" P | |
5457 | "RTN","PSI VORLB",34, 0) | |
5458 | ; PSJ*5*1 84 - Displ ay all mes sages if m ore than o ne additiv e has a me ssage. | |
5459 | "RTN","PSI VORLB",35, 0) | |
5460 | I $D(MESS ) S PSIMES S="" F S PSIMESS=$O (MESS(PSIM ESS)) Q:PS IMESS="" S X=PSIMES S D P | |
5461 | "RTN","PSI VORLB",36, 0) | |
5462 | I $D(^PS( 59.5,PSIVS N,4)) S Y= ^(4) F PSI V=1:1 S X= $P(Y,U,PSI V) Q:X="" D P | |
5463 | "RTN","PSI VORLB",37, 0) | |
5464 | S X=PSIV1 _"["_PSIVN OL_"]" D P | |
5465 | "RTN","PSI VORLB",38, 0) | |
5466 | Q | |
5467 | "RTN","PSI VORLB",39, 0) | |
5468 | P F LINE=L INE+1:1 X: LINE>+PSIV SITE "S LI NE=1 F ZZ= 1:1 Q:ZZ>$ P(PSIVSITE ,""^"",16) W !" K Z Z W | |
5469 | $E(X,1,PSI VRM),! S X =$E(X,PSIV RM+1,999) Q:$L(X)<1 | |
5470 | "RTN","PSI VORLB",40, 0) | |
5471 | Q | |
5472 | "RTN","PSI VORLB",41, 0) | |
5473 | SOL1 S X=$ S($P(Y,U,2 )]"":$P(Y, U,2)_" "_$ P(Y,U,3),1 :"******** **") Q | |
5474 | "RTN","PSI VORLB",42, 0) | |
5475 | MESS ; PSJ *5*184 - m ake MESS a local arr ay so all messages d isplay for all addit ives. | |
5476 | "RTN","PSI VORLB",43, 0) | |
5477 | I $P(^PS( 52.6,+$P(Y ,U),0),U,9 )]"" S MES S($P(^PS(5 2.6,+$P(Y, U),0),U,9) )="" | |
5478 | "RTN","PSI VORLB",44, 0) | |
5479 | Q | |
5480 | "RTN","PSI VORLB",45, 0) | |
5481 | CONVER ;Ex pand dose to date.do se and set in X | |
5482 | "RTN","PSI VORLB",46, 0) | |
5483 | I P(15)>1 440 S X=$$ CONVER1^PS IVORE2($P( PSIVDOSE," "),P(15), (PSIV1-1)) Q | |
5484 | "RTN","PSI VORLB",47, 0) | |
5485 | S PDOSE=X S:PSIV1=2 PDATE=$E( $P(PSIVDOS E," "),1,7 ) | |
5486 | "RTN","PSI VORLB",48, 0) | |
5487 | I $P(PSIV DOSE," ",P SIV1-1)#1' <PDOSE!(P( 15)>1440) S:$D(X1) X X1=X1 S:$D (X2) XX2=X 2 S X1=PDA TE,X2=1 | |
5488 | D C^%DTC S PDATE=X,X =X_PDOSE S :$D(XX1) X 1=XX1 S:$D (XX2) X2=X X2 Q | |
5489 | "RTN","PSI VORLB",49, 0) | |
5490 | S X=PDATE _PDOSE | |
5491 | "RTN","PSI VORLB",50, 0) | |
5492 | Q | |
5493 | "RTN","PSJ DIN") | |
5494 | 0^8^B46714 111^B38154 566 | |
5495 | "RTN","PSJ DIN",1,0) | |
5496 | PSJDIN ;BI R/MV - Nat ional Form ulary Indi cator Util ity ; 02 O ct 2018 1 0:45 AM | |
5497 | "RTN","PSJ DIN",2,0) | |
5498 | ;;5.0;INP ATIENT MED ICATIONS;* *50,56,76, 227,289,33 2**;16 DEC 97;Build 8 | |
5499 | "RTN","PSJ DIN",3,0) | |
5500 | ; | |
5501 | "RTN","PSJ DIN",4,0) | |
5502 | ; Referen ce to ^PSS DIN is sup ported by DBIA# 3166 . | |
5503 | "RTN","PSJ DIN",5,0) | |
5504 | ; Referen ce to ^PS( 52.6 is su pported by DBIA# 123 1. | |
5505 | "RTN","PSJ DIN",6,0) | |
5506 | ; Referen ce to ^PS( 52.7 is su pported by DBIA# 217 3. | |
5507 | "RTN","PSJ DIN",7,0) | |
5508 | ; Referen ce to ^PS( 50.7 is su pported by DBIA# 218 0. | |
5509 | "RTN","PSJ DIN",8,0) | |
5510 | ; Referen ce tp ^PSD RUG is sup ported by DBIA# 2192 . | |
5511 | "RTN","PSJ DIN",9,0) | |
5512 | ; | |
5513 | "RTN","PSJ DIN",10,0) | |
5514 | DINIV(FIL, DRGTMP) ; | |
5515 | "RTN","PSJ DIN",11,0) | |
5516 | ;*Find th e DD & OI IEN for th e additive or soluti on | |
5517 | "RTN","PSJ DIN",12,0) | |
5518 | ;*FIL: 52.6 or 5 2.7 | |
5519 | "RTN","PSJ DIN",13,0) | |
5520 | ;*DRGTMP: Additive or Solutio n's IEN | |
5521 | "RTN","PSJ DIN",14,0) | |
5522 | ; | |
5523 | "RTN","PSJ DIN",15,0) | |
5524 | NEW PSJDR G,PSJOI,PS JDD,PSJDIN ,PSJINDEX | |
5525 | "RTN","PSJ DIN",16,0) | |
5526 | S PSJDRG= $P(^PS(FIL ,+DRGTMP,0 ),U,2),PSJ OI=$P(^PS( FIL,+DRGTM P,0),U,11) | |
5527 | "RTN","PSJ DIN",17,0) | |
5528 | D DIN(PSJ OI,PSJDRG) | |
5529 | "RTN","PSJ DIN",18,0) | |
5530 | Q | |
5531 | "RTN","PSJ DIN",19,0) | |
5532 | DIN(PSJOI, PSJDRG) ; | |
5533 | "RTN","PSJ DIN",20,0) | |
5534 | ;*This wi ll issue t he Restric tion/guide line promp t for both OI & DD | |
5535 | "RTN","PSJ DIN",21,0) | |
5536 | ;*PSJOI: Orderabl e Item IEN | |
5537 | "RTN","PSJ DIN",22,0) | |
5538 | ;*PSJDRG: Dispens e drug IEN | |
5539 | "RTN","PSJ DIN",23,0) | |
5540 | ; | |
5541 | "RTN","PSJ DIN",24,0) | |
5542 | NEW PSJDI N,PSJDD,PS JINDEX,Y,X ,XIT | |
5543 | "RTN","PSJ DIN",25,0) | |
5544 | D EN^PSSD IN(PSJOI,P SJDRG) | |
5545 | "RTN","PSJ DIN",26,0) | |
5546 | Q:$O(^TMP ("PSSDIN", $J,""))="" | |
5547 | "RTN","PSJ DIN",27,0) | |
5548 | S PSJDIN= $$PROMPT^P SSDIN | |
5549 | "RTN","PSJ DIN",28,0) | |
5550 | W:"DOY"[Y @IOF | |
5551 | "RTN","PSJ DIN",29,0) | |
5552 | I PSJDIN= "D"!(PSJDI N="Y") D Q:XIT=U | |
5553 | "RTN","PSJ DIN",30,0) | |
5554 | . W !!,"D ispense Dr ug Text:" W ! D TXD( "DD") W !! | |
5555 | "RTN","PSJ DIN",31,0) | |
5556 | I PSJDIN= "O"!(PSJDI N="Y") D | |
5557 | "RTN","PSJ DIN",32,0) | |
5558 | . W !!,"O rderable I tem Text:" W ! D TXD ("OI") W ! ! | |
5559 | "RTN","PSJ DIN",33,0) | |
5560 | D PAUSE^V ALM1,CLEAR ^VALM1 | |
5561 | "RTN","PSJ DIN",34,0) | |
5562 | Q | |
5563 | "RTN","PSJ DIN",35,0) | |
5564 | TXD(N1) ; | |
5565 | "RTN","PSJ DIN",36,0) | |
5566 | ;N1 = "OI " or "DD" | |
5567 | "RTN","PSJ DIN",37,0) | |
5568 | ;DISPLAY OI/DD DRUG TEXT | |
5569 | "RTN","PSJ DIN",38,0) | |
5570 | N N2,N3,N 4,NX S XIT ="",NX="PS SDIN" ; | |
5571 | "RTN","PSJ DIN",39,0) | |
5572 | S N2="" F S N2=$O( ^TMP(NX,$J ,N1,N2)) Q :'N2!(XIT= U) D | |
5573 | "RTN","PSJ DIN",40,0) | |
5574 | .S N3="" F S N3=$O (^TMP(NX,$ J,N1,N2,N3 )) Q:'N3!( XIT=U) D | |
5575 | "RTN","PSJ DIN",41,0) | |
5576 | ..S N4="" F S N4=$ O(^TMP(NX, $J,N1,N2,N 3,N4)) Q:' N4!(XIT=U) D | |
5577 | "RTN","PSJ DIN",42,0) | |
5578 | ...W !?5, ^TMP(NX,$J ,N1,N2,N3, N4) I $Y>1 5 W ! D HL D S XIT=X | |
5579 | "RTN","PSJ DIN",43,0) | |
5580 | Q | |
5581 | "RTN","PSJ DIN",44,0) | |
5582 | HLD ; | |
5583 | "RTN","PSJ DIN",45,0) | |
5584 | W ! | |
5585 | "RTN","PSJ DIN",46,0) | |
5586 | ;K DIR S DIR(0)="E" ,DIR("A")= "Press Ret urn to Con tinue" D ^ DIR K DIR | |
5587 | "RTN","PSJ DIN",47,0) | |
5588 | K DIR | |
5589 | "RTN","PSJ DIN",48,0) | |
5590 | S DIR(0)= "E",DIR("A ")="Press Return to Continue o r ""^"" to Exit: " | |
5591 | "RTN","PSJ DIN",49,0) | |
5592 | D ^DIR K DIR | |
5593 | "RTN","PSJ DIN",50,0) | |
5594 | W @IOF | |
5595 | "RTN","PSJ DIN",51,0) | |
5596 | Q | |
5597 | "RTN","PSJ DIN",52,0) | |
5598 | NFIV(FIL,P SJIVIEN,PS JNF) ; | |
5599 | "RTN","PSJ DIN",53,0) | |
5600 | ;*Return N/F and ms g display for ad/sol . | |
5601 | "RTN","PSJ DIN",54,0) | |
5602 | ;*FIL: "AD" or "S OL" | |
5603 | "RTN","PSJ DIN",55,0) | |
5604 | ;*PSIVIEN : Additive or Soluti on's IEN | |
5605 | "RTN","PSJ DIN",56,0) | |
5606 | ;*PSJNF: 0 node f rom file 5 0 | |
5607 | "RTN","PSJ DIN",57,0) | |
5608 | ;*PSJNF(" NF"): Onl y exist if it is a N on-formula ry | |
5609 | "RTN","PSJ DIN",58,0) | |
5610 | ;*PSJNF(" MSG"): Ret urn the me ssage fiel d to be di splayed /w IV names | |
5611 | "RTN","PSJ DIN",59,0) | |
5612 | ; | |
5613 | "RTN","PSJ DIN",60,0) | |
5614 | S PSJNF=$ G(^PSDRUG( +$P($G(^PS (FIL,+PSJI VIEN,0)),U ,2),0)) | |
5615 | "RTN","PSJ DIN",61,0) | |
5616 | S PSJNF(" NF")=$S($P (PSJNF,U,9 )=1:" *N/F *",1:"") | |
5617 | "RTN","PSJ DIN",62,0) | |
5618 | S PSJNF(" MSG")=$P(P SJNF,U,10) | |
5619 | "RTN","PSJ DIN",63,0) | |
5620 | Q | |
5621 | "RTN","PSJ DIN",64,0) | |
5622 | DINFLIV(DR G) ; | |
5623 | "RTN","PSJ DIN",65,0) | |
5624 | ;*This mo dule will find all d rug text t hat exist for the Or derable | |
5625 | "RTN","PSJ DIN",66,0) | |
5626 | ;*Items & dispense drugs asso ciated wit h the Addi tive(s) & Solution(s ) | |
5627 | "RTN","PSJ DIN",67,0) | |
5628 | ;*within the IV ord er. Once a drug tex t exist, r eturn the <DIN> | |
5629 | "RTN","PSJ DIN",68,0) | |
5630 | ;*indicat or to be d isplayed w ithin the order view . | |
5631 | "RTN","PSJ DIN",69,0) | |
5632 | ; | |
5633 | "RTN","PSJ DIN",70,0) | |
5634 | ;*DRG: D rug array from the I V order | |
5635 | "RTN","PSJ DIN",71,0) | |
5636 | NEW PSJFI L,PSJND,PS JX,PSJFL | |
5637 | "RTN","PSJ DIN",72,0) | |
5638 | F PSJFIL= "AD","SOL" F PSJND=0 :0 S PSJND =$O(DRG(PS JFIL,PSJND )) Q:'PSJN D!$G(PSJFL ) D | |
5639 | "RTN","PSJ DIN",73,0) | |
5640 | . S PSJX= $G(^PS($S( PSJFIL="AD ":52.6,1:5 2.7),+DRG( PSJFIL,PSJ ND),0)) D | |
5641 | EN^PSSDIN( $P(PSJX,U, 11),$P(PSJ X,U,2)) | |
5642 | "RTN","PSJ DIN",74,0) | |
5643 | . I $O(^T MP("PSSDIN ",$J,""))] "" S PSJFL =1 Q | |
5644 | "RTN","PSJ DIN",75,0) | |
5645 | I '$G(PSJ FL),$G(PSJ ORD)["P" S PSJFL=$$D INFLUD(+P( "PD")),PSJ FL=$S(PSJF L]"":1,1:0 ) | |
5646 | "RTN","PSJ DIN",76,0) | |
5647 | K ^TMP("P SSDIN",$J) | |
5648 | "RTN","PSJ DIN",77,0) | |
5649 | Q $S($G(P SJFL):" <D IN>",1:"") | |
5650 | "RTN","PSJ DIN",78,0) | |
5651 | ; | |
5652 | "RTN","PSJ DIN",79,0) | |
5653 | DINFLUD(PS JOI,PSJDDA ) ; | |
5654 | "RTN","PSJ DIN",80,0) | |
5655 | ;*This mo dule will find all d rug text t hat exist for the Or derable | |
5656 | "RTN","PSJ DIN",81,0) | |
5657 | ;*items & dispense drugs asso ciated wit h the unit dose orde r. Once | |
5658 | "RTN","PSJ DIN",82,0) | |
5659 | ;*a drug text exist , return t he <DIN> i ndicator t o be displ ayed with | |
5660 | "RTN","PSJ DIN",83,0) | |
5661 | ;*the ord er view. | |
5662 | "RTN","PSJ DIN",84,0) | |
5663 | ;*PSJOI: Orderable IEN (Requ ire) | |
5664 | "RTN","PSJ DIN",85,0) | |
5665 | ;*PSJDDA: Dispense drug array within th e order (O ptional) | |
5666 | "RTN","PSJ DIN",86,0) | |
5667 | ; | |
5668 | "RTN","PSJ DIN",87,0) | |
5669 | NEW PSJFL ,PSJDD | |
5670 | "RTN","PSJ DIN",88,0) | |
5671 | D EN^PSSD IN(PSJOI) I $O(^TMP( "PSSDIN",$ J,"OI",0)) K ^TMP("P SSDIN",$J) Q "<DIN>" | |
5672 | "RTN","PSJ DIN",89,0) | |
5673 | F PSJDD=0 :0 S PSJDD =$O(PSJDDA (PSJDD)) Q :'PSJDD D | |
5674 | "RTN","PSJ DIN",90,0) | |
5675 | . D EN^PS SDIN(,PSJD D) I $O(^T MP("PSSDIN ",$J,"DD", 0)) S PSJF L=1 Q | |
5676 | "RTN","PSJ DIN",91,0) | |
5677 | K ^TMP("P SSDIN",$J) | |
5678 | "RTN","PSJ DIN",92,0) | |
5679 | Q $S($G(P SJFL):"<DI N>",1:"") | |
5680 | "RTN","PSJ DIN",93,0) | |
5681 | ; | |
5682 | "RTN","PSJ DIN",94,0) | |
5683 | DINHIDE(PS JDFN,PSJOR D) ; | |
5684 | "RTN","PSJ DIN",95,0) | |
5685 | ;*Display drug text from the hidden act ion. | |
5686 | "RTN","PSJ DIN",96,0) | |
5687 | ;*PSJDFN: Patient I EN (Requir e) | |
5688 | "RTN","PSJ DIN",97,0) | |
5689 | ;*PSJORD: Order #_" UVP" (Requ ired) | |
5690 | "RTN","PSJ DIN",98,0) | |
5691 | ;*DRG: IV DRG ar ray (Requi red for IV but Optio nal for UD orders) | |
5692 | "RTN","PSJ DIN",99,0) | |
5693 | ; | |
5694 | "RTN","PSJ DIN",100,0 ) | |
5695 | D:PSJORD[ "V" IV | |
5696 | "RTN","PSJ DIN",101,0 ) | |
5697 | D:PSJORD[ "U" UD | |
5698 | "RTN","PSJ DIN",102,0 ) | |
5699 | I PSJORD[ "P" D | |
5700 | "RTN","PSJ DIN",103,0 ) | |
5701 | . D @($S( $P(^PS(53. 1,+PSJORD, 0),U,4)="U ":"UD",1:" IV")) ;PS J*5*227 - Unit Dose DIN fix | |
5702 | "RTN","PSJ DIN",104,0 ) | |
5703 | I PSJORD= "" D NEWUD | |
5704 | "RTN","PSJ DIN",105,0 ) | |
5705 | K ^TMP("P SSDIN",$J) | |
5706 | "RTN","PSJ DIN",106,0 ) | |
5707 | Q | |
5708 | "RTN","PSJ DIN",107,0 ) | |
5709 | IV ; | |
5710 | "RTN","PSJ DIN",108,0 ) | |
5711 | ;NEW DRG, DRGI,DRGT, ND,ON55,Y | |
5712 | "RTN","PSJ DIN",109,0 ) | |
5713 | ;D:PSJORD ["P" GT531 ^PSIVORFA( DFN,PSJORD ) | |
5714 | "RTN","PSJ DIN",110,0 ) | |
5715 | ;I PSJORD ["V" S ON5 5=PSJORD D GTDRG^PSI VORFB | |
5716 | "RTN","PSJ DIN",111,0 ) | |
5717 | ;*Loop th ru IV DRG array to f ind OI & D D IEN from each AD & SOL. | |
5718 | "RTN","PSJ DIN",112,0 ) | |
5719 | ; | |
5720 | "RTN","PSJ DIN",113,0 ) | |
5721 | NEW FIL,N AME,PSJDD, PSJNF,PSJO I,PSJX,Y,X ,PSJXY,STR ,UNT,STRUN | |
5722 | "RTN","PSJ DIN",114,0 ) | |
5723 | D FULL^VA LM1 W @IOF | |
5724 | "RTN","PSJ DIN",115,0 ) | |
5725 | W !,"Drug restricti on/guideli ne info:" | |
5726 | "RTN","PSJ DIN",116,0 ) | |
5727 | F FIL="AD ","SOL" F PSJX=0:0 S PSJX=$O(D RG(FIL,PSJ X)) Q:'PSJ X D | |
5728 | "RTN","PSJ DIN",117,0 ) | |
5729 | . NEW X | |
5730 | "RTN","PSJ DIN",118,0 ) | |
5731 | . S PSJXY =1 | |
5732 | "RTN","PSJ DIN",119,0 ) | |
5733 | . SET NAM E=$P(DRG(F IL,PSJX),U ,2) | |
5734 | "RTN","PSJ DIN",120,0 ) | |
5735 | . ;PSJ*5* 289 - Add Additive S trength to display. | |
5736 | "RTN","PSJ DIN",121,0 ) | |
5737 | . S STR=$ $GET1^DIQ( 52.6,$P(DR G(FIL,PSJX ),U,1)_"," ,19) ; Ge t STRENGTH from IV A dditives F ile | |
5738 | "RTN","PSJ DIN",122,0 ) | |
5739 | . S UNT=$ $GET1^DIQ( 52.6,$P(DR G(FIL,PSJX ),U,1)_"," ,2) ; Ge t DRUG UNI T from IV Additives File | |
5740 | "RTN","PSJ DIN",123,0 ) | |
5741 | . S STRUN =$G(STR)_" "_$G(UNT) ; Append DRUG UNIT to STRENG TH | |
5742 | "RTN","PSJ DIN",124,0 ) | |
5743 | . I STR=" " S STRUN= "N/A" ; P er Pharmac y User Gro up - put N /A if the STRENGTH f ield is no t populate d. | |
5744 | "RTN","PSJ DIN",125,0 ) | |
5745 | . W !!,"I V "_$S(FIL ="AD":"Add itive",1:" Solution") _": "_NAME | |
5746 | "RTN","PSJ DIN",126,0 ) | |
5747 | . D NFIV( FIL,+PSJX, .PSJNF) W $G(PSJNF(" NF"))_$S(F IL="AD":" Additive Strength: "_$G(STRU N),1:""),! | |
5748 | ;Put Addit ive Streng th after * N/F*. | |
5749 | "RTN","PSJ DIN",127,0 ) | |
5750 | . S X=$S( FIL="AD":$ G(^PS(52.6 ,+DRG(FIL, PSJX),0)), 1:$G(^PS(5 2.7,+DRG(F IL,PSJX),0 ))) | |
5751 | "RTN","PSJ DIN",128,0 ) | |
5752 | . S PSJOI =$P(X,U,11 ),PSJDD=$P (X,U,2) D EN^PSSDIN( +PSJOI,+PS JDD) | |
5753 | "RTN","PSJ DIN",129,0 ) | |
5754 | . D DINOI (PSJOI,3) | |
5755 | "RTN","PSJ DIN",130,0 ) | |
5756 | . D DINDD (PSJDD,3) | |
5757 | "RTN","PSJ DIN",131,0 ) | |
5758 | D:'$G(PSJ XY) HLD | |
5759 | "RTN","PSJ DIN",132,0 ) | |
5760 | K ^TMP("P SSDIN",$J) | |
5761 | "RTN","PSJ DIN",133,0 ) | |
5762 | Q | |
5763 | "RTN","PSJ DIN",134,0 ) | |
5764 | UD ; | |
5765 | "RTN","PSJ DIN",135,0 ) | |
5766 | ;*Loop th ru Unit do se order f or Orderab le Item & Dispense d rug | |
5767 | "RTN","PSJ DIN",136,0 ) | |
5768 | ; | |
5769 | "RTN","PSJ DIN",137,0 ) | |
5770 | NEW F,PSJ DD,PSJDDX, PSJOI,PSJX Y | |
5771 | "RTN","PSJ DIN",138,0 ) | |
5772 | D FULL^VA LM1 W @IOF | |
5773 | "RTN","PSJ DIN",139,0 ) | |
5774 | W !,"Drug restricti on/guideli ne info:" | |
5775 | "RTN","PSJ DIN",140,0 ) | |
5776 | S F=$S(PS JORD["U":" ^PS(55,PSJ DFN,5,+PSJ ORD,",1:"^ PS(53.1,+P SJORD,") | |
5777 | "RTN","PSJ DIN",141,0 ) | |
5778 | S PSJOI=+ @(F_".2)") D EN^PSSD IN(PSJOI), DINOI(PSJO I,3) | |
5779 | "RTN","PSJ DIN",142,0 ) | |
5780 | ;*Loop th ru dispens e drug arr ay | |
5781 | "RTN","PSJ DIN",143,0 ) | |
5782 | F PSJDDX= 0:0 S PSJD DX=$O(@(F_ "1,"_PSJDD X_")")) Q: 'PSJDDX D | |
5783 | "RTN","PSJ DIN",144,0 ) | |
5784 | . S PSJXY =1 | |
5785 | "RTN","PSJ DIN",145,0 ) | |
5786 | . S PSJDD =+@(F_"1," _PSJDDX_", 0)") | |
5787 | "RTN","PSJ DIN",146,0 ) | |
5788 | . D EN^PS SDIN(PSJOI ,PSJDD) | |
5789 | "RTN","PSJ DIN",147,0 ) | |
5790 | . D DINDD (PSJDD,3) | |
5791 | "RTN","PSJ DIN",148,0 ) | |
5792 | D:'$G(PSJ XY) HLD | |
5793 | "RTN","PSJ DIN",149,0 ) | |
5794 | K ^TMP("P SSDIN",$J) | |
5795 | "RTN","PSJ DIN",150,0 ) | |
5796 | Q | |
5797 | "RTN","PSJ DIN",151,0 ) | |
5798 | NEWUD ;*Ne w backdoor order doe sn't have an order# yet. | |
5799 | "RTN","PSJ DIN",152,0 ) | |
5800 | ;*Loop th ru Orderab le Item & Dispense d rug | |
5801 | "RTN","PSJ DIN",153,0 ) | |
5802 | ; | |
5803 | "RTN","PSJ DIN",154,0 ) | |
5804 | NEW F,PSJ DD,PSJDDX, PSJOI,PSJX Y | |
5805 | "RTN","PSJ DIN",155,0 ) | |
5806 | D FULL^VA LM1 W @IOF | |
5807 | "RTN","PSJ DIN",156,0 ) | |
5808 | W !,"Drug restricti on/guideli ne info:" | |
5809 | "RTN","PSJ DIN",157,0 ) | |
5810 | S PSJOI=+ $G(PSGPD) D EN^PSSDI N(PSJOI),D INOI(PSJOI ,3) | |
5811 | "RTN","PSJ DIN",158,0 ) | |
5812 | ;*Loop th ru dispens e drug arr ay | |
5813 | "RTN","PSJ DIN",159,0 ) | |
5814 | F PSJDDX= 0:0 S PSJD DX=$O(^PS( 53.45,PSJS YSP,2,PSJD DX)) Q:'PS JDDX D | |
5815 | "RTN","PSJ DIN",160,0 ) | |
5816 | . S PSJXY =1 | |
5817 | "RTN","PSJ DIN",161,0 ) | |
5818 | . S PSJDD =+$G(^PS(5 3.45,PSJSY SP,2,PSJDD X,0)) | |
5819 | "RTN","PSJ DIN",162,0 ) | |
5820 | . D EN^PS SDIN(PSJOI ,PSJDD) | |
5821 | "RTN","PSJ DIN",163,0 ) | |
5822 | . D DINDD (PSJDD,3) | |
5823 | "RTN","PSJ DIN",164,0 ) | |
5824 | D:'$G(PSJ XY) HLD | |
5825 | "RTN","PSJ DIN",165,0 ) | |
5826 | K ^TMP("P SSDIN",$J) | |
5827 | "RTN","PSJ DIN",166,0 ) | |
5828 | Q | |
5829 | "RTN","PSJ DIN",167,0 ) | |
5830 | DINOI(PSJO I,COL) ; | |
5831 | "RTN","PSJ DIN",168,0 ) | |
5832 | ;*Display drug text for Order able Item | |
5833 | "RTN","PSJ DIN",169,0 ) | |
5834 | ;*OI: O rderable I tem IEN | |
5835 | "RTN","PSJ DIN",170,0 ) | |
5836 | ;*COl: C olumn to d isplay the text in | |
5837 | "RTN","PSJ DIN",171,0 ) | |
5838 | ; | |
5839 | "RTN","PSJ DIN",172,0 ) | |
5840 | NEW X,XX | |
5841 | "RTN","PSJ DIN",173,0 ) | |
5842 | W !!,?COL ,"Orderabl e Item: "_ $$OINAME^P SJLMUTL(PS JOI)_$$OIN F(PSJOI),! | |
5843 | "RTN","PSJ DIN",174,0 ) | |
5844 | I '$O(^TM P("PSSDIN" ,$J,"OI",P SJOI,0)) W !,?10,"No informati on availab le",! Q | |
5845 | "RTN","PSJ DIN",175,0 ) | |
5846 | D TXD("OI ") W ! | |
5847 | "RTN","PSJ DIN",176,0 ) | |
5848 | Q | |
5849 | "RTN","PSJ DIN",177,0 ) | |
5850 | DINDD(PSJD D,COL) ; | |
5851 | "RTN","PSJ DIN",178,0 ) | |
5852 | ;*Display drug text for Dispe nse drug | |
5853 | "RTN","PSJ DIN",179,0 ) | |
5854 | ;*PSJDD: Dispense drug IEN | |
5855 | "RTN","PSJ DIN",180,0 ) | |
5856 | ;*COL: Column to display t he text in | |
5857 | "RTN","PSJ DIN",181,0 ) | |
5858 | ; | |
5859 | "RTN","PSJ DIN",182,0 ) | |
5860 | NEW X | |
5861 | "RTN","PSJ DIN",183,0 ) | |
5862 | W !,?COL, "Dispense drug: "_$$ DDNAME^PSJ LMUTL(+PSJ DD)_$$DDNF (PSJDD),! | |
5863 | "RTN","PSJ DIN",184,0 ) | |
5864 | I '$O(^TM P("PSSDIN" ,$J,"DD",P SJDD,0)) W !?10,"No informatio n availabl e",! D HLD Q | |
5865 | "RTN","PSJ DIN",185,0 ) | |
5866 | D TXD("DD "),HLD W @ IOF | |
5867 | "RTN","PSJ DIN",186,0 ) | |
5868 | Q | |
5869 | "RTN","PSJ DIN",187,0 ) | |
5870 | OINF(PSJOI ) ; | |
5871 | "RTN","PSJ DIN",188,0 ) | |
5872 | ;*Return *N/F* if t he orderab le item is Non-formu lary | |
5873 | "RTN","PSJ DIN",189,0 ) | |
5874 | ;*Return *PA* if or derable is formulary , but rest ricted. | |
5875 | "RTN","PSJ DIN",190,0 ) | |
5876 | N RTRN,ZC NT,ZFLG | |
5877 | "RTN","PSJ DIN",191,0 ) | |
5878 | S RTRN="" ,ZFLG="N" | |
5879 | "RTN","PSJ DIN",192,0 ) | |
5880 | I $$GET1^ DIQ(50.7,+ PSJOI_",", 5,"I")=1 S RTRN=" *N /F*" | |
5881 | "RTN","PSJ DIN",193,0 ) | |
5882 | I $$GET^X PAR("DIV", "PSS PRIOR AUTH NOTA TION","`"_ DUZ(2))>0, RTRN'=" *N /F*" D | |
5883 | "RTN","PSJ DIN",194,0 ) | |
5884 | . S ZCNT= 0 F S ZCN T=$O(^PS(5 0.7,"A50", +PSJOI,ZCN T)) Q:ZCNT =""!(ZFLG= "Y") D | |
5885 | "RTN","PSJ DIN",195,0 ) | |
5886 | . . N PSJ AR,PSJER D GETS^DIQ( 50,+ZCNT_" ,","3;100; 102","E"," PSJAR","PS JER") | |
5887 | "RTN","PSJ DIN",196,0 ) | |
5888 | . . I PSJ AR(50,+ZCN T_",",100, "E")]"" S ZFLG="Y" Q ; INACTI VE | |
5889 | "RTN","PSJ DIN",197,0 ) | |
5890 | . . I PSJ AR(50,+ZCN T_",",3,"E ")["R" S Z FLG="Y",RT RN=" **PA* *" Q | |
5891 | "RTN","PSJ DIN",198,0 ) | |
5892 | . . I PSJ AR(50,+ZCN T_",",102, "E")["REST RICTED" S ZFLG="Y",R TRN=" **PA **" Q | |
5893 | "RTN","PSJ DIN",199,0 ) | |
5894 | Q RTRN | |
5895 | "RTN","PSJ DIN",200,0 ) | |
5896 | ; | |
5897 | "RTN","PSJ DIN",201,0 ) | |
5898 | ;*PSJOI: Orderable item IEN | |
5899 | "RTN","PSJ DIN",202,0 ) | |
5900 | ; | |
5901 | "RTN","PSJ DIN",203,0 ) | |
5902 | ;Q $S($P( $G(^PS(50. 7,+PSJOI,0 )),U,12)=1 :" *N/F*", 1:"") | |
5903 | "RTN","PSJ DIN",204,0 ) | |
5904 | ; | |
5905 | "RTN","PSJ DIN",205,0 ) | |
5906 | DDNF(PSJDD ) ; | |
5907 | "RTN","PSJ DIN",206,0 ) | |
5908 | ;**Return *N/F* if the dispen se drug is Non-formu lary | |
5909 | "RTN","PSJ DIN",207,0 ) | |
5910 | ;**Return **PA** if drug need s prior au thorizatio n (Restric ted) | |
5911 | "RTN","PSJ DIN",208,0 ) | |
5912 | ;*PSJDD: Dispense d rug IEN | |
5913 | "RTN","PSJ DIN",209,0 ) | |
5914 | ; | |
5915 | "RTN","PSJ DIN",210,0 ) | |
5916 | ;Q $S($P( $G(^PSDRUG (+PSJDD,0) ),U,9)=1:" *N/F*",1: "") | |
5917 | "RTN","PSJ DIN",211,0 ) | |
5918 | N RTRN | |
5919 | "RTN","PSJ DIN",212,0 ) | |
5920 | S RTRN="" | |
5921 | "RTN","PSJ DIN",213,0 ) | |
5922 | I $$GET1^ DIQ(50,+PS JDD_",",51 ,"I")=1 S RTRN="*N/F *" | |
5923 | "RTN","PSJ DIN",214,0 ) | |
5924 | I RTRN'=" *N/F*" D | |
5925 | "RTN","PSJ DIN",215,0 ) | |
5926 | . I $$GET 1^DIQ(50,+ PSJDD_",", 3,"I")["R" !($$GET1^D IQ(50,+PSJ DD_",",102 ,"I"))["RE STRICTED" S RTRN=" | |
5927 | **PA**" | |
5928 | "RTN","PSJ DIN",216,0 ) | |
5929 | Q RTRN | |
5930 | "VER") | |
5931 | 8.0^22.2 | |
5932 | "^DD",59.5 ,59.5,.107 ,0) | |
5933 | HEADER LAB EL^NJ1,0^^ 1;7^K:+X'= X!(X>9)!(X <0)!(X?.E1 "."1N.N) X | |
5934 | "^DD",59.5 ,59.5,.107 ,3) | |
5935 | Type a num ber betwee n 0 and 9, 0 decimal digits. | |
5936 | "^DD",59.5 ,59.5,.107 ,20,0) | |
5937 | ^.3LA^1^1 | |
5938 | "^DD",59.5 ,59.5,.107 ,20,1,0) | |
5939 | PSJI | |
5940 | "^DD",59.5 ,59.5,.107 ,21,0) | |
5941 | ^^3^3^3170 730^ | |
5942 | "^DD",59.5 ,59.5,.107 ,21,1,0) | |
5943 | Indicates the number of labels to be pro duced when printing pre-exchan ge | |
5944 | "^DD",59.5 ,59.5,.107 ,21,2,0) | |
5945 | labels for IVs. Val id values are 0-9, w here 0 = N o Header L abel, 1 = 1 | |
5946 | "^DD",59.5 ,59.5,.107 ,21,3,0) | |
5947 | label, 2 = two (2) h eader labe ls, etc. | |
5948 | "^DD",59.5 ,59.5,.107 ,22) | |
5949 | ||
5950 | "^DD",59.5 ,59.5,.107 ,"DT") | |
5951 | 3170730 | |
5952 | "BLD",9866 ,6) | |
5953 | 1^ | |
5954 | $END KID P SJ*5.0*332 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.