ORB3FUP1 ; slc/CLA - Routine to support notification follow-up actions ; 4/8/08 9:32am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139,243**;Dec 17, 1997;Build 242
Q
TYPE(ORBY,ORXQAID) ; return notif follow-up action type
N NIEN
S NIEN=$P($P(ORXQAID,";"),",",3)
S ORBY=$G(^ORD(100.9,NIEN,3))
I ORBY="" S ORBY="INFO^"
E S ORBY=$P(ORBY,U,2)
Q
GUI(ORBY,ORXQAID) ; Notification follow-up for GUI called via API: ORB FOLLOW-UP
; called by ORB FOLLOW-UP api:
S ORENVIR="GUI"
D PROCESS
Q
PROCESS ; main process for notification follow-up
;ORXQAID = OR,dfn,nien;
;XQADATA = placer num^placer id;filler num^filler id
;XQAKILL = value of parameter ORB DELETE MECHANISM for notif in 100.9
N ORPDIEN,ORN,ORDFN,ORSITE,ORFID,ORFIEN,ORKILL
D GETACT^XQALERT(ORXQAID) ;return follow-up action info
;Q:'($D(XQADATA)) Q:'($D(XQAID))
;Q:($P(XQAID,",")'="OR")
;call function rpc stored in xqarou with params from xqadata
D @XQAROU
K ORENVIR
Q
MSG ; display msg re: alert being processed for non-GUI follow-up actions
I $G(ORENVIR)'="GUI" D
.I $L($G(XQX)) W !!,"Processing alert: ",$P(XQX,U,3) H 1.5
Q
DEL(ORBY,XQAID,ORKILL) ; delete an alert
N ORN
S ORN=$P($P(XQAID,";"),",",3)
I $G(ORKILL)=1!($G(ORKILL)=0) S XQAKILL=ORKILL
I $G(XQAKILL)="" S XQAKILL=$$XQAKILL^ORB3F1(ORN)
I $G(XQAKILL)="" S XQAKILL=1
S ORBY="FALSE"
I $L($G(XQAID)) D DELETE^XQALERT S ORBY="TRUE"
K XQAKILL
Q
CSORD ;co-sign order(s) follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for orders requiring CO-SIGNATURE in ORQ1 is 'to be determined when ASU is available'
D DEL(.ORY,XQAID) ;until ASU is implemented, delete the alert and quit
Q ;quit until ASU is implemented
;I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",???,"","")
;I $G(ORENVIR)'="GUI" D
;.D MSG
;.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
;.D EN^ORCB(ORPT,???,ORDG,???)
;.K ^TMP("ORR",$J)
;.D EN^ORQ1(ORPT_";DPT(",ORDG,???,"","","",0,0)
;.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
;..D DEL(.ORY,ORBXQAID) ;if no more orders req. co-sign, delete the alert
;.K ^TMP("ORR",$J)
Q
EXDNR ;expiring dnr follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
N DNRORD,DNRY S DNRORD=$P(XQADATA,"@")
I $G(ORENVIR)="GUI" D
.S ORBY(1)=DNRY
I $G(ORENVIR)'="GUI" D
.D MSG
.D EN1^ORCB(DNRORD,"RENEW") ;display order, allow renewing, then delete
.D DEL(.ORY,ORBXQAID)
Q
UNLINKED ;unlinked provider follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
N ORNUM,ORUNY S ORNUM=$P(XQADATA,"@")
I $G(ORENVIR)="GUI" D
.S ORBY(1)=ORUNY
I $G(ORENVIR)'="GUI" D
.D MSG
.D EN1^ORCB(ORNUM,"REPLACE") ;display order, allow replace, then delete
.D DEL(.ORY,ORBXQAID)
Q
FLORD ;flagged order(s) follow-up
K XQAKILL
N ORPT,ORDG,X,ORBXQAID,ORY,ORBLMDEL
S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for "FLAGGED" in ORQ1 is '12'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",12,"","")
I $G(ORENVIR)'="GUI" D
.D MSG
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
.K ^TMP("ORR",$J)
.Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
.D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
..D DEL(.ORY,ORBXQAID) ;if no more flagged orders found, delete alert
.K ^TMP("ORR",$J)
Q
NEWORD ;new order(s) follow-up
K XQAKILL
N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for NEW orders since last reviewed orders in ORQ1 is '6'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
I $G(ORENVIR)'="GUI" D
.D MSG
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
.Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
.D DEL(.ORY,ORBXQAID) ;delete the alert
Q
DCORD ;DC order(s) follow-up
K XQAKILL
N ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
S ORSDT="",OREDT="",ENT="USR",ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for DC orders is '3'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
I $G(ORENVIR)'="GUI" D
.D MSG
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
.Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
.D DEL(.ORY,ORBXQAID) ;delete the alert
Q
NUMORD ;detailed order display follow-up - return order number
K XQAKILL
N ORBXQAID,ORY S ORBXQAID=XQAID
S ORNUM=$P(XQADATA,"@")
I $G(ORENVIR)="GUI" D
.Q
I $G(ORENVIR)'="GUI" D
.D MSG
.D EN1^ORCB(+ORNUM,"NEW") ;display order, allow new order then delete
.D DEL(.ORY,ORBXQAID)
Q
ESORD ;order(s) requiring electronic signature follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
S ORBXQAID=XQAID,ORDERS=0,ORQUIT=0
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for UNSIGNED orders in ORQ1 is '11'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",11,"","")
I $G(ORENVIR)'="GUI" D
.D MSG
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,11,ORDG,.ORBLMDEL)
.K ^TMP("ORR",$J) ;clean up array
.Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
.I $L($G(XQAID)) D ;EN^ORCB may kill XQAID in its follow-up
..;
..;get unsigned orders - if none exist, delete alert then quit:
..D EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
..S ORX="",ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX="" I +$G(^TMP("ORR",$J,ORX,"TOT"))<1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
..;
..;user does not have ORES key, delete user's alert:
..I '$D(^XUSEC("ORES",DUZ)) S XQAKILL=1 D DEL(.ORY,ORBXQAID) K ^TMP("ORR",$J) Q
..;
..;if prov is NOT linked to pt via attending, primary, teams or PCMM:
..I $$PPLINK^ORQPTQ1(DUZ,ORPT)=0 D
...S ORX="" F S ORX=$O(^TMP("ORR",$J,ORX)) Q:ORX=""!(ORDERS=1) D
....S ORZ="" F S ORZ=$O(^TMP("ORR",$J,ORX,ORZ)) Q:ORZ=""!(ORDERS=1) D
.....S ORDNUM=^TMP("ORR",$J,ORX,ORZ)
.....;quit if this unsigned order's last action was made by the user
.....I DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM) S ORDERS=1
...I ORDERS'=1 D ;provider has no outstanding unsiged orders for pt
....S XQAKILL=1 D DEL(.ORY,ORBXQAID) ;delete alert for this user
..K ^TMP("ORR",$J)
Q
UNFLAG(ORPT) ;order unflagged - delete alert if no more flagged orders
N ORDG,ORDOIT,ORQUIT,X,XQAID,XQAKILL,XQAUSER
S ORDOIT=1,ORQUIT=0
S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
K ^TMP("ORR",$J)
D EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
;========DELETE ALERT (FOR ALL USERS) IF NO FLAGGED ORDERS AT ALL=====
S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
.;if no more flagged orders found, delete alert:
.S XQAKILL=$$XQAKILL^ORB3F1(6)
.I $G(XQAKILL)="" S XQAKILL=1
.S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL S ORQUIT=1
Q:ORQUIT
;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT IS UNFLAGGING=====
S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" D
.N Y S Y="" F S Y=$O(^TMP("ORR",$J,X,Y)) Q:'Y D
..N ORDER S ORDER=$G(^TMP("ORR",$J,X,Y))
..I $$FLAGRULE^ORWORR1(+ORDER)=0 S ORDOIT=0 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
I ORDOIT D
.;if no more flagged orders found for this user, delete alert only for this user:
.S XQAKILL=1
.S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL
;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT WAS THE ALERTED PROVIDER OF THE CURRENT ORDER=====
S ORDOIT=1
;get the alerted provider
I $G(ORIFN) D
.N ORD,ORACT S ORD=+$G(ORIFN),ORACT=$P($G(ORIFN),";",2)
.N ORUSR S ORUSR=$P($G(^OR(100,ORD,8,ORACT,3)),U,9)
.I ORUSR D
..S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" D
...N Y S Y="" F S Y=$O(^TMP("ORR",$J,X,Y)) Q:'Y D
....N ORDER S ORDER=$G(^TMP("ORR",$J,X,Y))
....I $$FLAGRULE^ORWORR1(+ORDER,ORUSR)=0 S ORDOIT=0 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
..I ORDOIT D
...;if no more flagged orders found for this user, delete alert only for this user:
...S XQAKILL=1,XQAUSER=ORUSR
...S XQAID="OR,"_ORPT_",6" D DELETEA^XQALERT K XQAID,XQAKILL,XQAUSER
K ^TMP("ORR",$J)
Q
ORB3FUP1 ; slc/CLA - Routine to support notification follow-up actions ; 4/8/08 9:32am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139,243**;Dec 17, 1997;Build 242
+2 QUIT
TYPE(ORBY,ORXQAID) ; return notif follow-up action type
+1 NEW NIEN
+2 SET NIEN=$PIECE($PIECE(ORXQAID,";"),",",3)
+3 SET ORBY=$GET(^ORD(100.9,NIEN,3))
+4 IF ORBY=""
SET ORBY="INFO^"
+5 IF '$TEST
SET ORBY=$PIECE(ORBY,U,2)
+6 QUIT
GUI(ORBY,ORXQAID) ; Notification follow-up for GUI called via API: ORB FOLLOW-UP
+1 ; called by ORB FOLLOW-UP api:
+2 SET ORENVIR="GUI"
+3 DO PROCESS
+4 QUIT
PROCESS ; main process for notification follow-up
+1 ;ORXQAID = OR,dfn,nien;
+2 ;XQADATA = placer num^placer id;filler num^filler id
+3 ;XQAKILL = value of parameter ORB DELETE MECHANISM for notif in 100.9
+4 NEW ORPDIEN,ORN,ORDFN,ORSITE,ORFID,ORFIEN,ORKILL
+5 ;return follow-up action info
DO GETACT^XQALERT(ORXQAID)
+6 ;Q:'($D(XQADATA)) Q:'($D(XQAID))
+7 ;Q:($P(XQAID,",")'="OR")
+8 ;call function rpc stored in xqarou with params from xqadata
+9 DO @XQAROU
+10 KILL ORENVIR
+11 QUIT
MSG ; display msg re: alert being processed for non-GUI follow-up actions
+1 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+2 IF $LENGTH($GET(XQX))
WRITE !!,"Processing alert: ",$PIECE(XQX,U,3)
HANG 1.5
End DoDot:1
+3 QUIT
DEL(ORBY,XQAID,ORKILL) ; delete an alert
+1 NEW ORN
+2 SET ORN=$PIECE($PIECE(XQAID,";"),",",3)
+3 IF $GET(ORKILL)=1!($GET(ORKILL)=0)
SET XQAKILL=ORKILL
+4 IF $GET(XQAKILL)=""
SET XQAKILL=$$XQAKILL^ORB3F1(ORN)
+5 IF $GET(XQAKILL)=""
SET XQAKILL=1
+6 SET ORBY="FALSE"
+7 IF $LENGTH($GET(XQAID))
DO DELETE^XQALERT
SET ORBY="TRUE"
+8 KILL XQAKILL
+9 QUIT
CSORD ;co-sign order(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY
SET ORBXQAID=XQAID
+3 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+4 ;the FLG code for orders requiring CO-SIGNATURE in ORQ1 is 'to be determined when ASU is available'
+5 ;until ASU is implemented, delete the alert and quit
DO DEL(.ORY,XQAID)
+6 ;quit until ASU is implemented
QUIT
+7 ;I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",???,"","")
+8 ;I $G(ORENVIR)'="GUI" D
+9 ;.D MSG
+10 ;.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
+11 ;.D EN^ORCB(ORPT,???,ORDG,???)
+12 ;.K ^TMP("ORR",$J)
+13 ;.D EN^ORQ1(ORPT_";DPT(",ORDG,???,"","","",0,0)
+14 ;.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
+15 ;..D DEL(.ORY,ORBXQAID) ;if no more orders req. co-sign, delete the alert
+16 ;.K ^TMP("ORR",$J)
+17 QUIT
EXDNR ;expiring dnr follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORBXQAID,ORY
SET ORBXQAID=XQAID
+3 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+4 NEW DNRORD,DNRY
SET DNRORD=$PIECE(XQADATA,"@")
+5 IF $GET(ORENVIR)="GUI"
Begin DoDot:1
+6 SET ORBY(1)=DNRY
End DoDot:1
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG
+9 ;display order, allow renewing, then delete
DO EN1^ORCB(DNRORD,"RENEW")
+10 DO DEL(.ORY,ORBXQAID)
End DoDot:1
+11 QUIT
UNLINKED ;unlinked provider follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORBXQAID,ORY
SET ORBXQAID=XQAID
+3 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+4 NEW ORNUM,ORUNY
SET ORNUM=$PIECE(XQADATA,"@")
+5 IF $GET(ORENVIR)="GUI"
Begin DoDot:1
+6 SET ORBY(1)=ORUNY
End DoDot:1
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG
+9 ;display order, allow replace, then delete
DO EN1^ORCB(ORNUM,"REPLACE")
+10 DO DEL(.ORY,ORBXQAID)
End DoDot:1
+11 QUIT
FLORD ;flagged order(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,X,ORBXQAID,ORY,ORBLMDEL
+3 SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for "FLAGGED" in ORQ1 is '12'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"ALL",12,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+10 DO EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
+11 KILL ^TMP("ORR",$JOB)
+12 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
IF $GET(ORBLMDEL)=1
QUIT
+13 DO EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
+14 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
IF X=""
QUIT
IF +$GET(^TMP("ORR",$JOB,X,"TOT"))<1
Begin DoDot:2
+15 ;if no more flagged orders found, delete alert
DO DEL(.ORY,ORBXQAID)
End DoDot:2
+16 KILL ^TMP("ORR",$JOB)
End DoDot:1
+17 QUIT
NEWORD ;new order(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
+3 SET ORSDT=""
SET OREDT=""
SET ENT="USR"
SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for NEW orders since last reviewed orders in ORQ1 is '6'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+10 DO EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
+11 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
IF $GET(ORBLMDEL)=1
QUIT
+12 ;delete the alert
DO DEL(.ORY,ORBXQAID)
End DoDot:1
+13 QUIT
DCORD ;DC order(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORSDT,OREDT,ENT,X,ORBXQAID,ORY,ORBLMDEL
+3 SET ORSDT=""
SET OREDT=""
SET ENT="USR"
SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for DC orders is '3'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"ALL",6,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+10 DO EN^ORCB(ORPT,6,ORDG,.ORBLMDEL)
+11 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
IF $GET(ORBLMDEL)=1
QUIT
+12 ;delete the alert
DO DEL(.ORY,ORBXQAID)
End DoDot:1
+13 QUIT
NUMORD ;detailed order display follow-up - return order number
+1 KILL XQAKILL
+2 NEW ORBXQAID,ORY
SET ORBXQAID=XQAID
+3 SET ORNUM=$PIECE(XQADATA,"@")
+4 IF $GET(ORENVIR)="GUI"
Begin DoDot:1
+5 QUIT
End DoDot:1
+6 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+7 DO MSG
+8 ;display order, allow new order then delete
DO EN1^ORCB(+ORNUM,"NEW")
+9 DO DEL(.ORY,ORBXQAID)
End DoDot:1
+10 QUIT
ESORD ;order(s) requiring electronic signature follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY,ORX,ORZ,ORDERS,ORDNUM,ORQUIT,ORBLMDEL
+3 SET ORBXQAID=XQAID
SET ORDERS=0
SET ORQUIT=0
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for UNSIGNED orders in ORQ1 is '11'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"ALL",11,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+10 DO EN^ORCB(ORPT,11,ORDG,.ORBLMDEL)
+11 ;clean up array
KILL ^TMP("ORR",$JOB)
+12 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
IF $GET(ORBLMDEL)=1
QUIT
+13 ;EN^ORCB may kill XQAID in its follow-up
IF $LENGTH($GET(XQAID))
Begin DoDot:2
+14 ;
+15 ;get unsigned orders - if none exist, delete alert then quit:
+16 DO EN^ORQ1(ORPT_";DPT(",ORDG,11,"","","",0,0)
+17 SET ORX=""
SET ORX=$ORDER(^TMP("ORR",$JOB,ORX))
IF ORX=""
QUIT
IF +$GET(^TMP("ORR",$JOB,ORX,"TOT"))<1
DO DEL(.ORY,ORBXQAID)
KILL ^TMP("ORR",$JOB)
QUIT
+18 ;
+19 ;user does not have ORES key, delete user's alert:
+20 IF '$DATA(^XUSEC("ORES",DUZ))
SET XQAKILL=1
DO DEL(.ORY,ORBXQAID)
KILL ^TMP("ORR",$JOB)
QUIT
+21 ;
+22 ;if prov is NOT linked to pt via attending, primary, teams or PCMM:
+23 IF $$PPLINK^ORQPTQ1(DUZ,ORPT)=0
Begin DoDot:3
+24 SET ORX=""
FOR
SET ORX=$ORDER(^TMP("ORR",$JOB,ORX))
IF ORX=""!(ORDERS=1)
QUIT
Begin DoDot:4
+25 SET ORZ=""
FOR
SET ORZ=$ORDER(^TMP("ORR",$JOB,ORX,ORZ))
IF ORZ=""!(ORDERS=1)
QUIT
Begin DoDot:5
+26 SET ORDNUM=^TMP("ORR",$JOB,ORX,ORZ)
+27 ;quit if this unsigned order's last action was made by the user
+28 IF DUZ=+$$UNSIGNOR^ORQOR2(ORDNUM)
SET ORDERS=1
End DoDot:5
End DoDot:4
+29 ;provider has no outstanding unsiged orders for pt
IF ORDERS'=1
Begin DoDot:4
+30 ;delete alert for this user
SET XQAKILL=1
DO DEL(.ORY,ORBXQAID)
End DoDot:4
End DoDot:3
+31 KILL ^TMP("ORR",$JOB)
End DoDot:2
End DoDot:1
+32 QUIT
UNFLAG(ORPT) ;order unflagged - delete alert if no more flagged orders
+1 NEW ORDG,ORDOIT,ORQUIT,X,XQAID,XQAKILL,XQAUSER
+2 SET ORDOIT=1
SET ORQUIT=0
+3 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+4 KILL ^TMP("ORR",$JOB)
+5 DO EN^ORQ1(ORPT_";DPT(",ORDG,12,"","","",0,0)
+6 ;========DELETE ALERT (FOR ALL USERS) IF NO FLAGGED ORDERS AT ALL=====
+7 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
IF X=""
QUIT
IF +$GET(^TMP("ORR",$JOB,X,"TOT"))<1
Begin DoDot:1
+8 ;if no more flagged orders found, delete alert:
+9 SET XQAKILL=$$XQAKILL^ORB3F1(6)
+10 IF $GET(XQAKILL)=""
SET XQAKILL=1
+11 SET XQAID="OR,"_ORPT_",6"
DO DELETEA^XQALERT
KILL XQAID,XQAKILL
SET ORQUIT=1
End DoDot:1
+12 IF ORQUIT
QUIT
+13 ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT IS UNFLAGGING=====
+14 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
IF X=""
QUIT
Begin DoDot:1
+15 NEW Y
SET Y=""
FOR
SET Y=$ORDER(^TMP("ORR",$JOB,X,Y))
IF 'Y
QUIT
Begin DoDot:2
+16 NEW ORDER
SET ORDER=$GET(^TMP("ORR",$JOB,X,Y))
+17 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
IF $$FLAGRULE^ORWORR1(+ORDER)=0
SET ORDOIT=0
End DoDot:2
End DoDot:1
+18 IF ORDOIT
Begin DoDot:1
+19 ;if no more flagged orders found for this user, delete alert only for this user:
+20 SET XQAKILL=1
+21 SET XQAID="OR,"_ORPT_",6"
DO DELETEA^XQALERT
KILL XQAID,XQAKILL
End DoDot:1
+22 ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT WAS THE ALERTED PROVIDER OF THE CURRENT ORDER=====
+23 SET ORDOIT=1
+24 ;get the alerted provider
+25 IF $GET(ORIFN)
Begin DoDot:1
+26 NEW ORD,ORACT
SET ORD=+$GET(ORIFN)
SET ORACT=$PIECE($GET(ORIFN),";",2)
+27 NEW ORUSR
SET ORUSR=$PIECE($GET(^OR(100,ORD,8,ORACT,3)),U,9)
+28 IF ORUSR
Begin DoDot:2
+29 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
IF X=""
QUIT
Begin DoDot:3
+30 NEW Y
SET Y=""
FOR
SET Y=$ORDER(^TMP("ORR",$JOB,X,Y))
IF 'Y
QUIT
Begin DoDot:4
+31 NEW ORDER
SET ORDER=$GET(^TMP("ORR",$JOB,X,Y))
+32 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
IF $$FLAGRULE^ORWORR1(+ORDER,ORUSR)=0
SET ORDOIT=0
End DoDot:4
End DoDot:3
+33 IF ORDOIT
Begin DoDot:3
+34 ;if no more flagged orders found for this user, delete alert only for this user:
+35 SET XQAKILL=1
SET XQAUSER=ORUSR
+36 SET XQAID="OR,"_ORPT_",6"
DO DELETEA^XQALERT
KILL XQAID,XQAKILL,XQAUSER
End DoDot:3
End DoDot:2
End DoDot:1
+37 KILL ^TMP("ORR",$JOB)
+38 QUIT
