source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROREXT01.m@ 770

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

initial load of FOIAVistA 6/30/08 version

File size: 8.4 KB
Line 
1ROREXT01 ;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 ;
21INTEXT(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 ;
84NEXTPAT(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 ;
119PROCESS(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 ;
185PROCPAT(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 ;
233SUSPEND(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
Note: See TracBrowser for help on using the repository browser.