| 1 | RORHDT04 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION PROCESS ; 1/22/06 8:18pm
 | 
|---|
| 2 |  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  Q
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ;***** DATA EXTRACTION PROCESS
 | 
|---|
| 7 |  ;
 | 
|---|
| 8 |  ; .REGLST       Reference to a local array containing registry
 | 
|---|
| 9 |  ;               names as subscripts and registry IENs as values
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 |  ; HDEIEN        Data Extract IEN
 | 
|---|
| 12 |  ; TASKIEN       Task IEN
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  ; FAM           File Access Mode
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  ; Return Values:
 | 
|---|
| 17 |  ;       <0  Error code
 | 
|---|
| 18 |  ;      >=0  Statistics
 | 
|---|
| 19 |  ;             ^1: Total number of processed patients
 | 
|---|
| 20 |  ;             ^2: Number of patients processed with errors
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | EXTRACT(REGLST,HDEIEN,TASKIEN,FAM) ;
 | 
|---|
| 23 |  N ROREXT        ; Data extraction descriptor
 | 
|---|
| 24 |  N RORHL         ; HL7 variables
 | 
|---|
| 25 |  N RORLRC        ; List of codes of Lab results to be extracted
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  N CNT           ; Number of processed registry records
 | 
|---|
| 28 |  N ECNT          ; Number of records processed with errors
 | 
|---|
| 29 |  N FILE          ; Name of the output file
 | 
|---|
| 30 |  N OUTDIR        ; Name of the output directory
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 |  N BDT,EDT,NEXT,POP,RC,REGIEN,REGNAME,RGIENLST,RRBIEN,RREIEN,STOP,TMP
 | 
|---|
| 33 |  K ^TMP("RORHDT",$J,"PR"),^TMP("HLS",$J),^TMP("RORPTF",$J)
 | 
|---|
| 34 |  S (CNT,ECNT,STOP)=0,RORHDT("BHS")=1
 | 
|---|
| 35 |  ;--- Prepare the list of registry IENs
 | 
|---|
| 36 |  S REGNAME="",REGIEN=0
 | 
|---|
| 37 |  F  S REGNAME=$O(REGLST(REGNAME))  Q:REGNAME=""  D  Q:REGIEN<0
 | 
|---|
| 38 |  . S REGIEN=+REGLST(REGNAME)
 | 
|---|
| 39 |  . S:REGIEN'>0 REGIEN=$$REGIEN^RORUTL02(REGNAME)
 | 
|---|
| 40 |  . S:REGIEN>0 RGIENLST(REGIEN)=""
 | 
|---|
| 41 |  Q:REGIEN<0 REGIEN
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 |  ;=== Load parameters
 | 
|---|
| 44 |  S RC=$$HDEPARM^RORHDT05(HDEIEN,.BDT,.EDT,.OUTDIR)
 | 
|---|
| 45 |  Q:RC<0 RC
 | 
|---|
| 46 |  S RC=$$TASKPARM^RORHDT05(HDEIEN,TASKIEN,.RRBIEN,.RREIEN,.FILE)
 | 
|---|
| 47 |  Q:RC<0 RC
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 |  ;=== Prepare data extraction rules
 | 
|---|
| 50 |  S RC=$$PREPARE^ROREXPR(.REGLST,BDT,EDT)
 | 
|---|
| 51 |  Q:RC<0 $$ERROR^RORERR(-22)
 | 
|---|
| 52 |  ;--- Load and process historical data extraction parameters
 | 
|---|
| 53 |  S RC=$$PREPARE^RORHDT06(HDEIEN)  Q:RC<0 RC
 | 
|---|
| 54 |  K ROREXT("MAXHL7SIZE")  ; Do not limit the size
 | 
|---|
| 55 |  ;
 | 
|---|
| 56 |  ;=== Initialize the HL7 environment
 | 
|---|
| 57 |  S RC=$$INIT^RORHL7()  Q:RC<0 RC
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 |  ;=== Delete the old output host file(s)
 | 
|---|
| 60 |  S TMP=$$DELFILES^RORHDT05(OUTDIR,FILE)
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 |  D
 | 
|---|
| 63 |  . N COMMIT,IENS,NODE,NRTC,PTIEN
 | 
|---|
| 64 |  . S NRTC=100 ; Number of records to commit
 | 
|---|
| 65 |  . ;
 | 
|---|
| 66 |  . ;=== Try to re-extract the erroneous records
 | 
|---|
| 67 |  . S NODE=$$ROOT^DILFD(799.641,","_(+TASKIEN)_","_(+HDEIEN)_",",1)
 | 
|---|
| 68 |  . S NODE=$NA(@NODE@("B"))
 | 
|---|
| 69 |  . S PTIEN=0,RC=0
 | 
|---|
| 70 |  . F  D  Q:RC!STOP!(PTIEN'>0)
 | 
|---|
| 71 |  . . K ^TMP("HLS",$J)
 | 
|---|
| 72 |  . . F  S PTIEN=$O(@NODE@(PTIEN))  Q:PTIEN'>0  D  Q:RC!'((CNT-ECNT)#NRTC)
 | 
|---|
| 73 |  . . . S RC=$$LOOP^RORTSK01()
 | 
|---|
| 74 |  . . . I RC<0  S:RC=-42 STOP=1  Q
 | 
|---|
| 75 |  . . . S RC=$$PROCREC(PTIEN,.RGIENLST),CNT=CNT+1
 | 
|---|
| 76 |  . . . S ^TMP("RORHDT",$J,"PR",PTIEN)=RC
 | 
|---|
| 77 |  . . . I RC'<0  S RC=0  Q
 | 
|---|
| 78 |  . . . ;--- Proccess the error
 | 
|---|
| 79 |  . . . S RC=$$ERROR^RORERR(-15,,,PTIEN),ECNT=ECNT+1
 | 
|---|
| 80 |  . . . S:$G(RORPARM("DEBUG"))<3 RC=0
 | 
|---|
| 81 |  . . I RC<0  Q:'STOP
 | 
|---|
| 82 |  . . ;--- Commit the data
 | 
|---|
| 83 |  . . S TMP=$$COMMIT^RORHDT05(OUTDIR,FILE)
 | 
|---|
| 84 |  . . S:TMP<0 RC=TMP
 | 
|---|
| 85 |  . Q:STOP!(RC=-34)
 | 
|---|
| 86 |  . ;
 | 
|---|
| 87 |  . ;=== Extract the remaining registry data
 | 
|---|
| 88 |  . S PTIEN=$S(RRBIEN>0:+$O(^RORDATA(798,"KEY",RRBIEN),-1),1:0)
 | 
|---|
| 89 |  . S RC=0
 | 
|---|
| 90 |  . F  D  Q:RC!STOP!(PTIEN'>0)
 | 
|---|
| 91 |  . . K ^TMP("HLS",$J)  S COMMIT=0
 | 
|---|
| 92 |  . . F  S PTIEN=$$NEXTPAT(PTIEN,.RGIENLST)  Q:PTIEN'>0  D  Q:RC!COMMIT
 | 
|---|
| 93 |  . . . S RC=$$LOOP^RORTSK01()
 | 
|---|
| 94 |  . . . I RC<0  S:RC=-42 STOP=1  Q
 | 
|---|
| 95 |  . . . I RREIEN>0,PTIEN'<RREIEN  S PTIEN="",RC=1  Q
 | 
|---|
| 96 |  . . . Q:$D(^TMP("RORHDT",$J,"PR",PTIEN))
 | 
|---|
| 97 |  . . . S RC=$$PROCREC(PTIEN,.RGIENLST),CNT=CNT+1
 | 
|---|
| 98 |  . . . I RC'<0  S COMMIT='((CNT-ECNT)#NRTC),RC=0  Q
 | 
|---|
| 99 |  . . . ;--- Proccess the error
 | 
|---|
| 100 |  . . . S RC=$$ERROR^RORERR(-15,,,PTIEN),ECNT=ECNT+1
 | 
|---|
| 101 |  . . . S:$G(RORPARM("DEBUG"))<3 RC=0
 | 
|---|
| 102 |  . . . S TMP=$$ADDERR^RORHDT05(HDEIEN,TASKIEN,PTIEN)
 | 
|---|
| 103 |  . . . S:TMP<0 RC=TMP
 | 
|---|
| 104 |  . . I RC<0  Q:'STOP
 | 
|---|
| 105 |  . . ;--- Commit the data
 | 
|---|
| 106 |  . . S NEXT=$S(COMMIT:$$NEXTPAT(PTIEN,.RGIENLST),1:PTIEN)
 | 
|---|
| 107 |  . . S TMP=$$COMMIT^RORHDT05(OUTDIR,FILE)
 | 
|---|
| 108 |  . . S:TMP<0 RC=TMP
 | 
|---|
| 109 |  ;
 | 
|---|
| 110 |  ;--- The $$COMMIT^RORHDT05 returns -34 if it was not able to create
 | 
|---|
| 111 |  ;--- the output file (wrong directory name, protection error, etc.).
 | 
|---|
| 112 |  D:RC'=-34
 | 
|---|
| 113 |  . N NODE,RORFDA,RORMSG
 | 
|---|
| 114 |  . ;
 | 
|---|
| 115 |  . ;=== Write the batch trailer segment and close the file if
 | 
|---|
| 116 |  . ;=== the batch is not empty. Otherwise, record a warning.
 | 
|---|
| 117 |  . I '$G(RORHDT("BHS"))  D
 | 
|---|
| 118 |  . . S TMP=$S(ECNT!(RC<0):"Completed with errors",STOP:"Stopped",1:"")
 | 
|---|
| 119 |  . . U IO  W $$BTS^RORHL7A($$MSGCNT^RORHL7,TMP),$C(13)
 | 
|---|
| 120 |  . . D CLOSE^%ZISH("HL7FILE")
 | 
|---|
| 121 |  . E  D ERROR^RORERR(-89)
 | 
|---|
| 122 |  . ;
 | 
|---|
| 123 |  . ;=== Update the NEXT RECORD IEN field in the task record
 | 
|---|
| 124 |  . I $D(NEXT)  D:NEXT'>0
 | 
|---|
| 125 |  . . ;--- If the task completed successfuly, the NEXT RECORD IEN
 | 
|---|
| 126 |  . . ;    field is set to an empty string. If the task is restarted
 | 
|---|
| 127 |  . . ;--- afterwards, it will re-extract all data again.
 | 
|---|
| 128 |  . . I 'ECNT  S NEXT=""  Q
 | 
|---|
| 129 |  . . ;--- If completed with errors, use IEN of the last record
 | 
|---|
| 130 |  . . ;--- processed by the task incremented by 1.
 | 
|---|
| 131 |  . . I RREIEN>0  S NEXT=RREIEN+1  Q
 | 
|---|
| 132 |  . . ;--- Or the IEN of the last patient record incremented by 1
 | 
|---|
| 133 |  . . ;--- (in case of the last/single task).
 | 
|---|
| 134 |  . . S NEXT=$O(^RORDATA(798,"KEY",""),-1)+1
 | 
|---|
| 135 |  . . ;--- When the task is restarted, it will try to re-extract only
 | 
|---|
| 136 |  . . ;    erroneous records and will not process already extracted
 | 
|---|
| 137 |  . . ;    data (the PTIEN will not be less than the RREIEN or the
 | 
|---|
| 138 |  . . ;--- $ORDER function will not return a value greater than zero).
 | 
|---|
| 139 |  . E  Q:(RC<0)!ECNT!STOP  S NEXT=""
 | 
|---|
| 140 |  . ;
 | 
|---|
| 141 |  . ;=== Update the task record
 | 
|---|
| 142 |  . S IENS=(+TASKIEN)_","_(+HDEIEN)_","
 | 
|---|
| 143 |  . S RORFDA(799.64,IENS,.04)=NEXT
 | 
|---|
| 144 |  . D FILE^DIE("K","RORFDA","RORMSG")
 | 
|---|
| 145 |  . S TMP=$$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
 | 
|---|
| 146 |  ;
 | 
|---|
| 147 |  ;=== Cleanup
 | 
|---|
| 148 |  K ^TMP("RORPTF",$J)
 | 
|---|
| 149 |  S:RC'<0 RC=$$CLRERRS^RORHDT05(HDEIEN,TASKIEN)
 | 
|---|
| 150 |  Q $S(RC<0:RC,1:CNT_U_ECNT)
 | 
|---|
| 151 |  ;
 | 
|---|
| 152 |  ;***** RETURNS THE NEXT PATIENT FOR DATA EXTRACTION
 | 
|---|
| 153 |  ;
 | 
|---|
| 154 |  ; PTIEN         Patient IEN (DFN)
 | 
|---|
| 155 |  ;
 | 
|---|
| 156 |  ; .RGIENLST     Reference to a local array containing registry
 | 
|---|
| 157 |  ;               IENs as subscripts. The IENs of the corresponding
 | 
|---|
| 158 |  ;               patient's registry records are returned as values.
 | 
|---|
| 159 |  ;
 | 
|---|
| 160 |  ; Return Values:
 | 
|---|
| 161 |  ;        0  No more patients
 | 
|---|
| 162 |  ;       >0  IEN (DFN) of the next patient who belongs to at least
 | 
|---|
| 163 |  ;           one of the registries defined by the RGIENLST parameter.
 | 
|---|
| 164 |  ;
 | 
|---|
| 165 | NEXTPAT(PTIEN,RGIENLST) ;
 | 
|---|
| 166 |  N CNT,IEN,REGIEN
 | 
|---|
| 167 |  S CNT=0
 | 
|---|
| 168 |  F  S PTIEN=$O(^RORDATA(798,"KEY",PTIEN))  Q:PTIEN'>0  D  Q:CNT
 | 
|---|
| 169 |  . S REGIEN=0
 | 
|---|
| 170 |  . F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D
 | 
|---|
| 171 |  . . S RGIENLST(REGIEN)=0
 | 
|---|
| 172 |  . . S IEN=+$O(^RORDATA(798,"KEY",PTIEN,REGIEN,""))
 | 
|---|
| 173 |  . . Q:IEN'>0
 | 
|---|
| 174 |  . . ;--- Skip inactive records
 | 
|---|
| 175 |  . . Q:'$$ACTIVE^RORDD(IEN)
 | 
|---|
| 176 |  . . ;--- Skip records tagged as "DON'T SEND"
 | 
|---|
| 177 |  . . Q:$P($G(^RORDATA(798,IEN,2)),U,4)
 | 
|---|
| 178 |  . . ;--- Consider the record
 | 
|---|
| 179 |  . . S RGIENLST(REGIEN)=IEN,CNT=CNT+1
 | 
|---|
| 180 |  Q $S(PTIEN>0:PTIEN,1:0)
 | 
|---|
| 181 |  ;
 | 
|---|
| 182 |  ;***** PROCESSES A RECORD IN THE REGISTRY
 | 
|---|
| 183 |  ;
 | 
|---|
| 184 |  ; PTIEN         Patient IEN (DFN)
 | 
|---|
| 185 |  ;
 | 
|---|
| 186 |  ; .RGIENLST     Reference to a local array containing registry
 | 
|---|
| 187 |  ;               IENs as subscripts and IENs of the corresponding
 | 
|---|
| 188 |  ;               patient's registry records as values.
 | 
|---|
| 189 |  ;
 | 
|---|
| 190 |  ; Return Values:
 | 
|---|
| 191 |  ;       <0  Error code
 | 
|---|
| 192 |  ;        0  Ok
 | 
|---|
| 193 |  ;        1  Nothing has been extracted
 | 
|---|
| 194 |  ;
 | 
|---|
| 195 | PROCREC(PTIEN,RGIENLST) ;
 | 
|---|
| 196 |  N RORERRDL      ; Default error location
 | 
|---|
| 197 |  ;
 | 
|---|
| 198 |  N BATCHID,CNT,DXDTS,IEN,MSHPTR,RC,REGIEN,RORMSH,TMP
 | 
|---|
| 199 |  D CLEAR^RORERR("PROCREC^RORHDT04")
 | 
|---|
| 200 |  ;
 | 
|---|
| 201 |  ;--- Compile the data extraction time frames
 | 
|---|
| 202 |  S (CNT,RC,REGIEN)=0
 | 
|---|
| 203 |  F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D  Q:RC<0
 | 
|---|
| 204 |  . S IEN=+RGIENLST(REGIEN)  Q:IEN'>0
 | 
|---|
| 205 |  . S RC=$$DXPERIOD^ROREXTUT(.DXDTS,IEN,PTIEN)
 | 
|---|
| 206 |  . S:'RC CNT=CNT+1
 | 
|---|
| 207 |  . S:RC>0 RGIENLST(REGIEN)=0
 | 
|---|
| 208 |  Q:RC<0 RC
 | 
|---|
| 209 |  ;--- If the patient should be skipped in all registries
 | 
|---|
| 210 |  ;    that are being processed, then do not perform the data
 | 
|---|
| 211 |  ;--- extraction for this patient at all.
 | 
|---|
| 212 |  I 'CNT  D:$G(RORPARM("DEBUG"))  Q 0
 | 
|---|
| 213 |  . D LOG^RORLOG(4,"There is no data to extract.",PTIEN)
 | 
|---|
| 214 |  ;
 | 
|---|
| 215 |  ;--- Create an HL7 message for the patient
 | 
|---|
| 216 |  S MSHPTR=$$CREATE^RORHL7(.RORMSH)  Q:MSHPTR<0 MSHPTR
 | 
|---|
| 217 |  S RC=$$MESSAGE^ROREXT02(PTIEN,.RGIENLST,.DXDTS,$G(ROREXT("HDTIEN")))
 | 
|---|
| 218 |  ;
 | 
|---|
| 219 |  ;--- Delete the unfinished message from the ^TMP("HLS",$J)
 | 
|---|
| 220 |  ;    if there is no data to send (RC>0) or there was an error
 | 
|---|
| 221 |  ;    during the data extraction (RC<0). Return the error code
 | 
|---|
| 222 |  ;--- in the latter case.
 | 
|---|
| 223 |  I RC!($O(^TMP("HLS",$J,""),-1)=MSHPTR)  D  Q:RC<0 RC
 | 
|---|
| 224 |  . D ROLLBACK^RORHL7(MSHPTR)  S:'RC RC=1
 | 
|---|
| 225 |  ;---
 | 
|---|
| 226 |  Q RC
 | 
|---|