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