source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMBULK.m@ 1046

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

initial load of WorldVistAEHR

File size: 8.5 KB
Line 
1IVMBULK ;ALB/KCL - IVM/ENROLLMENT Extract ; 18-AUG-1997
2 ;;2.0;INCOME VERIFICATION MATCH;**9**; 21-OCT-94
3 ;
4 ; * This extract will scan the PATIENT (#2) file for patients that
5 ; meet the following enrollment extract selection criteria:
6 ;
7 ; [Patient has a current enrollment]
8 ; AND
9 ; [Enrollment status is 'Pending'
10 ; OR
11 ; Enrollment status is 'Unverified'
12 ; OR
13 ; Enrollment status is 'Verified']
14 ;
15 ; OR,
16 ;
17 ; [Patient is a Veteran]
18 ; AND
19 ; [Patient is a current inpatient
20 ; OR
21 ; Patient was an inpatient after 1/1/96
22 ; OR
23 ; Patient was an outpatient after 1/1/96]
24 ;
25 ;
26 ; * An HL7 "Full Data Transmission" message (Z07) will be built
27 ; for each patient selected. HL7 messages will be output to a
28 ; selected host file.
29 ;
30 ; * A mail message will be generated upon completion of the initial
31 ; data extract. This mail message will contian the results of
32 ; the extract.
33 ;
34 ; * This job will be queued.
35 ;
36 ;
37EN(IVMARRY1,IVMCONST) ; --
38 ; Description: Entry point responsible for queuing off the enrollment extract job.
39 ;
40 ; Input: None
41 ;
42 ; Output:
43 ; IVMARRY1 - as array containing required input parameters for enrollment extract job, pass by reference
44 ; IVMCONST - as array containing enrollment extract constants, pass by reference
45 ;
46 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,QUIT
47 ;
48 S QUIT=0
49 ;
50 ; lock IVM Extract Mangement file, otherwise exit
51 I '$$LOCK^IVMBULK2(1) D G ENQ
52 .W !,">>> This job has already been queued!"
53 ;
54 ; if environment check fails, exit
55 I '$$ENV() S QUIT=1 G ENQ
56 ;
57 ; get extract constants
58 I $$GETCONST^IVMBULK2(.IVMCONST)
59 ;
60 ; get IVM Extract Management record
61 I '$$GET^IVMBULK2(.IVMARRY1) D
62 .;
63 .; - if no IVM Extract Mgmt. record, init IVM Extract Mgmt. record
64 .I $$INIT^IVMBULK2(.IVMARRY1)
65 ;
66 ; don't want sites to unknowingly run extract again
67 I IVMARRY1("EXTRACT"),'IVMARRY1("LASTPAT") D G:QUIT ENQ
68 .W !,"> > > W A R N I N G",*7
69 .W !,?5,"The enrollment data extract has already run to completion!"
70 .W !,?5,"Do NOT run the extract again unless you have first deleted the"
71 .W !,?5,"host files that contain the prior extract!",!
72 .D INQUIRE^IVMBULK2("^IVM(301.63,",1)
73 .N DIR
74 .S DIR(0)="Y"
75 .S DIR("A")="Do you want to run the enrollment extract again"
76 .S DIR("B")="NO"
77 .D ^DIR
78 .I $D(DIRUT)!(Y'=1) D
79 ..S QUIT=1
80 .E D
81 ..D CLEAR(.IVMARRY1)
82 ;
83 ; write user info
84 D HDR1
85 ;
86 ; calculate extract size/time estimates
87 S IVMARRY1("PROJECT")=""
88 D EST(.IVMARRY1,.IVMCONST)
89 ;
90 ; if user time-out or abort, exit
91 I '$$PAUSE() S QUIT=1 G ENQ
92 ;
93 ; if directory not specified, exit
94 I IVMARRY1("DIR")="",('$$PATH^IVMBULK2(.IVMARRY1)) S QUIT=1 G ENQ
95 ;
96 ; queue enrollment extract job
97 S ZTSAVE("IVMARRY1(")="",ZTSAVE("IVMCONST(")=""
98 S ZTDESC="Enrollment Initial Data Extract",ZTRTN="GOGO^IVMBULK1",ZTIO=""
99 D ^%ZTLOAD,HOME^%ZIS
100 I $D(ZTSK) W !,"This job has been queued. The task number is "_ZTSK_"."
101 I '$D(ZTSK) W !,"Unable to queue this job." S QUIT=1
102 ;
103ENQ ;
104 ; if job is not queued, unlock IVM EXTRACT MANAGEMENT file
105 I QUIT D UNLOCK^IVMBULK2(1)
106 Q
107 ;
108 ;
109ENV() ; --
110 ; Description: This function performs an environment check for the enrollment initial data extract job.
111 ;
112 ; Input: None
113 ;
114 ; Output:
115 ; Function Value - Extract environment check successful?
116 ; Return 1 if successful, otherwise 0
117 ;
118 N IVMOK
119 S IVMOK=1
120 ;
121 I '($D(DUZ)#2) W *7,!,"You must have a valid DUZ defined before running this routine!" S IVMOK=0
122 ;
123 Q IVMOK
124 ;
125 ;
126PAUSE() ; --
127 ; Description: End-of-Page, Press return to continue or "^" to exit.
128 ;
129 ; Input: None
130 ;
131 ; Output: Function value - returns 1 if success, 0 otherwise
132 ;
133 N DIR,DIRUT,DUOUT,SUCCESS,Y
134 S SUCCESS=0
135 ;
136 S DIR(0)="E"
137 D ^DIR
138 I $D(DIRUT)!($D(DUOUT)) G PAUSEQ
139 ;
140 S SUCCESS=1
141 ;
142PAUSEQ Q SUCCESS
143 ;
144 ;
145EST(IVMARRY1,IVMCONST) ; --
146 ; Description: Calculate extract size/time estimates.
147 ;
148 ; Input:
149 ; IVMARRY1 - as array containing required input parameters for enrollment extract job, pass by reference
150 ; IVMCONST - as array containing enrollment extract constants, pass by reference
151 ;
152 ; Output: None
153 ;
154 N IVMTOTAL,X,X2,X3
155 ;
156 ; total patients in PATIENT file
157 S IVMTOTAL=$$TOTPAT(1)
158 ;
159 ; if extract complete, exit
160 I IVMTOTAL'>$G(IVMARRY1("PROC")) G ESTQ
161 ;
162 ; write estimate disclaimer
163 D HDR2(.IVMCONST)
164 ;
165 S IVMTOTAL=IVMTOTAL-$G(IVMARRY1("PROC"))
166 S X=IVMTOTAL,X2=0,X3=10 D COMMA^%DTC
167 W !,?7,"Estimated number of patients to be processed: "_X
168 ;W !,?7,"Estimated time of extract: "_$$TIMEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("AVG100"))
169 S X=$$TIMEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("AVG100"))
170 W !,?7,"Estimated time of extract: "_$P(X,"^",1)_" Hours "_$P(X,"^",2)_" Minutes"
171 S IVMARRY1("PROJECT")=$$FMADD^XLFDT($$NOW^XLFDT,0,$P(X,"^",1),$P(X,"^",2),0)
172 S X=($$SIZEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("SIZE"))\1),X2=0,X3=20 D COMMA^%DTC
173 W !,?7,"Estimated amount of disk space (bytes): "_X
174 W !
175ESTQ Q
176 ;
177 ;
178TOTPAT(ESTIMATE) ; --
179 ; Description: This function counts the number of records in the PATIENT file.
180 ;
181 ; Input:
182 ; ESTIMATE - (optional) if not passed, an actual patient count will be returned as the function value. If ESTIMATE=1, then an estimated number of patients in the Patient (#2) file will be returned as the function value.
183 ;
184 ; Output:
185 ; Function Value - If ESTIMATE=1 the actual count of records in the patient file, otherwise the estimated count of records in the patient file.
186 ;
187 N COUNT,DFN
188 S (COUNT,DFN)=0
189 ;
190 ; if flag, estimated count of records in Patient (#2) file (header node)
191 I $G(ESTIMATE) S COUNT=$P($G(^DPT(0)),"^",4)
192 ;
193 ELSE D
194 .;
195 .; - loop through Patient (#2) file for actual count of records
196 .F S DFN=$O(^DPT(DFN)) Q:'DFN S COUNT=COUNT+1
197 ;
198 Q COUNT
199 ;
200 ;
201TIMEST(COUNT,PERCN,AVG100) ; --
202 ; Description: This function will return a time estimate as to how long the initial data extract will run.
203 ;
204 ; Input:
205 ; COUNT - number of patients in the PATIENT file
206 ; PERCN - percentage of total patients that are expected to be extracted
207 ; AVG100 - average time to add 100 patients to the extract in seconds
208 ;
209 ; Output:
210 ; Function Value - If successful, returns the time estimate in the format HOURS^MINUTES. If function is not successful, the function returns NULL
211 ;
212 N SECONDS,HOURS,MINUTES
213 ;
214 I ($G(COUNT)'>0)!($G(PERCN)'>0)!($G(AVG100)'>0) Q ""
215 S SECONDS=(PERCN*AVG100*COUNT)/10000
216 S HOURS=SECONDS\3600
217 S SECONDS=SECONDS-(HOURS*3600)
218 S MINUTES=SECONDS\60
219 ;
220 Q HOURS_"^"_MINUTES
221 ;
222 ;
223SIZEST(COUNT,PERCN,SIZE) ;
224 ; Description: This function will return a size estimate for the initial data extract.
225 ;
226 ; Input:
227 ; COUNT - number of patients in the PATIENT file
228 ; PERCN - percentage of total patients that are expected to be extracted
229 ; SIZE - average size of single patient record in the extract in BYTES
230 ; Output:
231 ; Function Value - the estimated file size in BYTES
232 ;
233 I (COUNT'>0)!(PERCN'>0)!(SIZE'>0) Q 0
234 Q (PERCN*SIZE*COUNT)/100
235 ;
236 ;
237HDR1 ; --
238 ; Description: Write extract user info.
239 ;
240 ; Input: None
241 ; Output: None
242 ;
243 W !!,"> > > E N R O L L M E N T D A T A E X T R A C T"
244 W !!,?5,"This job will loop through the Patient (#2) file to find patients"
245 W !,?5,"that meet the enrollment extract selection criteria.",!
246 W !,?5,"Due to the high integration with the Patient (#2) file, please"
247 W !,?5,"queue this job to run at non-peak hours.",!
248 Q
249 ;
250 ;
251HDR2(IVMCONST) ; --
252 ; Description: Write extract estimate disclaimer
253 ;
254 ; Input:
255 ; IVMCONST() - an array containing extract constants, pass by reference
256 ; IVMCONST("PERCNT") - % of patients expected to be extracted.
257 ;
258 ; Output: None
259 ;
260 W !,?15," * * * * * P L E A S E N O T E * * * * *"
261 W !,?5,"The following time and space estimates are based on the approximate"
262 W !,?5,"number of patients in your database. Of those patients, it is assumed"
263 W !,?5,"that approximately "_IVMCONST("PERCNT")_"% will meet the requirements to be included in"
264 W !,?5,"the extract. Also, the time estimate provided does not account for"
265 W !,?5,"the speed of your system or the load on your system.",!
266 Q
267 ;
268CLEAR(IVMARRAY) ;
269 ;Description: If the extract must be run again (the entire extract
270 ;created from scratch, as opposed to restarted), the IVM EXTRACT
271 ;MANAGMENT record needs to be cleared. This call will do that.
272 ;
273 ;Input: none
274 ;Output:
275 ; IVMARRAY - optional output variable, pass by reference,
276 ; IVMARRAY() contains the IVM EXTRACT MANAGMENT record after
277 ; being initialized.
278 ;
279 N IVMCONST
280 ;
281 I $$GETCONST^IVMBULK2(.IVMCONST),$$INIT^IVMBULK2(.IVMARRAY) D
282 .S IVMARRAY("HOST")=IVMCONST("HOST")
283 .I $$STORE^IVMBULK2(.IVMARRAY)
284 Q
Note: See TracBrowser for help on using the repository browser.