source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHDT02.m@ 635

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)