source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL3.m@ 619

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

initial load of WorldVistAEHR
File size: 9.2 KB
Line 
1PSJHL3 ;BIR/RLW-PHARMACY ORDER SEGMENTS ;04 Aug 98 / 10:10 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**1,11,14,40,42,47,50,56,58,92,101,102,123,110,111,152,134**;16 DEC 97;Build 124
3 ;
4 ; Reference to ^PS(50.606 is supported by DBIA# 2174.
5 ; Reference to ^PS(50.607 is supported by DBIA# 2221.
6 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
7 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
8 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
9 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
10 ; Reference to ^PS(55 is supported by DBIA# 2191.
11 ; Reference to ^PSDRUG( is supported by DBIA# 2192.
12 ; Reference to ^PSNDF( is supported by DBIA# 2195.
13 ; Reference to ^VA(200 is supported by DBIA# 10060.
14 ; Reference to ^PSNAPIS is supported by DBIA# 2531.
15 ; Reference to ^XLFDT is supported by DBIA# 10103.
16 ; Reference to ^PSSUTIL1 is supported by DBIA# 3179.
17 ; Reference to ^ORHLESC is supported by DBIA# 4922.
18 ;
19EN1(PSJHLDFN,PSOC,PSJORDER) ; start here
20 ; passed in are PSJHLDFN (patient ien)
21 ; PSJORDER (file root of order)
22 ; OC (order control code - NW for new order, OK for finished order, OC for order canceled)
23 I $G(PSJHLDFN)']""!$G(PSOC)']""!$G(PSJORDER)']"" W !,"INSUFFICIENT DATA FOR ^PSJHL3" Q
24 N COMMENTS,DDIEA,DDNUM,DOSE,DOSEFORM,DOSEOR,NAME,DURATION,IVTYPE,NODE1,NODE2,NDNODE,OINODE,PSGPLS,PSGPLF,PRODNAME,SPDIEN,UNIT,UNITS,CNT,DDIEN,SCHEDULE,PSGST
25 D INIT
26 S IVTYPE=$S(RXORDER["U":"",1:$$IVTYPE^PSJHLU(PSJORDER))
27 D RXO,RXE,RXR D ZRX
28 D CALL^PSJHLU(PSJI)
29 Q
30INIT ; initialize HL7 variables
31 D INIT^PSJHLU
32 Q
33RXO ; pharmacy prescription order segment (used to send Orderable Item to OE/RR)
34 S LIMIT=17 X PSJCLEAR
35 S FIELD(0)="RXO"
36 S OINODE=$G(@(PSJORDER_".2)"))
37 S SPDIEN=+$P(OINODE,"^"),DOSEOR=$$ESC^ORHLESC($P(OINODE,"^",2)),DOSE=$P(OINODE,"^",5),UNIT=$P(OINODE,"^",6) S:'$G(PSJBCBU) UNIT=$$ESC^ORHLESC(UNIT)
38 S FIELD(1)=$S(SPDIEN=0:"^^^^",1:"^^^"_SPDIEN_"^")
39 I SPDIEN S DOSEFORM=$P($G(^PS(50.7,SPDIEN,0)),"^",2),NAME=$P($G(^PS(50.606,+DOSEFORM,0)),"^") S:'$G(PSJBCBU) NAME=$$ESC^ORHLESC(NAME) S FIELD(1)=FIELD(1)_$$ESC^ORHLESC($P($G(^PS(50.7,SPDIEN,0)),"^"))_" "_NAME
40 S FIELD(1)=FIELD(1)_"^99PSP"
41 N IVLNOD S IVLNOD=$G(@(PSJORDER_"2.5)")) D
42 .S IVLIM=$P(IVLNOD,"^",4) I IVLIM?1"a".N S IVLIM="doses"_$P(IVLIM,"a",2)
43 .S $P(FIELD(1),"^",3)=IVLIM
44 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
45 Q
46RXE ; pharmacy encoded order segment
47 S (UNITS,NDNODE,SPDIEN,PRODNAME,DDNUM,DDIEN,CNT)="",LIMIT=26 X PSJCLEAR
48 S FIELD(0)="RXE"
49 S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)")),NODEPT2=$G(@(PSJORDER_".2)"))
50 I $G(PSGST)="" N PSGST D
51 .I $G(RXORDER)["V" N X,ZZND,LYN,PSGS0XT,PSGS0Y,PSGOES S PSGOES=1 S X=$G(P(9)) I X]"" D EN^PSGS0 S:$G(ZZND)'="" PSGST=$P(ZZND,"^",5) Q
52 .S PSGST=$P($G(NODE1),"^",7)
53 I RXORDER["V" D IVRXE Q
54 I RXORDER["P",IVTYPE="F" D IVRXE Q
55 I RXORDER["P",$P(NODE1,"^",4)="H" D IVRXE Q
56 N RENEW S RENEW=$$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER)
57 S PSGPLS=$S($G(PSJEXPOE):$P(NODE2,"^",2),RENEW>$P(NODE2,"^",2):RENEW,1:$P(NODE2,"^",2))
58 S PSGPLF=$S($G(PSJEXPOE):PSJEXPOE,1:$P(NODE2,"^",4))
59 S FIELD(1)="^"_$S($G(PSJBCBU):$P(NODE2,"^"),1:$$ESC^ORHLESC($P(NODE2,"^")))_"&"_$P(NODE2,"^",5)_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"_$P($G(NODEPT2),"^",4)_"^"_$G(PSGST)
60 S FIELD(21)="^"_$P(NODE2,"^",5)_"^99PSA^^^"
61 I ($G(DOSEOR)']"")!($O(@(PSJORDER_"1,"" "")"),-1)=1) D
62 .S (CNT,DDNUM)=0 F S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM Q:CNT=1 S DDIEN=+$G(@(PSJORDER_"1,"_DDNUM_",0)")) D
63 ..S FIELD(1)=$S($P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2)="":"1",1:$P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2))_"&"_FIELD(1)
64 ..S FIELD(1)=DOSE_"&"_UNIT_"&"_FIELD(1),$P(FIELD(1),"^",8)=$S($G(DOSEOR)]"":$G(DOSEOR),1:DOSE_UNIT)
65 ..S:$P(FIELD(1),"^",8)="" $P(FIELD(1),"^",8)=$$ESC^ORHLESC($G(@(PSJORDER_".3)")))
66 ..S NDNODE=$G(^PSDRUG(DDIEN,"ND"))
67 ..; CHANGE FOR NEW NDF CALL
68 ..S PRODNAME=$S($T(^PSNAPIS)]"":$$PROD0^PSNAPIS(+NDNODE,$P(NDNODE,"^",3)),$G(^PSNDF(+NDNODE,5,+$P(NDNODE,"^",3),0))]"":^(0),1:"N/A")
69 ..S:PRODNAME="" PRODNAME="N/A"
70 ..S FIELD(2)=$S(PRODNAME="N/A":"^^",1:+NDNODE_"."_+$P(NDNODE,"^",3)_"^"_$P(NDNODE,"^",2)_"^"_"99NDF")_"^"_DDIEN_"^"_$S($G(PSJBCBU):$P($G(^PSDRUG(DDIEN,0)),"^"),1:$$ESC^ORHLESC($P($G(^PSDRUG(DDIEN,0)),"^")))_"^"_"99PSD"
71 ..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)),"^")))
72 ..S FIELD(5)="^^^"_$$ESC^ORHLESC(UNITS)_"^"_$$ESC^ORHLESC($P($G(^PS(50.607,UNITS,0)),"^"))_"^99PSU"
73 ..S FIELD(6)="^^^"_$$ESC^ORHLESC($G(DOSEFORM))_"^"_$$ESC^ORHLESC($P($G(^PS(50.606,+$G(DOSEFORM),0)),"^"))_"^99PSF"
74 ..S FIELD(25)=$$EN^PSSUTIL1(DDIEN),FIELD(26)=$P(FIELD(25),"|",2),FIELD(25)=$P(FIELD(25),"|")
75 ..I $P(FIELD(25),"^",5)]"" S $P(FIELD(25),"^",5)=$$ESC^ORHLESC($P(FIELD(25),"^",5))
76 ..S CNT=CNT+1
77 E S $P(FIELD(1),"^",8)=$$ESC^ORHLESC(DOSEOR)
78 S NAME=$P($G(^VA(200,DUZ,0)),"^") S:'$G(PSJBCBU) NAME=$$ESC^ORHLESC(NAME) S FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
79 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
80 D SEGMENT2^PSJHLU
81 Q
82IVRXE ; RXE segment for IV orders
83 ; If an Inpatient Med IV order, send RXE w/dispense drug info.
84 ; If an IV FLUID order, send start/stop date and duration in the RXE
85 ; and send an RXC for each additive and solution.
86 N ADSNODE
87 I RXORDER["V" S PSGPLS=$P(NODE1,"^",2),PSGPLF=$P(NODE1,"^",3)
88 E S PSGPLS=$P(NODE2,"^",2),PSGPLF=$P(NODE2,"^",4)
89 S FIELD(1)="^"_$S(PSJORDER["IV":($P(NODE1,"^",9)_"&"_$P(NODE1,"^",11)),1:$P(NODE2,"^"))_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"_$G(P("PRY"))
90 S FIELD(21)="^"_$S(PSJORDER["IV":$P(NODE1,"^",11),1:$P(NODE2,"^",5))_"^99PSA^^^"
91 S NAME=$P($G(^VA(200,DUZ,0)),"^") S:'$G(PSJBCBU) NAME=$$ESC^ORHLESC(NAME)
92 S FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
93 N X,Y
94 I RXORDER["V" S INFUSE=$P(NODE1,"^",8)
95 E S INFUSE=$P($G(@(PSJORDER_"8)")),"^",5)
96 I INFUSE?1N.N1" ml/hr" S FIELD(23)=+INFUSE,Y=$P(INFUSE,+INFUSE,2),Y=$$TRIM^XLFSTR(Y,"LR"," "),FIELD(24)="^^^^"_Y_"^PSU"
97 I FIELD(23)="",FIELD(24)="" S FIELD(23)=INFUSE
98 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
99 K SEGMENT I RXORDER["V" S JJ=0 F S JJ=$O(@(PSJORDER_"5,"_JJ_")")) Q:'JJ S SEGMENT(JJ-1)=$S($G(PSJBCBU):$G(@(PSJORDER_"5,"_JJ_",0)")),1:$$ESC^ORHLESC($G(@(PSJORDER_"5,"_JJ_",0)"))))
100 E S JJ=0 F S JJ=$O(@(PSJORDER_"12,"_JJ_")")) Q:'JJ S SEGMENT(JJ-1)=$S($G(PSJBCBU):$G(@(PSJORDER_"12,"_JJ_",0)")),1:$G(@(PSJORDER_"12,"_JJ_",0)")))
101 I $D(SEGMENT(0)) S SEGMENT(0)="NTE|6|L|"_SEGMENT(0) D
102 .D SET^PSJHLU K SEGMENT,JJ
103 I RXORDER["V",$P($G(@(PSJORDER_"3)")),"^")]"" K SEGMENT D
104 .S SEGMENT(0)="NTE|21|L|"_$S($G(PSJSBCBU):$P($G(@(PSJORDER_"3)")),"^"),1:$$ESC^ORHLESC($P($G(@(PSJORDER_"3)")),"^"))) D
105 .D SET^PSJHLU K SEGMENT
106 I RXORDER["P",$P($G(@(PSJORDER_"9)")),U,2)]"" K SEGMENT D
107 .S SEGMENT(0)="NTE|21|L|"_$S($G(PSJSBCBU):$P($G(@(PSJORDER_"9)")),U,2),1:$$ESC^ORHLESC($P($G(@(PSJORDER_"9)")),U,2))) D
108 .D SET^PSJHLU K SEGMENT
109RXC ;component segments
110 N ADDITIVE,SOLUTION,SUB,TYPE,AD,SOL,PTR,NUM,UTMP,XTMP
111 S LIMIT=24 X PSJCLEAR
112 S FIELD(0)="RXC"
113 ; In the line below, the naked reference refers to the full global reference represented in PSJORDER_TYPE...
114 ; This could be a reference to either ^PS(53.1 or ^PS(55
115 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
116 .S FIELD(1)=$S(TYPE="AD":"A",1:"B")
117 .S PTR=+$S(TYPE="AD":+$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",11),1:+$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",11))
118 .S 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)),"^"))
119 .S:(TYPE="AD"&$G(PSJBCBU)) FIELD(2)=FIELD(2)_$S($P(NODE1,"^",3)]"":" BOTTLE: "_$P(NODE1,"^",3),1:"")
120 .S FIELD(2)=FIELD(2)_"^99PSP"
121 .S FIELD(3)=$P($P(NODE1,"^",2)," ")
122 .S FIELD(4)=$P($P(NODE1,"^",2)," ",2)
123 .F XTMP=1:1:14 S UTMP($P("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL","^",XTMP))="PSIV-"_XTMP
124 .S NUM="" S:FIELD(4)'="" NUM=$G(UTMP(FIELD(4)))
125 .S FIELD(4)="^^^"_NUM_"^"_FIELD(4)_"^99OTH"
126 .D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
127 Q
128RXR ; med route segment
129 S LIMIT=4 X PSJCLEAR
130 S FIELD(0)="RXR"
131 I PSJORDER["IV" S FIELD(1)="^^^"_$P($G(@(PSJORDER_".2)")),"^",3) Q:$P(FIELD(1),U,4)="" D
132 .N PSJUNITS S PSJUNITS=$S($G(PSJBCBU):$P($G(^PS(51.2,+$P(FIELD(1),"^",4),0)),"^"),1:$$ESC^ORHLESC($P($G(^PS(51.2,+$P(FIELD(1),"^",4),0)),"^")))
133 .S FIELD(1)=FIELD(1)_"^"_PSJUNITS_"^99PSR"
134 .S:$G(PSJBCBU) FIELD(4)="^^^"_$P($G(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($P($G(@(PSJORDER_"0)")),"^",4),55.01,.04)_"^99PSR"
135 I PSJORDER[53.1 S FIELD(1)="^^^"_$P($G(@(PSJORDER_"0)")),"^",3) Q:$P(FIELD(1),U,4)="" D
136 .N PSJUNITS S PSJUNITS=$S($G(PSJBCBU):$P($G(^PS(51.2,+$P(FIELD(1),"^",4),0)),"^"),1:$$ESC^ORHLESC($P($G(^PS(51.2,+$P(FIELD(1),"^",4),0)),"^")))
137 .S FIELD(1)=FIELD(1)_"^"_PSJUNITS_"^99PSR"
138 .S:$G(PSJBCBU) FIELD(4)="^^^"_$P($G(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($P($G(@(PSJORDER_"0)")),"^",4),53.1,4)_"^99PSR"
139 S:FIELD(1)="" FIELD(1)="^^^"_$P(NODE1,"^",3)_"^"_$S($G(PSJBCBU):$P($G(^PS(51.2,+$P(NODE1,"^",3),0)),"^"),1:$$ESC^ORHLESC($P($G(^PS(51.2,+$P(NODE1,"^",3),0)),"^")))_"^99PSR"
140 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
141 Q
142ZRX ; pharmacy Z-segment
143 D ZRX^PSJHLU
144 Q
145CNT ;Count dispense drugs for an order
146 S (CNT,DDNUM)=0 F S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM S CNT=CNT+1
147 Q
Note: See TracBrowser for help on using the repository browser.