GMRCIBKG ;SLC/JFR - IFC BACKGROUND ERROR PROCESSOR; Jun 18, 2024@15:09:24
;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,35,58,92,154,189**;DEC 27, 1997;Build 54
;;Per VHA Directive 6402, this routine should not be modified.
;
; This routine invokes IA# 3335
;
EN ;process file 123.6 and take action
;Start background process
I $D(ZTQUEUED) S ZTREQ="@"
;
; OK to run?
I '$$GONOGO Q
;
; set start param to NOW and run
D EN^XPAR("SYS","GMRC IFC BACKGROUND START",1,$$NOW^XLFDT)
;
N GMRCLOG,GMRCTIM,GMRCLOG0
S GMRCLOG=0
S GMRCTIM=$$FMADD^XLFDT($$NOW^XLFDT,,-1)
F S GMRCLOG=$O(^GMR(123.6,GMRCLOG)) Q:'GMRCLOG D
. S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0))
. ;
. ; v-- resend if couldn't update file immediately
. I $P(GMRCLOG0,U,6),$P(GMRCLOG0,U,8)=901 D Q
.. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
. ;
. ; wait at least 10 minutes for 205 errors (Waiting for treating facility to update) - p189 wtc 6/18/2024
. ;
. I $P(GMRCLOG0,U,6),$P(GMRCLOG0,U,8)=205 D Q ;
.. ;
.. I $P(GMRCLOG0,U,1)<$$FMADD^XLFDT($$NOW^XLFDT,,-10/60) D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
. ;
. ; wait a day for 203 errors (Patient not in Cerner) - p189 wtc 5/4/22
. ;
. I $P(GMRCLOG0,U,6),$P(GMRCLOG0,U,8)=203 D Q ;
.. ;
.. I $P(GMRCLOG0,U,1)<$$FMADD^XLFDT($$NOW^XLFDT,-1) D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
. ;
. ; v-- wait at least 1 hour on all other errors
. I $P(GMRCLOG0,U)>GMRCTIM Q
. ; v-- if incomplete activity is now the earliest, resend it
. I $P(GMRCLOG0,U,6),$P(GMRCLOG0,U,8)=902 D Q
.. Q:$O(^GMR(123.6,"AC",$P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)),-1)
.. D DELALRT(GMRCLOG)
.. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
. ; v-- delete complete entries after # in GMRC RETAIN IFC ACTIVITY DAYS
. I '$P(GMRCLOG0,U,6) D Q
.. N DIK,DA,GMRCRETN
.. S GMRCRETN=$$GET^XPAR("SYS","GMRC RETAIN IFC ACTIVITY DAYS",1)
.. I 'GMRCRETN S GMRCRETN=7
.. I $P(GMRCLOG0,U)>$$FMADD^XLFDT(GMRCTIM,(0-GMRCRETN)) Q ;don't delete
.. S DIK="^GMR(123.6,",DA=GMRCLOG
.. D ^DIK ;remove old completed entries
. ;
. ; v-- resend unknown patient errors after 3 hours
. I $P(GMRCLOG0,U,8)=201,GMRCLOG0<$$FMADD^XLFDT($$NOW^XLFDT,,-1) D Q
.. N GMRCSND,GMRCPAR,DOW
.. S GMRCPAR=$$GET^XPAR("SYS","GMRC IFC SKIP WEEKEND RE-TRANS",1)
.. S DOW=$$DOW^XLFDT(DT,1)
.. S GMRCSND=$S('GMRCPAR:1,(+DOW&(DOW<6)):1,1:0)
.. I GMRCSND D ;re-send based on parameter and day of week
... D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
... D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5))
.. I '($P(GMRCLOG0,U,7)#8),GMRCSND D
... ;alert CAC's about errors every 24 hrs.
... D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
... D SNDALRT^GMRCIERR(GMRCLOG,"C") ; alert CAC's to patient errors
... D ; send mail to remote CAC group
.... N GMRCLNK,GMRCIQT,HL,HLECH,HLFS,HLQ,PID,DOM,STA,GMRCLNK,OBR
.... D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
.... D I $D(GMRCIQT) Q ;build PID seg if nat'l ICN
..... N GMRCDFN S GMRCDFN=$P(^GMR(123,+$P(GMRCLOG0,U,4),0),U,2)
..... I '$G(GMRCDFN) S GMRCIQT=1 Q
..... I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
..... I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
..... S PID=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
..... S PID=$P(PID,"|",2,999)
.... D LINK^HLUTIL3($P(GMRCLOG0,U,2),.GMRCLNK)
.... ;BL GMRC*3.0*154; Need to check if site has been converted to Cerner and if so route properly
.... ; S:$$CNVTD^GMRCIEVT($P(GMRCLOG0,U,2)) GMRCLNK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
.... ; S:$$CNVTD^GMRCIEVT($P(GMRCLOG0,U,4)) GMRCLNK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
.... N CNVDT
.... S CNVDT=$$CNVTD^GMRCIEVT($P(GMRCLOG0,U,4))
.... I CNVDT D
..... S GMRCLNK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
..... S GMRCLNK=$$FIND1^DIC(870,,"EX",GMRCLNK(1))
.... I 'CNVDT S GMRCLNK=$O(GMRCLNK(0))
.... I 'GMRCLNK Q ;no link set up
.... S DOM=$$GET1^DIQ(870,+GMRCLNK,.03)
.... S STA=$$STA^XUAF4($P(GMRCLOG0,U,2))
.... S OBR=$E($$OBR^GMRCISG1(+$P(GMRCLOG0,U,4),+$P(GMRCLOG0,U,5)),5,999)
.... ;N DIV S DIV=STA,STA=+$$SITE^VASITE
.... N DIV S DIV=STA,STA=+$P($$SITE^VASITE,U,3) ;Changed to return correct station number
.... D PTERRMSG^GMRCIERR(PID,STA,DOM,OBR)
. ;
. ; v-- resend local ICN errors after 3 hours
. I $P(GMRCLOG0,U,8)=202,GMRCLOG0<$$FMADD^XLFDT($$NOW^XLFDT,,-3) D Q
.. ;re-send based on parameter and day of week
.. N GMRCSND,GMRCPAR,DOW
.. S GMRCPAR=$$GET^XPAR("SYS","GMRC IFC SKIP WEEKEND RE-TRANS",1)
.. S DOW=$$DOW^XLFDT(DT,1)
.. S GMRCSND=$S('GMRCPAR:1,(+DOW&(DOW<6)):1,1:0)
.. I 'GMRCSND Q ;don't re-send activity
.. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
.. I '($P(GMRCLOG0,U,7)#8) D ;alert CAC's about errors every 24 hrs
... D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
... D SNDALRT^GMRCIERR(GMRCLOG,"C") ; alert CAC's to patient errors
. ; v-- re-process implementation errors
. ;I $P(GMRCLOG0,U,8)>300,$P(GMRCLOG0,U,8)<702 D Q
. I $P(GMRCLOG0,U,8)>300,$P(GMRCLOG0,U,8)<704 D Q
.. D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
.. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
. ; v-- if incomplete and no error, alert tech group
. I '$P(GMRCLOG0,U,8)!($P(GMRCLOG0,U,8)>902) D Q
.. D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
.. D SNDALRT^GMRCIERR(GMRCLOG,"T")
. Q
;
; v-- set finish param
D EN^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1,$$NOW^XLFDT)
; v-- start it again one hour after completing
D REQUEUE
Q
;
REQUEUE ;task job to start up again one hour after completing
N ZTRTN,ZTSK,ZTIO,ZTDESC,ZTDTH
S ZTDESC="IF Consults background error processor"
S ZTIO=""
S ZTRTN="EN^GMRCIBKG"
S ZTDTH=$$FMTH^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,,1))
D ^%ZTLOAD
Q
DELALRT(MSGLOG) ;delete obsolete alerts for an entry
; Input:
; MSGLOG = ien from file 123.6
;
N XQAID,XQAKILL
S XQAID="GMRCIFC,trans error,"_MSGLOG,XQAKILL=0
D DELETEA^XQALERT
Q
;
OVERDUE ; write message for alert to tell IRM job is overdue
W @IOF
W !,"The Inter-facility Consults background job is overdue."
W !,"This is likely due to an error while the job runs. It is suggested"
W !,"that you check the systems for errors. If the errors are resolved"
W !,"the background job will catch up and run normally. There is a "
W !,"remote possibility that the GMRC IFC BACKGROUND... parameters have"
W !,"been edited and are out of synch."
S XQAKILL=0
Q
;
GONOGO() ; determine if background job should run or not
;Output:
; 1 = go ahead and run
; 0 = don't run for some reason
N GMRCQT
S GMRCQT=1
D
. N GMRCBST,GMRCNOW,GMRCBFI
. S GMRCBST=$$GET^XPAR("SYS","GMRC IFC BACKGROUND START",1)
. I 'GMRCBST Q ; has never run or needs to
. S GMRCNOW=$$NOW^XLFDT
. I GMRCBST>GMRCNOW S GMRCQT=0 Q ;set to future date/time - don't run
. S GMRCBFI=$$GET^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1)
. I $$FMDIFF^XLFDT(GMRCNOW,GMRCBFI,2)<3600,GMRCBFI>GMRCBST S GMRCQT=0 Q
. ; ^--ran < 1 hr ago
. I $$FMDIFF^XLFDT(GMRCBST,GMRCBFI,2)>4500 D Q
.. ; >1.5 hrs and job not finishing for some reason, alert techies
.. N XQA,XQAMSG,XQAROU,XQAID,XQAKILL
.. S XQAID="GMRC IFC BKG",XQAKILL=0 D DELETEA^XQALERT
.. S XQA("G.IFC TECH ERRORS")=""
.. S XQAMSG="IFC Background job overdue."
.. S XQAID="GMRC IFC BKG"
.. S XQAROU="OVERDUE^GMRCIBKG"
.. D SETUP^XQALERT
.. Q
. Q
Q GMRCQT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCIBKG 7669 printed Dec 13, 2024@01:45:57 Page 2
GMRCIBKG ;SLC/JFR - IFC BACKGROUND ERROR PROCESSOR; Jun 18, 2024@15:09:24
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,35,58,92,154,189**;DEC 27, 1997;Build 54
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine invokes IA# 3335
+5 ;
EN ;process file 123.6 and take action
+1 ;Start background process
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 ;
+4 ; OK to run?
+5 IF '$$GONOGO
QUIT
+6 ;
+7 ; set start param to NOW and run
+8 DO EN^XPAR("SYS","GMRC IFC BACKGROUND START",1,$$NOW^XLFDT)
+9 ;
+10 NEW GMRCLOG,GMRCTIM,GMRCLOG0
+11 SET GMRCLOG=0
+12 SET GMRCTIM=$$FMADD^XLFDT($$NOW^XLFDT,,-1)
+13 FOR
SET GMRCLOG=$ORDER(^GMR(123.6,GMRCLOG))
if 'GMRCLOG
QUIT
Begin DoDot:1
+14 SET GMRCLOG0=$GET(^GMR(123.6,GMRCLOG,0))
+15 ;
+16 ; v-- resend if couldn't update file immediately
+17 IF $PIECE(GMRCLOG0,U,6)
IF $PIECE(GMRCLOG0,U,8)=901
Begin DoDot:2
+18 ;re-send activity
DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
End DoDot:2
QUIT
+19 ;
+20 ; wait at least 10 minutes for 205 errors (Waiting for treating facility to update) - p189 wtc 6/18/2024
+21 ;
+22 ;
IF $PIECE(GMRCLOG0,U,6)
IF $PIECE(GMRCLOG0,U,8)=205
Begin DoDot:2
+23 ;
+24 ;re-send activity
IF $PIECE(GMRCLOG0,U,1)<$$FMADD^XLFDT($$NOW^XLFDT,,-10/60)
DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
End DoDot:2
QUIT
+25 ;
+26 ; wait a day for 203 errors (Patient not in Cerner) - p189 wtc 5/4/22
+27 ;
+28 ;
IF $PIECE(GMRCLOG0,U,6)
IF $PIECE(GMRCLOG0,U,8)=203
Begin DoDot:2
+29 ;
+30 ;re-send activity
IF $PIECE(GMRCLOG0,U,1)<$$FMADD^XLFDT($$NOW^XLFDT,-1)
DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
End DoDot:2
QUIT
+31 ;
+32 ; v-- wait at least 1 hour on all other errors
+33 IF $PIECE(GMRCLOG0,U)>GMRCTIM
QUIT
+34 ; v-- if incomplete activity is now the earliest, resend it
+35 IF $PIECE(GMRCLOG0,U,6)
IF $PIECE(GMRCLOG0,U,8)=902
Begin DoDot:2
+36 if $ORDER(^GMR(123.6,"AC",$PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5)),-1)
QUIT
+37 DO DELALRT(GMRCLOG)
+38 ;re-send activity
DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
End DoDot:2
QUIT
+39 ; v-- delete complete entries after # in GMRC RETAIN IFC ACTIVITY DAYS
+40 IF '$PIECE(GMRCLOG0,U,6)
Begin DoDot:2
+41 NEW DIK,DA,GMRCRETN
+42 SET GMRCRETN=$$GET^XPAR("SYS","GMRC RETAIN IFC ACTIVITY DAYS",1)
+43 IF 'GMRCRETN
SET GMRCRETN=7
+44 ;don't delete
IF $PIECE(GMRCLOG0,U)>$$FMADD^XLFDT(GMRCTIM,(0-GMRCRETN))
QUIT
+45 SET DIK="^GMR(123.6,"
SET DA=GMRCLOG
+46 ;remove old completed entries
DO ^DIK
End DoDot:2
QUIT
+47 ;
+48 ; v-- resend unknown patient errors after 3 hours
+49 IF $PIECE(GMRCLOG0,U,8)=201
IF GMRCLOG0<$$FMADD^XLFDT($$NOW^XLFDT,,-1)
Begin DoDot:2
+50 NEW GMRCSND,GMRCPAR,DOW
+51 SET GMRCPAR=$$GET^XPAR("SYS","GMRC IFC SKIP WEEKEND RE-TRANS",1)
+52 SET DOW=$$DOW^XLFDT(DT,1)
+53 SET GMRCSND=$SELECT('GMRCPAR:1,(+DOW&(DOW<6)):1,1:0)
+54 ;re-send based on parameter and day of week
IF GMRCSND
Begin DoDot:3
+55 ;delete previous alerts on same transaction
DO DELALRT(GMRCLOG)
+56 DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
End DoDot:3
+57 IF '($PIECE(GMRCLOG0,U,7)#8)
IF GMRCSND
Begin DoDot:3
+58 ;alert CAC's about errors every 24 hrs.
+59 ;delete previous alerts on same transaction
DO DELALRT(GMRCLOG)
+60 ; alert CAC's to patient errors
DO SNDALRT^GMRCIERR(GMRCLOG,"C")
+61 ; send mail to remote CAC group
Begin DoDot:4
+62 NEW GMRCLNK,GMRCIQT,HL,HLECH,HLFS,HLQ,PID,DOM,STA,GMRCLNK,OBR
+63 DO INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
+64 ;build PID seg if nat'l ICN
Begin DoDot:5
+65 NEW GMRCDFN
SET GMRCDFN=$PIECE(^GMR(123,+$PIECE(GMRCLOG0,U,4),0),U,2)
+66 IF '$GET(GMRCDFN)
SET GMRCIQT=1
QUIT
+67 IF $$GETICN^MPIF001(GMRCDFN)<1
SET GMRCIQT=1
QUIT
+68 IF $$IFLOCAL^MPIF001(GMRCDFN)
SET GMRCIQT=1
QUIT
+69 SET PID=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
+70 SET PID=$PIECE(PID,"|",2,999)
End DoDot:5
IF $DATA(GMRCIQT)
QUIT
+71 DO LINK^HLUTIL3($PIECE(GMRCLOG0,U,2),.GMRCLNK)
+72 ;BL GMRC*3.0*154; Need to check if site has been converted to Cerner and if so route properly
+73 ; S:$$CNVTD^GMRCIEVT($P(GMRCLOG0,U,2)) GMRCLNK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
+74 ; S:$$CNVTD^GMRCIEVT($P(GMRCLOG0,U,4)) GMRCLNK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
+75 NEW CNVDT
+76 SET CNVDT=$$CNVTD^GMRCIEVT($PIECE(GMRCLOG0,U,4))
+77 IF CNVDT
Begin DoDot:5
+78 SET GMRCLNK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
+79 SET GMRCLNK=$$FIND1^DIC(870,,"EX",GMRCLNK(1))
End DoDot:5
+80 IF 'CNVDT
SET GMRCLNK=$ORDER(GMRCLNK(0))
+81 ;no link set up
IF 'GMRCLNK
QUIT
+82 SET DOM=$$GET1^DIQ(870,+GMRCLNK,.03)
+83 SET STA=$$STA^XUAF4($PIECE(GMRCLOG0,U,2))
+84 SET OBR=$EXTRACT($$OBR^GMRCISG1(+$PIECE(GMRCLOG0,U,4),+$PIECE(GMRCLOG0,U,5)),5,999)
+85 ;N DIV S DIV=STA,STA=+$$SITE^VASITE
+86 ;Changed to return correct station number
NEW DIV
SET DIV=STA
SET STA=+$PIECE($$SITE^VASITE,U,3)
+87 DO PTERRMSG^GMRCIERR(PID,STA,DOM,OBR)
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+88 ;
+89 ; v-- resend local ICN errors after 3 hours
+90 IF $PIECE(GMRCLOG0,U,8)=202
IF GMRCLOG0<$$FMADD^XLFDT($$NOW^XLFDT,,-3)
Begin DoDot:2
+91 ;re-send based on parameter and day of week
+92 NEW GMRCSND,GMRCPAR,DOW
+93 SET GMRCPAR=$$GET^XPAR("SYS","GMRC IFC SKIP WEEKEND RE-TRANS",1)
+94 SET DOW=$$DOW^XLFDT(DT,1)
+95 SET GMRCSND=$SELECT('GMRCPAR:1,(+DOW&(DOW<6)):1,1:0)
+96 ;don't re-send activity
IF 'GMRCSND
QUIT
+97 ;re-send activity
DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
+98 ;alert CAC's about errors every 24 hrs
IF '($PIECE(GMRCLOG0,U,7)#8)
Begin DoDot:3
+99 ;delete previous alerts on same transaction
DO DELALRT(GMRCLOG)
+100 ; alert CAC's to patient errors
DO SNDALRT^GMRCIERR(GMRCLOG,"C")
End DoDot:3
End DoDot:2
QUIT
+101 ; v-- re-process implementation errors
+102 ;I $P(GMRCLOG0,U,8)>300,$P(GMRCLOG0,U,8)<702 D Q
+103 IF $PIECE(GMRCLOG0,U,8)>300
IF $PIECE(GMRCLOG0,U,8)<704
Begin DoDot:2
+104 ;delete previous alerts on same transaction
DO DELALRT(GMRCLOG)
+105 ;re-send activity
DO TRIGR^GMRCIEVT($PIECE(GMRCLOG0,U,4),$PIECE(GMRCLOG0,U,5))
End DoDot:2
QUIT
+106 ; v-- if incomplete and no error, alert tech group
+107 IF '$PIECE(GMRCLOG0,U,8)!($PIECE(GMRCLOG0,U,8)>902)
Begin DoDot:2
+108 ;delete previous alerts on same transaction
DO DELALRT(GMRCLOG)
+109 DO SNDALRT^GMRCIERR(GMRCLOG,"T")
End DoDot:2
QUIT
+110 QUIT
End DoDot:1
+111 ;
+112 ; v-- set finish param
+113 DO EN^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1,$$NOW^XLFDT)
+114 ; v-- start it again one hour after completing
+115 DO REQUEUE
+116 QUIT
+117 ;
REQUEUE ;task job to start up again one hour after completing
+1 NEW ZTRTN,ZTSK,ZTIO,ZTDESC,ZTDTH
+2 SET ZTDESC="IF Consults background error processor"
+3 SET ZTIO=""
+4 SET ZTRTN="EN^GMRCIBKG"
+5 SET ZTDTH=$$FMTH^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,,1))
+6 DO ^%ZTLOAD
+7 QUIT
DELALRT(MSGLOG) ;delete obsolete alerts for an entry
+1 ; Input:
+2 ; MSGLOG = ien from file 123.6
+3 ;
+4 NEW XQAID,XQAKILL
+5 SET XQAID="GMRCIFC,trans error,"_MSGLOG
SET XQAKILL=0
+6 DO DELETEA^XQALERT
+7 QUIT
+8 ;
OVERDUE ; write message for alert to tell IRM job is overdue
+1 WRITE @IOF
+2 WRITE !,"The Inter-facility Consults background job is overdue."
+3 WRITE !,"This is likely due to an error while the job runs. It is suggested"
+4 WRITE !,"that you check the systems for errors. If the errors are resolved"
+5 WRITE !,"the background job will catch up and run normally. There is a "
+6 WRITE !,"remote possibility that the GMRC IFC BACKGROUND... parameters have"
+7 WRITE !,"been edited and are out of synch."
+8 SET XQAKILL=0
+9 QUIT
+10 ;
GONOGO() ; determine if background job should run or not
+1 ;Output:
+2 ; 1 = go ahead and run
+3 ; 0 = don't run for some reason
+4 NEW GMRCQT
+5 SET GMRCQT=1
+6 Begin DoDot:1
+7 NEW GMRCBST,GMRCNOW,GMRCBFI
+8 SET GMRCBST=$$GET^XPAR("SYS","GMRC IFC BACKGROUND START",1)
+9 ; has never run or needs to
IF 'GMRCBST
QUIT
+10 SET GMRCNOW=$$NOW^XLFDT
+11 ;set to future date/time - don't run
IF GMRCBST>GMRCNOW
SET GMRCQT=0
QUIT
+12 SET GMRCBFI=$$GET^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1)
+13 IF $$FMDIFF^XLFDT(GMRCNOW,GMRCBFI,2)<3600
IF GMRCBFI>GMRCBST
SET GMRCQT=0
QUIT
+14 ; ^--ran < 1 hr ago
+15 IF $$FMDIFF^XLFDT(GMRCBST,GMRCBFI,2)>4500
Begin DoDot:2
+16 ; >1.5 hrs and job not finishing for some reason, alert techies
+17 NEW XQA,XQAMSG,XQAROU,XQAID,XQAKILL
+18 SET XQAID="GMRC IFC BKG"
SET XQAKILL=0
DO DELETEA^XQALERT
+19 SET XQA("G.IFC TECH ERRORS")=""
+20 SET XQAMSG="IFC Background job overdue."
+21 SET XQAID="GMRC IFC BKG"
+22 SET XQAROU="OVERDUE^GMRCIBKG"
+23 DO SETUP^XQALERT
+24 QUIT
End DoDot:2
QUIT
+25 QUIT
End DoDot:1
+26 QUIT GMRCQT
