Routine: ORCB

ORCB ;SLC/MKB-Notifications followup for LMgr chart ; Apr 20, 2023@17:45

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,36,48,70,108,116,243,334,588**;Dec 17, 1997;Build 29

 ;;Per VHA Directive 2004-038, this routine should not be modified

 ;DBIA reference section

 ;10035 - ^DPT

 ;2437  - ^DGPM

 ;10009 - DICN

 ;10026 - DIR

 ;10118 - VALM

 ;10116 - VALM1

 ;10103 - XLFDT

 ;10104 - XLFSTR

 ;10140 - XQORM

EN(DFN,ORFLG,DGRP,DEL) ; -- main entry point

 Q:'$G(DFN)  Q:'$G(ORFLG)

 N BEG,END D SLCT1^ORQPT

 S DGRP=$P($G(^ORD(100.98,+$G(DGRP),0)),U,3) S:'$L(DGRP) DGRP="ALL"

 S (BEG,END)="" I ORFLG=6 D  ;get BEG from XQAID for New Orders

 . S BEG=$P(XQAID,";",3) I BEG'?7N1".".6N!(BEG'<DT) S BEG="" Q

 . S BEG=$$FMADD^XLFDT(BEG,,,-5),END=$$NOW^XLFDT

 I ORFLG=9 D  ;get BEG from Current Admission

 . N ADM S ADM=+$G(^DPT(DFN,.105)) S:ADM ADM=+$P($G(^DGPM(ADM,0)),U)

 . S END=$$NOW^XLFDT,BEG=$S(ADM:ADM,1:$$FMADD^XLFDT(END,-30))

 S ^TMP("OR",$J,"ORDERS",0)="^^"_BEG_";"_END_";"_ORFLG_";"_DGRP_";L"

 I $$ONEHR^ORACCESS D  Q

 . W !,"Site has migrated to Electronic Health Record."

 . W !,"CPRS List Manager access not allowed."

 . H 2

 D EN^VALM("ORCB NOTIFICATIONS")

INIT ; -- init variables and list array

 S ORTAB="ORDERS" D TAB^ORCHART("ORDERS",1)

 I VALMCNT=1,$G(^TMP("OR",$J,ORTAB,1,0))["No data available" D

 . N X,I S X="     No "_$S(ORFLG=5:"expiring",ORFLG=11:"unsigned",ORFLG=12:"flagged",9:"unverified",1:"new")_" orders found."

 . F I="ORDERS","CURRENT" S ^TMP("OR",$J,I,1,0)=$$LJ^XLFSTR(X,45)_"|"

HELP ; -- help code

 N X S VALMBCK=""

 W !!,"Enter the display numbers of the orders you wish to act on;"

 W !,"select either DT for a detailed listing of information about each"

 W !,"order, or the desired action.  Enter Q to exit."

 W !!,"Press <return> to continue ..." R X:DTIME

PHDR ; -- protocol menu header code

 N NUM,ORI,ORDEF,I,X K ORNMBR,OREBUILD

 S VALMSG=$$MSG^ORCHART D SHOW^VALM

 S NUM=+$P($G(^TMP("OR",$J,"CURRENT",0)),U,2)

 S XQORM("#")=$O(^ORD(101,"B","ORCB ACTIONS",0))_"^1:"_NUM

 S ORI=$S(ORFLG=5:1,ORFLG=11:"2,3,4",ORFLG=12:"3,4,5,6,7",1:8)

 S ORDEF=$S(ORFLG=5:1,ORFLG=11:9,ORFLG=12:5,1:10)

 F I=1:1:$L(ORI,",") S X=$T(ACTIONS+$P(ORI,",",I)),XQORM("KEY",$P(X,";",3))=$O(^ORD(101,"B","ORC "_$P(X,";",4)_" ORDERS",0))_"^1"

 S XQORM("KEY","DT")=$O(^ORD(101,"B","ORC DETAILED DISPLAY",0))_"^1"

 I +$P($G(^TMP("OR",$J,"CURRENT",0)),U,2)>0,XQORM("B")="Quit" S X=$T(ACTIONS+ORDEF),X=$P(X,";",4),XQORM("KEY",$P(X," "))=$O(^ORD(101,"B","ORC "_X_" ORDERS",0))_"^1",XQORM("B")=$$LOWER^VALM1(X)_" Orders" ; default action

 S:'$G(ORL) ORL=$$FINDLOC ; attempt to determine location from orders

SELECT ; -- process selected order(s)

 N MENU,XQORM,Y,ORNMBR,OREBUILD,ORY S VALMBCK=""

 S ORNMBR=$P(XQORNOD(0),"=",2) D SELECT^ORCHART(ORNMBR)

 S:'$G(ORFLG) ORFLG=$P($P(^TMP("OR",$J,"CURRENT",0),U,3),";",3)

 S MENU=$S(ORFLG=5:"EXPIRING",ORFLG=11:"UNSIGNED",ORFLG=12:"FLAGGED",1:"NEW")

 S XQORM=$O(^ORD(101,"B","ORCB "_MENU_" MENU",0))_";ORD(101,"

 I 'XQORM W !!,"ERROR" H 2 G SQ

 S XQORM(0)="1AD",XQORM("A")="Select action: "

 W ! D EN^XQORM G:Y'>0 SQ M ORY=Y

 I $D(^ORD(101,+$P(ORY(1),U,2),20)) X ^(20) S VALMBCK="R"

 I $G(OREBUILD) D:ORFLG=12 UNFLAG D TAB^ORCHART(ORTAB,1) Q

SQ D DESELECT^ORCHART(ORNMBR)

UNFLAG ; -- Unflag orders

 N ORX,ORI,NUM,ORIFN,ORA,X

 S ORX=$P(ORY(1),U,3) Q:(ORX="Unflag")!(ORX="Detailed Display")

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

 . S ORIFN=$P(^TMP("OR",$J,"CURRENT","IDX",NUM),U) Q:'ORIFN

 . S ORA=+$P(ORIFN,";",2),ORIFN=+ORIFN Q:'ORA

 . Q:'$D(^OR(100,ORIFN))  Q:(ORX="Edit")&($P(^(ORIFN,3),U,3)'=12)

 . S X=+$G(^OR(100,ORIFN,8,ORA,0)),$P(^(3),U)=0,$P(^(3),U,6,8)=X_U_DUZ_"^Unflagged by action" ; Unflag

 . S X=ORIFN_";"_ORA D MSG^ORCFLAG(X)

EN1(ORIFN,ACTION) ; -- entry point to display single order

 Q:'ORIFN  Q:'$D(^OR(100,ORIFN))

 Q:"^^NEW^RENEW^REPLACE^"'[(U_$G(ACTION)_U)

 S DFN=+$P(^OR(100,ORIFN,0),U,2) Q:'DFN

 S ^TMP("ORXPND",$J,0)=ORIFN_U_$G(ACTION)

 D EN1^ORCXPND(DFN,ORIFN)

 K ^TMP("ORXPND",$J),^TMP("OR",$J)

NEW ; -- Add new order as follow-up action

 N IFN,TYPE,ORIG,ORNP,ORPTLK S VALMBCK="" K ^TMP("ORNEW",$J)

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

 S ORNP=$$PROVIDER^ORCMENU1,VALMBCK="R" G:ORNP="^" NWQ

 I '$G(ORL) S ORL=$$LOCATION^ORCMENU1 G:ORL["^" NWQ

 S ORIG=+$P($G(^TMP("ORXPND",$J,0)),U),IFN=+$P($G(^OR(100,+ORIG,0)),U,5)

 G:'IFN NWQ S TYPE=$P($G(^ORD(101.41,IFN,0)),U,4)

 ; If 2.5 order, use DG or PKG to get dlg

 D FULL^VALM1,ORDER^ORCMENU

 I $O(^TMP("ORNEW",$J,0)) D SIGN,NOTIF^ORCMENU2

 K ^TMP("ORNEW",$J) S VALMBCK="R"

NWQ D UNLOCK^ORX2(+ORVP)

EDIT ; -- Edit order as follow-up action

 N OREBUILD K ^TMP("ORNEW",$J)

 D EDIT^ORCACT I $G(OREBUILD) D

 . D SIGN,NOTIF^ORCMENU2

 . S $P(^TMP("ORXPND",$J,0),U,2)=""

 K ^TMP("ORNEW",$J) S VALMBCK="R"

 D UNLOCK^ORX2(+ORVP)

RENEW ; --Renew order as follow-up action

 N OREBUILD K ^TMP("ORNEW",$J)

 D RENEW^ORCACT I $G(OREBUILD) D

 . D SIGN,NOTIF^ORCMENU2

 . S $P(^TMP("ORXPND",$J,0),U,2)=""

 . K ^TMP("ORXPND",$J) D INIT^ORCXPND

 K ^TMP("ORNEW",$J) S VALMBCK="R"

 D UNLOCK^ORX2(+ORVP)

SIGN ; -- Sign new order

 N ORIFN,ORTAB,ORNMBR,CNT

 S ORTAB="NEW",(ORIFN,CNT)=0,ORNMBR=""

 F  S ORIFN=+$O(^TMP("ORNEW",$J,ORIFN)) Q:ORIFN'>0  S CNT=CNT+1,^TMP("OR",$J,"NEW","IDX",CNT)=ORIFN,ORNMBR=ORNMBR_CNT_","

 I CNT D EN^ORCSIGN K ^TMP("OR",$J,"NEW","IDX")

EXIT ; -- exit action

 ;*334/VMP-DJE Auto unflag has been disabled

 ;I $P($P(^TMP("OR",$J,"CURRENT",0),U,3),";",3)=12 D  ; flagged orders

 ;. Q:'$$GET^XPAR("ALL","ORPF AUTO UNFLAG")

 ;. N ORI,ORIFN,ORA,XQAKILL,ORN,ORUNF

 ;. S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged"

 ;. S ORI=0 F  S ORI=$O(^TMP("OR",$J,"CURRENT","IDX",ORI)) Q:ORI'>0  S ORIFN=$P(^(ORI),U),ORA=+$P(ORIFN,";",2) I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF D MSG^ORCFLAG(ORIFN) ; unflag

 ;. S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0))

 ;. S XQAKILL=$$XQAKILL^ORB3F1(ORN) D:$D(XQAID) DELETE^XQALERT

 D EXIT^ORCHART

ACTIONS ;;KEY;NAME

 ;;RN;RENEW

 ;;$;SIGN

 ;;DC;DISCONTINUE

 ;;ED;CHANGE

 ;;UF;UNFLAG

 ;;HD;HOLD

 ;;RL;UNHOLD

 ;;VF;VERIFY

 ;;;SIGN ALL

 ;;;VERIFY ALL

ALL ; -- Select ALL orders

 N X,Y,DIR,MAX

 S MAX=+$P($G(^TMP("OR",$J,"CURRENT",0)),U,2),X="1-"_MAX,Y=""

 S DIR(0)="L^1:"_MAX,DIR("V")="" D:MAX ^DIR

 S ORNMBR=Y

FINDLOC() ; -- Loop through orders in alert to find assigned location

 N ORI,ORIFN,ORY S ORI=0,ORY=""

 F  S ORI=$O(^TMP("OR",$J,"CURRENT","IDX",ORI)) Q:ORI'>0  S ORIFN=+^(ORI),ORX=$P($G(^OR(100,ORIFN,0)),U,10) S:ORY="" ORY=ORX I ORY'="",ORX'=ORY S ORY="" Q  ; ORY=location for all orders, or "" if different

 Q ORY

DELETE ; -- Delete current alert

 N %,%Y,X,Y,PRMT,XQAKILL S VALMBCK="",XQAKILL=1

 S PRMT="Your "_$S(ORFLG=5:"Expiring",ORFLG=11:"Unsigned",ORFLG=12:"Flagged",ORFLG=9:"Unverified",1:"New")_" Orders alert for "_$G(ORPNM)_" will be deleted!"

D1 W !!,PRMT,!,"Are you sure" S %=2 D YN^DICN

 I (%<0)!(%=2) W !,"Nothing deleted." H 2 Q

 I %=0 D  G D1

 . W !!,"This action will delete the alert you are currently processing; the alert will",!,"disappear automatically when all orders have been acted on, but this action may",!,"be used to remove the alert if some orders are to be left unchanged."

 . W !,"Press <return> to continue ..." R X:DTIME

 W !,"Removing alert ..." D:$D(XQAID) DEL^ORB3FUP1(.Y,XQAID)

 I $G(Y)="TRUE" W " done." S VALMBCK="Q",DEL=1 H 2

 E  W " unable to delete alert." H 2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCB   7598     printed  Feb 18, 2025@23:54:26                                                                                                                                                                                                        Page 2

ORCB      ;SLC/MKB-Notifications followup for LMgr chart ; Apr 20, 2023@17:45

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,36,48,70,108,116,243,334,588**;Dec 17, 1997;Build 29

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified

 +3       ;DBIA reference section

 +4       ;10035 - ^DPT

 +5       ;2437  - ^DGPM

 +6       ;10009 - DICN

 +7       ;10026 - DIR

 +8       ;10118 - VALM

 +9       ;10116 - VALM1

 +10      ;10103 - XLFDT

 +11      ;10104 - XLFSTR

 +12      ;10140 - XQORM

EN(DFN,ORFLG,DGRP,DEL) ; -- main entry point

 +1        if '$GET(DFN)

               QUIT

           if '$GET(ORFLG)

               QUIT

 +2        NEW BEG,END

           DO SLCT1^ORQPT

 +3        SET DGRP=$PIECE($GET(^ORD(100.98,+$GET(DGRP),0)),U,3)

           if '$LENGTH(DGRP)

               SET DGRP="ALL"

 +4       ;get BEG from XQAID for New Orders

           SET (BEG,END)=""

           IF ORFLG=6

               Begin DoDot:1

 +5                SET BEG=$PIECE(XQAID,";",3)

                   IF BEG'?7N1".".6N!(BEG'<DT)

                       SET BEG=""

                       QUIT

 +6                SET BEG=$$FMADD^XLFDT(BEG,,,-5)

                   SET END=$$NOW^XLFDT

               End DoDot:1

 +7       ;get BEG from Current Admission

           IF ORFLG=9

               Begin DoDot:1

 +8                NEW ADM

                   SET ADM=+$GET(^DPT(DFN,.105))

                   if ADM

                       SET ADM=+$PIECE($GET(^DGPM(ADM,0)),U)

 +9                SET END=$$NOW^XLFDT

                   SET BEG=$SELECT(ADM:ADM,1:$$FMADD^XLFDT(END,-30))

               End DoDot:1

 +10       SET ^TMP("OR",$JOB,"ORDERS",0)="^^"_BEG_";"_END_";"_ORFLG_";"_DGRP_";L"

 +11       IF $$ONEHR^ORACCESS

               Begin DoDot:1

 +12               WRITE !,"Site has migrated to Electronic Health Record."

 +13               WRITE !,"CPRS List Manager access not allowed."

 +14               HANG 2

               End DoDot:1

               QUIT

 +15       DO EN^VALM("ORCB NOTIFICATIONS")

 +16       QUIT

 +17      ;

INIT      ; -- init variables and list array

 +1        SET ORTAB="ORDERS"

           DO TAB^ORCHART("ORDERS",1)

 +2        IF VALMCNT=1

               IF $GET(^TMP("OR",$JOB,ORTAB,1,0))["No data available"

                   Begin DoDot:1

 +3                    NEW X,I

                       SET X="     No "_$SELECT(ORFLG=5:"expiring",ORFLG=11:"unsigned",ORFLG=12:"flagged",9:"unverified",1:"new")_" orders found."

 +4                    FOR I="ORDERS","CURRENT"

                           SET ^TMP("OR",$JOB,I,1,0)=$$LJ^XLFSTR(X,45)_"|"

                   End DoDot:1

 +5        QUIT

 +6       ;

HELP      ; -- help code

 +1        NEW X

           SET VALMBCK=""

 +2        WRITE !!,"Enter the display numbers of the orders you wish to act on;"

 +3        WRITE !,"select either DT for a detailed listing of information about each"

 +4        WRITE !,"order, or the desired action.  Enter Q to exit."

 +5        WRITE !!,"Press <return> to continue ..."

           READ X:DTIME

 +6        QUIT

 +7       ;

PHDR      ; -- protocol menu header code

 +1        NEW NUM,ORI,ORDEF,I,X

           KILL ORNMBR,OREBUILD

 +2        SET VALMSG=$$MSG^ORCHART

           DO SHOW^VALM

 +3        SET NUM=+$PIECE($GET(^TMP("OR",$JOB,"CURRENT",0)),U,2)

 +4        SET XQORM("#")=$ORDER(^ORD(101,"B","ORCB ACTIONS",0))_"^1:"_NUM

 +5        SET ORI=$SELECT(ORFLG=5:1,ORFLG=11:"2,3,4",ORFLG=12:"3,4,5,6,7",1:8)

 +6        SET ORDEF=$SELECT(ORFLG=5:1,ORFLG=11:9,ORFLG=12:5,1:10)

 +7        FOR I=1:1:$LENGTH(ORI,",")

               SET X=$TEXT(ACTIONS+$PIECE(ORI,",",I))

               SET XQORM("KEY",$PIECE(X,";",3))=$ORDER(^ORD(101,"B","ORC "_$PIECE(X,";",4)_" ORDERS",0))_"^1"

 +8        SET XQORM("KEY","DT")=$ORDER(^ORD(101,"B","ORC DETAILED DISPLAY",0))_"^1"

 +9       ; default action

           IF +$PIECE($GET(^TMP("OR",$JOB,"CURRENT",0)),U,2)>0

               IF XQORM("B")="Quit"

                   SET X=$TEXT(ACTIONS+ORDEF)

                   SET X=$PIECE(X,";",4)

                   SET XQORM("KEY",$PIECE(X," "))=$ORDER(^ORD(101,"B","ORC "_X_" ORDERS",0))_"^1"

                   SET XQORM("B")=$$LOWER^VALM1(X)_" Orders"

 +10      ; attempt to determine location from orders

           if '$GET(ORL)

               SET ORL=$$FINDLOC

 +11       QUIT

 +12      ;

SELECT    ; -- process selected order(s)

 +1        NEW MENU,XQORM,Y,ORNMBR,OREBUILD,ORY

           SET VALMBCK=""

 +2        SET ORNMBR=$PIECE(XQORNOD(0),"=",2)

           DO SELECT^ORCHART(ORNMBR)

 +3        if '$GET(ORFLG)

               SET ORFLG=$PIECE($PIECE(^TMP("OR",$JOB,"CURRENT",0),U,3),";",3)

 +4        SET MENU=$SELECT(ORFLG=5:"EXPIRING",ORFLG=11:"UNSIGNED",ORFLG=12:"FLAGGED",1:"NEW")

 +5        SET XQORM=$ORDER(^ORD(101,"B","ORCB "_MENU_" MENU",0))_";ORD(101,"

 +6        IF 'XQORM

               WRITE !!,"ERROR"

               HANG 2

               GOTO SQ

 +7        SET XQORM(0)="1AD"

           SET XQORM("A")="Select action: "

 +8        WRITE !

           DO EN^XQORM

           if Y'>0

               GOTO SQ

           MERGE ORY=Y

 +9        IF $DATA(^ORD(101,+$PIECE(ORY(1),U,2),20))

               XECUTE ^(20)

               SET VALMBCK="R"

 +10       IF $GET(OREBUILD)

               if ORFLG=12

                   DO UNFLAG

               DO TAB^ORCHART(ORTAB,1)

               QUIT

SQ         DO DESELECT^ORCHART(ORNMBR)

 +1        QUIT

 +2       ;

UNFLAG    ; -- Unflag orders

 +1        NEW ORX,ORI,NUM,ORIFN,ORA,X

 +2        SET ORX=$PIECE(ORY(1),U,3)

           if (ORX="Unflag")!(ORX="Detailed Display")

               QUIT

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

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

               IF NUM

                   Begin DoDot:1

 +4                    SET ORIFN=$PIECE(^TMP("OR",$JOB,"CURRENT","IDX",NUM),U)

                       if 'ORIFN

                           QUIT

 +5                    SET ORA=+$PIECE(ORIFN,";",2)

                       SET ORIFN=+ORIFN

                       if 'ORA

                           QUIT

 +6                    if '$DATA(^OR(100,ORIFN))

                           QUIT

                       if (ORX="Edit")&($PIECE(^(ORIFN,3),U,3)'=12)

                           QUIT

 +7       ; Unflag

                       SET X=+$GET(^OR(100,ORIFN,8,ORA,0))

                       SET $PIECE(^(3),U)=0

                       SET $PIECE(^(3),U,6,8)=X_U_DUZ_"^Unflagged by action"

 +8                    SET X=ORIFN_";"_ORA

                       DO MSG^ORCFLAG(X)

                   End DoDot:1

 +9        QUIT

 +10      ;

EN1(ORIFN,ACTION) ; -- entry point to display single order

 +1        if 'ORIFN

               QUIT

           if '$DATA(^OR(100,ORIFN))

               QUIT

 +2        if "^^NEW^RENEW^REPLACE^"'[(U_$GET(ACTION)_U)

               QUIT

 +3        SET DFN=+$PIECE(^OR(100,ORIFN,0),U,2)

           if 'DFN

               QUIT

 +4        SET ^TMP("ORXPND",$JOB,0)=ORIFN_U_$GET(ACTION)

 +5        DO EN1^ORCXPND(DFN,ORIFN)

 +6        KILL ^TMP("ORXPND",$JOB),^TMP("OR",$JOB)

 +7        QUIT

 +8       ;

NEW       ; -- Add new order as follow-up action

 +1        NEW IFN,TYPE,ORIG,ORNP,ORPTLK

           SET VALMBCK=""

           KILL ^TMP("ORNEW",$JOB)

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

           IF 'ORPTLK

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

               HANG 2

               QUIT

 +3        SET ORNP=$$PROVIDER^ORCMENU1

           SET VALMBCK="R"

           if ORNP="^"

               GOTO NWQ

 +4        IF '$GET(ORL)

               SET ORL=$$LOCATION^ORCMENU1

               if ORL["^"

                   GOTO NWQ

 +5        SET ORIG=+$PIECE($GET(^TMP("ORXPND",$JOB,0)),U)

           SET IFN=+$PIECE($GET(^OR(100,+ORIG,0)),U,5)

 +6        if 'IFN

               GOTO NWQ

           SET TYPE=$PIECE($GET(^ORD(101.41,IFN,0)),U,4)

 +7       ; If 2.5 order, use DG or PKG to get dlg

 +8        DO FULL^VALM1

           DO ORDER^ORCMENU

 +9        IF $ORDER(^TMP("ORNEW",$JOB,0))

               DO SIGN

               DO NOTIF^ORCMENU2

 +10       KILL ^TMP("ORNEW",$JOB)

           SET VALMBCK="R"

NWQ        DO UNLOCK^ORX2(+ORVP)

 +1        QUIT

 +2       ;

EDIT      ; -- Edit order as follow-up action

 +1        NEW OREBUILD

           KILL ^TMP("ORNEW",$JOB)

 +2        DO EDIT^ORCACT

           IF $GET(OREBUILD)

               Begin DoDot:1

 +3                DO SIGN

                   DO NOTIF^ORCMENU2

 +4                SET $PIECE(^TMP("ORXPND",$JOB,0),U,2)=""

               End DoDot:1

 +5        KILL ^TMP("ORNEW",$JOB)

           SET VALMBCK="R"

 +6        DO UNLOCK^ORX2(+ORVP)

 +7        QUIT

 +8       ;

RENEW     ; --Renew order as follow-up action

 +1        NEW OREBUILD

           KILL ^TMP("ORNEW",$JOB)

 +2        DO RENEW^ORCACT

           IF $GET(OREBUILD)

               Begin DoDot:1

 +3                DO SIGN

                   DO NOTIF^ORCMENU2

 +4                SET $PIECE(^TMP("ORXPND",$JOB,0),U,2)=""

 +5                KILL ^TMP("ORXPND",$JOB)

                   DO INIT^ORCXPND

               End DoDot:1

 +6        KILL ^TMP("ORNEW",$JOB)

           SET VALMBCK="R"

 +7        DO UNLOCK^ORX2(+ORVP)

 +8        QUIT

 +9       ;

SIGN      ; -- Sign new order

 +1        NEW ORIFN,ORTAB,ORNMBR,CNT

 +2        SET ORTAB="NEW"

           SET (ORIFN,CNT)=0

           SET ORNMBR=""

 +3        FOR

               SET ORIFN=+$ORDER(^TMP("ORNEW",$JOB,ORIFN))

               if ORIFN'>0

                   QUIT

               SET CNT=CNT+1

               SET ^TMP("OR",$JOB,"NEW","IDX",CNT)=ORIFN

               SET ORNMBR=ORNMBR_CNT_","

 +4        IF CNT

               DO EN^ORCSIGN

               KILL ^TMP("OR",$JOB,"NEW","IDX")

 +5        QUIT

 +6       ;

EXIT      ; -- exit action

 +1       ;*334/VMP-DJE Auto unflag has been disabled

 +2       ;I $P($P(^TMP("OR",$J,"CURRENT",0),U,3),";",3)=12 D  ; flagged orders

 +3       ;. Q:'$$GET^XPAR("ALL","ORPF AUTO UNFLAG")

 +4       ;. N ORI,ORIFN,ORA,XQAKILL,ORN,ORUNF

 +5       ;. S ORUNF=+$E($$NOW^XLFDT,1,12)_U_DUZ_"^Auto-Unflagged"

 +6       ;. S ORI=0 F  S ORI=$O(^TMP("OR",$J,"CURRENT","IDX",ORI)) Q:ORI'>0  S ORIFN=$P(^(ORI),U),ORA=+$P(ORIFN,";",2) I ORIFN,$D(^OR(100,+ORIFN,0)) S $P(^(8,ORA,3),U)=0,$P(^(3),U,6,8)=ORUNF D MSG^ORCFLAG(ORIFN) ; unflag

 +7       ;. S ORN=+$O(^ORD(100.9,"B","FLAGGED ORDERS",0))

 +8       ;. S XQAKILL=$$XQAKILL^ORB3F1(ORN) D:$D(XQAID) DELETE^XQALERT

 +9        DO EXIT^ORCHART

 +10       QUIT

 +11      ;

ACTIONS   ;;KEY;NAME

 +1       ;;RN;RENEW

 +2       ;;$;SIGN

 +3       ;;DC;DISCONTINUE

 +4       ;;ED;CHANGE

 +5       ;;UF;UNFLAG

 +6       ;;HD;HOLD

 +7       ;;RL;UNHOLD

 +8       ;;VF;VERIFY

 +9       ;;;SIGN ALL

 +10      ;;;VERIFY ALL

 +11      ;

ALL       ; -- Select ALL orders

 +1        NEW X,Y,DIR,MAX

 +2        SET MAX=+$PIECE($GET(^TMP("OR",$JOB,"CURRENT",0)),U,2)

           SET X="1-"_MAX

           SET Y=""

 +3        SET DIR(0)="L^1:"_MAX

           SET DIR("V")=""

           if MAX

               DO ^DIR

 +4        SET ORNMBR=Y

 +5        QUIT

 +6       ;

FINDLOC() ; -- Loop through orders in alert to find assigned location

 +1        NEW ORI,ORIFN,ORY

           SET ORI=0

           SET ORY=""

 +2       ; ORY=location for all orders, or "" if different

FOR

               SET ORI=$ORDER(^TMP("OR",$JOB,"CURRENT","IDX",ORI))

               if ORI'>0

                   QUIT

               SET ORIFN=+^(ORI)

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

               if ORY=""

                   SET ORY=ORX

               IF ORY'=""

                   IF ORX'=ORY

                       SET ORY=""

                       QUIT

 +3        QUIT ORY

 +4       ;

DELETE    ; -- Delete current alert

 +1        NEW %,%Y,X,Y,PRMT,XQAKILL

           SET VALMBCK=""

           SET XQAKILL=1

 +2        SET PRMT="Your "_$SELECT(ORFLG=5:"Expiring",ORFLG=11:"Unsigned",ORFLG=12:"Flagged",ORFLG=9:"Unverified",1:"New")_" Orders alert for "_$GET(ORPNM)_" will be deleted!"

D1         WRITE !!,PRMT,!,"Are you sure"

           SET %=2

           DO YN^DICN

 +1        IF (%<0)!(%=2)

               WRITE !,"Nothing deleted."

               HANG 2

               QUIT

 +2        IF %=0

               Begin DoDot:1

 +3                WRITE !!,"This action will delete the alert you are currently processing; the alert will",!,"disappear automatically when all orders have been acted on, but this action may",!,"be used to remove the alert if some orders are to be left u

nchanged."

 +4                WRITE !,"Press <return> to continue ..."

                   READ X:DTIME

               End DoDot:1

               GOTO D1

 +5        WRITE !,"Removing alert ..."

           if $DATA(XQAID)

               DO DEL^ORB3FUP1(.Y,XQAID)

 +6        IF $GET(Y)="TRUE"

               WRITE " done."

               SET VALMBCK="Q"

               SET DEL=1

               HANG 2

 +7       IF '$TEST

               WRITE " unable to delete alert."

               HANG 2

 +8        QUIT

ORCB.m