source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHDT04.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1RORHDT04 ;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 ;
22EXTRACT(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 ;
165NEXTPAT(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 ;
195PROCREC(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
Note: See TracBrowser for help on using the repository browser.