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")
Q
;
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)_"|"
Q
;
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
Q
;
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
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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)
Q
;
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")
Q
;
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
Q
;
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
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCB 7598 printed Dec 13, 2024@02:27:53 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
