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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHDT02 4093 printed Apr 09, 2024@20:48:50 Page 2
RORHDT02 ;HCIOFO/SG - CREATE EXTRACTION TASK RECORDS ; 1/25/06 8:56am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** (RE)CREATES THE TASK TABLE
+6 ;
+7 ; HDEIEN Data Extract IEN
+8 ; [NTSK] Number of tasks to create
+9 ;
+10 ; Return Values:
+11 ; <0 Error code
+12 ; 0 Ok
+13 ; 1 Timeout or "^"
+14 ;
CREATE(HDEIEN,NTSK) ;
+1 NEW BUF,FNAME,I,IENS,REGLST,SILENT,TSKTBL,TMP
+2 SET SILENT=($GET(NTSK)>0)
+3 ;--- Load the data extract parameters
+4 SET IENS=(+HDEIEN)_","
+5 DO GETS^DIQ(799.6,IENS,".05;.08;3*",,"RORBUF","RORMSG")
+6 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
+7 ;--- Construct the base file name
+8 SET FNAME=$GET(RORBUF(799.6,IENS,.08))
+9 SET FNAME=$TRANSLATE(FNAME," !@#$%^&*-+=[]{}|\;:'"",.<>/?`~")
+10 SET FNAME=FNAME_"-"_$EXTRACT($PIECE($$SITE^VASITE(),U,3),1,3)_"-"
+11 ;--- Compile the list of registries
+12 SET I=""
+13 FOR
SET I=$ORDER(RORBUF(799.63,I))
if I=""
QUIT
Begin DoDot:1
+14 SET TMP=$GET(RORBUF(799.63,I,.01))
if TMP'=""
SET REGLST(TMP)=""
End DoDot:1
+15 ;---
+16 SET TMP=+$GET(RORBUF(799.6,IENS,.05))
+17 SET NTSK=$$TASKTBL(.REGLST,TMP,.TSKTBL,$GET(NTSK))
+18 ;--- Ask for the final confirmation
+19 IF 'SILENT
Begin DoDot:1
+20 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+21 SET DIR(0)="Y"
+22 SET DIR("A")="Create the new task table"
+23 SET DIR("B")="NO"
+24 WRITE !
DO ^DIR
+25 SET TMP=$DATA(DIRUT)!'$GET(Y)
End DoDot:1
if TMP
QUIT 1
+26 ;--- Create the new task table
+27 QUIT $$UPDTBL(HDEIEN,.TSKTBL,FNAME)
+28 ;
+29 ;***** DISTRIBUTES PATIENTS AMONG THE DATA EXTRACTION TASKS
+30 ;
+31 ; .REGLST Reference to a local array containing registry
+32 ; names as the subscripts and optional registry IENs
+33 ; as the values.
+34 ;
+35 ; MNPTPB Maximum number of patients per batch
+36 ;
+37 ; .TSKTBL Reference to a local array where task
+38 ; desciptors will be stored
+39 ;
+40 ; [NTSK] If this parameters is defined and greater than 0,
+41 ; then this number of task is enforced. Moreover,
+42 ; in this case the function work in silent mode and
+43 ; do not displays any messages.
+44 ;
+45 ; Return Values:
+46 ; <0 Error code
+47 ; >0 Number of tasks
+48 ;
TASKTBL(REGLST,MNPTPB,TSKTBL,NTSK) ;
+1 NEW I,IEN,INC,NPT,NR,PTLST,SILENT
+2 SET SILENT=($GET(NTSK)>0)
SET PTLST=$$ALLOC^RORTMP()
+3 if MNPTPB'>0
SET MNPTPB=1000
KILL TSKTBL
+4 ;--- Count the registry patients
+5 if 'SILENT
WRITE !!,"Counting registry patients..."
+6 SET NPT=$$REGPTCNT^RORUTL18(.REGLST,"AS",PTLST)
+7 if 'SILENT
WRITE *13,"Number of unique patients: ",NPT
+8 ;--- Calculate number of tasks
+9 if 'SILENT
WRITE !,"Maximum number of patients per batch: ",MNPTPB
+10 IF $GET(NTSK)'>0
Begin DoDot:1
+11 SET NTSK=NPT\MNPTPB
if NPT#MNPTPB
SET NTSK=NTSK+1
End DoDot:1
+12 IF '$TEST
if NTSK>NPT
SET NTSK=NPT
+13 ;--- Distribute patients between the tasks
+14 if NTSK>1
Begin DoDot:1
+15 ;--- Generate IEN intervals (no more than 1000)
+16 SET INC=NPT\1000
SET NR=0
if INC<1
SET INC=1
+17 FOR IEN=0:INC
SET IEN=$ORDER(@PTLST@(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+18 SET NR=NR+1
SET @PTLST@("I",NR)=IEN
End DoDot:2
+19 ;--- Generate the task table
+20 SET IEN=1
SET INC=NR/NTSK
+21 FOR TSKTBL=1:1
Begin DoDot:2
+22 SET TSKTBL(TSKTBL)=IEN
+23 SET I=TSKTBL*INC\1
SET IEN=$GET(@PTLST@("I",I))
+24 SET $PIECE(TSKTBL(TSKTBL),U,2)=IEN
End DoDot:2
if (TSKTBL'<NTSK)!(IEN'>0)
QUIT
End DoDot:1
+25 ;--- Analize the result
+26 IF $GET(TSKTBL)<2
KILL TSKTBL
SET TSKTBL=1
SET TSKTBL(1)=1
+27 SET $PIECE(TSKTBL(TSKTBL),U,2)=+$ORDER(@PTLST@(" "),-1)
+28 SET NTSK=+TSKTBL
+29 ;--- Cleanup
+30 DO FREE^RORTMP(PTLST)
+31 if 'SILENT
WRITE !,"Number of data extraction tasks: ",NTSK
+32 QUIT NTSK
+33 ;
+34 ;***** UPDATES THE TASK TABLE
+35 ;
+36 ; HDEIEN Data Extract IEN
+37 ;
+38 ; [.TSKTBL] Reference to a local variable containing a task
+39 ; table generated by the TASKTBL function.
+40 ;
+41 ; [FNAME] Base file name
+42 ;
+43 ; Return Values:
+44 ; <0 Error code
+45 ; 0 Ok
+46 ;
UPDTBL(HDEIEN,TSKTBL,FNAME) ;
+1 NEW I,IENS,RC,RORFDA,RORMSG
+2 SET RC=0
+3 ;--- Clear the old table
+4 SET RC=$$CLEAR^RORUTL05(799.64,","_(+HDEIEN)_",")
if RC<0
QUIT RC
+5 ;--- Prepare records in the FDA.
+6 FOR I=1:1:+TSKTBL
Begin DoDot:1
+7 SET IENS="+"_I_","_(+HDEIEN)_","
+8 SET RORFDA(799.64,IENS,.01)=+TSKTBL(I)
+9 SET RORFDA(799.64,IENS,.05)=FNAME_$TRANSLATE($JUSTIFY(I,2)," ","0")_".HDT"
End DoDot:1
+10 ;--- Update the table
+11 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
+12 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,799.64)
+13 QUIT $SELECT(RC<0:RC,1:0)
