| [613] | 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
|
|---|
