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

VPRDJ05V.m

Go to the documentation of this file. 
  1. VPRDJ05V ;SLC/MKB -- IV/Infusions ;8/2/11  15:29
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
  1.  ;;Per VHA Directive 2004-038, 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                         4483
  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, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
  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 VPRDJ05]
  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^VPRUTILS("user",,X),MED("orders",1,"pharmacistName")=$P($G(^VA(200,X,0)),U)
  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,,,,"VPRTE")
  1.  . S MED("dosages",1,"routeName")=$G(^TMP($J,"VPRTE",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.  S I=0 F  S I=$O(^OR(100,ID,.1,I)) Q:I<1  S X=+$G(^(I,0)) D
  1.  . S X0=$G(^ORD(101.43,X,0)),MED("name")=$P(X0,U)
  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,"VPRTE")
  1.  S MED("qualifiedName")=ADD_$S($L(ADD)&$L(BASE):" in ",1:"")_BASE
  1.  D BCMA(.MED,DFN,ORPK)
  1.  D ADD^VPRDJ("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,"VPRPSIV") S NAME=$P($G(PS("A",VPI,0)),U)
  1.  . D ZERO^PSS52P6("",NAME,"","VPRPSIV")
  1.  . S IEN=$O(^TMP($J,"VPRPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
  1.  . S OI=$G(^TMP($J,"VPRPSIV",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,"VPRPSIV") S NAME=$P($G(PS("B",VPI,0)),U)
  1.  . D ZERO^PSS52P7("",NAME,"","VPRPSIV")
  1.  . S IEN=$O(^TMP($J,"VPRPSIV",0)),DRUG=+$G(^(IEN,1)) Q:IEN<1
  1.  . S OI=$G(^TMP($J,"VPRPSIV",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,"VPRPSIV")
  1.  Q 
  1.  ;
  1. NAME(PSOI) ; -- return name_form of PS orderable item
  1.  N Y,VPRX S PSOI=+$G(PSOI),Y=""
  1.  D EN^PSSDI(50.7,,50.7,".01;.02",PSOI,"VPRX")
  1.  S:$D(VPRX) Y=$G(VPRX(50.7,PSOI,.01))_" "_$G(VPRX(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 VPRX,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^VPRD(+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^VPRD(+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,"VPRS")
  1.  I NAME?.E1" PRN" S NAME=$P(NAME," PRN") Q:NAME=""  ;strip off PRN for search
  1.  D ZERO^PSS51P1("",NAME,"PSJ",,"VPRS")
  1.  S I=+$O(^TMP($J,"VPRS","B",NAME,0)) Q:'I
  1.  S Y("scheduleFreq")=+$G(^TMP($J,"VPRS",I,2))
  1.  S Y("scheduleType")=$P($G(^TMP($J,"VPRS",I,5)),U,2)
  1.  K ^TMP($J,"VPRS")
  1.  Q
  1.  ;
  1. BCMA(Y,DFN,ORPK) ; -- administration times
  1.  Q:$G(DFN)<1  Q:$G(ORPK)<1
  1.  N ADT,DA,CNT,STS S (ADT,CNT)=0
  1.  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 STS=$$GET1^DIQ(53.79,DA_",",.09) Q:STS="REMOVED"
  1.  .. S CNT=CNT+1,Y("administrations",CNT,"status")=STS
  1.  .. S Y("administrations",CNT,"dateTime")=$$JSONDT^VPRUTILS(ADT)
  1.  Q