source: FOIAVistA/trunk/r/VDEF-VDEF/VDEFCONT.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1VDEFCONT ;INTEGIC/AM & BPOIFO/JG - VDEF CONTROL PROGRAM ; 16 Nov 2005 1:08 PM
2 ;;1.0;VDEF;**3**;Dec 28, 2004
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; IA: 10063 - $$S^%ZTLOAD
6 ; 10063 - $$ASKSTOP^%ZTLOAD
7 ;
8 Q ; No bozos
9 ;
10START ; Main entry point for scheduling queue processor jobs at Taskman
11 ; Startup time
12 I '$D(ZTQUEUED) W !,"Must be run from TaskMan." Q
13 ;
14 ; Start Request Queue processors
15 N QIEN F QIEN=0:0 S QIEN=$O(^VDEFHL7(579.3,QIEN)) Q:'QIEN D REQ(QIEN)
16 ;
17 ; Start the checked out request monitor job
18 D MONCHKO
19 ;
20 ; Start the Request Queue processor monitor job
21 D START^VDEFMON
22 Q
23 ;
24MONCHKO ; Start the VDEF job to monitor checked out requests
25 N ARR,ERR,FDA,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSK
26 ;
27 ; Check the status of the last VDEF Monitor task.
28 D GETS^DIQ(579.5,"1,",".01;.02;.06","I","ARR","ERR")
29 ; Don't start a new one if old one is scheduled.
30 S ZTSK=+$G(ARR(579.5,"1,",.06,"I")) D STAT^%ZTLOAD
31 I ZTSK(1)=1 Q
32 ;
33 ; Schedule a new task.
34 S ZTRTN="MONITOR^VDEFCONT",ZTDESC="VDEF Checked Out Monitor"
35 ;
36 ; Calculate when to run the VDEF Monitor next time
37 S ZTDTH=$$FUTURE^VDEFUTIL($G(ARR(579.5,"1,",.02,"I")))
38 S (ZTPRI,ZTIO)=""
39 D ^%ZTLOAD
40 ;
41 ; Check that TaskMan successfully queued up the Monitor task
42 I '$G(ZTSK) D ALERT^VDEFUTIL("VDEF CHECKED OUT MONITOR FAILED TO START. CHECK ERROR TRAP.")
43 ;
44 ; File the task number of the task that has been queued up
45 I $G(ZTSK) S FDA(1,579.5,"1,",.06)=ZTSK D FILE^DIE("","FDA(1)","ERR(1)")
46 Q
47 ;
48MONITOR ; VDEF monitor task, executed on a schedule determined by queue
49 ; parameter 'CHECK OUT TIME LIMIT'. Checks for potentially hung
50 ; 'Checked Out' entries in the Request Queues
51 ;
52 N QIEN S (ZTSTOP,QIEN)=0
53 F S QIEN=$O(^VDEFHL7(579.3,"C","C",QIEN)) Q:'QIEN D Q:ZTSTOP
54 . N IEN,LIMIT,QUEUE,QUEUENAM,QUIT
55 . ;
56 . ; Retrieve queue data
57 . D GETS^DIQ(579.3,QIEN_",",".01;.04;.05","I","QUEUE","ERR")
58 . S QUEUENAM=$G(QUEUE(579.3,QIEN_",",.01,"I"))
59 . ;
60 . ; Check-out Time Limit in seconds
61 . S LIMIT=$G(QUEUE(579.3,QIEN_",",.05,"I"))
62 . ;
63 . ; Get a list of currently Checked-out Requests in this queue
64 . S IEN=0 F S IEN=$O(^VDEFHL7(579.3,"C","C",QIEN,IEN)) Q:'IEN D Q:ZTSTOP
65 .. S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
66 .. N CHECKOUT,ENTRY,ERR,FDA
67 .. ;
68 .. ; Get the related data for the request
69 .. D GETS^DIQ(579.31,IEN_","_QIEN_",",".01;.02;.09;.15","I","ENTRY","ERR")
70 .. ;
71 .. ; Quit if Vista HL7 IRM already notified or if status is not "C"
72 .. Q:$G(ENTRY(579.31,IEN_","_QIEN_",",.15,"I"))'=""
73 .. Q:$G(ENTRY(579.31,IEN_","_QIEN_",",.02,"I"))'="C"
74 .. ;
75 .. ; Get the date when the request was checked out and compare with
76 .. ; CHECK OUT TIME LIMIT parameter.
77 .. S CHECKOUT=$G(ENTRY(579.31,IEN_","_QIEN_",",.09,"I"))
78 .. ;
79 .. ; If no checkout time, don't create a false alert.
80 .. Q:'CHECKOUT
81 .. Q:$$DIFF^VDEFUTIL(CHECKOUT,$H)'>LIMIT
82 .. ;
83 .. ; Request appears hung. Send a message to the Vista HL7 IRM.
84 .. D ALERT^VDEFUTIL("RECORD "_IEN_" IN VDEF QUEUE '"_$E(QUEUENAM,1,35)_"' HUNG IN CHECKED OUT STATUS.")
85 .. ;
86 .. ; Update the time stamp in the entry so that the VDEF Monitor
87 .. ; doesn't notify the Vista HL7 IRM more than once.
88 .. L +^VDEFHL7(579.3,QIEN,IEN)
89 .. D NOW^%DTC S FDA(1,579.31,IEN_","_QIEN_",",.15)=%
90 .. D FILE^DIE("","FDA(1)","ERR(1)")
91 .. L -^VDEFHL7(579.3,QIEN,IEN)
92 .. Q
93 ;
94 ; Check if TaskMan requested a stop
95 I ZTSTOP S X=$$ASKSTOP^%ZTLOAD(ZTSK),ZTREQ="@" Q
96 ;
97PURGE ; Purge old entries in Request Queues
98 S (ZTSTOP,QIEN)=0
99 F S QIEN=$O(^VDEFHL7(579.3,"C","P",QIEN)) Q:'QIEN D Q:ZTSTOP
100 . N ARCH,IEN,QUEUE,QUIT
101 . ; Retrieve queue data
102 . D GETS^DIQ(579.3,QIEN_",",".04","I","QUEUE","ERR")
103 . ; Retrieve the queue's Archival Parameter (in seconds)
104 . S ARCH=$G(QUEUE(579.3,QIEN_",",.04,"I"))
105 . ; Initialize the flag that indicates whether the oldest Processed
106 . ; entry in a given Request Queue is too recent to be purged
107 . S QUIT=0
108 . ; Loop through the list of "P"rocesses entries in this Request
109 . ; Queue, starting with the oldest
110 . F IEN=0:0 S IEN=$O(^VDEFHL7(579.3,"C","P",QIEN,IEN)) Q:'IEN D Q:QUIT!ZTSTOP
111 .. S ZTSTOP=$$S^%ZTLOAD() Q:ZTSTOP
112 .. N DTS,ENTRY,ERR,FDA
113 .. ; Get this entry's data
114 .. D GETS^DIQ(579.31,IEN_","_QIEN_",",".13","I","ENTRY","ERR")
115 .. I $D(ERR) ; Add error processing here
116 .. ; Retrieve the DTS when the Request was "P"rocessed
117 .. S DTS=$G(ENTRY(579.31,IEN_","_QIEN_",",.13,"I"))
118 .. ; Calculate how long it has been since this Request was "P"rocessed
119 .. ; and, if the Request is more recent than the Archival Parameter
120 .. ; for this Queue, set the "Quit" flag and stop processing the Queue
121 .. I $$DIFF^VDEFUTIL(DTS,$H)<ARCH S QUIT=1 Q
122 .. ; If we are here, then the entry is older than allowed by the
123 .. ; Archival Parameter - purge this entry from the Request Queue
124 .. S FDA(1,579.31,IEN_","_QIEN_",",.01)="@"
125 .. D FILE^DIE("","FDA(1)","ERR(1)")
126 ;
127 ; Stop if TaskMan requested
128 I ZTSTOP S X=$$ASKSTOP^%ZTLOAD(ZTSK),ZTREQ="@" Q
129 ;
130 ; Reschedule VDEF checked out monitor
131 D MONCHKO
132 S ZTREQ="@"
133 Q
134 ;
135REQ(QIEN) ; Start a Request Queue Processor task for a single queue
136 ; Try locking the Request Queue - if we fail, then there is
137 ; another Request Processor currently holding the lock, so skip it
138 L +^VDEFHL7(579.3,"QUEUE",QIEN):3 Q:'$T
139 N ERR,FDA,QNAME,QUEUE,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSAVE,ZTSK
140 ; Retrieve queue data
141 D GETS^DIQ(579.3,QIEN_",",".01;.02;.07;.08;.09","I","QUEUE","ERR")
142 ; If this Request Queue is suspended, quit
143 I $G(QUEUE(579.3,QIEN_",",.09,"I"))="S" G REQX
144 ; TaskMan task number of the last Request Processor task for this queue
145 S ZTSK=+$G(QUEUE(579.3,QIEN_",",.08,"I"))
146 ; Check the status of the last Request Processor task
147 D STAT^%ZTLOAD
148 ; If the task is scheduled to run, then don't submit a new one - this
149 ; means that the system is coming back after a restart which occurred
150 ; while an old Request Processor task was scheduled for running
151 I ZTSK(1)=1 G REQX
152 ;
153 ; Create TaskMan variables
154 S ZTRTN="EN^VDEFREQ",(ZTIO,ZTPRI)=""
155 S QNAME=$G(QUEUE(579.3,QIEN_",",.01,"I"))
156 S ZTDESC="VDEF Request Processor for "_QNAME
157 S ZTSAVE("QIEN")=QIEN,ZTDTH=$H
158 D ^%ZTLOAD
159 ; Check that TaskMan created the task.
160 I '$G(ZTSK) D ALERT^VDEFUTIL("VDEF REQUEST PROCESS "_$E(QNAME,1,20)_" FAILED TO START. CHECK ERROR TRAP.")
161 ; File the task number of the task that has been queued up
162 I $G(ZTSK) D
163 . S FDA(1,579.3,QIEN_",",.08)=ZTSK
164 . D FILE^DIE("","FDA(1)","ERR(1)")
165REQX L -^VDEFHL7(579.3,"QUEUE",QIEN)
166 Q
Note: See TracBrowser for help on using the repository browser.