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

VPRDPSOR.m

Go to the documentation of this file.
  1. VPRDPSOR ;SLC/MKB -- Medication extract by order ;8/2/11 15:29
  1. ;;1.0;VIRTUAL PATIENT RECORD;**1,4,18,28,32,33**;Sep 01, 2011;Build 8
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^DIC(9.4 10048
  1. ; ^OR(100 5771
  1. ; ^ORD(100.98 873
  1. ; ^SC 10040
  1. ; ^VA(200 10060
  1. ; DIQ 2056
  1. ; ORCD 5493
  1. ; ORQ1,^TMP("ORR",$J) 3154
  1. ; ORX8 871,2467,3071
  1. ; PSOORRL,^TMP("PS",$J) 2400
  1. ; PSS50P7 4662
  1. ; PSS51P2 4548
  1. ;
  1. ; ------------ Get data from VistA ------------
  1. ;
  1. EN(DFN,BEG,END,MAX,ORIFN) ; -- find a patient's orders
  1. S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
  1. S BEG=$G(BEG,1410101),END=$G(END,4141015),MAX=$G(MAX,9999)
  1. N ORDIALOG ;med dialog array, keep/reuse
  1. ;
  1. ; get one order
  1. I $G(ORIFN) D EN1(ORIFN,.VPRITM),XML^VPRDPS(.VPRITM):$D(VPRITM) Q
  1. ;
  1. ; get all orders
  1. N TYPE,ORDG,ORFLG,ORVP,ORLIST,VPRITM,VPRCNT,VPRN,ORLIST,ORIFN,X3,X4,DAD
  1. S TYPE=$G(FILTER("vaType")) S:$L(TYPE) TYPE=$S(TYPE="N":"NV",TYPE="V":"IV",1:TYPE)_" "
  1. S ORDG=+$O(^ORD(100.98,"B",TYPE_"RX",0)),ORVP=DFN_";DPT("
  1. S ORFLG=+$G(FILTER("view"),6) ;default = Released Orders
  1. I 7<ORFLG,ORFLG<22,ORFLG'=18 Q ;action, event views not supported
  1. D EN^ORQ1(ORVP,ORDG,ORFLG,,BEG,END)
  1. K ^TMP("VPROR",$J) S (VPRCNT,VPRN)=0
  1. F S VPRN=$O(^TMP("ORR",$J,ORLIST,VPRN)) Q:VPRN<1 S ORIFN=+$G(^(VPRN)) D Q:VPRCNT'<MAX
  1. . Q:$D(^TMP("VPROR",$J,ORIFN)) ;Q:$P(ORIFN,";",2)>1 S ORIFN=+ORIFN
  1. . S X3=$G(^OR(100,ORIFN,3)),X4=$G(^(4))
  1. . Q:$P(X3,U,3)=13 I X4["P",$P(X3,U,3)=1 Q ;cancelled
  1. . S DAD=$P(X3,U,9) I DAD Q:$D(^TMP("VPROR",$J,DAD)) S ORIFN=DAD
  1. . K VPRITM D EN1(ORIFN,.VPRITM) Q:'$D(VPRITM)
  1. . D XML^VPRDPS(.VPRITM)
  1. . S ^TMP("VPROR",$J,ORIFN)="",VPRCNT=VPRCNT+1
  1. K ^TMP("VPROR",$J),^TMP("ORR",$J),^TMP($J,"PSOI")
  1. Q
  1. ;
  1. EN1(IFN,MED) ; -- return an order in MED("attribute")=value [from EN]
  1. N ORUPCHUK,ORVP,ORPCL,ORPK,ORDUZ,ORODT,ORSTRT,ORSTOP,ORL,ORTO,ORSTS,ORNP,ORPV,ORTX
  1. N CLS,OI,X,LOC,DRUG,DA,CNT,VPRESP K MED
  1. S IFN=+$G(IFN) I IFN<1!'$D(^OR(100,IFN)) Q
  1. I $G(DFN),+$P($G(^OR(100,IFN,0)),U,2)'=DFN Q
  1. I '$$RX(IFN) Q ; p33 - make sure the order is a real med order.
  1. S ORPK=$$PKGID^ORX8(IFN)
  1. S X=$S(ORPK:$E(ORPK,$L(ORPK)),1:"Z") S:X=+X X="R" ;last char = PS file
  1. S CLS=$S("RSN"[X:"O","UV"[X:"I",1:$$GETCLS) ; p18 added package check in new function
  1. I CLS="O",ORPK=+ORPK!(ORPK["R") D RX^VPRDPSO(ORPK,.MED) S MED("id")=IFN Q
  1. S MED("id")=IFN,MED("orderID")=IFN,MED("vaType")=CLS
  1. S:ORPK MED("medID")=ORPK_";"_CLS
  1. D EN^ORX8(IFN) S X="" F S X=$O(ORUPCHUK(X)) Q:X="" S:$D(ORUPCHUK(X))#2 @X=ORUPCHUK(X)
  1. S MED("ordered")=$G(ORODT),MED("orderingProvider")=$G(ORNP)_U_$$PROVSPC^VPRD(+ORNP)
  1. S X=$$LASTPROV(IFN),MED("currentProvider")=X_U_$$PROVSPC^VPRD(+X)
  1. S MED("start")=$G(ORSTRT),MED("stop")=$G(ORSTOP)
  1. S MED("vaStatus")=$P($G(ORSTS),U,2),MED("status")=$$STATUS(+$G(ORSTS))
  1. S X=$$VALUE^ORX8(IFN,"INDICATION") S:$L(X) MED("indication")=X
  1. S LOC=+$G(ORL) S:LOC MED("location")=LOC_U_$P(^SC(LOC,0),U)
  1. I CLS="I" D
  1. . S:$P($G(^SC(+$G(LOC),0)),U,25) MED("IMO")=1
  1. . S X=$P($G(^OR(100,IFN,3)),U,9) S:X MED("parent")=X
  1. S MED("facility")=$$FAC^VPRD(LOC) I ORPK D
  1. . N IFN D OEL^PSOORRL(DFN,ORPK_";"_CLS)
  1. I $$IV D IV^VPRDPSI Q
  1. S:CLS="O" MED("type")="Prescription"
  1. S:ORPK["N" MED("vaType")="N",MED("type")="OTC"
  1. ENA ; get order responses
  1. S OI=$$OI^ORX8(IFN) I OI S MED("name")=$P(OI,U,2) D
  1. . D ZERO^PSS50P7(+$P(OI,U,3),,,"PSOI")
  1. . S MED("form")=$P($G(^TMP($J,"PSOI",+$P(OI,U,3),.02)),U,2)
  1. . S:+$G(^TMP($J,"PSOI",+$P(OI,U,3),.09)) MED("supply")=1
  1. D RESP(IFN,.VPRESP) ;order responses
  1. S DRUG=+$G(^TMP("PS",$J,"DD",1,0)) S:'DRUG DRUG=+$G(VPRESP("DRUG",1))
  1. S MED("sig")=$S(CLS="I":"Give: ",1:"")_$G(VPRESP("SIG",1)) ;ORTX(2)
  1. I CLS="I"!(ORPK["N") D G ENQ ;UD or NVA: single dose, or child orders
  1. . I '$O(^OR(100,IFN,2,0)) S MED("dose",1)=$$DOSE(1)_U_$G(ORSTRT)_U_$G(ORSTOP) Q
  1. . N DD,CONJ M CONJ=VPRESP("CONJ")
  1. . S (DA,CNT)=0 F S DA=$O(^OR(100,IFN,2,DA)) Q:DA<1 D
  1. .. K VPRESP D RESP(DA,.VPRESP)
  1. .. S CNT=CNT+1,MED("dose",CNT)=$$DOSE(1)_U_$P($G(^OR(100,DA,0)),U,8,9)_U_DA
  1. .. S $P(MED("dose",CNT),U,8)=$G(CONJ(CNT))
  1. .. I $P(MED("dose",CNT),U,10)>$G(ORSTOP) S ORSTOP=$P(MED("dose",CNT),U,10)
  1. .. S:'DRUG DD=+$G(VPRESP("DRUG",1)),DD(DD,DA)="" ;dispense drug(s)
  1. .. ; get ^TMP("PS",$J) from 1st child, if Inpt parent:
  1. .. I '$D(^TMP("PS",$J)) S ORPK=$$PKGID^ORX8(DA) D OEL^PSOORRL(DFN,ORPK_";"_CLS)
  1. . S MED("stop")=$G(ORSTOP) ;reset from last child order
  1. . S DD=$O(DD(0)) I DD,'$O(DD(DD)) S DRUG=DD Q ;1 drug for order
  1. . S (DD,CNT)=0 F S DD=$O(DD(DD)) Q:DD<1 S DA=0 F S DA=$O(DD(DD,DA)) Q:DA<1 S CNT=CNT+1 D NDF^VPRDPS(DD,CNT,DA)
  1. ; pending Rx: dose(s), qty, etc.
  1. S CNT=0 F S CNT=$O(VPRESP("INSTR",CNT)) Q:CNT<1 S MED("dose",CNT)=$$DOSE(CNT) ;_STRT^STOP
  1. S MED("quantity")=$G(VPRESP("QTY",1))
  1. S MED("daysSupply")=$G(VPRESP("SUPPLY",1))
  1. S MED("routing")=$G(VPRESP("PICKUP",1))
  1. S MED("fillsAllowed")=$G(VPRESP("REFILLS",1))
  1. S MED("ptInstructions")=$G(VPRESP("PI",1))
  1. ENQ ; finish
  1. D:DRUG NDF^VPRDPS(+DRUG)
  1. S X=+$P($G(^TMP("PS",$J,"RXN",0)),U,5)
  1. S:X MED("pharmacist")=X_U_$P($G(^VA(200,X,0)),U)
  1. K ^TMP("PS",$J),^TMP($J,"PSOI")
  1. Q
  1. ;
  1. IV() ; -- 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. DOSE(N) ; --add dosage data from VPRESP(ID,N) [instance N]
  1. N DOSE,X,ID S N=+$G(N,1)
  1. S DOSE=$P($G(VPRESP("DOSE",N)),"&",1,4),DOSE=$TR(DOSE,"&","^")
  1. I '$L($P(DOSE,U)) S DOSE=$G(VPRESP("INSTR",N))_"^^^"
  1. S X=+$G(VPRESP("ROUTE",N)) D ALL^PSS51P2(X,,,,"VPRTE")
  1. S DOSE=DOSE_U_$G(^TMP($J,"VPRTE",X,1))
  1. F ID="SCHEDULE","DAYS","CONJ" S DOSE=DOSE_U_$G(VPRESP(ID,N))
  1. K ^TMP($J,"VPRTE")
  1. Q DOSE
  1. ;
  1. LASTPROV(IFN) ; -- return last provider who took action on order IFN
  1. N I,X,Y S Y="^"
  1. S I="A" F S I=$O(^OR(100,IFN,8,I),-1) Q:I<1 S X=$G(^(I,0)) D Q:Y
  1. . I $P(X,U,5) S Y=+$P(X,U,5) Q ;signer
  1. . I $P(X,U,3) S Y=+$P(X,U,3) Q ;orderer
  1. S:Y Y=Y_U_$P($G(^VA(200,Y,0)),U)
  1. Q Y
  1. ;
  1. STRING(IFN,ID) ; -- return text value as a string
  1. N DA,I,X,Y
  1. S DA=+$O(^OR(100,IFN,4.5,"ID",ID,0)) Q:DA<1 ""
  1. S I=+$O(^OR(100,IFN,4.5,DA,2,0)),Y=$G(^(I,0))
  1. F S I=+$O(^OR(100,IFN,4.5,DA,2,I)) Q:I<1 S X=$G(^(I,0)) D
  1. . I $E(Y,$L(Y))'=" " S Y=Y_" "
  1. . S Y=Y_X
  1. Q Y
  1. ;
  1. STATUS(X) ; -- return HITSP status for 100.01 #X
  1. S X=+$G(X) S:'X X=99 ;no status
  1. I X=3 Q "hold"
  1. I X=10!(X=11)!(X=5) Q "not active"
  1. I X=1!(X=12)!(X=13) Q "not active"
  1. I X=14!(X=99) Q "not active"
  1. I X=2!(X=7)!(X=15) Q "historical"
  1. Q "active"
  1. ;
  1. RESP(ORIFN,RESP) ; -- return order responses [internal form]
  1. N VPRDLG,I,J,W,ID,TYPE,X,Y
  1. I '$D(ORDIALOG) S ORDIALOG=129 D GETDLG1^ORCD(129)
  1. D GETORDER^ORCD(+$G(ORIFN),"VPRDLG")
  1. S I=0 F S I=$O(VPRDLG(I)) Q:I<1 D
  1. . S ID=$P($G(ORDIALOG(I)),U,2) Q:'$L(ID)
  1. . S TYPE=$P($G(ORDIALOG(I,0)),U)
  1. . S J=0 F S J=$O(VPRDLG(I,J)) Q:J<1 I $D(VPRDLG(I,J)) D
  1. .. S X=VPRDLG(I,J) I TYPE'="W" S RESP(ID,J)=X Q
  1. .. S Y=$G(@X@(1,0)),W=1 F S W=$O(@X@(W)) Q:W<1 S Y=Y_$S($E(Y,$L(Y))'=" ":" ",1:"")_$G(@X@(W,0))
  1. .. S:$L(Y) RESP(ID,J)=Y
  1. Q
  1. GETCLS() ; p18 added package check
  1. N PKGIEN S PKGIEN=$$GET1^DIQ(100,IFN_",",12,"I")
  1. I $P($G(^DIC(9.4,PKGIEN,0)),U)="INPATIENT MEDICATIONS" Q "I"
  1. I $P($G(^DIC(9.4,PKGIEN,0)),U)="OUTPATIENT PHARMACY" Q "O"
  1. Q $$GET1^DIQ(100,IFN_",",10,"I")
  1. ;
  1. RX(ORIFN) ; -- is order really a med? (non-PS order in display group)
  1. N X,Y,PKG S Y=0
  1. S X=$P($G(^OR(100,+$G(ORIFN),0)),U,14),PKG=$$GET1^DIQ(9.4,+X_",",1)
  1. I $E(PKG,1,2)="PS" S Y=1
  1. Q Y