Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPDJ05V

HMPDJ05V.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^OR(100 5771
  1. ; ^ORD(100.98 873
  1. ; ^ORD(101.43 2843
  1. ; ^PSB(53.79 5909
  1. ; ^SC 10040
  1. ; ^VA(200 10060
  1. ; DIQ 2056
  1. ; ORQ1,^TMP("ORR" 3154
  1. ; ORX8 2467,3071
  1. ; PSODI 4858
  1. ; PSOORDER,^TMP("PSOR" 1878
  1. ; PSOORRL,^TMP("PS" 2400
  1. ; PSS50 4533
  1. ; PSS50P7 4662
  1. ; PSS51P1 4546
  1. ; PSS51P2 4548
  1. ; PSS52P6 4549
  1. ; PSS52P7 4550
  1. ; PSSDI 4551
  1. ; XLFDT 10103
  1. ; XLFSTR 10104
  1. ;
  1. ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
  1. Q
  1. ;
  1. ISIV() ; -- Return 1 or 0, if order is for IV/infusion
  1. I ORPK["V" Q 1
  1. I $P($G(ORTO),U,2)?1"IV".E Q 1
  1. I +$G(ORPCL)=130 Q 1
  1. I $G(^TMP("PS",$J,"B",0)) Q 1
  1. Q 0
  1. ;
  1. IV1 ; -- IV fluid, Infusion order [continued from HMPDJ05]
  1. ; [Also expects ORPK, OEL^PSOORRL data]
  1. N PS,PS0,X,X0,RTE,I,ADD,BASE
  1. S MED("vaType")="V",MED("medType")="urn:sct:105903003"
  1. S (ADD,BASE)=""
  1. I ORPK,$D(^TMP("PS",$J)) D G IVQ
  1. . M PS=^TMP("PS",$J) S PS0=$G(PS(0)),MED("name")=$P(PS0,U)
  1. . S X=$G(PS("MDR",1,0)) S:$L(X) MED("dosages",1,"routeName")=X
  1. . S X=$P($G(PS("SCH",1,0)),U) I $L(X) D
  1. .. S MED("dosages",1,"scheduleName")=X
  1. .. N Y D SCH(X)
  1. .. M MED("dosages",1)=Y
  1. . S X=$G(PS("ADM",1,0)) S:$L(X) MED("dosages",1,"adminTimes")=X
  1. . S X=$P(PS0,U,2) I X["INFUSE OVER" S MED("dosages",1,"duration")=X
  1. . E S MED("dosages",1,"ivRate")=X
  1. . S X=$G(PS("IVLIM",0)) S:$L(X) MED("dosages",1,"restriction")=$$IVLIM(X)
  1. . S X=+$P($G(PS("RXN",0)),U,5)
  1. . S:X MED("orders",1,"pharmacistUid")=$$SETUID^HMPUTILS("user",,X),MED("orders",1,"pharmacistName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
  1. . D IVP
  1. ; no med in PS (pending or cancelled), so use Order values
  1. S RTE=+$$VALUE^ORX8(ID,"ROUTE") I RTE D
  1. . D ALL^PSS51P2(RTE,,,,"HMPTE")
  1. . S MED("dosages",1,"routeName")=$G(^TMP($J,"HMPTE",RTE,1))
  1. S X=$$VALUE^ORX8(ID,"SCHEDULE") I $L(X) D
  1. . S MED("dosages",1,"scheduleName")=X
  1. . N Y D SCH(X)
  1. . M MED("dosages",1)=Y
  1. S X=$$VALUE^ORX8(ID,"ADMIN") S:$L(X) MED("dosages",1,"adminTimes")=X
  1. S X=$$VALUE^ORX8(ID,"RATE")
  1. I X["INFUSE OVER" S MED("dosages",1,"duration")=X
  1. E S MED("dosages",1,"ivRate")=X
  1. ;DE2818, ^OR(100) references - ICR 5771
  1. S I=0 F S I=$O(^OR(100,ID,.1,I)) Q:I<1 S X=+$G(^(I,0)) D
  1. . S X0=$$GET1^DIQ(101.43,X_",",.01),MED("name")=$P(X0,U) ;DE2818, ICR 2843
  1. . S MED("products",I,"ingredientName")=$P(X0,U)
  1. S X=$$VALUE^ORX8(ID,"DAYS") I $L(X) D S MED("dosages",1,"restriction")=X
  1. . I X?1.A1.N S X=$$IVLIM(X) Q
  1. . ; CPRS format = "for a total of 3 doses" or "with total volume 100ml"
  1. . F I=1:1:$L(X) I $E(X,I)=+$E(X,I) S X=$E(X,I,$L(X)) Q
  1. IVQ ; done
  1. K ^TMP("PS",$J),^TMP($J,"HMPTE")
  1. S MED("qualifiedName")=ADD_$S($L(ADD)&$L(BASE):" in ",1:"")_BASE
  1. S MED("lastUpdateTime")=$$EN^HMPSTMP("med") ;RHL 20150102
  1. S MED("stampTime")=MED("lastUpdateTime") ; RHL 20150102
  1. D BCMA(.MED,DFN,ORPK)
  1. ;US6734 - pre-compile metastamp
  1. I $G(HMPMETA) D ADD^HMPMETA("med",MED("uid"),MED("stampTime")) Q:HMPMETA=1 ;US6734,US11019
  1. D ADD^HMPDJ("MED","med")
  1. Q
  1. ;
  1. IVP ; -- add IV products
  1. ; [expects PS("A") & PS("B") data arrays from IV1]
  1. N VPI,N,NAME,IEN,DRUG,OI,X S N=0
  1. ; IV Additives
  1. S VPI=0 F S VPI=$O(PS("A",VPI)) Q:VPI<1 D
  1. . K ^TMP($J,"HMPPSIV") S NAME=$P($G(PS("A",VPI,0)),U)
  1. . D ZERO^PSS52P6("",NAME,"","HMPPSIV")
  1. . S IEN=$O(^TMP($J,"HMPPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
  1. . S OI=$G(^TMP($J,"HMPPSIV",IEN,15)) S:OI NAME=$$NAME(+OI)
  1. . S N=N+1 D:DRUG NDF(DRUG,N,"A",NAME)
  1. . S MED("products",N,"strength")=$P($G(PS("A",VPI,0)),U,2)
  1. ; IV Base Solutions
  1. S VPI=0 F S VPI=$O(PS("B",VPI)) Q:VPI<1 D
  1. . K ^TMP($J,"HMPPSIV") S NAME=$P($G(PS("B",VPI,0)),U)
  1. . D ZERO^PSS52P7("",NAME,"","HMPPSIV")
  1. . S IEN=$O(^TMP($J,"HMPPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
  1. . S OI=$G(^TMP($J,"HMPPSIV",IEN,9)) S:OI NAME=$$NAME(+OI)
  1. . S N=N+1 D:DRUG NDF(DRUG,N,"B",NAME)
  1. . S MED("products",N,"volume")=$P($G(PS("B",VPI,0)),U,2)
  1. K ^TMP($J,"HMPPSIV")
  1. Q
  1. ;
  1. NAME(PSOI) ; -- return name_form of PS orderable item
  1. N Y,HMPX S PSOI=+$G(PSOI),Y=""
  1. D EN^PSSDI(50.7,,50.7,".01;.02",PSOI,"HMPX")
  1. S:$D(HMPX) Y=$G(HMPX(50.7,PSOI,.01))_" "_$G(HMPX(50.7,PSOI,.02))
  1. Q Y
  1. ;
  1. NDF(DRUG,VPI,ROLE,OI) ; -- Set NDF data for dispense DRUG ien
  1. ; code ^ name ^ vuid ^ role ^ concentration
  1. N HMPX,VUID,X,I,CONC,NM
  1. S DRUG=+$G(DRUG) Q:'DRUG
  1. D NDF^PSS50(DRUG,,,,,"NDF")
  1. S CONC=$P($G(PS(ROLE,VPI,0)),U,2),NM=""
  1. ;
  1. S MED("products",VPI,"ingredientRole")=$$ROLE(ROLE)
  1. S OI=$G(OI) S:$L(OI) MED("products",VPI,"ingredientName")=OI,NM=OI
  1. ; NM=X
  1. ;
  1. S X=$G(^TMP($J,"NDF",DRUG,20)) I X D ;VA Generic
  1. . S MED("products",VPI,"ingredientCode")="urn:va:vuid:"_$$VUID^HMPD(+X,50.6)
  1. . S MED("products",VPI,"ingredientCodeName")=$P(X,U,2)
  1. ;
  1. S X=$G(^TMP($J,"NDF",DRUG,22)) I X D ;VA Product
  1. . S MED("products",VPI,"suppliedCode")="urn:va:vuid:"_$$VUID^HMPD(+X,50.68)
  1. . S MED("products",VPI,"suppliedName")=$P(X,U,2)_" "_CONC
  1. . S:NM="" NM=$P(X,U,2)
  1. ;
  1. S X=$G(^TMP($J,"NDF",DRUG,25)) I X D ;VA Drug Class
  1. . S MED("products",VPI,"drugClassCode")="urn:vadc:"_$P(X,U,2)
  1. . S MED("products",VPI,"drugClassName")=$P(X,U,3)
  1. . S:NM="" NM=$P(X,U,3)
  1. ;
  1. I $L(NM),ROLE="A" S ADD=ADD_$S($L(ADD):", ",1:"")_NM
  1. I $L(NM),ROLE="B" S BASE=BASE_$S($L(BASE):", ",1:"")_NM
  1. K ^TMP($J,"NDF",DRUG)
  1. Q
  1. ;
  1. IVLIM(X) ; -- Return expanded version of IV Limit X
  1. I '$L($G(X)) Q ""
  1. N Y,VAL,UNT,I
  1. S Y="",X=$$UP^XLFSTR(X)
  1. I X?1"DOSES".E S X="A"_$P(X,"DOSES",2)
  1. S UNT=$E(X),VAL=0 F I=2:1:$L(X) I $E(X,I) S VAL=$E(X,I,$L(X)) Q
  1. I UNT="A" S Y=+VAL_$S(+VAL>1:" doses",1:" dose")
  1. I UNT="D" S Y=+VAL_$S(+VAL>1:" days",1:" day")
  1. I UNT="H" S Y=+VAL_$S(+VAL>1:" hours",1:" hour")
  1. I UNT="C" S Y=+VAL_" CC"
  1. I UNT="M" S Y=+VAL_" ml"
  1. I UNT="L" S Y=+VAL_" L"
  1. Q Y
  1. ;
  1. ROLE(X) ;
  1. N RESULT,TXT,Y
  1. S RESULT="",TXT="urn:sct:"
  1. S RESULT=$S(X="A":TXT_"418804003",X="B":TXT_"418297009",1:TXT_"410942007")
  1. Q RESULT
  1. ;
  1. MEDSTAT(X) ;
  1. N Y S Y="urn:sct:"
  1. S Y=Y_$S(X="active":"55561003",X="historical":"392521001","hold":"421139008",1:"73425007")
  1. Q Y
  1. ;
  1. TYPE(VA) ;
  1. N RESULT,TXT,Y
  1. S RESULT="",TXT="urn:sct:"
  1. S RESULT=$S(VA="N":TXT_"329505003",VA="O":TXT_"73639000",1:TXT_"105903003")
  1. Q RESULT
  1. ;
  1. SCH(NAME) ; -- Return other schedule info
  1. N I K ^TMP($J,"HMPS")
  1. I NAME?.E1" PRN" S NAME=$P(NAME," PRN") Q:NAME="" ;strip off PRN for search
  1. D ZERO^PSS51P1("",NAME,"PSJ",,"HMPS")
  1. S I=+$O(^TMP($J,"HMPS","B",NAME,0)) Q:'I
  1. S Y("scheduleFreq")=+$G(^TMP($J,"HMPS",I,2))
  1. S Y("scheduleType")=$P($G(^TMP($J,"HMPS",I,5)),U,2)
  1. K ^TMP($J,"HMPS")
  1. Q
  1. ;
  1. BCMA(RET,DFN,ORPK) ; -- administration times
  1. Q:$G(DFN)<1 Q:$G(ORPK)<1
  1. N LAST,ADT,DA,CNT,X,Y,N,NODE,X0,DRUG,HMPDT
  1. ;DE2818 begin, ^PSB(53.79) references - ICR 5909
  1. S LAST=$P($O(^PSB(53.79,"AORDX",DFN,ORPK,9999999),-1),".")
  1. S ADT=$$FMADD^XLFDT(LAST,-90) ;return most recent 90 days
  1. S CNT=0 F S ADT=$O(^PSB(53.79,"AORDX",DFN,ORPK,ADT)) Q:ADT<1 D
  1. . S DA=0 F S DA=+$O(^PSB(53.79,"AORDX",DFN,ORPK,ADT,DA)) Q:DA<1 D
  1. .. S X=$$GET1^DIQ(53.79,DA_",",.09) Q:X="REMOVED" ;status
  1. .. S Y("status")=X,Y("dateTime")=$$JSONDT^HMPUTILS(ADT)
  1. .. S X=+$P($G(^PSB(53.79,DA,0)),U,7) I X D
  1. ... S Y("administeredByUid")=$$SETUID^HMPUTILS("user",,X)
  1. ... S Y("administeredByName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
  1. .. S X=$P($G(^PSB(53.79,DA,.1)),U,6) S:$L(X) Y("injectionSite")=X
  1. .. S X=$G(^PSB(53.79,DA,.2)) ;PRN
  1. .. S:$L($P(X,U,1)) Y("prnReason")=$P(X,U)
  1. .. S:$L($P(X,U,2)) Y("prnEffectiveness")=$P(X,U,2)
  1. .. ; comments
  1. .. S N=0 F S N=$O(^PSB(53.79,DA,.3,N)) Q:N<1 S X=$G(^(N,0)) D
  1. ... S Y("comment",N,"text")=$P(X,U)
  1. ... S:$P(X,U,3) Y("comment",N,"dateTime")=$$JSONDT^HMPUTILS($P(X,U,3))
  1. ... S X=+$P(X,U,2) Q:X<1
  1. ... S Y("comment",N,"enteredByUid")=$$SETUID^HMPUTILS("user",,X)
  1. ... S Y("comment",N,"enteredByName")=$$GET1^DIQ(200,X_",",.01) ;DE2818
  1. .. ; drugs administered
  1. .. 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
  1. ... S X=$P(X0,U,2)
  1. ... I NODE=.5 S X=$G(DRUG(+X0)) S:X="" X=$$EXTERNAL^DILFD(53.795,.01,,+X0),DRUG(+X0)=X
  1. ... S:$L(X) Y("medication",N,"name")=X
  1. ... S X=$P(X0,U,3) S:$L(X) Y("medication",N,"amount")=X
  1. ... S X=$P(X0,U,4) S:$L(X) Y("medication",N,"units")=X
  1. .. S CNT=CNT+1 M RET("administrations",CNT)=Y
  1. ;DE2818 end, ^PSB(53.79) references - ICR 5909
  1. ; get next scheduled administration time
  1. ;D ADMIN^PSBHMP(.HMPDT,DFN,ORPK) ; <<< 12.3
  1. D ADMIN^PSBVPR(.HMPDT,DFN,ORPK) ; <<<< 12.3
  1. S:$G(HMPDT) RET("nextAdminTime")=HMPDT
  1. Q