| [613] | 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)
 | 
|---|