- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJHL3.m
r613 r623 1 PSJHL3 ;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 ; 19 EN1(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 30 INIT ; initialize HL7 variables 31 D INIT^PSJHLU 32 Q 33 RXO ; 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 46 RXE ; 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 82 IVRXE ; 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 109 RXC ;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 128 RXR ; 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 142 ZRX ; pharmacy Z-segment 143 D ZRX^PSJHLU 144 Q 145 CNT ;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 1 PSJHL3 ;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 ; 18 EN1(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 ; 30 INIT ; initialize HL7 variables 31 D INIT^PSJHLU 32 Q 33 ; 34 RXO ; 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 ; 46 RXE ; 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 ; 86 IVRXE ; 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 ; 112 RXC ;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 ; 132 RXR ; 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 ; 142 ZRX ; 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 ; 158 CNT ;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 TracChangeset
for help on using the changeset viewer.
