Produced by Araxis Merge on 3/20/2019 1:04:39 PM Eastern Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | eInsurance_IB_2.0_602.zip | IB_2.0_602_KIDS | Wed Mar 20 11:58:48 2019 UTC |
2 | eInsurance_IB_2.0_602.zip | IB_2.0_602_KIDS | Wed Mar 20 16:56:41 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 4 | 16676 |
Changed | 3 | 6 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | $END TXT | |
2 | $KID IB*2. 0*602 | |
3 | **INSTALL NAME** | |
4 | IB*2.0*602 | |
5 | "BLD",1110 5,0) | |
6 | IB*2.0*602 ^INTEGRATE D BILLING^ 0^3190221^ y | |
7 | "BLD",1110 5,4,0) | |
8 | ^9.64PA^^ | |
9 | "BLD",1110 5,6) | |
10 | 10^ | |
11 | "BLD",1110 5,6.3) | |
12 | 22 | |
13 | "BLD",1110 5,"INID") | |
14 | ^n | |
15 | "BLD",1110 5,"INIT") | |
16 | IBY602PO | |
17 | "BLD",1110 5,"KRN",0) | |
18 | ^9.67PA^77 9.2^20 | |
19 | "BLD",1110 5,"KRN",.4 ,0) | |
20 | .4 | |
21 | "BLD",1110 5,"KRN",.4 ,"NM",0) | |
22 | ^9.68A^^ | |
23 | "BLD",1110 5,"KRN",.4 01,0) | |
24 | .401 | |
25 | "BLD",1110 5,"KRN",.4 02,0) | |
26 | .402 | |
27 | "BLD",1110 5,"KRN",.4 03,0) | |
28 | .403 | |
29 | "BLD",1110 5,"KRN",.5 ,0) | |
30 | .5 | |
31 | "BLD",1110 5,"KRN",.8 4,0) | |
32 | .84 | |
33 | "BLD",1110 5,"KRN",3. 6,0) | |
34 | 3.6 | |
35 | "BLD",1110 5,"KRN",3. 6,"NM",0) | |
36 | ^9.68A^^ | |
37 | "BLD",1110 5,"KRN",3. 8,0) | |
38 | 3.8 | |
39 | "BLD",1110 5,"KRN",9. 2,0) | |
40 | 9.2 | |
41 | "BLD",1110 5,"KRN",9. 8,0) | |
42 | 9.8 | |
43 | "BLD",1110 5,"KRN",9. 8,"NM",0) | |
44 | ^9.68A^20^ 19 | |
45 | "BLD",1110 5,"KRN",9. 8,"NM",1,0 ) | |
46 | IBCNAU3^^0 ^B12969808 | |
47 | "BLD",1110 5,"KRN",9. 8,"NM",2,0 ) | |
48 | IBCNBOA^^0 ^B68100333 | |
49 | "BLD",1110 5,"KRN",9. 8,"NM",3,0 ) | |
50 | IBCNBOF^^0 ^B33394771 | |
51 | "BLD",1110 5,"KRN",9. 8,"NM",4,0 ) | |
52 | IBCNERP3^^ 0^B1021282 47 | |
53 | "BLD",1110 5,"KRN",9. 8,"NM",5,0 ) | |
54 | IBCNERPD^^ 0^B1265238 71 | |
55 | "BLD",1110 5,"KRN",9. 8,"NM",6,0 ) | |
56 | IBCNSP^^0^ B77777224 | |
57 | "BLD",1110 5,"KRN",9. 8,"NM",7,0 ) | |
58 | IBCNSUR^^0 ^B13141899 3 | |
59 | "BLD",1110 5,"KRN",9. 8,"NM",8,0 ) | |
60 | IBCOC1^^0^ B24512676 | |
61 | "BLD",1110 5,"KRN",9. 8,"NM",9,0 ) | |
62 | IBCOMD1^^0 ^B37249446 | |
63 | "BLD",1110 5,"KRN",9. 8,"NM",10, 0) | |
64 | IBCOMN1^^0 ^B18271189 | |
65 | "BLD",1110 5,"KRN",9. 8,"NM",11, 0) | |
66 | IBCNEKIT^^ 0^B1644960 28 | |
67 | "BLD",1110 5,"KRN",9. 8,"NM",12, 0) | |
68 | IBCNSMM^^0 ^B19438322 | |
69 | "BLD",1110 5,"KRN",9. 8,"NM",14, 0) | |
70 | IBCNSMM2^^ 0^B1523423 3 | |
71 | "BLD",1110 5,"KRN",9. 8,"NM",15, 0) | |
72 | IBCNBOE^^0 ^B11271632 0 | |
73 | "BLD",1110 5,"KRN",9. 8,"NM",16, 0) | |
74 | IBCNSMM1^^ 0^B2778804 8 | |
75 | "BLD",1110 5,"KRN",9. 8,"NM",17, 0) | |
76 | IBY602PO^^ 0^B4368711 5 | |
77 | "BLD",1110 5,"KRN",9. 8,"NM",18, 0) | |
78 | IBCNEUT5^^ 0^B6544439 0 | |
79 | "BLD",1110 5,"KRN",9. 8,"NM",19, 0) | |
80 | IBCNEDE4^^ 0^B6182662 0 | |
81 | "BLD",1110 5,"KRN",9. 8,"NM",20, 0) | |
82 | IBCNEHL3^^ 0^B1729506 82 | |
83 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNAU3" ,1) | |
84 | ||
85 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNBOA" ,2) | |
86 | ||
87 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNBOE" ,15) | |
88 | ||
89 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNBOF" ,3) | |
90 | ||
91 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNEDE4 ",19) | |
92 | ||
93 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNEHL3 ",20) | |
94 | ||
95 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNEKIT ",11) | |
96 | ||
97 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNERP3 ",4) | |
98 | ||
99 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNERPD ",5) | |
100 | ||
101 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNEUT5 ",18) | |
102 | ||
103 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNSMM" ,12) | |
104 | ||
105 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNSMM1 ",16) | |
106 | ||
107 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNSMM2 ",14) | |
108 | ||
109 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNSP", 6) | |
110 | ||
111 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCNSUR" ,7) | |
112 | ||
113 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCOC1", 8) | |
114 | ||
115 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCOMD1" ,9) | |
116 | ||
117 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBCOMN1" ,10) | |
118 | ||
119 | "BLD",1110 5,"KRN",9. 8,"NM","B" ,"IBY602PO ",17) | |
120 | ||
121 | "BLD",1110 5,"KRN",19 ,0) | |
122 | 19 | |
123 | "BLD",1110 5,"KRN",19 ,"NM",0) | |
124 | ^9.68A^24^ 24 | |
125 | "BLD",1110 5,"KRN",19 ,"NM",1,0) | |
126 | IBCN LIST INACTIVE I NS W/PAT^^ 4^ | |
127 | "BLD",1110 5,"KRN",19 ,"NM",2,0) | |
128 | IBCN EXPIR E GROUP SU BSCRIBERS^ ^0 | |
129 | "BLD",1110 5,"KRN",19 ,"NM",3,0) | |
130 | IBCN INSUR ANCE MGMT MENU^^0 | |
131 | "BLD",1110 5,"KRN",19 ,"NM",4,0) | |
132 | IBCN INSUR ANCE CO ED IT^^4^ | |
133 | "BLD",1110 5,"KRN",19 ,"NM",5,0) | |
134 | IBCN PATIE NT INSURAN CE^^4^ | |
135 | "BLD",1110 5,"KRN",19 ,"NM",6,0) | |
136 | IBCN VIEW PATIENT IN SURANCE^^4 ^ | |
137 | "BLD",1110 5,"KRN",19 ,"NM",7,0) | |
138 | IBCN VIEW INSURANCE CO^^4^ | |
139 | "BLD",1110 5,"KRN",19 ,"NM",8,0) | |
140 | IBCN LIST NEW NOT VE R^^4^ | |
141 | "BLD",1110 5,"KRN",19 ,"NM",9,0) | |
142 | IBCN LIST PLANS BY I NS CO^^4^ | |
143 | "BLD",1110 5,"KRN",19 ,"NM",10,0 ) | |
144 | IBCN INSUR ANCE BUFFE R PROCESS^ ^4^ | |
145 | "BLD",1110 5,"KRN",19 ,"NM",11,0 ) | |
146 | IBCN POL W /NO EFF DA TE REPORT^ ^4^ | |
147 | "BLD",1110 5,"KRN",19 ,"NM",12,0 ) | |
148 | IBCN ID DU P INSURANC E ENTRIES^ ^4^ | |
149 | "BLD",1110 5,"KRN",19 ,"NM",13,0 ) | |
150 | IBCN MOVE SUBSCRIB T O PLAN^^4^ | |
151 | "BLD",1110 5,"KRN",19 ,"NM",14,0 ) | |
152 | IBCN NO CO VERAGE VER IFIED^^4^ | |
153 | "BLD",1110 5,"KRN",19 ,"NM",15,0 ) | |
154 | IBCN PT W/ WO INSURAN CE REPORT^ ^4^ | |
155 | "BLD",1110 5,"KRN",19 ,"NM",16,0 ) | |
156 | IBCN REMOT E INSURANC E QUERY^^4 ^ | |
157 | "BLD",1110 5,"KRN",19 ,"NM",17,0 ) | |
158 | IBCNE IIV MENU^^4^ | |
159 | "BLD",1110 5,"KRN",19 ,"NM",18,0 ) | |
160 | IBCNE PAYE R MAINTENA NCE MENU^^ 4^ | |
161 | "BLD",1110 5,"KRN",19 ,"NM",19,0 ) | |
162 | IBCNR E-PH ARMACY MEN U^^4^ | |
163 | "BLD",1110 5,"KRN",19 ,"NM",20,0 ) | |
164 | IBCN INSUR ANCE EDI R EPORT^^4^ | |
165 | "BLD",1110 5,"KRN",19 ,"NM",21,0 ) | |
166 | IBCN INS R PTS^^4^ | |
167 | "BLD",1110 5,"KRN",19 ,"NM",22,0 ) | |
168 | IBCN INTER FACILITY I NS UPDATE^ ^4^ | |
169 | "BLD",1110 5,"KRN",19 ,"NM",23,0 ) | |
170 | IBCN HPID CLAIM RPT^ ^4^ | |
171 | "BLD",1110 5,"KRN",19 ,"NM",24,0 ) | |
172 | IBCN INS P LANS MISSI NG DATA^^4 ^ | |
173 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN EXPI RE GROUP S UBSCRIBERS ",2) | |
174 | ||
175 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN HPID CLAIM RPT ",23) | |
176 | ||
177 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN ID D UP INSURAN CE ENTRIES ",12) | |
178 | ||
179 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INS PLANS MISS ING DATA", 24) | |
180 | ||
181 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INS RPTS",21) | |
182 | ||
183 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INSU RANCE BUFF ER PROCESS ",10) | |
184 | ||
185 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INSU RANCE CO E DIT",4) | |
186 | ||
187 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INSU RANCE EDI REPORT",20 ) | |
188 | ||
189 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INSU RANCE MGMT MENU",3) | |
190 | ||
191 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN INTE RFACILITY INS UPDATE ",22) | |
192 | ||
193 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN LIST INACTIVE INS W/PAT" ,1) | |
194 | ||
195 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN LIST NEW NOT V ER",8) | |
196 | ||
197 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN LIST PLANS BY INS CO",9) | |
198 | ||
199 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN MOVE SUBSCRIB TO PLAN",1 3) | |
200 | ||
201 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN NO C OVERAGE VE RIFIED",14 ) | |
202 | ||
203 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN PATI ENT INSURA NCE",5) | |
204 | ||
205 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN POL W/NO EFF D ATE REPORT ",11) | |
206 | ||
207 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN PT W /WO INSURA NCE REPORT ",15) | |
208 | ||
209 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN REMO TE INSURAN CE QUERY", 16) | |
210 | ||
211 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN VIEW INSURANCE CO",7) | |
212 | ||
213 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCN VIEW PATIENT I NSURANCE", 6) | |
214 | ||
215 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCNE IIV MENU",17) | |
216 | ||
217 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCNE PAY ER MAINTEN ANCE MENU" ,18) | |
218 | ||
219 | "BLD",1110 5,"KRN",19 ,"NM","B", "IBCNR E-P HARMACY ME NU",19) | |
220 | ||
221 | "BLD",1110 5,"KRN",19 .1,0) | |
222 | 19.1 | |
223 | "BLD",1110 5,"KRN",10 1,0) | |
224 | 101 | |
225 | "BLD",1110 5,"KRN",40 9.61,0) | |
226 | 409.61 | |
227 | "BLD",1110 5,"KRN",77 1,0) | |
228 | 771 | |
229 | "BLD",1110 5,"KRN",77 9.2,0) | |
230 | 779.2 | |
231 | "BLD",1110 5,"KRN",87 0,0) | |
232 | 870 | |
233 | "BLD",1110 5,"KRN",89 89.51,0) | |
234 | 8989.51 | |
235 | "BLD",1110 5,"KRN",89 89.52,0) | |
236 | 8989.52 | |
237 | "BLD",1110 5,"KRN",89 94,0) | |
238 | 8994 | |
239 | "BLD",1110 5,"KRN","B ",.4,.4) | |
240 | ||
241 | "BLD",1110 5,"KRN","B ",.401,.40 1) | |
242 | ||
243 | "BLD",1110 5,"KRN","B ",.402,.40 2) | |
244 | ||
245 | "BLD",1110 5,"KRN","B ",.403,.40 3) | |
246 | ||
247 | "BLD",1110 5,"KRN","B ",.5,.5) | |
248 | ||
249 | "BLD",1110 5,"KRN","B ",.84,.84) | |
250 | ||
251 | "BLD",1110 5,"KRN","B ",3.6,3.6) | |
252 | ||
253 | "BLD",1110 5,"KRN","B ",3.8,3.8) | |
254 | ||
255 | "BLD",1110 5,"KRN","B ",9.2,9.2) | |
256 | ||
257 | "BLD",1110 5,"KRN","B ",9.8,9.8) | |
258 | ||
259 | "BLD",1110 5,"KRN","B ",19,19) | |
260 | ||
261 | "BLD",1110 5,"KRN","B ",19.1,19. 1) | |
262 | ||
263 | "BLD",1110 5,"KRN","B ",101,101) | |
264 | ||
265 | "BLD",1110 5,"KRN","B ",409.61,4 09.61) | |
266 | ||
267 | "BLD",1110 5,"KRN","B ",771,771) | |
268 | ||
269 | "BLD",1110 5,"KRN","B ",779.2,77 9.2) | |
270 | ||
271 | "BLD",1110 5,"KRN","B ",870,870) | |
272 | ||
273 | "BLD",1110 5,"KRN","B ",8989.51, 8989.51) | |
274 | ||
275 | "BLD",1110 5,"KRN","B ",8989.52, 8989.52) | |
276 | ||
277 | "BLD",1110 5,"KRN","B ",8994,899 4) | |
278 | ||
279 | "BLD",1110 5,"QDEF") | |
280 | ^^^^NO^^^^ YES^^YES | |
281 | "BLD",1110 5,"QUES",0 ) | |
282 | ^9.62^^ | |
283 | "BLD",1110 5,"REQB",0 ) | |
284 | ^9.611^2^1 | |
285 | "BLD",1110 5,"REQB",2 ,0) | |
286 | IB*2.0*621 ^1 | |
287 | "BLD",1110 5,"REQB"," B","IB*2.0 *621",2) | |
288 | ||
289 | "INIT") | |
290 | IBY602PO | |
291 | "KRN",19,2 913770,-1) | |
292 | 0^3 | |
293 | "KRN",19,2 913770,0) | |
294 | IBCN INSUR ANCE MGMT MENU^Patie nt Insuran ce Menu^^M ^^^^^^^^ | |
295 | "KRN",19,2 913770,1,0 ) | |
296 | ^19.06^1^1 ^3180314^^ ^^ | |
297 | "KRN",19,2 913770,1,1 ,0) | |
298 | This is th e main men u to edit, view, and print ins urance inf ormation. | |
299 | "KRN",19,2 913770,10, 0) | |
300 | ^19.01IP^2 5^25 | |
301 | "KRN",19,2 913770,10, 2,0) | |
302 | 2913771^EI ^3 | |
303 | "KRN",19,2 913770,10, 2,"^") | |
304 | IBCN INSUR ANCE CO ED IT | |
305 | "KRN",19,2 913770,10, 3,0) | |
306 | 2913772^PI ^1 | |
307 | "KRN",19,2 913770,10, 3,"^") | |
308 | IBCN PATIE NT INSURAN CE | |
309 | "KRN",19,2 913770,10, 4,0) | |
310 | 2913773^VP ^2 | |
311 | "KRN",19,2 913770,10, 4,"^") | |
312 | IBCN VIEW PATIENT IN SURANCE | |
313 | "KRN",19,2 913770,10, 5,0) | |
314 | 2913774^VI ^4 | |
315 | "KRN",19,2 913770,10, 5,"^") | |
316 | IBCN VIEW INSURANCE CO | |
317 | "KRN",19,2 913770,10, 6,0) | |
318 | 2913790^LC ^49 | |
319 | "KRN",19,2 913770,10, 6,"^") | |
320 | IBCN LIST INACTIVE I NS W/PAT | |
321 | "KRN",19,2 913770,10, 7,0) | |
322 | 2913792^NV | |
323 | "KRN",19,2 913770,10, 7,"^") | |
324 | IBCN LIST NEW NOT VE R | |
325 | "KRN",19,2 913770,10, 8,0) | |
326 | 2915092^LP ^53 | |
327 | "KRN",19,2 913770,10, 8,"^") | |
328 | IBCN LIST PLANS BY I NS CO | |
329 | "KRN",19,2 913770,10, 9,0) | |
330 | 2917882^BI ^21 | |
331 | "KRN",19,2 913770,10, 9,"^") | |
332 | IBCN INSUR ANCE BUFFE R PROCESS | |
333 | "KRN",19,2 913770,10, 10,0) | |
334 | 2918301^NE | |
335 | "KRN",19,2 913770,10, 10,"^") | |
336 | IBCN POL W /NO EFF DA TE REPORT | |
337 | "KRN",19,2 913770,10, 11,0) | |
338 | 2918300^ID ^37 | |
339 | "KRN",19,2 913770,10, 11,"^") | |
340 | IBCN ID DU P INSURANC E ENTRIES | |
341 | "KRN",19,2 913770,10, 12,0) | |
342 | 2918302^MV ^61 | |
343 | "KRN",19,2 913770,10, 12,"^") | |
344 | IBCN MOVE SUBSCRIB T O PLAN | |
345 | "KRN",19,2 913770,10, 13,0) | |
346 | 2918304^NC | |
347 | "KRN",19,2 913770,10, 13,"^") | |
348 | IBCN NO CO VERAGE VER IFIED | |
349 | "KRN",19,2 913770,10, 15,0) | |
350 | 2918303^WO | |
351 | "KRN",19,2 913770,10, 15,"^") | |
352 | IBCN PT W/ WO INSURAN CE REPORT | |
353 | "KRN",19,2 913770,10, 16,0) | |
354 | 2919241^RQ I | |
355 | "KRN",19,2 913770,10, 16,"^") | |
356 | IBCN REMOT E INSURANC E QUERY | |
357 | "KRN",19,2 913770,10, 17,0) | |
358 | 2919334^EI V^25 | |
359 | "KRN",19,2 913770,10, 17,"^") | |
360 | IBCNE IIV MENU | |
361 | "KRN",19,2 913770,10, 18,0) | |
362 | 2919335^PM | |
363 | "KRN",19,2 913770,10, 18,"^") | |
364 | IBCNE PAYE R MAINTENA NCE MENU | |
365 | "KRN",19,2 913770,10, 19,0) | |
366 | 2919873^EP H^29 | |
367 | "KRN",19,2 913770,10, 19,"^") | |
368 | IBCNR E-PH ARMACY MEN U | |
369 | "KRN",19,2 913770,10, 20,0) | |
370 | 2920073^EP R^17 | |
371 | "KRN",19,2 913770,10, 20,"^") | |
372 | IBCN INSUR ANCE EDI R EPORT | |
373 | "KRN",19,2 913770,10, 21,0) | |
374 | 2922289^IN SR^45 | |
375 | "KRN",19,2 913770,10, 21,"^") | |
376 | IBCN INS R PTS | |
377 | "KRN",19,2 913770,10, 22,0) | |
378 | 2922293^IF IU^41 | |
379 | "KRN",19,2 913770,10, 22,"^") | |
380 | IBCN INTER FACILITY I NS UPDATE | |
381 | "KRN",19,2 913770,10, 23,0) | |
382 | 2922294^HP ID^33 | |
383 | "KRN",19,2 913770,10, 23,"^") | |
384 | IBCN HPID CLAIM RPT | |
385 | "KRN",19,2 913770,10, 24,0) | |
386 | 2922342^MD ^57 | |
387 | "KRN",19,2 913770,10, 24,"^") | |
388 | IBCN INS P LANS MISSI NG DATA | |
389 | "KRN",19,2 913770,10, 25,0) | |
390 | 2922538^XP IR^65 | |
391 | "KRN",19,2 913770,10, 25,"^") | |
392 | IBCN EXPIR E GROUP SU BSCRIBERS | |
393 | "KRN",19,2 913770,99) | |
394 | 65021,3038 1 | |
395 | "KRN",19,2 913770,99. 1) | |
396 | 65064,4023 6 | |
397 | "KRN",19,2 913770,"U" ) | |
398 | PATIENT IN SURANCE ME NU | |
399 | "KRN",19,2 913771,-1) | |
400 | 4^4 | |
401 | "KRN",19,2 913771,0) | |
402 | IBCN INSUR ANCE CO ED IT | |
403 | "KRN",19,2 913772,-1) | |
404 | 4^5 | |
405 | "KRN",19,2 913772,0) | |
406 | IBCN PATIE NT INSURAN CE | |
407 | "KRN",19,2 913773,-1) | |
408 | 4^6 | |
409 | "KRN",19,2 913773,0) | |
410 | IBCN VIEW PATIENT IN SURANCE | |
411 | "KRN",19,2 913774,-1) | |
412 | 4^7 | |
413 | "KRN",19,2 913774,0) | |
414 | IBCN VIEW INSURANCE CO | |
415 | "KRN",19,2 913790,-1) | |
416 | 4^1 | |
417 | "KRN",19,2 913790,0) | |
418 | IBCN LIST INACTIVE I NS W/PAT | |
419 | "KRN",19,2 913792,-1) | |
420 | 4^8 | |
421 | "KRN",19,2 913792,0) | |
422 | IBCN LIST NEW NOT VE R | |
423 | "KRN",19,2 915092,-1) | |
424 | 4^9 | |
425 | "KRN",19,2 915092,0) | |
426 | IBCN LIST PLANS BY I NS CO | |
427 | "KRN",19,2 917882,-1) | |
428 | 4^10 | |
429 | "KRN",19,2 917882,0) | |
430 | IBCN INSUR ANCE BUFFE R PROCESS | |
431 | "KRN",19,2 918300,-1) | |
432 | 4^12 | |
433 | "KRN",19,2 918300,0) | |
434 | IBCN ID DU P INSURANC E ENTRIES | |
435 | "KRN",19,2 918301,-1) | |
436 | 4^11 | |
437 | "KRN",19,2 918301,0) | |
438 | IBCN POL W /NO EFF DA TE REPORT | |
439 | "KRN",19,2 918302,-1) | |
440 | 4^13 | |
441 | "KRN",19,2 918302,0) | |
442 | IBCN MOVE SUBSCRIB T O PLAN | |
443 | "KRN",19,2 918303,-1) | |
444 | 4^15 | |
445 | "KRN",19,2 918303,0) | |
446 | IBCN PT W/ WO INSURAN CE REPORT | |
447 | "KRN",19,2 918304,-1) | |
448 | 4^14 | |
449 | "KRN",19,2 918304,0) | |
450 | IBCN NO CO VERAGE VER IFIED | |
451 | "KRN",19,2 919241,-1) | |
452 | 4^16 | |
453 | "KRN",19,2 919241,0) | |
454 | IBCN REMOT E INSURANC E QUERY | |
455 | "KRN",19,2 919334,-1) | |
456 | 4^17 | |
457 | "KRN",19,2 919334,0) | |
458 | IBCNE IIV MENU | |
459 | "KRN",19,2 919335,-1) | |
460 | 4^18 | |
461 | "KRN",19,2 919335,0) | |
462 | IBCNE PAYE R MAINTENA NCE MENU | |
463 | "KRN",19,2 919873,-1) | |
464 | 4^19 | |
465 | "KRN",19,2 919873,0) | |
466 | IBCNR E-PH ARMACY MEN U | |
467 | "KRN",19,2 920073,-1) | |
468 | 4^20 | |
469 | "KRN",19,2 920073,0) | |
470 | IBCN INSUR ANCE EDI R EPORT | |
471 | "KRN",19,2 922289,-1) | |
472 | 4^21 | |
473 | "KRN",19,2 922289,0) | |
474 | IBCN INS R PTS | |
475 | "KRN",19,2 922293,-1) | |
476 | 4^22 | |
477 | "KRN",19,2 922293,0) | |
478 | IBCN INTER FACILITY I NS UPDATE | |
479 | "KRN",19,2 922294,-1) | |
480 | 4^23 | |
481 | "KRN",19,2 922294,0) | |
482 | IBCN HPID CLAIM RPT | |
483 | "KRN",19,2 922342,-1) | |
484 | 4^24 | |
485 | "KRN",19,2 922342,0) | |
486 | IBCN INS P LANS MISSI NG DATA | |
487 | "KRN",19,2 922538,-1) | |
488 | 0^2 | |
489 | "KRN",19,2 922538,0) | |
490 | IBCN EXPIR E GROUP SU BSCRIBERS^ Expire Gro up Plan^^R ^^^^^^^n^I NTEGRATED BILLING | |
491 | "KRN",19,2 922538,1,0 ) | |
492 | ^^3^3^3180 406^ | |
493 | "KRN",19,2 922538,1,1 ,0) | |
494 | This optio n allows u sers to en ter an exp iration da te to expi re all | |
495 | "KRN",19,2 922538,1,2 ,0) | |
496 | subscriber policies associated with a gr oup plan w ithout req uiring | |
497 | "KRN",19,2 922538,1,3 ,0) | |
498 | them to be moved to a new plan . | |
499 | "KRN",19,2 922538,10. 1) | |
500 | Expire Gro up Plan | |
501 | "KRN",19,2 922538,25) | |
502 | EXPGRP^IBC NSUR | |
503 | "KRN",19,2 922538,"U" ) | |
504 | EXPIRE GRO UP PLAN | |
505 | "MBREQ") | |
506 | 0 | |
507 | "ORD",18,1 9) | |
508 | 19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA | |
509 | "ORD",18,1 9,0) | |
510 | OPTION | |
511 | "PKG",230, -1) | |
512 | 1^1 | |
513 | "PKG",230, 0) | |
514 | INTEGRATED BILLING^I B^INTEGRAT ED BILLING | |
515 | "PKG",230, 22,0) | |
516 | ^9.49I^1^1 | |
517 | "PKG",230, 22,1,0) | |
518 | 2.0^294032 1^2940525 | |
519 | "PKG",230, 22,1,"PAH" ,1,0) | |
520 | 602^319022 1^217 | |
521 | "QUES","XP F1",0) | |
522 | Y | |
523 | "QUES","XP F1","??") | |
524 | ^D REP^XPD H | |
525 | "QUES","XP F1","A") | |
526 | Shall I wr ite over y our |FLAG| File | |
527 | "QUES","XP F1","B") | |
528 | YES | |
529 | "QUES","XP F1","M") | |
530 | D XPF1^XPD IQ | |
531 | "QUES","XP F2",0) | |
532 | Y | |
533 | "QUES","XP F2","??") | |
534 | ^D DTA^XPD H | |
535 | "QUES","XP F2","A") | |
536 | Want my da ta |FLAG| yours | |
537 | "QUES","XP F2","B") | |
538 | YES | |
539 | "QUES","XP F2","M") | |
540 | D XPF2^XPD IQ | |
541 | "QUES","XP I1",0) | |
542 | YO | |
543 | "QUES","XP I1","??") | |
544 | ^D INHIBIT ^XPDH | |
545 | "QUES","XP I1","A") | |
546 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
547 | "QUES","XP I1","B") | |
548 | NO | |
549 | "QUES","XP I1","M") | |
550 | D XPI1^XPD IQ | |
551 | "QUES","XP M1",0) | |
552 | PO^VA(200, :EM | |
553 | "QUES","XP M1","??") | |
554 | ^D MG^XPDH | |
555 | "QUES","XP M1","A") | |
556 | Enter the Coordinato r for Mail Group '|F LAG|' | |
557 | "QUES","XP M1","B") | |
558 | ||
559 | "QUES","XP M1","M") | |
560 | D XPM1^XPD IQ | |
561 | "QUES","XP O1",0) | |
562 | Y | |
563 | "QUES","XP O1","??") | |
564 | ^D MENU^XP DH | |
565 | "QUES","XP O1","A") | |
566 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
567 | "QUES","XP O1","B") | |
568 | YES | |
569 | "QUES","XP O1","M") | |
570 | D XPO1^XPD IQ | |
571 | "QUES","XP Z1",0) | |
572 | Y | |
573 | "QUES","XP Z1","??") | |
574 | ^D OPT^XPD H | |
575 | "QUES","XP Z1","A") | |
576 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
577 | "QUES","XP Z1","B") | |
578 | YES | |
579 | "QUES","XP Z1","M") | |
580 | D XPZ1^XPD IQ | |
581 | "QUES","XP Z2",0) | |
582 | Y | |
583 | "QUES","XP Z2","??") | |
584 | ^D RTN^XPD H | |
585 | "QUES","XP Z2","A") | |
586 | Want to MO VE routine s to other CPUs | |
587 | "QUES","XP Z2","B") | |
588 | NO | |
589 | "QUES","XP Z2","M") | |
590 | D XPZ2^XPD IQ | |
591 | "RTN") | |
592 | 19 | |
593 | "RTN","IBC NAU3") | |
594 | 0^1^B12969 808^B12671 484 | |
595 | "RTN","IBC NAU3",1,0) | |
596 | IBCNAU3 ;A LB/KML/AWC - eIV USE R EDIT REP ORT (PRINT ) ;6-APRIL -2015 | |
597 | "RTN","IBC NAU3",2,0) | |
598 | ;;2.0;INT EGRATED BI LLING;**52 8,602**;21 -MAR-94;Bu ild 22 | |
599 | "RTN","IBC NAU3",3,0) | |
600 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
601 | "RTN","IBC NAU3",4,0) | |
602 | ; | |
603 | "RTN","IBC NAU3",5,0) | |
604 | ; Requir ed variabl e input: ALLUSERS, ALLINS, PL ANS, ALLPL ANS, EXCEL | |
605 | "RTN","IBC NAU3",6,0) | |
606 | ; ^TMP(" IBINC",$J) | |
607 | "RTN","IBC NAU3",7,0) | |
608 | ; ^TMP(" IBUSER",$J ) | |
609 | "RTN","IBC NAU3",8,0) | |
610 | ; DATE(" START") an d DATE("EN D") requir ed array e lements if all dates not selec ted | |
611 | "RTN","IBC NAU3",9,0) | |
612 | Q | |
613 | "RTN","IBC NAU3",10,0 ) | |
614 | ; | |
615 | "RTN","IBC NAU3",11,0 ) | |
616 | EN(ALLPLAN S,PLANS) ; | |
617 | "RTN","IBC NAU3",12,0 ) | |
618 | ; Print t he report. | |
619 | "RTN","IBC NAU3",13,0 ) | |
620 | ; | |
621 | "RTN","IBC NAU3",14,0 ) | |
622 | I EXCEL D EXCEL(PLA NS) Q | |
623 | "RTN","IBC NAU3",15,0 ) | |
624 | N IBI,IBJ ,IBK,IBL,I BM,IB01,IB 02,IBQUIT, IBPAG,IBPD ,IBHDT | |
625 | "RTN","IBC NAU3",16,0 ) | |
626 | S (IB02,I BQUIT,IBPA G)=0 | |
627 | "RTN","IBC NAU3",17,0 ) | |
628 | S IBHDT=$ $FMTE^XLFD T($$NOW^XL FDT()) | |
629 | "RTN","IBC NAU3",18,0 ) | |
630 | ; | |
631 | "RTN","IBC NAU3",19,0 ) | |
632 | D HDR(ALL PLANS,PLAN S) | |
633 | "RTN","IBC NAU3",20,0 ) | |
634 | I '$D(^TM P("IBPR",$ J)) W !!," User Edits do not ex ist per th e selected filters." D PAUSE Q | |
635 | "RTN","IBC NAU3",21,0 ) | |
636 | ; | |
637 | "RTN","IBC NAU3",22,0 ) | |
638 | F IB01=0, 1 F S IB0 2=$O(^TMP( "IBPR",$J, IB01,IB02) ) Q:'IB02 Q:IBQUIT S IBPD=$G (^TMP("IBP R",$J,IB01 ,IB02)) D Q:IBQUIT | |
639 | "RTN","IBC NAU3",23,0 ) | |
640 | . I $Y>(I OSL-5) D P AUSE Q:IBQ UIT D HDR (ALLPLANS, PLANS) | |
641 | "RTN","IBC NAU3",24,0 ) | |
642 | . D PLAN | |
643 | "RTN","IBC NAU3",25,0 ) | |
644 | W !!,"END OF REPORT " D PAUSE | |
645 | "RTN","IBC NAU3",26,0 ) | |
646 | Q | |
647 | "RTN","IBC NAU3",27,0 ) | |
648 | ; | |
649 | "RTN","IBC NAU3",28,0 ) | |
650 | ; | |
651 | "RTN","IBC NAU3",29,0 ) | |
652 | HDR(ALLPLA NS,PLANS) ; Print RE PORT heade r | |
653 | "RTN","IBC NAU3",30,0 ) | |
654 | I $E(IOST ,1,2)="C-" !(IBPAG) W @IOF | |
655 | "RTN","IBC NAU3",31,0 ) | |
656 | S IBPAG=I BPAG+1 | |
657 | "RTN","IBC NAU3",32,0 ) | |
658 | W !,"USER EDIT REPO RT" | |
659 | "RTN","IBC NAU3",33,0 ) | |
660 | W ?IOM-34 ,IBHDT,?IO M-10,"Page : ",IBPAG | |
661 | "RTN","IBC NAU3",34,0 ) | |
662 | W !?5,"In surance Co mpany" | |
663 | "RTN","IBC NAU3",35,0 ) | |
664 | I PLANS W ?42,"Grou p Name" | |
665 | "RTN","IBC NAU3",36,0 ) | |
666 | W !!?5,"U ser",?25," Date/Time of Change" ,?49,"Modi fied Field ",?75,"Pre vious Valu e of Data" ,?100,"Mod ified Valu e of Data" | |
667 | "RTN","IBC NAU3",37,0 ) | |
668 | W !,$TR($ J(" ",IOM) ," ","_"), ! | |
669 | "RTN","IBC NAU3",38,0 ) | |
670 | Q | |
671 | "RTN","IBC NAU3",39,0 ) | |
672 | ; | |
673 | "RTN","IBC NAU3",40,0 ) | |
674 | PLAN ; Pri nt plan in formation. | |
675 | "RTN","IBC NAU3",41,0 ) | |
676 | N USER,DA TE | |
677 | "RTN","IBC NAU3",42,0 ) | |
678 | S USER=$$ GET1^DIQ(2 00,$P(IBPD ,U,3)_",", .01) | |
679 | "RTN","IBC NAU3",43,0 ) | |
680 | S DATE=$$ FMTE^XLFDT ($P(IBPD,U ,4),2),DAT E=$TR(DATE ,"@"," ") | |
681 | "RTN","IBC NAU3",44,0 ) | |
682 | W !?5,$P( IBPD,U),?4 2,$S('IB01 :"",1:$P(I BPD,U,2)) | |
683 | "RTN","IBC NAU3",45,0 ) | |
684 | W !?5,USE R,?25,DATE ,?49,$P(IB PD,U,7),?7 5,$S($P(IB PD,U,5)="" :"<no prev ious value >",1:$P(IB PD,U,5)),? 100,$P(IBP D,U,6),!! | |
685 | "RTN","IBC NAU3",46,0 ) | |
686 | Q | |
687 | "RTN","IBC NAU3",47,0 ) | |
688 | ; | |
689 | "RTN","IBC NAU3",48,0 ) | |
690 | PAUSE ; Pa use for sc reen outpu t. | |
691 | "RTN","IBC NAU3",49,0 ) | |
692 | Q:$E(IOST ,1,2)'["C- " | |
693 | "RTN","IBC NAU3",50,0 ) | |
694 | S DIR(0)= "E" D ^DIR K DIR I $ D(DIRUT)!( $D(DUOUT)) S IBQUIT= 1 K DIRUT, DTOUT,DUOU T | |
695 | "RTN","IBC NAU3",51,0 ) | |
696 | Q | |
697 | "RTN","IBC NAU3",52,0 ) | |
698 | ; | |
699 | "RTN","IBC NAU3",53,0 ) | |
700 | EXCEL(PLAN S) ; user selected f ormat that can be vi ewed in MS Excel | |
701 | "RTN","IBC NAU3",54,0 ) | |
702 | N IBI,IBJ ,IBK,IBL,I BM,IB01,IB 02,USER,DA TE | |
703 | "RTN","IBC NAU3",55,0 ) | |
704 | S (IB01,I B02)=0 | |
705 | "RTN","IBC NAU3",56,0 ) | |
706 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
707 | "RTN","IBC NAU3",57,0 ) | |
708 | W !,"USER EDIT REPO RT^"_$$FMT E^XLFDT($$ NOW^XLFDT, 1) | |
709 | "RTN","IBC NAU3",58,0 ) | |
710 | ; IB*602/ HN end | |
711 | "RTN","IBC NAU3",59,0 ) | |
712 | ; | |
713 | "RTN","IBC NAU3",60,0 ) | |
714 | I PLANS W !,"Insura nce Compan y^Group Na me^User^Da te/Time of Change^Mo dified Fie ld^Previou s Value of Data^Modi fied Value of Data", ! | |
715 | "RTN","IBC NAU3",61,0 ) | |
716 | E W !,"I nsurance C ompany^Use r^Date/Tim e of Chang e^Modified Field^Pre vious Valu e of Data^ Modified V alue of Da ta",! | |
717 | "RTN","IBC NAU3",62,0 ) | |
718 | ; | |
719 | "RTN","IBC NAU3",63,0 ) | |
720 | F IB01=0, 1 F S IB0 2=$O(^TMP( "IBPR",$J, IB01,IB02) ) Q:'IB02 S IBPD=$G (^TMP("IBP R",$J,IB01 ,IB02)) D | |
721 | "RTN","IBC NAU3",64,0 ) | |
722 | . S USER= $$GET1^DIQ (200,$P(IB PD,U,3)_", ",.01) | |
723 | "RTN","IBC NAU3",65,0 ) | |
724 | . S DATE= $$FMTE^XLF DT($P(IBPD ,U,4),2) | |
725 | "RTN","IBC NAU3",66,0 ) | |
726 | . I IB01= 0 W $P(IBP D,U)_U_USE R_U_DATE_U _$P(IBPD,U ,7)_U_$S($ P(IBPD,U,5 )="":"<no previous v alue>",1:$ P(IBPD,U,5 ))_U_$P(IB PD,U,6) | |
727 | "RTN","IBC NAU3",67,0 ) | |
728 | . E W $P (IBPD,U)_U _$P(IBPD,U ,2)_U_USER _U_DATE_U_ $P(IBPD,U, 7)_U_$S($P (IBPD,U,5) ="":"<no p revious va lue>",1:$P (IBPD,U,5) )_U_$P(IBP D,U,6) | |
729 | "RTN","IBC NAU3",68,0 ) | |
730 | . W ! | |
731 | "RTN","IBC NAU3",69,0 ) | |
732 | ; -- writ e to scree n | |
733 | "RTN","IBC NAU3",70,0 ) | |
734 | I $E(IOST ,1,2)["C-" W !,"[END OF REPORT ]",! S DIR ("A")="Pre ss RETURN to continu e" D PAUSE | |
735 | "RTN","IBC NAU3",71,0 ) | |
736 | Q | |
737 | "RTN","IBC NBOA") | |
738 | 0^2^B68100 333^B66757 822 | |
739 | "RTN","IBC NBOA",1,0) | |
740 | IBCNBOA ;A LB/ARH - I ns Buffer: Activity Report ;1 Jun 97 | |
741 | "RTN","IBC NBOA",2,0) | |
742 | ;;2.0;INT EGRATED BI LLING;**82 ,305,528,6 02**;21-MA R-94;Build 22 | |
743 | "RTN","IBC NBOA",3,0) | |
744 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
745 | "RTN","IBC NBOA",4,0) | |
746 | ; | |
747 | "RTN","IBC NBOA",5,0) | |
748 | EN ;get pa rameters t hen run th e report | |
749 | "RTN","IBC NBOA",6,0) | |
750 | ; | |
751 | "RTN","IBC NBOA",7,0) | |
752 | K ^TMP($J ) D HOME^% ZIS S IBHD R="INSURAN CE BUFFER ACTIVITY R EPORT" W @ IOF,!!,?25 ,IBHDR | |
753 | "RTN","IBC NBOA",8,0) | |
754 | W !!,"Thi s report c ontains th e counts a nd time st atistics f or all act ivity in t he",!,"Ins urance Buf fer.",!! | |
755 | "RTN","IBC NBOA",9,0) | |
756 | ; | |
757 | "RTN","IBC NBOA",10,0 ) | |
758 | S IBBEG=$ $DATES^IBC NBOE("Begi nning") G: 'IBBEG EXI T | |
759 | "RTN","IBC NBOA",11,0 ) | |
760 | S IBEND=$ $DATES^IBC NBOE("Endi ng",IBBEG) G:'IBEND EXIT W !! | |
761 | "RTN","IBC NBOA",12,0 ) | |
762 | ; | |
763 | "RTN","IBC NBOA",13,0 ) | |
764 | S IBMONTH =$$MONTH^I BCNBOE G:I BMONTH="" EXIT W !! | |
765 | "RTN","IBC NBOA",14,0 ) | |
766 | ; | |
767 | "RTN","IBC NBOA",15,0 ) | |
768 | S IBOUT=$ $OUT^IBCNB OE G:IBOUT ="" EXIT | |
769 | "RTN","IBC NBOA",16,0 ) | |
770 | ; | |
771 | "RTN","IBC NBOA",17,0 ) | |
772 | DEV ;get t he device | |
773 | "RTN","IBC NBOA",18,0 ) | |
774 | S %ZIS="Q M",%ZIS("A ")="OUTPUT DEVICE: " D ^%ZIS G :POP EXIT | |
775 | "RTN","IBC NBOA",19,0 ) | |
776 | I $D(IO(" Q")) S ZTR TN="RPT^IB CNBOA",ZTD ESC=IBHDR, ZTSAVE("IB *")="" D ^ %ZTLOAD K IO("Q") G EXIT | |
777 | "RTN","IBC NBOA",20,0 ) | |
778 | U IO | |
779 | "RTN","IBC NBOA",21,0 ) | |
780 | ; | |
781 | "RTN","IBC NBOA",22,0 ) | |
782 | RPT ; run report | |
783 | "RTN","IBC NBOA",23,0 ) | |
784 | S IBQUIT= 0 | |
785 | "RTN","IBC NBOA",24,0 ) | |
786 | ; | |
787 | "RTN","IBC NBOA",25,0 ) | |
788 | ;Patch 30 5- QUIT in line belo w inserted for trans mission to ARC | |
789 | "RTN","IBC NBOA",26,0 ) | |
790 | D SEARCH( IBBEG,IBEN D,IBMONTH) Q:$G(IBAR FLAG) G:I BQUIT EXIT | |
791 | "RTN","IBC NBOA",27,0 ) | |
792 | D PRINT(I BBEG,IBEND ,IBOUT) | |
793 | "RTN","IBC NBOA",28,0 ) | |
794 | ; | |
795 | "RTN","IBC NBOA",29,0 ) | |
796 | EXIT K ^TM P($J),IBHD R,IBBEG,IB END,IBMONT H,IBOUT,IB QUIT | |
797 | "RTN","IBC NBOA",30,0 ) | |
798 | Q:$D(ZTQU EUED) | |
799 | "RTN","IBC NBOA",31,0 ) | |
800 | D ^%ZISC | |
801 | "RTN","IBC NBOA",32,0 ) | |
802 | Q | |
803 | "RTN","IBC NBOA",33,0 ) | |
804 | ; | |
805 | "RTN","IBC NBOA",34,0 ) | |
806 | SEARCH(IBB EG,IBEND,I BMONTH) ; search/sor t statisti cs for act ivity repo rt | |
807 | "RTN","IBC NBOA",35,0 ) | |
808 | N IBXST,I BXDT,IBBUF DA,IBB0,IB STAT,IBTIM E,IBS3,IBD ATE,IBVER, IBDT2 S IB QUIT="" | |
809 | "RTN","IBC NBOA",36,0 ) | |
810 | S IBBEG=$ G(IBBEG)-. 01,IBEND=$ S('$G(IBEN D):9999999 ,1:$P(IBEN D,".")+.9) | |
811 | "RTN","IBC NBOA",37,0 ) | |
812 | ; | |
813 | "RTN","IBC NBOA",38,0 ) | |
814 | S IBXST=" " F S IBX ST=$O(^IBA (355.33,"A FST",IBXST )) Q:IBXST ="" D Q :IBQUIT | |
815 | "RTN","IBC NBOA",39,0 ) | |
816 | . S IBXDT =+IBBEG F S IBXDT=$ O(^IBA(355 .33,"AFST" ,IBXST,IBX DT)) Q:'IB XDT!(IBXDT >IBEND) D S IBQUIT =$$STOP Q: IBQUIT | |
817 | "RTN","IBC NBOA",40,0 ) | |
818 | .. S IBBU FDA=0 F S IBBUFDA=$ O(^IBA(355 .33,"AFST" ,IBXST,IBX DT,IBBUFDA )) Q:'IBBU FDA D | |
819 | "RTN","IBC NBOA",41,0 ) | |
820 | ... ; | |
821 | "RTN","IBC NBOA",42,0 ) | |
822 | ... S IBB 0=$G(^IBA( 355.33,IBB UFDA,0)),I BSTAT=$P(I BB0,U,4),I BVER=$P(IB B0,U,10) | |
823 | "RTN","IBC NBOA",43,0 ) | |
824 | ... ; | |
825 | "RTN","IBC NBOA",44,0 ) | |
826 | ... ; ent ered | |
827 | "RTN","IBC NBOA",45,0 ) | |
828 | ... I IBX ST="E" S I BDATE=+IBB 0 I +IBDAT E,IBDATE>I BBEG,IBDAT E<IBEND D | |
829 | "RTN","IBC NBOA",46,0 ) | |
830 | .... S IB DT2=+$P(IB B0,U,10) I 'IBDT2 S IBDT2=+$P( IBB0,U,5) I 'IBDT2 S IBDT2=$$N OW^XLFDT | |
831 | "RTN","IBC NBOA",47,0 ) | |
832 | .... S IB TIME=+$$FM DIFF^XLFDT (IBDT2,IBD ATE,2),IBS TAT="ENTER ED",IBS3=1 | |
833 | "RTN","IBC NBOA",48,0 ) | |
834 | .... I +$ G(IBMONTH) D SET(IBS TAT,$E(IBD ATE,1,5),I BS3,IBTIME ,IBB0) | |
835 | "RTN","IBC NBOA",49,0 ) | |
836 | .... D SE T(IBSTAT,9 9999,IBS3, IBTIME,IBB 0) | |
837 | "RTN","IBC NBOA",50,0 ) | |
838 | ... ; | |
839 | "RTN","IBC NBOA",51,0 ) | |
840 | ... ; ver ified | |
841 | "RTN","IBC NBOA",52,0 ) | |
842 | ... I IBX ST="V" S I BDATE=+$P( IBB0,U,10) I +IBDATE ,IBDATE>IB BEG,IBDATE <IBEND D | |
843 | "RTN","IBC NBOA",53,0 ) | |
844 | .... S IB TIME=+$$FM DIFF^XLFDT (IBDATE,+I BB0,2),IBS TAT="VERIF IED",IBS3= 2 | |
845 | "RTN","IBC NBOA",54,0 ) | |
846 | .... I +$ G(IBMONTH) D SET(IBS TAT,$E(IBD ATE,1,5),I BS3,IBTIME ,IBB0) | |
847 | "RTN","IBC NBOA",55,0 ) | |
848 | .... D SE T(IBSTAT,9 9999,IBS3, IBTIME,IBB 0) | |
849 | "RTN","IBC NBOA",56,0 ) | |
850 | ... ; | |
851 | "RTN","IBC NBOA",57,0 ) | |
852 | ... ; pro cessed | |
853 | "RTN","IBC NBOA",58,0 ) | |
854 | ... I IBX ST="A"!(IB XST="R") S IBDATE=+$ P(IBB0,U,5 ) I +IBDAT E,IBDATE>I BBEG,IBDAT E<IBEND D | |
855 | "RTN","IBC NBOA",59,0 ) | |
856 | .... S IB DT2=+IBVER I 'IBVER S IBDT2=+I BB0 | |
857 | "RTN","IBC NBOA",60,0 ) | |
858 | .... S IB TIME=+$$FM DIFF^XLFDT (IBDATE,+I BDT2,2),IB STAT="UNKN OWN",IBS3= 6 | |
859 | "RTN","IBC NBOA",61,0 ) | |
860 | .... I $P (IBB0,U,4) ="A" S IBS 3=3,IBSTAT ="ACCEPTED " I 'IBVER S IBS3=4, IBSTAT=IBS TAT_" (&V) " | |
861 | "RTN","IBC NBOA",62,0 ) | |
862 | .... I $P (IBB0,U,4) ="R" S IBS 3=5,IBSTAT ="REJECTED " I +IBVER S IBS3=6, IBSTAT=IBS TAT_" (V)" | |
863 | "RTN","IBC NBOA",63,0 ) | |
864 | .... I +$ G(IBMONTH) D SET(IBS TAT,$E(IBD ATE,1,5),I BS3,IBTIME ,IBB0) | |
865 | "RTN","IBC NBOA",64,0 ) | |
866 | .... D SE T(IBSTAT,9 9999,IBS3, IBTIME,IBB 0) | |
867 | "RTN","IBC NBOA",65,0 ) | |
868 | ; | |
869 | "RTN","IBC NBOA",66,0 ) | |
870 | Q | |
871 | "RTN","IBC NBOA",67,0 ) | |
872 | ; | |
873 | "RTN","IBC NBOA",68,0 ) | |
874 | SET(STAT,S 1,S3,TIME, IBB0) ; | |
875 | "RTN","IBC NBOA",69,0 ) | |
876 | D TMP("IB CNBOA",S1, 1,S3,TIME, STAT) | |
877 | "RTN","IBC NBOA",70,0 ) | |
878 | I S3<3 D TMP("IBCNB OA",S1,2,1 ,TIME,"NOT PROCESSED ") | |
879 | "RTN","IBC NBOA",71,0 ) | |
880 | I S3>2 D TMP("IBCNB OA",S1,2,2 ,TIME,"PRO CESSED") | |
881 | "RTN","IBC NBOA",72,0 ) | |
882 | D TMP("IB CNBOA",S1, 2,9,TIME," TOTAL") | |
883 | "RTN","IBC NBOA",73,0 ) | |
884 | ; | |
885 | "RTN","IBC NBOA",74,0 ) | |
886 | Q:$E(STAT )'="A" | |
887 | "RTN","IBC NBOA",75,0 ) | |
888 | ; | |
889 | "RTN","IBC NBOA",76,0 ) | |
890 | D TMP1("I BCNBOAC",S 1,+$P(IBB0 ,U,7),+$P( IBB0,U,8), +$P(IBB0,U ,9)) | |
891 | "RTN","IBC NBOA",77,0 ) | |
892 | Q | |
893 | "RTN","IBC NBOA",78,0 ) | |
894 | ; | |
895 | "RTN","IBC NBOA",79,0 ) | |
896 | TMP(XREF,S 1,S2,S3,TI ME,NAME) ; | |
897 | "RTN","IBC NBOA",80,0 ) | |
898 | S ^TMP($J ,XREF,S1,S 2,S3)=NAME | |
899 | "RTN","IBC NBOA",81,0 ) | |
900 | S ^TMP($J ,XREF,S1,S 2,S3,"CNT" )=$G(^TMP( $J,XREF,S1 ,S2,S3,"CN T"))+1 | |
901 | "RTN","IBC NBOA",82,0 ) | |
902 | S ^TMP($J ,XREF,S1,S 2,S3,"TM") =$G(^TMP($ J,XREF,S1, S2,S3,"TM" ))+TIME | |
903 | "RTN","IBC NBOA",83,0 ) | |
904 | I '$G(^TM P($J,XREF, S1,S2,S3," HG"))!($G( ^TMP($J,XR EF,S1,S2,S 3,"HG"))<T IME) S ^TM P($J,XREF, S1,S2,S3," HG")=TIME | |
905 | "RTN","IBC NBOA",84,0 ) | |
906 | I '$G(^TM P($J,XREF, S1,S2,S3," LS"))!($G( ^TMP($J,XR EF,S1,S2,S 3,"LS"))>T IME) S ^TM P($J,XREF, S1,S2,S3," LS")=TIME | |
907 | "RTN","IBC NBOA",85,0 ) | |
908 | Q | |
909 | "RTN","IBC NBOA",86,0 ) | |
910 | ; | |
911 | "RTN","IBC NBOA",87,0 ) | |
912 | TMP1(XREF, S1,IC,GC,P C) ; | |
913 | "RTN","IBC NBOA",88,0 ) | |
914 | I +IC S ^ TMP($J,XRE F,S1,"I")= $G(^TMP($J ,XREF,S1," I"))+1 | |
915 | "RTN","IBC NBOA",89,0 ) | |
916 | I +GC S ^ TMP($J,XRE F,S1,"G")= $G(^TMP($J ,XREF,S1," G"))+1 | |
917 | "RTN","IBC NBOA",90,0 ) | |
918 | I +PC S ^ TMP($J,XRE F,S1,"P")= $G(^TMP($J ,XREF,S1," P"))+1 | |
919 | "RTN","IBC NBOA",91,0 ) | |
920 | S ^TMP($J ,XREF,S1," CNT")=$G(^ TMP($J,XRE F,S1,"CNT" ))+1 | |
921 | "RTN","IBC NBOA",92,0 ) | |
922 | Q | |
923 | "RTN","IBC NBOA",93,0 ) | |
924 | ; | |
925 | "RTN","IBC NBOA",94,0 ) | |
926 | ; | |
927 | "RTN","IBC NBOA",95,0 ) | |
928 | ; | |
929 | "RTN","IBC NBOA",96,0 ) | |
930 | PRINT(IBBE G,IBEND,IB OUT) ; | |
931 | "RTN","IBC NBOA",97,0 ) | |
932 | N IBXREF, IBLABLE,IB S1,IBS2,IB S3,IBINS,I BGRP,IBPOL ,IBCNT,IBI P,IBGP,IBP P,IBRDT,IB PGN,IBRANG E,IBLN,IBI | |
933 | "RTN","IBC NBOA",98,0 ) | |
934 | ; | |
935 | "RTN","IBC NBOA",99,0 ) | |
936 | I "^R^E^" '[(U_$G(IB OUT)_U) S IBOUT="R" | |
937 | "RTN","IBC NBOA",100, 0) | |
938 | S IBRANGE =$$FMTE^XL FDT(+IBBEG )_" - "_$$ FMTE^XLFDT (IBEND) | |
939 | "RTN","IBC NBOA",101, 0) | |
940 | S IBRDT=$ $FMTE^XLFD T($J($$NOW ^XLFDT,0,4 ),2),IBRDT =$TR(IBRDT ,"@"," "), (IBLN,IBPG N)=0 | |
941 | "RTN","IBC NBOA",102, 0) | |
942 | ; | |
943 | "RTN","IBC NBOA",103, 0) | |
944 | ; Excel o utput | |
945 | "RTN","IBC NBOA",104, 0) | |
946 | I IBOUT=" E" D PHDL D S IBI=$ $PAUSE Q | |
947 | "RTN","IBC NBOA",105, 0) | |
948 | . S IBXRE F="IBCNBOA ",IBS1="" F S IBS1= $O(^TMP($J ,IBXREF,IB S1)) Q:IBS 1="" D | |
949 | "RTN","IBC NBOA",106, 0) | |
950 | .. S IBLA BLE=$S(IBS 1=99999:"T OTALS",($E (IBBEG,1,5 )<IBS1)&($ E(IBEND,1, 5)>IBS1):$ $FMTE^XLFD T(IBS1_"00 "),1:"") | |
951 | "RTN","IBC NBOA",107, 0) | |
952 | .. I IBLA BLE="" S I BLABLE=$$F MTE^XLFDT( $S($E(IBBE G,1,5)<IBS 1:IBS1_"01 ",1:IBBEG) )_" - "_$$ FMTE^XLFDT ($S($E(IBE ND,1,5)>IB S1:$$SCH^X LFDT("1M(L )",IBS1_11 ),1:IBEND) ) | |
953 | "RTN","IBC NBOA",108, 0) | |
954 | .. S IBS2 =0 F S IB S2=$O(^TMP ($J,IBXREF ,IBS1,IBS2 )) Q:IBS2= "" D | |
955 | "RTN","IBC NBOA",109, 0) | |
956 | ... S IBS 3="" F S IBS3=$O(^T MP($J,IBXR EF,IBS1,IB S2,IBS3)) Q:'IBS3 D PRTLN | |
957 | "RTN","IBC NBOA",110, 0) | |
958 | .. ; | |
959 | "RTN","IBC NBOA",111, 0) | |
960 | .. S IBIN S=+$G(^TMP ($J,"IBCNB OAC",IBS1, "I")),IBGR P=+$G(^TMP ($J,"IBCNB OAC",IBS1, "G")) | |
961 | "RTN","IBC NBOA",112, 0) | |
962 | .. S IBPO L=+$G(^TMP ($J,"IBCNB OAC",IBS1, "P")),IBCN T=+$G(^TMP ($J,"IBCNB OAC",IBS1, "CNT")) | |
963 | "RTN","IBC NBOA",113, 0) | |
964 | .. S (IBI P,IBGP,IBP P)=0 I IBC NT'=0 S IB IP=((IBINS /IBCNT)*10 0)\1,IBGP= ((IBGRP/IB CNT)*100)\ 1,IBPP=((I BPOL/IBCNT )*100)\1 | |
965 | "RTN","IBC NBOA",114, 0) | |
966 | .. W U_IB INS_U_IBIP _"%"_U_IBG RP_U_IBGP_ "%"_U_IBPO L_U_IBPP_" %" | |
967 | "RTN","IBC NBOA",115, 0) | |
968 | ; | |
969 | "RTN","IBC NBOA",116, 0) | |
970 | D HDR | |
971 | "RTN","IBC NBOA",117, 0) | |
972 | ; | |
973 | "RTN","IBC NBOA",118, 0) | |
974 | S IBXREF= "IBCNBOA", IBS1="" F S IBS1=$O (^TMP($J,I BXREF,IBS1 )) Q:IBS1= "" D:IBLN >(IOSL-17) HDR Q:IBQ UIT D S IBLN=IBLN+ 7 | |
975 | "RTN","IBC NBOA",119, 0) | |
976 | . S IBLAB LE=$S(IBS1 =99999:"TO TALS",($E( IBBEG,1,5) <IBS1)&($E (IBEND,1,5 )>IBS1):$$ FMTE^XLFDT (IBS1_"00" ),1:"") | |
977 | "RTN","IBC NBOA",120, 0) | |
978 | . I IBLAB LE="" S IB LABLE=$$FM TE^XLFDT($ S($E(IBBEG ,1,5)<IBS1 :IBS1_"01" ,1:IBBEG)) _" - "_$$F MTE^XLFDT( $S($E(IBEN D,1,5)>IBS 1:$$SCH^XL FDT("1M(L) ",IBS1_11) ,1:IBEND)) | |
979 | "RTN","IBC NBOA",121, 0) | |
980 | . W !,?(4 0-($L(IBLA BLE)/2)),I BLABLE,! | |
981 | "RTN","IBC NBOA",122, 0) | |
982 | . W !,?43 ,"AVERAGE" ,?56,"LONG EST",?68," SHORTEST" | |
983 | "RTN","IBC NBOA",123, 0) | |
984 | . W !,"ST ATUS",?22, "COUNT",?3 0,"PERCENT ",?43,"# D AYS",?56," # DAYS",?6 8,"# DAYS" | |
985 | "RTN","IBC NBOA",124, 0) | |
986 | . ; | |
987 | "RTN","IBC NBOA",125, 0) | |
988 | . S IBS2= 0 F S IBS 2=$O(^TMP( $J,IBXREF, IBS1,IBS2) ) Q:IBS2=" " D S IB LN=IBLN+1 | |
989 | "RTN","IBC NBOA",126, 0) | |
990 | .. W !,"- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ------" | |
991 | "RTN","IBC NBOA",127, 0) | |
992 | .. S IBS3 ="" F S I BS3=$O(^TM P($J,IBXRE F,IBS1,IBS 2,IBS3)) Q :'IBS3 D PRTLN S I BLN=IBLN+1 | |
993 | "RTN","IBC NBOA",128, 0) | |
994 | . ; | |
995 | "RTN","IBC NBOA",129, 0) | |
996 | . S IBINS =+$G(^TMP( $J,"IBCNBO AC",IBS1," I")),IBGRP =+$G(^TMP( $J,"IBCNBO AC",IBS1," G")) | |
997 | "RTN","IBC NBOA",130, 0) | |
998 | . S IBPOL =+$G(^TMP( $J,"IBCNBO AC",IBS1," P")),IBCNT =+$G(^TMP( $J,"IBCNBO AC",IBS1," CNT")) | |
999 | "RTN","IBC NBOA",131, 0) | |
1000 | . S (IBIP ,IBGP,IBPP )=0 I IBCN T'=0 S IBI P=((IBINS/ IBCNT)*100 )\1,IBGP=( (IBGRP/IBC NT)*100)\1 ,IBPP=((IB POL/IBCNT) *100)\1 | |
1001 | "RTN","IBC NBOA",132, 0) | |
1002 | . W !!,?2 ,IBINS," N ew Compan" ,$S(IBINS= 1:"y",1:"i es")," (", IBIP,"%), " | |
1003 | "RTN","IBC NBOA",133, 0) | |
1004 | . W IBGRP ," New Gro up/Plan",$ S(IBGRP=1: "",1:"s"), " (",IBGP, "%), " | |
1005 | "RTN","IBC NBOA",134, 0) | |
1006 | . W IBPOL ," New Pat ient Polic ",$S(IBPOL =1:"y",1:" ies")," (" ,IBPP,"%)" ,! | |
1007 | "RTN","IBC NBOA",135, 0) | |
1008 | ; | |
1009 | "RTN","IBC NBOA",136, 0) | |
1010 | I 'IBQUIT S IBI=$$P AUSE | |
1011 | "RTN","IBC NBOA",137, 0) | |
1012 | Q | |
1013 | "RTN","IBC NBOA",138, 0) | |
1014 | ; | |
1015 | "RTN","IBC NBOA",139, 0) | |
1016 | PRTLN ; | |
1017 | "RTN","IBC NBOA",140, 0) | |
1018 | N IBSTX,I BCNT,IBTM, IBHG,IBLS, IBTCNT | |
1019 | "RTN","IBC NBOA",141, 0) | |
1020 | ; | |
1021 | "RTN","IBC NBOA",142, 0) | |
1022 | S IBSTX=$ G(^TMP($J, IBXREF,IBS 1,IBS2,IBS 3)) | |
1023 | "RTN","IBC NBOA",143, 0) | |
1024 | S IBCNT=$ G(^TMP($J, IBXREF,IBS 1,IBS2,IBS 3,"CNT")) Q:'IBCNT | |
1025 | "RTN","IBC NBOA",144, 0) | |
1026 | S IBTM=$G (^TMP($J,I BXREF,IBS1 ,IBS2,IBS3 ,"TM")) | |
1027 | "RTN","IBC NBOA",145, 0) | |
1028 | S IBHG=$G (^TMP($J,I BXREF,IBS1 ,IBS2,IBS3 ,"HG")) | |
1029 | "RTN","IBC NBOA",146, 0) | |
1030 | S IBLS=$G (^TMP($J,I BXREF,IBS1 ,IBS2,IBS3 ,"LS")) | |
1031 | "RTN","IBC NBOA",147, 0) | |
1032 | S IBTCNT= $G(^TMP($J ,IBXREF,IB S1,2,9,"CN T")) Q:'IB TCNT | |
1033 | "RTN","IBC NBOA",148, 0) | |
1034 | ; | |
1035 | "RTN","IBC NBOA",149, 0) | |
1036 | ; Excel o utput | |
1037 | "RTN","IBC NBOA",150, 0) | |
1038 | I IBOUT=" E" W !,IBL ABLE_U_IBS TX_U_$FN(I BCNT,",")_ U_((IBCNT/ IBTCNT)*10 0)_"%"_U_$ $STD((IBTM /IBCNT))_U _$$STD(IBH G)_U_$$STD (IBLS) Q | |
1039 | "RTN","IBC NBOA",151, 0) | |
1040 | ; | |
1041 | "RTN","IBC NBOA",152, 0) | |
1042 | ; Report output | |
1043 | "RTN","IBC NBOA",153, 0) | |
1044 | W !,IBSTX ,?20,$J($F N(IBCNT,", "),7),?30, $J(((IBCNT /IBTCNT)*1 00),6,1)," %",?43,$J( $$STD((IBT M/IBCNT)), 6,1),?56,$ J($$STD(IB HG),6,1),? 68,$J($$ST D(IBLS),6, 1) | |
1045 | "RTN","IBC NBOA",154, 0) | |
1046 | Q | |
1047 | "RTN","IBC NBOA",155, 0) | |
1048 | ; | |
1049 | "RTN","IBC NBOA",156, 0) | |
1050 | STD(SEC) ; convert s econds to days | |
1051 | "RTN","IBC NBOA",157, 0) | |
1052 | N IBX,IBD ,IBS,IBH,D AYS S DAYS ="" G:'$G( SEC) STDQ | |
1053 | "RTN","IBC NBOA",158, 0) | |
1054 | S IBD=(SE C/86400),I BD=+$P(IBD ,".") | |
1055 | "RTN","IBC NBOA",159, 0) | |
1056 | S IBS=SEC -(IBD*8640 0) | |
1057 | "RTN","IBC NBOA",160, 0) | |
1058 | S IBH=((I BS/60)/60) ,IBH=+$J(I BH,0,2) | |
1059 | "RTN","IBC NBOA",161, 0) | |
1060 | S DAYS=IB D+(IBH/24) | |
1061 | "RTN","IBC NBOA",162, 0) | |
1062 | STDQ Q DAY S | |
1063 | "RTN","IBC NBOA",163, 0) | |
1064 | ; | |
1065 | "RTN","IBC NBOA",164, 0) | |
1066 | HDR ;print the repor t header | |
1067 | "RTN","IBC NBOA",165, 0) | |
1068 | S IBQUIT= $$STOP Q:I BQUIT | |
1069 | "RTN","IBC NBOA",166, 0) | |
1070 | I IBPGN>0 S IBQUIT= $$PAUSE Q: IBQUIT | |
1071 | "RTN","IBC NBOA",167, 0) | |
1072 | S IBPGN=I BPGN+1,IBL N=4 I IBPG N>1!($E(IO ST,1,2)["C -") W @IOF | |
1073 | "RTN","IBC NBOA",168, 0) | |
1074 | W !,"INSU RANCE BUFF ER ACTIVIT Y REPORT ",IBRANGE ," " | |
1075 | "RTN","IBC NBOA",169, 0) | |
1076 | W ?(IOM-2 2),IBRDT,? (IOM-7)," PAGE ",IBP GN,! | |
1077 | "RTN","IBC NBOA",170, 0) | |
1078 | S IBI="", $P(IBI,"-" ,IOM+1)="" W IBI,! | |
1079 | "RTN","IBC NBOA",171, 0) | |
1080 | Q | |
1081 | "RTN","IBC NBOA",172, 0) | |
1082 | ; | |
1083 | "RTN","IBC NBOA",173, 0) | |
1084 | PHDL ; - P rint the h eader line for the E xcel sprea dsheet | |
1085 | "RTN","IBC NBOA",174, 0) | |
1086 | N X | |
1087 | "RTN","IBC NBOA",175, 0) | |
1088 | ; ; IB*60 2/HN ; Add report he aders to E xcel Sprea dsheets | |
1089 | "RTN","IBC NBOA",176, 0) | |
1090 | W !,"INSU RANCE BUFF ER ACTIVIT Y REPORT^" ,IBRANGE_" ^"_$$FMTE^ XLFDT($$NO W^XLFDT,1) ,! | |
1091 | "RTN","IBC NBOA",177, 0) | |
1092 | ; IB*602/ HN end | |
1093 | "RTN","IBC NBOA",178, 0) | |
1094 | S X="MONT H^STATUS^C OUNT^PERCE NT^AVERAGE # DAYS^LO NGEST # DA YS^SHORTES T # DAYS^N ew Compani es^% New C ompanies^N ew Group/P lans^% New Group/Pla ns^New Pat ient Polic ies^% New Patient Po licies" | |
1095 | "RTN","IBC NBOA",179, 0) | |
1096 | W X | |
1097 | "RTN","IBC NBOA",180, 0) | |
1098 | K X | |
1099 | "RTN","IBC NBOA",181, 0) | |
1100 | Q | |
1101 | "RTN","IBC NBOA",182, 0) | |
1102 | ; | |
1103 | "RTN","IBC NBOA",183, 0) | |
1104 | PAUSE() ;p ause at en d of scree n if being displayed on a term inal | |
1105 | "RTN","IBC NBOA",184, 0) | |
1106 | N IBX,DIR ,DIRUT,X,Y S IBX=0 | |
1107 | "RTN","IBC NBOA",185, 0) | |
1108 | I $E(IOST ,1,2)["C-" W !! S DI R(0)="E" D ^DIR K DI R I $D(DUO UT)!($D(DI RUT)) S IB X=1 | |
1109 | "RTN","IBC NBOA",186, 0) | |
1110 | Q IBX | |
1111 | "RTN","IBC NBOA",187, 0) | |
1112 | ; | |
1113 | "RTN","IBC NBOA",188, 0) | |
1114 | STOP() ;de termine if user has requested the queued report to stop | |
1115 | "RTN","IBC NBOA",189, 0) | |
1116 | I $D(ZTQU EUED),$$S^ %ZTLOAD S ZTSTOP=1 K ZTREQ I + $G(IBPGN) W !,"***TA SK STOPPED BY USER** *" | |
1117 | "RTN","IBC NBOA",190, 0) | |
1118 | Q +$G(ZTS TOP) | |
1119 | "RTN","IBC NBOA",191, 0) | |
1120 | ; | |
1121 | "RTN","IBC NBOA",192, 0) | |
1122 | IBAR(IBBEG ,IBEND) ;E ntry point for Vista IB AR dat a to ARC | |
1123 | "RTN","IBC NBOA",193, 0) | |
1124 | ;patch 30 5 - called by IBRFN4 | |
1125 | "RTN","IBC NBOA",194, 0) | |
1126 | N IBMONTH ,IBARFLAG, IBARDATA,I BTM,IBCNT | |
1127 | "RTN","IBC NBOA",195, 0) | |
1128 | S IBMONTH =0,IBARFLA G=1 K ^TMP ($J) | |
1129 | "RTN","IBC NBOA",196, 0) | |
1130 | D RPT | |
1131 | "RTN","IBC NBOA",197, 0) | |
1132 | S IBTM=$G (^TMP($J," IBCNBOA",9 9999,2,2," TM")) | |
1133 | "RTN","IBC NBOA",198, 0) | |
1134 | S IBCNT=$ G(^TMP($J, "IBCNBOA", 99999,2,2, "CNT")) | |
1135 | "RTN","IBC NBOA",199, 0) | |
1136 | I 'IBCNT S IBARDATA =0 G IBARQ | |
1137 | "RTN","IBC NBOA",200, 0) | |
1138 | S IBARDAT A=$FN($$ST D((IBTM/IB CNT)),"",1 ) | |
1139 | "RTN","IBC NBOA",201, 0) | |
1140 | K ^TMP($J ) | |
1141 | "RTN","IBC NBOA",202, 0) | |
1142 | IBARQ Q IB ARDATA | |
1143 | "RTN","IBC NBOE") | |
1144 | 0^15^B1127 16320^B109 925669 | |
1145 | "RTN","IBC NBOE",1,0) | |
1146 | IBCNBOE ;A LB/ARH - I ns Buffer: Employee Report ;1 Jun 97 | |
1147 | "RTN","IBC NBOE",2,0) | |
1148 | ;;2.0;INT EGRATED BI LLING;**82 ,528,602** ;21-MAR-94 ;Build 22 | |
1149 | "RTN","IBC NBOE",3,0) | |
1150 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
1151 | "RTN","IBC NBOE",4,0) | |
1152 | ; | |
1153 | "RTN","IBC NBOE",5,0) | |
1154 | EN ;get pa rameters t hen run th e report | |
1155 | "RTN","IBC NBOE",6,0) | |
1156 | N IBX S I BX=$$WR Q: 'IBX I IB X=1 G ^IBC NBOF ; WHI CH REPORT? entered or process ed | |
1157 | "RTN","IBC NBOE",7,0) | |
1158 | ; | |
1159 | "RTN","IBC NBOE",8,0) | |
1160 | ; | |
1161 | "RTN","IBC NBOE",9,0) | |
1162 | K ^TMP($J ) D HOME^% ZIS S IBHD R="INSURAN CE BUFFER INSURANCE EMPLOYEE R EPORT" W @ IOF,!!,?17 ,IBHDR | |
1163 | "RTN","IBC NBOE",10,0 ) | |
1164 | W !!,"Thi s report p roduces co unts and t ime statis tics for I nsurance E mployees t hat",!,"ha ve either Verified o r Processe d (Accept/ Reject) an Insurance Buffer en try.",!! | |
1165 | "RTN","IBC NBOE",11,0 ) | |
1166 | ; | |
1167 | "RTN","IBC NBOE",12,0 ) | |
1168 | S IBEMPL= $$EMPL G:I BEMPL="" E XIT W !! | |
1169 | "RTN","IBC NBOE",13,0 ) | |
1170 | ; | |
1171 | "RTN","IBC NBOE",14,0 ) | |
1172 | I +IBEMPL S IBEMPL= $$SELEMPL( "Verifies or Process es") G:IBE MPL="" EXI T W !! | |
1173 | "RTN","IBC NBOE",15,0 ) | |
1174 | ; | |
1175 | "RTN","IBC NBOE",16,0 ) | |
1176 | S IBBEG=$ $DATES("Be ginning") G:'IBBEG E XIT | |
1177 | "RTN","IBC NBOE",17,0 ) | |
1178 | S IBEND=$ $DATES("En ding",IBBE G) G:'IBEN D EXIT W !! | |
1179 | "RTN","IBC NBOE",18,0 ) | |
1180 | ; | |
1181 | "RTN","IBC NBOE",19,0 ) | |
1182 | S IBMONTH =$$MONTH G :IBMONTH=" " EXIT W !! | |
1183 | "RTN","IBC NBOE",20,0 ) | |
1184 | ; | |
1185 | "RTN","IBC NBOE",21,0 ) | |
1186 | S IBOUT=$ $OUT G:IBO UT="" EXIT | |
1187 | "RTN","IBC NBOE",22,0 ) | |
1188 | ; | |
1189 | "RTN","IBC NBOE",23,0 ) | |
1190 | DEV ;get t he device | |
1191 | "RTN","IBC NBOE",24,0 ) | |
1192 | S %ZIS="Q M",%ZIS("A ")="OUTPUT DEVICE: " D ^%ZIS G :POP EXIT | |
1193 | "RTN","IBC NBOE",25,0 ) | |
1194 | I $D(IO(" Q")) S ZTR TN="RPT^IB CNBOE",ZTD ESC=IBHDR, ZTSAVE("IB *")="" D ^ %ZTLOAD K IO("Q") G EXIT | |
1195 | "RTN","IBC NBOE",26,0 ) | |
1196 | U IO | |
1197 | "RTN","IBC NBOE",27,0 ) | |
1198 | ; | |
1199 | "RTN","IBC NBOE",28,0 ) | |
1200 | RPT ; run report | |
1201 | "RTN","IBC NBOE",29,0 ) | |
1202 | S IBQUIT= 0 | |
1203 | "RTN","IBC NBOE",30,0 ) | |
1204 | ; | |
1205 | "RTN","IBC NBOE",31,0 ) | |
1206 | D SEARCH( IBBEG,IBEN D,IBMONTH, IBEMPL) G: IBQUIT EXI T | |
1207 | "RTN","IBC NBOE",32,0 ) | |
1208 | D PRINT(I BBEG,IBEND ,IBEMPL,IB OUT) | |
1209 | "RTN","IBC NBOE",33,0 ) | |
1210 | ; | |
1211 | "RTN","IBC NBOE",34,0 ) | |
1212 | EXIT K ^TM P($J),IBHD R,IBBEG,IB END,IBMONT H,IBOUT,IB QUIT,IBEMP L | |
1213 | "RTN","IBC NBOE",35,0 ) | |
1214 | Q:$D(ZTQU EUED) | |
1215 | "RTN","IBC NBOE",36,0 ) | |
1216 | D ^%ZISC | |
1217 | "RTN","IBC NBOE",37,0 ) | |
1218 | Q | |
1219 | "RTN","IBC NBOE",38,0 ) | |
1220 | ; | |
1221 | "RTN","IBC NBOE",39,0 ) | |
1222 | SEARCH(IBB EG,IBEND,I BMONTH,IBE MPL) ; sea rch/sort s tatistics for activi ty report | |
1223 | "RTN","IBC NBOE",40,0 ) | |
1224 | N IBXST,I BXDT,IBBUF DA,IBB0,IB DATE,IBEMP ,IBTIME,IB STAT,IBDT2 ,IBVER,IBS 3 S IBQUIT ="" | |
1225 | "RTN","IBC NBOE",41,0 ) | |
1226 | S IBBEG=$ G(IBBEG)-. 01,IBEND=$ S('$G(IBEN D):9999999 ,1:$P(IBEN D,".")+.9) | |
1227 | "RTN","IBC NBOE",42,0 ) | |
1228 | ; | |
1229 | "RTN","IBC NBOE",43,0 ) | |
1230 | F IBXST=" A","R","V" D Q:IBQ UIT | |
1231 | "RTN","IBC NBOE",44,0 ) | |
1232 | . S IBXDT =IBBEG F S IBXDT=$O (^IBA(355. 33,"AFST", IBXST,IBXD T)) Q:'IBX DT!(IBXDT> IBEND) D S IBQUIT= $$STOP Q:I BQUIT | |
1233 | "RTN","IBC NBOE",45,0 ) | |
1234 | .. S IBBU FDA=0 F S IBBUFDA=$ O(^IBA(355 .33,"AFST" ,IBXST,IBX DT,IBBUFDA )) Q:'IBBU FDA D | |
1235 | "RTN","IBC NBOE",46,0 ) | |
1236 | ... ; | |
1237 | "RTN","IBC NBOE",47,0 ) | |
1238 | ... S IBB 0=$G(^IBA( 355.33,IBB UFDA,0)) | |
1239 | "RTN","IBC NBOE",48,0 ) | |
1240 | ... ; | |
1241 | "RTN","IBC NBOE",49,0 ) | |
1242 | ... ; ver ified | |
1243 | "RTN","IBC NBOE",50,0 ) | |
1244 | ... I IBX ST="V" S I BDATE=+$P( IBB0,U,10) I +IBDATE ,IBDATE>IB BEG,IBDATE <IBEND D | |
1245 | "RTN","IBC NBOE",51,0 ) | |
1246 | .... S IB EMP=+$P(IB B0,U,11) I +IBEMPL,I BEMPL'=IBE MP Q | |
1247 | "RTN","IBC NBOE",52,0 ) | |
1248 | .... S IB TIME=$$FMD IFF^XLFDT( IBDATE,+IB B0,2),IBST AT="VERIFI ED",IBS3=1 | |
1249 | "RTN","IBC NBOE",53,0 ) | |
1250 | .... D SE T(IBSTAT,I BEMP,$E(IB DATE,1,5), IBS3,IBTIM E,IBB0,$G( IBMONTH)) | |
1251 | "RTN","IBC NBOE",54,0 ) | |
1252 | ... ; | |
1253 | "RTN","IBC NBOE",55,0 ) | |
1254 | ... ; pro cessed | |
1255 | "RTN","IBC NBOE",56,0 ) | |
1256 | ... I IBX ST="A"!(IB XST="R") S IBDATE=+$ P(IBB0,U,5 ) I +IBDAT E,IBDATE>I BBEG,IBDAT E<IBEND D | |
1257 | "RTN","IBC NBOE",57,0 ) | |
1258 | .... S IB EMP=+$P(IB B0,U,6) I +IBEMPL,IB EMPL'=IBEM P Q | |
1259 | "RTN","IBC NBOE",58,0 ) | |
1260 | .... S IB VER=$P(IBB 0,U,10),IB STAT="UNKN OWN",IBS3= 6 | |
1261 | "RTN","IBC NBOE",59,0 ) | |
1262 | .... S IB DT2=$S(+IB VER:+IBVER ,1:+IBB0), IBTIME=$$F MDIFF^XLFD T(IBDATE,+ IBDT2,2) | |
1263 | "RTN","IBC NBOE",60,0 ) | |
1264 | .... ; | |
1265 | "RTN","IBC NBOE",61,0 ) | |
1266 | .... I $P (IBB0,U,4) ="A" S IBS 3=2,IBSTAT ="ACCEPTED " I 'IBVER S IBS3=3, IBSTAT=IBS TAT_" (&V) " | |
1267 | "RTN","IBC NBOE",62,0 ) | |
1268 | .... I $P (IBB0,U,4) ="R" S IBS 3=4,IBSTAT ="REJECTED " I +IBVER S IBS3=5, IBSTAT=IBS TAT_" (V)" | |
1269 | "RTN","IBC NBOE",63,0 ) | |
1270 | .... D SE T(IBSTAT,I BEMP,$E(IB DATE,1,5), IBS3,IBTIM E,IBB0,$G( IBMONTH)) | |
1271 | "RTN","IBC NBOE",64,0 ) | |
1272 | ; | |
1273 | "RTN","IBC NBOE",65,0 ) | |
1274 | Q | |
1275 | "RTN","IBC NBOE",66,0 ) | |
1276 | ; | |
1277 | "RTN","IBC NBOE",67,0 ) | |
1278 | SET(STAT,I BEMP,IBDAT E,S3,TIME, IBB0,IBMON TH) ; | |
1279 | "RTN","IBC NBOE",68,0 ) | |
1280 | I +$G(IBM ONTH) D SE T1(IBSTAT, IBEMP,$E(I BDATE,1,5) ,S3,IBTIME ,IBB0) | |
1281 | "RTN","IBC NBOE",69,0 ) | |
1282 | D SET1(IB STAT,IBEMP ,99999,S3, IBTIME,IBB 0) | |
1283 | "RTN","IBC NBOE",70,0 ) | |
1284 | D SET1(IB STAT,"~",9 9999,S3,IB TIME,IBB0) | |
1285 | "RTN","IBC NBOE",71,0 ) | |
1286 | Q | |
1287 | "RTN","IBC NBOE",72,0 ) | |
1288 | ; | |
1289 | "RTN","IBC NBOE",73,0 ) | |
1290 | SET1(STAT, S1,S2,S3,T IME,IBB0) ; | |
1291 | "RTN","IBC NBOE",74,0 ) | |
1292 | ; | |
1293 | "RTN","IBC NBOE",75,0 ) | |
1294 | D TMP("IB CNBOE",S1, S2,S3,TIME ,STAT) | |
1295 | "RTN","IBC NBOE",76,0 ) | |
1296 | D TMP("IB CNBOE",S1, S2,9,TIME, "TOTAL") | |
1297 | "RTN","IBC NBOE",77,0 ) | |
1298 | ; | |
1299 | "RTN","IBC NBOE",78,0 ) | |
1300 | Q:$E(STAT )'="A" | |
1301 | "RTN","IBC NBOE",79,0 ) | |
1302 | ; | |
1303 | "RTN","IBC NBOE",80,0 ) | |
1304 | D TMP1("I BCNBOEC",S 1,S2,+$P(I BB0,U,7),+ $P(IBB0,U, 8),+$P(IBB 0,U,9)) | |
1305 | "RTN","IBC NBOE",81,0 ) | |
1306 | Q | |
1307 | "RTN","IBC NBOE",82,0 ) | |
1308 | ; | |
1309 | "RTN","IBC NBOE",83,0 ) | |
1310 | TMP(XREF,S 1,S2,S3,TI ME,NAME) ; | |
1311 | "RTN","IBC NBOE",84,0 ) | |
1312 | S ^TMP($J ,XREF,S1,S 2,S3)=NAME | |
1313 | "RTN","IBC NBOE",85,0 ) | |
1314 | S ^TMP($J ,XREF,S1,S 2,S3,"CNT" )=$G(^TMP( $J,XREF,S1 ,S2,S3,"CN T"))+1 | |
1315 | "RTN","IBC NBOE",86,0 ) | |
1316 | S ^TMP($J ,XREF,S1,S 2,S3,"TM") =$G(^TMP($ J,XREF,S1, S2,S3,"TM" ))+TIME | |
1317 | "RTN","IBC NBOE",87,0 ) | |
1318 | I '$G(^TM P($J,XREF, S1,S2,S3," HG"))!($G( ^TMP($J,XR EF,S1,S2,S 3,"HG"))<T IME) S ^TM P($J,XREF, S1,S2,S3," HG")=TIME | |
1319 | "RTN","IBC NBOE",88,0 ) | |
1320 | I '$G(^TM P($J,XREF, S1,S2,S3," LS"))!($G( ^TMP($J,XR EF,S1,S2,S 3,"LS"))>T IME) S ^TM P($J,XREF, S1,S2,S3," LS")=TIME | |
1321 | "RTN","IBC NBOE",89,0 ) | |
1322 | Q | |
1323 | "RTN","IBC NBOE",90,0 ) | |
1324 | ; | |
1325 | "RTN","IBC NBOE",91,0 ) | |
1326 | TMP1(XREF, S1,S2,IC,G C,PC) ; | |
1327 | "RTN","IBC NBOE",92,0 ) | |
1328 | I +IC S ^ TMP($J,XRE F,S1,S2,"I ")=$G(^TMP ($J,XREF,S 1,S2,"I")) +1 | |
1329 | "RTN","IBC NBOE",93,0 ) | |
1330 | I +GC S ^ TMP($J,XRE F,S1,S2,"G ")=$G(^TMP ($J,XREF,S 1,S2,"G")) +1 | |
1331 | "RTN","IBC NBOE",94,0 ) | |
1332 | I +PC S ^ TMP($J,XRE F,S1,S2,"P ")=$G(^TMP ($J,XREF,S 1,S2,"P")) +1 | |
1333 | "RTN","IBC NBOE",95,0 ) | |
1334 | S ^TMP($J ,XREF,S1,S 2,"CNT")=$ G(^TMP($J, XREF,S1,S2 ,"CNT"))+1 | |
1335 | "RTN","IBC NBOE",96,0 ) | |
1336 | Q | |
1337 | "RTN","IBC NBOE",97,0 ) | |
1338 | ; | |
1339 | "RTN","IBC NBOE",98,0 ) | |
1340 | ; | |
1341 | "RTN","IBC NBOE",99,0 ) | |
1342 | ; | |
1343 | "RTN","IBC NBOE",100, 0) | |
1344 | PRINT(IBBE G,IBEND,IB EMPL,IBOUT ) ; | |
1345 | "RTN","IBC NBOE",101, 0) | |
1346 | N IBXREF, IBLABLE,IB EMPN,IBS1, IBS2,IBS3, IBINS,IBGR P,IBPOL,IB CNT,IBIP,I BGP,IBPP,I BRDT,IBPGN ,IBRANGE,I BLN,IBI | |
1347 | "RTN","IBC NBOE",102, 0) | |
1348 | ; | |
1349 | "RTN","IBC NBOE",103, 0) | |
1350 | I "^R^E^" '[(U_$G(IB OUT)_U) S IBOUT="R" | |
1351 | "RTN","IBC NBOE",104, 0) | |
1352 | S IBRANGE =$$FMTE^XL FDT(IBBEG) _" - "_$$F MTE^XLFDT( IBEND) | |
1353 | "RTN","IBC NBOE",105, 0) | |
1354 | S IBRDT=$ $FMTE^XLFD T($J($$NOW ^XLFDT,0,4 ),2),IBRDT =$TR(IBRDT ,"@"," "), (IBLN,IBPG N)=0 | |
1355 | "RTN","IBC NBOE",106, 0) | |
1356 | ; | |
1357 | "RTN","IBC NBOE",107, 0) | |
1358 | ; Excel o utput | |
1359 | "RTN","IBC NBOE",108, 0) | |
1360 | I IBOUT=" E" D PHDL D S IBI=$ $PAUSE Q | |
1361 | "RTN","IBC NBOE",109, 0) | |
1362 | . S IBXRE F="IBCNBOE ",IBS1="" F S IBS1= $O(^TMP($J ,IBXREF,IB S1)) Q:IBS 1="" D | |
1363 | "RTN","IBC NBOE",110, 0) | |
1364 | .. S IBS2 =0 F S IB S2=$O(^TMP ($J,IBXREF ,IBS1,IBS2 )) Q:IBS2= "" D | |
1365 | "RTN","IBC NBOE",111, 0) | |
1366 | ... S IBL ABLE=$S(IB S2=99999:" TOTALS",($ E(IBBEG,1, 5)<IBS2)&( $E(IBEND,1 ,5)>IBS2): $$FMTE^XLF DT(IBS2_"0 0"),1:"") | |
1367 | "RTN","IBC NBOE",112, 0) | |
1368 | ... I IBL ABLE="" S IBLABLE=$$ FMTE^XLFDT ($S($E(IBB EG,1,5)<IB S2:IBS2_"0 1",1:IBBEG ))_" - "_$ $FMTE^XLFD T($S($E(IB END,1,5)>I BS2:$$SCH^ XLFDT("1M( L)",IBS2_1 1),1:IBEND )) | |
1369 | "RTN","IBC NBOE",113, 0) | |
1370 | ... S IBE MPN=$P($G( ^VA(200,IB S1,0)),U,1 ) | |
1371 | "RTN","IBC NBOE",114, 0) | |
1372 | ... S IBS 3="" F S IBS3=$O(^T MP($J,IBXR EF,IBS1,IB S2,IBS3)) Q:'IBS3 D PRTLN | |
1373 | "RTN","IBC NBOE",115, 0) | |
1374 | ... ; | |
1375 | "RTN","IBC NBOE",116, 0) | |
1376 | ... S IBI NS=+$G(^TM P($J,"IBCN BOEC",IBS1 ,IBS2,"I") ),IBGRP=+$ G(^TMP($J, "IBCNBOEC" ,IBS1,IBS2 ,"G")) | |
1377 | "RTN","IBC NBOE",117, 0) | |
1378 | ... S IBP OL=+$G(^TM P($J,"IBCN BOEC",IBS1 ,IBS2,"P") ),IBCNT=+$ G(^TMP($J, "IBCNBOEC" ,IBS1,IBS2 ,"CNT")) | |
1379 | "RTN","IBC NBOE",118, 0) | |
1380 | ... S (IB IP,IBGP,IB PP)=0 I IB CNT'=0 S I BIP=((IBIN S/IBCNT)*1 00)\1,IBGP =((IBGRP/I BCNT)*100) \1,IBPP=(( IBPOL/IBCN T)*100)\1 | |
1381 | "RTN","IBC NBOE",119, 0) | |
1382 | ... W U_I BINS_U_IBI P_"%"_U_IB GRP_U_IBGP _"%"_U_IBP OL_U_IBPP_ "%" | |
1383 | "RTN","IBC NBOE",120, 0) | |
1384 | ; | |
1385 | "RTN","IBC NBOE",121, 0) | |
1386 | D HDR | |
1387 | "RTN","IBC NBOE",122, 0) | |
1388 | ; | |
1389 | "RTN","IBC NBOE",123, 0) | |
1390 | S IBXREF= "IBCNBOE", IBS1="" F S IBS1=$O (^TMP($J,I BXREF,IBS1 )) Q:IBS1= "" D Q:I BQUIT | |
1391 | "RTN","IBC NBOE",124, 0) | |
1392 | . ; | |
1393 | "RTN","IBC NBOE",125, 0) | |
1394 | . S IBS2= 0 F S IBS 2=$O(^TMP( $J,IBXREF, IBS1,IBS2) ) Q:IBS2=" " D:IBLN> (IOSL-15) HDR Q:IBQU IT D S I BLN=IBLN+8 | |
1395 | "RTN","IBC NBOE",126, 0) | |
1396 | .. S IBLA BLE=$S(IBS 2=99999:"T OTALS",($E (IBBEG,1,5 )<IBS2)&($ E(IBEND,1, 5)>IBS2):$ $FMTE^XLFD T(IBS2_"00 "),1:"") | |
1397 | "RTN","IBC NBOE",127, 0) | |
1398 | .. I IBLA BLE="" S I BLABLE=$$F MTE^XLFDT( $S($E(IBBE G,1,5)<IBS 2:IBS2_1,1 :IBBEG))_" - "_$$FMT E^XLFDT($S ($E(IBEND, 1,5)>IBS2: $$SCH^XLFD T("1M(L)", IBS2_11),1 :IBEND)) | |
1399 | "RTN","IBC NBOE",128, 0) | |
1400 | .. S IBLA BLE=$P($G( ^VA(200,IB S1,0)),U,1 )_" "_IBL ABLE | |
1401 | "RTN","IBC NBOE",129, 0) | |
1402 | .. W !,?( 40-($L(IBL ABLE)/2)), IBLABLE,! | |
1403 | "RTN","IBC NBOE",130, 0) | |
1404 | .. W !,?4 3,"AVERAGE ",?56,"LON GEST",?68, "SHORTEST" | |
1405 | "RTN","IBC NBOE",131, 0) | |
1406 | .. W !,"S TATUS",?22 ,"COUNT",? 30,"PERCEN T",?43,"# DAYS",?56, "# DAYS",? 68,"# DAYS " | |
1407 | "RTN","IBC NBOE",132, 0) | |
1408 | .. W !,"- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ------" | |
1409 | "RTN","IBC NBOE",133, 0) | |
1410 | .. ; | |
1411 | "RTN","IBC NBOE",134, 0) | |
1412 | .. S IBS3 ="" F S I BS3=$O(^TM P($J,IBXRE F,IBS1,IBS 2,IBS3)) Q :'IBS3 D PRTLN S I BLN=IBLN+1 | |
1413 | "RTN","IBC NBOE",135, 0) | |
1414 | .. ; | |
1415 | "RTN","IBC NBOE",136, 0) | |
1416 | .. S IBIN S=+$G(^TMP ($J,"IBCNB OEC",IBS1, IBS2,"I")) ,IBGRP=+$G (^TMP($J," IBCNBOEC", IBS1,IBS2, "G")) | |
1417 | "RTN","IBC NBOE",137, 0) | |
1418 | .. S IBPO L=+$G(^TMP ($J,"IBCNB OEC",IBS1, IBS2,"P")) ,IBCNT=+$G (^TMP($J," IBCNBOEC", IBS1,IBS2, "CNT")) | |
1419 | "RTN","IBC NBOE",138, 0) | |
1420 | .. S (IBI P,IBGP,IBP P)=0 I IBC NT'=0 S IB IP=((IBINS /IBCNT)*10 0)\1,IBGP= ((IBGRP/IB CNT)*100)\ 1,IBPP=((I BPOL/IBCNT )*100)\1 | |
1421 | "RTN","IBC NBOE",139, 0) | |
1422 | .. W !!,? 2,IBINS," New Compan ",$S(IBINS =1:"y",1:" ies")," (" ,IBIP,"%), " | |
1423 | "RTN","IBC NBOE",140, 0) | |
1424 | .. W IBGR P," New Gr oup/Plan", $S(IBGRP=1 :"",1:"s") ," (",IBGP ,"%), " | |
1425 | "RTN","IBC NBOE",141, 0) | |
1426 | .. W IBPO L," New Pa tient Poli c",$S(IBPO L=1:"y",1: "ies")," ( ",IBPP,"%) ",! | |
1427 | "RTN","IBC NBOE",142, 0) | |
1428 | ; | |
1429 | "RTN","IBC NBOE",143, 0) | |
1430 | I 'IBQUIT S IBI=$$P AUSE | |
1431 | "RTN","IBC NBOE",144, 0) | |
1432 | Q | |
1433 | "RTN","IBC NBOE",145, 0) | |
1434 | ; | |
1435 | "RTN","IBC NBOE",146, 0) | |
1436 | PRTLN ; | |
1437 | "RTN","IBC NBOE",147, 0) | |
1438 | N IBSTX,I BCNT,IBTM, IBHG,IBLS, IBTCNT | |
1439 | "RTN","IBC NBOE",148, 0) | |
1440 | ; | |
1441 | "RTN","IBC NBOE",149, 0) | |
1442 | S IBSTX=$ G(^TMP($J, IBXREF,IBS 1,IBS2,IBS 3)) | |
1443 | "RTN","IBC NBOE",150, 0) | |
1444 | S IBCNT=$ G(^TMP($J, IBXREF,IBS 1,IBS2,IBS 3,"CNT")) Q:'IBCNT | |
1445 | "RTN","IBC NBOE",151, 0) | |
1446 | S IBTM=$G (^TMP($J,I BXREF,IBS1 ,IBS2,IBS3 ,"TM")) | |
1447 | "RTN","IBC NBOE",152, 0) | |
1448 | S IBHG=$G (^TMP($J,I BXREF,IBS1 ,IBS2,IBS3 ,"HG")) | |
1449 | "RTN","IBC NBOE",153, 0) | |
1450 | S IBLS=$G (^TMP($J,I BXREF,IBS1 ,IBS2,IBS3 ,"LS")) | |
1451 | "RTN","IBC NBOE",154, 0) | |
1452 | S IBTCNT= $G(^TMP($J ,IBXREF,IB S1,IBS2,9, "CNT")) Q: 'IBTCNT | |
1453 | "RTN","IBC NBOE",155, 0) | |
1454 | ; | |
1455 | "RTN","IBC NBOE",156, 0) | |
1456 | ; Excel o utput | |
1457 | "RTN","IBC NBOE",157, 0) | |
1458 | I IBOUT=" E" W !,IBE MPN_U_IBLA BLE_U_IBST X_U_$FN(IB CNT,",")_U _((IBCNT/I BTCNT)*100 )_"%"_U_$$ STD((IBTM/ IBCNT))_U_ $$STD(IBHG )_U_$$STD( IBLS) Q | |
1459 | "RTN","IBC NBOE",158, 0) | |
1460 | ; | |
1461 | "RTN","IBC NBOE",159, 0) | |
1462 | ; Report output | |
1463 | "RTN","IBC NBOE",160, 0) | |
1464 | W !,IBSTX ,?20,$J($F N(IBCNT,", "),7),?30, $J(((IBCNT /IBTCNT)*1 00),6,1)," %",?43,$J( $$STD((IBT M/IBCNT)), 6,1),?56,$ J($$STD(IB HG),6,1),? 68,$J($$ST D(IBLS),6, 1) | |
1465 | "RTN","IBC NBOE",161, 0) | |
1466 | Q | |
1467 | "RTN","IBC NBOE",162, 0) | |
1468 | ; | |
1469 | "RTN","IBC NBOE",163, 0) | |
1470 | STD(SEC) ; convert s econds to days | |
1471 | "RTN","IBC NBOE",164, 0) | |
1472 | N IBX,IBD ,IBS,IBH,D AYS S DAYS ="" G:'$G( SEC) STDQ | |
1473 | "RTN","IBC NBOE",165, 0) | |
1474 | S IBD=(SE C/86400),I BD=+$P(IBD ,".") | |
1475 | "RTN","IBC NBOE",166, 0) | |
1476 | S IBS=SEC -(IBD*8640 0) | |
1477 | "RTN","IBC NBOE",167, 0) | |
1478 | S IBH=((I BS/60)/60) ,IBH=+$J(I BH,0,2) | |
1479 | "RTN","IBC NBOE",168, 0) | |
1480 | S DAYS=IB D+(IBH/24) | |
1481 | "RTN","IBC NBOE",169, 0) | |
1482 | STDQ Q DAY S | |
1483 | "RTN","IBC NBOE",170, 0) | |
1484 | ; | |
1485 | "RTN","IBC NBOE",171, 0) | |
1486 | HDR ;print the repor t header | |
1487 | "RTN","IBC NBOE",172, 0) | |
1488 | S IBQUIT= $$STOP Q:I BQUIT | |
1489 | "RTN","IBC NBOE",173, 0) | |
1490 | I IBPGN>0 S IBQUIT= $$PAUSE Q: IBQUIT | |
1491 | "RTN","IBC NBOE",174, 0) | |
1492 | S IBPGN=I BPGN+1,IBL N=5 I IBPG N>1!($E(IO ST,1,2)["C -") W @IOF | |
1493 | "RTN","IBC NBOE",175, 0) | |
1494 | W !,"INSU RANCE BUFF ER EMPLOYE E REPORT ",IBRANGE ," " | |
1495 | "RTN","IBC NBOE",176, 0) | |
1496 | W ?(IOM-2 2),IBRDT,? (IOM-7)," PAGE ",IBP GN,! | |
1497 | "RTN","IBC NBOE",177, 0) | |
1498 | I +$G(IBE MPL) W !," EMPLOYEE: ",$P($G(^ VA(200,+IB EMPL,0)),U ,1),! | |
1499 | "RTN","IBC NBOE",178, 0) | |
1500 | S IBI="", $P(IBI,"-" ,IOM+1)="" W IBI,! | |
1501 | "RTN","IBC NBOE",179, 0) | |
1502 | Q | |
1503 | "RTN","IBC NBOE",180, 0) | |
1504 | ; | |
1505 | "RTN","IBC NBOE",181, 0) | |
1506 | PHDL ; - P rint the h eader line for the E xcel sprea dsheet | |
1507 | "RTN","IBC NBOE",182, 0) | |
1508 | N X | |
1509 | "RTN","IBC NBOE",183, 0) | |
1510 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
1511 | "RTN","IBC NBOE",184, 0) | |
1512 | W !,"INSU RANCE BUFF ER EMPLOYE E REPORT^" _IBRANGE_" ^"_$$FMTE^ XLFDT($$NO W^XLFDT,1) ,! | |
1513 | "RTN","IBC NBOE",185, 0) | |
1514 | I +$G(IBE MPL) W "EM PLOYEE: " ,$P($G(^VA (200,+IBEM PL,0)),U,1 ),! | |
1515 | "RTN","IBC NBOE",186, 0) | |
1516 | ; IB*602/ HN end | |
1517 | "RTN","IBC NBOE",187, 0) | |
1518 | S X="EMPL OYEE^MONTH ^STATUS^CO UNT^PERCEN T^AVERAGE # DAYS^LON GEST # DAY S^SHORTEST # DAYS^Ne w Companie s^% New Co mpanies^Ne w Group/Pl ans^% New Group/Plan s^New Pati ent Polici es^% New P atient Pol icies" | |
1519 | "RTN","IBC NBOE",188, 0) | |
1520 | W X | |
1521 | "RTN","IBC NBOE",189, 0) | |
1522 | K X | |
1523 | "RTN","IBC NBOE",190, 0) | |
1524 | Q | |
1525 | "RTN","IBC NBOE",191, 0) | |
1526 | ; | |
1527 | "RTN","IBC NBOE",192, 0) | |
1528 | PAUSE() ;p ause at en d of scree n if beein g displaye d on a ter minal | |
1529 | "RTN","IBC NBOE",193, 0) | |
1530 | N IBX,DIR ,DIRUT,X,Y S IBX=0 | |
1531 | "RTN","IBC NBOE",194, 0) | |
1532 | I $E(IOST ,1,2)["C-" W !! S DI R(0)="E" D ^DIR K DI R I $D(DUO UT)!($D(DI RUT)) S IB X=1 | |
1533 | "RTN","IBC NBOE",195, 0) | |
1534 | Q IBX | |
1535 | "RTN","IBC NBOE",196, 0) | |
1536 | ; | |
1537 | "RTN","IBC NBOE",197, 0) | |
1538 | STOP() ;de termine if user has requested the queued report to stop | |
1539 | "RTN","IBC NBOE",198, 0) | |
1540 | I $D(ZTQU EUED),$$S^ %ZTLOAD S ZTSTOP=1 K ZTREQ I + $G(IBPGN) W !,"***TA SK STOPPED BY USER** *" | |
1541 | "RTN","IBC NBOE",199, 0) | |
1542 | Q +$G(ZTS TOP) | |
1543 | "RTN","IBC NBOE",200, 0) | |
1544 | ; | |
1545 | "RTN","IBC NBOE",201, 0) | |
1546 | WR() ; whi ch report | |
1547 | "RTN","IBC NBOE",202, 0) | |
1548 | N DIR,X,Y ,DIRUT,DUO UT,IBX S I BX="" | |
1549 | "RTN","IBC NBOE",203, 0) | |
1550 | S DIR("?" )="Enter ' V' for a r eport base d on emplo yees that verify or process (a ccept/reje ct) buffer entries." | |
1551 | "RTN","IBC NBOE",204, 0) | |
1552 | S DIR("?" ,5)="Enter 'E' for a report ba sed on emp loyees tha t create n ew buffer entries." | |
1553 | "RTN","IBC NBOE",205, 0) | |
1554 | S DIR("?" ,1)="This report may be printe d for thos e employee s that cre ate Buffer entries," | |
1555 | "RTN","IBC NBOE",206, 0) | |
1556 | S DIR("?" ,2)="prima rily non-I nsurance p ersonnel o r for thos e employee s that ver ify and pr ocess",DIR ("?",3)="( accept/rej ect) Buffe r entries, primarily Insurance Personnel .",DIR("?" ,4)=" " | |
1557 | "RTN","IBC NBOE",207, 0) | |
1558 | S DIR("A" )="Include which Typ e of Emplo yee",DIR(0 )="SO^1:En tered By;2 :Verified/ Processed By" D ^DIR | |
1559 | "RTN","IBC NBOE",208, 0) | |
1560 | S IBX=$S( Y>0:+Y,1:" ") | |
1561 | "RTN","IBC NBOE",209, 0) | |
1562 | Q IBX | |
1563 | "RTN","IBC NBOE",210, 0) | |
1564 | ; | |
1565 | "RTN","IBC NBOE",211, 0) | |
1566 | EMPL() ; p rint a sin gle or all employees ? | |
1567 | "RTN","IBC NBOE",212, 0) | |
1568 | N DIR,X,Y ,DIRUT,DUO UT,IBX S I BX="" | |
1569 | "RTN","IBC NBOE",213, 0) | |
1570 | S DIR("?" ,1)="Repor t of activ ity in the Buffer fi le by Empl oyee and d ate range. " | |
1571 | "RTN","IBC NBOE",214, 0) | |
1572 | S DIR("?" ,2)="Enter 'S' to in clude only a single employee i n the repo rt." | |
1573 | "RTN","IBC NBOE",215, 0) | |
1574 | S DIR("?" )="Enter ' A' to incl ude all em ployees in the repor t." | |
1575 | "RTN","IBC NBOE",216, 0) | |
1576 | S DIR("A" )="Include Selected or All Emp loyees" | |
1577 | "RTN","IBC NBOE",217, 0) | |
1578 | S DIR("B" )="All",DI R(0)="SO^A :All Emplo yees;S:Sel ected Empl oyee" D ^D IR | |
1579 | "RTN","IBC NBOE",218, 0) | |
1580 | S IBX=$S( Y="S":1,Y= "A":0,1:"" ) | |
1581 | "RTN","IBC NBOE",219, 0) | |
1582 | Q IBX | |
1583 | "RTN","IBC NBOE",220, 0) | |
1584 | ; | |
1585 | "RTN","IBC NBOE",221, 0) | |
1586 | SELEMPL(TY PE) ; get the name o f an emplo yee | |
1587 | "RTN","IBC NBOE",222, 0) | |
1588 | N DIC,X,Y ,DTOUT,DUO UT,IBX S I BX="" | |
1589 | "RTN","IBC NBOE",223, 0) | |
1590 | S DIC("A" )="Select an Employe e that "_T YPE_" Buff er entries : " | |
1591 | "RTN","IBC NBOE",224, 0) | |
1592 | S DIC="^V A(200,",DI C(0)="AEMQ " D ^DIC S IBX=+Y I $D(DTOUT)! $D(DUOUT)! (Y<1) S IB X="" | |
1593 | "RTN","IBC NBOE",225, 0) | |
1594 | Q IBX | |
1595 | "RTN","IBC NBOE",226, 0) | |
1596 | ; | |
1597 | "RTN","IBC NBOE",227, 0) | |
1598 | DATES(LABL E,IBBEG) ; | |
1599 | "RTN","IBC NBOE",228, 0) | |
1600 | N DIR,X,Y ,DIRUT,DUO UT,IBX,IBB ,IBD S IBX ="",IBB=$P ($S(+$G(IB BEG):IBBEG ,1:+$O(^IB A(355.33," B",0))),". "),IBD=$S( +$G(IBBEG) :DT,1:IBB) | |
1601 | "RTN","IBC NBOE",229, 0) | |
1602 | S DIR("?" )="Enter t he "_LABLE _" date to include i n the repo rt." | |
1603 | "RTN","IBC NBOE",230, 0) | |
1604 | S DIR("?" ,1)="Enter a date fr om the dat e of the f irst Buffe r entry to today." | |
1605 | "RTN","IBC NBOE",231, 0) | |
1606 | S DIR("A" )=LABLE_" Date",DIR( "B")=$$FMT E^XLFDT(IB D) | |
1607 | "RTN","IBC NBOE",232, 0) | |
1608 | S DIR(0)= "DO^"_IBB_ ":"_DT_":E X" D ^DIR S IBX=Y I $D(DIRUT)! $D(DUOUT) S IBX="" | |
1609 | "RTN","IBC NBOE",233, 0) | |
1610 | Q IBX | |
1611 | "RTN","IBC NBOE",234, 0) | |
1612 | ; | |
1613 | "RTN","IBC NBOE",235, 0) | |
1614 | MONTH() ; | |
1615 | "RTN","IBC NBOE",236, 0) | |
1616 | N DIR,X,Y ,DIRUT,DUO UT,IBX S I BX="" | |
1617 | "RTN","IBC NBOE",237, 0) | |
1618 | S DIR("?" )="Enter N o if only totals for the date range shou ld be repo rted." | |
1619 | "RTN","IBC NBOE",238, 0) | |
1620 | S DIR("?" ,1)="Enter Yes if th e report s hould be b roken down by month. " | |
1621 | "RTN","IBC NBOE",239, 0) | |
1622 | S DIR("A" )="Report By Month", DIR(0)="Y" ,DIR("B")= "No" D ^DI R | |
1623 | "RTN","IBC NBOE",240, 0) | |
1624 | S IBX=$S( Y=1:Y,Y=0: Y,1:"") | |
1625 | "RTN","IBC NBOE",241, 0) | |
1626 | Q IBX | |
1627 | "RTN","IBC NBOE",242, 0) | |
1628 | ; | |
1629 | "RTN","IBC NBOE",243, 0) | |
1630 | OUT() ; | |
1631 | "RTN","IBC NBOE",244, 0) | |
1632 | N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y | |
1633 | "RTN","IBC NBOE",245, 0) | |
1634 | W ! | |
1635 | "RTN","IBC NBOE",246, 0) | |
1636 | S DIR(0)= "SA^E:Exce l;R:Report " | |
1637 | "RTN","IBC NBOE",247, 0) | |
1638 | S DIR("A" )="(E)xcel Format or (R)eport Format: " | |
1639 | "RTN","IBC NBOE",248, 0) | |
1640 | S DIR("B" )="Report" | |
1641 | "RTN","IBC NBOE",249, 0) | |
1642 | D ^DIR I $D(DIRUT) Q "" | |
1643 | "RTN","IBC NBOE",250, 0) | |
1644 | Q Y | |
1645 | "RTN","IBC NBOF") | |
1646 | 0^3^B33394 771^B32265 412 | |
1647 | "RTN","IBC NBOF",1,0) | |
1648 | IBCNBOF ;A LB/ARH - I ns Buffer: Employee Report (En tered);1 J un 97 | |
1649 | "RTN","IBC NBOF",2,0) | |
1650 | ;;2.0;INT EGRATED BI LLING;**82 ,528,602** ;21-MAR-94 ;Build 22 | |
1651 | "RTN","IBC NBOF",3,0) | |
1652 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
1653 | "RTN","IBC NBOF",4,0) | |
1654 | ; | |
1655 | "RTN","IBC NBOF",5,0) | |
1656 | EN ;get pa rameters t hen run th e report | |
1657 | "RTN","IBC NBOF",6,0) | |
1658 | ; | |
1659 | "RTN","IBC NBOF",7,0) | |
1660 | K ^TMP($J ) D HOME^% ZIS S IBHD R="INSURAN CE BUFFER EMPLOYEE R EPORT" W @ IOF,!!,?25 ,IBHDR | |
1661 | "RTN","IBC NBOF",8,0) | |
1662 | W !!,"Thi s report p roduces a count of t he number of entries added to the Buffer ",!,"file for a spec ified date range sor ted by emp loyee. Al so include d are",!," sub-totals and perce ntages bas ed on the current st atus of th ose entrie s." | |
1663 | "RTN","IBC NBOF",9,0) | |
1664 | ; | |
1665 | "RTN","IBC NBOF",10,0 ) | |
1666 | S IBEMPL= +$$EMPL^IB CNBOE G:IB EMPL="" EX IT W !! | |
1667 | "RTN","IBC NBOF",11,0 ) | |
1668 | I +IBEMPL S IBEMPL= $$SELEMPL^ IBCNBOE("E nters/Crea tes") G:IB EMPL="" EX IT W !! | |
1669 | "RTN","IBC NBOF",12,0 ) | |
1670 | ; | |
1671 | "RTN","IBC NBOF",13,0 ) | |
1672 | S IBBEG=$ $DATES^IBC NBOE("Begi nning") G: 'IBBEG EXI T | |
1673 | "RTN","IBC NBOF",14,0 ) | |
1674 | S IBEND=$ $DATES^IBC NBOE("Endi ng",IBBEG) G:'IBEND EXIT W !! | |
1675 | "RTN","IBC NBOF",15,0 ) | |
1676 | ; | |
1677 | "RTN","IBC NBOF",16,0 ) | |
1678 | S IBMONTH =$$MONTH^I BCNBOE G:I BMONTH="" EXIT W !! | |
1679 | "RTN","IBC NBOF",17,0 ) | |
1680 | ; | |
1681 | "RTN","IBC NBOF",18,0 ) | |
1682 | S IBOUT=$ $OUT^IBCNB OE G:IBOUT ="" EXIT | |
1683 | "RTN","IBC NBOF",19,0 ) | |
1684 | ; | |
1685 | "RTN","IBC NBOF",20,0 ) | |
1686 | DEV ;get t he device | |
1687 | "RTN","IBC NBOF",21,0 ) | |
1688 | I IBOUT=" R" W !,"Re port requi res 132 co lumns." | |
1689 | "RTN","IBC NBOF",22,0 ) | |
1690 | S %ZIS="Q M",%ZIS("A ")="OUTPUT DEVICE: " D ^%ZIS G :POP EXIT | |
1691 | "RTN","IBC NBOF",23,0 ) | |
1692 | I $D(IO(" Q")) S ZTR TN="RPT^IB CNBOF",ZTD ESC=IBHDR, ZTSAVE("IB *")="" D ^ %ZTLOAD K IO("Q") G EXIT | |
1693 | "RTN","IBC NBOF",24,0 ) | |
1694 | U IO | |
1695 | "RTN","IBC NBOF",25,0 ) | |
1696 | ; | |
1697 | "RTN","IBC NBOF",26,0 ) | |
1698 | RPT ; run report | |
1699 | "RTN","IBC NBOF",27,0 ) | |
1700 | S IBQUIT= 0 | |
1701 | "RTN","IBC NBOF",28,0 ) | |
1702 | ; | |
1703 | "RTN","IBC NBOF",29,0 ) | |
1704 | D SEARCH( IBBEG,IBEN D,IBMONTH, IBEMPL) G: IBQUIT EXI T | |
1705 | "RTN","IBC NBOF",30,0 ) | |
1706 | D PRINT(I BBEG,IBEND ,IBMONTH,I BEMPL,IBOU T) | |
1707 | "RTN","IBC NBOF",31,0 ) | |
1708 | ; | |
1709 | "RTN","IBC NBOF",32,0 ) | |
1710 | EXIT K ^TM P($J),IBHD R,IBBEG,IB END,IBMONT H,IBOUT,IB QUIT,IBEMP L | |
1711 | "RTN","IBC NBOF",33,0 ) | |
1712 | Q:$D(ZTQU EUED) | |
1713 | "RTN","IBC NBOF",34,0 ) | |
1714 | D ^%ZISC | |
1715 | "RTN","IBC NBOF",35,0 ) | |
1716 | Q | |
1717 | "RTN","IBC NBOF",36,0 ) | |
1718 | ; | |
1719 | "RTN","IBC NBOF",37,0 ) | |
1720 | SEARCH(IBB EG,IBEND,I BMONTH,IBE MPL) ; sea rch/sort s tatistics for employ ee report | |
1721 | "RTN","IBC NBOF",38,0 ) | |
1722 | N IBXDT,I BBUFDA,IBB 0,IBXREF,I BS1,IBEMP | |
1723 | "RTN","IBC NBOF",39,0 ) | |
1724 | S IBBEG=$ G(IBBEG)-. 01,IBEND=$ S('$G(IBEN D):9999999 ,1:$P(IBEN D,".")+.9) | |
1725 | "RTN","IBC NBOF",40,0 ) | |
1726 | ; | |
1727 | "RTN","IBC NBOF",41,0 ) | |
1728 | S IBXDT=I BBEG F S IBXDT=$O(^ IBA(355.33 ,"B",IBXDT )) Q:'IBXD T!(IBXDT>I BEND) D S IBQUIT=$ $STOP Q:IB QUIT | |
1729 | "RTN","IBC NBOF",42,0 ) | |
1730 | . S IBBUF DA=0 F S IBBUFDA=$O (^IBA(355. 33,"B",IBX DT,IBBUFDA )) Q:'IBBU FDA D | |
1731 | "RTN","IBC NBOF",43,0 ) | |
1732 | .. ; | |
1733 | "RTN","IBC NBOF",44,0 ) | |
1734 | .. S IBB0 =$G(^IBA(3 55.33,IBBU FDA,0)),IB EMP=+$P(IB B0,U,2) I 'IBEMP Q | |
1735 | "RTN","IBC NBOF",45,0 ) | |
1736 | .. I +IBE MPL,IBEMPL '=IBEMP Q | |
1737 | "RTN","IBC NBOF",46,0 ) | |
1738 | .. ; | |
1739 | "RTN","IBC NBOF",47,0 ) | |
1740 | .. I $G(I BMONTH) D SET("IBCNB OF",IBEMP, $E(+IBB0,1 ,5),$P(IBB 0,U,4),+$P (IBB0,U,7) ,+$P(IBB0, U,8),+$P(I BB0,U,9)) | |
1741 | "RTN","IBC NBOF",48,0 ) | |
1742 | .. D SET( "IBCNBOF", IBEMP,9999 9,$P(IBB0, U,4),+$P(I BB0,U,7),+ $P(IBB0,U, 8),+$P(IBB 0,U,9)) | |
1743 | "RTN","IBC NBOF",49,0 ) | |
1744 | .. D SET( "IBCNBOF", "~",99999, $P(IBB0,U, 4),+$P(IBB 0,U,7),+$P (IBB0,U,8) ,+$P(IBB0, U,9)) | |
1745 | "RTN","IBC NBOF",50,0 ) | |
1746 | ; | |
1747 | "RTN","IBC NBOF",51,0 ) | |
1748 | Q | |
1749 | "RTN","IBC NBOF",52,0 ) | |
1750 | ; | |
1751 | "RTN","IBC NBOF",53,0 ) | |
1752 | SET(XREF,S 1,S2,STAT, NC,NG,NP) ; | |
1753 | "RTN","IBC NBOF",54,0 ) | |
1754 | S ^TMP($J ,XREF,S1,S 2,"CNT")=$ G(^TMP($J, XREF,S1,S2 ,"CNT"))+1 | |
1755 | "RTN","IBC NBOF",55,0 ) | |
1756 | I STAT="E " S ^TMP($ J,XREF,S1, S2,"EN")=$ G(^TMP($J, XREF,S1,S2 ,"EN"))+1 | |
1757 | "RTN","IBC NBOF",56,0 ) | |
1758 | I STAT="R " S ^TMP($ J,XREF,S1, S2,"RJ")=$ G(^TMP($J, XREF,S1,S2 ,"RJ"))+1 | |
1759 | "RTN","IBC NBOF",57,0 ) | |
1760 | I STAT="A " S ^TMP($ J,XREF,S1, S2,"AC")=$ G(^TMP($J, XREF,S1,S2 ,"AC"))+1 | |
1761 | "RTN","IBC NBOF",58,0 ) | |
1762 | I +NC S ^ TMP($J,XRE F,S1,S2,"N C")=$G(^TM P($J,XREF, S1,S2,"NC" ))+1 | |
1763 | "RTN","IBC NBOF",59,0 ) | |
1764 | I +NG S ^ TMP($J,XRE F,S1,S2,"N G")=$G(^TM P($J,XREF, S1,S2,"NG" ))+1 | |
1765 | "RTN","IBC NBOF",60,0 ) | |
1766 | I +NP S ^ TMP($J,XRE F,S1,S2,"N P")=$G(^TM P($J,XREF, S1,S2,"NP" ))+1 | |
1767 | "RTN","IBC NBOF",61,0 ) | |
1768 | Q | |
1769 | "RTN","IBC NBOF",62,0 ) | |
1770 | ; | |
1771 | "RTN","IBC NBOF",63,0 ) | |
1772 | ; | |
1773 | "RTN","IBC NBOF",64,0 ) | |
1774 | PRINT(IBBE G,IBEND,IB MONTH,IBEM PL,IBOUT) ; | |
1775 | "RTN","IBC NBOF",65,0 ) | |
1776 | N IBXREF, IBS1,IBS2, IBRDT,IBPG N,IBRANGE, IBLN,IBI | |
1777 | "RTN","IBC NBOF",66,0 ) | |
1778 | ; | |
1779 | "RTN","IBC NBOF",67,0 ) | |
1780 | I "^R^E^" '[(U_$G(IB OUT)_U) S IBOUT="R" | |
1781 | "RTN","IBC NBOF",68,0 ) | |
1782 | S IBRANGE =$$FMTE^XL FDT(IBBEG) _" - "_$$F MTE^XLFDT( IBEND) | |
1783 | "RTN","IBC NBOF",69,0 ) | |
1784 | S IBRDT=$ $FMTE^XLFD T($J($$NOW ^XLFDT,0,4 ),2),IBRDT =$TR(IBRDT ,"@"," "), (IBLN,IBPG N)=0 | |
1785 | "RTN","IBC NBOF",70,0 ) | |
1786 | ; | |
1787 | "RTN","IBC NBOF",71,0 ) | |
1788 | D HDR:IBO UT="R",PHD L:IBOUT="E " | |
1789 | "RTN","IBC NBOF",72,0 ) | |
1790 | ; | |
1791 | "RTN","IBC NBOF",73,0 ) | |
1792 | S IBXREF= "IBCNBOF", IBS1="" F S IBS1=$O (^TMP($J,I BXREF,IBS1 )) Q:IBS1= "" D Q:I BQUIT | |
1793 | "RTN","IBC NBOF",74,0 ) | |
1794 | . I +$G(I BMONTH),(I BOUT="R") W ! S IBLN =IBLN+1 | |
1795 | "RTN","IBC NBOF",75,0 ) | |
1796 | . ; | |
1797 | "RTN","IBC NBOF",76,0 ) | |
1798 | . S IBS2= 0 F S IBS 2=$O(^TMP( $J,IBXREF, IBS1,IBS2) ) Q:IBS2=" " D:IBLN> (IOSL-3)&( IBOUT="R") HDR Q:IBQ UIT D | |
1799 | "RTN","IBC NBOF",77,0 ) | |
1800 | .. D PRTL N S IBLN= IBLN+1 | |
1801 | "RTN","IBC NBOF",78,0 ) | |
1802 | ; | |
1803 | "RTN","IBC NBOF",79,0 ) | |
1804 | I 'IBQUIT S IBI=$$P AUSE | |
1805 | "RTN","IBC NBOF",80,0 ) | |
1806 | Q | |
1807 | "RTN","IBC NBOF",81,0 ) | |
1808 | ; | |
1809 | "RTN","IBC NBOF",82,0 ) | |
1810 | PRTLN ; | |
1811 | "RTN","IBC NBOF",83,0 ) | |
1812 | N IBEMP,I BCNT,IBEN, IBAC,IBRJ, IBNC,IBNG, IBNP,DATM | |
1813 | "RTN","IBC NBOF",84,0 ) | |
1814 | ; | |
1815 | "RTN","IBC NBOF",85,0 ) | |
1816 | S IBEMP=$ P($G(^VA(2 00,+IBS1,0 )),U,1) I IBS1="~" S IBEMP="TO TAL" | |
1817 | "RTN","IBC NBOF",86,0 ) | |
1818 | S IBCNT=$ G(^TMP($J, IBXREF,IBS 1,IBS2,"CN T")) Q:'IB CNT | |
1819 | "RTN","IBC NBOF",87,0 ) | |
1820 | S IBEN=$G (^TMP($J,I BXREF,IBS1 ,IBS2,"EN" )) | |
1821 | "RTN","IBC NBOF",88,0 ) | |
1822 | S IBAC=$G (^TMP($J,I BXREF,IBS1 ,IBS2,"AC" )) | |
1823 | "RTN","IBC NBOF",89,0 ) | |
1824 | S IBRJ=$G (^TMP($J,I BXREF,IBS1 ,IBS2,"RJ" )) | |
1825 | "RTN","IBC NBOF",90,0 ) | |
1826 | S IBNC=$G (^TMP($J,I BXREF,IBS1 ,IBS2,"NC" )) | |
1827 | "RTN","IBC NBOF",91,0 ) | |
1828 | S IBNG=$G (^TMP($J,I BXREF,IBS1 ,IBS2,"NG" )) | |
1829 | "RTN","IBC NBOF",92,0 ) | |
1830 | S IBNP=$G (^TMP($J,I BXREF,IBS1 ,IBS2,"NP" )) | |
1831 | "RTN","IBC NBOF",93,0 ) | |
1832 | S DATM=$S (IBS2=9999 9:"TOTAL", 1:$$FMTE^X LFDT(IBS2_ "00")) | |
1833 | "RTN","IBC NBOF",94,0 ) | |
1834 | ; | |
1835 | "RTN","IBC NBOF",95,0 ) | |
1836 | ; Excel o utput | |
1837 | "RTN","IBC NBOF",96,0 ) | |
1838 | I IBOUT=" E" D Q | |
1839 | "RTN","IBC NBOF",97,0 ) | |
1840 | .W !,IBEM P_U_DATM_U _$FN(IBCNT ,",")_U_$F N(IBEN,"," )_U_$FN((( IBEN/IBCNT )*100),"," ,1)_"%"_U_ $FN(IBAC," ,")_U_$FN( ((IBAC/IBC NT)*100)," ,",1)_"%" | |
1841 | "RTN","IBC NBOF",98,0 ) | |
1842 | .W U_$FN( IBRJ,",")_ U_$FN(((IB RJ/IBCNT)* 100),",",1 )_"%"_U_$F N(IBNC,"," )_U_$FN(IB NG,",")_U_ $FN(IBNP," ,") | |
1843 | "RTN","IBC NBOF",99,0 ) | |
1844 | ; | |
1845 | "RTN","IBC NBOF",100, 0) | |
1846 | ; Report output | |
1847 | "RTN","IBC NBOF",101, 0) | |
1848 | W !,$E(IB EMP,1,15), ?17,DATM,? 25,$J($FN( IBCNT,",") ,7) | |
1849 | "RTN","IBC NBOF",102, 0) | |
1850 | W ?35,$J( $FN(IBEN," ,"),7),?43 ,$J("("_$F N(((IBEN/I BCNT)*100) ,",",1)_"% )",8) | |
1851 | "RTN","IBC NBOF",103, 0) | |
1852 | W ?54,$J( $FN(IBAC," ,"),7),?62 ,$J("("_$F N(((IBAC/I BCNT)*100) ,",",1)_"% )",8) | |
1853 | "RTN","IBC NBOF",104, 0) | |
1854 | W ?73,$J( $FN(IBRJ," ,"),7),?81 ,$J("("_$F N(((IBRJ/I BCNT)*100) ,",",1)_"% )",8) | |
1855 | "RTN","IBC NBOF",105, 0) | |
1856 | W ?92,$J( $FN(IBNC," ,"),7),?10 2,$J($FN(I BNG,","),7 ),?112,$J( $FN(IBNP," ,"),7) | |
1857 | "RTN","IBC NBOF",106, 0) | |
1858 | Q | |
1859 | "RTN","IBC NBOF",107, 0) | |
1860 | ; | |
1861 | "RTN","IBC NBOF",108, 0) | |
1862 | HDR ;print the repor t header | |
1863 | "RTN","IBC NBOF",109, 0) | |
1864 | S IBQUIT= $$STOP Q:I BQUIT | |
1865 | "RTN","IBC NBOF",110, 0) | |
1866 | I IBPGN>0 S IBQUIT= $$PAUSE Q: IBQUIT | |
1867 | "RTN","IBC NBOF",111, 0) | |
1868 | S IBPGN=I BPGN+1,IBL N=5 I IBPG N>1!($E(IO ST,1,2)["C -") W @IOF | |
1869 | "RTN","IBC NBOF",112, 0) | |
1870 | W !,"INSU RANCE BUFF ER (ENTERI NG) EMPLOY EE REPORT ",IBRANG E," " | |
1871 | "RTN","IBC NBOF",113, 0) | |
1872 | W ?(IOM-2 2),IBRDT,? (IOM-7)," PAGE ",IBP GN,!,?39," NOT YET",? 93,"NEW",? 104,"NEW", ?113,"NEW" | |
1873 | "RTN","IBC NBOF",114, 0) | |
1874 | W !,"EMPL OYEE",?17, "MONTH",?2 7,"TOTAL", ?39,"PROCE SSED",?58, "ACCEPTED" ,?77,"REJE CTED",?93, "INS CO",? 104,"GROUP ",?113,"PO LICY",! | |
1875 | "RTN","IBC NBOF",115, 0) | |
1876 | S IBI="", $P(IBI,"-" ,IOM+1)="" W IBI | |
1877 | "RTN","IBC NBOF",116, 0) | |
1878 | Q | |
1879 | "RTN","IBC NBOF",117, 0) | |
1880 | ; | |
1881 | "RTN","IBC NBOF",118, 0) | |
1882 | PHDL ; - P rint the h eader line for the E xcel sprea dsheet | |
1883 | "RTN","IBC NBOF",119, 0) | |
1884 | N X | |
1885 | "RTN","IBC NBOF",120, 0) | |
1886 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
1887 | "RTN","IBC NBOF",121, 0) | |
1888 | W !,"INSU RANCE BUFF ER (ENTERI NG) EMPLOY EE REPORT^ "_IBRANGE_ "^"_$$FMTE ^XLFDT($$N OW^XLFDT,1 ),! | |
1889 | "RTN","IBC NBOF",122, 0) | |
1890 | ; IB*602/ HN end | |
1891 | "RTN","IBC NBOF",123, 0) | |
1892 | S X="EMPL OYEE^MONTH ^TOTAL^NOT YET PROCE SSED^% NOT YET PROCE SSED^ACCEP TED^% ACCE PTED^REJEC TED^% REJE CTED^NEW I NS CO^NEW GROUP^NEW POLICY" | |
1893 | "RTN","IBC NBOF",124, 0) | |
1894 | W X | |
1895 | "RTN","IBC NBOF",125, 0) | |
1896 | K X | |
1897 | "RTN","IBC NBOF",126, 0) | |
1898 | Q | |
1899 | "RTN","IBC NBOF",127, 0) | |
1900 | ; | |
1901 | "RTN","IBC NBOF",128, 0) | |
1902 | PAUSE() ;p ause at en d of scree n if beein g displaye d on a ter minal | |
1903 | "RTN","IBC NBOF",129, 0) | |
1904 | N IBX,DIR ,DIRUT,DUO UT,X,Y S I BX=0 | |
1905 | "RTN","IBC NBOF",130, 0) | |
1906 | I $E(IOST ,1,2)["C-" W !! S DI R(0)="E" D ^DIR K DI R I $D(DUO UT)!($D(DI RUT)) S IB X=1 | |
1907 | "RTN","IBC NBOF",131, 0) | |
1908 | Q IBX | |
1909 | "RTN","IBC NBOF",132, 0) | |
1910 | ; | |
1911 | "RTN","IBC NBOF",133, 0) | |
1912 | STOP() ;de termine if user has requested the queued report to stop | |
1913 | "RTN","IBC NBOF",134, 0) | |
1914 | I $D(ZTQU EUED),$$S^ %ZTLOAD S ZTSTOP=1 K ZTREQ I + $G(IBPGN) W !,"***TA SK STOPPED BY USER** *" | |
1915 | "RTN","IBC NBOF",135, 0) | |
1916 | Q +$G(ZTS TOP) | |
1917 | "RTN","IBC NEDE4") | |
1918 | 0^19^B6182 6620^B6008 9694 | |
1919 | "RTN","IBC NEDE4",1,0 ) | |
1920 | IBCNEDE4 ; AITC/DM - EICD (Elec tronic Ins urance Cov erage Disc overy) ext ract;24-JU N-2002 | |
1921 | "RTN","IBC NEDE4",2,0 ) | |
1922 | ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 621,602**; 21-MAR-94; Build 22 | |
1923 | "RTN","IBC NEDE4",3,0 ) | |
1924 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
1925 | "RTN","IBC NEDE4",4,0 ) | |
1926 | ; | |
1927 | "RTN","IBC NEDE4",5,0 ) | |
1928 | ; **Progr am Descrip tion** | |
1929 | "RTN","IBC NEDE4",6,0 ) | |
1930 | ; The Ele ctronic In surance Co verage Dis covery a.k .a EICD ex tract (#4) | |
1931 | "RTN","IBC NEDE4",7,0 ) | |
1932 | ; is call ed from th e nightly job - IBCN EDE. | |
1933 | "RTN","IBC NEDE4",8,0 ) | |
1934 | ; | |
1935 | "RTN","IBC NEDE4",9,0 ) | |
1936 | ; Formerl y known as "No Insur ance", we are rework ing the en tire logic for | |
1937 | "RTN","IBC NEDE4",10, 0) | |
1938 | ; determi ning insur ance for t hose who d on't have active pol icies with patch IB* 2.0*621. | |
1939 | "RTN","IBC NEDE4",11, 0) | |
1940 | ; | |
1941 | "RTN","IBC NEDE4",12, 0) | |
1942 | Q | |
1943 | "RTN","IBC NEDE4",13, 0) | |
1944 | ; | |
1945 | "RTN","IBC NEDE4",14, 0) | |
1946 | EN ; EICD extract en try | |
1947 | "RTN","IBC NEDE4",15, 0) | |
1948 | N CLNC,DA TA1,DATA2, DATA5,DFN, EACTIVE,EL G,FRESHDT, IBACTV,IBA PPTDT | |
1949 | "RTN","IBC NEDE4",16, 0) | |
1950 | N IBBEGDT ,IBCSIEN,I BDFNDONE,I BEFF,IBEIC DPAY,IBEND DT,IBERR,I BEXP,IBFDA | |
1951 | "RTN","IBC NEDE4",17, 0) | |
1952 | N IBFREQ, IBIDX,IBIN SNM,IBMSG, IBSDA,IBTA SKTOT,IBTO PIEN,IBTQC NT,IBTQIEN | |
1953 | "RTN","IBC NEDE4",18, 0) | |
1954 | N IBTQSTA T,IBWK1,IB WK2,IBWKIE N,MAXCNT,O K | |
1955 | "RTN","IBC NEDE4",19, 0) | |
1956 | ; | |
1957 | "RTN","IBC NEDE4",20, 0) | |
1958 | ; Get Ex tract para meters | |
1959 | "RTN","IBC NEDE4",21, 0) | |
1960 | S EACTIVE =$$SETTING S^IBCNEDE7 (4) | |
1961 | "RTN","IBC NEDE4",22, 0) | |
1962 | I 'EACTIV E G ENQQ ; not activ e, or requ ired field s missing | |
1963 | "RTN","IBC NEDE4",23, 0) | |
1964 | S MAXCNT= $P(EACTIVE ,U,4) ; th rottle dai ly extract queries | |
1965 | "RTN","IBC NEDE4",24, 0) | |
1966 | S:MAXCNT= "" MAXCNT= 9999999999 | |
1967 | "RTN","IBC NEDE4",25, 0) | |
1968 | S IBWK1=$ P(EACTIVE, U,6) ; sta rt days | |
1969 | "RTN","IBC NEDE4",26, 0) | |
1970 | S IBBEGDT =$$FMADD^X LFDT(DT,IB WK1) ; beg in date = today + st art days | |
1971 | "RTN","IBC NEDE4",27, 0) | |
1972 | S IBENDDT =$$FMADD^X LFDT(DT,IB WK1+$P(EAC TIVE,U,7)) ; end dat e = today + start da ys + days after star t | |
1973 | "RTN","IBC NEDE4",28, 0) | |
1974 | S IBFREQ= $P(EACTIVE ,U,8) ; fr equency | |
1975 | "RTN","IBC NEDE4",29, 0) | |
1976 | S FRESHDT =$$FMADD^X LFDT(DT,-I BFREQ) | |
1977 | "RTN","IBC NEDE4",30, 0) | |
1978 | S IBCSIEN =$$FIND1^D IC(355.12, ,"X","CONT RACT SERVI CES","C") | |
1979 | "RTN","IBC NEDE4",31, 0) | |
1980 | S IBTQSTA T=$$FIND1^ DIC(365.14 ,,"X","Rea dy to Tran smit","B") | |
1981 | "RTN","IBC NEDE4",32, 0) | |
1982 | ; | |
1983 | "RTN","IBC NEDE4",33, 0) | |
1984 | ; see if the EICD P AYER site parameter has been p opulated | |
1985 | "RTN","IBC NEDE4",34, 0) | |
1986 | ; and is nationally and local ly active, if not, q uietly qui t | |
1987 | "RTN","IBC NEDE4",35, 0) | |
1988 | S IBEICDP AY=+$$GET1 ^DIQ(350.9 ,"1,",51.3 1,"I") ; " EICD PAYER " | |
1989 | "RTN","IBC NEDE4",36, 0) | |
1990 | I 'IBEICD PAY G ENQQ | |
1991 | "RTN","IBC NEDE4",37, 0) | |
1992 | I '($$GET 1^DIQ(365. 121,"1,"_I BEICDPAY_" ,",.02,"I" )) G ENQQ ; "NATIONA L ACTIVE" | |
1993 | "RTN","IBC NEDE4",38, 0) | |
1994 | I '($$GET 1^DIQ(365. 121,"1,"_I BEICDPAY_" ,",.03,"I" )) G ENQQ ; "LOCAL A CTIVE" | |
1995 | "RTN","IBC NEDE4",39, 0) | |
1996 | ; | |
1997 | "RTN","IBC NEDE4",40, 0) | |
1998 | ; gather the non-ac tive insur ance compa ny names | |
1999 | "RTN","IBC NEDE4",41, 0) | |
2000 | ; we will strip all blanks fr om the nam es, so das hes ('-') are treate d properly for a com pare | |
2001 | "RTN","IBC NEDE4",42, 0) | |
2002 | F IBIDX=2 :1 S IBWK1 =$P($T(NAI NSCO+IBIDX ),";;",2) Q:IBWK1="" S IBINSN M($TR(IBWK 1," ","")) ="" | |
2003 | "RTN","IBC NEDE4",43, 0) | |
2004 | ; | |
2005 | "RTN","IBC NEDE4",44, 0) | |
2006 | ; gather the non-ac tive type of plan ie ns | |
2007 | "RTN","IBC NEDE4",45, 0) | |
2008 | F IBIDX=2 :1 S IBWK1 =$P($T(NAT PLANS+IBID X),";;",2) Q:IBWK1=" " D | |
2009 | "RTN","IBC NEDE4",46, 0) | |
2010 | . S IBWK2 =+$$FIND1^ DIC(355.1, ,"BQX",IBW K1) | |
2011 | "RTN","IBC NEDE4",47, 0) | |
2012 | . Q:'IBWK 2 | |
2013 | "RTN","IBC NEDE4",48, 0) | |
2014 | . S IBTOP IEN(IBWK2) ="" | |
2015 | "RTN","IBC NEDE4",49, 0) | |
2016 | ; | |
2017 | "RTN","IBC NEDE4",50, 0) | |
2018 | S IBTASKT OT=0 ; Tas kman check | |
2019 | "RTN","IBC NEDE4",51, 0) | |
2020 | S IBTQCNT =0 ; TQ en try count | |
2021 | "RTN","IBC NEDE4",52, 0) | |
2022 | K ^TMP($J ,"SDAMA301 "),^TMP($J ,"IBCNEDE4 "),IBDFNDO NE | |
2023 | "RTN","IBC NEDE4",53, 0) | |
2024 | ; | |
2025 | "RTN","IBC NEDE4",54, 0) | |
2026 | ; Loop th rough clin ics | |
2027 | "RTN","IBC NEDE4",55, 0) | |
2028 | S CLNC=0 F S CLNC= $O(^SC(CLN C)) Q:'CLN C D | |
2029 | "RTN","IBC NEDE4",56, 0) | |
2030 | . D CLINI CEX^IBCNED E2 Q:'OK ; clinic e xcluded | |
2031 | "RTN","IBC NEDE4",57, 0) | |
2032 | . S ^TMP( $J,"IBCNED E4",CLNC)= "" | |
2033 | "RTN","IBC NEDE4",58, 0) | |
2034 | ; | |
2035 | "RTN","IBC NEDE4",59, 0) | |
2036 | ; Set up variables for schedu ling api a nd call | |
2037 | "RTN","IBC NEDE4",60, 0) | |
2038 | S IBSDA(" FLDS")=8 | |
2039 | "RTN","IBC NEDE4",61, 0) | |
2040 | S IBSDA(1 )=IBBEGDT_ ";"_IBENDD T | |
2041 | "RTN","IBC NEDE4",62, 0) | |
2042 | S IBSDA(2 )="^TMP($J ,""IBCNEDE 4""," | |
2043 | "RTN","IBC NEDE4",63, 0) | |
2044 | S IBSDA(3 )="R" | |
2045 | "RTN","IBC NEDE4",64, 0) | |
2046 | S OK=$$SD API^SDAMA3 01(.IBSDA) I OK<1 D: OK<0 ERRMS G G ENQQ | |
2047 | "RTN","IBC NEDE4",65, 0) | |
2048 | ; | |
2049 | "RTN","IBC NEDE4",66, 0) | |
2050 | ; loop th rough retu rned clini cs | |
2051 | "RTN","IBC NEDE4",67, 0) | |
2052 | S CLNC=0 | |
2053 | "RTN","IBC NEDE4",68, 0) | |
2054 | F S CLNC =$O(^TMP($ J,"SDAMA30 1",CLNC)) Q:'CLNC D G ENQQ:$ G(ZTSTOP)! (IBTQCNT'< MAXCNT) | |
2055 | "RTN","IBC NEDE4",69, 0) | |
2056 | . ; | |
2057 | "RTN","IBC NEDE4",70, 0) | |
2058 | . ; Loop through pa tients ret urned | |
2059 | "RTN","IBC NEDE4",71, 0) | |
2060 | . S DFN=0 | |
2061 | "RTN","IBC NEDE4",72, 0) | |
2062 | . F S DF N=$O(^TMP( $J,"SDAMA3 01",CLNC,D FN)) Q:'DF N D Q:$G (ZTSTOP)!( IBTQCNT'<M AXCNT) | |
2063 | "RTN","IBC NEDE4",73, 0) | |
2064 | .. ; | |
2065 | "RTN","IBC NEDE4",74, 0) | |
2066 | .. ; CHEC K DFN STUF F | |
2067 | "RTN","IBC NEDE4",75, 0) | |
2068 | .. Q:$D(I BDFNDONE(D FN)) ; DF N has been handled | |
2069 | "RTN","IBC NEDE4",76, 0) | |
2070 | .. ; | |
2071 | "RTN","IBC NEDE4",77, 0) | |
2072 | .. S OK=1 | |
2073 | "RTN","IBC NEDE4",78, 0) | |
2074 | .. S IBWK 1=+$$GET1^ DIQ(2,DFN_ ",",.6,"I" ) ; "TEST PATIENT IN DICATOR" | |
2075 | "RTN","IBC NEDE4",79, 0) | |
2076 | .. S:IBWK 1 OK=0 | |
2077 | "RTN","IBC NEDE4",80, 0) | |
2078 | .. ; | |
2079 | "RTN","IBC NEDE4",81, 0) | |
2080 | .. S IBWK 1=+$$GET1^ DIQ(2,DFN_ ",",2001," I") ; "DAT E LAST EIC D RUN" fro m PATIENT INS node | |
2081 | "RTN","IBC NEDE4",82, 0) | |
2082 | .. I IBWK 1,(IBWK1>F RESHDT) S OK=0 | |
2083 | "RTN","IBC NEDE4",83, 0) | |
2084 | .. ; | |
2085 | "RTN","IBC NEDE4",84, 0) | |
2086 | .. S IBWK 1=+$$GET1^ DIQ(2,DFN_ ",",.351," I") ; "DAT E OF DEATH " | |
2087 | "RTN","IBC NEDE4",85, 0) | |
2088 | .. S:IBWK 1 OK=0 | |
2089 | "RTN","IBC NEDE4",86, 0) | |
2090 | .. ; | |
2091 | "RTN","IBC NEDE4",87, 0) | |
2092 | .. ; any value for CITY is va lid, HL7 w ill replac e a "" wit h "UNKNOWN " | |
2093 | "RTN","IBC NEDE4",88, 0) | |
2094 | .. S IBWK 1=$$GET1^D IQ(2,DFN_" ,",.115) ; "STATE" | |
2095 | "RTN","IBC NEDE4",89, 0) | |
2096 | .. S:IBWK 1="" OK=0 | |
2097 | "RTN","IBC NEDE4",90, 0) | |
2098 | .. S IBWK 1=$$GET1^D IQ(2,DFN_" ,",.116) ; "ZIP CODE " | |
2099 | "RTN","IBC NEDE4",91, 0) | |
2100 | .. S:IBWK 1="" OK=0 | |
2101 | "RTN","IBC NEDE4",92, 0) | |
2102 | .. ; | |
2103 | "RTN","IBC NEDE4",93, 0) | |
2104 | .. I 'OK S IBDFNDON E(DFN)="" Q ; patie nt require ments not met | |
2105 | "RTN","IBC NEDE4",94, 0) | |
2106 | .. ; | |
2107 | "RTN","IBC NEDE4",95, 0) | |
2108 | .. ; Loop through d ates in ra nge at cli nic | |
2109 | "RTN","IBC NEDE4",96, 0) | |
2110 | .. S IBAP PTDT=IBBEG DT | |
2111 | "RTN","IBC NEDE4",97, 0) | |
2112 | .. F S I BAPPTDT=$O (^TMP($J," SDAMA301", CLNC,DFN,I BAPPTDT)) Q:('IBAPPT DT)!((IBAP PTDT\1)>IB ENDDT) D Q:$G(ZTST OP)!(IBTQC NT'<MAXCNT ) | |
2113 | "RTN","IBC NEDE4",98, 0) | |
2114 | ... ; | |
2115 | "RTN","IBC NEDE4",99, 0) | |
2116 | ... ; Upd ate count for period ic check | |
2117 | "RTN","IBC NEDE4",100 ,0) | |
2118 | ... S IBT ASKTOT=IBT ASKTOT+1 | |
2119 | "RTN","IBC NEDE4",101 ,0) | |
2120 | ... ; Che ck for req uest to st op backgro und job, p eriodicall y | |
2121 | "RTN","IBC NEDE4",102 ,0) | |
2122 | ... I $D( ZTQUEUED), IBTASKTOT# 100=0,$$S^ %ZTLOAD() S ZTSTOP=1 Q | |
2123 | "RTN","IBC NEDE4",103 ,0) | |
2124 | ... ; | |
2125 | "RTN","IBC NEDE4",104 ,0) | |
2126 | ... Q:$D( IBDFNDONE( DFN)) ; w e've alrea dy seen th is DFN | |
2127 | "RTN","IBC NEDE4",105 ,0) | |
2128 | ... ; | |
2129 | "RTN","IBC NEDE4",106 ,0) | |
2130 | ... S IBW K1=$G(^TMP ($J,"SDAMA 301",CLNC, DFN,IBAPPT DT)) | |
2131 | "RTN","IBC NEDE4",107 ,0) | |
2132 | ... S ELG =$P(IBWK1, U,8) | |
2133 | "RTN","IBC NEDE4",108 ,0) | |
2134 | ... S:ELG ="" ELG=$$ GET1^DIQ(2 ,DFN_",",. 361) ; "PR IMARY ELIG IBILITY CO DE" | |
2135 | "RTN","IBC NEDE4",109 ,0) | |
2136 | ... D ELG ^IBCNEDE2 Q:'OK ; e ligibility exclusion | |
2137 | "RTN","IBC NEDE4",110 ,0) | |
2138 | ... ; | |
2139 | "RTN","IBC NEDE4",111 ,0) | |
2140 | ... ; ski p any pati ent with " active" in surance | |
2141 | "RTN","IBC NEDE4",112 ,0) | |
2142 | ... S IBA CTV=0 | |
2143 | "RTN","IBC NEDE4",113 ,0) | |
2144 | ... S IBI DX=0 ; che ck policie s for "act ive" insur ance | |
2145 | "RTN","IBC NEDE4",114 ,0) | |
2146 | ... F S IBIDX=$O(^ DPT(DFN,.3 12,IBIDX)) Q:('IBIDX )!IBACTV D | |
2147 | "RTN","IBC NEDE4",115 ,0) | |
2148 | .... S IB WKIEN=IBID X_","_DFN_ "," | |
2149 | "RTN","IBC NEDE4",116 ,0) | |
2150 | .... S IB EFF=+$$GET 1^DIQ(2.31 2,IBWKIEN, 8,"I") ; e ffective d ate | |
2151 | "RTN","IBC NEDE4",117 ,0) | |
2152 | .... S IB EXP=+$$GET 1^DIQ(2.31 2,IBWKIEN, 3,"I") ; e xpiration date | |
2153 | "RTN","IBC NEDE4",118 ,0) | |
2154 | .... I 'I BEFF Q ; non-active | |
2155 | "RTN","IBC NEDE4",119 ,0) | |
2156 | .... I IB EXP,(IBEXP <(IBAPPTDT \1)) Q ; non-active | |
2157 | "RTN","IBC NEDE4",120 ,0) | |
2158 | .... ; | |
2159 | "RTN","IBC NEDE4",121 ,0) | |
2160 | .... S IB WK1=$TR($$ GET1^DIQ(2 .312,IBWKI EN,.01,"E" )," ","") ; insuranc e company name | |
2161 | "RTN","IBC NEDE4",122 ,0) | |
2162 | .... ; IB *2.0*602/T AZ Screen out bad po inters to File 36 | |
2163 | "RTN","IBC NEDE4",123 ,0) | |
2164 | .... I IB WK1="" Q ; bad poin ter to INS URANCE COM PANY File (#36) | |
2165 | "RTN","IBC NEDE4",124 ,0) | |
2166 | .... I $D (IBINSNM(I BWK1)) Q ; matches non-active insurance | |
2167 | "RTN","IBC NEDE4",125 ,0) | |
2168 | .... S IB WK1=$$GET1 ^DIQ(2.312 ,IBWKIEN,. 18,"I") ; group pl an ien | |
2169 | "RTN","IBC NEDE4",126 ,0) | |
2170 | .... S IB WK2=$$GET1 ^DIQ(355.3 ,IBWK1_"," ,.09,"I") ; type of plan ien | |
2171 | "RTN","IBC NEDE4",127 ,0) | |
2172 | .... ; no type of p lan is con sidered ac tive | |
2173 | "RTN","IBC NEDE4",128 ,0) | |
2174 | .... I IB WK2'="",$D (IBTOPIEN( IBWK2)) Q ; matches non-activ e type of plan | |
2175 | "RTN","IBC NEDE4",129 ,0) | |
2176 | .... ; | |
2177 | "RTN","IBC NEDE4",130 ,0) | |
2178 | .... ; 'I BEXP is co nsidered a ctive at t his point | |
2179 | "RTN","IBC NEDE4",131 ,0) | |
2180 | .... S IB ACTV=1 Q ; active | |
2181 | "RTN","IBC NEDE4",132 ,0) | |
2182 | ... ; | |
2183 | "RTN","IBC NEDE4",133 ,0) | |
2184 | ... I IBA CTV Q ; n ext clinic appt | |
2185 | "RTN","IBC NEDE4",134 ,0) | |
2186 | ... ; | |
2187 | "RTN","IBC NEDE4",135 ,0) | |
2188 | ... ; Thi s DFN is c onsidered non-active , we'll at tempt a TQ entry | |
2189 | "RTN","IBC NEDE4",136 ,0) | |
2190 | ... S IBD FNDONE(DFN )="" ; ok to flag D FN as hand led now | |
2191 | "RTN","IBC NEDE4",137 ,0) | |
2192 | ... ; the re should be no TQ e ntry for t his DFN, c onsider it a safety check | |
2193 | "RTN","IBC NEDE4",138 ,0) | |
2194 | ... I '$$ ADDTQ^IBCN EUT5(DFN,I BEICDPAY,D T,IBFREQ,1 ) Q | |
2195 | "RTN","IBC NEDE4",139 ,0) | |
2196 | ... ; SET prepare a nd file th e TQ | |
2197 | "RTN","IBC NEDE4",140 ,0) | |
2198 | ... ; DFN :Patient I EN | |
2199 | "RTN","IBC NEDE4",141 ,0) | |
2200 | ... ; IBE ICDPAY:EIC D payer IE N | |
2201 | "RTN","IBC NEDE4",142 ,0) | |
2202 | ... ; IBT QSTAT:TQ S TATUS IEN - Ready to Transmit | |
2203 | "RTN","IBC NEDE4",143 ,0) | |
2204 | ... ; FRE SHDT:Fresh ness date | |
2205 | "RTN","IBC NEDE4",144 ,0) | |
2206 | ... ; 4:E ICD data e xtract (#4 ) | |
2207 | "RTN","IBC NEDE4",145 ,0) | |
2208 | ... ; I:I dentificat ion | |
2209 | "RTN","IBC NEDE4",146 ,0) | |
2210 | ... ; DT: Todays dat e | |
2211 | "RTN","IBC NEDE4",147 ,0) | |
2212 | ... ; IBC SIEN:Sourc e of Infor mation IEN - Contrac t Services | |
2213 | "RTN","IBC NEDE4",148 ,0) | |
2214 | ... S DAT A1=DFN_U_I BEICDPAY_U _IBTQSTAT_ U_""_U_""_ U_FRESHDT | |
2215 | "RTN","IBC NEDE4",149 ,0) | |
2216 | ... S DAT A2=4_U_"I" _U_DT | |
2217 | "RTN","IBC NEDE4",150 ,0) | |
2218 | ... S DAT A5=IBCSIEN | |
2219 | "RTN","IBC NEDE4",151 ,0) | |
2220 | ... S IBT QIEN=$$SET TQ^IBCNEDE 7(DATA1,DA TA2,,,DATA 5) ; Sets in TQ | |
2221 | "RTN","IBC NEDE4",152 ,0) | |
2222 | ... I IBT QIEN="" K IBDFNDONE( DFN) Q ; didn't fi le, unmark DFN | |
2223 | "RTN","IBC NEDE4",153 ,0) | |
2224 | ... S IBT QCNT=IBTQC NT+1 ; increment the TQ co unt | |
2225 | "RTN","IBC NEDE4",154 ,0) | |
2226 | ... ; pla ce a stub into EIV E ICD TRACKI NG (#365.1 8) | |
2227 | "RTN","IBC NEDE4",155 ,0) | |
2228 | ... K IBF DA,IBERR | |
2229 | "RTN","IBC NEDE4",156 ,0) | |
2230 | ... ; EIV EICD TRAC KING, .01: TRANSMISSI ON .02:DAT E CREATED .03:PAYER .05:PATIEN T | |
2231 | "RTN","IBC NEDE4",157 ,0) | |
2232 | ... S IBF DA(365.18, "+1,",.01) =IBTQIEN,I BFDA(365.1 8,"+1,",.0 2)=DT | |
2233 | "RTN","IBC NEDE4",158 ,0) | |
2234 | ... S IBF DA(365.18, "+1,",.03) =IBEICDPAY ,IBFDA(365 .18,"+1,", .05)=DFN | |
2235 | "RTN","IBC NEDE4",159 ,0) | |
2236 | ... D UPD ATE^DIE(," IBFDA",,"I BERR") | |
2237 | "RTN","IBC NEDE4",160 ,0) | |
2238 | ... I $G( IBERR("DIE RR",1,"TEX T",1))'="" D Q | |
2239 | "RTN","IBC NEDE4",161 ,0) | |
2240 | .... S IB MSG="" | |
2241 | "RTN","IBC NEDE4",162 ,0) | |
2242 | .... D MS G002^IBCNE MS1(.IBMSG ,.IBERR,IB TQIEN) | |
2243 | "RTN","IBC NEDE4",163 ,0) | |
2244 | .... D MS G^IBCNEUT5 ($$MGRP^IB CNEUT5()," eIV Proble m: Error w riting EIV EICD TRAC KING (#365 .18)","IBM SG(") | |
2245 | "RTN","IBC NEDE4",164 ,0) | |
2246 | ... Q ; next clini c appt | |
2247 | "RTN","IBC NEDE4",165 ,0) | |
2248 | ... ; | |
2249 | "RTN","IBC NEDE4",166 ,0) | |
2250 | ENQQ ; cle an and qui t | |
2251 | "RTN","IBC NEDE4",167 ,0) | |
2252 | K ^TMP($J ,"SDAMA301 "),^TMP($J ,"IBCNEDE2 ") | |
2253 | "RTN","IBC NEDE4",168 ,0) | |
2254 | Q | |
2255 | "RTN","IBC NEDE4",169 ,0) | |
2256 | ; | |
2257 | "RTN","IBC NEDE4",170 ,0) | |
2258 | ERRMSG ; S end a mess age indica ting an ex tract erro r has occu rred | |
2259 | "RTN","IBC NEDE4",171 ,0) | |
2260 | S IBMSG=" " | |
2261 | "RTN","IBC NEDE4",172 ,0) | |
2262 | D MSG001^ IBCNEMS1(. IBMSG,"EIC D") | |
2263 | "RTN","IBC NEDE4",173 ,0) | |
2264 | D MSG^IBC NEUT5($$MG RP^IBCNEUT 5(),"eIV P roblem: EI CD Extract ","IBMSG(" ) | |
2265 | "RTN","IBC NEDE4",174 ,0) | |
2266 | ; | |
2267 | "RTN","IBC NEDE4",175 ,0) | |
2268 | Q | |
2269 | "RTN","IBC NEDE4",176 ,0) | |
2270 | ; | |
2271 | "RTN","IBC NEDE4",177 ,0) | |
2272 | NAINSCO ; Non-active Insurance companies | |
2273 | "RTN","IBC NEDE4",178 ,0) | |
2274 | ; | |
2275 | "RTN","IBC NEDE4",179 ,0) | |
2276 | ;;MEDICAR E (WNR) | |
2277 | "RTN","IBC NEDE4",180 ,0) | |
2278 | ;;VACAA-W NR | |
2279 | "RTN","IBC NEDE4",181 ,0) | |
2280 | ;;CAMP LE JEUNE - WN R | |
2281 | "RTN","IBC NEDE4",182 ,0) | |
2282 | ;;IVF - W NR | |
2283 | "RTN","IBC NEDE4",183 ,0) | |
2284 | ;;VHA DIR ECTIVE 102 9 WNR | |
2285 | "RTN","IBC NEDE4",184 ,0) | |
2286 | ; | |
2287 | "RTN","IBC NEDE4",185 ,0) | |
2288 | NATPLANS ; Non-activ e Type of Plans | |
2289 | "RTN","IBC NEDE4",186 ,0) | |
2290 | ; | |
2291 | "RTN","IBC NEDE4",187 ,0) | |
2292 | ;;ACCIDEN T AND HEAL TH INSURAN CE | |
2293 | "RTN","IBC NEDE4",188 ,0) | |
2294 | ;;AUTOMOB ILE | |
2295 | "RTN","IBC NEDE4",189 ,0) | |
2296 | ;;AVIATIO N TRIP INS URANCE | |
2297 | "RTN","IBC NEDE4",190 ,0) | |
2298 | ;;CATASTR OPHIC INSU RANCE | |
2299 | "RTN","IBC NEDE4",191 ,0) | |
2300 | ;;CHAMPVA | |
2301 | "RTN","IBC NEDE4",192 ,0) | |
2302 | ;;COINSUR ANCE | |
2303 | "RTN","IBC NEDE4",193 ,0) | |
2304 | ;;DENTAL INSURANCE | |
2305 | "RTN","IBC NEDE4",194 ,0) | |
2306 | ;;DUAL CO VERAGE | |
2307 | "RTN","IBC NEDE4",195 ,0) | |
2308 | ;;INCOME PROTECTION (INDEMNIT Y) | |
2309 | "RTN","IBC NEDE4",196 ,0) | |
2310 | ;;KEY-MAN HEALTH IN SURANCE | |
2311 | "RTN","IBC NEDE4",197 ,0) | |
2312 | ;;LABS, P ROCEDURES, X-RAY, ET C. (ONLY) | |
2313 | "RTN","IBC NEDE4",198 ,0) | |
2314 | ;;MEDI-CA L | |
2315 | "RTN","IBC NEDE4",199 ,0) | |
2316 | ;;MEDICAI D | |
2317 | "RTN","IBC NEDE4",200 ,0) | |
2318 | ;;MEDICAR E (M) | |
2319 | "RTN","IBC NEDE4",201 ,0) | |
2320 | ;;MEDICAR E/MEDICAID (MEDI-CAL ) | |
2321 | "RTN","IBC NEDE4",202 ,0) | |
2322 | ;;MENTAL HEALTH | |
2323 | "RTN","IBC NEDE4",203 ,0) | |
2324 | ;;NO-FAUL T INSURANC E | |
2325 | "RTN","IBC NEDE4",204 ,0) | |
2326 | ;;PRESCRI PTION | |
2327 | "RTN","IBC NEDE4",205 ,0) | |
2328 | ;;QUALIFI ED IMPAIRM ENT INSURA NCE | |
2329 | "RTN","IBC NEDE4",206 ,0) | |
2330 | ;;SPECIAL CLASS INS URANCE | |
2331 | "RTN","IBC NEDE4",207 ,0) | |
2332 | ;;SPECIAL RISK INSU RANCE | |
2333 | "RTN","IBC NEDE4",208 ,0) | |
2334 | ;;SPECIFI ED DISEASE INSURANCE | |
2335 | "RTN","IBC NEDE4",209 ,0) | |
2336 | ;;Substan ce abuse o nly | |
2337 | "RTN","IBC NEDE4",210 ,0) | |
2338 | ;;TORT FE ASOR | |
2339 | "RTN","IBC NEDE4",211 ,0) | |
2340 | ;;TRICARE | |
2341 | "RTN","IBC NEDE4",212 ,0) | |
2342 | ;;TRICARE SUPPLEMEN TAL | |
2343 | "RTN","IBC NEDE4",213 ,0) | |
2344 | ;;VA SPEC IAL CLASS | |
2345 | "RTN","IBC NEDE4",214 ,0) | |
2346 | ;;VISION | |
2347 | "RTN","IBC NEDE4",215 ,0) | |
2348 | ;;WORKERS ' COMPENSA TION INSUR ANCE | |
2349 | "RTN","IBC NEDE4",216 ,0) | |
2350 | ; | |
2351 | "RTN","IBC NEDE4",217 ,0) | |
2352 | Q | |
2353 | "RTN","IBC NEDE4",218 ,0) | |
2354 | ; | |
2355 | "RTN","IBC NEHL3") | |
2356 | 0^20^B1729 50682^B172 154152 | |
2357 | "RTN","IBC NEHL3",1,0 ) | |
2358 | IBCNEHL3 ; DAOU/ALA - HL7 Proce ss Incomin g RPI Cont inued ;03- JUL-2002 ; Compiled June 2, 2 005 14:20: 19 | |
2359 | "RTN","IBC NEHL3",2,0 ) | |
2360 | ;;2.0;INT EGRATED BI LLING;**30 0,416,497, 506,595,62 1,602**;21 -MAR-94;Bu ild 22 | |
2361 | "RTN","IBC NEHL3",3,0 ) | |
2362 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
2363 | "RTN","IBC NEHL3",4,0 ) | |
2364 | ; | |
2365 | "RTN","IBC NEHL3",5,0 ) | |
2366 | ;**Progra m Descript ion** | |
2367 | "RTN","IBC NEHL3",6,0 ) | |
2368 | ; This i s a contin uation of IBCNEHL1 w hich proce sses an in coming | |
2369 | "RTN","IBC NEHL3",7,0 ) | |
2370 | ; RPI II V message. | |
2371 | "RTN","IBC NEHL3",8,0 ) | |
2372 | ; | |
2373 | "RTN","IBC NEHL3",9,0 ) | |
2374 | ; This r outine is based on I BCNEHLS wh ich was in troduced w ith patch 184, and s ubsequentl y | |
2375 | "RTN","IBC NEHL3",10, 0) | |
2376 | ; patche d with pat ch 271. I BCNEHLS is obsolete and delete d with pat ch 300. | |
2377 | "RTN","IBC NEHL3",11, 0) | |
2378 | ; | |
2379 | "RTN","IBC NEHL3",12, 0) | |
2380 | Q ; no direct cal ls allow | |
2381 | "RTN","IBC NEHL3",13, 0) | |
2382 | ; | |
2383 | "RTN","IBC NEHL3",14, 0) | |
2384 | ERROR(TQN, ERACT,ERCO N,TRCN) ; Entry poin t | |
2385 | "RTN","IBC NEHL3",15, 0) | |
2386 | ; Input: TQN - IEN for eIV T ransmissio n Queue (# 365.1), re quired | |
2387 | "RTN","IBC NEHL3",16, 0) | |
2388 | ; ERACT - E rror Actio n Code (#3 65.14), re quired | |
2389 | "RTN","IBC NEHL3",17, 0) | |
2390 | ; ERCON - E rror Condi tion Code (#365.17), required | |
2391 | "RTN","IBC NEHL3",18, 0) | |
2392 | ; TRCN - Tr ace # from eIV Respo nse (#365) | |
2393 | "RTN","IBC NEHL3",19, 0) | |
2394 | ; | |
2395 | "RTN","IBC NEHL3",20, 0) | |
2396 | ; IIVSTAT - IIV statu s transmit ted by EC | |
2397 | "RTN","IBC NEHL3",21, 0) | |
2398 | ; Note: MAP (IIVSTAT) = IIV STAT US IEN | |
2399 | "RTN","IBC NEHL3",22, 0) | |
2400 | N MSG,ERD ESC,ERIEN, XMY,DA,DIE ,DR | |
2401 | "RTN","IBC NEHL3",23, 0) | |
2402 | ; | |
2403 | "RTN","IBC NEHL3",24, 0) | |
2404 | I $G(TQN) ="" G ERRO RX | |
2405 | "RTN","IBC NEHL3",25, 0) | |
2406 | ; | |
2407 | "RTN","IBC NEHL3",26, 0) | |
2408 | ;/Removed the follo wing lines of code a s part of IB*2.0*506 but wante d to | |
2409 | "RTN","IBC NEHL3",27, 0) | |
2410 | ;/leave t his code a vailable i f it shoul d be neede d in the f uture. | |
2411 | "RTN","IBC NEHL3",28, 0) | |
2412 | ; Scenari os: | |
2413 | "RTN","IBC NEHL3",29, 0) | |
2414 | ; #1 - If error mes sage = "Re submission Allowed" OR "Please Resubmit | |
2415 | "RTN","IBC NEHL3",30, 0) | |
2416 | ; Origina l Transact ion" - set TQ | |
2417 | "RTN","IBC NEHL3",31, 0) | |
2418 | ; Fut Tra ns Dt to T + Comm Fa ilure Days and Statu s to "Hold " | |
2419 | "RTN","IBC NEHL3",32, 0) | |
2420 | ;I ERACT= "R"!(ERACT ="P") D G ERRORX | |
2421 | "RTN","IBC NEHL3",33, 0) | |
2422 | ;. I $P($ G(^IBCN(36 5.1,TQN,0) ),U,9)="" D Q ; firs t time pay er asked u s to resub mit | |
2423 | "RTN","IBC NEHL3",34, 0) | |
2424 | ;. . ; Up date IIV T Q fields: "Hold" (4) , IIV Site Param Com m Failure Days | |
2425 | "RTN","IBC NEHL3",35, 0) | |
2426 | ;. . D UP DATE(TQN,4 ,+$P($G(^I BE(350.9,1 ,51)),U,5) ,ERACT) | |
2427 | "RTN","IBC NEHL3",36, 0) | |
2428 | ;. . ; | |
2429 | "RTN","IBC NEHL3",37, 0) | |
2430 | ;. ; paye r asked us to resubm it for the 2nd time for this i nquiry | |
2431 | "RTN","IBC NEHL3",38, 0) | |
2432 | ;. ; Upda te IIV TQ fields: "R esponse Re ceived" (3 ), n/a ("" ) | |
2433 | "RTN","IBC NEHL3",39, 0) | |
2434 | ;. D UPDA TE(TQN,3," ",ERACT,ER CON) | |
2435 | "RTN","IBC NEHL3",40, 0) | |
2436 | ;. ; clea r future t ransmissio n date so it won't d isplay in the buffer | |
2437 | "RTN","IBC NEHL3",41, 0) | |
2438 | ;. S DA=T QN,DIE="^I BCN(365.1, ",DR=".09/ //@" D ^DI E | |
2439 | "RTN","IBC NEHL3",42, 0) | |
2440 | ; | |
2441 | "RTN","IBC NEHL3",43, 0) | |
2442 | ; #2 - If error mes sage = "Pl ease Wait 30 Days an d Resubmit " - set TQ | |
2443 | "RTN","IBC NEHL3",44, 0) | |
2444 | ; Fut Tra ns Dt to T + 30 and Status to "Hold" | |
2445 | "RTN","IBC NEHL3",45, 0) | |
2446 | ;I ERACT= "W" D G ER RORX | |
2447 | "RTN","IBC NEHL3",46, 0) | |
2448 | ;. ; Upda te IIV TQ fields: "H old" (4), 30 | |
2449 | "RTN","IBC NEHL3",47, 0) | |
2450 | ;. D UPDA TE(TQN,4,3 0,ERACT) | |
2451 | "RTN","IBC NEHL3",48, 0) | |
2452 | ; | |
2453 | "RTN","IBC NEHL3",49, 0) | |
2454 | ; #3 - If error mes sage = "Pl ease Wait 10 Days an d Resubmit " - set TQ | |
2455 | "RTN","IBC NEHL3",50, 0) | |
2456 | ; Fut Tra ns Dt to T + 10 and Status to "Hold" | |
2457 | "RTN","IBC NEHL3",51, 0) | |
2458 | ;I ERACT= "X" D G ER RORX | |
2459 | "RTN","IBC NEHL3",52, 0) | |
2460 | ;. ; Upda te IIV TQ fields: "H old" (4), 10 | |
2461 | "RTN","IBC NEHL3",53, 0) | |
2462 | ;. D UPDA TE(TQN,4,1 0,ERACT) | |
2463 | "RTN","IBC NEHL3",54, 0) | |
2464 | ; | |
2465 | "RTN","IBC NEHL3",55, 0) | |
2466 | ; #4 - If error mes sage = "Re submission Not Allow ed" or | |
2467 | "RTN","IBC NEHL3",56, 0) | |
2468 | ; "Do not resubmit ...." OR " Please cor rect and r esubmit" | |
2469 | "RTN","IBC NEHL3",57, 0) | |
2470 | ; - set T Q Status t o "Respons e Received " | |
2471 | "RTN","IBC NEHL3",58, 0) | |
2472 | ; If we r eceive err or txt, tr eat as an "N" | |
2473 | "RTN","IBC NEHL3",59, 0) | |
2474 | ;I ERACT= "" S ERACT ="N" | |
2475 | "RTN","IBC NEHL3",60, 0) | |
2476 | ;I ERACT= "N"!(ERACT ="Y")!(ERA CT="S")!(E RACT="C") D G ERRORX | |
2477 | "RTN","IBC NEHL3",61, 0) | |
2478 | ;. ; Upda te IIV TQ fields: "R esponse Re ceived" (3 ), n/a ("" ) | |
2479 | "RTN","IBC NEHL3",62, 0) | |
2480 | ;. D UPDA TE(TQN,3," ",ERACT,ER CON) | |
2481 | "RTN","IBC NEHL3",63, 0) | |
2482 | ; | |
2483 | "RTN","IBC NEHL3",64, 0) | |
2484 | ; #5 - Er ror messag e is unfam iliar - ne w Error Ac tion Code | |
2485 | "RTN","IBC NEHL3",65, 0) | |
2486 | ; *** Cur rently pro cessed in IBCNEHL1 * ** | |
2487 | "RTN","IBC NEHL3",66, 0) | |
2488 | ;/End of removed co de for IB* 2.0*506 | |
2489 | "RTN","IBC NEHL3",67, 0) | |
2490 | ; | |
2491 | "RTN","IBC NEHL3",68, 0) | |
2492 | ; /IB*2.0 *506 Begin ning | |
2493 | "RTN","IBC NEHL3",69, 0) | |
2494 | ; For all Scenarios 1 thru 5, set TQ St atus to "R esponse Re ceived" | |
2495 | "RTN","IBC NEHL3",70, 0) | |
2496 | I ERACT=" " S ERACT= "N" | |
2497 | "RTN","IBC NEHL3",71, 0) | |
2498 | I ",R,P,W ,X,N,Y,S,C ,"[(","_ER ACT_",") D G ERRORX | |
2499 | "RTN","IBC NEHL3",72, 0) | |
2500 | . ; Updat e IIV TQ f ields: "Re sponse Rec eived" (3) , n/a ("") | |
2501 | "RTN","IBC NEHL3",73, 0) | |
2502 | . D UPDAT E(TQN,3,"" ,ERACT,ERC ON) | |
2503 | "RTN","IBC NEHL3",74, 0) | |
2504 | ; /IB*2.0 *506 End | |
2505 | "RTN","IBC NEHL3",75, 0) | |
2506 | ; | |
2507 | "RTN","IBC NEHL3",76, 0) | |
2508 | ERRORX ; E RROR exit pt | |
2509 | "RTN","IBC NEHL3",77, 0) | |
2510 | Q | |
2511 | "RTN","IBC NEHL3",78, 0) | |
2512 | ; | |
2513 | "RTN","IBC NEHL3",79, 0) | |
2514 | UPDATE(TQN ,TSTS,TDAY S,ERACT,ER CON) ; Up date Trans mission Qu eue (#365. 1) | |
2515 | "RTN","IBC NEHL3",80, 0) | |
2516 | ; Update/ Create Buf fer inform ation as n ecessary | |
2517 | "RTN","IBC NEHL3",81, 0) | |
2518 | ; * If un solicited error or n egative Ve rification response do not | |
2519 | "RTN","IBC NEHL3",82, 0) | |
2520 | ; update TQ entry. However, create a n ew Buffer entry. | |
2521 | "RTN","IBC NEHL3",83, 0) | |
2522 | ; Input V ariables | |
2523 | "RTN","IBC NEHL3",84, 0) | |
2524 | ; ERACT,E RCON,IIVST AT,TDAYS,T QN,TSTS | |
2525 | "RTN","IBC NEHL3",85, 0) | |
2526 | ; | |
2527 | "RTN","IBC NEHL3",86, 0) | |
2528 | ; Output Variables | |
2529 | "RTN","IBC NEHL3",87, 0) | |
2530 | ; IIVSTAT (updated) | |
2531 | "RTN","IBC NEHL3",88, 0) | |
2532 | ; | |
2533 | "RTN","IBC NEHL3",89, 0) | |
2534 | ; Init op tional par am | |
2535 | "RTN","IBC NEHL3",90, 0) | |
2536 | S ERCON=$ G(ERCON) | |
2537 | "RTN","IBC NEHL3",91, 0) | |
2538 | ; | |
2539 | "RTN","IBC NEHL3",92, 0) | |
2540 | ; Init va rs | |
2541 | "RTN","IBC NEHL3",93, 0) | |
2542 | N D,D0,DA ,DFN,DI,DI C,DIE,DQ,D R,FTDT,IBD ATA,IBIEN, IBQFL,IBST S,IBSYM | |
2543 | "RTN","IBC NEHL3",94, 0) | |
2544 | N INSIEN, RSTYPE,SYM BOL,TQDATA ,X | |
2545 | "RTN","IBC NEHL3",95, 0) | |
2546 | ; | |
2547 | "RTN","IBC NEHL3",96, 0) | |
2548 | ; If no Z EB segment received, set IIVST AT to "V" | |
2549 | "RTN","IBC NEHL3",97, 0) | |
2550 | I $TR(IIV STAT," ")= "" S IIVST AT="V" | |
2551 | "RTN","IBC NEHL3",98, 0) | |
2552 | ; | |
2553 | "RTN","IBC NEHL3",99, 0) | |
2554 | S TQDATA= $G(^IBCN(3 65.1,TQN,0 )) | |
2555 | "RTN","IBC NEHL3",100 ,0) | |
2556 | I TQDATA= "" G UPDAT X | |
2557 | "RTN","IBC NEHL3",101 ,0) | |
2558 | ; | |
2559 | "RTN","IBC NEHL3",102 ,0) | |
2560 | ; Ins Buf fer IEN | |
2561 | "RTN","IBC NEHL3",103 ,0) | |
2562 | S IBIEN=$ P(TQDATA,U ,5) | |
2563 | "RTN","IBC NEHL3",104 ,0) | |
2564 | S IBQFL=$ P(TQDATA,U ,11) | |
2565 | "RTN","IBC NEHL3",105 ,0) | |
2566 | S RSTYPE= $P($G(^IBC N(365,RIEN ,0)),U,10) | |
2567 | "RTN","IBC NEHL3",106 ,0) | |
2568 | ; | |
2569 | "RTN","IBC NEHL3",107 ,0) | |
2570 | ; If unso licited er ror or neg ative Iden tification response DON'T | |
2571 | "RTN","IBC NEHL3",108 ,0) | |
2572 | ; update TQ entry o r Buffer ( includes n ot creatin g a new bu ffer) | |
2573 | "RTN","IBC NEHL3",109 ,0) | |
2574 | I RSTYPE= "U",(IBQFL ="I") G UP DATX | |
2575 | "RTN","IBC NEHL3",110 ,0) | |
2576 | ; | |
2577 | "RTN","IBC NEHL3",111 ,0) | |
2578 | I RSTYPE= "U" S IBIE N="" ; ma kes sure a new buffe r is creat ed | |
2579 | "RTN","IBC NEHL3",112 ,0) | |
2580 | ; | |
2581 | "RTN","IBC NEHL3",113 ,0) | |
2582 | ; Ins Buf fer proces sing | |
2583 | "RTN","IBC NEHL3",114 ,0) | |
2584 | I IBIEN'= "" D | |
2585 | "RTN","IBC NEHL3",115 ,0) | |
2586 | . ; Ins B uf data | |
2587 | "RTN","IBC NEHL3",116 ,0) | |
2588 | . S IBDAT A=$G(^IBA( 355.33,+IB IEN,0)) | |
2589 | "RTN","IBC NEHL3",117 ,0) | |
2590 | . S IBSTS =$P(IBDATA ,U,4) ; Status | |
2591 | "RTN","IBC NEHL3",118 ,0) | |
2592 | . S IBSYM =$P(IBDATA ,U,12) ; Symbol | |
2593 | "RTN","IBC NEHL3",119 ,0) | |
2594 | . ; If IB status is (A)ccepte d or (R)ej ected or I B symbol i s "*" | |
2595 | "RTN","IBC NEHL3",120 ,0) | |
2596 | . ; (ver ified) or IB symbol is "-" (de nied), upd ate TQ sta tus to | |
2597 | "RTN","IBC NEHL3",121 ,0) | |
2598 | . ; Resp Rec'd (3) and DON'T update th e Ins Buff er symbol | |
2599 | "RTN","IBC NEHL3",122 ,0) | |
2600 | . I IBSTS ="A"!(IBST S="R")!(IB SYM=8)!(IB SYM=9) S T STS=3 Q | |
2601 | "RTN","IBC NEHL3",123 ,0) | |
2602 | . ; If TQ status is "Hold", u pdate buff er symbol to "?" (10 ) | |
2603 | "RTN","IBC NEHL3",124 ,0) | |
2604 | . I TSTS= 4 D BUFF^I BCNEUT2(IB IEN,10) Q ; Set buf fer symbol to "?" | |
2605 | "RTN","IBC NEHL3",125 ,0) | |
2606 | . ; If TQ status is "Response Received" , update b uffer symb ol to "-" (9) for Er ror | |
2607 | "RTN","IBC NEHL3",126 ,0) | |
2608 | . ; Actio n Codes (' N','Y','S' ) & Action Codes ('P ','R', if 2nd time p ayer sent that code) | |
2609 | "RTN","IBC NEHL3",127 ,0) | |
2610 | . I TSTS= 3,(ERACT=" N"!(ERACT= "Y")!(ERAC T="S")!(ER ACT="C")!( ERACT="P") !(ERACT="R ")) D Q | |
2611 | "RTN","IBC NEHL3",128 ,0) | |
2612 | .. S SYMB OL=MAP(IIV STAT) | |
2613 | "RTN","IBC NEHL3",129 ,0) | |
2614 | .. D BUFF ^IBCNEUT2( IBIEN,SYMB OL) ; Set buffer sym bol to EC value | |
2615 | "RTN","IBC NEHL3",130 ,0) | |
2616 | .. D IIVP ROC(IBIEN) ; Set I IV process date & II V status | |
2617 | "RTN","IBC NEHL3",131 ,0) | |
2618 | . ; If TQ status is "Response Received" , update b uffer symb ol to "!" (12 = B9) for new Er ror Action Code | |
2619 | "RTN","IBC NEHL3",132 ,0) | |
2620 | . I TSTS= 3,",W,X,R, P,C,N,Y,S, "'[(","_ER ACT_",") D BUFF^IBCN EUT2(IBIEN ,22) Q | |
2621 | "RTN","IBC NEHL3",133 ,0) | |
2622 | ; | |
2623 | "RTN","IBC NEHL3",134 ,0) | |
2624 | ; Non-Ins Buffer pr ocessing, create ent ry only fo r Verifica tion queri es | |
2625 | "RTN","IBC NEHL3",135 ,0) | |
2626 | I IBIEN=" ",IBQFL="V " D | |
2627 | "RTN","IBC NEHL3",136 ,0) | |
2628 | . ; Deter mine Patie nt DFN | |
2629 | "RTN","IBC NEHL3",137 ,0) | |
2630 | . S DFN=$ P(TQDATA,U ,2) | |
2631 | "RTN","IBC NEHL3",138 ,0) | |
2632 | . ; Deter mine Patie nt Ins rec ord IEN | |
2633 | "RTN","IBC NEHL3",139 ,0) | |
2634 | . S INSIE N=$P(TQDAT A,U,13) ; If INSIEN ="" avoids TQ update | |
2635 | "RTN","IBC NEHL3",140 ,0) | |
2636 | . ; If ER ACT="C" sy mbol is pa ssed by EC | |
2637 | "RTN","IBC NEHL3",141 ,0) | |
2638 | . I ERACT ="C" S SYM BOL=MAP(II VSTAT) D B UF Q | |
2639 | "RTN","IBC NEHL3",142 ,0) | |
2640 | . ; Resu bmission N ot Allowed or Do Not Resubmit ... | |
2641 | "RTN","IBC NEHL3",143 ,0) | |
2642 | . I ERACT ="N"!(ERAC T="Y")!(ER ACT="S") S SYMBOL=MA P(IIVSTAT) D BUF Q | |
2643 | "RTN","IBC NEHL3",144 ,0) | |
2644 | . ; An un known erro r action - generate a '#' | |
2645 | "RTN","IBC NEHL3",145 ,0) | |
2646 | . I ",W,X ,R,P,C,N,Y ,S,"'[("," _ERACT_"," ) S SYMBOL =22 D BUF Q | |
2647 | "RTN","IBC NEHL3",146 ,0) | |
2648 | ; | |
2649 | "RTN","IBC NEHL3",147 ,0) | |
2650 | I RSTYPE= "U" G UPDA TX ; fini shed creat ing new bu ffer | |
2651 | "RTN","IBC NEHL3",148 ,0) | |
2652 | ; | |
2653 | "RTN","IBC NEHL3",149 ,0) | |
2654 | ; Update TQ record - Status | |
2655 | "RTN","IBC NEHL3",150 ,0) | |
2656 | D SST^IBC NEUT2(TQN, TSTS) | |
2657 | "RTN","IBC NEHL3",151 ,0) | |
2658 | ; | |
2659 | "RTN","IBC NEHL3",152 ,0) | |
2660 | ; If TQ S tatus = "H old", upda te TQ reco rd - Futur e Transmis sion Date | |
2661 | "RTN","IBC NEHL3",153 ,0) | |
2662 | I TSTS=4, +$G(TDAYS) D | |
2663 | "RTN","IBC NEHL3",154 ,0) | |
2664 | . S FTDT= $$FMADD^XL FDT($$DT^X LFDT,TDAYS ) | |
2665 | "RTN","IBC NEHL3",155 ,0) | |
2666 | . S DIE=" ^IBCN(365. 1,",DA=TQN ,DR=".09// /^S X=FTDT " | |
2667 | "RTN","IBC NEHL3",156 ,0) | |
2668 | . D ^DIE | |
2669 | "RTN","IBC NEHL3",157 ,0) | |
2670 | I TSTS=4, $P(TQDATA, U,8) D | |
2671 | "RTN","IBC NEHL3",158 ,0) | |
2672 | . S DIE=" ^IBCN(365. 1,",DA=TQN ,DR=".08// /0" | |
2673 | "RTN","IBC NEHL3",159 ,0) | |
2674 | . D ^DIE | |
2675 | "RTN","IBC NEHL3",160 ,0) | |
2676 | ; | |
2677 | "RTN","IBC NEHL3",161 ,0) | |
2678 | UPDATX ; U PDATE exit point | |
2679 | "RTN","IBC NEHL3",162 ,0) | |
2680 | Q | |
2681 | "RTN","IBC NEHL3",163 ,0) | |
2682 | ; | |
2683 | "RTN","IBC NEHL3",164 ,0) | |
2684 | PCK ; Paye r Check | |
2685 | "RTN","IBC NEHL3",165 ,0) | |
2686 | ; Find t he associa ted Respon se IEN | |
2687 | "RTN","IBC NEHL3",166 ,0) | |
2688 | ; | |
2689 | "RTN","IBC NEHL3",167 ,0) | |
2690 | ; Input V ariables | |
2691 | "RTN","IBC NEHL3",168 ,0) | |
2692 | ; MSGID | |
2693 | "RTN","IBC NEHL3",169 ,0) | |
2694 | ; | |
2695 | "RTN","IBC NEHL3",170 ,0) | |
2696 | ; Output Variables | |
2697 | "RTN","IBC NEHL3",171 ,0) | |
2698 | ; RIEN,ER FLG | |
2699 | "RTN","IBC NEHL3",172 ,0) | |
2700 | ; | |
2701 | "RTN","IBC NEHL3",173 ,0) | |
2702 | N BUFF,DA ,DFN,DIE,D R,IEN,IERN ,IN1DATA,M DTM,QFL,PA YR,PIEN,PP | |
2703 | "RTN","IBC NEHL3",174 ,0) | |
2704 | N PRDATA, PRIEN,RSIE N,X | |
2705 | "RTN","IBC NEHL3",175 ,0) | |
2706 | N NOPAYER ,TQIEN | |
2707 | "RTN","IBC NEHL3",176 ,0) | |
2708 | ; | |
2709 | "RTN","IBC NEHL3",177 ,0) | |
2710 | K ^TMP("I BCNEMID",$ J) | |
2711 | "RTN","IBC NEHL3",178 ,0) | |
2712 | D FIND^DI C(365,""," ","P",MSGI D,"","B"," ","","^TMP (""IBCNEMI D"",$J)") | |
2713 | "RTN","IBC NEHL3",179 ,0) | |
2714 | ; | |
2715 | "RTN","IBC NEHL3",180 ,0) | |
2716 | S PP=0,QF L=0,(RIEN, PIEN)="" | |
2717 | "RTN","IBC NEHL3",181 ,0) | |
2718 | S NOPAYER =$$FIND1^D IC(365.12, ,"X","~NO PAYER"),TQ IEN=$O(^IB CN(365.1," C",MSGID," ")) | |
2719 | "RTN","IBC NEHL3",182 ,0) | |
2720 | F S PP=$ O(^TMP("IB CNEMID",$J ,"DILIST", PP)) Q:'PP D Q:QFL | |
2721 | "RTN","IBC NEHL3",183 ,0) | |
2722 | . S PRIEN =$P(^TMP(" IBCNEMID", $J,"DILIST ",PP,0),U, 1) | |
2723 | "RTN","IBC NEHL3",184 ,0) | |
2724 | . ; | |
2725 | "RTN","IBC NEHL3",185 ,0) | |
2726 | . ; If t his is a r esponse w/ o an IN1 s egment | |
2727 | "RTN","IBC NEHL3",186 ,0) | |
2728 | . ; Get payer IEN from TQ as original response s hell will change for | |
2729 | "RTN","IBC NEHL3",187 ,0) | |
2730 | . ; ~NO PAYER if a payer res ponse is r eceived | |
2731 | "RTN","IBC NEHL3",188 ,0) | |
2732 | . S IN1DA TA=$S(EVEN TYP=1:"",1 :$$GIN1()) ; IB*2.0* 621 | |
2733 | "RTN","IBC NEHL3",189 ,0) | |
2734 | . I IN1DA TA="",PRIE N'="",TQIE N'="" D | |
2735 | "RTN","IBC NEHL3",190 ,0) | |
2736 | .. S QFL =1,PIEN=$P (^IBCN(365 .1,TQIEN,0 ),U,3) | |
2737 | "RTN","IBC NEHL3",191 ,0) | |
2738 | . ; | |
2739 | "RTN","IBC NEHL3",192 ,0) | |
2740 | . I 'PIEN D PFN(IN1 DATA) I 'P IEN S QFL= 1 Q | |
2741 | "RTN","IBC NEHL3",193 ,0) | |
2742 | . ; | |
2743 | "RTN","IBC NEHL3",194 ,0) | |
2744 | . ; If me ssage id/p ayer found & Respons e (#365) s tatus is N OT | |
2745 | "RTN","IBC NEHL3",195 ,0) | |
2746 | . ; 'Resp onse Recei ved' updat e the exis ting respo nse entry (set RIEN) | |
2747 | "RTN","IBC NEHL3",196 ,0) | |
2748 | . I $P(^I BCN(365,PR IEN,0),U,3 )=PIEN,($P (^IBCN(365 ,PRIEN,0), U,6)'=3) D Q | |
2749 | "RTN","IBC NEHL3",197 ,0) | |
2750 | .. S RIEN =PRIEN,QFL =1 | |
2751 | "RTN","IBC NEHL3",198 ,0) | |
2752 | ..; | |
2753 | "RTN","IBC NEHL3",199 ,0) | |
2754 | ..; If me ssage id/p ayer found & Respons e (#365) s tatus equa ls | |
2755 | "RTN","IBC NEHL3",200 ,0) | |
2756 | . ; 'Resp onse Recei ved', RIEN is still null so th at this ta g knows | |
2757 | "RTN","IBC NEHL3",201 ,0) | |
2758 | . ; to cr eate a new unsolicit ed respons e entry | |
2759 | "RTN","IBC NEHL3",202 ,0) | |
2760 | . ; | |
2761 | "RTN","IBC NEHL3",203 ,0) | |
2762 | . ; If pa yer respon se receive d to ~NO P AYER, upda te eIV Res ponse file | |
2763 | "RTN","IBC NEHL3",204 ,0) | |
2764 | . ; w/ re sponding p ayer | |
2765 | "RTN","IBC NEHL3",205 ,0) | |
2766 | . I RIEN= "" S PRDAT A=$G(^IBCN (365,PRIEN ,0)) I $P( PRDATA,U,3 )=NOPAYER, $P(PRDATA, U,6)'=3,$P (PRDATA,U, 10)="O" D Q | |
2767 | "RTN","IBC NEHL3",206 ,0) | |
2768 | .. S RIEN =PRIEN,QFL =1 | |
2769 | "RTN","IBC NEHL3",207 ,0) | |
2770 | .. S DIE= "^IBCN(365 ,",DA=RIEN ,DR=".03// /^S X=PIEN " D ^DIE | |
2771 | "RTN","IBC NEHL3",208 ,0) | |
2772 | ; | |
2773 | "RTN","IBC NEHL3",209 ,0) | |
2774 | ; If mes sage id/pa yer not fo und or uns olicited r esponse, c reate new response e ntry | |
2775 | "RTN","IBC NEHL3",210 ,0) | |
2776 | I RIEN="" D Q:ERFL G | |
2777 | "RTN","IBC NEHL3",211 ,0) | |
2778 | . I $G(PR IEN)'="" D | |
2779 | "RTN","IBC NEHL3",212 ,0) | |
2780 | .. S PRDA TA=$G(^IBC N(365,PRIE N,0)) | |
2781 | "RTN","IBC NEHL3",213 ,0) | |
2782 | .. S DFN= $P(PRDATA, U,2),IEN=$ P(PRDATA,U ,5),MDTM=$ P(PRDATA,U ,8) | |
2783 | "RTN","IBC NEHL3",214 ,0) | |
2784 | . ; | |
2785 | "RTN","IBC NEHL3",215 ,0) | |
2786 | . I PIEN= "" D Q:ER FLG | |
2787 | "RTN","IBC NEHL3",216 ,0) | |
2788 | .. S IN1 DATA=$$GIN 1() | |
2789 | "RTN","IBC NEHL3",217 ,0) | |
2790 | .. I IN1 DATA]"" D PFN(IN1DAT A) I 'PIEN S PIEN="" ,QFL=1 | |
2791 | "RTN","IBC NEHL3",218 ,0) | |
2792 | . S PAYR= PIEN,(RSTY PE,BUFF)=" " | |
2793 | "RTN","IBC NEHL3",219 ,0) | |
2794 | . ;I MDTM ="" S MDTM =$$NOW^XLF DT | |
2795 | "RTN","IBC NEHL3",220 ,0) | |
2796 | . D RESP^ IBCNEDEQ | |
2797 | "RTN","IBC NEHL3",221 ,0) | |
2798 | . S RIEN= RSIEN | |
2799 | "RTN","IBC NEHL3",222 ,0) | |
2800 | ; | |
2801 | "RTN","IBC NEHL3",223 ,0) | |
2802 | ; If no p ayer in re sponse fil e, set it | |
2803 | "RTN","IBC NEHL3",224 ,0) | |
2804 | ; IB*2*59 5/DM corre ctly ident ify a paye r when the payer nam e begins w ith number s | |
2805 | "RTN","IBC NEHL3",225 ,0) | |
2806 | I $G(PIEN )'="",$G(R IEN)'="",$ P($G(^IBCN (365,RIEN, 0)),U,3)=" " D | |
2807 | "RTN","IBC NEHL3",226 ,0) | |
2808 | . S DIE=" ^IBCN(365, ",DA=RIEN, DR=".03/// /^S X=PIEN " D ^DIE ; stuff inte rnal value for payer | |
2809 | "RTN","IBC NEHL3",227 ,0) | |
2810 | Q | |
2811 | "RTN","IBC NEHL3",228 ,0) | |
2812 | ; | |
2813 | "RTN","IBC NEHL3",229 ,0) | |
2814 | BUF ; Crea te Buffer Record if Doesn't Ex ist | |
2815 | "RTN","IBC NEHL3",230 ,0) | |
2816 | ; | |
2817 | "RTN","IBC NEHL3",231 ,0) | |
2818 | ; Input V ariables | |
2819 | "RTN","IBC NEHL3",232 ,0) | |
2820 | ; RIEN,RS TYPE,TQN | |
2821 | "RTN","IBC NEHL3",233 ,0) | |
2822 | ; | |
2823 | "RTN","IBC NEHL3",234 ,0) | |
2824 | ; Output Variables | |
2825 | "RTN","IBC NEHL3",235 ,0) | |
2826 | ; ERROR,S YMBOL is k illed,TQIE N and IRIE N may be r eset | |
2827 | "RTN","IBC NEHL3",236 ,0) | |
2828 | ; | |
2829 | "RTN","IBC NEHL3",237 ,0) | |
2830 | N BUFF,IB FDA,UP | |
2831 | "RTN","IBC NEHL3",238 ,0) | |
2832 | I $G(RSTY PE)="U" S (TQIEN,IRI EN)="" | |
2833 | "RTN","IBC NEHL3",239 ,0) | |
2834 | D RP^IBCN EBF(RIEN,1 ) | |
2835 | "RTN","IBC NEHL3",240 ,0) | |
2836 | S BUFF=+I BFDA | |
2837 | "RTN","IBC NEHL3",241 ,0) | |
2838 | S UP(365, RIEN_",",. 04)=+IBFDA | |
2839 | "RTN","IBC NEHL3",242 ,0) | |
2840 | I RSTYPE= "O" S UP(3 65.1,TQN_" ,",.05)=+I BFDA | |
2841 | "RTN","IBC NEHL3",243 ,0) | |
2842 | D FILE^DI E("I","UP" ,"ERROR") | |
2843 | "RTN","IBC NEHL3",244 ,0) | |
2844 | K SYMBOL | |
2845 | "RTN","IBC NEHL3",245 ,0) | |
2846 | Q | |
2847 | "RTN","IBC NEHL3",246 ,0) | |
2848 | ; | |
2849 | "RTN","IBC NEHL3",247 ,0) | |
2850 | IIVPROC(BU FF) ; Set IIV Proces sed Date t o current dt/tm & II V stat (ak a SYMBOL) | |
2851 | "RTN","IBC NEHL3",248 ,0) | |
2852 | ; Input V ariables | |
2853 | "RTN","IBC NEHL3",249 ,0) | |
2854 | ; BUFF | |
2855 | "RTN","IBC NEHL3",250 ,0) | |
2856 | ; | |
2857 | "RTN","IBC NEHL3",251 ,0) | |
2858 | ; Output Variables | |
2859 | "RTN","IBC NEHL3",252 ,0) | |
2860 | ; SYMBOL | |
2861 | "RTN","IBC NEHL3",253 ,0) | |
2862 | ; | |
2863 | "RTN","IBC NEHL3",254 ,0) | |
2864 | N IDUZ,UP | |
2865 | "RTN","IBC NEHL3",255 ,0) | |
2866 | S UP(355. 33,BUFF_", ",.15)=$$N OW^XLFDT() | |
2867 | "RTN","IBC NEHL3",256 ,0) | |
2868 | ; Set ID UZ to the specific, non-human user. | |
2869 | "RTN","IBC NEHL3",257 ,0) | |
2870 | S IDUZ=$$ FIND1^DIC( 200,"","X" ,"INTERFAC E,IB EIV") | |
2871 | "RTN","IBC NEHL3",258 ,0) | |
2872 | D FILE^DI E("I","UP" ,"ERROR") | |
2873 | "RTN","IBC NEHL3",259 ,0) | |
2874 | ; set the symbol of the buffe r entry | |
2875 | "RTN","IBC NEHL3",260 ,0) | |
2876 | D BUFF^IB CNEUT2(BUF F,SYMBOL) ; reset s ymbol to a ppropriate value | |
2877 | "RTN","IBC NEHL3",261 ,0) | |
2878 | Q | |
2879 | "RTN","IBC NEHL3",262 ,0) | |
2880 | ; | |
2881 | "RTN","IBC NEHL3",263 ,0) | |
2882 | PFN(IN1DAT A) ; Find Payer fro m HL7 msg | |
2883 | "RTN","IBC NEHL3",264 ,0) | |
2884 | ; | |
2885 | "RTN","IBC NEHL3",265 ,0) | |
2886 | ; Input V ariables | |
2887 | "RTN","IBC NEHL3",266 ,0) | |
2888 | ; IN1DATA , TRACE | |
2889 | "RTN","IBC NEHL3",267 ,0) | |
2890 | ; | |
2891 | "RTN","IBC NEHL3",268 ,0) | |
2892 | ; Output Variables | |
2893 | "RTN","IBC NEHL3",269 ,0) | |
2894 | ; ERFLG,E RROR,PIEN | |
2895 | "RTN","IBC NEHL3",270 ,0) | |
2896 | ; | |
2897 | "RTN","IBC NEHL3",271 ,0) | |
2898 | N IERN,PA YRID | |
2899 | "RTN","IBC NEHL3",272 ,0) | |
2900 | S PAYRID= $$CLNSTR^I BCNEHLU($P ($P(IN1DAT A,HLFS,4), $E(HL("ECH "))),HL("E CH"),$E(HL ("ECH"))) | |
2901 | "RTN","IBC NEHL3",273 ,0) | |
2902 | S PIEN=+$ $FIND1^DIC (365.12,"" ,"MX",PAYR ID) | |
2903 | "RTN","IBC NEHL3",274 ,0) | |
2904 | I PIEN=0 D Q | |
2905 | "RTN","IBC NEHL3",275 ,0) | |
2906 | . S ERFLG =1,IERN=$$ ERRN^IBCNE UT7("ERROR (""DIERR"" )") | |
2907 | "RTN","IBC NEHL3",276 ,0) | |
2908 | . S ERROR ("DIERR",I ERN,"TEXT" ,1)="Natio nal Id: "_ PAYRID_" n ot found i n Payer Ta ble" | |
2909 | "RTN","IBC NEHL3",277 ,0) | |
2910 | . S ERROR ("DIERR",I ERN,"TEXT" ,2)="for T race Numbe r: "_TRACE | |
2911 | "RTN","IBC NEHL3",278 ,0) | |
2912 | Q | |
2913 | "RTN","IBC NEHL3",279 ,0) | |
2914 | ; | |
2915 | "RTN","IBC NEHL3",280 ,0) | |
2916 | GIN1() ;Ge t IN1 segm ent | |
2917 | "RTN","IBC NEHL3",281 ,0) | |
2918 | ; | |
2919 | "RTN","IBC NEHL3",282 ,0) | |
2920 | ; Input V ariables | |
2921 | "RTN","IBC NEHL3",283 ,0) | |
2922 | ; HCT | |
2923 | "RTN","IBC NEHL3",284 ,0) | |
2924 | ; | |
2925 | "RTN","IBC NEHL3",285 ,0) | |
2926 | ; Returns value of SEGMT | |
2927 | "RTN","IBC NEHL3",286 ,0) | |
2928 | ; | |
2929 | "RTN","IBC NEHL3",287 ,0) | |
2930 | N IPCT,SE GMT | |
2931 | "RTN","IBC NEHL3",288 ,0) | |
2932 | S IPCT=HC T,SEGMT="" | |
2933 | "RTN","IBC NEHL3",289 ,0) | |
2934 | F S IPCT =$O(^TMP($ J,"IBCNEHL I",IPCT)) Q:IPCT="" D | |
2935 | "RTN","IBC NEHL3",290 ,0) | |
2936 | . I $E(^T MP($J,"IBC NEHLI",IPC T,0),1,3)= "IN1" S SE GMT=^TMP($ J,"IBCNEHL I",IPCT,0) | |
2937 | "RTN","IBC NEHL3",291 ,0) | |
2938 | Q SEGMT | |
2939 | "RTN","IBC NEHL3",292 ,0) | |
2940 | ; | |
2941 | "RTN","IBC NEHL3",293 ,0) | |
2942 | ; ======= ========== ========== ========== ========== ========== ======== | |
2943 | "RTN","IBC NEHL3",294 ,0) | |
2944 | WARN ; Cr eate and s end a resp onse proce ssing erro r warning message | |
2945 | "RTN","IBC NEHL3",295 ,0) | |
2946 | ; | |
2947 | "RTN","IBC NEHL3",296 ,0) | |
2948 | ; Input V ariables | |
2949 | "RTN","IBC NEHL3",297 ,0) | |
2950 | ; ERROR, TRACE | |
2951 | "RTN","IBC NEHL3",298 ,0) | |
2952 | ; | |
2953 | "RTN","IBC NEHL3",299 ,0) | |
2954 | ; Output Variables | |
2955 | "RTN","IBC NEHL3",300 ,0) | |
2956 | ; ERFLG=1 | |
2957 | "RTN","IBC NEHL3",301 ,0) | |
2958 | ; | |
2959 | "RTN","IBC NEHL3",302 ,0) | |
2960 | N MCT,MSG ,SUBCNT,VE N,XMY | |
2961 | "RTN","IBC NEHL3",303 ,0) | |
2962 | S VEN=0,M CT=9,ERFLG =1,SUBCNT= "" | |
2963 | "RTN","IBC NEHL3",304 ,0) | |
2964 | S MSG(1)= "IMPORTANT : Error Wh ile Proces sing Respo nse Messag e from the EC" | |
2965 | "RTN","IBC NEHL3",305 ,0) | |
2966 | S MSG(2)= "--------- ---------- ---------- ---------- ---------- ---------- --" | |
2967 | "RTN","IBC NEHL3",306 ,0) | |
2968 | S MSG(3)= "*** IRM * ** Please contact He lp Desk be cause the" | |
2969 | "RTN","IBC NEHL3",307 ,0) | |
2970 | S MSG(4)= "response message re ceived fro m the Elig ibility Co mmunicator " | |
2971 | "RTN","IBC NEHL3",308 ,0) | |
2972 | S MSG(5)= "could not be proces sed. Prog ramming ch anges may be necessa ry" | |
2973 | "RTN","IBC NEHL3",309 ,0) | |
2974 | S MSG(6)= "to proper ly handle the respon se." | |
2975 | "RTN","IBC NEHL3",310 ,0) | |
2976 | S MSG(7)= "The assoc iated Trac e # is "_$ S($G(TRACE )="":"Unkn own",1:TRA CE)_". If applicable ," | |
2977 | "RTN","IBC NEHL3",311 ,0) | |
2978 | S MSG(8)= "please re view the r esponse wi th the eIV Response Report by Trace#." | |
2979 | "RTN","IBC NEHL3",312 ,0) | |
2980 | S MSG(9)= " " | |
2981 | "RTN","IBC NEHL3",313 ,0) | |
2982 | F S VEN= $O(ERROR(" DIERR",VEN )) Q:'VEN D | |
2983 | "RTN","IBC NEHL3",314 ,0) | |
2984 | .S MCT=MC T+1,MSG(MC T)="Error: " | |
2985 | "RTN","IBC NEHL3",315 ,0) | |
2986 | .F S SUB CNT=$O(ERR OR("DIERR" ,VEN,"TEXT ",SUBCNT)) Q:'SUBCNT S MCT=MC T+1,MSG(MC T)=ERROR(" DIERR",VEN ,"TEXT",SU BCNT) | |
2987 | "RTN","IBC NEHL3",316 ,0) | |
2988 | .S MCT=MC T+1,MSG(MC T)=" " | |
2989 | "RTN","IBC NEHL3",317 ,0) | |
2990 | .I $G(ERR OR("DIERR" ,VEN,"PARA M","FILE") )'="" S MC T=MCT+1,MS G(MCT)="Fi le: "_ERRO R("DIERR", VEN,"PARAM ","FILE") | |
2991 | "RTN","IBC NEHL3",318 ,0) | |
2992 | .I $G(ERR OR("DIERR" ,VEN,"PARA M","IENS") )'="" S MC T=MCT+1,MS G(MCT)="IE NS: "_ERRO R("DIERR", VEN,"PARAM ","IENS") | |
2993 | "RTN","IBC NEHL3",319 ,0) | |
2994 | .I $G(ERR OR("DIERR" ,VEN,"PARA M","FIELD" ))'="" S M CT=MCT+1,M SG(MCT)="F ield: "_ER ROR("DIERR ",VEN,"PAR AM","FIELD ") | |
2995 | "RTN","IBC NEHL3",320 ,0) | |
2996 | .S MCT=MC T+1,MSG(MC T)=" " | |
2997 | "RTN","IBC NEHL3",321 ,0) | |
2998 | .Q | |
2999 | "RTN","IBC NEHL3",322 ,0) | |
3000 | D MSG^IBC NEUT5(MGRP ,MSG(1),"M SG(",,.XMY ) | |
3001 | "RTN","IBC NEHL3",323 ,0) | |
3002 | Q | |
3003 | "RTN","IBC NEHL3",324 ,0) | |
3004 | ; | |
3005 | "RTN","IBC NEHL3",325 ,0) | |
3006 | ; ======= ========== ========== ========== ========== ========== ======== | |
3007 | "RTN","IBC NEHL3",326 ,0) | |
3008 | UEACT ; Se nd warning msg if Un known Erro r Action C ode was re ceived or | |
3009 | "RTN","IBC NEHL3",327 ,0) | |
3010 | ; encount ered probl em filing date | |
3011 | "RTN","IBC NEHL3",328 ,0) | |
3012 | ; | |
3013 | "RTN","IBC NEHL3",329 ,0) | |
3014 | ; Input V ariables | |
3015 | "RTN","IBC NEHL3",330 ,0) | |
3016 | ; ERROR, IBIEN, IBQ FL, RIEN, RSTYPE, TQ DATA, TRAC E | |
3017 | "RTN","IBC NEHL3",331 ,0) | |
3018 | ; | |
3019 | "RTN","IBC NEHL3",332 ,0) | |
3020 | ; Output Variables | |
3021 | "RTN","IBC NEHL3",333 ,0) | |
3022 | ; ERFLG=1 (SET IN W ARN TAG) | |
3023 | "RTN","IBC NEHL3",334 ,0) | |
3024 | ; | |
3025 | "RTN","IBC NEHL3",335 ,0) | |
3026 | N DFN,SYM BOL | |
3027 | "RTN","IBC NEHL3",336 ,0) | |
3028 | D WARN ; send warn ing msg | |
3029 | "RTN","IBC NEHL3",337 ,0) | |
3030 | ; | |
3031 | "RTN","IBC NEHL3",338 ,0) | |
3032 | ; If the response c ould not b e created or there i s no assoc iated TQ e ntry, stop processin g | |
3033 | "RTN","IBC NEHL3",339 ,0) | |
3034 | I '$G(RIE N)!(TQDATA ="") Q | |
3035 | "RTN","IBC NEHL3",340 ,0) | |
3036 | ; | |
3037 | "RTN","IBC NEHL3",341 ,0) | |
3038 | ; For an original response, set the Tr ansmission Queue Sta tus to 'Re sponse Rec eived' & | |
3039 | "RTN","IBC NEHL3",342 ,0) | |
3040 | ; update remaining retries t o comm fai lure (5) | |
3041 | "RTN","IBC NEHL3",343 ,0) | |
3042 | I $G(RSTY PE)="O" D SST^IBCNEU T2(TQN,3), RSTA^IBCNE UT7(TQN) | |
3043 | "RTN","IBC NEHL3",344 ,0) | |
3044 | ; | |
3045 | "RTN","IBC NEHL3",345 ,0) | |
3046 | ; If it i s an ident ification and policy is not ac tive don't | |
3047 | "RTN","IBC NEHL3",346 ,0) | |
3048 | ; create buffer ent ry | |
3049 | "RTN","IBC NEHL3",347 ,0) | |
3050 | I IBQFL=" I",IIVSTAT '=1 Q | |
3051 | "RTN","IBC NEHL3",348 ,0) | |
3052 | ; | |
3053 | "RTN","IBC NEHL3",349 ,0) | |
3054 | ; If unso licited me ssage or n o buffer i n TQ, crea te new buf fer entry | |
3055 | "RTN","IBC NEHL3",350 ,0) | |
3056 | I RSTYPE= "U" S IBIE N="" | |
3057 | "RTN","IBC NEHL3",351 ,0) | |
3058 | I IBIEN=" " D Q | |
3059 | "RTN","IBC NEHL3",352 ,0) | |
3060 | . S DFN= $P(TQDATA, U,2) ; Determ ine Patien t DFN | |
3061 | "RTN","IBC NEHL3",353 ,0) | |
3062 | . S SYMB OL=22 D BU F^IBCNEHL3 ; Create a new buf fer entry | |
3063 | "RTN","IBC NEHL3",354 ,0) | |
3064 | ; | |
3065 | "RTN","IBC NEHL3",355 ,0) | |
3066 | ;Update b uffer symb ol | |
3067 | "RTN","IBC NEHL3",356 ,0) | |
3068 | D BUFF^IB CNEUT2(IBI EN,22) | |
3069 | "RTN","IBC NEHL3",357 ,0) | |
3070 | ; | |
3071 | "RTN","IBC NEHL3",358 ,0) | |
3072 | Q | |
3073 | "RTN","IBC NEHL3",359 ,0) | |
3074 | ; | |
3075 | "RTN","IBC NEHL3",360 ,0) | |
3076 | CHK1() ; c heck auto- update cri teria for patient wh o is the s ubscriber | |
3077 | "RTN","IBC NEHL3",361 ,0) | |
3078 | ; called from tag A UTOUPD, us es variabl es defined there | |
3079 | "RTN","IBC NEHL3",362 ,0) | |
3080 | ; | |
3081 | "RTN","IBC NEHL3",363 ,0) | |
3082 | ; returns 1 if give n policy s atisfies a uto-update criteria, returns 0 otherwise | |
3083 | "RTN","IBC NEHL3",364 ,0) | |
3084 | N RES | |
3085 | "RTN","IBC NEHL3",365 ,0) | |
3086 | S RES=0 | |
3087 | "RTN","IBC NEHL3",366 ,0) | |
3088 | I $P(RDAT A13,U,2)'= $P(IDATA7, U,2) G CHK 1X ; Subs criber ID doesn't ma tch ; IB *2.0*497 c ompare sub scriber ID data at t heir new l ocations | |
3089 | "RTN","IBC NEHL3",367 ,0) | |
3090 | I $P(RDAT A1,U,2)'=$ P(IDATA3,U ) G CHK1X ; DOB doe sn't match | |
3091 | "RTN","IBC NEHL3",368 ,0) | |
3092 | I '$$NAME CMP^IBCNEH LU($P(RDAT A13,U),$P( IDATA7,U)) G CHK1X ; Insured' s name doe sn't match ; IB*2.0 *497 compa re name of insured d ata at the ir new loc ations | |
3093 | "RTN","IBC NEHL3",369 ,0) | |
3094 | S RES=1 | |
3095 | "RTN","IBC NEHL3",370 ,0) | |
3096 | CHK1X ; | |
3097 | "RTN","IBC NEHL3",371 ,0) | |
3098 | Q RES | |
3099 | "RTN","IBC NEHL3",372 ,0) | |
3100 | ; | |
3101 | "RTN","IBC NEHL3",373 ,0) | |
3102 | CHK2(MWNRT YP) ; chec k auto-upd ate criter ia for pat ient who i s not the subscriber | |
3103 | "RTN","IBC NEHL3",374 ,0) | |
3104 | ; called from tag A UTOUPD, us es variabl es defined there | |
3105 | "RTN","IBC NEHL3",375 ,0) | |
3106 | ; | |
3107 | "RTN","IBC NEHL3",376 ,0) | |
3108 | ; returns 1 if poli cy satisfi es auto-up date crite ria, retur ns 0 other wise | |
3109 | "RTN","IBC NEHL3",377 ,0) | |
3110 | N DOB,ID, IDATA5,IEN S,NAME,PDO B,PNAME,RE S | |
3111 | "RTN","IBC NEHL3",378 ,0) | |
3112 | S RES=0 | |
3113 | "RTN","IBC NEHL3",379 ,0) | |
3114 | S IDATA5= $G(^DPT(IE N2,.312,IE N312,5)) | |
3115 | "RTN","IBC NEHL3",380 ,0) | |
3116 | S IENS=IE N2_"," | |
3117 | "RTN","IBC NEHL3",381 ,0) | |
3118 | S ID=$P(R DATA13,U,2 ) ; IB* 2.0*497 Su bscriber I D needs to be retrie ved from i ts new loc ation | |
3119 | "RTN","IBC NEHL3",382 ,0) | |
3120 | I ID'=$P( IDATA7,U,2 ),ID'=$P(I DATA5,U) G CHK2X ; both Subsc riber ID a nd Patient ID don't match ; IB *2.0*497 c ompare sub scriber ID at new lo cations | |
3121 | "RTN","IBC NEHL3",383 ,0) | |
3122 | S DOB=$P( RDATA1,U,2 ),PDOB=$$G ET1^DIQ(2, IENS,.03," I") | |
3123 | "RTN","IBC NEHL3",384 ,0) | |
3124 | I DOB'=$P (IDATA3,U) ,DOB'=PDOB G CHK2X ; both Sub scriber an d Patient DOB don't match | |
3125 | "RTN","IBC NEHL3",385 ,0) | |
3126 | S NAME=$P (RDATA13,U ),PNAME=$$ GET1^DIQ(2 ,IENS,.01) ; IB*2. 0*497 get name of in sured at i ts new loc ation | |
3127 | "RTN","IBC NEHL3",386 ,0) | |
3128 | I '+MWNRT YP,'$$NAME CMP^IBCNEH LU(NAME,$P (IDATA7,U) ),'$$NAMEC MP^IBCNEHL U(NAME,PNA ME) G CHK2 X ; non-M edicare, b oth Subscr iber and P atient nam e don't ma tch ; IB*2 *497 | |
3129 | "RTN","IBC NEHL3",387 ,0) | |
3130 | I +MWNRTY P,'$$NAMEC MP^IBCNEHL U(NAME,PNA ME) G CHK2 X ; Medic are, Patie nt name do esn't matc h | |
3131 | "RTN","IBC NEHL3",388 ,0) | |
3132 | S RES=1 | |
3133 | "RTN","IBC NEHL3",389 ,0) | |
3134 | CHK2X ; | |
3135 | "RTN","IBC NEHL3",390 ,0) | |
3136 | Q RES | |
3137 | "RTN","IBC NEHL3",391 ,0) | |
3138 | ; | |
3139 | "RTN","IBC NEHL3",392 ,0) | |
3140 | UPDIREC(RI EN,IEN312) ; IB*2*59 5/DM updat e INSUR RE CORD IEN i n the resp onse file (#365,.12) | |
3141 | "RTN","IBC NEHL3",393 ,0) | |
3142 | ; RIEN - ien in eIV Response file (365) | |
3143 | "RTN","IBC NEHL3",394 ,0) | |
3144 | ; IEN312 - ien in p at. insura nce multip le (2.312) | |
3145 | "RTN","IBC NEHL3",395 ,0) | |
3146 | ; | |
3147 | "RTN","IBC NEHL3",396 ,0) | |
3148 | N DATA,ER ROR,IENS | |
3149 | "RTN","IBC NEHL3",397 ,0) | |
3150 | I RIEN'>0 !(IEN312'> 0) Q | |
3151 | "RTN","IBC NEHL3",398 ,0) | |
3152 | ; IB*2*59 5/DM do no t update T Q file. | |
3153 | "RTN","IBC NEHL3",399 ,0) | |
3154 | ; The pro per INSUR RECORD IEN field is now locate d in the r esponse fi le | |
3155 | "RTN","IBC NEHL3",400 ,0) | |
3156 | ;S IENS=$ P($G(^IBCN (365,RIEN, 0)),U,5)_" ," I IENS= "," Q | |
3157 | "RTN","IBC NEHL3",401 ,0) | |
3158 | ;S DATA(3 65.1,IENS, .13)=IEN31 2 | |
3159 | "RTN","IBC NEHL3",402 ,0) | |
3160 | S DATA(36 5,RIEN_"," ,.12)=IEN3 12 | |
3161 | "RTN","IBC NEHL3",403 ,0) | |
3162 | D FILE^DI E("ET","DA TA","ERROR ") | |
3163 | "RTN","IBC NEHL3",404 ,0) | |
3164 | Q | |
3165 | "RTN","IBC NEHL3",405 ,0) | |
3166 | ; | |
3167 | "RTN","IBC NEHL3",406 ,0) | |
3168 | LCKERR ; s end lockin g error me ssage | |
3169 | "RTN","IBC NEHL3",407 ,0) | |
3170 | N MSG,XMY | |
3171 | "RTN","IBC NEHL3",408 ,0) | |
3172 | S MSG(1)= "WARNING: Unable to Auto-file Response M essage fro m the EC" | |
3173 | "RTN","IBC NEHL3",409 ,0) | |
3174 | S MSG(2)= "--------- ---------- ---------- ---------- ---------- --------" | |
3175 | "RTN","IBC NEHL3",410 ,0) | |
3176 | S MSG(3)= "Failed to lock pati ent insura nce entry: " | |
3177 | "RTN","IBC NEHL3",411 ,0) | |
3178 | S MSG(4)= " Patient name - "_ $$GET1^DIQ (2,DFN_"," ,.01) | |
3179 | "RTN","IBC NEHL3",412 ,0) | |
3180 | S MSG(5)= " Insuran ce - "_$$G ET1^DIQ(2. 312,IENS,. 01) | |
3181 | "RTN","IBC NEHL3",413 ,0) | |
3182 | S MSG(6)= " IENS - "_$S($G(IE NS)="":"Un known",1:I ENS) | |
3183 | "RTN","IBC NEHL3",414 ,0) | |
3184 | S MSG(7)= " " | |
3185 | "RTN","IBC NEHL3",415 ,0) | |
3186 | S MSG(8)= "The respo nse will b e filed in to Insuran ce Buffer instead." | |
3187 | "RTN","IBC NEHL3",416 ,0) | |
3188 | S MSG(9)= " " | |
3189 | "RTN","IBC NEHL3",417 ,0) | |
3190 | D MSG^IBC NEUT5(MGRP ,MSG(1),"M SG(",,.XMY ) | |
3191 | "RTN","IBC NEHL3",418 ,0) | |
3192 | Q | |
3193 | "RTN","IBC NEHL3",419 ,0) | |
3194 | ; | |
3195 | "RTN","IBC NEKIT") | |
3196 | 0^11^B1644 96028^B147 072833 | |
3197 | "RTN","IBC NEKIT",1,0 ) | |
3198 | IBCNEKIT ; DAOU/ESG - PURGE eIV DATA FILE S ;11-JUL- 2002 | |
3199 | "RTN","IBC NEKIT",2,0 ) | |
3200 | ;;2.0;INT EGRATED BI LLING;**18 4,271,316, 416,549,59 5,621,602* *;21-MAR-9 4;Build 22 | |
3201 | "RTN","IBC NEKIT",3,0 ) | |
3202 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3203 | "RTN","IBC NEKIT",4,0 ) | |
3204 | ; | |
3205 | "RTN","IBC NEKIT",5,0 ) | |
3206 | ; This ro utine hand les the pu rging of t he eIV dat a stored i n the | |
3207 | "RTN","IBC NEKIT",6,0 ) | |
3208 | ; eIV Tra nsmission Queue file (#365.1), the eIV R esponse fi le (#365) and | |
3209 | "RTN","IBC NEKIT",7,0 ) | |
3210 | ; the EIV EICD TRAC KING file (#365.18) IB*2.0*621 /DM | |
3211 | "RTN","IBC NEKIT",8,0 ) | |
3212 | ; User ca n pick a d ate range for the pu rge. Data created w ithin 6 mo nths | |
3213 | "RTN","IBC NEKIT",9,0 ) | |
3214 | ; cannot be purged. The actu al global kills are done by a background | |
3215 | "RTN","IBC NEKIT",10, 0) | |
3216 | ; task af ter hours (8:00pm). | |
3217 | "RTN","IBC NEKIT",11, 0) | |
3218 | ; | |
3219 | "RTN","IBC NEKIT",12, 0) | |
3220 | EN ; | |
3221 | "RTN","IBC NEKIT",13, 0) | |
3222 | NEW STOP, BEGDT,ENDD T,STATLIST ,IBVER | |
3223 | "RTN","IBC NEKIT",14, 0) | |
3224 | S IBVER=1 | |
3225 | "RTN","IBC NEKIT",15, 0) | |
3226 | D INIT I STOP G EXI T ; initialize /calculate default d ates | |
3227 | "RTN","IBC NEKIT",16, 0) | |
3228 | D DEFLT I STOP G EX IT ; allow user to change default e nd date if test syst em ;IB*2.0 *621 | |
3229 | "RTN","IBC NEKIT",17, 0) | |
3230 | D BEGDT I STOP G EX IT ; user inter face for b eginning d ate | |
3231 | "RTN","IBC NEKIT",18, 0) | |
3232 | D ENDDT I STOP G EX IT ; user inter face for e nding date | |
3233 | "RTN","IBC NEKIT",19, 0) | |
3234 | D CONFIRM I STOP G EXIT ; confirmati on message /final che ck | |
3235 | "RTN","IBC NEKIT",20, 0) | |
3236 | D QUEUE ; queuing pr ocess | |
3237 | "RTN","IBC NEKIT",21, 0) | |
3238 | EXIT ; | |
3239 | "RTN","IBC NEKIT",22, 0) | |
3240 | Q | |
3241 | "RTN","IBC NEKIT",23, 0) | |
3242 | ; | |
3243 | "RTN","IBC NEKIT",24, 0) | |
3244 | EN1 ; Auto mated Mont hly Purge *IB*2*595 | |
3245 | "RTN","IBC NEKIT",25, 0) | |
3246 | NEW STOP, BEGDT,ENDD T,STATLIST ,IBVER | |
3247 | "RTN","IBC NEKIT",26, 0) | |
3248 | S IBVER=2 | |
3249 | "RTN","IBC NEKIT",27, 0) | |
3250 | D INIT I STOP G EXI T1 ; initializ e/calculat e default dates | |
3251 | "RTN","IBC NEKIT",28, 0) | |
3252 | D QUEUE ; queuing pr ocess | |
3253 | "RTN","IBC NEKIT",29, 0) | |
3254 | EXIT1 ; | |
3255 | "RTN","IBC NEKIT",30, 0) | |
3256 | Q | |
3257 | "RTN","IBC NEKIT",31, 0) | |
3258 | PURGE ; Th is procedu re is queu ed to run in the bac kground an d does the | |
3259 | "RTN","IBC NEKIT",32, 0) | |
3260 | ; actual purging. Variables available from the T askMan cal l are: | |
3261 | "RTN","IBC NEKIT",33, 0) | |
3262 | ; | |
3263 | "RTN","IBC NEKIT",34, 0) | |
3264 | ; STATLIS T = list o f statuses that are OK to purg e | |
3265 | "RTN","IBC NEKIT",35, 0) | |
3266 | ; BEGD T = beginn ing date f or purging | |
3267 | "RTN","IBC NEKIT",36, 0) | |
3268 | ; ENDD T = ending date for purging | |
3269 | "RTN","IBC NEKIT",37, 0) | |
3270 | ; | |
3271 | "RTN","IBC NEKIT",38, 0) | |
3272 | ; First l oop throug h the eIV Transmissi on Queue f ile and de lete all | |
3273 | "RTN","IBC NEKIT",39, 0) | |
3274 | ; records in the da te range w hose statu s is in th e list | |
3275 | "RTN","IBC NEKIT",40, 0) | |
3276 | ; | |
3277 | "RTN","IBC NEKIT",41, 0) | |
3278 | N CNT,DA, DATE,DIK,H LIEN,PFLAG ,TQIEN,TQS ;IB*2.0 *549 added PFLAG | |
3279 | "RTN","IBC NEKIT",42, 0) | |
3280 | N IBWEXT, IBIORV | |
3281 | "RTN","IBC NEKIT",43, 0) | |
3282 | S DATE=$O (^IBCN(365 .1,"AE",BE GDT),-1),C NT=0 | |
3283 | "RTN","IBC NEKIT",44, 0) | |
3284 | F S DATE =$O(^IBCN( 365.1,"AE" ,DATE)) Q: 'DATE!($P( DATE,".",1 )>ENDDT)!$ G(ZTSTOP) S TQIEN=0 F S TQIE N=$O(^IBCN (365.1,"AE ",DATE,TQI EN)) Q:'TQ IEN D Q: $G(ZTSTOP) | |
3285 | "RTN","IBC NEKIT",45, 0) | |
3286 | . S CNT=C NT+1 | |
3287 | "RTN","IBC NEKIT",46, 0) | |
3288 | . I $D(ZT QUEUED),CN T#100=0,$$ S^%ZTLOAD( ) S ZTSTOP =1 Q | |
3289 | "RTN","IBC NEKIT",47, 0) | |
3290 | . S TQS=$ P($G(^IBCN (365.1,TQI EN,0)),U,4 ) ; tr ans queue status | |
3291 | "RTN","IBC NEKIT",48, 0) | |
3292 | . S IBWEX T=$P($G(^I BCN(365.1, TQIEN,0)), U,10) ; IB *2.0*621/D M WHICH EX TRACT | |
3293 | "RTN","IBC NEKIT",49, 0) | |
3294 | . S IBIOR V=$P($G(^I BCN(365.1, TQIEN,0)), U,11) ; IB *2.0*621/D M QUERY FL AG | |
3295 | "RTN","IBC NEKIT",50, 0) | |
3296 | . I IBWEX T=4,IBIORV ="V" Q ; sk ip EICD Ve rification entries a s they | |
3297 | "RTN","IBC NEKIT",51, 0) | |
3298 | . ; wi ll be addr essed with EICD Iden tification s | |
3299 | "RTN","IBC NEKIT",52, 0) | |
3300 | . I '$F(S TATLIST,", "_TQS_",") Q ; mu st be in t he list | |
3301 | "RTN","IBC NEKIT",53, 0) | |
3302 | . I IBWEX T=4,IBIORV ="I" D CHK TRK(TQIEN) Q ; ch eck EIV EI CD TRACKIN G for purg e | |
3303 | "RTN","IBC NEKIT",54, 0) | |
3304 | . ; loop through th e HL7 mess ages multi ple and ki ll any res ponse | |
3305 | "RTN","IBC NEKIT",55, 0) | |
3306 | . ; recor ds that ar e found fo r this tra nsmission queue entr y | |
3307 | "RTN","IBC NEKIT",56, 0) | |
3308 | . ; IB*2. 0*621/DM P reserve an y TQ and r esponse th at has DO NOT PURGE set to 1 ( YES) | |
3309 | "RTN","IBC NEKIT",57, 0) | |
3310 | . S PFLAG =0,HLIEN=0 ,DIK="^IBC N(365," | |
3311 | "RTN","IBC NEKIT",58, 0) | |
3312 | . F S HL IEN=$O(^IB CN(365.1,T QIEN,2,HLI EN)) Q:'HL IEN D | |
3313 | "RTN","IBC NEKIT",59, 0) | |
3314 | .. S DA=$ P($G(^IBCN (365.1,TQI EN,2,HLIEN ,0)),U,3) Q:'DA | |
3315 | "RTN","IBC NEKIT",60, 0) | |
3316 | .. I +$$G ET1^DIQ(36 5,DA_",",. 11,"I") S PFLAG=1 Q ;"DO NOT PURGE" | |
3317 | "RTN","IBC NEKIT",61, 0) | |
3318 | .. D ^DIK | |
3319 | "RTN","IBC NEKIT",62, 0) | |
3320 | .. Q | |
3321 | "RTN","IBC NEKIT",63, 0) | |
3322 | . ; | |
3323 | "RTN","IBC NEKIT",64, 0) | |
3324 | . ; now w e can kill the trans mission qu eue entry itself | |
3325 | "RTN","IBC NEKIT",65, 0) | |
3326 | . ; as lo ng as ther e was no D O NOT PURG E response s IB*2.0*6 21/DM | |
3327 | "RTN","IBC NEKIT",66, 0) | |
3328 | . I 'PFLA G S DA=TQI EN,DIK="^I BCN(365.1, " D ^DIK K DA,DIK | |
3329 | "RTN","IBC NEKIT",67, 0) | |
3330 | . Q | |
3331 | "RTN","IBC NEKIT",68, 0) | |
3332 | ; | |
3333 | "RTN","IBC NEKIT",69, 0) | |
3334 | ; Check f or a stop request | |
3335 | "RTN","IBC NEKIT",70, 0) | |
3336 | I $G(ZTST OP) G PURG EX | |
3337 | "RTN","IBC NEKIT",71, 0) | |
3338 | ; | |
3339 | "RTN","IBC NEKIT",72, 0) | |
3340 | ; Now we must loop through th e eIV Resp onse file itself to purge any | |
3341 | "RTN","IBC NEKIT",73, 0) | |
3342 | ; respons e records that do no t have a c orrespondi ng transmi ssion | |
3343 | "RTN","IBC NEKIT",74, 0) | |
3344 | ; queue e ntry. The se are the unsolicit ed respons es. The s tatus of | |
3345 | "RTN","IBC NEKIT",75, 0) | |
3346 | ; these r esponses i s always ' response r eceived' s o we don't need to | |
3347 | "RTN","IBC NEKIT",76, 0) | |
3348 | ; check t he status. For this loop, star t from the very begi nning of | |
3349 | "RTN","IBC NEKIT",77, 0) | |
3350 | ; the fil e. | |
3351 | "RTN","IBC NEKIT",78, 0) | |
3352 | ; | |
3353 | "RTN","IBC NEKIT",79, 0) | |
3354 | S DATE="" ,DIK="^IBC N(365,",CN T=0 | |
3355 | "RTN","IBC NEKIT",80, 0) | |
3356 | F S DATE =$O(^IBCN( 365,"AE",D ATE)) Q:'D ATE!($P(DA TE,".",1)> ENDDT)!$G( ZTSTOP) S DA=0 F S DA=$O(^IB CN(365,"AE ",DATE,DA) ) Q:'DA D Q:$G(ZTS TOP) | |
3357 | "RTN","IBC NEKIT",81, 0) | |
3358 | . S CNT=C NT+1 | |
3359 | "RTN","IBC NEKIT",82, 0) | |
3360 | . I $D(ZT QUEUED),CN T#100=0,$$ S^%ZTLOAD( ) S ZTSTOP =1 Q | |
3361 | "RTN","IBC NEKIT",83, 0) | |
3362 | . ; | |
3363 | "RTN","IBC NEKIT",84, 0) | |
3364 | . ; IB*2. 0*602/TAZ never drop a DO NOT PURGE resp onse | |
3365 | "RTN","IBC NEKIT",85, 0) | |
3366 | . Q:+$$GE T1^DIQ(365 ,DA_",",.1 1,"I") | |
3367 | "RTN","IBC NEKIT",86, 0) | |
3368 | . ; If th ere is a p ointer to the transm ission que ue file, | |
3369 | "RTN","IBC NEKIT",87, 0) | |
3370 | . ; make sure the t ransmissio n queue re cord actua lly exists . | |
3371 | "RTN","IBC NEKIT",88, 0) | |
3372 | . ; If th e TQ exist s, quit th is loop, i f not, rem ove this r esponse. | |
3373 | "RTN","IBC NEKIT",89, 0) | |
3374 | . ; | |
3375 | "RTN","IBC NEKIT",90, 0) | |
3376 | . S TQIEN =+$$GET1^D IQ(365,DA_ ",",.05,"I ") | |
3377 | "RTN","IBC NEKIT",91, 0) | |
3378 | . D ^DIK | |
3379 | "RTN","IBC NEKIT",92, 0) | |
3380 | . Q | |
3381 | "RTN","IBC NEKIT",93, 0) | |
3382 | ; | |
3383 | "RTN","IBC NEKIT",94, 0) | |
3384 | K DA,DIK | |
3385 | "RTN","IBC NEKIT",95, 0) | |
3386 | PURGEX ; | |
3387 | "RTN","IBC NEKIT",96, 0) | |
3388 | ; Tell Ta skManager to delete the task's record | |
3389 | "RTN","IBC NEKIT",97, 0) | |
3390 | I $D(ZTQU EUED) S ZT REQ="@" | |
3391 | "RTN","IBC NEKIT",98, 0) | |
3392 | Q | |
3393 | "RTN","IBC NEKIT",99, 0) | |
3394 | ; | |
3395 | "RTN","IBC NEKIT",100 ,0) | |
3396 | INIT ; Thi s procedur e calculat es the def ault begin ning and e nding date s | |
3397 | "RTN","IBC NEKIT",101 ,0) | |
3398 | ; and dis plays scre en message s about th is option to the use r. | |
3399 | "RTN","IBC NEKIT",102 ,0) | |
3400 | ; | |
3401 | "RTN","IBC NEKIT",103 ,0) | |
3402 | NEW DATE, FOUND,TQIE N,TQS,RPIE N,RPS,IBHL 7,IBDNP | |
3403 | "RTN","IBC NEKIT",104 ,0) | |
3404 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
3405 | "RTN","IBC NEKIT",105 ,0) | |
3406 | ; | |
3407 | "RTN","IBC NEKIT",106 ,0) | |
3408 | S STOP=0 | |
3409 | "RTN","IBC NEKIT",107 ,0) | |
3410 | ; | |
3411 | "RTN","IBC NEKIT",108 ,0) | |
3412 | ; This is the list of statuse s that are OK to pur ge | |
3413 | "RTN","IBC NEKIT",109 ,0) | |
3414 | ; 3=Res ponse Rece ived | |
3415 | "RTN","IBC NEKIT",110 ,0) | |
3416 | ; 5=Com munication Failure | |
3417 | "RTN","IBC NEKIT",111 ,0) | |
3418 | ; 7=Can celled | |
3419 | "RTN","IBC NEKIT",112 ,0) | |
3420 | S STATLIS T=","_$$FI ND1^DIC(36 5.14,,"B", "Response Received") | |
3421 | "RTN","IBC NEKIT",113 ,0) | |
3422 | S STATLIS T=STATLIST _","_$$FIN D1^DIC(365 .14,,"B"," Communicat ion Failur e") | |
3423 | "RTN","IBC NEKIT",114 ,0) | |
3424 | S STATLIS T=STATLIST _","_$$FIN D1^DIC(365 .14,,"B"," Cancelled" )_"," | |
3425 | "RTN","IBC NEKIT",115 ,0) | |
3426 | ; | |
3427 | "RTN","IBC NEKIT",116 ,0) | |
3428 | ; Try to find a beg inning dat e in the e IV Transmi ssion Queu e file | |
3429 | "RTN","IBC NEKIT",117 ,0) | |
3430 | S DATE="" ,FOUND=0,B EGDT=DT | |
3431 | "RTN","IBC NEKIT",118 ,0) | |
3432 | F S DATE =$O(^IBCN( 365.1,"AE" ,DATE)) Q: 'DATE!FOUN D S TQIEN =0 F S TQ IEN=$O(^IB CN(365.1," AE",DATE,T QIEN)) Q:' TQIEN D Q:FOUND | |
3433 | "RTN","IBC NEKIT",119 ,0) | |
3434 | . S TQS=$ P($G(^IBCN (365.1,TQI EN,0)),U,4 ) ; sta tus | |
3435 | "RTN","IBC NEKIT",120 ,0) | |
3436 | . I '$F(S TATLIST,", "_TQS_",") Q | |
3437 | "RTN","IBC NEKIT",121 ,0) | |
3438 | . ;IB*2.0 *602/DM ma ke sure th e default earliest d ate is not a DO NOT PURGE entr y | |
3439 | "RTN","IBC NEKIT",122 ,0) | |
3440 | . ;check the HL7 me ssages mul tiple to s ee if DO N OT PURGE i s set on a ny respons e | |
3441 | "RTN","IBC NEKIT",123 ,0) | |
3442 | . S (IBDN P,IBHL7)=0 | |
3443 | "RTN","IBC NEKIT",124 ,0) | |
3444 | . F S IB HL7=$O(^IB CN(365.1,T QIEN,2,IBH L7)) Q:'IB HL7!IBDNP D | |
3445 | "RTN","IBC NEKIT",125 ,0) | |
3446 | .. S RPIE N=$P($G(^I BCN(365.1, TQIEN,2,IB HL7,0)),U, 3) Q:'RPIE N | |
3447 | "RTN","IBC NEKIT",126 ,0) | |
3448 | .. I +$$G ET1^DIQ(36 5,RPIEN_", ","DO NOT PURGE","I" ) S IBDNP= 1 | |
3449 | "RTN","IBC NEKIT",127 ,0) | |
3450 | .. Q | |
3451 | "RTN","IBC NEKIT",128 ,0) | |
3452 | . ; | |
3453 | "RTN","IBC NEKIT",129 ,0) | |
3454 | . I IBDNP ,IBVER=2 Q | |
3455 | "RTN","IBC NEKIT",130 ,0) | |
3456 | . I IBDNP W !,"Plea se wait, c hecking fo r the earl iest purge date ..." ,! Q | |
3457 | "RTN","IBC NEKIT",131 ,0) | |
3458 | . ; | |
3459 | "RTN","IBC NEKIT",132 ,0) | |
3460 | . S FOUND =1 | |
3461 | "RTN","IBC NEKIT",133 ,0) | |
3462 | . S BEGDT =$P(DATE," .",1) | |
3463 | "RTN","IBC NEKIT",134 ,0) | |
3464 | . Q | |
3465 | "RTN","IBC NEKIT",135 ,0) | |
3466 | ; | |
3467 | "RTN","IBC NEKIT",136 ,0) | |
3468 | ; If not successful , try to f ind a begi nning date in the eI V Response file. | |
3469 | "RTN","IBC NEKIT",137 ,0) | |
3470 | I 'FOUND D | |
3471 | "RTN","IBC NEKIT",138 ,0) | |
3472 | . S DATE= "" | |
3473 | "RTN","IBC NEKIT",139 ,0) | |
3474 | . F S DA TE=$O(^IBC N(365,"AE" ,DATE)) Q: 'DATE!FOUN D S RPIEN =0 F S RP IEN=$O(^IB CN(365,"AE ",DATE,RPI EN)) Q:'RP IEN D Q: FOUND | |
3475 | "RTN","IBC NEKIT",140 ,0) | |
3476 | .. S RPS= $P($G(^IBC N(365,RPIE N,0)),U,6) ; stat us | |
3477 | "RTN","IBC NEKIT",141 ,0) | |
3478 | .. I '$F( STATLIST," ,"_RPS_"," ) Q | |
3479 | "RTN","IBC NEKIT",142 ,0) | |
3480 | .. ;IB*2. 0*602/DM d o not choo se a DO NO T PURGE re sponse | |
3481 | "RTN","IBC NEKIT",143 ,0) | |
3482 | .. I +$$G ET1^DIQ(36 5,RPIEN_", ","DO NOT PURGE","I" ) Q | |
3483 | "RTN","IBC NEKIT",144 ,0) | |
3484 | .. S FOUN D=1 | |
3485 | "RTN","IBC NEKIT",145 ,0) | |
3486 | .. S BEGD T=$P(DATE, ".",1) | |
3487 | "RTN","IBC NEKIT",146 ,0) | |
3488 | .. Q | |
3489 | "RTN","IBC NEKIT",147 ,0) | |
3490 | . Q | |
3491 | "RTN","IBC NEKIT",148 ,0) | |
3492 | ; | |
3493 | "RTN","IBC NEKIT",149 ,0) | |
3494 | ; default end date, Today min us 182 day s (approx 6 months) | |
3495 | "RTN","IBC NEKIT",150 ,0) | |
3496 | S ENDDT=$ $FMADD^XLF DT(DT,-182 ) | |
3497 | "RTN","IBC NEKIT",151 ,0) | |
3498 | ; | |
3499 | "RTN","IBC NEKIT",152 ,0) | |
3500 | ;I IBVER= 1,'FOUND!( BEGDT>ENDD T) D S ST OP=1 G INI TX ; IB*2. 0*621 | |
3501 | "RTN","IBC NEKIT",153 ,0) | |
3502 | I IBVER=1 ,'FOUND,'$ $PROD^XUPR OD(1)!(BEG DT>ENDDT) D S STOP= 1 G INITX | |
3503 | "RTN","IBC NEKIT",154 ,0) | |
3504 | . W !!?5, "Purging o f eIV data is not po ssible at this time. " | |
3505 | "RTN","IBC NEKIT",155 ,0) | |
3506 | . I 'FOUN D W !?5,"T here are n o entries in the fil e that are eligible to be",!?5 ,"purged o r there is no data i n the file ." | |
3507 | "RTN","IBC NEKIT",156 ,0) | |
3508 | . E W !? 5,"The old est date i n the file is ",$$FM TE^XLFDT(B EGDT,"5Z") ,".",!?5," Data canno t be purge d unless i t is at le ast 6 mont hs old." | |
3509 | "RTN","IBC NEKIT",157 ,0) | |
3510 | . W ! S D IR(0)="E" D ^DIR K D IR | |
3511 | "RTN","IBC NEKIT",158 ,0) | |
3512 | . Q | |
3513 | "RTN","IBC NEKIT",159 ,0) | |
3514 | I IBVER=2 ,'FOUND!(B EGDT>ENDDT ) D S STO P=1 G INIT X | |
3515 | "RTN","IBC NEKIT",160 ,0) | |
3516 | .; Send a MailMan m essage wit h Eligible Purge cou nts ; IB*2 .0*621 - U pdated Mes sage | |
3517 | "RTN","IBC NEKIT",161 ,0) | |
3518 | .N MGRP,M SG,IBXMY | |
3519 | "RTN","IBC NEKIT",162 ,0) | |
3520 | .S MSG(1) ="Purge El ectronic I nsurance V erificatio n (eIV) Da ta Files d id not fin d records" | |
3521 | "RTN","IBC NEKIT",163 ,0) | |
3522 | .S MSG(2) ="for stat ion "_+$$S ITE^VASITE ()_"." | |
3523 | "RTN","IBC NEKIT",164 ,0) | |
3524 | .S MSG(3) ="" | |
3525 | "RTN","IBC NEKIT",165 ,0) | |
3526 | .S MSG(4) ="The opti on runs au tomaticall y on a mon thly basis and purge s data fro m the" | |
3527 | "RTN","IBC NEKIT",166 ,0) | |
3528 | .S MSG(5) ="IIV RESP ONSE file (#365), th e IIV TRAN SMISSION Q UEUE file (#365.1), and the" | |
3529 | "RTN","IBC NEKIT",167 ,0) | |
3530 | .S MSG(6) ="EIV EICD TRACKING file (#365 .18). The data must be at lea st six mon ths old" | |
3531 | "RTN","IBC NEKIT",168 ,0) | |
3532 | .S MSG(7) ="before i t can be p urged. On ly insuran ce transac tions that have a tr ansmission " | |
3533 | "RTN","IBC NEKIT",169 ,0) | |
3534 | .S MSG(8) ="status o f ""Respon se Receive d"", ""Com munication Failure"" , or ""Can celled""" | |
3535 | "RTN","IBC NEKIT",170 ,0) | |
3536 | .S MSG(9) ="may be p urged." | |
3537 | "RTN","IBC NEKIT",171 ,0) | |
3538 | .; Set to IB site p arameter M AILGROUP - IBCNE EIV MESSAGE | |
3539 | "RTN","IBC NEKIT",172 ,0) | |
3540 | .S MGRP=$ $MGRP^IBCN EUT5() | |
3541 | "RTN","IBC NEKIT",173 ,0) | |
3542 | .S IBXMY( " P I I ")="" | |
3543 | "RTN","IBC NEKIT",174 ,0) | |
3544 | .D MSG^IB CNEUT5(MGR P,"eIV Pur ge No Data Found for Station " _+$$SITE^V ASITE(),"M SG(",,.IBX MY) | |
3545 | "RTN","IBC NEKIT",175 ,0) | |
3546 | .; Duplic ate messag e to Outlo ok group | |
3547 | "RTN","IBC NEKIT",176 ,0) | |
3548 | .; S MGRP =" P I I " | |
3549 | "RTN","IBC NEKIT",177 ,0) | |
3550 | .; D MSG^ IBCNEUT5(M GRP,"eIV D ata Backgr ound Purge ","MSG(") | |
3551 | "RTN","IBC NEKIT",178 ,0) | |
3552 | .Q | |
3553 | "RTN","IBC NEKIT",179 ,0) | |
3554 | ; | |
3555 | "RTN","IBC NEKIT",180 ,0) | |
3556 | ; At this point, we know that there are some entr ies eligib le for | |
3557 | "RTN","IBC NEKIT",181 ,0) | |
3558 | ; purging . Display a message to the us er about t his option . | |
3559 | "RTN","IBC NEKIT",182 ,0) | |
3560 | I IBVER=2 G INITX | |
3561 | "RTN","IBC NEKIT",183 ,0) | |
3562 | W @IOF | |
3563 | "RTN","IBC NEKIT",184 ,0) | |
3564 | W !?8,"Pu rge Electr onic Insur ance Verif ication (e IV) Data F iles" | |
3565 | "RTN","IBC NEKIT",185 ,0) | |
3566 | W !!!," T his option will allo w you to p urge data from the e IV Respons e File (#3 65)" | |
3567 | "RTN","IBC NEKIT",186 ,0) | |
3568 | W !," and the eIV T ransmissio n Queue Fi le (#365.1 ). The da ta must be at least six" | |
3569 | "RTN","IBC NEKIT",187 ,0) | |
3570 | W !," mon ths old be fore it ca n be purge d. Only i nsurance t ransaction s that hav e a" | |
3571 | "RTN","IBC NEKIT",188 ,0) | |
3572 | W !," tra nsmission status of ""Response Received" ", ""Commu nication F ailure"", or" | |
3573 | "RTN","IBC NEKIT",189 ,0) | |
3574 | W !," ""C ancelled"" may be pu rged. You will be a llowed to select a d ate range for" | |
3575 | "RTN","IBC NEKIT",190 ,0) | |
3576 | W !," thi s purging. The defa ult beginn ing date w ill be the date of t he oldest" | |
3577 | "RTN","IBC NEKIT",191 ,0) | |
3578 | W !," eli gible reco rd in the system. T he default ending da te will be six month s" | |
3579 | "RTN","IBC NEKIT",192 ,0) | |
3580 | W !," ago from toda y's date. You may m odify this default d ate range. However, you" | |
3581 | "RTN","IBC NEKIT",193 ,0) | |
3582 | W !," may not selec t an endin g date tha t is more recent tha n six mont hs ago." | |
3583 | "RTN","IBC NEKIT",194 ,0) | |
3584 | W !! | |
3585 | "RTN","IBC NEKIT",195 ,0) | |
3586 | INITX ; | |
3587 | "RTN","IBC NEKIT",196 ,0) | |
3588 | Q | |
3589 | "RTN","IBC NEKIT",197 ,0) | |
3590 | ; | |
3591 | "RTN","IBC NEKIT",198 ,0) | |
3592 | DEFLT ; I B*621/DW A dded to as sist with testing | |
3593 | "RTN","IBC NEKIT",199 ,0) | |
3594 | I IBVER=1 ,('$$PROD^ XUPROD(1)) D | |
3595 | "RTN","IBC NEKIT",200 ,0) | |
3596 | . W ?5,"* ** For Tes t Purposes Only:" | |
3597 | "RTN","IBC NEKIT",201 ,0) | |
3598 | . W !!?5, "In test s ystems one may overr ide the DE FAULT end date." | |
3599 | "RTN","IBC NEKIT",202 ,0) | |
3600 | . W !!?5, "Current d efault end date is T ODAY - 182 DAYS: "_$ $FMTE^XLFD T(ENDDT,"5 Z"),!! | |
3601 | "RTN","IBC NEKIT",203 ,0) | |
3602 | . NEW DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT | |
3603 | "RTN","IBC NEKIT",204 ,0) | |
3604 | . S DIR(0 )="DOA^"_B EGDT_":"_D T_":AEX" | |
3605 | "RTN","IBC NEKIT",205 ,0) | |
3606 | . S DIR(" A")="Enter the purge default d ate: " | |
3607 | "RTN","IBC NEKIT",206 ,0) | |
3608 | . S DIR(" B")=$$FMTE ^XLFDT(END DT,"5Z") | |
3609 | "RTN","IBC NEKIT",207 ,0) | |
3610 | . S DIR(" ?")="This response m ust be a d ate betwee n "_$$FMTE ^XLFDT(BEG DT,"5Z")_" and "_$$F MTE^XLFDT( DT,"5Z")_" ." | |
3611 | "RTN","IBC NEKIT",208 ,0) | |
3612 | . D ^DIR K DIR | |
3613 | "RTN","IBC NEKIT",209 ,0) | |
3614 | . I $D(DI RUT)!'Y S STOP=1 G D EFLTX | |
3615 | "RTN","IBC NEKIT",210 ,0) | |
3616 | . S ENDDT =Y | |
3617 | "RTN","IBC NEKIT",211 ,0) | |
3618 | W !!! | |
3619 | "RTN","IBC NEKIT",212 ,0) | |
3620 | DEFLTX ; | |
3621 | "RTN","IBC NEKIT",213 ,0) | |
3622 | Q | |
3623 | "RTN","IBC NEKIT",214 ,0) | |
3624 | ; | |
3625 | "RTN","IBC NEKIT",215 ,0) | |
3626 | BEGDT ; Th is procedu re capture s the begi nning date from the user. | |
3627 | "RTN","IBC NEKIT",216 ,0) | |
3628 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
3629 | "RTN","IBC NEKIT",217 ,0) | |
3630 | S DIR(0)= "DOA^"_BEG DT_":"_END DT_":AEX" | |
3631 | "RTN","IBC NEKIT",218 ,0) | |
3632 | S DIR("A" )="Enter t he purge b egin date: " | |
3633 | "RTN","IBC NEKIT",219 ,0) | |
3634 | S DIR("B" )=$$FMTE^X LFDT(BEGDT ,"5Z") | |
3635 | "RTN","IBC NEKIT",220 ,0) | |
3636 | S DIR("?" )="This re sponse mus t be a dat e between "_$$FMTE^X LFDT(BEGDT ,"5Z")_" a nd "_$$FMT E^XLFDT(EN DDT,"5Z")_ "." | |
3637 | "RTN","IBC NEKIT",221 ,0) | |
3638 | D ^DIR K DIR | |
3639 | "RTN","IBC NEKIT",222 ,0) | |
3640 | I $D(DIRU T)!'Y S ST OP=1 G BEG DTX | |
3641 | "RTN","IBC NEKIT",223 ,0) | |
3642 | S BEGDT=Y | |
3643 | "RTN","IBC NEKIT",224 ,0) | |
3644 | BEGDTX ; | |
3645 | "RTN","IBC NEKIT",225 ,0) | |
3646 | Q | |
3647 | "RTN","IBC NEKIT",226 ,0) | |
3648 | ; | |
3649 | "RTN","IBC NEKIT",227 ,0) | |
3650 | ENDDT ; Th is procedu re capture s the endi ng date fr om the use r. | |
3651 | "RTN","IBC NEKIT",228 ,0) | |
3652 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
3653 | "RTN","IBC NEKIT",229 ,0) | |
3654 | W ! | |
3655 | "RTN","IBC NEKIT",230 ,0) | |
3656 | S DIR(0)= "DOA^"_BEG DT_":"_END DT_":AEX" | |
3657 | "RTN","IBC NEKIT",231 ,0) | |
3658 | S DIR("A" )=" Enter the purge end date: " | |
3659 | "RTN","IBC NEKIT",232 ,0) | |
3660 | S DIR("B" )=$$FMTE^X LFDT(ENDDT ,"5Z") | |
3661 | "RTN","IBC NEKIT",233 ,0) | |
3662 | S DIR("?" )="This re sponse mus t be a dat e between "_$$FMTE^X LFDT(BEGDT ,"5Z")_" a nd "_$$FMT E^XLFDT(EN DDT,"5Z")_ "." | |
3663 | "RTN","IBC NEKIT",234 ,0) | |
3664 | D ^DIR K DIR | |
3665 | "RTN","IBC NEKIT",235 ,0) | |
3666 | I $D(DIRU T)!'Y S ST OP=1 G END DTX | |
3667 | "RTN","IBC NEKIT",236 ,0) | |
3668 | S ENDDT=Y | |
3669 | "RTN","IBC NEKIT",237 ,0) | |
3670 | ENDDTX ; | |
3671 | "RTN","IBC NEKIT",238 ,0) | |
3672 | Q | |
3673 | "RTN","IBC NEKIT",239 ,0) | |
3674 | ; | |
3675 | "RTN","IBC NEKIT",240 ,0) | |
3676 | CONFIRM ; This proce dure displ ays a conf irmation m essage to the user a nd | |
3677 | "RTN","IBC NEKIT",241 ,0) | |
3678 | ; asks if it is OK to proceed with the purge. | |
3679 | "RTN","IBC NEKIT",242 ,0) | |
3680 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
3681 | "RTN","IBC NEKIT",243 ,0) | |
3682 | W !!!," Y ou want to purge all eIV data created be tween " | |
3683 | "RTN","IBC NEKIT",244 ,0) | |
3684 | W $$FMTE^ XLFDT(BEGD T,"5Z")," and ",$$FM TE^XLFDT(E NDDT,"5Z") ,"." | |
3685 | "RTN","IBC NEKIT",245 ,0) | |
3686 | W ! | |
3687 | "RTN","IBC NEKIT",246 ,0) | |
3688 | S DIR(0)= "YO",DIR(" A")=" OK t o continue " | |
3689 | "RTN","IBC NEKIT",247 ,0) | |
3690 | S DIR("B" )="NO" | |
3691 | "RTN","IBC NEKIT",248 ,0) | |
3692 | D ^DIR K DIR | |
3693 | "RTN","IBC NEKIT",249 ,0) | |
3694 | I 'Y S ST OP=1 | |
3695 | "RTN","IBC NEKIT",250 ,0) | |
3696 | CONFX ; | |
3697 | "RTN","IBC NEKIT",251 ,0) | |
3698 | Q | |
3699 | "RTN","IBC NEKIT",252 ,0) | |
3700 | ; | |
3701 | "RTN","IBC NEKIT",253 ,0) | |
3702 | QUEUE ; Th is procedu re queues the purge process fo r later at night. | |
3703 | "RTN","IBC NEKIT",254 ,0) | |
3704 | ; The con cept for q ueuing the purge cam e from the insurance buffer | |
3705 | "RTN","IBC NEKIT",255 ,0) | |
3706 | ; purge r outine, IB CNBPG. Th at purge p rocess is also hard- coded to | |
3707 | "RTN","IBC NEKIT",256 ,0) | |
3708 | ; be run at 8:00 PM just like this one is. | |
3709 | "RTN","IBC NEKIT",257 ,0) | |
3710 | ; | |
3711 | "RTN","IBC NEKIT",258 ,0) | |
3712 | NEW ZTRTN ,ZTDESC,ZT DTH,ZTIO,Z TUCI,ZTCPU ,ZTPRI,ZTS AVE,ZTKIL, ZTSYNC,ZTS K | |
3713 | "RTN","IBC NEKIT",259 ,0) | |
3714 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
3715 | "RTN","IBC NEKIT",260 ,0) | |
3716 | ; | |
3717 | "RTN","IBC NEKIT",261 ,0) | |
3718 | ; IB*621/ DW Added l oop below to assist with testi ng | |
3719 | "RTN","IBC NEKIT",262 ,0) | |
3720 | I IBVER=1 ,('$$PROD^ XUPROD(1)) D I Y D PURGE^IBCN EKIT G QUE UEX | |
3721 | "RTN","IBC NEKIT",263 ,0) | |
3722 | . W !!!!, "*** TEST System onl y - you ma y run this immediate ly",! | |
3723 | "RTN","IBC NEKIT",264 ,0) | |
3724 | . S DIR(" A")="Do yo u want to run this n ow instead of taskin g it for 8 :00pm" | |
3725 | "RTN","IBC NEKIT",265 ,0) | |
3726 | . S DIR(0 )="Y",DIR( "B")="YES" | |
3727 | "RTN","IBC NEKIT",266 ,0) | |
3728 | . D ^DIR | |
3729 | "RTN","IBC NEKIT",267 ,0) | |
3730 | . I Y="^" S STOP=1 | |
3731 | "RTN","IBC NEKIT",268 ,0) | |
3732 | ; | |
3733 | "RTN","IBC NEKIT",269 ,0) | |
3734 | I STOP G QUEUEX ; IB*2.0*6 21 | |
3735 | "RTN","IBC NEKIT",270 ,0) | |
3736 | S ZTRTN=" PURGE^IBCN EKIT" ; TaskMan task entry point | |
3737 | "RTN","IBC NEKIT",271 ,0) | |
3738 | S ZTDESC= "Purge eIV Data" ; Task des cription | |
3739 | "RTN","IBC NEKIT",272 ,0) | |
3740 | S ZTDTH=D T_".20" ; start it at 8:00 P M tonight | |
3741 | "RTN","IBC NEKIT",273 ,0) | |
3742 | S ZTIO="" | |
3743 | "RTN","IBC NEKIT",274 ,0) | |
3744 | S ZTSAVE( "BEGDT")=" " | |
3745 | "RTN","IBC NEKIT",275 ,0) | |
3746 | S ZTSAVE( "ENDDT")=" " | |
3747 | "RTN","IBC NEKIT",276 ,0) | |
3748 | S ZTSAVE( "STATLIST" )="" | |
3749 | "RTN","IBC NEKIT",277 ,0) | |
3750 | D ^%ZTLOA D | |
3751 | "RTN","IBC NEKIT",278 ,0) | |
3752 | I IBVER=2 G QUEUEX | |
3753 | "RTN","IBC NEKIT",279 ,0) | |
3754 | I $G(ZTSK ) W !!," T ask# ",ZTS K," has be en schedul ed to purg e the eIV data tonig ht at 8:00 PM." | |
3755 | "RTN","IBC NEKIT",280 ,0) | |
3756 | E W !!," TaskManag er could n ot schedul e this tas k.",!," Co ntact IRM for techni cal assist ance." | |
3757 | "RTN","IBC NEKIT",281 ,0) | |
3758 | W ! S DIR (0)="E" D ^DIR K DIR | |
3759 | "RTN","IBC NEKIT",282 ,0) | |
3760 | QUEUEX ; | |
3761 | "RTN","IBC NEKIT",283 ,0) | |
3762 | Q | |
3763 | "RTN","IBC NEKIT",284 ,0) | |
3764 | ; | |
3765 | "RTN","IBC NEKIT",285 ,0) | |
3766 | CHKTRK(IBT Q1) ; IB*6 21, Evalua te associa ted record s for one EICD trans action | |
3767 | "RTN","IBC NEKIT",286 ,0) | |
3768 | ; IBTQ1 = EICD Iden tification TQ IEN | |
3769 | "RTN","IBC NEKIT",287 ,0) | |
3770 | ; | |
3771 | "RTN","IBC NEKIT",288 ,0) | |
3772 | N FILE,HL IEN,IBTQIE N1,IBTQIEN 2,IBFIELDS ,IBPURGE,I BSKIP,IBTQ IEN,IBTQS | |
3773 | "RTN","IBC NEKIT",289 ,0) | |
3774 | N IBTRKIE N,PFLAG | |
3775 | "RTN","IBC NEKIT",290 ,0) | |
3776 | ; | |
3777 | "RTN","IBC NEKIT",291 ,0) | |
3778 | S (IBSKIP ,PFLAG)=0 | |
3779 | "RTN","IBC NEKIT",292 ,0) | |
3780 | K IBPURGE | |
3781 | "RTN","IBC NEKIT",293 ,0) | |
3782 | S IBTQIEN 1=+$$FIND1 ^DIC(365.1 8,,"QX",IB TQ1,"B") | |
3783 | "RTN","IBC NEKIT",294 ,0) | |
3784 | Q:'IBTQIE N1 ; the passed TQ IEN is not in the tr acking fil e | |
3785 | "RTN","IBC NEKIT",295 ,0) | |
3786 | S IBPURGE ("EICD",36 5.1,IBTQ1) ="" ;E ICD TQ for identific ations | |
3787 | "RTN","IBC NEKIT",296 ,0) | |
3788 | S IBTQIEN =+$$GET1^D IQ(365.18, IBTQIEN1,. 06,"I") ;E ICD RESPON SE for ide ntificatio ns | |
3789 | "RTN","IBC NEKIT",297 ,0) | |
3790 | I IBTQIEN S IBPURGE ("EICD",36 5,IBTQIEN) ="" | |
3791 | "RTN","IBC NEKIT",298 ,0) | |
3792 | ; | |
3793 | "RTN","IBC NEKIT",299 ,0) | |
3794 | ; loop th rough the EICD verif ication en tries look ing for ex clusions | |
3795 | "RTN","IBC NEKIT",300 ,0) | |
3796 | S IBTRKIE N=0 F S I BTRKIEN=$O (^IBCN(365 .18,IBTQIE N1,"INS-FN D",IBTRKIE N)) Q:'IBT RKIEN D Q:IBSKIP | |
3797 | "RTN","IBC NEKIT",301 ,0) | |
3798 | . ; | |
3799 | "RTN","IBC NEKIT",302 ,0) | |
3800 | . ; check the 1 nod e data for associate d TQs & th eir respon ses | |
3801 | "RTN","IBC NEKIT",303 ,0) | |
3802 | . S IBTQI EN2=IBTRKI EN_","_IBT QIEN1_"," | |
3803 | "RTN","IBC NEKIT",304 ,0) | |
3804 | . K IBFIE LDS D GETS ^DIQ(365.1 85,IBTQIEN 2,"1.01:1. 04","I","I BFIELDS") | |
3805 | "RTN","IBC NEKIT",305 ,0) | |
3806 | . ; | |
3807 | "RTN","IBC NEKIT",306 ,0) | |
3808 | . I IBFIE LDS(365.18 5,IBTQIEN2 ,1.02,"I") ="" Q ; No TQ w as created | |
3809 | "RTN","IBC NEKIT",307 ,0) | |
3810 | . I IBFIE LDS(365.18 5,IBTQIEN2 ,1.02,"I") >ENDDT S I BSKIP=1 Q ; TQ not old enough | |
3811 | "RTN","IBC NEKIT",308 ,0) | |
3812 | . S IBTQI EN=+IBFIEL DS(365.185 ,IBTQIEN2, 1.01,"I") ; EICD VE R INQ TQ | |
3813 | "RTN","IBC NEKIT",309 ,0) | |
3814 | . S IBTQS =+$$GET1^D IQ(365.1,I BTQIEN_"," ,.04,"I") ; TQ Tran smission S tatus | |
3815 | "RTN","IBC NEKIT",310 ,0) | |
3816 | . I IBTQS ,('$F(STAT LIST,","_I BTQS_",")) S IBSKIP= 1 Q ; must be in the li st | |
3817 | "RTN","IBC NEKIT",311 ,0) | |
3818 | . ; | |
3819 | "RTN","IBC NEKIT",312 ,0) | |
3820 | . ; Loop thru all E ICD Verifi cations if any are D O NOT PURG E then kil l | |
3821 | "RTN","IBC NEKIT",313 ,0) | |
3822 | . ; nothi ng associa ted with i t | |
3823 | "RTN","IBC NEKIT",314 ,0) | |
3824 | . S HLIEN =0 | |
3825 | "RTN","IBC NEKIT",315 ,0) | |
3826 | . F S HL IEN=$O(^IB CN(365.1,I BTQIEN,2,H LIEN)) Q:' HLIEN!PFLA G D | |
3827 | "RTN","IBC NEKIT",316 ,0) | |
3828 | .. S DA=$ P($G(^IBCN (365.1,IBT QIEN,2,HLI EN,0)),U,3 ) Q:'DA | |
3829 | "RTN","IBC NEKIT",317 ,0) | |
3830 | .. I +$$G ET1^DIQ(36 5,DA_",",. 11,"I") S PFLAG=1 Q ;"DO NOT PURGE" | |
3831 | "RTN","IBC NEKIT",318 ,0) | |
3832 | .. S IBPU RGE("EICD" ,365,DA)=" " ; array of Verifi cations to purge (re sponses) | |
3833 | "RTN","IBC NEKIT",319 ,0) | |
3834 | . I PFLAG Q | |
3835 | "RTN","IBC NEKIT",320 ,0) | |
3836 | . S IBPUR GE("EICD", 365.1,IBTQ IEN)="" ; array of V erificatio ns to purg e (inquiri es) | |
3837 | "RTN","IBC NEKIT",321 ,0) | |
3838 | ; | |
3839 | "RTN","IBC NEKIT",322 ,0) | |
3840 | I PFLAG!I BSKIP K IB PURGE ; D O NOT PURG E is set o r Not all records ar e old enou gh | |
3841 | "RTN","IBC NEKIT",323 ,0) | |
3842 | ; | |
3843 | "RTN","IBC NEKIT",324 ,0) | |
3844 | I '$D(IBP URGE) Q ; No record s associat ed with th is entry t o purge | |
3845 | "RTN","IBC NEKIT",325 ,0) | |
3846 | S IBPURGE ("EICD",36 5.18,IBTQ1 )="" | |
3847 | "RTN","IBC NEKIT",326 ,0) | |
3848 | S FILE="" F S FILE =$O(IBPURG E("EICD",F ILE)) Q:'F ILE D | |
3849 | "RTN","IBC NEKIT",327 ,0) | |
3850 | . S DIK=" ^IBCN("_FI LE_"," | |
3851 | "RTN","IBC NEKIT",328 ,0) | |
3852 | . S DA="" F S DA=$ O(IBPURGE( "EICD",FIL E,DA)) Q:' DA D | |
3853 | "RTN","IBC NEKIT",329 ,0) | |
3854 | .. D ^DIK | |
3855 | "RTN","IBC NEKIT",330 ,0) | |
3856 | K IBPURGE ,DA,DIK | |
3857 | "RTN","IBC NEKIT",331 ,0) | |
3858 | Q | |
3859 | "RTN","IBC NEKIT",332 ,0) | |
3860 | ; | |
3861 | "RTN","IBC NERP3") | |
3862 | 0^4^B10212 8247^B7982 4613 | |
3863 | "RTN","IBC NERP3",1,0 ) | |
3864 | IBCNERP3 ; DAOU/BHS - IBCNE eIV RESPONSE REPORT PRI NT ;03-JUN -2002 | |
3865 | "RTN","IBC NERP3",2,0 ) | |
3866 | ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 528,602**; 21-MAR-94; Build 22 | |
3867 | "RTN","IBC NERP3",3,0 ) | |
3868 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3869 | "RTN","IBC NERP3",4,0 ) | |
3870 | ; | |
3871 | "RTN","IBC NERP3",5,0 ) | |
3872 | ; eIV - I nsurance V erificatio n | |
3873 | "RTN","IBC NERP3",6,0 ) | |
3874 | ; | |
3875 | "RTN","IBC NERP3",7,0 ) | |
3876 | ; Called by IBCNERP A | |
3877 | "RTN","IBC NERP3",8,0 ) | |
3878 | ; Input f rom IBCNER P1/2: | |
3879 | "RTN","IBC NERP3",9,0 ) | |
3880 | ; IBCNER TN="IBCNER P1" - Driv er rtn | |
3881 | "RTN","IBC NERP3",10, 0) | |
3882 | ; IBCNES PC("BEGDT" )=Start Dt , IBCNESP C("ENDDT") =End Dt | |
3883 | "RTN","IBC NERP3",11, 0) | |
3884 | ; IBCNES PC("PYR")= Pyr IEN OR "" for al l | |
3885 | "RTN","IBC NERP3",12, 0) | |
3886 | ; IBCNES PC("PAT")= Pat IEN OR "" for al l | |
3887 | "RTN","IBC NERP3",13, 0) | |
3888 | ; IBCNES PC("TYPE") =A (All Re sponses) O R M (Most Recent Res ponses) fo r | |
3889 | "RTN","IBC NERP3",14, 0) | |
3890 | ; uniqu e Pyr/Pt p air | |
3891 | "RTN","IBC NERP3",15, 0) | |
3892 | ; IBCNES PC("SORT") =1 (PyrNm) OR 2 (Pat Nm) | |
3893 | "RTN","IBC NERP3",16, 0) | |
3894 | ; IBCNES PC("TRCN") =Trace #^I EN, if non -null, all params nu ll | |
3895 | "RTN","IBC NERP3",17, 0) | |
3896 | ; IBCNES PC("RFLAG" )=Report F lag used t o indicate which rep ort is bei ng | |
3897 | "RTN","IBC NERP3",18, 0) | |
3898 | ; run. Response Report (0) , Inactive Report (1 ), or Ambi guous | |
3899 | "RTN","IBC NERP3",19, 0) | |
3900 | ; Repor t (2). | |
3901 | "RTN","IBC NERP3",20, 0) | |
3902 | ; IBCNES PC("DTEXP" )=Expirati on date us ed in the inactive p olicy repo rt | |
3903 | "RTN","IBC NERP3",21, 0) | |
3904 | ; IBOUT= "R" for Re port forma t or "E" f or Excel f ormat | |
3905 | "RTN","IBC NERP3",22, 0) | |
3906 | ; | |
3907 | "RTN","IBC NERP3",23, 0) | |
3908 | ; Based on structu re of eIV Response F ile (#365) | |
3909 | "RTN","IBC NERP3",24, 0) | |
3910 | ; ^TMP($ J,IBCNERTN ,S1,S2,CT, 0) based o n ^IBCN(36 5,DA,0) | |
3911 | "RTN","IBC NERP3",25, 0) | |
3912 | ; IBCN ERTN="IBCN ERP1", S1= PyrName(SO RT=1) or P atNm(SORT= 2), | |
3913 | "RTN","IBC NERP3",26, 0) | |
3914 | ; S2=P atName(SOR T=1) or Py rName(SORT =2), CT=Se q ct | |
3915 | "RTN","IBC NERP3",27, 0) | |
3916 | ; ^TMP($ J,IBCNERTN ,S1,S2,CT, 1) based o n ^IBCN(36 5,DA,1) | |
3917 | "RTN","IBC NERP3",28, 0) | |
3918 | ; ^TMP($ J,IBCNERTN ,S1,S2,2,E BCT) based on ^IBCN( 365,DA,2) | |
3919 | "RTN","IBC NERP3",29, 0) | |
3920 | ; EBCT =E/B IEN ( 365.02) | |
3921 | "RTN","IBC NERP3",30, 0) | |
3922 | ; ^TMP($ J,IBCNERTN ,S1,S2,2,E BCT,NTCT)= based on ^ IBCN(365,D A,2,EB,NT) | |
3923 | "RTN","IBC NERP3",31, 0) | |
3924 | ; NTCT= Notes Ct, may not be Notes IEN , if line wrapped (3 65.021) | |
3925 | "RTN","IBC NERP3",32, 0) | |
3926 | ; ^TMP($ J,IBCNERTN ,S1,S2,2,C NCT) based on ^IBCN( 365,DA,3) | |
3927 | "RTN","IBC NERP3",33, 0) | |
3928 | ; CNCT= Cont Pers IEN (365.0 3) | |
3929 | "RTN","IBC NERP3",34, 0) | |
3930 | ; ^TMP($ J,IBCNERTN ,S1,S2,4,C T)= err tx t based on ^IBCN(365 ,DA,4) | |
3931 | "RTN","IBC NERP3",35, 0) | |
3932 | ; CT=1/ 2 if >60 c h long | |
3933 | "RTN","IBC NERP3",36, 0) | |
3934 | ; ^TMP($ J,IBCNERTN ,S1,S2,5,C T)= based on # lines of commen ts reqd | |
3935 | "RTN","IBC NERP3",37, 0) | |
3936 | ; CT=1 to display future re transmissi on date | |
3937 | "RTN","IBC NERP3",38, 0) | |
3938 | ; Must ca ll at appr opriate ta g | |
3939 | "RTN","IBC NERP3",39, 0) | |
3940 | Q | |
3941 | "RTN","IBC NERP3",40, 0) | |
3942 | ; | |
3943 | "RTN","IBC NERP3",41, 0) | |
3944 | PRINT(RTN, BDT,EDT,PY R,PAT,TYP, SRT,PGC,PX T,MAX,CRT, TRC,EXP,IP RF,IBRDT,I BOUT) ; Pr int data | |
3945 | "RTN","IBC NERP3",42, 0) | |
3946 | ; Input: RTN="IBCEN RP1", BDT= start dt, EDT=end dt , PYR=pyr ien, | |
3947 | "RTN","IBC NERP3",43, 0) | |
3948 | ; PAT= p at ien, TY P=A/M, SRT =1/2, PGC= page ct, P XT=exit fl g, | |
3949 | "RTN","IBC NERP3",44, 0) | |
3950 | ; MAX=max line ct/p g, CRT=1/0 , TRC=trc# , EXP=earl iest expir ation date ,IBRDT=tod ay's date/ time forma tted | |
3951 | "RTN","IBC NERP3",45, 0) | |
3952 | N EORMSG, NONEMSG,SO RT1,SORT2, CNT,CNFLG, ERFLG,PRT1 ,PRT2,DISP DATA | |
3953 | "RTN","IBC NERP3",46, 0) | |
3954 | N OPRT1,O PRT2 ; Ori ginal valu es for PRT 1 and PRT2 , respecti vely | |
3955 | "RTN","IBC NERP3",47, 0) | |
3956 | S EORMSG= "*** END O F REPORT * **" | |
3957 | "RTN","IBC NERP3",48, 0) | |
3958 | S NONEMSG ="* * * N O D A T A F O U N D * * *" | |
3959 | "RTN","IBC NERP3",49, 0) | |
3960 | S (SORT1, SORT2)="" | |
3961 | "RTN","IBC NERP3",50, 0) | |
3962 | ; | |
3963 | "RTN","IBC NERP3",51, 0) | |
3964 | D PHDL:IB OUT="E" I $G(ZTSTOP) !PXT G PRI NTX | |
3965 | "RTN","IBC NERP3",52, 0) | |
3966 | ; | |
3967 | "RTN","IBC NERP3",53, 0) | |
3968 | ; If glob al does no t exist - display No Data mess age | |
3969 | "RTN","IBC NERP3",54, 0) | |
3970 | I '$D(^TM P($J,RTN)) W !,?(80- $L(NONEMSG )\2),NONEM SG,!! | |
3971 | "RTN","IBC NERP3",55, 0) | |
3972 | ; | |
3973 | "RTN","IBC NERP3",56, 0) | |
3974 | F S SORT 1=$O(^TMP( $J,RTN,SOR T1)) Q:SOR T1="" D Q:PXT!$G(Z TSTOP) | |
3975 | "RTN","IBC NERP3",57, 0) | |
3976 | . S (OPRT 1,PRT1)=$S (SORT1="~N O PAYER":" * No Payer Identifie d",1:SORT1 ) | |
3977 | "RTN","IBC NERP3",58, 0) | |
3978 | . S SORT2 ="" F S S ORT2=$O(^T MP($J,RTN, SORT1,SORT 2)) Q:SORT 2="" D Q :PXT!$G(ZT STOP) | |
3979 | "RTN","IBC NERP3",59, 0) | |
3980 | . . S (OP RT2,PRT2)= $S(SORT2=" ~NO PAYER" :"* No Pay er Identif ied",1:SOR T2) | |
3981 | "RTN","IBC NERP3",60, 0) | |
3982 | . . S CNT ="" F S C NT=$O(^TMP ($J,RTN,SO RT1,SORT2, CNT)) Q:CN T="" D Q :PXT!$G(ZT STOP) | |
3983 | "RTN","IBC NERP3",61, 0) | |
3984 | . . . I I BOUT="E" D XLDATA Q | |
3985 | "RTN","IBC NERP3",62, 0) | |
3986 | . . . D S SDB ; add SSN (from ^DPT) and DOB to pat ient heade r info | |
3987 | "RTN","IBC NERP3",63, 0) | |
3988 | . . . D H EADER | |
3989 | "RTN","IBC NERP3",64, 0) | |
3990 | . . . I $ G(ZTSTOP)! PXT Q | |
3991 | "RTN","IBC NERP3",65, 0) | |
3992 | . . . K D ISPDATA ; Init disp | |
3993 | "RTN","IBC NERP3",66, 0) | |
3994 | . . . D D ATA^IBCNER PE(.DISPDA TA),LINE(. DISPDATA) ; build/d isplay dat a | |
3995 | "RTN","IBC NERP3",67, 0) | |
3996 | ; | |
3997 | "RTN","IBC NERP3",68, 0) | |
3998 | I $G(ZTST OP)!PXT G PRINTX | |
3999 | "RTN","IBC NERP3",69, 0) | |
4000 | S (CNFLG, ERFLG)=0 | |
4001 | "RTN","IBC NERP3",70, 0) | |
4002 | I $Y+1>MA X!('PGC) D HEADER I $G(ZTSTOP) !PXT G PRI NTX | |
4003 | "RTN","IBC NERP3",71, 0) | |
4004 | W !,?(80- $L(EORMSG) \2),EORMSG | |
4005 | "RTN","IBC NERP3",72, 0) | |
4006 | PRINTX ; | |
4007 | "RTN","IBC NERP3",73, 0) | |
4008 | Q | |
4009 | "RTN","IBC NERP3",74, 0) | |
4010 | ; | |
4011 | "RTN","IBC NERP3",75, 0) | |
4012 | XLDATA ; E xcel outpu t ; 528 | |
4013 | "RTN","IBC NERP3",76, 0) | |
4014 | N PYRNM,P TNM,DFN,PT SSN,PTDOB, REFQ,REFID ,RFIDSC,PR OCD,REFID2 ,PRIDC,MLI ST,EMPST,G OVAFL,DTMP ,SRVRNK,MD ESC,RPTDAT A | |
4015 | "RTN","IBC NERP3",77, 0) | |
4016 | M RPTDATA =^TMP($J,R TN,SORT1,S ORT2,CNT) | |
4017 | "RTN","IBC NERP3",78, 0) | |
4018 | S PYRNM=$ P(RPTDATA( 0),U,3),PY RNM=$$GET1 ^DIQ(365.1 2,PYRNM,.0 1) | |
4019 | "RTN","IBC NERP3",79, 0) | |
4020 | S DFN=$P( RPTDATA(0) ,U,2),PTNM =$$GET1^DI Q(2,DFN,.0 1) | |
4021 | "RTN","IBC NERP3",80, 0) | |
4022 | S PTSSN=$ E($$GETSSN ^IBCNEDE5( DFN),6,9), PTDOB=$$GE TDOB^IBCNE DEQ(DFN) | |
4023 | "RTN","IBC NERP3",81, 0) | |
4024 | W !,$S(SR T=1:PYRNM, 1:PTNM)_U_ $S(SRT=1:P TNM,1:PYRN M)_U_PTSSN _U_PTDOB_U _$P(RPTDAT A(13),U)_U _$P(RPTDAT A(13),U,2) _U_$P(RPTD ATA(1),U,2 )_U_$P(RPT DATA(1),U, 3)_U_$P(RP TDATA(1),U ,4)_U_$P(R PTDATA(14) ,U)_U_$P(R PTDATA(14) ,U,2)_U_$P (RPTDATA(1 ),U,8) | |
4025 | "RTN","IBC NERP3",82, 0) | |
4026 | W U_RPTDA TA(8)_U_$P (RPTDATA(1 ),U,18)_U_ $P(RPTDATA (1),U,13)_ U_$P(RPTDA TA(1),U,10 )_U_$P(RPT DATA(1),U, 16)_U_$P(R PTDATA(1), U,11)_U_$P (RPTDATA(1 ),U,17) | |
4027 | "RTN","IBC NERP3",83, 0) | |
4028 | W U_$P(RP TDATA(1),U ,12)_U_$P( RPTDATA(1) ,U,19)_U_$ P(RPTDATA( 0),U,7)_U_ $P(RPTDATA (0),U,9)_U _$P(RPTDAT A(1),U,20) _U | |
4029 | "RTN","IBC NERP3",84, 0) | |
4030 | D DATA^IB CNERPE(.DI SPDATA) ; Build El ig. Ben. g lobal | |
4031 | "RTN","IBC NERP3",85, 0) | |
4032 | D GTDT | |
4033 | "RTN","IBC NERP3",86, 0) | |
4034 | W $G(REFQ )_U_$G(REF ID)_U_$G(R FIDSC)_U_$ G(PROCD)_U _$G(REFID2 )_U_$G(PRI DC)_U_$G(M LIST)_U_$G (EMPST)_U_ $G(GOVAFL) _U_$G(DTMP )_U_$G(SRV RNK)_U_$G( MDESC) | |
4035 | "RTN","IBC NERP3",87, 0) | |
4036 | Q | |
4037 | "RTN","IBC NERP3",88, 0) | |
4038 | ; | |
4039 | "RTN","IBC NERP3",89, 0) | |
4040 | GTDT ; Get Eligibili ty/Group P lan Inform ation | |
4041 | "RTN","IBC NERP3",90, 0) | |
4042 | ;^TMP("EI V RESP. EB DATA",$J, "DISP",1,0 ) | |
4043 | "RTN","IBC NERP3",91, 0) | |
4044 | ;S SEL=$$ TRIM^XLFST R($E(Y(0), 1,30),"R") | |
4045 | "RTN","IBC NERP3",92, 0) | |
4046 | N LN,OUT, DATA | |
4047 | "RTN","IBC NERP3",93, 0) | |
4048 | S (REFID, REFQ,RFIDS C,PROCD,RE FID2,PRIDC ,EMPST,MLI ST,DTMP,GO VAFL,SRVRN K,MDESC)=" " | |
4049 | "RTN","IBC NERP3",94, 0) | |
4050 | S LN=0 | |
4051 | "RTN","IBC NERP3",95, 0) | |
4052 | F S LN=$ O(^TMP("EI V RESP. EB DATA",$J, "DISP",LN) ) Q:LN="" D | |
4053 | "RTN","IBC NERP3",96, 0) | |
4054 | . S OUT=$ G(^TMP("EI V RESP. EB DATA",$J, "DISP",LN, 0)) | |
4055 | "RTN","IBC NERP3",97, 0) | |
4056 | . ; | |
4057 | "RTN","IBC NERP3",98, 0) | |
4058 | . I OUT[" Reference ID Qualifi er:" D | |
4059 | "RTN","IBC NERP3",99, 0) | |
4060 | . . S DAT A=$P(OUT," Reference ID Qualifi er:",2) | |
4061 | "RTN","IBC NERP3",100 ,0) | |
4062 | . . S REF ID=$$TRIM^ XLFSTR($P( DATA,"Refe rence ID:" ,2),"R") | |
4063 | "RTN","IBC NERP3",101 ,0) | |
4064 | . . S REF Q=$$TRIM^X LFSTR($P(D ATA,"Refer ence ID:", 1),"R") | |
4065 | "RTN","IBC NERP3",102 ,0) | |
4066 | . I OUT[" Reference ID descrip tion:" D | |
4067 | "RTN","IBC NERP3",103 ,0) | |
4068 | . . S DAT A=$P(OUT," Reference ID descrip tion:",2) | |
4069 | "RTN","IBC NERP3",104 ,0) | |
4070 | . . S RFI DSC=$$TRIM ^XLFSTR(DA TA,"R") | |
4071 | "RTN","IBC NERP3",105 ,0) | |
4072 | . I OUT[" Provider C ode:" D | |
4073 | "RTN","IBC NERP3",106 ,0) | |
4074 | . . S DAT A=$P(OUT," Provider C ode:",2) | |
4075 | "RTN","IBC NERP3",107 ,0) | |
4076 | . . S PRO CD=$$TRIM^ XLFSTR(DAT A,"R") | |
4077 | "RTN","IBC NERP3",108 ,0) | |
4078 | . I OUT[" Reference ID:" D | |
4079 | "RTN","IBC NERP3",109 ,0) | |
4080 | . . S DAT A=$P(OUT," Reference ID:",2) | |
4081 | "RTN","IBC NERP3",110 ,0) | |
4082 | . . S REF ID2=$$TRIM ^XLFSTR(DA TA,"R") | |
4083 | "RTN","IBC NERP3",111 ,0) | |
4084 | . I OUT[" Primary Di agnosis Co de:" D | |
4085 | "RTN","IBC NERP3",112 ,0) | |
4086 | . . S DAT A=$P(OUT," Primary Di agnosis Co de:",2) | |
4087 | "RTN","IBC NERP3",113 ,0) | |
4088 | . . S PRI DC=$$TRIM^ XLFSTR(DAT A,"R") | |
4089 | "RTN","IBC NERP3",114 ,0) | |
4090 | . I OUT[" Military I nfo Status :" D | |
4091 | "RTN","IBC NERP3",115 ,0) | |
4092 | . . S DAT A=$P(OUT," Military I nfo Status :",2) | |
4093 | "RTN","IBC NERP3",116 ,0) | |
4094 | . . S EMP ST=$$TRIM^ XLFSTR($P( DATA,"Empl oyment Sta tus:",2)," R") | |
4095 | "RTN","IBC NERP3",117 ,0) | |
4096 | . . S MLI ST=$$TRIM^ XLFSTR($P( DATA,"Empl oyment Sta tus:",1)," R") | |
4097 | "RTN","IBC NERP3",118 ,0) | |
4098 | . I OUT[" Government Affiliati on:" D | |
4099 | "RTN","IBC NERP3",119 ,0) | |
4100 | . . S DAT A=$P(OUT," Government Affiliati on:",2) | |
4101 | "RTN","IBC NERP3",120 ,0) | |
4102 | . . S DTM P=$$TRIM^X LFSTR($P(D ATA,"Date Time Perio d:",2),"R" ) | |
4103 | "RTN","IBC NERP3",121 ,0) | |
4104 | . . S GOV AFL=$$TRIM ^XLFSTR($P (DATA,"Dat e Time Per iod:",1)," R") | |
4105 | "RTN","IBC NERP3",122 ,0) | |
4106 | . I OUT[" Service Ra nk:" D | |
4107 | "RTN","IBC NERP3",123 ,0) | |
4108 | . . S DAT A=$P(OUT," Service Ra nk:",2) | |
4109 | "RTN","IBC NERP3",124 ,0) | |
4110 | . . S SRV RNK=$$TRIM ^XLFSTR(DA TA,"R") | |
4111 | "RTN","IBC NERP3",125 ,0) | |
4112 | . I OUT[" Desc:" D | |
4113 | "RTN","IBC NERP3",126 ,0) | |
4114 | . . S DAT A=$P(OUT," Desc:",2) | |
4115 | "RTN","IBC NERP3",127 ,0) | |
4116 | . . S MDE SC=$$TRIM^ XLFSTR(DAT A,"R") | |
4117 | "RTN","IBC NERP3",128 ,0) | |
4118 | Q | |
4119 | "RTN","IBC NERP3",129 ,0) | |
4120 | ; | |
4121 | "RTN","IBC NERP3",130 ,0) | |
4122 | HEADER ; P rint hdr i nfo | |
4123 | "RTN","IBC NERP3",131 ,0) | |
4124 | N X,Y,DIR ,DTOUT,DUO UT,OFFSET, HDR,LIN,HD R | |
4125 | "RTN","IBC NERP3",132 ,0) | |
4126 | I CRT,PGC >0,'$D(ZTQ UEUED) D I PXT G HE ADERX | |
4127 | "RTN","IBC NERP3",133 ,0) | |
4128 | . I MAX<5 1 F LIN=1: 1:(MAX-$Y) W ! | |
4129 | "RTN","IBC NERP3",134 ,0) | |
4130 | . S DIR(0 )="E" D ^D IR K DIR | |
4131 | "RTN","IBC NERP3",135 ,0) | |
4132 | . I $D(DT OUT)!($D(D UOUT)) S P XT=1 Q | |
4133 | "RTN","IBC NERP3",136 ,0) | |
4134 | I $D(ZTQU EUED),$$S^ %ZTLOAD() S ZTSTOP=1 G HEADERX | |
4135 | "RTN","IBC NERP3",137 ,0) | |
4136 | ; | |
4137 | "RTN","IBC NERP3",138 ,0) | |
4138 | S PGC=PGC +1 | |
4139 | "RTN","IBC NERP3",139 ,0) | |
4140 | W @IOF,!, ?1,$S($G(I PRF)=1:"eI V Inactive Policy Re port",$G(I PRF)=2:"eI V Ambiguou s Policy R eport",1:" eIV Respon se Report" ) I TRC'=" " W " by T race #" | |
4141 | "RTN","IBC NERP3",140 ,0) | |
4142 | ; | |
4143 | "RTN","IBC NERP3",141 ,0) | |
4144 | S HDR=IBR DT_" Page : "_PGC,OF FSET=79-$L (HDR) | |
4145 | "RTN","IBC NERP3",142 ,0) | |
4146 | W ?OFFSET ,HDR | |
4147 | "RTN","IBC NERP3",143 ,0) | |
4148 | ; | |
4149 | "RTN","IBC NERP3",144 ,0) | |
4150 | I TRC'="" S HDR="Tr ace #: "_T RC,OFFSET= 80-$L(HDR) \2 W !,?OF FSET,HDR | |
4151 | "RTN","IBC NERP3",145 ,0) | |
4152 | I TRC="" D | |
4153 | "RTN","IBC NERP3",146 ,0) | |
4154 | . W !,?1, "Sorted by : "_$S(SRT =1:"Payer" ,1:"Patien t")_" Name " | |
4155 | "RTN","IBC NERP3",147 ,0) | |
4156 | . S HDR=" Responses Displayed: "_$S(TYP= "M":"Most Recent",1: "All") | |
4157 | "RTN","IBC NERP3",148 ,0) | |
4158 | . S OFFSE T=79-$L(HD R) | |
4159 | "RTN","IBC NERP3",149 ,0) | |
4160 | . W ?OFFS ET,HDR | |
4161 | "RTN","IBC NERP3",150 ,0) | |
4162 | . I $G(IP RF)=1 W !, ?1,"Earlie st Policy Expiration Date: ",$ $FMTE^XLFD T(EXP,"5Z" ),! | |
4163 | "RTN","IBC NERP3",151 ,0) | |
4164 | . S HDR=$ $FMTE^XLFD T(BDT,"5Z" )_" - "_$$ FMTE^XLFDT (EDT,"5Z") | |
4165 | "RTN","IBC NERP3",152 ,0) | |
4166 | . S OFFSE T=80-$L(HD R)\2 | |
4167 | "RTN","IBC NERP3",153 ,0) | |
4168 | . W !,?OF FSET,HDR | |
4169 | "RTN","IBC NERP3",154 ,0) | |
4170 | . ; Disp SORT1 rng | |
4171 | "RTN","IBC NERP3",155 ,0) | |
4172 | . S HDR=" " | |
4173 | "RTN","IBC NERP3",156 ,0) | |
4174 | . I SRT=1 ,PYR="" S HDR="All P ayers" | |
4175 | "RTN","IBC NERP3",157 ,0) | |
4176 | . I SRT=2 ,PAT="" S HDR="All P atients" | |
4177 | "RTN","IBC NERP3",158 ,0) | |
4178 | . I HDR=" " D | |
4179 | "RTN","IBC NERP3",159 ,0) | |
4180 | .. I SRT =1 S HDR=$ P($G(^IBE( 365.12,PYR ,0)),U,1) Q | |
4181 | "RTN","IBC NERP3",160 ,0) | |
4182 | .. S HDR =$P($G(^DP T(PAT,0)), U,1) | |
4183 | "RTN","IBC NERP3",161 ,0) | |
4184 | . S OFFSE T=80-$L(HD R)\2 | |
4185 | "RTN","IBC NERP3",162 ,0) | |
4186 | . W !,?OF FSET,HDR | |
4187 | "RTN","IBC NERP3",163 ,0) | |
4188 | . ; Disp SORT2 rng | |
4189 | "RTN","IBC NERP3",164 ,0) | |
4190 | . S HDR=" " | |
4191 | "RTN","IBC NERP3",165 ,0) | |
4192 | . I SRT=1 ,PAT="" S HDR="All P atients" | |
4193 | "RTN","IBC NERP3",166 ,0) | |
4194 | . I SRT=2 ,PYR="" S HDR="All P ayers" | |
4195 | "RTN","IBC NERP3",167 ,0) | |
4196 | . I HDR=" " D | |
4197 | "RTN","IBC NERP3",168 ,0) | |
4198 | .. I SRT= 1 S HDR=$P ($G(^DPT(P AT,0)),U,1 ) Q | |
4199 | "RTN","IBC NERP3",169 ,0) | |
4200 | .. S HDR= $P($G(^IBE (365.12,PY R,0)),U,1) | |
4201 | "RTN","IBC NERP3",170 ,0) | |
4202 | . S OFFSE T=80-$L(HD R)\2 | |
4203 | "RTN","IBC NERP3",171 ,0) | |
4204 | . W !,?OF FSET,HDR | |
4205 | "RTN","IBC NERP3",172 ,0) | |
4206 | W ! | |
4207 | "RTN","IBC NERP3",173 ,0) | |
4208 | ; Build d isp | |
4209 | "RTN","IBC NERP3",174 ,0) | |
4210 | I SORT1'= "",SORT2'= "" D | |
4211 | "RTN","IBC NERP3",175 ,0) | |
4212 | . W !,?1, $$FO^IBCNE UT1($S(TRC '=""!(SRT= 1):" Paye r: ",1:"Pa tient: "), 9)_$E(PRT1 ,1,69) | |
4213 | "RTN","IBC NERP3",176 ,0) | |
4214 | . W !,?1, $$FO^IBCNE UT1($S(TRC '=""!(SRT= 1):"Patien t: ",1:" Payer: "), 9)_$E(PRT2 ,1,69) | |
4215 | "RTN","IBC NERP3",177 ,0) | |
4216 | . W ! | |
4217 | "RTN","IBC NERP3",178 ,0) | |
4218 | HEADERX ; | |
4219 | "RTN","IBC NERP3",179 ,0) | |
4220 | Q | |
4221 | "RTN","IBC NERP3",180 ,0) | |
4222 | ; | |
4223 | "RTN","IBC NERP3",181 ,0) | |
4224 | LINE(DISPD ATA) ; Pr int data | |
4225 | "RTN","IBC NERP3",182 ,0) | |
4226 | N LNCT,LN TOT,NWPG | |
4227 | "RTN","IBC NERP3",183 ,0) | |
4228 | S LNTOT=+ $O(DISPDAT A(""),-1) | |
4229 | "RTN","IBC NERP3",184 ,0) | |
4230 | S (CNFLG, ERFLG,NWPG )=0 | |
4231 | "RTN","IBC NERP3",185 ,0) | |
4232 | F LNCT=1: 1:LNTOT D Q:$G(ZTST OP)!PXT | |
4233 | "RTN","IBC NERP3",186 ,0) | |
4234 | . I $Y+1> MAX!('PGC) D HEADER S NWPG=1 I $G(ZTSTOP )!PXT Q | |
4235 | "RTN","IBC NERP3",187 ,0) | |
4236 | . I DISPD ATA(LNCT)= "Contact I nformation :"!(DISPDA TA(LNCT)=" Error Info rmation:") ,$Y+3>MAX S (CNFLG,E RFLG)=0 D HEADER S N WPG=1 I $G (ZTSTOP)!P XT Q | |
4237 | "RTN","IBC NERP3",188 ,0) | |
4238 | . I CNFLG ,DISPDATA( LNCT)="",$ G(DISPDATA (LNCT+1))= "Error Inf ormation:" S CNFLG=0 | |
4239 | "RTN","IBC NERP3",189 ,0) | |
4240 | . I NWPG, CNFLG W !, ?1,"Contac t Informat ion: (cont 'd)",! | |
4241 | "RTN","IBC NERP3",190 ,0) | |
4242 | . I NWPG, ERFLG W !, ?1,"Error Informatio n: (cont'd )",! | |
4243 | "RTN","IBC NERP3",191 ,0) | |
4244 | . I 'NWPG !(NWPG&(DI SPDATA(LNC T)'="")) W !,?1,DISP DATA(LNCT) | |
4245 | "RTN","IBC NERP3",192 ,0) | |
4246 | . I NWPG S NWPG=0 | |
4247 | "RTN","IBC NERP3",193 ,0) | |
4248 | . I DISPD ATA(LNCT)[ "Contact I nformation :" S ERFLG =0,CNFLG=1 | |
4249 | "RTN","IBC NERP3",194 ,0) | |
4250 | . I DISPD ATA(LNCT)[ "Error Inf ormation:" S CNFLG=0 ,ERFLG=1 | |
4251 | "RTN","IBC NERP3",195 ,0) | |
4252 | . Q | |
4253 | "RTN","IBC NERP3",196 ,0) | |
4254 | S (CNFLG, ERFLG)=0 | |
4255 | "RTN","IBC NERP3",197 ,0) | |
4256 | LINEX ; | |
4257 | "RTN","IBC NERP3",198 ,0) | |
4258 | Q | |
4259 | "RTN","IBC NERP3",199 ,0) | |
4260 | ; | |
4261 | "RTN","IBC NERP3",200 ,0) | |
4262 | SSDB ; Dis play last 4 digits o f SSN and DOB to fac ilitate pt . identifi cation | |
4263 | "RTN","IBC NERP3",201 ,0) | |
4264 | ; $$SSN^I BCNEDEQ(DF N) returns SSN follo wed by DOB | |
4265 | "RTN","IBC NERP3",202 ,0) | |
4266 | ; | |
4267 | "RTN","IBC NERP3",203 ,0) | |
4268 | N DFN | |
4269 | "RTN","IBC NERP3",204 ,0) | |
4270 | S DFN=$P( $G(^TMP($J ,RTN,SORT1 ,SORT2,CNT ,0)),U,2) | |
4271 | "RTN","IBC NERP3",205 ,0) | |
4272 | I DFN D | |
4273 | "RTN","IBC NERP3",206 ,0) | |
4274 | . I SRT=1 !TRC S PRT 2=OPRT2_$$ SSN^IBCNED EQ(DFN) Q | |
4275 | "RTN","IBC NERP3",207 ,0) | |
4276 | . S PRT1= OPRT1_$$SS N^IBCNEDEQ (DFN) | |
4277 | "RTN","IBC NERP3",208 ,0) | |
4278 | Q | |
4279 | "RTN","IBC NERP3",209 ,0) | |
4280 | ; | |
4281 | "RTN","IBC NERP3",210 ,0) | |
4282 | PHDL ; - P rint the h eader line for the E xcel sprea dsheet ; 528 | |
4283 | "RTN","IBC NERP3",211 ,0) | |
4284 | N X | |
4285 | "RTN","IBC NERP3",212 ,0) | |
4286 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
4287 | "RTN","IBC NERP3",213 ,0) | |
4288 | S EHDR=$S ($G(IPRF)= 1:"eIV Ina ctive Poli cy Report" ,$G(IPRF)= 2:"eIV Amb iguous Pol icy Report ",1:"eIV R esponse Re port") I T RC'="" S E HDR=EHDR_" ^by Trace #" | |
4289 | "RTN","IBC NERP3",214 ,0) | |
4290 | W !,EHDR_ "^"_$$FMTE ^XLFDT($$N OW^XLFDT,1 ) | |
4291 | "RTN","IBC NERP3",215 ,0) | |
4292 | ; | |
4293 | "RTN","IBC NERP3",216 ,0) | |
4294 | I TRC'="" S HDR="Tr ace #: "_T RC W !,HDR | |
4295 | "RTN","IBC NERP3",217 ,0) | |
4296 | I TRC="" D | |
4297 | "RTN","IBC NERP3",218 ,0) | |
4298 | . S EHDR= "Sorted by : "_$S(SRT =1:"Payer" ,1:"Patien t")_" Name " | |
4299 | "RTN","IBC NERP3",219 ,0) | |
4300 | . S EHDR= EHDR_"^Res ponses Dis played: "_ $S(TYP="M" :"Most Rec ent",1:"Al l") | |
4301 | "RTN","IBC NERP3",220 ,0) | |
4302 | . W !,EHD R S EHDR=" " | |
4303 | "RTN","IBC NERP3",221 ,0) | |
4304 | . I $G(IP RF)=1 W !, "Earliest Policy Exp iration Da te: ",$$FM TE^XLFDT(E XP,"5Z") | |
4305 | "RTN","IBC NERP3",222 ,0) | |
4306 | . S EHDR= $$FMTE^XLF DT(BDT,"5Z ")_" - "_$ $FMTE^XLFD T(EDT,"5Z" ) | |
4307 | "RTN","IBC NERP3",223 ,0) | |
4308 | . W !,EHD R | |
4309 | "RTN","IBC NERP3",224 ,0) | |
4310 | . ; Disp SORT1 rng | |
4311 | "RTN","IBC NERP3",225 ,0) | |
4312 | . S EHDR= "" | |
4313 | "RTN","IBC NERP3",226 ,0) | |
4314 | . I SRT=1 ,PYR="" S EHDR="All Payers" | |
4315 | "RTN","IBC NERP3",227 ,0) | |
4316 | . I SRT=2 ,PAT="" S EHDR="All Patients" | |
4317 | "RTN","IBC NERP3",228 ,0) | |
4318 | . I EHDR= "" D | |
4319 | "RTN","IBC NERP3",229 ,0) | |
4320 | .. I SRT= 1 S EHDR=$ P($G(^IBE( 365.12,PYR ,0)),U,1) Q | |
4321 | "RTN","IBC NERP3",230 ,0) | |
4322 | .. S EHDR =$P($G(^DP T(PAT,0)), U,1) | |
4323 | "RTN","IBC NERP3",231 ,0) | |
4324 | . W !,EHD R | |
4325 | "RTN","IBC NERP3",232 ,0) | |
4326 | . ; Disp SORT2 rng | |
4327 | "RTN","IBC NERP3",233 ,0) | |
4328 | . S EHDR= "" | |
4329 | "RTN","IBC NERP3",234 ,0) | |
4330 | . I SRT=1 ,PAT="" S EHDR="All Patients" | |
4331 | "RTN","IBC NERP3",235 ,0) | |
4332 | . I SRT=2 ,PYR="" S EHDR="All Payers" | |
4333 | "RTN","IBC NERP3",236 ,0) | |
4334 | . I EHDR= "" D | |
4335 | "RTN","IBC NERP3",237 ,0) | |
4336 | .. I SRT= 1 S EHDR=$ P($G(^DPT( PAT,0)),U, 1) Q | |
4337 | "RTN","IBC NERP3",238 ,0) | |
4338 | .. S EHDR =$P($G(^IB E(365.12,P YR,0)),U,1 ) | |
4339 | "RTN","IBC NERP3",239 ,0) | |
4340 | . W !,EH DR | |
4341 | "RTN","IBC NERP3",240 ,0) | |
4342 | W ! | |
4343 | "RTN","IBC NERP3",241 ,0) | |
4344 | ; Build d isp | |
4345 | "RTN","IBC NERP3",242 ,0) | |
4346 | I SORT1'= "",SORT2'= "" D | |
4347 | "RTN","IBC NERP3",243 ,0) | |
4348 | . W !,$$F O^IBCNEUT1 ($S(TRC'=" "!(SRT=1): " Payer: " ,1:"Patien t: "),9)_$ E(PRT1,1,6 9) | |
4349 | "RTN","IBC NERP3",244 ,0) | |
4350 | . W !,$$F O^IBCNEUT1 ($S(TRC'=" "!(SRT=1): "Patient: ",1:" Paye r: "),9)_$ E(PRT2,1,6 9) | |
4351 | "RTN","IBC NERP3",245 ,0) | |
4352 | . W ! | |
4353 | "RTN","IBC NERP3",246 ,0) | |
4354 | K EHDR | |
4355 | "RTN","IBC NERP3",247 ,0) | |
4356 | ; IB*602/ HN end | |
4357 | "RTN","IBC NERP3",248 ,0) | |
4358 | S PGC=1 | |
4359 | "RTN","IBC NERP3",249 ,0) | |
4360 | S X=$S(SR T=1:"Payer ",1:"Patie nt")_U_$S( SRT=1:"Pat ient",1:"P ayer")_"^P atient SSN ^Patient D OB^Subscri ber^Subscr iber ID^Su bscriber D OB^Subscri ber SSN^Su bscriber S ex^Group N ame^Group ID" | |
4361 | "RTN","IBC NERP3",250 ,0) | |
4362 | S X=X_"^W hose Insur ance^Pt Re lationship to Subscr iber^Membe r ID^COB^S ervice Dat e^Date of Death^Effe ctive Date ^Certifica tion Date^ Expiration Date^Paye r Updated Policy" | |
4363 | "RTN","IBC NERP3",251 ,0) | |
4364 | S X=X_"^R esponse Da te^Trace # ^Policy Nu mber^Refer ence ID Qu alifier^Re ference ID ^Reference ID Descri ption^Prov ider Code^ Reference ID^Primary Diagnosis Code^Mili tary Info Status" | |
4365 | "RTN","IBC NERP3",252 ,0) | |
4366 | W X | |
4367 | "RTN","IBC NERP3",253 ,0) | |
4368 | S X="^Emp loyment St atus^Gover nment Affi liation^Da te Time Pe riod^Servi ce Rank^De sc" | |
4369 | "RTN","IBC NERP3",254 ,0) | |
4370 | W X | |
4371 | "RTN","IBC NERP3",255 ,0) | |
4372 | Q | |
4373 | "RTN","IBC NERPD") | |
4374 | 0^5^B12652 3871^B1103 03722 | |
4375 | "RTN","IBC NERPD",1,0 ) | |
4376 | IBCNERPD ; DAOU/RO - eIV PAYER LINK REPOR T PRINT;AU G-2003 | |
4377 | "RTN","IBC NERPD",2,0 ) | |
4378 | ;;2.0;INT EGRATED BI LLING;**18 4,252,416, 521,528,59 5,602**;21 -MAR-94;Bu ild 22 | |
4379 | "RTN","IBC NERPD",3,0 ) | |
4380 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4381 | "RTN","IBC NERPD",4,0 ) | |
4382 | ; | |
4383 | "RTN","IBC NERPD",5,0 ) | |
4384 | ; eIV - I nsurance V erificatio n | |
4385 | "RTN","IBC NERPD",6,0 ) | |
4386 | ; | |
4387 | "RTN","IBC NERPD",7,0 ) | |
4388 | ; Called by IBCNERP B | |
4389 | "RTN","IBC NERPD",8,0 ) | |
4390 | ; Input f rom IBCNER PB/C: | |
4391 | "RTN","IBC NERPD",9,0 ) | |
4392 | ; | |
4393 | "RTN","IBC NERPD",10, 0) | |
4394 | ; ^TMP($ J,IBCNERTN ,S1,S2,CT, 0) | |
4395 | "RTN","IBC NERPD",11, 0) | |
4396 | ; IBCN ERTN="IBCN ERPB", | |
4397 | "RTN","IBC NERPD",12, 0) | |
4398 | ; CT=S eq ct | |
4399 | "RTN","IBC NERPD",13, 0) | |
4400 | ; ^TMP($ J,IBCNERTN ,S1,S2,CT, 1) | |
4401 | "RTN","IBC NERPD",14, 0) | |
4402 | ; IBOUT | |
4403 | "RTN","IBC NERPD",15, 0) | |
4404 | ; | |
4405 | "RTN","IBC NERPD",16, 0) | |
4406 | EN3(IBCNER TN,IBCNESP C) ; Entry pt. | |
4407 | "RTN","IBC NERPD",17, 0) | |
4408 | N IBTYP,I BSRT,CRT,M AXCNT,IBPX T | |
4409 | "RTN","IBC NERPD",18, 0) | |
4410 | N IBPGC,X ,Y,DIR,DTO UT,DUOUT,L IN,IBTRC,I BMAT,IBREP ,IBDET,IBP PYR,ZZ | |
4411 | "RTN","IBC NERPD",19, 0) | |
4412 | S IBREP=$ G(IBCNESPC ("REP")) | |
4413 | "RTN","IBC NERPD",20, 0) | |
4414 | S IBDET=$ G(IBCNESPC ("PDET")) | |
4415 | "RTN","IBC NERPD",21, 0) | |
4416 | S IBTYP=$ G(IBCNESPC ("PTYPE")) | |
4417 | "RTN","IBC NERPD",22, 0) | |
4418 | S IBSRT=$ G(IBCNESPC ("PSORT")) | |
4419 | "RTN","IBC NERPD",23, 0) | |
4420 | S IBPPYR= $G(IBCNESP C("PPYR")) | |
4421 | "RTN","IBC NERPD",24, 0) | |
4422 | ; Ins Rep ort | |
4423 | "RTN","IBC NERPD",25, 0) | |
4424 | I IBREP=2 D | |
4425 | "RTN","IBC NERPD",26, 0) | |
4426 | . S IBTYP =$G(IBCNES PC("ITYPE" )) | |
4427 | "RTN","IBC NERPD",27, 0) | |
4428 | . S IBSRT =$G(IBCNES PC("ISORT" )) | |
4429 | "RTN","IBC NERPD",28, 0) | |
4430 | . S IBMAT =$G(IBCNES PC("IMAT") ) | |
4431 | "RTN","IBC NERPD",29, 0) | |
4432 | S (IBPXT, IBPGC)=0 | |
4433 | "RTN","IBC NERPD",30, 0) | |
4434 | ; Determi ne IO para ms | |
4435 | "RTN","IBC NERPD",31, 0) | |
4436 | I "^R^E^" '[(U_$G(IB OUT)_U) S IBOUT="R" | |
4437 | "RTN","IBC NERPD",32, 0) | |
4438 | I IOST["C -" S MAXCN T=IOSL-3,C RT=1 | |
4439 | "RTN","IBC NERPD",33, 0) | |
4440 | E S MAXC NT=IOSL-6, CRT=0 | |
4441 | "RTN","IBC NERPD",34, 0) | |
4442 | D PRINT(I BCNERTN,IB REP,IBDET, IBTYP,IBSR T,.IBPGC,. IBPXT,MAXC NT,CRT,IBO UT) | |
4443 | "RTN","IBC NERPD",35, 0) | |
4444 | I $G(ZTST OP)!IBPXT G EXIT3 | |
4445 | "RTN","IBC NERPD",36, 0) | |
4446 | I CRT,IBP GC>0,'$D(Z TQUEUED) D | |
4447 | "RTN","IBC NERPD",37, 0) | |
4448 | . I MAXCN T<51 F LIN =1:1:(MAXC NT-$Y) W ! | |
4449 | "RTN","IBC NERPD",38, 0) | |
4450 | . S DIR(0 )="E" D ^D IR K DIR | |
4451 | "RTN","IBC NERPD",39, 0) | |
4452 | EXIT3 ; Ex it pt | |
4453 | "RTN","IBC NERPD",40, 0) | |
4454 | Q | |
4455 | "RTN","IBC NERPD",41, 0) | |
4456 | ; | |
4457 | "RTN","IBC NERPD",42, 0) | |
4458 | PRINT(RTN, REP,DET,TY P,SRT,PGC, PXT,MAX,CR T,IBOUT) ; Print dat a | |
4459 | "RTN","IBC NERPD",43, 0) | |
4460 | ; Input: RTN="IBCEN RPB", PGC= page ct, | |
4461 | "RTN","IBC NERPD",44, 0) | |
4462 | ; PXT=e xit flg, M AX=max lin e ct/pg, | |
4463 | "RTN","IBC NERPD",45, 0) | |
4464 | ; CRT=1/ 0, IBOUT=" R"/"E" | |
4465 | "RTN","IBC NERPD",46, 0) | |
4466 | N EORMSG, NONEMSG,SO RT1,SORT2, CNT,DASH | |
4467 | "RTN","IBC NERPD",47, 0) | |
4468 | S EORMSG= "*** END O F REPORT * **" | |
4469 | "RTN","IBC NERPD",48, 0) | |
4470 | S NONEMSG ="* * * N O D A T A F O U N D * * *" | |
4471 | "RTN","IBC NERPD",49, 0) | |
4472 | S (SORT1, SORT2)="", $P(DASH,"- ",133)="" | |
4473 | "RTN","IBC NERPD",50, 0) | |
4474 | ; | |
4475 | "RTN","IBC NERPD",51, 0) | |
4476 | ;Excel he ader | |
4477 | "RTN","IBC NERPD",52, 0) | |
4478 | I IBOUT=" E" D PHDL | |
4479 | "RTN","IBC NERPD",53, 0) | |
4480 | ; | |
4481 | "RTN","IBC NERPD",54, 0) | |
4482 | I '$D(^TM P($J,RTN)) D HEADER: (IBOUT="R" ) W !,?(80 -$L(NONEMS G)\2),NONE MSG,!! | |
4483 | "RTN","IBC NERPD",55, 0) | |
4484 | F S SORT 1=$O(^TMP( $J,RTN,SOR T1)) Q:SOR T1="" D Q:PXT!$G(Z TSTOP) | |
4485 | "RTN","IBC NERPD",56, 0) | |
4486 | . S SORT2 ="" F S S ORT2=$O(^T MP($J,RTN, SORT1,SORT 2)) Q:SORT 2="" D Q :PXT!$G(ZT STOP) | |
4487 | "RTN","IBC NERPD",57, 0) | |
4488 | . . S CNT ="" F S C NT=$O(^TMP ($J,RTN,SO RT1,SORT2, CNT)) Q:CN T="" D Q :PXT!$G(ZT STOP) | |
4489 | "RTN","IBC NERPD",58, 0) | |
4490 | . . . K D ISPDATA ; Init disp | |
4491 | "RTN","IBC NERPD",59, 0) | |
4492 | . . . D D ATA(.DISPD ATA),LINE( .DISPDATA) ; build/ display da ta | |
4493 | "RTN","IBC NERPD",60, 0) | |
4494 | ; | |
4495 | "RTN","IBC NERPD",61, 0) | |
4496 | I $G(ZTST OP)!PXT G PRINTX | |
4497 | "RTN","IBC NERPD",62, 0) | |
4498 | I IBOUT=" R" D | |
4499 | "RTN","IBC NERPD",63, 0) | |
4500 | . I $Y+1> MAX!('PGC) D HEADER I $G(ZTSTO P)!PXT G P RINTX | |
4501 | "RTN","IBC NERPD",64, 0) | |
4502 | W !,?(80- $L(EORMSG) \2),EORMSG | |
4503 | "RTN","IBC NERPD",65, 0) | |
4504 | PRINTX ; | |
4505 | "RTN","IBC NERPD",66, 0) | |
4506 | Q | |
4507 | "RTN","IBC NERPD",67, 0) | |
4508 | ; | |
4509 | "RTN","IBC NERPD",68, 0) | |
4510 | HEADER ; P rint hdr i nfo | |
4511 | "RTN","IBC NERPD",69, 0) | |
4512 | N X,Y,DIR ,DTOUT,DUO UT,OFFSET, HDR,LIN,HD R | |
4513 | "RTN","IBC NERPD",70, 0) | |
4514 | I CRT,PGC >0,'$D(ZTQ UEUED) D I PXT G HE ADERX | |
4515 | "RTN","IBC NERPD",71, 0) | |
4516 | . I MAX<5 1 F LIN=1: 1:(MAX-$Y) W ! | |
4517 | "RTN","IBC NERPD",72, 0) | |
4518 | . S DIR(0 )="E" D ^D IR K DIR | |
4519 | "RTN","IBC NERPD",73, 0) | |
4520 | . I $D(DT OUT)!($D(D UOUT)) S P XT=1 Q | |
4521 | "RTN","IBC NERPD",74, 0) | |
4522 | I $D(ZTQU EUED),$$S^ %ZTLOAD() S ZTSTOP=1 G HEADERX | |
4523 | "RTN","IBC NERPD",75, 0) | |
4524 | S PGC=PGC +1 | |
4525 | "RTN","IBC NERPD",76, 0) | |
4526 | W @IOF,!, ?1,"eIV Pa yer Link R eport" | |
4527 | "RTN","IBC NERPD",77, 0) | |
4528 | S HDR=$$F MTE^XLFDT( $$NOW^XLFD T,1)_" Pa ge: "_PGC, OFFSET=131 -$L(HDR) | |
4529 | "RTN","IBC NERPD",78, 0) | |
4530 | W ?OFFSET ,HDR | |
4531 | "RTN","IBC NERPD",79, 0) | |
4532 | W !,?1,"R eport Opti on: "_$S(R EP=1:"Paye r List",1: "Insurance Company L ist") | |
4533 | "RTN","IBC NERPD",80, 0) | |
4534 | I REP=1 D | |
4535 | "RTN","IBC NERPD",81, 0) | |
4536 | . S HDR=$ S(TYP=1:"U nlinked Pa yers Only" ,TYP=2:"Li nked Payer s Only",1: "All Payer s") | |
4537 | "RTN","IBC NERPD",82, 0) | |
4538 | . I TYP=3 S HDR=HDR _", "_$S(D ET=1:"With Ins. Co. Detail",1: "Without I ns. Co. De tail") | |
4539 | "RTN","IBC NERPD",83, 0) | |
4540 | I REP=2 D | |
4541 | "RTN","IBC NERPD",84, 0) | |
4542 | . S HDR=$ S(TYP=1:"U nlinked In surance Co mpanies On ly",TYP=2: "Linked In surance Co mpanies On ly",1:"All Insurance Companies ") | |
4543 | "RTN","IBC NERPD",85, 0) | |
4544 | S OFFSET= 79-$L(HDR) | |
4545 | "RTN","IBC NERPD",86, 0) | |
4546 | W ?OFFSET ,HDR | |
4547 | "RTN","IBC NERPD",87, 0) | |
4548 | ; IB*2.0* 521 add va lidated HP ID to repo rt | |
4549 | "RTN","IBC NERPD",88, 0) | |
4550 | I REP=2 W !,"'*' in dicates th e Insuranc e Company HPID/OEID failed val idation ch ecks" | |
4551 | "RTN","IBC NERPD",89, 0) | |
4552 | I REP=1,D ET=1 W !," '*' indica tes the Li nked Insur ance Compa ny HPID/OE ID failed validation checks" | |
4553 | "RTN","IBC NERPD",90, 0) | |
4554 | W ! | |
4555 | "RTN","IBC NERPD",91, 0) | |
4556 | I REP=1 D | |
4557 | "RTN","IBC NERPD",92, 0) | |
4558 | . I IBPPY R'="" W ?1 ,"For Sing le Payer: ",$P(IBPPY R,"^",2) | |
4559 | "RTN","IBC NERPD",93, 0) | |
4560 | . ; IB*2. 0*528 add Trusted fl ag to repo rt | |
4561 | "RTN","IBC NERPD",94, 0) | |
4562 | . ;W !?39 ,"National ",?54,"# L inked",?64 ,"National ly",?77,"L ocally",?8 7,"Prof.", ?104,"Inst ." W:DET=1 ?121,"HPI D/" | |
4563 | "RTN","IBC NERPD",95, 0) | |
4564 | . ;W !,"P ayer Name: ",?39,"Pay er ID",?54 ,"Ins. Co. ",?65,"Act ive?",?77, "Active?", ?87,"EDI#" ,?104,"EDI #" W:DET=1 ?121,"OEI D" | |
4565 | "RTN","IBC NERPD",96, 0) | |
4566 | . W !?31, "National" ,?46,"# Li nked",?56, "Nationall y",?69,"Lo cally",?78 ,"FSC",?87 ,"Prof.",? 104,"Inst. " W:DET=1 ?121,"HPID /" | |
4567 | "RTN","IBC NERPD",97, 0) | |
4568 | . W !,"Pa yer Name:" ,?31,"Paye r ID",?46, "Ins. Co." ,?57,"Acti ve?",?69," Active?",? 78,"Truste d?",?87,"E DI#",?104, "EDI#" W:D ET=1 ?121, "OEID" | |
4569 | "RTN","IBC NERPD",98, 0) | |
4570 | I REP=2 D | |
4571 | "RTN","IBC NERPD",99, 0) | |
4572 | . I IBMAT '="" W ?1, "Only Insu rance Comp anies that match: ", IBMAT | |
4573 | "RTN","IBC NERPD",100 ,0) | |
4574 | . ; IB*2. 0*528 add Trusted fl ag and Num ber of Act ive Groups to report | |
4575 | "RTN","IBC NERPD",101 ,0) | |
4576 | . ;W !?56 ,"Nat.",?7 1,"Loc.",? 83,"Prof." ,?104,"Ins t.",?121," HPID/" | |
4577 | "RTN","IBC NERPD",102 ,0) | |
4578 | . ;W !,"I nsurance C ompany:",? 56,"Act?", ?71,"Act?" ,?83,"EDI# ",?104,"ED I#",?121," OEID" | |
4579 | "RTN","IBC NERPD",103 ,0) | |
4580 | . W !?32, "# Active" ,?56,"Nat. ",?66,"Loc .",?73,"FS C",?83,"Pr of.",?104, "Inst.",?1 21,"HPID/" | |
4581 | "RTN","IBC NERPD",104 ,0) | |
4582 | . W !,"In surance Co mpany:",?3 3,"Groups" ,?56,"Act? ",?66,"Act ?",?73,"Tr usted?",?8 3,"EDI#",? 104,"EDI#" ,?121,"OEI D" | |
4583 | "RTN","IBC NERPD",105 ,0) | |
4584 | . I TYP'= 1 W !," Payer:",?4 4,"VA ID" | |
4585 | "RTN","IBC NERPD",106 ,0) | |
4586 | W !,DASH | |
4587 | "RTN","IBC NERPD",107 ,0) | |
4588 | HEADERX ; | |
4589 | "RTN","IBC NERPD",108 ,0) | |
4590 | Q | |
4591 | "RTN","IBC NERPD",109 ,0) | |
4592 | ; | |
4593 | "RTN","IBC NERPD",110 ,0) | |
4594 | LINE(DISPD ATA) ; Pr int data | |
4595 | "RTN","IBC NERPD",111 ,0) | |
4596 | N LNCT,LN TOT,NWPG | |
4597 | "RTN","IBC NERPD",112 ,0) | |
4598 | S LNTOT=+ $O(DISPDAT A(""),-1) | |
4599 | "RTN","IBC NERPD",113 ,0) | |
4600 | S NWPG=0 | |
4601 | "RTN","IBC NERPD",114 ,0) | |
4602 | F LNCT=1: 1:LNTOT D Q:$G(ZTST OP)!PXT | |
4603 | "RTN","IBC NERPD",115 ,0) | |
4604 | . I IBOUT ="R" D | |
4605 | "RTN","IBC NERPD",116 ,0) | |
4606 | . . I $Y+ 1>MAX!('PG C) D HEADE R S NWPG=1 I $G(ZTST OP)!PXT Q | |
4607 | "RTN","IBC NERPD",117 ,0) | |
4608 | . W ! W:I BOUT="R" ? 1 W DISPDA TA(LNCT) Q | |
4609 | "RTN","IBC NERPD",118 ,0) | |
4610 | . I 'NWPG !(NWPG&(DI SPDATA(LNC T)'="")) W !,?1,DISP DATA(LNCT) | |
4611 | "RTN","IBC NERPD",119 ,0) | |
4612 | . I NWPG S NWPG=0 | |
4613 | "RTN","IBC NERPD",120 ,0) | |
4614 | . Q | |
4615 | "RTN","IBC NERPD",121 ,0) | |
4616 | LINEX Q | |
4617 | "RTN","IBC NERPD",122 ,0) | |
4618 | ; | |
4619 | "RTN","IBC NERPD",123 ,0) | |
4620 | DATA(DISPD ATA) ; Bu ild disp l ines | |
4621 | "RTN","IBC NERPD",124 ,0) | |
4622 | N LCT,CT, CT2,RPTDAT A,WW,XX,YY ,ZZ,IBHPD | |
4623 | "RTN","IBC NERPD",125 ,0) | |
4624 | ; Merge i nto local array | |
4625 | "RTN","IBC NERPD",126 ,0) | |
4626 | M RPTDATA =^TMP($J,R TN,SORT1,S ORT2,CNT) | |
4627 | "RTN","IBC NERPD",127 ,0) | |
4628 | ; Build | |
4629 | "RTN","IBC NERPD",128 ,0) | |
4630 | ; | |
4631 | "RTN","IBC NERPD",129 ,0) | |
4632 | ; PAYER R EPORT | |
4633 | "RTN","IBC NERPD",130 ,0) | |
4634 | I REP=1 D | |
4635 | "RTN","IBC NERPD",131 ,0) | |
4636 | . ; Excel format | |
4637 | "RTN","IBC NERPD",132 ,0) | |
4638 | . I IBOUT ="E" D Q | |
4639 | "RTN","IBC NERPD",133 ,0) | |
4640 | . . ; IB* 2*595/DM f or Excel, properly d isplay the locally a ctive stat us | |
4641 | "RTN","IBC NERPD",134 ,0) | |
4642 | . . S LCT =0,DISPDAT A(1)=SORT2 _U_$P(RPTD ATA,U)_U_$ P(RPTDATA, U,6)_U_$S( $P(RPTDATA ,U,4)=1:"Y ES",1:"NO" )_U_$S($P( RPTDATA,U, 5)=1:"YES" ,1:"NO")_U _$P(RPTDAT A,U,7)_U_$ P(RPTDATA, U,2)_U_$P( RPTDATA,U, 3) | |
4643 | "RTN","IBC NERPD",135 ,0) | |
4644 | . . I DET =1 S WW=DI SPDATA(1) D DET | |
4645 | "RTN","IBC NERPD",136 ,0) | |
4646 | . ; | |
4647 | "RTN","IBC NERPD",137 ,0) | |
4648 | . ; 1st l ine is pay er | |
4649 | "RTN","IBC NERPD",138 ,0) | |
4650 | . ; IB*2. 0*528 add Trusted fl ag to repo rt | |
4651 | "RTN","IBC NERPD",139 ,0) | |
4652 | . ;S LCT= 1,DISPDATA (1)=$$FO^I BCNEUT1(SO RT2,35,"L" )_" "_$$ FO^IBCNEUT 1($P(RPTDA TA,U,1),10 ,"L")_" "_$$FO^I BCNEUT1($P (RPTDATA,U ,6),5,"R") _" "_$$FO^IBC NEUT1($S($ P(RPTDATA, U,4)=1:"YE S",1:"NO") ,12,"L") | |
4653 | "RTN","IBC NERPD",140 ,0) | |
4654 | . ;S DISP DATA(1)=DI SPDATA(1)_ $$FO^IBCNE UT1($S($P( RPTDATA,U, 5)=1:"YES" ,1:"NO"),8 ,"L")_$$FO ^IBCNEUT1( $P(RPTDATA ,U,2),16," L")_" "_$$ FO^IBCNEUT 1($P(RPTDA TA,U,3),16 ,"L") | |
4655 | "RTN","IBC NERPD",141 ,0) | |
4656 | . S LCT=1 ,DISPDATA( 1)=$$FO^IB CNEUT1(SOR T2,27,"L") _" "_$$F O^IBCNEUT1 ($P(RPTDAT A,U,1),10, "L")_" "_$$FO^IB CNEUT1($P( RPTDATA,U, 6),5,"R")_ " " _$$FO^IBCN EUT1($S($P (RPTDATA,U ,4)=1:"YES ",1:"NO"), 12,"L") | |
4657 | "RTN","IBC NERPD",142 ,0) | |
4658 | . S DISPD ATA(1)=DIS PDATA(1)_$ $FO^IBCNEU T1($S($P(R PTDATA,U,5 )=1:"YES", 1:"NO"),9, "L")_$$FO^ IBCNEUT1($ P(RPTDATA, U,7),7,"L" )_$$FO^IBC NEUT1($P(R PTDATA,U,2 ),16,"L")_ " "_$$FO^I BCNEUT1($P (RPTDATA,U ,3),16,"L" ) | |
4659 | "RTN","IBC NERPD",143 ,0) | |
4660 | . ; See i f detail i s required | |
4661 | "RTN","IBC NERPD",144 ,0) | |
4662 | . I DET=1 D | |
4663 | "RTN","IBC NERPD",145 ,0) | |
4664 | . . I $O( RPTDATA("" ))'="" S L CT=LCT+1,D ISPDATA(LC T)=" Lin ked Insura nce Compan ies:" | |
4665 | "RTN","IBC NERPD",146 ,0) | |
4666 | . . S (XX ,YY,ZZ)="" F S XX=$ O(RPTDATA( XX)) Q:XX= "" F S Y Y=$O(RPTDA TA(XX,YY)) Q:YY="" D | |
4667 | "RTN","IBC NERPD",147 ,0) | |
4668 | . . . S Z Z=RPTDATA( XX,YY) | |
4669 | "RTN","IBC NERPD",148 ,0) | |
4670 | . . . S L CT=LCT+1,D ISPDATA(LC T)=" "_$ $FO^IBCNEU T1(XX,35," L")_" "_$ $FO^IBCNEU T1($P(ZZ,U ,1),20,"L" )_" "_$E($ P(ZZ,U,4), 1,15) | |
4671 | "RTN","IBC NERPD",149 ,0) | |
4672 | . . . ; d on't displ ay ','s if no addres s/state on file | |
4673 | "RTN","IBC NERPD",150 ,0) | |
4674 | . . . I $ P(ZZ,U,5)' ="" S DISP DATA(LCT)= DISPDATA(L CT)_", "_$ P($G(^DIC( 5,$P(ZZ,U, 5)+0,0)),U ,2) | |
4675 | "RTN","IBC NERPD",151 ,0) | |
4676 | . . . ; I B*2.0*521 add valida ted HPID t o report | |
4677 | "RTN","IBC NERPD",152 ,0) | |
4678 | . . . S I BHPD=$$HPD ^IBCNHUT1( YY,1) | |
4679 | "RTN","IBC NERPD",153 ,0) | |
4680 | . . . ;S DISPDATA(L CT)=DISPDA TA(LCT)_$$ FO^IBCNEUT 1(" ",93-$ L(DISPDATA (LCT)),"L" ) | |
4681 | "RTN","IBC NERPD",154 ,0) | |
4682 | . . . S D ISPDATA(LC T)=DISPDAT A(LCT)_$$F O^IBCNEUT1 (" ",86-$L (DISPDATA( LCT)),"L") | |
4683 | "RTN","IBC NERPD",155 ,0) | |
4684 | . . . ; d isplay EDI #'s | |
4685 | "RTN","IBC NERPD",156 ,0) | |
4686 | . . . ;S DISPDATA(L CT)=DISPDA TA(LCT)_$$ FO^IBCNEUT 1($P(ZZ,U, 7),16,"L") _" "_$ $FO^IBCNEU T1($P(ZZ,U ,8),16,"L" ) | |
4687 | "RTN","IBC NERPD",157 ,0) | |
4688 | . . . S D ISPDATA(LC T)=DISPDAT A(LCT)_$$F O^IBCNEUT1 ($P(ZZ,U,7 ),16,"L")_ " "_$$FO^I BCNEUT1($P (ZZ,U,8),1 6,"L")_" " _IBHPD | |
4689 | "RTN","IBC NERPD",158 ,0) | |
4690 | ; | |
4691 | "RTN","IBC NERPD",159 ,0) | |
4692 | ; Insuran ce Company Report | |
4693 | "RTN","IBC NERPD",160 ,0) | |
4694 | I REP=2 D | |
4695 | "RTN","IBC NERPD",161 ,0) | |
4696 | . ; Excel format | |
4697 | "RTN","IBC NERPD",162 ,0) | |
4698 | . I IBOUT ="E" D Q | |
4699 | "RTN","IBC NERPD",163 ,0) | |
4700 | . . ;S LC T=1,DISPDA TA(1)=SORT 2_U_$P(RPT DATA,U,1)_ U_$P(RPTDA TA,U,6)_U_ $S($P(RPTD ATA,U,4)=1 :"YES",1:" NO")_U_$S( $P(RPTDATA ,U,4)=1:"Y ES",1:"NO" )_U_$P(RPT DATA,U,7)_ U_$P(RPTDA TA,U,2)_U_ $P(RPTDATA ,U,3) | |
4701 | "RTN","IBC NERPD",164 ,0) | |
4702 | . . S LCT =1,DISPDAT A(1)=SORT2 _U_$P(RPTD ATA,U,10)_ U_$P(RPTDA TA,U,13) | |
4703 | "RTN","IBC NERPD",165 ,0) | |
4704 | . . I $P( RPTDATA,U, 14)'="" S DISPDATA(1 )=DISPDATA (1)_", "_$ P($G(^DIC( 5,$P(RPTDA TA,U,14)+0 ,0)),U,2)_ " "_$P(RPT DATA,U,15) | |
4705 | "RTN","IBC NERPD",166 ,0) | |
4706 | . . S IBH PD=$$HPD^I BCNHUT1(CN T,1),ZZ=$P (RPTDATA," ~",2) | |
4707 | "RTN","IBC NERPD",167 ,0) | |
4708 | . . S DIS PDATA(1)=D ISPDATA(1) _U_$P(RPTD ATA,U,8)_U _$P(ZZ,U,2 )_U_$P(ZZ, U,4)_U_IBH PD_U | |
4709 | "RTN","IBC NERPD",168 ,0) | |
4710 | . . I $P( RPTDATA,U) ="" S:TYP' =1 DISPDAT A(1)=DISPD ATA(1)_"** NOT CURRE NTLY LINKE D **" Q | |
4711 | "RTN","IBC NERPD",169 ,0) | |
4712 | . . S DIS PDATA(1)=D ISPDATA(1) _$P(RPTDAT A,U,1,2)_U _$S($P(RPT DATA,U,5)= 1:"YES",1: "NO")_U_$S ($P(RPTDAT A,U,6)=1:" YES",1:"NO ")_U_$P(RP TDATA,U,9) _U_$P(RPTD ATA,U,3,4) | |
4713 | "RTN","IBC NERPD",170 ,0) | |
4714 | . ; | |
4715 | "RTN","IBC NERPD",171 ,0) | |
4716 | . ; Ins c arrier | |
4717 | "RTN","IBC NERPD",172 ,0) | |
4718 | . ; IB*2. 0*528 add number of active gro ups to rep ort | |
4719 | "RTN","IBC NERPD",173 ,0) | |
4720 | . S DISPD ATA(1)=$$F O^IBCNEUT1 (SORT2,30, "L")_" "_ $$FO^IBCNE UT1($P(RPT DATA,U,8), 5,"R")_$$F O^IBCNEUT1 (" ",45,"L ") | |
4721 | "RTN","IBC NERPD",174 ,0) | |
4722 | . ; Ins a ddress | |
4723 | "RTN","IBC NERPD",175 ,0) | |
4724 | . S IBHPD =$$HPD^IBC NHUT1(CNT, 1) | |
4725 | "RTN","IBC NERPD",176 ,0) | |
4726 | . S ZZ=$P (RPTDATA," ~",2),DISP DATA(1)=DI SPDATA(1)_ $$FO^IBCNE UT1($P(ZZ, U,2),16,"L ")_" " _$$FO^IBCN EUT1($P(ZZ ,U,4),16," L")_" "_IB HPD | |
4727 | "RTN","IBC NERPD",177 ,0) | |
4728 | . S DISPD ATA(2)=" "_$P (RPTDATA,U ,10)_" "_ $P(RPTDATA ,U,13) | |
4729 | "RTN","IBC NERPD",178 ,0) | |
4730 | . ; Add s tate/zip i f defined | |
4731 | "RTN","IBC NERPD",179 ,0) | |
4732 | . I $P(RP TDATA,U,14 )'="" S DI SPDATA(2)= DISPDATA(2 )_", "_$P( $G(^DIC(5, $P(RPTDATA ,U,14)+0,0 )),U,2)_" "_$$FO^IBC NEUT1($P(R PTDATA,U,1 5),5,"L") | |
4733 | "RTN","IBC NERPD",180 ,0) | |
4734 | . ; if no payer is linked AND displayin g payers | |
4735 | "RTN","IBC NERPD",181 ,0) | |
4736 | . I $P(RP TDATA,U)=" ",TYP'=1 S DISPDATA( 3)=" ** NOT CURREN TLY LINKED **",LCT=4 ,DISPDATA( 4)=" " Q | |
4737 | "RTN","IBC NERPD",182 ,0) | |
4738 | . ; if no payer and not displ aying then quit | |
4739 | "RTN","IBC NERPD",183 ,0) | |
4740 | . I $P(RP TDATA,U)=" " S LCT=3, DISPDATA(3 )=" " Q | |
4741 | "RTN","IBC NERPD",184 ,0) | |
4742 | . ; Displ ay Payer I nfo Line | |
4743 | "RTN","IBC NERPD",185 ,0) | |
4744 | . S DISPD ATA(3)=" "_$$FO^IBC NEUT1($P(R PTDATA,U,1 ),35,"L")_ " "_$ $FO^IBCNEU T1($P(RPTD ATA,U,2),1 2,"L")_$$F O^IBCNEUT1 ($S($P(RPT DATA,U,5)= 1:"YES",1: "NO"),10," L") | |
4745 | "RTN","IBC NERPD",186 ,0) | |
4746 | . ; IB*2. 0*528 add Trusted fl ag to repo rt | |
4747 | "RTN","IBC NERPD",187 ,0) | |
4748 | . ;S DISP DATA(3)=DI SPDATA(3)_ $$FO^IBCNE UT1($S($P( RPTDATA,U, 6)=1:"YES" ,1:"NO"),1 2,"L")_$$F O^IBCNEUT1 ($P(RPTDAT A,U,4),16, "L")_" "_$$FO^IB CNEUT1($P( RPTDATA,U, 4),16,"L") | |
4749 | "RTN","IBC NERPD",188 ,0) | |
4750 | . S DISPD ATA(3)=DIS PDATA(3)_$ $FO^IBCNEU T1($S($P(R PTDATA,U,6 )=1:"YES", 1:"NO"),7, "L")_$$FO^ IBCNEUT1($ P(RPTDATA, U,9),10,"L ")_$$FO^IB CNEUT1($P( RPTDATA,U, 3),16,"L") _" "_$ $FO^IBCNEU T1($P(RPTD ATA,U,4),1 6,"L") | |
4751 | "RTN","IBC NERPD",189 ,0) | |
4752 | . S LCT=4 ,DISPDATA( 4)=" " | |
4753 | "RTN","IBC NERPD",190 ,0) | |
4754 | S LCT=LCT +1 | |
4755 | "RTN","IBC NERPD",191 ,0) | |
4756 | Q | |
4757 | "RTN","IBC NERPD",192 ,0) | |
4758 | ; | |
4759 | "RTN","IBC NERPD",193 ,0) | |
4760 | DET ; - Pr int insura nce compan y detail i n Excel Pa yer report | |
4761 | "RTN","IBC NERPD",194 ,0) | |
4762 | S (XX,YY, ZZ)="" F S XX=$O(RP TDATA(XX)) Q:XX="" F S YY=$O (RPTDATA(X X,YY)) Q:Y Y="" D | |
4763 | "RTN","IBC NERPD",195 ,0) | |
4764 | . S ZZ=RP TDATA(XX,Y Y) | |
4765 | "RTN","IBC NERPD",196 ,0) | |
4766 | . S LCT=L CT+1,DISPD ATA(LCT)=W W_U_XX_U_$ P(ZZ,U,1)_ U_$P(ZZ,U, 4) | |
4767 | "RTN","IBC NERPD",197 ,0) | |
4768 | . I $P(ZZ ,U,5)'="" S DISPDATA (LCT)=DISP DATA(LCT)_ ", "_$P($G (^DIC(5,$P (ZZ,U,5)+0 ,0)),U,2) | |
4769 | "RTN","IBC NERPD",198 ,0) | |
4770 | . S IBHPD =$$HPD^IBC NHUT1(YY,1 ) | |
4771 | "RTN","IBC NERPD",199 ,0) | |
4772 | . S DISPD ATA(LCT)=D ISPDATA(LC T)_U_$P(ZZ ,U,7)_U_$P (ZZ,U,8)_U _IBHPD | |
4773 | "RTN","IBC NERPD",200 ,0) | |
4774 | Q | |
4775 | "RTN","IBC NERPD",201 ,0) | |
4776 | ; | |
4777 | "RTN","IBC NERPD",202 ,0) | |
4778 | PHDL ; - P rint the h eader line for the E xcel sprea dsheet | |
4779 | "RTN","IBC NERPD",203 ,0) | |
4780 | N X | |
4781 | "RTN","IBC NERPD",204 ,0) | |
4782 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
4783 | "RTN","IBC NERPD",205 ,0) | |
4784 | S X="eIV Payer Link Report^"_ $$FMTE^XLF DT($$NOW^X LFDT,1) | |
4785 | "RTN","IBC NERPD",206 ,0) | |
4786 | W X | |
4787 | "RTN","IBC NERPD",207 ,0) | |
4788 | S X="Repo rt Option: "_$S(REP= 1:"Payer L ist",1:"In surance Co mpany List ") | |
4789 | "RTN","IBC NERPD",208 ,0) | |
4790 | W !,X | |
4791 | "RTN","IBC NERPD",209 ,0) | |
4792 | I REP=1 D | |
4793 | "RTN","IBC NERPD",210 ,0) | |
4794 | . S HDR=$ S(TYP=1:"U nlinked Pa yers Only" ,TYP=2:"Li nked Payer s Only",1: "All Payer s") | |
4795 | "RTN","IBC NERPD",211 ,0) | |
4796 | . I TYP=3 S HDR=HDR _"^"_$S(DE T=1:"With Ins. Co. D etail",1:" Without In s. Co. Det ail") | |
4797 | "RTN","IBC NERPD",212 ,0) | |
4798 | I REP=2 D | |
4799 | "RTN","IBC NERPD",213 ,0) | |
4800 | . S HDR=$ S(TYP=1:"U nlinked In surance Co mpanies On ly",TYP=2: "Linked In surance Co mpanies On ly",1:"All Insurance Companies ") | |
4801 | "RTN","IBC NERPD",214 ,0) | |
4802 | W "^"_HDR | |
4803 | "RTN","IBC NERPD",215 ,0) | |
4804 | I REP=2 W !,"'*' in dicates th e Insuranc e Company HPID/OEID failed val idation ch ecks" | |
4805 | "RTN","IBC NERPD",216 ,0) | |
4806 | I REP=1,D ET=1 W !," '*' indica tes the Li nked Insur ance Compa ny HPID/OE ID failed validation checks" | |
4807 | "RTN","IBC NERPD",217 ,0) | |
4808 | I REP=1,I BPPYR'="" W !,"For S ingle Paye r:"_"^"_$P (IBPPYR,"^ ",2) | |
4809 | "RTN","IBC NERPD",218 ,0) | |
4810 | I REP=2,I BMAT'="" W !,"Only I nsurance C ompanies t hat match: "_"^"_IBMA T | |
4811 | "RTN","IBC NERPD",219 ,0) | |
4812 | ; IB*602/ HN end | |
4813 | "RTN","IBC NERPD",220 ,0) | |
4814 | I REP=1 D | |
4815 | "RTN","IBC NERPD",221 ,0) | |
4816 | .S X="Pay er Name^Na tional Pay er ID^# Li nked Ins. Co.^Nation ally Activ e?^Locally Active?^F SC Trusted ?^Professi onal EDI#^ Institutio nal EDI#" | |
4817 | "RTN","IBC NERPD",222 ,0) | |
4818 | .I DET=1 S X=X_"^Li nked Insur ance Compa ny Name^St reet Addre ss^City, S T^Professi onal EDI#^ Institutio nal EDI#^H PID/OEID" | |
4819 | "RTN","IBC NERPD",223 ,0) | |
4820 | I REP=2 D | |
4821 | "RTN","IBC NERPD",224 ,0) | |
4822 | .S X="Ins urance Com pany Name^ Street Add ress^City, ST Zip^# Active Gro ups^Profes sional EDI #^Institut ional EDI# ^HPID/OEID ^" | |
4823 | "RTN","IBC NERPD",225 ,0) | |
4824 | .S X=X_"L inked Paye r^VA ID^Na tionally A ctive?^Loc ally Activ e?^FSC Tru sted?^Prof essional E DI#^Instit utional ED I#" | |
4825 | "RTN","IBC NERPD",226 ,0) | |
4826 | W !,X | |
4827 | "RTN","IBC NERPD",227 ,0) | |
4828 | Q | |
4829 | "RTN","IBC NEUT5") | |
4830 | 0^18^B6544 4390^B6325 2821 | |
4831 | "RTN","IBC NEUT5",1,0 ) | |
4832 | IBCNEUT5 ; DAOU/ALA - eIV MISC. UTILITIES ;20-JUN-2 002 | |
4833 | "RTN","IBC NEUT5",2,0 ) | |
4834 | ;;2.0;INT EGRATED BI LLING;**18 4,284,271, 416,621,60 2**;21-MAR -94;Build 22 | |
4835 | "RTN","IBC NEUT5",3,0 ) | |
4836 | ;;Per VHA Directive 6402, thi s routine should not be modifi ed. | |
4837 | "RTN","IBC NEUT5",4,0 ) | |
4838 | ; | |
4839 | "RTN","IBC NEUT5",5,0 ) | |
4840 | ;**Progra m Descript ion** | |
4841 | "RTN","IBC NEUT5",6,0 ) | |
4842 | ; This p rogram con tains some general u tilities o r function s | |
4843 | "RTN","IBC NEUT5",7,0 ) | |
4844 | ; | |
4845 | "RTN","IBC NEUT5",8,0 ) | |
4846 | Q | |
4847 | "RTN","IBC NEUT5",9,0 ) | |
4848 | ; | |
4849 | "RTN","IBC NEUT5",10, 0) | |
4850 | MSG(MGRP,X MSUB,XMTEX T,FROMFLAG ,XMY) ; S end a Mail Man Messag e | |
4851 | "RTN","IBC NEUT5",11, 0) | |
4852 | ; | |
4853 | "RTN","IBC NEUT5",12, 0) | |
4854 | ; Input Parameters | |
4855 | "RTN","IBC NEUT5",13, 0) | |
4856 | ; MGRP = Mailgrou p Name (op tional) | |
4857 | "RTN","IBC NEUT5",14, 0) | |
4858 | ; XMSUB = Subject Line (req uired) | |
4859 | "RTN","IBC NEUT5",15, 0) | |
4860 | ; XMTEX T = Messag e Text Arr ay Name in open form at: "MSG( " (require d) | |
4861 | "RTN","IBC NEUT5",16, 0) | |
4862 | ; FROMF LAG = Flag indicatin g from who m the mess age is sen t (optiona l) | |
4863 | "RTN","IBC NEUT5",17, 0) | |
4864 | ; false/und efined: f rom the sp ecific, no n-human eI V user | |
4865 | "RTN","IBC NEUT5",18, 0) | |
4866 | ; true: f rom the ac tual user (DUZ) | |
4867 | "RTN","IBC NEUT5",19, 0) | |
4868 | ; XMY = recipient s array; p ass by ref erence (op tional) | |
4869 | "RTN","IBC NEUT5",20, 0) | |
4870 | ; The possi ble recipi ents are t he sender, the Mail Group in t he | |
4871 | "RTN","IBC NEUT5",21, 0) | |
4872 | ; first par ameter, an d anybody else alrea dy defined in the XM Y | |
4873 | "RTN","IBC NEUT5",22, 0) | |
4874 | ; array whe n this par ameter is used. | |
4875 | "RTN","IBC NEUT5",23, 0) | |
4876 | ; | |
4877 | "RTN","IBC NEUT5",24, 0) | |
4878 | ; New Mai lMan varia bles and a lso some F ileMan var iables. T he FileMan | |
4879 | "RTN","IBC NEUT5",25, 0) | |
4880 | ; variabl es are use d and not cleaned up when send ing to ext ernal | |
4881 | "RTN","IBC NEUT5",26, 0) | |
4882 | ; interne t addresse s. | |
4883 | "RTN","IBC NEUT5",27, 0) | |
4884 | NEW DIFRO M,XMDUZ,XM DUN,XMZ,XM MG,XMSTRIP ,XMROU,XMY BLOB | |
4885 | "RTN","IBC NEUT5",28, 0) | |
4886 | NEW D0,D1 ,D2,DG,DIC ,DICR,DISY S,DIW | |
4887 | "RTN","IBC NEUT5",29, 0) | |
4888 | NEW TMPSU B,TMPTEXT, TMPY,XX | |
4889 | "RTN","IBC NEUT5",30, 0) | |
4890 | ; | |
4891 | "RTN","IBC NEUT5",31, 0) | |
4892 | I $G(FROM FLAG),$G(D UZ) S XMDU Z=DUZ | |
4893 | "RTN","IBC NEUT5",32, 0) | |
4894 | E S XMDU Z="eIV INT ERFACE (IB )" | |
4895 | "RTN","IBC NEUT5",33, 0) | |
4896 | I $G(MGRP )'="" S XM Y("G."_MGR P)="" | |
4897 | "RTN","IBC NEUT5",34, 0) | |
4898 | ; If no r ecipients are define d, send to postmaste r | |
4899 | "RTN","IBC NEUT5",35, 0) | |
4900 | I '$D(XMY ) S XMY(.5 )="" | |
4901 | "RTN","IBC NEUT5",36, 0) | |
4902 | I $G(DUZ) S XMY(DUZ )="" | |
4903 | "RTN","IBC NEUT5",37, 0) | |
4904 | ; Store o ff subject , array re ference an d array of recipient s | |
4905 | "RTN","IBC NEUT5",38, 0) | |
4906 | S TMPSUB= XMSUB,TMPT EXT=XMTEXT | |
4907 | "RTN","IBC NEUT5",39, 0) | |
4908 | M TMPY=XM Y | |
4909 | "RTN","IBC NEUT5",40, 0) | |
4910 | D ^XMD | |
4911 | "RTN","IBC NEUT5",41, 0) | |
4912 | ; | |
4913 | "RTN","IBC NEUT5",42, 0) | |
4914 | ; Error l ogic | |
4915 | "RTN","IBC NEUT5",43, 0) | |
4916 | ; If ther e's an err or message and the m essage was not origi nally sent | |
4917 | "RTN","IBC NEUT5",44, 0) | |
4918 | ; to the postmaster , then sen d a messag e to the p ostmaster with this | |
4919 | "RTN","IBC NEUT5",45, 0) | |
4920 | ; error m essage. | |
4921 | "RTN","IBC NEUT5",46, 0) | |
4922 | ; | |
4923 | "RTN","IBC NEUT5",47, 0) | |
4924 | I $D(XMMG ),'$D(TMPY (.5)) D | |
4925 | "RTN","IBC NEUT5",48, 0) | |
4926 | . S XMY(. 5)="" | |
4927 | "RTN","IBC NEUT5",49, 0) | |
4928 | . S XMTEX T=TMPTEXT, XMSUB="Mai lMan Error " | |
4929 | "RTN","IBC NEUT5",50, 0) | |
4930 | . ; Add X MMG error message as the first line of t he message | |
4931 | "RTN","IBC NEUT5",51, 0) | |
4932 | . S XX=99 9999 | |
4933 | "RTN","IBC NEUT5",52, 0) | |
4934 | . F S XX =$O(@(XMTE XT_"XX)"), -1) Q:'XX S @(XMTEX T_"XX+3)") =@(XMTEXT_ "XX)") | |
4935 | "RTN","IBC NEUT5",53, 0) | |
4936 | . S @(XMT EXT_"1)")= " MailMa n Error: "_XMMG | |
4937 | "RTN","IBC NEUT5",54, 0) | |
4938 | . S @(XMT EXT_"2)")= "Original Subject: "_TMPSUB | |
4939 | "RTN","IBC NEUT5",55, 0) | |
4940 | . S @(XMT EXT_"3)")= "------Ori ginal Mess age------" | |
4941 | "RTN","IBC NEUT5",56, 0) | |
4942 | . D ^XMD | |
4943 | "RTN","IBC NEUT5",57, 0) | |
4944 | . Q | |
4945 | "RTN","IBC NEUT5",58, 0) | |
4946 | Q | |
4947 | "RTN","IBC NEUT5",59, 0) | |
4948 | ; | |
4949 | "RTN","IBC NEUT5",60, 0) | |
4950 | ; | |
4951 | "RTN","IBC NEUT5",61, 0) | |
4952 | BFEXIST(DF N,INSNAME) ; Functio n returns 1 if an En tered Ins Buffer Fil e | |
4953 | "RTN","IBC NEUT5",62, 0) | |
4954 | ; entry e xists with the same DFN and IN SNAME, oth erwise it returns a 0 | |
4955 | "RTN","IBC NEUT5",63, 0) | |
4956 | ; | |
4957 | "RTN","IBC NEUT5",64, 0) | |
4958 | ; DFN - P atient DFN | |
4959 | "RTN","IBC NEUT5",65, 0) | |
4960 | ; INSNAME - Insuran ce Company Name File 36 - Fiel d .01 | |
4961 | "RTN","IBC NEUT5",66, 0) | |
4962 | ; | |
4963 | "RTN","IBC NEUT5",67, 0) | |
4964 | NEW BUFFN AME,EXIST, IEN ; IB*2 .0*602 | |
4965 | "RTN","IBC NEUT5",68, 0) | |
4966 | S EXIST=0 | |
4967 | "RTN","IBC NEUT5",69, 0) | |
4968 | S INSNAME =$$UP^XLFS TR(INSNAME ),INSNAME= $$TRIM^XLF STR(INSNAM E) ; trim med *IB*2. 0*602 | |
4969 | "RTN","IBC NEUT5",70, 0) | |
4970 | I ('DFN)! (INSNAME=" ") G BFEXI T | |
4971 | "RTN","IBC NEUT5",71, 0) | |
4972 | ; | |
4973 | "RTN","IBC NEUT5",72, 0) | |
4974 | S IEN=0 | |
4975 | "RTN","IBC NEUT5",73, 0) | |
4976 | F S IEN= $O(^IBA(35 5.33,"C",D FN,IEN)) Q :'IEN!EXIS T D | |
4977 | "RTN","IBC NEUT5",74, 0) | |
4978 | . ; Quit if status is NOT 'E ntered' | |
4979 | "RTN","IBC NEUT5",75, 0) | |
4980 | . I $P($ G(^IBA(355 .33,IEN,0) ),U,4)'="E " Q | |
4981 | "RTN","IBC NEUT5",76, 0) | |
4982 | . ; Quit if Ins Bu ffer Ins C o Name (tr immed) is NOT EQUAL to | |
4983 | "RTN","IBC NEUT5",77, 0) | |
4984 | . ; the Ins Co Na me paramet er (trimme d) | |
4985 | "RTN","IBC NEUT5",78, 0) | |
4986 | . ; IB*2 .0*602 in case the i nput templ ate for th at field c hanges in the future (TRIM & U P) | |
4987 | "RTN","IBC NEUT5",79, 0) | |
4988 | . S BUFF NAME=$$TRI M^XLFSTR($ P($G(^IBA( 355.33,IEN ,20)),U)) | |
4989 | "RTN","IBC NEUT5",80, 0) | |
4990 | . I $$UP ^XLFSTR(BU FFNAME)'=I NSNAME Q | |
4991 | "RTN","IBC NEUT5",81, 0) | |
4992 | . ; Matc h found | |
4993 | "RTN","IBC NEUT5",82, 0) | |
4994 | . S EXIS T=1 | |
4995 | "RTN","IBC NEUT5",83, 0) | |
4996 | . Q | |
4997 | "RTN","IBC NEUT5",84, 0) | |
4998 | BFEXIT ; | |
4999 | "RTN","IBC NEUT5",85, 0) | |
5000 | Q EXIST | |
5001 | "RTN","IBC NEUT5",86, 0) | |
5002 | ; | |
5003 | "RTN","IBC NEUT5",87, 0) | |
5004 | ; | |
5005 | "RTN","IBC NEUT5",88, 0) | |
5006 | MGRP() ; G et the Mai l Group fo r the eIV Interface - IB Site Parameters (51.04) | |
5007 | "RTN","IBC NEUT5",89, 0) | |
5008 | Q $$GET1^ DIQ(350.9, "1,",51.04 ,"E") | |
5009 | "RTN","IBC NEUT5",90, 0) | |
5010 | ; | |
5011 | "RTN","IBC NEUT5",91, 0) | |
5012 | ; | |
5013 | "RTN","IBC NEUT5",92, 0) | |
5014 | PYRAPP(APP ,PAYERIEN) ; Get the Payer App lication m ultiple IE N | |
5015 | "RTN","IBC NEUT5",93, 0) | |
5016 | ; based o n the paye r applicat ion name a nd payer i en. | |
5017 | "RTN","IBC NEUT5",94, 0) | |
5018 | ; | |
5019 | "RTN","IBC NEUT5",95, 0) | |
5020 | NEW MIEN, APPIEN,DIS YS | |
5021 | "RTN","IBC NEUT5",96, 0) | |
5022 | S MIEN="" | |
5023 | "RTN","IBC NEUT5",97, 0) | |
5024 | S APPIEN= $$FIND1^DI C(365.13,, "X",APP,"B ") | |
5025 | "RTN","IBC NEUT5",98, 0) | |
5026 | I 'APPIEN G PYRAPPX | |
5027 | "RTN","IBC NEUT5",99, 0) | |
5028 | I '$G(PAY ERIEN) G P YRAPPX | |
5029 | "RTN","IBC NEUT5",100 ,0) | |
5030 | S MIEN=$O (^IBE(365. 12,PAYERIE N,1,"B",AP PIEN,"")) | |
5031 | "RTN","IBC NEUT5",101 ,0) | |
5032 | PYRAPPX ; | |
5033 | "RTN","IBC NEUT5",102 ,0) | |
5034 | Q MIEN | |
5035 | "RTN","IBC NEUT5",103 ,0) | |
5036 | ; | |
5037 | "RTN","IBC NEUT5",104 ,0) | |
5038 | ; | |
5039 | "RTN","IBC NEUT5",105 ,0) | |
5040 | ACTAPP(IEN ) ; Active payer app lications | |
5041 | "RTN","IBC NEUT5",106 ,0) | |
5042 | ; This fu nction wil l return 1 if any of the payer applicati ons for | |
5043 | "RTN","IBC NEUT5",107 ,0) | |
5044 | ; this pa yer (being passed in by the pa yer IEN) a re NOT dea ctivated. | |
5045 | "RTN","IBC NEUT5",108 ,0) | |
5046 | ; This sh ould not b e confused with the other paye r applicat ion fields | |
5047 | "RTN","IBC NEUT5",109 ,0) | |
5048 | ; such as national active or local acti ve. The d eactivated field is | |
5049 | "RTN","IBC NEUT5",110 ,0) | |
5050 | ; the .11 field in the payer applicatio n multiple . | |
5051 | "RTN","IBC NEUT5",111 ,0) | |
5052 | ; | |
5053 | "RTN","IBC NEUT5",112 ,0) | |
5054 | ; This fu nction is invoked by the FileM an data di ctionary a s a screen | |
5055 | "RTN","IBC NEUT5",113 ,0) | |
5056 | ; for the Payer fie ld (#3.1) in the Ins urance com pany file (#36). | |
5057 | "RTN","IBC NEUT5",114 ,0) | |
5058 | ; | |
5059 | "RTN","IBC NEUT5",115 ,0) | |
5060 | NEW APPIE N,ACTAPP,A PPDATA | |
5061 | "RTN","IBC NEUT5",116 ,0) | |
5062 | S APPIEN= 0,ACTAPP=" ",IEN=+$G( IEN) | |
5063 | "RTN","IBC NEUT5",117 ,0) | |
5064 | F S APPI EN=$O(^IBE (365.12,IE N,1,APPIEN )) Q:'APPI EN D Q:A CTAPP | |
5065 | "RTN","IBC NEUT5",118 ,0) | |
5066 | . S APPDA TA=$G(^IBE (365.12,IE N,1,APPIEN ,0)) | |
5067 | "RTN","IBC NEUT5",119 ,0) | |
5068 | . I $P(AP PDATA,U,11 ) Q | |
5069 | "RTN","IBC NEUT5",120 ,0) | |
5070 | . I $P(AP PDATA,U,12 ) Q | |
5071 | "RTN","IBC NEUT5",121 ,0) | |
5072 | . S ACTAP P=1 | |
5073 | "RTN","IBC NEUT5",122 ,0) | |
5074 | . Q | |
5075 | "RTN","IBC NEUT5",123 ,0) | |
5076 | Q ACTAPP | |
5077 | "RTN","IBC NEUT5",124 ,0) | |
5078 | ; | |
5079 | "RTN","IBC NEUT5",125 ,0) | |
5080 | ADDTQ(DFN, PAYER,SRVD T,FDAYS,EI CDEXT) ; F unction - Returns f lag (0/1) | |
5081 | "RTN","IBC NEUT5",126 ,0) | |
5082 | ; 1 - TQ File entry can be ad ded as the service d ate for th e patient | |
5083 | "RTN","IBC NEUT5",127 ,0) | |
5084 | ; and payer >= MAX TQ ser vice date + Freshnes s Days | |
5085 | "RTN","IBC NEUT5",128 ,0) | |
5086 | ; 0 - oth erwise | |
5087 | "RTN","IBC NEUT5",129 ,0) | |
5088 | ; | |
5089 | "RTN","IBC NEUT5",130 ,0) | |
5090 | ; Input: | |
5091 | "RTN","IBC NEUT5",131 ,0) | |
5092 | ; DFN - Patient DFN (File #2) | |
5093 | "RTN","IBC NEUT5",132 ,0) | |
5094 | ; PAYER - Payer IE N (File #3 65.12) | |
5095 | "RTN","IBC NEUT5",133 ,0) | |
5096 | ; SRVDT - Service dt for pot ential TQ entry | |
5097 | "RTN","IBC NEUT5",134 ,0) | |
5098 | ; FDAYS - Freshnes s Days par am (by ext ract type) | |
5099 | "RTN","IBC NEUT5",135 ,0) | |
5100 | ; EICDEX T - 1 OR 0 (Is this from the E ICD extrac t?) ;IB*2. 0*621 - Re named para meter to E ICD extrac t | |
5101 | "RTN","IBC NEUT5",136 ,0) | |
5102 | ; | |
5103 | "RTN","IBC NEUT5",137 ,0) | |
5104 | N ADDTQ,M AXDT | |
5105 | "RTN","IBC NEUT5",138 ,0) | |
5106 | ; | |
5107 | "RTN","IBC NEUT5",139 ,0) | |
5108 | S ADDTQ=1 | |
5109 | "RTN","IBC NEUT5",140 ,0) | |
5110 | I ($G(DFN )="")!($G( SRVDT)="") !($G(FDAYS )="") S AD DTQ=0 G AD DTQX | |
5111 | "RTN","IBC NEUT5",141 ,0) | |
5112 | I ($G(EIC DEXT)="")! ($G(PAYER) ="") S ADD TQ=0 G ADD TQX | |
5113 | "RTN","IBC NEUT5",142 ,0) | |
5114 | ; | |
5115 | "RTN","IBC NEUT5",143 ,0) | |
5116 | ; MAX TQ Service Da te | |
5117 | "RTN","IBC NEUT5",144 ,0) | |
5118 | S MAXDT=$ $TQMAXSV(D FN,$G(PAYE R),$G(EICD EXT)) | |
5119 | "RTN","IBC NEUT5",145 ,0) | |
5120 | I MAXDT=" " G ADDTQX | |
5121 | "RTN","IBC NEUT5",146 ,0) | |
5122 | ; If Serv ice Date < Max Servi ce Date + Freshness Days, do n ot add | |
5123 | "RTN","IBC NEUT5",147 ,0) | |
5124 | I SRVDT'> $$FMADD^XL FDT(MAXDT, FDAYS) S A DDTQ=0 | |
5125 | "RTN","IBC NEUT5",148 ,0) | |
5126 | ; | |
5127 | "RTN","IBC NEUT5",149 ,0) | |
5128 | ADDTQX ; A DDTQ exit pt | |
5129 | "RTN","IBC NEUT5",150 ,0) | |
5130 | Q ADDTQ | |
5131 | "RTN","IBC NEUT5",151 ,0) | |
5132 | ; | |
5133 | "RTN","IBC NEUT5",152 ,0) | |
5134 | TQUPDSV(DF N,PAYER,SR VDT) ; Upd ate servic e dates & freshness dates for TQ | |
5135 | "RTN","IBC NEUT5",153 ,0) | |
5136 | ; entries awaiting transmissi on | |
5137 | "RTN","IBC NEUT5",154 ,0) | |
5138 | ; | |
5139 | "RTN","IBC NEUT5",155 ,0) | |
5140 | N SVDT,ST S,ERACT,CS RVDT,CSPAN ,SPAN,DA,H L7IEN,RIEN | |
5141 | "RTN","IBC NEUT5",156 ,0) | |
5142 | ; | |
5143 | "RTN","IBC NEUT5",157 ,0) | |
5144 | I ($G(DFN )="")!($G( PAYER)="") !($G(SRVDT )="") G TQ UPDSVX | |
5145 | "RTN","IBC NEUT5",158 ,0) | |
5146 | ; | |
5147 | "RTN","IBC NEUT5",159 ,0) | |
5148 | ; Loop th ru all inq uiries to be transmi tted to up date the s ervice dat e | |
5149 | "RTN","IBC NEUT5",160 ,0) | |
5150 | ; Statuse s: Ready to Transmi t(1), Hold (4) and Re try(6) | |
5151 | "RTN","IBC NEUT5",161 ,0) | |
5152 | S SVDT="" | |
5153 | "RTN","IBC NEUT5",162 ,0) | |
5154 | F S SVDT =$O(^IBCN( 365.1,"AD" ,DFN,PAYER ,SVDT)) Q: 'SVDT D | |
5155 | "RTN","IBC NEUT5",163 ,0) | |
5156 | . S DA=0 | |
5157 | "RTN","IBC NEUT5",164 ,0) | |
5158 | . F S DA =$O(^IBCN( 365.1,"AD" ,DFN,PAYER ,SVDT,DA)) Q:'DA D | |
5159 | "RTN","IBC NEUT5",165 ,0) | |
5160 | .. ; TQ S tatus | |
5161 | "RTN","IBC NEUT5",166 ,0) | |
5162 | .. S STS= $P($G(^IBC N(365.1,DA ,0)),U,4) | |
5163 | "RTN","IBC NEUT5",167 ,0) | |
5164 | .. ; Chec k to see i f record i s still sc heduled to be transm itted. | |
5165 | "RTN","IBC NEUT5",168 ,0) | |
5166 | .. ; If s o, update the servic e date if the new se rvice date and curre nt | |
5167 | "RTN","IBC NEUT5",169 ,0) | |
5168 | .. ; serv ice date a re both in the past or future and the ne w service | |
5169 | "RTN","IBC NEUT5",170 ,0) | |
5170 | .. ; date is closer to Today. Also, if the curre nt service date is i n | |
5171 | "RTN","IBC NEUT5",171 ,0) | |
5172 | .. ; the future and the new s ervice dat e is in th e past, up date with the | |
5173 | "RTN","IBC NEUT5",172 ,0) | |
5174 | .. ; new service da te. | |
5175 | "RTN","IBC NEUT5",173 ,0) | |
5176 | .. ; If n ot Ready t o Transmit (1), Hold( 4) and Ret ry(6), qui t | |
5177 | "RTN","IBC NEUT5",174 ,0) | |
5178 | .. I STS' =1,STS'=4, STS'=6 Q | |
5179 | "RTN","IBC NEUT5",175 ,0) | |
5180 | .. ; If H old and la st Respons e returned Error Act ion - Plea se resubmi t | |
5181 | "RTN","IBC NEUT5",176 ,0) | |
5182 | .. ; Orig inal Trans action (P) - do not update | |
5183 | "RTN","IBC NEUT5",177 ,0) | |
5184 | .. I STS= 4 S ERACT= "" D I ER ACT="P" Q | |
5185 | "RTN","IBC NEUT5",178 ,0) | |
5186 | .. . ; La st msg sen t | |
5187 | "RTN","IBC NEUT5",179 ,0) | |
5188 | .. . S HL 7IEN=$O(^I BCN(365.1, DA,2," "), -1) Q:'HL7 IEN | |
5189 | "RTN","IBC NEUT5",180 ,0) | |
5190 | .. . ; As soc eIV Re sponse IEN | |
5191 | "RTN","IBC NEUT5",181 ,0) | |
5192 | .. . S RI EN=$P($G(^ IBCN(365.1 ,DA,2,HL7I EN,0)),U,3 ) Q:'RIEN | |
5193 | "RTN","IBC NEUT5",182 ,0) | |
5194 | .. . ; Er ror Action IEN (365. 018) | |
5195 | "RTN","IBC NEUT5",183 ,0) | |
5196 | .. . S ER ACT=$P($G( ^IBCN(365, RIEN,1)),U ,15) Q:'ER ACT | |
5197 | "RTN","IBC NEUT5",184 ,0) | |
5198 | .. . S ER ACT=$P($G( ^IBE(365.0 18,ERACT,0 )),U,1) | |
5199 | "RTN","IBC NEUT5",185 ,0) | |
5200 | .. ; | |
5201 | "RTN","IBC NEUT5",186 ,0) | |
5202 | .. ; Curr ent servic e date for TQ entry | |
5203 | "RTN","IBC NEUT5",187 ,0) | |
5204 | .. S CSRV DT=$P($G(^ IBCN(365.1 ,DA,0)),U, 12) | |
5205 | "RTN","IBC NEUT5",188 ,0) | |
5206 | .. ; If c urrent ser vice date is today ( DT), do no t update | |
5207 | "RTN","IBC NEUT5",189 ,0) | |
5208 | .. I CSRV DT=DT Q | |
5209 | "RTN","IBC NEUT5",190 ,0) | |
5210 | .. ; If n ew service date is i n the futu re and cur rent servi ce date is in | |
5211 | "RTN","IBC NEUT5",191 ,0) | |
5212 | .. ; the past, do n ot update | |
5213 | "RTN","IBC NEUT5",192 ,0) | |
5214 | .. I SRVD T>DT,CSRVD T<DT Q | |
5215 | "RTN","IBC NEUT5",193 ,0) | |
5216 | .. ; If n ew service date is t oday, upda te | |
5217 | "RTN","IBC NEUT5",194 ,0) | |
5218 | .. I SRVD T=DT D SAV ETQ^IBCNEU T2(DA,SRVD T),SAVFRSH (DA,+$$FMD IFF^XLFDT( SRVDT,CSRV DT,1)) Q | |
5219 | "RTN","IBC NEUT5",195 ,0) | |
5220 | .. ; If b oth curren t and new service da tes are in the past or future, | |
5221 | "RTN","IBC NEUT5",196 ,0) | |
5222 | .. ; only update, w hen new se rvice date is closer to today (DT). | |
5223 | "RTN","IBC NEUT5",197 ,0) | |
5224 | .. I ((CS RVDT<DT)&( SRVDT<DT)) !((CSRVDT> DT)&(SRVDT >DT)) D Q | |
5225 | "RTN","IBC NEUT5",198 ,0) | |
5226 | .. . S CS PAN=$$FMDI FF^XLFDT(C SRVDT,DT,1 ),SPAN=$$F MDIFF^XLFD T(SRVDT,DT ,1) | |
5227 | "RTN","IBC NEUT5",199 ,0) | |
5228 | .. . I CS PAN<0 S CS PAN=-CSPAN | |
5229 | "RTN","IBC NEUT5",200 ,0) | |
5230 | .. . I SP AN<0 S SPA N=-SPAN | |
5231 | "RTN","IBC NEUT5",201 ,0) | |
5232 | .. . I SP AN<CSPAN D SAVETQ^IB CNEUT2(DA, SRVDT),SAV FRSH(DA,+$ $FMDIFF^XL FDT(SRVDT, CSRVDT,1)) | |
5233 | "RTN","IBC NEUT5",202 ,0) | |
5234 | .. ; If n ew service date is i n the past and curre nt service date is i n | |
5235 | "RTN","IBC NEUT5",203 ,0) | |
5236 | .. ; the future, up date | |
5237 | "RTN","IBC NEUT5",204 ,0) | |
5238 | .. I SRVD T<CSRVDT D SAVETQ^IB CNEUT2(DA, SRVDT),SAV FRSH(DA,+$ $FMDIFF^XL FDT(SRVDT, CSRVDT,1)) Q | |
5239 | "RTN","IBC NEUT5",205 ,0) | |
5240 | .. Q | |
5241 | "RTN","IBC NEUT5",206 ,0) | |
5242 | TQUPDSVX ; TQUPDSV e xit pt | |
5243 | "RTN","IBC NEUT5",207 ,0) | |
5244 | Q | |
5245 | "RTN","IBC NEUT5",208 ,0) | |
5246 | ; | |
5247 | "RTN","IBC NEUT5",209 ,0) | |
5248 | TQMAXSV(DF N,PAYER,EI CDEXT) ; R eturns MAX (TQ Servic e Date) fo r Patient & Payer | |
5249 | "RTN","IBC NEUT5",210 ,0) | |
5250 | ; Input: | |
5251 | "RTN","IBC NEUT5",211 ,0) | |
5252 | ; DFN - Patien t DFN (2) | |
5253 | "RTN","IBC NEUT5",212 ,0) | |
5254 | ; PAYER - Payer IEN (365.1 2) (If no PAYER pass ed in, che ck them al l) | |
5255 | "RTN","IBC NEUT5",213 ,0) | |
5256 | ; EICDEX T - 1 OR 0 (Is this from the E ICD extrac t?) | |
5257 | "RTN","IBC NEUT5",214 ,0) | |
5258 | ; | |
5259 | "RTN","IBC NEUT5",215 ,0) | |
5260 | ; Output: | |
5261 | "RTN","IBC NEUT5",216 ,0) | |
5262 | ; TQMAXS V - MAX (m ost recent ) service date from TQ entry f or Patient & | |
5263 | "RTN","IBC NEUT5",217 ,0) | |
5264 | ; Payer | |
5265 | "RTN","IBC NEUT5",218 ,0) | |
5266 | ; | |
5267 | "RTN","IBC NEUT5",219 ,0) | |
5268 | ; IB*621 reworked t his functi on to igno re TQ entr ies with s tatuses of | |
5269 | "RTN","IBC NEUT5",220 ,0) | |
5270 | ; "Respo nse Receiv ed" for EI CD for whi ch the Res ponse indi cated a "C learinghou se Timeout " | |
5271 | "RTN","IBC NEUT5",221 ,0) | |
5272 | N TQMAXSV | |
5273 | "RTN","IBC NEUT5",222 ,0) | |
5274 | S TQMAXSV ="" | |
5275 | "RTN","IBC NEUT5",223 ,0) | |
5276 | I $G(DFN) ="" G TQMA XSVX | |
5277 | "RTN","IBC NEUT5",224 ,0) | |
5278 | ; | |
5279 | "RTN","IBC NEUT5",225 ,0) | |
5280 | N ERTXT,I BSKIP,IBTQ S,IENS,LAS TBYP,STATL IST,TQIEN | |
5281 | "RTN","IBC NEUT5",226 ,0) | |
5282 | ; This is the list of statuse s that are to be ign ored for E ICD extrac t only | |
5283 | "RTN","IBC NEUT5",227 ,0) | |
5284 | ; 3=Res ponse Rece ived | |
5285 | "RTN","IBC NEUT5",228 ,0) | |
5286 | S STATLIS T=",3," | |
5287 | "RTN","IBC NEUT5",229 ,0) | |
5288 | ; | |
5289 | "RTN","IBC NEUT5",230 ,0) | |
5290 | S LASTBYP ="" | |
5291 | "RTN","IBC NEUT5",231 ,0) | |
5292 | F S LAST BYP=$O(^IB CN(365.1," AD",DFN,PA YER,LASTBY P)) Q:LAST BYP="" D | |
5293 | "RTN","IBC NEUT5",232 ,0) | |
5294 | . S TQIEN ="" | |
5295 | "RTN","IBC NEUT5",233 ,0) | |
5296 | . F S TQ IEN=$O(^IB CN(365.1," AD",DFN,PA YER,LASTBY P,TQIEN)) Q:TQIEN="" D | |
5297 | "RTN","IBC NEUT5",234 ,0) | |
5298 | .. S IBSK IP=0 | |
5299 | "RTN","IBC NEUT5",235 ,0) | |
5300 | .. I EICD EXT D Q:I BSKIP | |
5301 | "RTN","IBC NEUT5",236 ,0) | |
5302 | .. . S IB TQS=+$$GET 1^DIQ(365. 1,TQIEN_", ",.04,"I") ; TQ T ransmissio n Status | |
5303 | "RTN","IBC NEUT5",237 ,0) | |
5304 | .. . I IB TQS,'($F(S TATLIST,", "_IBTQS_", ")) Q | |
5305 | "RTN","IBC NEUT5",238 ,0) | |
5306 | .. . S IE NS="1,"_TQ IEN_",",RI EN=$$GET1^ DIQ(365.16 ,IENS,.03, "I") | |
5307 | "RTN","IBC NEUT5",239 ,0) | |
5308 | .. . S ER TXT=$$GET1 ^DIQ(365,R IEN_",",4. 01) I $$UP ^XLFSTR(ER TXT)["TIME OUT" S IBS KIP=1 ; ke ep looking | |
5309 | "RTN","IBC NEUT5",240 ,0) | |
5310 | .. I LAST BYP>TQMAXS V S TQMAXS V=LASTBYP | |
5311 | "RTN","IBC NEUT5",241 ,0) | |
5312 | ; | |
5313 | "RTN","IBC NEUT5",242 ,0) | |
5314 | TQMAXSVX ; TQMAXSV e xit pt | |
5315 | "RTN","IBC NEUT5",243 ,0) | |
5316 | Q TQMAXSV | |
5317 | "RTN","IBC NEUT5",244 ,0) | |
5318 | ; | |
5319 | "RTN","IBC NEUT5",245 ,0) | |
5320 | SAVFRSH(TQ IEN,DTDIFF ) ; Update TQ freshn ess date b ased on se rvice date diff | |
5321 | "RTN","IBC NEUT5",246 ,0) | |
5322 | ; | |
5323 | "RTN","IBC NEUT5",247 ,0) | |
5324 | N DIE,DA, FDT,DR,D,D 0,DI,DIC,D Q,X | |
5325 | "RTN","IBC NEUT5",248 ,0) | |
5326 | I $G(TQIE N)="" Q | |
5327 | "RTN","IBC NEUT5",249 ,0) | |
5328 | S FDT=$P( $G(^IBCN(3 65.1,TQIEN ,0)),U,17) | |
5329 | "RTN","IBC NEUT5",250 ,0) | |
5330 | ; Note - will only update if FDT > 0. | |
5331 | "RTN","IBC NEUT5",251 ,0) | |
5332 | S FDT=$$F MADD^XLFDT (FDT,+DTDI FF) | |
5333 | "RTN","IBC NEUT5",252 ,0) | |
5334 | S DIE="^I BCN(365.1, ",DA=TQIEN ,DR=".17// //"_FDT | |
5335 | "RTN","IBC NEUT5",253 ,0) | |
5336 | D ^DIE | |
5337 | "RTN","IBC NEUT5",254 ,0) | |
5338 | Q | |
5339 | "RTN","IBC NEUT5",255 ,0) | |
5340 | ; | |
5341 | "RTN","IBC NSMM") | |
5342 | 0^12^B1943 8322^B1930 1339 | |
5343 | "RTN","IBC NSMM",1,0) | |
5344 | IBCNSMM ;A LB/CMS -ME DICARE INS URANCE INT AKE ; 18-O CT-98 | |
5345 | "RTN","IBC NSMM",2,0) | |
5346 | ;;2.0;INT EGRATED BI LLING;**10 3,133,184, 516,601,59 5,602**;21 -MAR-94;Bu ild 22 | |
5347 | "RTN","IBC NSMM",3,0) | |
5348 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
5349 | "RTN","IBC NSMM",4,0) | |
5350 | Q | |
5351 | "RTN","IBC NSMM",5,0) | |
5352 | ; | |
5353 | "RTN","IBC NSMM",6,0) | |
5354 | EN ; -- En try point from Medic are Intake Standalon e option | |
5355 | "RTN","IBC NSMM",7,0) | |
5356 | N DIC,DIR ,DA,%A,DFN ,X,Y,IBQUI T,IBCNSP,I BSOURCE | |
5357 | "RTN","IBC NSMM",8,0) | |
5358 | S (IBQUIT ,IBCNSP)=0 D GETWNR I IBQUIT G ENQ | |
5359 | "RTN","IBC NSMM",9,0) | |
5360 | ; | |
5361 | "RTN","IBC NSMM",10,0 ) | |
5362 | ; - allow the user to enter t he Source of Informa tion for t he policie s | |
5363 | "RTN","IBC NSMM",11,0 ) | |
5364 | W !!,"You may enter the 'Sour ce of Info rmation' t hat will b e filed wi th all" | |
5365 | "RTN","IBC NSMM",12,0 ) | |
5366 | W !,"Medi care insur ance cover age polici es that ar e created. ",! | |
5367 | "RTN","IBC NSMM",13,0 ) | |
5368 | ; | |
5369 | "RTN","IBC NSMM",14,0 ) | |
5370 | S DIR(0)= "2.312,1.0 9" | |
5371 | "RTN","IBC NSMM",15,0 ) | |
5372 | S DIR("A" )="Enter S ource of I nformation " | |
5373 | "RTN","IBC NSMM",16,0 ) | |
5374 | S DIR("B" )="INTERVI EW" | |
5375 | "RTN","IBC NSMM",17,0 ) | |
5376 | D ^DIR K DUOUT,DTOU T,DIRUT,DI ROUT,DIR | |
5377 | "RTN","IBC NSMM",18,0 ) | |
5378 | S IBSOURC E=+Y I Y<1 G ENQ | |
5379 | "RTN","IBC NSMM",19,0 ) | |
5380 | W ! | |
5381 | "RTN","IBC NSMM",20,0 ) | |
5382 | ; | |
5383 | "RTN","IBC NSMM",21,0 ) | |
5384 | ; - loop to select patients | |
5385 | "RTN","IBC NSMM",22,0 ) | |
5386 | ENA S DIC( 0)="AEQMN" ,DIC="^DPT (" D ^DIC | |
5387 | "RTN","IBC NSMM",23,0 ) | |
5388 | I +Y<1 G ENQ | |
5389 | "RTN","IBC NSMM",24,0 ) | |
5390 | S DFN=+Y | |
5391 | "RTN","IBC NSMM",25,0 ) | |
5392 | I $G(^DPT (DFN,.35)) W *7,!!,? 10,"Patien t Expired on ",$$FMT E^XLFDT($P (^DPT(DFN, .35),U)) | |
5393 | "RTN","IBC NSMM",26,0 ) | |
5394 | W ! D DIS P^IBCNS W !,?3 S X=" ",$P(X,"=" ,76)="" W X | |
5395 | "RTN","IBC NSMM",27,0 ) | |
5396 | D ENR(DFN ,IBSOURCE, 1) K DIC W !! G ENA | |
5397 | "RTN","IBC NSMM",28,0 ) | |
5398 | ; | |
5399 | "RTN","IBC NSMM",29,0 ) | |
5400 | ENQ Q | |
5401 | "RTN","IBC NSMM",30,0 ) | |
5402 | ; | |
5403 | "RTN","IBC NSMM",31,0 ) | |
5404 | ; | |
5405 | "RTN","IBC NSMM",32,0 ) | |
5406 | ENR(DFN,IB SOUR,IBOPT ) ; -- Ent ry point f rom IBCNBM E Patient Registrati on or Pre- Registrati on | |
5407 | "RTN","IBC NSMM",33,0 ) | |
5408 | ; Inpu t Variable DFN Requi red and IB SOUR =Sour ce of Info rmation | |
5409 | "RTN","IBC NSMM",34,0 ) | |
5410 | ; IBOPT =1 if coming from MII S tandalone Option | |
5411 | "RTN","IBC NSMM",35,0 ) | |
5412 | ; | |
5413 | "RTN","IBC NSMM",36,0 ) | |
5414 | N D,DIE,D A,DIR,DIC, E,IBCPOL,I BCNSP,IBCD FN,IBQUIT, IBOK,IBC0, IBAD,IBGRP ,IBADPOL | |
5415 | "RTN","IBC NSMM",37,0 ) | |
5416 | N IBNAME, IBHICN,IBA EFF,IBBEFF ,IBCOVP,IB GNA,IBGNU, IBBUF,IBNE W,IBP,X,Y | |
5417 | "RTN","IBC NSMM",38,0 ) | |
5418 | N IBPOLA, IBPOLB,IBA RR,IBHIT,I BHITA,IBHI TB,IBCOB,I BCOBI | |
5419 | "RTN","IBC NSMM",39,0 ) | |
5420 | ; | |
5421 | "RTN","IBC NSMM",40,0 ) | |
5422 | ; IB*602 - IBHICN c ould also be a Medic are Benefi ciary ID | |
5423 | "RTN","IBC NSMM",41,0 ) | |
5424 | S (IBAEFF ,IBBEFF,IB CNSP,IBCDF N,IBNEW,IB QUIT)=0,IB ADPOL=1 | |
5425 | "RTN","IBC NSMM",42,0 ) | |
5426 | S (IBNAME ,IBHICN)=" " | |
5427 | "RTN","IBC NSMM",43,0 ) | |
5428 | ; | |
5429 | "RTN","IBC NSMM",44,0 ) | |
5430 | ; -- Get Standard M edicare In surance Co mpany and plans in I BCNSP | |
5431 | "RTN","IBC NSMM",45,0 ) | |
5432 | D GETWNR I IBQUIT G ENRQ | |
5433 | "RTN","IBC NSMM",46,0 ) | |
5434 | ; | |
5435 | "RTN","IBC NSMM",47,0 ) | |
5436 | ; -- get the patien t's Medica re policie s | |
5437 | "RTN","IBC NSMM",48,0 ) | |
5438 | S (IBPOLA ,IBPOLB)=0 | |
5439 | "RTN","IBC NSMM",49,0 ) | |
5440 | S IBCDFN= 0 F S IBC DFN=$O(^DP T(DFN,.312 ,"B",+IBCN SP,IBCDFN) ) Q:'IBCDF N D | |
5441 | "RTN","IBC NSMM",50,0 ) | |
5442 | .;IB*2.0* 516/TAZ - Retrieve D ata from H IPAA compl iant field s. | |
5443 | "RTN","IBC NSMM",51,0 ) | |
5444 | .;S IBCPO L=$G(^DPT( DFN,.312,I BCDFN,0)) ;516 - ba a | |
5445 | "RTN","IBC NSMM",52,0 ) | |
5446 | .S IBCPOL =$$ZND^IBC NS1(DFN,IB CDFN) ;51 6 - baa | |
5447 | "RTN","IBC NSMM",53,0 ) | |
5448 | .; | |
5449 | "RTN","IBC NSMM",54,0 ) | |
5450 | .; - is t he policy for Part A ? | |
5451 | "RTN","IBC NSMM",55,0 ) | |
5452 | .I $P(IBC NSP,U,3)=$ P(IBCPOL,U ,18) D Q | |
5453 | "RTN","IBC NSMM",56,0 ) | |
5454 | ..S IBPOL A=IBPOLA+1 ,IBARR("A" ,IBPOLA)=I BCDFN_"^"_ IBCPOL | |
5455 | "RTN","IBC NSMM",57,0 ) | |
5456 | .; | |
5457 | "RTN","IBC NSMM",58,0 ) | |
5458 | .; - is t he policy for Part B ? | |
5459 | "RTN","IBC NSMM",59,0 ) | |
5460 | .I $P(IBC NSP,U,5)=$ P(IBCPOL,U ,18) D | |
5461 | "RTN","IBC NSMM",60,0 ) | |
5462 | ..S IBPOL B=IBPOLB+1 ,IBARR("B" ,IBPOLB)=I BCDFN_"^"_ IBCPOL | |
5463 | "RTN","IBC NSMM",61,0 ) | |
5464 | ; | |
5465 | "RTN","IBC NSMM",62,0 ) | |
5466 | ; - can't edit here if there is more th an one pol icy | |
5467 | "RTN","IBC NSMM",63,0 ) | |
5468 | I $D(IBAR R("A",2)) K IBARR("A ") D | |
5469 | "RTN","IBC NSMM",64,0 ) | |
5470 | .W !!,"Th is patient has more than one P art A poli cy. Pleas e edit in Ins Mgmt." | |
5471 | "RTN","IBC NSMM",65,0 ) | |
5472 | ; | |
5473 | "RTN","IBC NSMM",66,0 ) | |
5474 | I $D(IBAR R("B",2)) K IBARR("B ") D | |
5475 | "RTN","IBC NSMM",67,0 ) | |
5476 | .W !!,"Th is patient has more than one P art B poli cy. Pleas e edit in Ins Mgmt." | |
5477 | "RTN","IBC NSMM",68,0 ) | |
5478 | ; | |
5479 | "RTN","IBC NSMM",69,0 ) | |
5480 | I (IBPOLA !IBPOLB),' $D(IBARR) G ENRQ | |
5481 | "RTN","IBC NSMM",70,0 ) | |
5482 | ; | |
5483 | "RTN","IBC NSMM",71,0 ) | |
5484 | ; -- Ask for Medica re Insuran ce Card in formation | |
5485 | "RTN","IBC NSMM",72,0 ) | |
5486 | ; Retu rn IBNAME, IBHICN, I BAEFF, IBB EFF, IBCOB /IBCOBI | |
5487 | "RTN","IBC NSMM",73,0 ) | |
5488 | D MII^IBC NSMM2 I IB QUIT G ENR Q | |
5489 | "RTN","IBC NSMM",74,0 ) | |
5490 | ; | |
5491 | "RTN","IBC NSMM",75,0 ) | |
5492 | ; - if Pa rt A or B exists, bu t no chang es, quit | |
5493 | "RTN","IBC NSMM",76,0 ) | |
5494 | I $D(IBAR R("A",1)) D COM($P(I BARR("A",1 ),"^",2,99 ),"A") I I BHIT D | |
5495 | "RTN","IBC NSMM",77,0 ) | |
5496 | .S IBHITA =1 W !," * No Part A changes made..." | |
5497 | "RTN","IBC NSMM",78,0 ) | |
5498 | ; | |
5499 | "RTN","IBC NSMM",79,0 ) | |
5500 | I $D(IBAR R("B",1)) D COM($P(I BARR("B",1 ),"^",2,99 ),"B") I I BHIT D | |
5501 | "RTN","IBC NSMM",80,0 ) | |
5502 | .S IBHITB =1 W !," * No Part B changes made..." | |
5503 | "RTN","IBC NSMM",81,0 ) | |
5504 | ; | |
5505 | "RTN","IBC NSMM",82,0 ) | |
5506 | I $G(IBHI TA),$G(IBH ITB) G ENR Q | |
5507 | "RTN","IBC NSMM",83,0 ) | |
5508 | I $G(IBHI TA),'$G(IB BEFF) G EN RQ | |
5509 | "RTN","IBC NSMM",84,0 ) | |
5510 | I $G(IBHI TB),'$G(IB AEFF) G EN RQ | |
5511 | "RTN","IBC NSMM",85,0 ) | |
5512 | ; | |
5513 | "RTN","IBC NSMM",86,0 ) | |
5514 | ;IB*595 R emoved abi lity to fi le directl y into Ins urance Typ e File | |
5515 | "RTN","IBC NSMM",87,0 ) | |
5516 | I IBAEFF, '$G(IBHITA ) D BUFF^I BCNSMM1("A ") | |
5517 | "RTN","IBC NSMM",88,0 ) | |
5518 | I IBBEFF, '$G(IBHITB ) D BUFF^I BCNSMM1("B ") | |
5519 | "RTN","IBC NSMM",89,0 ) | |
5520 | ; | |
5521 | "RTN","IBC NSMM",90,0 ) | |
5522 | ; -- If u ser not ho lding key set data i n Buffer F ile | |
5523 | "RTN","IBC NSMM",91,0 ) | |
5524 | ;I '$D(^X USEC("IB I NSURANCE S UPERVISOR" ,DUZ)) D G ENRQ | |
5525 | "RTN","IBC NSMM",92,0 ) | |
5526 | ;.I IBAEF F,'$G(IBHI TA) D BUFF ^IBCNSMM1( "A") | |
5527 | "RTN","IBC NSMM",93,0 ) | |
5528 | ;.I IBBEF F,'$G(IBHI TB) D BUFF ^IBCNSMM1( "B") | |
5529 | "RTN","IBC NSMM",94,0 ) | |
5530 | ; | |
5531 | "RTN","IBC NSMM",95,0 ) | |
5532 | ; -- Othe rwise, set data into permanent files | |
5533 | "RTN","IBC NSMM",96,0 ) | |
5534 | ;I IBAEFF ,'$G(IBHIT A) D | |
5535 | "RTN","IBC NSMM",97,0 ) | |
5536 | ;.I IBPOL A,'$D(IBAR R("A")) Q ; can't up date Part A policy | |
5537 | "RTN","IBC NSMM",98,0 ) | |
5538 | ;.I '$D(I BARR("A",1 )) D ADDP( "A") Q | |
5539 | "RTN","IBC NSMM",99,0 ) | |
5540 | ;.S IBCDF N=+IBARR(" A",1) D SE TP^IBCNSMM 1("A") | |
5541 | "RTN","IBC NSMM",100, 0) | |
5542 | ;I IBBEFF ,'$G(IBHIT B) D | |
5543 | "RTN","IBC NSMM",101, 0) | |
5544 | ;.I IBPOL B,'$D(IBAR R("B")) Q ; can't up date Part B policy | |
5545 | "RTN","IBC NSMM",102, 0) | |
5546 | ;.I '$D(I BARR("B",1 )) D ADDP( "B") Q | |
5547 | "RTN","IBC NSMM",103, 0) | |
5548 | ;.S IBCDF N=+IBARR(" B",1) D SE TP^IBCNSMM 1("B") | |
5549 | "RTN","IBC NSMM",104, 0) | |
5550 | ;IB*595 E ND | |
5551 | "RTN","IBC NSMM",105, 0) | |
5552 | ; | |
5553 | "RTN","IBC NSMM",106, 0) | |
5554 | ENRQ W ! Q | |
5555 | "RTN","IBC NSMM",107, 0) | |
5556 | ; | |
5557 | "RTN","IBC NSMM",108, 0) | |
5558 | ; | |
5559 | "RTN","IBC NSMM",109, 0) | |
5560 | ; | |
5561 | "RTN","IBC NSMM",110, 0) | |
5562 | ADDP(IBP) ; -- Creat e a new pa tient poli cy | |
5563 | "RTN","IBC NSMM",111, 0) | |
5564 | ; Inpu t: DFN | |
5565 | "RTN","IBC NSMM",112, 0) | |
5566 | ; IBCNSP= MED WNR IN S IEN^MEDI CARE (WNR) | |
5567 | "RTN","IBC NSMM",113, 0) | |
5568 | ; ^PART A IE N^PART A | |
5569 | "RTN","IBC NSMM",114, 0) | |
5570 | ; ^PART B IE N^PART A | |
5571 | "RTN","IBC NSMM",115, 0) | |
5572 | ; IBP = " A" or "B" for medica re part | |
5573 | "RTN","IBC NSMM",116, 0) | |
5574 | ; IBSOUR = Source o f Informat ion | |
5575 | "RTN","IBC NSMM",117, 0) | |
5576 | ; Retur n: IBCDFN= -1 could n ot add OR Policy ien | |
5577 | "RTN","IBC NSMM",118, 0) | |
5578 | ; IBCOVP= Covered b y Health I nsurance | |
5579 | "RTN","IBC NSMM",119, 0) | |
5580 | ; | |
5581 | "RTN","IBC NSMM",120, 0) | |
5582 | N X,Y,DO, DD,DA,DR,D IC,DIE,DIK ,DIR,DIRUT ,IBSPEC | |
5583 | "RTN","IBC NSMM",121, 0) | |
5584 | ; -- Crea te a New p atient pol icy | |
5585 | "RTN","IBC NSMM",122, 0) | |
5586 | S IBCOVP= $P($G(^DPT (DFN,.31)) ,U,11) | |
5587 | "RTN","IBC NSMM",123, 0) | |
5588 | ; | |
5589 | "RTN","IBC NSMM",124, 0) | |
5590 | D FIELD^D ID(2,.3121 ,"","SPECI FIER","IBS PEC") | |
5591 | "RTN","IBC NSMM",125, 0) | |
5592 | S DIC("DR ")="1.09// //"_IBSOUR _";1.05/// NOW;1.06// //"_DUZ,DI C("P")=$G( IBSPEC("SP ECIFIER")) | |
5593 | "RTN","IBC NSMM",126, 0) | |
5594 | K DD,DO S DA(1)=DFN ,DIC="^DPT ("_DFN_",. 312,",DIC( 0)="L",X=+ IBCNSP,DLA YGO=2.312 | |
5595 | "RTN","IBC NSMM",127, 0) | |
5596 | D FILE^DI CN K DD,DO ,DLAYGO,DI C | |
5597 | "RTN","IBC NSMM",128, 0) | |
5598 | S IBCDFN= +Y | |
5599 | "RTN","IBC NSMM",129, 0) | |
5600 | I IBCDFN< 1 W !!,*7, " <Could not create new polic y at this time. Try Later!>", ! G ADDPQ | |
5601 | "RTN","IBC NSMM",130, 0) | |
5602 | ; | |
5603 | "RTN","IBC NSMM",131, 0) | |
5604 | ; -- Set Medicare p olicy data | |
5605 | "RTN","IBC NSMM",132, 0) | |
5606 | D SETP^IB CNSMM1(IBP ) | |
5607 | "RTN","IBC NSMM",133, 0) | |
5608 | ADDPQ Q | |
5609 | "RTN","IBC NSMM",134, 0) | |
5610 | ; | |
5611 | "RTN","IBC NSMM",135, 0) | |
5612 | ; | |
5613 | "RTN","IBC NSMM",136, 0) | |
5614 | GETWNR ; | |
5615 | "RTN","IBC NSMM",137, 0) | |
5616 | ; -- Get Medicare ( WNR) insur ance compa ny and pla n data | |
5617 | "RTN","IBC NSMM",138, 0) | |
5618 | ; Retu rns IBCNSP or IBQUIT | |
5619 | "RTN","IBC NSMM",139, 0) | |
5620 | ; IBCN SP="Error: Medicare (WNR) ... not setup properly" | |
5621 | "RTN","IBC NSMM",140, 0) | |
5622 | ; if Medi care WNR e ntry or pl ans not se tup proper ly | |
5623 | "RTN","IBC NSMM",141, 0) | |
5624 | ; | |
5625 | "RTN","IBC NSMM",142, 0) | |
5626 | ; IBCN SP=INS CO. (36) IEN^ "MEDICARE (WNR)" | |
5627 | "RTN","IBC NSMM",143, 0) | |
5628 | ; ^PLAN ( 355.3) PAR TA IEN^"PA RT A" | |
5629 | "RTN","IBC NSMM",144, 0) | |
5630 | ; ^PLAN ( 355.3) PAR TB IEN^"PA RT B" | |
5631 | "RTN","IBC NSMM",145, 0) | |
5632 | ; | |
5633 | "RTN","IBC NSMM",146, 0) | |
5634 | I 'IBCNSP S IBCNSP= $$GETWNR^I BCNSMM1 | |
5635 | "RTN","IBC NSMM",147, 0) | |
5636 | I 'IBCNSP W !!,*7,? 3,IBCNSP S IBQUIT=1 | |
5637 | "RTN","IBC NSMM",148, 0) | |
5638 | Q | |
5639 | "RTN","IBC NSMM",149, 0) | |
5640 | ; | |
5641 | "RTN","IBC NSMM",150, 0) | |
5642 | VALHIC(X) ; Edits fo r validati ng HIC # | |
5643 | "RTN","IBC NSMM",151, 0) | |
5644 | ; X = the HIC # to be validat ed | |
5645 | "RTN","IBC NSMM",152, 0) | |
5646 | ;IB*2.0*6 01 JRA Rem ove specia l HIC # va lidation - use exist ing error messages I B356/IB357 /IB358 whe n the | |
5647 | "RTN","IBC NSMM",153, 0) | |
5648 | ; Primary /Secondary /Tertiary insurance subscriber 's ID numb er is miss ing (as wi th other i nsurances) . | |
5649 | "RTN","IBC NSMM",154, 0) | |
5650 | ; | |
5651 | "RTN","IBC NSMM",155, 0) | |
5652 | ;IB*2.0*6 01 JRA QUI T '1' to r emove spec ial valida tion for H IC #, whic h will pre vent the d isplay of IB Error | |
5653 | "RTN","IBC NSMM",156, 0) | |
5654 | ; message IB215 and the HIC # help text at HLP^IB CNSM32. | |
5655 | "RTN","IBC NSMM",157, 0) | |
5656 | Q 1 ;IB* 2.0*601 JR A | |
5657 | "RTN","IBC NSMM",158, 0) | |
5658 | N VAL | |
5659 | "RTN","IBC NSMM",159, 0) | |
5660 | S VAL=1 | |
5661 | "RTN","IBC NSMM",160, 0) | |
5662 | I X'?9N1A .1AN,X'?1. 3A6N,X'?1. 3A9N S VAL =0 | |
5663 | "RTN","IBC NSMM",161, 0) | |
5664 | Q VAL | |
5665 | "RTN","IBC NSMM",162, 0) | |
5666 | ; | |
5667 | "RTN","IBC NSMM",163, 0) | |
5668 | COM(X,Y) ; Compare X with the intake var iables. | |
5669 | "RTN","IBC NSMM",164, 0) | |
5670 | ; Inpu t: X => 0t h node of policy in file #2.31 2 | |
5671 | "RTN","IBC NSMM",165, 0) | |
5672 | ; Y => A (Part A) o r B (part B) | |
5673 | "RTN","IBC NSMM",166, 0) | |
5674 | ; Outpu t: IBHIT=1 (no chang es made) | |
5675 | "RTN","IBC NSMM",167, 0) | |
5676 | S IBHIT=0 | |
5677 | "RTN","IBC NSMM",168, 0) | |
5678 | I $P(X,"^ ",17)'=IBN AME G COMQ | |
5679 | "RTN","IBC NSMM",169, 0) | |
5680 | I $P(X,"^ ",2)'=IBHI CN G COMQ | |
5681 | "RTN","IBC NSMM",170, 0) | |
5682 | I $P(X,"^ ",8)'=$S(Y ="A":IBAEF F,1:IBBEFF ) G COMQ | |
5683 | "RTN","IBC NSMM",171, 0) | |
5684 | I $P(X,"^ ",20)'=IBC OBI G COMQ | |
5685 | "RTN","IBC NSMM",172, 0) | |
5686 | ; | |
5687 | "RTN","IBC NSMM",173, 0) | |
5688 | S IBHIT=1 | |
5689 | "RTN","IBC NSMM",174, 0) | |
5690 | COMQ Q | |
5691 | "RTN","IBC NSMM1") | |
5692 | 0^16^B2778 8048^B2781 8840 | |
5693 | "RTN","IBC NSMM1",1,0 ) | |
5694 | IBCNSMM1 ; ALB/CMS -M EDICARE IN SURANCE IN TAKE (CONT ) ; 11/8/0 6 9:32am | |
5695 | "RTN","IBC NSMM1",2,0 ) | |
5696 | ;;2.0;INT EGRATED BI LLING;**10 3,359,497, 602**;21-M AR-94;Buil d 22 | |
5697 | "RTN","IBC NSMM1",3,0 ) | |
5698 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
5699 | "RTN","IBC NSMM1",4,0 ) | |
5700 | ;;(THIS R OUTINE WAS DEACTIVAT ED VIA PAT CH 497...A ND SHOULD BE RESEARC HED | |
5701 | "RTN","IBC NSMM1",5,0 ) | |
5702 | ;;IF REAC TIVATED... REFER TO F IELDS (40. 02, 40.03, 60.04, 60 .07 OF THE | |
5703 | "RTN","IBC NSMM1",6,0 ) | |
5704 | ;;355.33 FILE.) | |
5705 | "RTN","IBC NSMM1",7,0 ) | |
5706 | Q | |
5707 | "RTN","IBC NSMM1",8,0 ) | |
5708 | ; | |
5709 | "RTN","IBC NSMM1",9,0 ) | |
5710 | SETP(IBP) ; -- Stuff data fiel ds in pati ent policy | |
5711 | "RTN","IBC NSMM1",10, 0) | |
5712 | ; Requir ed Input: | |
5713 | "RTN","IBC NSMM1",11, 0) | |
5714 | ; IBP =A for Part A, B for P art B | |
5715 | "RTN","IBC NSMM1",12, 0) | |
5716 | ; DFN =p t. ien | |
5717 | "RTN","IBC NSMM1",13, 0) | |
5718 | ; IBCDFN =patient policy ien | |
5719 | "RTN","IBC NSMM1",14, 0) | |
5720 | ; IBNAME =Name of Insured | |
5721 | "RTN","IBC NSMM1",15, 0) | |
5722 | ; IBHICN =Subscrib er ID - as of IB*601 could als o be a MBI Number | |
5723 | "RTN","IBC NSMM1",16, 0) | |
5724 | ; IBAEFF =Effectiv e Date of Plan A | |
5725 | "RTN","IBC NSMM1",17, 0) | |
5726 | ; IBBEFF =Effectiv e Date of Plan B | |
5727 | "RTN","IBC NSMM1",18, 0) | |
5728 | ; IBCNSP =Medicare (WNR) ien ^Part A i en ^Part B ien | |
5729 | "RTN","IBC NSMM1",19, 0) | |
5730 | ; IBCOBI =Coordina tion of Be nefits (In ternal val ue) | |
5731 | "RTN","IBC NSMM1",20, 0) | |
5732 | ; | |
5733 | "RTN","IBC NSMM1",21, 0) | |
5734 | N D,DA,DI E,DR,IBBDA ,X,Y | |
5735 | "RTN","IBC NSMM1",22, 0) | |
5736 | I '$D(^DP T(DFN,.312 ,+IBCDFN,0 )) G SETPQ | |
5737 | "RTN","IBC NSMM1",23, 0) | |
5738 | ; | |
5739 | "RTN","IBC NSMM1",24, 0) | |
5740 | ; -- Stuf f the pt. policy fie lds | |
5741 | "RTN","IBC NSMM1",25, 0) | |
5742 | ; #2 * Group Numb er #.18 Group Pl an | |
5743 | "RTN","IBC NSMM1",26, 0) | |
5744 | ; #6 W hose Ins. #.2 COB | |
5745 | "RTN","IBC NSMM1",27, 0) | |
5746 | ; #8 E ffective D ate of Pol icy #7.0 2 Sub. ID | |
5747 | "RTN","IBC NSMM1",28, 0) | |
5748 | ; #15 * Group Name #7.0 1 Name o f Insured | |
5749 | "RTN","IBC NSMM1",29, 0) | |
5750 | ; #16 P t. Relatio nship to I nsured | |
5751 | "RTN","IBC NSMM1",30, 0) | |
5752 | ; | |
5753 | "RTN","IBC NSMM1",31, 0) | |
5754 | S DIE="^D PT("_DFN_" ,.312,",DA =+IBCDFN,D A(1)=DFN | |
5755 | "RTN","IBC NSMM1",32, 0) | |
5756 | S DR="2// /"_$S(IBP= "A":$P(IBC NSP,U,4),I BP="B":$P( IBCNSP,U,6 ),1:"") | |
5757 | "RTN","IBC NSMM1",33, 0) | |
5758 | S DR=DR_" ;7.01///"_ IBNAME_";7 .02///"_IB HICN ; IB*2.0* 497 (vd) | |
5759 | "RTN","IBC NSMM1",34, 0) | |
5760 | S DR=DR_" ;6///v;8// /"_$S(IBP= "A":$G(IBA EFF),IBP=" B":$G(IBBE FF),1:"") | |
5761 | "RTN","IBC NSMM1",35, 0) | |
5762 | S DR=DR_" ;.2////"_I BCOBI_";15 ///"_$S(IB P="A":"PAR T A",IBP=" B":"PART B ",1:"") | |
5763 | "RTN","IBC NSMM1",36, 0) | |
5764 | S DR=DR_" ;16///01;. 18////"_$S (IBP="A":+ $P(IBCNSP, U,3),IBP=" B":+$P(IBC NSP,U,5),1 :"") | |
5765 | "RTN","IBC NSMM1",37, 0) | |
5766 | D ^DIE | |
5767 | "RTN","IBC NSMM1",38, 0) | |
5768 | ; | |
5769 | "RTN","IBC NSMM1",39, 0) | |
5770 | ; -- Upd ate Insura nce Event | |
5771 | "RTN","IBC NSMM1",40, 0) | |
5772 | S IBCOVP= $P($G(^DPT (DFN,.31)) ,U,11) | |
5773 | "RTN","IBC NSMM1",41, 0) | |
5774 | D BEFORE^ IBCNSEVT S IBNEW=1 | |
5775 | "RTN","IBC NSMM1",42, 0) | |
5776 | ; | |
5777 | "RTN","IBC NSMM1",43, 0) | |
5778 | ; -- Ask to Verify at this ti me | |
5779 | "RTN","IBC NSMM1",44, 0) | |
5780 | K DIR S D IR("A")="V erify Medi care (WNR) Part "_IB P_" Covera ge Now" | |
5781 | "RTN","IBC NSMM1",45, 0) | |
5782 | S DIR("?" )="Enter ' No' to not Verify Co verage at this time. " | |
5783 | "RTN","IBC NSMM1",46, 0) | |
5784 | W ! S IBO K=0 D OK I 'IBOK G S ETEV | |
5785 | "RTN","IBC NSMM1",47, 0) | |
5786 | ; | |
5787 | "RTN","IBC NSMM1",48, 0) | |
5788 | ; -- Chec k to see i f Pt. Name = name of Insured | |
5789 | "RTN","IBC NSMM1",49, 0) | |
5790 | I IBNAME' =$P($G(^DP T(DFN,0)), U,1) D | |
5791 | "RTN","IBC NSMM1",50, 0) | |
5792 | .W !!,"WA RNING: Pat ient Name: '"_$P($G( ^DPT(DFN,0 )),U,1)_"' DOES NOT MATCH" | |
5793 | "RTN","IBC NSMM1",51, 0) | |
5794 | .W !," Name of Insured: '"_IBNAME_ "'.",! | |
5795 | "RTN","IBC NSMM1",52, 0) | |
5796 | ; | |
5797 | "RTN","IBC NSMM1",53, 0) | |
5798 | ; -- veri fy policy | |
5799 | "RTN","IBC NSMM1",54, 0) | |
5800 | S DIE="^D PT("_DFN_" ,.312,",DA =IBCDFN,DA (1)=DFN | |
5801 | "RTN","IBC NSMM1",55, 0) | |
5802 | S DR="1.0 3///NOW;1. 04////"_DU Z D ^DIE | |
5803 | "RTN","IBC NSMM1",56, 0) | |
5804 | W !," PA RT "_IBP_" COVERAGE VERIFIED." | |
5805 | "RTN","IBC NSMM1",57, 0) | |
5806 | ; | |
5807 | "RTN","IBC NSMM1",58, 0) | |
5808 | SETEV ; -- Update In surance ev ent | |
5809 | "RTN","IBC NSMM1",59, 0) | |
5810 | N X,Y | |
5811 | "RTN","IBC NSMM1",60, 0) | |
5812 | D COVERED ^IBCNSM31( DFN,IBCOVP ) | |
5813 | "RTN","IBC NSMM1",61, 0) | |
5814 | I $G(IBCD FN)>0,IBNE W=1 D AFTE R^IBCNSEVT ,^IBCNSEVT | |
5815 | "RTN","IBC NSMM1",62, 0) | |
5816 | ; | |
5817 | "RTN","IBC NSMM1",63, 0) | |
5818 | SETPQ Q | |
5819 | "RTN","IBC NSMM1",64, 0) | |
5820 | ; | |
5821 | "RTN","IBC NSMM1",65, 0) | |
5822 | ; | |
5823 | "RTN","IBC NSMM1",66, 0) | |
5824 | BUFF(IBP) ; -- Set I BBUF array with poli cy info fo r Buffer F ile | |
5825 | "RTN","IBC NSMM1",67, 0) | |
5826 | ; Return: IBBUF arr ay | |
5827 | "RTN","IBC NSMM1",68, 0) | |
5828 | ; IBBU F(355.33 f ield #s)=c orrespondi ng policy, plan and company da ta | |
5829 | "RTN","IBC NSMM1",69, 0) | |
5830 | ; i.e. IBBUF(20 .01)=Insur ance Compa ny Name | |
5831 | "RTN","IBC NSMM1",70, 0) | |
5832 | ; IBBUF(90 .01)=Group Name | |
5833 | "RTN","IBC NSMM1",71, 0) | |
5834 | ; IBBUF(60 .01)=DFN | |
5835 | "RTN","IBC NSMM1",72, 0) | |
5836 | ; | |
5837 | "RTN","IBC NSMM1",73, 0) | |
5838 | ; Input: DFN, IBCNS P, IBNAME, IBHICN, I BAEFF, IBB EFF, IBCOB I | |
5839 | "RTN","IBC NSMM1",74, 0) | |
5840 | ; | |
5841 | "RTN","IBC NSMM1",75, 0) | |
5842 | ; Auto st uff other fields | |
5843 | "RTN","IBC NSMM1",76, 0) | |
5844 | ; | |
5845 | "RTN","IBC NSMM1",77, 0) | |
5846 | N IBP0 K IBBUF S IB BUF="" | |
5847 | "RTN","IBC NSMM1",78, 0) | |
5848 | S IBBUF(. 03)=$G(IBS OUR) | |
5849 | "RTN","IBC NSMM1",79, 0) | |
5850 | S IBBUF(2 0.01)=$P(I BCNSP,U,2) | |
5851 | "RTN","IBC NSMM1",80, 0) | |
5852 | S IBBUF(9 0.01)=$S(I BP="A":$P( IBCNSP,U,4 ),IBP="B": $P(IBCNSP, U,6),1:"") ; IB*2. 0*497 (vd) | |
5853 | "RTN","IBC NSMM1",81, 0) | |
5854 | S IBBUF(9 0.02)=IBBU F(90.01) ; IB*2.0*49 7 (vd) | |
5855 | "RTN","IBC NSMM1",82, 0) | |
5856 | S IBBUF(6 0.01)=+DFN | |
5857 | "RTN","IBC NSMM1",83, 0) | |
5858 | S IBBUF(6 0.02)=$S(I BP="A":IBA EFF,IBP="B ":IBBEFF,1 :"") | |
5859 | "RTN","IBC NSMM1",84, 0) | |
5860 | S IBBUF(9 0.03)=IBHI CN ; IB*2.0*49 7 (vd) | |
5861 | "RTN","IBC NSMM1",85, 0) | |
5862 | S IBBUF(6 0.05)="v" | |
5863 | "RTN","IBC NSMM1",86, 0) | |
5864 | S IBBUF(6 0.06)="01" | |
5865 | "RTN","IBC NSMM1",87, 0) | |
5866 | S IBBUF(9 1.01)=IBNA ME ; IB*2.0*49 7 (vd) | |
5867 | "RTN","IBC NSMM1",88, 0) | |
5868 | S IBBUF(6 0.12)=IBCO BI | |
5869 | "RTN","IBC NSMM1",89, 0) | |
5870 | S IBBDA=$ $ADDSTF^IB CNBES(1,DF N,.IBBUF) | |
5871 | "RTN","IBC NSMM1",90, 0) | |
5872 | I +IBBDA W !,?3,$P( IBCNSP,U,2 )," PART " _IBP_" ent ry #"_+IBB DA_" added to Insura nce Buffer File." | |
5873 | "RTN","IBC NSMM1",91, 0) | |
5874 | I 'IBBDA W !,*7,?3, "Warning: Could not add new po licy Part "_IBP_" in Buffer Fi le.",!,?13 ,"("_$P(IB BDA,U,2)_" )",! | |
5875 | "RTN","IBC NSMM1",92, 0) | |
5876 | Q | |
5877 | "RTN","IBC NSMM1",93, 0) | |
5878 | ; | |
5879 | "RTN","IBC NSMM1",94, 0) | |
5880 | OK ; -- as k okay | |
5881 | "RTN","IBC NSMM1",95, 0) | |
5882 | N DTOUT,D IROUT,DIRU T,DUOUT,X, Y | |
5883 | "RTN","IBC NSMM1",96, 0) | |
5884 | ; Returns : | |
5885 | "RTN","IBC NSMM1",97, 0) | |
5886 | ; IBQUIT= 1 Exit use r timedout | |
5887 | "RTN","IBC NSMM1",98, 0) | |
5888 | ; IBOK= 1 Yes | |
5889 | "RTN","IBC NSMM1",99, 0) | |
5890 | ; IBOK= 0 No | |
5891 | "RTN","IBC NSMM1",100 ,0) | |
5892 | S IBQUIT= 0,DIR(0)=" Y",DIR("B" )="YES" W ! | |
5893 | "RTN","IBC NSMM1",101 ,0) | |
5894 | I $G(DIR( "A"))="" S DIR("A")= "Is this D ata Correc t" | |
5895 | "RTN","IBC NSMM1",102 ,0) | |
5896 | I $G(DIR( "?"))="" S DIR("?")= "Enter 'No ' to edit Medicare C ard inform ation" | |
5897 | "RTN","IBC NSMM1",103 ,0) | |
5898 | D ^DIR K DIR | |
5899 | "RTN","IBC NSMM1",104 ,0) | |
5900 | I $D(DTOU T) S IBQUI T=1 | |
5901 | "RTN","IBC NSMM1",105 ,0) | |
5902 | S IBOK=$G (Y) I IBOK ["^" S IBQ UIT=1 | |
5903 | "RTN","IBC NSMM1",106 ,0) | |
5904 | Q | |
5905 | "RTN","IBC NSMM1",107 ,0) | |
5906 | ; | |
5907 | "RTN","IBC NSMM1",108 ,0) | |
5908 | GETWNR() ; -- Find a nd return the MEDICA RE (WNR) i en | |
5909 | "RTN","IBC NSMM1",109 ,0) | |
5910 | ; -- Return s Error me ssage or | |
5911 | "RTN","IBC NSMM1",110 ,0) | |
5912 | ; DIC(36 IEN ^"MED ICARE (WNR )"^IBA(355 .3 PART A IEN ^"PART A"^ IBA(3 55.3 PART B IEN ^"PA RT B" | |
5913 | "RTN","IBC NSMM1",111 ,0) | |
5914 | ; | |
5915 | "RTN","IBC NSMM1",112 ,0) | |
5916 | N IBWNR,I B0,IBP0,IB Q,IBPQ,IBP X,IBX,IBY, IBPGN | |
5917 | "RTN","IBC NSMM1",113 ,0) | |
5918 | S IBY="ME DICARE (WN R)",IBQ=0 | |
5919 | "RTN","IBC NSMM1",114 ,0) | |
5920 | S IBX=0 F S IBX=$O (^DIC(36," B",IBY,IBX )) Q:('IBX ) D Q:IB Q | |
5921 | "RTN","IBC NSMM1",115 ,0) | |
5922 | .S IB0=$G (^DIC(36,I BX,0)) | |
5923 | "RTN","IBC NSMM1",116 ,0) | |
5924 | .K IBWNR( "INS") | |
5925 | "RTN","IBC NSMM1",117 ,0) | |
5926 | .I $P(IB0 ,U,1)'=IBY Q ;name | |
5927 | "RTN","IBC NSMM1",118 ,0) | |
5928 | .I $P(IB0 ,U,2)'="N" Q ;Reimb ? | |
5929 | "RTN","IBC NSMM1",119 ,0) | |
5930 | .;I '$P(I B0,U,3) Q ;Sig Req. --> remo ved edit, cm, 5/18/9 9 | |
5931 | "RTN","IBC NSMM1",120 ,0) | |
5932 | .I $P(IB0 ,U,5) Q ; Inactive | |
5933 | "RTN","IBC NSMM1",121 ,0) | |
5934 | .I $P($G( ^IBE(355.2 ,+$P(IB0,U ,13),0)),U )'="MEDICA RE" Q ;Ma jor Cat. | |
5935 | "RTN","IBC NSMM1",122 ,0) | |
5936 | .S IBWNR( "INS")=IBX _U_IBY | |
5937 | "RTN","IBC NSMM1",123 ,0) | |
5938 | .; | |
5939 | "RTN","IBC NSMM1",124 ,0) | |
5940 | .; -- Mus t have Act ive Group Plan Categ ory Medica re Part A and B | |
5941 | "RTN","IBC NSMM1",125 ,0) | |
5942 | .; | |
5943 | "RTN","IBC NSMM1",126 ,0) | |
5944 | .K IBWNR( "A"),IBWNR ("B") | |
5945 | "RTN","IBC NSMM1",127 ,0) | |
5946 | .S IBPX=0 F S IBPX =$O(^IBA(3 55.3,"B",I BX,IBPX)) Q:('IBPX)! (IBQ) D | |
5947 | "RTN","IBC NSMM1",128 ,0) | |
5948 | ..S IBP0= $G(^IBA(35 5.3,IBPX,0 )) | |
5949 | "RTN","IBC NSMM1",129 ,0) | |
5950 | ..I $P(IB P0,U,11) Q ;Inactiv e | |
5951 | "RTN","IBC NSMM1",130 ,0) | |
5952 | ..I $P(IB P0,U,14)'= "A",$P(IBP 0,U,14)'=" B" Q ;Not Plan Cate gory Part A or B | |
5953 | "RTN","IBC NSMM1",131 ,0) | |
5954 | ..S IBPGN =$TR($P(IB P0,U,3),"a bcdefghijk lmnopqrstu vwxyz","AB CDEFGHIJKL MNOPQRSTUV WXYZ") | |
5955 | "RTN","IBC NSMM1",132 ,0) | |
5956 | ..I IBPGN '="PART A" ,IBPGN'="P ART B" Q ;excludes non PART A and PART B plans | |
5957 | "RTN","IBC NSMM1",133 ,0) | |
5958 | ..S IBWNR ($P(IBP0,U ,14))=IBPX _U_$P(IBP0 ,U,3) | |
5959 | "RTN","IBC NSMM1",134 ,0) | |
5960 | ..I $G(IB WNR("A")), $G(IBWNR(" B")) S IBQ =1 | |
5961 | "RTN","IBC NSMM1",135 ,0) | |
5962 | ; | |
5963 | "RTN","IBC NSMM1",136 ,0) | |
5964 | S IBX=$G( IBWNR("INS "))_U_$G(I BWNR("A")) _U_$G(IBWN R("B")) | |
5965 | "RTN","IBC NSMM1",137 ,0) | |
5966 | I 'IBX S IBX="Error : Standard Medicare (WNR) Insu rance Comp any not se tup proper ly." G GET WNRQ | |
5967 | "RTN","IBC NSMM1",138 ,0) | |
5968 | I '$P(IBX ,U,3) S IB X="Error: Standard M edicare (W NR) plan P ART A not setup prop erly." G G ETWNRQ | |
5969 | "RTN","IBC NSMM1",139 ,0) | |
5970 | I '$G(IBW NR("B")) S IBX="Erro r: Standar d Medicare (WNR) pla n PART B n ot setup p roperly." | |
5971 | "RTN","IBC NSMM1",140 ,0) | |
5972 | GETWNRQ Q IBX | |
5973 | "RTN","IBC NSMM2") | |
5974 | 0^14^B1523 4233^B1687 1457 | |
5975 | "RTN","IBC NSMM2",1,0 ) | |
5976 | IBCNSMM2 ; ALB/CMS -M EDICARE IN SURANCE IN TAKE (CONT ) ; 18-MAY -99 | |
5977 | "RTN","IBC NSMM2",2,0 ) | |
5978 | ;;2.0;INT EGRATED BI LLING;**10 3,133,602* *;21-MAR-9 4;Build 22 | |
5979 | "RTN","IBC NSMM2",3,0 ) | |
5980 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
5981 | "RTN","IBC NSMM2",4,0 ) | |
5982 | Q | |
5983 | "RTN","IBC NSMM2",5,0 ) | |
5984 | ; | |
5985 | "RTN","IBC NSMM2",6,0 ) | |
5986 | ; | |
5987 | "RTN","IBC NSMM2",7,0 ) | |
5988 | MII ; -- A sk Medicar e Insuranc e Card que stions | |
5989 | "RTN","IBC NSMM2",8,0 ) | |
5990 | ; | |
5991 | "RTN","IBC NSMM2",9,0 ) | |
5992 | ; Output Variables : | |
5993 | "RTN","IBC NSMM2",10, 0) | |
5994 | ; IBNAME = Name of Insured | |
5995 | "RTN","IBC NSMM2",11, 0) | |
5996 | ; IBHICN = Subscri ber ID as of IB*601 could also be a MBI Number | |
5997 | "RTN","IBC NSMM2",12, 0) | |
5998 | ; IBAEFF = Effecti ve Date fo r Part A | |
5999 | "RTN","IBC NSMM2",13, 0) | |
6000 | ; IBBEFF = Effecti ve Date fo r Part B | |
6001 | "RTN","IBC NSMM2",14, 0) | |
6002 | ; IBCOB/ IBCOBI = C oordinatio n of Benef its | |
6003 | "RTN","IBC NSMM2",15, 0) | |
6004 | ; IBQUIT =1 User ti med-out or entered ^ | |
6005 | "RTN","IBC NSMM2",16, 0) | |
6006 | ; | |
6007 | "RTN","IBC NSMM2",17, 0) | |
6008 | N DIR,DTO UT,DUOUT,D IROUT,DIRU T,X,Y,IBX | |
6009 | "RTN","IBC NSMM2",18, 0) | |
6010 | ; | |
6011 | "RTN","IBC NSMM2",19, 0) | |
6012 | MIIA ; -- Ask user f or Informa tion | |
6013 | "RTN","IBC NSMM2",20, 0) | |
6014 | ; | |
6015 | "RTN","IBC NSMM2",21, 0) | |
6016 | W ! S DIR ("A")="NAM E OF BENEF ICIARY" | |
6017 | "RTN","IBC NSMM2",22, 0) | |
6018 | S IBX=$P( $G(IBARR(" A",1)),"^" ,18) I IBX ="" S IBX= $P($G(IBAR R("B",1)), "^",18) | |
6019 | "RTN","IBC NSMM2",23, 0) | |
6020 | S DIR("B" )=$S($G(IB NAME)'="": IBNAME,IBX '="":IBX,1 :$P(^DPT(D FN,0),U)) | |
6021 | "RTN","IBC NSMM2",24, 0) | |
6022 | S DIR(0)= "F^3:30^K: X'?1E.E1"" ,"".1E.E X " | |
6023 | "RTN","IBC NSMM2",25, 0) | |
6024 | S DIR("?" )="Enter t he Name of Beneficia ry (Last n ame, First ) from the Medicare Insurance Card. Thi s name sho uld be 3 t o 30 chara cters in l ength." | |
6025 | "RTN","IBC NSMM2",26, 0) | |
6026 | D ^DIR K DIR | |
6027 | "RTN","IBC NSMM2",27, 0) | |
6028 | I $D(DTOU T)!$D(DUOU T) K DUOUT ,DTOUT,DIR OUT,DIRUT S IBQUIT=1 G MIIQ | |
6029 | "RTN","IBC NSMM2",28, 0) | |
6030 | S IBNAME= Y | |
6031 | "RTN","IBC NSMM2",29, 0) | |
6032 | ; | |
6033 | "RTN","IBC NSMM2",30, 0) | |
6034 | S DIR("A" )="MEDICAR E CLAIM NU MBER" | |
6035 | "RTN","IBC NSMM2",31, 0) | |
6036 | S IBX=$P( $G(IBARR(" A",1)),"^" ,3) I IBX= "" S IBX=$ P($G(IBARR ("B",1))," ^",3) | |
6037 | "RTN","IBC NSMM2",32, 0) | |
6038 | I $G(IBHI CN)'="" S DIR("B")=I BHICN | |
6039 | "RTN","IBC NSMM2",33, 0) | |
6040 | I IBX'="" ,'$D(DIR(" B")) S DIR ("B")=IBX | |
6041 | "RTN","IBC NSMM2",34, 0) | |
6042 | ;S DIR(0) ="F^7:15^I '$$VALHIC ^IBCNSMM($ TR(X,""-"" )) K X" ; IB*602 | |
6043 | "RTN","IBC NSMM2",35, 0) | |
6044 | S DIR(0)= "F^3:20" ; IB*602 | |
6045 | "RTN","IBC NSMM2",36, 0) | |
6046 | S DIR("?" )="^D HICH ^IBCNSMM2" | |
6047 | "RTN","IBC NSMM2",37, 0) | |
6048 | D ^DIR K DIR | |
6049 | "RTN","IBC NSMM2",38, 0) | |
6050 | I $D(DTOU T)!$D(DUOU T) K DUOUT ,DTOUT,DIR OUT,DIRUT S IBQUIT=1 G MIIQ | |
6051 | "RTN","IBC NSMM2",39, 0) | |
6052 | S IBHICN= $TR(Y,"-") ; Strip o ff any '-' | |
6053 | "RTN","IBC NSMM2",40, 0) | |
6054 | ; | |
6055 | "RTN","IBC NSMM2",41, 0) | |
6056 | ; - don't allow edi ting Part A date if more than one policy | |
6057 | "RTN","IBC NSMM2",42, 0) | |
6058 | I IBPOLA, '$D(IBARR( "A",1)) G MIIPB | |
6059 | "RTN","IBC NSMM2",43, 0) | |
6060 | S DIR("A" )="HOSPITA L INSURANC E (PART A) EFFECTIVE DATE" | |
6061 | "RTN","IBC NSMM2",44, 0) | |
6062 | S IBX=$P( $G(IBARR(" A",1)),"^" ,9) | |
6063 | "RTN","IBC NSMM2",45, 0) | |
6064 | I $G(IBAE FF) S Y=IB AEFF D D^D IQ S DIR(" B")=Y | |
6065 | "RTN","IBC NSMM2",46, 0) | |
6066 | I IBX'="" ,'$D(DIR(" B")) S Y=I BX D D^DIQ S DIR("B" )=Y | |
6067 | "RTN","IBC NSMM2",47, 0) | |
6068 | S DIR(0)= "DO^::E" | |
6069 | "RTN","IBC NSMM2",48, 0) | |
6070 | S DIR("?" )="Enter P ART A Effe ctive Date if shown on Medicar e Insuranc e Card." | |
6071 | "RTN","IBC NSMM2",49, 0) | |
6072 | D ^DIR K DIR | |
6073 | "RTN","IBC NSMM2",50, 0) | |
6074 | I $D(DTOU T)!$D(DUOU T) K DUOUT ,DTOUT,DIR OUT,DIRUT S IBQUIT=1 G MIIQ | |
6075 | "RTN","IBC NSMM2",51, 0) | |
6076 | S IBAEFF= Y | |
6077 | "RTN","IBC NSMM2",52, 0) | |
6078 | ; | |
6079 | "RTN","IBC NSMM2",53, 0) | |
6080 | MIIPB ; - don't allo w editing Part B dat e if more than one p olicy | |
6081 | "RTN","IBC NSMM2",54, 0) | |
6082 | I IBPOLB, '$D(IBARR( "B",1)) G MIIC | |
6083 | "RTN","IBC NSMM2",55, 0) | |
6084 | S DIR("A" )="MEDICAL INSURANCE (PART B) EFFECTIVE DATE" | |
6085 | "RTN","IBC NSMM2",56, 0) | |
6086 | S IBX=$P( $G(IBARR(" B",1)),"^" ,9) | |
6087 | "RTN","IBC NSMM2",57, 0) | |
6088 | I $G(IBBE FF) S Y=IB BEFF D D^D IQ S DIR(" B")=Y | |
6089 | "RTN","IBC NSMM2",58, 0) | |
6090 | I IBX'="" ,'$D(DIR(" B")) S Y=I BX D D^DIQ S DIR("B" )=Y | |
6091 | "RTN","IBC NSMM2",59, 0) | |
6092 | S DIR(0)= "DO^::E" | |
6093 | "RTN","IBC NSMM2",60, 0) | |
6094 | S DIR("?" )="Enter P ART B Effe ctive Date if shown on Medicar e Insuranc e Card." | |
6095 | "RTN","IBC NSMM2",61, 0) | |
6096 | D ^DIR K DIR | |
6097 | "RTN","IBC NSMM2",62, 0) | |
6098 | I $D(DTOU T)!$D(DUOU T) K DUOUT ,DTOUT,DIR OUT,DIRUT S IBQUIT=1 G MIIQ | |
6099 | "RTN","IBC NSMM2",63, 0) | |
6100 | S IBBEFF= Y | |
6101 | "RTN","IBC NSMM2",64, 0) | |
6102 | ; | |
6103 | "RTN","IBC NSMM2",65, 0) | |
6104 | MIIC ; - c heck effec tive dates before CO B prompt | |
6105 | "RTN","IBC NSMM2",66, 0) | |
6106 | I '$G(IBA EFF),'$G(I BBEFF) S I BQUIT=1 D G MIIQ | |
6107 | "RTN","IBC NSMM2",67, 0) | |
6108 | .W !!,*7, ?5,"No dat a can be f iled witho ut Part A or B Effec tive Dates ." | |
6109 | "RTN","IBC NSMM2",68, 0) | |
6110 | ; | |
6111 | "RTN","IBC NSMM2",69, 0) | |
6112 | ; - Coord ination of Benefits prompt | |
6113 | "RTN","IBC NSMM2",70, 0) | |
6114 | S DIR("A" )="COORDIN ATION OF B ENEFITS: " | |
6115 | "RTN","IBC NSMM2",71, 0) | |
6116 | S IBX=$P( $G(IBARR(" A",1)),"^" ,21) I 'IB X S IBX=$P ($G(IBARR( "B",1)),"^ ",21) | |
6117 | "RTN","IBC NSMM2",72, 0) | |
6118 | I IBX S I BX=$S(IBX= 1:"PRIMARY ",IBX=2:"S ECONDARY", 3:"TERTIAR Y",1:"") | |
6119 | "RTN","IBC NSMM2",73, 0) | |
6120 | S DIR("B" )=$S($G(IB COB)'="":I BCOB,IBX'= "":IBX,1:" PRIMARY") | |
6121 | "RTN","IBC NSMM2",74, 0) | |
6122 | S DIR(0)= "SA^1:PRIM ARY;2:SECO NDARY;3:TE RTIARY" | |
6123 | "RTN","IBC NSMM2",75, 0) | |
6124 | S DIR("?" )="Enter t he Coordin ation of B enefits as Primary, Secondary, or Tertia ry." | |
6125 | "RTN","IBC NSMM2",76, 0) | |
6126 | D ^DIR K DIR | |
6127 | "RTN","IBC NSMM2",77, 0) | |
6128 | I $D(DTOU T)!$D(DUOU T) K DUOUT ,DTOUT,DIR OUT,DIRUT S IBQUIT=1 G MIIQ | |
6129 | "RTN","IBC NSMM2",78, 0) | |
6130 | S IBCOBI= Y,IBCOB=$S (Y=3:"TERT IARY",Y=2: "SECONDARY ",1:"PRIMA RY") | |
6131 | "RTN","IBC NSMM2",79, 0) | |
6132 | ; | |
6133 | "RTN","IBC NSMM2",80, 0) | |
6134 | ; -- Ask if Data Ok ay | |
6135 | "RTN","IBC NSMM2",81, 0) | |
6136 | S IBOK=0 K DIR D OK ^IBCNSMM1 I IBOK=0 K DIR,Y G M IIA | |
6137 | "RTN","IBC NSMM2",82, 0) | |
6138 | I IBOK["^ " S IBQUIT =1 | |
6139 | "RTN","IBC NSMM2",83, 0) | |
6140 | MIIQ Q | |
6141 | "RTN","IBC NSMM2",84, 0) | |
6142 | ; | |
6143 | "RTN","IBC NSMM2",85, 0) | |
6144 | ; | |
6145 | "RTN","IBC NSMM2",86, 0) | |
6146 | HICH ; Hel p text for the HIC n umber prom pt. | |
6147 | "RTN","IBC NSMM2",87, 0) | |
6148 | W !,"Ente r the Medi care Claim Number (S ubscriber ID) exactl y as it ap pears" ; I B*602 | |
6149 | "RTN","IBC NSMM2",88, 0) | |
6150 | W !,"on t he Medicar e Insuranc e Card, ex cluding sp ecial char acters." | |
6151 | "RTN","IBC NSMM2",89, 0) | |
6152 | W !,"Entr y must be 3-20 chara cters." | |
6153 | "RTN","IBC NSMM2",90, 0) | |
6154 | Q | |
6155 | "RTN","IBC NSP") | |
6156 | 0^6^B77777 224^B77034 837 | |
6157 | "RTN","IBC NSP",1,0) | |
6158 | IBCNSP ;AL B/AAS - IN SURANCE MA NAGEMENT - EXPANDED POLICY ;05 -MAR-1993 | |
6159 | "RTN","IBC NSP",2,0) | |
6160 | ;;2.0;INT EGRATED BI LLING;**6, 28,43,52,8 5,251,363, 371,416,49 7,516,528, 549,602**; 21-MAR-94; Build 22 | |
6161 | "RTN","IBC NSP",3,0) | |
6162 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
6163 | "RTN","IBC NSP",4,0) | |
6164 | % ; | |
6165 | "RTN","IBC NSP",5,0) | |
6166 | EN ; -- ma in entry p oint for I BCNS EXPAN DED POLICY | |
6167 | "RTN","IBC NSP",6,0) | |
6168 | N IB1ST | |
6169 | "RTN","IBC NSP",7,0) | |
6170 | K VALMQUI T,IBPPOL,I BTOP | |
6171 | "RTN","IBC NSP",8,0) | |
6172 | S IBTOP=" IBCNSP" | |
6173 | "RTN","IBC NSP",9,0) | |
6174 | D EN^VALM ("IBCNS EX PANDED POL ICY") | |
6175 | "RTN","IBC NSP",10,0) | |
6176 | Q | |
6177 | "RTN","IBC NSP",11,0) | |
6178 | ; | |
6179 | "RTN","IBC NSP",12,0) | |
6180 | HDR ; -- h eader code | |
6181 | "RTN","IBC NSP",13,0) | |
6182 | N DOD,IBD OB,IBNAME, W,X,Y,Z ; IB*2 .0*549 Add ed DOD | |
6183 | "RTN","IBC NSP",14,0) | |
6184 | S IBNAME= ^DPT(DFN,0 ) ; Dire ct global read on fi le 2 suppo rted by IA 10035 | |
6185 | "RTN","IBC NSP",15,0) | |
6186 | S IBDOB=$ P(IBNAME," ^",3) | |
6187 | "RTN","IBC NSP",16,0) | |
6188 | S IBNAME= $E($P(IBNA ME,U),1,20 ) | |
6189 | "RTN","IBC NSP",17,0) | |
6190 | ; | |
6191 | "RTN","IBC NSP",18,0) | |
6192 | ; IB*2.0* 549 Shorte ned 'Expan ded Policy Informati on For ' t o 'For: ' below | |
6193 | "RTN","IBC NSP",19,0) | |
6194 | S VALMHDR (1)="For: "_IBNAME_" "_$P($$P T^IBEFUNC( DFN),U,2)_ " "_$$FMT E^XLFDT(IB DOB,"5DZ") | |
6195 | "RTN","IBC NSP",20,0) | |
6196 | ; | |
6197 | "RTN","IBC NSP",21,0) | |
6198 | ; IB*2.0* 549 Added next 4 lin es | |
6199 | "RTN","IBC NSP",22,0) | |
6200 | S DOD=$$G ET1^DIQ(2, DFN_",",.3 51,"I") | |
6201 | "RTN","IBC NSP",23,0) | |
6202 | I DOD'="" D | |
6203 | "RTN","IBC NSP",24,0) | |
6204 | . S DOD=$ $FMTE^XLFD T(DOD,"5DZ ") | |
6205 | "RTN","IBC NSP",25,0) | |
6206 | . ;IB*2.0 *602/DM di splay DoD properly w ith long p atient nam e | |
6207 | "RTN","IBC NSP",26,0) | |
6208 | . S VALMH DR(1)=VALM HDR(1)_" DoD: "_DO D | |
6209 | "RTN","IBC NSP",27,0) | |
6210 | S Z=$G(^D PT(DFN,.31 2,+$P(IBPP OL,U,4),0) ) | |
6211 | "RTN","IBC NSP",28,0) | |
6212 | S W=$P($G (^IBA(355. 3,+$P(Z,U, 18),0)),U, 11) | |
6213 | "RTN","IBC NSP",29,0) | |
6214 | S Y=$E($P ($G(^DIC(3 6,+Z,0)),U ),1,20)_" Insurance Company" | |
6215 | "RTN","IBC NSP",30,0) | |
6216 | S X="** P lan Curren tly "_$S(W :"Ina",1:" A")_"ctive **" | |
6217 | "RTN","IBC NSP",31,0) | |
6218 | S VALMHDR (2)=$$SETS TR^VALM1(X ,Y,48,29) | |
6219 | "RTN","IBC NSP",32,0) | |
6220 | Q | |
6221 | "RTN","IBC NSP",33,0) | |
6222 | ; | |
6223 | "RTN","IBC NSP",34,0) | |
6224 | INIT ; -- init varia bles and l ist array | |
6225 | "RTN","IBC NSP",35,0) | |
6226 | K VALMQUI T | |
6227 | "RTN","IBC NSP",36,0) | |
6228 | S VALMCNT =0,VALMBG= 1 | |
6229 | "RTN","IBC NSP",37,0) | |
6230 | I '$D(IBP POL) D PPO L Q:$D(VAL MQUIT) | |
6231 | "RTN","IBC NSP",38,0) | |
6232 | D BLD,HDR | |
6233 | "RTN","IBC NSP",39,0) | |
6234 | Q | |
6235 | "RTN","IBC NSP",40,0) | |
6236 | ; | |
6237 | "RTN","IBC NSP",41,0) | |
6238 | BLD ; -- l ist builde r | |
6239 | "RTN","IBC NSP",42,0) | |
6240 | K ^TMP("I BCNSVP",$J ),^TMP("IB CNSVPDX",$ J) | |
6241 | "RTN","IBC NSP",43,0) | |
6242 | D KILL^VA LM10() | |
6243 | "RTN","IBC NSP",44,0) | |
6244 | N IBCDFND ,IBCDFND1, IBCDFND2,I BCDFND4,IB CDFND5,IBC DFND7 | |
6245 | "RTN","IBC NSP",45,0) | |
6246 | S IBCDFND =$G(^DPT(D FN,.312,$P (IBPPOL,U, 4),0)),IBC DFND1=$G(^ (1)),IBCDF ND2=$G(^(2 )),IBCDFND 4=$G(^(4)) ,IBCDFND5= $G(^(5)),I BCDFND7=$G (^(7)) | |
6247 | "RTN","IBC NSP",46,0) | |
6248 | ; MRD;IB* 2.0*516 - Use $$ZND^ IBCNS1 to pull zero node of 2. 312. | |
6249 | "RTN","IBC NSP",47,0) | |
6250 | S IBCDFND =$$ZND^IBC NS1(DFN,$P (IBPPOL,U, 4)) | |
6251 | "RTN","IBC NSP",48,0) | |
6252 | S IBCPOL= +$P(IBCDFN D,U,18),IB CNS=+IBCDF ND,IBCDFN= $P(IBPPOL, U,4) | |
6253 | "RTN","IBC NSP",49,0) | |
6254 | S IBCPOLD =$G(^IBA(3 55.3,+$P(I BCDFND,U,1 8),0)),IBC POLD1=$G(^ (1)) | |
6255 | "RTN","IBC NSP",50,0) | |
6256 | S IBCPOLD 2=$G(^IBA( 355.3,+$G( IBCPOL),6) ) ;; Daou/ EEN adding BIN and P CN | |
6257 | "RTN","IBC NSP",51,0) | |
6258 | S IBCPOLD L=$G(^IBA( 355.3,+$G( IBCPOL),2) ) ;IB*2*4 97 new gr oup name a nd group n umber loca tions | |
6259 | "RTN","IBC NSP",52,0) | |
6260 | ; | |
6261 | "RTN","IBC NSP",53,0) | |
6262 | D INS^IBC NSP0 ; in surance co mpany | |
6263 | "RTN","IBC NSP",54,0) | |
6264 | D POLICY^ IBCNSP0 ; pl an informa tion | |
6265 | "RTN","IBC NSP",55,0) | |
6266 | D UR ; ut ilization review inf o | |
6267 | "RTN","IBC NSP",56,0) | |
6268 | D EFFECT ; ef fective da tes & sour ce of info | |
6269 | "RTN","IBC NSP",57,0) | |
6270 | D SUBSC^I BCNSP01 ; su bscriber i nfo | |
6271 | "RTN","IBC NSP",58,0) | |
6272 | D EMP ; su bscriber's employer info | |
6273 | "RTN","IBC NSP",59,0) | |
6274 | D PRV^IBC NSP01 ; su bscriber's provider contact in fo ;IB*2*4 97 | |
6275 | "RTN","IBC NSP",60,0) | |
6276 | D SPON^IB CNSP0 ; in sured pers on's info | |
6277 | "RTN","IBC NSP",61,0) | |
6278 | D ID^IBCN SP01 ; in s co ID nu mbers (IB* 2*371) | |
6279 | "RTN","IBC NSP",62,0) | |
6280 | D PLIM ; pl an coverag e limitati ons | |
6281 | "RTN","IBC NSP",63,0) | |
6282 | D VER^IBC NSP01 ; us er/verifie r/editor i nfo | |
6283 | "RTN","IBC NSP",64,0) | |
6284 | ; | |
6285 | "RTN","IBC NSP",65,0) | |
6286 | ;IB*2.0*5 49 Removed next line | |
6287 | "RTN","IBC NSP",66,0) | |
6288 | ;D CONTAC T^IBCNSP0 ; l ast insura nce contac t | |
6289 | "RTN","IBC NSP",67,0) | |
6290 | D COMMENT ; co mments - p olicy & pl an | |
6291 | "RTN","IBC NSP",68,0) | |
6292 | D RIDER^I BCNSP01 ; po licy rider info | |
6293 | "RTN","IBC NSP",69,0) | |
6294 | ; | |
6295 | "RTN","IBC NSP",70,0) | |
6296 | S VALMCNT =+$O(^TMP( "IBCNSVP", $J,""),-1) | |
6297 | "RTN","IBC NSP",71,0) | |
6298 | Q | |
6299 | "RTN","IBC NSP",72,0) | |
6300 | ; | |
6301 | "RTN","IBC NSP",73,0) | |
6302 | COMMENT ; -- Comment region | |
6303 | "RTN","IBC NSP",74,0) | |
6304 | ; Input: DFN - IEN of the curre ntly selec ted patien t | |
6305 | "RTN","IBC NSP",75,0) | |
6306 | ; IBCPOL - | |
6307 | "RTN","IBC NSP",76,0) | |
6308 | ; IBPPOL - O node of the se lected Pat ient Polic y | |
6309 | "RTN","IBC NSP",77,0) | |
6310 | ; ^TMP("IB CNSVP",$J) - Curren t global A rray of di splay line s | |
6311 | "RTN","IBC NSP",78,0) | |
6312 | ; Output: IB1ST("C OMMENT") - 1st li ne of comm ents displ ay | |
6313 | "RTN","IBC NSP",79,0) | |
6314 | ; ^TMP("IB CNSVP",$J) - Update d global A rray of di splay line s | |
6315 | "RTN","IBC NSP",80,0) | |
6316 | ; | |
6317 | "RTN","IBC NSP",81,0) | |
6318 | ;IB*2.0*5 49 Moved G roup Plan Comment ab ove Patien t Policy C omment. Ch anged | |
6319 | "RTN","IBC NSP",82,0) | |
6320 | ; Patient Policy Co mment to d isplay the two most recent com ments | |
6321 | "RTN","IBC NSP",83,0) | |
6322 | ; in the patient po licy comme nt multipl e (2.342,1 .18) | |
6323 | "RTN","IBC NSP",84,0) | |
6324 | N COMDT,C OMIEN,COMC TR,COMSTOP ,IBI,IBIIE N,IBL,OFFS ET,XX | |
6325 | "RTN","IBC NSP",85,0) | |
6326 | S IBL=$O( ^TMP("IBCN SVP",$J,"" ),-1)+1,OF FSET=2 | |
6327 | "RTN","IBC NSP",86,0) | |
6328 | S IB1ST(" COMMENT")= IBL | |
6329 | "RTN","IBC NSP",87,0) | |
6330 | ; | |
6331 | "RTN","IBC NSP",88,0) | |
6332 | ; Display Group Pla n Comment | |
6333 | "RTN","IBC NSP",89,0) | |
6334 | D SET(IBL ,OFFSET," Comment -- Group Pla n ",IORVON ,IORVOFF) | |
6335 | "RTN","IBC NSP",90,0) | |
6336 | S IBI=0 | |
6337 | "RTN","IBC NSP",91,0) | |
6338 | F S IBI= $O(^IBA(35 5.3,+IBCPO L,11,IBI)) Q:IBI<1 D | |
6339 | "RTN","IBC NSP",92,0) | |
6340 | . S IBL=I BL+1 | |
6341 | "RTN","IBC NSP",93,0) | |
6342 | . D SET(I BL,OFFSET, " "_$E($G( ^IBA(355.3 ,+IBCPOL,1 1,IBI,0)), 1,80)) | |
6343 | "RTN","IBC NSP",94,0) | |
6344 | S IBL=IBL +1 | |
6345 | "RTN","IBC NSP",95,0) | |
6346 | D SET(IBL ,OFFSET," ") | |
6347 | "RTN","IBC NSP",96,0) | |
6348 | ; | |
6349 | "RTN","IBC NSP",97,0) | |
6350 | ; Display Last two Patient Po licy Comme nts | |
6351 | "RTN","IBC NSP",98,0) | |
6352 | S IBIIEN= $P(IBPPOL, "^",4),IBL =IBL+1 | |
6353 | "RTN","IBC NSP",99,0) | |
6354 | D SET(IBL ,OFFSET," Comment -- Patient P olicy ",IO RVON,IORVO FF) | |
6355 | "RTN","IBC NSP",100,0 ) | |
6356 | S IBL=IBL +1,XX=" Dt Entered Entered By Meth od Per son Contac ted" | |
6357 | "RTN","IBC NSP",101,0 ) | |
6358 | S XX=XX_$ J("",78-$L (XX)) | |
6359 | "RTN","IBC NSP",102,0 ) | |
6360 | D SET(IBL ,OFFSET,XX ,IOUON,IOU OFF) | |
6361 | "RTN","IBC NSP",103,0 ) | |
6362 | S COMDT=" ",(COMCTR, COMSTOP)=0 | |
6363 | "RTN","IBC NSP",104,0 ) | |
6364 | F D Q:( COMDT="")! COMSTOP | |
6365 | "RTN","IBC NSP",105,0 ) | |
6366 | . S COMDT =$O(^DPT(D FN,.312,IB IIEN,13,"B ",COMDT),- 1) | |
6367 | "RTN","IBC NSP",106,0 ) | |
6368 | . Q:COMDT ="" | |
6369 | "RTN","IBC NSP",107,0 ) | |
6370 | . S COMIE N="" | |
6371 | "RTN","IBC NSP",108,0 ) | |
6372 | . F D Q :(COMIEN=" ")!COMSTOP | |
6373 | "RTN","IBC NSP",109,0 ) | |
6374 | . . S COM IEN=$O(^DP T(DFN,.312 ,IBIIEN,13 ,"B",COMDT ,COMIEN),- 1) | |
6375 | "RTN","IBC NSP",110,0 ) | |
6376 | . . Q:COM IEN="" | |
6377 | "RTN","IBC NSP",111,0 ) | |
6378 | . . S COM CTR=COMCTR +1 | |
6379 | "RTN","IBC NSP",112,0 ) | |
6380 | . . I COM CTR>2 S CO MSTOP=1 Q | |
6381 | "RTN","IBC NSP",113,0 ) | |
6382 | . . I COM CTR=2 D | |
6383 | "RTN","IBC NSP",114,0 ) | |
6384 | . . . S I BL=IBL+1 | |
6385 | "RTN","IBC NSP",115,0 ) | |
6386 | . . . D S ET(IBL,OFF SET," ") | |
6387 | "RTN","IBC NSP",116,0 ) | |
6388 | . . D DIS PPPC(.IBL, DFN,IBIIEN ,COMIEN) ; Display Pa tient Poli cy Comment | |
6389 | "RTN","IBC NSP",117,0 ) | |
6390 | ; | |
6391 | "RTN","IBC NSP",118,0 ) | |
6392 | ; Add two blank lin es at end | |
6393 | "RTN","IBC NSP",119,0 ) | |
6394 | S IBL=IBL +1 | |
6395 | "RTN","IBC NSP",120,0 ) | |
6396 | D SET(IBL ,OFFSET," ") | |
6397 | "RTN","IBC NSP",121,0 ) | |
6398 | S IBL=IBL +1 | |
6399 | "RTN","IBC NSP",122,0 ) | |
6400 | D SET(IBL ,OFFSET," ") | |
6401 | "RTN","IBC NSP",123,0 ) | |
6402 | Q | |
6403 | "RTN","IBC NSP",124,0 ) | |
6404 | ; | |
6405 | "RTN","IBC NSP",125,0 ) | |
6406 | DISPPPC(IB L,DFN,IBII EN,COMIEN) ; Display one Patie nt Policy Comment | |
6407 | "RTN","IBC NSP",126,0 ) | |
6408 | ;IB*2.0*5 49 - Added sub-routi ne | |
6409 | "RTN","IBC NSP",127,0 ) | |
6410 | ; Input: IBL - Curren t Display Line Count er | |
6411 | "RTN","IBC NSP",128,0 ) | |
6412 | ; DFN - IEN of the curre ntly selec ted patien t | |
6413 | "RTN","IBC NSP",129,0 ) | |
6414 | ; IBIIEN - ^DPT(D FN,.312,IB IIEN,0) Wh ere IBIIEN is the | |
6415 | "RTN","IBC NSP",130,0 ) | |
6416 | ; multip le IEN of the select ed patient policy | |
6417 | "RTN","IBC NSP",131,0 ) | |
6418 | ; COMIEN - ^DPT(D FN,.312,IB IIEN,13,CO MIEN,0) Wh ere | |
6419 | "RTN","IBC NSP",132,0 ) | |
6420 | ; COMIEN is the mu ltiple IEN of the se lected | |
6421 | "RTN","IBC NSP",133,0 ) | |
6422 | ; Patien t Policy C omment | |
6423 | "RTN","IBC NSP",134,0 ) | |
6424 | ; ^TMP("IB CNSVP",$J) - Curren t global A rray of di splay line s | |
6425 | "RTN","IBC NSP",135,0 ) | |
6426 | ; Output: IBL - Update d Display Line Count er | |
6427 | "RTN","IBC NSP",136,0 ) | |
6428 | ; ^TMP("IB CNSVP",$J) - Update d global A rray of di splay line s | |
6429 | "RTN","IBC NSP",137,0 ) | |
6430 | N COMDATA ,LINE,XX,Z Z | |
6431 | "RTN","IBC NSP",138,0 ) | |
6432 | S COMDATA =$$GETONEC ^IBCNCH2(D FN,IBIIEN, COMIEN,0,7 7,0,1) | |
6433 | "RTN","IBC NSP",139,0 ) | |
6434 | S LINE=$P (COMDATA," ^",1)_" " | |
6435 | "RTN","IBC NSP",140,0 ) | |
6436 | S XX=$P(C OMDATA,"^" ,2),ZZ=$J( "",26-$L(X X)) | |
6437 | "RTN","IBC NSP",141,0 ) | |
6438 | S LINE=LI NE_XX_ZZ | |
6439 | "RTN","IBC NSP",142,0 ) | |
6440 | S XX=$P(C OMDATA,"^" ,4),ZZ=$J( "",11-$L(X X)) | |
6441 | "RTN","IBC NSP",143,0 ) | |
6442 | S LINE=LI NE_XX_ZZ_$ P(COMDATA, "^",3),IBL =IBL+1 | |
6443 | "RTN","IBC NSP",144,0 ) | |
6444 | D SET(IBL ,OFFSET,LI NE) | |
6445 | "RTN","IBC NSP",145,0 ) | |
6446 | S IBL=IBL +1,LINE=" "_$P(COMDA TA,"^",8) | |
6447 | "RTN","IBC NSP",146,0 ) | |
6448 | D SET(IBL ,OFFSET,LI NE) | |
6449 | "RTN","IBC NSP",147,0 ) | |
6450 | Q | |
6451 | "RTN","IBC NSP",148,0 ) | |
6452 | ; | |
6453 | "RTN","IBC NSP",149,0 ) | |
6454 | EFFECT ; - - Effectiv e date reg ion | |
6455 | "RTN","IBC NSP",150,0 ) | |
6456 | N START,O FFSET | |
6457 | "RTN","IBC NSP",151,0 ) | |
6458 | S START=$ O(^TMP("IB CNSVP",$J, ""),-1)-6 ;ib*2*497 lines nee d to be di splayed al ongside UR region | |
6459 | "RTN","IBC NSP",152,0 ) | |
6460 | S OFFSET= 45 | |
6461 | "RTN","IBC NSP",153,0 ) | |
6462 | D SET(STA RT,OFFSET- 4," Effect ive Dates & Source " ,IORVON,IO RVOFF) | |
6463 | "RTN","IBC NSP",154,0 ) | |
6464 | D SET(STA RT+1,OFFSE T," Effect ive Date: "_$$DAT1^I BOUTL($P(I BCDFND,U,8 ))) | |
6465 | "RTN","IBC NSP",155,0 ) | |
6466 | D SET(STA RT+2,OFFSE T,"Expirat ion Date: "_$$DAT1^I BOUTL($P(I BCDFND,U,4 ))) | |
6467 | "RTN","IBC NSP",156,0 ) | |
6468 | D SET(STA RT+3,OFFSE T," Source of Info: "_$$EXPAND ^IBTRE(2.3 12,1.09,$P ($G(IBCDFN D1),U,9))) | |
6469 | "RTN","IBC NSP",157,0 ) | |
6470 | ; | |
6471 | "RTN","IBC NSP",158,0 ) | |
6472 | ;IB*2.0*5 49 Changed OFFSET-4 to OFFSET- 8 | |
6473 | "RTN","IBC NSP",159,0 ) | |
6474 | ; Changed 'Policy N ot Billabl e' to 'Sto p Policy F rom Billin g' | |
6475 | "RTN","IBC NSP",160,0 ) | |
6476 | D SET(STA RT+4,OFFSE T-9,"Stop Policy Fro m Billing: "_$S($P($ G(^DPT(DFN ,.312,IBCD FN,3)),"^" ,4):"YES", 1:"NO")) | |
6477 | "RTN","IBC NSP",161,0 ) | |
6478 | Q | |
6479 | "RTN","IBC NSP",162,0 ) | |
6480 | ; | |
6481 | "RTN","IBC NSP",163,0 ) | |
6482 | UR ; -- UR of insura nce region | |
6483 | "RTN","IBC NSP",164,0 ) | |
6484 | N START,O FFSET | |
6485 | "RTN","IBC NSP",165,0 ) | |
6486 | S START=$ O(^TMP("IB CNSVP",$J, ""),-1)+1, OFFSET=2 ;IB*2*497 | |
6487 | "RTN","IBC NSP",166,0 ) | |
6488 | D SET(STA RT,OFFSET, " Utilizat ion Review Info ",IO RVON,IORVO FF) | |
6489 | "RTN","IBC NSP",167,0 ) | |
6490 | D SET(STA RT+1,OFFSE T," Require UR: "_$$EX PAND^IBTRE (355.3,.05 ,$P(IBCPOL D,U,5))) | |
6491 | "RTN","IBC NSP",168,0 ) | |
6492 | D SET(STA RT+2,OFFSE T," Requ ire Amb Ce rt: "_$$EX PAND^IBTRE (355.3,.12 ,$P(IBCPOL D,U,12))) | |
6493 | "RTN","IBC NSP",169,0 ) | |
6494 | D SET(STA RT+3,OFFSE T," Requ ire Pre-Ce rt: "_$$EX PAND^IBTRE (355.3,.06 ,$P(IBCPOL D,U,6))) | |
6495 | "RTN","IBC NSP",170,0 ) | |
6496 | D SET(STA RT+4,OFFSE T," Excl ude Pre-Co nd: "_$$EX PAND^IBTRE (355.3,.07 ,$P(IBCPOL D,U,7))) | |
6497 | "RTN","IBC NSP",171,0 ) | |
6498 | D SET(STA RT+5,OFFSE T,"Benefit s Assignab le: "_$$EX PAND^IBTRE (355.3,.08 ,$P(IBCPOL D,U,8))) | |
6499 | "RTN","IBC NSP",172,0 ) | |
6500 | D SET(STA RT+6,2," " ) | |
6501 | "RTN","IBC NSP",173,0 ) | |
6502 | Q | |
6503 | "RTN","IBC NSP",174,0 ) | |
6504 | EMP ; -- I nsurance E mployer Re gion | |
6505 | "RTN","IBC NSP",175,0 ) | |
6506 | ; ib*2*49 7 move emp loyer line s around | |
6507 | "RTN","IBC NSP",176,0 ) | |
6508 | N OFFSET, START,IBAD D,COL2 | |
6509 | "RTN","IBC NSP",177,0 ) | |
6510 | S START=$ O(^TMP("IB CNSVP",$J, ""),-1)+1, OFFSET=2 | |
6511 | "RTN","IBC NSP",178,0 ) | |
6512 | D SET(STA RT,OFFSET, " Subscrib er's Emplo yer Inform ation ",IO RVON,IORVO FF) | |
6513 | "RTN","IBC NSP",179,0 ) | |
6514 | D SET(STA RT+1,OFFSE T,$$RJ^XLF STR(" Empl oyment Sta tus: ",20) _$$EXPAND^ IBTRE(2.31 2,2.11,$P( IBCDFND2,U ,11))) | |
6515 | "RTN","IBC NSP",180,0 ) | |
6516 | S COL2=ST ART+1 | |
6517 | "RTN","IBC NSP",181,0 ) | |
6518 | D SET(STA RT+2,OFFSE T,$$RJ^XLF STR("Emplo yer: ",20) _$P(IBCDFN D2,U,9)) | |
6519 | "RTN","IBC NSP",182,0 ) | |
6520 | D SET(STA RT+3,OFFSE T,$$RJ^XLF STR("Stree t: ",20)_$ P(IBCDFND2 ,U,2)) S I BADD=1 | |
6521 | "RTN","IBC NSP",183,0 ) | |
6522 | I $P(IBCD FND2,U,3)' ="" D SET( START+4,OF FSET,$$RJ^ XLFSTR("St reet 2: ", 20)_$P(IBC DFND2,U,3) ) S IBADD= 2 | |
6523 | "RTN","IBC NSP",184,0 ) | |
6524 | I $P(IBCD FND2,U,4)' ="" D SET( START+5,OF FSET,$$RJ^ XLFSTR("St reet 3: ", 20)_$P(IBC DFND2,U,4) ) S IBADD= 3 | |
6525 | "RTN","IBC NSP",185,0 ) | |
6526 | D SET(STA RT+3+IBADD ,OFFSET,$$ RJ^XLFSTR( "City/Stat e: ",20)_$ E($P(IBCDF ND2,U,5),1 ,15)_$S($P (IBCDFND2, U,5)="":"" ,1:", ")_$ P($G(^DIC( 5,+$P(IBCD FND2,U,6), 0)),U,2)_" "_$E($P(I BCDFND2,U, 7),1,5)) | |
6527 | "RTN","IBC NSP",186,0 ) | |
6528 | D SET(STA RT+4+IBADD ,OFFSET,$$ RJ^XLFSTR( "Phone: ", 20)_$P(IBC DFND2,U,8) ) | |
6529 | "RTN","IBC NSP",187,0 ) | |
6530 | D SET(STA RT+5+IBADD ,OFFSET," ") ; ib*2 *497 only 1 blank l ine to end the secti on | |
6531 | "RTN","IBC NSP",188,0 ) | |
6532 | ; | |
6533 | "RTN","IBC NSP",189,0 ) | |
6534 | S START=C OL2,OFFSET =40 | |
6535 | "RTN","IBC NSP",190,0 ) | |
6536 | D SET(STA RT,OFFSET, "Emp Spons ored Plan: "_$S(+$P( IBCDFND2,U ,10):"Yes" ,1:"No")) | |
6537 | "RTN","IBC NSP",191,0 ) | |
6538 | D SET(STA RT+1,OFFSE T,"Claims to Employe r: "_$S(+I BCDFND2:"Y es, Send t o Employer ",1:"No, S end to Ins urance Com pany")) | |
6539 | "RTN","IBC NSP",192,0 ) | |
6540 | D SET(STA RT+2,OFFSE T," Reti rement Dat e: "_$$DAT 1^IBOUTL($ P(IBCDFND2 ,U,12))) | |
6541 | "RTN","IBC NSP",193,0 ) | |
6542 | ; | |
6543 | "RTN","IBC NSP",194,0 ) | |
6544 | EMPQ Q | |
6545 | "RTN","IBC NSP",195,0 ) | |
6546 | ; | |
6547 | "RTN","IBC NSP",196,0 ) | |
6548 | PLIM ; pla n coverage limitatio ns/plan li mitation c ategory di splay | |
6549 | "RTN","IBC NSP",197,0 ) | |
6550 | N START,E ND S START =$O(^TMP(" IBCNSVP",$ J,""),-1)+ 1 | |
6551 | "RTN","IBC NSP",198,0 ) | |
6552 | S IB1ST(" PLIM")=STA RT | |
6553 | "RTN","IBC NSP",199,0 ) | |
6554 | D LIMBLD^ IBCNSC41(S TART,2) | |
6555 | "RTN","IBC NSP",200,0 ) | |
6556 | S END=$O( ^TMP("IBCN SVP",$J,"" ),-1) ; l ast line c onstructed | |
6557 | "RTN","IBC NSP",201,0 ) | |
6558 | D SET(END +1,2," ") ; 2 bla nk lines t o end this section | |
6559 | "RTN","IBC NSP",202,0 ) | |
6560 | D SET(END +2,2," ") | |
6561 | "RTN","IBC NSP",203,0 ) | |
6562 | PLIMX ; | |
6563 | "RTN","IBC NSP",204,0 ) | |
6564 | Q | |
6565 | "RTN","IBC NSP",205,0 ) | |
6566 | ; | |
6567 | "RTN","IBC NSP",206,0 ) | |
6568 | HELP ; -- help code | |
6569 | "RTN","IBC NSP",207,0 ) | |
6570 | S X="?" D DISP^XQOR M1 W !! | |
6571 | "RTN","IBC NSP",208,0 ) | |
6572 | Q | |
6573 | "RTN","IBC NSP",209,0 ) | |
6574 | ; | |
6575 | "RTN","IBC NSP",210,0 ) | |
6576 | EXIT ; -- exit code | |
6577 | "RTN","IBC NSP",211,0 ) | |
6578 | K IBPPOL, VALMQUIT,I BCNS,IBCDF N,IBCPOL,I BCPOLD,IBC POLD1,IBCP OLD2,IBCPO LDL,IBCDFN D,IBCDFND1 ,IBCDFND2, IBVPCLBG,I BVPCLEN | |
6579 | "RTN","IBC NSP",212,0 ) | |
6580 | D CLEAN^V ALM10,CLEA R^VALM1 | |
6581 | "RTN","IBC NSP",213,0 ) | |
6582 | Q | |
6583 | "RTN","IBC NSP",214,0 ) | |
6584 | ; | |
6585 | "RTN","IBC NSP",215,0 ) | |
6586 | EXPND ; -- expand co de | |
6587 | "RTN","IBC NSP",216,0 ) | |
6588 | Q | |
6589 | "RTN","IBC NSP",217,0 ) | |
6590 | ; | |
6591 | "RTN","IBC NSP",218,0 ) | |
6592 | PPOL ; -- select pat ient, sele ct policy | |
6593 | "RTN","IBC NSP",219,0 ) | |
6594 | I '$D(DFN ) D G:$D( VALMQUIT) PPOLQ | |
6595 | "RTN","IBC NSP",220,0 ) | |
6596 | .S DIC="^ DPT(",DIC( 0)="AEQMN" D ^DIC | |
6597 | "RTN","IBC NSP",221,0 ) | |
6598 | .S DFN=+Y | |
6599 | "RTN","IBC NSP",222,0 ) | |
6600 | I $G(DFN) <1 S VALMQ UIT="" G P POLQ | |
6601 | "RTN","IBC NSP",223,0 ) | |
6602 | ; | |
6603 | "RTN","IBC NSP",224,0 ) | |
6604 | I '$O(^DP T(DFN,.312 ,0)) W !!, "Patient d oesn't hav e Insuranc e" K DFN G PPOL | |
6605 | "RTN","IBC NSP",225,0 ) | |
6606 | ; | |
6607 | "RTN","IBC NSP",226,0 ) | |
6608 | S DIC="^D PT("_DFN_" ,.312,",DI C(0)="AEQM N",DIC("A" )="Select Patient Po licy: " | |
6609 | "RTN","IBC NSP",227,0 ) | |
6610 | D ^DIC I +Y<1 S VAL MQUIT="" | |
6611 | "RTN","IBC NSP",228,0 ) | |
6612 | G:$D(VALM QUIT) PPOL Q | |
6613 | "RTN","IBC NSP",229,0 ) | |
6614 | S IBPPOL= "^2^"_DFN_ U_+Y_U_$G( ^DPT(DFN,. 312,+Y,0)) | |
6615 | "RTN","IBC NSP",230,0 ) | |
6616 | PPOLQ K DI C Q | |
6617 | "RTN","IBC NSP",231,0 ) | |
6618 | ; | |
6619 | "RTN","IBC NSP",232,0 ) | |
6620 | BLANK(LINE ) ; -- Bui ld blank l ine | |
6621 | "RTN","IBC NSP",233,0 ) | |
6622 | D SET^VAL M10(.LINE, $J("",80)) | |
6623 | "RTN","IBC NSP",234,0 ) | |
6624 | Q | |
6625 | "RTN","IBC NSP",235,0 ) | |
6626 | ; | |
6627 | "RTN","IBC NSP",236,0 ) | |
6628 | SET(LINE,C OL,TEXT,ON ,OFF) ; -- set displ ay info in array | |
6629 | "RTN","IBC NSP",237,0 ) | |
6630 | I '$D(@VA LMAR@(LINE ,0)) D BLA NK(.LINE) S VALMCNT= $G(VALMCNT )+1 | |
6631 | "RTN","IBC NSP",238,0 ) | |
6632 | D SET^VAL M10(.LINE, $$SETSTR^V ALM1(.TEXT ,@VALMAR@( LINE,0),.C OL,$L(TEXT ))) | |
6633 | "RTN","IBC NSP",239,0 ) | |
6634 | D:$G(ON)] ""!($G(OFF )]"") CNTR L^VALM10(. LINE,.COL, $L(TEXT),$ G(ON),$G(O FF)) | |
6635 | "RTN","IBC NSP",240,0 ) | |
6636 | W:'(LINE# 5) "." | |
6637 | "RTN","IBC NSP",241,0 ) | |
6638 | Q | |
6639 | "RTN","IBC NSP",242,0 ) | |
6640 | ; | |
6641 | "RTN","IBC NSUR") | |
6642 | 0^7^B13141 8993^B2478 2605 | |
6643 | "RTN","IBC NSUR",1,0) | |
6644 | IBCNSUR ;A LB/CPM/CMS - MOVE SU BSCRIBERS TO DIFFERE NT PLAN ;0 9-SEP-96 | |
6645 | "RTN","IBC NSUR",2,0) | |
6646 | ;;2.0;INT EGRATED BI LLING;**10 3,276,506, 516,549,60 2**;21-MAR -94;Build 22 | |
6647 | "RTN","IBC NSUR",3,0) | |
6648 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
6649 | "RTN","IBC NSUR",4,0) | |
6650 | Q | |
6651 | "RTN","IBC NSUR",5,0) | |
6652 | ; | |
6653 | "RTN","IBC NSUR",6,0) | |
6654 | EN ; Entry point fro m option. Main proce ssing loop . | |
6655 | "RTN","IBC NSUR",7,0) | |
6656 | I $S('($D (DUZ)#2):1 ,'$D(^VA(2 00,+DUZ,0) ):1,1:0) W !!?3,"The variable DUZ must b e set to a n active u ser code b efore cont inuing." G ENQ | |
6657 | "RTN","IBC NSUR",8,0) | |
6658 | W !!,?5," MOVE SUBSC RIBERS OF ONE PLAN T O ANOTHER PLAN" | |
6659 | "RTN","IBC NSUR",9,0) | |
6660 | W !,?5,"T his option may be us ed to move subscribe rs from a selected P lan" | |
6661 | "RTN","IBC NSUR",10,0 ) | |
6662 | W !,?5,"t o a differ ent Plan. The plans may be ass ociated wi th the sam e" | |
6663 | "RTN","IBC NSUR",11,0 ) | |
6664 | W !,?5,"I nsurance C ompany or a differen t one. Pla n and Annu al Benefit " | |
6665 | "RTN","IBC NSUR",12,0 ) | |
6666 | W !,?5,"i nformation may be mo ved as wel l. Users o f this opt ion should " | |
6667 | "RTN","IBC NSUR",13,0 ) | |
6668 | W !,?5,"b e knowledg eable of t he VistA P atient Ins urance man agement op tions." | |
6669 | "RTN","IBC NSUR",14,0 ) | |
6670 | W ! | |
6671 | "RTN","IBC NSUR",15,0 ) | |
6672 | W !,?5,"T his option also give s the user the optio n to expir e the old plan or" | |
6673 | "RTN","IBC NSUR",16,0 ) | |
6674 | W !,?5,"r eplace it completely in the pa tient insu rance prof ile. The reason" | |
6675 | "RTN","IBC NSUR",17,0 ) | |
6676 | W !,?5,"t o expire t he old pla n is inten ded for us e when Ins urance gro ups change " | |
6677 | "RTN","IBC NSUR",18,0 ) | |
6678 | W !,?5,"P BMs for pr ocessing e lectronic Pharmacy c laims. By leaving t he old" | |
6679 | "RTN","IBC NSUR",19,0 ) | |
6680 | W !,?5,"p lan inform ation inta ct (i.e. d o not repl ace), the user will be able" | |
6681 | "RTN","IBC NSUR",20,0 ) | |
6682 | W !,?5,"t o monitor PBM change s that af fect the e lectronic Pharmacy c laims." | |
6683 | "RTN","IBC NSUR",21,0 ) | |
6684 | ; | |
6685 | "RTN","IBC NSUR",22,0 ) | |
6686 | W !!,$TR( $J("",75), " ","-") | |
6687 | "RTN","IBC NSUR",23,0 ) | |
6688 | S IBSTOP= 0 F D PRO C^IBCNSUR1 Q:IBSTOP | |
6689 | "RTN","IBC NSUR",24,0 ) | |
6690 | ENQ K IBST OP | |
6691 | "RTN","IBC NSUR",25,0 ) | |
6692 | Q | |
6693 | "RTN","IBC NSUR",26,0 ) | |
6694 | ; | |
6695 | "RTN","IBC NSUR",27,0 ) | |
6696 | PROC ; - P rocess con tinuation from IBCNS UR1. | |
6697 | "RTN","IBC NSUR",28,0 ) | |
6698 | ; - displ ay old pla n attribut es; allow new plan t o be edite d | |
6699 | "RTN","IBC NSUR",29,0 ) | |
6700 | D PL^IBCN SUR2 | |
6701 | "RTN","IBC NSUR",30,0 ) | |
6702 | R !!,?10, "Press any key to co ntinue. ",IBX:DTI ME | |
6703 | "RTN","IBC NSUR",31,0 ) | |
6704 | ; | |
6705 | "RTN","IBC NSUR",32,0 ) | |
6706 | ; - displ ay coverag e limitati ons; allow add/edit of plan 2 limitation s | |
6707 | "RTN","IBC NSUR",33,0 ) | |
6708 | D LIM^IBC NSUR2 | |
6709 | "RTN","IBC NSUR",34,0 ) | |
6710 | ; | |
6711 | "RTN","IBC NSUR",35,0 ) | |
6712 | I $P($G(^ IBA(355.3, IBP1,0))," ^",11) W ! !,"Please note that ",IBC1N,"' s",!,"plan , subscrib ers were m oved from, is alread y inactive ." G PROCD P | |
6713 | "RTN","IBC NSUR",36,0 ) | |
6714 | ; | |
6715 | "RTN","IBC NSUR",37,0 ) | |
6716 | ; - does the user w ish to ina ctivate th e old plan ? | |
6717 | "RTN","IBC NSUR",38,0 ) | |
6718 | W !! S DI R(0)="Y",D IR("A")="D o you wish to inacti vate "_IBC 1N_"'s pla n subscrib ers were m oved from" | |
6719 | "RTN","IBC NSUR",39,0 ) | |
6720 | S DIR("?" )="If you wish to in activate t he old pla n, enter ' Yes' - oth erwise, en ter 'No.'" | |
6721 | "RTN","IBC NSUR",40,0 ) | |
6722 | D ^DIR K DIR I 'Y W !," <The old plan i s still ac tive>" G P ROCQ | |
6723 | "RTN","IBC NSUR",41,0 ) | |
6724 | ; | |
6725 | "RTN","IBC NSUR",42,0 ) | |
6726 | D IRACT^I BCNSJ(IBP1 ,1) W !!," The plan h as been in activated. " | |
6727 | "RTN","IBC NSUR",43,0 ) | |
6728 | ; | |
6729 | "RTN","IBC NSUR",44,0 ) | |
6730 | PROCDP ; - does the user wish to delete the old pl an? | |
6731 | "RTN","IBC NSUR",45,0 ) | |
6732 | W !! S DI R(0)="Y",D IR("A")="D o you wish to delete this plan " | |
6733 | "RTN","IBC NSUR",46,0 ) | |
6734 | S DIR("?" )="If you wish to de lete the o ld plan, e nter 'Yes' - otherwi se, enter 'No.'" | |
6735 | "RTN","IBC NSUR",47,0 ) | |
6736 | D ^DIR K DIR I 'Y G PROCQ | |
6737 | "RTN","IBC NSUR",48,0 ) | |
6738 | ; | |
6739 | "RTN","IBC NSUR",49,0 ) | |
6740 | D DEL^IBC NSJ(IBP1) W !!,"The plan has b een delete d." | |
6741 | "RTN","IBC NSUR",50,0 ) | |
6742 | ; | |
6743 | "RTN","IBC NSUR",51,0 ) | |
6744 | PROCQ Q | |
6745 | "RTN","IBC NSUR",52,0 ) | |
6746 | ; | |
6747 | "RTN","IBC NSUR",53,0 ) | |
6748 | ; | |
6749 | "RTN","IBC NSUR",54,0 ) | |
6750 | SEL(IBNP) ; Select a company a nd plan. | |
6751 | "RTN","IBC NSUR",55,0 ) | |
6752 | ; Input : IBNP -- If s et to 1, a llows addi ng a new p lan and | |
6753 | "RTN","IBC NSUR",56,0 ) | |
6754 | ; -- Scre en Inactiv e Companie s | |
6755 | "RTN","IBC NSUR",57,0 ) | |
6756 | ; -- If s et to 0, m ust have a t least on e group pl an | |
6757 | "RTN","IBC NSUR",58,0 ) | |
6758 | ; Output : IBCNS -- Point er to sele cted compa ny in file #36 | |
6759 | "RTN","IBC NSUR",59,0 ) | |
6760 | ; IBPLAN -- Point er to sele cted/added plan in f ile #355.3 | |
6761 | "RTN","IBC NSUR",60,0 ) | |
6762 | ; IBQUIT -- Set t o 1 if the user want s to quit. | |
6763 | "RTN","IBC NSUR",61,0 ) | |
6764 | ; | |
6765 | "RTN","IBC NSUR",62,0 ) | |
6766 | N X,Y K D IC,DIR | |
6767 | "RTN","IBC NSUR",63,0 ) | |
6768 | S DIC(0)= "QEAMZ",DI C="^DIC(36 ," | |
6769 | "RTN","IBC NSUR",64,0 ) | |
6770 | I 'IBNP S DIC("S")= "I $$ANYGP ^IBCNSJ(+Y ,0,1)" | |
6771 | "RTN","IBC NSUR",65,0 ) | |
6772 | I IBNP S DIC("S")=" I '$P($G(^ DIC(36,+Y, 0)),U,5)" | |
6773 | "RTN","IBC NSUR",66,0 ) | |
6774 | S DIC("A" )="Select INSURANCE COMPANY: " | |
6775 | "RTN","IBC NSUR",67,0 ) | |
6776 | D ^DIC K DIC S IBCN S=+Y | |
6777 | "RTN","IBC NSUR",68,0 ) | |
6778 | I Y<0 W " <No Ins urance Com pany selec ted>" S IB QUIT=1 G S ELQ | |
6779 | "RTN","IBC NSUR",69,0 ) | |
6780 | ; | |
6781 | "RTN","IBC NSUR",70,0 ) | |
6782 | ; - if a new plan m ay be adde d, allow a dding | |
6783 | "RTN","IBC NSUR",71,0 ) | |
6784 | I IBNP D I (IBPLAN )!(IBQUIT) G SELQ | |
6785 | "RTN","IBC NSUR",72,0 ) | |
6786 | .W !!,"Yo u may add a new Plan at this t ime or sel ect an exi sting Plan ." | |
6787 | "RTN","IBC NSUR",73,0 ) | |
6788 | .; IB*2.0 *506 added IBKEY par ameter (4t h) to the NEW^IBCNSJ 3 call (ch eck user's security keys) | |
6789 | "RTN","IBC NSUR",74,0 ) | |
6790 | .D NEW^IB CNSJ3(IBCN S,.IBPLAN, 1,1) | |
6791 | "RTN","IBC NSUR",75,0 ) | |
6792 | .I 'IBPLA N,'$$ANYGP ^IBCNSJ(+I BCNS,0,1) W !!,*7,"I nsurance C ompany rec eiving sub scribers m ust have a Plan." S IBQUIT=1 | |
6793 | "RTN","IBC NSUR",76,0 ) | |
6794 | ; | |
6795 | "RTN","IBC NSUR",77,0 ) | |
6796 | ; - see i f user wan ts to sele ct the pla n | |
6797 | "RTN","IBC NSUR",78,0 ) | |
6798 | W !!,"You may selec t an exist ing Plan f rom a list or enter a specific Plan.",! | |
6799 | "RTN","IBC NSUR",79,0 ) | |
6800 | S DIR(0)= "Y",DIR("B ")="YES",D IR("A")="D o you wish to enter a specific plan" | |
6801 | "RTN","IBC NSUR",80,0 ) | |
6802 | S DIR("?" )="The loo k-up facil ity to sel ect a grou p plan has been enha nced to us e the List Manager. Enter 'NO ' if you w ish to sel ect a plan from this look-up, or 'YES' t o directly enter a p lan." | |
6803 | "RTN","IBC NSUR",81,0 ) | |
6804 | D ^DIR K DIR I $D(D IRUT) S IB QUIT=1 G S ELQ | |
6805 | "RTN","IBC NSUR",82,0 ) | |
6806 | ; | |
6807 | "RTN","IBC NSUR",83,0 ) | |
6808 | ; - invok e the plan look-up | |
6809 | "RTN","IBC NSUR",84,0 ) | |
6810 | I 'Y D G SELQ | |
6811 | "RTN","IBC NSUR",85,0 ) | |
6812 | . N IBTIT LE | |
6813 | "RTN","IBC NSUR",86,0 ) | |
6814 | . S IBTIT LE="Group Plan Looku p" | |
6815 | "RTN","IBC NSUR",87,0 ) | |
6816 | . W " . .." | |
6817 | "RTN","IBC NSUR",88,0 ) | |
6818 | . S IBPLA N=0 | |
6819 | "RTN","IBC NSUR",89,0 ) | |
6820 | . D LKP^I BCNSU2(IBC NS,0,0,.IB PLAN,0,1,I BTITLE) | |
6821 | "RTN","IBC NSUR",90,0 ) | |
6822 | . I 'IBPL AN W !!,*7 ,"* No pl an selecte d!",! S IB QUIT=1 | |
6823 | "RTN","IBC NSUR",91,0 ) | |
6824 | ; | |
6825 | "RTN","IBC NSUR",92,0 ) | |
6826 | ; - allow a FileMan look-up | |
6827 | "RTN","IBC NSUR",93,0 ) | |
6828 | ; MRD;IB* 2.0*516 - Display ne w Group Na me and Num ber fields . | |
6829 | "RTN","IBC NSUR",94,0 ) | |
6830 | S DIC("A" )="Select a GROUP PL AN: " | |
6831 | "RTN","IBC NSUR",95,0 ) | |
6832 | S DIC="^I BA(355.3," ,DIC(0)="A EQM",DIC(" S")="I +^( 0)=IBCNS,$ P(^(0),U,2 )" | |
6833 | "RTN","IBC NSUR",96,0 ) | |
6834 | ;S DIC("W ")="N IBX S IBX=$G(^ (0)) W "" Name: "" ,$E($S($P( IBX,U,3)]" """:$P(IBX ,U,3),1:"" <none>"")_ $J("""",20 ),1,20),"" Number: "",$S($P( IBX,U,4)]" """:$P(IBX ,U,4),1:"" <none>"")" | |
6835 | "RTN","IBC NSUR",97,0 ) | |
6836 | S DIC("W" )="N IBX S IBX=$G(^( 2)) W "" Name: "", $E($S($P(I BX,U,1)]"" "":$P(IBX, U,1),1:""< none>"")_$ J("""",20) ,1,20),"" Number: "",$E($S($ P(IBX,U,2) ]"""":$P(I BX,U,2),1: ""<none>"" ),1,14)" | |
6837 | "RTN","IBC NSUR",98,0 ) | |
6838 | D ^DIC K DIC S IBPL AN=+Y | |
6839 | "RTN","IBC NSUR",99,0 ) | |
6840 | I Y<0 W ! !,*7,"* N o plan sel ected!",! S IBQUIT=1 | |
6841 | "RTN","IBC NSUR",100, 0) | |
6842 | ; | |
6843 | "RTN","IBC NSUR",101, 0) | |
6844 | SELQ K DIR UT,DUOUT,D TOUT,DIROU T | |
6845 | "RTN","IBC NSUR",102, 0) | |
6846 | Q | |
6847 | "RTN","IBC NSUR",103, 0) | |
6848 | ; | |
6849 | "RTN","IBC NSUR",104, 0) | |
6850 | EXPGRP ; E P for [IBC N EXPIRE G ROUP SUBSC RIBERS] | |
6851 | "RTN","IBC NSUR",105, 0) | |
6852 | ; IB*2.0* 602/DM imp lement exp ire group plan | |
6853 | "RTN","IBC NSUR",106, 0) | |
6854 | N X,Y,DIC ,DIR,DTA,E RR,REF,IBL N,XMDUZ,XM TEXT,XMSUB ,XMY | |
6855 | "RTN","IBC NSUR",107, 0) | |
6856 | N IBQUIT, IBCNS,IBPL AN,IBSUB,I BEXP,DFN,I BIPOL,IBIE NWK | |
6857 | "RTN","IBC NSUR",108, 0) | |
6858 | N IBINSNM ,IBGRPNM,I BGRPNO,IBE XPOK,IBEXP ERR,IBSUPR ES,IBCBI | |
6859 | "RTN","IBC NSUR",109, 0) | |
6860 | ; | |
6861 | "RTN","IBC NSUR",110, 0) | |
6862 | W !!,?5," EXPIRE ALL SUBSCRIBE RS WITHIN A GROUP PL AN" | |
6863 | "RTN","IBC NSUR",111, 0) | |
6864 | W !,?5,"Y ou can use this opti on to spec ify an exp iration da te for all subscribe r" | |
6865 | "RTN","IBC NSUR",112, 0) | |
6866 | W !,?5,"p olicies in a group p lan withou t moving t he subscri bers to an other grou p" | |
6867 | "RTN","IBC NSUR",113, 0) | |
6868 | W !,?5,"p lan. If th e group pl an status is current ly ""activ e"", you c an also ch oose" | |
6869 | "RTN","IBC NSUR",114, 0) | |
6870 | W !,?5,"t o ""inacti vate"" the group pla n." | |
6871 | "RTN","IBC NSUR",115, 0) | |
6872 | W !!,$TR( $J("",75), " ","-") | |
6873 | "RTN","IBC NSUR",116, 0) | |
6874 | S IBQUIT= 1 | |
6875 | "RTN","IBC NSUR",117, 0) | |
6876 | ; | |
6877 | "RTN","IBC NSUR",118, 0) | |
6878 | NXTGRP ; E P for next expire gr oup proces s | |
6879 | "RTN","IBC NSUR",119, 0) | |
6880 | K ^TMP($J ,"IBCNSUR" ) ; subscr ibers | |
6881 | "RTN","IBC NSUR",120, 0) | |
6882 | K ^TMP($J ,"IBCNSURB LL") ; bul letin | |
6883 | "RTN","IBC NSUR",121, 0) | |
6884 | I 'IBQUIT D | |
6885 | "RTN","IBC NSUR",122, 0) | |
6886 | . W !!,"= ========== ========== ========== ========== =" | |
6887 | "RTN","IBC NSUR",123, 0) | |
6888 | . W !,"EX PIRE ALL S UBSCRIBERS WITHIN A GROUP PLAN " | |
6889 | "RTN","IBC NSUR",124, 0) | |
6890 | . W !,"== ========== ========== ========== ========== ",! | |
6891 | "RTN","IBC NSUR",125, 0) | |
6892 | ; get ins co and pla n | |
6893 | "RTN","IBC NSUR",126, 0) | |
6894 | S IBQUIT= 0 | |
6895 | "RTN","IBC NSUR",127, 0) | |
6896 | D SEL^IBC NSUR(0) I IBQUIT Q | |
6897 | "RTN","IBC NSUR",128, 0) | |
6898 | ; | |
6899 | "RTN","IBC NSUR",129, 0) | |
6900 | ; Make su re plan ha s at least one subsc riber | |
6901 | "RTN","IBC NSUR",130, 0) | |
6902 | I '$$SUBS ^IBCNSJ(IB CNS,IBPLAN ,0,,1) W ! !,?5,*7,"* This grou p plan has no subscr ibers!",! G NXTGRP | |
6903 | "RTN","IBC NSUR",131, 0) | |
6904 | ; | |
6905 | "RTN","IBC NSUR",132, 0) | |
6906 | S IBINSNM =$$GET1^DI Q(36,IBCNS _",","NAME ") | |
6907 | "RTN","IBC NSUR",133, 0) | |
6908 | S IBGRPNM =$$GET1^DI Q(355.3,IB PLAN_","," GROUP NAME ") | |
6909 | "RTN","IBC NSUR",134, 0) | |
6910 | S IBGRPNO =$$GET1^DI Q(355.3,IB PLAN_","," GROUP NUMB ER") | |
6911 | "RTN","IBC NSUR",135, 0) | |
6912 | ; | |
6913 | "RTN","IBC NSUR",136, 0) | |
6914 | W !!,"Col lecting Su bscribers ..." | |
6915 | "RTN","IBC NSUR",137, 0) | |
6916 | S IBSUB=$ $SUBS^IBCN SJ(IBCNS,I BPLAN,0,"^ TMP($J,""I BCNSUR"")" ) | |
6917 | "RTN","IBC NSUR",138, 0) | |
6918 | W !!,"Thi s group pl an has "_+ IBSUB_" su bscribers. All subsc ribers wil l be expir ed.",! | |
6919 | "RTN","IBC NSUR",139, 0) | |
6920 | S DIR(0)= "Y" | |
6921 | "RTN","IBC NSUR",140, 0) | |
6922 | S DIR("A" )="Do you want to ex pire all s ubscribers ' policies for this plan" | |
6923 | "RTN","IBC NSUR",141, 0) | |
6924 | S DIR("?" ,1)="You w ill be ask ed for an expiration date to t erminate t he attache d policies ." | |
6925 | "RTN","IBC NSUR",142, 0) | |
6926 | S DIR("?" ,2)="You w ill have a n opportun ity to sto p if desir ed." | |
6927 | "RTN","IBC NSUR",143, 0) | |
6928 | S DIR("?" )="Enter ' Yes' to co ntinue, or 'No' to s top the pr ocess now. " | |
6929 | "RTN","IBC NSUR",144, 0) | |
6930 | D ^DIR K DIR | |
6931 | "RTN","IBC NSUR",145, 0) | |
6932 | I 'Y!$D(D IRUT) G NX TGRP | |
6933 | "RTN","IBC NSUR",146, 0) | |
6934 | ; | |
6935 | "RTN","IBC NSUR",147, 0) | |
6936 | W ! | |
6937 | "RTN","IBC NSUR",148, 0) | |
6938 | ; get the expiratio n date | |
6939 | "RTN","IBC NSUR",149, 0) | |
6940 | S DIR(0)= "D",DIR("A ")="Enter expiration date (app lies to al l subscrib ers in thi s plan)" | |
6941 | "RTN","IBC NSUR",150, 0) | |
6942 | S DIR("?" )="Each ac tive polic y will be expired wi th the exp iration da te entered ." | |
6943 | "RTN","IBC NSUR",151, 0) | |
6944 | D ^DIR K DIR | |
6945 | "RTN","IBC NSUR",152, 0) | |
6946 | I 'Y!$D(D IRUT) G NX TGRP | |
6947 | "RTN","IBC NSUR",153, 0) | |
6948 | S IBEXP=Y | |
6949 | "RTN","IBC NSUR",154, 0) | |
6950 | ; | |
6951 | "RTN","IBC NSUR",155, 0) | |
6952 | W !!,"You selected to expire "_+IBSUB_" subscribe r(s) with Expiration Date "_$$ FMTE^XLFDT (IBEXP)_" for:" | |
6953 | "RTN","IBC NSUR",156, 0) | |
6954 | W !,?5,"I nsurance C ompany "_I BINSNM | |
6955 | "RTN","IBC NSUR",157, 0) | |
6956 | W !,?5,"P lan Name " _IBGRPNM_" Number "_IBGRPNO | |
6957 | "RTN","IBC NSUR",158, 0) | |
6958 | W !!,"Ple ase Note t hat the po licy will be EXPIRED in the pa tient prof ile!!",! | |
6959 | "RTN","IBC NSUR",159, 0) | |
6960 | ; | |
6961 | "RTN","IBC NSUR",160, 0) | |
6962 | S DIR(0)= "Y",DIR("A ")="Okay t o continue " | |
6963 | "RTN","IBC NSUR",161, 0) | |
6964 | S DIR("?" ,1)="If yo u wish to expire the policies for these subscriber s, enter ' Yes'." | |
6965 | "RTN","IBC NSUR",162, 0) | |
6966 | S DIR("?" )="Otherwi se, enter 'No' to ex it." | |
6967 | "RTN","IBC NSUR",163, 0) | |
6968 | D ^DIR K DIR | |
6969 | "RTN","IBC NSUR",164, 0) | |
6970 | I 'Y!$D(D IRUT) G NX TGRP | |
6971 | "RTN","IBC NSUR",165, 0) | |
6972 | ; | |
6973 | "RTN","IBC NSUR",166, 0) | |
6974 | ; expire the plan s ubscribers | |
6975 | "RTN","IBC NSUR",167, 0) | |
6976 | ; as we p rocess the policies, we'll set the ^TMP nodes to ' O'k or 'E' rror | |
6977 | "RTN","IBC NSUR",168, 0) | |
6978 | W !!,"Exp iring Poli cies...",! | |
6979 | "RTN","IBC NSUR",169, 0) | |
6980 | S IBSUPRE S=1 ; tell COVERED^I BCNSM31 to be quiet | |
6981 | "RTN","IBC NSUR",170, 0) | |
6982 | S (IBEXPO K,IBEXPERR )=0 | |
6983 | "RTN","IBC NSUR",171, 0) | |
6984 | S DFN=0 F S DFN=$O (^TMP($J," IBCNSUR",D FN)) Q:'DF N D | |
6985 | "RTN","IBC NSUR",172, 0) | |
6986 | . S IBIPO L=0 F S I BIPOL=$O(^ TMP($J,"IB CNSUR",DFN ,IBIPOL)) Q:IBIPOL=" " D | |
6987 | "RTN","IBC NSUR",173, 0) | |
6988 | .. S IBIE NWK=IBIPOL _","_DFN_" ," | |
6989 | "RTN","IBC NSUR",174, 0) | |
6990 | .. Q:$$GE T1^DIQ(2.3 12,IBIENWK ,"GROUP PL AN","I")'= IBPLAN | |
6991 | "RTN","IBC NSUR",175, 0) | |
6992 | .. Q:+$$G ET1^DIQ(2. 312,IBIENW K,"INSURAN CE EXPIRAT ION","I") | |
6993 | "RTN","IBC NSUR",176, 0) | |
6994 | .. I $$GE T1^DIQ(2.3 12,IBIENWK ,"EFFECTIV E DATE OF POLICY","I ")>IBEXP S ^TMP($J," IBCNSUR",D FN,IBIPOL) ="E",IBEXP ERR=IBEXPE RR+1 Q | |
6995 | "RTN","IBC NSUR",177, 0) | |
6996 | .. S IBCB I=$$GET1^D IQ(2,DFN_" ,","COVERE D BY HEALT H INSURANC E?","I") | |
6997 | "RTN","IBC NSUR",178, 0) | |
6998 | .. K DTA, ERR | |
6999 | "RTN","IBC NSUR",179, 0) | |
7000 | .. S DTA( 2.312,IBIE NWK,3)=IBE XP ; set t he expirat ion date | |
7001 | "RTN","IBC NSUR",180, 0) | |
7002 | .. S DTA( 2.312,IBIE NWK,1.05)= $$NOW^XLFD T() ; last edited | |
7003 | "RTN","IBC NSUR",181, 0) | |
7004 | .. S DTA( 2.312,IBIE NWK,1.06)= DUZ ; by | |
7005 | "RTN","IBC NSUR",182, 0) | |
7006 | .. D FILE ^DIE("","D TA","ERR") | |
7007 | "RTN","IBC NSUR",183, 0) | |
7008 | .. I $D(E RR) S ^TMP ($J,"IBCNS UR",DFN,IB IPOL)="E", IBEXPERR=I BEXPERR+1 Q | |
7009 | "RTN","IBC NSUR",184, 0) | |
7010 | .. S ^TMP ($J,"IBCNS UR",DFN,IB IPOL)="O", IBEXPOK=IB EXPOK+1 | |
7011 | "RTN","IBC NSUR",185, 0) | |
7012 | .. D COVE RED^IBCNSM 31(DFN,IBC BI) ; set covered by insurance | |
7013 | "RTN","IBC NSUR",186, 0) | |
7014 | ; | |
7015 | "RTN","IBC NSUR",187, 0) | |
7016 | W !,"Done . "_IBEXPO K_" Subscr ibers' pol icies were expired a s of "_$$F MTE^XLFDT( IBEXP)_"." | |
7017 | "RTN","IBC NSUR",188, 0) | |
7018 | W !,"A Bu lletin was sent to y ou and mem bers of 'I B NEW INSU RANCE' Mai l Group." | |
7019 | "RTN","IBC NSUR",189, 0) | |
7020 | ; | |
7021 | "RTN","IBC NSUR",190, 0) | |
7022 | ; prepare the bulle tin | |
7023 | "RTN","IBC NSUR",191, 0) | |
7024 | S IBLN=0, REF=$NA(^T MP($J,"IBC NSURBLL")) | |
7025 | "RTN","IBC NSUR",192, 0) | |
7026 | D ADD^IBC NSUR3(1,"E XPIRE ALL SUBSCRIBER S WITHIN A GROUP PLA N") | |
7027 | "RTN","IBC NSUR",193, 0) | |
7028 | D ADD^IBC NSUR3() | |
7029 | "RTN","IBC NSUR",194, 0) | |
7030 | D ADD^IBC NSUR3(1,"Y ou selecte d to expir e ",IBSUB, " subscrib er(s)") | |
7031 | "RTN","IBC NSUR",195, 0) | |
7032 | D ADD^IBC NSUR3() | |
7033 | "RTN","IBC NSUR",196, 0) | |
7034 | D ADD^IBC NSUR3(1,"F ROM Insura nce Compan y ",IBINSN M) | |
7035 | "RTN","IBC NSUR",197, 0) | |
7036 | D ADD^IBC NSUR3(1,"P lan Name " ,IBGRPNM," Number ",IBGRPNO ) | |
7037 | "RTN","IBC NSUR",198, 0) | |
7038 | D ADD^IBC NSUR3() | |
7039 | "RTN","IBC NSUR",199, 0) | |
7040 | D ADD^IBC NSUR3(1,"P olicies wi ll be expi red as of ",$$FMTE^X LFDT(IBEXP ),".") | |
7041 | "RTN","IBC NSUR",200, 0) | |
7042 | D ADD^IBC NSUR3() | |
7043 | "RTN","IBC NSUR",201, 0) | |
7044 | ; | |
7045 | "RTN","IBC NSUR",202, 0) | |
7046 | I IBEXPER R D | |
7047 | "RTN","IBC NSUR",203, 0) | |
7048 | . D ADD^I BCNSUR3(1, "* These " ,IBEXPERR, " entries could not be process ed, they'l l need to be adjuste d manually ") | |
7049 | "RTN","IBC NSUR",204, 0) | |
7050 | . W !!,@R EF@(IBLN) | |
7051 | "RTN","IBC NSUR",205, 0) | |
7052 | . D ADD^I BCNSUR3(1, "--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ") | |
7053 | "RTN","IBC NSUR",206, 0) | |
7054 | . W !,@RE F@(IBLN) | |
7055 | "RTN","IBC NSUR",207, 0) | |
7056 | . D ADD^I BCNSUR3(1, "Patient N ame/ID W hose Em ployer Effective Expires" ) | |
7057 | "RTN","IBC NSUR",208, 0) | |
7058 | . W !,@RE F@(IBLN),! | |
7059 | "RTN","IBC NSUR",209, 0) | |
7060 | . S DFN=0 F S DFN= $O(^TMP($J ,"IBCNSUR" ,DFN)) Q:' DFN D | |
7061 | "RTN","IBC NSUR",210, 0) | |
7062 | .. S IBIP OL=0 F S IBIPOL=$O( ^TMP($J,"I BCNSUR",DF N,IBIPOL)) Q:IBIPOL= "" D | |
7063 | "RTN","IBC NSUR",211, 0) | |
7064 | ... I ^TM P($J,"IBCN SUR",DFN,I BIPOL)'="E " Q | |
7065 | "RTN","IBC NSUR",212, 0) | |
7066 | ... D ADS ^IBCNSUR3( DFN,IBIPOL ) | |
7067 | "RTN","IBC NSUR",213, 0) | |
7068 | ... W !,@ REF@(IBLN) | |
7069 | "RTN","IBC NSUR",214, 0) | |
7070 | . D ADD^I BCNSUR3(1, "========= ========== =========" ) | |
7071 | "RTN","IBC NSUR",215, 0) | |
7072 | . D ADD^I BCNSUR3() | |
7073 | "RTN","IBC NSUR",216, 0) | |
7074 | . W !!,"E xamine the entries t hat could not be pro cessed." | |
7075 | "RTN","IBC NSUR",217, 0) | |
7076 | ; | |
7077 | "RTN","IBC NSUR",218, 0) | |
7078 | I IBEXPOK D | |
7079 | "RTN","IBC NSUR",219, 0) | |
7080 | . D ADD^I BCNSUR3(1, "These ",I BEXPOK," p olicies we re process ed success fully") | |
7081 | "RTN","IBC NSUR",220, 0) | |
7082 | . D ADD^I BCNSUR3(1, "--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ") | |
7083 | "RTN","IBC NSUR",221, 0) | |
7084 | . D ADD^I BCNSUR3(1, "Patient N ame/ID W hose Em ployer Effective Expires" ) | |
7085 | "RTN","IBC NSUR",222, 0) | |
7086 | . S DFN=0 F S DFN= $O(^TMP($J ,"IBCNSUR" ,DFN)) Q:' DFN D | |
7087 | "RTN","IBC NSUR",223, 0) | |
7088 | .. S IBIP OL=0 F S IBIPOL=$O( ^TMP($J,"I BCNSUR",DF N,IBIPOL)) Q:IBIPOL= "" D | |
7089 | "RTN","IBC NSUR",224, 0) | |
7090 | ... I ^TM P($J,"IBCN SUR",DFN,I BIPOL)'="O " Q | |
7091 | "RTN","IBC NSUR",225, 0) | |
7092 | ... D ADS ^IBCNSUR3( DFN,IBIPOL ) | |
7093 | "RTN","IBC NSUR",226, 0) | |
7094 | . D ADD^I BCNSUR3(1, "========= ========== =========" ) | |
7095 | "RTN","IBC NSUR",227, 0) | |
7096 | . D ADD^I BCNSUR3() | |
7097 | "RTN","IBC NSUR",228, 0) | |
7098 | ; | |
7099 | "RTN","IBC NSUR",229, 0) | |
7100 | I 'IBEXPO K,'IBEXPER R D | |
7101 | "RTN","IBC NSUR",230, 0) | |
7102 | . D ADD^I BCNSUR3(1, "========= ========== =========" ) | |
7103 | "RTN","IBC NSUR",231, 0) | |
7104 | . D ADD^I BCNSUR3(1, "After pro cessing, n o changes were neede d, no poli cies were expired.") | |
7105 | "RTN","IBC NSUR",232, 0) | |
7106 | . W !!,@R EF@(IBLN) | |
7107 | "RTN","IBC NSUR",233, 0) | |
7108 | . D ADD^I BCNSUR3(1, "========= ========== =========" ) | |
7109 | "RTN","IBC NSUR",234, 0) | |
7110 | . D ADD^I BCNSUR3() | |
7111 | "RTN","IBC NSUR",235, 0) | |
7112 | ; | |
7113 | "RTN","IBC NSUR",236, 0) | |
7114 | W ! | |
7115 | "RTN","IBC NSUR",237, 0) | |
7116 | S DIR(0)= "EA",DIR(" A")="Press RETURN to continue. " D ^DIR K DIR | |
7117 | "RTN","IBC NSUR",238, 0) | |
7118 | ; | |
7119 | "RTN","IBC NSUR",239, 0) | |
7120 | I +$$GET1 ^DIQ(355.3 ,IBPLAN_", ","INACTIV E","I") D G NXTGRP | |
7121 | "RTN","IBC NSUR",240, 0) | |
7122 | . D ADD^I BCNSUR3(1, "Please no te the ",I BGRPNM," p lan is alr eady inact ive.") | |
7123 | "RTN","IBC NSUR",241, 0) | |
7124 | . W !!,@R EF@(IBLN), ! | |
7125 | "RTN","IBC NSUR",242, 0) | |
7126 | . D SNDBU LL | |
7127 | "RTN","IBC NSUR",243, 0) | |
7128 | ; | |
7129 | "RTN","IBC NSUR",244, 0) | |
7130 | W ! | |
7131 | "RTN","IBC NSUR",245, 0) | |
7132 | S DIR(0)= "Y",DIR("B ")="NO" | |
7133 | "RTN","IBC NSUR",246, 0) | |
7134 | I IBEXPER R D | |
7135 | "RTN","IBC NSUR",247, 0) | |
7136 | . S DIR(" A",1)=" ****** ********** ********** ********** ********** *" | |
7137 | "RTN","IBC NSUR",248, 0) | |
7138 | . S DIR(" A",2)=" * WARNIN G *" | |
7139 | "RTN","IBC NSUR",249, 0) | |
7140 | . S DIR(" A",3)=" * There are still acti ve subscri bers *" | |
7141 | "RTN","IBC NSUR",250, 0) | |
7142 | . S DIR(" A",4)=" * th at will ne ed to be a djusted ma nually *" | |
7143 | "RTN","IBC NSUR",251, 0) | |
7144 | . S DIR(" A",5)=" ****** ********** ********** ********** ********** *" | |
7145 | "RTN","IBC NSUR",252, 0) | |
7146 | . S DIR(" A",6)=" " | |
7147 | "RTN","IBC NSUR",253, 0) | |
7148 | S DIR("A" )="Do you wish to in activate p lan "_IBGR PNM | |
7149 | "RTN","IBC NSUR",254, 0) | |
7150 | D ^DIR K DIR | |
7151 | "RTN","IBC NSUR",255, 0) | |
7152 | I 'Y!$D(D IRUT) D G NXTGRP | |
7153 | "RTN","IBC NSUR",256, 0) | |
7154 | . D ADD^I BCNSUR3(1, "The ",IBG RPNM," pla n is still active.") | |
7155 | "RTN","IBC NSUR",257, 0) | |
7156 | . W !!,@R EF@(IBLN), ! | |
7157 | "RTN","IBC NSUR",258, 0) | |
7158 | . D SNDBU LL | |
7159 | "RTN","IBC NSUR",259, 0) | |
7160 | ; inactiv ate the pl an | |
7161 | "RTN","IBC NSUR",260, 0) | |
7162 | S IBIENWK =IBPLAN_", " | |
7163 | "RTN","IBC NSUR",261, 0) | |
7164 | K DTA,ERR | |
7165 | "RTN","IBC NSUR",262, 0) | |
7166 | S DTA(355 .3,IBIENWK ,.11)=1 ; inactive | |
7167 | "RTN","IBC NSUR",263, 0) | |
7168 | S DTA(355 .3,IBIENWK ,1.05)=$$N OW^XLFDT() ; last ed ited | |
7169 | "RTN","IBC NSUR",264, 0) | |
7170 | S DTA(355 .3,IBIENWK ,1.06)=DUZ ; by | |
7171 | "RTN","IBC NSUR",265, 0) | |
7172 | D FILE^DI E("","DTA" ,"ERR") | |
7173 | "RTN","IBC NSUR",266, 0) | |
7174 | I $D(ERR) D G NXTG RP | |
7175 | "RTN","IBC NSUR",267, 0) | |
7176 | . D ADD^I BCNSUR3(1, "There was an issue inactivati ng the ",I BGRPNM," p lan.") | |
7177 | "RTN","IBC NSUR",268, 0) | |
7178 | . W !!,@R EF@(IBLN), ! | |
7179 | "RTN","IBC NSUR",269, 0) | |
7180 | . D SNDBU LL | |
7181 | "RTN","IBC NSUR",270, 0) | |
7182 | D ADD^IBC NSUR3(1,"T he ",IBGRP NM," plan has been i nactivated .") | |
7183 | "RTN","IBC NSUR",271, 0) | |
7184 | W !!,@REF @(IBLN),! | |
7185 | "RTN","IBC NSUR",272, 0) | |
7186 | D SNDBULL | |
7187 | "RTN","IBC NSUR",273, 0) | |
7188 | G NXTGRP | |
7189 | "RTN","IBC NSUR",274, 0) | |
7190 | ; | |
7191 | "RTN","IBC NSUR",275, 0) | |
7192 | SNDBULL ; send out t he bulleti n | |
7193 | "RTN","IBC NSUR",276, 0) | |
7194 | I '$G(IBL N) Q | |
7195 | "RTN","IBC NSUR",277, 0) | |
7196 | D ADD^IBC NSUR3() | |
7197 | "RTN","IBC NSUR",278, 0) | |
7198 | D ADD^IBC NSUR3(1,"T HE PROCESS COMPLETED SUCCESSFU LLY ON "_$ $DAT1^IBOU TL($$NOW^X LFDT(),1)) | |
7199 | "RTN","IBC NSUR",279, 0) | |
7200 | S XMSUB=" SUBSCRIPTI ON LIST FO R INACTIVA TED PLAN" | |
7201 | "RTN","IBC NSUR",280, 0) | |
7202 | S XMDUZ=" INTEGRATED BILLING P ACKAGE",XM TEXT="^TMP ("_$J_","" IBCNSURBLL ""," | |
7203 | "RTN","IBC NSUR",281, 0) | |
7204 | S XMY(DUZ )="" | |
7205 | "RTN","IBC NSUR",282, 0) | |
7206 | S XMY("G. IB NEW INS URANCE")=" " | |
7207 | "RTN","IBC NSUR",283, 0) | |
7208 | D ^XMD | |
7209 | "RTN","IBC NSUR",284, 0) | |
7210 | Q | |
7211 | "RTN","IBC OC1") | |
7212 | 0^8^B24512 676^B21404 907 | |
7213 | "RTN","IBC OC1",1,0) | |
7214 | IBCOC1 ;AL B/NLR - NE W, NOT VER IFIED INS. ENTRIES ; 24-NOV-93 | |
7215 | "RTN","IBC OC1",2,0) | |
7216 | ;;2.0;INT EGRATED BI LLING;**52 8,602**;21 -MAR-94;Bu ild 22 | |
7217 | "RTN","IBC OC1",3,0) | |
7218 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7219 | "RTN","IBC OC1",4,0) | |
7220 | ; | |
7221 | "RTN","IBC OC1",5,0) | |
7222 | % ; | |
7223 | "RTN","IBC OC1",6,0) | |
7224 | N POP,ZTQ UEUED,ZTRE Q | |
7225 | "RTN","IBC OC1",7,0) | |
7226 | ; -- file man print of new, no t verified insurance entries | |
7227 | "RTN","IBC OC1",8,0) | |
7228 | ; | |
7229 | "RTN","IBC OC1",9,0) | |
7230 | W !!,"Pri nt List of New, Not Verified I nsurance E ntries" | |
7231 | "RTN","IBC OC1",10,0) | |
7232 | ; | |
7233 | "RTN","IBC OC1",11,0) | |
7234 | ; Report or Excel f ormat | |
7235 | "RTN","IBC OC1",12,0) | |
7236 | S IBOUT=$ $OUT G:IBO UT="" END | |
7237 | "RTN","IBC OC1",13,0) | |
7238 | I IBOUT=" E" G EXCEL | |
7239 | "RTN","IBC OC1",14,0) | |
7240 | ; | |
7241 | "RTN","IBC OC1",15,0) | |
7242 | W !!,"You will need a 132 col umn printe r for this report!", !! | |
7243 | "RTN","IBC OC1",16,0) | |
7244 | ; | |
7245 | "RTN","IBC OC1",17,0) | |
7246 | S DIC="^D PT(",FLDS= "[IBNOTVER ]",BY="[IB NOTVER1]" | |
7247 | "RTN","IBC OC1",18,0) | |
7248 | D ASK G:$ G(IBQ)=1 E ND | |
7249 | "RTN","IBC OC1",19,0) | |
7250 | S DHD="RE PORT OF NE W, NOT VER IFIED INSU RANCE ENTR IES FROM: "_FR(1)_" TO: "_TO(1 ) | |
7251 | "RTN","IBC OC1",20,0) | |
7252 | D EN1^DIP ,ASK^IBCOM C2 | |
7253 | "RTN","IBC OC1",21,0) | |
7254 | ; | |
7255 | "RTN","IBC OC1",22,0) | |
7256 | I $D(ZTQU EUED) S ZT REQ="@" Q | |
7257 | "RTN","IBC OC1",23,0) | |
7258 | D ^%ZISC | |
7259 | "RTN","IBC OC1",24,0) | |
7260 | END K DIC, FLDS,BY,FR ,TO,IBOUT, IBQ,DHD | |
7261 | "RTN","IBC OC1",25,0) | |
7262 | Q | |
7263 | "RTN","IBC OC1",26,0) | |
7264 | ASK ; | |
7265 | "RTN","IBC OC1",27,0) | |
7266 | N IBBDT,I BEDT | |
7267 | "RTN","IBC OC1",28,0) | |
7268 | D DATE^IB OUTL | |
7269 | "RTN","IBC OC1",29,0) | |
7270 | I (IBBDT< 1)!(IBEDT< 1) S IBQ=1 | |
7271 | "RTN","IBC OC1",30,0) | |
7272 | S FR=",," _IBBDT_",? ",TO=",,"_ IBEDT_",?" | |
7273 | "RTN","IBC OC1",31,0) | |
7274 | S FR(1)=$ $DAT1^IBOU TL(IBBDT), TO(1)=$$DA T1^IBOUTL( IBEDT) | |
7275 | "RTN","IBC OC1",32,0) | |
7276 | Q | |
7277 | "RTN","IBC OC1",33,0) | |
7278 | ; | |
7279 | "RTN","IBC OC1",34,0) | |
7280 | OUT() ; | |
7281 | "RTN","IBC OC1",35,0) | |
7282 | N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y | |
7283 | "RTN","IBC OC1",36,0) | |
7284 | W ! | |
7285 | "RTN","IBC OC1",37,0) | |
7286 | S DIR(0)= "SA^E:Exce l;R:Report " | |
7287 | "RTN","IBC OC1",38,0) | |
7288 | S DIR("A" )="(E)xcel Format or (R)eport Format: " | |
7289 | "RTN","IBC OC1",39,0) | |
7290 | S DIR("B" )="Report" | |
7291 | "RTN","IBC OC1",40,0) | |
7292 | D ^DIR I $D(DIRUT) Q "" | |
7293 | "RTN","IBC OC1",41,0) | |
7294 | Q Y | |
7295 | "RTN","IBC OC1",42,0) | |
7296 | ; | |
7297 | "RTN","IBC OC1",43,0) | |
7298 | EXCEL ; | |
7299 | "RTN","IBC OC1",44,0) | |
7300 | ; Ask for Date Ente red range | |
7301 | "RTN","IBC OC1",45,0) | |
7302 | N IBBDT,I BEDT,IBRF, IBRL,IBQUI T | |
7303 | "RTN","IBC OC1",46,0) | |
7304 | S IBQUIT= 0 | |
7305 | "RTN","IBC OC1",47,0) | |
7306 | D DATE^IB OUTL | |
7307 | "RTN","IBC OC1",48,0) | |
7308 | I (IBBDT< 1)!(IBEDT< 1) G XLQUI T | |
7309 | "RTN","IBC OC1",49,0) | |
7310 | ; | |
7311 | "RTN","IBC OC1",50,0) | |
7312 | D NR G:IB QUIT XLQUI T | |
7313 | "RTN","IBC OC1",51,0) | |
7314 | ; | |
7315 | "RTN","IBC OC1",52,0) | |
7316 | W !! D QU E | |
7317 | "RTN","IBC OC1",53,0) | |
7318 | ; | |
7319 | "RTN","IBC OC1",54,0) | |
7320 | XLQUIT ; | |
7321 | "RTN","IBC OC1",55,0) | |
7322 | K IBBDT,I BEDT,IBRF, IBRL,IBOUT ,IBQUIT | |
7323 | "RTN","IBC OC1",56,0) | |
7324 | Q | |
7325 | "RTN","IBC OC1",57,0) | |
7326 | ; | |
7327 | "RTN","IBC OC1",58,0) | |
7328 | NR ; Ask N ame Range | |
7329 | "RTN","IBC OC1",59,0) | |
7330 | N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y | |
7331 | "RTN","IBC OC1",60,0) | |
7332 | NRR S DIR( 0)="FO",DI R("B")="FI RST",DIR(" A")=" START WIT H NAME" | |
7333 | "RTN","IBC OC1",61,0) | |
7334 | D ^DIR I ($D(DTOUT) )!($D(DUOU T)) S IBQU IT=1 Q | |
7335 | "RTN","IBC OC1",62,0) | |
7336 | S:Y="FIRS T" Y="A" S IBRF=Y | |
7337 | "RTN","IBC OC1",63,0) | |
7338 | S DIR(0)= "FO",DIR(" B")="LAST" ,DIR("A")= " GO TO NAME" | |
7339 | "RTN","IBC OC1",64,0) | |
7340 | D ^DIR I ($D(DTOUT) )!($D(DUOU T)) S IBQU IT=1 Q | |
7341 | "RTN","IBC OC1",65,0) | |
7342 | S:Y="LAST " Y="zzzzz z" S IBRL= Y | |
7343 | "RTN","IBC OC1",66,0) | |
7344 | I $G(IBRL )']$G(IBRF ) W !!,?5, "* The Go to Patient Name must follow af ter the St art with N ame. *",! G NRR | |
7345 | "RTN","IBC OC1",67,0) | |
7346 | Q | |
7347 | "RTN","IBC OC1",68,0) | |
7348 | ; | |
7349 | "RTN","IBC OC1",69,0) | |
7350 | QUE ; Ask Device for Excel Out put | |
7351 | "RTN","IBC OC1",70,0) | |
7352 | N %ZIS,ZT RTN,ZTSAVE ,ZTDESC | |
7353 | "RTN","IBC OC1",71,0) | |
7354 | S %ZIS="Q M" D ^%ZIS G:POP QUE Q | |
7355 | "RTN","IBC OC1",72,0) | |
7356 | I $D(IO(" Q")) K IO( "Q") D G QUEQ | |
7357 | "RTN","IBC OC1",73,0) | |
7358 | .S ZTRTN= "COMPXL^IB COC1",ZTSA VE("IBRF") ="",ZTSAVE ("IBRL")=" " | |
7359 | "RTN","IBC OC1",74,0) | |
7360 | .S ZTSAVE ("IBBDT")= "",ZTSAVE( "IBEDT")=" " | |
7361 | "RTN","IBC OC1",75,0) | |
7362 | .S ZTDESC ="IB - Lis t New not Verified P olicies" | |
7363 | "RTN","IBC OC1",76,0) | |
7364 | .D ^%ZTLO AD K ZTSK D HOME^%ZI S | |
7365 | "RTN","IBC OC1",77,0) | |
7366 | ; | |
7367 | "RTN","IBC OC1",78,0) | |
7368 | U IO | |
7369 | "RTN","IBC OC1",79,0) | |
7370 | D COMPXL | |
7371 | "RTN","IBC OC1",80,0) | |
7372 | ; | |
7373 | "RTN","IBC OC1",81,0) | |
7374 | QUEQ ; Exi t clean-up | |
7375 | "RTN","IBC OC1",82,0) | |
7376 | W ! D ^%Z ISC K IBBD T,IBEDT,IB OUT,IBRF,I BRL,VA,VAE RR,VADM,VA PA,^TMP("I BCOC1",$J) | |
7377 | "RTN","IBC OC1",83,0) | |
7378 | Q | |
7379 | "RTN","IBC OC1",84,0) | |
7380 | ; | |
7381 | "RTN","IBC OC1",85,0) | |
7382 | COMPXL ; C ompile Exc el data | |
7383 | "RTN","IBC OC1",86,0) | |
7384 | ; Input v ariables: | |
7385 | "RTN","IBC OC1",87,0) | |
7386 | ; IBRF - Required. Name Ran ge Start v alue | |
7387 | "RTN","IBC OC1",88,0) | |
7388 | ; IBRL - Required. Name Ran ge Go To v alue | |
7389 | "RTN","IBC OC1",89,0) | |
7390 | ; IBBDT - Required. Begining Entered D ate Range | |
7391 | "RTN","IBC OC1",90,0) | |
7392 | ; IBEDT - Required. Ending E ntered Dat e Range | |
7393 | "RTN","IBC OC1",91,0) | |
7394 | ; | |
7395 | "RTN","IBC OC1",92,0) | |
7396 | N IBC,IBC DA,IBCDA0, IBCDA1,IBS SN,IBINS,I BSUBID,IBE NDT,IBENUS R,DFN,VA,V ADM,VAERR, VAPA | |
7397 | "RTN","IBC OC1",93,0) | |
7398 | K ^TMP("I BCOC1",$J) | |
7399 | "RTN","IBC OC1",94,0) | |
7400 | S IBC=0 F S IBC=$O (^DPT("AB" ,IBC)) Q:' IBC D | |
7401 | "RTN","IBC OC1",95,0) | |
7402 | .S DFN=0 F S DFN=$ O(^DPT("AB ",IBC,DFN) ) Q:'DFN D | |
7403 | "RTN","IBC OC1",96,0) | |
7404 | ..K VA,VA DM,VAERR,V APA | |
7405 | "RTN","IBC OC1",97,0) | |
7406 | ..D DEM^V ADPT,ADD^V ADPT | |
7407 | "RTN","IBC OC1",98,0) | |
7408 | ..; | |
7409 | "RTN","IBC OC1",99,0) | |
7410 | ..; I Pt . name out of range quit | |
7411 | "RTN","IBC OC1",100,0 ) | |
7412 | ..S VADM( 1)=$P($G(V ADM(1)),U, 1) I VADM( 1)="" Q | |
7413 | "RTN","IBC OC1",101,0 ) | |
7414 | ..I VADM( 1)]IBRL Q | |
7415 | "RTN","IBC OC1",102,0 ) | |
7416 | ..I IBRF] VADM(1) Q | |
7417 | "RTN","IBC OC1",103,0 ) | |
7418 | ..; | |
7419 | "RTN","IBC OC1",104,0 ) | |
7420 | ..S IBCDA =0 F S IB CDA=$O(^DP T("AB",IBC ,DFN,IBCDA )) Q:'IBCD A D | |
7421 | "RTN","IBC OC1",105,0 ) | |
7422 | ...S IBCD A0=$$ZND^I BCNS1(DFN, IBCDA) ;5 16 - baa | |
7423 | "RTN","IBC OC1",106,0 ) | |
7424 | ...; | |
7425 | "RTN","IBC OC1",107,0 ) | |
7426 | ...; I V erificatio n Date pop ulated qui t | |
7427 | "RTN","IBC OC1",108,0 ) | |
7428 | ...S IBCD A1=$G(^DPT (DFN,.312, IBCDA,1)) | |
7429 | "RTN","IBC OC1",109,0 ) | |
7430 | ...I $P(I BCDA1,U,3) Q | |
7431 | "RTN","IBC OC1",110,0 ) | |
7432 | ...; | |
7433 | "RTN","IBC OC1",111,0 ) | |
7434 | ...; I E ntered Dat e out of r ange quit | |
7435 | "RTN","IBC OC1",112,0 ) | |
7436 | ...I +$P( IBCDA1,U)> IBEDT Q | |
7437 | "RTN","IBC OC1",113,0 ) | |
7438 | ...I +$P( IBCDA1,U)< IBBDT Q | |
7439 | "RTN","IBC OC1",114,0 ) | |
7440 | ...; | |
7441 | "RTN","IBC OC1",115,0 ) | |
7442 | ...; Get data fiel ds | |
7443 | "RTN","IBC OC1",116,0 ) | |
7444 | ...S IBSS N=$$GET1^D IQ(2,DFN,. 09) | |
7445 | "RTN","IBC OC1",117,0 ) | |
7446 | ...S IBIN S=$$GET1^D IQ(2.312,I BCDA_","_D FN_",",.01 ) | |
7447 | "RTN","IBC OC1",118,0 ) | |
7448 | ...S IBSU BID=$$GET1 ^DIQ(2.312 ,IBCDA_"," _DFN_",",7 .02) | |
7449 | "RTN","IBC OC1",119,0 ) | |
7450 | ...S IBEN USR=$$GET1 ^DIQ(2.312 ,IBCDA_"," _DFN_",",1 .02) | |
7451 | "RTN","IBC OC1",120,0 ) | |
7452 | ...S IBEN DT=$$FMTE^ XLFDT($P(I BCDA1,U),1 ) | |
7453 | "RTN","IBC OC1",121,0 ) | |
7454 | ...; | |
7455 | "RTN","IBC OC1",122,0 ) | |
7456 | ...; Set global ar ray | |
7457 | "RTN","IBC OC1",123,0 ) | |
7458 | ...S ^TMP ("IBCOC1", $J,VADM(1) ,IBCDA)=VA DM(1)_U_IB SSN_U_IBIN S_U_IBSUBI D_U_IBENUS R_U_IBENDT | |
7459 | "RTN","IBC OC1",124,0 ) | |
7460 | ; | |
7461 | "RTN","IBC OC1",125,0 ) | |
7462 | ;IB*2.0*6 02 Add tit le to Exce l Report | |
7463 | "RTN","IBC OC1",126,0 ) | |
7464 | W "REPORT OF NEW, N OT VERIFIE D INSURANC E ENTRIES FROM: ",$$ DAT1^IBOUT L(IBBDT)," TO: ",$$D AT1^IBOUTL (IBEDT) | |
7465 | "RTN","IBC OC1",127,0 ) | |
7466 | W !,"NAME S RANGING FROM ",$S( IBRF="A":" FIRST",1:I BRF)," TO ",$S(IBRL= "zzzzzz":" LAST",1:IB RL)_"^"_$$ FMTE^XLFDT ($$NOW^XLF DT,"Z"),! ; IB*2.0*6 02 | |
7467 | "RTN","IBC OC1",128,0 ) | |
7468 | ; IB*602/ HN end | |
7469 | "RTN","IBC OC1",129,0 ) | |
7470 | W "PATIEN T^PATIENT ID^INSURAN CE CO^SUBS CRIBER ID^ WHO ENTERE D^DATE ENT ERED" | |
7471 | "RTN","IBC OC1",130,0 ) | |
7472 | I '$D(^TM P("IBCOC1" ,$J)) W !! ,"** NO RE CORDS FOUN D **" D AS K^IBCOMC2 Q | |
7473 | "RTN","IBC OC1",131,0 ) | |
7474 | D WRT,ASK ^IBCOMC2 | |
7475 | "RTN","IBC OC1",132,0 ) | |
7476 | ; | |
7477 | "RTN","IBC OC1",133,0 ) | |
7478 | Q | |
7479 | "RTN","IBC OC1",134,0 ) | |
7480 | ; | |
7481 | "RTN","IBC OC1",135,0 ) | |
7482 | WRT ; Prin t Excel da ta | |
7483 | "RTN","IBC OC1",136,0 ) | |
7484 | N IBPAT,I BINSTYP | |
7485 | "RTN","IBC OC1",137,0 ) | |
7486 | S (IBPAT, IBINSTYP)= "" | |
7487 | "RTN","IBC OC1",138,0 ) | |
7488 | F S IBPA T=$O(^TMP( "IBCOC1",$ J,IBPAT)) Q:IBPAT="" D | |
7489 | "RTN","IBC OC1",139,0 ) | |
7490 | .F S IBI NSTYP=$O(^ TMP("IBCOC 1",$J,IBPA T,IBINSTYP )) Q:'IBIN STYP W !, ^TMP("IBCO C1",$J,IBP AT,IBINSTY P) | |
7491 | "RTN","IBC OC1",140,0 ) | |
7492 | Q | |
7493 | "RTN","IBC OMD1") | |
7494 | 0^9^B37249 446^B27677 991 | |
7495 | "RTN","IBC OMD1",1,0) | |
7496 | IBCOMD1 ;A LB/CMS - G ENERATE IN SURANCE CO MPANY LIST INGS ;03-A UG-98 | |
7497 | "RTN","IBC OMD1",2,0) | |
7498 | ;;2.0;INT EGRATED BI LLING;**10 3,528,602* *;21-MAR-9 4;Build 22 | |
7499 | "RTN","IBC OMD1",3,0) | |
7500 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7501 | "RTN","IBC OMD1",4,0) | |
7502 | Q | |
7503 | "RTN","IBC OMD1",5,0) | |
7504 | ; | |
7505 | "RTN","IBC OMD1",6,0) | |
7506 | BEG ; Queu ed entry p oint. | |
7507 | "RTN","IBC OMD1",7,0) | |
7508 | ; Input variables: | |
7509 | "RTN","IBC OMD1",8,0) | |
7510 | ; | |
7511 | "RTN","IBC OMD1",9,0) | |
7512 | ; IBCASE (n) = x ^ y ^ z (Op tional), w here | |
7513 | "RTN","IBC OMD1",10,0 ) | |
7514 | ; n = 1-4 (1:N ame, 2:Str eet, 3:Cit y, 4:State ) | |
7515 | "RTN","IBC OMD1",11,0 ) | |
7516 | ; x = C (Contai ns), or R (RANGE) | |
7517 | "RTN","IBC OMD1",12,0 ) | |
7518 | ; y = Pointer t o the STAT E (#5) fil e, if n=4 | |
7519 | "RTN","IBC OMD1",13,0 ) | |
7520 | ; The 'Cont ains' valu e, if x = C | |
7521 | "RTN","IBC OMD1",14,0 ) | |
7522 | ; The 'Star t From' va lue, if x = R | |
7523 | "RTN","IBC OMD1",15,0 ) | |
7524 | ; z = The 'Go T o' value, if x = R | |
7525 | "RTN","IBC OMD1",16,0 ) | |
7526 | ; | |
7527 | "RTN","IBC OMD1",17,0 ) | |
7528 | ; IBFLD( n) = x (R equired), where | |
7529 | "RTN","IBC OMD1",18,0 ) | |
7530 | ; n = 1-4 (1:N ame, 2:Str eet, 3:Cit y, 4:State ) | |
7531 | "RTN","IBC OMD1",19,0 ) | |
7532 | ; x = NAME (n=1 ), STREET (n=2), CIT Y (n=3), S TATE (n=4) | |
7533 | "RTN","IBC OMD1",20,0 ) | |
7534 | ; | |
7535 | "RTN","IBC OMD1",21,0 ) | |
7536 | ; IBAIB - Required . Includ e Active I nsurance | |
7537 | "RTN","IBC OMD1",22,0 ) | |
7538 | ; 1= Activ e Ins. 2 = Inactive Ins. 3= B oth | |
7539 | "RTN","IBC OMD1",23,0 ) | |
7540 | ; IBOUT - Required . Output format | |
7541 | "RTN","IBC OMD1",24,0 ) | |
7542 | ; "R"= rep ort format " E"= Excel format | |
7543 | "RTN","IBC OMD1",25,0 ) | |
7544 | ; | |
7545 | "RTN","IBC OMD1",26,0 ) | |
7546 | N IBDA,IB DA0,IBDA11 ,IBDA13,IB I,IBPAGE,I BTMP,IBX,X ,Y,IBJ,IBN OT | |
7547 | "RTN","IBC OMD1",27,0 ) | |
7548 | ; | |
7549 | "RTN","IBC OMD1",28,0 ) | |
7550 | I "^R^E^" '[(U_$G(IB OUT)_U) S IBOUT="R" | |
7551 | "RTN","IBC OMD1",29,0 ) | |
7552 | K ^TMP("I BCOMD",$J) S IBPAGE= 0 | |
7553 | "RTN","IBC OMD1",30,0 ) | |
7554 | ; | |
7555 | "RTN","IBC OMD1",31,0 ) | |
7556 | ; - must look at al l entries in file #3 6 | |
7557 | "RTN","IBC OMD1",32,0 ) | |
7558 | S IBDA=0 F S IBDA= $O(^DIC(36 ,IBDA)) Q: 'IBDA S I BDA0=$G(^( IBDA,0)) D | |
7559 | "RTN","IBC OMD1",33,0 ) | |
7560 | .; | |
7561 | "RTN","IBC OMD1",34,0 ) | |
7562 | .; - scre en out act ive/inacti ve compani es | |
7563 | "RTN","IBC OMD1",35,0 ) | |
7564 | .I IBAIB= 1,$P(IBDA0 ,U,5) Q | |
7565 | "RTN","IBC OMD1",36,0 ) | |
7566 | .I IBAIB= 2,'$P(IBDA 0,U,5) Q | |
7567 | "RTN","IBC OMD1",37,0 ) | |
7568 | .; | |
7569 | "RTN","IBC OMD1",38,0 ) | |
7570 | .S IBDA11 =$G(^DIC(3 6,IBDA,.11 )),IBDA13= $G(^(.13)) | |
7571 | "RTN","IBC OMD1",39,0 ) | |
7572 | .; | |
7573 | "RTN","IBC OMD1",40,0 ) | |
7574 | .; - scre en out ent ries based on user-s elected fi eld screen s | |
7575 | "RTN","IBC OMD1",41,0 ) | |
7576 | .S (IBJ,I BNOT)=0 F S IBJ=$O( IBCASE(IBJ )) Q:'IBJ D Q:IBNO T | |
7577 | "RTN","IBC OMD1",42,0 ) | |
7578 | ..N IBD,V AL S IBD=I BCASE(IBJ) | |
7579 | "RTN","IBC OMD1",43,0 ) | |
7580 | ..; | |
7581 | "RTN","IBC OMD1",44,0 ) | |
7582 | ..; - che ck state f irst | |
7583 | "RTN","IBC OMD1",45,0 ) | |
7584 | ..I IBJ=4 S:$P(IBDA 11,"^",5)' =$P(IBD,"^ ",2) IBNOT =1 Q | |
7585 | "RTN","IBC OMD1",46,0 ) | |
7586 | ..; | |
7587 | "RTN","IBC OMD1",47,0 ) | |
7588 | ..; - fin d the fiel d value to be evalua ted | |
7589 | "RTN","IBC OMD1",48,0 ) | |
7590 | ..S VAL=$ S(IBJ=1:$P (IBDA0,"^" ),1:$P(IBD A11,"^",$S (IBJ=2:1,1 :4))) | |
7591 | "RTN","IBC OMD1",49,0 ) | |
7592 | ..; | |
7593 | "RTN","IBC OMD1",50,0 ) | |
7594 | ..; - che ck 'contai ns' values | |
7595 | "RTN","IBC OMD1",51,0 ) | |
7596 | ..I $P(IB D,"^")="C" S:VAL'[$P (IBD,"^",2 ) IBNOT=1 Q | |
7597 | "RTN","IBC OMD1",52,0 ) | |
7598 | ..; | |
7599 | "RTN","IBC OMD1",53,0 ) | |
7600 | ..; - che ck 'range' values | |
7601 | "RTN","IBC OMD1",54,0 ) | |
7602 | ..I VAL=" " S IBNOT= 1 Q ; VAL must have a value i n a range | |
7603 | "RTN","IBC OMD1",55,0 ) | |
7604 | ..I $P(IB D,"^",2)]V AL S IBNOT =1 Q ; VA L doesn't follow Sta rt value | |
7605 | "RTN","IBC OMD1",56,0 ) | |
7606 | ..I VAL]$ P(IBD,"^", 3) S IBNOT =1 ; VA L follows the Go To value | |
7607 | "RTN","IBC OMD1",57,0 ) | |
7608 | .; | |
7609 | "RTN","IBC OMD1",58,0 ) | |
7610 | .Q:IBNOT ; entry d oes not me et criteri a | |
7611 | "RTN","IBC OMD1",59,0 ) | |
7612 | .; | |
7613 | "RTN","IBC OMD1",60,0 ) | |
7614 | .; | |
7615 | "RTN","IBC OMD1",61,0 ) | |
7616 | .; - set entry in g lobal | |
7617 | "RTN","IBC OMD1",62,0 ) | |
7618 | .S IBTMP= $P(IBDA0,U ,1)_U | |
7619 | "RTN","IBC OMD1",63,0 ) | |
7620 | .S IBX=$P (IBDA0,U,2 ) S $P(IBT MP,U,2)=$S (IBX]"":$E ($$EXPAND^ IBTRE(36,1 ,IBX),1,20 ),1:"")_U | |
7621 | "RTN","IBC OMD1",64,0 ) | |
7622 | .F IBX=1: 1:6 S IBTM P=IBTMP_$P (IBDA11,U, IBX)_U | |
7623 | "RTN","IBC OMD1",65,0 ) | |
7624 | .S IBX=$P (IBTMP,U,7 ) S $P(IBT MP,U,7)=$S (IBX]"":$$ STATE^IBCF 2(IBX),1:" ")_U | |
7625 | "RTN","IBC OMD1",66,0 ) | |
7626 | .S $P(IBT MP,U,9)=$P (IBDA13,U, 1) | |
7627 | "RTN","IBC OMD1",67,0 ) | |
7628 | .S ^TMP(" IBCOMD",$J ,+$P(IBDA0 ,U,5),$S($ P(IBDA0,U, 1)]"":$P(I BDA0,U,1), 1:"ZZZZ"), +IBDA)=IBT MP | |
7629 | "RTN","IBC OMD1",68,0 ) | |
7630 | ; | |
7631 | "RTN","IBC OMD1",69,0 ) | |
7632 | I '$D(^TM P("IBCOMD" ,$J)) D HD W !!,"** NO RECORDS FOUND **" D ASK G Q UEQ | |
7633 | "RTN","IBC OMD1",70,0 ) | |
7634 | D HD:IBOU T="E",WRT | |
7635 | "RTN","IBC OMD1",71,0 ) | |
7636 | ; | |
7637 | "RTN","IBC OMD1",72,0 ) | |
7638 | ; Exit cl ean-UP | |
7639 | "RTN","IBC OMD1",73,0 ) | |
7640 | QUEQ K IBA IB,IBCASE, IBFLD,IBOU T,IBQUIT,^ TMP("IBCOM D",$J) | |
7641 | "RTN","IBC OMD1",74,0 ) | |
7642 | I $D(ZTQU EUED) S ZT REQ="@" Q | |
7643 | "RTN","IBC OMD1",75,0 ) | |
7644 | W ! D ^%Z ISC | |
7645 | "RTN","IBC OMD1",76,0 ) | |
7646 | Q | |
7647 | "RTN","IBC OMD1",77,0 ) | |
7648 | ; | |
7649 | "RTN","IBC OMD1",78,0 ) | |
7650 | ; | |
7651 | "RTN","IBC OMD1",79,0 ) | |
7652 | HD ; Write Heading | |
7653 | "RTN","IBC OMD1",80,0 ) | |
7654 | S IBPAGE= IBPAGE+1 | |
7655 | "RTN","IBC OMD1",81,0 ) | |
7656 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
7657 | "RTN","IBC OMD1",82,0 ) | |
7658 | I IBOUT=" E" D Q | |
7659 | "RTN","IBC OMD1",83,0 ) | |
7660 | .W !,"Gen erate Insu rance Comp any Listin gs^"_$$FMT E^XLFDT($$ NOW^XLFDT, 1) | |
7661 | "RTN","IBC OMD1",84,0 ) | |
7662 | .W !,"Lis t of ",$S( IBAIB=1:"A ctive",IBA IB=2:"Inac tive",1:"A ll")," Ins urance Com panies" | |
7663 | "RTN","IBC OMD1",85,0 ) | |
7664 | .; | |
7665 | "RTN","IBC OMD1",86,0 ) | |
7666 | .; - disp lay defini tion of sc reens | |
7667 | "RTN","IBC OMD1",87,0 ) | |
7668 | .I $D(IBC ASE) W "^w here" D | |
7669 | "RTN","IBC OMD1",88,0 ) | |
7670 | ..N I,H | |
7671 | "RTN","IBC OMD1",89,0 ) | |
7672 | ..S (H,I) =0 F S I= $O(IBCASE( I)) Q:'I D | |
7673 | "RTN","IBC OMD1",90,0 ) | |
7674 | ...I H W "^and" | |
7675 | "RTN","IBC OMD1",91,0 ) | |
7676 | ...S H=1 W "^"_IBFL D(I) | |
7677 | "RTN","IBC OMD1",92,0 ) | |
7678 | ...W $S(I =4:"^Equal s ",$P(IBC ASE(I),"^" )="C":"^Co ntains ",1 :"^Between ") | |
7679 | "RTN","IBC OMD1",93,0 ) | |
7680 | ...W $S(I =4:$P($G(^ DIC(5,+$P( IBCASE(I), "^",2),0)) ,"^"),$P(I BCASE(I)," ^",2)="":" ^'FIRST'", 1:$P(IBCAS E(I),"^",2 )) | |
7681 | "RTN","IBC OMD1",94,0 ) | |
7682 | ...I $P(I BCASE(I)," ^")="R" W "^and ",$S ($P(IBCASE (I),"^",3) ="zzzzzz": "^'LAST'", 1:$P(IBCAS E(I),"^",3 )) ; **IB* 2.0*602 | |
7683 | "RTN","IBC OMD1",95,0 ) | |
7684 | .; | |
7685 | "RTN","IBC OMD1",96,0 ) | |
7686 | .W !,"Act ive/Inacti ve^Insuran ce Name^Re imburse?^S treet Addr ess 1^Stre et Address 2^Street Address 3^ City^State ^ZIP^Phone Number" | |
7687 | "RTN","IBC OMD1",97,0 ) | |
7688 | ; IB*602/ HN end | |
7689 | "RTN","IBC OMD1",98,0 ) | |
7690 | ; | |
7691 | "RTN","IBC OMD1",99,0 ) | |
7692 | I IBOUT=" E" W:($E(I OST,1,2)[" C-") ! W " Active/Ina ctive^Insu rance Name ^Reimburse ?^Street A ddress 1^S treet Addr ess 2^Stre et Address 3^City^St ate^ZIP^Ph one Number " Q | |
7693 | "RTN","IBC OMD1",100, 0) | |
7694 | W @IOF,"G enerate In surance Co mpany List ings",?50, $$FMTE^XLF DT($$NOW^X LFDT,"Z"), ?70," Page ",IBPAGE | |
7695 | "RTN","IBC OMD1",101, 0) | |
7696 | W !,"List of ",$S(I BAIB=1:"Ac tive",IBAI B=2:"Inact ive",1:"Al l")," Insu rance Comp anies" | |
7697 | "RTN","IBC OMD1",102, 0) | |
7698 | ; | |
7699 | "RTN","IBC OMD1",103, 0) | |
7700 | ; - displ ay definit ion of scr eens | |
7701 | "RTN","IBC OMD1",104, 0) | |
7702 | I $D(IBCA SE) W ", w here" D | |
7703 | "RTN","IBC OMD1",105, 0) | |
7704 | .N I,H | |
7705 | "RTN","IBC OMD1",106, 0) | |
7706 | .S (H,I)= 0 F S I=$ O(IBCASE(I )) Q:'I D | |
7707 | "RTN","IBC OMD1",107, 0) | |
7708 | ..W ! I H W ?3,"and " | |
7709 | "RTN","IBC OMD1",108, 0) | |
7710 | ..S H=1 W ?8,IBFLD( I)," " | |
7711 | "RTN","IBC OMD1",109, 0) | |
7712 | ..W $S(I= 4:"Equals ",$P(IBCAS E(I),"^")= "C":"Conta ins ",1:"B etween ") | |
7713 | "RTN","IBC OMD1",110, 0) | |
7714 | ..W $S(I= 4:$P($G(^D IC(5,+$P(I BCASE(I)," ^",2),0)), "^"),$P(IB CASE(I),"^ ",2)="":"' FIRST'",1: $P(IBCASE( I),"^",2)) | |
7715 | "RTN","IBC OMD1",111, 0) | |
7716 | ..I $P(IB CASE(I),"^ ")="R" W " and ",$S( $P(IBCASE( I),"^",3)= "zzzzzz":" 'LAST'",1: $P(IBCASE( I),"^",3)) | |
7717 | "RTN","IBC OMD1",112, 0) | |
7718 | ; | |
7719 | "RTN","IBC OMD1",113, 0) | |
7720 | W !,"Insu rance Name /Address", ?33,"Reimb urse?",?56 ,"Phone Nu mber" | |
7721 | "RTN","IBC OMD1",114, 0) | |
7722 | W ! F IBX =1:1:79 W "=" | |
7723 | "RTN","IBC OMD1",115, 0) | |
7724 | Q | |
7725 | "RTN","IBC OMD1",116, 0) | |
7726 | ; | |
7727 | "RTN","IBC OMD1",117, 0) | |
7728 | WRT ; Writ e data lin es | |
7729 | "RTN","IBC OMD1",118, 0) | |
7730 | N IBA,IBN A,IBOFF,IB ACT,X,Y S IBQUIT=0 | |
7731 | "RTN","IBC OMD1",119, 0) | |
7732 | S IBA="" F S IBA=$ O(^TMP("IB COMD",$J,I BA)) Q:(IB A="")!(IBQ UIT=1) D | |
7733 | "RTN","IBC OMD1",120, 0) | |
7734 | .I IBPAGE ,(IBOUT="R ") D ASK I IBQUIT=1 Q | |
7735 | "RTN","IBC OMD1",121, 0) | |
7736 | .; Excel Output | |
7737 | "RTN","IBC OMD1",122, 0) | |
7738 | .I IBOUT= "E" S IBAC T=$S(IBA=1 :"Inactive ",1:"Activ e") | |
7739 | "RTN","IBC OMD1",123, 0) | |
7740 | .; Report Output | |
7741 | "RTN","IBC OMD1",124, 0) | |
7742 | .I IBOUT= "R" D HD W !,$S(IBA= 1:"Inactiv e Companie s",1:"Acti ve Compani es"),! | |
7743 | "RTN","IBC OMD1",125, 0) | |
7744 | .S IBNA=" " F S IBN A=$O(^TMP( "IBCOMD",$ J,IBA,IBNA )) Q:(IBNA ="")!(IBQU IT=1) D | |
7745 | "RTN","IBC OMD1",126, 0) | |
7746 | ..S IBDA= "" F S IB DA=$O(^TMP ("IBCOMD", $J,IBA,IBN A,IBDA)) Q :('IBDA)!( IBQUIT=1) D | |
7747 | "RTN","IBC OMD1",127, 0) | |
7748 | ...S IBTM P=^TMP("IB COMD",$J,I BA,IBNA,IB DA) | |
7749 | "RTN","IBC OMD1",128, 0) | |
7750 | ...S IBOF F=$S($P(IB TMP,U,4)]" "!($P(IBTM P,U,5)]"") :7,1:6) | |
7751 | "RTN","IBC OMD1",129, 0) | |
7752 | ...I ($Y+ IBOFF)>IOS L,(IBOUT=" R") D I I BQUIT=1 Q | |
7753 | "RTN","IBC OMD1",130, 0) | |
7754 | ....D ASK I IBQUIT= 1 Q | |
7755 | "RTN","IBC OMD1",131, 0) | |
7756 | ....D HD | |
7757 | "RTN","IBC OMD1",132, 0) | |
7758 | ...S IBTM P=^TMP("IB COMD",$J,I BA,IBNA,IB DA) | |
7759 | "RTN","IBC OMD1",133, 0) | |
7760 | ...; Exce l Output | |
7761 | "RTN","IBC OMD1",134, 0) | |
7762 | ...I IBOU T="E" W !, IBACT_U_IB TMP Q | |
7763 | "RTN","IBC OMD1",135, 0) | |
7764 | ...; Repo rt Output | |
7765 | "RTN","IBC OMD1",136, 0) | |
7766 | ...W !!,$ P(IBTMP,U, 1),?33,$P( IBTMP,U,2) ,?56,$P(IB TMP,U,9) | |
7767 | "RTN","IBC OMD1",137, 0) | |
7768 | ...I $P(I BTMP,U,3)] "" W !,$P( IBTMP,U,3) | |
7769 | "RTN","IBC OMD1",138, 0) | |
7770 | ...I $P(I BTMP,U,4)] ""!($P(IBT MP,U,5)]"" ) W !,$P(I BTMP,U,4) W:$P(IBTMP ,U,4)]""&( $P(IBTMP,U ,5)]"") ", " W $P(IB TMP,U,5) | |
7771 | "RTN","IBC OMD1",139, 0) | |
7772 | ...W !,$P (IBTMP,U,6 ) W:$P(IBT MP,U,6)]"" &($P(IBTMP ,U,7)]"") ", " W $P( IBTMP,U,7) ," ",$P(I BTMP,U,8) | |
7773 | "RTN","IBC OMD1",140, 0) | |
7774 | I 'IBQUIT D ASK | |
7775 | "RTN","IBC OMD1",141, 0) | |
7776 | Q | |
7777 | "RTN","IBC OMD1",142, 0) | |
7778 | ; | |
7779 | "RTN","IBC OMD1",143, 0) | |
7780 | ASK ; Ask to Continu e with dis play | |
7781 | "RTN","IBC OMD1",144, 0) | |
7782 | ; Returns IBQUIT=1 if user Ti med out or entered ^ | |
7783 | "RTN","IBC OMD1",145, 0) | |
7784 | I $E(IOST ,1,2)'["C- " Q | |
7785 | "RTN","IBC OMD1",146, 0) | |
7786 | N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,IBI,X,Y | |
7787 | "RTN","IBC OMD1",147, 0) | |
7788 | S DIR(0)= "E" D ^DIR | |
7789 | "RTN","IBC OMD1",148, 0) | |
7790 | I ($D(DIR UT))!($D(D UOUT)) S I BQUIT=1 | |
7791 | "RTN","IBC OMD1",149, 0) | |
7792 | Q | |
7793 | "RTN","IBC OMN1") | |
7794 | 0^10^B1827 1189^B1429 8599 | |
7795 | "RTN","IBC OMN1",1,0) | |
7796 | IBCOMN1 ;A LB/CMS - P ATIENTS NO COVERAGE VERIFIED R EPORT (CON 'T);10-09- 98 | |
7797 | "RTN","IBC OMN1",2,0) | |
7798 | ;;2.0;INT EGRATED BI LLING;**10 3,528,602* *;21-MAR-9 4;Build 22 | |
7799 | "RTN","IBC OMN1",3,0) | |
7800 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7801 | "RTN","IBC OMN1",4,0) | |
7802 | Q | |
7803 | "RTN","IBC OMN1",5,0) | |
7804 | ; | |
7805 | "RTN","IBC OMN1",6,0) | |
7806 | BEG ; Entr y to run P atients w/ no Coverag e Verifica tion Repor t | |
7807 | "RTN","IBC OMN1",7,0) | |
7808 | ; Input v ariables: | |
7809 | "RTN","IBC OMN1",8,0) | |
7810 | ; IBAIB - Required. How to sort | |
7811 | "RTN","IBC OMN1",9,0) | |
7812 | ; 1= Patien t Name Ran ge 2= Terminal Digit Rang e | |
7813 | "RTN","IBC OMN1",10,0 ) | |
7814 | ; | |
7815 | "RTN","IBC OMN1",11,0 ) | |
7816 | ; IBRF - Required. Name or Terminal D igit Range Start val ue | |
7817 | "RTN","IBC OMN1",12,0 ) | |
7818 | ; IBRL - Required. Name or Terminal D igit Range Go to val ue | |
7819 | "RTN","IBC OMN1",13,0 ) | |
7820 | ; IBBDT - Required. Begining Verificat ion Date R ange | |
7821 | "RTN","IBC OMN1",14,0 ) | |
7822 | ; IBEDT - Required. Ending V erificatio n Date Ran ge | |
7823 | "RTN","IBC OMN1",15,0 ) | |
7824 | ; IBOUT - Required. Output f ormat | |
7825 | "RTN","IBC OMN1",16,0 ) | |
7826 | ; "R"= repo rt format "E" = Excel fo rmat | |
7827 | "RTN","IBC OMN1",17,0 ) | |
7828 | ; | |
7829 | "RTN","IBC OMN1",18,0 ) | |
7830 | N DFN,IBD T,IBGP,IBI ,IBQUIT,IB PAGE,IBTMP ,IBTD,IBX, VA,VADM,VA ERR,X,Y | |
7831 | "RTN","IBC OMN1",19,0 ) | |
7832 | ; | |
7833 | "RTN","IBC OMN1",20,0 ) | |
7834 | I "^R^E^" '[(U_$G(IB OUT)_U) S IBOUT="R" | |
7835 | "RTN","IBC OMN1",21,0 ) | |
7836 | K ^TMP("I BCOMN",$J) S IBPAGE= 0,IBQUIT=0 | |
7837 | "RTN","IBC OMN1",22,0 ) | |
7838 | S IBDT=IB BDT F S I BDT=$O(^IB A(354,"AVD T",IBDT)) Q:('IBDT)! (IBDT>IBED T) D | |
7839 | "RTN","IBC OMN1",23,0 ) | |
7840 | .S DFN=0 F S DFN=$ O(^IBA(354 ,"AVDT",IB DT,DFN)) Q :'DFN D | |
7841 | "RTN","IBC OMN1",24,0 ) | |
7842 | ..K VA,VA DM,VAERR,V APA | |
7843 | "RTN","IBC OMN1",25,0 ) | |
7844 | ..D DEM^V ADPT,ADD^V ADPT | |
7845 | "RTN","IBC OMN1",26,0 ) | |
7846 | ..; | |
7847 | "RTN","IBC OMN1",27,0 ) | |
7848 | ..; I Pt . name out of range quit | |
7849 | "RTN","IBC OMN1",28,0 ) | |
7850 | ..S VADM( 1)=$P($G(V ADM(1)),U, 1) I VADM( 1)="" Q | |
7851 | "RTN","IBC OMN1",29,0 ) | |
7852 | ..I IBAIB =1,VADM(1) ]IBRL Q | |
7853 | "RTN","IBC OMN1",30,0 ) | |
7854 | ..I IBAIB =1,IBRF]VA DM(1) Q | |
7855 | "RTN","IBC OMN1",31,0 ) | |
7856 | ..; | |
7857 | "RTN","IBC OMN1",32,0 ) | |
7858 | ..; I Te rminal Dig it out of range quit | |
7859 | "RTN","IBC OMN1",33,0 ) | |
7860 | ..I IBAIB =2 S IBTD= $$TERMDG^I BCONS2(DFN ) I (+IBTD >IBRL)!(IB RF>+IBTD) Q | |
7861 | "RTN","IBC OMN1",34,0 ) | |
7862 | ..; | |
7863 | "RTN","IBC OMN1",35,0 ) | |
7864 | ..; Fix s ubscript e rror if te rminal dig it is null | |
7865 | "RTN","IBC OMN1",36,0 ) | |
7866 | ..I IBAIB =2,IBTD="" S IBTD=" " | |
7867 | "RTN","IBC OMN1",37,0 ) | |
7868 | ..; | |
7869 | "RTN","IBC OMN1",38,0 ) | |
7870 | ..; set data line , set glob al * if de ceased | |
7871 | "RTN","IBC OMN1",39,0 ) | |
7872 | ..;S IBTM P=PT NAME^ SSN^AGE^DO B^HOME PHO NE^VERIFIC ATION NO C OV | |
7873 | "RTN","IBC OMN1",40,0 ) | |
7874 | ..S IBTMP =$S($G(VAD M(6)):"*", 1:"")_VADM (1)_U_$P($ P(VADM(2), U,2),"-",3 )_U_+VADM( 4)_U_$$FMT E^XLFDT(VA DM(3),"5ZD ")_U_$P(VA PA(8),U,1) _U_$$FMTE^ XLFDT(IBDT ,"5ZD") | |
7875 | "RTN","IBC OMN1",41,0 ) | |
7876 | ..S ^TMP( "IBCOMN",$ J,$S(IBAIB =2:IBTD,1: VADM(1)),D FN)=IBTMP | |
7877 | "RTN","IBC OMN1",42,0 ) | |
7878 | ..; | |
7879 | "RTN","IBC OMN1",43,0 ) | |
7880 | ; | |
7881 | "RTN","IBC OMN1",44,0 ) | |
7882 | I '$D(^TM P("IBCOMN" ,$J)) D HD W !!,"** NO RECORDS FOUND **" D ASK G Q UEQ | |
7883 | "RTN","IBC OMN1",45,0 ) | |
7884 | D HD,WRT | |
7885 | "RTN","IBC OMN1",46,0 ) | |
7886 | ; | |
7887 | "RTN","IBC OMN1",47,0 ) | |
7888 | QUEQ ; Exi t clean-UP | |
7889 | "RTN","IBC OMN1",48,0 ) | |
7890 | W ! D ^%Z ISC K IBTM P,IBAIB,IB OUT,IBRF,I BRL,VA,VAE RR,VADM,VA PA,^TMP("I BCOMN",$J) | |
7891 | "RTN","IBC OMN1",49,0 ) | |
7892 | Q | |
7893 | "RTN","IBC OMN1",50,0 ) | |
7894 | ; | |
7895 | "RTN","IBC OMN1",51,0 ) | |
7896 | HD ;Write Heading | |
7897 | "RTN","IBC OMN1",52,0 ) | |
7898 | S IBPAGE= IBPAGE+1 | |
7899 | "RTN","IBC OMN1",53,0 ) | |
7900 | ; IB*602/ HN ; Add r eport head ers to Exc el Spreads heets | |
7901 | "RTN","IBC OMN1",54,0 ) | |
7902 | I IBOUT=" E" D W:($ E(IOST,1,2 )["C-") ! W "Patient Name^SSN^ Age^DOB^Ph one^Verifi ed" Q | |
7903 | "RTN","IBC OMN1",55,0 ) | |
7904 | .W !,"Pat ients w/No Coverage Verificati on Date Re port^"_$$F MTE^XLFDT( $$NOW^XLFD T,"Z") | |
7905 | "RTN","IBC OMN1",56,0 ) | |
7906 | .W !,"Ver ification Date Range : "_$$FMTE ^XLFDT(IBB DT,"Z")_" to "_$$FMT E^XLFDT(IB EDT,"Z") | |
7907 | "RTN","IBC OMN1",57,0 ) | |
7908 | .W !," So rted by: " _$S(IBAIB= 1:"Patient Name",1:" Terminal D igit")_" R ange: "_$S (IBRF="A": "FIRST",1: IBRF)_" to "_$S(IBRL ="zzzzzz": "LAST",1:I BRL) | |
7909 | "RTN","IBC OMN1",58,0 ) | |
7910 | .W !,"(* - Patient Deceased)" | |
7911 | "RTN","IBC OMN1",59,0 ) | |
7912 | ; IB*602/ HN end | |
7913 | "RTN","IBC OMN1",60,0 ) | |
7914 | I IBOUT=" E" W:($E(I OST,1,2)[" C-") ! W " Patient Na me^SSN^Age ^DOB^Phone ^Verified" Q | |
7915 | "RTN","IBC OMN1",61,0 ) | |
7916 | W @IOF,!, "Patients w/No Cover age Verifi cation Dat e Report", ?50,$$FMTE ^XLFDT($$N OW^XLFDT," Z"),?70," Page ",IBP AGE | |
7917 | "RTN","IBC OMN1",62,0 ) | |
7918 | W !,?5,"V erificatio n Date Ran ge: "_$$FM TE^XLFDT(I BBDT,"Z")_ " to "_$$F MTE^XLFDT( IBEDT,"Z") | |
7919 | "RTN","IBC OMN1",63,0 ) | |
7920 | W !,?5," Sorted by : "_$S(IBA IB=1:"Pati ent Name", 1:"Termina l Digit")_ " Range: "_$S(IBRF= "A":"FIRST ",1:IBRF)_ " to "_$S( IBRL="zzzz zz":"LAST" ,1:IBRL) | |
7921 | "RTN","IBC OMN1",64,0 ) | |
7922 | W !,?20," (* - Pati ent Deceas ed)" | |
7923 | "RTN","IBC OMN1",65,0 ) | |
7924 | W !,"Pati ent Name", ?31,"SSN", ?38,"Age", ?43,"DOB", ?55,"Phone ",?70,"Ver ified" | |
7925 | "RTN","IBC OMN1",66,0 ) | |
7926 | W ! F IBX =1:1:79 W "=" | |
7927 | "RTN","IBC OMN1",67,0 ) | |
7928 | Q | |
7929 | "RTN","IBC OMN1",68,0 ) | |
7930 | ; | |
7931 | "RTN","IBC OMN1",69,0 ) | |
7932 | WRT ;Write data line s | |
7933 | "RTN","IBC OMN1",70,0 ) | |
7934 | N IBA,IBD FN,IBPT,X, Y S IBQUIT =0 | |
7935 | "RTN","IBC OMN1",71,0 ) | |
7936 | S IBA="" F S IBA=$ O(^TMP("IB COMN",$J,I BA)) Q:(IB A="")!(IBQ UIT=1) D | |
7937 | "RTN","IBC OMN1",72,0 ) | |
7938 | .S IBDFN= 0 F S IBD FN=$O(^TMP ("IBCOMN", $J,IBA,IBD FN)) Q:('I BDFN)!(IBQ UIT=1) D | |
7939 | "RTN","IBC OMN1",73,0 ) | |
7940 | ..S IBPT= $G(^TMP("I BCOMN",$J, IBA,IBDFN) ) | |
7941 | "RTN","IBC OMN1",74,0 ) | |
7942 | ..; | |
7943 | "RTN","IBC OMN1",75,0 ) | |
7944 | ..I ($Y+5 )>IOSL,(IB OUT="R") D I IBQUIT =1 Q | |
7945 | "RTN","IBC OMN1",76,0 ) | |
7946 | ...D ASK I IBQUIT=1 Q | |
7947 | "RTN","IBC OMN1",77,0 ) | |
7948 | ...D HD | |
7949 | "RTN","IBC OMN1",78,0 ) | |
7950 | ..; | |
7951 | "RTN","IBC OMN1",79,0 ) | |
7952 | ..; Excel Output | |
7953 | "RTN","IBC OMN1",80,0 ) | |
7954 | ..I IBOUT ="E" W !,$ P(IBPT,U,1 )_U_$E($P( IBPT,U,1), 1,1)_$P(IB PT,U,2)_U_ $P(IBPT,U, 3,6) Q | |
7955 | "RTN","IBC OMN1",81,0 ) | |
7956 | ..; Repor t Output | |
7957 | "RTN","IBC OMN1",82,0 ) | |
7958 | ..W !,$E( $P(IBPT,U, 1),1,30),? 31,$E($P(I BPT,U,1),1 ,1),$P(IBP T,U,2),?38 ,$J($P(IBP T,U,3),3), ?43,$P(IBP T,U,4),?55 ,$E($P(IBP T,U,5),1,1 5),?70,$P( IBPT,U,6) | |
7959 | "RTN","IBC OMN1",83,0 ) | |
7960 | ..; | |
7961 | "RTN","IBC OMN1",84,0 ) | |
7962 | I 'IBQUIT D ASK | |
7963 | "RTN","IBC OMN1",85,0 ) | |
7964 | Q | |
7965 | "RTN","IBC OMN1",86,0 ) | |
7966 | ; | |
7967 | "RTN","IBC OMN1",87,0 ) | |
7968 | ASK ; Ask to Continu e with dis play | |
7969 | "RTN","IBC OMN1",88,0 ) | |
7970 | I $E(IOST ,1,2)'["C- " Q | |
7971 | "RTN","IBC OMN1",89,0 ) | |
7972 | N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y | |
7973 | "RTN","IBC OMN1",90,0 ) | |
7974 | S DIR(0)= "E" D ^DIR | |
7975 | "RTN","IBC OMN1",91,0 ) | |
7976 | I ($D(DIR UT))!($D(D UOUT)) S I BQUIT=1 | |
7977 | "RTN","IBC OMN1",92,0 ) | |
7978 | Q | |
7979 | "RTN","IBY 602PO") | |
7980 | 0^17^B4368 7115^n/a | |
7981 | "RTN","IBY 602PO",1,0 ) | |
7982 | IBY602PO ; EDE/DM - P ost-Instal lation for IB*2.8*60 2 ; 23-MAR -2018 | |
7983 | "RTN","IBY 602PO",2,0 ) | |
7984 | ;;2.0;INT EGRATED BI LLING;**60 2**;09-AUG -2018;Buil d 22 | |
7985 | "RTN","IBY 602PO",3,0 ) | |
7986 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
7987 | "RTN","IBY 602PO",4,0 ) | |
7988 | ; | |
7989 | "RTN","IBY 602PO",5,0 ) | |
7990 | POST ; POS T ROUTINE( S) | |
7991 | "RTN","IBY 602PO",6,0 ) | |
7992 | N IBXPD,X PDIDTOT | |
7993 | "RTN","IBY 602PO",7,0 ) | |
7994 | S XPDIDTO T=1 | |
7995 | "RTN","IBY 602PO",8,0 ) | |
7996 | ; | |
7997 | "RTN","IBY 602PO",9,0 ) | |
7998 | ; Task FI XTQ | |
7999 | "RTN","IBY 602PO",10, 0) | |
8000 | D TSKFIXT Q(1) | |
8001 | "RTN","IBY 602PO",11, 0) | |
8002 | ; | |
8003 | "RTN","IBY 602PO",12, 0) | |
8004 | ; Done... | |
8005 | "RTN","IBY 602PO",13, 0) | |
8006 | D MES^XPD UTL("") | |
8007 | "RTN","IBY 602PO",14, 0) | |
8008 | D MES^XPD UTL("POST- Install Co mpleted.") | |
8009 | "RTN","IBY 602PO",15, 0) | |
8010 | Q | |
8011 | "RTN","IBY 602PO",16, 0) | |
8012 | ; | |
8013 | "RTN","IBY 602PO",17, 0) | |
8014 | TSKFIXTQ(I BXPD) ; ta sk the FIX TQ routine | |
8015 | "RTN","IBY 602PO",18, 0) | |
8016 | D BMES^XP DUTL(" STE P "_IBXPD_ " of "_XPD IDTOT) | |
8017 | "RTN","IBY 602PO",19, 0) | |
8018 | D MES^XPD UTL("----- --------") | |
8019 | "RTN","IBY 602PO",20, 0) | |
8020 | D MES^XPD UTL("Taski ng Examine /Clean IIV Response & IIV Tran smission Q ueue ... " ) | |
8021 | "RTN","IBY 602PO",21, 0) | |
8022 | N MSG,ZTD ESC,ZTRTN, ZTQUEUED | |
8023 | "RTN","IBY 602PO",22, 0) | |
8024 | S ZTQUEUE D=1 | |
8025 | "RTN","IBY 602PO",23, 0) | |
8026 | S ZTDESC= "IBCN EXAM INE #365 & #365.1 FI LES" | |
8027 | "RTN","IBY 602PO",24, 0) | |
8028 | S ZTRTN=" FIXTQ^IBY6 02PO" | |
8029 | "RTN","IBY 602PO",25, 0) | |
8030 | S MSG=$$T ASK("T@200 0",ZTDESC, ZTRTN) | |
8031 | "RTN","IBY 602PO",26, 0) | |
8032 | D MES^XPD UTL(MSG) | |
8033 | "RTN","IBY 602PO",27, 0) | |
8034 | Q | |
8035 | "RTN","IBY 602PO",28, 0) | |
8036 | ; | |
8037 | "RTN","IBY 602PO",29, 0) | |
8038 | TASK(X,ZTD ESC,ZTRTN) ;bypass f or queued task | |
8039 | "RTN","IBY 602PO",30, 0) | |
8040 | N Y,IDT,X DT,TSK,MSG ,ZTIO,ZTSK ,%DT | |
8041 | "RTN","IBY 602PO",31, 0) | |
8042 | S %DT="FR " | |
8043 | "RTN","IBY 602PO",32, 0) | |
8044 | D ^%DT | |
8045 | "RTN","IBY 602PO",33, 0) | |
8046 | S IDT=Y D DD^%DT S XDT=Y | |
8047 | "RTN","IBY 602PO",34, 0) | |
8048 | ; | |
8049 | "RTN","IBY 602PO",35, 0) | |
8050 | ;Check if task alre ady schedu led for da te/time | |
8051 | "RTN","IBY 602PO",36, 0) | |
8052 | S TSK=$$G ETTASK(IDT ) | |
8053 | "RTN","IBY 602PO",37, 0) | |
8054 | I TSK D Q MSG | |
8055 | "RTN","IBY 602PO",38, 0) | |
8056 | . S Y=$P( TSK,U,2) D DD^%DT | |
8057 | "RTN","IBY 602PO",39, 0) | |
8058 | . S MSG=" Task (#"_ +TSK_") al ready sche duled to r un on "_Y | |
8059 | "RTN","IBY 602PO",40, 0) | |
8060 | ; | |
8061 | "RTN","IBY 602PO",41, 0) | |
8062 | ;Schedule the task | |
8063 | "RTN","IBY 602PO",42, 0) | |
8064 | S TSK=$$S CHED(IDT) | |
8065 | "RTN","IBY 602PO",43, 0) | |
8066 | ; | |
8067 | "RTN","IBY 602PO",44, 0) | |
8068 | ;Check fo r scheduli ng problem | |
8069 | "RTN","IBY 602PO",45, 0) | |
8070 | I '$G(TSK ) S MSG=" Task Could Not Be Sc heduled" Q MSG | |
8071 | "RTN","IBY 602PO",46, 0) | |
8072 | ; | |
8073 | "RTN","IBY 602PO",47, 0) | |
8074 | ;Send suc cessful sc hedule mes sage | |
8075 | "RTN","IBY 602PO",48, 0) | |
8076 | S MSG=" E xamine/Cle an IIV Tra nsmission Queue Sche duled for "_XDT | |
8077 | "RTN","IBY 602PO",49, 0) | |
8078 | Q MSG | |
8079 | "RTN","IBY 602PO",50, 0) | |
8080 | ; | |
8081 | "RTN","IBY 602PO",51, 0) | |
8082 | GETTASK(ID T) ; | |
8083 | "RTN","IBY 602PO",52, 0) | |
8084 | N TASK,TA SKNO,TDT,X USUCI,Y,ZT SK0 | |
8085 | "RTN","IBY 602PO",53, 0) | |
8086 | ; | |
8087 | "RTN","IBY 602PO",54, 0) | |
8088 | ;Retrieve UCI | |
8089 | "RTN","IBY 602PO",55, 0) | |
8090 | X ^%ZOSF( "UCI") S X USUCI=Y | |
8091 | "RTN","IBY 602PO",56, 0) | |
8092 | ; | |
8093 | "RTN","IBY 602PO",57, 0) | |
8094 | S (TASK,T DT)=0,TASK NO="" | |
8095 | "RTN","IBY 602PO",58, 0) | |
8096 | F S TASK =$O(^%ZTSK (TASK)) Q: 'TASK D Q:TASKNO | |
8097 | "RTN","IBY 602PO",59, 0) | |
8098 | .I $G(^%Z TSK(TASK,. 03))[ZTDES C D | |
8099 | "RTN","IBY 602PO",60, 0) | |
8100 | ..S ZTSK0 =$G(^%ZTSK (TASK,0)) | |
8101 | "RTN","IBY 602PO",61, 0) | |
8102 | ..; | |
8103 | "RTN","IBY 602PO",62, 0) | |
8104 | ..;Exclud e tasks sc heduled by TaskMan | |
8105 | "RTN","IBY 602PO",63, 0) | |
8106 | ..Q:ZTSK0 ["ZTSK^XQ1 " | |
8107 | "RTN","IBY 602PO",64, 0) | |
8108 | ..; | |
8109 | "RTN","IBY 602PO",65, 0) | |
8110 | ..;Exclud e tasks in other uci s | |
8111 | "RTN","IBY 602PO",66, 0) | |
8112 | ..Q:(($P( ZTSK0,U,11 )_","_$P(Z TSK0,U,12) )'=XUSUCI) | |
8113 | "RTN","IBY 602PO",67, 0) | |
8114 | ..; | |
8115 | "RTN","IBY 602PO",68, 0) | |
8116 | ..;Check for correc t date and time | |
8117 | "RTN","IBY 602PO",69, 0) | |
8118 | ..S TDT=$ $HTFM^XLFD T($P(ZTSK0 ,"^",6)) | |
8119 | "RTN","IBY 602PO",70, 0) | |
8120 | ..;I TDT= IDT S TASK NO=TASK | |
8121 | "RTN","IBY 602PO",71, 0) | |
8122 | Q TASKNO_ U_TDT | |
8123 | "RTN","IBY 602PO",72, 0) | |
8124 | ; | |
8125 | "RTN","IBY 602PO",73, 0) | |
8126 | SCHED(ZTDT H) ; | |
8127 | "RTN","IBY 602PO",74, 0) | |
8128 | N XUSUCI, ZTIO,ZTSK | |
8129 | "RTN","IBY 602PO",75, 0) | |
8130 | ;Retrieve UCI | |
8131 | "RTN","IBY 602PO",76, 0) | |
8132 | X ^%ZOSF( "UCI") S X USUCI=Y | |
8133 | "RTN","IBY 602PO",77, 0) | |
8134 | S ZTIO="" | |
8135 | "RTN","IBY 602PO",78, 0) | |
8136 | D ^%ZTLOA D | |
8137 | "RTN","IBY 602PO",79, 0) | |
8138 | Q ZTSK | |
8139 | "RTN","IBY 602PO",80, 0) | |
8140 | ; | |
8141 | "RTN","IBY 602PO",81, 0) | |
8142 | FIXTQ(IBXP D) ; clean /report ab normal IIV TRANSMISS ION QUEUE (#365.1) r ecords | |
8143 | "RTN","IBY 602PO",82, 0) | |
8144 | N DA,DIK, HLIEN,DNP, TQIEN,ENDD T,WKDT,WKZ Z | |
8145 | "RTN","IBY 602PO",83, 0) | |
8146 | N STATLIS T,STAGE,TC NT,ACNT,MC NT,DONE | |
8147 | "RTN","IBY 602PO",84, 0) | |
8148 | N BAD,TQS ,TQD,TQQ,M SG,IBXMY | |
8149 | "RTN","IBY 602PO",85, 0) | |
8150 | ; | |
8151 | "RTN","IBY 602PO",86, 0) | |
8152 | S STATLIS T=","_$$FI ND1^DIC(36 5.14,,"B", "Response Received") | |
8153 | "RTN","IBY 602PO",87, 0) | |
8154 | S STATLIS T=STATLIST _","_$$FIN D1^DIC(365 .14,,"B"," Communicat ion Failur e") | |
8155 | "RTN","IBY 602PO",88, 0) | |
8156 | S STATLIS T=STATLIST _","_$$FIN D1^DIC(365 .14,,"B"," Cancelled" )_"," | |
8157 | "RTN","IBY 602PO",89, 0) | |
8158 | S (TQIEN, TCNT,STAGE ,ACNT,MCNT ,DONE)=0 | |
8159 | "RTN","IBY 602PO",90, 0) | |
8160 | S MSG="" | |
8161 | "RTN","IBY 602PO",91, 0) | |
8162 | S ENDDT=$ $FMADD^XLF DT(DT,-182 ) ; about 6 months | |
8163 | "RTN","IBY 602PO",92, 0) | |
8164 | ; STAGE=0 , delete a bnormal < T-182 | |
8165 | "RTN","IBY 602PO",93, 0) | |
8166 | ; STAGE=1 , report a bnormal fr om T-182 t hrough T-3 2 | |
8167 | "RTN","IBY 602PO",94, 0) | |
8168 | ; | |
8169 | "RTN","IBY 602PO",95, 0) | |
8170 | D FIXRESP | |
8171 | "RTN","IBY 602PO",96, 0) | |
8172 | ; | |
8173 | "RTN","IBY 602PO",97, 0) | |
8174 | F S TQIE N=$O(^IBCN (365.1,TQI EN)) Q:'TQ IEN!DONE!$ G(ZTSTOP) D | |
8175 | "RTN","IBY 602PO",98, 0) | |
8176 | . S TCNT= TCNT+1 | |
8177 | "RTN","IBY 602PO",99, 0) | |
8178 | . I $D(ZT QUEUED),TC NT#100=0,$ $S^%ZTLOAD () S ZTSTO P=1 Q | |
8179 | "RTN","IBY 602PO",100 ,0) | |
8180 | . S TQD=$ $GET1^DIQ( 365.1,TQIE N_",",.06, "I") ; DAT E/TIME CRE ATED | |
8181 | "RTN","IBY 602PO",101 ,0) | |
8182 | . S WKDT= +$P(TQD,". ",1) | |
8183 | "RTN","IBY 602PO",102 ,0) | |
8184 | . I WKDT> ENDDT,STAG E S DONE=1 Q | |
8185 | "RTN","IBY 602PO",103 ,0) | |
8186 | . I WKDT> ENDDT S ST AGE=1,ENDD T=$$FMADD^ XLFDT(DT,- 32) | |
8187 | "RTN","IBY 602PO",104 ,0) | |
8188 | . I WKDT> ENDDT S DO NE=1 Q | |
8189 | "RTN","IBY 602PO",105 ,0) | |
8190 | . ; check for abnor mal | |
8191 | "RTN","IBY 602PO",106 ,0) | |
8192 | . S BAD=0 | |
8193 | "RTN","IBY 602PO",107 ,0) | |
8194 | . S TQS=$ $GET1^DIQ( 365.1,TQIE N_",",.04, "I") ; TRA NSMISSION STATUS | |
8195 | "RTN","IBY 602PO",108 ,0) | |
8196 | . S TQQ=$ $GET1^DIQ( 365.1,TQIE N_",",.11, "I") ; QUE RY FLAG | |
8197 | "RTN","IBY 602PO",109 ,0) | |
8198 | . ; If th e QUERY FL AG IS "I" and not an EICD Tran saction en try will p urge/repor t. | |
8199 | "RTN","IBY 602PO",110 ,0) | |
8200 | . S:TQQ=" I"&'$D(^IB CN(365.18, "B",TQIEN) ) BAD=1 | |
8201 | "RTN","IBY 602PO",111 ,0) | |
8202 | . ; If th e QUERY FL AG is null OR the DA TE/TIME CR EATED is n ull or | |
8203 | "RTN","IBY 602PO",112 ,0) | |
8204 | . ; TRANS MISSION ST ATUS not i n STATLIST entry wil l purge/re port | |
8205 | "RTN","IBY 602PO",113 ,0) | |
8206 | . S:(TQQ= "")!('TQD) !('$F(STAT LIST,","_T QS_",")) B AD=1 | |
8207 | "RTN","IBY 602PO",114 ,0) | |
8208 | . Q:'BAD | |
8209 | "RTN","IBY 602PO",115 ,0) | |
8210 | . I STAGE =0 D | |
8211 | "RTN","IBY 602PO",116 ,0) | |
8212 | .. ; loop through t he HL7 mes sages mult iple and k ill any re sponse | |
8213 | "RTN","IBY 602PO",117 ,0) | |
8214 | .. ; reco rds that a re found f or this tr ansmission queue ent ry. | |
8215 | "RTN","IBY 602PO",118 ,0) | |
8216 | .. ; Pres erve the T Q and any response t hat has DO NOT PURGE set to 1 (YES) | |
8217 | "RTN","IBY 602PO",119 ,0) | |
8218 | .. S DNP= 0,HLIEN=0, DIK="^IBCN (365," | |
8219 | "RTN","IBY 602PO",120 ,0) | |
8220 | .. F S H LIEN=$O(^I BCN(365.1, TQIEN,2,HL IEN)) Q:'H LIEN D | |
8221 | "RTN","IBY 602PO",121 ,0) | |
8222 | ... S DA= $P($G(^IBC N(365.1,TQ IEN,2,HLIE N,0)),U,3) Q:'DA | |
8223 | "RTN","IBY 602PO",122 ,0) | |
8224 | ... I +$$ GET1^DIQ(3 65,DA_",", .11,"I") S DNP=1 Q | |
8225 | "RTN","IBY 602PO",123 ,0) | |
8226 | ... D ^DI K | |
8227 | "RTN","IBY 602PO",124 ,0) | |
8228 | ... Q | |
8229 | "RTN","IBY 602PO",125 ,0) | |
8230 | .. ; now we can kil l the TQ e ntry itsel f | |
8231 | "RTN","IBY 602PO",126 ,0) | |
8232 | .. ; as l ong as the re was no DO NOT PUR GE respons es | |
8233 | "RTN","IBY 602PO",127 ,0) | |
8234 | .. I 'DNP S DA=TQIE N,DIK="^IB CN(365.1," D ^DIK | |
8235 | "RTN","IBY 602PO",128 ,0) | |
8236 | .. Q | |
8237 | "RTN","IBY 602PO",129 ,0) | |
8238 | . Q:'STAG E ; not r eporting a bnormal ye t | |
8239 | "RTN","IBY 602PO",130 ,0) | |
8240 | . S ACNT= ACNT+1 ; a bnormal co unt | |
8241 | "RTN","IBY 602PO",131 ,0) | |
8242 | . Q:MCNT> 9 ; msg c ount, only want 10 | |
8243 | "RTN","IBY 602PO",132 ,0) | |
8244 | . S MCNT= MCNT+1 | |
8245 | "RTN","IBY 602PO",133 ,0) | |
8246 | . ;exampl e of a det ail line o n the emai l | |
8247 | "RTN","IBY 602PO",134 ,0) | |
8248 | . ;FEB 22 , 2017@10: 44:08 T#:x xxxxxxxxx *xxxxxxxxx xxxxxxxxxx xx *NO QFL AG | |
8249 | "RTN","IBY 602PO",135 ,0) | |
8250 | . I 'TQD S $E(MSG(M CNT+2),1)= "*NO DATE" | |
8251 | "RTN","IBY 602PO",136 ,0) | |
8252 | . I TQD S $E(MSG(MC NT+2),1)=$ $GET1^DIQ( 365.1,TQIE N_",",.06, "E") ;DATE /TIME CREA TED | |
8253 | "RTN","IBY 602PO",137 ,0) | |
8254 | . S $E(MS G(MCNT+2), 23)="T#:"_ TQIEN | |
8255 | "RTN","IBY 602PO",138 ,0) | |
8256 | . I '$F(S TATLIST,", "_TQS_",") S $E(MSG( MCNT+2),40 )=" *"_$$G ET1^DIQ(36 5.1,TQIEN_ ",",.04,"E ") | |
8257 | "RTN","IBY 602PO",139 ,0) | |
8258 | . S WKZZ= "" | |
8259 | "RTN","IBY 602PO",140 ,0) | |
8260 | . I TQQ=" " S WKZZ=" *NO QUERY FLAG" | |
8261 | "RTN","IBY 602PO",141 ,0) | |
8262 | . I TQQ=" I" S WKZZ= " *QUERY F LAG: 'I'" | |
8263 | "RTN","IBY 602PO",142 ,0) | |
8264 | . S $E(MS G(MCNT+2), 60)=WKZZ | |
8265 | "RTN","IBY 602PO",143 ,0) | |
8266 | ; send ma ilman msg | |
8267 | "RTN","IBY 602PO",144 ,0) | |
8268 | S WKDT=$$ SITE^VASIT E() | |
8269 | "RTN","IBY 602PO",145 ,0) | |
8270 | S MSG(1)= "Patch IB* 2.0*602 Po st Install Issue Sum mary for s tation "_$ P(WKDT,U,3 )_":"_$P(W KDT,U,2) | |
8271 | "RTN","IBY 602PO",146 ,0) | |
8272 | S MSG(2)= "--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- " | |
8273 | "RTN","IBY 602PO",147 ,0) | |
8274 | I 'ACNT S MSG(3)=" NO ISSUES FOUND" | |
8275 | "RTN","IBY 602PO",148 ,0) | |
8276 | I ACNT D | |
8277 | "RTN","IBY 602PO",149 ,0) | |
8278 | . S MSG(M CNT+3)="" | |
8279 | "RTN","IBY 602PO",150 ,0) | |
8280 | . S MSG(M CNT+4)="TO TAL ISSUES DETECTED: "_ACNT | |
8281 | "RTN","IBY 602PO",151 ,0) | |
8282 | S IBXMY(" PII ")="" | |
8283 | "RTN","IBY 602PO",152 ,0) | |
8284 | D MSG^IBC NEUT5(,"Pa tch IB*2.0 *602 Post Install Is sue Summar y ("_$P(WK DT,U,3)_") ","MSG(",, .IBXMY) | |
8285 | "RTN","IBY 602PO",153 ,0) | |
8286 | ; Tell Ta skManager to delete the task's record | |
8287 | "RTN","IBY 602PO",154 ,0) | |
8288 | I $D(ZTQU EUED) S ZT REQ="@" | |
8289 | "RTN","IBY 602PO",155 ,0) | |
8290 | Q | |
8291 | "RTN","IBY 602PO",156 ,0) | |
8292 | ; | |
8293 | "RTN","IBY 602PO",157 ,0) | |
8294 | FIXRESP ;P opulate Re sponse ent ries with null date/ time creat ed. | |
8295 | "RTN","IBY 602PO",158 ,0) | |
8296 | N DIE,DR, DTM,RDTM,R IEN,RPDTM | |
8297 | "RTN","IBY 602PO",159 ,0) | |
8298 | S RIEN=0, RPDTM=$$FM ADD^XLFDT( DT,-182) | |
8299 | "RTN","IBY 602PO",160 ,0) | |
8300 | F S RIEN =$O(^IBCN( 365,RIEN)) Q:'RIEN D | |
8301 | "RTN","IBY 602PO",161 ,0) | |
8302 | . S TCNT= TCNT+1 | |
8303 | "RTN","IBY 602PO",162 ,0) | |
8304 | . I $D(ZT QUEUED),TC NT#100=0,$ $S^%ZTLOAD () S ZTSTO P=1 Q | |
8305 | "RTN","IBY 602PO",163 ,0) | |
8306 | . ; | |
8307 | "RTN","IBY 602PO",164 ,0) | |
8308 | . S DTM=$ $GET1^DIQ( 365,RIEN_" ,",.08,"I" ) I DTM Q | |
8309 | "RTN","IBY 602PO",165 ,0) | |
8310 | . S RDTM= $$GET1^DIQ (365,RIEN_ ",",.07,"I ") | |
8311 | "RTN","IBY 602PO",166 ,0) | |
8312 | . I RDTM> RPDTM D | |
8313 | "RTN","IBY 602PO",167 ,0) | |
8314 | .. S ACNT =ACNT+1 | |
8315 | "RTN","IBY 602PO",168 ,0) | |
8316 | .. I MCNT <6 D | |
8317 | "RTN","IBY 602PO",169 ,0) | |
8318 | ... S MCN T=MCNT+1 | |
8319 | "RTN","IBY 602PO",170 ,0) | |
8320 | ... S $E( MSG(MCNT+2 ),1)="*NO DATE/TIME CR" | |
8321 | "RTN","IBY 602PO",171 ,0) | |
8322 | ... S $E( MSG(MCNT+2 ),23)="R#: "_$$GET1^D IQ(365,RIE N_",",.01) ;MESSAGE CONTROL I D | |
8323 | "RTN","IBY 602PO",172 ,0) | |
8324 | ... S $E( MSG(MCNT+2 ),40)=" *" _$$GET1^DI Q(365,RIEN _",",.06) ;TRANSMIS SION STATU S | |
8325 | "RTN","IBY 602PO",173 ,0) | |
8326 | ... S $E( MSG(MCNT+2 ),60)=" *" _$$GET1^DI Q(365,RIEN _",",.1) ; RESPONSE T YPE | |
8327 | "RTN","IBY 602PO",174 ,0) | |
8328 | . S DTM=$ S(RDTM:RDT M,1:"NOW") | |
8329 | "RTN","IBY 602PO",175 ,0) | |
8330 | . S DIE=3 65,DA=RIEN ,DR=".08// /"_DTM | |
8331 | "RTN","IBY 602PO",176 ,0) | |
8332 | . D ^DIE | |
8333 | "RTN","IBY 602PO",177 ,0) | |
8334 | Q | |
8335 | "RTN","IBY 602PO",178 ,0) | |
8336 | ; | |
8337 | "VER") | |
8338 | 8.0^22.2 | |
8339 | "BLD",1110 5,6) | |
8340 | 12^ | |
8341 | $END KID I B*2.0*602 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.