Routine: OREVNT1

OREVNT1 ;SLC/MKB - Release delayed orders ;3/31/04  09:08

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,195**;Dec 17, 1997

EN ; -- start here

 I '$$CANREL^OREV3() W !,"Insufficient privilege!" H 1 Q

 N ORPTLK,ORLR,ORACT,ORNATR,ORI,NMBR,IDX,ORDER,ORIFN,ORDA,ORQUIT,ORES,ORWAIT,ORSIG,OREL,ORPRNT,ORPRINT,ORCHART,ORWORK,ORLAB,OR0,ORA0,ORERR,ORCL,OREVT,OREVENT,J ;195

 S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q

 I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") G:'ORNMBR ENQ

 D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD

 S ORL=$$LOCATION^ORCMENU1 G:ORL="^" ENQ ;I '$G(ORL)

 S ORLR=+$O(^DIC(9.4,"C","LR",0)),(ORACT,ORNATR)=""

 I $$NEEDSIG S ORACT=$S($D(^XUSEC("ORES",DUZ)):"ES",$D(^XUSEC("OREMAS",DUZ)):"OC",$D(^XUSEC("ORELSE",DUZ)):$$SELSIG^ORCSIGN,1:"^") G:ORACT="^" ENQ

 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR D

 . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORDER=$P(IDX,U)

 . Q:'ORDER  S:'$P(ORDER,";",2) ORDER=+ORDER_";1"

 . S ORIFN=+ORDER,ORDA=+$P(ORDER,";",2) K ORQUIT

 . D VALID Q:$G(ORQUIT)  S ORES(ORDER)=""

 . S:$P($G(^OR(100,ORIFN,0)),U,14)=ORLR ORES("LAB")=1

EN1 G:'$O(ORES(0)) ENQ K ORQUIT,ORWAIT

 ;D ORDCHK^ORCMENU1 G:'$O(ORES(0)) ENQ0

 ;I $G(ORQUIT) D UNLOCK G ENQ ;quit - ^ at override reason

 S ORSIG=$S($G(ORES("ES")):2,1:""),OREL=$S(ORSIG:0,1:1)

 I ORSIG D  I ORSIG=2,'OREL W !,"Nothing signed or released!" D UNLOCK H 2 G ENQ

 . I ORACT="ES" S:$$ESIG^ORCSIGN ORSIG=1,OREL=1 Q

 . I ORACT="OC" S:$$ONCHART^ORCSIGN ORSIG=0,OREL=1,ORNATR="W" Q

 . S ORNATR=$$NATURE^ORCSIGN Q:ORNATR="^"  ;ORACT="RS"

 . W:ORNATR'="I" !!,"A signature is required to RELEASE these orders; the responsible provider will",!,"be alerted to electronically sign them."

 . S:$$ESIG^ORCSIGN ORSIG=$S(ORNATR="I":1,1:$$SIGSTS^ORX1(ORNATR)),OREL=1

 S ORPRNT=$$GET^XPAR("ALL","ORPF PRINT CHART COPY WHEN")

 S (ORPRINT,ORCHART,ORWORK,ORLAB)=0

 I '$D(^XUSEC("ORES",DUZ))!$$GET^XPAR("ALL","ORPF SHOW LAB #") S ORLAB=ORLR ;show Lab# when released

 W !!,"Processing orders ..." D:$G(ORES("LAB")) BHS^ORMBLD(ORVP)

EN2 S ORDER=0 F  S ORDER=$O(ORES(ORDER)) Q:ORDER'>0  D

 . S OR0=$G(^OR(100,+ORDER,0)),ORA0=$G(^(8,+$P(ORDER,";",2),0))

 . I '$$LCKEVT^ORX2($P(OR0,U,17)) S EVENT($P(OR0,U,17))="" Q  ;195 Don't process if event locked

 . N ORNP S ORNP=$P(ORA0,U,3),ORIFN=+ORDER,ORDA=+$P(ORDER,";",2)

 . S:$G(ORL) $P(^OR(100,ORIFN,0),U,10)=ORL ;set location

 . S:$G(ORTS) $P(^OR(100,ORIFN,0),U,13)=ORTS ;set specialty

 . D EN2^ORCSEND(ORDER,ORSIG,ORNATR,.ORERR),UNLK1^ORX2(ORIFN)

 . I $D(^TMP("ORNEW",$J,ORIFN,ORDA)) K ^(ORDA) D UNLK1^ORX2(ORIFN)

 . I $G(ORERR) D  S ORWAIT=1 Q

 . . W !!,$$ORDITEM^ORCACT(ORDER)_" "_$$STATUS^ORCSIGN(ORDER)

 . . W:$L($P($G(ORERR),U,2)) !,"  >> "_$P(ORERR,U,2)

 . I $P(OR0,U,14)=ORLAB,$G(^OR(100,ORIFN,4)) W !,$$ORDITEM^ORCACT(ORIFN)_"  (LB #"_+^OR(100,ORIFN,4)_")" S ORWAIT=1

 . S ORV=+$P(OR0,U,17),OREVT(ORV)="" D SETPRINT(ORNATR)

 . D:$$TYPE^OREVNTX(ORV)="M" SAVE^ORMEVNT1(ORIFN,ORV,2) W "."

 D:$G(ORES("LAB")) BTS^ORMBLD(ORVP)

EN3 I $O(ORCHART(0))!$O(ORPRINT(0)) S ORCL=$$LOC^ORMEVNT I ORCL,ORCL'=ORL D

 . N X,Y,DIR S DIR(0)="YA",DIR("B")="YES"

 . S DIR("A",1)="This patient's location has been changed to "_$P($G(^SC(+ORCL,0)),U)_"."

 . S DIR("A")="Should the orders be printed using the new location? "

 . S DIR("?")="Enter NO to continue using "_$P($G(^SC(+ORL,0)),U)_" for ordering and printing, or YES to switch to the patient's current location instead"

 . D ^DIR S:Y ORL=ORCL

 D:$O(ORCHART(0)) PRINT^ORPR02(ORVP,.ORCHART,,ORL,"1^0^0^0^0")

 D:$O(ORPRINT(0)) PRINT^ORPR02(ORVP,.ORPRINT,,ORL,"0^1^1^1^0")

 D:$O(ORWORK(0)) PRINT^ORPR02(ORVP,.ORWORK,,ORL,"0^0^0^0^1")

ENQ0 D UNOTIF^ORCSIGN,EMPTY S OREBUILD=1

ENQ D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) D:$G(ORWAIT) READ ;output

 I $D(EVENT) W !!,"Orders not released >> Delayed event being processed by another user!" D READ S J=0 F  S J=$O(EVENT(J)) Q:'+J  D UNLEVT^ORX2(J) ;195

SETPRINT(NATR) ; -- Set print arrays

 S:'$L(NATR)!($P(ORA0,U,4)'=2) NATR=$P(ORA0,U,12)

 S ORPRINT=ORPRINT+1,ORPRINT(ORPRINT)=ORDER

 I ("R"[ORPRNT)!(ORPRNT="S"&($P(ORA0,U,4)=2)&(ORSIG'=2)),$$CHART^ORX1(NATR) S ORCHART=ORCHART+1,ORCHART(ORCHART)=ORDER

 S:$$WORK(NATR) ORWORK=ORWORK+1,ORWORK(ORWORK)=ORDER

WORK(NATR) ; -- Returns 1 or 0, to print work copies for NATR

 S:$G(NATR)="" NATR="E" S:'NATR NATR=+$O(^ORD(100.02,"C",NATR,0))

 Q +$P($G(^ORD(100.02,NATR,1)),U,5)

NEEDSIG()       ; -- Return 1 or 0, if any selected orders need ES

 N ORI,NMBR,ORIFN,ORDA,Y S Y=0

 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR D  Q:Y

 . S ORIFN=$P($G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),U) Q:'ORIFN

 . S ORDA=+$P(ORIFN,";",2),ORIFN=+ORIFN S:'ORDA ORDA=1

 . S:$P($G(^OR(100,ORIFN,8,ORDA,0)),U,4)=2 ORES("ES")=1,Y=1

Q Y

VALID ; -- validate ORDER for signature/release

 I '$$VALID^ORCACT0(ORDER,"MN",.ORERR) W !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!,"  >> "_ORERR S (ORQUIT,ORWAIT)=1 Q

 I $L(ORACT),$P($G(^OR(100,ORIFN,8,ORDA,0)),U,4)=2,'$$VALID^ORCACT0(ORDER,ORACT,.ORERR,ORNATR) W !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!,"  >> "_ORERR S (ORQUIT,ORWAIT)=1 Q

 N ORLK,ORDIALOG S ORLK=$$LOCK1^ORX2(ORIFN)

 I 'ORLK W !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!,"  >> "_$P(ORLK,U,2) S (ORQUIT,ORWAIT)=1 Q  ;order locked

 S ORDIALOG=+$P($G(^OR(100,ORIFN,0)),U,5)

 I $L($G(^ORD(101.41,ORDIALOG,7))) X ^(7) D:$G(ORQUIT) UNLK1^ORX2(ORIFN)

EMPTY ; -- check if no more orders for events in OREVT()

 N EVT,X

 S EVT=0 F  S EVT=$O(OREVT(EVT)) Q:EVT<1  D  ;terminate any events?

 . Q:$G(^ORE(100.2,EVT,1))  Q:'$$EMPTY^OREVNTX(EVT)  ;active,empty

 . ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders."

 . ;S DIR(0)="YA",DIR("A")="Do you want to terminate this event? "

 . ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it."

 . ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q

 . D DONE^OREVNTX(EVT),ACTLOG^OREVNTX(EVT,"MN")

 . S X=$P($$NAME^OREVNTX(EVT)," ",2,99)

 . W !,"   ... "_X_" event completed." H 1

 . D:$G(OREVENT) EX^OREVNT ;return view to Active

UNLOCK ; -- Unlock orders in ORES(ORDER)

 N ORIFN S ORIFN=0

 F  S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0  D UNLK1^ORX2(+ORIFN)

READ ; -- Press return to continue

 N X,Y,DIR

 S DIR(0)="EA",DIR("A")="Press <return> to continue ..."

 D ^DIR

DONE() ; -- OREVENT done?

 Q:'$G(^ORE(100.2,+$G(OREVENT),1)) 0  ;not done yet

 D FULL^VALM1

 W !!,"The event "_$$NAME^OREVNTX(OREVENT)_" has occurred since"

 W !,"you started writing delayed orders.  The orders that were signed have now been"

 W !,"released; any unsigned orders will be released immediately upon signature."

 W !!,"To write new delayed orders for this event you must select the Delayed Orders"

 W !,"action and this release event again.  Orders delayed to this same event will"

 W !,"remain delayed until the event occurs again."

 W !!,"The Orders tab will now be refreshed in the Active Orders view; you may then"

 W !,"write active orders for this patient as usual."

 D READ S XQORQUIT=1 D EX^OREVNT ;return view to Active

Q 1

OREVNT1   ;SLC/MKB - Release delayed orders ;3/31/04  09:08

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,195**;Dec 17, 1997

 +2       ;

EN        ; -- start here

 +1        IF '$$CANREL^OREV3()

               WRITE !,"Insufficient privilege!"

               HANG 1

               QUIT

 +2       ;195

           NEW ORPTLK,ORLR,ORACT,ORNATR,ORI,NMBR,IDX,ORDER,ORIFN,ORDA,ORQUIT,ORES,ORWAIT,ORSIG,OREL,ORPRNT,ORPRINT,ORCHART,ORWORK,ORLAB,OR0,ORA0,ORERR,ORCL,OREVT,OREVENT,J

 +3        SET ORPTLK=$$LOCK^ORX2(+ORVP)

           IF 'ORPTLK

               WRITE !!,$CHAR(7),$PIECE(ORPTLK,U,2)

               HANG 2

               QUIT

 +4        IF '$GET(ORNMBR)

               SET ORNMBR=$$ORDERS^ORCHART("")

               IF 'ORNMBR

                   GOTO ENQ

 +5        DO FREEZE^ORCMENU

           SET VALMBCK="R"

           KILL OREBUILD

 +6       ;I '$G(ORL)

           SET ORL=$$LOCATION^ORCMENU1

           IF ORL="^"

               GOTO ENQ

 +7        SET ORLR=+$ORDER(^DIC(9.4,"C","LR",0))

           SET (ORACT,ORNATR)=""

 +8        IF $$NEEDSIG

               SET ORACT=$SELECT($DATA(^XUSEC("ORES",DUZ)):"ES",$DATA(^XUSEC("OREMAS",DUZ)):"OC",$DATA(^XUSEC("ORELSE",DUZ)):$$SELSIG^ORCSIGN,1:"^")

               IF ORACT="^"

                   GOTO ENQ

 +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 ORDER=$PIECE(IDX,U)

 +11                   IF 'ORDER

                           QUIT

                       IF '$PIECE(ORDER,";",2)

                           SET ORDER=+ORDER_";1"

 +12                   SET ORIFN=+ORDER

                       SET ORDA=+$PIECE(ORDER,";",2)

                       KILL ORQUIT

 +13                   DO VALID

                       IF $GET(ORQUIT)

                           QUIT

                       SET ORES(ORDER)=""

 +14                   IF $PIECE($GET(^OR(100,ORIFN,0)),U,14)=ORLR

                           SET ORES("LAB")=1

                   End DoDot:1

EN1        IF '$ORDER(ORES(0))

               GOTO ENQ

           KILL ORQUIT,ORWAIT

 +1       ;D ORDCHK^ORCMENU1 G:'$O(ORES(0)) ENQ0

 +2       ;I $G(ORQUIT) D UNLOCK G ENQ ;quit - ^ at override reason

 +3        SET ORSIG=$SELECT($GET(ORES("ES")):2,1:"")

           SET OREL=$SELECT(ORSIG:0,1:1)

 +4        IF ORSIG

               Begin DoDot:1

 +5                IF ORACT="ES"

                       IF $$ESIG^ORCSIGN

                           SET ORSIG=1

                           SET OREL=1

                       QUIT

 +6                IF ORACT="OC"

                       IF $$ONCHART^ORCSIGN

                           SET ORSIG=0

                           SET OREL=1

                           SET ORNATR="W"

                       QUIT

 +7       ;ORACT="RS"

                   SET ORNATR=$$NATURE^ORCSIGN

                   IF ORNATR="^"

                       QUIT

 +8                IF ORNATR'="I"

                       WRITE !!,"A signature is required to RELEASE these orders; the responsible provider will",!,"be alerted to electronically sign them."

 +9                IF $$ESIG^ORCSIGN

                       SET ORSIG=$SELECT(ORNATR="I":1,1:$$SIGSTS^ORX1(ORNATR))

                       SET OREL=1

               End DoDot:1

               IF ORSIG=2

                   IF 'OREL

                       WRITE !,"Nothing signed or released!"

                       DO UNLOCK

                       HANG 2

                       GOTO ENQ

 +10       SET ORPRNT=$$GET^XPAR("ALL","ORPF PRINT CHART COPY WHEN")

 +11       SET (ORPRINT,ORCHART,ORWORK,ORLAB)=0

 +12      ;show Lab# when released

           IF '$DATA(^XUSEC("ORES",DUZ))!$$GET^XPAR("ALL","ORPF SHOW LAB #")

               SET ORLAB=ORLR

 +13       WRITE !!,"Processing orders ..."

           IF $GET(ORES("LAB"))

               DO BHS^ORMBLD(ORVP)

EN2        SET ORDER=0

FOR

               SET ORDER=$ORDER(ORES(ORDER))

               IF ORDER'>0

                   QUIT

               Begin DoDot:1

 +1                SET OR0=$GET(^OR(100,+ORDER,0))

                   SET ORA0=$GET(^(8,+$PIECE(ORDER,";",2),0))

 +2       ;195 Don't process if event locked

                   IF '$$LCKEVT^ORX2($PIECE(OR0,U,17))

                       SET EVENT($PIECE(OR0,U,17))=""

                       QUIT

 +3                NEW ORNP

                   SET ORNP=$PIECE(ORA0,U,3)

                   SET ORIFN=+ORDER

                   SET ORDA=+$PIECE(ORDER,";",2)

 +4       ;set location

                   IF $GET(ORL)

                       SET $PIECE(^OR(100,ORIFN,0),U,10)=ORL

 +5       ;set specialty

                   IF $GET(ORTS)

                       SET $PIECE(^OR(100,ORIFN,0),U,13)=ORTS

 +6                DO EN2^ORCSEND(ORDER,ORSIG,ORNATR,.ORERR)

                   DO UNLK1^ORX2(ORIFN)

 +7                IF $DATA(^TMP("ORNEW",$JOB,ORIFN,ORDA))

                       KILL ^(ORDA)

                       DO UNLK1^ORX2(ORIFN)

 +8                IF $GET(ORERR)

                       Begin DoDot:2

 +9                        WRITE !!,$$ORDITEM^ORCACT(ORDER)_" "_$$STATUS^ORCSIGN(ORDER)

 +10                       IF $LENGTH($PIECE($GET(ORERR),U,2))

                               WRITE !,"  >> "_$PIECE(ORERR,U,2)

                       End DoDot:2

                       SET ORWAIT=1

                       QUIT

 +11               IF $PIECE(OR0,U,14)=ORLAB

                       IF $GET(^OR(100,ORIFN,4))

                           WRITE !,$$ORDITEM^ORCACT(ORIFN)_"  (LB #"_+^OR(100,ORIFN,4)_")"

                           SET ORWAIT=1

 +12               SET ORV=+$PIECE(OR0,U,17)

                   SET OREVT(ORV)=""

                   DO SETPRINT(ORNATR)

 +13               IF $$TYPE^OREVNTX(ORV)="M"

                       DO SAVE^ORMEVNT1(ORIFN,ORV,2)

                   WRITE "."

               End DoDot:1

 +14       IF $GET(ORES("LAB"))

               DO BTS^ORMBLD(ORVP)

EN3        IF $ORDER(ORCHART(0))!$ORDER(ORPRINT(0))

               SET ORCL=$$LOC^ORMEVNT

               IF ORCL

                   IF ORCL'=ORL

                       Begin DoDot:1

 +1                        NEW X,Y,DIR

                           SET DIR(0)="YA"

                           SET DIR("B")="YES"

 +2                        SET DIR("A",1)="This patient's location has been changed to "_$PIECE($GET(^SC(+ORCL,0)),U)_"."

 +3                        SET DIR("A")="Should the orders be printed using the new location? "

 +4                        SET DIR("?")="Enter NO to continue using "_$PIECE($GET(^SC(+ORL,0)),U)_" for ordering and printing, or YES to switch to the patient's current location instead"

 +5                        DO ^DIR

                           IF Y

                               SET ORL=ORCL

                       End DoDot:1

 +6        IF $ORDER(ORCHART(0))

               DO PRINT^ORPR02(ORVP,.ORCHART,,ORL,"1^0^0^0^0")

 +7        IF $ORDER(ORPRINT(0))

               DO PRINT^ORPR02(ORVP,.ORPRINT,,ORL,"0^1^1^1^0")

 +8        IF $ORDER(ORWORK(0))

               DO PRINT^ORPR02(ORVP,.ORWORK,,ORL,"0^0^0^0^1")

ENQ0       DO UNOTIF^ORCSIGN

           DO EMPTY

           SET OREBUILD=1

ENQ       ;output

           IF '$DATA(^TMP("ORNEW",$JOB))

               DO UNLOCK^ORX2(+ORVP)

           IF $GET(ORWAIT)

               DO READ

 +1       ;195

           IF $DATA(EVENT)

               WRITE !!,"Orders not released >> Delayed event being processed by another user!"

               DO READ

               SET J=0

FOR

                   SET J=$ORDER(EVENT(J))

                   IF '+J

                       QUIT

                   DO UNLEVT^ORX2(J)

 +2        QUIT

 +3       ;

SETPRINT(NATR) ; -- Set print arrays

 +1        IF '$LENGTH(NATR)!($PIECE(ORA0,U,4)'=2)

               SET NATR=$PIECE(ORA0,U,12)

 +2        SET ORPRINT=ORPRINT+1

           SET ORPRINT(ORPRINT)=ORDER

 +3        IF ("R"[ORPRNT)!(ORPRNT="S"&($PIECE(ORA0,U,4)=2)&(ORSIG'=2))

               IF $$CHART^ORX1(NATR)

                   SET ORCHART=ORCHART+1

                   SET ORCHART(ORCHART)=ORDER

 +4        IF $$WORK(NATR)

               SET ORWORK=ORWORK+1

               SET ORWORK(ORWORK)=ORDER

 +5        QUIT

 +6       ;

WORK(NATR) ; -- Returns 1 or 0, to print work copies for NATR

 +1        IF $GET(NATR)=""

               SET NATR="E"

           IF 'NATR

               SET NATR=+$ORDER(^ORD(100.02,"C",NATR,0))

 +2        QUIT +$PIECE($GET(^ORD(100.02,NATR,1)),U,5)

 +3       ;

NEEDSIG() ; -- Return 1 or 0, if any selected orders need ES

 +1        NEW ORI,NMBR,ORIFN,ORDA,Y

           SET Y=0

 +2        FOR ORI=1:1:$LENGTH(ORNMBR,",")

               SET NMBR=$PIECE(ORNMBR,",",ORI)

               IF NMBR

                   Begin DoDot:1

 +3                    SET ORIFN=$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR)),U)

                       IF 'ORIFN

                           QUIT

 +4                    SET ORDA=+$PIECE(ORIFN,";",2)

                       SET ORIFN=+ORIFN

                       IF 'ORDA

                           SET ORDA=1

 +5                    IF $PIECE($GET(^OR(100,ORIFN,8,ORDA,0)),U,4)=2

                           SET ORES("ES")=1

                           SET Y=1

                   End DoDot:1

                   IF Y

                       QUIT

 +6        QUIT Y

 +7       ;

VALID     ; -- validate ORDER for signature/release

 +1        IF '$$VALID^ORCACT0(ORDER,"MN",.ORERR)

               WRITE !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!,"  >> "_ORERR

               SET (ORQUIT,ORWAIT)=1

               QUIT

 +2        IF $LENGTH(ORACT)

               IF $PIECE($GET(^OR(100,ORIFN,8,ORDA,0)),U,4)=2

                   IF '$$VALID^ORCACT0(ORDER,ORACT,.ORERR,ORNATR)

                       WRITE !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!,"  >> "_ORERR

                       SET (ORQUIT,ORWAIT)=1

                       QUIT

 +3        NEW ORLK,ORDIALOG

           SET ORLK=$$LOCK1^ORX2(ORIFN)

 +4       ;order locked

           IF 'ORLK

               WRITE !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!,"  >> "_$PIECE(ORLK,U,2)

               SET (ORQUIT,ORWAIT)=1

               QUIT

 +5        SET ORDIALOG=+$PIECE($GET(^OR(100,ORIFN,0)),U,5)

 +6        IF $LENGTH($GET(^ORD(101.41,ORDIALOG,7)))

               XECUTE ^(7)

               IF $GET(ORQUIT)

                   DO UNLK1^ORX2(ORIFN)

 +7        QUIT

 +8       ;

EMPTY     ; -- check if no more orders for events in OREVT()

 +1        NEW EVT,X

 +2       ;terminate any events?

           SET EVT=0

FOR

               SET EVT=$ORDER(OREVT(EVT))

               IF EVT<1

                   QUIT

               Begin DoDot:1

 +3       ;active,empty

                   IF $GET(^ORE(100.2,EVT,1))

                       QUIT

                   IF '$$EMPTY^OREVNTX(EVT)

                       QUIT

 +4       ;W !!,$P($$NAME^OREVNTX(EVT)," ",2,99)_" has no more delayed orders."

 +5       ;S DIR(0)="YA",DIR("A")="Do you want to terminate this event? "

 +6       ;S DIR("?")="Enter NO if you wish to enter new delayed orders for this event, otherwise enter YES to terminate it."

 +7       ;S DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q

 +8                DO DONE^OREVNTX(EVT)

                   DO ACTLOG^OREVNTX(EVT,"MN")

 +9                SET X=$PIECE($$NAME^OREVNTX(EVT)," ",2,99)

 +10               WRITE !,"   ... "_X_" event completed."

                   HANG 1

 +11      ;return view to Active

                   IF $GET(OREVENT)

                       DO EX^OREVNT

               End DoDot:1

 +12       QUIT

 +13      ;

UNLOCK    ; -- Unlock orders in ORES(ORDER)

 +1        NEW ORIFN

           SET ORIFN=0

 +2        FOR

               SET ORIFN=$ORDER(ORES(ORIFN))

               IF ORIFN'>0

                   QUIT

               DO UNLK1^ORX2(+ORIFN)

 +3        QUIT

 +4       ;

READ      ; -- Press return to continue

 +1        NEW X,Y,DIR

 +2        SET DIR(0)="EA"

           SET DIR("A")="Press <return> to continue ..."

 +3        DO ^DIR

 +4        QUIT

 +5       ;

DONE()    ; -- OREVENT done?

 +1       ;not done yet

           IF '$GET(^ORE(100.2,+$GET(OREVENT),1))

               QUIT 0

 +2        DO FULL^VALM1

 +3        WRITE !!,"The event "_$$NAME^OREVNTX(OREVENT)_" has occurred since"

 +4        WRITE !,"you started writing delayed orders.  The orders that were signed have now been"

 +5        WRITE !,"released; any unsigned orders will be released immediately upon signature."

 +6        WRITE !!,"To write new delayed orders for this event you must select the Delayed Orders"

 +7        WRITE !,"action and this release event again.  Orders delayed to this same event will"

 +8        WRITE !,"remain delayed until the event occurs again."

 +9        WRITE !!,"The Orders tab will now be refreshed in the Active Orders view; you may then"

 +10       WRITE !,"write active orders for this patient as usual."

 +11      ;return view to Active

           DO READ

           SET XQORQUIT=1

           DO EX^OREVNT

 +12       QUIT 1

OREVNT1.m