| [613] | 1 | ROREXT01 ;HCIOFO/SG - EXTRACTION & TRANSMISSION PROCESS ; 1/22/06 12:40pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** INTERNAL ENTRY POINT FOR DATA EXTRACTION
|
|---|
| 7 | ;
|
|---|
| 8 | ; .REGLST Reference to a local array containing registry
|
|---|
| 9 | ; names as subscripts and registry IENs as values
|
|---|
| 10 | ;
|
|---|
| 11 | ; [RORTASK] Task Number (if the data extraction is performed
|
|---|
| 12 | ; by a separate process)
|
|---|
| 13 | ;
|
|---|
| 14 | ; Return Values:
|
|---|
| 15 | ; <0 Error code (see MSGLIST^RORERR20)
|
|---|
| 16 | ; 0 Ok
|
|---|
| 17 | ;
|
|---|
| 18 | ; NOTE: The ROREXT and RORPARM local arrays must be properly
|
|---|
| 19 | ; initialized before calling this function.
|
|---|
| 20 | ;
|
|---|
| 21 | INTEXT(REGLST,RORTASK) ;
|
|---|
| 22 | N RORHL ; HL7 variables
|
|---|
| 23 | N RORLOG ; Log subsystem constants & variables
|
|---|
| 24 | N RORLRC ; List of codes of Lab results to be extracted
|
|---|
| 25 | ;
|
|---|
| 26 | N COUNTERS,DXBEG,DXEND,HDTIEN,MID,RC,TMP
|
|---|
| 27 | D INIT^RORUTL01("ROREXT")
|
|---|
| 28 | S DXBEG=$G(ROREXT("DXBEG")),DXEND="",HDTIEN=0
|
|---|
| 29 | K ^TMP("RORPTF",$J)
|
|---|
| 30 | ;--- Open a new log
|
|---|
| 31 | S TMP=$$SETUP^RORLOG(.REGLST)
|
|---|
| 32 | S TMP=$S($G(RORTASK)'="":" TASK #"_RORTASK,1:"")
|
|---|
| 33 | S TMP=$$OPEN^RORLOG(.REGLST,2,"DATA EXTRACTION"_TMP_" STARTED")
|
|---|
| 34 | D
|
|---|
| 35 | . ;--- Check the list of registries
|
|---|
| 36 | . I $D(REGLST)<10 D Q
|
|---|
| 37 | . . S RC=$$ERROR^RORERR(-28,,,,"extract data")
|
|---|
| 38 | . ;--- Lock parameters of the registries being processed
|
|---|
| 39 | . S RC=$$LOCKREG^RORUTL02(.REGLST,1,,"DATA EXTRACTION") Q:RC<0
|
|---|
| 40 | . I 'RC D Q
|
|---|
| 41 | . . S RC=$$ERROR^RORERR(-11,,,,"registries being processed")
|
|---|
| 42 | . ;--- Check for pending historical data extraction
|
|---|
| 43 | . I DXBEG'>0 D I HDTIEN<0 S RC=+HDTIEN Q
|
|---|
| 44 | . . S HDTIEN=$$FIND^RORHDT06(.REGLST,.DXBEG,.DXEND)
|
|---|
| 45 | . ;--- Load and process data extraction rules
|
|---|
| 46 | . S RC=$$PREPARE^ROREXPR(.REGLST,DXBEG,DXEND)
|
|---|
| 47 | . I RC<0 S RC=$$ERROR^RORERR(-22) Q
|
|---|
| 48 | . ;--- Load and process the historical data extraction parameters
|
|---|
| 49 | . I HDTIEN>0 D Q:RC<0
|
|---|
| 50 | . . S RC=$$PREPARE^RORHDT06(HDTIEN)
|
|---|
| 51 | . ;--- Reference the historical data extraction definition
|
|---|
| 52 | . S RC=$$REGREF^RORHDT06(.REGLST,HDTIEN) Q:RC<0
|
|---|
| 53 | . ;--- Display the debug information
|
|---|
| 54 | . D:$G(RORPARM("DEBUG"))>1 DEBUG^ROREXTUT
|
|---|
| 55 | . ;--- Extract and send the data
|
|---|
| 56 | . S RC=$$PROCESS(.REGLST) Q:RC<0
|
|---|
| 57 | . S COUNTERS=RC,RC=0
|
|---|
| 58 | . ;--- Update registry parameters
|
|---|
| 59 | . S TMP=$$TMSTMP^ROREXTUT(.REGLST)
|
|---|
| 60 | ;--- Unlock parameters of processed registries
|
|---|
| 61 | S TMP=$$LOCKREG^RORUTL02(.REGLST,0)
|
|---|
| 62 | ;
|
|---|
| 63 | ;--- Statistics & Cleanup
|
|---|
| 64 | S TMP="DATA EXTRACTION "_$S(RC<0:"ABORTED",1:"COMPLETED")
|
|---|
| 65 | D CLOSE^RORLOG(TMP,$G(COUNTERS))
|
|---|
| 66 | D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("ROREXT")
|
|---|
| 67 | K ^TMP("RORPTF",$J)
|
|---|
| 68 | ;---
|
|---|
| 69 | Q $S($G(RC)<0:RC,1:0)
|
|---|
| 70 | ;
|
|---|
| 71 | ;***** RETURNS THE NEXT PATIENT FOR DATA EXTRACTION
|
|---|
| 72 | ;
|
|---|
| 73 | ; PTIEN Patient IEN (DFN)
|
|---|
| 74 | ;
|
|---|
| 75 | ; .RGIENLST Reference to a local array containing registry
|
|---|
| 76 | ; IENs as subscripts. The IENs of the corresponding
|
|---|
| 77 | ; patient's registry records are returned as values.
|
|---|
| 78 | ;
|
|---|
| 79 | ; Return Values:
|
|---|
| 80 | ; 0 No more patients
|
|---|
| 81 | ; >0 IEN (DFN) of the next patient who belongs to at least
|
|---|
| 82 | ; one of the registries defined by the RGIENLST parameter.
|
|---|
| 83 | ;
|
|---|
| 84 | NEXTPAT(PTIEN,RGIENLST) ;
|
|---|
| 85 | N CNT,IEN,REGIEN,STATUS
|
|---|
| 86 | S CNT=0
|
|---|
| 87 | F S PTIEN=$O(^RORDATA(798,"KEY",PTIEN)) Q:PTIEN'>0 D Q:CNT
|
|---|
| 88 | . S REGIEN=0
|
|---|
| 89 | . F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D
|
|---|
| 90 | . . S RGIENLST(REGIEN)=0
|
|---|
| 91 | . . S IEN=+$O(^RORDATA(798,"KEY",PTIEN,REGIEN,""))
|
|---|
| 92 | . . Q:IEN'>0
|
|---|
| 93 | . . ;--- Skip all inactive records except marked for deletion
|
|---|
| 94 | . . I '$$ACTIVE^RORDD(IEN,,.STATUS) Q:STATUS'=5
|
|---|
| 95 | . . ;--- Skip a record tagged as "DON'T SEND"
|
|---|
| 96 | . . Q:$P($G(^RORDATA(798,IEN,2)),U,4)
|
|---|
| 97 | . . ;--- Consider the record
|
|---|
| 98 | . . S RGIENLST(REGIEN)=IEN,CNT=CNT+1
|
|---|
| 99 | Q $S(PTIEN>0:PTIEN,1:0)
|
|---|
| 100 | ;
|
|---|
| 101 | ;***** SCANS THE REGISTRY AND EXTRACTS THE DATA
|
|---|
| 102 | ;
|
|---|
| 103 | ; .REGLST Reference to a local array containing registry
|
|---|
| 104 | ; names as subscripts and registry IENs as values
|
|---|
| 105 | ;
|
|---|
| 106 | ; Return Values:
|
|---|
| 107 | ; <0 Error Code
|
|---|
| 108 | ; >=0 Statistics
|
|---|
| 109 | ; ^1: Total number of processed patients
|
|---|
| 110 | ; ^2: Number of patients processed with errors
|
|---|
| 111 | ;
|
|---|
| 112 | ; In normal mode this function processes all patients and returns
|
|---|
| 113 | ; total number of patients and number of patients processed with
|
|---|
| 114 | ; errors.
|
|---|
| 115 | ;
|
|---|
| 116 | ; However, in debug mode 3 the function stops after the first
|
|---|
| 117 | ; patient processed with error and returns an error code.
|
|---|
| 118 | ;
|
|---|
| 119 | PROCESS(REGLST) ;
|
|---|
| 120 | N CNT,DTNEXT,ECNT,PTIEN,RC,REGIEN,REGNAME,RGIENLST,RORBUF,RORMSG,TH,TMP
|
|---|
| 121 | ;--- Prepare the list of registry IENs
|
|---|
| 122 | S REGNAME="",REGIEN=0
|
|---|
| 123 | F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:REGIEN<0
|
|---|
| 124 | . S REGIEN=+REGLST(REGNAME)
|
|---|
| 125 | . S:REGIEN'>0 REGIEN=$$REGIEN^RORUTL02(REGNAME)
|
|---|
| 126 | . S:REGIEN>0 RGIENLST(REGIEN)=""
|
|---|
| 127 | Q:REGIEN<0 REGIEN
|
|---|
| 128 | ;--- Initialize environment variables
|
|---|
| 129 | S RC=$$INIT^RORHL7() Q:RC<0 RC
|
|---|
| 130 | ;
|
|---|
| 131 | ;--- Generate the registry state message
|
|---|
| 132 | S RC=$$CREATE^RORHL7() Q:RC<0 RC
|
|---|
| 133 | S REGIEN=0
|
|---|
| 134 | F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:RC<0
|
|---|
| 135 | . S RC=$$REGSTATE^ROREXT03(REGIEN)
|
|---|
| 136 | Q:RC<0 RC
|
|---|
| 137 | ;
|
|---|
| 138 | ;--- Loop through the patients of the registries
|
|---|
| 139 | S (CNT,ECNT,PTIEN,RC)=0
|
|---|
| 140 | F S PTIEN=$$NEXTPAT(PTIEN,.RGIENLST) Q:PTIEN'>0 D Q:RC
|
|---|
| 141 | . ;--- For a queued task only
|
|---|
| 142 | . I $D(ZTQUEUED) S RC=0 D Q:RC<0
|
|---|
| 143 | . . ;--- Check if task stop has been requested
|
|---|
| 144 | . . I $$S^%ZTLOAD S RC=$$ERROR^RORERR(-42) Q
|
|---|
| 145 | . . ;--- Check if the task should be suspended
|
|---|
| 146 | . . Q:'$G(ROREXT("SUSPEND"))
|
|---|
| 147 | . . Q:$$NOW^XLFDT<$G(DTNEXT)
|
|---|
| 148 | . . Q:'$$SUSPEND(.DTNEXT)
|
|---|
| 149 | . . ;--- Suspend the task during the peak hours
|
|---|
| 150 | . . F D Q:'TH!(RC<0)
|
|---|
| 151 | . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
|
|---|
| 152 | . . . I TH<60 S TH=0 Q ; Do not HANG for less than a
|
|---|
| 153 | . . . H $S(TH>3600:3600,1:TH) ; minute and more than an hour
|
|---|
| 154 | . . . ;--- Check if task stop has been requested
|
|---|
| 155 | . . . S:$$S^%ZTLOAD RC=$$ERROR^RORERR(-42)
|
|---|
| 156 | . ;--- Process the patient's records
|
|---|
| 157 | . S CNT=CNT+1
|
|---|
| 158 | . I $G(RORPARM("DEBUG"))>1 W:$E($G(IOST),1,2)="C-" *13,CNT
|
|---|
| 159 | . S RC=$$PROCPAT(PTIEN,.RGIENLST)
|
|---|
| 160 | . ;--- Process the error (if any)
|
|---|
| 161 | . I RC<0 D S:$G(RORPARM("DEBUG"))<3 RC=0 Q
|
|---|
| 162 | . . S ECNT=ECNT+1,RC=$$ERROR^RORERR(-15,,,$G(PTIEN))
|
|---|
| 163 | . ;--- Send the batch HL7 message when the maximum size is reached
|
|---|
| 164 | . S:$$ISMAXSZ^RORHL7() RC=$$SEND^ROREXT03(.RGIENLST)
|
|---|
| 165 | Q:RC<0 RC
|
|---|
| 166 | ;
|
|---|
| 167 | ;--- Send the remaining data (flush the buffer)
|
|---|
| 168 | S RC=$$SEND^ROREXT03(.RGIENLST) Q:RC<0 RC
|
|---|
| 169 | ;
|
|---|
| 170 | ;--- Return number of processed patients and number of errors
|
|---|
| 171 | Q CNT_U_ECNT
|
|---|
| 172 | ;
|
|---|
| 173 | ;***** PROCESS THE PATIENT'S REGISTRY RECORDS
|
|---|
| 174 | ;
|
|---|
| 175 | ; PTIEN Patient IEN (DFN)
|
|---|
| 176 | ;
|
|---|
| 177 | ; .RGIENLST Reference to a local array containing registry
|
|---|
| 178 | ; IENs as subscripts and IENs of the corresponding
|
|---|
| 179 | ; patient's registry records as values.
|
|---|
| 180 | ;
|
|---|
| 181 | ; Return Values:
|
|---|
| 182 | ; <0 Error Code
|
|---|
| 183 | ; 0 Ok
|
|---|
| 184 | ;
|
|---|
| 185 | PROCPAT(PTIEN,RGIENLST) ;
|
|---|
| 186 | N RORERRDL ; Default error location
|
|---|
| 187 | ;
|
|---|
| 188 | N BATCHID,CNT,DXDTS,IEN,MSHPTR,RC,REGIEN,RORMSH,TMP
|
|---|
| 189 | D CLEAR^RORERR("PROCPAT^ROREXT01")
|
|---|
| 190 | ;
|
|---|
| 191 | ;--- Compile the data extraction time frames
|
|---|
| 192 | S (CNT,RC,REGIEN)=0
|
|---|
| 193 | F S REGIEN=$O(RGIENLST(REGIEN)) Q:REGIEN'>0 D Q:RC<0
|
|---|
| 194 | . S IEN=+RGIENLST(REGIEN) Q:IEN'>0
|
|---|
| 195 | . S RC=$$DXPERIOD^ROREXTUT(.DXDTS,IEN,PTIEN)
|
|---|
| 196 | . S:'RC CNT=CNT+1
|
|---|
| 197 | . S:RC>0 RGIENLST(REGIEN)=0
|
|---|
| 198 | Q:RC<0 RC
|
|---|
| 199 | ;--- If the patient should be skipped in all registries
|
|---|
| 200 | ; that are being processed, then do not perform the data
|
|---|
| 201 | ;--- extraction for this patient at all.
|
|---|
| 202 | I 'CNT D:$G(RORPARM("DEBUG")) Q 0
|
|---|
| 203 | . D LOG^RORLOG(4,"There is no data to extract.",PTIEN)
|
|---|
| 204 | ;
|
|---|
| 205 | ;--- Create an HL7 message for the patient
|
|---|
| 206 | S MSHPTR=$$CREATE^RORHL7(.RORMSH) Q:MSHPTR<0 MSHPTR
|
|---|
| 207 | S RC=$$MESSAGE^ROREXT02(PTIEN,.RGIENLST,.DXDTS,$G(ROREXT("HDTIEN")))
|
|---|
| 208 | ;
|
|---|
| 209 | ;--- Delete the unfinished message from the ^TMP("HLS",$J)
|
|---|
| 210 | ; if there is no data to send (RC>0) or there was an error
|
|---|
| 211 | ; during the data extraction (RC<0). Return the error code
|
|---|
| 212 | ;--- in the latter case.
|
|---|
| 213 | I RC!($O(^TMP("HLS",$J,""),-1)=MSHPTR) D Q:RC<0 RC
|
|---|
| 214 | . D ROLLBACK^RORHL7(MSHPTR) S:'RC RC=1
|
|---|
| 215 | ;
|
|---|
| 216 | ;--- Do not change state of the record(s) during the
|
|---|
| 217 | ;--- historical data extraction
|
|---|
| 218 | I $G(ROREXT("HDTIEN"))'>0 D Q:RC<0 RC
|
|---|
| 219 | . S TMP=$S('RC:$P(RORMSH,$E(RORMSH,4),10),1:"")
|
|---|
| 220 | . S RC=$$UPDRECS^ROREXT03(PTIEN,.RGIENLST,TMP,$P(DXDTS,U,2))
|
|---|
| 221 | ;---
|
|---|
| 222 | Q 0
|
|---|
| 223 | ;
|
|---|
| 224 | ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED
|
|---|
| 225 | ;
|
|---|
| 226 | ; .DTNEXT Date/Time of the next event (suspend/resume)
|
|---|
| 227 | ; is returned via this parameter
|
|---|
| 228 | ;
|
|---|
| 229 | ; Return Values:
|
|---|
| 230 | ; 0 Continue/Resume
|
|---|
| 231 | ; 1 Suspend
|
|---|
| 232 | ;
|
|---|
| 233 | SUSPEND(DTNEXT) ;
|
|---|
| 234 | N DATE,NOW,SUSPEND,TIME,TS,TR
|
|---|
| 235 | S TS=$P(ROREXT("SUSPEND"),U,1)
|
|---|
| 236 | S TR=$P(ROREXT("SUSPEND"),U,2)
|
|---|
| 237 | S NOW=$$NOW^XLFDT,DATE=NOW\1
|
|---|
| 238 | ;--- A work day
|
|---|
| 239 | I $$WDCHK^RORUTL01(DATE) D Q SUSPEND
|
|---|
| 240 | . S TIME=NOW-DATE,SUSPEND=0
|
|---|
| 241 | . I TIME<TS S DTNEXT=DATE+TS Q
|
|---|
| 242 | . I TIME'<TR S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS Q
|
|---|
| 243 | . S DTNEXT=DATE+TR,SUSPEND=1
|
|---|
| 244 | ;--- Saturday, Sunday or Holiday
|
|---|
| 245 | S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
|
|---|
| 246 | Q 0
|
|---|
