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

ORCACT1.m

Go to the documentation of this file.
  1. ORCACT1 ;SLC/MKB,ASMR/BL-Act on orders cont ; 10/16/15 1:36pm
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,56,48,86,92,116,149,215,284,390**;Dec 17, 1997;Build 425
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. FLAG ; -- flag orders
  1. D EN("FL") Q
  1. ;
  1. UNFLAG ; -- unflag orders
  1. D EN("UF") Q
  1. ;
  1. COMMENT ; -- add ward comments to orders
  1. D EN("CM") Q
  1. ;
  1. ALERT ; -- alert provider when results available
  1. D EN("AL") Q
  1. ;
  1. UNHOLD ; -- release hold on orders - no longer in use
  1. Q ; see UNHOLD^ORCACT instead
  1. ;
  1. EN(ORACT) ; -- Actions that don't create orders
  1. ; ORNMBR = #,#,...,# of selected orders
  1. ; ORACT = action to be taken
  1. ;
  1. ; OREBUILD defined on return if Orders tab needs to be rebuilt
  1. ;
  1. N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORERR,ORQUIT
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
  1. D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORIFN=$P(IDX,U)
  1. . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1"
  1. . I '$D(^OR(100,+ORIFN,0)) W !,"This order has been deleted!" H 1 Q
  1. . S ORDITM=$$ORDITEM^ORCACT(ORIFN) D SUBHDR^ORCACT(ORDITM)
  1. . I '$$VALID^ORCACT0(ORIFN,ORACT,.ORERR) W !,ORERR H 1 Q
  1. . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !,$P(ORLK,U,2) H 1 Q
  1. . D @ORACT,UNLK1^ORX2(+ORIFN)
  1. ENQ Q
  1. ;
  1. FL ; -- Flag order ORIFN
  1. D EN^ORCFLAG
  1. Q
  1. ;
  1. UF ; -- Unflag order ORIFN
  1. D UN^ORCFLAG
  1. Q
  1. ;
  1. CM ; -- Ward Comments on order ORIFN
  1. N DIC,DWPK,DIWEPSE,DIWESUB,DDWRW
  1. S DIC="^OR(100,"_+ORIFN_",8,"_+$P(ORIFN,";",2)_",5,",(DWPK,DIWEPSE)=1
  1. S DIWESUB=ORDITM,DDWRW="B" ;go to bottom of text
  1. D EN^DIWE
  1. Q
  1. ;
  1. AL ; -- Alert when results are available for order ORIFN
  1. S $P(^OR(100,+ORIFN,3),U,10)=1
  1. W !?10,"... done." H 1
  1. Q
  1. ;
  1. RL ; -- Release hold on order ORIFN [No longer used]
  1. D EN^ORCSEND(+ORIFN,ORACT,3,1,,,.ORERR)
  1. W !,"... order "_$S($G(ORERR):"not ",1:"")_"released from hold."
  1. W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2) H 1
  1. S OREBUILD=1 ; print?
  1. Q
  1. ;
  1. VERIFY(ORVER) ; -- Verify orders
  1. N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORES,ORERR,ORSIG,OROLDSTS,ORNEW,ORWAIT
  1. I "^"[$G(ORVER) W $C(7),!!,"You must be a nurse or clerk to verify these orders!" S VALMBCK="" H 2 Q
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
  1. D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
  1. F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORIFN=$P(IDX,U)
  1. . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1" Q:$D(ORES(ORIFN))
  1. . I '$$VALID^ORCACT0(ORIFN,"VR",.ORERR) W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR H 1 Q
  1. . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$P(ORLK,U,2) H 1 Q
  1. . S ORES(ORIFN)="" D REPLCD
  1. VR1 Q:'$O(ORES(0)) D COMPLX S ORSIG=$S($$ESIG^ORCSIGN:1,1:0)
  1. I 'ORSIG W !,"Nothing verified!" D UNLOCK H 1 Q
  1. W !!,"Verifying orders ..."
  1. S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D
  1. . S OROLDSTS=+$P($G(^OR(100,+ORIFN,3)),U,3)
  1. . D EN^ORCSEND(ORIFN,"VR","","",,,.ORERR),UNLK1^ORX2(+ORIFN)
  1. . I $G(ORERR) D Q
  1. . . W !,$$ORDITEM^ORCACT(ORIFN)_" not verified."
  1. . . W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2) H 1
  1. . S ORNEW=+$P($G(^OR(100,+ORIFN,3)),U,3) I ORNEW'=OROLDSTS W !,$$ORDITEM^ORCACT(ORIFN)_" is now "_$$STS(ORNEW)_"." S ORWAIT=1
  1. S OREBUILD=1 D:'$D(XQAID) CKALERT I $G(ORWAIT) H 2
  1. VRQ Q
  1. ;
  1. STS(X) ; -- Return name of status X
  1. N Y S Y=$P($G(^ORD(100.01,+$G(X),0)),U)
  1. Q Y
  1. ;
  1. REPLCD ; -- Ck for unverified replaced orders for ORIFN, add to ORES(order#)
  1. ; [Expects ORVER; also called from VERIFY^ORWDXA,VERIFY^ORRCOR]
  1. N OR3,ORIG,ORFLD,ORDA,ORI,ORLK
  1. S ORFLD=$S($G(ORVER)="N":8,$G(ORVER)="R":18,1:10),ORDA=+$P(ORIFN,";",2)
  1. I ORDA>1 D Q ;ck for prior unverified actions
  1. . ;Q:$P($G(^OR(100,+ORIFN,8,ORDA,0)),U,2)'="XX"
  1. . S ORI=0 F S ORI=$O(^OR(100,+ORIFN,8,ORI)) Q:ORI<1 Q:ORI'<ORDA D
  1. .. Q:$P($G(^OR(100,+ORIFN,8,ORI,0)),U,ORFLD) ;already verified
  1. .. S ORLK=$$LOCK1^ORX2(+ORIFN) Q:'ORLK
  1. .. S ORES(+ORIFN_";"_ORI)=""
  1. S OR3=$G(^OR(100,+ORIFN,3)) Q:$P(OR3,U,11)'=1
  1. S ORIG=+$P(OR3,U,5) Q:'ORIG Q:$P($G(^OR(100,ORIG,3)),U,3)'=12
  1. S ORDA=0 F S ORDA=$O(^OR(100,ORIG,8,ORDA)) Q:ORDA'>0 I '$P($G(^(ORDA,0)),U,ORFLD) D
  1. . S ORLK=$$LOCK1^ORX2(ORIG) Q:'ORLK
  1. . S ORES(ORIG_";"_ORDA)=""
  1. Q
  1. ;
  1. COMPLX ; -- Ck for other child orders to be verified at same time
  1. N IFN,DAD,CHLD,ALL,P,X,I
  1. S P=$S(ORVER="N":9,ORVER="C":11,ORVER="R":19,1:0) Q:P<1
  1. S IFN=0 F S IFN=$O(ORES(IFN)) Q:IFN<1 D
  1. . S X=+$P($G(^OR(100,+IFN,0)),U,14) Q:$$NMSP^ORCD(X)'["PS"
  1. . S X=$P($G(^OR(100,+IFN,8,+$P(IFN,";",2),0)),U,2) Q:X'="NW"&(X'="XX")
  1. . I $P($G(^OR(100,+IFN,3)),U,9) S DAD(+$P(^(3),U,9))=""
  1. Q:'$O(DAD(0)) S IFN=0 F S IFN=+$O(DAD(IFN)) Q:IFN<1 D
  1. . S CHLD=0,ALL=1
  1. . F S CHLD=+$O(^OR(100,IFN,2,CHLD)) Q:CHLD<1 F X="NW","XX" D
  1. .. S I=+$O(^OR(100,CHLD,8,"C",X,0)) Q:I<1
  1. .. Q:$P($G(^OR(100,CHLD,8,I,0)),U,P) Q:$D(ORES(CHLD_";"_I))
  1. .. S ORES(CHLD_";"_I)="",ALL=0
  1. . Q:ALL S X=$$ORDITEM^ORCACT(IFN) D SUBHDR^ORCACT(X)
  1. . W !,"All doses of this complex order must be verified together;"
  1. . W !,"adding remaining doses to signature list..."
  1. Q
  1. ;
  1. CKALERT ; -- Ck if Unverified Orders alerts can be deleted
  1. N ORNOW,ORBEG,ORLIST,ORALL,ORMEDS S ORNOW=$$NOW^XLFDT
  1. S:'$G(ORWARD) ORBEG=$$FMADD^XLFDT(ORNOW,"-30") I $G(ORWARD) D
  1. . N DFN,VAIN,VAERR S DFN=+ORVP D INP^VADPT
  1. . S ORBEG=$S($G(VAIN(7)):$P(VAIN(7),U),1:$$FMADD^XLFDT(ORNOW,-30))
  1. D EN^ORQ1(ORVP,,9,,ORBEG,ORNOW) ;see if any unverified orders remain
  1. I $G(ORLIST),$G(^TMP("ORR",$J,ORLIST,"TOT")) D ;see if any are meds
  1. . N ORRX,ORGRP,I,IFN,DG S ORALL=1
  1. . S ORRX=+$O(^ORD(100.98,"B","RX",0)) D GRP^ORQ1(ORRX)
  1. . S I=0 F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:I'>0 S IFN=+^(I),DG=+$P($G(^OR(100,IFN,0)),U,11) I $D(ORGRP(DG)) S ORMEDS=1 Q
  1. D:'$G(ORALL) DELALRT("UNVERIFIED ORDER")
  1. D:'$G(ORMEDS) DELALRT("UNVERIFIED MEDICATION ORDER")
  1. Q
  1. ;
  1. DELALRT(X) ; -- delete alert X
  1. N ORNIFN,XQAKILL,XQAID
  1. S ORNIFN=+$O(^ORD(100.9,"B",X,0)) Q:ORNIFN'>0
  1. S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
  1. S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
  1. D DELETEA^XQALERT
  1. Q
  1. ;
  1. UNLOCK ; -- Unlock orders in ORES(ORIFN) [from VR1]
  1. F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D UNLK1^ORX2(+ORIFN)
  1. Q
  1. ;
  1. SIGNREQD(IFN) ; -- Returns 2, 1, or 0, if order/actions need ES
  1. Q +$P($G(^OR(100,IFN,0)),U,16)
  1. ;
  1. SIGN ; -- Sign orders [no longer used]
  1. D EN^ORCSIGN
  1. Q
  1. ;
  1. COMPLETE ; -- complete orders
  1. N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORES,ORERR,ORSIG,ORSTOP
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("complete") Q:'ORNMBR
  1. D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
  1. F ORI=1:1:$L(ORNMBR) S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORIFN=$P(IDX,U)
  1. . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1"
  1. . I '$$VALID^ORCACT0(ORIFN,"CP",.ORERR) W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR H 1 Q
  1. . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$P(ORLK,U,2) H 1 Q
  1. . S ORES(ORIFN)=""
  1. CP1 Q:'$O(ORES(0)) S ORSIG=$S($$ESIG^ORCSIGN:1,1:0)
  1. I 'ORSIG W !,"Nothing completed!" D UNLOCK H 1 Q
  1. W !!,"Completing orders ..." S ORSTOP=+$E($$NOW^XLFDT,1,12),ORIFN=0
  1. F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D
  1. . D COMP^ORCSAVE2(ORIFN,DUZ,ORSTOP),UNLK1^ORX2(+ORIFN)
  1. . D COMP^ORMBLDOR(ORIFN)
  1. S OREBUILD=1
  1. CPQ Q