- 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 Feb 18, 2025@23:19:45 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