VPRDJ05V ;SLC/MKB -- IV/Infusions ;8/2/11 15:29
;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^OR(100 5771
; ^ORD(100.98 873
; ^ORD(101.43 2843
; ^PSB(53.79 5909
; ^SC 10040
; ^VA(200 10060
; DIQ 2056
; ORQ1,^TMP("ORR" 3154
; ORX8 2467,3071
; PSODI 4858
; PSOORDER,^TMP("PSOR" 1878
; PSOORRL,^TMP("PS" 2400
; PSS50 4483
; PSS50P7 4662
; PSS51P1 4546
; PSS51P2 4548
; PSS52P6 4549
; PSS52P7 4550
; PSSDI 4551
; XLFDT 10103
; XLFSTR 10104
;
; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
;
ISIV() ; -- Return 1 or 0, if order is for IV/infusion
I ORPK["V" Q 1
I $P($G(ORTO),U,2)?1"IV".E Q 1
I +$G(ORPCL)=130 Q 1
I $G(^TMP("PS",$J,"B",0)) Q 1
Q 0
;
IV1 ; -- IV fluid, Infusion order [continued from VPRDJ05]
; [Also expects ORPK, OEL^PSOORRL data]
N PS,PS0,X,X0,RTE,I,ADD,BASE
S MED("vaType")="V",MED("medType")="urn:sct:105903003"
S (ADD,BASE)=""
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 X=$G(PS("MDR",1,0)) S:$L(X) MED("dosages",1,"routeName")=X
. S X=$P($G(PS("SCH",1,0)),U) I $L(X) D
.. S MED("dosages",1,"scheduleName")=X
.. N Y D SCH(X)
.. M MED("dosages",1)=Y
. S X=$G(PS("ADM",1,0)) S:$L(X) MED("dosages",1,"adminTimes")=X
. S X=$P(PS0,U,2) I X["INFUSE OVER" S MED("dosages",1,"duration")=X
. E S MED("dosages",1,"ivRate")=X
. S X=$G(PS("IVLIM",0)) S:$L(X) MED("dosages",1,"restriction")=$$IVLIM(X)
. S X=+$P($G(PS("RXN",0)),U,5)
. S:X MED("orders",1,"pharmacistUid")=$$SETUID^VPRUTILS("user",,X),MED("orders",1,"pharmacistName")=$P($G(^VA(200,X,0)),U)
. D IVP
; no med in PS (pending or cancelled), so use Order values
S RTE=+$$VALUE^ORX8(ID,"ROUTE") I RTE D
. D ALL^PSS51P2(RTE,,,,"VPRTE")
. S MED("dosages",1,"routeName")=$G(^TMP($J,"VPRTE",RTE,1))
S X=$$VALUE^ORX8(ID,"SCHEDULE") I $L(X) D
. S MED("dosages",1,"scheduleName")=X
. N Y D SCH(X)
. M MED("dosages",1)=Y
S X=$$VALUE^ORX8(ID,"ADMIN") S:$L(X) MED("dosages",1,"adminTimes")=X
S X=$$VALUE^ORX8(ID,"RATE")
I X["INFUSE OVER" S MED("dosages",1,"duration")=X
E S MED("dosages",1,"ivRate")=X
S I=0 F S I=$O(^OR(100,ID,.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("products",I,"ingredientName")=$P(X0,U)
S X=$$VALUE^ORX8(ID,"DAYS") I $L(X) D S MED("dosages",1,"restriction")=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")
S MED("qualifiedName")=ADD_$S($L(ADD)&$L(BASE):" in ",1:"")_BASE
D BCMA(.MED,DFN,ORPK)
D ADD^VPRDJ("MED","med")
Q
;
IVP ; -- add IV products
; [expects PS("A") & PS("B") data arrays from IV1]
N VPI,N,NAME,IEN,DRUG,OI,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 OI=$G(^TMP($J,"VPRPSIV",IEN,15)) S:OI NAME=$$NAME(+OI)
. S N=N+1 D:DRUG NDF(DRUG,N,"A",NAME)
. S MED("products",N,"strength")=$P($G(PS("A",VPI,0)),U,2)
; 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 OI=$G(^TMP($J,"VPRPSIV",IEN,9)) S:OI NAME=$$NAME(+OI)
. S N=N+1 D:DRUG NDF(DRUG,N,"B",NAME)
. S MED("products",N,"volume")=$P($G(PS("B",VPI,0)),U,2)
K ^TMP($J,"VPRPSIV")
Q
;
NAME(PSOI) ; -- return name_form of PS orderable item
N Y,VPRX S PSOI=+$G(PSOI),Y=""
D EN^PSSDI(50.7,,50.7,".01;.02",PSOI,"VPRX")
S:$D(VPRX) Y=$G(VPRX(50.7,PSOI,.01))_" "_$G(VPRX(50.7,PSOI,.02))
Q Y
;
NDF(DRUG,VPI,ROLE,OI) ; -- Set NDF data for dispense DRUG ien
; code ^ name ^ vuid ^ role ^ concentration
N VPRX,VUID,X,I,CONC,NM
S DRUG=+$G(DRUG) Q:'DRUG
D NDF^PSS50(DRUG,,,,,"NDF")
S CONC=$P($G(PS(ROLE,VPI,0)),U,2),NM=""
;
S MED("products",VPI,"ingredientRole")=$$ROLE(ROLE)
S OI=$G(OI) S:$L(OI) MED("products",VPI,"ingredientName")=OI,NM=OI
; NM=X
;
S X=$G(^TMP($J,"NDF",DRUG,20)) I X D ;VA Generic
. S MED("products",VPI,"ingredientCode")="urn:va:vuid:"_$$VUID^VPRD(+X,50.6)
. S MED("products",VPI,"ingredientCodeName")=$P(X,U,2)
;
S X=$G(^TMP($J,"NDF",DRUG,22)) I X D ;VA Product
. S MED("products",VPI,"suppliedCode")="urn:va:vuid:"_$$VUID^VPRD(+X,50.68)
. S MED("products",VPI,"suppliedName")=$P(X,U,2)_" "_CONC
. S:NM="" NM=$P(X,U,2)
;
S X=$G(^TMP($J,"NDF",DRUG,25)) I X D ;VA Drug Class
. S MED("products",VPI,"drugClassCode")="urn:vadc:"_$P(X,U,2)
. S MED("products",VPI,"drugClassName")=$P(X,U,3)
. S:NM="" NM=$P(X,U,3)
;
I $L(NM),ROLE="A" S ADD=ADD_$S($L(ADD):", ",1:"")_NM
I $L(NM),ROLE="B" S BASE=BASE_$S($L(BASE):", ",1:"")_NM
K ^TMP($J,"NDF",DRUG)
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
;
ROLE(X) ;
N RESULT,TXT,Y
S RESULT="",TXT="urn:sct:"
S RESULT=$S(X="A":TXT_"418804003",X="B":TXT_"418297009",1:TXT_"410942007")
Q RESULT
;
MEDSTAT(X) ;
N Y S Y="urn:sct:"
S Y=Y_$S(X="active":"55561003",X="historical":"392521001","hold":"421139008",1:"73425007")
Q Y
;
TYPE(VA) ;
N RESULT,TXT,Y
S RESULT="",TXT="urn:sct:"
S RESULT=$S(VA="N":TXT_"329505003",VA="O":TXT_"73639000",1:TXT_"105903003")
Q RESULT
;
SCH(NAME) ; -- Return other schedule info
N I K ^TMP($J,"VPRS")
I NAME?.E1" PRN" S NAME=$P(NAME," PRN") Q:NAME="" ;strip off PRN for search
D ZERO^PSS51P1("",NAME,"PSJ",,"VPRS")
S I=+$O(^TMP($J,"VPRS","B",NAME,0)) Q:'I
S Y("scheduleFreq")=+$G(^TMP($J,"VPRS",I,2))
S Y("scheduleType")=$P($G(^TMP($J,"VPRS",I,5)),U,2)
K ^TMP($J,"VPRS")
Q
;
BCMA(Y,DFN,ORPK) ; -- administration times
Q:$G(DFN)<1 Q:$G(ORPK)<1
N ADT,DA,CNT,STS S (ADT,CNT)=0
F S ADT=$O(^PSB(53.79,"AORDX",DFN,ORPK,ADT)) Q:ADT<1 D
. S DA=0 F S DA=+$O(^PSB(53.79,"AORDX",DFN,ORPK,ADT,DA)) Q:DA<1 D
.. S STS=$$GET1^DIQ(53.79,DA_",",.09) Q:STS="REMOVED"
.. S CNT=CNT+1,Y("administrations",CNT,"status")=STS
.. S Y("administrations",CNT,"dateTime")=$$JSONDT^VPRUTILS(ADT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJ05V 7258 printed Apr 09, 2024@21:47:41 Page 2
VPRDJ05V ;SLC/MKB -- IV/Infusions ;8/2/11 15:29
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^OR(100 5771
+7 ; ^ORD(100.98 873
+8 ; ^ORD(101.43 2843
+9 ; ^PSB(53.79 5909
+10 ; ^SC 10040
+11 ; ^VA(200 10060
+12 ; DIQ 2056
+13 ; ORQ1,^TMP("ORR" 3154
+14 ; ORX8 2467,3071
+15 ; PSODI 4858
+16 ; PSOORDER,^TMP("PSOR" 1878
+17 ; PSOORRL,^TMP("PS" 2400
+18 ; PSS50 4483
+19 ; PSS50P7 4662
+20 ; PSS51P1 4546
+21 ; PSS51P2 4548
+22 ; PSS52P6 4549
+23 ; PSS52P7 4550
+24 ; PSSDI 4551
+25 ; XLFDT 10103
+26 ; XLFSTR 10104
+27 ;
+28 ; All tags expect DFN, ID, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
+29 ;
ISIV() ; -- Return 1 or 0, if order is for IV/infusion
+1 IF ORPK["V"
QUIT 1
+2 IF $PIECE($GET(ORTO),U,2)?1"IV".E
QUIT 1
+3 IF +$GET(ORPCL)=130
QUIT 1
+4 IF $GET(^TMP("PS",$JOB,"B",0))
QUIT 1
+5 QUIT 0
+6 ;
IV1 ; -- IV fluid, Infusion order [continued from VPRDJ05]
+1 ; [Also expects ORPK, OEL^PSOORRL data]
+2 NEW PS,PS0,X,X0,RTE,I,ADD,BASE
+3 SET MED("vaType")="V"
SET MED("medType")="urn:sct:105903003"
+4 SET (ADD,BASE)=""
+5 IF ORPK
IF $DATA(^TMP("PS",$JOB))
Begin DoDot:1
+6 MERGE PS=^TMP("PS",$JOB)
SET PS0=$GET(PS(0))
SET MED("name")=$PIECE(PS0,U)
+7 SET X=$GET(PS("MDR",1,0))
if $LENGTH(X)
SET MED("dosages",1,"routeName")=X
+8 SET X=$PIECE($GET(PS("SCH",1,0)),U)
IF $LENGTH(X)
Begin DoDot:2
+9 SET MED("dosages",1,"scheduleName")=X
+10 NEW Y
DO SCH(X)
+11 MERGE MED("dosages",1)=Y
End DoDot:2
+12 SET X=$GET(PS("ADM",1,0))
if $LENGTH(X)
SET MED("dosages",1,"adminTimes")=X
+13 SET X=$PIECE(PS0,U,2)
IF X["INFUSE OVER"
SET MED("dosages",1,"duration")=X
+14 IF '$TEST
SET MED("dosages",1,"ivRate")=X
+15 SET X=$GET(PS("IVLIM",0))
if $LENGTH(X)
SET MED("dosages",1,"restriction")=$$IVLIM(X)
+16 SET X=+$PIECE($GET(PS("RXN",0)),U,5)
+17 if X
SET MED("orders",1,"pharmacistUid")=$$SETUID^VPRUTILS("user",,X)
SET MED("orders",1,"pharmacistName")=$PIECE($GET(^VA(200,X,0)),U)
+18 DO IVP
End DoDot:1
GOTO IVQ
+19 ; no med in PS (pending or cancelled), so use Order values
+20 SET RTE=+$$VALUE^ORX8(ID,"ROUTE")
IF RTE
Begin DoDot:1
+21 DO ALL^PSS51P2(RTE,,,,"VPRTE")
+22 SET MED("dosages",1,"routeName")=$GET(^TMP($JOB,"VPRTE",RTE,1))
End DoDot:1
+23 SET X=$$VALUE^ORX8(ID,"SCHEDULE")
IF $LENGTH(X)
Begin DoDot:1
+24 SET MED("dosages",1,"scheduleName")=X
+25 NEW Y
DO SCH(X)
+26 MERGE MED("dosages",1)=Y
End DoDot:1
+27 SET X=$$VALUE^ORX8(ID,"ADMIN")
if $LENGTH(X)
SET MED("dosages",1,"adminTimes")=X
+28 SET X=$$VALUE^ORX8(ID,"RATE")
+29 IF X["INFUSE OVER"
SET MED("dosages",1,"duration")=X
+30 IF '$TEST
SET MED("dosages",1,"ivRate")=X
+31 SET I=0
FOR
SET I=$ORDER(^OR(100,ID,.1,I))
if I<1
QUIT
SET X=+$GET(^(I,0))
Begin DoDot:1
+32 SET X0=$GET(^ORD(101.43,X,0))
SET MED("name")=$PIECE(X0,U)
+33 SET MED("products",I,"ingredientName")=$PIECE(X0,U)
End DoDot:1
+34 SET X=$$VALUE^ORX8(ID,"DAYS")
IF $LENGTH(X)
Begin DoDot:1
+35 IF X?1.A1.N
SET X=$$IVLIM(X)
QUIT
+36 ; CPRS format = "for a total of 3 doses" or "with total volume 100ml"
+37 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("dosages",1,"restriction")=X
IVQ ; done
+1 KILL ^TMP("PS",$JOB),^TMP($JOB,"VPRTE")
+2 SET MED("qualifiedName")=ADD_$SELECT($LENGTH(ADD)&$LENGTH(BASE):" in ",1:"")_BASE
+3 DO BCMA(.MED,DFN,ORPK)
+4 DO ADD^VPRDJ("MED","med")
+5 QUIT
+6 ;
IVP ; -- add IV products
+1 ; [expects PS("A") & PS("B") data arrays from IV1]
+2 NEW VPI,N,NAME,IEN,DRUG,OI,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 OI=$GET(^TMP($JOB,"VPRPSIV",IEN,15))
if OI
SET NAME=$$NAME(+OI)
+9 SET N=N+1
if DRUG
DO NDF(DRUG,N,"A",NAME)
+10 SET MED("products",N,"strength")=$PIECE($GET(PS("A",VPI,0)),U,2)
End DoDot:1
+11 ; IV Base Solutions
+12 SET VPI=0
FOR
SET VPI=$ORDER(PS("B",VPI))
if VPI<1
QUIT
Begin DoDot:1
+13 KILL ^TMP($JOB,"VPRPSIV")
SET NAME=$PIECE($GET(PS("B",VPI,0)),U)
+14 DO ZERO^PSS52P7("",NAME,"","VPRPSIV")
+15 SET IEN=$ORDER(^TMP($JOB,"VPRPSIV",0))
SET DRUG=+$GET(^(IEN,1))
if IEN<1
QUIT
+16 SET OI=$GET(^TMP($JOB,"VPRPSIV",IEN,9))
if OI
SET NAME=$$NAME(+OI)
+17 SET N=N+1
if DRUG
DO NDF(DRUG,N,"B",NAME)
+18 SET MED("products",N,"volume")=$PIECE($GET(PS("B",VPI,0)),U,2)
End DoDot:1
+19 KILL ^TMP($JOB,"VPRPSIV")
+20 QUIT
+21 ;
NAME(PSOI) ; -- return name_form of PS orderable item
+1 NEW Y,VPRX
SET PSOI=+$GET(PSOI)
SET Y=""
+2 DO EN^PSSDI(50.7,,50.7,".01;.02",PSOI,"VPRX")
+3 if $DATA(VPRX)
SET Y=$GET(VPRX(50.7,PSOI,.01))_" "_$GET(VPRX(50.7,PSOI,.02))
+4 QUIT Y
+5 ;
NDF(DRUG,VPI,ROLE,OI) ; -- Set NDF data for dispense DRUG ien
+1 ; code ^ name ^ vuid ^ role ^ concentration
+2 NEW VPRX,VUID,X,I,CONC,NM
+3 SET DRUG=+$GET(DRUG)
if 'DRUG
QUIT
+4 DO NDF^PSS50(DRUG,,,,,"NDF")
+5 SET CONC=$PIECE($GET(PS(ROLE,VPI,0)),U,2)
SET NM=""
+6 ;
+7 SET MED("products",VPI,"ingredientRole")=$$ROLE(ROLE)
+8 SET OI=$GET(OI)
if $LENGTH(OI)
SET MED("products",VPI,"ingredientName")=OI
SET NM=OI
+9 ; NM=X
+10 ;
+11 ;VA Generic
SET X=$GET(^TMP($JOB,"NDF",DRUG,20))
IF X
Begin DoDot:1
+12 SET MED("products",VPI,"ingredientCode")="urn:va:vuid:"_$$VUID^VPRD(+X,50.6)
+13 SET MED("products",VPI,"ingredientCodeName")=$PIECE(X,U,2)
End DoDot:1
+14 ;
+15 ;VA Product
SET X=$GET(^TMP($JOB,"NDF",DRUG,22))
IF X
Begin DoDot:1
+16 SET MED("products",VPI,"suppliedCode")="urn:va:vuid:"_$$VUID^VPRD(+X,50.68)
+17 SET MED("products",VPI,"suppliedName")=$PIECE(X,U,2)_" "_CONC
+18 if NM=""
SET NM=$PIECE(X,U,2)
End DoDot:1
+19 ;
+20 ;VA Drug Class
SET X=$GET(^TMP($JOB,"NDF",DRUG,25))
IF X
Begin DoDot:1
+21 SET MED("products",VPI,"drugClassCode")="urn:vadc:"_$PIECE(X,U,2)
+22 SET MED("products",VPI,"drugClassName")=$PIECE(X,U,3)
+23 if NM=""
SET NM=$PIECE(X,U,3)
End DoDot:1
+24 ;
+25 IF $LENGTH(NM)
IF ROLE="A"
SET ADD=ADD_$SELECT($LENGTH(ADD):", ",1:"")_NM
+26 IF $LENGTH(NM)
IF ROLE="B"
SET BASE=BASE_$SELECT($LENGTH(BASE):", ",1:"")_NM
+27 KILL ^TMP($JOB,"NDF",DRUG)
+28 QUIT
+29 ;
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
+13 ;
ROLE(X) ;
+1 NEW RESULT,TXT,Y
+2 SET RESULT=""
SET TXT="urn:sct:"
+3 SET RESULT=$SELECT(X="A":TXT_"418804003",X="B":TXT_"418297009",1:TXT_"410942007")
+4 QUIT RESULT
+5 ;
MEDSTAT(X) ;
+1 NEW Y
SET Y="urn:sct:"
+2 SET Y=Y_$SELECT(X="active":"55561003",X="historical":"392521001","hold":"421139008",1:"73425007")
+3 QUIT Y
+4 ;
TYPE(VA) ;
+1 NEW RESULT,TXT,Y
+2 SET RESULT=""
SET TXT="urn:sct:"
+3 SET RESULT=$SELECT(VA="N":TXT_"329505003",VA="O":TXT_"73639000",1:TXT_"105903003")
+4 QUIT RESULT
+5 ;
SCH(NAME) ; -- Return other schedule info
+1 NEW I
KILL ^TMP($JOB,"VPRS")
+2 ;strip off PRN for search
IF NAME?.E1" PRN"
SET NAME=$PIECE(NAME," PRN")
if NAME=""
QUIT
+3 DO ZERO^PSS51P1("",NAME,"PSJ",,"VPRS")
+4 SET I=+$ORDER(^TMP($JOB,"VPRS","B",NAME,0))
if 'I
QUIT
+5 SET Y("scheduleFreq")=+$GET(^TMP($JOB,"VPRS",I,2))
+6 SET Y("scheduleType")=$PIECE($GET(^TMP($JOB,"VPRS",I,5)),U,2)
+7 KILL ^TMP($JOB,"VPRS")
+8 QUIT
+9 ;
BCMA(Y,DFN,ORPK) ; -- administration times
+1 if $GET(DFN)<1
QUIT
if $GET(ORPK)<1
QUIT
+2 NEW ADT,DA,CNT,STS
SET (ADT,CNT)=0
+3 FOR
SET ADT=$ORDER(^PSB(53.79,"AORDX",DFN,ORPK,ADT))
if ADT<1
QUIT
Begin DoDot:1
+4 SET DA=0
FOR
SET DA=+$ORDER(^PSB(53.79,"AORDX",DFN,ORPK,ADT,DA))
if DA<1
QUIT
Begin DoDot:2
+5 SET STS=$$GET1^DIQ(53.79,DA_",",.09)
if STS="REMOVED"
QUIT
+6 SET CNT=CNT+1
SET Y("administrations",CNT,"status")=STS
+7 SET Y("administrations",CNT,"dateTime")=$$JSONDT^VPRUTILS(ADT)
End DoDot:2
End DoDot:1
+8 QUIT
