243 lines
8.0 KiB
Mathematica
243 lines
8.0 KiB
Mathematica
RORUPD05 ;HCIOFO/SG - REGISTRY UPDATE (MULTITASK) ; 7/6/06 11:09am
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
Q
|
|
;
|
|
;***** MONITORS THE SUBTASKS
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; >=0 Combined statistics returned by the $$PROCESS^RORUPD01
|
|
; function of each subtask
|
|
;
|
|
MONITOR() ;
|
|
N CNT,ECNT,EXIT,RC,TASK,TIMEOUT,TSKCNT
|
|
S (CNT,ECNT,EXIT)=0,TIMEOUT=600 ; 10hrs = 600*60
|
|
F H 60 D Q:EXIT
|
|
. ;--- Exit if all subtasks finished
|
|
. I $D(@RORUPDPI@("T"))<10 S EXIT=1 Q
|
|
. ;--- Abort if some of the subtasks have not started during
|
|
. ;--- the predefined time frame.
|
|
. I TIMEOUT'>0 S EXIT=$$ERROR^RORERR(-78) Q
|
|
. ;--- Check for a request to stop
|
|
. I $D(ZTQUEUED),$$S^%ZTLOAD S EXIT=$$ERROR^RORERR(-42) Q
|
|
. ;--- Browse through the list of subtasks
|
|
. S (TASK,TSKCNT)=0
|
|
. F S TASK=$O(@RORUPDPI@("T",TASK)) Q:TASK="" D
|
|
. . S RC=@RORUPDPI@("T",TASK),TSKCNT=TSKCNT+1
|
|
. . ;--- Skip a subtask that was scheduled but has not started yet
|
|
. . I RC="S" S TSKCNT=TSKCNT-1 Q
|
|
. . ;--- Skip a running subtask
|
|
. . L +@RORUPDPI@("T",TASK):1 E Q
|
|
. . L -@RORUPDPI@("T",TASK)
|
|
. . ;--- The subtask has crashed
|
|
. . I RC=-60 S EXIT=$$ERROR^RORERR(-60,,,,TASK) Q
|
|
. . ;--- Fatal error in the subtask
|
|
. . I RC<0 S EXIT=+RC D Q
|
|
. . . S RC=$$ERROR^RORERR(-56,,,,+RC,"subtask #"_TASK)
|
|
. . ;--- The subtask is completed (accumulate the statistics)
|
|
. . S CNT=CNT+$P(RC,U),ECNT=ECNT+$P(RC,U,2)
|
|
. . K @RORUPDPI@("T",TASK)
|
|
. ;--- Timeout timer is ticking only if no subtasks are running
|
|
. S:TSKCNT'>0 TIMEOUT=TIMEOUT-1
|
|
Q $S(EXIT<0:EXIT,1:CNT_U_ECNT)
|
|
;
|
|
;***** PROCESSES THE DATA (SINGLE TASK OR MULTITASK MODE)
|
|
;
|
|
; [MAXNTSK] Maximum number of data processing subtasks.
|
|
; If this parameter is less than 2, all patients
|
|
; will be processed by the single main task.
|
|
; Otherwise, all patients can be distributed among
|
|
; several subtasks.
|
|
;
|
|
; If "N^M^AUTO" is passed as a value of this parameter
|
|
; and difference between the end and start dates is
|
|
; more than M days then N subtasks will be created.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; >=0 Statistics returned by the $$MONITOR function
|
|
;
|
|
; The main task will wait for completion of the subtasks. If one
|
|
; of them fails, all other (including the main one) will fail too.
|
|
;
|
|
PROCESS(MAXNTSK) ;
|
|
N COUNTERS,NTSK,OLDPI,RC,SUBSCR,TASKTBL,TMP
|
|
;--- Calculate number of tasks and create the task table
|
|
D:$G(MAXNTSK)["AUTO"
|
|
. S TMP=$$FMDIFF^XLFDT(RORUPD("DSEND"),RORUPD("DSBEG"),1)
|
|
. S MAXNTSK=$S(TMP>$P(MAXNTSK,U,2):+MAXNTSK,1:0)
|
|
I $G(MAXNTSK)>1 D Q:NTSK<0 NTSK
|
|
. S NTSK=$$TASKTBL(MAXNTSK,.TASKTBL)
|
|
;--- Process all patients by the main task
|
|
Q:$G(NTSK)<2 $$PROCESS^RORUPD01()
|
|
;
|
|
S RORUPD("JOB")=$J,OLDPI=RORUPDPI
|
|
;--- Initialize the node in the ^XTMP global
|
|
I $G(RORPARM("SETUP")) D
|
|
. S SUBSCR="RORUPDR"_+$O(RORUPD("LM2",""))
|
|
. S RORUPDPI=$NA(^XTMP(SUBSCR)),I=0
|
|
. F S I=$O(@RORUPDPI@(I)) Q:I="" K:I'="U" @RORUPDPI@(I)
|
|
E D
|
|
. S SUBSCR="RORUPDJ"_$J
|
|
. S RORUPDPI=$NA(^XTMP(SUBSCR))
|
|
. K @RORUPDPI
|
|
D XTMPHDR^RORUTL01(SUBSCR,30,"PROCESS-RORUPD05")
|
|
M @RORUPDPI=@OLDPI
|
|
;--- Indicate that the main task is running
|
|
L +@RORUPDPI@("T",0):7
|
|
E Q $$ERROR^RORERR(-61)
|
|
;
|
|
;--- Start the subtasks
|
|
S RC=$$START(.TASKTBL)
|
|
;--- Monitor the subtasks
|
|
S COUNTERS=$S(RC'<0:$$MONITOR(),1:RC)
|
|
;
|
|
;--- Clear "running" flag of the main task
|
|
; (request all unfinished subtasks to stop)
|
|
L -@RORUPDPI@("T",0)
|
|
;--- Cleanup
|
|
I COUNTERS<0 D
|
|
. N TASK,ZTSK
|
|
. ;--- Dequeue subtasks that have not started yet
|
|
. S TASK=0
|
|
. F S TASK=$O(@RORUPDPI@("T",TASK)) Q:TASK="" D
|
|
. . S ZTSK=TASK D DQ^%ZTLOAD
|
|
. ;--- Wait for all unfinished subtasks to stop
|
|
. L +@RORUPDPI@("T"):300 L -@RORUPDPI@("T")
|
|
K @RORUPDPI@("T")
|
|
Q COUNTERS
|
|
;
|
|
;***** STARTS THE SUBTASKS
|
|
;
|
|
; .TASKTBL Reference to a local variable containing the table
|
|
; of subtask parameters. See the TASKSPLT and TASKTBL
|
|
; entry points for details.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
START(TASKTBL) ;
|
|
N CNT,I,ZTDESC,ZTDTH,ZTIO,ZTPRI,ZTRTN,ZTSAVE,ZTSK
|
|
K @RORUPDPI@("T")
|
|
;--- Do not allow subtasks to proceed before everything is ready
|
|
L +@RORUPDPI@("T"):7
|
|
E Q $$ERROR^RORERR(-61)
|
|
;--- Start the subtasks
|
|
S I=""
|
|
F CNT=1:1 S I=$O(TASKTBL(I)) Q:I="" D
|
|
. S ZTRTN="SUBTASK^RORUPD05",ZTIO=""
|
|
. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,,CNT*30)
|
|
. S ZTDESC="Registry Update Subtask ("_$TR(TASKTBL(I),U,"-")_")"
|
|
. S ZTSAVE("RORIENS")=TASKTBL(I)
|
|
. S ZTSAVE("RORLRC(")=""
|
|
. S ZTSAVE("RORPARM(")=""
|
|
. S ZTSAVE("RORUPD(")=""
|
|
. S ZTSAVE("RORUPDPI")=""
|
|
. D ^%ZTLOAD
|
|
. ;--- Indicate that the subtask has been scheduled
|
|
. S @RORUPDPI@("T",ZTSK)="S"
|
|
. D LOG^RORERR(-62,,,ZTSK)
|
|
;--- The subtasks may proceed now
|
|
L -@RORUPDPI@("T")
|
|
Q 0
|
|
;
|
|
;***** DATA PROCESSING SUBTASK
|
|
;
|
|
; RORIENS Diapason of IENs in the 'PATIENT' file
|
|
; ^1: Start IEN
|
|
; ^2: End IEN
|
|
; RORLRC List of Lab result codes to check
|
|
; RORPARM Application parameters
|
|
; RORUPD Registry update descriptor
|
|
; RORUPDPI Closed root of the temporary storage
|
|
;
|
|
SUBTASK ;
|
|
N RORERROR ; Error processing data
|
|
N RORLOG ; Log subsystem constants & variables
|
|
;
|
|
N RC,TASK,TMP
|
|
S TASK=ZTSK
|
|
;--- We are not in the KIDS environment anymore
|
|
K RORPARM("KIDS")
|
|
;--- Disable debug output (subtask has no device)
|
|
S:$G(RORPARM("DEBUG"))>1 RORPARM("DEBUG")=1
|
|
;--- Indicate that the subtask is running
|
|
L +@RORUPDPI@("T",TASK):180
|
|
E S RC=$$ERROR^RORERR(-61) Q
|
|
;--- Check if the main task is running
|
|
L +@RORUPDPI@("T",0):3
|
|
I D
|
|
. ;--- Cleanup if the main task is not running
|
|
. L -@RORUPDPI@("T",0)
|
|
. K @RORUPDPI@("T",TASK)
|
|
E D
|
|
. N REGIEN,REGLST
|
|
. ;--- Error code that will be in effect if the subtask crashes
|
|
. S @RORUPDPI@("T",TASK)=-60
|
|
. ;--- Initialize the variables
|
|
. D INIT^RORUTL01(),CLEAR^RORERR("SUBTASK^RORUPD05")
|
|
. S REGIEN=""
|
|
. F S REGIEN=$O(@RORUPDPI@(2,REGIEN)) Q:REGIEN="" D
|
|
. . S TMP=$P(@RORUPDPI@(2,REGIEN),U) S:TMP'="" REGLST(TMP)=REGIEN
|
|
. S TMP="REGISTRY UPDATE SUBTASK #"_TASK_" STARTED"
|
|
. S TMP=$$OPEN^RORLOG(.REGLST,1,TMP)
|
|
. ;--- Process the patients from 'Start IEN' to 'End IEN'
|
|
. S RC=$$PROCESS^RORUPD01($P(RORIENS,U),$P(RORIENS,U,2))
|
|
. ;--- Set the error code returned by the registry update process
|
|
. S @RORUPDPI@("T",TASK)=RC
|
|
. ;--- Cleanup and error processing
|
|
. S:RC=-42 ZTSTOP=1
|
|
. S TMP="REGISTRY UPDATE SUBTASK "_$S(RC<0:"ABORTED",1:"COMPLETED")
|
|
. D CLOSE^RORLOG(TMP,$S(RC'<0:RC,1:""))
|
|
;--- Clear "running" flag of the subtask
|
|
L -@RORUPDPI@("T",TASK)
|
|
S ZTREQ="@"
|
|
Q
|
|
;
|
|
;***** CALCULATES TABLE OF SUBTASKS
|
|
;
|
|
; MAXNTSK Maximum number of data processing subtasks
|
|
;
|
|
; .TASKTBL Reference to a local variable where table of
|
|
; subtask parameters is returned:
|
|
;
|
|
; TASKTBL Number of subtasks
|
|
; TASKTBL(I) Subtask parameters
|
|
; ^1: Start IEN
|
|
; ^2: End IEN
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Process all data by the main task
|
|
; >1 Number of subtasks
|
|
;
|
|
; If the PATIENT file contains more than 100,000 records, up to
|
|
; MAXNTSK data processing subtasks may be defined. Otherwise, the
|
|
; data should be processed by the main task.
|
|
;
|
|
TASKTBL(MAXNTSK,RORTBL) ;
|
|
N I,IEN,INC,LST,NR,RORTMP
|
|
K RORTBL
|
|
;--- Get number of records in the PATIENT file
|
|
S NR=$$GET1^DID(2,,,"ENTRIES",,"RORMSG")
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9)
|
|
Q:NR'>10000 0
|
|
;--- Generate IEN intervals (no more than 300)
|
|
S RORTMP=$$ALLOC^RORTMP()
|
|
S INC=NR\300,NR=0 S:INC<1 INC=1
|
|
F IEN=0:INC S IEN=$O(^DPT(IEN)) Q:IEN'>0 D
|
|
. S NR=NR+1,@RORTMP@(NR)=IEN
|
|
;--- Generate the task table
|
|
S IEN=1,INC=NR/MAXNTSK
|
|
F RORTBL=1:1 D Q:(RORTBL'<MAXNTSK)!(IEN'>0)
|
|
. S RORTBL(RORTBL)=IEN
|
|
. S I=$J(RORTBL*INC,0,0),IEN=$G(@RORTMP@(I))
|
|
. S $P(RORTBL(RORTBL),U,2)=IEN
|
|
D FREE^RORTMP(RORTMP)
|
|
;--- Analize the result
|
|
I $G(RORTBL)<2 K RORTBL
|
|
E S $P(RORTBL(RORTBL),U,2)=$O(^DPT(" "),-1)
|
|
Q +$G(RORTBL)
|