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

VPRSDAOR.m

Go to the documentation of this file.
  1. VPRSDAOR ;SLC/MKB -- SDA Order utilities ;7/29/22 14:11
  1. ;;1.0;VIRTUAL PATIENT RECORD;**30,35**;Sep 01, 2011;Build 16
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^OR(100 5771
  1. ; ^ORD(100.98 6982
  1. ; DIC 2051
  1. ; DILFD 2055
  1. ; DIQ 2056
  1. ; ORQ1, ^TM("ORR",$J) 3154
  1. ;
  1. ;
  1. ORDERS(DG) ; -- get orders by Display Group
  1. ; Query called from GET^DDE, returns DLIST(#)=ien
  1. ; Expects context variables DFN, DSTRT, DSTOP, DMAX
  1. ;
  1. N ORDG,ORIGVIEW,ORKID,ORLIST,VPRI,VPRN,ORDER,X3,X4
  1. S DG=$G(DG,"ALL"),ORDG=+$O(^ORD(100.98,"B",DG,0))
  1. ; return original view, child orders for Lab
  1. S ORIGVIEW=2,ORKID=$S(DG="CH":1,DG="LAB":1,1:0)
  1. D EN^ORQ1(DFN_";DPT(",ORDG,6,,DSTRT,DSTOP,,,,ORKID) S VPRN=0
  1. S VPRI=0 F S VPRI=$O(^TMP("ORR",$J,ORLIST,VPRI)) Q:VPRI<1 S ORDER=$G(^(VPRI)) D Q:VPRN'<DMAX
  1. . I $P($P(ORDER,U),";",2)>1 Q ;skip order actions
  1. . I $O(^OR(100,+ORDER,2,0)) Q ;skip parent orders
  1. . S ORDER=+ORDER,X3=$G(^OR(100,ORDER,3)),X4=$G(^(4))
  1. . Q:$P(X3,U,3)=13 I X4["P",$P(X3,U,3)=1!($P(X3,U,3)=12) Q ;cancelled
  1. . Q:$P(X3,U,3)=14 ;lapsed
  1. . I DG="RX",'$$RX(ORDER) Q ;skip non-PS in RX group
  1. . I DG="LAB",$$BB(ORDER) Q ;skip blood bank in Lab
  1. . S VPRN=VPRN+1,DLIST(VPRN)=ORDER
  1. K ^TMP("ORR",$J)
  1. Q
  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
  1. BB(ORIFN) ; -- return 1 or 0, if order is for Blood Bank
  1. N X,Y,DG S Y=0
  1. S X=$P($G(^OR(100,+$G(ORIFN),0)),U,11),DG=$P($G(^ORD(100.98,+X,0)),U,3)
  1. I DG="BB"!(DG?1"VB".E) S Y=1
  1. Q Y
  1. ;
  1. NONORD ; -- get other orders: not Lab, Rad, or Med
  1. ; Query called from GET^DDE, returns DLIST(#)=ien
  1. ; Expects context variables DFN, DSTRT, DSTOP, DMAX
  1. ;
  1. N ORDG,ORPKG,ORIGVIEW,ORLIST,VPRI,VPRN,ORDER,X
  1. S ORDG=+$O(^ORD(100.98,"B","ALL",0)) D ORPKG ;get list of pkgs to exclude
  1. S ORIGVIEW=2 ;get original view of order
  1. D EN^ORQ1(DFN_";DPT(",ORDG,6,,DSTRT,DSTOP) S VPRN=0
  1. S VPRI=0 F S VPRI=$O(^TMP("ORR",$J,ORLIST,VPRI)) Q:VPRI<1 S ORDER=$G(^(VPRI)) D Q:VPRN'<DMAX
  1. . I $P($P(ORDER,U),";",2)>1 Q ;skip order actions
  1. . Q:$P($G(^OR(100,+ORDER,3)),U,3)=14 ;skip lapsed orders
  1. . S X=+$P($G(^OR(100,+ORDER,0)),U,14)
  1. . I $D(ORPKG(X)) Q ;skip Lab,Rad,Med
  1. . S VPRN=VPRN+1,DLIST(VPRN)=+ORDER
  1. K ^TMP("ORR",$J)
  1. Q
  1. ORPKG ; -- get list of pkgs to exclude
  1. N NMSP,X
  1. F NMSP="LR","RA","PSG","PSIV","PSJ","PSO","PSH" D
  1. . S X=+$$FIND1^DIC(9.4,,"QX",NMSP,"C")
  1. . S:X>0 ORPKG(X)=""
  1. Q
  1. ;
  1. OR1(ORIFN) ; -- define basic variables for any order [ID Action]
  1. ; Returns OR0, OR3, OR6, OR8, ORDAD, and ORSIG to Order entities
  1. S ORIFN=+$G(ORIFN)
  1. S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)),OR8=$G(^(8,1,0))
  1. S ORDAD=$P($G(OR3),U,9) ;parent order
  1. S ORSIG=$$ORSIG(ORIFN) ;signature info
  1. Q
  1. ;
  1. WP(ORIFN,ID) ; -- return a WP value from an order response as a string
  1. N DA,I,X,Y S Y=""
  1. S DA=+$O(^OR(100,+$G(ORIFN),4.5,"ID",ID,0))
  1. S I=0 F S I=$O(^OR(100,+$G(ORIFN),4.5,DA,2,I)) Q:'I S X=$G(^(I,0)) D
  1. . I '$L(Y) Q:(X="")!(X?1." ") S Y=X Q
  1. . I $E(X)=" " S Y=Y_$C(13,10)_X Q
  1. . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X
  1. Q Y
  1. ;
  1. ORDG(DG) ; -- return ien^name^VA100.98 for a DG abbreviation
  1. N X,Y S X=$O(^ORD(100.98,"B",DG,0)),Y=""
  1. S:X Y=X_U_$P($G(^ORD(100.98,X,0)),U)_"^VA100.98"
  1. Q Y
  1. ;
  1. LASTACT(ORIFN) ; -- return DA of current or last order action
  1. N Y S ORIFN=+$G(ORIFN)
  1. S Y=+$P($G(^OR(100,ORIFN,3)),U,7)
  1. I Y<1 S Y=+$O(^OR(100,ORIFN,8,"A"),-1) S:'Y Y=1
  1. Q Y
  1. ;
  1. ORSIG(ORIFN) ; -- return string of signature data from Order Action as
  1. ; Signature Status (#4) ^ Signed By (#5) ^ D/T Signed (#6), or
  1. ; Signature Status (#4) ^ ^ Release D/T (#16) if not e-signed
  1. N Y,X0,X,I S Y=""
  1. S X0=$G(^OR(100,+$G(ORIFN),8,1,0))
  1. I $P(X0,U,6) S Y=$P(X0,U,4,6)
  1. ; look for sign on corrected or parent order action
  1. I Y="",$P(X0,U,15)=12 D ;replaced
  1. . S I=+$O(^OR(100,+$G(ORIFN),8,1)),X=$G(^(I,0))
  1. . I $P(X,U,2)="XX",$P(X,U,6) S Y=$P(X,U,4,6)
  1. I Y="",$P(X0,U,4)=8,$G(ORDAD) D ;parent [no longer used]
  1. . S X=$G(^OR(100,+$G(ORDAD),8,1,0))
  1. . S:$P(X,U,6) Y=$P(X,U,4,6)
  1. ; else, return Sig Sts & Release D/T
  1. S:Y="" Y=$P(X0,U,4)_U_U_$P(X0,U,16)
  1. S X=$P(Y,U) S:$L(X) $P(Y,U)=$$EXTERNAL^DILFD(100.008,4,,X)
  1. Q Y
  1. ;
  1. FLAGS(IFN,LIST) ; -- returns 1 or 0, if any flags are active [VPRSDAOR]
  1. ; Can also return .LIST(DA) of actions w/flag nodes
  1. N X,Y,I S Y=0
  1. S IFN=+$G(IFN) K LIST
  1. S I=0 F S I=$O(^OR(100,IFN,8,I)) Q:I<1 I $D(^(I,3)) S X=$G(^(3)) D
  1. . S LIST(I)=I_","_IFN
  1. . S:X Y=1
  1. Q Y