source: FOIAVistA/tag/r/E_CLAIMS_MGMT_ENGINE-BPS/BPS01P5B.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1BPS01P5B ;BHAM ISC/BEE - Post-Install for BPS*1*5 (cont) ;13-DEC-06
2 ;;1.0;E CLAIMS MGMT ENGINE;**5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7 ; Called by the BPS*1.0*5 Post-Install routine BPS01P5.
8 ;
9EN N DA,DIK,F,FILE,FIELD,FLDNUM,IFLD,XEC
10 F F=2,201,31,56,56011,57,58,59,6,91,9102,99,9902,9903,9905,9904,992271,992273,992274,992279,9901,992388,992389 S FILE=$P($T(@F),";",3) F IFLD=1:1 S FLDNUM=$P($T(@F+IFLD),";",3) Q:FLDNUM="END" D
11 .I FLDNUM]"" S DIK="^DD("_FILE_",",DA=FLDNUM,DA(1)=FILE D ^DIK
12 .S XEC=$P($T(@F+IFLD),";",4) I XEC]"" X XEC
13 Q
14 ;
15 ;BPS CLAIMS (#9002313.02)
162 ;;9002313.02
17 ;;1.02
18 ;;1.03
19 ;;308
20 ;;315
21 ;;316
22 ;;317
23 ;;318
24 ;;319
25 ;;320
26 ;;327
27 ;;329
28 ;;498.09
29 ;;END
30 ;
31 ;BPS CLAIMS - Medication(s) (#9002313.0201)
32201 ;;9002313.0201
33 ;;.02
34 ;;404
35 ;;410
36 ;;416
37 ;;422
38 ;;425
39 ;;428
40 ;;432
41 ;;437
42 ;;439
43 ;;440
44 ;;441
45 ;;END
46 ;
47 ;BPS CERTIFICATION (#9002313.31)
4831 ;;9002313.31
49 ;;.05
50 ;;901
51 ;;END
52 ;
53 ;BPS PHARMACIES (#9002313.56)
5456 ;;9002313.56
55 ;;.04
56 ;;.05
57 ;;.06
58 ;;.07
59 ;;3001.01
60 ;;3001.02
61 ;;END
62 ;
63 ;BPS PHARMACIES - PRESCRIBER (#9002313.56011) - Field 1 In OUTPATIENT SITE Multiple
6456011 ;;9002313.56011
65 ;;;N DIU S DIU=9002313.56011,DIU(0)="DS" D EN^DIU2 K DIU
66 ;;END
67 ;
68 ;BPS LOG OF TRANSACTIONS (#9002313.57)
6957 ;;9002313.57
70 ;;.13
71 ;;.14
72 ;;.15
73 ;;.16
74 ;;1.05
75 ;;1.06
76 ;;1.14
77 ;;8
78 ;;8.0099
79 ;;12
80 ;;16
81 ;;301
82 ;;302
83 ;;403
84 ;;506
85 ;;601
86 ;;602
87 ;;603
88 ;;701
89 ;;702
90 ;;703
91 ;;802
92 ;;END
93 ;
94 ;BPS STATISTICS (#9002313.58)
9558 ;;9002313.58
96 ;;301
97 ;;302
98 ;;402
99 ;;403
100 ;;404
101 ;;405
102 ;;406
103 ;;407
104 ;;408
105 ;;409
106 ;;411
107 ;;412
108 ;;413
109 ;;414
110 ;;415
111 ;;419
112 ;;501
113 ;;601
114 ;;602
115 ;;603
116 ;;604
117 ;;701
118 ;;702
119 ;;703
120 ;;704
121 ;;705
122 ;;709
123 ;;719
124 ;;801
125 ;;802
126 ;;803
127 ;;804
128 ;;809
129 ;;901
130 ;;902
131 ;;903
132 ;;904
133 ;;909
134 ;;1001
135 ;;1002
136 ;;1101
137 ;;1102
138 ;;1103
139 ;;END
140 ;
141 ;BPS TRANSACTION (#9002313.59)
14259 ;;9002313.59
143 ;;.13
144 ;;.14
145 ;;.15
146 ;;.16
147 ;;1.05
148 ;;1.06
149 ;;1.14
150 ;;8
151 ;;8.0099
152 ;;12
153 ;;16
154 ;;301
155 ;;302
156 ;;403
157 ;;506
158 ;;601
159 ;;602
160 ;;603
161 ;;701
162 ;;702
163 ;;703
164 ;;802
165 ;;END
166 ;
167 ;BPS PHARMACIES - INSURER-ASSIGNED # (#9002313.6)/Field 950
1686 ;;9002313.6
169 ;;;N DIU S DIU=9002313.6,DIU(0)="DS" D EN^DIU2 K DIU
170 ;;END
171 ;
172 ;BPS NCPDP FIELD DEFS (#9002313.91)
17391 ;;9002313.91
174 ;;.02
175 ;;.05
176 ;;END
177 ;
178 ;BPS NCPDP FIELD DEFS - FORMAT CODE (#9002313.9102)/Field 20
1799102 ;;9002313.9102
180 ;;;N DIU S DIU=9002313.9102,DIU(0)="DS" D EN^DIU2 K DIU
181 ;;END
182 ;
183 ;BPS SETUP (#9002313.99)
18499 ;;9002313.99
185 ;;2.01
186 ;;115.01
187 ;;115.02
188 ;;119.01
189 ;;119.02
190 ;;119.03
191 ;;119.04
192 ;;119.05
193 ;;120.01
194 ;;120.02
195 ;;120.03
196 ;;120.04
197 ;;120.05
198 ;;120.06
199 ;;120.07
200 ;;140.01
201 ;;140.02
202 ;;140.03
203 ;;170.01
204 ;;230.01
205 ;;235.01
206 ;;235.02
207 ;;235.03
208 ;;235.04
209 ;;235.05
210 ;;235.06
211 ;;235.07
212 ;;370.01
213 ;;370.02
214 ;;370.03
215 ;;440.01
216 ;;577.01
217 ;;577.02
218 ;;577.03
219 ;;577.04
220 ;;577.05
221 ;;665.01
222 ;;665.02
223 ;;665.03
224 ;;665.04
225 ;;667.01
226 ;;667.02
227 ;;941
228 ;;942
229 ;;943
230 ;;951
231 ;;952
232 ;;953
233 ;;960.01
234 ;;960.02
235 ;;960.03
236 ;;960.04
237 ;;960.05
238 ;;1490
239 ;;1501
240 ;;1660.01
241 ;;1801
242 ;;1811.01
243 ;;1960.01
244 ;;1960.02
245 ;;1960.03
246 ;;1980.01
247 ;;2128.13
248 ;;2270.01
249 ;;2270.02
250 ;;2270.03
251 ;;2270.04
252 ;;2270.05
253 ;;2270.06
254 ;;2270.11
255 ;;2270.12
256 ;;2270.7
257 ;;2270.8
258 ;;2270.9
259 ;;2272.01
260 ;;2341.02
261 ;;2341.04
262 ;;2341.05
263 ;;2341.06
264 ;;2341.07
265 ;;2341.08
266 ;;2341.09
267 ;;2341.1
268 ;;2341.11
269 ;;2342.01
270 ;;2342.02
271 ;;2342.03
272 ;;2343.01
273 ;;5151
274 ;;END
275 ;
276 ;BPS SETUP - BILLING LOG FILE (#9002313.9902)/Field 240
2779902 ;;9002313.9902
278 ;;;N DIU S DIU=9002313.9902,DIU(0)="DS" D EN^DIU2 K DIU
279 ;;END
280 ;
281 ;BPS SETUP - INS RULE ORDER (#9002313.9903)/Field 970.01
2829903 ;;9002313.9903
283 ;;;N DIU S DIU=9002313.9903,DIU(0)="DS" D EN^DIU2 K DIU
284 ;;END
285 ;
286 ;BPS SETUP - UNBILLABLE NDC # (#9002313.9905)/Field 2128.11
2879905 ;;9002313.9905
288 ;;;N DIU S DIU=9002313.9905,DIU(0)="DS" D EN^DIU2 K DIU
289 ;;END
290 ;
291 ;BPS SETUP - UNBILLABLE DRUG NAME (#9002313.9904)/Field 2128.12
2929904 ;;9002313.9904
293 ;;;N DIU S DIU=9002313.9904,DIU(0)="DS" D EN^DIU2 K DIU
294 ;;END
295 ;
296 ;BPS SETUP - WO ARTYPE (#9002313.992271)/Field 2271
297992271 ;;9002313.992271
298 ;;;N DIU S DIU=9002313.992271,DIU(0)="DS" D EN^DIU2 K DIU
299 ;;END
300 ;
301 ;BPS SETUP - WO CLINIC (#9002313.992273)/Field 2273
302992273 ;;9002313.992273
303 ;;;N DIU S DIU=9002313.992273,DIU(0)="DS" D EN^DIU2 K DIU
304 ;;END
305 ;
306 ;BPS SETUP - WO DIAG (#9002313.992274)/Field 2274
307992274 ;;9002313.992274
308 ;;;N DIU S DIU=9002313.992274,DIU(0)="DS" D EN^DIU2 K DIU
309 ;;END
310 ;
311 ;BPS SETUP - WO INSURER (#9002313.992279)/Field 2279
312992279 ;;9002313.992279
313 ;;;N DIU S DIU=9002313.992279,DIU(0)="DS" D EN^DIU2 K DIU
314 ;;END
315 ;
316 ;BPS SETUP - WORKERS COMP (#9002313.9901)/Field 2380
3179901 ;;9002313.9901
318 ;;;N DIU S DIU=9002313.9901,DIU(0)="DS" D EN^DIU2 K DIU
319 ;;END
320 ;
321 ;BPS SETUP - WRITE OFF INSURER (#9002313.992388)/Field 2388
322992388 ;;9002313.992388
323 ;;;N DIU S DIU=9002313.992388,DIU(0)="DS" D EN^DIU2 K DIU
324 ;;END
325 ;
326 ;BPS SETUP - WRITE OFF SELF PAY (#9002313.992389)/Field 2389
327992389 ;;9002313.992389
328 ;;;N DIU S DIU=9002313.992389,DIU(0)="DS" D EN^DIU2 K DIU
329 ;;END
330 ;
331 ; STAT - This procedure will adjust the Statistics buckets.
332 ; It should move some claims from the OTHER bucket to the Accepted
333 ; Reversal bucket
334 ; It should move claims from the REJECTED bucket to the Rejected
335 ; Reversal bucket
336 ;
337STAT ; EP - BPS01P5
338 ; Initialize variables
339 N RESPDT,RESPIEN,POS,REV,RESP,PIECE,RESP1
340 N CLOSEDT,CLAIMIEN,DROP
341 F PIECE=2:1:8,19 S $P(RESP1,U,PIECE)=0
342 ;
343 ; Get date when stats were last cleared
344 ; If missing, set to 1/1/2001, which preceeds initial ECME install
345 ; Subtract one second for starting time of loop
346 S RESPDT=$$GET1^DIQ(9002313.58,1,2,"I")
347 I RESPDT="" S RESPDT=3010101
348 S RESPDT=$$FMADD^XLFDT(RESPDT,0,0,0,-1)
349 S CLOSEDT=RESPDT
350 ;
351 ; Loop trough BPS Response starting with Zero-Out Date,
352 ; get response and update counters
353 F S RESPDT=$O(^BPSR("AE",RESPDT)) Q:RESPDT="" D
354 . S RESPIEN="" F S RESPIEN=$O(^BPSR("AE",RESPDT,RESPIEN)) Q:RESPIEN="" D
355 .. S POS=$O(^BPSR(RESPIEN,1000,0))
356 .. I POS="" Q
357 .. S REV=$$GET1^DIQ(9002313.03,RESPIEN,103)="B2"
358 .. S RESP=$$GET1^DIQ(9002313.0301,POS_","_RESPIEN,501,"I")
359 .. S PIECE=$S(RESP="R"&REV:7,RESP="R":2,RESP="P":3,RESP="D":4,RESP="C":5,RESP="A":6,1:19)
360 .. S $P(RESP1,U,PIECE)=$P(RESP1,U,PIECE)+1
361 ;
362 ; Loop through Closed Date cross-reference of BPS Claims starting
363 ; with Zero-Out Date and update Dropped to Paper bucket
364 F S CLOSEDT=$O(^BPSC("AG",CLOSEDT)) Q:CLOSEDT="" D
365 . S CLAIMIEN="" F S CLAIMIEN=$O(^BPSC("AG",CLOSEDT,CLAIMIEN)) Q:CLAIMIEN="" D
366 .. S DROP=$$GET1^DIQ(9002313.02,CLAIMIEN,905,"I")
367 .. I DROP="D" S $P(RESP1,U,8)=$P(RESP1,U,8)+1
368 ;
369 ; Set up XTMP global
370 N X,X1,X2
371 S X1=DT,X2=60 D C^%DTC
372 S ^XTMP("BPS01P5B",0)=X_U_DT_U_"BPS Stats Update"
373 M ^XTMP("BPS01P5B","STATS")=^BPSECX("S",1)
374 ;
375 ; Save off old stats and reset stats
376 L +^BPSECX("S",1,"R"):5
377 S $P(^BPSECX("S",1,"R"),U,2,8)=$P(RESP1,U,2,8)
378 S $P(^BPSECX("S",1,"R"),U,19)=$P(RESP1,U,19)
379 L -^BPSECX("S",1,"R")
380 Q
381 ;
382 ; SUBMIT - Move Submit Date/Time from submit queue to
383 ; BPS Transaction
384SUBMIT ;
385 ; Initialize variables
386 N RXI,RXR,IEN59,SUBDT
387 ;
388 ; Get RX/Fill from submit queue
389 S RXI=""
390 F S RXI=$O(^XTMP("BPSOSRX",RXI)) Q:RXI="" D
391 . S RXR="" F S RXR=$O(^XTMP("BPSOSRX",RXI,RXR)) Q:RXR="" D
392 .. ; Calculate IEN59
393 .. S IEN59=$$IEN59^BPSOSRX(RXI,RXR)
394 .. ; If no IEN59 or zero node not defined, quit
395 .. I IEN59="" Q
396 .. I '$D(^BPST(IEN59,0)) Q
397 .. ; Get submit date and quit if not there
398 .. S SUBDT=$G(^XTMP("BPSOSRX",RXI,RXR))
399 .. I SUBDT="" Q
400 .. ; If not processed yet, quit
401 .. I $D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)) Q
402 .. I $D(^XTMP("BPS-PROC","UNCLAIM",RXI,RXR)) Q
403 .. ; Store in BPS Transaction
404 .. S $P(^BPST(IEN59,0),U,7)=SUBDT
405 Q
Note: See TracBrowser for help on using the repository browser.