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

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1IBCEOB ;ALB/TMP - 835 EDI EOB MESSAGE PROCESSING ;20-JAN-99
2 ;;2.0;INTEGRATED BILLING;**137,135,265,155,377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7UPDEOB(IBTDA) ; Update EXPLANATION OF BENEFITS file (#361.1) from return msg
8 ; IBTDA = ien of return message
9 ; Function returns ien of EOB file entry or "" if errors found
10 ; the data. Any errors found are
11 ; stored in array ^TMP("IBCERR-EOB",$J,n) in text format
12 ; n = seq # and are stored with the EOB in a wp field
13 ;
14 N IB0,IB100,IBBTCH,IBE,IBMNUM,IBT,DLAYGO,DIC,DD,DO,X,Y,Z,Z0,Z1,IBEOB,IBBAD,IBOK,IB,IBA1,IBIFN,IBFILE
15 K ^TMP($J),^TMP("IBCERR-EOB",$J)
16 ;
17 S (IBBAD,IBEOB)=""
18 S IB0=$G(^IBA(364.2,IBTDA,0))
19 S IBMNUM=+$P(IB0,U)
20 S X=+$G(^IBA(364,+$P(IB0,U,5),0))
21 ;
22 G:$S(IBMNUM=""!(X=""):1,1:$D(^IBM(361.1,"AC",IBMNUM))) UPDQ
23 ;
24 ; Duplicate EOB Check
25 S IBFILE="^IBA(364.2,"_IBTDA_",2)"
26 I $$DUP(IBFILE,X) D DELMSG^IBCESRV2(IBTDA) G UPDQ
27 ;
28 I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock msg file 364.2
29 S IBEOB=+$$ADD3611(IBMNUM,$P(IB0,U,5),$P(IB0,U,4),X,0,IBFILE)
30 L -^IBA(364.2,IBTDA,0)
31 ;
32 I IBEOB<0 S IBEOB="" G UPDQ
33 D UPD3611(IBEOB,IBTDA,0)
34 ;
35UPDQ I IBEOB,$O(^TMP("IBCERR-EOB",$J,0)) D ERRUPD(IBEOB,"IBCERR-EOB")
36 K ^TMP($J),^TMP("IBCERR-EOB",$J)
37 D CLEAN^DILF
38 Q +IBEOB
39 ;
40 ;
41 ; NOTE: **** For all variables IB0,IBEGBL,IBEOB below:
42 ; IB0 = raw data received for this record type on the 835 flat file
43 ; IBEGBL = subscript to use in error global
44 ; IBEOB = ien in file 361.1 for this EOB
45 ;
46835(IB0,IBEGBL,IBEOB) ; Store header
47 ;
48 Q $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB)
49 ;
505(IB0,IBEGBL,IBEOB) ; Record '05'
51 ;
52 N IBOK,DA,DR,DIE,X,Y
53 K IBZDATA
54 S DR=";",IBOK=1
55 S DIE="^IBM(361.1,",DA=IBEOB
56 ;
57 I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";" ; statement start date
58 I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";" ; statement end date
59 S DR=$P(DR,";",2,$L(DR,";")-1)
60 I DR'="" D ^DIE S IBOK=$D(Y)=0
61 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 5 data"
62 Q IBOK
63 ;
646(IB0,IBEGBL,IBEOB) ; Record '06' - corrected patient name and/or ID#
65 ; This data is not going to be filed into file 361.1 so the value of this function will always be a 1 so as to
66 ; not interrupt the filing process of the EOB/MRA data into file 361.1.
67 ;
68 ; perform overall integrity checks on the incoming 06 record. If anything is out of place, don't update anything
69 ; and report the problem and get out.
70 NEW CLM,SITE,IBM,IBIFN,IBIFN1,DFN,SEQ,DIE,DA,DR
71 S DIE=361.1,DA=IBEOB,DR="61.01////^S X=IB0" D ^DIE ; archive the raw 06 record data
72 S CLM=$P(IB0,U,2),SITE=+CLM,CLM=$P(CLM,"-",2) I CLM="" D MSG(IBEOB,"The claim# in piece 2 is invalid.") G Q6
73 S IBM=$G(^IBM(361.1,IBEOB,0))
74 I $P(IBM,U,4)'=1 D MSG(IBEOB,"This is a non-Medicare EOB.") G Q6
75 S IBIFN=+$P(IBM,U,1) ; claim# from MRA
76 S IBIFN1=+$O(^DGCR(399,"B",CLM,"")) ; claim# from 06 record
77 I IBIFN'=IBIFN1 D MSG(IBEOB,"Claim mismatch error."_IBIFN_","_IBIFN1_","_CLM_".") G Q6
78 I $P($$SITE^VASITE,U,3)'=SITE D MSG(IBEOB,"Invalid station# mismatch."_$P($$SITE^VASITE,U,3)_","_SITE_".") G Q6
79 S SEQ=$$COBN^IBCEF(IBIFN) ; current payer sequence# on claim
80 I '$$WNRBILL^IBEFUNC(IBIFN,SEQ) D MSG(IBEOB,"The current payer on this claim is not MEDICARE (WNR).") G Q6
81 S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) ; patient ien
82 I 'DFN D MSG(IBEOB,"The patient DFN cannot be determined.") G Q6
83 ;
84 D UPD^IBCEOB01(IB0,IBEOB,IBIFN,DFN,SEQ) ; update patient insurance policy data
85 ;
86Q6 ; exit point for $$6 function
87 Q 1
88 ;
8910(IB0,IBEGBL,IBEOB) ; Record '10'
90 ;
91 N DA,DR,DIE,X,Y,VAL,IBOK
92 S DIE="^IBM(361.1,",DA=IBEOB
93 S DR=".13////"_$S($P(IB0,U,3)="Y":1,$P(IB0,U,4)="Y":2,$P(IB0,U,5)="Y":3,$P(IB0,U,6)="Y":4,1:5)_";.21////"_$P(IB0,U,7)
94 S DR=DR_";2.04////"_$$DOLLAR($P(IB0,U,10))_";1.01////"_$$DOLLAR($P(IB0,U,11))_$S($P(IB0,U,12)'="":";.14///"_$P(IB0,U,12),1:"")
95 S DR=DR_$S($P(IB0,U,13)'="":";.1///"_$P(IB0,U,13),1:"")_";.11///"_($P(IB0,U,14)/10000)_";.12///"_($P(IB0,U,15)/100)
96 I $P(IB0,U,8)'="" S DR=DR_";.08////"_$P(IB0,U,8)_$S($P(IB0,U,9)'="":";.09///"_$P(IB0,U,9),1:"")
97 ;
98 D ^DIE
99 S IBOK=($D(Y)=0)
100 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 10 data" G Q10
101 ;
102 ; File ICN in Bill
103 D ICN^IBCEOB00(IBEOB,$P(IB0,U,12),$P($G(^IBM(361.1,IBEOB,0)),U,15),.IBOK)
104 ;
105Q10 Q IBOK
106 ;
10715(IB0,IBEGBL,IBEOB) ; Record '15'
108 ; Moved due to space constraints
109Q15 Q $$15^IBCEOB00(IB0,IBEGBL,IBEOB)
110 ;
11117(IB0,IBEGBL,IBEOB) ; Record '17'
112 N A,IBOK
113 S A="3;25.01;0;1;0^4;25.02;0;1;0^5;25.03;0;1;0^6;25.04;0;1;0^7;25.05;0;1;0^8;25.06;0;1;0^9;25.07;0;1;0"
114 S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB)
115 I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 17 data"
116Q17 Q IBOK
117 ;
11820(IB0,IBEGBL,IBEOB) ; Record '20'
119 ; Moved due to space constraints
120Q20 Q $$20^IBCEOB00(IB0,IBEGBL,IBEOB)
121 ;
12230(IB0,IBEGBL,IBEOB) ; Record '30'
123 ;
124 N IBOK
125 D 30^IBCEOB0(IB0,IBEOB,.IBOK)
126Q30 Q $G(IBOK)
127 ;
12835(IB0,IBEGBL,IBEOB) ; Record '35'
129 ; Moved due to space constraints
130Q35 Q $$35^IBCEOB00(IB0,IBEGBL,IBEOB)
131 ;
13237(IB0,IBEGBL,IBEOB) ; Record '37'
133 ; Moved due to space constraints
134Q37 Q $$37^IBCEOB00(IB0,IBEGBL,IBEOB)
135 ;
13640(IB0,IBEGBL,IBEOB) ; Record '40'
137 ;
138 N IBOK
139 D 40^IBCEOB0(IB0,IBEOB,.IBOK)
140Q40 Q $G(IBOK)
141 ;
14241(IB0,IBEGBL,IBEOB) ; Record '41'
143 ;
144 N IBOK
145 D 41^IBCEOB0(IB0,IBEOB,.IBOK)
146Q41 Q $G(IBOK)
147 ;
14842(IB0,IBEGBL,IBEOB) ; Record '42'
149 ;
150 N IBOK
151 D 42^IBCEOB0(IB0,IBEOB,.IBOK)
152Q42 Q $G(IBOK)
153 ;
15445(IB0,IBEGBL,IBEOB) ; Record '45'
155 ;
156 N IBOK
157 D 45^IBCEOB0(IB0,IBEOB,.IBOK)
158 Q $G(IBOK)
159 ;
160MSG(IBEOB,MSG) ; procedure to file message into field 6.03
161 ; Results of processing of the "06" record type
162 N DIE,DA,DR,Z
163 S DIE=361.1,DA=+$G(IBEOB)
164 I $G(MSG)="" G MSGX
165 S Z=$P($G(^IBM(361.1,DA,6)),U,3) ; already existing message
166 I Z'="" S MSG=Z_" "_MSG ; append new message to existing message
167 S MSG=$E(MSG,1,190)
168 S DR="6.03///^S X=MSG"
169 D ^DIE
170MSGX ;
171 Q
172 ;
173DOLLAR(X) ; Convert value in X to dollar format XXX.XX
174 Q $S(+X:$J(X/100,$L(+X),2),1:0)
175 ;
176ADD3611(IBMNUM,IBTBILL,IBBATCH,X,IBAR,IBFILE) ; Add stub record to file 361.1
177 ; X = the ien of the referenced bill in file 399
178 ; IBTBILL = ien of transmitted bill (optional)
179 ; IBBATCH = ien of batch # the transmitted bill was in (optional)
180 ; IBMNUM = the message # from which this record originally came
181 ; IBAR = 1 only if called from AR
182 ; IBFILE = array reference of raw EOB data
183 ;
184 N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS,MMI
185 F L +^IBM(361.1,0):10 Q:$T
186 ;
187 ; default proper review status
188 S BS=$P($G(^DGCR(399,X,0)),U,13) ; bill status
189 S REVSTAT=$S(BS=7:9,BS=3:3,BS=4:3,1:0)
190 S MMI=$$NET^XMRENT(IBMNUM) ; MailMan header info
191 S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1
192 S DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$S('$G(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"")
193 S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)_";62.01////^S X=MMI"
194 D FILE^DICN
195 L -^IBM(361.1,0)
196 Q +Y
197 ;
198UPD3611(IBEOB,IBTDA,IBAR) ; From flat file 835 format, add EOB record
199 ; IBEOB = the ien of the entry in file 361.1 being updated
200 ; IBTDA = the ien in the source file
201 ; IBAR = 1 if being called from AR
202 N IBA1,IBFILE,IBEGBL,Z,IBREC,Q
203 S IBFILE=$S('$G(IBAR):"^IBA(364.2,"_IBTDA_",2)",1:"^TMP("_$J_",""RCDP-EOB"","_IBTDA_")")
204 S IBEGBL=$S('$G(IBAR):"IBCERR-EOB",1:"RCDPERR-EOB")
205 I $G(IBAR),'$$HDR^IBCEOB1($G(^TMP($J,"RCDPEOB","HDR")),IBEGBL,IBEOB) Q
206 S IBA1=0
207 F S IBA1=$O(@IBFILE@(IBA1)) Q:'IBA1 S IB0=$S('$G(IBAR):$P($G(^(IBA1,0)),"##RAW DATA: ",2),1:$G(@IBFILE@(IBA1,0))) I IB0'="" D
208 . S IBREC=+IB0
209 . I IBREC'=37 K ^TMP($J,37)
210 . I IBREC S IB="S IBOK=$$"_IBREC_"(IB0,IBEGBL,IBEOB)",Q=IBREC_"^IBCEOB" I $T(@Q)'="" X IB S:'IBOK ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)=$S('$G(IBAR):" ##RAW DATA: ",1:"")_IB0
211 ;
212 Q
213 ;
214ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed
215 D WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","")
216 Q
217 ;
218 ;
219DUP(IBARRAY,IBIFN) ; Duplicate Check
220 ; This function determines if the EOB data already exists in file
221 ; 361.1 by comparing the checksums of the raw 835 data.
222 ;
223 ; IBARRAY = Literal array reference where the raw 835 data exists.
224 ; The data exists at @IBARRAY@(n,0), where n is the seq#.
225 ; For example, IBARRAY = "^IBA(364.2,IBIEN,2)"
226 ;
227 ; IBIFN = the bill # (ptr to 399). The checksums of the EOB's on
228 ; file for this bill will be compared to the checksum of the
229 ; 835 raw data in the IBARRAY reference.
230 ;
231 ; This function returns 0 if the entry is not found (no duplicate),
232 ; Otherwise, the IEN of the entry in file 361.1 is returned if this
233 ; is a duplicate EOB.
234 ;
235 NEW DUP,IBEOB,CHKSUM1,CHKSUM2
236 S DUP=0,IBIFN=+$G(IBIFN)
237 I $G(IBARRAY)=""!'IBIFN G DUPX
238 I '$D(^IBM(361.1,"B",IBIFN)) G DUPX ; no EOB's on file yet
239 S CHKSUM1=$$CHKSUM^IBCEMU1(IBARRAY) ; checksum of current EOB
240 I 'CHKSUM1 G DUPX ; must be able to be calculated
241 S IBEOB=0
242 F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D Q:DUP
243 . S CHKSUM2=+$P($G(^IBM(361.1,IBEOB,100)),U,5) ; checksum of old EOB
244 . I 'CHKSUM2 Q
245 . I CHKSUM1=CHKSUM2 S DUP=IBEOB Q ; comparison
246 . Q
247DUPX ;
248 Q DUP
249 ;
Note: See TracBrowser for help on using the repository browser.