| 1 | RORHDT02 ;HCIOFO/SG - CREATE EXTRACTION TASK RECORDS ; 1/25/06 8:56am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** (RE)CREATES THE TASK TABLE
|
|---|
| 7 | ;
|
|---|
| 8 | ; HDEIEN Data Extract IEN
|
|---|
| 9 | ; [NTSK] Number of tasks to create
|
|---|
| 10 | ;
|
|---|
| 11 | ; Return Values:
|
|---|
| 12 | ; <0 Error code
|
|---|
| 13 | ; 0 Ok
|
|---|
| 14 | ; 1 Timeout or "^"
|
|---|
| 15 | ;
|
|---|
| 16 | CREATE(HDEIEN,NTSK) ;
|
|---|
| 17 | N BUF,FNAME,I,IENS,REGLST,SILENT,TSKTBL,TMP
|
|---|
| 18 | S SILENT=($G(NTSK)>0)
|
|---|
| 19 | ;--- Load the data extract parameters
|
|---|
| 20 | S IENS=(+HDEIEN)_","
|
|---|
| 21 | D GETS^DIQ(799.6,IENS,".05;.08;3*",,"RORBUF","RORMSG")
|
|---|
| 22 | Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
|
|---|
| 23 | ;--- Construct the base file name
|
|---|
| 24 | S FNAME=$G(RORBUF(799.6,IENS,.08))
|
|---|
| 25 | S FNAME=$TR(FNAME," !@#$%^&*-+=[]{}|\;:'"",.<>/?`~")
|
|---|
| 26 | S FNAME=FNAME_"-"_$E($P($$SITE^VASITE(),U,3),1,3)_"-"
|
|---|
| 27 | ;--- Compile the list of registries
|
|---|
| 28 | S I=""
|
|---|
| 29 | F S I=$O(RORBUF(799.63,I)) Q:I="" D
|
|---|
| 30 | . S TMP=$G(RORBUF(799.63,I,.01)) S:TMP'="" REGLST(TMP)=""
|
|---|
| 31 | ;---
|
|---|
| 32 | S TMP=+$G(RORBUF(799.6,IENS,.05))
|
|---|
| 33 | S NTSK=$$TASKTBL(.REGLST,TMP,.TSKTBL,$G(NTSK))
|
|---|
| 34 | ;--- Ask for the final confirmation
|
|---|
| 35 | I 'SILENT D Q:TMP 1
|
|---|
| 36 | . N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 37 | . S DIR(0)="Y"
|
|---|
| 38 | . S DIR("A")="Create the new task table"
|
|---|
| 39 | . S DIR("B")="NO"
|
|---|
| 40 | . W ! D ^DIR
|
|---|
| 41 | . S TMP=$D(DIRUT)!'$G(Y)
|
|---|
| 42 | ;--- Create the new task table
|
|---|
| 43 | Q $$UPDTBL(HDEIEN,.TSKTBL,FNAME)
|
|---|
| 44 | ;
|
|---|
| 45 | ;***** DISTRIBUTES PATIENTS AMONG THE DATA EXTRACTION TASKS
|
|---|
| 46 | ;
|
|---|
| 47 | ; .REGLST Reference to a local array containing registry
|
|---|
| 48 | ; names as the subscripts and optional registry IENs
|
|---|
| 49 | ; as the values.
|
|---|
| 50 | ;
|
|---|
| 51 | ; MNPTPB Maximum number of patients per batch
|
|---|
| 52 | ;
|
|---|
| 53 | ; .TSKTBL Reference to a local array where task
|
|---|
| 54 | ; desciptors will be stored
|
|---|
| 55 | ;
|
|---|
| 56 | ; [NTSK] If this parameters is defined and greater than 0,
|
|---|
| 57 | ; then this number of task is enforced. Moreover,
|
|---|
| 58 | ; in this case the function work in silent mode and
|
|---|
| 59 | ; do not displays any messages.
|
|---|
| 60 | ;
|
|---|
| 61 | ; Return Values:
|
|---|
| 62 | ; <0 Error code
|
|---|
| 63 | ; >0 Number of tasks
|
|---|
| 64 | ;
|
|---|
| 65 | TASKTBL(REGLST,MNPTPB,TSKTBL,NTSK) ;
|
|---|
| 66 | N I,IEN,INC,NPT,NR,PTLST,SILENT
|
|---|
| 67 | S SILENT=($G(NTSK)>0),PTLST=$$ALLOC^RORTMP()
|
|---|
| 68 | S:MNPTPB'>0 MNPTPB=1000 K TSKTBL
|
|---|
| 69 | ;--- Count the registry patients
|
|---|
| 70 | W:'SILENT !!,"Counting registry patients..."
|
|---|
| 71 | S NPT=$$REGPTCNT^RORUTL18(.REGLST,"AS",PTLST)
|
|---|
| 72 | W:'SILENT *13,"Number of unique patients: ",NPT
|
|---|
| 73 | ;--- Calculate number of tasks
|
|---|
| 74 | W:'SILENT !,"Maximum number of patients per batch: ",MNPTPB
|
|---|
| 75 | I $G(NTSK)'>0 D
|
|---|
| 76 | . S NTSK=NPT\MNPTPB S:NPT#MNPTPB NTSK=NTSK+1
|
|---|
| 77 | E S:NTSK>NPT NTSK=NPT
|
|---|
| 78 | ;--- Distribute patients between the tasks
|
|---|
| 79 | D:NTSK>1
|
|---|
| 80 | . ;--- Generate IEN intervals (no more than 1000)
|
|---|
| 81 | . S INC=NPT\1000,NR=0 S:INC<1 INC=1
|
|---|
| 82 | . F IEN=0:INC S IEN=$O(@PTLST@(IEN)) Q:IEN'>0 D
|
|---|
| 83 | . . S NR=NR+1,@PTLST@("I",NR)=IEN
|
|---|
| 84 | . ;--- Generate the task table
|
|---|
| 85 | . S IEN=1,INC=NR/NTSK
|
|---|
| 86 | . F TSKTBL=1:1 D Q:(TSKTBL'<NTSK)!(IEN'>0)
|
|---|
| 87 | . . S TSKTBL(TSKTBL)=IEN
|
|---|
| 88 | . . S I=TSKTBL*INC\1,IEN=$G(@PTLST@("I",I))
|
|---|
| 89 | . . S $P(TSKTBL(TSKTBL),U,2)=IEN
|
|---|
| 90 | ;--- Analize the result
|
|---|
| 91 | I $G(TSKTBL)<2 K TSKTBL S TSKTBL=1,TSKTBL(1)=1
|
|---|
| 92 | S $P(TSKTBL(TSKTBL),U,2)=+$O(@PTLST@(" "),-1)
|
|---|
| 93 | S NTSK=+TSKTBL
|
|---|
| 94 | ;--- Cleanup
|
|---|
| 95 | D FREE^RORTMP(PTLST)
|
|---|
| 96 | W:'SILENT !,"Number of data extraction tasks: ",NTSK
|
|---|
| 97 | Q NTSK
|
|---|
| 98 | ;
|
|---|
| 99 | ;***** UPDATES THE TASK TABLE
|
|---|
| 100 | ;
|
|---|
| 101 | ; HDEIEN Data Extract IEN
|
|---|
| 102 | ;
|
|---|
| 103 | ; [.TSKTBL] Reference to a local variable containing a task
|
|---|
| 104 | ; table generated by the TASKTBL function.
|
|---|
| 105 | ;
|
|---|
| 106 | ; [FNAME] Base file name
|
|---|
| 107 | ;
|
|---|
| 108 | ; Return Values:
|
|---|
| 109 | ; <0 Error code
|
|---|
| 110 | ; 0 Ok
|
|---|
| 111 | ;
|
|---|
| 112 | UPDTBL(HDEIEN,TSKTBL,FNAME) ;
|
|---|
| 113 | N I,IENS,RC,RORFDA,RORMSG
|
|---|
| 114 | S RC=0
|
|---|
| 115 | ;--- Clear the old table
|
|---|
| 116 | S RC=$$CLEAR^RORUTL05(799.64,","_(+HDEIEN)_",") Q:RC<0 RC
|
|---|
| 117 | ;--- Prepare records in the FDA.
|
|---|
| 118 | F I=1:1:+TSKTBL D
|
|---|
| 119 | . S IENS="+"_I_","_(+HDEIEN)_","
|
|---|
| 120 | . S RORFDA(799.64,IENS,.01)=+TSKTBL(I)
|
|---|
| 121 | . S RORFDA(799.64,IENS,.05)=FNAME_$TR($J(I,2)," ","0")_".HDT"
|
|---|
| 122 | ;--- Update the table
|
|---|
| 123 | D UPDATE^DIE(,"RORFDA",,"RORMSG")
|
|---|
| 124 | S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.64)
|
|---|
| 125 | Q $S(RC<0:RC,1:0)
|
|---|
