126 lines
3.9 KiB
Mathematica
126 lines
3.9 KiB
Mathematica
RORHDT02 ;HCIOFO/SG - CREATE EXTRACTION TASK RECORDS ; 1/25/06 8:56am
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|
;
|
|
Q
|
|
;
|
|
;***** (RE)CREATES THE TASK TABLE
|
|
;
|
|
; HDEIEN Data Extract IEN
|
|
; [NTSK] Number of tasks to create
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
; 1 Timeout or "^"
|
|
;
|
|
CREATE(HDEIEN,NTSK) ;
|
|
N BUF,FNAME,I,IENS,REGLST,SILENT,TSKTBL,TMP
|
|
S SILENT=($G(NTSK)>0)
|
|
;--- Load the data extract parameters
|
|
S IENS=(+HDEIEN)_","
|
|
D GETS^DIQ(799.6,IENS,".05;.08;3*",,"RORBUF","RORMSG")
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
|
|
;--- Construct the base file name
|
|
S FNAME=$G(RORBUF(799.6,IENS,.08))
|
|
S FNAME=$TR(FNAME," !@#$%^&*-+=[]{}|\;:'"",.<>/?`~")
|
|
S FNAME=FNAME_"-"_$E($P($$SITE^VASITE(),U,3),1,3)_"-"
|
|
;--- Compile the list of registries
|
|
S I=""
|
|
F S I=$O(RORBUF(799.63,I)) Q:I="" D
|
|
. S TMP=$G(RORBUF(799.63,I,.01)) S:TMP'="" REGLST(TMP)=""
|
|
;---
|
|
S TMP=+$G(RORBUF(799.6,IENS,.05))
|
|
S NTSK=$$TASKTBL(.REGLST,TMP,.TSKTBL,$G(NTSK))
|
|
;--- Ask for the final confirmation
|
|
I 'SILENT D Q:TMP 1
|
|
. N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|
. S DIR(0)="Y"
|
|
. S DIR("A")="Create the new task table"
|
|
. S DIR("B")="NO"
|
|
. W ! D ^DIR
|
|
. S TMP=$D(DIRUT)!'$G(Y)
|
|
;--- Create the new task table
|
|
Q $$UPDTBL(HDEIEN,.TSKTBL,FNAME)
|
|
;
|
|
;***** DISTRIBUTES PATIENTS AMONG THE DATA EXTRACTION TASKS
|
|
;
|
|
; .REGLST Reference to a local array containing registry
|
|
; names as the subscripts and optional registry IENs
|
|
; as the values.
|
|
;
|
|
; MNPTPB Maximum number of patients per batch
|
|
;
|
|
; .TSKTBL Reference to a local array where task
|
|
; desciptors will be stored
|
|
;
|
|
; [NTSK] If this parameters is defined and greater than 0,
|
|
; then this number of task is enforced. Moreover,
|
|
; in this case the function work in silent mode and
|
|
; do not displays any messages.
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; >0 Number of tasks
|
|
;
|
|
TASKTBL(REGLST,MNPTPB,TSKTBL,NTSK) ;
|
|
N I,IEN,INC,NPT,NR,PTLST,SILENT
|
|
S SILENT=($G(NTSK)>0),PTLST=$$ALLOC^RORTMP()
|
|
S:MNPTPB'>0 MNPTPB=1000 K TSKTBL
|
|
;--- Count the registry patients
|
|
W:'SILENT !!,"Counting registry patients..."
|
|
S NPT=$$REGPTCNT^RORUTL18(.REGLST,"AS",PTLST)
|
|
W:'SILENT *13,"Number of unique patients: ",NPT
|
|
;--- Calculate number of tasks
|
|
W:'SILENT !,"Maximum number of patients per batch: ",MNPTPB
|
|
I $G(NTSK)'>0 D
|
|
. S NTSK=NPT\MNPTPB S:NPT#MNPTPB NTSK=NTSK+1
|
|
E S:NTSK>NPT NTSK=NPT
|
|
;--- Distribute patients between the tasks
|
|
D:NTSK>1
|
|
. ;--- Generate IEN intervals (no more than 1000)
|
|
. S INC=NPT\1000,NR=0 S:INC<1 INC=1
|
|
. F IEN=0:INC S IEN=$O(@PTLST@(IEN)) Q:IEN'>0 D
|
|
. . S NR=NR+1,@PTLST@("I",NR)=IEN
|
|
. ;--- Generate the task table
|
|
. S IEN=1,INC=NR/NTSK
|
|
. F TSKTBL=1:1 D Q:(TSKTBL'<NTSK)!(IEN'>0)
|
|
. . S TSKTBL(TSKTBL)=IEN
|
|
. . S I=TSKTBL*INC\1,IEN=$G(@PTLST@("I",I))
|
|
. . S $P(TSKTBL(TSKTBL),U,2)=IEN
|
|
;--- Analize the result
|
|
I $G(TSKTBL)<2 K TSKTBL S TSKTBL=1,TSKTBL(1)=1
|
|
S $P(TSKTBL(TSKTBL),U,2)=+$O(@PTLST@(" "),-1)
|
|
S NTSK=+TSKTBL
|
|
;--- Cleanup
|
|
D FREE^RORTMP(PTLST)
|
|
W:'SILENT !,"Number of data extraction tasks: ",NTSK
|
|
Q NTSK
|
|
;
|
|
;***** UPDATES THE TASK TABLE
|
|
;
|
|
; HDEIEN Data Extract IEN
|
|
;
|
|
; [.TSKTBL] Reference to a local variable containing a task
|
|
; table generated by the TASKTBL function.
|
|
;
|
|
; [FNAME] Base file name
|
|
;
|
|
; Return Values:
|
|
; <0 Error code
|
|
; 0 Ok
|
|
;
|
|
UPDTBL(HDEIEN,TSKTBL,FNAME) ;
|
|
N I,IENS,RC,RORFDA,RORMSG
|
|
S RC=0
|
|
;--- Clear the old table
|
|
S RC=$$CLEAR^RORUTL05(799.64,","_(+HDEIEN)_",") Q:RC<0 RC
|
|
;--- Prepare records in the FDA.
|
|
F I=1:1:+TSKTBL D
|
|
. S IENS="+"_I_","_(+HDEIEN)_","
|
|
. S RORFDA(799.64,IENS,.01)=+TSKTBL(I)
|
|
. S RORFDA(799.64,IENS,.05)=FNAME_$TR($J(I,2)," ","0")_".HDT"
|
|
;--- Update the table
|
|
D UPDATE^DIE(,"RORFDA",,"RORMSG")
|
|
S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.64)
|
|
Q $S(RC<0:RC,1:0)
|