source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD01.m@ 623

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

initial load of WorldVistAEHR

File size: 9.0 KB
Line 
1RORUPD01 ;HCIOFO/SG - PROCESSING OF THE FILES ; 7/21/03 10:19am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IA's:
5 ;
6 ; #3646 $$EMPL^DGSEC4
7 ; #10035 Browse through IENs of the file #2
8 ;
9 Q
10 ;
11 ;***** CHECKS FOR A STOP REQUESTS (TASKMAN & PROPRIETARY)
12 ;
13 ; Return Values:
14 ; 0 Continue running
15 ; 1 Stop the subtask
16 ;
17CHKSTOP() ;
18 Q:'$G(RORUPD("JOB")) $$S^%ZTLOAD
19 L +@RORUPDPI@("T",0):0
20 I L -@RORUPDPI@("T",0) Q 1
21 Q $$S^%ZTLOAD
22 ;
23 ;***** LOAD DATA ELEMENTS
24 ;
25 ; IENS IENS of the current record
26 ;
27 ; Return values:
28 ; <0 Error code
29 ; 0 Ok
30 ;
31LOAD(IENS) ;
32 N RC S RC=0
33 ;--- API #1
34 I $D(RORUPD("SR",2,"F",1)) D Q:RC<0 RC
35 . S RC=$$LOADFLDS^RORUPDUT(2,IENS)
36 ;--- API #2
37 Q 0
38 ;
39 ;***** INITIALIZES LOOP CONTROL LISTS
40 ;
41 ; PATIEN Patient IEN
42 ;
43 ; Return Values:
44 ; <0 Error code
45 ; 0 Ok
46 ;
47 ; The RORUPD("LM",1,Rule Name) list contains names of the top level
48 ; rules that have not been triggered by now.
49 ;
50 ; The RORUPD("LM",2,Registry#) list contains IENs of the registries
51 ; that do not contain the patient by now.
52 ;
53 ; If the patient is an employee and the registry must not include
54 ; employees (see the EXCLUDE EMPLOYEES field of the ROR REGISTRY
55 ; PARAMETERS file), the function initializes the corresponding items
56 ; of control lists as if the patient were already in the registry.
57 ; Therefore, the patient will not be added to this registry.
58 ;
59LOOPINIT(PATIEN) ;
60 N I,EMPL,REGIEN
61 K RORUPD("LM",1),RORUPD("LM",2)
62 S EMPL=$$EMPL^DGSEC4(PATIEN,"P")
63 M RORUPD("LM",1)=RORUPD("LM1")
64 S REGIEN=""
65 F S REGIEN=$O(RORUPD("LM2",REGIEN)) Q:REGIEN="" D
66 . S $P(RORUPD("LM2",REGIEN),U)=0
67 . ;--- Check if the patient is already in the registry
68 . Q:$D(^RORDATA(798,"KEY",PATIEN,REGIEN))
69 . ;--- Check if the patient is an employee and the
70 . ;--- employees must not be added to the registry
71 . I EMPL Q:$P(RORUPD("LM2",REGIEN),U,2)
72 . ;--- Initialize the items of control lists
73 . S $P(RORUPD("LM2",REGIEN),U)=1,RORUPD("LM",2,REGIEN)=""
74 Q 0
75 ;
76 ;***** PROCESS EVERY PATIENT IN THE 'PATIENT' FILE
77 ;
78 ; BEGIEN Start IEN in the PATIENT file
79 ; ENDIEN End IEN in the PATIENT file
80 ;
81 ; Return Values:
82 ; <0 Error code
83 ; >=0 Statistics
84 ; ^1: Total number of processed patients
85 ; ^2: Number of patients processed with errors
86 ;
87 ; If there is an error in processing of a patient, routine behavior
88 ; depends on the mode of execution:
89 ;
90 ; In the normal mode program logs the errors, adds a record to the
91 ; ROR PATIENT EVENTS file (#798.3), and continues processing of
92 ; the remaining patients. Next registry update wil start data scan
93 ; for this patient from the date stored in the file #798.3.
94 ;
95 ; In the debug mode 3 program is aborted if there is an error
96 ; during processing of a patient.
97 ;
98PROCESS(BEGIEN,ENDIEN) ;
99 N CNT,DTNEXT,ECNT,EXIT,PATIEN,RC,TH,TMP
100 ;--- Loop through the patients
101 S:$G(ENDIEN)'>0 ENDIEN=0
102 S PATIEN=$S($G(BEGIEN)>0:$O(^DPT(BEGIEN),-1),1:0)
103 S (CNT,ECNT,EXIT,RC)=0
104 F S PATIEN=$O(^DPT(PATIEN)) Q:PATIEN'>0 D Q:EXIT!(RC<0)
105 . I ENDIEN,PATIEN'<ENDIEN S EXIT=1 Q
106 . ;--- For a queued task only
107 . I $D(ZTQUEUED) S RC=0 D Q:RC<0
108 . . ;--- Check if task stop has been requested
109 . . I $$CHKSTOP() S RC=$$ERROR^RORERR(-42) Q
110 . . ;--- Check if the task should be suspended
111 . . Q:'$G(RORUPD("SUSPEND"))
112 . . Q:$$NOW^XLFDT<$G(DTNEXT)
113 . . Q:'$$SUSPEND(.DTNEXT)
114 . . ;--- Suspend the task during the peak hours
115 . . F D Q:'TH!(RC<0)
116 . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
117 . . . I TH<60 S TH=0 Q ; Do not HANG for less than a
118 . . . H $S(TH>3600:3600,1:TH) ; minute and more than an hour
119 . . . ;--- Check if task stop has been requested
120 . . . S:$$CHKSTOP() RC=$$ERROR^RORERR(-42)
121 . ;--- Update the progress indicator
122 . S CNT=CNT+1
123 . I $G(RORPARM("DEBUG"))>1 W:$E($G(IOST),1,2)="C-" *13,CNT
124 . ;--- Process the patient
125 . S RC=$$PROCPAT(PATIEN)
126 . I $G(RORPARM("SETUP")) D:'(CNT#1000)
127 . . D LOG^RORLOG(2,"Number of patients processed by now: "_CNT)
128 . ;--- Process the error (if any)
129 . I RC<0 D S:$G(RORPARM("DEBUG"))<3 RC=0
130 . . I RC=-66 S RC=0 Q ; Counter in the file #798.3
131 . . S ECNT=ECNT+1
132 . . S RC=$$ERROR^RORERR(-15,,,PATIEN)
133 . . ;--- Create a record in the file #798.3
134 . . S TMP=$$ADD^RORUPP01(PATIEN,RORUPD("DSBEG"))
135 . . S:TMP<0 RC=TMP
136 Q $S(RC<0:RC,1:CNT_"^"_ECNT)
137 ;
138 ;***** PROCESSES PATIENT'S DATA (EXCEPT DEMOGRAPHIC DATA)
139 ;
140 ; PATIEN Patient IEN
141 ; [NOUPD] Disable registry update (0 by default)
142 ;
143 ; Return Values:
144 ; <0 Error code
145 ; 0 Ok
146 ;
147 ; If there is a record for the patient in the ROR PATIENT EVENTS
148 ; file (#798.3) and date in that record is less than a value of the
149 ; RORUPD("DSBEG") then it is used as a start date of the data scan
150 ; for the patient. Otherwise, the RORUPD("DSBEG") is used.
151 ;
152PROCPAT(PATIEN,NOUPD) ;
153 ;--- Quit if the patient has already been processed
154 Q:$D(@RORUPDPI@("U",PATIEN)) 0
155 ;--- Quit if the patient's record has been merged
156 Q:$G(^DPT(PATIEN,-9)) 0
157 ;--- Do not update the registries with a "test patient"
158 I '$G(NOUPD),$$TESTPAT^RORUTL01(PATIEN) D Q 0
159 . S @RORUPDPI@("U",PATIEN)=""
160 ;
161 N RORERRDL ; Default error location
162 ;
163 N PATIENS,RC,RLST,RORMSG,SDSDT,TMP,UPDREG,UPDSTART
164 S PATIENS=PATIEN_","
165 ;--- Initialize the variables
166 D CLEAR^RORERR("PROCPAT^RORUPD01"),CLREC^RORUPDUT
167 K RORVALS ; Clear all calculated values
168 S RC=$$LOOPINIT(PATIEN) Q:RC<0 RC
169 ;
170 ;--- If the loop control list of registries is empty, the patient
171 ; is already in all the registries that we are going to process.
172 S UPDREG=0
173 I $D(RORUPD("LM",2))>1 S RC=0 D G:RC<0 PPEX S UPDREG='$G(NOUPD)
174 . ;--- Determine start date of the data scan
175 . S UPDSTART=RORUPD("DSBEG")
176 . S SDSDT=$$SDSDATE^RORUPP01(PATIEN)
177 . I SDSDT<0 S RC=SDSDT Q
178 . I SDSDT S:SDSDT<UPDSTART UPDSTART=SDSDT
179 . S UPDSTART=$$FMADD^XLFDT(UPDSTART\1,-RORUPD("LD",1))
180 . ;--- Load necessary data elements
181 . I $D(RORUPD("SR",2,"F"))>1 D Q:RC<0
182 . . S RC=$$LOAD(PATIENS)
183 . D SETVAL^RORUPDUT("ROR DFN",PATIEN)
184 . ;--- Apply "before" rules
185 . S RC=$$APLRULES^RORUPDUT(2,PATIENS,"B") Q:RC
186 . ;
187 . ;--- Process patient data from other VistA files
188 . I $D(RORUPD("SR",9000010)) D Q:RC
189 . . S RC=$$VISIT^RORUPD08(UPDSTART,PATIEN)
190 . I $D(RORUPD("SR",9000011)) D Q:RC
191 . . S RC=$$PROBLEM^RORUPD07(UPDSTART,PATIEN)
192 . I $D(RORUPD("SR",45)) D Q:RC
193 . . S RC=$$PTF^RORUPD09(UPDSTART,PATIEN)
194 . I $D(RORUPD("SR",63)) D Q:RC
195 . . S RC=$$LAB^RORUPD04(UPDSTART,PATIEN)
196 . ; <--- Insert processing of other files here. Do not forget to add
197 . ; definitions of these files into the 'ROR METADATA' file.
198 . ;
199 . ;--- Apply "after" rules
200 . S RC=$$APLRULES^RORUPDUT(2,PATIENS,"A") Q:RC
201 ;
202 ;--- Update the registries if necessary
203 I UPDREG S RC=$$UPDREG^RORUPD50(PATIEN) G:RC<0 PPEX
204 ;--- Error processing
205 I $$GETEC^RORUPDUT D S RC=-15
206 . S RLST=$NA(@RORUPDPI@("U",PATIEN,2))
207 E S RLST="",RC=0
208 ;--- If there are records in the file #798.3 for the patient,
209 ; remove them (log a warning if cannot remove). If the patient
210 ; has been processed with errors, remove only records associated
211 ;--- with the registries that the patient has been added to.
212 D:$G(SDSDT)
213 . S TMP=$$REMOVE^RORUPP01(PATIEN,RLST)
214 . S:TMP<0 TMP=$$ERROR^RORERR(-31,,,PATIEN)
215 ;--- Mark the patient as processed
216 S @RORUPDPI@("U",PATIEN)=""
217PPEX ;--- Cleanup
218 D CLRDES^RORUPDUT(2)
219 Q RC
220 ;
221 ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED
222 ;
223 ; .DTNEXT Date/Time of the next event (suspend/resume)
224 ; is returned via this parameter
225 ;
226 ; Return Values:
227 ; 0 Continue/Resume
228 ; 1 Suspend
229 ;
230SUSPEND(DTNEXT) ;
231 N DATE,NOW,SUSPEND,TIME,TS,TR
232 S TS=$P(RORUPD("SUSPEND"),U,1)
233 S TR=$P(RORUPD("SUSPEND"),U,2)
234 S NOW=$$NOW^XLFDT,DATE=NOW\1
235 ;--- A working day
236 I $$WDCHK^RORUTL01(DATE) D Q SUSPEND
237 . S TIME=NOW-DATE,SUSPEND=0
238 . I TIME<TS S DTNEXT=DATE+TS Q
239 . I TIME'<TR S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS Q
240 . S DTNEXT=DATE+TR,SUSPEND=1
241 ;--- Saturday, Sunday or Holiday
242 S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
243 Q 0
244 ;
245 ;***** UPDATES REGISTRY UPDATE PARAMETERS
246 ;
247 ; .REGLST Reference to a local array containing registry names
248 ; as subscripts and optional registry IENs as values
249 ;
250 ; Return values:
251 ; <0 Error code
252 ; 0 Ok
253 ;
254TMSTMP(REGLST) ;
255 N DATE,RC,REGIEN,REGIENS,REGNAME,RORFDA,RORMSG,TMP
256 S REGNAME="",RC=0
257 F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
258 . S REGIEN=+$G(REGLST(REGNAME))
259 . I REGIEN'>0 D I REGIEN'>0 S RC=+REGIEN Q
260 . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
261 . S REGIENS=REGIEN_","
262 . ;--- Check if the new date until that registry is updated is
263 . ; greater than that stored in the registry parameters
264 . S TMP=$$GET1^DIQ(798.1,REGIENS,1,"I",,"RORMSG")
265 . I $G(DIERR) D Q
266 . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
267 . S DATE=RORUPD("DSEND")\1
268 . S:DATE>TMP RORFDA(798.1,REGIENS,1)=DATE
269 . ;--- Update registry parameters (if necessary)
270 . Q:$D(RORFDA)<10
271 . D FILE^DIE("K","RORFDA","RORMSG")
272 . I $G(DIERR) D Q
273 . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
274 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.