VPRDPSI ;SLC/MKB -- Inpatient Pharmacy extract ;8/2/11 15:29
;;1.0;VIRTUAL PATIENT RECORD;**1**;Sep 01, 2011;Build 38
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^OR(100 5771
; ^ORD(101.43 2843
; ^SC 10040
; ^VA(200 10060
; DIQ 2056
; ORX8 871,2467
; PSOORRL,^TMP("PS",$J) 2400
; PSS50P7 4662
; PSS51P2 4548
; PSS52P6 4549
; PSS52P7 4550
; XLFSTR 10104
;
; ------------ Get medications from VistA ------------
; [used to be called from VPRDPS]
;
IN(ID,MED) ; -- return a medication in MED("attribute")=value
; [expects VPRN, OCL^PSOORRL data]
N X,PS,PS0,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,LOC K MED
M PS=^TMP("VPRPS",$J,VPRN) S PS0=PS(0)
S MED("medID")=ID_";I",MED("vaType")="I"
S X=$P(PS0,U,15) S:X MED("start")=X
S X=$P(PS0,U,4) S:X MED("stop")=X
S MED("name")=$P(PS0,U,2),X=$P(PS0,U,9),MED("vaStatus")=X,X=$E(X,1,3)
S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="REN"):"historical",X="REI":"active",1:$$LOW^XLFSTR($P(PS0,U,9)))
S DOSE=$P(PS0,U,6) S:DOSE="" DOSE=$G(PS("SIG",1,0))
S RTE=$G(PS("MDR",1,0)),SCH=$P($G(PS("SCH",1,0)),U)
S MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
S MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH I $G(PS("SIO",0)) D
. N SIO M SIO=PS("SIO")
. S MED("sig")=MED("sig")_" "_$$STRING^VPRD(.SIO)
I $D(PS("P",0)) S MED("orderingProvider")=PS("P",0)
I $G(PS("CLINIC",0)) S MED("IMO")=1
S MED("facility")=$$FAC^VPRD ;local stn#^name
S ORDER=+$P(PS0,U,8) D:ORDER ORD
Q
;
IN1(ID,MED) ; -- return a medication in MED("attribute")=value
; [expects OEL^PSOORRL data]
N X,PS,PS0,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,DRUG,LOC K MED
M PS=^TMP("PS",$J) S PS0=PS(0)
S MED("medID")=ID_";I",MED("vaType")="I"
S X=$P(PS0,U,5) S:X MED("start")=X
S X=$P(PS0,U,3) S:X MED("stop")=X
S MED("name")=$P(PS0,U),X=$P(PS0,U,6),MED("vaStatus")=X,X=$E(X,1,3)
S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="REN"):"historical",X="REI":"active",1:$$LOW^XLFSTR($P(PS0,U,6)))
S DOSE=$P(PS0,U,9) S:DOSE="" DOSE=$G(PS("SIG",1,0))
S RTE=$G(PS("MDR",1,0)),SCH=$P($G(PS("SCH",1,0)),U)
S MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
S MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH I $G(PS("SIO",0)) D
. N SIO M SIO=PS("SIO")
. S MED("sig")=MED("sig")_" "_$$STRING^VPRD(.SIO)
I $D(PS("P",0)) S MED("orderingProvider")=PS("P",0)
S MED("facility")=$$FAC^VPRD ;local stn#^name
S ORDER=+$P(PS0,U,11) D:ORDER ORD
I $P($G(^SC(+$G(LOC),0)),U,25) S MED("IMO")=1
Q
;
IV1(ID,MED) ; -- return an infusion in MED("attribute")=value
; [expects OEL^PSOORRL data]
N PS,PS0,X,ORDER,LOC K MED
M PS=^TMP("PS",$J) S PS0=PS(0)
S MED("medID")=ID_";I",MED("vaType")="V",MED("name")=$P(PS0,U)
S X=$P(PS0,U,5) S:X MED("start")=X
S X=$P(PS0,U,3) S:X MED("stop")=X
S MED("vaStatus")=$P(PS0,U,6),X=$E($P(PS0,U,6),1,3)
S MED("status")=$S(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="PUR"):"historical",X="HOL":"hold",1:"active")
S MED("dose",1)="^^^^"_$G(PS("MDR",1,0))_U_$P($G(PS("SCH",1,0)),U)
S MED("rate")=$P(PS0,U,2) D IVP
S X=$G(PS("IVLIM",0)) S:$L(X) MED("ivLimit")=$$IVLIM(X)
I $G(PS("P",0)) S MED("orderingProvider")=PS("P",0)
S MED("facility")=$$FAC^VPRD ;local stn#^name
S ORDER=+$P(PS0,U,11) D:ORDER ORDLOC
I $P($G(^SC(+$G(LOC),0)),U,25) S MED("IMO")=1
Q
;
ORD ; get rest of inpatient data from ORDER
S OI=$$OI^ORX8(ORDER),PSOI=+$P(OI,U,3)
S MED("name")=$P(OI,U,2) I PSOI D
. D ZERO^PSS50P7(PSOI,,,"OI")
. S MED("form")=$P($G(^TMP($J,"OI",PSOI,.02)),U,2)
S X=$$VALUE^ORX8(ORDER,"DOSE"),DOSE=DOSE_"^^^"
S DRUG="" I X'="",X["&" D
. S DRUG=+$P(X,"&",6)
. S DOSE=$TR($P(X,"&",1,4),"&","^")
. S $P(MED("dose",1),U,1,4)=DOSE
S:'DRUG DRUG=+$$VALUE^ORX8(ORDER,"DRUG")
D:DRUG NDF^VPRDPS(DRUG)
S X=$$GET1^DIQ(100,ORDER_",",36,"I") S:X MED("parent")=X
K ^TMP($J,"OI")
ORDLOC ; enter here for IV's
N ORUPCHUK D EN^ORX8(ORDER)
S MED("orderID")=ORDER
S MED("ordered")=$G(ORUPCHUK("ORODT"))
S LOC=+$G(ORUPCHUK("ORL")) I LOC D
. S MED("location")=LOC_U_$P($G(^SC(LOC,0)),U)
. S MED("facility")=$$FAC^VPRD(LOC)
Q
;
; ---------- Called from VPRDPSOR ----------
;
IV ; -- add IV data to MED("attribute")=value
; [expects IFN, ORPK, OEL^PSOORRL data]
N PS,PS0,X,X0,ID,RTE,I
S MED("vaType")="V" I ORPK,$D(^TMP("PS",$J)) D G IVQ
. M PS=^TMP("PS",$J) S PS0=$G(PS(0)),MED("name")=$P(PS0,U)
. S MED("dose",1)="^^^^"_$G(PS("MDR",1,0))_U_$P($G(PS("SCH",1,0)),U)
. S MED("rate")=$P(PS0,U,2),ID=ORPK D IVP
. S X=$G(PS("IVLIM",0)) S:$L(X) MED("ivLimit")=$$IVLIM(X)
. S X=+$P($G(^TMP("PS",$J,"RXN",0)),U,5)
. S:X MED("pharmacist")=X_U_$P($G(^VA(200,X,0)),U)
; no med in PS, so use Order values
S RTE=+$$VALUE^ORX8(IFN,"ROUTE") D ALL^PSS51P2(RTE,,,,"VPRTE")
S MED("dose",1)="^^^^"_$G(^TMP($J,"VPRTE",RTE,1))_U_$$VALUE^ORX8(IFN,"SCHEDULE")
S MED("rate")=$$VALUE^ORX8(IFN,"RATE")
S I=0 F S I=$O(^OR(100,IFN,.1,I)) Q:I<1 S X=+$G(^(I,0)) D
. S X0=$G(^ORD(101.43,X,0)),MED("name")=$P(X0,U)
. S MED("product",I,"O")=+$P(X0,U,2)_U_$P(X0,U)
S X=$$VALUE^ORX8(IFN,"DAYS") I $L(X) D S MED("ivLimit")=X
. I X?1.A1.N S X=$$IVLIM(X) Q
. ; CPRS format = "for a total of 3 doses" or "with total volume 100ml"
. F I=1:1:$L(X) I $E(X,I)=+$E(X,I) S X=$E(X,I,$L(X)) Q
IVQ ; done
K ^TMP("PS",$J),^TMP($J,"VPRTE")
Q
;
IVP ; -- add IV products for ID,DFN
; [expects PS("A") & PS("B") data arrays from IV*/PSOORRL]
N VPI,N,NAME,IEN,DRUG,X S N=0
; IV Additives
S VPI=0 F S VPI=$O(PS("A",VPI)) Q:VPI<1 D
. K ^TMP($J,"VPRPSIV") S NAME=$P($G(PS("A",VPI,0)),U)
. D ZERO^PSS52P6("",NAME,"","VPRPSIV")
. S IEN=$O(^TMP($J,"VPRPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
. S N=N+1 D:DRUG NDF^VPRDPS(DRUG,N) S:'DRUG MED("product",N)=U_NAME
. S $P(MED("product",N),U,4,5)="A^"_$P($G(PS("A",VPI,0)),U,2)
. S X=$G(^TMP($J,"VPRPSIV",IEN,15))
. S:X MED("product",N,"O")=+X_U_$$NAME^PSS50P7(+X)
; IV Base Solutions
S VPI=0 F S VPI=$O(PS("B",VPI)) Q:VPI<1 D
. K ^TMP($J,"VPRPSIV") S NAME=$P($G(PS("B",VPI,0)),U)
. D ZERO^PSS52P7("",NAME,"","VPRPSIV")
. S IEN=$O(^TMP($J,"VPRPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
. S N=N+1 D:DRUG NDF^VPRDPS(DRUG,N) S:'DRUG MED("product",N)=U_NAME
. S $P(MED("product",N),U,4,5)="B^"_$P($G(PS("B",VPI,0)),U,2)
. S X=$G(^TMP($J,"VPRPSIV",IEN,9))
. S:X MED("product",N,"O")=+X_U_$$NAME^PSS50P7(+X)
K ^TMP($J,"VPRPSIV")
Q
;
IVLIM(X) ; -- Return expanded version of IV Limit X
I '$L($G(X)) Q ""
N Y,VAL,UNT,I
S Y="",X=$$UP^XLFSTR(X)
I X?1"DOSES".E S X="A"_$P(X,"DOSES",2)
S UNT=$E(X),VAL=0 F I=2:1:$L(X) I $E(X,I) S VAL=$E(X,I,$L(X)) Q
I UNT="A" S Y=+VAL_$S(+VAL>1:" doses",1:" dose")
I UNT="D" S Y=+VAL_$S(+VAL>1:" days",1:" day")
I UNT="H" S Y=+VAL_$S(+VAL>1:" hours",1:" hour")
I UNT="C" S Y=+VAL_" CC"
I UNT="M" S Y=+VAL_" ml"
I UNT="L" S Y=+VAL_" L"
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDPSI 7171 printed Dec 13, 2024@02:44:54 Page 2
VPRDPSI ;SLC/MKB -- Inpatient Pharmacy extract ;8/2/11 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**1**;Sep 01, 2011;Build 38
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^OR(100 5771
+7 ; ^ORD(101.43 2843
+8 ; ^SC 10040
+9 ; ^VA(200 10060
+10 ; DIQ 2056
+11 ; ORX8 871,2467
+12 ; PSOORRL,^TMP("PS",$J) 2400
+13 ; PSS50P7 4662
+14 ; PSS51P2 4548
+15 ; PSS52P6 4549
+16 ; PSS52P7 4550
+17 ; XLFSTR 10104
+18 ;
+19 ; ------------ Get medications from VistA ------------
+20 ; [used to be called from VPRDPS]
+21 ;
IN(ID,MED) ; -- return a medication in MED("attribute")=value
+1 ; [expects VPRN, OCL^PSOORRL data]
+2 NEW X,PS,PS0,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,LOC
KILL MED
+3 MERGE PS=^TMP("VPRPS",$JOB,VPRN)
SET PS0=PS(0)
+4 SET MED("medID")=ID_";I"
SET MED("vaType")="I"
+5 SET X=$PIECE(PS0,U,15)
if X
SET MED("start")=X
+6 SET X=$PIECE(PS0,U,4)
if X
SET MED("stop")=X
+7 SET MED("name")=$PIECE(PS0,U,2)
SET X=$PIECE(PS0,U,9)
SET MED("vaStatus")=X
SET X=$EXTRACT(X,1,3)
+8 SET MED("status")=$SELECT(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="REN"):"historical",X="REI":"active",1:$$LOW^XLFSTR($PIECE(PS0,U,9)))
+9 SET DOSE=$PIECE(PS0,U,6)
if DOSE=""
SET DOSE=$GET(PS("SIG",1,0))
+10 SET RTE=$GET(PS("MDR",1,0))
SET SCH=$PIECE($GET(PS("SCH",1,0)),U)
+11 SET MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
+12 SET MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH
IF $GET(PS("SIO",0))
Begin DoDot:1
+13 NEW SIO
MERGE SIO=PS("SIO")
+14 SET MED("sig")=MED("sig")_" "_$$STRING^VPRD(.SIO)
End DoDot:1
+15 IF $DATA(PS("P",0))
SET MED("orderingProvider")=PS("P",0)
+16 IF $GET(PS("CLINIC",0))
SET MED("IMO")=1
+17 ;local stn#^name
SET MED("facility")=$$FAC^VPRD
+18 SET ORDER=+$PIECE(PS0,U,8)
if ORDER
DO ORD
+19 QUIT
+20 ;
IN1(ID,MED) ; -- return a medication in MED("attribute")=value
+1 ; [expects OEL^PSOORRL data]
+2 NEW X,PS,PS0,ORDER,DOSE,UNTS,RTE,SCH,OI,PSOI,DRUG,LOC
KILL MED
+3 MERGE PS=^TMP("PS",$JOB)
SET PS0=PS(0)
+4 SET MED("medID")=ID_";I"
SET MED("vaType")="I"
+5 SET X=$PIECE(PS0,U,5)
if X
SET MED("start")=X
+6 SET X=$PIECE(PS0,U,3)
if X
SET MED("stop")=X
+7 SET MED("name")=$PIECE(PS0,U)
SET X=$PIECE(PS0,U,6)
SET MED("vaStatus")=X
SET X=$EXTRACT(X,1,3)
+8 SET MED("status")=$SELECT(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="REN"):"historical",X="REI":"active",1:$$LOW^XLFSTR($PIECE(PS0,U,6)))
+9 SET DOSE=$PIECE(PS0,U,9)
if DOSE=""
SET DOSE=$GET(PS("SIG",1,0))
+10 SET RTE=$GET(PS("MDR",1,0))
SET SCH=$PIECE($GET(PS("SCH",1,0)),U)
+11 SET MED("dose",1)=DOSE_"^^^^"_RTE_U_SCH
+12 SET MED("sig")="Give: "_DOSE_" "_RTE_" "_SCH
IF $GET(PS("SIO",0))
Begin DoDot:1
+13 NEW SIO
MERGE SIO=PS("SIO")
+14 SET MED("sig")=MED("sig")_" "_$$STRING^VPRD(.SIO)
End DoDot:1
+15 IF $DATA(PS("P",0))
SET MED("orderingProvider")=PS("P",0)
+16 ;local stn#^name
SET MED("facility")=$$FAC^VPRD
+17 SET ORDER=+$PIECE(PS0,U,11)
if ORDER
DO ORD
+18 IF $PIECE($GET(^SC(+$GET(LOC),0)),U,25)
SET MED("IMO")=1
+19 QUIT
+20 ;
IV1(ID,MED) ; -- return an infusion in MED("attribute")=value
+1 ; [expects OEL^PSOORRL data]
+2 NEW PS,PS0,X,ORDER,LOC
KILL MED
+3 MERGE PS=^TMP("PS",$JOB)
SET PS0=PS(0)
+4 SET MED("medID")=ID_";I"
SET MED("vaType")="V"
SET MED("name")=$PIECE(PS0,U)
+5 SET X=$PIECE(PS0,U,5)
if X
SET MED("start")=X
+6 SET X=$PIECE(PS0,U,3)
if X
SET MED("stop")=X
+7 SET MED("vaStatus")=$PIECE(PS0,U,6)
SET X=$EXTRACT($PIECE(PS0,U,6),1,3)
+8 SET MED("status")=$SELECT(X="DIS"!(X="PEN"):"not active",X="EXP"!(X="PUR"):"historical",X="HOL":"hold",1:"active")
+9 SET MED("dose",1)="^^^^"_$GET(PS("MDR",1,0))_U_$PIECE($GET(PS("SCH",1,0)),U)
+10 SET MED("rate")=$PIECE(PS0,U,2)
DO IVP
+11 SET X=$GET(PS("IVLIM",0))
if $LENGTH(X)
SET MED("ivLimit")=$$IVLIM(X)
+12 IF $GET(PS("P",0))
SET MED("orderingProvider")=PS("P",0)
+13 ;local stn#^name
SET MED("facility")=$$FAC^VPRD
+14 SET ORDER=+$PIECE(PS0,U,11)
if ORDER
DO ORDLOC
+15 IF $PIECE($GET(^SC(+$GET(LOC),0)),U,25)
SET MED("IMO")=1
+16 QUIT
+17 ;
ORD ; get rest of inpatient data from ORDER
+1 SET OI=$$OI^ORX8(ORDER)
SET PSOI=+$PIECE(OI,U,3)
+2 SET MED("name")=$PIECE(OI,U,2)
IF PSOI
Begin DoDot:1
+3 DO ZERO^PSS50P7(PSOI,,,"OI")
+4 SET MED("form")=$PIECE($GET(^TMP($JOB,"OI",PSOI,.02)),U,2)
End DoDot:1
+5 SET X=$$VALUE^ORX8(ORDER,"DOSE")
SET DOSE=DOSE_"^^^"
+6 SET DRUG=""
IF X'=""
IF X["&"
Begin DoDot:1
+7 SET DRUG=+$PIECE(X,"&",6)
+8 SET DOSE=$TRANSLATE($PIECE(X,"&",1,4),"&","^")
+9 SET $PIECE(MED("dose",1),U,1,4)=DOSE
End DoDot:1
+10 if 'DRUG
SET DRUG=+$$VALUE^ORX8(ORDER,"DRUG")
+11 if DRUG
DO NDF^VPRDPS(DRUG)
+12 SET X=$$GET1^DIQ(100,ORDER_",",36,"I")
if X
SET MED("parent")=X
+13 KILL ^TMP($JOB,"OI")
ORDLOC ; enter here for IV's
+1 NEW ORUPCHUK
DO EN^ORX8(ORDER)
+2 SET MED("orderID")=ORDER
+3 SET MED("ordered")=$GET(ORUPCHUK("ORODT"))
+4 SET LOC=+$GET(ORUPCHUK("ORL"))
IF LOC
Begin DoDot:1
+5 SET MED("location")=LOC_U_$PIECE($GET(^SC(LOC,0)),U)
+6 SET MED("facility")=$$FAC^VPRD(LOC)
End DoDot:1
+7 QUIT
+8 ;
+9 ; ---------- Called from VPRDPSOR ----------
+10 ;
IV ; -- add IV data to MED("attribute")=value
+1 ; [expects IFN, ORPK, OEL^PSOORRL data]
+2 NEW PS,PS0,X,X0,ID,RTE,I
+3 SET MED("vaType")="V"
IF ORPK
IF $DATA(^TMP("PS",$JOB))
Begin DoDot:1
+4 MERGE PS=^TMP("PS",$JOB)
SET PS0=$GET(PS(0))
SET MED("name")=$PIECE(PS0,U)
+5 SET MED("dose",1)="^^^^"_$GET(PS("MDR",1,0))_U_$PIECE($GET(PS("SCH",1,0)),U)
+6 SET MED("rate")=$PIECE(PS0,U,2)
SET ID=ORPK
DO IVP
+7 SET X=$GET(PS("IVLIM",0))
if $LENGTH(X)
SET MED("ivLimit")=$$IVLIM(X)
+8 SET X=+$PIECE($GET(^TMP("PS",$JOB,"RXN",0)),U,5)
+9 if X
SET MED("pharmacist")=X_U_$PIECE($GET(^VA(200,X,0)),U)
End DoDot:1
GOTO IVQ
+10 ; no med in PS, so use Order values
+11 SET RTE=+$$VALUE^ORX8(IFN,"ROUTE")
DO ALL^PSS51P2(RTE,,,,"VPRTE")
+12 SET MED("dose",1)="^^^^"_$GET(^TMP($JOB,"VPRTE",RTE,1))_U_$$VALUE^ORX8(IFN,"SCHEDULE")
+13 SET MED("rate")=$$VALUE^ORX8(IFN,"RATE")
+14 SET I=0
FOR
SET I=$ORDER(^OR(100,IFN,.1,I))
if I<1
QUIT
SET X=+$GET(^(I,0))
Begin DoDot:1
+15 SET X0=$GET(^ORD(101.43,X,0))
SET MED("name")=$PIECE(X0,U)
+16 SET MED("product",I,"O")=+$PIECE(X0,U,2)_U_$PIECE(X0,U)
End DoDot:1
+17 SET X=$$VALUE^ORX8(IFN,"DAYS")
IF $LENGTH(X)
Begin DoDot:1
+18 IF X?1.A1.N
SET X=$$IVLIM(X)
QUIT
+19 ; CPRS format = "for a total of 3 doses" or "with total volume 100ml"
+20 FOR I=1:1:$LENGTH(X)
IF $EXTRACT(X,I)=+$EXTRACT(X,I)
SET X=$EXTRACT(X,I,$LENGTH(X))
QUIT
End DoDot:1
SET MED("ivLimit")=X
IVQ ; done
+1 KILL ^TMP("PS",$JOB),^TMP($JOB,"VPRTE")
+2 QUIT
+3 ;
IVP ; -- add IV products for ID,DFN
+1 ; [expects PS("A") & PS("B") data arrays from IV*/PSOORRL]
+2 NEW VPI,N,NAME,IEN,DRUG,X
SET N=0
+3 ; IV Additives
+4 SET VPI=0
FOR
SET VPI=$ORDER(PS("A",VPI))
if VPI<1
QUIT
Begin DoDot:1
+5 KILL ^TMP($JOB,"VPRPSIV")
SET NAME=$PIECE($GET(PS("A",VPI,0)),U)
+6 DO ZERO^PSS52P6("",NAME,"","VPRPSIV")
+7 SET IEN=$ORDER(^TMP($JOB,"VPRPSIV",0))
SET DRUG=+$GET(^(IEN,1))
if IEN<1
QUIT
+8 SET N=N+1
if DRUG
DO NDF^VPRDPS(DRUG,N)
if 'DRUG
SET MED("product",N)=U_NAME
+9 SET $PIECE(MED("product",N),U,4,5)="A^"_$PIECE($GET(PS("A",VPI,0)),U,2)
+10 SET X=$GET(^TMP($JOB,"VPRPSIV",IEN,15))
+11 if X
SET MED("product",N,"O")=+X_U_$$NAME^PSS50P7(+X)
End DoDot:1
+12 ; IV Base Solutions
+13 SET VPI=0
FOR
SET VPI=$ORDER(PS("B",VPI))
if VPI<1
QUIT
Begin DoDot:1
+14 KILL ^TMP($JOB,"VPRPSIV")
SET NAME=$PIECE($GET(PS("B",VPI,0)),U)
+15 DO ZERO^PSS52P7("",NAME,"","VPRPSIV")
+16 SET IEN=$ORDER(^TMP($JOB,"VPRPSIV",0))
SET DRUG=+$GET(^(IEN,1))
if IEN<1
QUIT
+17 SET N=N+1
if DRUG
DO NDF^VPRDPS(DRUG,N)
if 'DRUG
SET MED("product",N)=U_NAME
+18 SET $PIECE(MED("product",N),U,4,5)="B^"_$PIECE($GET(PS("B",VPI,0)),U,2)
+19 SET X=$GET(^TMP($JOB,"VPRPSIV",IEN,9))
+20 if X
SET MED("product",N,"O")=+X_U_$$NAME^PSS50P7(+X)
End DoDot:1
+21 KILL ^TMP($JOB,"VPRPSIV")
+22 QUIT
+23 ;
IVLIM(X) ; -- Return expanded version of IV Limit X
+1 IF '$LENGTH($GET(X))
QUIT ""
+2 NEW Y,VAL,UNT,I
+3 SET Y=""
SET X=$$UP^XLFSTR(X)
+4 IF X?1"DOSES".E
SET X="A"_$PIECE(X,"DOSES",2)
+5 SET UNT=$EXTRACT(X)
SET VAL=0
FOR I=2:1:$LENGTH(X)
IF $EXTRACT(X,I)
SET VAL=$EXTRACT(X,I,$LENGTH(X))
QUIT
+6 IF UNT="A"
SET Y=+VAL_$SELECT(+VAL>1:" doses",1:" dose")
+7 IF UNT="D"
SET Y=+VAL_$SELECT(+VAL>1:" days",1:" day")
+8 IF UNT="H"
SET Y=+VAL_$SELECT(+VAL>1:" hours",1:" hour")
+9 IF UNT="C"
SET Y=+VAL_" CC"
+10 IF UNT="M"
SET Y=+VAL_" ml"
+11 IF UNT="L"
SET Y=+VAL_" L"
+12 QUIT Y
