ORB3FUP2 ; slc/CLA - Routine to support notification follow-up actions ;8/29/17
;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,64,88,112,243,434**;Dec 17, 1997;Build 35
RESULT ;STAT, orderer-flagged and site-flagged result follow-up
;determine what pkg to get report/results from then do RPTLAB or RPTRAD
N ORBFILL S ORBFILL=$P($P(XQADATA,"|",2),"@",2)
I ORBFILL["LR" D RPTLAB
I ORBFILL["RA" D RPTRAD
I ORBFILL["GMRC" D RPTCON
Q
CSPN ;co-sign progress note(s) follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
I $G(ORENVIR)="GUI" ;entry pt to get notes req co-sign then quit
;joel rtn to display notes req co-signature and allow co-sign on vt
;if lm fup action completed D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
USPN ;unsigned progress note(s) follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
I $G(ORENVIR)="GUI" ;entry pt to get unsigned notes then quit
;joel rtn to display notes req signature and allow signature on vt
;if lm fup action completed D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
EXMED ;expiring med(s) follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for EXPIRING orders in ORQ1 is '5'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"RX",5,"","")
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.S ORDG=$$DG^ORQOR1("RX") ;get Display Group ien
.D EN^ORCB(ORPT,5,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,5,"","","",0,0)
.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
..D DEL^ORB3FUP1(.ORY,ORBXQAID) ;if no more EXPIRING orders found, delete the alert
.K X,^TMP("ORR",$J)
Q
UVMED ;unverified med(s) follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL,ORADT
S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for UNVERIFIED (NURSE) orders in ORQ1 is '9'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"RX",9,"","")
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.S ORDG=$$DG^ORQOR1("RX") ;get Display Group ien
.D EN^ORCB(ORPT,9,ORDG,.ORBLMDEL)
.K ^TMP("ORR",$J)
.Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
.;
.;if user doesn't have ORELSE or ORMAS keys (can't verify),
.; delete user's alert after display:
.I '$D(^XUSEC("ORELSE",DUZ)),('$D(^XUSEC("OREMAS",DUZ))) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) Q
.;
.;get current admission date/time:
.N DFN S DFN=ORPT,VA200="" D INP^VADPT
.S ORADT=$P($G(VAIN(7)),U)
.S ORADT=$S('$L($G(ORADT)):$$FMADD^XLFDT($$NOW^XLFDT,"-30"),1:ORADT)
.;
.;if no more UNVERIFIED MED orders found (within current admission or
.; past 30 days), delete the alert:
.D EN^ORQ1(ORPT_";DPT(",ORDG,9,"",ORADT,$$NOW^XLFDT,0,0)
.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
..D DEL^ORB3FUP1(.ORY,ORBXQAID)
.K X,^TMP("ORR",$J),VA200,VAIN
Q
UNVER ;unverified order(s) follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL,ORADT
S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for UNVERIFIED (NURSE) orders in ORQ1 is '9'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",9,"","")
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,9,ORDG,.ORBLMDEL)
.K ^TMP("ORR",$J)
.Q:$G(ORBLMDEL)=1 ;if EN^ORCB rtns ORBLMDEL=1, alert was removed in LM
.;
.;if user doesn't have ORELSE or ORMAS keys (can't verify),
.; delete user's alert after display:
.I '$D(^XUSEC("ORELSE",DUZ)),('$D(^XUSEC("OREMAS",DUZ))) S XQAKILL=1 D DEL^ORB3FUP1(.ORY,ORBXQAID) Q
.;
.;get current admission date/time:
.N DFN S DFN=ORPT,VA200="" D INP^VADPT
.S ORADT=$P($G(VAIN(7)),U)
.S ORADT=$S('$L($G(ORADT)):$$FMADD^XLFDT($$NOW^XLFDT,"-30"),1:ORADT)
.;
.;if no more UNVERIFIED orders found (within current admission or past
.; 30 days), delete the alert:
.D EN^ORQ1(ORPT_";DPT(",ORDG,9,"",ORADT,$$NOW^XLFDT,0,0)
.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
..D DEL^ORB3FUP1(.ORY,ORBXQAID)
.K X,^TMP("ORR",$J),VA200,VAIN
Q
NEWCON ;new consult/request follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;I $G(ORENVIR)="GUI" D ;comment out until GUI follow-up
;.entry pt to get new consults then quit
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.D EN^GMRCALRT(XQADATA,XQAID) ;display new c/r and allow action
.;D DEL^ORB3FUP1(.ORY,ORBXQAID) ;Dwight does the delete in GMRC
Q
UPCON ;updated consult/request follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.D EN^GMRCALRT(XQADATA,XQAID) ;display updated c/r and allow action
Q
DCCON ;cancelled, held or DCed consult/request follow-up
K XQAKILL
N ORPT,NXQADATA
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;I $G(ORENVIR)="GUI" D ;comment out until GUI follow-up
;.entry pt to get new consults then quit
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.I XQADATA["GMRC" S NXQADATA=$P($P(XQADATA,"|",2),"@") D EN^GMRCEDIT(NXQADATA,XQAID)
.I +$G(NXQADATA)<1 D EN^GMRCEDIT(XQADATA,XQAID)
Q
RPTCON ;consult result follow-up
K XQAKILL
N NXQADATA
;N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
;S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
I $G(ORENVIR)="GUI" D DETAIL^ORQQCN(.ORBY,XQADATA)
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.D EN^GMRCALRT(XQADATA,XQAID)
.;I XQADATA["GMRC" S NXQADATA=$P($P(XQADATA,"|",2),"@") D EN^GMRCALRT(NXQADATA,XQAID)
.;I +$G(NXQADATA)<1 D EN^GMRCALRT(XQADATA,XQAID)
.;D DEL^ORB3FUP1(.ORY,ORBXQAID) ;Dwight does the delete in GMRC
Q
RPTAP ; AP lab result follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(ORBXQAID,";"),",",2) ;get pt dfn from xqaid
N ORACCNUM,ORDTSTKN S ORACCNUM=$P(XQADATA,U,2),ORDTSTKN=$P(XQADATA,U,3)
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.D EN1^ORCXPND(ORPT,ORACCNUM_"-"_ORDTSTKN,"LABS")
.D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
RPTLAB ;lab result follow-up
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
N ORDER,ORLAB S ORDER=$P(XQADATA,"@")
I $G(ORENVIR)="GUI" D DETAIL^ORQQLR(.ORBY,ORPT,ORDER)
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.;S ORLAB=$$OETOLAB^ORQQLR1(ORDER)
.;Q:'$L($G(ORLAB))
.;D EN1^ORCXPND(ORPT,ORLAB,"LABS") ;api used lab # pre-6/97
.D EN1^ORCXPND(ORPT,ORDER,"LABS")
.D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
RPTRAD ;radiology result follow-up for HL7-triggered notifications
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
N INVDT,CASE S INVDT="",CASE=""
;XQADATA is different for HL7-triggered vs. radiology pkg triggered
S INVDT=$P(XQADATA,"~",2),CASE=$P($P(XQADATA,"~",3),"@")
I $G(ORENVIR)="GUI" D DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.D EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
.D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
RPTRAD2 ;radiology result follow-up for radiology pkg-triggered notifications
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
N INVDT,CASE S INVDT="",CASE=""
;XQADATA is different for HL7-triggered vs. radiology pkg triggered
S INVDT=$P(XQADATA,"~",1),CASE=$P(XQADATA,"~",2)
I $G(ORENVIR)="GUI" D DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.D EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
.D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
EXOI ;expiring flagged orderable items follow-up
K XQAKILL
N ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
;the FLG code for EXPIRING orders in ORQ1 is '5'
I $G(ORENVIR)="GUI" D LIST^ORQOR1(.ORBY,ORPT,"ALL",5,"","")
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.S ORDG=$$DG^ORQOR1("ALL") ;get Display Group ien
.D EN^ORCB(ORPT,5,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,5,"","","",0,0)
.S X="",X=$O(^TMP("ORR",$J,X)) Q:X="" I +$G(^TMP("ORR",$J,X,"TOT"))<1 D
..D DEL^ORB3FUP1(.ORY,ORBXQAID) ;if no more EXPIRING orders found, delete the alert
.K X,^TMP("ORR",$J)
Q
INTCON ;consult interpretation follow-up
K XQAKILL
N NXQADATA
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.R !!?5,"This alert must be processed in the CPRS GUI.",X:10
.K X
Q
CHGRAD ;radiology follow-up for #67 Imaging Request Changed
K XQAKILL
N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
I $G(ORENVIR)'="GUI" D
.D MSG^ORB3FUP1
.I $L($T(EN1^RAO7PC4))>0 D
..D EN1^RAO7PC4 ;display before and after change(s)
..D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
INFODEL ;follow-up action to delete "informational" alerts
K XQAKILL
N ORY,ORBXQAID
S ORBXQAID=XQAID
D MSG^ORB3FUP1
D DEL^ORB3FUP1(.ORY,ORBXQAID)
Q
RTC ;followup action for RTC order alert
N ORY
W !,"You must use CPRS to process this alert!"
D RENEW^ORB31(.ORY,XQAID)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3FUP2 9382 printed Nov 22, 2024@17:37:22 Page 2
ORB3FUP2 ; slc/CLA - Routine to support notification follow-up actions ;8/29/17
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,64,88,112,243,434**;Dec 17, 1997;Build 35
RESULT ;STAT, orderer-flagged and site-flagged result follow-up
+1 ;determine what pkg to get report/results from then do RPTLAB or RPTRAD
+2 NEW ORBFILL
SET ORBFILL=$PIECE($PIECE(XQADATA,"|",2),"@",2)
+3 IF ORBFILL["LR"
DO RPTLAB
+4 IF ORBFILL["RA"
DO RPTRAD
+5 IF ORBFILL["GMRC"
DO RPTCON
+6 QUIT
CSPN ;co-sign progress note(s) 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 ;entry pt to get notes req co-sign then quit
IF $GET(ORENVIR)="GUI"
+5 ;joel rtn to display notes req co-signature and allow co-sign on vt
+6 ;if lm fup action completed D DEL^ORB3FUP1(.ORY,ORBXQAID)
+7 QUIT
USPN ;unsigned progress note(s) 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 ;entry pt to get unsigned notes then quit
IF $GET(ORENVIR)="GUI"
+5 ;joel rtn to display notes req signature and allow signature on vt
+6 ;if lm fup action completed D DEL^ORB3FUP1(.ORY,ORBXQAID)
+7 QUIT
EXMED ;expiring med(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
+3 SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for EXPIRING orders in ORQ1 is '5'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"RX",5,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG^ORB3FUP1
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("RX")
+10 DO EN^ORCB(ORPT,5,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,5,"","","",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 EXPIRING orders found, delete the alert
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:2
+16 KILL X,^TMP("ORR",$JOB)
End DoDot:1
+17 QUIT
UVMED ;unverified med(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL,ORADT
+3 SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for UNVERIFIED (NURSE) orders in ORQ1 is '9'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"RX",9,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG^ORB3FUP1
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("RX")
+10 DO EN^ORCB(ORPT,9,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 ;
+14 ;if user doesn't have ORELSE or ORMAS keys (can't verify),
+15 ; delete user's alert after display:
+16 IF '$DATA(^XUSEC("ORELSE",DUZ))
IF ('$DATA(^XUSEC("OREMAS",DUZ)))
SET XQAKILL=1
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
QUIT
+17 ;
+18 ;get current admission date/time:
+19 NEW DFN
SET DFN=ORPT
SET VA200=""
DO INP^VADPT
+20 SET ORADT=$PIECE($GET(VAIN(7)),U)
+21 SET ORADT=$SELECT('$LENGTH($GET(ORADT)):$$FMADD^XLFDT($$NOW^XLFDT,"-30"),1:ORADT)
+22 ;
+23 ;if no more UNVERIFIED MED orders found (within current admission or
+24 ; past 30 days), delete the alert:
+25 DO EN^ORQ1(ORPT_";DPT(",ORDG,9,"",ORADT,$$NOW^XLFDT,0,0)
+26 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
if X=""
QUIT
IF +$GET(^TMP("ORR",$JOB,X,"TOT"))<1
Begin DoDot:2
+27 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:2
+28 KILL X,^TMP("ORR",$JOB),VA200,VAIN
End DoDot:1
+29 QUIT
UNVER ;unverified order(s) follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL,ORADT
+3 SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for UNVERIFIED (NURSE) orders in ORQ1 is '9'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"ALL",9,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG^ORB3FUP1
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+10 DO EN^ORCB(ORPT,9,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 ;
+14 ;if user doesn't have ORELSE or ORMAS keys (can't verify),
+15 ; delete user's alert after display:
+16 IF '$DATA(^XUSEC("ORELSE",DUZ))
IF ('$DATA(^XUSEC("OREMAS",DUZ)))
SET XQAKILL=1
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
QUIT
+17 ;
+18 ;get current admission date/time:
+19 NEW DFN
SET DFN=ORPT
SET VA200=""
DO INP^VADPT
+20 SET ORADT=$PIECE($GET(VAIN(7)),U)
+21 SET ORADT=$SELECT('$LENGTH($GET(ORADT)):$$FMADD^XLFDT($$NOW^XLFDT,"-30"),1:ORADT)
+22 ;
+23 ;if no more UNVERIFIED orders found (within current admission or past
+24 ; 30 days), delete the alert:
+25 DO EN^ORQ1(ORPT_";DPT(",ORDG,9,"",ORADT,$$NOW^XLFDT,0,0)
+26 SET X=""
SET X=$ORDER(^TMP("ORR",$JOB,X))
if X=""
QUIT
IF +$GET(^TMP("ORR",$JOB,X,"TOT"))<1
Begin DoDot:2
+27 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:2
+28 KILL X,^TMP("ORR",$JOB),VA200,VAIN
End DoDot:1
+29 QUIT
NEWCON ;new consult/request 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 ;I $G(ORENVIR)="GUI" D ;comment out until GUI follow-up
+5 ;.entry pt to get new consults then quit
+6 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+7 DO MSG^ORB3FUP1
+8 ;display new c/r and allow action
DO EN^GMRCALRT(XQADATA,XQAID)
+9 ;D DEL^ORB3FUP1(.ORY,ORBXQAID) ;Dwight does the delete in GMRC
End DoDot:1
+10 QUIT
UPCON ;updated consult/request 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 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+5 DO MSG^ORB3FUP1
+6 ;display updated c/r and allow action
DO EN^GMRCALRT(XQADATA,XQAID)
End DoDot:1
+7 QUIT
DCCON ;cancelled, held or DCed consult/request follow-up
+1 KILL XQAKILL
+2 NEW ORPT,NXQADATA
+3 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+4 ;I $G(ORENVIR)="GUI" D ;comment out until GUI follow-up
+5 ;.entry pt to get new consults then quit
+6 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+7 DO MSG^ORB3FUP1
+8 IF XQADATA["GMRC"
SET NXQADATA=$PIECE($PIECE(XQADATA,"|",2),"@")
DO EN^GMRCEDIT(NXQADATA,XQAID)
+9 IF +$GET(NXQADATA)<1
DO EN^GMRCEDIT(XQADATA,XQAID)
End DoDot:1
+10 QUIT
RPTCON ;consult result follow-up
+1 KILL XQAKILL
+2 NEW NXQADATA
+3 ;N ORPT,ORBXQAID,ORY S ORBXQAID=XQAID
+4 ;S ORPT=$P($P(XQAID,";"),",",2) ;get pt dfn from xqaid
+5 IF $GET(ORENVIR)="GUI"
DO DETAIL^ORQQCN(.ORBY,XQADATA)
+6 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+7 DO MSG^ORB3FUP1
+8 DO EN^GMRCALRT(XQADATA,XQAID)
+9 ;I XQADATA["GMRC" S NXQADATA=$P($P(XQADATA,"|",2),"@") D EN^GMRCALRT(NXQADATA,XQAID)
+10 ;I +$G(NXQADATA)<1 D EN^GMRCALRT(XQADATA,XQAID)
+11 ;D DEL^ORB3FUP1(.ORY,ORBXQAID) ;Dwight does the delete in GMRC
End DoDot:1
+12 QUIT
RPTAP ; AP lab result follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORBXQAID,ORY
SET ORBXQAID=XQAID
+3 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(ORBXQAID,";"),",",2)
+4 NEW ORACCNUM,ORDTSTKN
SET ORACCNUM=$PIECE(XQADATA,U,2)
SET ORDTSTKN=$PIECE(XQADATA,U,3)
+5 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+6 DO MSG^ORB3FUP1
+7 DO EN1^ORCXPND(ORPT,ORACCNUM_"-"_ORDTSTKN,"LABS")
+8 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:1
+9 QUIT
RPTLAB ;lab result 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 ORDER,ORLAB
SET ORDER=$PIECE(XQADATA,"@")
+5 IF $GET(ORENVIR)="GUI"
DO DETAIL^ORQQLR(.ORBY,ORPT,ORDER)
+6 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+7 DO MSG^ORB3FUP1
+8 ;S ORLAB=$$OETOLAB^ORQQLR1(ORDER)
+9 ;Q:'$L($G(ORLAB))
+10 ;D EN1^ORCXPND(ORPT,ORLAB,"LABS") ;api used lab # pre-6/97
+11 DO EN1^ORCXPND(ORPT,ORDER,"LABS")
+12 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:1
+13 QUIT
RPTRAD ;radiology result follow-up for HL7-triggered notifications
+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 INVDT,CASE
SET INVDT=""
SET CASE=""
+5 ;XQADATA is different for HL7-triggered vs. radiology pkg triggered
+6 SET INVDT=$PIECE(XQADATA,"~",2)
SET CASE=$PIECE($PIECE(XQADATA,"~",3),"@")
+7 IF $GET(ORENVIR)="GUI"
DO DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
+8 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+9 DO MSG^ORB3FUP1
+10 DO EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
+11 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:1
+12 QUIT
RPTRAD2 ;radiology result follow-up for radiology pkg-triggered notifications
+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 INVDT,CASE
SET INVDT=""
SET CASE=""
+5 ;XQADATA is different for HL7-triggered vs. radiology pkg triggered
+6 SET INVDT=$PIECE(XQADATA,"~",1)
SET CASE=$PIECE(XQADATA,"~",2)
+7 IF $GET(ORENVIR)="GUI"
DO DETAIL^ORQQRA(.ORBY,ORPT,INVDT,CASE)
+8 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+9 DO MSG^ORB3FUP1
+10 DO EN1^ORCXPND(ORPT,INVDT_"-"_CASE,"XRAYS")
+11 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:1
+12 QUIT
EXOI ;expiring flagged orderable items follow-up
+1 KILL XQAKILL
+2 NEW ORPT,ORDG,ORBXQAID,ORY,ORBLMDEL
+3 SET ORBXQAID=XQAID
+4 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+5 ;the FLG code for EXPIRING orders in ORQ1 is '5'
+6 IF $GET(ORENVIR)="GUI"
DO LIST^ORQOR1(.ORBY,ORPT,"ALL",5,"","")
+7 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+8 DO MSG^ORB3FUP1
+9 ;get Display Group ien
SET ORDG=$$DG^ORQOR1("ALL")
+10 DO EN^ORCB(ORPT,5,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,5,"","","",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 EXPIRING orders found, delete the alert
DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:2
+16 KILL X,^TMP("ORR",$JOB)
End DoDot:1
+17 QUIT
INTCON ;consult interpretation follow-up
+1 KILL XQAKILL
+2 NEW NXQADATA
+3 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+4 DO MSG^ORB3FUP1
+5 READ !!?5,"This alert must be processed in the CPRS GUI.",X:10
+6 KILL X
End DoDot:1
+7 QUIT
CHGRAD ;radiology follow-up for #67 Imaging Request Changed
+1 KILL XQAKILL
+2 NEW ORPT,ORBXQAID,ORY
SET ORBXQAID=XQAID
+3 ;get pt dfn from xqaid
SET ORPT=$PIECE($PIECE(XQAID,";"),",",2)
+4 IF $GET(ORENVIR)'="GUI"
Begin DoDot:1
+5 DO MSG^ORB3FUP1
+6 IF $LENGTH($TEXT(EN1^RAO7PC4))>0
Begin DoDot:2
+7 ;display before and after change(s)
DO EN1^RAO7PC4
+8 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
End DoDot:2
End DoDot:1
+9 QUIT
INFODEL ;follow-up action to delete "informational" alerts
+1 KILL XQAKILL
+2 NEW ORY,ORBXQAID
+3 SET ORBXQAID=XQAID
+4 DO MSG^ORB3FUP1
+5 DO DEL^ORB3FUP1(.ORY,ORBXQAID)
+6 QUIT
RTC ;followup action for RTC order alert
+1 NEW ORY
+2 WRITE !,"You must use CPRS to process this alert!"
+3 DO RENEW^ORB31(.ORY,XQAID)
+4 QUIT
+5 ;
