source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIBKG.m@ 1094

Last change on this file since 1094 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1GMRCIBKG ;SLC/JFR - IFC BACKGROUND ERROR PROCESSOR; 07/02/03 13:54
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,35**;DEC 27, 1997
3 ;
4 ; This routine invokes IA# 3335
5 ;
6EN ;process file 123.6 and take action
7 ;Start background process
8 I $D(ZTQUEUED) S ZTREQ="@"
9 ;
10 ; OK to run?
11 I '$$GONOGO Q
12 ;
13 ; set start param to NOW and run
14 D EN^XPAR("SYS","GMRC IFC BACKGROUND START",1,$$NOW^XLFDT)
15 ;
16 N GMRCLOG,GMRCTIM,GMRCLOG0
17 S GMRCLOG=0
18 S GMRCTIM=$$FMADD^XLFDT($$NOW^XLFDT,,-1)
19 F S GMRCLOG=$O(^GMR(123.6,GMRCLOG)) Q:'GMRCLOG D
20 . S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0))
21 . ;
22 . ; v-- resend if couldn't update file immediately
23 . I $P(GMRCLOG0,U,6),$P(GMRCLOG0,U,8)=901 D Q
24 .. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
25 . ; v-- wait at least 1 hour on all other errors
26 . I $P(GMRCLOG0,U)>GMRCTIM Q
27 . ; v-- if incomplete activity is now the earliest, resend it
28 . I $P(GMRCLOG0,U,6),$P(GMRCLOG0,U,8)=902 D Q
29 .. Q:$O(^GMR(123.6,"AC",$P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)),-1)
30 .. D DELALRT(GMRCLOG)
31 .. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
32 . ; v-- delete complete entries after # in GMRC RETAIN IFC ACTIVITY DAYS
33 . I '$P(GMRCLOG0,U,6) D Q
34 .. N DIK,DA,GMRCRETN
35 .. S GMRCRETN=$$GET^XPAR("SYS","GMRC RETAIN IFC ACTIVITY DAYS",1)
36 .. I 'GMRCRETN S GMRCRETN=7
37 .. I $P(GMRCLOG0,U)>$$FMADD^XLFDT(GMRCTIM,(0-GMRCRETN)) Q ;don't delete
38 .. S DIK="^GMR(123.6,",DA=GMRCLOG
39 .. D ^DIK ;remove old completed entries
40 . ;
41 . ; v-- resend unknown patient errors after 3 hours
42 . I $P(GMRCLOG0,U,8)=201,GMRCLOG0<$$FMADD^XLFDT($$NOW^XLFDT,,-3) D Q
43 .. N GMRCSND,GMRCPAR,DOW
44 .. S GMRCPAR=$$GET^XPAR("SYS","GMRC IFC SKIP WEEKEND RE-TRANS",1)
45 .. S DOW=$$DOW^XLFDT(DT,1)
46 .. S GMRCSND=$S('GMRCPAR:1,(+DOW&(DOW<6)):1,1:0)
47 .. I GMRCSND D ;re-send based on parameter and day of week
48 ... D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
49 ... D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5))
50 .. I '($P(GMRCLOG0,U,7)#8),GMRCSND D
51 ... ;alert CAC's about errors every 24 hrs.
52 ... D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
53 ... D SNDALRT^GMRCIERR(GMRCLOG,"C") ; alert CAC's to patient errors
54 ... D ; send mail to remote CAC group
55 .... N GMRCLNK,GMRCIQT,HL,HLECH,HLFS,HLQ,PID,DOM,STA,GMRCLNK,OBR
56 .... D INIT^HLFNC2("GMRC IFC ORM EVENT",.HL)
57 .... D I $D(GMRCIQT) Q ;build PID seg if nat'l ICN
58 ..... N GMRCDFN S GMRCDFN=$P(^GMR(123,+$P(GMRCLOG0,U,4),0),U,2)
59 ..... I '$G(GMRCDFN) S GMRCIQT=1 Q
60 ..... I $$GETICN^MPIF001(GMRCDFN)<1 S GMRCIQT=1 Q
61 ..... I $$IFLOCAL^MPIF001(GMRCDFN) S GMRCIQT=1 Q
62 ..... S PID=$$EN^VAFCPID(GMRCDFN,"1,2,3,4,5,7,8,19")
63 ..... S PID=$P(PID,"|",2,999)
64 .... D LINK^HLUTIL3($P(GMRCLOG0,U,2),.GMRCLNK)
65 .... S GMRCLNK=$O(GMRCLNK(0)) I 'GMRCLNK Q ;no link set up
66 .... S DOM=$$GET1^DIQ(870,+GMRCLNK,.03)
67 .... S STA=$$STA^XUAF4($P(GMRCLOG0,U,2))
68 .... S OBR=$E($$OBR^GMRCISG1(+$P(GMRCLOG0,U,4),+$P(GMRCLOG0,U,5)),5,999)
69 .... D PTERRMSG^GMRCIERR(PID,STA,DOM,OBR)
70 . ;
71 . ; v-- resend local ICN errors after 3 hours
72 . I $P(GMRCLOG0,U,8)=202,GMRCLOG0<$$FMADD^XLFDT($$NOW^XLFDT,,-3) D Q
73 .. ;re-send based on parameter and day of week
74 .. N GMRCSND,GMRCPAR,DOW
75 .. S GMRCPAR=$$GET^XPAR("SYS","GMRC IFC SKIP WEEKEND RE-TRANS",1)
76 .. S DOW=$$DOW^XLFDT(DT,1)
77 .. S GMRCSND=$S('GMRCPAR:1,(+DOW&(DOW<6)):1,1:0)
78 .. I 'GMRCSND Q ;don't re-send activity
79 .. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
80 .. I '($P(GMRCLOG0,U,7)#8) D ;alert CAC's about errors every 24 hrs
81 ... D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
82 ... D SNDALRT^GMRCIERR(GMRCLOG,"C") ; alert CAC's to patient errors
83 . ; v-- re-process implementation errors
84 . I $P(GMRCLOG0,U,8)>300,$P(GMRCLOG0,U,8)<702 D Q
85 .. D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
86 .. D TRIGR^GMRCIEVT($P(GMRCLOG0,U,4),$P(GMRCLOG0,U,5)) ;re-send activity
87 . ; v-- if incomplete and no error, alert tech group
88 . I '$P(GMRCLOG0,U,8)!($P(GMRCLOG0,U,8)>902) D Q
89 .. D DELALRT(GMRCLOG) ;delete previous alerts on same transaction
90 .. D SNDALRT^GMRCIERR(GMRCLOG,"T")
91 . Q
92 ;
93 ; v-- set finish param
94 D EN^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1,$$NOW^XLFDT)
95 ; v-- start it again one hour after completing
96 D REQUEUE
97 Q
98 ;
99REQUEUE ;task job to start up again one hour after completing
100 N ZTRTN,ZTSK,ZTIO,ZTDESC,ZTDTH
101 S ZTDESC="IF Consults background error processor"
102 S ZTIO=""
103 S ZTRTN="EN^GMRCIBKG"
104 S ZTDTH=$$FMTH^XLFDT($$FMADD^XLFDT($$NOW^XLFDT,,1))
105 D ^%ZTLOAD
106 Q
107DELALRT(MSGLOG) ;delete obsolete alerts for an entry
108 ; Input:
109 ; MSGLOG = ien from file 123.6
110 ;
111 N XQAID,XQAKILL
112 S XQAID="GMRCIFC,trans error,"_MSGLOG,XQAKILL=0
113 D DELETEA^XQALERT
114 Q
115 ;
116OVERDUE ; write message for alert to tell IRM job is overdue
117 W @IOF
118 W !,"The Inter-facility Consults background job is overdue."
119 W !,"This is likely due to an error while the job runs. It is suggested"
120 W !,"that you check the systems for errors. If the errors are resolved"
121 W !,"the background job will catch up and run normally. There is a "
122 W !,"remote possibility that the GMRC IFC BACKGROUND... parameters have"
123 W !,"been edited and are out of synch."
124 S XQAKILL=0
125 Q
126 ;
127GONOGO() ; determine if background job should run or not
128 ;Output:
129 ; 1 = go ahead and run
130 ; 0 = don't run for some reason
131 N GMRCQT
132 S GMRCQT=1
133 D
134 . N GMRCBST,GMRCNOW,GMRCBFI
135 . S GMRCBST=$$GET^XPAR("SYS","GMRC IFC BACKGROUND START",1)
136 . I 'GMRCBST Q ; has never run or needs to
137 . S GMRCNOW=$$NOW^XLFDT
138 . I GMRCBST>GMRCNOW S GMRCQT=0 Q ;set to future date/time - don't run
139 . S GMRCBFI=$$GET^XPAR("SYS","GMRC IFC BACKGROUND FINISH",1)
140 . I $$FMDIFF^XLFDT(GMRCNOW,GMRCBFI,2)<3600,GMRCBFI>GMRCBST S GMRCQT=0 Q
141 . ; ^--ran < 1 hr ago
142 . I $$FMDIFF^XLFDT(GMRCBST,GMRCBFI,2)>4500 D Q
143 .. ; >1.5 hrs and job not finishing for some reason, alert techies
144 .. N XQA,XQAMSG,XQAROU,XQAID,XQAKILL
145 .. S XQAID="GMRC IFC BKG",XQAKILL=0 D DELETEA^XQALERT
146 .. S XQA("G.IFC TECH ERRORS")=""
147 .. S XQAMSG="IFC Background job overdue."
148 .. S XQAID="GMRC IFC BKG"
149 .. S XQAROU="OVERDUE^GMRCIBKG"
150 .. D SETUP^XQALERT
151 .. Q
152 . Q
153 Q GMRCQT
Note: See TracBrowser for help on using the repository browser.