Produced by Araxis Merge on 12/6/2018 10:45:27 AM Eastern 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 | PSU_P2_V2_Build_3.zip | PSO_7_524.KID | Thu Dec 6 14:45:20 2018 UTC |
2 | PSU_P2_V2_Build_3.zip | PSO_7_524.KID | Thu Dec 6 15:34:08 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 4464 |
Changed | 2 | 4 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | KIDS Distr ibution sa ved on Jun 05, 2018@ 13:14:18 | |
2 | CAS - RXSU 2 Build 3 v3 | |
3 | **KIDS**:P SO*7.0*524 ^ | |
4 | ||
5 | **INSTALL NAME** | |
6 | PSO*7.0*52 4 | |
7 | "BLD",1054 2,0) | |
8 | PSO*7.0*52 4^OUTPATIE NT PHARMAC Y^0^318060 5^y | |
9 | "BLD",1054 2,1,0) | |
10 | ^^14^14^31 80605^ | |
11 | "BLD",1054 2,1,1,0) | |
12 | Patch PSO* 7.0*524 wi ll enhance Outpatien t Prescrip tion Proce ssing by | |
13 | "BLD",1054 2,1,2,0) | |
14 | adding an alert to P harmacists and Pharm acy techni cians duri ng Finishi ng | |
15 | "BLD",1054 2,1,3,0) | |
16 | an outpati ent order that invol ves a Haza rdous to H andle and/ or a Hazar dous | |
17 | "BLD",1054 2,1,4,0) | |
18 | to Dispose drug. | |
19 | "BLD",1054 2,1,5,0) | |
20 | ||
21 | "BLD",1054 2,1,6,0) | |
22 | * NOTICE * | |
23 | "BLD",1054 2,1,7,0) | |
24 | This CA S-RXSU2 pr oject is a n enhancem ent that i ncludes 5 patches th at | |
25 | "BLD",1054 2,1,8,0) | |
26 | should be install ed togethe r: | |
27 | "BLD",1054 2,1,9,0) | |
28 | ||
29 | "BLD",1054 2,1,10,0) | |
30 | 1. PS S*1*226 | |
31 | "BLD",1054 2,1,11,0) | |
32 | 2. PS O*7*524 | |
33 | "BLD",1054 2,1,12,0) | |
34 | 3. PS J*5*364 | |
35 | "BLD",1054 2,1,13,0) | |
36 | 4. PS B*3*106 | |
37 | "BLD",1054 2,1,14,0) | |
38 | 5. PS B*3*108 | |
39 | "BLD",1054 2,4,0) | |
40 | ^9.64PA^^ | |
41 | "BLD",1054 2,6.3) | |
42 | 12 | |
43 | "BLD",1054 2,"KRN",0) | |
44 | ^9.67PA^77 9.2^20 | |
45 | "BLD",1054 2,"KRN",.4 ,0) | |
46 | .4 | |
47 | "BLD",1054 2,"KRN",.4 01,0) | |
48 | .401 | |
49 | "BLD",1054 2,"KRN",.4 02,0) | |
50 | .402 | |
51 | "BLD",1054 2,"KRN",.4 03,0) | |
52 | .403 | |
53 | "BLD",1054 2,"KRN",.5 ,0) | |
54 | .5 | |
55 | "BLD",1054 2,"KRN",.8 4,0) | |
56 | .84 | |
57 | "BLD",1054 2,"KRN",3. 6,0) | |
58 | 3.6 | |
59 | "BLD",1054 2,"KRN",3. 8,0) | |
60 | 3.8 | |
61 | "BLD",1054 2,"KRN",9. 2,0) | |
62 | 9.2 | |
63 | "BLD",1054 2,"KRN",9. 8,0) | |
64 | 9.8 | |
65 | "BLD",1054 2,"KRN",9. 8,"NM",0) | |
66 | ^9.68A^6^5 | |
67 | "BLD",1054 2,"KRN",9. 8,"NM",1,0 ) | |
68 | PSODRG^^0^ B104026958 | |
69 | "BLD",1054 2,"KRN",9. 8,"NM",2,0 ) | |
70 | PSOHLDS1^^ 0^B4988790 0 | |
71 | "BLD",1054 2,"KRN",9. 8,"NM",3,0 ) | |
72 | PSOHLDS2^^ 0^B9825519 2 | |
73 | "BLD",1054 2,"KRN",9. 8,"NM",5,0 ) | |
74 | PSOOREDT^^ 0^B8316480 4 | |
75 | "BLD",1054 2,"KRN",9. 8,"NM",6,0 ) | |
76 | PSOORNE2^^ 0^B1148073 67 | |
77 | "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSODRG", 1) | |
78 | ||
79 | "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOHLDS1 ",2) | |
80 | ||
81 | "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOHLDS2 ",3) | |
82 | ||
83 | "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOOREDT ",5) | |
84 | ||
85 | "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOORNE2 ",6) | |
86 | ||
87 | "BLD",1054 2,"KRN",19 ,0) | |
88 | 19 | |
89 | "BLD",1054 2,"KRN",19 .1,0) | |
90 | 19.1 | |
91 | "BLD",1054 2,"KRN",10 1,0) | |
92 | 101 | |
93 | "BLD",1054 2,"KRN",40 9.61,0) | |
94 | 409.61 | |
95 | "BLD",1054 2,"KRN",77 1,0) | |
96 | 771 | |
97 | "BLD",1054 2,"KRN",77 9.2,0) | |
98 | 779.2 | |
99 | "BLD",1054 2,"KRN",87 0,0) | |
100 | 870 | |
101 | "BLD",1054 2,"KRN",89 89.51,0) | |
102 | 8989.51 | |
103 | "BLD",1054 2,"KRN",89 89.52,0) | |
104 | 8989.52 | |
105 | "BLD",1054 2,"KRN",89 94,0) | |
106 | 8994 | |
107 | "BLD",1054 2,"KRN","B ",.4,.4) | |
108 | ||
109 | "BLD",1054 2,"KRN","B ",.401,.40 1) | |
110 | ||
111 | "BLD",1054 2,"KRN","B ",.402,.40 2) | |
112 | ||
113 | "BLD",1054 2,"KRN","B ",.403,.40 3) | |
114 | ||
115 | "BLD",1054 2,"KRN","B ",.5,.5) | |
116 | ||
117 | "BLD",1054 2,"KRN","B ",.84,.84) | |
118 | ||
119 | "BLD",1054 2,"KRN","B ",3.6,3.6) | |
120 | ||
121 | "BLD",1054 2,"KRN","B ",3.8,3.8) | |
122 | ||
123 | "BLD",1054 2,"KRN","B ",9.2,9.2) | |
124 | ||
125 | "BLD",1054 2,"KRN","B ",9.8,9.8) | |
126 | ||
127 | "BLD",1054 2,"KRN","B ",19,19) | |
128 | ||
129 | "BLD",1054 2,"KRN","B ",19.1,19. 1) | |
130 | ||
131 | "BLD",1054 2,"KRN","B ",101,101) | |
132 | ||
133 | "BLD",1054 2,"KRN","B ",409.61,4 09.61) | |
134 | ||
135 | "BLD",1054 2,"KRN","B ",771,771) | |
136 | ||
137 | "BLD",1054 2,"KRN","B ",779.2,77 9.2) | |
138 | ||
139 | "BLD",1054 2,"KRN","B ",870,870) | |
140 | ||
141 | "BLD",1054 2,"KRN","B ",8989.51, 8989.51) | |
142 | ||
143 | "BLD",1054 2,"KRN","B ",8989.52, 8989.52) | |
144 | ||
145 | "BLD",1054 2,"KRN","B ",8994,899 4) | |
146 | ||
147 | "BLD",1054 2,"QDEF") | |
148 | ^^^^NO^^^^ NO^^NO | |
149 | "BLD",1054 2,"QUES",0 ) | |
150 | ^9.62^^ | |
151 | "BLD",1054 2,"REQB",0 ) | |
152 | ^9.611^2^2 | |
153 | "BLD",1054 2,"REQB",1 ,0) | |
154 | PSO*7.0*46 7^2 | |
155 | "BLD",1054 2,"REQB",2 ,0) | |
156 | PSO*7.0*50 4^2 | |
157 | "BLD",1054 2,"REQB"," B","PSO*7. 0*467",1) | |
158 | ||
159 | "BLD",1054 2,"REQB"," B","PSO*7. 0*504",2) | |
160 | ||
161 | "MBREQ") | |
162 | 0 | |
163 | "PKG",170, -1) | |
164 | 1^1 | |
165 | "PKG",170, 0) | |
166 | OUTPATIENT PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS | |
167 | "PKG",170, 20,0) | |
168 | ^9.402P^^ | |
169 | "PKG",170, 22,0) | |
170 | ^9.49I^1^1 | |
171 | "PKG",170, 22,1,0) | |
172 | 7.0^297121 6^2981113^ 1 | |
173 | "PKG",170, 22,1,"PAH" ,1,0) | |
174 | 524^318060 5 | |
175 | "PKG",170, 22,1,"PAH" ,1,1,0) | |
176 | ^^14^14^31 80605 | |
177 | "PKG",170, 22,1,"PAH" ,1,1,1,0) | |
178 | Patch PSO* 7.0*524 wi ll enhance Outpatien t Prescrip tion Proce ssing by | |
179 | "PKG",170, 22,1,"PAH" ,1,1,2,0) | |
180 | adding an alert to P harmacists and Pharm acy techni cians duri ng Finishi ng | |
181 | "PKG",170, 22,1,"PAH" ,1,1,3,0) | |
182 | an outpati ent order that invol ves a Haza rdous to H andle and/ or a Hazar dous | |
183 | "PKG",170, 22,1,"PAH" ,1,1,4,0) | |
184 | to Dispose drug. | |
185 | "PKG",170, 22,1,"PAH" ,1,1,5,0) | |
186 | ||
187 | "PKG",170, 22,1,"PAH" ,1,1,6,0) | |
188 | * NOTICE * | |
189 | "PKG",170, 22,1,"PAH" ,1,1,7,0) | |
190 | This CA S-RXSU2 pr oject is a n enhancem ent that i ncludes 5 patches th at | |
191 | "PKG",170, 22,1,"PAH" ,1,1,8,0) | |
192 | should be install ed togethe r: | |
193 | "PKG",170, 22,1,"PAH" ,1,1,9,0) | |
194 | ||
195 | "PKG",170, 22,1,"PAH" ,1,1,10,0) | |
196 | 1. PS S*1*226 | |
197 | "PKG",170, 22,1,"PAH" ,1,1,11,0) | |
198 | 2. PS O*7*524 | |
199 | "PKG",170, 22,1,"PAH" ,1,1,12,0) | |
200 | 3. PS J*5*364 | |
201 | "PKG",170, 22,1,"PAH" ,1,1,13,0) | |
202 | 4. PS B*3*106 | |
203 | "PKG",170, 22,1,"PAH" ,1,1,14,0) | |
204 | 5. PS B*3*108 | |
205 | "QUES","XP F1",0) | |
206 | Y | |
207 | "QUES","XP F1","??") | |
208 | ^D REP^XPD H | |
209 | "QUES","XP F1","A") | |
210 | Shall I wr ite over y our |FLAG| File | |
211 | "QUES","XP F1","B") | |
212 | YES | |
213 | "QUES","XP F1","M") | |
214 | D XPF1^XPD IQ | |
215 | "QUES","XP F2",0) | |
216 | Y | |
217 | "QUES","XP F2","??") | |
218 | ^D DTA^XPD H | |
219 | "QUES","XP F2","A") | |
220 | Want my da ta |FLAG| yours | |
221 | "QUES","XP F2","B") | |
222 | YES | |
223 | "QUES","XP F2","M") | |
224 | D XPF2^XPD IQ | |
225 | "QUES","XP I1",0) | |
226 | YO | |
227 | "QUES","XP I1","??") | |
228 | ^D INHIBIT ^XPDH | |
229 | "QUES","XP I1","A") | |
230 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
231 | "QUES","XP I1","B") | |
232 | NO | |
233 | "QUES","XP I1","M") | |
234 | D XPI1^XPD IQ | |
235 | "QUES","XP M1",0) | |
236 | PO^VA(200, :EM | |
237 | "QUES","XP M1","??") | |
238 | ^D MG^XPDH | |
239 | "QUES","XP M1","A") | |
240 | Enter the Coordinato r for Mail Group '|F LAG|' | |
241 | "QUES","XP M1","B") | |
242 | ||
243 | "QUES","XP M1","M") | |
244 | D XPM1^XPD IQ | |
245 | "QUES","XP O1",0) | |
246 | Y | |
247 | "QUES","XP O1","??") | |
248 | ^D MENU^XP DH | |
249 | "QUES","XP O1","A") | |
250 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
251 | "QUES","XP O1","B") | |
252 | NO | |
253 | "QUES","XP O1","M") | |
254 | D XPO1^XPD IQ | |
255 | "QUES","XP Z1",0) | |
256 | Y | |
257 | "QUES","XP Z1","??") | |
258 | ^D OPT^XPD H | |
259 | "QUES","XP Z1","A") | |
260 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
261 | "QUES","XP Z1","B") | |
262 | NO | |
263 | "QUES","XP Z1","M") | |
264 | D XPZ1^XPD IQ | |
265 | "QUES","XP Z2",0) | |
266 | Y | |
267 | "QUES","XP Z2","??") | |
268 | ^D RTN^XPD H | |
269 | "QUES","XP Z2","A") | |
270 | Want to MO VE routine s to other CPUs | |
271 | "QUES","XP Z2","B") | |
272 | NO | |
273 | "QUES","XP Z2","M") | |
274 | D XPZ2^XPD IQ | |
275 | "RTN") | |
276 | 5 | |
277 | "RTN","PSO DRG") | |
278 | 0^1^B10402 6958 | |
279 | "RTN","PSO DRG",1,0) | |
280 | PSODRG ;IH S/DSD/JCM - ORDER EN TRY DRUG S ELECTION ; 2/16/12 12 :50pm | |
281 | "RTN","PSO DRG",2,0) | |
282 | ;;7.0;OUT PATIENT PH ARMACY;**2 0,23,36,53 ,54,46,112 ,139,207,1 48,243,268 ,324,251,3 75,387,398 ,390,427,4 11,458,504 ,524**;DEC 1997;Buil d 12 | |
283 | "RTN","PSO DRG",3,0) | |
284 | ;Referenc e to ^PSDR UG( suppor ted by DBI A 221 | |
285 | "RTN","PSO DRG",4,0) | |
286 | ;Referenc e to ^PS(5 0.7 suppor ted by DBI A 2223 | |
287 | "RTN","PSO DRG",5,0) | |
288 | ;Referenc e to $$PRO MPT^PSSDIN supported by DBIA 3 166 | |
289 | "RTN","PSO DRG",6,0) | |
290 | ;Referenc e to EN^PS SDIN suppo rted by DB IA 3166 | |
291 | "RTN","PSO DRG",7,0) | |
292 | ;Referenc e to $$GET NDC^PSSNDC UT support ed by DBIA 4707 | |
293 | "RTN","PSO DRG",8,0) | |
294 | ;Referenc e to ^OROC API contro lled subsc ription su pported by DBIA 5367 | |
295 | "RTN","PSO DRG",9,0) | |
296 | ;Referenc e to $$OIT M^ORX8 sup ported by DBIA 5469 | |
297 | "RTN","PSO DRG",10,0) | |
298 | ;Referenc e to ^VADP T supporte d by DBIA 10061 | |
299 | "RTN","PSO DRG",11,0) | |
300 | ;Referenc e to IN^PS SHRQ2 supp orted by D BIA 5369 | |
301 | "RTN","PSO DRG",12,0) | |
302 | ;Referenc e to ^XTMP ("ORRDI" s upported b y DBIA 544 0 | |
303 | "RTN","PSO DRG",13,0) | |
304 | ; | |
305 | "RTN","PSO DRG",14,0) | |
306 | ;*524 Add HAZ Handl e & Haz Di spose Aler t pre-orde r checks | |
307 | "RTN","PSO DRG",15,0) | |
308 | ;-------- ---------- ---------- ---------- ---------- ---------- | |
309 | "RTN","PSO DRG",16,0) | |
310 | START ; | |
311 | "RTN","PSO DRG",17,0) | |
312 | S (PSONEW ("DFLG"),P SONEW("FIE LD"),PSODR G("QFLG")) =0 K PSORX ("DFLG") | |
313 | "RTN","PSO DRG",18,0) | |
314 | D @($S(+$ G(PSOEDIT) =1&('$D(DA )):"SELECT ^PSODRGN", 1:"SELECT" )) | |
315 | "RTN","PSO DRG",19,0) | |
316 | G:$G(PSOR XED("DFLG" )) END ; S elect Drug | |
317 | "RTN","PSO DRG",20,0) | |
318 | I $G(PSOR X("EDIT")) ,$G(PSOY), $G(PSODRUG ("IEN"))=+ PSOY D G: $G(PSORXED ("DFLG")) END | |
319 | "RTN","PSO DRG",21,0) | |
320 | . N NDC D NDC(+$G(P SORXED("IR XN")),0,+P SOY,.NDC) I $G(NDC)= "^" S PSOR XED("DFLG" )=1 Q | |
321 | "RTN","PSO DRG",22,0) | |
322 | . I $G(ND C)'="" S ( PSODRUG("N DC"),PSORX ED("FLD",2 7))=NDC | |
323 | "RTN","PSO DRG",23,0) | |
324 | ; | |
325 | "RTN","PSO DRG",24,0) | |
326 | I $G(PSOR X("EDIT")) ]"",'PSONE W("FIELD") D TRADE | |
327 | "RTN","PSO DRG",25,0) | |
328 | G:$G(PSON EW("DFLG") )!($G(PSOD RG("QFLG") ))!($G(PSO RXED("DFLG "))) END | |
329 | "RTN","PSO DRG",26,0) | |
330 | D SET ; S et various drug info rmation | |
331 | "RTN","PSO DRG",27,0) | |
332 | D NFI ; D isplay dis pense drug /orderable item text | |
333 | "RTN","PSO DRG",28,0) | |
334 | D:'$G(PSO EDIT) POST I $G(PSOR X("DFLG")) S PSONEW( "DFLG")=1 K:'$G(PSOR X("EDIT")) PSORX("DF LG") ; Do any post s election a ction | |
335 | "RTN","PSO DRG",29,0) | |
336 | END ;D EOJ | |
337 | "RTN","PSO DRG",30,0) | |
338 | Q | |
339 | "RTN","PSO DRG",31,0) | |
340 | ;-------- ---------- ---------- ---------- ---------- ---------- -- | |
341 | "RTN","PSO DRG",32,0) | |
342 | ; | |
343 | "RTN","PSO DRG",33,0) | |
344 | SELECT ; | |
345 | "RTN","PSO DRG",34,0) | |
346 | K:'$G(PSO RXED) CLOZ PAT | |
347 | "RTN","PSO DRG",35,0) | |
348 | K IT,DIC, X,Y,PSODRU G("TRADE N AME"),PSOD RUG("NDC") ,PSODRUG(" DAW"),PSOD RUG("BAD") S:$G(POER R)&($P($G( OR0),"^",9 )) Y=$P(^P SDRUG($P(O R0,"^",9), 0),"^") | |
349 | "RTN","PSO DRG",36,0) | |
350 | I $G(PSOD RUG("IEN") )]"" S Y=P SODRUG("NA ME"),PSONE W("OLD VAL ")=PSODRUG ("IEN") | |
351 | "RTN","PSO DRG",37,0) | |
352 | W !,"DRUG : "_$S($G( Y)]"":Y_"/ / ",1:"") R X:$S($D( DTIME):DTI ME,1:300) I '$T S DT OUT=1 | |
353 | "RTN","PSO DRG",38,0) | |
354 | I X="",$G (Y)]"" S:Y X=Y S:'X X=$G(PSODR UG("IEN")) S:X X="`" _X | |
355 | "RTN","PSO DRG",39,0) | |
356 | G:X="" SE LECT | |
357 | "RTN","PSO DRG",40,0) | |
358 | I X?1."?" W !!,"Ans wer with D RUG NUMBER , or GENER IC NAME, o r VA PRODU CT NAME, o r",!,"NATI ONAL DRUG CLASS, or SYNONYM" G SELECT | |
359 | "RTN","PSO DRG",41,0) | |
360 | I $G(PSOR XED),X["^" S PSORXED ("DFLG")=1 G SELECTX | |
361 | "RTN","PSO DRG",42,0) | |
362 | I X="^"!( X["^^")!($ D(DTOUT)) S PSONEW(" DFLG")=1 G SELECTX | |
363 | "RTN","PSO DRG",43,0) | |
364 | I '$G(POE RR),X[U,$L (X)>1 S PS ODIR("FLD" )=PSONEW(" FLD") D JU MP^PSODIR1 S:$G(PSOD IR("FIELD" )) PSONEW( "FIELD")=P SODIR("FIE LD") K PSO DIR S PSOD RG("QFLG") =1 G SELEC TX | |
365 | "RTN","PSO DRG",44,0) | |
366 | S DIC=50, DIC(0)="EM QZVT",DIC( "T")="",D= "B^C^VAPN^ VAC" | |
367 | "RTN","PSO DRG",45,0) | |
368 | S DIC("S" )="I $S('$ D(^PSDRUG( +Y,""I"")) :1,'^(""I" "):1,DT'>^ (""I""):1, 1:0),$S($P ($G(^PSDRU G(+Y,2))," "^"",3)'[" "O"":0,1:1 ),$D(^PSDR UG(""ASP"" ,+$G(^(2)) ,+Y))" | |
369 | "RTN","PSO DRG",46,0) | |
370 | D MIX^DIC 1 K DIC,D | |
371 | "RTN","PSO DRG",47,0) | |
372 | I $D(DTOU T) S PSONE W("DFLG")= 1 G SELECT X | |
373 | "RTN","PSO DRG",48,0) | |
374 | I $D(DUOU T) K DUOUT G SELECT | |
375 | "RTN","PSO DRG",49,0) | |
376 | I Y<0 G S ELECT | |
377 | "RTN","PSO DRG",50,0) | |
378 | S:$G(PSON EW("OLD VA L"))=+Y&(' $G(PSOEDIT )) PSODRG( "QFLG")=1 | |
379 | "RTN","PSO DRG",51,0) | |
380 | K PSOY S PSOY=Y,PSO Y(0)=Y(0) | |
381 | "RTN","PSO DRG",52,0) | |
382 | I $P(PSOY (0),"^")=" OTHER DRUG "!($P(PSOY (0),"^")=" OUTSIDE DR UG") D TRA DE | |
383 | "RTN","PSO DRG",53,0) | |
384 | SELECTX K X,Y,DTOUT, DUOUT,PSON EW("OLD VA L") | |
385 | "RTN","PSO DRG",54,0) | |
386 | Q | |
387 | "RTN","PSO DRG",55,0) | |
388 | ; | |
389 | "RTN","PSO DRG",56,0) | |
390 | NDC(RX,RFL ,DRG,NDC) ; Editing NDC for Re leased Rx' s or for U nresolved ECME Rejec ts | |
391 | "RTN","PSO DRG",57,0) | |
392 | S NDC=$S( $G(NDC)'=" ":$G(NDC), 1:$$GETNDC ^PSONDCUT( RX,.RFL)) | |
393 | "RTN","PSO DRG",58,0) | |
394 | ; Check i f we shoul d edit the NDC | |
395 | "RTN","PSO DRG",59,0) | |
396 | ; Needs t o be relea sed or hav e unresolv ed billabl e rejects (PSO*7*427 ) | |
397 | "RTN","PSO DRG",60,0) | |
398 | ; | |
399 | "RTN","PSO DRG",61,0) | |
400 | N PSOCONT S PSOCONT =0 ; c ontinue fl ag | |
401 | "RTN","PSO DRG",62,0) | |
402 | D Q:'PSO CONT ; g et out if NDC edit n ot allowed | |
403 | "RTN","PSO DRG",63,0) | |
404 | . I $$RXR LDT^PSOBPS UT(RX,RFL) S PSOCONT =1 Q ; R eleased - continue a nd allow e dit | |
405 | "RTN","PSO DRG",64,0) | |
406 | . I $$FIN D^PSOREJUT (RX,RFL),$ $STATUS^PS OBPSUT(RX, RFL)'="" S PSOCONT=1 Q ; un released w /unresolve d billable rejection s | |
407 | "RTN","PSO DRG",65,0) | |
408 | . Q | |
409 | "RTN","PSO DRG",66,0) | |
410 | ; | |
411 | "RTN","PSO DRG",67,0) | |
412 | S NDC=$S( $G(NDC)'=" ":$G(NDC), 1:$$GETNDC ^PSONDCUT( RX,.RFL)) | |
413 | "RTN","PSO DRG",68,0) | |
414 | D NDCEDT^ PSONDCUT(R X,.RFL,$G( DRG),$G(PS OSITE),.ND C) | |
415 | "RTN","PSO DRG",69,0) | |
416 | Q | |
417 | "RTN","PSO DRG",70,0) | |
418 | ; | |
419 | "RTN","PSO DRG",71,0) | |
420 | TRADE ; | |
421 | "RTN","PSO DRG",72,0) | |
422 | K DIR,DIC ,DA,X,Y | |
423 | "RTN","PSO DRG",73,0) | |
424 | S DIR(0)= "52,6.5" S :$G(PSOTRN )]"" DIR(" B")=$G(PSO TRN) D ^DI R K DIR,DI C | |
425 | "RTN","PSO DRG",74,0) | |
426 | I X="@" S Y=X K DIR UT | |
427 | "RTN","PSO DRG",75,0) | |
428 | I $D(DIRU T) S:$D(DU OUT)!$D(DT OUT)&('$D( PSORX("EDI T"))) PSON EW("DFLG") =1 G TRADE X | |
429 | "RTN","PSO DRG",76,0) | |
430 | S PSODRUG ("TRADE NA ME")=Y | |
431 | "RTN","PSO DRG",77,0) | |
432 | TRADEX I $ G(PSORXED( "DFLG")),$ D(DIRUT) S PSORXED(" DFLG")=1 | |
433 | "RTN","PSO DRG",78,0) | |
434 | K DIRUT,D TOUT,DUOUT ,X,Y,DA,DR ,DIE | |
435 | "RTN","PSO DRG",79,0) | |
436 | Q | |
437 | "RTN","PSO DRG",80,0) | |
438 | SET ; | |
439 | "RTN","PSO DRG",81,0) | |
440 | N PSOHZ S PSOHZ=0 ;init ha z alert sh own to use r=no *524 | |
441 | "RTN","PSO DRG",82,0) | |
442 | N STAT S PSODRUG("I EN")=+PSOY ,PSODRUG(" VA CLASS") =$P(PSOY(0 ),"^",2) | |
443 | "RTN","PSO DRG",83,0) | |
444 | S PSODRUG ("NAME")=$ P(PSOY(0), "^") | |
445 | "RTN","PSO DRG",84,0) | |
446 | S:+$G(^PS DRUG(+PSOY ,2)) PSODR UG("OI")=+ $G(^(2)),P SODRUG("OI N")=$P(^PS (50.7,+$G( ^(2)),0)," ^") | |
447 | "RTN","PSO DRG",85,0) | |
448 | S PSODRUG ("NDF")=$S ($G(^PSDRU G(+PSOY,"N D"))]"":+^ ("ND")_"A" _$P(^("ND" ),"^",3),1 :0) | |
449 | "RTN","PSO DRG",86,0) | |
450 | S PSODRUG ("MAXDOSE" )=$P(PSOY( 0),"^",4), PSODRUG("D EA")=$P(PS OY(0),"^", 3) | |
451 | "RTN","PSO DRG",87,0) | |
452 | S PSODRUG ("CLN")=$S ($D(^PSDRU G(+PSOY,"N D")):+$P(^ ("ND"),"^" ,6),1:0) | |
453 | "RTN","PSO DRG",88,0) | |
454 | S PSODRUG ("SIG")=$P (PSOY(0)," ^",5) | |
455 | "RTN","PSO DRG",89,0) | |
456 | I $G(PSOD RUG("NDC") )="" S PSO DRUG("NDC" )=$$GETNDC ^PSSNDCUT( +PSOY,$G(P SOSITE)) | |
457 | "RTN","PSO DRG",90,0) | |
458 | S PSODRUG ("DAW")=+$ $GET1^DIQ( 50,+PSOY,8 1) | |
459 | "RTN","PSO DRG",91,0) | |
460 | S PSODRUG ("STKLVL") =$G(^PSDRU G(+PSOY,66 0.1)) | |
461 | "RTN","PSO DRG",92,0) | |
462 | G:$G(^PSD RUG(+PSOY, 660))']"" SETX | |
463 | "RTN","PSO DRG",93,0) | |
464 | S PSOX1=$ G(^PSDRUG( +PSOY,660) ) | |
465 | "RTN","PSO DRG",94,0) | |
466 | S PSODRUG ("COST")=$ P($G(PSOX1 ),"^",6) | |
467 | "RTN","PSO DRG",95,0) | |
468 | S PSODRUG ("UNIT")=$ P($G(PSOX1 ),"^",8) | |
469 | "RTN","PSO DRG",96,0) | |
470 | S PSODRUG ("EXPIRATI ON DATE")= $P($G(PSOX 1),"^",9) | |
471 | "RTN","PSO DRG",97,0) | |
472 | SETX K PSO X1,PSOY | |
473 | "RTN","PSO DRG",98,0) | |
474 | Q | |
475 | "RTN","PSO DRG",99,0) | |
476 | NFI ;displ ay restric tion/guide lines | |
477 | "RTN","PSO DRG",100,0 ) | |
478 | D EN^PSSD IN(PSODRUG ("OI"),PSO DRUG("IEN" )) S NFI=$ $PROMPT^PS SDIN | |
479 | "RTN","PSO DRG",101,0 ) | |
480 | I NFI]"", "ODY"[NFI D TD^PSONF I | |
481 | "RTN","PSO DRG",102,0 ) | |
482 | K NFI Q | |
483 | "RTN","PSO DRG",103,0 ) | |
484 | POST ;orde r checks | |
485 | "RTN","PSO DRG",104,0 ) | |
486 | ;add Haza rdous to H andle/Disp ose warnin g messages *524 | |
487 | "RTN","PSO DRG",105,0 ) | |
488 | N HAZ,HAZ H,HAZD,HTX T,LL S HAZ =$$HAZ^PSS UTIL(PSODR UG("IEN")) ,HAZH=$P(H AZ,U),HAZD =$P(HAZ,U, 2) | |
489 | "RTN","PSO DRG",106,0 ) | |
490 | I ('$G(PS OHZ)!(PSOD RUG("IEN") '=$G(PSOLS TDR))),(HA ZH!HAZD) D | |
491 | "RTN","PSO DRG",107,0 ) | |
492 | . S PSOHZ =1,PSOLSTD R=PSODRUG( "IEN") | |
493 | "RTN","PSO DRG",108,0 ) | |
494 | . D HAZWA RNG^PSSUTI L(PSODRUG( "IEN"),"O" ,HAZH,HAZD ,.HTXT) | |
495 | "RTN","PSO DRG",109,0 ) | |
496 | . S $P(LL ,"-",80)=" -" | |
497 | "RTN","PSO DRG",110,0 ) | |
498 | . W #,$C( 7),LL,! | |
499 | "RTN","PSO DRG",111,0 ) | |
500 | . W $J("* **** WARNI NG *****", 47) | |
501 | "RTN","PSO DRG",112,0 ) | |
502 | . D WRAPT EXT^PSOQUT IL(HTXT,80 ,0) W ! | |
503 | "RTN","PSO DRG",113,0 ) | |
504 | . W LL,! | |
505 | "RTN","PSO DRG",114,0 ) | |
506 | . K DIR S DIR(0)="E ",DIR("?") ="Press Re turn to co ntinue",DI R("A")="Pr ess Return to contin ue" D ^DIR | |
507 | "RTN","PSO DRG",115,0 ) | |
508 | N LIST S LIST="PSOP EPS" | |
509 | "RTN","PSO DRG",116,0 ) | |
510 | K PSODOSD ,^TMP("PSO RXDC",$J), ^TMP($J,LI ST),^TMP(" PSODAOC",$ J) | |
511 | "RTN","PSO DRG",117,0 ) | |
512 | K ZDGDG,Z THER,IT,PS ODLQT,PSOD OSD | |
513 | "RTN","PSO DRG",118,0 ) | |
514 | I $D(^XTM P("ORRDI", "OUTAGE IN FO","DOWN" )) S ^TMP( "PSODAOC", $J,"NORDI" ,1,0)="Rem ote data n ot availab le - Only local orde r checks p rocessed." | |
515 | "RTN","PSO DRG",119,0 ) | |
516 | S ^TMP($J ,LIST,"IN" ,"PING")=" " D IN^PSS HRQ2(LIST) | |
517 | "RTN","PSO DRG",120,0 ) | |
518 | K DIR I $ P(^TMP($J, LIST,"OUT" ,0),"^")=- 1 D | |
519 | "RTN","PSO DRG",121,0 ) | |
520 | .D DATACK ^PSODDPRE | |
521 | "RTN","PSO DRG",122,0 ) | |
522 | .S ^TMP(" PSODAOC",$ J,"NOSYS", 1,0)="No E nhanced Or der Checks can be pe rformed. R eason(s): "_$P($G(^T MP($J,LIST ,"OUT",0)) ,"^",2) | |
523 | "RTN","PSO DRG",123,0 ) | |
524 | K ^TMP($J ,LIST,"IN" ),^TMP($J, LIST,"OUT" ,"EXCEPTIO NS") | |
525 | "RTN","PSO DRG",124,0 ) | |
526 | G:$G(PSOR X("DFLG")) !($G(PSORX ED("DFLG") )) POSTX | |
527 | "RTN","PSO DRG",125,0 ) | |
528 | K PSORX(" INTERVENE" ),PSOQUIT N STAT,SIG ,PTR,NDF,V AP S PSORX ("DFLG")=0 | |
529 | "RTN","PSO DRG",126,0 ) | |
530 | W !! D HD ^PSODDPR2( ):(($Y+5)' >IOSL) | |
531 | "RTN","PSO DRG",127,0 ) | |
532 | D ^PSOBUI LD | |
533 | "RTN","PSO DRG",128,0 ) | |
534 | D @$S($G( COPY):"^PS OCPPRE",1: "^PSODDPRE ") ; Dupli cate drug check | |
535 | "RTN","PSO DRG",129,0 ) | |
536 | G:$G(PSOR X("DFLG")) POSTX | |
537 | "RTN","PSO DRG",130,0 ) | |
538 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
539 | "RTN","PSO DRG",131,0 ) | |
540 | I $P($G(^ PSDRUG(PSO DRUG("IEN" ),"CLOZ1") ),"^")="PS OCLO1" W ! ,"Now doin g Clozapin e Order ch ecks. Ple ase wait.. .",! D CLO Z | |
541 | "RTN","PSO DRG",132,0 ) | |
542 | G:PSORX(" DFLG") POS TX | |
543 | "RTN","PSO DRG",133,0 ) | |
544 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
545 | "RTN","PSO DRG",134,0 ) | |
546 | W !,"Now doing alle rgy checks . Please wait...",! H 1 | |
547 | "RTN","PSO DRG",135,0 ) | |
548 | S PSONOAL ="" D ALLE RGY^PSOORU T2 D:PSONO AL'="" NOA LRGY K PSO NOAL | |
549 | "RTN","PSO DRG",136,0 ) | |
550 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
551 | "RTN","PSO DRG",137,0 ) | |
552 | I '$G(PSO DGCKX) D ^ PSODGAL1 K PSORX("IN TERVENE") | |
553 | "RTN","PSO DRG",138,0 ) | |
554 | G:PSORX(" DFLG")!$G( PSOQUIT) P OSTX | |
555 | "RTN","PSO DRG",139,0 ) | |
556 | ;This is the allerg y check fo r profile drugs CK a ction | |
557 | "RTN","PSO DRG",140,0 ) | |
558 | I $D(PSOD GCK),$D(PS OSD) D PRF LP^PSOUTL | |
559 | "RTN","PSO DRG",141,0 ) | |
560 | G:$G(PSOR X("DFLG")) POSTX ;ps o*7*412 | |
561 | "RTN","PSO DRG",142,0 ) | |
562 | G:$G(PSOS PRNW)&($G( PSORENW("D FLG"))) PO STX ;speed renew | |
563 | "RTN","PSO DRG",143,0 ) | |
564 | ;aminogly coside | |
565 | "RTN","PSO DRG",144,0 ) | |
566 | N AOC,CRO CPFLG S CR OCPFLG=0 | |
567 | "RTN","PSO DRG",145,0 ) | |
568 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
569 | "RTN","PSO DRG",146,0 ) | |
570 | S AOC=$$A OC^OROCAPI (PSODFN,$P (PSODRUG(" NDF"),"A", 2)) I $P(A OC,"^",4)] "" D | |
571 | "RTN","PSO DRG",147,0 ) | |
572 | .S CROCPF LG=1 | |
573 | "RTN","PSO DRG",148,0 ) | |
574 | .W !!,"** *Aminoglyc oside Orde red***",!! | |
575 | "RTN","PSO DRG",149,0 ) | |
576 | .K ^UTILI TY($J,"W") S DIWL=1, DIWR=78,DI WF="" S X= $P(AOC,"^" ,4) D ^DIW P | |
577 | "RTN","PSO DRG",150,0 ) | |
578 | .W ! F ZX =0:0 S ZX= $O(^UTILIT Y($J,"W",1 ,ZX)) Q:'Z X W ?2,^U TILITY($J, "W",1,ZX,0 ),! D HD^P SODDPR2(): (($Y+5)'>I OSL) | |
579 | "RTN","PSO DRG",151,0 ) | |
580 | .K ^UTILI TY($J,"W") | |
581 | "RTN","PSO DRG",152,0 ) | |
582 | .S ^TMP(" PSODAOC",$ J,"CPRS",$ P(AOC,"^", 2),0)=PSOD RUG("IEN") _"^"_$P(AO C,"^",4) | |
583 | "RTN","PSO DRG",153,0 ) | |
584 | .W ! | |
585 | "RTN","PSO DRG",154,0 ) | |
586 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
587 | "RTN","PSO DRG",155,0 ) | |
588 | ;dangerou s meds for pat >64 | |
589 | "RTN","PSO DRG",156,0 ) | |
590 | I $G(PSOD RUG("OI")) D | |
591 | "RTN","PSO DRG",157,0 ) | |
592 | .N OI,OIR S OI=$$OI TM^ORX8(PS ODRUG("OI" ),"99PSP") Q:'OI | |
593 | "RTN","PSO DRG",158,0 ) | |
594 | .S OIR=$$ DOC^OROCAP I(PSODFN,O I) I $P(OI R,"^",4)]" " D | |
595 | "RTN","PSO DRG",159,0 ) | |
596 | ..S CROCP FLG=1 | |
597 | "RTN","PSO DRG",160,0 ) | |
598 | ..D HD^PS ODDPR2():( ($Y+5)'>IO SL) W !!," ***Dangero us Meds fo r Patient >64***",!! S DFN=PSO DFN D DEM^ VADPT | |
599 | "RTN","PSO DRG",161,0 ) | |
600 | ..K ^UTIL ITY($J,"W" ) S DIWL=1 ,DIWR=78,D IWF="" S X =$P(OIR,"^ ",4) D ^DI WP | |
601 | "RTN","PSO DRG",162,0 ) | |
602 | ..F ZX=0: 0 S ZX=$O( ^UTILITY($ J,"W",1,ZX )) Q:'ZX W ?2,^UTIL ITY($J,"W" ,1,ZX,0),! D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
603 | "RTN","PSO DRG",163,0 ) | |
604 | ..K ^UTIL ITY($J,"W" ) | |
605 | "RTN","PSO DRG",164,0 ) | |
606 | ..S ^TMP( "PSODAOC", $J,"CPRS", $P(OIR,"^" ,2),0)=PSO DRUG("IEN" )_"^"_$P(O IR,"^",4) | |
607 | "RTN","PSO DRG",165,0 ) | |
608 | ..W ! | |
609 | "RTN","PSO DRG",166,0 ) | |
610 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
611 | "RTN","PSO DRG",167,0 ) | |
612 | ;metformi n lab resu lts | |
613 | "RTN","PSO DRG",168,0 ) | |
614 | N GOC S G OC=$$GOC^O ROCAPI(PSO DFN,PSODRU G("NAME")) I $P(GOC, "^",4)]"" D | |
615 | "RTN","PSO DRG",169,0 ) | |
616 | .S CROCPF LG=1 | |
617 | "RTN","PSO DRG",170,0 ) | |
618 | .W !!,"** *Metformin Lab Resul ts***",!! | |
619 | "RTN","PSO DRG",171,0 ) | |
620 | .K ^UTILI TY($J,"W") S DIWL=1, DIWR=78,DI WF="" S X= $P(GOC,"^" ,4) D ^DIW P | |
621 | "RTN","PSO DRG",172,0 ) | |
622 | .F ZX=0:0 S ZX=$O(^ UTILITY($J ,"W",1,ZX) ) Q:'ZX W ?2,^UTILI TY($J,"W", 1,ZX,0),! D HD^PSODD PR2():(($Y +5)'>IOSL) | |
623 | "RTN","PSO DRG",173,0 ) | |
624 | .K ^UTILI TY($J,"W") | |
625 | "RTN","PSO DRG",174,0 ) | |
626 | .S ^TMP(" PSODAOC",$ J,"CPRS",$ P(GOC,"^", 2),0)=PSOD RUG("IEN") _"^"_$P(GO C,"^",4) | |
627 | "RTN","PSO DRG",175,0 ) | |
628 | .W ! | |
629 | "RTN","PSO DRG",176,0 ) | |
630 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
631 | "RTN","PSO DRG",177,0 ) | |
632 | ;clinical reminder oc | |
633 | "RTN","PSO DRG",178,0 ) | |
634 | D:'$G(PSO NCROC) CK^ PSOCROC K CROCPFLG I $G(PSORX( "DFLG")) Q | |
635 | "RTN","PSO DRG",179,0 ) | |
636 | K DIWF,DI WL,DIWR,ZX ,DFN,CROCP FLG | |
637 | "RTN","PSO DRG",180,0 ) | |
638 | I $G(PSOD RUG("DEA") )["S"!($E( $G(PSODRUG ("VA CLASS ")),1,2)=" XA"),'$G(P SODGCK) D G POSTX ; stops if d rug is sup ply | |
639 | "RTN","PSO DRG",181,0 ) | |
640 | .W !,"Now Processin g Enhanced Order Che cks! Plea se wait... ",! H 1 | |
641 | "RTN","PSO DRG",182,0 ) | |
642 | ;enhanced OC | |
643 | "RTN","PSO DRG",183,0 ) | |
644 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
645 | "RTN","PSO DRG",184,0 ) | |
646 | W ! D @$S ($G(COPY): "OBX^PSOCP PRE",1:"OB X^PSODDPRE ") ; Set P SORX("DFLG ")=1 if pr ocess to s top new en hanced ord er checks | |
647 | "RTN","PSO DRG",185,0 ) | |
648 | POSTX ; | |
649 | "RTN","PSO DRG",186,0 ) | |
650 | K IT,^TMP ($J,"DI"), PSORX("INT ERVENE"),D A,^TMP($J, "PSODRDI") ,ZDGDG,ZTH ER,^TMP($J ,"DI"_PSOD FN),PSZZQU IT | |
651 | "RTN","PSO DRG",187,0 ) | |
652 | I '$G(PSO RXED),'$G( PSOREINS) K PSOQUIT | |
653 | "RTN","PSO DRG",188,0 ) | |
654 | Q | |
655 | "RTN","PSO DRG",189,0 ) | |
656 | ; | |
657 | "RTN","PSO DRG",190,0 ) | |
658 | EOJ ; | |
659 | "RTN","PSO DRG",191,0 ) | |
660 | K PSODRG | |
661 | "RTN","PSO DRG",192,0 ) | |
662 | Q | |
663 | "RTN","PSO DRG",193,0 ) | |
664 | WAIT ; | |
665 | "RTN","PSO DRG",194,0 ) | |
666 | K DIR S D IR(0)="E", DIR("?")=" Press Retu rn to cont inue",DIR( "A")="Pres s Return t o continue ..." W ! | |
667 | "RTN","PSO DRG",195,0 ) | |
668 | D ^DIR K DIRUT,DUOU T,DIR,X,Y | |
669 | "RTN","PSO DRG",196,0 ) | |
670 | Q | |
671 | "RTN","PSO DRG",197,0 ) | |
672 | ; | |
673 | "RTN","PSO DRG",198,0 ) | |
674 | CLOZ ; | |
675 | "RTN","PSO DRG",199,0 ) | |
676 | S ANQRTN= $P(^PSDRUG (PSODRUG(" IEN"),"CLO Z1"),"^"), ANQX=0 | |
677 | "RTN","PSO DRG",200,0 ) | |
678 | S P(5)=PS ODRUG("IEN "),DFN=PSO DFN,X=ANQR TN | |
679 | "RTN","PSO DRG",201,0 ) | |
680 | X ^%ZOSF( "TEST") I D @("^"_A NQRTN) S:$ G(ANQX) PS ORX("DFLG" )=1 | |
681 | "RTN","PSO DRG",202,0 ) | |
682 | K P(5),AN QRTN,ANQX, X,DFN | |
683 | "RTN","PSO DRG",203,0 ) | |
684 | Q | |
685 | "RTN","PSO DRG",204,0 ) | |
686 | ; | |
687 | "RTN","PSO DRG",205,0 ) | |
688 | EN(DRG) ;r eturns lab test iden tified for clozapine order che cking | |
689 | "RTN","PSO DRG",206,0 ) | |
690 | K LAB I $ P($G(^PSDR UG(DRG,"CL OZ1")),"^" )'="PSOCLO 1" S LAB(" NOT")=0 Q | |
691 | "RTN","PSO DRG",207,0 ) | |
692 | I $P($G(^ PSDRUG(DRG ,"CLOZ1")) ,"^")="PSO CLO1" D | |
693 | "RTN","PSO DRG",208,0 ) | |
694 | .S (CNT,I )=0 F S I =$O(^PSDRU G(DRG,"CLO Z2",I)) Q: 'I S CNT= $G(CNT)+1 | |
695 | "RTN","PSO DRG",209,0 ) | |
696 | .I CNT'=2 S LAB("BA D TEST")=0 K CNT Q | |
697 | "RTN","PSO DRG",210,0 ) | |
698 | .K CNT F I=0:0 S I= $O(^PSDRUG (DRG,"CLOZ 2",I)) Q:' I D | |
699 | "RTN","PSO DRG",211,0 ) | |
700 | ..S LABT= $S($P(^PSD RUG(DRG,"C LOZ2",I,0) ,"^",4)=1: "WBC",1:"A NC"),LAB(L ABT)=$P(^P SDRUG(DRG, "CLOZ2",I, 0),"^")_"^ "_$P(^(0), "^",3)_"^" _$P(^(0)," ^",4) | |
701 | "RTN","PSO DRG",212,0 ) | |
702 | K LABT,I | |
703 | "RTN","PSO DRG",213,0 ) | |
704 | Q | |
705 | "RTN","PSO DRG",214,0 ) | |
706 | NOALRGY ; | |
707 | "RTN","PSO DRG",215,0 ) | |
708 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
709 | "RTN","PSO DRG",216,0 ) | |
710 | N DIR S D IR(0)="SA^ 1:YES;0:NO " | |
711 | "RTN","PSO DRG",217,0 ) | |
712 | I $D(^TMP ($J,"PSOIN TERVENE",+ PSODFN)) D Q | |
713 | "RTN","PSO DRG",218,0 ) | |
714 | .S DIR("A ")="No All ergy Asses sment - Do you want to duplica te Interve ntion?: ", DIR("B")=" Yes" | |
715 | "RTN","PSO DRG",219,0 ) | |
716 | .D ^DIR | |
717 | "RTN","PSO DRG",220,0 ) | |
718 | .I 'Y D Q | |
719 | "RTN","PSO DRG",221,0 ) | |
720 | ..I Y=0 D ^PSORXI Q | |
721 | "RTN","PSO DRG",222,0 ) | |
722 | ..S PSORX ("DFLG")=1 | |
723 | "RTN","PSO DRG",223,0 ) | |
724 | .D DUPINV ^PSORXI | |
725 | "RTN","PSO DRG",224,0 ) | |
726 | W $C(7),! ,"There is no allerg y assessme nt on file for this patient." | |
727 | "RTN","PSO DRG",225,0 ) | |
728 | W !,"You will be pr ompted to intervene if you con tinue with this pres cription" | |
729 | "RTN","PSO DRG",226,0 ) | |
730 | I $D(PSOD GCK) W ! K DIR S DIR (0)="E",DI R("A")="Pr ess Return to Contin ue..." D ^ DIR K DIR | |
731 | "RTN","PSO DRG",227,0 ) | |
732 | Q:$D(PSOD GCK) | |
733 | "RTN","PSO DRG",228,0 ) | |
734 | N DUOUT,D TOUT,RXIEN ,RXSTA ;*398 | |
735 | "RTN","PSO DRG",229,0 ) | |
736 | S DIR("A" )="Do you want to Co ntinue?: " ,DIR("B")= "N" D ^DIR | |
737 | "RTN","PSO DRG",230,0 ) | |
738 | I 'Y!($D( DUOUT))!($ D(DTOUT)) D Q ;*398 - E xit/Timeou t | |
739 | "RTN","PSO DRG",231,0 ) | |
740 | .I $D(PSO NV) S PSZZ QUIT=1 Q | |
741 | "RTN","PSO DRG",232,0 ) | |
742 | .S PSORX( "DFLG")=1 | |
743 | "RTN","PSO DRG",233,0 ) | |
744 | .I '$O(PS CAN(0)) Q ;*398 - A rray has R x IEN | |
745 | "RTN","PSO DRG",234,0 ) | |
746 | .I $G(REA )'="R" Q ;*398 - R einstate o nly | |
747 | "RTN","PSO DRG",235,0 ) | |
748 | .S RXIEN= +$G(PSCAN( RX)) I 'RX IEN Q ;*398 - G et Rx IEN | |
749 | "RTN","PSO DRG",236,0 ) | |
750 | .S RXSTA= $$GET1^DIQ (52,RXIEN, 100,"I") ;*398 - G et status | |
751 | "RTN","PSO DRG",237,0 ) | |
752 | .I RXSTA= 12 Q ;*398 - C orrect sta tus | |
753 | "RTN","PSO DRG",238,0 ) | |
754 | .S DIE="^ PSRX(",DA= RXIEN,DR=" 100///12" ;*398 - D iscontinue d | |
755 | "RTN","PSO DRG",239,0 ) | |
756 | .D ^DIE ;*398 - U pdate Rx f ile | |
757 | "RTN","PSO DRG",240,0 ) | |
758 | I $D(PSON V) S PSORX ("INTERVEN E")=0 D EN 1^PSORXI(P SONV) Q | |
759 | "RTN","PSO DRG",241,0 ) | |
760 | D ^PSORXI | |
761 | "RTN","PSO DRG",242,0 ) | |
762 | Q | |
763 | "RTN","PSO HLDS1") | |
764 | 0^2^B49887 900 | |
765 | "RTN","PSO HLDS1",1,0 ) | |
766 | PSOHLDS1 ; BIR/LC,PWC -Build HL7 Segments for Automa ted Interf ace ; 2/5/ 10 10:01am | |
767 | "RTN","PSO HLDS1",2,0 ) | |
768 | ;;7.0;OUT PATIENT PH ARMACY;**1 56,232,255 ,200,305,3 36,351,434 ,524**;DEC 1997;Buil d 12 | |
769 | "RTN","PSO HLDS1",3,0 ) | |
770 | ;HLFNC supp. by DBIA 10 106 | |
771 | "RTN","PSO HLDS1",4,0 ) | |
772 | ;PSNAPIS supp. by DBIA 25 31 | |
773 | "RTN","PSO HLDS1",5,0 ) | |
774 | ;VASITE supp. by DBIA 10 112 | |
775 | "RTN","PSO HLDS1",6,0 ) | |
776 | ;VADPT supp. by DBIA 10 061 | |
777 | "RTN","PSO HLDS1",7,0 ) | |
778 | ;EN^DIQ1 supp. by DBIA 10 0 | |
779 | "RTN","PSO HLDS1",8,0 ) | |
780 | ;EN^VAFHL ZTA supp. by DBIA 75 8 | |
781 | "RTN","PSO HLDS1",9,0 ) | |
782 | ;PSDRUG supp. by DBIA 22 1 | |
783 | "RTN","PSO HLDS1",10, 0) | |
784 | ;PS(50.60 7 supp. by DBIA 22 21 | |
785 | "RTN","PSO HLDS1",11, 0) | |
786 | ;PS(55 supp. by DBIA 22 28 | |
787 | "RTN","PSO HLDS1",12, 0) | |
788 | ;DPT supp. by DBIA 30 97 | |
789 | "RTN","PSO HLDS1",13, 0) | |
790 | ;SC supp. by DBIA 10 040 | |
791 | "RTN","PSO HLDS1",14, 0) | |
792 | ;VA(200 supp. by DBIA 10 060 | |
793 | "RTN","PSO HLDS1",15, 0) | |
794 | ;SCMSVUT5 supp. by DBIA 43 47 | |
795 | "RTN","PSO HLDS1",16, 0) | |
796 | ;BLDPID^V AFCQRY sup p. by DBIA 3630 | |
797 | "RTN","PSO HLDS1",17, 0) | |
798 | ;MAKEIT^V AFHLU sup p. by DBIA 4346 | |
799 | "RTN","PSO HLDS1",18, 0) | |
800 | ; | |
801 | "RTN","PSO HLDS1",19, 0) | |
802 | ;*232 all ow for Do Not Mail | |
803 | "RTN","PSO HLDS1",20, 0) | |
804 | ;*255 mov e NTEPMI t o PSOHLDS4 . fix "MP " node tes t to '="" | |
805 | "RTN","PSO HLDS1",21, 0) | |
806 | ;*305 sen d Notice of Privacy Practices in NTE9 - Modified to NTE9 as NTE8 alre ady exist | |
807 | "RTN","PSO HLDS1",22, 0) | |
808 | ;*524 add ed ZZZ seg ment for h azardous d rug inform ation | |
809 | "RTN","PSO HLDS1",23, 0) | |
810 | ; | |
811 | "RTN","PSO HLDS1",24, 0) | |
812 | START ; | |
813 | "RTN","PSO HLDS1",25, 0) | |
814 | D GETDATA | |
815 | "RTN","PSO HLDS1",26, 0) | |
816 | D PID(.PS I),PV1(.PS I),PV2(.PS I),IAM^PSO HLDS4(.PSI ),ORC^PSOH LDS4(.PSI) | |
817 | "RTN","PSO HLDS1",27, 0) | |
818 | D NTE^PSO HLDS2,RXE^ PSOHLDS2(. PSI),RXD^P SOHLDS2(.P SI) | |
819 | "RTN","PSO HLDS1",28, 0) | |
820 | D NTEPMI^ PSOHLDS4(. PSI),NTE9^ PSOHLDS2(. PSI),RXR^P SOHLDS2(.P SI),ZZZ^PS OHLDS2(.PS I) ;* 255 ;*524 added ZZZ segment fo r hazardou s flags | |
821 | "RTN","PSO HLDS1",29, 0) | |
822 | ; clean u p data set by GETDAT A | |
823 | "RTN","PSO HLDS1",30, 0) | |
824 | K EBY,EBY 1,EFDT,EXD T,FDT,PVDR ,PVDR1,CSI NER,CSINER 1,SITE,SIT ADD,SITPHN | |
825 | "RTN","PSO HLDS1",31, 0) | |
826 | K VPHARMI D,VPHARM,D EAID,MW,QT Y,DASPLY,O LAN,OTHLAN ,PRIORDT,R FRM,NFLD,W ARN | |
827 | "RTN","PSO HLDS1",32, 0) | |
828 | K PSOXN,P SOXN2,PSND 1,PSND2,PR ODUCT,PSOP ROD,UNIT,V ANAME,DISP DT,PSONDC | |
829 | "RTN","PSO HLDS1",33, 0) | |
830 | K DRUG | |
831 | "RTN","PSO HLDS1",34, 0) | |
832 | Q | |
833 | "RTN","PSO HLDS1",35, 0) | |
834 | GETDATA ; this is th e place to set all d ata needed for sever al segment s | |
835 | "RTN","PSO HLDS1",36, 0) | |
836 | I $G(FP)= "F"&('$G(F PN)) D ;original | |
837 | "RTN","PSO HLDS1",37, 0) | |
838 | . S FDT=$ P(^PSRX(IR XN,2),"^", 2),VPHARMI D=$P(^(2), "^",10),DI SPDT=$P(^( 2),"^",5), EXDT=$P(^( 2),"^",6), PSONDC=$P( ^(2),"^",7 ) | |
839 | "RTN","PSO HLDS1",38, 0) | |
840 | . S PVDR= $P(^PSRX(I RXN,0),"^" ,4),QTY=$P (^(0),"^", 7),DASPLY= $P(^(0),"^ ",8),MW=$P (^(0),"^", 11),EBY=$P (^(0),"^", 16) | |
841 | "RTN","PSO HLDS1",39, 0) | |
842 | I $G(FP)= "F"&($G(FP N)) D ; refill | |
843 | "RTN","PSO HLDS1",40, 0) | |
844 | . S FDT=$ P(^PSRX(IR XN,1,FPN,0 ),"^"),MW= $P(^(0),"^ ",2),QTY=$ P(^(0),"^" ,4),DASPLY =$P(^(0)," ^",10),DIS PDT=$P(^(0 ),"^",19), EXDT=$S($P (^(0),"^", 15):$P(^(0 ),"^",15), 1:$P(^PSRX (IRXN,2)," ^",6)) | |
845 | "RTN","PSO HLDS1",41, 0) | |
846 | . S VPHAR MID=$S($P( ^PSRX(IRXN ,1,FPN,0), "^",5)'="" :$P(^(0)," ^",5),1:$P (^PSRX(IRX N,2),"^",1 0)) | |
847 | "RTN","PSO HLDS1",42, 0) | |
848 | . S EBY=$ S($P(^PSRX (IRXN,1,FP N,0),"^",5 ):$P(^(0), "^",5),1:$ P(^(0),"^" ,7)),PVDR= $P(^(0),"^ ",17),PSON DC=$S($P($ G(^PSRX(IR XN,1,FPN,1 )),"^",3): $P(^(1),"^ ",3),1:$P( ^PSRX(IRXN ,2),"^",7) ) | |
849 | "RTN","PSO HLDS1",43, 0) | |
850 | I $G(FP)= "P"&($G(FP N)) D ;pa rtial | |
851 | "RTN","PSO HLDS1",44, 0) | |
852 | . S FDT=$ P(^PSRX(IR XN,"P",FPN ,0),"^"),M W=$P(^(0), "^",2),QTY =$P(^(0)," ^",4),DASP LY=$P(^(0) ,"^",10),D ISPDT=FDT, PVDR=$P(^( 0),"^",17) ,EXDT=$P(^ PSRX(IRXN, 2),"^",6) | |
853 | "RTN","PSO HLDS1",45, 0) | |
854 | . S EBY=$ S($P(^PSRX (IRXN,"P", FPN,0),"^" ,5):$P(^(0 ),"^",5),1 :$P(^(0)," ^",7)),VPH ARMID=$S($ P(^(0),"^" ,5)'="":$P (^(0),"^", 5),1:$P(^P SRX(IRXN,2 ),"^",10)) ,PVDR=$P(^ PSRX(IRXN, "P",FPN,0) ,"^",17) | |
855 | "RTN","PSO HLDS1",46, 0) | |
856 | . S PSOND C=$S($P(^P SRX(IRXN," P",FPN,0), "^",12):$P (^(0),"^", 12),1:$P(^ PSRX(IRXN, 2),"^",7)) | |
857 | "RTN","PSO HLDS1",47, 0) | |
858 | S EFDT=$P (^PSRX(IRX N,2),"^",2 ) S:$G(EFD T) EFDT=$$ HLDATE^HLF NC(EFDT,"D T") | |
859 | "RTN","PSO HLDS1",48, 0) | |
860 | S ISDT=$P (^PSRX(IRX N,0),"^",1 3) S:$G(IS DT) ISDT=$ $HLDATE^HL FNC(ISDT," DT") | |
861 | "RTN","PSO HLDS1",49, 0) | |
862 | S DEAID=$ $GET1^DIQ( 200,PVDR_" ,",53.2) | |
863 | "RTN","PSO HLDS1",50, 0) | |
864 | K DIC,X,Y S DIC="^V A(200,",DI C(0)="N,Z" ,X=VPHARMI D D ^DIC | |
865 | "RTN","PSO HLDS1",51, 0) | |
866 | S VPHARM= $S(+Y:$$HL NAME^HLFNC ($P(Y,"^", 2)),1:"""" "") K DIC, X,Y | |
867 | "RTN","PSO HLDS1",52, 0) | |
868 | K DIC,X,Y S DIC="^V A(200,",DI C(0)="N,Z" ,X=EBY D ^ DIC | |
869 | "RTN","PSO HLDS1",53, 0) | |
870 | S EBY1=$S (+Y:$$HLNA ME^HLFNC($ P(Y,"^",2) ),1:"""""" ) K DIC,X, Y | |
871 | "RTN","PSO HLDS1",54, 0) | |
872 | K DIC,X,Y S DIC="^V A(200,",DI C(0)="N,Z" ,X=PVDR D ^DIC | |
873 | "RTN","PSO HLDS1",55, 0) | |
874 | S PVDR1=$ S(+Y:$$HLN AME^HLFNC( $P(Y,"^",2 )),1:""""" ") K DIC,X ,Y | |
875 | "RTN","PSO HLDS1",56, 0) | |
876 | S PRIORDT =$P(^PSRX( IRXN,3),"^ ",4),PRIOR DT=$$HLDAT E^HLFNC(PR IORDT,"DT" ) | |
877 | "RTN","PSO HLDS1",57, 0) | |
878 | S FDT=$$H LDATE^HLFN C(FDT,"DT" ) | |
879 | "RTN","PSO HLDS1",58, 0) | |
880 | S:$G(DISP DT) DISPDT =$$HLDATE^ HLFNC(DISP DT,"DT") | |
881 | "RTN","PSO HLDS1",59, 0) | |
882 | S:$G(EXDT ) EXDT=$$H LDATE^HLFN C(EXDT,"DT ") | |
883 | "RTN","PSO HLDS1",60, 0) | |
884 | S FIN=$P( ^PSRX(IRXN ,"OR1"),"^ ",5) | |
885 | "RTN","PSO HLDS1",61, 0) | |
886 | K DIC,X,Y S DIC="^V A(200,",DI C(0)="N,Z" ,X=FIN D ^ DIC | |
887 | "RTN","PSO HLDS1",62, 0) | |
888 | S FIN1=$S (+Y:$$HLNA ME^HLFNC($ P(Y,"^",2) ),1:"""""" ) K DIC,X, Y | |
889 | "RTN","PSO HLDS1",63, 0) | |
890 | S SITE=$S ($D(^PS(59 ,PSOSITE,0 )):^(0),1: "") | |
891 | "RTN","PSO HLDS1",64, 0) | |
892 | S PSZIP=$ P(SITE,"^" ,5) S PSOH ZIP=$S(PSZ IP["-":PSZ IP,1:$E(PS ZIP,1,5)_$ S($E(PSZIP ,6,9)]"":" -"_$E(PSZI P,6,9),1:" ")) | |
893 | "RTN","PSO HLDS1",65, 0) | |
894 | S CLN=+$P (^PSRX(IRX N,0),"^",5 ),CLN1=$S( $D(^SC(CLN ,0)):$P(^( 0),"^",1), 1:"UNKNOWN ") | |
895 | "RTN","PSO HLDS1",66, 0) | |
896 | S CSINER= $P(^PSRX(I RXN,3),"^" ,3) | |
897 | "RTN","PSO HLDS1",67, 0) | |
898 | K DIC,X,Y S DIC="^V A(200,",DI C(0)="N,Z" ,X=CSINER D ^DIC | |
899 | "RTN","PSO HLDS1",68, 0) | |
900 | S CSINER1 =$S(+Y:$$H LNAME^HLFN C($P(Y,"^" ,2)),1:""" """) K DIC ,X,Y | |
901 | "RTN","PSO HLDS1",69, 0) | |
902 | D 6^VADPT | |
903 | "RTN","PSO HLDS1",70, 0) | |
904 | S X=$S($D (^PS(55,DF N,0)):^(0) ,1:""),CAP =$P(X,"^", 2) | |
905 | "RTN","PSO HLDS1",71, 0) | |
906 | D MW(X,.M W,.MP) ;PSO*232 | |
907 | "RTN","PSO HLDS1",72, 0) | |
908 | I (($P(^P SRX(IRXN," STA"),"^") >0)&($P(^( "STA"),"^" )'=2)&('$G (PSODBQ))) !'$G(^PSRX (IRXN,"IB" )) S COPAY ="NO COPAY " | |
909 | "RTN","PSO HLDS1",73, 0) | |
910 | E S COPA Y="COPAY" | |
911 | "RTN","PSO HLDS1",74, 0) | |
912 | S NURSE=$ S($P($G(^D PT(DFN,"NH C")),"^")= "Y":1,$P($ G(^PS(55,D FN,40)),"^ "):1,1:0) | |
913 | "RTN","PSO HLDS1",75, 0) | |
914 | S DATE=$$ HLDATE^HLF NC(FDT) D NOW^%DTC S NOW=$$HLD ATE^HLFNC( %,"TS") | |
915 | "RTN","PSO HLDS1",76, 0) | |
916 | S OLAN=$P ($G(^PS(55 ,DFN,"LAN" )),"^",2), OTLAN="N" I OLAN=2 S OTLAN="Y" | |
917 | "RTN","PSO HLDS1",77, 0) | |
918 | S CSUB1=$ $GET1^DIQ( 50,IDGN_", ",3),CSUB= "N" I $E(C SUB1,1)>1& ($E(CSUB1, 1)<6) S CS UB="Y" | |
919 | "RTN","PSO HLDS1",78, 0) | |
920 | S SCTALK= +$G(^PS(55 ,"ASTALK", $P(^PSRX(I RXN,0),"^" ,2))) | |
921 | "RTN","PSO HLDS1",79, 0) | |
922 | K DIC,DR, DIQ S DA=$ P($$SITE^V ASITE(),"^ ") I DA D | |
923 | "RTN","PSO HLDS1",80, 0) | |
924 | .K PSOINS T S DIC=4, DIQ(0)="I" ,DR=99,DIQ ="PSOINST" D EN^DIQ1 | |
925 | "RTN","PSO HLDS1",81, 0) | |
926 | .S PSOINS T=PSOINST( 4,DA,99,"I ") K DIC,D A,DR,DIQ,P SOINST(4) | |
927 | "RTN","PSO HLDS1",82, 0) | |
928 | S DRUG=$$ ZZ^PSOSUTL (IRXN),DEA =$P(^PSDRU G(IDGN,0), "^",3),WAR N=$P($G(^( 0)),"^",8) | |
929 | "RTN","PSO HLDS1",83, 0) | |
930 | S PSND1=$ P($G(^PSDR UG(IDGN,"N D")),"^"), PSND2=$P($ G(^("ND")) ,"^",2),PS ND3=$P($G( ^("ND"))," ^",3) | |
931 | "RTN","PSO HLDS1",84, 0) | |
932 | K PSOXN,P SOXN2,PSOP ROD | |
933 | "RTN","PSO HLDS1",85, 0) | |
934 | I PSND1,P SND3 D | |
935 | "RTN","PSO HLDS1",86, 0) | |
936 | .S PSOPRO D=$$PROD2^ PSNAPIS(PS ND1,PSND3) ,VANAME=$P ($G(PSOPRO D),"^",1) | |
937 | "RTN","PSO HLDS1",87, 0) | |
938 | .I $T(^PS NAPIS)]"" S PSOXN=$$ DFSU^PSNAP IS(PSND1,P SND3),UNIT =$P($G(PSO XN),"^",6) S PSOXN=$ P($G(PSOXN ),"^",5) S PSOXN2=$$ PROD2^PSNA PIS(PSND1, PSND3) Q | |
939 | "RTN","PSO HLDS1",88, 0) | |
940 | .S PSOXN2 =$G(^PSNDF (PSND1,5,P SND3,2)) | |
941 | "RTN","PSO HLDS1",89, 0) | |
942 | .S PRODUC T=$G(^PSND F(PSND1,5, PSND3,0)) | |
943 | "RTN","PSO HLDS1",90, 0) | |
944 | .I $G(PRO DUCT)'="" S PSOXN=+$ P($G(^PSND F(PSND1,2, +$P(PRODUC T,"^",2),3 ,+$P(PRODU CT,"^",3), 4,+$P(PROD UCT,"^",4) ,0)),"^"), UNIT=$P($G (^PS(50.60 7,PSOXN,0) ),"^") | |
945 | "RTN","PSO HLDS1",91, 0) | |
946 | S NFLD=0, UU="" F S UU=$O(^PS RX(IRXN,1, UU)) Q:UU= "" S:$D(^ PSRX(IRXN, 1,UU,0)) N FLD=NFLD+1 | |
947 | "RTN","PSO HLDS1",92, 0) | |
948 | S NRFL=$P (^PSRX(IRX N,0),"^",9 ),RFRM=(NR FL-NFLD) | |
949 | "RTN","PSO HLDS1",93, 0) | |
950 | Q | |
951 | "RTN","PSO HLDS1",94, 0) | |
952 | PID(PSI) ; patient ID segment | |
953 | "RTN","PSO HLDS1",95, 0) | |
954 | Q:'$D(DFN )!$D(PAS) | |
955 | "RTN","PSO HLDS1",96, 0) | |
956 | S HLFS=HL 1("FS"),HL ECH=HL1("E CH"),HLQ=H L1("Q"),HL VER=HL1("V ER") | |
957 | "RTN","PSO HLDS1",97, 0) | |
958 | K PSPID,P SPID1 | |
959 | "RTN","PSO HLDS1",98, 0) | |
960 | D BLDPID^ VAFCQRY(DF N,"","3,4, 5,7,8,11,1 3",.PSPID, .HL1,.ERR) | |
961 | "RTN","PSO HLDS1",99, 0) | |
962 | ; put PID in format needed fo r segment parser | |
963 | "RTN","PSO HLDS1",100 ,0) | |
964 | S PSPID=P SPID(1) K PSPID(1) | |
965 | "RTN","PSO HLDS1",101 ,0) | |
966 | S (X,Y)=1 F S X=+$ O(PSPID(X) ) Q:'X S PSPID(Y)=P SPID(X),Y= Y+1 K PSPI D(X) | |
967 | "RTN","PSO HLDS1",102 ,0) | |
968 | ;parse PI D into ind ividual fi elds | |
969 | "RTN","PSO HLDS1",103 ,0) | |
970 | K PRSEPID D SEGPRSE ^SCMSVUT5( "PSPID","P RSEPID",HL 1("FS")) | |
971 | "RTN","PSO HLDS1",104 ,0) | |
972 | ; parse a ddress int o individu al compone nts | |
973 | "RTN","PSO HLDS1",105 ,0) | |
974 | K ADDSEQ D SEQPRSE^ SCMSVUT5($ NA(PRSEPID (11)),"ADD SEQ",HL1(" ECH")) | |
975 | "RTN","PSO HLDS1",106 ,0) | |
976 | ; build Z TA (Tempor ary Addres s) | |
977 | "RTN","PSO HLDS1",107 ,0) | |
978 | K X2 S X2 =$$EN^VAFH LZTA(DFN," 1,2,3,4,5, 6,7,",1) | |
979 | "RTN","PSO HLDS1",108 ,0) | |
980 | ; parse X 2 (ZTA) in to individ ual fields if temp a dd. exists | |
981 | "RTN","PSO HLDS1",109 ,0) | |
982 | D:'$$CHKT EMP^PSOBAI (DFN) | |
983 | "RTN","PSO HLDS1",110 ,0) | |
984 | . N BADA S BADA=$$C HKRX^PSOBA I(IRXN) | |
985 | "RTN","PSO HLDS1",111 ,0) | |
986 | . I $P(BA DA,"^"),'$ P(BADA,"^" ,2),ADDSEQ (1,7)'["VA B" S BADA= $$GET1^DIQ (2,DFN_"," ,.121,"I") S:BADA AD DSEQ(1,7)= "VAB"_BADA | |
987 | "RTN","PSO HLDS1",112 ,0) | |
988 | D:$$CHKTE MP^PSOBAI( DFN) | |
989 | "RTN","PSO HLDS1",113 ,0) | |
990 | . K PRSEZ TA D SEGPR SE^SCMSVUT 5("X2","PR SEZTA",HL1 ("FS")) | |
991 | "RTN","PSO HLDS1",114 ,0) | |
992 | . ; parse temporary address i nto indivi dual compo nents | |
993 | "RTN","PSO HLDS1",115 ,0) | |
994 | . K TMPAD D D SEQPRS E^SCMSVUT5 ($NA(PRSEZ TA(5)),"TM PADD",HL1( "ECH")) | |
995 | "RTN","PSO HLDS1",116 ,0) | |
996 | . ; add t emporary a ddress as next repit ition in P ID segment | |
997 | "RTN","PSO HLDS1",117 ,0) | |
998 | . S SPOT= 1+$O(ADDSE Q(""),-1) | |
999 | "RTN","PSO HLDS1",118 ,0) | |
1000 | . M ADDSE Q(SPOT)=TM PADD(1) | |
1001 | "RTN","PSO HLDS1",119 ,0) | |
1002 | . S ADDSE Q(SPOT,7)= "C" | |
1003 | "RTN","PSO HLDS1",120 ,0) | |
1004 | . S ADDSE Q(SPOT,9)= PRSEZTA(6) | |
1005 | "RTN","PSO HLDS1",121 ,0) | |
1006 | . S ADDSE Q(SPOT,12, 1)=PRSEZTA (3) | |
1007 | "RTN","PSO HLDS1",122 ,0) | |
1008 | . S ADDSE Q(SPOT,12, 2)=PRSEZTA (4) | |
1009 | "RTN","PSO HLDS1",123 ,0) | |
1010 | . ;move a ddress seq uence back into pars e PID segm ent | |
1011 | "RTN","PSO HLDS1",124 ,0) | |
1012 | ; rebuild PID segme nt | |
1013 | "RTN","PSO HLDS1",125 ,0) | |
1014 | K PRSEPID (11) M PRS EPID(11)=A DDSEQ | |
1015 | "RTN","PSO HLDS1",126 ,0) | |
1016 | K PSPID1 D MAKEIT^V AFHLU("PID ",.PRSEPID ,.PSPID1,. PSPID1) | |
1017 | "RTN","PSO HLDS1",127 ,0) | |
1018 | ;put rebu ilt PID in to format used by $$ EN^VAFCQRY | |
1019 | "RTN","PSO HLDS1",128 ,0) | |
1020 | K PSPID S PSPID(1)= PSPID1 | |
1021 | "RTN","PSO HLDS1",129 ,0) | |
1022 | S X=0,Y=2 F S X=+$ O(PSPID1(X )) Q:'X S PSPID(Y)= PSPID1(X) S Y=Y+1 | |
1023 | "RTN","PSO HLDS1",130 ,0) | |
1024 | S CNT=0 F I=1:1 Q:' $D(PSPID(I )) D | |
1025 | "RTN","PSO HLDS1",131 ,0) | |
1026 | . I I=1 S ^TMP("PSO ",$J,PSI)= PSPID(I) Q | |
1027 | "RTN","PSO HLDS1",132 ,0) | |
1028 | . S CNT=C NT+1 S ^TM P("PSO",$J ,PSI,CNT)= PSPID(I) | |
1029 | "RTN","PSO HLDS1",133 ,0) | |
1030 | S PSI=PSI +1 | |
1031 | "RTN","PSO HLDS1",134 ,0) | |
1032 | S PAS=1 | |
1033 | "RTN","PSO HLDS1",135 ,0) | |
1034 | K PSPID,P SPID1,PRSE PID,PRSEZT A,SPOT,TMP ADD,ADDSEQ | |
1035 | "RTN","PSO HLDS1",136 ,0) | |
1036 | Q | |
1037 | "RTN","PSO HLDS1",137 ,0) | |
1038 | PV1(PSI) ; patient vi sit segmen t | |
1039 | "RTN","PSO HLDS1",138 ,0) | |
1040 | Q:'$D(DFN )!$D(PAS1) | |
1041 | "RTN","PSO HLDS1",139 ,0) | |
1042 | N PV1 ;h ardcoded t o letter O for Outpa tient (Pat ient class ) | |
1043 | "RTN","PSO HLDS1",140 ,0) | |
1044 | S PV1="PV 1"_FS_FS_" O"_FS | |
1045 | "RTN","PSO HLDS1",141 ,0) | |
1046 | S ^TMP("P SO",$J,PSI )=PV1 | |
1047 | "RTN","PSO HLDS1",142 ,0) | |
1048 | S PSI=PSI +1,PAS1=1 | |
1049 | "RTN","PSO HLDS1",143 ,0) | |
1050 | Q | |
1051 | "RTN","PSO HLDS1",144 ,0) | |
1052 | PV2(PSI) ; patient vi sit segmen t (additio nal inform ation) | |
1053 | "RTN","PSO HLDS1",145 ,0) | |
1054 | ;PATIENT STATUS AND COPAY | |
1055 | "RTN","PSO HLDS1",146 ,0) | |
1056 | Q:'$D(DFN )!$D(PAS2) | |
1057 | "RTN","PSO HLDS1",147 ,0) | |
1058 | N PV2 S P V2="" | |
1059 | "RTN","PSO HLDS1",148 ,0) | |
1060 | S $P(PV2, "|",24)=$P ($G(^PS(53 ,+$P($G(^P SRX(IRXN,0 )),"^",3), 0)),"^",2) _"~"_COPAY _FS | |
1061 | "RTN","PSO HLDS1",149 ,0) | |
1062 | S ^TMP("P SO",$J,PSI )="PV2|"_P V2 | |
1063 | "RTN","PSO HLDS1",150 ,0) | |
1064 | S PSI=PSI +1,PAS2=1 | |
1065 | "RTN","PSO HLDS1",151 ,0) | |
1066 | Q | |
1067 | "RTN","PSO HLDS1",152 ,0) | |
1068 | ; | |
1069 | "RTN","PSO HLDS1",153 ,0) | |
1070 | MW(PS55,MW ,MP) ;Retu rn Mail/Wi ndow and M P expanded text ;PSO*232 | |
1071 | "RTN","PSO HLDS1",154 ,0) | |
1072 | I MW="W"! (MW="") D ;* 255 | |
1073 | "RTN","PSO HLDS1",155 ,0) | |
1074 | . S MP=$S ($P($G(^PS RX(IRXN,"M P")),"^")' ="":$P(^(" MP"),"^"), 1:"""""") | |
1075 | "RTN","PSO HLDS1",156 ,0) | |
1076 | . S MW="W INDOW" | |
1077 | "RTN","PSO HLDS1",157 ,0) | |
1078 | I MW="M" D | |
1079 | "RTN","PSO HLDS1",158 ,0) | |
1080 | . S MP="" """" | |
1081 | "RTN","PSO HLDS1",159 ,0) | |
1082 | . S PS55= $P(PS55,"^ ",3) | |
1083 | "RTN","PSO HLDS1",160 ,0) | |
1084 | . S MW=$S (PS55=1:"C ERTIFIED M AIL",PS55= 2:"DO NOT MAIL",1:"R EGULAR MAI L") | |
1085 | "RTN","PSO HLDS1",161 ,0) | |
1086 | Q | |
1087 | "RTN","PSO HLDS2") | |
1088 | 0^3^B98255 192 | |
1089 | "RTN","PSO HLDS2",1,0 ) | |
1090 | PSOHLDS2 ; BHAM ISC/P WC,SAB-Bui ld HL7 Seg ments for automated interface ;11/22/06 3:24pm | |
1091 | "RTN","PSO HLDS2",2,0 ) | |
1092 | ;;7.0;OUT PATIENT PH ARMACY;**1 56,198,255 ,200,268,3 05,336,434 ,282,524** ;DEC 1997; Build 12 | |
1093 | "RTN","PSO HLDS2",3,0 ) | |
1094 | ;DIWP sup ported by DBIA 10011 | |
1095 | "RTN","PSO HLDS2",4,0 ) | |
1096 | ;^PS(50.6 06 support ed by DBIA 2174 | |
1097 | "RTN","PSO HLDS2",5,0 ) | |
1098 | ;^PS(50.7 supported by DBIA # 2223 | |
1099 | "RTN","PSO HLDS2",6,0 ) | |
1100 | ;^PS(51 s upported b y DBIA 222 4 | |
1101 | "RTN","PSO HLDS2",7,0 ) | |
1102 | ;^PS(51.2 supported by DBIA 2 226 | |
1103 | "RTN","PSO HLDS2",8,0 ) | |
1104 | ;^PS(55 s upported b y DBIA 222 8 | |
1105 | "RTN","PSO HLDS2",9,0 ) | |
1106 | ;^PSDRUG supported by DBIA 22 1 | |
1107 | "RTN","PSO HLDS2",10, 0) | |
1108 | ;^PS(54 s upported b y DBIA 222 7 | |
1109 | "RTN","PSO HLDS2",11, 0) | |
1110 | ;Cont'd b uild HL7 s egments | |
1111 | "RTN","PSO HLDS2",12, 0) | |
1112 | ; | |
1113 | "RTN","PSO HLDS2",13, 0) | |
1114 | ;*198 add check to insert spa ces into P MI segment s | |
1115 | "RTN","PSO HLDS2",14, 0) | |
1116 | ;*255 add 2 new fie lds to RXE .21 (label name & VA PRINT NAM E) | |
1117 | "RTN","PSO HLDS2",15, 0) | |
1118 | ; and move NTEP MI tag to PSOHLDS4 | |
1119 | "RTN","PSO HLDS2",16, 0) | |
1120 | ;*305 sen d Notice of Privacy Practices in NTE9 - Modified to NTE9 as NTE8 alre ady exist | |
1121 | "RTN","PSO HLDS2",17, 0) | |
1122 | ; | |
1123 | "RTN","PSO HLDS2",18, 0) | |
1124 | ; | |
1125 | "RTN","PSO HLDS2",19, 0) | |
1126 | RXE(PSI) ; pharmacy e ncoded ord er segment | |
1127 | "RTN","PSO HLDS2",20, 0) | |
1128 | Q:'$D(DFN ) N RXE S RXE="" S $P(RXE,"|" ,1)="""""" | |
1129 | "RTN","PSO HLDS2",21, 0) | |
1130 | S $P(RXE, "|",2)=$S( $P($G(^PSD RUG(IDGN," ND")),"^", 10)'="":$P (^("ND")," ^",10),($G (PSND1)&$G (PSND3)):$ P($G(PSOXN 2),"^",2), 1:"""""")_ CS_$G(PSND 2)_CS_"99P SNDF"_CS_P SND1_"."_P SND3_"."_$ G(IDGN)_CS _$P($G(^PS DRUG(IDGN, 0)),"^")_C S_"99PSD" | |
1131 | "RTN","PSO HLDS2",22, 0) | |
1132 | S $P(RXE, "|",3)="" I $G(PSOXN )="" S PSO XN="""""" | |
1133 | "RTN","PSO HLDS2",23, 0) | |
1134 | S $P(RXE, "|",5)=PSO XN_CS_$S($ G(UNIT)'=" ":$G(UNIT) ,1:"""""") _CS_"99PSU " | |
1135 | "RTN","PSO HLDS2",24, 0) | |
1136 | S POIPTR= $P($G(^PSR X(IRXN,"OR 1")),"^") I POIPTR S PODOSE=$P ($G(^PS(50 .7,POIPTR, 0)),"^",2) ,PODOSENM= $P($G(^PS( 50.606,POD OSE,0)),"^ ") | |
1137 | "RTN","PSO HLDS2",25, 0) | |
1138 | I '$G(POI PTR) S POD OSE=$P($G( ^PS(50.7,$ P($G(^PSDR UG(IDGN,2) ),"^"),0)) ,"^",2),PO DOSENM=$P( $G(^PS(50. 606,PODOSE ,0)),"^") | |
1139 | "RTN","PSO HLDS2",26, 0) | |
1140 | S TRADENM =$G(^PSRX( IRXN,"TN") ),$P(RXE," |",6)=PODO SE_CS_PODO SENM_CS_"9 9PSF" | |
1141 | "RTN","PSO HLDS2",27, 0) | |
1142 | S $P(RXE, "|",8)=MP, $P(RXE,"|" ,9)=TRADEN M,$P(RXE," |",10)=QTY | |
1143 | "RTN","PSO HLDS2",28, 0) | |
1144 | S $P(RXE, "|",11)=CS _$P($G(^PS DRUG(IDGN, 660)),"^", 8),$P(RXE, "|",12)=NR FL | |
1145 | "RTN","PSO HLDS2",29, 0) | |
1146 | S $P(RXE, "|",13)=DE AID,$P(RXE ,"|",14)=V PHARMID_CS _$P(VPHARM ,",",1)_CS _$P(VPHARM ,",",2) | |
1147 | "RTN","PSO HLDS2",30, 0) | |
1148 | S $P(RXE, "|",15)=$P (^PSRX(IRX N,0),"^"), $P(RXE,"|" ,16)=RFRM, $P(RXE,"|" ,17)=NFLD | |
1149 | "RTN","PSO HLDS2",31, 0) | |
1150 | S $P(RXE, "|",18)=PR IORDT,$P(R XE,"|",31) =CSUB_RS_S CTALK_RS_O TLAN | |
1151 | "RTN","PSO HLDS2",32, 0) | |
1152 | S $P(RXE, "|",21)=CS _DRUG_RS_C S_$G(VANAM E) ;*255 | |
1153 | "RTN","PSO HLDS2",33, 0) | |
1154 | S ^TMP("P SO",$J,PSI )="RXE|"_R XE,PSI=PSI +1 | |
1155 | "RTN","PSO HLDS2",34, 0) | |
1156 | K PODOSE, PODOSENM,P OIPTR,TRAD ENM,UU | |
1157 | "RTN","PSO HLDS2",35, 0) | |
1158 | Q | |
1159 | "RTN","PSO HLDS2",36, 0) | |
1160 | RXD(PSI) ; pharmacy d ispense se gment | |
1161 | "RTN","PSO HLDS2",37, 0) | |
1162 | Q:'$D(DFN ) N RXD,I | |
1163 | "RTN","PSO HLDS2",38, 0) | |
1164 | S WNS="" I $G(WARN) F I=1:1 S WW=$P(WAR N,",",I) Q :WW="" S WNS=WNS_WW _CS_$S(WW' ["N":^PS(5 4,WW,0),1: "")_RS | |
1165 | "RTN","PSO HLDS2",39, 0) | |
1166 | S RXD="RX D"_FS_$S($ G(NFLD):NF LD,1:0)_FS _$S($P($G( ^PSDRUG(ID GN,"ND")), "^",10)'=" ":$P(^("ND "),"^",10) ,($G(PSND1 )&$G(PSND3 )):$P($G(P SOXN2),"^" ,2),1:"""" "")_CS_PSN D2_CS_"99P SNDF" | |
1167 | "RTN","PSO HLDS2",40, 0) | |
1168 | S RXD=RXD _CS_PSND1_ "."_PSND3_ "."_$G(IDG N)_CS_$P($ G(^PSDRUG( IDGN,0))," ^")_CS_"99 PSD" | |
1169 | "RTN","PSO HLDS2",41, 0) | |
1170 | S RXD=RXD _FS_DISPDT _FS_FS_FS_ FS_$P(^PSR X(IRXN,0), "^")_FS_NR FL | |
1171 | "RTN","PSO HLDS2",42, 0) | |
1172 | S RXD=RXD _FS_DEA_RS _PSONDC_FS _$S(FIN'=" ":FIN_CS_F IN1,1:"")_ FS | |
1173 | "RTN","PSO HLDS2",43, 0) | |
1174 | S RXD=RXD _FS_DASPLY _FS_MW_FS_ FS_CS_$S($ G(CAP):"NO N-SAFETY", 1:"SAFETY" ) | |
1175 | "RTN","PSO HLDS2",44, 0) | |
1176 | S RXD=RXD _FS_FS_FS_ FS_EXDT_FS _FS_FS_FS_ FS_FS_WNS_ FS_FS | |
1177 | "RTN","PSO HLDS2",45, 0) | |
1178 | S ^TMP("P SO",$J,PSI )=RXD,PSI= PSI+1 | |
1179 | "RTN","PSO HLDS2",46, 0) | |
1180 | Q | |
1181 | "RTN","PSO HLDS2",47, 0) | |
1182 | RXR(PSI) ; pharmacy r oute segme nt | |
1183 | "RTN","PSO HLDS2",48, 0) | |
1184 | Q:'$D(DFN ) N RXR S (PSROUTE, RTNAME)="" """" | |
1185 | "RTN","PSO HLDS2",49, 0) | |
1186 | F PSRTLP= 0:0 S PSRT LP=$O(^PSR X(IRXN,6,P SRTLP)) Q: 'PSRTLP D | |
1187 | "RTN","PSO HLDS2",50, 0) | |
1188 | .S PSROUT E=$P($G(^P SRX(IRXN,6 ,PSRTLP,0) ),"^",7) | |
1189 | "RTN","PSO HLDS2",51, 0) | |
1190 | .I PSROUT E,$D(^PS(5 1.2,PSROUT E,0)) S R TNAME=$P(^ PS(51.2,PS ROUTE,0)," ^") | |
1191 | "RTN","PSO HLDS2",52, 0) | |
1192 | I RTNAME= "" K PSROU TE,RTNAME, PSRTLP Q | |
1193 | "RTN","PSO HLDS2",53, 0) | |
1194 | S RXR="RX R"_FS_$G(P SROUTE)_CS _$G(RTNAME )_CS_"99PS R"_FS_FS_F S_FS | |
1195 | "RTN","PSO HLDS2",54, 0) | |
1196 | S ^TMP("P SO",$J,PSI )=RXR,PSI= PSI+1 | |
1197 | "RTN","PSO HLDS2",55, 0) | |
1198 | K PSROUTE ,RTNAME,PS RTLP | |
1199 | "RTN","PSO HLDS2",56, 0) | |
1200 | Q | |
1201 | "RTN","PSO HLDS2",57, 0) | |
1202 | SIG K OT S SGY="" F P=1:1:$L(S IG," ") S X=$P(SIG," ",P) D:X] "" | |
1203 | "RTN","PSO HLDS2",58, 0) | |
1204 | .I $D(^PS (51,"A",X) ) D | |
1205 | "RTN","PSO HLDS2",59, 0) | |
1206 | ..;PSO*7* 282 Intend ed Use | |
1207 | "RTN","PSO HLDS2",60, 0) | |
1208 | ..I $P($G (^PS(55,DF N,"LAN")), "^") S OT= $O(^PS(51, "B",X,0)) I OT,($P(^ PS(51,OT,0 ),"^",4)<2 )&($P($G(^ PS(51,OT,4 )),"^")]"" ) S X=$P(^ PS(51,OT,4 ),"^") K O T Q | |
1209 | "RTN","PSO HLDS2",61, 0) | |
1210 | ..;S %=^P S(51,"A",X ),X=$P(%," ^") I $P(% ,"^",2)]"" S Y=$P(SI G," ",P-1) ,Y=$E(Y,$L (Y)) S:Y>1 X=$P(%,"^ ",2) | |
1211 | "RTN","PSO HLDS2",62, 0) | |
1212 | .S SGY=SG Y_X_" " | |
1213 | "RTN","PSO HLDS2",63, 0) | |
1214 | S X="",SG C=1 F J=1: 1 S Z=$P(S GY," ",J) S:Z="" SGY (SGC)=X Q: Z="" S:$L (X)+$L(Z)' <$S($P(PSO PAR,"^",28 ):46,1:34) SGY(SGC)= X,SGC=SGC+ 1,X="" S X =X_Z_" " | |
1215 | "RTN","PSO HLDS2",64, 0) | |
1216 | SIGOLD I ' $P(PSOPAR, "^",28) D K NHC | |
1217 | "RTN","PSO HLDS2",65, 0) | |
1218 | .K DIC,DR ,DIQ,NHC S DIC=2,DA= DFN,DR=148 ,DIQ="NHC" ,DIQ(0)="I " | |
1219 | "RTN","PSO HLDS2",66, 0) | |
1220 | .D EN^DIQ 1 K DIC,DR ,DIQ | |
1221 | "RTN","PSO HLDS2",67, 0) | |
1222 | .I NHC(2, DFN,148,"I ")="Y"!($P ($G(^PS(55 ,DFN,40)), "^")) S SG C=SGC+1,SG Y(SGC)="Ex piration:_ _______ Mf g:________ _" | |
1223 | "RTN","PSO HLDS2",68, 0) | |
1224 | Q | |
1225 | "RTN","PSO HLDS2",69, 0) | |
1226 | ; | |
1227 | "RTN","PSO HLDS2",70, 0) | |
1228 | PSOLBL3 ;R X must be defined (I nternal), Check alre ady done f or OERR SI G | |
1229 | "RTN","PSO HLDS2",71, 0) | |
1230 | ;Format O ERR Sig fo r New and Old label stock | |
1231 | "RTN","PSO HLDS2",72, 0) | |
1232 | N CTCT,FF FF,LLIM,LL LL,LVAR,LV AR1,PPP,PP PP,SGCT,SI G9,ZZZZ,PS LONG,PPPP | |
1233 | "RTN","PSO HLDS2",73, 0) | |
1234 | S RX=IRXN | |
1235 | "RTN","PSO HLDS2",74, 0) | |
1236 | I $P($G(^ PS(55,DFN, "LAN")),"^ ") N II D OTHL^PSOLB L3 G:$G(FN D) FMSIG | |
1237 | "RTN","PSO HLDS2",75, 0) | |
1238 | S PSLONG= $S($P(PSOP AR,"^",28) :46,1:34) | |
1239 | "RTN","PSO HLDS2",76, 0) | |
1240 | ; NEXT LI NE IF SIG IS MOVED B ACK TO MUL TIPLE | |
1241 | "RTN","PSO HLDS2",77, 0) | |
1242 | S PPPP=1 F PPP=0:0 S PPP=$O(^ PSRX(RX,"S IG1",PPP)) Q:'PPP I $G(^PSRX( RX,"SIG1", PPP,0))'=" " S SIG9(P PPP)=^(0) S PPPP=PPP P+1 | |
1243 | "RTN","PSO HLDS2",78, 0) | |
1244 | ;NEXT LIN E IF 1ST F RONT DOOR SIG LINE L IVES IN BA CK DOOR SP OT | |
1245 | "RTN","PSO HLDS2",79, 0) | |
1246 | FMSIG S (L VAR,LVAR1) ="",LLLL=1 | |
1247 | "RTN","PSO HLDS2",80, 0) | |
1248 | F FFFF=0: 0 S FFFF=$ O(SIG9(FFF F)) Q:'FFF F S SGCT= 0 F ZZZZ=1 :1:$L(SIG9 (FFFF)) I $E(SIG9(FF FF),ZZZZ)= " "!($L(SI G9(FFFF))= ZZZZ) S SG CT=SGCT+1 D I $L(LV AR)>PSLONG S SGY(LLL L)=LLIM_" ",LLLL=LLL L+1,LVAR=L VAR1 | |
1249 | "RTN","PSO HLDS2",81, 0) | |
1250 | .S LVAR1= $P(SIG9(FF FF)," ",(S GCT)),LLIM =LVAR,LVAR =$S(LVAR=" ":LVAR1,1: LVAR_" "_L VAR1) | |
1251 | "RTN","PSO HLDS2",82, 0) | |
1252 | I $G(LVAR )'="" S SG Y(LLLL)=LV AR | |
1253 | "RTN","PSO HLDS2",83, 0) | |
1254 | I '$P(PSO PAR,"^",28 ) S SGC=0 F CTCT=0:0 S CTCT=$O (SGY(CTCT) ) Q:'CTCT S SGC=SGC +1 | |
1255 | "RTN","PSO HLDS2",84, 0) | |
1256 | I $O(OSGY (0)) D | |
1257 | "RTN","PSO HLDS2",85, 0) | |
1258 | .F I=0:0 S I=$O(SGY (I)) Q:'I I $G(OSGY (I))']"" S OSGY(I)=" " | |
1259 | "RTN","PSO HLDS2",86, 0) | |
1260 | .F I=0:0 S I=$O(OSG Y(I)) Q:'I I $G(SGY (I))']"" S SGY(I)=" " | |
1261 | "RTN","PSO HLDS2",87, 0) | |
1262 | Q | |
1263 | "RTN","PSO HLDS2",88, 0) | |
1264 | NTE ;build NTE segme nt for SIG | |
1265 | "RTN","PSO HLDS2",89, 0) | |
1266 | ; | |
1267 | "RTN","PSO HLDS2",90, 0) | |
1268 | Q:'$D(DFN ) | |
1269 | "RTN","PSO HLDS2",91, 0) | |
1270 | ; 1 = SIG | |
1271 | "RTN","PSO HLDS2",92, 0) | |
1272 | ; 2 = PI Narrative | |
1273 | "RTN","PSO HLDS2",93, 0) | |
1274 | ; 3 = Dru g Warning | |
1275 | "RTN","PSO HLDS2",94, 0) | |
1276 | ; 4 = Pro file | |
1277 | "RTN","PSO HLDS2",95, 0) | |
1278 | ; 5 = Dru g Interact ion | |
1279 | "RTN","PSO HLDS2",96, 0) | |
1280 | ; 6 = Dru g Allergy | |
1281 | "RTN","PSO HLDS2",97, 0) | |
1282 | ; 7 = PMI Sheet (NT EPMI in PS OHLDS4) | |
1283 | "RTN","PSO HLDS2",98, 0) | |
1284 | ; 8 = Med ication In structions | |
1285 | "RTN","PSO HLDS2",99, 0) | |
1286 | ; 9 = Pri vacy Notif ication | |
1287 | "RTN","PSO HLDS2",100 ,0) | |
1288 | ; | |
1289 | "RTN","PSO HLDS2",101 ,0) | |
1290 | K FLDX | |
1291 | "RTN","PSO HLDS2",102 ,0) | |
1292 | D NTE1(.P SI) K FLDX D NTE2(.P SI) K FLDX D NTE3(.P SI) K FLDX | |
1293 | "RTN","PSO HLDS2",103 ,0) | |
1294 | D NTE4(.P SI) K FLDX D NTE5(.P SI) K FLDX D NTE6(.P SI) K FLDX | |
1295 | "RTN","PSO HLDS2",104 ,0) | |
1296 | Q | |
1297 | "RTN","PSO HLDS2",105 ,0) | |
1298 | ; | |
1299 | "RTN","PSO HLDS2",106 ,0) | |
1300 | NTE1(PSI) ;SIG | |
1301 | "RTN","PSO HLDS2",107 ,0) | |
1302 | S SIG=$P( $G(^PSRX(I RXN,"SIG") ),"^") | |
1303 | "RTN","PSO HLDS2",108 ,0) | |
1304 | I $P($G(^ PSRX(IRXN, "SIG")),"^ ",2) D PSO LBL3,SIGOL D | |
1305 | "RTN","PSO HLDS2",109 ,0) | |
1306 | I '$P($G( ^PSRX(IRXN ,"SIG"))," ^",2) D SI G | |
1307 | "RTN","PSO HLDS2",110 ,0) | |
1308 | I $O(OSGY (0)) D G KNTE | |
1309 | "RTN","PSO HLDS2",111 ,0) | |
1310 | .K DRR F DR=0:0 S D R=$O(SGY(D R)) Q:'DR S DRR=$G( DRR)+1 | |
1311 | "RTN","PSO HLDS2",112 ,0) | |
1312 | .S DRR=DR R+1,SGY(DR R)=FS_"Med ication In structions (LANGUAGE PREFERENC E)" | |
1313 | "RTN","PSO HLDS2",113 ,0) | |
1314 | .K DRR F DR=0:0 S D R=$O(OSGY( DR)) Q:'DR S DRR=$G (DRR)+1 | |
1315 | "RTN","PSO HLDS2",114 ,0) | |
1316 | .S DRR=DR R+1,OSGY(D RR)=FS_"Me dication I nstruction s (ENGLISH )" | |
1317 | "RTN","PSO HLDS2",115 ,0) | |
1318 | .K DRR S ^TMP("PSO" ,$J,PSI)=" NTE"_FS_1_ FS_FS | |
1319 | "RTN","PSO HLDS2",116 ,0) | |
1320 | .S CLD=1 F DR=0:0 S DR=$O(OSG Y(DR)) Q:' DR D | |
1321 | "RTN","PSO HLDS2",117 ,0) | |
1322 | ..S:$L($G (^TMP("PSO ",$J,PSI,C LD))_OSGY( DR))>245 C LD=CLD+1 S ^TMP("PSO ",$J,PSI,C LD)=$G(^TM P("PSO",$J ,PSI,CLD)) _OSGY(DR) | |
1323 | "RTN","PSO HLDS2",118 ,0) | |
1324 | .S PSI=PS I+1,^TMP(" PSO",$J,PS I)="NTE"_F S_8_FS_FS | |
1325 | "RTN","PSO HLDS2",119 ,0) | |
1326 | .S CLD=1 F DR=0:0 S DR=$O(SGY (DR)) Q:'D R D | |
1327 | "RTN","PSO HLDS2",120 ,0) | |
1328 | ..S:$L($G (^TMP("PSO ",$J,PSI,C LD))_SGY(D R))>245 CL D=CLD+1 S ^TMP("PSO" ,$J,PSI,CL D)=$G(^TMP ("PSO",$J, PSI,CLD))_ SGY(DR) | |
1329 | "RTN","PSO HLDS2",121 ,0) | |
1330 | K DRR F D R=0:0 S DR =$O(SGY(DR )) Q:'DR S DRR=$G(D RR)+1 | |
1331 | "RTN","PSO HLDS2",122 ,0) | |
1332 | S DRR=DRR +1,SGY(DRR )=FS_"Medi cation Ins tructions" | |
1333 | "RTN","PSO HLDS2",123 ,0) | |
1334 | K DRR S ^ TMP("PSO", $J,PSI)="N TE"_FS_1_F S_FS | |
1335 | "RTN","PSO HLDS2",124 ,0) | |
1336 | S CLD=1 F DR=0:0 S DR=$O(SGY( DR)) Q:'DR D | |
1337 | "RTN","PSO HLDS2",125 ,0) | |
1338 | .S:$L($G( ^TMP("PSO" ,$J,PSI,CL D))_SGY(DR ))>245 CLD =CLD+1 S ^ TMP("PSO", $J,PSI,CLD )=$G(^TMP( "PSO",$J,P SI,CLD))_S GY(DR) | |
1339 | "RTN","PSO HLDS2",126 ,0) | |
1340 | KNTE S PSI =PSI+1 K D R,CLD,DRR, SIG,E,F,S, FLD1,X,Y,S GY,SGC,Z,D R,%,J,P,NT 1,ST,EN,LT H | |
1341 | "RTN","PSO HLDS2",127 ,0) | |
1342 | Q | |
1343 | "RTN","PSO HLDS2",128 ,0) | |
1344 | LENGTH(NT1 ) ; compen sate for l ength > 24 5 | |
1345 | "RTN","PSO HLDS2",129 ,0) | |
1346 | I $L(NT1) >245 S LTH =$E($L(NT1 )/245,1) S :$L(NT1)#2 45>0 LTH=L TH+1 F WW= 1:1:LTH D | |
1347 | "RTN","PSO HLDS2",130 ,0) | |
1348 | . S:WW=1 ST=1,EN=24 5 S:WW>1 S T=(ST+245) ,EN=(EN+24 5) S NT11= $E(NT1,ST, EN) | |
1349 | "RTN","PSO HLDS2",131 ,0) | |
1350 | . S:WW=1 ^TMP("PSO" ,$J,PSI)=N T11 S:WW>1 ^TMP("PSO ",$J,PSI,W W-1)=NT11 | |
1351 | "RTN","PSO HLDS2",132 ,0) | |
1352 | S:'$D(LTH ) ^TMP("PS O",$J,PSI) =NT1 S PSI =PSI+1 | |
1353 | "RTN","PSO HLDS2",133 ,0) | |
1354 | Q | |
1355 | "RTN","PSO HLDS2",134 ,0) | |
1356 | NTE2(PSI) ; Patient Narrative | |
1357 | "RTN","PSO HLDS2",135 ,0) | |
1358 | K ^UTILIT Y($J,"W") S (DIWL,PS NACNT)=1,D IWR=45,DIW F="",(PSSI XFL,PSSEVF L)=0 F ZZ= 0:0 S ZZ=$ O(^PS(59,P SOSITE,6,Z Z)) Q:'ZZ I $D(^(ZZ ,0)) S X=^ (0) D ^DIW P | |
1359 | "RTN","PSO HLDS2",136 ,0) | |
1360 | F LLL=0:0 S LLL=$O( ^UTILITY($ J,"W",DIWL ,LLL)) Q:' LLL S ^TM P("PSO",$J ,PSI,PSNAC NT)=^UTILI TY($J,"W", DIWL,LLL,0 ) S PSNACN T=PSNACNT+ 1,PSSIXFL= 1 | |
1361 | "RTN","PSO HLDS2",137 ,0) | |
1362 | I PSSIXFL S ^TMP("P SO",$J,PSI )="NTE"_FS _2_FS_FS,^ TMP("PSO", $J,PSI,PSN ACNT)=" " S PSNACNT= PSNACNT+1, FLDX=1 | |
1363 | "RTN","PSO HLDS2",138 ,0) | |
1364 | S DIWL=1, DIWR=45,DI WF="" K ^U TILITY($J, "W") F ZZ= 0:0 S ZZ=$ O(^PS(59,P SOSITE,7,Z Z)) Q:'ZZ I $D(^(ZZ ,0)) S X=^ (0) D ^DIW P | |
1365 | "RTN","PSO HLDS2",139 ,0) | |
1366 | F LLL=0:0 S LLL=$O( ^UTILITY($ J,"W",DIWL ,LLL)) Q:' LLL S ^TM P("PSO",$J ,PSI,PSNAC NT)=^UTILI TY($J,"W", DIWL,LLL,0 ) S PSNACN T=PSNACNT+ 1,PSSEVFL= 1 | |
1367 | "RTN","PSO HLDS2",140 ,0) | |
1368 | I PSSEVFL S ^TMP("P SO",$J,PSI ,PSNACNT)= " " S PSNA CNT=PSNACN T+1 | |
1369 | "RTN","PSO HLDS2",141 ,0) | |
1370 | S DIWL=1, DIWR=45,DI WF="" K ^U TILITY($J, "W") F ZZ= 0:0 S ZZ=$ O(^PS(59,P SOSITE,4,Z Z)) Q:'ZZ I $D(^(ZZ ,0)) S X=^ (0) D ^DIW P | |
1371 | "RTN","PSO HLDS2",142 ,0) | |
1372 | F LLL=0:0 S LLL=$O( ^UTILITY($ J,"W",DIWL ,LLL)) Q:' LLL S ^TM P("PSO",$J ,PSI,PSNAC NT)=^UTILI TY($J,"W", DIWL,LLL,0 ) S PSNACN T=PSNACNT+ 1 | |
1373 | "RTN","PSO HLDS2",143 ,0) | |
1374 | S:$D(FLDX ) ^TMP("PS O",$J,PSI, PSNACNT-1) =^TMP("PSO ",$J,PSI,P SNACNT-1)_ FS_"Patien t Narrativ e",PSI=PSI +1 | |
1375 | "RTN","PSO HLDS2",144 ,0) | |
1376 | K DIWF,DI WL,DIWR,LL L,PSNACNT, PSSEVFL,PS SIXFL,ZZ | |
1377 | "RTN","PSO HLDS2",145 ,0) | |
1378 | Q | |
1379 | "RTN","PSO HLDS2",146 ,0) | |
1380 | NTE3(PSI) ;Drug Warn ing Narrat ive | |
1381 | "RTN","PSO HLDS2",147 ,0) | |
1382 | N NTE3,J, TEXT,W,CNT ,PSSWSITE | |
1383 | "RTN","PSO HLDS2",148 ,0) | |
1384 | S WARN=$P ($G(^PSDRU G(IDGN,0)) ,"^",8) | |
1385 | "RTN","PSO HLDS2",149 ,0) | |
1386 | S PSSWSIT E=+$O(^PS( 59.7,0)) | |
1387 | "RTN","PSO HLDS2",150 ,0) | |
1388 | I $P($G(^ PS(59.7,PS SWSITE,10) ),"^",11)= "N" D | |
1389 | "RTN","PSO HLDS2",151 ,0) | |
1390 | .S WARN=$ $DRUG^PSSW RNA(IDGN,D FN) | |
1391 | "RTN","PSO HLDS2",152 ,0) | |
1392 | I WARN="" Q | |
1393 | "RTN","PSO HLDS2",153 ,0) | |
1394 | S NTE3="N TE"_FS_3_F S_FS,^TMP( "PSO",$J,P SI)=NTE3,C NT=1 | |
1395 | "RTN","PSO HLDS2",154 ,0) | |
1396 | F J=1:1 S W=$P(WARN ,",",J) Q: W="" D | |
1397 | "RTN","PSO HLDS2",155 ,0) | |
1398 | . S:CNT>1 ^TMP("PSO ",$J,PSI,C NT-1)=^TMP ("PSO",$J, PSI,CNT-1) _"\.sp\" | |
1399 | "RTN","PSO HLDS2",156 ,0) | |
1400 | . S TEXT= $$WTEXT^PS SWRNA(W,$G (OLAN)) I TEXT'="" S FLDX=1 D | |
1401 | "RTN","PSO HLDS2",157 ,0) | |
1402 | . . I $L( TEXT)<245 S ^TMP("PS O",$J,PSI, CNT)=TEXT, CNT=CNT+1 Q | |
1403 | "RTN","PSO HLDS2",158 ,0) | |
1404 | . . N LTH ,ST,EN,TXT ,WW | |
1405 | "RTN","PSO HLDS2",159 ,0) | |
1406 | . . S LTH =$E($L(TEX T)/245,1) S:$L(TEXT) #245>0 LTH =LTH+1 | |
1407 | "RTN","PSO HLDS2",160 ,0) | |
1408 | . . F WW= 1:1:LTH D | |
1409 | "RTN","PSO HLDS2",161 ,0) | |
1410 | . . . S:W W=1 ST=1,E N=245 S:WW >1 ST=(ST+ 245),EN=(E N+245) S T XT=$E(TEXT ,ST,EN) | |
1411 | "RTN","PSO HLDS2",162 ,0) | |
1412 | . . . S ^ TMP("PSO", $J,PSI,CNT )=TXT,CNT= CNT+1 | |
1413 | "RTN","PSO HLDS2",163 ,0) | |
1414 | I $G(FLDX ) D S PSI =PSI+1 | |
1415 | "RTN","PSO HLDS2",164 ,0) | |
1416 | . I $L(^T MP("PSO",$ J,PSI,CNT- 1)_FS_"Dru g Warning Narrative" )<245 S ^T MP("PSO",$ J,PSI,CNT- 1)=$G(^TMP ("PSO",$J, PSI,CNT-1) )_FS_"Drug Warning N arrative" | |
1417 | "RTN","PSO HLDS2",165 ,0) | |
1418 | . E S ^T MP("PSO",$ J,PSI,CNT) =FS_"Drug Warning Na rrative" | |
1419 | "RTN","PSO HLDS2",166 ,0) | |
1420 | Q | |
1421 | "RTN","PSO HLDS2",167 ,0) | |
1422 | NTE4(PSI) ;Profile i nformation | |
1423 | "RTN","PSO HLDS2",168 ,0) | |
1424 | S PSODFN= DFN N NTE4 | |
1425 | "RTN","PSO HLDS2",169 ,0) | |
1426 | I $P(PSOP AR,"^",8) D START^PS OHLDS3 | |
1427 | "RTN","PSO HLDS2",170 ,0) | |
1428 | S:$D(NTE4 ) PSI=PSI+ 1 | |
1429 | "RTN","PSO HLDS2",171 ,0) | |
1430 | Q | |
1431 | "RTN","PSO HLDS2",172 ,0) | |
1432 | NTE5(PSI) ;Drug Inte ractions | |
1433 | "RTN","PSO HLDS2",173 ,0) | |
1434 | N NTE5 D: $D(DRI) ST ART2^PSOHL DS3 | |
1435 | "RTN","PSO HLDS2",174 ,0) | |
1436 | S:$D(NTE5 ) ^TMP("PS O",$J,PSI) =NTE5_FS_" Drug Inter actions",P SI=PSI+1 | |
1437 | "RTN","PSO HLDS2",175 ,0) | |
1438 | Q | |
1439 | "RTN","PSO HLDS2",176 ,0) | |
1440 | NTE6(PSI) ;Drug Alle rgy Indica tions | |
1441 | "RTN","PSO HLDS2",177 ,0) | |
1442 | N NTE6 | |
1443 | "RTN","PSO HLDS2",178 ,0) | |
1444 | Q:'$G(DAW ) | |
1445 | "RTN","PSO HLDS2",179 ,0) | |
1446 | D START3^ PSOHLDS3 | |
1447 | "RTN","PSO HLDS2",180 ,0) | |
1448 | Q:NTE6="" | |
1449 | "RTN","PSO HLDS2",181 ,0) | |
1450 | S ^TMP("P SO",$J,PSI )=NTE6_FS_ "Drug Alle rgy Indica tions",PSI =PSI+1 | |
1451 | "RTN","PSO HLDS2",182 ,0) | |
1452 | Q | |
1453 | "RTN","PSO HLDS2",183 ,0) | |
1454 | NTE9(PSI) ;Privacy N otificatio n | |
1455 | "RTN","PSO HLDS2",184 ,0) | |
1456 | N NTE9,PS OLAN | |
1457 | "RTN","PSO HLDS2",185 ,0) | |
1458 | S NTE9="N TE"_FS_9_F S_FS,^TMP( "PSO",$J,P SI)=NTE9 | |
1459 | "RTN","PSO HLDS2",186 ,0) | |
1460 | S PSOLAN= $P($G(^PS( 55,DFN,"LA N")),"^",2 ) | |
1461 | "RTN","PSO HLDS2",187 ,0) | |
1462 | I PSOLAN' =2 D | |
1463 | "RTN","PSO HLDS2",188 ,0) | |
1464 | . S ^TMP( "PSO",$J,P SI,1)="The VA Notice of Privac y Practice s, IB 10-1 63, which outlines y our privac y rights, is availab le online at http:// DNS . URL /Health/ o r you may obtain a c opy by wri ting the V HA Privacy Office (1 9F2)," | |
1465 | "RTN","PSO HLDS2",189 ,0) | |
1466 | . S ^TMP( "PSO",$J,P SI,2)="810 Vermont A venue NW, Washington , DC 20420 ."_FS_"Pri vacy Notif ication" | |
1467 | "RTN","PSO HLDS2",190 ,0) | |
1468 | I PSOLAN= 2 D | |
1469 | "RTN","PSO HLDS2",191 ,0) | |
1470 | . S ^TMP( "PSO",$J,P SI,1)="La Notificaci on relacio nada con l as Politic as de Priv acidad del Departame nto de Asu ntos del V eterano, I B 10-163, contiene l os detalle s acerca d e sus dere chos de pr ivacidad y esta disp onsible el ectronicam ente" | |
1471 | "RTN","PSO HLDS2",192 ,0) | |
1472 | . S ^TMP( "PSO",$J,P SI,2)=" en la siguie nte direcc ion: http: // DNS . URL /Health/. Usted tamb ien puede conseguir una copia escribiend o a la Ofi cina de Pr ivacidad d el Departa mento de A suntos de Salud del Veterano, (19F2)," | |
1473 | "RTN","PSO HLDS2",193 ,0) | |
1474 | . S ^TMP( "PSO",$J,P SI,3)="810 Vermont A venue NW, Washington , DC 20420 ."_FS_"Pri vacy Notif ication" | |
1475 | "RTN","PSO HLDS2",194 ,0) | |
1476 | S PSI=PSI +1 | |
1477 | "RTN","PSO HLDS2",195 ,0) | |
1478 | Q | |
1479 | "RTN","PSO HLDS2",196 ,0) | |
1480 | ZZZ(PSI) ; ZZZ segmen t for HL7 hazardous text ;*524 | |
1481 | "RTN","PSO HLDS2",197 ,0) | |
1482 | N DRIEN,H AZD,HAZH,V AR | |
1483 | "RTN","PSO HLDS2",198 ,0) | |
1484 | S DRIEN=$ P(^PSRX(IR XN,0),"^", 6) | |
1485 | "RTN","PSO HLDS2",199 ,0) | |
1486 | S VAR=$$H AZ^PSSUTIL (DRIEN) | |
1487 | "RTN","PSO HLDS2",200 ,0) | |
1488 | S HAZH=$P (VAR,"^",1 ) | |
1489 | "RTN","PSO HLDS2",201 ,0) | |
1490 | S HAZH=$S (HAZH:"Y", 1:"N") | |
1491 | "RTN","PSO HLDS2",202 ,0) | |
1492 | S HAZD=$P (VAR,"^",2 ) | |
1493 | "RTN","PSO HLDS2",203 ,0) | |
1494 | S HAZD=$S (HAZD:"Y", 1:"N") | |
1495 | "RTN","PSO HLDS2",204 ,0) | |
1496 | S ^TMP("P SO",$J,PSI )="ZZZ"_FS _FS_FS_FS_ HAZH_FS_HA ZD | |
1497 | "RTN","PSO HLDS2",205 ,0) | |
1498 | S PSI=PSI +1 | |
1499 | "RTN","PSO HLDS2",206 ,0) | |
1500 | Q | |
1501 | "RTN","PSO OREDT") | |
1502 | 0^5^B83164 804 | |
1503 | "RTN","PSO OREDT",1,0 ) | |
1504 | PSOOREDT ; BIR/SAB - Edit order s from bac kdoor ;5/8 /08 3:27pm | |
1505 | "RTN","PSO OREDT",2,0 ) | |
1506 | ;;7.0;OUT PATIENT PH ARMACY;**4 ,20,27,37, 57,46,78,1 02,104,119 ,143,148,2 60,281,304 ,289,298,3 79,377,391 ,313,427,4 11,524**;D EC 1997;Bu ild 12 | |
1507 | "RTN","PSO OREDT",3,0 ) | |
1508 | ;External reference to ^PSDRU G( support ed by DBIA 221 | |
1509 | "RTN","PSO OREDT",4,0 ) | |
1510 | ;External reference to L^PSSL OCK suppor ted by DBI A 2789 | |
1511 | "RTN","PSO OREDT",5,0 ) | |
1512 | ;External reference to UL^PSS LOCK suppo rted by DB IA 2789 | |
1513 | "RTN","PSO OREDT",6,0 ) | |
1514 | ;External reference to PSOL^P SSLOCK sup ported by DBIA 2789 | |
1515 | "RTN","PSO OREDT",7,0 ) | |
1516 | ;External reference to PSOUL^ PSSLOCK su pported by DBIA 2789 | |
1517 | "RTN","PSO OREDT",8,0 ) | |
1518 | ;External reference to ^VA(20 0 supporte d by DBIA 10060 | |
1519 | "RTN","PSO OREDT",9,0 ) | |
1520 | SEL K PSOI SLKD,PSOLO KED S PSOP LCK=$$L^PS SLOCK(PSOD FN,0) I '$ G(PSOPLCK) D LOCK^PS OORCPY D S VAL K PSOP LCK S VALM BCK="" Q | |
1521 | "RTN","PSO OREDT",10, 0) | |
1522 | K PSOPLCK D PSOL^PS SLOCK($P(P SOLST(ORN) ,"^",2)) I '$G(PSOMS G) D UL^PS SLOCK(+$G( PSODFN)) D SVALO K P SOMSG S VA LMBCK="" Q | |
1523 | "RTN","PSO OREDT",11, 0) | |
1524 | K PSOMSG S PSOLOKED =1 | |
1525 | "RTN","PSO OREDT",12, 0) | |
1526 | N PSOHZ S PSOHZ=0 ;reset h az alert d isplayed t o user *52 4 | |
1527 | "RTN","PSO OREDT",13, 0) | |
1528 | S REF=0 S :$$LSTRFL^ PSOBPSU1($ P(PSOLST(O RN),"^",2) ) REF=1 ; *377 | |
1529 | "RTN","PSO OREDT",14, 0) | |
1530 | K PSORX(" DFLG"),DIR ,DUOUT,DIR UT S DIR(" A")="Selec t fields b y number" | |
1531 | "RTN","PSO OREDT",15, 0) | |
1532 | S DIR(0)= "LO^1:"_$S ($$STATUS^ PSOBPSUT($ P(PSOLST(O RN),"^",2) )'="":21,$ G(REF):20, 1:19) | |
1533 | "RTN","PSO OREDT",16, 0) | |
1534 | D ^DIR I $D(DIRUT) K DIR,DIRU T,DTOUT S VALMBCK="" D UL K PS OLOKED Q | |
1535 | "RTN","PSO OREDT",17, 0) | |
1536 | EDTSEL N V ALMCNT K P SOISLKD,PS ORX("DFLG" ),PSOOIFLG ,PSOMRFLG, DIR,DIRUT, DTOUT,DTOU T,ZONE S P SOQUIT=0,( PSOEDIT,PS ORXED)=1 I +Y S FST= Y D HLDHDR ^PSOLMUTL D G EX ;P SO LM SELE CT MENU pr otocol | |
1537 | "RTN","PSO OREDT",18, 0) | |
1538 | .I '$G(PS OLOKED) S PSOPLCK=$$ L^PSSLOCK( PSODFN,0) I '$G(PSOP LCK) D LOC K^PSOORCPY D SVAL K PSOPLCK S VALMBCK="" ,(PSOISLKD ,PSODE)=1 Q | |
1539 | "RTN","PSO OREDT",19, 0) | |
1540 | .I '$G(PS OLOKED) K PSOPLCK D PSOL^PSSLO CK($P(PSOL ST(ORN),"^ ",2)) I '$ G(PSOMSG) D UL^PSSLO CK(+$G(PSO DFN)) D SV ALO K PSOM SG S VALMB CK="",(PSO ISLKD,PSOD E)=1 Q | |
1541 | "RTN","PSO OREDT",20, 0) | |
1542 | .K PSOMSG ,PSOPLCK S (NEWEDT,P SOLOKED)=1 D EDT | |
1543 | "RTN","PSO OREDT",21, 0) | |
1544 | E S VALM BCK="",PSO DE=1 | |
1545 | "RTN","PSO OREDT",22, 0) | |
1546 | EX I $G(PS OISLKD)!($ G(PSOQUIT) ) D UL K P SOISLKD G EX2 | |
1547 | "RTN","PSO OREDT",23, 0) | |
1548 | I '$G(PSO SIGFL),'$G (PSORXED(" DFLG")) D UPDATE^PSO ORED6 D LO G^PSORXED, POST^PSORX ED G EX1 | |
1549 | "RTN","PSO OREDT",24, 0) | |
1550 | I $G(PSOS IGFL)=1 D Q:$G(PSOR X("FN")) | |
1551 | "RTN","PSO OREDT",25, 0) | |
1552 | .N PSOTMP | |
1553 | "RTN","PSO OREDT",26, 0) | |
1554 | .S PSOTMP =$G(PSOFRO M),PSOFROM ="NEW" | |
1555 | "RTN","PSO OREDT",27, 0) | |
1556 | .S VALMSG ="This cha nge will c reate a ne w prescrip tion!",NCP DPFLG=1 | |
1557 | "RTN","PSO OREDT",28, 0) | |
1558 | .D EN^PSO ORED1(.PSO RXED) | |
1559 | "RTN","PSO OREDT",29, 0) | |
1560 | .I $G(PSO RX("FN")) D Q | |
1561 | "RTN","PSO OREDT",30, 0) | |
1562 | ..D ^PSOB UILD | |
1563 | "RTN","PSO OREDT",31, 0) | |
1564 | ..K QUIT, PSORX("DFL G"),FST,FL D,IEN,FLN, INCOM,PSOI ,PSODRUG,P SOEDIT | |
1565 | "RTN","PSO OREDT",32, 0) | |
1566 | ..K PSORE NW,PSOSIGF L,PSOOIFLG ,PSOMRFLG, PSODIR,CHK ,PSORX("SI G"),PSODE | |
1567 | "RTN","PSO OREDT",33, 0) | |
1568 | ..K PSOTR N,PSORX("E DIT"),PSOR XED("FLD") ,NEWEDT | |
1569 | "RTN","PSO OREDT",34, 0) | |
1570 | ..S ZZEDI T=1 D EOJ^ PSONEW K Z ZEDIT | |
1571 | "RTN","PSO OREDT",35, 0) | |
1572 | ..D UL K PSOLOKED S VALMBCK=" Q" | |
1573 | "RTN","PSO OREDT",36, 0) | |
1574 | .S PSOFRO M=PSOTMP I PSOFROM=" " K PSOFRO M | |
1575 | "RTN","PSO OREDT",37, 0) | |
1576 | ; | |
1577 | "RTN","PSO OREDT",38, 0) | |
1578 | EX1 I '$G( PSODE)!('$ G(ZONE)) I $G(PSOREN W("OIRXN") ) D EN^PSO HLSN1(PSOR ENW("OIRXN "),"XX","" ,"Order ed ited") | |
1579 | "RTN","PSO OREDT",39, 0) | |
1580 | QUIT D UL K PSOLOKED D ^PSOBUI LD,ACT^PSO ORNE2 D:+^ PSRX($P(PS OLST(ORN), "^",2),"ST A")=5 EN^P SOCMOPC($P (PSOLST(OR N),"^",2)) | |
1581 | "RTN","PSO OREDT",40, 0) | |
1582 | K:'$O(^PS RX($P(PSOL ST(ORN),"^ ",2),1,0)) REF | |
1583 | "RTN","PSO OREDT",41, 0) | |
1584 | EX2 S VALM BCK=$S($G( PSOQUIT):" R",$G(PSOR X("FN")):" Q",$G(ZONE ):"Q",1:"R ") | |
1585 | "RTN","PSO OREDT",42, 0) | |
1586 | K PSORXED ,FST,FLD,I EN,FLN,INC OM,PSOI,PS ODRUG,PSOE DIT,PSOREN W,PSOSIGFL ,PSODIR,CH K,PSORX("S IG"),PSODE ,PSOTRN,PS ORX("DFLG" ),RFED,ZON E,PSORX("E DIT"),PSOO IFLG,PSOMR FLG,SIG,QU IT,PSOQUIT | |
1587 | "RTN","PSO OREDT",43, 0) | |
1588 | K NEWEDT I $G(VALMB CK)="R" W ! D CLEAN^ PSOVER1 H 2 | |
1589 | "RTN","PSO OREDT",44, 0) | |
1590 | Q | |
1591 | "RTN","PSO OREDT",45, 0) | |
1592 | ; | |
1593 | "RTN","PSO OREDT",46, 0) | |
1594 | EDT ; Rx E dit (Backd oor) | |
1595 | "RTN","PSO OREDT",47, 0) | |
1596 | K NCPDPFL G,PSOPKI,D EA | |
1597 | "RTN","PSO OREDT",48, 0) | |
1598 | S I=0 F S I=$O(^PS RX($P(PSOL ST(ORN),"^ ",2),1,I)) Q:'I S P SORXED("RX 1")=^PSRX( $P(PSOLST( ORN),"^",2 ),1,I,0) | |
1599 | "RTN","PSO OREDT",49, 0) | |
1600 | ;*298 Tra ck PI and Oth Lang P I | |
1601 | "RTN","PSO OREDT",50, 0) | |
1602 | S (RX0,PS ORXED("RX0 "))=^PSRX( $P(PSOLST( ORN),"^",2 ),0),PSORX ED("RX2")= $G(^(2)),P SORXED("RX 3")=$G(^(3 )),PSOSIG= $P(^("SIG" ),"^"),PSO PINS=$G(^( "INS")),PS OOINS=$G(^ ("INSS")) | |
1603 | "RTN","PSO OREDT",51, 0) | |
1604 | I '$D(PSO DRUG) NEW PSOY S PSO Y=$P(RX0,U ,6),PSOY(0 )=^PSDRUG( PSOY,0) D SET^PSODRG ; *298 mo ved this l ine from E DT+2 RX0 was not de fined yet | |
1605 | "RTN","PSO OREDT",52, 0) | |
1606 | F FLD=1:1 :$L(FST,", ") Q:$P(FS T,",",FLD) ']""!($G(P SORXED("DF LG")))!($G (PSORX("DF LG"))) S FLN=+$P(FS T,",",FLD) D | |
1607 | "RTN","PSO OREDT",53, 0) | |
1608 | .S PSORXE D("DFLG")= 0,(DA,PSOR XED("IRXN" ),PSORENW( "OIRXN"))= $P(PSOLST( ORN),"^",2 ),RX0=^PSR X(PSORXED( "IRXN"),0) ,PSOPKI=$P ($G(^PSRX( PSORXED("I RXN"),"PKI ")),"^") S :$G(PSOSIG )="" PSOSI G=$P(^("SI G"),"^") | |
1609 | "RTN","PSO OREDT",54, 0) | |
1610 | .;*298 Tr ack PI and Oth Lang PI | |
1611 | "RTN","PSO OREDT",55, 0) | |
1612 | .S:$G(PSO PINS)="" P SOPINS=$G( ^PSRX(DA," INS")) S:$ G(PSOOINS) ="" PSOOIN S=$G(^PSRX (DA,"INSS" )) | |
1613 | "RTN","PSO OREDT",56, 0) | |
1614 | .I '$G(PS OSIGFL) D | |
1615 | "RTN","PSO OREDT",57, 0) | |
1616 | ..S PSOI= +^PSRX(DA, "OR1"),PSO DAYS=$P(RX 0,"^",8),P SORXST=+$P ($G(^PS(53 ,$P(RX0,"^ ",3),0))," ^",7) | |
1617 | "RTN","PSO OREDT",58, 0) | |
1618 | ..I 'PSOI S PSOI=+^ PSDRUG($P( RX0,"^",6) ,2),$P(^PS RX(DA,"OR1 "),"^")=PS OI | |
1619 | "RTN","PSO OREDT",59, 0) | |
1620 | ..S:'$G(P SODRUG("IE N")) PSODR UG("IEN")= $P(RX0,"^" ,6),PSODRU G("NAME")= $P(^PSDRUG ($P(RX0,"^ ",6),0),"^ ") | |
1621 | "RTN","PSO OREDT",60, 0) | |
1622 | ..S PSODR UG("OI")=P SOI | |
1623 | "RTN","PSO OREDT",61, 0) | |
1624 | .S PSORX( "PROVIDER" )=$P(RX0," ^",4),PSOR X("PROVIDE R NAME")=$ P(^VA(200, $P(RX0,"^" ,4),0),"^" ),PSOTRN=$ G(^PSRX(DA ,"TN")) | |
1625 | "RTN","PSO OREDT",62, 0) | |
1626 | .D:'$G(CH K) POP^PSO SIGNO(DA), CHK Q:$G(P SORXED("DF LG")) | |
1627 | "RTN","PSO OREDT",63, 0) | |
1628 | .S FDR="3 9.2^"_$S($ P(PSOPAR," ^",3):"6", 1:"")_";6. 5^113^114^ 3^1^22R^24 ^8^7^9^4^1 1;"_$S($P( RX0,"^",11 )="W"&($P( PSOPAR,"^" ,12)):"35; ",1:"")_"^ 10.6^5^20^ 23^12^PSOC OU^RF^81" | |
1629 | "RTN","PSO OREDT",64, 0) | |
1630 | .; Titrat ion/Mainte nance Rx c heck | |
1631 | "RTN","PSO OREDT",65, 0) | |
1632 | .I $$REQF LDS(FST),$ $TITRX^PSO UTL($P(PSO LST(ORN)," ^",2))="t" D S PSOR XED("DFLG" )=1 Q | |
1633 | "RTN","PSO OREDT",66, 0) | |
1634 | .. S VALM SG="Cannot edit Drug /Dose fiel ds (Titrat ion Rx).", VALMBCK="R " W $C(7) | |
1635 | "RTN","PSO OREDT",67, 0) | |
1636 | .D:'$G(CH K) POP^PSO SIGNO(DA), CHK Q:$G(P SORXED("DF LG")) | |
1637 | "RTN","PSO OREDT",68, 0) | |
1638 | .S FDR="3 9.2^"_$S($ P(PSOPAR," ^",3):"6", 1:"")_";6. 5^113^114^ 3^1^22R^24 ^8^7^9^4^1 1;"_$S($P( RX0,"^",11 )="W"&($P( PSOPAR,"^" ,12)):"35; ",1:"")_"^ 10.6^5^20^ 23^12^PSOC OU^RF^81" | |
1639 | "RTN","PSO OREDT",69, 0) | |
1640 | .I $G(ST) =11!($G(ST )=12)!($G( ST)=14)!($ G(ST)=15) D NDCDAWDE ^PSOORED7( ST,FLN,$G( RXN)) Q | |
1641 | "RTN","PSO OREDT",70, 0) | |
1642 | .S REF=0 S:$$LSTRFL ^PSOBPSU1( $P(PSOLST( ORN),"^",2 )) REF=1 ;*377 | |
1643 | "RTN","PSO OREDT",71, 0) | |
1644 | .I FLN=20 ,'$G(REF) S VALMSG=" There is n o Refill D ata to be edited." Q | |
1645 | "RTN","PSO OREDT",72, 0) | |
1646 | .S DR=$P( FDR,"^",FL N) I DR="R F" D REF^P SOORED2 Q | |
1647 | "RTN","PSO OREDT",73, 0) | |
1648 | .I DR="PS OCOU" D PS OCOU^PSOOR ED6 Q | |
1649 | "RTN","PSO OREDT",74, 0) | |
1650 | .; Allow edit of th e NDC when the EDIT DRUG setti ng is off | |
1651 | "RTN","PSO OREDT",75, 0) | |
1652 | .; Other checks reg arding if the NDC ma y be edite d are foun d in NDC^P SODRG - PS O*7*427 | |
1653 | "RTN","PSO OREDT",76, 0) | |
1654 | .I FLN=2, '$P(PSOPAR ,"^",3) D Q | |
1655 | "RTN","PSO OREDT",77, 0) | |
1656 | ..N NDC D NDC^PSODR G(RXN,0,,. NDC) I $G( NDC)="^"!( $G(NDC)="" ) Q | |
1657 | "RTN","PSO OREDT",78, 0) | |
1658 | ..S (PSOD RUG("NDC") ,PSORXED(" FLD",27))= NDC | |
1659 | "RTN","PSO OREDT",79, 0) | |
1660 | .I FLN'>2 ,'$P(PSOPA R,"^",3) S VALMSG="C heck site parameters , Drug dat a is not e ditable." Q | |
1661 | "RTN","PSO OREDT",80, 0) | |
1662 | .I FLN=3 D EDTDOSE^ PSOORED2,F ULL^VALM1, POST^PSODR G S:$G(PSO RX("DFLG") ) PSOISLKD =1,PSORX(" FN")=1 Q | |
1663 | "RTN","PSO OREDT",81, 0) | |
1664 | .I FLN=4 D INS^PSOO RED1 Q | |
1665 | "RTN","PSO OREDT",82, 0) | |
1666 | .I FLN=1 D PSOI^PSO ORED6 N PS OX S PSORX ED=1,PSOX( "IRXN")=$S ($D(DA):DA ,$D(PSORXE D("IRXN")) :PSORXED(" IRXN"),$D( PSORENW("O IRXN")):PS ORENW("OIR XN")) D:'$ G(PSORXED( "DFLG")) E N^PSODIAG Q | |
1667 | "RTN","PSO OREDT",83, 0) | |
1668 | .I FLN=2 D DRG^PSOO RED6 N PSO X S PSORXE D=1,PSOX(" IRXN")=PSO RXED("IRXN ") D:'$G(P SORXED("DF LG")) EN^P SODIAG S:$ O(^PSRX(PS ORXED("IRX N"),1,0)) REF=1 Q | |
1669 | "RTN","PSO OREDT",84, 0) | |
1670 | .I FLN=12 ,PSOPKI W !!,"Digita lly Signed Order - P rovider ca n't be cha nged" D PA USE Q | |
1671 | "RTN","PSO OREDT",85, 0) | |
1672 | .I FLN=12 D PROV Q | |
1673 | "RTN","PSO OREDT",86, 0) | |
1674 | .I FLN=6 D ISDT^PSO ORED2 Q | |
1675 | "RTN","PSO OREDT",87, 0) | |
1676 | .I FLN=7 D FLDT^PSO ORED2 Q | |
1677 | "RTN","PSO OREDT",88, 0) | |
1678 | .I FLN=21 ,$$STATUS^ PSOBPSUT(R XN,0)="" S VALMSG="I nvalid sel ection!" Q | |
1679 | "RTN","PSO OREDT",89, 0) | |
1680 | .I FLN=21 D Q | |
1681 | "RTN","PSO OREDT",90, 0) | |
1682 | ..N DAW D EDTDAW^PS ODAWUT(RXN ,0,.DAW) I $G(DAW)=" ^" Q | |
1683 | "RTN","PSO OREDT",91, 0) | |
1684 | ..S (PSOD RUG("DAW") ,PSORXED(" FLD",81))= DAW | |
1685 | "RTN","PSO OREDT",92, 0) | |
1686 | .I FLN=9! (FLN=10)!( FLN=11) D NOCHG^PSOO RED7 Q | |
1687 | "RTN","PSO OREDT",93, 0) | |
1688 | .S DR=+DR | |
1689 | "RTN","PSO OREDT",94, 0) | |
1690 | .K DIR,DI RUT,DIROUT ;S DIE=52 D ^DIE I $D(Y) S PS ORXED("DFL G")=1 | |
1691 | "RTN","PSO OREDT",95, 0) | |
1692 | .K DIC,DI Q S DIC=52 ,DA=PSORXE D("IRXN"), DIQ="PSORX ED" D EN^D IQ1 K DIC, DIQ | |
1693 | "RTN","PSO OREDT",96, 0) | |
1694 | .S DIR("B ")=$S($G(P SORXED("FL D",DR))]"" :PSORXED(" FLD",DR),1 :PSORXED(5 2,DA,DR)), DIR(0)="52 ,"_DR D ^D IR | |
1695 | "RTN","PSO OREDT",97, 0) | |
1696 | .I DR=24! (DR=12) S PSORXED("F LD",DR)=X | |
1697 | "RTN","PSO OREDT",98, 0) | |
1698 | .I $D(DIR UT) K DIR, DIRUT,DUOU T,DTOUT,PS ORXED(52,D A,DR),PSOR XED("FLD", DR) Q | |
1699 | "RTN","PSO OREDT",99, 0) | |
1700 | .I DR'=5, X="@" W !, "Data Requ ired!",! K DIC,DIQ,D R,DA,DIR,D IRUT,PSORX ED(52,DA,D R),X,Y Q | |
1701 | "RTN","PSO OREDT",100 ,0) | |
1702 | .I DR=5,X '="@" S Y= +Y | |
1703 | "RTN","PSO OREDT",101 ,0) | |
1704 | .I DR=3!( DR=20)!(DR =23) S Y=+ Y | |
1705 | "RTN","PSO OREDT",102 ,0) | |
1706 | .S PSORXE D("FLD",DR )=$S(X="@" :X,1:Y) K DIR,DIRUT, DIROUT,X,Y ,PSORXED(5 2,DA,DR) | |
1707 | "RTN","PSO OREDT",103 ,0) | |
1708 | .I DR=11, PSORXED("F LD",DR)="W ",$P(PSOPA R,"^",12) D | |
1709 | "RTN","PSO OREDT",104 ,0) | |
1710 | ..D FIELD ^DID(52,DR ,"","LABEL ","ZZ") S PSORXED(ZZ ("LABEL")) =PSORXED(" FLD",DR) K ZZ | |
1711 | "RTN","PSO OREDT",105 ,0) | |
1712 | ..S DR=35 ,DIQ="PSOR XED" D EN^ DIQ1 K DIC ,DIQ,DIRUT ,DUOUT,DTO UT | |
1713 | "RTN","PSO OREDT",106 ,0) | |
1714 | ..S:$G(PS ORXED(52,D A,DR))]"" DIR("B")=P SORXED(52, DA,DR) | |
1715 | "RTN","PSO OREDT",107 ,0) | |
1716 | ..S DIR(0 )="52,"_(D R) D ^DIR I $D(DIRUT ),X'="@" K DIR,DIRUT Q | |
1717 | "RTN","PSO OREDT",108 ,0) | |
1718 | ..S PSORX ED("FLD",D R)=X K DIR ,DIRUT,DIR OUT,X,Y,PS ORXED(52,D A,DR) | |
1719 | "RTN","PSO OREDT",109 ,0) | |
1720 | .I $G(PSO RXED("FLD" ,DR))]"" D FIELD^DID (52,DR,"", "LABEL","Z Z") S PSOR XED(ZZ("LA BEL"))=PSO RXED("FLD" ,DR) K ZZ | |
1721 | "RTN","PSO OREDT",110 ,0) | |
1722 | Q:$G(PSOS IGFL) | |
1723 | "RTN","PSO OREDT",111 ,0) | |
1724 | S (RX1,I, RFD,RFDT)= 0 F S I=$ O(^PSRX(PS ORXED("IRX N"),1,I)) Q:'I S RF D=I,RFDT=$ P(^PSRX(PS ORXED("IRX N"),1,I,0) ,"^"),RX1( I)=$G(RX1( I))+1 | |
1725 | "RTN","PSO OREDT",112 ,0) | |
1726 | Q | |
1727 | "RTN","PSO OREDT",113 ,0) | |
1728 | CHK S CHK= 1 I $G(^PS DRUG($P(PS ORXED("RX0 "),"^",6), "I"))]"",^ ("I")<DT S VALMSG="T his drug h as been in activated. ",PSORXED ("DFLG")=1 Q | |
1729 | "RTN","PSO OREDT",114 ,0) | |
1730 | K PSPOP I $G(PSODIV ),$P(PSORX ED("RX2"), "^",9)'=PS OSITE S PS PRXN=PSORX ED("IRXN") D Q:PSOR XED("DFLG" ) | |
1731 | "RTN","PSO OREDT",115 ,0) | |
1732 | .I '$P(PS OSYS,"^",2 ) S VALMSG ="RX# "_$P (^PSRX(PSP RXN,0),"^" )_" is not a valid c hoice. (Di fferent Di vision)" S PSORXED(" DFLG")=1 Q | |
1733 | "RTN","PSO OREDT",116 ,0) | |
1734 | .I $P(PSO SYS,"^",3) K DIR,DUO UT,DTOUT D K DIR,DU OUT,DTOUT Q | |
1735 | "RTN","PSO OREDT",117 ,0) | |
1736 | ..W $C(7) S DIR("A" ,1)="",DIR ("A",2)="R X# "_$P(^P SRX(PSPRXN ,0),"^")_" is from a nother div ision.",DI R("A")="Co ntinue: (Y /N)",DIR(0 )="Y",DIR( "?",1)="'Y ' FOR YES" ,DIR("?")= "'N' FOR N O" | |
1737 | "RTN","PSO OREDT",118 ,0) | |
1738 | ..S DIR(" B")="N" D ^DIR I 'Y! ($D(DIRUT) ) S PSORXE D("DFLG")= 1 W ! | |
1739 | "RTN","PSO OREDT",119 ,0) | |
1740 | ; | |
1741 | "RTN","PSO OREDT",120 ,0) | |
1742 | I $P(^PSR X(PSORXED( "IRXN"),"S TA"),"^")= 16 D Q | |
1743 | "RTN","PSO OREDT",121 ,0) | |
1744 | . S PSORX ED("DFLG") =1 S VALMS G="Prescri ptions on Provider H old cannot be edited ." | |
1745 | "RTN","PSO OREDT",122 ,0) | |
1746 | ; | |
1747 | "RTN","PSO OREDT",123 ,0) | |
1748 | CHKX K PSP OP,DIR,DTO UT,DUOUT,Y ,X Q | |
1749 | "RTN","PSO OREDT",124 ,0) | |
1750 | Q | |
1751 | "RTN","PSO OREDT",125 ,0) | |
1752 | PROV ;sele ct provide r | |
1753 | "RTN","PSO OREDT",126 ,0) | |
1754 | S PSORXED ("PROVIDER ")=$P(RX0, "^",4),PSO RXED("PROV IDER NAME" )=$P(^VA(2 00,$P(RX0, "^",4),0), "^") | |
1755 | "RTN","PSO OREDT",127 ,0) | |
1756 | D PROV^PS ODIR(.PSOR XED) I PSO RXED("PROV IDER")'=$P (RX0,"^",4 ) D | |
1757 | "RTN","PSO OREDT",128 ,0) | |
1758 | .K DIR,DI RUT W ! S DIR(0)="Y" ,DIR("A",1 )="You hav e changed the name o f the prov ider enter ed for thi s Rx." | |
1759 | "RTN","PSO OREDT",129 ,0) | |
1760 | .S DIR("A ",2)="This edit will cause the provider' s name to be update for all fi lls.",DIR( "A")="Do y ou want to continue" D ^DIR | |
1761 | "RTN","PSO OREDT",130 ,0) | |
1762 | .I 'Y!$D( DIRUT) K P SORX("PROV IDER"),PSO RX("PROVID ER NAME"), PSORX("COS IGNING PRO VIDER") Q | |
1763 | "RTN","PSO OREDT",131 ,0) | |
1764 | .S PSORXE D("FLD",4) =PSORXED(" PROVIDER") K DIR,DIR UT,DUOUT | |
1765 | "RTN","PSO OREDT",132 ,0) | |
1766 | .S PSORXE D("FLD",10 9)=$G(PSOR XED("COSIG NING PROVI DER")) | |
1767 | "RTN","PSO OREDT",133 ,0) | |
1768 | Q | |
1769 | "RTN","PSO OREDT",134 ,0) | |
1770 | UDPROV ;up date provi der | |
1771 | "RTN","PSO OREDT",135 ,0) | |
1772 | S $P(^PSR X(PSORXED( "IRXN"),0) ,"^",4)=PS ORXED("PRO VIDER"),$P (^(3),"^", 3)=$G(PSOR X("COSIGNI NG PROVIDE R")) | |
1773 | "RTN","PSO OREDT",136 ,0) | |
1774 | F XTY="1" ,"P" F I=0 :0 S I=$O( ^PSRX(PSOR XED("IRXN" ),XTY,I)) Q:'I S $P (^PSRX(PSO RXED("IRXN "),XTY,I,0 ),"^",17)= PSORXED("P ROVIDER") S:XTY RFED =I | |
1775 | "RTN","PSO OREDT",137 ,0) | |
1776 | K XTY,I | |
1777 | "RTN","PSO OREDT",138 ,0) | |
1778 | Q | |
1779 | "RTN","PSO OREDT",139 ,0) | |
1780 | SIG ;edit medication instructi ons (SIG) | |
1781 | "RTN","PSO OREDT",140 ,0) | |
1782 | S PSOFDR= +$P(^PSRX( PSORXED("I RXN"),"SIG "),"^",2) I PSOFDR D | |
1783 | "RTN","PSO OREDT",141 ,0) | |
1784 | .F I=0:0 S I=$O(^PS RX(PSORXED ("IRXN")," SIG1",I)) Q:'I S SI G(I)=^PSRX (PSORXED(" IRXN"),"SI G1",I,0) | |
1785 | "RTN","PSO OREDT",142 ,0) | |
1786 | E S PSOR X("SIG")=$ P(^PSRX(PS ORXED("IRX N"),"SIG") ,"^") | |
1787 | "RTN","PSO OREDT",143 ,0) | |
1788 | D SIG^PSO DIR1(.PSOR X) D:$G(PS ORX("SIG") )]"" EN1^P SOSIGNO(PS ORXED("IRX N"),PSORX( "SIG")) | |
1789 | "RTN","PSO OREDT",144 ,0) | |
1790 | I '$G(PSO SIGFL),$G( PSORX("SIG "))]"" S ^ PSRX(PSORX ED("IRXN") ,"SIG")=PS ORX("SIG") K ^PSRX(P SORXED("IR XN"),"SIG1 ") Q | |
1791 | "RTN","PSO OREDT",145 ,0) | |
1792 | S PSOMRFL G=1 | |
1793 | "RTN","PSO OREDT",146 ,0) | |
1794 | Q | |
1795 | "RTN","PSO OREDT",147 ,0) | |
1796 | UL ; | |
1797 | "RTN","PSO OREDT",148 ,0) | |
1798 | I '$G(PSO LOKED) Q | |
1799 | "RTN","PSO OREDT",149 ,0) | |
1800 | D UL^PSSL OCK(PSODFN ) | |
1801 | "RTN","PSO OREDT",150 ,0) | |
1802 | D PSOUL^P SSLOCK($P( PSOLST(ORN ),"^",2)) | |
1803 | "RTN","PSO OREDT",151 ,0) | |
1804 | Q | |
1805 | "RTN","PSO OREDT",152 ,0) | |
1806 | SVAL ;Set message fo r patient lock | |
1807 | "RTN","PSO OREDT",153 ,0) | |
1808 | S VALMSG= $S($P($G(P SOPLCK),"^ ",2)'="":$ P($G(PSOPL CK),"^",2) _" is work ing on thi s patient. ",1:"Anoth er person is enterin g orders f or this pa tient.") | |
1809 | "RTN","PSO OREDT",154 ,0) | |
1810 | Q | |
1811 | "RTN","PSO OREDT",155 ,0) | |
1812 | SVALO ;Set message f or order l ock | |
1813 | "RTN","PSO OREDT",156 ,0) | |
1814 | S VALMSG= $S($P($G(P SOMSG),"^" ,2)'="":$P ($G(PSOMSG ),"^",2),1 :"Another person is editing th is order." ) | |
1815 | "RTN","PSO OREDT",157 ,0) | |
1816 | Q | |
1817 | "RTN","PSO OREDT",158 ,0) | |
1818 | ; | |
1819 | "RTN","PSO OREDT",159 ,0) | |
1820 | PAUSE ; | |
1821 | "RTN","PSO OREDT",160 ,0) | |
1822 | N DIR,X,Y | |
1823 | "RTN","PSO OREDT",161 ,0) | |
1824 | W ! S DIR (0)="E",DI R("A")="Pr ess Return to contin ue" D ^DIR | |
1825 | "RTN","PSO OREDT",162 ,0) | |
1826 | Q | |
1827 | "RTN","PSO OREDT",163 ,0) | |
1828 | REQFLDS(FI ELDS) ; Ch ecks if fi elds 1,2 o r 3 are be ing edited | |
1829 | "RTN","PSO OREDT",164 ,0) | |
1830 | N REQFLDS ,I | |
1831 | "RTN","PSO OREDT",165 ,0) | |
1832 | S REQFLDS =0 | |
1833 | "RTN","PSO OREDT",166 ,0) | |
1834 | F I=1:1:$ L(FIELDS) I ",1,2,3, "[(","_+$P (FIELDS,", ",I)_",") S REQFLDS= 1 Q | |
1835 | "RTN","PSO OREDT",167 ,0) | |
1836 | Q REQFLDS | |
1837 | "RTN","PSO ORNE2") | |
1838 | 0^6^B11480 7367 | |
1839 | "RTN","PSO ORNE2",1,0 ) | |
1840 | PSOORNE2 ; BIR/SAB - Display fi nished ord ers from b ackdoor ;7 /15/16 2:3 0pm | |
1841 | "RTN","PSO ORNE2",2,0 ) | |
1842 | ;;7.0;OUT PATIENT PH ARMACY;**1 1,21,23,27 ,32,37,46, 84,103,117 ,131,146,1 56,210,148 ,222,238,2 64,281,289 ,251,379,3 91,313,282 ,427,454,4 46,467,524 **;DEC 199 7;Build 12 | |
1843 | "RTN","PSO ORNE2",3,0 ) | |
1844 | ; | |
1845 | "RTN","PSO ORNE2",4,0 ) | |
1846 | ;^PSDRUG( - 221 | |
1847 | "RTN","PSO ORNE2",5,0 ) | |
1848 | ;^YSCL(60 3.01 - 269 7 | |
1849 | "RTN","PSO ORNE2",6,0 ) | |
1850 | ;^PS(50.6 06 - 2174 | |
1851 | "RTN","PSO ORNE2",7,0 ) | |
1852 | ;^PS(50.7 - 2223 | |
1853 | "RTN","PSO ORNE2",8,0 ) | |
1854 | ;PSO*210 add call t o WORDWRAP api | |
1855 | "RTN","PSO ORNE2",9,0 ) | |
1856 | ;$$DAWEXT ^PSSDAWUT - 4708 | |
1857 | "RTN","PSO ORNE2",10, 0) | |
1858 | ; | |
1859 | "RTN","PSO ORNE2",11, 0) | |
1860 | ;*524 cre ate and in it psohz; user has s een Haz dr ug warning during th is order's session | |
1861 | "RTN","PSO ORNE2",12, 0) | |
1862 | ;*530 pre vent parti al fills ( PR) | |
1863 | "RTN","PSO ORNE2",13, 0) | |
1864 | ; | |
1865 | "RTN","PSO ORNE2",14, 0) | |
1866 | SEL N ORN, ORD,PSORRB LD I '$G(P SOCNT),'$G (PSORCNT) S VALMSG=" This patie nt has no Prescripti ons!" S VA LMBCK="" Q | |
1867 | "RTN","PSO ORNE2",15, 0) | |
1868 | D K1^PSOO RNE6 S DIR ("A")="Sel ect Orders by number ",DIR(0)=" LO^1:"_$S( $G(PSORCNT ):PSORCNT, 1:PSOCNT) D ^DIR I $ D(DIRUT) D KV^PSOVER 1 S VALMBC K="" Q | |
1869 | "RTN","PSO ORNE2",16, 0) | |
1870 | NEWSEL N O RN,ORD D K 2^PSOORNE6 | |
1871 | "RTN","PSO ORNE2",17, 0) | |
1872 | N PSOHZ,P SOLSTDR S (PSOHZ,PSO LSTDR)=0 ;reset haz alerts di splayed to user *524 | |
1873 | "RTN","PSO ORNE2",18, 0) | |
1874 | ;*282 Cor rect Patie nt Instruc tions Copy | |
1875 | "RTN","PSO ORNE2",19, 0) | |
1876 | I +Y S PS OOELSE=1,P SLST=Y K P SOREEDT F ORD=1:1:$L (PSLST,"," ) Q:$P(PSL ST,",",ORD )']"" D D UL1 K ^T MP("PSORXP O",$J),PSO RXED,PSONE W,PSOPINS I $G(PSOQU IT) K PSOQ UIT Q | |
1877 | "RTN","PSO ORNE2",20, 0) | |
1878 | .; bwf 1/ 21/2014 - replaced l ine below with the o ne that fo llows for remote rx data handl ing. | |
1879 | "RTN","PSO ORNE2",21, 0) | |
1880 | .;S ORN=+ $P(PSLST," ,",ORD) D @$S(+PSOLS T(ORN)=52: "ACT",1:"P EN^PSOORNE 5") | |
1881 | "RTN","PSO ORNE2",22, 0) | |
1882 | .S ORN=+$ P(PSLST,", ",ORD) D @ $S(+PSOLST (ORN)=52:" ACT",$P(PS OLST(ORN), "^")="R52" :"RACT",1: "PEN^PSOOR NE5") | |
1883 | "RTN","PSO ORNE2",23, 0) | |
1884 | .K PSOREE DT,PSOSIGF L,PSONACT, SIGOK,PSOF DR,DRET,SI G,INS1 | |
1885 | "RTN","PSO ORNE2",24, 0) | |
1886 | K PRC,PHI ,RTE I '$G (PSOOELSE) S VALMBCK ="" | |
1887 | "RTN","PSO ORNE2",25, 0) | |
1888 | K PSONACT ,PSOOELSE, CLOZPAT | |
1889 | "RTN","PSO ORNE2",26, 0) | |
1890 | ; | |
1891 | "RTN","PSO ORNE2",27, 0) | |
1892 | ; Only re build remo te if some thing chan ged | |
1893 | "RTN","PSO ORNE2",28, 0) | |
1894 | I $G(PSOR RBLD) W !! ,"Updating prescript ion order list...",! ! D REMOTE RX^PSORRX1 (PSODFN,PS OSITE) K P SORRBLD | |
1895 | "RTN","PSO ORNE2",29, 0) | |
1896 | ; | |
1897 | "RTN","PSO ORNE2",30, 0) | |
1898 | D ^PSOBUI LD,BLD^PSO ORUT1,K3^P SOORNE6 | |
1899 | "RTN","PSO ORNE2",31, 0) | |
1900 | Q | |
1901 | "RTN","PSO ORNE2",32, 0) | |
1902 | ; | |
1903 | "RTN","PSO ORNE2",33, 0) | |
1904 | ACT N REF, RPHKEY,PKI ND K ^TMP( "PSOAO",$J ),PCOMX,PD A,PHI,PRC, ACOM,ANS,P SOFDR,CLOZ PAT,ANQREM ,DUR,DRET | |
1905 | "RTN","PSO ORNE2",34, 0) | |
1906 | S RXN=$P( PSOLST(ORN ),"^",2),R X0=^PSRX(R XN,0),RX2= $G(^(2)),R X3=$G(^(3) ),ST=+$G(^ ("STA")),R XOR=$G(^(" OR1")),POE =$G(^("POE ")),EXDT=$ S($P($G(^( 2)),"^",6) >DT:1,1:0) | |
1907 | "RTN","PSO ORNE2",35, 0) | |
1908 | I 'RX3 S $P(RX3,"^" ,1)=$P(RX2 ,"^",2),$P (^PSRX(RXN ,3),"^")=$ P(RX2,"^", 2) | |
1909 | "RTN","PSO ORNE2",36, 0) | |
1910 | S PSODRG= +$P(RX0,"^ ",6),PSODR UG0=^PSDRU G(PSODRG,0 ),INDT=$G( ^("I")) | |
1911 | "RTN","PSO ORNE2",37, 0) | |
1912 | ;PSO*7*23 8;SET PSOD RUG ARRAY ; PSOY KIL LED AT END OF SET^PS ODRG | |
1913 | "RTN","PSO ORNE2",38, 0) | |
1914 | K PSODRUG | |
1915 | "RTN","PSO ORNE2",39, 0) | |
1916 | S PSOY=PS ODRG,PSOY( 0)=PSODRUG 0 D SET^PS ODRG | |
1917 | "RTN","PSO ORNE2",40, 0) | |
1918 | I 'RXOR,$ P(^PSDRUG( PSODRG,2), "^") S $P( ^PSRX(RXN, "OR1"),"^" )=$P(^PSDR UG(PSODRG, 2),"^"),RX OR=$P(^PSD RUG(PSODRG ,2),"^") | |
1919 | "RTN","PSO ORNE2",41, 0) | |
1920 | I $P($G(^ PSDRUG(PSO DRG,"CLOZ1 ")),"^")=" PSOCLO1" D | |
1921 | "RTN","PSO ORNE2",42, 0) | |
1922 | .S CLOZPA T=$O(^YSCL (603.01,"C ",PSODFN,0 )) Q:'CLOZ PAT | |
1923 | "RTN","PSO ORNE2",43, 0) | |
1924 | .;S CLOZP AT=$S($P(^ YSCL(603.0 1,CLOZPAT, 0),"^",3)= "B":1,1:0) | |
1925 | "RTN","PSO ORNE2",44, 0) | |
1926 | .S CLOZPA T=$P(^YSCL (603.01,CL OZPAT,0)," ^",3) | |
1927 | "RTN","PSO ORNE2",45, 0) | |
1928 | .S CLOZPA T=$S(CLOZP AT="M":2,C LOZPAT="B" :1,1:0) | |
1929 | "RTN","PSO ORNE2",46, 0) | |
1930 | S PKIND=$ D(^PSRX(RX N,"PKI")), RPHKEY=$S( 'PKIND&($D (^XUSEC("P SORPH",DUZ ))):1,PKIN D&($D(^XUS EC("PSDRPH ",DUZ))):1 ,1:0) | |
1931 | "RTN","PSO ORNE2",47, 0) | |
1932 | I RPHKEY S RPH=1 D | |
1933 | "RTN","PSO ORNE2",48, 0) | |
1934 | .S PSOACT =$S('ST&($ G(INDT)]"" )&(DT>$G(I NDT)):"DHP LATC",ST=1 !(ST=4):"D VE",ST=3:" DU",ST=5:" ELTD",ST=1 1:"ETDPCL" ,ST=12&EXD T:"EDCL",S T=12&'EXDT :"ECL",(ST =14!(ST=15 ))&'EXDT:" ECL",ST=13 :"L",ST=16 :"DL",1:"D HPEATCL") | |
1935 | "RTN","PSO ORNE2",49, 0) | |
1936 | .D GET^PS OORNE5 S P SOACT=PSOA CT_$S(ACTR EN:"N",1:" "),PSOACT= PSOACT_$S( ACTREF:"R" ,1:"") | |
1937 | "RTN","PSO ORNE2",50, 0) | |
1938 | .I ST=5 S SURX=$O(^ PS(52.5,"B ",RXN,0)) I SURX,$P( $G(^PS(52. 5,SURX,0)) ,"^",7)="L " S PSOACT ="TL" K SU RX Q | |
1939 | "RTN","PSO ORNE2",51, 0) | |
1940 | .S:ST'=12 &('$D(^PS( 50.7,+$P(R XOR,"^"),0 ))) PSOACT ="DL",VALM SG="No Pha rmacy Orde rable Item !",PSONAC T=1 | |
1941 | "RTN","PSO ORNE2",52, 0) | |
1942 | .S:ST=12& ('$D(^PS(5 0.7,+$P(RX OR,"^"),0) )) PSOACT= "L",VALMSG ="No Pharm acy Ordera ble Item ! ",PSONACT= 1 | |
1943 | "RTN","PSO ORNE2",53, 0) | |
1944 | .S:ST=16 VALMSG="Rx Placed on HOLD by P rovider." | |
1945 | "RTN","PSO ORNE2",54, 0) | |
1946 | E D | |
1947 | "RTN","PSO ORNE2",55, 0) | |
1948 | .I ST=5 S SURX=$O(^ PS(52.5,"B ",RXN,0)) I SURX,$P( $G(^PS(52. 5,SURX,0)) ,"^",7)="L " S PSOACT ="TL" Q | |
1949 | "RTN","PSO ORNE2",56, 0) | |
1950 | .S PSOACT =$S(ST'<1& (ST'>4)!(S T>12):"",S T=12&EXDT& ($P($G(PSO PAR),"^",2 )):"CDPLT" ,1:"CPLT") | |
1951 | "RTN","PSO ORNE2",57, 0) | |
1952 | .D GET^PS OORNE5 S P SOACT=PSOA CT_$S(ACTR EN:"N",1:" "),PSOACT= PSOACT_$S( ACTREF:"R" ,1:"") | |
1953 | "RTN","PSO ORNE2",58, 0) | |
1954 | .S:'$D(^P S(50.7,+$P (RXOR,"^") ,0)) PSOAC T="L",PSON ACT=1,VALM SG="No Pha rmacy Orde rable Item !" | |
1955 | "RTN","PSO ORNE2",59, 0) | |
1956 | ;K PSOLKF L D PSOL^P SSLOCK(RXN ) I '$G(PS OMSG) K PS OMSG S PSO LKFL=1 S P SOACT="",V ALMSG="Thi s Order is being edi ted by ano ther user. " | |
1957 | "RTN","PSO ORNE2",60, 0) | |
1958 | K PSOMSG S IEN=0,$P (RN," ",12 )=" " | |
1959 | "RTN","PSO ORNE2",61, 0) | |
1960 | D DIN^PSO NFI(+RXOR, $P(RX0,"^" ,6)) | |
1961 | "RTN","PSO ORNE2",62, 0) | |
1962 | ; pso*7*4 67 - add d isplay of erx inform ation if t he rx came from eRx | |
1963 | "RTN","PSO ORNE2",63, 0) | |
1964 | N ERXIEN | |
1965 | "RTN","PSO ORNE2",64, 0) | |
1966 | I $P(RXOR ,U,2)]"" D | |
1967 | "RTN","PSO ORNE2",65, 0) | |
1968 | .S ERXIEN =$$CHKERX^ PSOERXU1($ P(RXOR,U,2 )) I ERXIE N D DERX1^ PSOERXU1($ NA(^TMP("P SOAO",$J)) ,ERXIEN,"" ,.IEN) | |
1969 | "RTN","PSO ORNE2",66, 0) | |
1970 | ; pso*7*4 67 - end e Rx enhance ment | |
1971 | "RTN","PSO ORNE2",67, 0) | |
1972 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=$S($ P($G(^PSRX (RXN,"TPB" )),"^"):" TPB Rx #: ",1:" Rx #: ") | |
1973 | "RTN","PSO ORNE2",68, 0) | |
1974 | S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_$ P(RX0,"^") _$S($G(^PS RX(RXN,"IB ")):"$",1: "")_$$ECME ^PSOBPSUT( RXN)_$$TIT RX^PSOUTL( RXN)_$E(RN ,$L($P(RX0 ,"^")_$S($ G(^PSRX(RX N,"IB")):" $",1:"")_$ $ECME^PSOB PSUT(RXN)_ $$TITRX^PS OUTL(RXN)) +1,12) | |
1975 | "RTN","PSO ORNE2",69, 0) | |
1976 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (" _$S($P(PSO PAR,"^",3) :1,1:"#")_ ")"_" *Ord erable Ite m: "_$S($D (^PS(50.7, $P(+RXOR," ^"),0)):$P (^PS(50.7, $P(+RXOR," ^"),0),"^" )_" "_$P(^ PS(50.606, $P(^(0),"^ ",2),0),"^ "),1:"")_N FIO | |
1977 | "RTN","PSO ORNE2",70, 0) | |
1978 | S:NFIO["< DIN>" NFIO =IEN_","_( $L(^TMP("P SOAO",$J,I EN,0))-4) | |
1979 | "RTN","PSO ORNE2",71, 0) | |
1980 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (" _$S($P(PSO PAR,"^",3) :2,1:"#")_ ")"_$S($D( ^PSDRUG("A Q",$P(RX0, "^",6))):" CMO P ",1:" " )_"Drug: " _$P(^PSDRU G($P(RX0," ^",6),0)," ^")_NFID | |
1981 | "RTN","PSO ORNE2",72, 0) | |
1982 | S:NFID["< DIN>" NFID =IEN_","_( $L(^TMP("P SOAO",$J,I EN,0))-4) | |
1983 | "RTN","PSO ORNE2",73, 0) | |
1984 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" "_ $S('$P(PSO PAR,"^",3) :"(2)",1:" ")_" NDC: "_$$G ETNDC^PSON DCUT(RXN,0 ) | |
1985 | "RTN","PSO ORNE2",74, 0) | |
1986 | S:$G(^PSR X(RXN,"TN" ))]"" IEN= IEN+1,^TMP ("PSOAO",$ J,IEN,0)=" Trade Name : "_$G(^PS RX(RXN,"TN ")) | |
1987 | "RTN","PSO ORNE2",75, 0) | |
1988 | D DOSE^PS OORNE5 | |
1989 | "RTN","PSO ORNE2",76, 0) | |
1990 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (4 )Pat Instr uctions:" D INS^PSOO RNE5 | |
1991 | "RTN","PSO ORNE2",77, 0) | |
1992 | D PC^PSOO RNE5 | |
1993 | "RTN","PSO ORNE2",78, 0) | |
1994 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" SIG:" | |
1995 | "RTN","PSO ORNE2",79, 0) | |
1996 | I '$P($G( ^PSRX(RXN, "SIG")),"^ ",2) S SIG OK=0 D G PTST | |
1997 | "RTN","PSO ORNE2",80, 0) | |
1998 | .S X=$P($ G(^PSRX(RX N,"SIG")), "^") D SIG ONE^PSOHEL P S SIG=$E ($G(INS1), 2,250) | |
1999 | "RTN","PSO ORNE2",81, 0) | |
2000 | .F SG=1:1 :$L(SIG) S :$L(^TMP(" PSOAO",$J, IEN,0)_" " _$P(SIG," ",SG))>80 IEN=IEN+1, $P(^TMP("P SOAO",$J,I EN,0)," ", 21)=" " S: $P(SIG," " ,SG)'="" ^ TMP("PSOAO ",$J,IEN,0 )=$G(^TMP( "PSOAO",$J ,IEN,0))_" "_$P(SIG, " ",SG) | |
2001 | "RTN","PSO ORNE2",82, 0) | |
2002 | S SIGOK=1 | |
2003 | "RTN","PSO ORNE2",83, 0) | |
2004 | F I=0:0 S I=$O(^PSR X(RXN,"SIG 1",I)) Q:' I D ;PSO*210 | |
2005 | "RTN","PSO ORNE2",84, 0) | |
2006 | . S MIG=$ P(^PSRX(RX N,"SIG1",I ,0),"^") | |
2007 | "RTN","PSO ORNE2",85, 0) | |
2008 | . D WORDW RAP^PSOUTL A2(MIG,.IE N,$NA(^TMP ("PSOAO",$ J)),21) | |
2009 | "RTN","PSO ORNE2",86, 0) | |
2010 | S SIGOK=1 K MIG,SG | |
2011 | "RTN","PSO ORNE2",87, 0) | |
2012 | PTST S $P( RN," ",25) =" ",PTST= $S($G(^PS( 53,+$P(RX0 ,"^",3),0) )]"":$P($G (^PS(53,+$ P(RX0,"^", 3),0)),"^" ),1:""),IE N=IEN+1 | |
2013 | "RTN","PSO ORNE2",88, 0) | |
2014 | S ^TMP("P SOAO",$J,I EN,0)=" (5 ) Patient Status: " _PTST_$E(R N,$L(PTST) +1,25) | |
2015 | "RTN","PSO ORNE2",89, 0) | |
2016 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (6 ) Iss ue Date: " _$E($P(RX0 ,"^",13),4 ,5)_"/"_$E ($P(RX0,"^ ",13),6,7) _"/"_$E($P (RX0,"^",1 3),2,3) | |
2017 | "RTN","PSO ORNE2",90, 0) | |
2018 | S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_" (7) Fill Date: "_$E($P(R X2,"^",2), 4,5)_"/"_$ E($P(RX2," ^",2),6,7) _"/"_$E($P (RX2,"^",2 ),2,3) | |
2019 | "RTN","PSO ORNE2",91, 0) | |
2020 | S ROU=$S( $P(RX0,"^" ,11)="W":" Window",1: "Mail") | |
2021 | "RTN","PSO ORNE2",92, 0) | |
2022 | S REFL=$P (RX0,"^",9 ),I=0 F S I=$O(^PSR X(RXN,1,I) ) Q:'I S REFL=REFL- 1,ROU=$S($ P(^PSRX(RX N,1,I,0)," ^",2)="W": "Window",1 :"Mail") | |
2023 | "RTN","PSO ORNE2",93, 0) | |
2024 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" Last Fi ll Date: " _$E($P(RX3 ,"^"),4,5) _"/"_$E($P (RX3,"^"), 6,7)_"/"_$ E($P(RX3," ^"),2,3) | |
2025 | "RTN","PSO ORNE2",94, 0) | |
2026 | D CMOP^PS OORNE3 | |
2027 | "RTN","PSO ORNE2",95, 0) | |
2028 | S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_" ("_ROU_$S ($G(PSOCMO P)]"":", " _PSOCMOP,1 :"")_")" K ROU,PSOCM OP | |
2029 | "RTN","PSO ORNE2",96, 0) | |
2030 | ;*282 Cor rect retur n to stock /release d isplay | |
2031 | "RTN","PSO ORNE2",97, 0) | |
2032 | S IEN=IEN +1 D | |
2033 | "RTN","PSO ORNE2",98, 0) | |
2034 | .S RLD=$S ($P(RX2,"^ ",13):$E($ P(RX2,"^", 13),4,5)_" /"_$E($P(R X2,"^",13) ,6,7)_"/"_ $E($P(RX2, "^",13),2, 3),1:"") | |
2035 | "RTN","PSO ORNE2",99, 0) | |
2036 | .I $O(^PS RX(RXN,1,0 )) F I=0:0 S I=$O(^P SRX(RXN,1, I)) Q:'I D | |
2037 | "RTN","PSO ORNE2",100 ,0) | |
2038 | ..I $P(^P SRX(RXN,1, I,0),"^",1 8) S RLD=$ E($P(^(0), "^",18),4, 5)_"/"_$E( $P(^(0),"^ ",18),6,7) _"/"_$E($P (^(0),"^", 18),2,3) | |
2039 | "RTN","PSO ORNE2",101 ,0) | |
2040 | .I $P(RX2 ,"^",15)&' $G(RLD) S ^TMP("PSOA O",$J,IEN, 0)=" Ret urned to S tock: "_$E ($P(RX2,"^ ",15),4,5) _"/"_$E($P (RX2,"^",1 5),6,7)_"/ "_$E($P(RX 2,"^",15), 2,3)_$S($P (RX2,"^",1 4):" (Repr inted)",1: "") | |
2041 | "RTN","PSO ORNE2",102 ,0) | |
2042 | .E S ^TM P("PSOAO", $J,IEN,0)= " Last R elease Dat e: "_$S($G (RLD)]"":R LD,1:" ") | |
2043 | "RTN","PSO ORNE2",103 ,0) | |
2044 | S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_" (8) Lot #: "_$P($G(R X2),"^",4) | |
2045 | "RTN","PSO ORNE2",104 ,0) | |
2046 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" Expires: " _$E($P(RX2 ,"^",6),4, 5)_"/"_$E( $P(RX2,"^" ,6),6,7)_" /"_$E($P(R X2,"^",6), 2,3) | |
2047 | "RTN","PSO ORNE2",105 ,0) | |
2048 | S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_" MFG: "_$P($G(R X2),"^",8) | |
2049 | "RTN","PSO ORNE2",106 ,0) | |
2050 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(9) Days Supply: " _$P(RX0,"^ ",8)_$S($L ($P(RX0,"^ ",8))=1:" ",1:"") | |
2051 | "RTN","PSO ORNE2",107 ,0) | |
2052 | S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_" (10) QTY" _$S($P($G( ^PSDRUG($P (RX0,"^",6 ),660)),"^ ",8)]"":" ("_$P($G(^ PSDRUG($P( RX0,"^",6) ,660)),"^" ,8)_")",1: " ( )")_" : "_$P(RX0 ,"^",7) | |
2053 | "RTN","PSO ORNE2",108 ,0) | |
2054 | I $P($G(^ PSDRUG($P( RX0,"^",6) ,5)),"^")] "" D | |
2055 | "RTN","PSO ORNE2",109 ,0) | |
2056 | .S $P(RN, " ",79)=" ",IEN=IEN+ 1 | |
2057 | "RTN","PSO ORNE2",110 ,0) | |
2058 | .S ^TMP(" PSOAO",$J, IEN,0)=$E( RN,$L("QTY DSP MSG: "_$P(^PSDR UG($P(RX0, "^",6),5), "^"))+1,79 )_"QTY DSP MSG: "_$P (^PSDRUG($ P(RX0,"^", 6),5),"^") K RN | |
2059 | "RTN","PSO ORNE2",111 ,0) | |
2060 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(11 ) # of Refills: " _$P(RX0,"^ ",9)_$S($L ($P(RX0,"^ ",9))=1:" ",1:"")_" Remai ning: "_RE FL | |
2061 | "RTN","PSO ORNE2",112 ,0) | |
2062 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(12 ) P rovider: " _$S($D(^VA (200,$P(RX 0,"^",4),0 )):$P(^VA( 200,$P(RX0 ,"^",4),0) ,"^"),1:"U NKNOWN") | |
2063 | "RTN","PSO ORNE2",113 ,0) | |
2064 | I +$P($G( ^PSDRUG($P (RX0,"^",6 ),0)),"^", 3)>1,+$P($ G(^PSDRUG( $P(RX0,"^" ,6),0)),"^ ",3)<6 D P RV^PSOORNE 5 | |
2065 | "RTN","PSO ORNE2",114 ,0) | |
2066 | I $P(RX3, "^",3) S I EN=IEN+1,^ TMP("PSOAO ",$J,IEN,0 )=" Cos-Provi der: "_$P( ^VA(200,$S ($G(PSORX( "COSIGNING PROVIDER" )):PSORX(" COSIGNING PROVIDER") ,1:$P(RX3, "^",3)),0) ,"^") | |
2067 | "RTN","PSO ORNE2",115 ,0) | |
2068 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(13 ) Routing: " _$S($P(RX0 ,"^",11)=" M":"MAIL", 1:"WINDOW" )_" (14) Copies: "_ $S($P(RX0, "^",18):$P (RX0,"^",1 8),1:1) | |
2069 | "RTN","PSO ORNE2",116 ,0) | |
2070 | S:$P(RX0, "^",11)="W "&($P(PSOP AR,"^",12) ) IEN=IEN+ 1,^TMP("PS OAO",$J,IE N,0)=" Method of Pickup: "_ $G(^PSRX(R XN,"MP")) | |
2071 | "RTN","PSO ORNE2",117 ,0) | |
2072 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(15 ) Clinic: " _$S($D(^SC (+$P(RX0," ^",5),0)): $P(^SC($P( RX0,"^",5) ,0),"^"),1 :"Not on F ile") | |
2073 | "RTN","PSO ORNE2",118 ,0) | |
2074 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(16 ) D ivision: " _$S($G(^PS (59,+$P(RX 2,"^",9),0 ))]"":$P(^ PS(59,$P(R X2,"^",9), 0),"^")_" ("_$P(^(0) ,"^",6)_") ",1:"UNKNO WN") | |
2075 | "RTN","PSO ORNE2",119 ,0) | |
2076 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(17 ) Pha rmacist: " _$S($P(RX2 ,"^",3):$P (^VA(200,$ P(RX2,"^", 3),0),"^") ,1:"") | |
2077 | "RTN","PSO ORNE2",120 ,0) | |
2078 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(18 ) Remarks:" D RMK^PSOO RNE3 | |
2079 | "RTN","PSO ORNE2",121 ,0) | |
2080 | S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(19 ) Cou nseling: " _$S($P($G( ^PSRX(RXN, "PC")),"^" ):"YES",1: "NO")_" " _$S($P($G( ^PSRX(RXN, "PC")),"^" ):"Was Cou nseling Un derstood: "_$S($P($G (^PSRX(RXN ,"PC")),"^ ",2):"YES" ,1:"NO"),1 :"") | |
2081 | "RTN","PSO ORNE2",122 ,0) | |
2082 | S:$O(^PSR X(RXN,1,0) ) REF=1,IE N=IEN+1,^T MP("PSOAO" ,$J,IEN,0) ="(20) Refill Da ta" | |
2083 | "RTN","PSO ORNE2",123 ,0) | |
2084 | I $$STATU S^PSOBPSUT (RXN,0)'=" " D | |
2085 | "RTN","PSO ORNE2",124 ,0) | |
2086 | . N DAW S IEN=IEN+1 ,DAW=$$GET DAW^PSODAW UT(RXN,0) | |
2087 | "RTN","PSO ORNE2",125 ,0) | |
2088 | . S ^TMP( "PSOAO",$J ,IEN,0)="( 21) DAW Code: "_DAW_" - "_$$DAWEX T^PSSDAWUT (DAW) | |
2089 | "RTN","PSO ORNE2",126 ,0) | |
2090 | D DISP^PS OORNE6 | |
2091 | "RTN","PSO ORNE2",127 ,0) | |
2092 | I $G(PSOB EDT),PSOAC T["E" S PS OACT="E" | |
2093 | "RTN","PSO ORNE2",128 ,0) | |
2094 | I $G(PSOB EDT),PSOAC T'["E" S P SOACT="" | |
2095 | "RTN","PSO ORNE2",129 ,0) | |
2096 | Q:$G(PSOR XED)!($G(C OPY))!($G( UPMI)) | |
2097 | "RTN","PSO ORNE2",130 ,0) | |
2098 | S:$G(PSOB EDT) (PSOE DIT,PSORXE D)=1 | |
2099 | "RTN","PSO ORNE2",131 ,0) | |
2100 | RENERR S P SORERR=0 D ^PSOLMLST | |
2101 | "RTN","PSO ORNE2",132 ,0) | |
2102 | I PSORERR =1 S:$G(PS OBEDT) (PS OEDIT,PSOR XED)=1 G R ENERR | |
2103 | "RTN","PSO ORNE2",133 ,0) | |
2104 | K DRET,SI G | |
2105 | "RTN","PSO ORNE2",134 ,0) | |
2106 | Q | |
2107 | "RTN","PSO ORNE2",135 ,0) | |
2108 | UL1 ; | |
2109 | "RTN","PSO ORNE2",136 ,0) | |
2110 | Q | |
2111 | "RTN","PSO ORNE2",137 ,0) | |
2112 | ; bwf 1/2 1/2014 - a dding disp lay of rem ote active orders. | |
2113 | "RTN","PSO ORNE2",138 ,0) | |
2114 | RACT ; dis play remot e active o rder | |
2115 | "RTN","PSO ORNE2",139 ,0) | |
2116 | N REMSITE ,CNT,REMDA TA,RSITENM ,RRXNUM,RD ETSTR,RSIG STR,RDET,R SIG,REMSIE N,RXSTAT,S IGLOOP,DET LOOP,DONE, SRXSTAT,SD NAME,DNAME | |
2117 | "RTN","PSO ORNE2",140 ,0) | |
2118 | K ^TMP("P SOAO",$J) | |
2119 | "RTN","PSO ORNE2",141 ,0) | |
2120 | S (RSIG,R DET)="" | |
2121 | "RTN","PSO ORNE2",142 ,0) | |
2122 | S REMSITE =$P(PSOLST (ORN),U,4) Q:'REMSIT E | |
2123 | "RTN","PSO ORNE2",143 ,0) | |
2124 | S REMSIEN =$O(^DIC(4 ,"D",REMSI TE,"")) | |
2125 | "RTN","PSO ORNE2",144 ,0) | |
2126 | S REMSIEN =$$FIND1^D IC(4,,"X", REMSITE,"D ","I $P(^( 0),U,11)=" "N"",'$P($ G(^(99)),U ,4)") Q:'R EMSIEN | |
2127 | "RTN","PSO ORNE2",145 ,0) | |
2128 | S RSITENM =$$GET1^DI Q(4,REMSIE N,.01,"E") | |
2129 | "RTN","PSO ORNE2",146 ,0) | |
2130 | ; do not continue i f we are m issing the remote or der number for some reason | |
2131 | "RTN","PSO ORNE2",147 ,0) | |
2132 | S RRXNUM= $P(PSOLST( ORN),U,2) Q:'RRXNUM | |
2133 | "RTN","PSO ORNE2",148 ,0) | |
2134 | S DONE=0 | |
2135 | "RTN","PSO ORNE2",149 ,0) | |
2136 | S RXSTAT= "" F S RX STAT=$O(^X TMP("PSORR X1",$J,PSO DFN,REMSIT E,RXSTAT)) Q:RXSTAT= ""!DONE D | |
2137 | "RTN","PSO ORNE2",150 ,0) | |
2138 | .S SRXSTA T=RXSTAT | |
2139 | "RTN","PSO ORNE2",151 ,0) | |
2140 | .S DNAME= "" F S DN AME=$O(^XT MP("PSORRX 1",$J,PSOD FN,REMSITE ,RXSTAT,DN AME)) Q:DN AME=""!DON E D | |
2141 | "RTN","PSO ORNE2",152 ,0) | |
2142 | ..S SDNAM E=DNAME | |
2143 | "RTN","PSO ORNE2",153 ,0) | |
2144 | ..I $P(^X TMP("PSORR X1",$J,PSO DFN,REMSIT E,RXSTAT,D NAME,0),U, 1)=RRXNUM S DONE=1 Q | |
2145 | "RTN","PSO ORNE2",154 ,0) | |
2146 | Q:$G(SRXS TAT)="" | |
2147 | "RTN","PSO ORNE2",155 ,0) | |
2148 | S REMDATA =$G(^XTMP( "PSORRX1", $J,PSODFN, REMSITE,SR XSTAT,SDNA ME,0)) | |
2149 | "RTN","PSO ORNE2",156 ,0) | |
2150 | S RDETSTR =$G(^XTMP( "PSORRX1", $J,PSODFN, REMSITE,SR XSTAT,SDNA ME,"DETAIL ")) | |
2151 | "RTN","PSO ORNE2",157 ,0) | |
2152 | S RSIGSTR =$G(^XTMP( "PSORRX1", $J,PSODFN, REMSITE,SR XSTAT,SDNA ME,"SIG")) | |
2153 | "RTN","PSO ORNE2",158 ,0) | |
2154 | S CNT=1 | |
2155 | "RTN","PSO ORNE2",159 ,0) | |
2156 | S ^TMP("P SOAO",$J,C NT,0)=" Site #: "_REMS ITE_"("_RS ITENM_")", CNT=CNT+1 | |
2157 | "RTN","PSO ORNE2",160 ,0) | |
2158 | S ^TMP("P SOAO",$J,C NT,0)=" Rx #: "_RRXN UM,CNT=CNT +1 | |
2159 | "RTN","PSO ORNE2",161 ,0) | |
2160 | S ^TMP("P SOAO",$J,C NT,0)=" Drug Na me: "_$P(R EMDATA,U,1 1),CNT=CNT +1 | |
2161 | "RTN","PSO ORNE2",162 ,0) | |
2162 | S ^TMP("P SOAO",$J,C NT,0)=" Days Supp ly: "_$S($ E($P(REMDA TA,U,4),1) ?1A:$E($P( REMDATA,U, 4),2,99),1 :$P(REMDAT A,U,4)),CN T=CNT+1 | |
2163 | "RTN","PSO ORNE2",163 ,0) | |
2164 | S ^TMP("P SOAO",$J,C NT,0)=" Quanti ty: "_$P(R EMDATA,U,2 ),CNT=CNT+ 1 | |
2165 | "RTN","PSO ORNE2",164 ,0) | |
2166 | S ^TMP("P SOAO",$J,C NT,0)=" Refil ls: "_$P(R EMDATA,U,3 ),CNT=CNT+ 1 | |
2167 | "RTN","PSO ORNE2",165 ,0) | |
2168 | S ^TMP("P SOAO",$J,C NT,0)="Exp iration Da te: "_$$RD T($P($P(RE MDATA,U,5) ,".")),CNT =CNT+1 | |
2169 | "RTN","PSO ORNE2",166 ,0) | |
2170 | S ^TMP("P SOAO",$J,C NT,0)=" Issue Da te: "_$$RD T($P($P(RE MDATA,U,6) ,".")),CNT =CNT+1 | |
2171 | "RTN","PSO ORNE2",167 ,0) | |
2172 | S ^TMP("P SOAO",$J,C NT,0)=" Stop Da te: "_$$RD T($P($P(RE MDATA,U,7) ,".")),CNT =CNT+1 | |
2173 | "RTN","PSO ORNE2",168 ,0) | |
2174 | S ^TMP("P SOAO",$J,C NT,0)=" La st Fill Da te: "_$$RD T($P($P(RE MDATA,U,8) ,".")),CNT =CNT+1 | |
2175 | "RTN","PSO ORNE2",169 ,0) | |
2176 | ;D RCHUNK (.RDET,RDE TSTR),RCHU NK(.RSIG,R SIGSTR) | |
2177 | "RTN","PSO ORNE2",170 ,0) | |
2178 | ;S ^TMP(" PSOAO",$J, CNT,0)=" Det ail: "_$G( RDET(1)),C NT=CNT+1 | |
2179 | "RTN","PSO ORNE2",171 ,0) | |
2180 | ;S DETLOO P=1 F S D ETLOOP=$O( RDET(DETLO OP)) Q:'DE TLOOP D | |
2181 | "RTN","PSO ORNE2",172 ,0) | |
2182 | ;.S ^TMP( "PSOAO",$J ,CNT,0)=" "_RDET (DETLOOP), CNT=CNT+1 | |
2183 | "RTN","PSO ORNE2",173 ,0) | |
2184 | D RCHUNK( .RSIG,RSIG STR) | |
2185 | "RTN","PSO ORNE2",174 ,0) | |
2186 | S ^TMP("P SOAO",$J,C NT,0)=" S ig: "_$G(R SIG(1)) | |
2187 | "RTN","PSO ORNE2",175 ,0) | |
2188 | S SIGLOOP =1 F S SI GLOOP=$O(R SIG(SIGLOO P)) Q:'SIG LOOP D | |
2189 | "RTN","PSO ORNE2",176 ,0) | |
2190 | .S CNT=CN T+1,^TMP(" PSOAO",$J, CNT,0)=" "_RSIG( SIGLOOP) | |
2191 | "RTN","PSO ORNE2",177 ,0) | |
2192 | ; ^PSOLML ST is the local orde r template | |
2193 | "RTN","PSO ORNE2",178 ,0) | |
2194 | D EN^PSOR OS | |
2195 | "RTN","PSO ORNE2",179 ,0) | |
2196 | Q | |
2197 | "RTN","PSO ORNE2",180 ,0) | |
2198 | RCHUNK(ARR ,STR) ; | |
2199 | "RTN","PSO ORNE2",181 ,0) | |
2200 | N START,E ND,I,C,ROO M | |
2201 | "RTN","PSO ORNE2",182 ,0) | |
2202 | S ROOM=60 | |
2203 | "RTN","PSO ORNE2",183 ,0) | |
2204 | ; if ther e is enoug h room for 1 line, n o wrapping needed | |
2205 | "RTN","PSO ORNE2",184 ,0) | |
2206 | I $L(STR) '>ROOM S A RR(1)=STR Q | |
2207 | "RTN","PSO ORNE2",185 ,0) | |
2208 | ; add a s pace to th e end of t he string to avoid d ropping la st charact er | |
2209 | "RTN","PSO ORNE2",186 ,0) | |
2210 | S START=1 ,END=ROOM, STR=STR_" " | |
2211 | "RTN","PSO ORNE2",187 ,0) | |
2212 | F C=1:1 D Q:$L(STR )<START ; stop if w e have mad e it to th e end of t he data st ring | |
2213 | "RTN","PSO ORNE2",188 ,0) | |
2214 | .; start at the end and work backwards until you find a bla nk space, cut the li ne there a nd move on to the ne xt line | |
2215 | "RTN","PSO ORNE2",189 ,0) | |
2216 | .F I=END: -1:START I $E(STR,I) =" " S ARR (C)=$E(STR ,START,I), START=I+1, END=ROOM+S TART Q | |
2217 | "RTN","PSO ORNE2",190 ,0) | |
2218 | .; make s ure there wasn't a r eally long string wi thout spac es | |
2219 | "RTN","PSO ORNE2",191 ,0) | |
2220 | .I I=STAR T S ARR(C) =$E(STR,ST ART,END),S TART=END+1 ,END=ROOM+ START | |
2221 | "RTN","PSO ORNE2",192 ,0) | |
2222 | Q | |
2223 | "RTN","PSO ORNE2",193 ,0) | |
2224 | RDT(DATE) ; | |
2225 | "RTN","PSO ORNE2",194 ,0) | |
2226 | N Y,M,D | |
2227 | "RTN","PSO ORNE2",195 ,0) | |
2228 | S Y=$E(DA TE,3,4),M= $E(DATE,5, 6),D=$E(DA TE,7,8) | |
2229 | "RTN","PSO ORNE2",196 ,0) | |
2230 | Q M_"/"_D _"/"_Y | |
2231 | "VER") | |
2232 | 8.0^22.2 | |
2233 | **END** | |
2234 | **END** |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.