← Back to branch summary

~ov+server/openvista-server/mainline

« back to all changes in this revision

Viewing changes to kids/PSJ_50_1505_2.KID

  • Committer: Derek Veit
  • Date: 2011-03-03 22:17:39 UTC
  • Revision ID: derek.veit@medsphere.com-20110303221739-10953epfz01xeach
OpenVista 1.5 Service Pack 6

Installed the following builds (in order):

PSB*3.0*1501
MSCPS340B*0.9*1
MSCIC*7.0*1501
MSCIC*7.0*1500
MSCCPTUPDATE*1.0*3
MSCCPT2010UPDATE*1.0*3
GMRA*4.0*1501
PSJ*5.0*1502
LR*5.2*1502
OR*3.0*1504
LR*5.2*1503
MSCVISIT070210*1.0*2
GMRA*4.0*1500
PSJ*5.0*1503
OR*3.0*1505
GMRV*5.0*1500
LR*5.2*1504
XU*8.0*1501
JAOPS*1.0*1500
OR*3.0*1504
PSJ*5.0*1504
OR*3.0*1506
MSCVISIT070210*1.0*3
MSCRM*1.1*3
PSS*1.0*1500
OR*3.0*1507
LR*5.2*1505
OR*3.0*1504
XT*7.3*1500
LR*5.2*1506
OR*3.0*1509
PSJ*5.0*1505
XU*8.0*1502
XU*8.0*1503
PSJ*5.0*1505
OR*3.0*1510
PSS*1.0*1501
PS*1.0*1500
MSCH*1.0*1501
MSCIC*7.0*1502
MSCPS*1.0*1500
PS*1.0*1500
XU*8.0*478
XU*8.0*1504
PSJ*5.0*1506
GMRA*4.0*1503
MSCPHMPR*1.0*2
RA*5.0*1503
LA*5.2*1500
MSCRXP*1.5*10
MSCIC*7.0*1503
OR*3.0*1508
ZMSCMFN*1.0*1
TIU*1.0*1500
MSCH*1.0*1503
PSJ*5.0*1507
MSCHL*1.0*1500
MSCO*1.5*1506

From these files:

PSB_30_1501.KID
MSCPS340B_0_9_1.KID
MSCIC_70_1501_3.KID
MSCIC_70_1500.KID
MSCCPT2010UPDATE02.KID
MSCCPT2010UPDATE03.KID
GMRA_40_1501.KID
PSJ_50_1502.KID
LR_52_1502.KID
OR_30_1504_3.KID
LR_52_1503.KID
MSCVISIT070210.KID
GMRA_4_1500A.KID
PSJ_50_1503.KID
OR_30_1505_2.KID
GMRV1500A.KID
LR_52_1504.KID
XU_80_1501.KID
JAOPS_1_1500.KID
OR_30_1504_4.KID
PSJ_50_1504.KID
OR3_1506.KID
MSCVISIT070210_3.KID
MSCRMPD1_1_3.KID
PSS_1_1500.KID
OR_3_1507.KID
LR_52_1505.KID
OR_30_1504_5.KID
XT7_3_1500.KID
LR_52_1506.KID
OR_3_1509.KID
PSJ_50_1505.KID
XU_80_1502.KID
XU_80_1503.KID
PSJ_50_1505_2.KID
OR_30_1510.KID
PSS_10_1501.KID
PS_10_1500.KID
MSCH_10_1501.KID
MSCIC_70_1502.KID
MSCPS_1_1500.KID
PS_10_1500_2.KID
xu-8_seq-395_pat-478.kid
XU_80_1504.KID
PSJ_5_1506_2.KID
GMRA_4_1503.KID
MSCPHMPR1002.KID
RA_50_1503.KID
LA_52_1500.KID
MSCRXP_10.KID
MSCIC_7_1503_2.KID
OR_3_1508.KID
ZMSCMFN_1.0_1.KID
TIU_10_1500.KID
MSCH_1_1503.KID
PSJ_5_1507.KID
MSCHL_1_1500_2.KID
MSCO_15_1506.KID

After all KIDS builds were installed, ^ZTMGRSET and ^ZUSET were run.

Show diffs side-by-side

added added

removed removed

Lines of Context:
kids/PSJ_50_1505_2.KID
 
1
KIDS Distribution saved on Sep 17, 2010@09:03:04
 
2
10570
 
3
**KIDS**:PSJ*5.0*1505^
 
4
 
 
5
**INSTALL NAME**
 
6
PSJ*5.0*1505
 
7
"BLD",7191,0)
 
8
PSJ*5.0*1505^^0^3100917^n
 
9
"BLD",7191,1,0)
 
10
^^1^1^3080108^^
 
11
"BLD",7191,1,1,0)
 
12
Pyxis/Omnicell interface
 
13
"BLD",7191,4,0)
 
14
^9.64PA^^0
 
15
"BLD",7191,6.3)
 
16
15
 
17
"BLD",7191,"KRN",0)
 
18
^9.67PA^8989.52^19
 
19
"BLD",7191,"KRN",.4,0)
 
20
.4
 
21
"BLD",7191,"KRN",.4,"NM",0)
 
22
^9.68A^^
 
23
"BLD",7191,"KRN",.401,0)
 
24
.401
 
25
"BLD",7191,"KRN",.402,0)
 
26
.402
 
27
"BLD",7191,"KRN",.402,"NM",0)
 
28
^9.68A^^0
 
29
"BLD",7191,"KRN",.403,0)
 
30
.403
 
31
"BLD",7191,"KRN",.5,0)
 
32
.5
 
33
"BLD",7191,"KRN",.84,0)
 
34
.84
 
35
"BLD",7191,"KRN",3.6,0)
 
36
3.6
 
37
"BLD",7191,"KRN",3.8,0)
 
38
3.8
 
39
"BLD",7191,"KRN",9.2,0)
 
40
9.2
 
41
"BLD",7191,"KRN",9.8,0)
 
42
9.8
 
43
"BLD",7191,"KRN",9.8,"NM",0)
 
44
^9.68A^5^3
 
45
"BLD",7191,"KRN",9.8,"NM",3,0)
 
46
PSJHLU^^0^B14183304
 
47
"BLD",7191,"KRN",9.8,"NM",4,0)
 
48
MSCPSRXE^^0^B29380734
 
49
"BLD",7191,"KRN",9.8,"NM",5,0)
 
50
MSCPSRX1^^0^B70514414
 
51
"BLD",7191,"KRN",9.8,"NM","B","MSCPSRX1",5)
 
52
 
 
53
"BLD",7191,"KRN",9.8,"NM","B","MSCPSRXE",4)
 
54
 
 
55
"BLD",7191,"KRN",9.8,"NM","B","PSJHLU",3)
 
56
 
 
57
"BLD",7191,"KRN",19,0)
 
58
19
 
59
"BLD",7191,"KRN",19,"NM",0)
 
60
^9.68A^^0
 
61
"BLD",7191,"KRN",19.1,0)
 
62
19.1
 
63
"BLD",7191,"KRN",19.1,"NM",0)
 
64
^9.68A^^
 
65
"BLD",7191,"KRN",101,0)
 
66
101
 
67
"BLD",7191,"KRN",101,"NM",0)
 
68
^9.68A^^0
 
69
"BLD",7191,"KRN",409.61,0)
 
70
409.61
 
71
"BLD",7191,"KRN",409.61,"NM",0)
 
72
^9.68A^^
 
73
"BLD",7191,"KRN",771,0)
 
74
771
 
75
"BLD",7191,"KRN",771,"NM",0)
 
76
^9.68A^^0
 
77
"BLD",7191,"KRN",870,0)
 
78
870
 
79
"BLD",7191,"KRN",870,"NM",0)
 
80
^9.68A^^0
 
81
"BLD",7191,"KRN",8989.51,0)
 
82
8989.51
 
83
"BLD",7191,"KRN",8989.51,"NM",0)
 
84
^9.68A^^0
 
85
"BLD",7191,"KRN",8989.52,0)
 
86
8989.52
 
87
"BLD",7191,"KRN",8994,0)
 
88
8994
 
89
"BLD",7191,"KRN","B",.4,.4)
 
90
 
 
91
"BLD",7191,"KRN","B",.401,.401)
 
92
 
 
93
"BLD",7191,"KRN","B",.402,.402)
 
94
 
 
95
"BLD",7191,"KRN","B",.403,.403)
 
96
 
 
97
"BLD",7191,"KRN","B",.5,.5)
 
98
 
 
99
"BLD",7191,"KRN","B",.84,.84)
 
100
 
 
101
"BLD",7191,"KRN","B",3.6,3.6)
 
102
 
 
103
"BLD",7191,"KRN","B",3.8,3.8)
 
104
 
 
105
"BLD",7191,"KRN","B",9.2,9.2)
 
106
 
 
107
"BLD",7191,"KRN","B",9.8,9.8)
 
108
 
 
109
"BLD",7191,"KRN","B",19,19)
 
110
 
 
111
"BLD",7191,"KRN","B",19.1,19.1)
 
112
 
 
113
"BLD",7191,"KRN","B",101,101)
 
114
 
 
115
"BLD",7191,"KRN","B",409.61,409.61)
 
116
 
 
117
"BLD",7191,"KRN","B",771,771)
 
118
 
 
119
"BLD",7191,"KRN","B",870,870)
 
120
 
 
121
"BLD",7191,"KRN","B",8989.51,8989.51)
 
122
 
 
123
"BLD",7191,"KRN","B",8989.52,8989.52)
 
124
 
 
125
"BLD",7191,"KRN","B",8994,8994)
 
126
 
 
127
"BLD",7191,"MSC")
 
128
C:\TEMP\PSJ_50_1505.KID
 
129
"BLD",7191,"MSCOM")
 
130
10570
 
131
"BLD",7191,"QUES",0)
 
132
^9.62^^
 
133
"BLD",7191,"REQB",0)
 
134
^9.611^^0
 
135
"MBREQ")
 
136
0
 
137
"QUES","XPF1",0)
 
138
Y
 
139
"QUES","XPF1","??")
 
140
^D REP^XPDH
 
141
"QUES","XPF1","A")
 
142
Shall I write over your |FLAG| File
 
143
"QUES","XPF1","B")
 
144
YES
 
145
"QUES","XPF1","M")
 
146
D XPF1^XPDIQ
 
147
"QUES","XPF2",0)
 
148
Y
 
149
"QUES","XPF2","??")
 
150
^D DTA^XPDH
 
151
"QUES","XPF2","A")
 
152
Want my data |FLAG| yours
 
153
"QUES","XPF2","B")
 
154
YES
 
155
"QUES","XPF2","M")
 
156
D XPF2^XPDIQ
 
157
"QUES","XPI1",0)
 
158
YO
 
159
"QUES","XPI1","??")
 
160
^D INHIBIT^XPDH
 
161
"QUES","XPI1","A")
 
162
Want KIDS to INHIBIT LOGONs during the install
 
163
"QUES","XPI1","B")
 
164
NO
 
165
"QUES","XPI1","M")
 
166
D XPI1^XPDIQ
 
167
"QUES","XPM1",0)
 
168
PO^VA(200,:EM
 
169
"QUES","XPM1","??")
 
170
^D MG^XPDH
 
171
"QUES","XPM1","A")
 
172
Enter the Coordinator for Mail Group '|FLAG|'
 
173
"QUES","XPM1","B")
 
174
 
 
175
"QUES","XPM1","M")
 
176
D XPM1^XPDIQ
 
177
"QUES","XPO1",0)
 
178
Y
 
179
"QUES","XPO1","??")
 
180
^D MENU^XPDH
 
181
"QUES","XPO1","A")
 
182
Want KIDS to Rebuild Menu Trees Upon Completion of Install
 
183
"QUES","XPO1","B")
 
184
NO
 
185
"QUES","XPO1","M")
 
186
D XPO1^XPDIQ
 
187
"QUES","XPZ1",0)
 
188
Y
 
189
"QUES","XPZ1","??")
 
190
^D OPT^XPDH
 
191
"QUES","XPZ1","A")
 
192
Want to DISABLE Scheduled Options, Menu Options, and Protocols
 
193
"QUES","XPZ1","B")
 
194
NO
 
195
"QUES","XPZ1","M")
 
196
D XPZ1^XPDIQ
 
197
"QUES","XPZ2",0)
 
198
Y
 
199
"QUES","XPZ2","??")
 
200
^D RTN^XPDH
 
201
"QUES","XPZ2","A")
 
202
Want to MOVE routines to other CPUs
 
203
"QUES","XPZ2","B")
 
204
NO
 
205
"QUES","XPZ2","M")
 
206
D XPZ2^XPDIQ
 
207
"RTN")
 
208
3
 
209
"RTN","MSCPSRX1")
 
210
0^5^B70514414
 
211
"RTN","MSCPSRX1",1,0)
 
212
MSCPSRX1 ;MSC/GFT - Continuation of Building outgoing RXE msgs when order is processed by pharmacy;16-Sep-2010 19:51;MH
 
213
"RTN","MSCPSRX1",2,0)
 
214
 ;;5.0;INPATIENT MEDICATIONS;**1504,1505**;March 26,2007
 
215
"RTN","MSCPSRX1",3,0)
 
216
 ;
 
217
"RTN","MSCPSRX1",4,0)
 
218
 ;
 
219
"RTN","MSCPSRX1",5,0)
 
220
RXO ; pharmacy prescription order segment (used to send Orderable Item to O
 
221
"RTN","MSCPSRX1",6,0)
 
222
 N FIELD,RXOCT
 
223
"RTN","MSCPSRX1",7,0)
 
224
 S LIMIT=17 X PSJCLEAR
 
225
"RTN","MSCPSRX1",8,0)
 
226
 S FIELD(0)="RXO"
 
227
"RTN","MSCPSRX1",9,0)
 
228
 S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)"))
 
229
"RTN","MSCPSRX1",10,0)
 
230
 S OINODE=$G(@(PSJORDER_".2)"))
 
231
"RTN","MSCPSRX1",11,0)
 
232
 S SPDIEN=+$P(OINODE,"^"),DOSEOR=$P(OINODE,"^",2),DOSE=$P(OINODE,"^",5),UNIT=$P(OINODE,"^",6)
 
233
"RTN","MSCPSRX1",12,0)
 
234
 ;If only local doses exist, create the dose and units from the doseform
 
235
"RTN","MSCPSRX1",13,0)
 
236
 I DOSE="" S DOSE=$P(DOSEOR," ",1),UNIT=$P(DOSEOR," ",2)
 
237
"RTN","MSCPSRX1",14,0)
 
238
 S FIELD(1)=$S(SPDIEN=0:"^",1:SPDIEN_"^")
 
239
"RTN","MSCPSRX1",15,0)
 
240
 I SPDIEN S DOSEFORM=$P($G(^PS(50.7,SPDIEN,0)),"^",2),NAME=$P($G(^PS(50.606,+DOSEFORM,0)),"^"),FIELD(1)=FIELD(1)_$P($G(^PS(50.7,SPDIEN,0)),"^")_" "_NAME
 
241
"RTN","MSCPSRX1",16,0)
 
242
 S FIELD(1)=FIELD(1)_"^L"
 
243
"RTN","MSCPSRX1",17,0)
 
244
 N DURNOD S DURNOD=$G(@(PSJORDER_"2.5)")) I $P(DURNOD,"^",4)]""
 
245
"RTN","MSCPSRX1",18,0)
 
246
 S $P(FIELD(1),"^",3)=$P(DURNOD,"^",4)
 
247
"RTN","MSCPSRX1",19,0)
 
248
 S FIELD(2)=DOSE
 
249
"RTN","MSCPSRX1",20,0)
 
250
 S FIELD(4)=UNIT
 
251
"RTN","MSCPSRX1",21,0)
 
252
 D SEGMENT(LIMIT)
 
253
"RTN","MSCPSRX1",22,0)
 
254
 S CNT=CNT+1
 
255
"RTN","MSCPSRX1",23,0)
 
256
 S ORMSG(CNT)=SEGMENT
 
257
"RTN","MSCPSRX1",24,0)
 
258
 S RXOCT=CNT
 
259
"RTN","MSCPSRX1",25,0)
 
260
 ;
 
261
"RTN","MSCPSRX1",26,0)
 
262
 ; pharmacy encoded order segment
 
263
"RTN","MSCPSRX1",27,0)
 
264
RXE1 N FIELD,NDC,NDC2,ADMCODE,NDNODE,SPDIEN,PRODNAME,DDNUM,DDIEN,CNT1,UNITS,AMT
 
265
"RTN","MSCPSRX1",28,0)
 
266
 S (UNITS,NDNODE,SPDIEN,PRODNAME,DDNUM,DDIEN,CNT1)="",LIMIT=26 X PSJCLEAR
 
267
"RTN","MSCPSRX1",29,0)
 
268
 S FIELD(0)="RXE"
 
269
"RTN","MSCPSRX1",30,0)
 
270
 I RXORDER["V" D IVRXE Q
 
271
"RTN","MSCPSRX1",31,0)
 
272
 I RXORDER["P",IVTYPE="F" D IVRXE Q
 
273
"RTN","MSCPSRX1",32,0)
 
274
 I RXORDER["P",$P(NODE1,"^",4)="H" D IVRXE Q
 
275
"RTN","MSCPSRX1",33,0)
 
276
 N RENEW S RENEW=$$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER)
 
277
"RTN","MSCPSRX1",34,0)
 
278
 S PSGPLS=$S($G(PSJEXPOE):$P(NODE2,"^",2),RENEW>$P(NODE2,"^",2):RENEW,1:$P(NODE2,"^",2))
 
279
"RTN","MSCPSRX1",35,0)
 
280
 S PSGPLF=$S($G(PSJEXPOE):PSJEXPOE,1:$P(NODE2,"^",4))
 
281
"RTN","MSCPSRX1",36,0)
 
282
 ;S FIELD(1)="^"_$P(NODE2,"^")_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"_$P(NODE2,"^",5)
 
283
"RTN","MSCPSRX1",37,0)
 
284
 S $P(NODE2,"^",5)=$TR($P(NODE2,"^",5),"-",",")
 
285
"RTN","MSCPSRX1",38,0)
 
286
 S FIELD(1)="^"_$P(NODE2,"^")_"&"_$P(NODE2,"^",5)_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"
 
287
"RTN","MSCPSRX1",39,0)
 
288
 ;commented out since this data is redundant
 
289
"RTN","MSCPSRX1",40,0)
 
290
 ;S FIELD(21)="^"_$P(NODE2,"^",5)_"^L^^^"
 
291
"RTN","MSCPSRX1",41,0)
 
292
 I ($G(DOSEOR)']"")!($O(@(PSJORDER_"1,"" "")"),-1)=1) D
 
293
"RTN","MSCPSRX1",42,0)
 
294
 .S (CNT1,DDNUM)=0 F  S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM  Q:CNT1=1  S DDIEN=+$G(@(PSJORDER_"1,"_DDNUM_",0)")) D
 
295
"RTN","MSCPSRX1",43,0)
 
296
 ..S AMT=$S($P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2)="":"1",1:$P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2))_"&"_FIELD(1)
 
297
"RTN","MSCPSRX1",44,0)
 
298
 ..S FIELD(1)=DOSE_"&"_UNIT_"&"_AMT,$P(FIELD(1),"^",8)=$S($G(DOSEOR)]"":$G(DOSEOR),1:DOSE_UNIT)
 
299
"RTN","MSCPSRX1",45,0)
 
300
 ..S:$P(FIELD(1),"^",8)="" $P(FIELD(1),"^",8)=$G(@(PSJORDER_".3)"))
 
301
"RTN","MSCPSRX1",46,0)
 
302
 ..S FIELD(3)=DOSE
 
303
"RTN","MSCPSRX1",47,0)
 
304
 ..;Get the NDF code for the drug number to send
 
305
"RTN","MSCPSRX1",48,0)
 
306
 .. S NDNODE=$G(^PSDRUG(DDIEN,"ND"))
 
307
"RTN","MSCPSRX1",49,0)
 
308
 .. S NDC=$G(^PSDRUG(DDIEN,2))
 
309
"RTN","MSCPSRX1",50,0)
 
310
 .. S NDC2=$P($G(^PSDRUG(DDIEN,2)),U,4)
 
311
"RTN","MSCPSRX1",51,0)
 
312
 .. S ADMCODE=$P($G(^PSDRUG(DDIEN,21400)),U,2)
 
313
"RTN","MSCPSRX1",52,0)
 
314
 .. I ADMCODE="" S MSCMSG="No ADM code; message cannot be sent. Drug "_$P(^PSDRUG(DDIEN,0),U,1)
 
315
"RTN","MSCPSRX1",53,0)
 
316
 ..;S PRODNAME=$S($G(^PSNDF(+NDNODE,5,+$P(NDNODE,"^",3),0))]"":^(0),1:"N/A")
 
317
"RTN","MSCPSRX1",54,0)
 
318
 ..;S PRODNAME=$S($T(^PSNAPIS)]"":$$PROD0^PSNAPIS(+NDNODE,$P(NDNODE,"^",3)),$G(^PSNDF(+NDNODE,5,+$P(NDNODE,"^",3),0))]"":^(0),1:"N/A")
 
319
"RTN","MSCPSRX1",55,0)
 
320
 ..S PRODNAME=NDC2 S:PRODNAME="" PRODNAME="N/A"
 
321
"RTN","MSCPSRX1",56,0)
 
322
 ..;S FIELD(2)=$S(PRODNAME="N/A":"^^",1:+NDNODE_"."_+$P(NDNODE,"^",3)_"^"_$P(NDNODE,"^",2)_"^"_"99NDF")_"^"_DDIEN_"^"_$P($G(^PSDRUG(DDIEN,0)),"^")_"^"_"99PSD"
 
323
"RTN","MSCPSRX1",57,0)
 
324
 ..S FIELD(2)=ADMCODE_"^"_$P($G(^PSDRUG(DDIEN,0)),"^")_"^L^"_PRODNAME_"^"_$P(NDNODE,"^",2)_"^NDC"
 
325
"RTN","MSCPSRX1",58,0)
 
326
 ..S $P(ORMSG(CNT),"|",2)=FIELD(2)
 
327
"RTN","MSCPSRX1",59,0)
 
328
 ..;"_DDIEN_"^"_$P($G(^PSDRUG(DDIEN,0)),"^")_"^"_"L"
 
329
"RTN","MSCPSRX1",60,0)
 
330
 ..S UNITS=$S(PRODNAME="N/A":"N/A",1:$S($T(^PSNAPIS)]"":$P($$DFSU^PSNAPIS(+NDNODE,$P(NDNODE,"^",3)),"^",5),1:$P($G(^PSNDF(+NDNODE,2,+$P(PRODNAME,"^",2),3,+$P(PRODNAME,"^",3),4,+$P(PRODNAME,"^",4),0)),"^")))
 
331
"RTN","MSCPSRX1",61,0)
 
332
 ..;S FIELD(5)=UNITS_"^"_$P($G(^PS(50.607,UNITS,0)),"^")_"^L"
 
333
"RTN","MSCPSRX1",62,0)
 
334
 ..S FIELD(5)=UNIT
 
335
"RTN","MSCPSRX1",63,0)
 
336
 ..S FIELD(6)=$G(DOSEFORM)_"^"_$P($G(^PS(50.606,+$G(DOSEFORM),0)),"^")_"^L"
 
337
"RTN","MSCPSRX1",64,0)
 
338
 ..S FIELD(25)=$$EN^PSSUTIL1(DDIEN),FIELD(26)=$P(FIELD(25),"|",2),FIELD(25)=$P(FIELD(25),"|")
 
339
"RTN","MSCPSRX1",65,0)
 
340
 ..I $D(PSGSI) S FIELD(22)=PSGSI
 
341
"RTN","MSCPSRX1",66,0)
 
342
 ..S CNT=CNT+1
 
343
"RTN","MSCPSRX1",67,0)
 
344
 E  S $P(FIELD(1),"^",8)=DOSEOR
 
345
"RTN","MSCPSRX1",68,0)
 
346
 I SYSTYP="p" S $P(ORMSG(4),"|",8)=FIELD(1)
 
347
"RTN","MSCPSRX1",69,0)
 
348
 ;S NAME=$$PROV^MSCHLUTL(DUZ),FIELD(14)=NAME
 
349
"RTN","MSCPSRX1",70,0)
 
350
 S NAME=$P($G(^VA(200,DUZ,0)),"^"),FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
 
351
"RTN","MSCPSRX1",71,0)
 
352
 D SEGMENT(LIMIT)
 
353
"RTN","MSCPSRX1",72,0)
 
354
 S CNT=CNT+1
 
355
"RTN","MSCPSRX1",73,0)
 
356
 S ORMSG(CNT)=SEGMENT
 
357
"RTN","MSCPSRX1",74,0)
 
358
 K SEGMENT S JJ=0 F  S JJ=$O(@(PSJORDER_"12,"_JJ_")")) Q:'JJ  S SEGMENT(JJ-1)=$G(@(PSJORDER_"12,"_JJ_",0)"))
 
359
"RTN","MSCPSRX1",75,0)
 
360
 I $D(SEGMENT(0)) S CNT=CNT+1,ORMSG(CNT)="NTE|6|L|"_SEGMENT(0)
 
361
"RTN","MSCPSRX1",76,0)
 
362
 K SEGMENT,JJ
 
363
"RTN","MSCPSRX1",77,0)
 
364
 I $P($G(@(PSJORDER_"6)")),"^")]"" K SEGMENT S SEGMENT(0)="NTE|21|L|"_$P($G(@(PSJORDER_"6)")),"^") K SEGMENT
 
365
"RTN","MSCPSRX1",78,0)
 
366
 I PSJORDER["P",$P($G(@(PSJORDER_"9)")),"^",2)]"" S CNT=CNT+1 S ORMSG(CNT)="NTE|21|L|"_$P($G(@(PSJORDER_"9)")),"^",2)
 
367
"RTN","MSCPSRX1",79,0)
 
368
 Q
 
369
"RTN","MSCPSRX1",80,0)
 
370
 ;
 
371
"RTN","MSCPSRX1",81,0)
 
372
IVRXE ; RXE segment for IV orders
 
373
"RTN","MSCPSRX1",82,0)
 
374
 ; if it's an Inpatient Med IV order, send the RXE with dispense drug
 
375
"RTN","MSCPSRX1",83,0)
 
376
 ; information.  If it's an IV FLUID order, send just the start/stop
 
377
"RTN","MSCPSRX1",84,0)
 
378
 ; date, duration in the RXE and send an RXC for each additive and
 
379
"RTN","MSCPSRX1",85,0)
 
380
 ; solution.
 
381
"RTN","MSCPSRX1",86,0)
 
382
 N ADSNODE
 
383
"RTN","MSCPSRX1",87,0)
 
384
 I RXORDER["V" S PSGPLS=$P(NODE1,"^",2),PSGPLF=$P(NODE1,"^",3)
 
385
"RTN","MSCPSRX1",88,0)
 
386
 E  S PSGPLS=$P(NODE2,"^",2),PSGPLF=$P(NODE2,"^",4)
 
387
"RTN","MSCPSRX1",89,0)
 
388
 ;S FIELD(1)="^"_$S(PSJORDER["IV":$P(NODE1,"^",9),1:$P(NODE2,"^"))_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)
 
389
"RTN","MSCPSRX1",90,0)
 
390
 S $P(NODE2,"^",5)=$TR($P(NODE1,"^",11),"-",",")
 
391
"RTN","MSCPSRX1",91,0)
 
392
 S $P(NODE1,"^",11)=$TR($P(NODE1,"^",11),"-",",")
 
393
"RTN","MSCPSRX1",92,0)
 
394
 S FIELD(1)="^"_$S(PSJORDER["IV":$P(NODE1,"^",9),1:$P(NODE2,"^"))_"&"_$P(NODE1,"^",11)_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)
 
395
"RTN","MSCPSRX1",93,0)
 
396
 ;S FIELD(1)="^"_$P(NODE2,"^")_"&"_$P(NODE2,"^",5)_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"
 
397
"RTN","MSCPSRX1",94,0)
 
398
 I $P(FIELD(1),"^",2)="" S $P(FIELD(1),"^",2)="IV"
 
399
"RTN","MSCPSRX1",95,0)
 
400
 S FIELD(21)="^"_$S(PSJORDER["IV":$P(NODE1,"^",11),1:$P(NODE2,"^",5))_"^L^^^"
 
401
"RTN","MSCPSRX1",96,0)
 
402
 ;S NAME=$$PROV^MSCHLUTL(DUZ),FIELD(14)=NAME
 
403
"RTN","MSCPSRX1",97,0)
 
404
 S NAME=$P($G(^VA(200,DUZ,0)),"^")
 
405
"RTN","MSCPSRX1",98,0)
 
406
 S FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
 
407
"RTN","MSCPSRX1",99,0)
 
408
 N X,Y
 
409
"RTN","MSCPSRX1",100,0)
 
410
 I RXORDER["V" S INFUSE=$P(NODE1,"^",8)
 
411
"RTN","MSCPSRX1",101,0)
 
412
 E  S INFUSE=$P($G(@(PSJORDER_"8)")),"^",5)
 
413
"RTN","MSCPSRX1",102,0)
 
414
 I INFUSE?1N.N1" ml/hr" S FIELD(23)=+INFUSE,Y=$P(INFUSE,+INFUSE,2),Y=$$TRIM^XLFSTR(Y,"LR"," "),FIELD(24)=Y
 
415
"RTN","MSCPSRX1",103,0)
 
416
 I INFUSE?1N.N1" ml/hr@0" S FIELD(23)=+INFUSE,Y=$P(INFUSE,+INFUSE,2),Y=$$TRIM^XLFSTR(Y,"LR"," "),FIELD(24)=$E(Y,1,5)
 
417
"RTN","MSCPSRX1",104,0)
 
418
 I FIELD(23)="",FIELD(24)="" S INFUSE=$E(INFUSE,13,$L(INFUSE)) S FIELD(23)=INFUSE
 
419
"RTN","MSCPSRX1",105,0)
 
420
 D SEGMENT(LIMIT)
 
421
"RTN","MSCPSRX1",106,0)
 
422
 S CNT=CNT+1
 
423
"RTN","MSCPSRX1",107,0)
 
424
 S ORMSG(CNT)=SEGMENT
 
425
"RTN","MSCPSRX1",108,0)
 
426
 S SRXE=CNT
 
427
"RTN","MSCPSRX1",109,0)
 
428
 K SEGMENT I RXORDER["V" S JJ=0 F  S JJ=$O(@(PSJORDER_"5,"_JJ_")")) Q:'JJ  S SEGMENT(JJ-1)=$G(@(PSJORDER_"5,"_JJ_",0)"))
 
429
"RTN","MSCPSRX1",110,0)
 
430
 E  S JJ=0 F  S JJ=$O(@(PSJORDER_"12,"_JJ_")")) Q:'JJ  S SEGMENT(JJ-1)=$G(@(PSJORDER_"12,"_JJ_",0)"))
 
431
"RTN","MSCPSRX1",111,0)
 
432
 I $D(SEGMENT(0)) S CNT=CNT+1,ORMSG(CNT)="NTE|6|L|"_SEGMENT(0)
 
433
"RTN","MSCPSRX1",112,0)
 
434
 K SEGMENT,JJ
 
435
"RTN","MSCPSRX1",113,0)
 
436
 I RXORDER["V",$P($G(@(PSJORDER_"3)")),"^")]"" S CNT=CNT+1,ORMSG(CNT)="NTE|21|L|"_$P($G(@(PSJORDER_"3)")),"^")
 
437
"RTN","MSCPSRX1",114,0)
 
438
 I RXORDER["P",$P($G(@(PSJORDER_"9)")),U,2)]"" S CNT=CNT+1,ORMSG(CNT)="NTE|21|L|"_$P($G(@(PSJORDER_"9)")),U,2)
 
439
"RTN","MSCPSRX1",115,0)
 
440
 ;
 
441
"RTN","MSCPSRX1",116,0)
 
442
RXC ;component segments
 
443
"RTN","MSCPSRX1",117,0)
 
444
 N ADDITIVE,SOLUTION,SUB,TYPE,AD,SOL,PTR,NUM,ADMCODE,RXENAME,CNAME,RXE1
 
445
"RTN","MSCPSRX1",118,0)
 
446
 S RXENAME=""
 
447
"RTN","MSCPSRX1",119,0)
 
448
 S LIMIT=24 X PSJCLEAR
 
449
"RTN","MSCPSRX1",120,0)
 
450
 S FIELD(0)="RXC"
 
451
"RTN","MSCPSRX1",121,0)
 
452
 ; In the line below, the naked reference refers to the full global refe
 
453
"RTN","MSCPSRX1",122,0)
 
454
 ; This could be a reference to either ^PS(53.1 or ^PS(55
 
455
"RTN","MSCPSRX1",123,0)
 
456
 S AD="AD",SOL="SOL" F TYPE="AD","SOL" S SUB=0 F  S SUB=$O(@(PSJORDER_TYPE_","_SUB_")")) Q:SUB=""  S NODE1=$G(^(SUB,0)) Q:NODE1=""  D
 
457
"RTN","MSCPSRX1",124,0)
 
458
 .S FIELD(1)=$S(TYPE="AD":"A",1:"B")
 
459
"RTN","MSCPSRX1",125,0)
 
460
 .S PTR=+$S(TYPE="AD":+$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",11),1:+$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",11))
 
461
"RTN","MSCPSRX1",126,0)
 
462
 .S DRUG=+$S(TYPE="AD":+$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",2),1:+$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",2))
 
463
"RTN","MSCPSRX1",127,0)
 
464
 .S ADMCODE=$P($G(^PSDRUG(DRUG,21400)),U,2)
 
465
"RTN","MSCPSRX1",128,0)
 
466
 .I ADMCODE="" S MSCMSG="No ADM code found. Message cannot be sent Drug: "_$P(^PSDRUG(DRUG,0),U,1)
 
467
"RTN","MSCPSRX1",129,0)
 
468
 .S FIELD(2)=ADMCODE_"^"_$P($G(^PSDRUG(DRUG,0)),U,1)_"^L"
 
469
"RTN","MSCPSRX1",130,0)
 
470
 .I TYPE="SOL" S $P(ORMSG(RXOCT),"|",2)=FIELD(2)
 
471
"RTN","MSCPSRX1",131,0)
 
472
 .S FIELD(2)=FIELD(2)_"^"_$S($G(PSJBCBU):+$P(NODE1,"^"),1:PTR)_"^"_$S($G(PSJBCBU):$S(TYPE="AD":$P($G(^PS(52.6,+$P(NODE1,"^"),0)),"^"),1:$P($G(^PS(52.7,+$P(NODE1,"^"),0)),"^")_" "_$P($G(^(0)),U,4)),1:$P($G(^PS(50.7,PTR,0)),"^"))
 
473
"RTN","MSCPSRX1",132,0)
 
474
 .S:(TYPE="AD"&$G(PSJBCBU)) FIELD(2)=FIELD(2)_$S($P(NODE1,"^",3)]"":"BOTTLE: "_$P(NODE1,"^",3),1:"")
 
475
"RTN","MSCPSRX1",133,0)
 
476
 .S FIELD(2)=FIELD(2)_"^L"
 
477
"RTN","MSCPSRX1",134,0)
 
478
 .S FIELD(3)=$P($P(NODE1,"^",2)," ")
 
479
"RTN","MSCPSRX1",135,0)
 
480
 .S FIELD(4)=$P($P(NODE1,"^",2)," ",2)
 
481
"RTN","MSCPSRX1",136,0)
 
482
 .I SYSTYP="o" D
 
483
"RTN","MSCPSRX1",137,0)
 
484
 ..I RXENAME="" S RXENAME="^"_$P($G(^PSDRUG(DRUG,0)),U,1)
 
485
"RTN","MSCPSRX1",138,0)
 
486
 ..E  S RXENAME=RXENAME_" / "_$P($G(^PSDRUG(DRUG,0)),U,1)
 
487
"RTN","MSCPSRX1",139,0)
 
488
 .S NUM=$S(FIELD(4)="":"","ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU"[FIELD(4):$P($T(@(FIELD(4))),";",3),1:"")
 
489
"RTN","MSCPSRX1",140,0)
 
490
 .;S FIELD(4)=NUM_"^"_FIELD(4)_"^L"
 
491
"RTN","MSCPSRX1",141,0)
 
492
 .I FIELD(1)="B" D
 
493
"RTN","MSCPSRX1",142,0)
 
494
 .. S RXE1=$P(ORMSG(SRXE),"|",2)
 
495
"RTN","MSCPSRX1",143,0)
 
496
 ..S $P(RXE1,U,1)=FIELD(3)_" "_FIELD(4)
 
497
"RTN","MSCPSRX1",144,0)
 
498
 ..S $P(ORMSG(SRXE),"|",2)=RXE1
 
499
"RTN","MSCPSRX1",145,0)
 
500
 .D SEGMENT(LIMIT)
 
501
"RTN","MSCPSRX1",146,0)
 
502
 .S CNT=CNT+1
 
503
"RTN","MSCPSRX1",147,0)
 
504
 .S ORMSG(CNT)=SEGMENT
 
505
"RTN","MSCPSRX1",148,0)
 
506
 I SYSTYP="o" S $P(ORMSG(SRXE),"|",3)=RXENAME
 
507
"RTN","MSCPSRX1",149,0)
 
508
 Q
 
509
"RTN","MSCPSRX1",150,0)
 
510
 ;
 
511
"RTN","MSCPSRX1",151,0)
 
512
RXR ; med route segment
 
513
"RTN","MSCPSRX1",152,0)
 
514
 S LIMIT=4 X PSJCLEAR
 
515
"RTN","MSCPSRX1",153,0)
 
516
 S FIELD(0)="RXR"
 
517
"RTN","MSCPSRX1",154,0)
 
518
 I PSJORDER["IV" S FIELD(1)="IV^IV^L"
 
519
"RTN","MSCPSRX1",155,0)
 
520
 ;S FIELD(1)=$P($G(@(PSJORDER_".2)")),"^",3) Q:$P(FIELD(1),U,4)=""  D
 
521
"RTN","MSCPSRX1",156,0)
 
522
 ;.S FIELD(1)=FIELD(1)_"^"_$P($G(^PS(51.2,+$P(FIELD(1),"^",4),0)),"^")_"^99PSR"
 
523
"RTN","MSCPSRX1",157,0)
 
524
 ;.S:$G(PSJBCBU) FIELD(4)=$P($G(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($P($G(@(PSJORDER_"0)")),"^",4),55.01,.04)_"^L"
 
525
"RTN","MSCPSRX1",158,0)
 
526
 ;S:FIELD(1)="" FIELD(1)=$P(NODE1,"^",3)_"^"_$P($G(^PS(51.2,+$P(NODE1,"^",3),0)),"^")_"^L"
 
527
"RTN","MSCPSRX1",159,0)
 
528
 S:FIELD(1)="" FIELD(1)=$P($G(^PS(51.2,+$P(NODE1,"^",3),0)),"^")_"^"_$P($G(^PS(51.2,+$P(NODE1,"^",3),0)),"^")_"^L"
 
529
"RTN","MSCPSRX1",160,0)
 
530
 D SEGMENT(LIMIT)
 
531
"RTN","MSCPSRX1",161,0)
 
532
 S CNT=CNT+1
 
533
"RTN","MSCPSRX1",162,0)
 
534
 S ORMSG(CNT)=SEGMENT
 
535
"RTN","MSCPSRX1",163,0)
 
536
 Q
 
537
"RTN","MSCPSRX1",164,0)
 
538
 ;
 
539
"RTN","MSCPSRX1",165,0)
 
540
SEGMENT(LIMIT) ;
 
541
"RTN","MSCPSRX1",166,0)
 
542
 K SEGMENT
 
543
"RTN","MSCPSRX1",167,0)
 
544
 N SUBSEG,SEGLENGT
 
545
"RTN","MSCPSRX1",168,0)
 
546
 S SUBSET=0,SEGMENT=""
 
547
"RTN","MSCPSRX1",169,0)
 
548
 F J=0:1:LIMIT D
 
549
"RTN","MSCPSRX1",170,0)
 
550
 .I SEGMENT']"" S SEGMENT=FIELD(J) Q
 
551
"RTN","MSCPSRX1",171,0)
 
552
 .S SEGMENT=SEGMENT_"|"_FIELD(J)
 
553
"RTN","MSCPSRX1",172,0)
 
554
 Q
 
555
"RTN","MSCPSRX1",173,0)
 
556
ZRX ; pharmacy Z-segment
 
557
"RTN","MSCPSRX1",174,0)
 
558
 S LIMIT=6 X PSJCLEAR
 
559
"RTN","MSCPSRX1",175,0)
 
560
 S FIELD(0)="ZRX"
 
561
"RTN","MSCPSRX1",176,0)
 
562
 I '$G(PSJREN) N PREON,PSJREN I $G(PSJORD)["U"&($P(NODE1,"^",24)="R")
 
563
"RTN","MSCPSRX1",177,0)
 
564
 S PSJREN=1
 
565
"RTN","MSCPSRX1",178,0)
 
566
 I $G(PSJORD)["V"&($P(NODE2,"^",8)="R") S PSJREN=1
 
567
"RTN","MSCPSRX1",179,0)
 
568
 S PREON=$S($G(PSJREN):$G(PSJORD),PSJORDER["IV":$P(NODE2,"^",5),1:$P(NODE1,"^",25))
 
569
"RTN","MSCPSRX1",180,0)
 
570
 S FIELD(1)=$S(PREON["P":$P($G(^PS(53.1,+PREON,0)),"^",21),PREON["V":$P($G(^PS(55,PSJHLDFN,"IV",+PREON,0)),"^",21),1:$P($G(^PS(55,PSJHLDFN,5,+PREON,0)),"^",21))
 
571
"RTN","MSCPSRX1",181,0)
 
572
 S FIELD(2)=$S(PSJORDER["IV":$G(P("NAT")),1:$G(PSJNOO))
 
573
"RTN","MSCPSRX1",182,0)
 
574
 S FIELD(3)=$S($G(PSJREN):"R",PSJORDER["IV":$P(NODE2,"^",8),1:$P(NODE1,"^",24))
 
575
"RTN","MSCPSRX1",183,0)
 
576
 I FIELD(3)="" I PSOC="SN" S FIELD(3)="N"
 
577
"RTN","MSCPSRX1",184,0)
 
578
 ;S NAME=$$PROV^MSCHLUTL(DUZ),FIELD(14)=NAME
 
579
"RTN","MSCPSRX1",185,0)
 
580
 S NAME=$P($G(^VA(200,DUZ,0)),"^")
 
581
"RTN","MSCPSRX1",186,0)
 
582
 S FIELD(5)=DUZ_"^"_NAME_"^"_"99NP"
 
583
"RTN","MSCPSRX1",187,0)
 
584
 S FIELD(6)=$S($G(IVTYPE)="F":"IV",$P($G(@(PSJORDER_"0)")),U,4)="H":"TPN",1:"")
 
585
"RTN","MSCPSRX1",188,0)
 
586
 D SEGMENT(LIMIT),DISPLAY^PSJHL2
 
587
"RTN","MSCPSRX1",189,0)
 
588
 Q
 
589
"RTN","MSCPSRX1",190,0)
 
590
 ;
 
591
"RTN","MSCPSRX1",191,0)
 
592
CNT ;Count dispense drugs for an order
 
593
"RTN","MSCPSRX1",192,0)
 
594
 S (CNT,DDNUM)=0 F  S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")"))
 
595
"RTN","MSCPSRX1",193,0)
 
596
 Q:'DDNUM  S CNT=CNT+1
 
597
"RTN","MSCPSRX1",194,0)
 
598
 Q
 
599
"RTN","MSCPSRX1",195,0)
 
600
ML ;;PSIV-1
 
601
"RTN","MSCPSRX1",196,0)
 
602
LITER ;;PSIV-2
 
603
"RTN","MSCPSRX1",197,0)
 
604
MCG ;;PSIV-3
 
605
"RTN","MSCPSRX1",198,0)
 
606
MG ;;PSIV-4
 
607
"RTN","MSCPSRX1",199,0)
 
608
GM ;;PSIV-5
 
609
"RTN","MSCPSRX1",200,0)
 
610
UNITS ;;PSIV-6
 
611
"RTN","MSCPSRX1",201,0)
 
612
IU ;;PSIV-7
 
613
"RTN","MSCPSRX1",202,0)
 
614
MEQ ;;PSIV-8
 
615
"RTN","MSCPSRX1",203,0)
 
616
MM ;;PSIV-9
 
617
"RTN","MSCPSRX1",204,0)
 
618
MU ;;PSIV-10
 
619
"RTN","MSCPSRX1",205,0)
 
620
THOUU ;;PSIV-11
 
621
"RTN","MSCPSRX1",206,0)
 
622
 ;
 
623
"RTN","MSCPSRX1",207,0)
 
624
 ;
 
625
"RTN","MSCPSRXE")
 
626
0^4^B29380734
 
627
"RTN","MSCPSRXE",1,0)
 
628
MSCPSRXE ;MSC/GFT - Build outgoing RXE msgs when order is processed by pharmacy;16-Sep-2010 19:51;MH
 
629
"RTN","MSCPSRXE",2,0)
 
630
 ;;5.0;INPATIENT MEDICATIONS;**1504,1505**;16 DEC 97
 
631
"RTN","MSCPSRXE",3,0)
 
632
EN(PSOC,RXORDER,PSJORDER) ; ORDER COMING FROM PHARMACY
 
633
"RTN","MSCPSRXE",4,0)
 
634
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**MSC**;Dec 17, 1997
 
635
"RTN","MSCPSRXE",5,0)
 
636
 ;Patch 4 adds a fix for onetime doses completed in BCMA
 
637
"RTN","MSCPSRXE",6,0)
 
638
 ;This routine is a copy of ORMBLD to send the message through HL7 to an outside application
 
639
"RTN","MSCPSRXE",7,0)
 
640
 ;   PSOC - type of order
 
641
"RTN","MSCPSRXE",8,0)
 
642
 ;   RXORDER = order number
 
643
"RTN","MSCPSRXE",9,0)
 
644
 ;   PSJORDER =
 
645
"RTN","MSCPSRXE",10,0)
 
646
 ; -- Send order message
 
647
"RTN","MSCPSRXE",11,0)
 
648
 N ORPKG,DGQUIET,UNDO,SUBSET,SRXE,CNT,PROV,MSCOR,OTYP,OPRI,ORMSG,HLRESLT,X,SYSTYP,ACCOUNT,MSC101,OR3,OR8,ORVP,ORDG
 
649
"RTN","MSCPSRXE",12,0)
 
650
 N NODE1,NODE2,NODE4,TST1,NODEP,MSCMSG,SUB,VDATE,MSCERROR,HL,LOCI,ORDCON,STATUS,TYPEB,VERIFY
 
651
"RTN","MSCPSRXE",13,0)
 
652
 S MSCERROR=""
 
653
"RTN","MSCPSRXE",14,0)
 
654
 K ^TMP("HLS",$J)
 
655
"RTN","MSCPSRXE",15,0)
 
656
 S MSCMSG=""
 
657
"RTN","MSCPSRXE",16,0)
 
658
 S:$G(PSOC)="" PSOC="NW"
 
659
"RTN","MSCPSRXE",17,0)
 
660
 I +RXORDER&(+PSJORDER=0) D
 
661
"RTN","MSCPSRXE",18,0)
 
662
 .S TST1=$G(@(PSJORDER_"0)")) I $P(TST1,U,4)="U" S RXORDER=RXORDER_"U"
 
663
"RTN","MSCPSRXE",19,0)
 
664
 .E  S RXORDER="V"
 
665
"RTN","MSCPSRXE",20,0)
 
666
 S PSOC=$S("SN^XX^ZC^XR"[PSOC:"XX","OC^CA^CR"[PSOC:"CA","DC^DR^OD"[PSOC:"DC","HD^OH^HR"[PSOC:"HD","RL^OE^OR"[PSOC:"RL","SN"[PSOC:"SN",1:"NW")
 
667
"RTN","MSCPSRXE",21,0)
 
668
 ;-------------------------------------------------
 
669
"RTN","MSCPSRXE",22,0)
 
670
 ;Get the information needed for the pharmacy order
 
671
"RTN","MSCPSRXE",23,0)
 
672
 ;B  S PSJORDER=$S((PSJORDER["N")!(PSJORDER["P"):"^PS(53.1,"_+PSJORDER,PSJORDER["V":"^PS(55,"_PSJHLDFN_",""IV"","_+PSJORDER,1:"^PS(55,"_PSJHLDFN_",5,"_+PSJORDER)_","
 
673
"RTN","MSCPSRXE",24,0)
 
674
 Q:(RXORDER'["P")&(RXORDER'["V")&(RXORDER'["U")&(RXORDER'["A")      ;Only pharmacy orders go to dispensing machine
 
675
"RTN","MSCPSRXE",25,0)
 
676
 Q:PSJORDER["53.1"   ;Unverified orders will not be sent to the dispensing machine
 
677
"RTN","MSCPSRXE",26,0)
 
678
 I $P($G(@(PSJORDER_"0)")),U,15)'=PSJHLDFN S ORDCON="Patient does not match/PSJHL2" S X="ORERR" X ^%ZOSF("TEST") I
 
679
"RTN","MSCPSRXE",27,0)
 
680
 S UNDO=$S("OC^CR"[PSOC:1,1:0)
 
681
"RTN","MSCPSRXE",28,0)
 
682
 I RXORDER["P",$P($G(@(PSJORDER_"0)")),U,15)'=PSJHLDFN W !,"ERROR"
 
683
"RTN","MSCPSRXE",29,0)
 
684
 ;Get the HL7 information to setup the variables
 
685
"RTN","MSCPSRXE",30,0)
 
686
 S MSC101="MSCH ORM MED SERVER"
 
687
"RTN","MSCPSRXE",31,0)
 
688
 D INIT^HLFNC2(MSC101,.HL) I $O(HL(""))="" Q  ;CAN'T SET UP HL7 VARIABLES
 
689
"RTN","MSCPSRXE",32,0)
 
690
 ;Determine if site is using Pyxis or Omnicell
 
691
"RTN","MSCPSRXE",33,0)
 
692
 S SYSTYP=$$GET^XPAR("ALL","MSCADM MACHINE")
 
693
"RTN","MSCPSRXE",34,0)
 
694
 I SYSTYP="p"&(PSOC="XX") S PSOC="XO"
 
695
"RTN","MSCPSRXE",35,0)
 
696
 S DGQUIET=1 D    ;build msg, ORDIALOG gone when posted
 
697
"RTN","MSCPSRXE",36,0)
 
698
 .S ORMSG(2)=$$PID^MSCHLUTL(PSJHLDFN)
 
699
"RTN","MSCPSRXE",37,0)
 
700
 .I $G(ORMSG(2))="" S MSCMSG="PID segment could not be created" D QUIT Q
 
701
"RTN","MSCPSRXE",38,0)
 
702
 .S ORMSG(3)=$$PV1^MSCHLUTL(PSJHLDFN)
 
703
"RTN","MSCPSRXE",39,0)
 
704
 .I $G(ORMSG(3))="" S MSCMSG="PV1 segment could not be created" D QUIT Q
 
705
"RTN","MSCPSRXE",40,0)
 
706
 .;Check to see if this order should be sent; Need to know where patient is
 
707
"RTN","MSCPSRXE",41,0)
 
708
 .;located before we can send this on
 
709
"RTN","MSCPSRXE",42,0)
 
710
 .N OK,TYPE,LOC,IEN,DIV,TYPEIEN,SEND
 
711
"RTN","MSCPSRXE",43,0)
 
712
 .S TYPE=$P(ORMSG(3),"|",3),LOC=$P($P(ORMSG(3),"|",4),"^",1)
 
713
"RTN","MSCPSRXE",44,0)
 
714
 .;Determine if the interface is setup to send messages from this location
 
715
"RTN","MSCPSRXE",45,0)
 
716
 .S DIV=$G(DUZ(2))
 
717
"RTN","MSCPSRXE",46,0)
 
718
 .S IEN=$O(^MSCH(21488,"B",DIV,""))
 
719
"RTN","MSCPSRXE",47,0)
 
720
 .Q:IEN=""
 
721
"RTN","MSCPSRXE",48,0)
 
722
 .S TYPEB=$O(^MSCH(21488,IEN,1,"B",TYPE,""))
 
723
"RTN","MSCPSRXE",49,0)
 
724
 .Q:TYPEB=""
 
725
"RTN","MSCPSRXE",50,0)
 
726
 .S SEND=$P($G(^MSCH(21488,IEN,1,TYPEB,0)),U,2)
 
727
"RTN","MSCPSRXE",51,0)
 
728
 .I SEND="A" D ORC
 
729
"RTN","MSCPSRXE",52,0)
 
730
 .I SEND="I" D
 
731
"RTN","MSCPSRXE",53,0)
 
732
 ..S LOCI=$O(^MSCH(21488,IEN,1,TYPEB,1,"B",LOC,"")) Q:LOCI=""  D ORC
 
733
"RTN","MSCPSRXE",54,0)
 
734
 .I SEND="E" D
 
735
"RTN","MSCPSRXE",55,0)
 
736
 ..S LOCI=$O(^MSCH(21488,IEN,1,TYPEB,1,"B",LOC,"")) Q:LOCI'=""
 
737
"RTN","MSCPSRXE",56,0)
 
738
 K ^TMP("ORWORD",$J)
 
739
"RTN","MSCPSRXE",57,0)
 
740
 Q
 
741
"RTN","MSCPSRXE",58,0)
 
742
 ;---------------------------------------------------------
 
743
"RTN","MSCPSRXE",59,0)
 
744
 ;Put the message together and generate the call
 
745
"RTN","MSCPSRXE",60,0)
 
746
GEN K ^TMP("HLS",$J) S ORMSG=""
 
747
"RTN","MSCPSRXE",61,0)
 
748
 F X=1:1 S ORMSG=$O(ORMSG(ORMSG)) Q:ORMSG=""  S ^TMP("HLS",$J,X)=ORMSG(ORMSG)
 
749
"RTN","MSCPSRXE",62,0)
 
750
 I MSCMSG'="" G QUIT
 
751
"RTN","MSCPSRXE",63,0)
 
752
 D GENERATE^HLMA(MSC101,"GM",1,.HLRESLT,"") K ^TMP("HLS",$J)
 
753
"RTN","MSCPSRXE",64,0)
 
754
 I +$P(HLRESLT,U,2) D  Q
 
755
"RTN","MSCPSRXE",65,0)
 
756
 .D ERR^MSCHLUTL(PSJHLDFN,"COULDN'T SEND "_PSOC_" ORDER "_RXORDER_" USING '"_MSC_"' PROTOCOL: "_$P(HLRESLT,U,3)) ;...and FILE exception
 
757
"RTN","MSCPSRXE",66,0)
 
758
 K PSJORDER,RXORDER
 
759
"RTN","MSCPSRXE",67,0)
 
760
 Q
 
761
"RTN","MSCPSRXE",68,0)
 
762
 ;
 
763
"RTN","MSCPSRXE",69,0)
 
764
QUIT ;Quit sending the message
 
765
"RTN","MSCPSRXE",70,0)
 
766
 I MSCMSG="" S MSCMSG="Unable to send message"
 
767
"RTN","MSCPSRXE",71,0)
 
768
 D ERR^MSCHLUTL(PSJHLDFN,MSCMSG)
 
769
"RTN","MSCPSRXE",72,0)
 
770
 Q
 
771
"RTN","MSCPSRXE",73,0)
 
772
NATURE(X) ; -- Returns 3 ^-piece identifier for nature X
 
773
"RTN","MSCPSRXE",74,0)
 
774
 N ORN,Y S ORN=$G(^ORD(100.02,+$G(X),0))
 
775
"RTN","MSCPSRXE",75,0)
 
776
 S Y=$P(ORN,U,2)_U_$P(ORN,U)_"^99ORN"
 
777
"RTN","MSCPSRXE",76,0)
 
778
 Q Y
 
779
"RTN","MSCPSRXE",77,0)
 
780
 ;
 
781
"RTN","MSCPSRXE",78,0)
 
782
 ;
 
783
"RTN","MSCPSRXE",79,0)
 
784
 ;Create the ORC
 
785
"RTN","MSCPSRXE",80,0)
 
786
ORC ;Find the order number for this entry
 
787
"RTN","MSCPSRXE",81,0)
 
788
 K FIELD
 
789
"RTN","MSCPSRXE",82,0)
 
790
 D INIT^PSJHL3
 
791
"RTN","MSCPSRXE",83,0)
 
792
 S LIMIT=18 X PSJCLEAR
 
793
"RTN","MSCPSRXE",84,0)
 
794
 Q:'$D(PSJORDER)!'$D(PSOC)
 
795
"RTN","MSCPSRXE",85,0)
 
796
 S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)"))
 
797
"RTN","MSCPSRXE",86,0)
 
798
 S NODE4=$G(@(PSJORDER_"4)")),NODEP=$G(@(PSJORDER_".2)"))
 
799
"RTN","MSCPSRXE",87,0)
 
800
 S OTYP=$P(NODE1,U,7),OPRI=$P(NODEP,U,4)
 
801
"RTN","MSCPSRXE",88,0)
 
802
 ;Quit if a one-time order and already done (from BCMA)
 
803
"RTN","MSCPSRXE",89,0)
 
804
 S VDATE=$P(NODE4,U,4)
 
805
"RTN","MSCPSRXE",90,0)
 
806
 I (OTYP="O")&(OPRI="D")&(VDATE="") Q
 
807
"RTN","MSCPSRXE",91,0)
 
808
 S FIELD(0)="ORC"
 
809
"RTN","MSCPSRXE",92,0)
 
810
 S FIELD(1)=PSOC
 
811
"RTN","MSCPSRXE",93,0)
 
812
 S FIELD(2)=$S(PSOC="SN":"",1:$P(NODE1,"^",21))_"^OR" I $P(FIELD(2),"^")
 
813
"RTN","MSCPSRXE",94,0)
 
814
 S SUB=$P(FIELD(2),"^",1) S SUB=$P(SUB,";",1) S $P(FIELD(2),"^",1)=SUB
 
815
"RTN","MSCPSRXE",95,0)
 
816
 S FIELD(3)=RXORDER_"^PS"
 
817
"RTN","MSCPSRXE",96,0)
 
818
 ; translate Pharmacy status code to HL7 status code, set in FIELD(5)
 
819
"RTN","MSCPSRXE",97,0)
 
820
 S STATUS=$S($G(PSJEXPOE):"E",(($P(NODE1,"^",17)]"")&(RXORDER["V")):($P(NODE1,"^",17)),($P(NODE1,"^",9)]""):$P(NODE1,"^",9),$G(PSIVCOPY):"DE",1:"")
 
821
"RTN","MSCPSRXE",98,0)
 
822
 I STATUS="E" S FIELD(1)="DC"
 
823
"RTN","MSCPSRXE",99,0)
 
824
 S FIELD(5)=STATUS
 
825
"RTN","MSCPSRXE",100,0)
 
826
 ;D @STATUS
 
827
"RTN","MSCPSRXE",101,0)
 
828
 I STATUS="U",RXORDER["P" S FIELD(3)="^PS"
 
829
"RTN","MSCPSRXE",102,0)
 
830
 S FIELD(9)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE2,"^")),1:$$FMTHL7^XLFDT($P(NODE1,"^",16)))
 
831
"RTN","MSCPSRXE",103,0)
 
832
 S CLERK=$S(RXORDER["V":$P(NODE2,"^",11),1:$P(NODE4,"^",7))
 
833
"RTN","MSCPSRXE",104,0)
 
834
 S NAME=$P($G(^VA(200,+CLERK,0)),"^")
 
835
"RTN","MSCPSRXE",105,0)
 
836
 S FIELD(10)=CLERK_"^"_NAME
 
837
"RTN","MSCPSRXE",106,0)
 
838
 I PSOC="ZV"!($G(PSJBCBU)) S VERIFY=$P($G(NODE4),"^"),FIELD(11)=VERIFY_"^"_$P($G(^VA(200,+VERIFY,0)),"^"),FIELD(9)=$$FMTHL7^XLFDT($P(NODE4,"^",2))
 
839
"RTN","MSCPSRXE",107,0)
 
840
 S PROVIDER=$S($G(PSJDCPRV)]"":$G(PSJDCPRV),RXORDER["V":$P(NODE1,"^",6),1:$P(NODE1,"^",2)) K PSJDCPRV
 
841
"RTN","MSCPSRXE",108,0)
 
842
 S NAME=$$PROV^MSCHLUTL(PROVIDER)
 
843
"RTN","MSCPSRXE",109,0)
 
844
 ;S NAME=$$HLNAME^HLFNC($P($G(^VA(200,+PROVIDER,0)),"^"))
 
845
"RTN","MSCPSRXE",110,0)
 
846
 S FIELD(12)=NAME
 
847
"RTN","MSCPSRXE",111,0)
 
848
 S FIELD(15)=$S(RXORDER["V":$$FMTHL7^XLFDT($P(NODE1,"^",2)),1:$$FMTHL7^XLFDT($P(NODE2,"^",2)))
 
849
"RTN","MSCPSRXE",112,0)
 
850
 S FIELD(16)=OTYP_"^"_OPRI
 
851
"RTN","MSCPSRXE",113,0)
 
852
 D SEGMENT^MSCPSRX1(LIMIT)
 
853
"RTN","MSCPSRXE",114,0)
 
854
 S ORMSG(4)=SEGMENT
 
855
"RTN","MSCPSRXE",115,0)
 
856
 D @$S("DC^NW^CA^HD^RL^XX^XO"[PSOC:"RXE",1:"QUIT")
 
857
"RTN","MSCPSRXE",116,0)
 
858
 Q
 
859
"RTN","MSCPSRXE",117,0)
 
860
RXE ;Send a pharmacy order (RXE) message. Pharmacy messages will be sent
 
861
"RTN","MSCPSRXE",118,0)
 
862
 ;after being processed by pharmacy
 
863
"RTN","MSCPSRXE",119,0)
 
864
 S CNT=4
 
865
"RTN","MSCPSRXE",120,0)
 
866
 I $G(PSJHLDFN)']""!$G(PSOC)']""!$G(PSJORDER)']""
 
867
"RTN","MSCPSRXE",121,0)
 
868
 N COMMENTS,DDIEA,DDNUM,DOSE,DOSEFORM,DOSEOR,NAME,DURATION,IVTYPE,NDNODE,OINODE,PSGPLS,PSGPLF,PRODNAME,SPDIEN,UNIT,UNITS,DDIEN,SCHEDULE
 
869
"RTN","MSCPSRXE",122,0)
 
870
 S IVTYPE=$S(RXORDER["U":"",1:$$IVTYPE^PSJHLU(PSJORDER))
 
871
"RTN","MSCPSRXE",123,0)
 
872
 D RXO^MSCPSRX1
 
873
"RTN","MSCPSRXE",124,0)
 
874
 D RXR^MSCPSRX1
 
875
"RTN","MSCPSRXE",125,0)
 
876
 ;D:(IVTYPE'="F") RXR^MSCPSRX1
 
877
"RTN","MSCPSRXE",126,0)
 
878
 D GEN
 
879
"RTN","MSCPSRXE",127,0)
 
880
 Q
 
881
"RTN","MSCPSRXE",128,0)
 
882
 ; ;
 
883
"RTN","MSCPSRXE",129,0)
 
884
 ;
 
885
"RTN","MSCPSRXE",130,0)
 
886
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
 
887
"RTN","MSCPSRXE",131,0)
 
888
 Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
 
889
"RTN","MSCPSRXE",132,0)
 
890
 ;
 
891
"RTN","PSJHLU")
 
892
0^3^B14183304
 
893
"RTN","PSJHLU",1,0)
 
894
PSJHLU ;BIR/RLW-UTILITIES USED IN BUILDING HL7 SEGMENTS ;16-Sep-2010 19:52;MH
 
895
"RTN","PSJHLU",2,0)
 
896
 ;;5.0; INPATIENT MEDICATIONS ;**1,56,72,102,1504,1505**;16 DEC 97
 
897
"RTN","PSJHLU",3,0)
 
898
 ;
 
899
"RTN","PSJHLU",4,0)
 
900
 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
 
901
"RTN","PSJHLU",5,0)
 
902
 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
 
903
"RTN","PSJHLU",6,0)
 
904
 ;
 
905
"RTN","PSJHLU",7,0)
 
906
INIT ; set up HL7 application variables
 
907
"RTN","PSJHLU",8,0)
 
908
 S PSJHLSDT="PS",PSJHINST=$P($$SITE^VASITE(),"^")
 
909
"RTN","PSJHLU",9,0)
 
910
 S PSJCLEAR="K FIELD F J=0:1:LIMIT S FIELD(J)="""""
 
911
"RTN","PSJHLU",10,0)
 
912
 Q
 
913
"RTN","PSJHLU",11,0)
 
914
 ;
 
915
"RTN","PSJHLU",12,0)
 
916
SEGMENT(LIMIT) ;
 
917
"RTN","PSJHLU",13,0)
 
918
 K SEGMENT
 
919
"RTN","PSJHLU",14,0)
 
920
 N SUBSEG,SEGLENGT S SUBSEG=0,SEGMENT="" F J=0:1:LIMIT D
 
921
"RTN","PSJHLU",15,0)
 
922
 .I SEGMENT']"" S SEGMENT=FIELD(J) Q
 
923
"RTN","PSJHLU",16,0)
 
924
 .S SEGMENT=SEGMENT_"|"_FIELD(J)
 
925
"RTN","PSJHLU",17,0)
 
926
 F  S SEGLENGT=$L(SEGMENT) D  Q:$L(SEGMENT)'>246
 
927
"RTN","PSJHLU",18,0)
 
928
 .I SEGLENGT'>246 S SEGMENT(SUBSEG)=SEGMENT
 
929
"RTN","PSJHLU",19,0)
 
930
 .I SEGLENGT>245 S SEGMENT(SUBSEG)=$E(SEGMENT,1,245),SUBSEG=SUBSEG+1 D
 
931
"RTN","PSJHLU",20,0)
 
932
 ..S SEGMENT=$E(SEGMENT,246,SEGLENGT),SEGMENT(SUBSEG)=$E(SEGMENT,1,245)
 
933
"RTN","PSJHLU",21,0)
 
934
SET S PSJI=PSJI+1,^TMP("PSJHLS",$J,PSJHLSDT,PSJI)=SEGMENT(0)
 
935
"RTN","PSJHLU",22,0)
 
936
 F J=1:1 Q:'$D(SEGMENT(J))  S ^TMP("PSJHLS",$J,PSJHLSDT,PSJI,J)=SEGMENT(J)
 
937
"RTN","PSJHLU",23,0)
 
938
 Q
 
939
"RTN","PSJHLU",24,0)
 
940
 ;
 
941
"RTN","PSJHLU",25,0)
 
942
CALL(HLEVN) ; call DHCP HL7 package -or- protocol, to pass Orders
 
943
"RTN","PSJHLU",26,0)
 
944
 ; HLEVN = number of segments in message
 
945
"RTN","PSJHLU",27,0)
 
946
 N MSCOC
 
947
"RTN","PSJHLU",28,0)
 
948
 I $G(PSJBCBU)=1 M PSJNAME=^TMP("PSJHLS",$J,"PS") Q
 
949
"RTN","PSJHLU",29,0)
 
950
 S MSCOC=PSOC
 
951
"RTN","PSJHLU",30,0)
 
952
 S PSJMSG="^TMP(""PSJHLS"",$J,""PS"")"
 
953
"RTN","PSJHLU",31,0)
 
954
 D MSG^XQOR("PS EVSEND OR",.PSJMSG)
 
955
"RTN","PSJHLU",32,0)
 
956
 D EN^MSCPSRXE(MSCOC,RXORDER,PSJORDER)
 
957
"RTN","PSJHLU",33,0)
 
958
 K CLERK,DDIEN,DDNUM,DOSEFORM,DOSEOR,FIELD,IVTYPE,LIMIT,NAME,NDNODE,NODE1,NODE2,PRODNAME,PROVIDER,PSGS0Y,PSJHINST,PSJHLSDT,PSJI,PSJORDER,PSOC,PSREASON,ROOMBED,SPDIEN,SEGMENT
 
959
"RTN","PSJHLU",34,0)
 
960
 Q
 
961
"RTN","PSJHLU",35,0)
 
962
 ;
 
963
"RTN","PSJHLU",36,0)
 
964
IVTYPE(PSJORDER) ; check whether a back-door order is Inpatient IV or IV fluid
 
965
"RTN","PSJHLU",37,0)
 
966
 I RXORDER["V",$P($G(@(PSJORDER_"0)")),"^",4)'="A" Q "I"
 
967
"RTN","PSJHLU",38,0)
 
968
 I RXORDER["P" I $P($G(@(PSJORDER_"0)")),"^",4)'="F" S IVTYPE="" Q IVTYPE
 
969
"RTN","PSJHLU",39,0)
 
970
 N SUB,AD,SOL,IVTYPE,NODE1 S SUB=0,IVTYPE="F"
 
971
"RTN","PSJHLU",40,0)
 
972
 ;naked reference on line below refers to the full indirect reference of PSJORDER_...
 
973
"RTN","PSJHLU",41,0)
 
974
 F TYPE="AD","SOL" S SUB=0 F  S SUB=$O(@(PSJORDER_""""_TYPE_""""_","_SUB_")")) Q:(SUB="")!(IVTYPE="I")  S NODE1=$G(^(SUB,0)) Q:NODE1=""  D  Q:IVTYPE="I"
 
975
"RTN","PSJHLU",42,0)
 
976
 .I TYPE="AD" D
 
977
"RTN","PSJHLU",43,0)
 
978
 ..I '$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",13) S IVTYPE="I"
 
979
"RTN","PSJHLU",44,0)
 
980
 .D:TYPE="SOL"
 
981
"RTN","PSJHLU",45,0)
 
982
 ..S:'$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",13) IVTYPE="I"
 
983
"RTN","PSJHLU",46,0)
 
984
 Q IVTYPE
 
985
"RTN","PSJHLU",47,0)
 
986
ENI ;Calculate Frequency for IV orders
 
987
"RTN","PSJHLU",48,0)
 
988
 N INFUSE
 
989
"RTN","PSJHLU",49,0)
 
990
 K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q
 
991
"RTN","PSJHLU",50,0)
 
992
 I X?.E1L.E S INFUSE=$$ENLU^PSGMI(X) Q:(INFUSE="TITRATE")!(INFUSE="BOLUS")
 
993
"RTN","PSJHLU",51,0)
 
994
 Q:(X="TITRATE")!(X="BOLUS")
 
995
"RTN","PSJHLU",52,0)
 
996
 I X["=" D  Q   ; NOIS LOU-0501-42191
 
997
"RTN","PSJHLU",53,0)
 
998
 .N X2,X1 S X1=$P(X,"="),X2=$P(X,"=",2)
 
999
"RTN","PSJHLU",54,0)
 
1000
 .I X1["ML/HR",(+X1=$P(X1,"ML/HR"))!(+X1=$P(X1," ML/HR")) D
 
1001
"RTN","PSJHLU",55,0)
 
1002
 ..S X1=$TR(X1,"ML/HR","ml/hr")
 
1003
"RTN","PSJHLU",56,0)
 
1004
 .I X2["ML/HR",(+X2=$P(X2,"ML/HR"))!(+X2=$P(X2," ML/HR")) D
 
1005
"RTN","PSJHLU",57,0)
 
1006
 ..S X2=$TR(X2,"ML/HR","ml/hr")
 
1007
"RTN","PSJHLU",58,0)
 
1008
 .I X1[" ml/hr",(+X1=$P(X1," ml/hr")) D
 
1009
"RTN","PSJHLU",59,0)
 
1010
 ..S X1=$P(X1," ml/hr")_$P(X1," ml/hr",2,9999)
 
1011
"RTN","PSJHLU",60,0)
 
1012
 .I X2[" ml/hr",(+X2=$P(X2," ml/hr")) D
 
1013
"RTN","PSJHLU",61,0)
 
1014
 ..S X2=$P(X2," ml/hr")_$P(X2," ml/hr",2,9999)
 
1015
"RTN","PSJHLU",62,0)
 
1016
 .I X1["ml/hr",(+X1=$P(X1,"ml/hr")) D
 
1017
"RTN","PSJHLU",63,0)
 
1018
 ..S X1=$P(X1,"ml/hr")_$P(X1,"ml/hr",2,9999)
 
1019
"RTN","PSJHLU",64,0)
 
1020
 .I X2["ml/hr",(+X2=$P(X2,"ml/hr")) D
 
1021
"RTN","PSJHLU",65,0)
 
1022
 ..S X2=$P(X2,"ml/hr")_$P(X2,"ml/hr",2,9999)
 
1023
"RTN","PSJHLU",66,0)
 
1024
 .I X2'=+X2 D
 
1025
"RTN","PSJHLU",67,0)
 
1026
 ..I ($P(X2,"@",2,999)'=+$P(X2,"@",2,999)!(+$P(X2,"@",2,999)<0)) K X Q
 
1027
"RTN","PSJHLU",68,0)
 
1028
 .I X1=+X1 S X1=X1_" ml/hr"
 
1029
"RTN","PSJHLU",69,0)
 
1030
 .I X2=+X2 S X2=X2_" ml/hr"
 
1031
"RTN","PSJHLU",70,0)
 
1032
 .S:$P(X2,"@")=+X2 $P(X2,"@")=$P(X2,"@")_" ml/hr"
 
1033
"RTN","PSJHLU",71,0)
 
1034
 .S X=X1_"="_X2
 
1035
"RTN","PSJHLU",72,0)
 
1036
 I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)),($P(X," ml/hr")'=+$P(X," ml/hr")!(+$P(X," ml/hr")<0)) K X Q
 
1037
"RTN","PSJHLU",73,0)
 
1038
 I X=+X S X=X_" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q
 
1039
"RTN","PSJHLU",74,0)
 
1040
 I X[" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q
 
1041
"RTN","PSJHLU",75,0)
 
1042
 S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr" S FREQ=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL
 
1043
"RTN","PSJHLU",76,0)
 
1044
 Q
 
1045
"RTN","PSJHLU",77,0)
 
1046
SPSOL S SPSOL=+TVOLUME Q
 
1047
"VER")
 
1048
8.0^22.0
 
1049
**END**
 
1050
**END**