source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROREXTUT.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1ROREXTUT ;HCIOFO/SG - DATA EXTRACT UTILITIES ; 11/25/05 3:57pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** PRINT SOME DEBUG INFORMATION
7DEBUG ;
8 D ZW^RORUTL01("ROREXT","Control Data")
9 D ZW^RORUTL01("RORLRC","Lab Results to extract")
10 W !,"Job number: ",$J,!
11 Q
12 ;
13 ;***** ADDS THE TIME FRAME TO THE LIST
14 ;
15 ; .DXDTS Reference to a local variable where the
16 ; data extraction time frames are stored.
17 ;
18 ; STDT Start date (FileMan)
19 ; ENDT End Date (FileMan)
20 ;
21 ; DTAR Data area code (see the ROR DATA AREA file #799.33)
22 ;
23 ; [MAIN] If this parameter defined and not zero, the time
24 ; frame is considered the main one.
25 ;
26 ; Variants of positional relationship of the existing time frames
27 ; and the one that is being added to the list (STDT-ENDT):
28 ;
29 ; (1) +--------TMP +----------+
30 ; STDT--------ENDT
31 ;
32 ; (2) +--------TMP
33 ; STDT--------ENDT
34 ;
35 ; (3) TMP--------+
36 ; STDT--------ENDT
37 ;
38 ; (4) +--------+
39 ; STDT------------------ENDT
40 ;
41DXADD(DXDTS,STDT,ENDT,DTAR,MAIN) ;
42 Q:STDT>ENDT
43 N DATE,EXIT,TMP
44 ;--- Update the main time frame
45 I $G(MAIN) D S DTAR=0
46 . S TMP=+$P(DXDTS,U)
47 . S:(TMP'>0)!(STDT<TMP) $P(DXDTS,U,1)=STDT
48 . S:ENDT>$P(DXDTS,U,2) $P(DXDTS,U,2)=ENDT
49 ;--- Merge the time frames if possible
50 S DATE=$O(DXDTS(DTAR,ENDT)),EXIT=0
51 F S DATE=$O(DXDTS(DTAR,DATE),-1) Q:DATE="" D Q:EXIT
52 . S TMP=$P(DXDTS(DTAR,DATE),U,2)
53 . I TMP<STDT S EXIT=1 Q ; (1)
54 . S:TMP>ENDT ENDT=TMP ; (2)
55 . S TMP=$P(DXDTS(DTAR,DATE),U)
56 . S:TMP<STDT STDT=TMP ; (3)
57 . K DXDTS(DTAR,DATE)
58 ;--- Store the new time frame
59 S DXDTS(DTAR,STDT)=STDT_U_ENDT
60 Q
61 ;
62 ;***** CALCULATES THE MAIN DATA EXTRACTION TIME FRAME
63 ;
64 ; .DXDTS Reference to a local variable where the
65 ; data extraction time frames are stored.
66 ;
67 ; IEN IEN of the patient's record in the registry
68 ;
69 ; Return Values:
70 ; <0 Error Code
71 ; 0 Ok
72 ; >0 Skip the patient
73 ;
74 ; If the special extraction start date for all patients is defined
75 ; then it is as the start date of the main time frame. Usually,
76 ; this mode is not used. ;-)
77 ;
78 ; If the field #9.1 of the patient record in the registry (#798)
79 ; has a value then this value is used as the start date of the
80 ; main time frame (data have already been extracted until that
81 ; date). This field is empty for new patients.
82 ;
83 ; The function tries to get the earliest date when a selection rule
84 ; has been triggered for the newly added patient. If the patient has
85 ; been added manually and there are no selection rules in the
86 ; SELECTION RULE multiple of the registry record then a date when
87 ; the patient was added to the registry is used.
88 ;
89 ; After that, extract period for new patients (value of the field
90 ; #7 of the file #798.1) is subtracted from the date and the result
91 ; is used as the start date. If the extract period is not set for
92 ; the registry then a default value (365) is used.
93 ;
94DXMAIN(DXDTS,IEN) ;
95 N ENDT,IENS,LCH,RC,RORBUF,RORMSG,STDT,TMP
96 S (ENDT,STDT)="",IENS=IEN_",",LCH=0
97 ;--- Get the registry record data
98 D GETS^DIQ(798,IENS,"1;3;3.2;4;5;9.1","I","RORBUF","RORMSG")
99 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
100 S ENDT=$$FMADD^XLFDT(ROREXT("DXEND"),-$G(ROREXT("LD",1)))
101 F TMP=4,5 S:$G(RORBUF(798,IENS,TMP,"I")) LCH=1
102 ;--- Empty time frame for patients who are marked for deletion
103 I $G(RORBUF(798,IENS,3,"I"))=5 D Q 0
104 . D DXADD(.DXDTS,ENDT,ENDT,0,1)
105 ;--- Special start date for ALL patients (if defined)
106 S STDT=$G(ROREXT("DXBEG"))
107 I STDT'>0 D
108 . ;--- Start date from the patient's registry record
109 . ;--- (value of the DATA ACKNOWLEDGED UNTIL field)
110 . S STDT=$G(RORBUF(798,IENS,9.1,"I"))\1 Q:STDT>0
111 . ;--- If value of the DATA ACKNOWLEDGED UNTIL field is missing or
112 . ; not greater than 0, then the patient is considered new and
113 . ; the start date is calculated as date of earliest selection
114 . ; rule minus maximum value of the EXTRACT PERIOD FOR NEW
115 . ;--- PATIENT field for all processed registries.
116 . S STDT=$G(RORBUF(798,IENS,3.2,"I")) Q:STDT'>0
117 . S TMP=+$G(ROREXT("EXTRDAYS"))
118 . S STDT=$$FMADD^XLFDT(STDT,-$S(TMP>0:TMP,1:365))\1
119 ;--- Check the dates and add the time frame to the list
120 I (STDT'>0)!(ENDT'>0) D Q RC
121 . S TMP=$$GET1^DIQ(798,IENS,.01,"I",,"RORMSG")
122 . S RC=$$ERROR^RORERR(-32,,,TMP,STDT,ENDT)
123 S RC=0
124 I STDT'<ENDT S RC=1 S:LCH STDT=ENDT,RC=0
125 D:'RC DXADD(.DXDTS,STDT,ENDT,0,1)
126 Q RC
127 ;
128 ;***** MERGES SPECIAL TIME FRAMES INTO THE 'DATA-SPECIFIC' LISTS
129 ;
130 ; .DXDTS Reference to a local variable where the
131 ; data extraction time frames are stored.
132 ;
133DXMERGE(DXDTS) ;
134 N DTAR,TMP
135 S DTAR=0
136 F S DTAR=$O(ROREXT("DTAR",DTAR)) Q:DTAR'>0 D
137 . ;--- Main time frame
138 . D DXADD(.DXDTS,$P(DXDTS,U),$P(DXDTS,U,2),DTAR)
139 . ;--- Data-specific time frame
140 . S TMP=$G(ROREXT("DTAR",DTAR))
141 . D:TMP>0 DXADD(.DXDTS,$P(TMP,U),$P(TMP,U,2),DTAR)
142 Q
143 ;
144 ;***** ADDS DATA EXTRACTION PERIODS FOR THE PATIENT TO THE LIST
145 ;
146 ; .DXDTS Reference to a local variable that the data
147 ; extraction time frames are added to. The
148 ; main time frame is returned in the root node:
149 ;
150 ; DXDTS( MainStartDate^MainEndDate (FileMan)
151 ; DataArea,
152 ; i) StartDate^EndDate (FileMan)
153 ;
154 ; IEN IEN of the patient record in the registry
155 ;
156 ; PATIEN Patient IEN
157 ;
158 ; Return Values:
159 ; <0 Error Code
160 ; 0 Ok
161 ; >0 Skip the patient
162 ;
163DXPERIOD(DXDTS,IEN,PATIEN) ;
164 N AREA,ENDT,EVTDT,EVTIEN,NODE,RC,STDT,TMP
165 S DXDTS=$G(DXDTS)
166 ;
167 ;=== Main data extraction time frame
168 S RC=$$DXMAIN(.DXDTS,IEN) Q:RC RC
169 ;
170 ;=== Data-specific protocols (only Inpatient at present)
171 ; The Inpatient protocol is not used anymore because now the
172 ; data search is performed on the PTF CLOSE OUT file instead
173 ; of the PTF file (after patch ROR*1*8).
174 ;S NODE=$NA(^RORDATA(798.3,+PATIEN,2))
175 ;F AREA=3 D
176 ;. ;--- Browse the events in the main time frame
177 ;. S EVTDT=$O(@NODE@("AT",AREA,+DXDTS),-1)
178 ;. S ENDT=+$P(DXDTS,U,2)
179 ;. F S EVTDT=$O(@NODE@("AT",AREA,EVTDT)) Q:'EVTDT!(EVTDT'<ENDT) D
180 ;. . S EVTIEN=""
181 ;. . F S EVTIEN=$O(@NODE@("AT",AREA,EVTDT,EVTIEN)) Q:EVTIEN="" D
182 ;. . . S TMP=$P($G(@NODE@(EVTIEN,0)),U,3)\1
183 ;. . . D:TMP>0 DXADD(.DXDTS,TMP,$$FMADD^XLFDT(TMP,1),AREA)
184 ;
185 ;=== Data-specific 'sliding windows'
186 D:$G(ROREXT("HDTIEN"))'>0
187 . S STDT=$$FMADD^XLFDT($P(DXDTS,U,1),-60)
188 . S ENDT=$$FMADD^XLFDT($P(DXDTS,U,2),-60)
189 . D DXADD(.DXDTS,STDT,ENDT,7) ; Autopsy
190 ;
191 ;=== Merge the main time frame into the data-specific ones
192 D DXMERGE(.DXDTS)
193 Q 0
194 ;
195 ;***** UPDATES DATA EXTRACTION PARAMETERS OF THE REGISTRY
196 ;
197 ; .REGLST Reference to a local array containing registry names
198 ; as subscripts and optional registry IENs as values
199 ;
200 ; Return values:
201 ; <0 Error code
202 ; 0 Ok
203 ;
204TMSTMP(REGLST) ;
205 N DATE,RC,REGIEN,REGIENS,REGNAME,RORFDA,RORMSG
206 S RC=0,DATE=ROREXT("DXEND")\1
207 ;---
208 S REGNAME=""
209 F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
210 . ;--- Get the registry IEN
211 . S REGIEN=+$G(REGLST(REGNAME))
212 . I REGIEN'>0 D I REGIEN'>0 S RC=+REGIEN Q
213 . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
214 . S REGIENS=REGIEN_","
215 . ;--- Do not update timestamp after historical data extractions
216 . I $G(ROREXT("HDTIEN"))'>0 D Q:RC<0
217 . . ;--- Check if the new date until that data has been extracted
218 . . ; is greater than that stored in the registry parameters
219 . . S TMP=$$GET1^DIQ(798.1,REGIENS,2,"I",,"RORMSG")
220 . . I $G(DIERR) D Q
221 . . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
222 . . S:DATE>TMP RORFDA(798.1,REGIENS,2)=DATE
223 . ;--- Increment the number of attempts
224 . D:$G(ROREXT("NBM"))>0
225 . . S TMP=$$GET1^DIQ(798.1,REGIENS,19.3,"I",,"RORMSG")
226 . . S RORFDA(798.1,REGIENS,19.3)=TMP+1
227 . ;--- Update registry parameters
228 . Q:$D(RORFDA)<10
229 . D FILE^DIE("K","RORFDA","RORMSG")
230 . I $G(DIERR) D Q
231 . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
232 . ;--- Reset all report stats
233 . D CLEAR^RORTSK12(REGIEN)
234 ;---
235 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.