source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMBULK1.m@ 1437

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1IVMBULK1 ;ALB/KCL - IVM/ENROLLMENT Extract Con't ; 18-AUG-1997
2 ;;2.0;INCOME VERIFICATION MATCH;**9,11,15**; 21-OCT-94
3 ;
4 ;
5GOGO ; --
6 ; Description: This entry point will be the main driver for enrollment data extract.
7 ;
8 ; Input:
9 ; IVMCONST - as local array containing extract input parameters
10 ; (constants), pass by reference
11 ; IVMARRY1 - as local array containing extract input parameters
12 ; (variable), pass by reference
13 ;
14 ; Output: None
15 ;
16 ; Perform enrollment data extract
17 D BULK(.IVMCONST,.IVMARRY1)
18 ;
19 ; Send extract notification message
20 D DOMAIL
21 ;
22 ; If enrollment events not on, turn on enrollment events
23 I '$$ON^IVMUPAR1() D SETON^IVMUPAR1
24 ;
25 Q
26 ;
27 ;
28BULK(IVMCONST,IVMARRY1) ; --
29 ; Description: This entry point will perform the enrollment data extract.
30 ;
31 ; Input:
32 ; IVMCONST - as local array containing extract input parameters
33 ; (constants), pass by reference
34 ; IVMARRY1 - as local array containing extract input parameters
35 ; (variable), pass by reference
36 ;
37 ; Output: None
38 ;
39 ; initilize varibles
40 N DFN,POP,Z
41 K IVMQUERY("LTD"),IVMQUERY("OVIS")
42 D INIT^IVMUFNC ; HL7 vars
43 S (IVMARRY1("ERROR"),IVMARRY1("TERM"))=""
44 S IVMARRY1("HOST")=$S(IVMARRY1("HOST")'="":IVMARRY1("HOST"),1:IVMCONST("HOST"))
45 S IVMARRY1("PROC")=$G(IVMARRY1("PROC")),IVMARRY1("EXTRACT")=$G(IVMARRY1("EXTRACT")) ; extract statistic counters
46 S IVMARRY1("START")=$$NOW^XLFDT ; current date/time job started
47 S IVMARRY1("TASK")=$G(ZTSK)
48 ;
49 ; store processing info
50 I $$STORE^IVMBULK2(.IVMARRY1)
51 ;
52 ; open host file, if error quit
53 D OPEN^%ZISH("FILE1",IVMARRY1("DIR"),IVMARRY1("HOST")_"_"_(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))),"A")
54 I POP S IVMARRY1("ERROR")="Could not create host file in specified directory." G BULKQ
55 ;
56 ; loop through patients in Patient (#2) file
57 S DFN=+IVMARRY1("LASTPAT")
58 F S DFN=$O(^DPT(DFN)) Q:'DFN D Q:IVMARRY1("ERROR")'=""
59 .;
60 .; - # of patients processed/checked
61 .S IVMARRY1("PROC")=IVMARRY1("PROC")+1
62 .;
63 .; - quit if patient does not pass selection criteria
64 .Q:'$$CRITERIA(DFN,IVMCONST("BEGDT"),DT)
65 .;
66 .; - kill ^TMP global containing previous HL7 msg
67 .K ^TMP("HLS",$J,HLSDT)
68 .;
69 .; - build HL7 full data transmission msg for patient
70 .D BUILD^IVMPTRN8(DFN,$$LD^IVMUFNC4(DFN),0,.IVMQUERY)
71 .;
72 .; - write HL7 full data transmission message to host file
73 .D HOST(HLSDT)
74 .;
75 .; - # of patients extracted
76 .S IVMARRY1("EXTRACT")=IVMARRY1("EXTRACT")+1
77 .;
78 .; - check if host file has reached max size limit
79 .I IVMARRY1("EXTRACT")#IVMCONST("MSGMAX")=0 D Q:IVMARRY1("ERROR")'=""
80 ..;
81 ..; -- close host file, max limit reached
82 ..D CLOSE^%ZISH("FILE1")
83 ..;
84 ..; -- open next host file
85 ..D OPEN^%ZISH("FILE1",IVMARRY1("DIR"),IVMARRY1("HOST")_"_"_(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))),"A")
86 ..I POP S IVMARRY1("ERROR")="Could not open host file." Q
87 .;
88 .; - for every 100 patients processed, check if task stopped
89 .I IVMARRY1("PROC")#100=0 D
90 ..; -- check if task has been stopped
91 ..I $$S^%ZTLOAD S IVMARRY1("ERROR")="Queued job stopped prior to completion.",IVMARRY1("TERM")=1,IVMARRY1("LASTPAT")=DFN
92 ..; -- update IVM EXTRACT MANAGEMENT file
93 ..I $$STORE^IVMBULK2(.IVMARRY1)
94 ;
95 ;Close the last treatment date search and the outpt visit queries
96 F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
97 ; close host file
98 D CLOSE^%ZISH("FILE1")
99 ;
100 ;
101BULKQ ; set up final extract statistics
102 I $G(DFN)'>0 S IVMARRY1("LASTPAT")=""
103 S IVMARRY1("STOP")=$$NOW^XLFDT ; current date/time job stopped
104 S IVMARRY1("FILES")=(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))) ; # of host files
105 ;
106 ; store processing info for extract in IVM Extract Management file
107 I $$STORE^IVMBULK2(.IVMARRY1)
108 ;
109 ; unlock IVM EXTRACT MANAGEMENT file
110 D UNLOCK^IVMBULK2(1)
111 ;
112 ; kill hl7 temp array
113 K ^TMP("HLS",$J,HLSDT)
114 ;
115 ; Cleanup HL7/IVM vars (as defined by call to INIT^IVMUFNC)
116 D CLEAN^IVMUFNC
117 ;
118 Q
119 ;
120 ;
121CRITERIA(DFN,IVMDT1,IVMDT2) ; --
122 ; Description: This function will determine if the patient meets the enrollment initial data extract selection criteria for a specific date range.
123 ;
124 ; Input:
125 ; DFN - pointer to patient in Patient (#2) file
126 ; IVMDT1 - as start date to use when looking for episodes of care
127 ; IVMDT2 - as end date to use when looking for episodes of care
128 ;
129 ; Output:
130 ; Function Value - Does patient meet the selection criteria?
131 ; Return 1 if successful, otherwise 0
132 ;
133 N IVMCRIT,IVMCUREN
134 S IVMCRIT=0
135 ;
136 ; get enrollment status from patient's current enrollment
137 S IVMCUREN=$$STATUS^DGENA(DFN),IVMCUREN=$G(IVMCUREN)
138 ; is status unverified, verified, or pending
139 I IVMCUREN,(IVMCUREN=1!(IVMCUREN=2)!(IVMCUREN=9)) S IVMCRIT=1 G CRITQ
140 ;
141 ; if patient is not a veteran, exit
142 I '$$VET^DGENPTA(DFN) G CRITQ
143 ;
144 ; is veteran a current inpatient?
145 I $$CURINPAT^DGENPTA(DFN) S IVMCRIT=1 G CRITQ
146 ;
147 ; was veteran an inpatient?
148 I $$INPAT^DGENPTA(DFN,IVMDT1,IVMDT2) S IVMCRIT=1 G CRITQ
149 ;
150 ; does veteran have a checked-out encounter (outpatient)?
151 I $$OUTPAT^DGENPTA(DFN,IVMDT1,IVMDT2) S IVMCRIT=1 G CRITQ
152 ;
153CRITQ Q IVMCRIT
154 ;
155 ;
156HOST(HLSDT) ; --
157 ; Description: Take HL7 message contained in temporary array and write to host file.
158 ;
159 ; Input:
160 ; IO - name of opened host file in the format to
161 ; to use for the 'M' USE command
162 ; ^TMP("HLS",$J,HLSDT) - global array containing all segments of the
163 ; HL7 message for a patient. The HLSDT
164 ; variable is a flag that indicates that data
165 ; is to be stored in the ^TMP("HLS") global
166 ; array. The IVMCT variable is a sequential
167 ; number starting at 0 and incremented by 1.
168 ;
169 ; Output: None
170 ;
171 N IVMSUB
172 ;
173 ; use host file
174 U IO
175 ;
176 ; used to delineate begining of new HL7 message
177 W "{",!
178 ;
179 ; write message segments to host file
180 S IVMSUB="" F S IVMSUB=$O(^TMP("HLS",$J,HLSDT,IVMSUB)) Q:IVMSUB'>0 D
181 .W $G(^TMP("HLS",$J,HLSDT,IVMSUB)),!
182 ;
183 ; used to delineate end of HL7 message
184 W "}",!
185 ;
186 Q
187 ;
188 ;
189DOMAIL ; --
190 ; Description: This function will generate a MailMan message contianing the results of the enrollment data extract.
191 ;
192 ; Input: None
193 ;
194 ; Output: None
195 ;
196 K XMZ
197 N DIFROM,IVMCON1,IVMMSG,IVMPRCNT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY
198 ;
199 ; init mail variables
200 S IVMSITE=$$SITE^VASITE
201 S XMSUB="Enrollment Extract Results "_"("_$P(IVMSITE,"^",3)_")"
202 S XMDUZ=.5,XMY(DUZ)="",XMY(.5)=""
203 S XMTEXT="IVMMSG("
204 ;
205 ; if error creating message text, exit
206 I '$$FINAL(.IVMMSG) G DOMAILQ
207 ;
208 ; get extract constants
209 I $$GETCONST^IVMBULK2(.IVMCON1)
210 ;
211 ; HEC mail group
212 I IVMARRY1("ERROR")']"" S XMY(IVMCON1("MAILGRP"))=""
213 ;
214 ; send msg
215 D ^XMD
216 ;
217DOMAILQ Q
218 ;
219 ;
220FINAL(IVMTXT) ; --
221 ; Description: Places message text into local IVMTXT array.
222 ;
223 ; Input: None
224 ;
225 ; Output:
226 ; Function Value - returns 1 if success, 0 if failure
227 ; IVMTXT - as local array containing mail message text,
228 ; pass by reference
229 ;
230 N SUCCESS,IVMSITE,IVMARRY2
231 S SUCCESS=0
232 ;
233 ; if obtaining IVM Extract Management record unsuccessful, exit
234 I '$$GET^IVMBULK2(.IVMARRY2) G FINALQ
235 ;
236 S IVMSITE=$$SITE^VASITE
237 ;
238 S IVMTXT(1)=" > > > > > > > > > > ENROLLMENT DATA EXTRACT RESULTS < < < < < < < < < <"
239 S IVMTXT(2)=""
240 S IVMTXT(3)=" Facility Name: "_$P(IVMSITE,"^",2)
241 S IVMTXT(4)=" Station Number: "_$P(IVMSITE,"^",3)
242 S IVMTXT(5)=""
243 S IVMTXT(6)=" Date/Time job started: "_$$FMTE^XLFDT(IVMARRY2("START"),"1P")
244 S IVMTXT(7)=" Date/Time job stopped: "_$$FMTE^XLFDT(IVMARRY2("STOP"),"1P")
245 S IVMTXT(8)=""
246 S IVMTXT(9)=" Total patients processed: "_IVMARRY2("PROC")
247 S IVMTXT(10)=" Total patients extracted: "_IVMARRY2("EXTRACT")
248 S IVMTXT(11)=" Percentage extracted: "_$S($G(IVMARRY2("PROC")):$P(IVMARRY2("EXTRACT")/IVMARRY2("PROC")*100,".")_"%",1:"")
249 S IVMTXT(12)=""
250 S IVMTXT(13)=" Host file directory: "_IVMARRY2("DIR")
251 S IVMTXT(14)=" Host file name: "_IVMARRY2("HOST")
252 S IVMTXT(15)=" Number of host files: "_IVMARRY2("FILES")
253 ;
254 ; if ERROR, set error into msg text
255 I IVMARRY2("ERROR")]"" D
256 .S IVMTXT(16)=""
257 .S IVMTXT(17)=" * * * * E R R O R E N C O U N T E R E D * * * *"
258 .S IVMTXT(18)=""
259 .S IVMTXT(19)=" Error Message: "_IVMARRY2("ERROR")
260 .S IVMTXT(20)=" Task Number: "_IVMARRY2("TASK")
261 ;
262 S SUCCESS=1
263 ;
264FINALQ Q SUCCESS
Note: See TracBrowser for help on using the repository browser.