| 1 | RORUPD05 ;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 |  ;
 | 
|---|
| 13 | MONITOR() ;
 | 
|---|
| 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 |  ;
 | 
|---|
| 64 | PROCESS(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 |  ;
 | 
|---|
| 121 | START(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 |  ;
 | 
|---|
| 156 | SUBTASK ;
 | 
|---|
| 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 |  ;
 | 
|---|
| 220 | TASKTBL(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)
 | 
|---|