source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEOB00.m@ 811

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1IBCEOB00 ;ALB/ESG - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003
2 ;;2.0;INTEGRATED BILLING;**155,349,377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check -
7 ; Total up outbound line items by revenue code and compare with
8 ; incoming EOB 40 record to see if it has been rolled up
9 ;
10 ; IBZDATA - UB output formatter array, passed by reference
11 ; IB0 - 40 record data
12 ; IBLN - output parameter, passed by reference
13 ;
14 NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH
15 I $P(IB0,U,4)="" G RCRUX
16 S IBLN="",Z=0
17 F S Z=$O(IBZDATA(Z)) Q:'Z S LN=IBZDATA(Z) D
18 . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3)
19 . I REV="" Q
20 . ;
21 . S RUD=$G(RUD(REV)) ; roll up data array for rev code
22 . S $P(RUD,U,1)=$P(RUD,U,1)+CH ; total charges
23 . S $P(RUD,U,2)=$P(RUD,U,2)+UN ; total units
24 . S $P(RUD,U,3)=$P(RUD,U,3)+1 ; total line items
25 . S RUD(REV)=RUD
26 . S RUD(REV,Z)=""
27 . ;
28 . S RUD2=$G(RUD2(REV,UCH)) ; roll up data array for rev code
29 . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH ; total charges
30 . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN ; total units
31 . S $P(RUD2,U,3)=$P(RUD2,U,3)+1 ; total line items
32 . S RUD2(REV,UCH)=RUD2
33 . S RUD2(REV,UCH,Z)=""
34 . ;
35 . Q
36 ;
37 I '$D(RUD),'$D(RUD2) G RCRUX
38 ;
39 ; delete the revenue code roll-up, if only 1 line item.
40 S REV="" ; this is not a roll up situation
41 F S REV=$O(RUD(REV)) Q:REV="" I $P(RUD(REV),U,3)=1 KILL RUD(REV)
42 ;
43 S (REV,UCH)=""
44 F S REV=$O(RUD2(REV)) Q:REV="" F S UCH=$O(RUD2(REV,UCH)) Q:UCH="" I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH)
45 ;
46 I '$D(RUD),'$D(RUD2) G RCRUX
47 ;
48 S RUD=$G(RUD($P(IB0,U,4))) ; compare with 40 record data
49 I RUD="" G RCRU2 ; make sure it exists
50 I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2 ; charges
51 I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2 ; units
52 S IBLN=$O(RUD($P(IB0,U,4),"")) ; use the first line# found
53 G RCRUX
54 ;
55RCRU2 ; check roll-up data by rev code and unit charge
56 S MRAUCH=0
57 I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16)
58 S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH)) ; compare with 40 record data
59 I RUD2="" G RCRUX ; make sure it exists
60 I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX ; charges
61 I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX ; units
62 S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,"")) ; use the first line# found
63 ;
64RCRUX ;
65 Q
66 ;
67ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill
68 ;
69 ; Input parameters
70 ; IBEOB - ien to file 361.1
71 ; ICN - the ICN# from the 835 transmission
72 ; COBN - the insurance sequence#
73 ;
74 ; Output parameter
75 ; IBOK - returns as 0 if we get a filing error here
76 ;
77 ; The field in file 399 depends on the current payer sequence
78 ; 399,453 - primary ICN
79 ; 399,454 - secondary ICN
80 ; 399,455 - tertiary ICN
81 ;
82 NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
83 S IBEOB=+$G(IBEOB),COBN=+$G(COBN)
84 I 'IBEOB!'COBN G ICNX
85 S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1)
86 I '$D(^DGCR(399,IBIFN)) G ICNX
87 I $G(ICN)="" G ICNX
88 I '$F(".1.2.3.","."_COBN_".") G ICNX
89 ;
90 S FIELD=452+COBN
91 S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE
92 S IBOK=($D(Y)=0)
93 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file"
94ICNX ;
95 Q
96 ;
9715(IB0,IBEGBL,IBEOB) ; Record '15'
98 ;
99 N A,IBOK
100 ;
101 S A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0"
102 ;
103 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
104 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15
105 ;
106 ; For Medicare MRA's only:
107 ; If the Covered Amount is present (15 record, piece 3), then file
108 ; a claim level adjustment with Group code=OA, Reason code=AB3.
109 ;
110 I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D
111 . N IB20
112 . S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000"
113 . S IB20=IB20_U_"Covered Amount"
114 . S IBOK=$$20(IB20,IBEGBL,IBEOB)
115 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount"
116 . K ^TMP($J,20)
117 . Q
118 ;
119Q15 Q IBOK
120 ;
12120(IB0,IBEGBL,IBEOB) ; Record '20'
122 ;
123 N A,LEVEL,IBGRP,IBDA,IBOK
124 ;
125 S IBGRP=$P(IB0,U,3)
126 I IBGRP'="" S ^TMP($J,20)=IBGRP
127 I IBGRP="" S IBGRP=$G(^TMP($J,20))
128 I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20
129 ;
130 S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,0))
131 ;
132 I 'IBDA(1) D ;Needs a new entry at group level
133 . N X,Y,DA,DD,DO,DIC,DLAYGO
134 . S DIC="^IBM(361.1,"_IBEOB_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB
135 . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10)
136 . S X=IBGRP
137 . D FILE^DICN K DIC,DO,DD,DLAYGO
138 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q
139 . S IBDA(1)=+Y
140 ;
141 I $G(IBDA(1)) D ;Add a new entry at the reason code level
142 . S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1)
143 . S DIC("P")=$$GETSPEC^IBEFUNC(361.11,1)
144 . S X=$P(IB0,U,4)
145 . D FILE^DICN K DIC,DO,DD,DLAYGO
146 . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment reason code could not be added" Q
147 . S IBDA=+Y
148 ;
149 I $G(IBDA) D
150 . S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,"
151 . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBEOB
152 . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0"
153 . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL)
154 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q
155Q20 Q $G(IBOK)
156 ;
15735(IB0,IBEGBL,IBEOB) ; Record '35'
158 ;
159 N A,IBOK
160 ;
161 S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0"
162 ;
163 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
164 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data"
165Q35 Q $G(IBOK)
166 ;
16737(IB0,IBEGBL,IBEOB) ; Record '37'
168 ;
169 N IBOK,IBCT
170 S IBCT=$G(^TMP($J,37))+1
171 I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37 ; Max 5 allowed
172 S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0"
173 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
174 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data"
175 ;
176 ; 4/22/03 - esg - If claim level remark code MA15 is reported, then
177 ; this is a split EOB and we need to change the REVIEW STATUS
178 ; of this EOB to be ACCEPTED-INTERIM EOB.
179 ;
180 I $P(IB0,U,4)["MA15" D
181 . N DA,DIE,DR,DIC
182 . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0)
183 . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly"
184 . Q
185 ;
186Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records
187 Q $G(IBOK)
188 ;
189 ;
190DET40(IB0,ARRAY) ; Format important details of record 40 for error
191 ; IB0 = data on 40 record (some pieces pre-formatted)
192 ; ARRAY(n)=formatted line is returned if passed by ref
193 N Q
194 S ARRAY(1)="Payer reported the following was billed to them:"
195 S ARRAY(2)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"Same as adjudicated")_" Chg: "_$J($P(IB0,U,15)/100,"",2)_" Units: "_$S($P(IB0,U,16):$P(IB0,U,16),1:1)
196 S ARRAY(3)=" Svc Date(s): "_$S($P(IB0,U,19)'="":$$FDT($P(IB0,U,19)),1:"??")_$S($P(IB0,U,20)'="":"-"_$$FDT($P(IB0,U,20)),1:"")
197 I $P(IB0,U,11)'="" S ARRAY(3)=ARRAY(3)_" Mods: " F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(3)=ARRAY(3)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"")
198 S ARRAY(4)="Payer reported adjudication on:"
199 S ARRAY(5)=" "_$S($P(IB0,U,21)="NU":"Rev Cd",1:"Proc")_": "_$S($P(IB0,U,3)'="":$P(IB0,U,3),1:$P(IB0,U,4))
200 S ARRAY(5)=ARRAY(5)_" Type: "_$P(IB0,U,21)_$S($P(IB0,U,21)'="NU":" Rev Cd: "_$P(IB0,U,4),1:"")_" Units: "_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1)_" Amt: "_$J($P(IB0,U,17)/100,"",2)
201 I $P(IB0,U,5)'="" S ARRAY(5)=ARRAY(5)_" Mods: " F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(5)=ARRAY(5)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"")
202 Q
203 ;
204DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-45 for error
205 ; RECID = 41,42,45
206 ; IB0 = data on RECID record
207 ; ARRAY(n)=formatted line is returned if passed by ref
208 N CT,Q
209 I RECID=41 D Q
210 . S ARRAY(1)="Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2)
211 ;
212 I RECID=42 D Q
213 . S ARRAY(1)="Line Item Remark Code: "_$P(IB0,U,3)
214 . I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80)
215 ;
216 I RECID=45 D
217 . S ARRAY(1)="Adj Group Cd: "_$P(IB0,U,3)_" Reason Cd: "_$P(IB0,U,4)_" Amt: "_$J($P(IB0,U,5)/100,"",2)_" Quantity: "_+$P(IB0,U,6)
218 . I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80)
219 Q
220 ;
221FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY
222 S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4)
223 Q X
224 ;
Note: See TracBrowser for help on using the repository browser.