ORB3FUP1 ;SLC/CLA - ROUTINE TO SUPPORT NOTIFICATION FOLLOW UP ACTIONS ;Jan 12, 2021@11:20
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139,243,350,377,539**;Dec 17, 1997;Build 41
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:
N ORENVIR
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
N XQAID,XQADATA,XQAOPT,XQAROU,XQALERTD
;return follow-up action info
I $P(ORXQAID,";",2)=DUZ D GETACT^XQALERT(ORXQAID)
I $P(ORXQAID,";",2)'=DUZ D
.D ALERTDAT^XQALBUTL(ORXQAID)
.S XQAID=ORXQAID,XQADATA=$G(XQALERTD(2))
.S XQAOPT=$G(XQALERTD(1.02))
.S XQAROU=$G(XQALERTD(1.03))_U_$G(XQALERTD(1.04))
.I XQAROU=U S XQAROU=""
;call function rpc stored in xqarou with params from xqadata
I XQAROU'="" D @XQAROU
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 XQAKILL=0 ;p539
.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 OR RECIPIENT OF THE CURRENT ORDER=====
;get the alerted provider/recipients ;p539
I $G(ORIFN) D
.N ORD,ORACT S ORD=+$G(ORIFN),ORACT=$P($G(ORIFN),";",2)
.N ORUSR,IEN,ORCPT S ORUSR=$P($G(^OR(100,ORD,8,ORACT,3)),U,9) I ORUSR S ORCPT(ORUSR)=""
.S IEN=0
.F S IEN=$O(^OR(100,ORD,8,ORACT,6,IEN)) Q:'IEN S ORUSR=+$G(^(IEN,0)) I ORUSR S ORCPT(ORUSR)=""
.I $O(ORCPT(""))'="" S ORUSR=0 F S ORUSR=$O(ORCPT(ORUSR)) Q:'ORUSR D
..S ORDOIT=1
..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
INDORDER ;process specific orders
;XQADATA=LIST MANAGER ACTION;CARET-DELIMITED LIST OF ORDER NUMBERS
K XQAKILL
N ORBXQAID,ORY
S ORBXQAID=XQAID
I $G(ORENVIR)="GUI",($L($P(XQADATA,";",2))>0) D
.N INDEX,IFN,ORLIST,ORLST,TOT,I,ORWTS,PTEVTID,EVTNAME,TXTVW,MULT,REF,FILTER
.S XQADATA=$P(XQADATA,";",2),ORLIST="INDORDER",ORLST=0,EVTNAME=""
.F INDEX=1:1:$L(XQADATA,U) D GET^ORQ12(+$P(XQADATA,U,INDEX),ORLIST,0,$P($G(^OR(100,+$P(XQADATA,U,INDEX),3)),U,7))
.S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST
.S ORWTS="",MULT=1,IFN="",FILTER=0
.D GET1^ORWORR1
.M ORBY=@REF
.K @REF
I $G(ORENVIR)'="GUI" D
.N IDX,ORACT,ORDEL
.S ORACT=$P(XQADATA,";",1),XQADATA=$P(XQADATA,";",2),ORDEL=0
.D MSG
.F IDX=1:1:$L(XQADATA,U) D EN1^ORCB($P(XQADATA,U,IDX),ORACT) ;DISPLAY EACH ORDER, ALLOWING USER TO EXECUTE SPECIFIED ACTION
.D DEL(.ORY,ORBXQAID) ;DELETE ENTIRE ALERT
Q
SMART ;
N ORY
I $G(ORENVIR)'="GUI" D
.W !,"You must use CPRS to process this alert!"
.D RENEW^ORB31(.ORY,XQAID)
Q
;
UPCOM ;process flagged order comment ;p539
K XQAKILL
N ORPT,ORBXQAID,ORY,ORDG,X,ORBLMDEL
S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
I $G(ORENVIR)'="GUI" D
.D MSG
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
.D DEL(.ORY,XQAID)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3FUP1 10419 printed Dec 13, 2024@02:27:22 Page 2
ORB3FUP1 ;SLC/CLA - ROUTINE TO SUPPORT NOTIFICATION FOLLOW UP ACTIONS ;Jan 12, 2021@11:20
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,64,74,105,139,243,350,377,539**;Dec 17, 1997;Build 41
+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 NEW ORENVIR
+3 SET ORENVIR="GUI"
+4 DO PROCESS
+5 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 NEW XQAID,XQADATA,XQAOPT,XQAROU,XQALERTD
+6 ;return follow-up action info
+7 IF $PIECE(ORXQAID,";",2)=DUZ
DO GETACT^XQALERT(ORXQAID)
+8 IF $PIECE(ORXQAID,";",2)'=DUZ
Begin DoDot:1
+9 DO ALERTDAT^XQALBUTL(ORXQAID)
+10 SET XQAID=ORXQAID
SET XQADATA=$GET(XQALERTD(2))
+11 SET XQAOPT=$GET(XQALERTD(1.02))
+12 SET XQAROU=$GET(XQALERTD(1.03))_U_$GET(XQALERTD(1.04))
+13 IF XQAROU=U
SET XQAROU=""
End DoDot:1
+14 ;call function rpc stored in xqarou with params from xqadata
+15 IF XQAROU'=""
DO @XQAROU
+16 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 ;S XQAKILL=$$XQAKILL^ORB3F1(6)
+10 ;I $G(XQAKILL)="" S XQAKILL=1
+11 ;p539
SET XQAKILL=0
+12 SET XQAID="OR,"_ORPT_",6"
DO DELETEA^XQALERT
KILL XQAID,XQAKILL
SET ORQUIT=1
End DoDot:1
+13 if ORQUIT
QUIT
+14 ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT IS UNFLAGGING=====
+15 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
if X=""
QUIT
Begin DoDot:1
+16 NEW Y
SET Y=""
FOR
SET Y=$ORDER(^TMP("ORR",$JOB,X,Y))
if 'Y
QUIT
Begin DoDot:2
+17 NEW ORDER
SET ORDER=$GET(^TMP("ORR",$JOB,X,Y))
+18 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
IF $$FLAGRULE^ORWORR1(+ORDER)=0
SET ORDOIT=0
End DoDot:2
End DoDot:1
+19 IF ORDOIT
Begin DoDot:1
+20 ;if no more flagged orders found for this user, delete alert only for this user:
+21 SET XQAKILL=1
+22 SET XQAID="OR,"_ORPT_",6"
DO DELETEA^XQALERT
KILL XQAID,XQAKILL
End DoDot:1
+23 ;========DELETE ALERT IF NO FLAGGED ORDERS LEFT RELATED TO THE USER THAT WAS THE ALERTED PROVIDER OR RECIPIENT OF THE CURRENT ORDER=====
+24 ;get the alerted provider/recipients ;p539
+25 IF $GET(ORIFN)
Begin DoDot:1
+26 NEW ORD,ORACT
SET ORD=+$GET(ORIFN)
SET ORACT=$PIECE($GET(ORIFN),";",2)
+27 NEW ORUSR,IEN,ORCPT
SET ORUSR=$PIECE($GET(^OR(100,ORD,8,ORACT,3)),U,9)
IF ORUSR
SET ORCPT(ORUSR)=""
+28 SET IEN=0
+29 FOR
SET IEN=$ORDER(^OR(100,ORD,8,ORACT,6,IEN))
if 'IEN
QUIT
SET ORUSR=+$GET(^(IEN,0))
IF ORUSR
SET ORCPT(ORUSR)=""
+30 IF $ORDER(ORCPT(""))'=""
SET ORUSR=0
FOR
SET ORUSR=$ORDER(ORCPT(ORUSR))
if 'ORUSR
QUIT
Begin DoDot:2
+31 SET ORDOIT=1
+32 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
if X=""
QUIT
Begin DoDot:3
+33 NEW Y
SET Y=""
FOR
SET Y=$ORDER(^TMP("ORR",$JOB,X,Y))
if 'Y
QUIT
Begin DoDot:4
+34 NEW ORDER
SET ORDER=$GET(^TMP("ORR",$JOB,X,Y))
+35 ; FOUND A FLAGGED ORDER THAT THE USER SHOULD GET
IF $$FLAGRULE^ORWORR1(+ORDER,ORUSR)=0
SET ORDOIT=0
End DoDot:4
End DoDot:3
+36 IF ORDOIT
Begin DoDot:3
+37 ;if no more flagged orders found for this user, delete alert only for this user:
+38 SET XQAKILL=1
SET XQAUSER=ORUSR
+39 SET XQAID="OR,"_ORPT_",6"
DO DELETEA^XQALERT
KILL XQAID,XQAKILL,XQAUSER
End DoDot:3
End DoDot:2
End DoDot:1
+40 KILL ^TMP("ORR",$JOB)
+41 QUIT
INDORDER ;process specific orders
+1 ;XQADATA=LIST MANAGER ACTION;CARET-DELIMITED LIST OF ORDER NUMBERS
+2 KILL XQAKILL
+3 NEW ORBXQAID,ORY
+4 SET ORBXQAID=XQAID
+5 IF $GET(ORENVIR)="GUI"
IF ($LENGTH($PIECE(XQADATA,";",2))>0)
Begin DoDot:1
+6 NEW INDEX,IFN,ORLIST,ORLST,TOT,I,ORWTS,PTEVTID,EVTNAME,TXTVW,MULT,REF,FILTER
+7 SET XQADATA=$PIECE(XQADATA,";",2)
SET ORLIST="INDORDER"
SET ORLST=0
SET EVTNAME=""
+8 FOR INDEX=1:1:$LENGTH(XQADATA,U)
DO GET^ORQ12(+$PIECE(XQADATA,U,INDEX),ORLIST,0,$PIECE($GET(^OR(100,+$PIECE(XQADATA,U,INDEX),3)),U,7))
+9 SET ^TMP("ORR",$JOB,ORLIST,"TOT")=ORLST
+10 SET ORWTS=""
SET MULT=1
SET IFN=""
SET FILTER=0
+11 DO GET1^ORWORR1
+12 MERGE ORBY=@REF
+13 KILL @REF
End DoDot:1
+14 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+15 NEW IDX,ORACT,ORDEL
+16 SET ORACT=$PIECE(XQADATA,";",1)
SET XQADATA=$PIECE(XQADATA,";",2)
SET ORDEL=0
+17 DO MSG
+18 ;DISPLAY EACH ORDER, ALLOWING USER TO EXECUTE SPECIFIED ACTION
FOR IDX=1:1:$LENGTH(XQADATA,U)
DO EN1^ORCB($PIECE(XQADATA,U,IDX),ORACT)
+19 ;DELETE ENTIRE ALERT
DO DEL(.ORY,ORBXQAID)
End DoDot:1
+20 QUIT
SMART ;
+1 NEW ORY
+2 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+3 WRITE !,"You must use CPRS to process this alert!"
+4 DO RENEW^ORB31(.ORY,XQAID)
End DoDot:1
+5 QUIT
+6 ;
UPCOM ;process flagged order comment ;p539
+1 KILL XQAKILL
+2 NEW ORPT,ORBXQAID,ORY,ORDG,X,ORBLMDEL
+3 SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+6 DO MSG
+7 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+8 DO EN^ORCB(ORPT,12,ORDG,.ORBLMDEL)
+9 DO DEL(.ORY,XQAID)
End DoDot:1
+10 QUIT
