Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHDT02

RORHDT02.m

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