HMPDJ05V ;SLC/MKB,ASMR/RRB - IV/Infusions;Nov 09, 2015 15:40:35
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
;Per VA Directive 6402, 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 4533
; PSS50P7 4662
; PSS51P1 4546
; PSS51P2 4548
; PSS52P6 4549
; PSS52P7 4550
; PSSDI 4551
; XLFDT 10103
; XLFSTR 10104
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
Q
;
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 HMPDJ05]
; [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^HMPUTILS("user",,X),MED("orders",1,"pharmacistName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
. 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,,,,"HMPTE")
. S MED("dosages",1,"routeName")=$G(^TMP($J,"HMPTE",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
;DE2818, ^OR(100) references - ICR 5771
S I=0 F S I=$O(^OR(100,ID,.1,I)) Q:I<1 S X=+$G(^(I,0)) D
. S X0=$$GET1^DIQ(101.43,X_",",.01),MED("name")=$P(X0,U) ;DE2818, ICR 2843
. 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,"HMPTE")
S MED("qualifiedName")=ADD_$S($L(ADD)&$L(BASE):" in ",1:"")_BASE
S MED("lastUpdateTime")=$$EN^HMPSTMP("med") ;RHL 20150102
S MED("stampTime")=MED("lastUpdateTime") ; RHL 20150102
D BCMA(.MED,DFN,ORPK)
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("med",MED("uid"),MED("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("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,"HMPPSIV") S NAME=$P($G(PS("A",VPI,0)),U)
. D ZERO^PSS52P6("",NAME,"","HMPPSIV")
. S IEN=$O(^TMP($J,"HMPPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
. S OI=$G(^TMP($J,"HMPPSIV",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,"HMPPSIV") S NAME=$P($G(PS("B",VPI,0)),U)
. D ZERO^PSS52P7("",NAME,"","HMPPSIV")
. S IEN=$O(^TMP($J,"HMPPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
. S OI=$G(^TMP($J,"HMPPSIV",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,"HMPPSIV")
Q
;
NAME(PSOI) ; -- return name_form of PS orderable item
N Y,HMPX S PSOI=+$G(PSOI),Y=""
D EN^PSSDI(50.7,,50.7,".01;.02",PSOI,"HMPX")
S:$D(HMPX) Y=$G(HMPX(50.7,PSOI,.01))_" "_$G(HMPX(50.7,PSOI,.02))
Q Y
;
NDF(DRUG,VPI,ROLE,OI) ; -- Set NDF data for dispense DRUG ien
; code ^ name ^ vuid ^ role ^ concentration
N HMPX,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^HMPD(+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^HMPD(+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,"HMPS")
I NAME?.E1" PRN" S NAME=$P(NAME," PRN") Q:NAME="" ;strip off PRN for search
D ZERO^PSS51P1("",NAME,"PSJ",,"HMPS")
S I=+$O(^TMP($J,"HMPS","B",NAME,0)) Q:'I
S Y("scheduleFreq")=+$G(^TMP($J,"HMPS",I,2))
S Y("scheduleType")=$P($G(^TMP($J,"HMPS",I,5)),U,2)
K ^TMP($J,"HMPS")
Q
;
BCMA(RET,DFN,ORPK) ; -- administration times
Q:$G(DFN)<1 Q:$G(ORPK)<1
N LAST,ADT,DA,CNT,X,Y,N,NODE,X0,DRUG,HMPDT
;DE2818 begin, ^PSB(53.79) references - ICR 5909
S LAST=$P($O(^PSB(53.79,"AORDX",DFN,ORPK,9999999),-1),".")
S ADT=$$FMADD^XLFDT(LAST,-90) ;return most recent 90 days
S 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 X=$$GET1^DIQ(53.79,DA_",",.09) Q:X="REMOVED" ;status
.. S Y("status")=X,Y("dateTime")=$$JSONDT^HMPUTILS(ADT)
.. S X=+$P($G(^PSB(53.79,DA,0)),U,7) I X D
... S Y("administeredByUid")=$$SETUID^HMPUTILS("user",,X)
... S Y("administeredByName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
.. S X=$P($G(^PSB(53.79,DA,.1)),U,6) S:$L(X) Y("injectionSite")=X
.. S X=$G(^PSB(53.79,DA,.2)) ;PRN
.. S:$L($P(X,U,1)) Y("prnReason")=$P(X,U)
.. S:$L($P(X,U,2)) Y("prnEffectiveness")=$P(X,U,2)
.. ; comments
.. S N=0 F S N=$O(^PSB(53.79,DA,.3,N)) Q:N<1 S X=$G(^(N,0)) D
... S Y("comment",N,"text")=$P(X,U)
... S:$P(X,U,3) Y("comment",N,"dateTime")=$$JSONDT^HMPUTILS($P(X,U,3))
... S X=+$P(X,U,2) Q:X<1
... S Y("comment",N,"enteredByUid")=$$SETUID^HMPUTILS("user",,X)
... S Y("comment",N,"enteredByName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
.. ; drugs administered
.. F NODE=.5,.6,.7 S N=0 F S N=$O(^PSB(53.79,DA,NODE,N)) Q:N<1 S X0=$G(^(N,0)) D
... S X=$P(X0,U,2)
... I NODE=.5 S X=$G(DRUG(+X0)) S:X="" X=$$EXTERNAL^DILFD(53.795,.01,,+X0),DRUG(+X0)=X
... S:$L(X) Y("medication",N,"name")=X
... S X=$P(X0,U,3) S:$L(X) Y("medication",N,"amount")=X
... S X=$P(X0,U,4) S:$L(X) Y("medication",N,"units")=X
.. S CNT=CNT+1 M RET("administrations",CNT)=Y
;DE2818 end, ^PSB(53.79) references - ICR 5909
; get next scheduled administration time
;D ADMIN^PSBHMP(.HMPDT,DFN,ORPK) ; <<< 12.3
D ADMIN^PSBVPR(.HMPDT,DFN,ORPK) ; <<<< 12.3
S:$G(HMPDT) RET("nextAdminTime")=HMPDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ05V 9130 printed Apr 09, 2024@20:59:02 Page 2
HMPDJ05V ;SLC/MKB,ASMR/RRB - IV/Infusions;Nov 09, 2015 15:40:35
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;Sep 01, 2011;Build 63
+2 ;Per VA Directive 6402, 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 4533
+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, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+29 QUIT
+30 ;
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 HMPDJ05]
+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 ;DE2818
if X
SET MED("orders",1,"pharmacistUid")=$$SETUID^HMPUTILS("user",,X)
SET MED("orders",1,"pharmacistName")=$$GET1^DIQ(200,X_",",.01)
+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,,,,"HMPTE")
+22 SET MED("dosages",1,"routeName")=$GET(^TMP($JOB,"HMPTE",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 ;DE2818, ^OR(100) references - ICR 5771
+32 SET I=0
FOR
SET I=$ORDER(^OR(100,ID,.1,I))
if I<1
QUIT
SET X=+$GET(^(I,0))
Begin DoDot:1
+33 ;DE2818, ICR 2843
SET X0=$$GET1^DIQ(101.43,X_",",.01)
SET MED("name")=$PIECE(X0,U)
+34 SET MED("products",I,"ingredientName")=$PIECE(X0,U)
End DoDot:1
+35 SET X=$$VALUE^ORX8(ID,"DAYS")
IF $LENGTH(X)
Begin DoDot:1
+36 IF X?1.A1.N
SET X=$$IVLIM(X)
QUIT
+37 ; CPRS format = "for a total of 3 doses" or "with total volume 100ml"
+38 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,"HMPTE")
+2 SET MED("qualifiedName")=ADD_$SELECT($LENGTH(ADD)&$LENGTH(BASE):" in ",1:"")_BASE
+3 ;RHL 20150102
SET MED("lastUpdateTime")=$$EN^HMPSTMP("med")
+4 ; RHL 20150102
SET MED("stampTime")=MED("lastUpdateTime")
+5 DO BCMA(.MED,DFN,ORPK)
+6 ;US6734 - pre-compile metastamp
+7 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("med",MED("uid"),MED("stampTime"))
if HMPMETA=1
QUIT
+8 DO ADD^HMPDJ("MED","med")
+9 QUIT
+10 ;
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,"HMPPSIV")
SET NAME=$PIECE($GET(PS("A",VPI,0)),U)
+6 DO ZERO^PSS52P6("",NAME,"","HMPPSIV")
+7 SET IEN=$ORDER(^TMP($JOB,"HMPPSIV",0))
SET DRUG=+$GET(^(IEN,1))
if IEN<1
QUIT
+8 SET OI=$GET(^TMP($JOB,"HMPPSIV",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,"HMPPSIV")
SET NAME=$PIECE($GET(PS("B",VPI,0)),U)
+14 DO ZERO^PSS52P7("",NAME,"","HMPPSIV")
+15 SET IEN=$ORDER(^TMP($JOB,"HMPPSIV",0))
SET DRUG=+$GET(^(IEN,1))
if IEN<1
QUIT
+16 SET OI=$GET(^TMP($JOB,"HMPPSIV",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,"HMPPSIV")
+20 QUIT
+21 ;
NAME(PSOI) ; -- return name_form of PS orderable item
+1 NEW Y,HMPX
SET PSOI=+$GET(PSOI)
SET Y=""
+2 DO EN^PSSDI(50.7,,50.7,".01;.02",PSOI,"HMPX")
+3 if $DATA(HMPX)
SET Y=$GET(HMPX(50.7,PSOI,.01))_" "_$GET(HMPX(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 HMPX,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^HMPD(+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^HMPD(+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,"HMPS")
+2 ;strip off PRN for search
IF NAME?.E1" PRN"
SET NAME=$PIECE(NAME," PRN")
if NAME=""
QUIT
+3 DO ZERO^PSS51P1("",NAME,"PSJ",,"HMPS")
+4 SET I=+$ORDER(^TMP($JOB,"HMPS","B",NAME,0))
if 'I
QUIT
+5 SET Y("scheduleFreq")=+$GET(^TMP($JOB,"HMPS",I,2))
+6 SET Y("scheduleType")=$PIECE($GET(^TMP($JOB,"HMPS",I,5)),U,2)
+7 KILL ^TMP($JOB,"HMPS")
+8 QUIT
+9 ;
BCMA(RET,DFN,ORPK) ; -- administration times
+1 if $GET(DFN)<1
QUIT
if $GET(ORPK)<1
QUIT
+2 NEW LAST,ADT,DA,CNT,X,Y,N,NODE,X0,DRUG,HMPDT
+3 ;DE2818 begin, ^PSB(53.79) references - ICR 5909
+4 SET LAST=$PIECE($ORDER(^PSB(53.79,"AORDX",DFN,ORPK,9999999),-1),".")
+5 ;return most recent 90 days
SET ADT=$$FMADD^XLFDT(LAST,-90)
+6 SET CNT=0
FOR
SET ADT=$ORDER(^PSB(53.79,"AORDX",DFN,ORPK,ADT))
if ADT<1
QUIT
Begin DoDot:1
+7 SET DA=0
FOR
SET DA=+$ORDER(^PSB(53.79,"AORDX",DFN,ORPK,ADT,DA))
if DA<1
QUIT
Begin DoDot:2
+8 ;status
SET X=$$GET1^DIQ(53.79,DA_",",.09)
if X="REMOVED"
QUIT
+9 SET Y("status")=X
SET Y("dateTime")=$$JSONDT^HMPUTILS(ADT)
+10 SET X=+$PIECE($GET(^PSB(53.79,DA,0)),U,7)
IF X
Begin DoDot:3
+11 SET Y("administeredByUid")=$$SETUID^HMPUTILS("user",,X)
+12 ;DE2818
SET Y("administeredByName")=$$GET1^DIQ(200,X_",",.01)
End DoDot:3
+13 SET X=$PIECE($GET(^PSB(53.79,DA,.1)),U,6)
if $LENGTH(X)
SET Y("injectionSite")=X
+14 ;PRN
SET X=$GET(^PSB(53.79,DA,.2))
+15 if $LENGTH($PIECE(X,U,1))
SET Y("prnReason")=$PIECE(X,U)
+16 if $LENGTH($PIECE(X,U,2))
SET Y("prnEffectiveness")=$PIECE(X,U,2)
+17 ; comments
+18 SET N=0
FOR
SET N=$ORDER(^PSB(53.79,DA,.3,N))
if N<1
QUIT
SET X=$GET(^(N,0))
Begin DoDot:3
+19 SET Y("comment",N,"text")=$PIECE(X,U)
+20 if $PIECE(X,U,3)
SET Y("comment",N,"dateTime")=$$JSONDT^HMPUTILS($PIECE(X,U,3))
+21 SET X=+$PIECE(X,U,2)
if X<1
QUIT
+22 SET Y("comment",N,"enteredByUid")=$$SETUID^HMPUTILS("user",,X)
+23 ;DE2818
SET Y("comment",N,"enteredByName")=$$GET1^DIQ(200,X_",",.01)
End DoDot:3
+24 ; drugs administered
+25 FOR NODE=.5,.6,.7
SET N=0
FOR
SET N=$ORDER(^PSB(53.79,DA,NODE,N))
if N<1
QUIT
SET X0=$GET(^(N,0))
Begin DoDot:3
+26 SET X=$PIECE(X0,U,2)
+27 IF NODE=.5
SET X=$GET(DRUG(+X0))
if X=""
SET X=$$EXTERNAL^DILFD(53.795,.01,,+X0)
SET DRUG(+X0)=X
+28 if $LENGTH(X)
SET Y("medication",N,"name")=X
+29 SET X=$PIECE(X0,U,3)
if $LENGTH(X)
SET Y("medication",N,"amount")=X
+30 SET X=$PIECE(X0,U,4)
if $LENGTH(X)
SET Y("medication",N,"units")=X
End DoDot:3
+31 SET CNT=CNT+1
MERGE RET("administrations",CNT)=Y
End DoDot:2
End DoDot:1
+32 ;DE2818 end, ^PSB(53.79) references - ICR 5909
+33 ; get next scheduled administration time
+34 ;D ADMIN^PSBHMP(.HMPDT,DFN,ORPK) ; <<< 12.3
+35 ; <<<< 12.3
DO ADMIN^PSBVPR(.HMPDT,DFN,ORPK)
+36 if $GET(HMPDT)
SET RET("nextAdminTime")=HMPDT
+37 QUIT
