source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL3.m@ 1684

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 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**;16 DEC 97
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 ;
18EN1(PSJHLDFN,PSOC,PSJORDER) ; start here
19 ; passed in are PSJHLDFN (patient ien)
20 ; PSJORDER (file root of order)
21 ; OC (order control code - NW for new order, OK for finished order, OC for order canceled)
22 I $G(PSJHLDFN)']""!$G(PSOC)']""!$G(PSJORDER)']"" W !,"INSUFFICIENT DATA FOR ^PSJHL3" Q
23 N COMMENTS,DDIEA,DDNUM,DOSE,DOSEFORM,DOSEOR,NAME,DURATION,IVTYPE,NODE1,NODE2,NDNODE,OINODE,PSGPLS,PSGPLF,PRODNAME,SPDIEN,UNIT,UNITS,CNT,DDIEN,SCHEDULE
24 D INIT
25 S IVTYPE=$S(RXORDER["U":"",1:$$IVTYPE^PSJHLU(PSJORDER))
26 D RXO,RXE D:(IVTYPE'="F")!($G(PSJBCBU)) RXR D ZRX
27 D CALL^PSJHLU(PSJI)
28 Q
29 ;
30INIT ; initialize HL7 variables
31 D INIT^PSJHLU
32 Q
33 ;
34RXO ; pharmacy prescription order segment (used to send Orderable Item to OE/RR)
35 S LIMIT=17 X PSJCLEAR
36 S FIELD(0)="RXO"
37 S OINODE=$G(@(PSJORDER_".2)"))
38 S SPDIEN=+$P(OINODE,"^"),DOSEOR=$P(OINODE,"^",2),DOSE=$P(OINODE,"^",5),UNIT=$P(OINODE,"^",6)
39 S FIELD(1)=$S(SPDIEN=0:"^^^^",1:"^^^"_SPDIEN_"^")
40 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
41 S FIELD(1)=FIELD(1)_"^99PSP"
42 N DURNOD S DURNOD=$G(@(PSJORDER_"2.5)")) I $P(DURNOD,"^",4)]"" S $P(FIELD(1),"^",3)=$P(DURNOD,"^",4)
43 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
44 Q
45 ;
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)"))
50 I RXORDER["V" D IVRXE Q
51 I RXORDER["P",IVTYPE="F" D IVRXE Q
52 I RXORDER["P",$P(NODE1,"^",4)="H" D IVRXE Q
53 ;S PSGPLS=$P(NODE2,"^",2),PSGPLF=$P(NODE2,"^",4),X1=PSGPLF,X2=PSGPLS D ^%DTC S DURATION="D"_X
54 N RENEW S RENEW=$$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER)
55 S PSGPLS=$S($G(PSJEXPOE):$P(NODE2,"^",2),RENEW>$P(NODE2,"^",2):RENEW,1:$P(NODE2,"^",2))
56 S PSGPLF=$S($G(PSJEXPOE):PSJEXPOE,1:$P(NODE2,"^",4))
57 ;S FIELD(1)="^"_$P(NODE2,"^")_$S($G(PSJBCBU):"&"_$P(NODE2,"^",5),1:"")_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)
58 S FIELD(1)="^"_$P(NODE2,"^")_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)
59 S FIELD(21)="^"_$P(NODE2,"^",5)_"^99PSA^^^"
60 I ($G(DOSEOR)']"")!($O(@(PSJORDER_"1,"" "")"),-1)=1) D
61 .S (CNT,DDNUM)=0 F S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM Q:CNT=1 S DDIEN=+$G(@(PSJORDER_"1,"_DDNUM_",0)")) D
62 ..S FIELD(1)=$S($P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2)="":"1",1:$P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2))_"&"_FIELD(1)
63 ..S FIELD(1)=DOSE_"&"_UNIT_"&"_FIELD(1),$P(FIELD(1),"^",8)=$S($G(DOSEOR)]"":$G(DOSEOR),1:DOSE_UNIT)
64 ..S:$P(FIELD(1),"^",8)="" $P(FIELD(1),"^",8)=$G(@(PSJORDER_".3)"))
65 ..S NDNODE=$G(^PSDRUG(DDIEN,"ND"))
66 ..; CHANGE FOR NEW NDF CALL
67 ..;S PRODNAME=$S($G(^PSNDF(+NDNODE,5,+$P(NDNODE,"^",3),0))]"":^(0),1:"N/A")
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_"^"_$P($G(^PSDRUG(DDIEN,0)),"^")_"^"_"99PSD"
71 ..;S UNITS=$S(PRODNAME="N/A":"N/A",1:$P($G(^PSNDF(+NDNODE,2,+$P(PRODNAME,"^",2),3,+$P(PRODNAME,"^",3),4,+$P(PRODNAME,"^",4),0)),"^"))
72 ..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)),"^")))
73 ..S FIELD(5)="^^^"_UNITS_"^"_$P($G(^PS(50.607,UNITS,0)),"^")_"^99PSU"
74 ..S FIELD(6)="^^^"_$G(DOSEFORM)_"^"_$P($G(^PS(50.606,+$G(DOSEFORM),0)),"^")_"^99PSF"
75 ..S FIELD(25)=$$EN^PSSUTIL1(DDIEN),FIELD(26)=$P(FIELD(25),"|",2),FIELD(25)=$P(FIELD(25),"|")
76 ..S CNT=CNT+1
77 E S $P(FIELD(1),"^",8)=DOSEOR
78 S NAME=$P($G(^VA(200,DUZ,0)),"^"),FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
79 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
80 K SEGMENT S JJ=0 F S JJ=$O(@(PSJORDER_"12,"_JJ_")")) Q:'JJ S SEGMENT(JJ-1)=$G(@(PSJORDER_"12,"_JJ_",0)"))
81 I $D(SEGMENT(0)) S SEGMENT(0)="NTE|6|L|"_SEGMENT(0) D SET^PSJHLU K SEGMENT,JJ
82 I $P($G(@(PSJORDER_"6)")),"^")]"" K SEGMENT S SEGMENT(0)="NTE|21|L|"_$P($G(@(PSJORDER_"6)")),"^") D SET^PSJHLU K SEGMENT
83 I PSJORDER["P",$P($G(@(PSJORDER_"9)")),"^",2)]"" K SEGMENT S SEGMENT(0)="NTE|21|L|"_$P($G(@(PSJORDER_"9)")),"^",2) D SET^PSJHLU K SEGMENT
84 Q
85 ;
86IVRXE ; RXE segment for IV orders
87 ; if it's an Inpatient Med IV order, send the RXE with dispense drug
88 ; information. If it's an IV FLUID order, send just the start/stop
89 ; date, duration in the RXE and send an RXC for each additive and
90 ; solution.
91 N ADSNODE
92 I RXORDER["V" S PSGPLS=$P(NODE1,"^",2),PSGPLF=$P(NODE1,"^",3)
93 E S PSGPLS=$P(NODE2,"^",2),PSGPLF=$P(NODE2,"^",4)
94 ;S X1=PSGPLF,X2=PSGPLS D ^%DTC S DURATION=$S(X]"":"D"_X,1:"")
95 S FIELD(1)="^"_$S(PSJORDER["IV":$P(NODE1,"^",9),1:$P(NODE2,"^"))_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)
96 ;S:$G(PSJBCBU) $P(FIELD(1),"^",2)=$P(FIELD(1),"^",2)_"&"_$S(PSJORDER["IV":$P(NODE1,"^",11),1:$P(NODE2,"^",5))
97 S FIELD(21)="^"_$S(PSJORDER["IV":$P(NODE1,"^",11),1:$P(NODE2,"^",5))_"^99PSA^^^"
98 S NAME=$P($G(^VA(200,DUZ,0)),"^")
99 S FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
100 N X,Y
101 I RXORDER["V" S INFUSE=$P(NODE1,"^",8)
102 E S INFUSE=$P($G(@(PSJORDER_"8)")),"^",5)
103 I INFUSE?1N.N1" ml/hr" S FIELD(23)=+INFUSE,Y=$P(INFUSE,+INFUSE,2),Y=$$TRIM^XLFSTR(Y,"LR"," "),FIELD(24)="^^^^"_Y_"^PSU"
104 I FIELD(23)="",FIELD(24)="" S FIELD(23)=INFUSE
105 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
106 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)"))
107 E S JJ=0 F S JJ=$O(@(PSJORDER_"12,"_JJ_")")) Q:'JJ S SEGMENT(JJ-1)=$G(@(PSJORDER_"12,"_JJ_",0)"))
108 I $D(SEGMENT(0)) S SEGMENT(0)="NTE|6|L|"_SEGMENT(0) D SET^PSJHLU K SEGMENT,JJ
109 I RXORDER["V",$P($G(@(PSJORDER_"3)")),"^")]"" K SEGMENT S SEGMENT(0)="NTE|21|L|"_$P($G(@(PSJORDER_"3)")),"^") D SET^PSJHLU K SEGMENT
110 I RXORDER["P",$P($G(@(PSJORDER_"9)")),U,2)]"" S SEGMENT(0)="NTE|21|L|"_$P($G(@(PSJORDER_"9)")),U,2) D SET^PSJHLU K SEGMENT
111 ;
112RXC ;component segments
113 N ADDITIVE,SOLUTION,SUB,TYPE,AD,SOL,PTR,NUM,UTMP,XTMP
114 S LIMIT=24 X PSJCLEAR
115 S FIELD(0)="RXC"
116 ; In the line below, the naked reference refers to the full global reference represented in PSJORDER_TYPE...
117 ; This could be a reference to either ^PS(53.1 or ^PS(55
118 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
119 .S FIELD(1)=$S(TYPE="AD":"A",1:"B")
120 .S PTR=+$S(TYPE="AD":+$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",11),1:+$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",11))
121 .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)),"^"))
122 .S:(TYPE="AD"&$G(PSJBCBU)) FIELD(2)=FIELD(2)_$S($P(NODE1,"^",3)]"":" BOTTLE: "_$P(NODE1,"^",3),1:"")
123 .S FIELD(2)=FIELD(2)_"^99PSP"
124 .S FIELD(3)=$P($P(NODE1,"^",2)," ")
125 .S FIELD(4)=$P($P(NODE1,"^",2)," ",2)
126 .F XTMP=1:1:13 S UTMP($P("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM","^",XTMP))="PSIV-"_XTMP
127 .S NUM="" S:FIELD(4)'="" NUM=$G(UTMP(FIELD(4)))
128 .S FIELD(4)="^^^"_NUM_"^"_FIELD(4)_"^99OTH"
129 .D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
130 Q
131 ;
132RXR ; med route segment
133 S LIMIT=4 X PSJCLEAR
134 S FIELD(0)="RXR"
135 I PSJORDER["IV" S FIELD(1)="^^^"_$P($G(@(PSJORDER_".2)")),"^",3) Q:$P(FIELD(1),U,4)="" D
136 .S FIELD(1)=FIELD(1)_"^"_$P($G(^PS(51.2,+$P(FIELD(1),"^",4),0)),"^")_"^99PSR"
137 .S:$G(PSJBCBU) FIELD(4)="^^^"_$P($G(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($P($G(@(PSJORDER_"0)")),"^",4),55.01,.04)_"^99PSR"
138 S:FIELD(1)="" FIELD(1)="^^^"_$P(NODE1,"^",3)_"^"_$P($G(^PS(51.2,+$P(NODE1,"^",3),0)),"^")_"^99PSR"
139 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
140 Q
141 ;
142ZRX ; pharmacy Z-segment
143 S LIMIT=6 X PSJCLEAR
144 S FIELD(0)="ZRX"
145 I '$G(PSJREN) N PREON,PSJREN I $G(PSJORD)["U"&($P(NODE1,"^",24)="R") S PSJREN=1
146 I $G(PSJORD)["V"&($P(NODE2,"^",8)="R") S PSJREN=1
147 S PREON=$S($G(PSJREN):$G(PSJORD),PSJORDER["IV":$P(NODE2,"^",5),1:$P(NODE1,"^",25))
148 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))
149 S FIELD(2)=$S(PSJORDER["IV":$G(P("NAT")),1:$G(PSJNOO))
150 S FIELD(3)=$S($G(PSJREN):"R",PSJORDER["IV":$P(NODE2,"^",8),1:$P(NODE1,"^",24))
151 I FIELD(3)="" I PSOC="SN" S FIELD(3)="N"
152 S NAME=$P($G(^VA(200,DUZ,0)),"^")
153 S FIELD(5)=DUZ_"^"_NAME_"^"_"99NP"
154 S FIELD(6)=$S($G(IVTYPE)="F":"IV",$P($G(@(PSJORDER_"0)")),U,4)="H":"TPN",1:"")
155 D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
156 Q
157 ;
158CNT ;Count dispense drugs for an order
159 S (CNT,DDNUM)=0 F S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM S CNT=CNT+1
160 Q
Note: See TracBrowser for help on using the repository browser.