source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD05.m@ 1535

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

initial load of FOIAVistA 6/30/08 version

File size: 8.0 KB
Line 
1RORUPD05 ;HCIOFO/SG - REGISTRY UPDATE (MULTITASK) ; 7/6/06 11:09am
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 Q
5 ;
6 ;***** MONITORS THE SUBTASKS
7 ;
8 ; Return Values:
9 ; <0 Error code
10 ; >=0 Combined statistics returned by the $$PROCESS^RORUPD01
11 ; function of each subtask
12 ;
13MONITOR() ;
14 N CNT,ECNT,EXIT,RC,TASK,TIMEOUT,TSKCNT
15 S (CNT,ECNT,EXIT)=0,TIMEOUT=600 ; 10hrs = 600*60
16 F H 60 D Q:EXIT
17 . ;--- Exit if all subtasks finished
18 . I $D(@RORUPDPI@("T"))<10 S EXIT=1 Q
19 . ;--- Abort if some of the subtasks have not started during
20 . ;--- the predefined time frame.
21 . I TIMEOUT'>0 S EXIT=$$ERROR^RORERR(-78) Q
22 . ;--- Check for a request to stop
23 . I $D(ZTQUEUED),$$S^%ZTLOAD S EXIT=$$ERROR^RORERR(-42) Q
24 . ;--- Browse through the list of subtasks
25 . S (TASK,TSKCNT)=0
26 . F S TASK=$O(@RORUPDPI@("T",TASK)) Q:TASK="" D
27 . . S RC=@RORUPDPI@("T",TASK),TSKCNT=TSKCNT+1
28 . . ;--- Skip a subtask that was scheduled but has not started yet
29 . . I RC="S" S TSKCNT=TSKCNT-1 Q
30 . . ;--- Skip a running subtask
31 . . L +@RORUPDPI@("T",TASK):1 E Q
32 . . L -@RORUPDPI@("T",TASK)
33 . . ;--- The subtask has crashed
34 . . I RC=-60 S EXIT=$$ERROR^RORERR(-60,,,,TASK) Q
35 . . ;--- Fatal error in the subtask
36 . . I RC<0 S EXIT=+RC D Q
37 . . . S RC=$$ERROR^RORERR(-56,,,,+RC,"subtask #"_TASK)
38 . . ;--- The subtask is completed (accumulate the statistics)
39 . . S CNT=CNT+$P(RC,U),ECNT=ECNT+$P(RC,U,2)
40 . . K @RORUPDPI@("T",TASK)
41 . ;--- Timeout timer is ticking only if no subtasks are running
42 . S:TSKCNT'>0 TIMEOUT=TIMEOUT-1
43 Q $S(EXIT<0:EXIT,1:CNT_U_ECNT)
44 ;
45 ;***** PROCESSES THE DATA (SINGLE TASK OR MULTITASK MODE)
46 ;
47 ; [MAXNTSK] Maximum number of data processing subtasks.
48 ; If this parameter is less than 2, all patients
49 ; will be processed by the single main task.
50 ; Otherwise, all patients can be distributed among
51 ; several subtasks.
52 ;
53 ; If "N^M^AUTO" is passed as a value of this parameter
54 ; and difference between the end and start dates is
55 ; more than M days then N subtasks will be created.
56 ;
57 ; Return Values:
58 ; <0 Error code
59 ; >=0 Statistics returned by the $$MONITOR function
60 ;
61 ; The main task will wait for completion of the subtasks. If one
62 ; of them fails, all other (including the main one) will fail too.
63 ;
64PROCESS(MAXNTSK) ;
65 N COUNTERS,NTSK,OLDPI,RC,SUBSCR,TASKTBL,TMP
66 ;--- Calculate number of tasks and create the task table
67 D:$G(MAXNTSK)["AUTO"
68 . S TMP=$$FMDIFF^XLFDT(RORUPD("DSEND"),RORUPD("DSBEG"),1)
69 . S MAXNTSK=$S(TMP>$P(MAXNTSK,U,2):+MAXNTSK,1:0)
70 I $G(MAXNTSK)>1 D Q:NTSK<0 NTSK
71 . S NTSK=$$TASKTBL(MAXNTSK,.TASKTBL)
72 ;--- Process all patients by the main task
73 Q:$G(NTSK)<2 $$PROCESS^RORUPD01()
74 ;
75 S RORUPD("JOB")=$J,OLDPI=RORUPDPI
76 ;--- Initialize the node in the ^XTMP global
77 I $G(RORPARM("SETUP")) D
78 . S SUBSCR="RORUPDR"_+$O(RORUPD("LM2",""))
79 . S RORUPDPI=$NA(^XTMP(SUBSCR)),I=0
80 . F S I=$O(@RORUPDPI@(I)) Q:I="" K:I'="U" @RORUPDPI@(I)
81 E D
82 . S SUBSCR="RORUPDJ"_$J
83 . S RORUPDPI=$NA(^XTMP(SUBSCR))
84 . K @RORUPDPI
85 D XTMPHDR^RORUTL01(SUBSCR,30,"PROCESS-RORUPD05")
86 M @RORUPDPI=@OLDPI
87 ;--- Indicate that the main task is running
88 L +@RORUPDPI@("T",0):7
89 E Q $$ERROR^RORERR(-61)
90 ;
91 ;--- Start the subtasks
92 S RC=$$START(.TASKTBL)
93 ;--- Monitor the subtasks
94 S COUNTERS=$S(RC'<0:$$MONITOR(),1:RC)
95 ;
96 ;--- Clear "running" flag of the main task
97 ; (request all unfinished subtasks to stop)
98 L -@RORUPDPI@("T",0)
99 ;--- Cleanup
100 I COUNTERS<0 D
101 . N TASK,ZTSK
102 . ;--- Dequeue subtasks that have not started yet
103 . S TASK=0
104 . F S TASK=$O(@RORUPDPI@("T",TASK)) Q:TASK="" D
105 . . S ZTSK=TASK D DQ^%ZTLOAD
106 . ;--- Wait for all unfinished subtasks to stop
107 . L +@RORUPDPI@("T"):300 L -@RORUPDPI@("T")
108 K @RORUPDPI@("T")
109 Q COUNTERS
110 ;
111 ;***** STARTS THE SUBTASKS
112 ;
113 ; .TASKTBL Reference to a local variable containing the table
114 ; of subtask parameters. See the TASKSPLT and TASKTBL
115 ; entry points for details.
116 ;
117 ; Return Values:
118 ; <0 Error code
119 ; 0 Ok
120 ;
121START(TASKTBL) ;
122 N CNT,I,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSAVE,ZTSK
123 K @RORUPDPI@("T")
124 ;--- Do not allow subtasks to proceed before everything is ready
125 L +@RORUPDPI@("T"):7
126 E Q $$ERROR^RORERR(-61)
127 ;--- Start the subtasks
128 S I=""
129 F CNT=1:1 S I=$O(TASKTBL(I)) Q:I="" D
130 . S ZTRTN="SUBTASK^RORUPD05",ZTIO=""
131 . S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,,CNT*30)
132 . S ZTDESC="Registry Update Subtask ("_$TR(TASKTBL(I),U,"-")_")"
133 . S ZTSAVE("RORIENS")=TASKTBL(I)
134 . S ZTSAVE("RORLRC(")=""
135 . S ZTSAVE("RORPARM(")=""
136 . S ZTSAVE("RORUPD(")=""
137 . S ZTSAVE("RORUPDPI")=""
138 . D ^%ZTLOAD
139 . ;--- Indicate that the subtask has been scheduled
140 . S @RORUPDPI@("T",ZTSK)="S"
141 . D LOG^RORERR(-62,,,ZTSK)
142 ;--- The subtasks may proceed now
143 L -@RORUPDPI@("T")
144 Q 0
145 ;
146 ;***** DATA PROCESSING SUBTASK
147 ;
148 ; RORIENS Diapason of IENs in the 'PATIENT' file
149 ; ^1: Start IEN
150 ; ^2: End IEN
151 ; RORLRC List of Lab result codes to check
152 ; RORPARM Application parameters
153 ; RORUPD Registry update descriptor
154 ; RORUPDPI Closed root of the temporary storage
155 ;
156SUBTASK ;
157 N RORERROR ; Error processing data
158 N RORLOG ; Log subsystem constants & variables
159 ;
160 N RC,TASK,TMP
161 S TASK=ZTSK
162 ;--- We are not in the KIDS environment anymore
163 K RORPARM("KIDS")
164 ;--- Disable debug output (subtask has no device)
165 S:$G(RORPARM("DEBUG"))>1 RORPARM("DEBUG")=1
166 ;--- Indicate that the subtask is running
167 L +@RORUPDPI@("T",TASK):180
168 E S RC=$$ERROR^RORERR(-61) Q
169 ;--- Check if the main task is running
170 L +@RORUPDPI@("T",0):3
171 I D
172 . ;--- Cleanup if the main task is not running
173 . L -@RORUPDPI@("T",0)
174 . K @RORUPDPI@("T",TASK)
175 E D
176 . N REGIEN,REGLST
177 . ;--- Error code that will be in effect if the subtask crashes
178 . S @RORUPDPI@("T",TASK)=-60
179 . ;--- Initialize the variables
180 . D INIT^RORUTL01(),CLEAR^RORERR("SUBTASK^RORUPD05")
181 . S REGIEN=""
182 . F S REGIEN=$O(@RORUPDPI@(2,REGIEN)) Q:REGIEN="" D
183 . . S TMP=$P(@RORUPDPI@(2,REGIEN),U) S:TMP'="" REGLST(TMP)=REGIEN
184 . S TMP="REGISTRY UPDATE SUBTASK #"_TASK_" STARTED"
185 . S TMP=$$OPEN^RORLOG(.REGLST,1,TMP)
186 . ;--- Process the patients from 'Start IEN' to 'End IEN'
187 . S RC=$$PROCESS^RORUPD01($P(RORIENS,U),$P(RORIENS,U,2))
188 . ;--- Set the error code returned by the registry update process
189 . S @RORUPDPI@("T",TASK)=RC
190 . ;--- Cleanup and error processing
191 . S:RC=-42 ZTSTOP=1
192 . S TMP="REGISTRY UPDATE SUBTASK "_$S(RC<0:"ABORTED",1:"COMPLETED")
193 . D CLOSE^RORLOG(TMP,$S(RC'<0:RC,1:""))
194 ;--- Clear "running" flag of the subtask
195 L -@RORUPDPI@("T",TASK)
196 S ZTREQ="@"
197 Q
198 ;
199 ;***** CALCULATES TABLE OF SUBTASKS
200 ;
201 ; MAXNTSK Maximum number of data processing subtasks
202 ;
203 ; .TASKTBL Reference to a local variable where table of
204 ; subtask parameters is returned:
205 ;
206 ; TASKTBL Number of subtasks
207 ; TASKTBL(I) Subtask parameters
208 ; ^1: Start IEN
209 ; ^2: End IEN
210 ;
211 ; Return Values:
212 ; <0 Error code
213 ; 0 Process all data by the main task
214 ; >1 Number of subtasks
215 ;
216 ; If the PATIENT file contains more than 100,000 records, up to
217 ; MAXNTSK data processing subtasks may be defined. Otherwise, the
218 ; data should be processed by the main task.
219 ;
220TASKTBL(MAXNTSK,RORTBL) ;
221 N I,IEN,INC,LST,NR,RORTMP
222 K RORTBL
223 ;--- Get number of records in the PATIENT file
224 S NR=$$GET1^DID(2,,,"ENTRIES",,"RORMSG")
225 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9)
226 Q:NR'>10000 0
227 ;--- Generate IEN intervals (no more than 300)
228 S RORTMP=$$ALLOC^RORTMP()
229 S INC=NR\300,NR=0 S:INC<1 INC=1
230 F IEN=0:INC S IEN=$O(^DPT(IEN)) Q:IEN'>0 D
231 . S NR=NR+1,@RORTMP@(NR)=IEN
232 ;--- Generate the task table
233 S IEN=1,INC=NR/MAXNTSK
234 F RORTBL=1:1 D Q:(RORTBL'<MAXNTSK)!(IEN'>0)
235 . S RORTBL(RORTBL)=IEN
236 . S I=$J(RORTBL*INC,0,0),IEN=$G(@RORTMP@(I))
237 . S $P(RORTBL(RORTBL),U,2)=IEN
238 D FREE^RORTMP(RORTMP)
239 ;--- Analize the result
240 I $G(RORTBL)<2 K RORTBL
241 E S $P(RORTBL(RORTBL),U,2)=$O(^DPT(" "),-1)
242 Q +$G(RORTBL)
Note: See TracBrowser for help on using the repository browser.