- PSJHL3 ;BIR/RLW-PHARMACY ORDER SEGMENTS ;04 Aug 98 / 10:10 AM
- ;;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
- ;
- ; Reference to ^PS(50.606 is supported by DBIA# 2174.
- ; Reference to ^PS(50.607 is supported by DBIA# 2221.
- ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- ; Reference to ^PS(51.2 is supported by DBIA# 2178.
- ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PSDRUG( is supported by DBIA# 2192.
- ; Reference to ^PSNDF( is supported by DBIA# 2195.
- ; Reference to ^VA(200 is supported by DBIA# 10060.
- ; Reference to ^PSNAPIS is supported by DBIA# 2531.
- ; Reference to ^XLFDT is supported by DBIA# 10103.
- ; Reference to ^PSSUTIL1 is supported by DBIA# 3179.
- ; Reference to ^ORHLESC is supported by DBIA# 4922.
- ;
- EN1(PSJHLDFN,PSOC,PSJORDER) ; start here
- ; passed in are PSJHLDFN (patient ien)
- ; PSJORDER (file root of order)
- ; OC (order control code - NW for new order, OK for finished order, OC for order canceled)
- I $G(PSJHLDFN)']""!$G(PSOC)']""!$G(PSJORDER)']"" W !,"INSUFFICIENT DATA FOR ^PSJHL3" Q
- N COMMENTS,DDIEA,DDNUM,DOSE,DOSEFORM,DOSEOR,NAME,DURATION,IVTYPE,NODE1,NODE2,NDNODE,OINODE,PSGPLS,PSGPLF,PRODNAME,SPDIEN,UNIT,UNITS,CNT,DDIEN,SCHEDULE,PSGST
- D INIT
- S IVTYPE=$S(RXORDER["U":"",1:$$IVTYPE^PSJHLU(PSJORDER))
- D RXO,RXE,RXR D ZRX
- D CALL^PSJHLU(PSJI)
- Q
- INIT ; initialize HL7 variables
- D INIT^PSJHLU
- Q
- RXO ; pharmacy prescription order segment (used to send Orderable Item to OE/RR)
- S LIMIT=17 X PSJCLEAR
- S FIELD(0)="RXO"
- S OINODE=$G(@(PSJORDER_".2)"))
- 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)
- S FIELD(1)=$S(SPDIEN=0:"^^^^",1:"^^^"_SPDIEN_"^")
- 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
- S FIELD(1)=FIELD(1)_"^99PSP"
- N IVLNOD S IVLNOD=$G(@(PSJORDER_"2.5)")) D
- .S IVLIM=$P(IVLNOD,"^",4) I IVLIM?1"a".N S IVLIM="doses"_$P(IVLIM,"a",2)
- .S $P(FIELD(1),"^",3)=IVLIM
- D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
- Q
- RXE ; pharmacy encoded order segment
- S (UNITS,NDNODE,SPDIEN,PRODNAME,DDNUM,DDIEN,CNT)="",LIMIT=26 X PSJCLEAR
- S FIELD(0)="RXE"
- S NODE1=$G(@(PSJORDER_"0)")),NODE2=$G(@(PSJORDER_"2)")),NODEPT2=$G(@(PSJORDER_".2)"))
- I $G(PSGST)="" N PSGST D
- .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
- .S PSGST=$P($G(NODE1),"^",7)
- I RXORDER["V" D IVRXE Q
- I RXORDER["P",IVTYPE="F" D IVRXE Q
- I RXORDER["P",$P(NODE1,"^",4)="H" D IVRXE Q
- N RENEW S RENEW=$$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER)
- S PSGPLS=$S($G(PSJEXPOE):$P(NODE2,"^",2),RENEW>$P(NODE2,"^",2):RENEW,1:$P(NODE2,"^",2))
- S PSGPLF=$S($G(PSJEXPOE):PSJEXPOE,1:$P(NODE2,"^",4))
- 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)
- S FIELD(21)="^"_$P(NODE2,"^",5)_"^99PSA^^^"
- I ($G(DOSEOR)']"")!($O(@(PSJORDER_"1,"" "")"),-1)=1) D
- .S (CNT,DDNUM)=0 F S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM Q:CNT=1 S DDIEN=+$G(@(PSJORDER_"1,"_DDNUM_",0)")) D
- ..S FIELD(1)=$S($P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2)="":"1",1:$P(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2))_"&"_FIELD(1)
- ..S FIELD(1)=DOSE_"&"_UNIT_"&"_FIELD(1),$P(FIELD(1),"^",8)=$S($G(DOSEOR)]"":$G(DOSEOR),1:DOSE_UNIT)
- ..S:$P(FIELD(1),"^",8)="" $P(FIELD(1),"^",8)=$$ESC^ORHLESC($G(@(PSJORDER_".3)")))
- ..S NDNODE=$G(^PSDRUG(DDIEN,"ND"))
- ..; CHANGE FOR NEW NDF CALL
- ..S PRODNAME=$S($T(^PSNAPIS)]"":$$PROD0^PSNAPIS(+NDNODE,$P(NDNODE,"^",3)),$G(^PSNDF(+NDNODE,5,+$P(NDNODE,"^",3),0))]"":^(0),1:"N/A")
- ..S:PRODNAME="" PRODNAME="N/A"
- ..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"
- ..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)),"^")))
- ..S FIELD(5)="^^^"_$$ESC^ORHLESC(UNITS)_"^"_$$ESC^ORHLESC($P($G(^PS(50.607,UNITS,0)),"^"))_"^99PSU"
- ..S FIELD(6)="^^^"_$$ESC^ORHLESC($G(DOSEFORM))_"^"_$$ESC^ORHLESC($P($G(^PS(50.606,+$G(DOSEFORM),0)),"^"))_"^99PSF"
- ..S FIELD(25)=$$EN^PSSUTIL1(DDIEN),FIELD(26)=$P(FIELD(25),"|",2),FIELD(25)=$P(FIELD(25),"|")
- ..I $P(FIELD(25),"^",5)]"" S $P(FIELD(25),"^",5)=$$ESC^ORHLESC($P(FIELD(25),"^",5))
- ..S CNT=CNT+1
- E S $P(FIELD(1),"^",8)=$$ESC^ORHLESC(DOSEOR)
- S NAME=$P($G(^VA(200,DUZ,0)),"^") S:'$G(PSJBCBU) NAME=$$ESC^ORHLESC(NAME) S FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
- D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
- D SEGMENT2^PSJHLU
- Q
- IVRXE ; RXE segment for IV orders
- ; If an Inpatient Med IV order, send RXE w/dispense drug info.
- ; If an IV FLUID order, send start/stop date and duration in the RXE
- ; and send an RXC for each additive and solution.
- N ADSNODE
- I RXORDER["V" S PSGPLS=$P(NODE1,"^",2),PSGPLF=$P(NODE1,"^",3)
- E S PSGPLS=$P(NODE2,"^",2),PSGPLF=$P(NODE2,"^",4)
- S FIELD(1)="^"_$S(PSJORDER["IV":($P(NODE1,"^",9)_"&"_$P(NODE1,"^",11)),1:$P(NODE2,"^"))_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"_$G(P("PRY"))
- S FIELD(21)="^"_$S(PSJORDER["IV":$P(NODE1,"^",11),1:$P(NODE2,"^",5))_"^99PSA^^^"
- S NAME=$P($G(^VA(200,DUZ,0)),"^") S:'$G(PSJBCBU) NAME=$$ESC^ORHLESC(NAME)
- S FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
- N X,Y
- I RXORDER["V" S INFUSE=$P(NODE1,"^",8)
- E S INFUSE=$P($G(@(PSJORDER_"8)")),"^",5)
- I INFUSE?1N.N1" ml/hr" S FIELD(23)=+INFUSE,Y=$P(INFUSE,+INFUSE,2),Y=$$TRIM^XLFSTR(Y,"LR"," "),FIELD(24)="^^^^"_Y_"^PSU"
- I FIELD(23)="",FIELD(24)="" S FIELD(23)=INFUSE
- D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
- 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)"))))
- 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)")))
- I $D(SEGMENT(0)) S SEGMENT(0)="NTE|6|L|"_SEGMENT(0) D
- .D SET^PSJHLU K SEGMENT,JJ
- I RXORDER["V",$P($G(@(PSJORDER_"3)")),"^")]"" K SEGMENT D
- .S SEGMENT(0)="NTE|21|L|"_$S($G(PSJSBCBU):$P($G(@(PSJORDER_"3)")),"^"),1:$$ESC^ORHLESC($P($G(@(PSJORDER_"3)")),"^"))) D
- .D SET^PSJHLU K SEGMENT
- I RXORDER["P",$P($G(@(PSJORDER_"9)")),U,2)]"" K SEGMENT D
- .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
- .D SET^PSJHLU K SEGMENT
- RXC ;component segments
- N ADDITIVE,SOLUTION,SUB,TYPE,AD,SOL,PTR,NUM,UTMP,XTMP
- S LIMIT=24 X PSJCLEAR
- S FIELD(0)="RXC"
- ; In the line below, the naked reference refers to the full global reference represented in PSJORDER_TYPE...
- ; This could be a reference to either ^PS(53.1 or ^PS(55
- 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
- .S FIELD(1)=$S(TYPE="AD":"A",1:"B")
- .S PTR=+$S(TYPE="AD":+$P($G(^PS(52.6,$P(NODE1,"^"),0)),"^",11),1:+$P($G(^PS(52.7,$P(NODE1,"^"),0)),"^",11))
- .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)),"^"))
- .S:(TYPE="AD"&$G(PSJBCBU)) FIELD(2)=FIELD(2)_$S($P(NODE1,"^",3)]"":" BOTTLE: "_$P(NODE1,"^",3),1:"")
- .S FIELD(2)=FIELD(2)_"^99PSP"
- .S FIELD(3)=$P($P(NODE1,"^",2)," ")
- .S FIELD(4)=$P($P(NODE1,"^",2)," ",2)
- .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
- .S NUM="" S:FIELD(4)'="" NUM=$G(UTMP(FIELD(4)))
- .S FIELD(4)="^^^"_NUM_"^"_FIELD(4)_"^99OTH"
- .D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
- Q
- RXR ; med route segment
- S LIMIT=4 X PSJCLEAR
- S FIELD(0)="RXR"
- I PSJORDER["IV" S FIELD(1)="^^^"_$P($G(@(PSJORDER_".2)")),"^",3) Q:$P(FIELD(1),U,4)="" D
- .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)),"^")))
- .S FIELD(1)=FIELD(1)_"^"_PSJUNITS_"^99PSR"
- .S:$G(PSJBCBU) FIELD(4)="^^^"_$P($G(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($P($G(@(PSJORDER_"0)")),"^",4),55.01,.04)_"^99PSR"
- I PSJORDER[53.1 S FIELD(1)="^^^"_$P($G(@(PSJORDER_"0)")),"^",3) Q:$P(FIELD(1),U,4)="" D
- .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)),"^")))
- .S FIELD(1)=FIELD(1)_"^"_PSJUNITS_"^99PSR"
- .S:$G(PSJBCBU) FIELD(4)="^^^"_$P($G(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($P($G(@(PSJORDER_"0)")),"^",4),53.1,4)_"^99PSR"
- 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"
- D SEGMENT^PSJHLU(LIMIT),DISPLAY^PSJHL2
- Q
- ZRX ; pharmacy Z-segment
- D ZRX^PSJHLU
- Q
- CNT ;Count dispense drugs for an order
- S (CNT,DDNUM)=0 F S DDNUM=$O(@(PSJORDER_"1,"_DDNUM_")")) Q:'DDNUM S CNT=CNT+1
- Q
- PSJHL3 ;BIR/RLW-PHARMACY ORDER SEGMENTS ;04 Aug 98 / 10:10 AM
- +1 ;;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
- +2 ;
- +3 ; Reference to ^PS(50.606 is supported by DBIA# 2174.
- +4 ; Reference to ^PS(50.607 is supported by DBIA# 2221.
- +5 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- +6 ; Reference to ^PS(51.2 is supported by DBIA# 2178.
- +7 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- +8 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- +9 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +10 ; Reference to ^PSDRUG( is supported by DBIA# 2192.
- +11 ; Reference to ^PSNDF( is supported by DBIA# 2195.
- +12 ; Reference to ^VA(200 is supported by DBIA# 10060.
- +13 ; Reference to ^PSNAPIS is supported by DBIA# 2531.
- +14 ; Reference to ^XLFDT is supported by DBIA# 10103.
- +15 ; Reference to ^PSSUTIL1 is supported by DBIA# 3179.
- +16 ; Reference to ^ORHLESC is supported by DBIA# 4922.
- +17 ;
- EN1(PSJHLDFN,PSOC,PSJORDER) ; start here
- +1 ; passed in are PSJHLDFN (patient ien)
- +2 ; PSJORDER (file root of order)
- +3 ; OC (order control code - NW for new order, OK for finished order, OC for order canceled)
- +4 IF $GET(PSJHLDFN)']""!$GET(PSOC)']""!$GET(PSJORDER)']""
- WRITE !,"INSUFFICIENT DATA FOR ^PSJHL3"
- QUIT
- +5 NEW COMMENTS,DDIEA,DDNUM,DOSE,DOSEFORM,DOSEOR,NAME,DURATION,IVTYPE,NODE1,NODE2,NDNODE,OINODE,PSGPLS,PSGPLF,PRODNAME,SPDIEN,UNIT,UNITS,CNT,DDIEN,SCHEDULE,PSGST
- +6 DO INIT
- +7 SET IVTYPE=$SELECT(RXORDER["U":"",1:$$IVTYPE^PSJHLU(PSJORDER))
- +8 DO RXO
- DO RXE
- DO RXR
- DO ZRX
- +9 DO CALL^PSJHLU(PSJI)
- +10 QUIT
- INIT ; initialize HL7 variables
- +1 DO INIT^PSJHLU
- +2 QUIT
- RXO ; pharmacy prescription order segment (used to send Orderable Item to OE/RR)
- +1 SET LIMIT=17
- XECUTE PSJCLEAR
- +2 SET FIELD(0)="RXO"
- +3 SET OINODE=$GET(@(PSJORDER_".2)"))
- +4 SET SPDIEN=+$PIECE(OINODE,"^")
- SET DOSEOR=$$ESC^ORHLESC($PIECE(OINODE,"^",2))
- SET DOSE=$PIECE(OINODE,"^",5)
- SET UNIT=$PIECE(OINODE,"^",6)
- IF '$GET(PSJBCBU)
- SET UNIT=$$ESC^ORHLESC(UNIT)
- +5 SET FIELD(1)=$SELECT(SPDIEN=0:"^^^^",1:"^^^"_SPDIEN_"^")
- +6 IF SPDIEN
- SET DOSEFORM=$PIECE($GET(^PS(50.7,SPDIEN,0)),"^",2)
- SET NAME=$PIECE($GET(^PS(50.606,+DOSEFORM,0)),"^")
- IF '$GET(PSJBCBU)
- SET NAME=$$ESC^ORHLESC(NAME)
- SET FIELD(1)=FIELD(1)_$$ESC^ORHLESC($PIECE($GET(^PS(50.7,SPDIEN,0)),"^"))_" "_NAME
- +7 SET FIELD(1)=FIELD(1)_"^99PSP"
- +8 NEW IVLNOD
- SET IVLNOD=$GET(@(PSJORDER_"2.5)"))
- Begin DoDot:1
- +9 SET IVLIM=$PIECE(IVLNOD,"^",4)
- IF IVLIM?1"a".N
- SET IVLIM="doses"_$PIECE(IVLIM,"a",2)
- +10 SET $PIECE(FIELD(1),"^",3)=IVLIM
- End DoDot:1
- +11 DO SEGMENT^PSJHLU(LIMIT)
- DO DISPLAY^PSJHL2
- +12 QUIT
- RXE ; pharmacy encoded order segment
- +1 SET (UNITS,NDNODE,SPDIEN,PRODNAME,DDNUM,DDIEN,CNT)=""
- SET LIMIT=26
- XECUTE PSJCLEAR
- +2 SET FIELD(0)="RXE"
- +3 SET NODE1=$GET(@(PSJORDER_"0)"))
- SET NODE2=$GET(@(PSJORDER_"2)"))
- SET NODEPT2=$GET(@(PSJORDER_".2)"))
- +4 IF $GET(PSGST)=""
- NEW PSGST
- Begin DoDot:1
- +5 IF $GET(RXORDER)["V"
- NEW X,ZZND,LYN,PSGS0XT,PSGS0Y,PSGOES
- SET PSGOES=1
- SET X=$GET(P(9))
- IF X]""
- DO EN^PSGS0
- IF $GET(ZZND)'=""
- SET PSGST=$PIECE(ZZND,"^",5)
- QUIT
- +6 SET PSGST=$PIECE($GET(NODE1),"^",7)
- End DoDot:1
- +7 IF RXORDER["V"
- DO IVRXE
- QUIT
- +8 IF RXORDER["P"
- IF IVTYPE="F"
- DO IVRXE
- QUIT
- +9 IF RXORDER["P"
- IF $PIECE(NODE1,"^",4)="H"
- DO IVRXE
- QUIT
- +10 NEW RENEW
- SET RENEW=$$LASTREN^PSJLMPRI(PSJHLDFN,RXORDER)
- +11 SET PSGPLS=$SELECT($GET(PSJEXPOE):$PIECE(NODE2,"^",2),RENEW>$PIECE(NODE2,"^",2):RENEW,1:$PIECE(NODE2,"^",2))
- +12 SET PSGPLF=$SELECT($GET(PSJEXPOE):PSJEXPOE,1:$PIECE(NODE2,"^",4))
- +13 SET FIELD(1)="^"_$SELECT($GET(PSJBCBU):$PIECE(NODE2,"^"),1:$$ESC^ORHLESC($PIECE(NODE2,"^")))_"&"_$PIECE(NODE2,"^",5)_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"_$PIECE($GET(NODEPT2),"^",4)_"^"_$GET(PSGST)
- +14 SET FIELD(21)="^"_$PIECE(NODE2,"^",5)_"^99PSA^^^"
- +15 IF ($GET(DOSEOR)']"")!($ORDER(@(PSJORDER_"1,"" "")"),-1)=1)
- Begin DoDot:1
- +16 SET (CNT,DDNUM)=0
- FOR
- SET DDNUM=$ORDER(@(PSJORDER_"1,"_DDNUM_")"))
- IF 'DDNUM
- QUIT
- IF CNT=1
- QUIT
- SET DDIEN=+$GET(@(PSJORDER_"1,"_DDNUM_",0)"))
- Begin DoDot:2
- +17 SET FIELD(1)=$SELECT($PIECE(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2)="":"1",1:$PIECE(@(PSJORDER_"1,"_DDNUM_",0)"),"^",2))_"&"_FIELD(1)
- +18 SET FIELD(1)=DOSE_"&"_UNIT_"&"_FIELD(1)
- SET $PIECE(FIELD(1),"^",8)=$SELECT($GET(DOSEOR)]"":$GET(DOSEOR),1:DOSE_UNIT)
- +19 IF $PIECE(FIELD(1),"^",8)=""
- SET $PIECE(FIELD(1),"^",8)=$$ESC^ORHLESC($GET(@(PSJORDER_".3)")))
- +20 SET NDNODE=$GET(^PSDRUG(DDIEN,"ND"))
- +21 ; CHANGE FOR NEW NDF CALL
- +22 SET PRODNAME=$SELECT($TEXT(^PSNAPIS)]"":$$PROD0^PSNAPIS(+NDNODE,$PIECE(NDNODE,"^",3)),$GET(^PSNDF(+NDNODE,5,+$PIECE(NDNODE,"^",3),0))]"":^(0),1:"N/A")
- +23 IF PRODNAME=""
- SET PRODNAME="N/A"
- +24 SET FIELD(2)=$SELECT(PRODNAME="N/A":"^^",1:+NDNODE_"."_+$PIECE(NDNODE,"^",3)_"^"_$PIECE(NDNODE,"^",2)_"^"_"99NDF")_"^"_DDIEN_"^"_$SELECT($GET(PSJBCBU):$PIECE($GET(^PSDRUG(DDIEN,0)),"^"),1:$$ESC^ORHLESC($PIECE($GET(^PSDRUG(DDIEN,
- 0)),"^")))_"^"_"99PSD"
- +25 SET UNITS=$SELECT(PRODNAME="N/A":"N/A",1:$SELECT($TEXT(^PSNAPIS)]"":$PIECE($$DFSU^PSNAPIS(+NDNODE,$PIECE(NDNODE,"^",3)),"^",5),1:$PIECE($GET(^PSNDF(+NDNODE,2,+$PIECE(PRODNAME,"^",2),3,+$PIECE(PRODNAME,"^",3),4,+$PIECE(PRODNAME,"
- ^",4),0)),"^")))
- +26 SET FIELD(5)="^^^"_$$ESC^ORHLESC(UNITS)_"^"_$$ESC^ORHLESC($PIECE($GET(^PS(50.607,UNITS,0)),"^"))_"^99PSU"
- +27 SET FIELD(6)="^^^"_$$ESC^ORHLESC($GET(DOSEFORM))_"^"_$$ESC^ORHLESC($PIECE($GET(^PS(50.606,+$GET(DOSEFORM),0)),"^"))_"^99PSF"
- +28 SET FIELD(25)=$$EN^PSSUTIL1(DDIEN)
- SET FIELD(26)=$PIECE(FIELD(25),"|",2)
- SET FIELD(25)=$PIECE(FIELD(25),"|")
- +29 IF $PIECE(FIELD(25),"^",5)]""
- SET $PIECE(FIELD(25),"^",5)=$$ESC^ORHLESC($PIECE(FIELD(25),"^",5))
- +30 SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +31 IF '$TEST
- SET $PIECE(FIELD(1),"^",8)=$$ESC^ORHLESC(DOSEOR)
- +32 SET NAME=$PIECE($GET(^VA(200,DUZ,0)),"^")
- IF '$GET(PSJBCBU)
- SET NAME=$$ESC^ORHLESC(NAME)
- SET FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
- +33 DO SEGMENT^PSJHLU(LIMIT)
- DO DISPLAY^PSJHL2
- +34 DO SEGMENT2^PSJHLU
- +35 QUIT
- IVRXE ; RXE segment for IV orders
- +1 ; If an Inpatient Med IV order, send RXE w/dispense drug info.
- +2 ; If an IV FLUID order, send start/stop date and duration in the RXE
- +3 ; and send an RXC for each additive and solution.
- +4 NEW ADSNODE
- +5 IF RXORDER["V"
- SET PSGPLS=$PIECE(NODE1,"^",2)
- SET PSGPLF=$PIECE(NODE1,"^",3)
- +6 IF '$TEST
- SET PSGPLS=$PIECE(NODE2,"^",2)
- SET PSGPLF=$PIECE(NODE2,"^",4)
- +7 SET FIELD(1)="^"_$SELECT(PSJORDER["IV":($PIECE(NODE1,"^",9)_"&"_$PIECE(NODE1,"^",11)),1:$PIECE(NODE2,"^"))_"^^"_$$FMTHL7^XLFDT(PSGPLS)_"^"_$$FMTHL7^XLFDT(PSGPLF)_"^"_$GET(P("PRY"))
- +8 SET FIELD(21)="^"_$SELECT(PSJORDER["IV":$PIECE(NODE1,"^",11),1:$PIECE(NODE2,"^",5))_"^99PSA^^^"
- +9 SET NAME=$PIECE($GET(^VA(200,DUZ,0)),"^")
- IF '$GET(PSJBCBU)
- SET NAME=$$ESC^ORHLESC(NAME)
- +10 SET FIELD(14)=DUZ_"^"_NAME_"^"_"99NP"
- +11 NEW X,Y
- +12 IF RXORDER["V"
- SET INFUSE=$PIECE(NODE1,"^",8)
- +13 IF '$TEST
- SET INFUSE=$PIECE($GET(@(PSJORDER_"8)")),"^",5)
- +14 IF INFUSE?1N.N1" ml/hr"
- SET FIELD(23)=+INFUSE
- SET Y=$PIECE(INFUSE,+INFUSE,2)
- SET Y=$$TRIM^XLFSTR(Y,"LR"," ")
- SET FIELD(24)="^^^^"_Y_"^PSU"
- +15 IF FIELD(23)=""
- IF FIELD(24)=""
- SET FIELD(23)=INFUSE
- +16 DO SEGMENT^PSJHLU(LIMIT)
- DO DISPLAY^PSJHL2
- +17 KILL SEGMENT
- IF RXORDER["V"
- SET JJ=0
- FOR
- SET JJ=$ORDER(@(PSJORDER_"5,"_JJ_")"))
- IF 'JJ
- QUIT
- SET SEGMENT(JJ-1)=$SELECT($GET(PSJBCBU):$GET(@(PSJORDER_"5,"_JJ_",0)")),1:$$ESC^ORHLESC($GET(@(PSJORDER_"5,"_JJ_",0)"))))
- +18 IF '$TEST
- SET JJ=0
- FOR
- SET JJ=$ORDER(@(PSJORDER_"12,"_JJ_")"))
- IF 'JJ
- QUIT
- SET SEGMENT(JJ-1)=$SELECT($GET(PSJBCBU):$GET(@(PSJORDER_"12,"_JJ_",0)")),1:$GET(@(PSJORDER_"12,"_JJ_",0)")))
- +19 IF $DATA(SEGMENT(0))
- SET SEGMENT(0)="NTE|6|L|"_SEGMENT(0)
- Begin DoDot:1
- +20 DO SET^PSJHLU
- KILL SEGMENT,JJ
- End DoDot:1
- +21 IF RXORDER["V"
- IF $PIECE($GET(@(PSJORDER_"3)")),"^")]""
- KILL SEGMENT
- Begin DoDot:1
- +22 SET SEGMENT(0)="NTE|21|L|"_$SELECT($GET(PSJSBCBU):$PIECE($GET(@(PSJORDER_"3)")),"^"),1:$$ESC^ORHLESC($PIECE($GET(@(PSJORDER_"3)")),"^")))
- Begin DoDot:2
- End DoDot:2
- +23 DO SET^PSJHLU
- KILL SEGMENT
- End DoDot:1
- +24 IF RXORDER["P"
- IF $PIECE($GET(@(PSJORDER_"9)")),U,2)]""
- KILL SEGMENT
- Begin DoDot:1
- +25 SET SEGMENT(0)="NTE|21|L|"_$SELECT($GET(PSJSBCBU):$PIECE($GET(@(PSJORDER_"9)")),U,2),1:$$ESC^ORHLESC($PIECE($GET(@(PSJORDER_"9)")),U,2)))
- Begin DoDot:2
- End DoDot:2
- +26 DO SET^PSJHLU
- KILL SEGMENT
- End DoDot:1
- RXC ;component segments
- +1 NEW ADDITIVE,SOLUTION,SUB,TYPE,AD,SOL,PTR,NUM,UTMP,XTMP
- +2 SET LIMIT=24
- XECUTE PSJCLEAR
- +3 SET FIELD(0)="RXC"
- +4 ; In the line below, the naked reference refers to the full global reference represented in PSJORDER_TYPE...
- +5 ; This could be a reference to either ^PS(53.1 or ^PS(55
- +6 SET AD="AD"
- SET SOL="SOL"
- FOR TYPE="AD","SOL"
- SET SUB=0
- FOR
- SET SUB=$ORDER(@(PSJORDER_TYPE_","_SUB_")"))
- IF SUB=""
- QUIT
- SET NODE1=$GET(^(SUB,0))
- IF NODE1=""
- QUIT
- Begin DoDot:1
- +7 SET FIELD(1)=$SELECT(TYPE="AD":"A",1:"B")
- +8 SET PTR=+$SELECT(TYPE="AD":+$PIECE($GET(^PS(52.6,$PIECE(NODE1,"^"),0)),"^",11),1:+$PIECE($GET(^PS(52.7,$PIECE(NODE1,"^"),0)),"^",11))
- +9 SET FIELD(2)="^^^"_$SELECT($GET(PSJBCBU):+$PIECE(NODE1,"^"),1:PTR)_"^"_$SELECT($GET(PSJBCBU):$SELECT(TYPE="AD":$PIECE($GET(^PS(52.6,+$PIECE(NODE1,"^"),0)),"^"),1:...
- ... $PIECE($GET(^PS(52.7,+$PIECE(NODE1,"^"),0)),"^")_" "_$PIECE($GET(^(0)),U,4)),1:$PIECE($GET(^PS(50.7,PTR,0)),"^"))
- +10 IF (TYPE="AD"&$GET(PSJBCBU))
- SET FIELD(2)=FIELD(2)_$SELECT($PIECE(NODE1,"^",3)]"":" BOTTLE: "_$PIECE(NODE1,"^",3),1:"")
- +11 SET FIELD(2)=FIELD(2)_"^99PSP"
- +12 SET FIELD(3)=$PIECE($PIECE(NODE1,"^",2)," ")
- +13 SET FIELD(4)=$PIECE($PIECE(NODE1,"^",2)," ",2)
- +14 FOR XTMP=1:1:14
- SET UTMP($PIECE("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL","^",XTMP))="PSIV-"_XTMP
- +15 SET NUM=""
- IF FIELD(4)'=""
- SET NUM=$GET(UTMP(FIELD(4)))
- +16 SET FIELD(4)="^^^"_NUM_"^"_FIELD(4)_"^99OTH"
- +17 DO SEGMENT^PSJHLU(LIMIT)
- DO DISPLAY^PSJHL2
- End DoDot:1
- +18 QUIT
- RXR ; med route segment
- +1 SET LIMIT=4
- XECUTE PSJCLEAR
- +2 SET FIELD(0)="RXR"
- +3 IF PSJORDER["IV"
- SET FIELD(1)="^^^"_$PIECE($GET(@(PSJORDER_".2)")),"^",3)
- IF $PIECE(FIELD(1),U,4)=""
- QUIT
- Begin DoDot:1
- +4 NEW PSJUNITS
- SET PSJUNITS=$SELECT($GET(PSJBCBU):$PIECE($GET(^PS(51.2,+$PIECE(FIELD(1),"^",4),0)),"^"),1:$$ESC^ORHLESC($PIECE($GET(^PS(51.2,+$PIECE(FIELD(1),"^",4),0)),"^")))
- +5 SET FIELD(1)=FIELD(1)_"^"_PSJUNITS_"^99PSR"
- +6 IF $GET(PSJBCBU)
- SET FIELD(4)="^^^"_$PIECE($GET(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($PIECE($GET(@(PSJORDER_"0)")),"^",4),55.01,.04)_"^99PSR"
- End DoDot:1
- +7 IF PSJORDER[53.1
- SET FIELD(1)="^^^"_$PIECE($GET(@(PSJORDER_"0)")),"^",3)
- IF $PIECE(FIELD(1),U,4)=""
- QUIT
- Begin DoDot:1
- +8 NEW PSJUNITS
- SET PSJUNITS=$SELECT($GET(PSJBCBU):$PIECE($GET(^PS(51.2,+$PIECE(FIELD(1),"^",4),0)),"^"),1:$$ESC^ORHLESC($PIECE($GET(^PS(51.2,+$PIECE(FIELD(1),"^",4),0)),"^")))
- +9 SET FIELD(1)=FIELD(1)_"^"_PSJUNITS_"^99PSR"
- +10 IF $GET(PSJBCBU)
- SET FIELD(4)="^^^"_$PIECE($GET(@(PSJORDER_"0)")),"^",4)_"^"_$$CODES^PSIVUTL($PIECE($GET(@(PSJORDER_"0)")),"^",4),53.1,4)_"^99PSR"
- End DoDot:1
- +11 IF FIELD(1)=""
- SET FIELD(1)="^^^"_$PIECE(NODE1,"^",3)_"^"_$SELECT($GET(PSJBCBU):$PIECE($GET(^PS(51.2,+$PIECE(NODE1,"^",3),0)),"^"),1:$$ESC^ORHLESC($PIECE($GET(^PS(51.2,+$PIECE(NODE1,"^",3),0)),"^")))_"^99PSR"
- +12 DO SEGMENT^PSJHLU(LIMIT)
- DO DISPLAY^PSJHL2
- +13 QUIT
- ZRX ; pharmacy Z-segment
- +1 DO ZRX^PSJHLU
- +2 QUIT
- CNT ;Count dispense drugs for an order
- +1 SET (CNT,DDNUM)=0
- FOR
- SET DDNUM=$ORDER(@(PSJORDER_"1,"_DDNUM_")"))
- IF 'DDNUM
- QUIT
- SET CNT=CNT+1
- +2 QUIT
