[628] | 1 | IBCEOB ;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 | ;
|
---|
| 7 | UPDEOB(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 | ;
|
---|
| 35 | UPDQ 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 | ;
|
---|
| 46 | 835(IB0,IBEGBL,IBEOB) ; Store header
|
---|
| 47 | ;
|
---|
| 48 | Q $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB)
|
---|
| 49 | ;
|
---|
| 50 | 5(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 | ;
|
---|
| 64 | 6(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 | ;
|
---|
| 86 | Q6 ; exit point for $$6 function
|
---|
| 87 | Q 1
|
---|
| 88 | ;
|
---|
| 89 | 10(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 | ;
|
---|
| 105 | Q10 Q IBOK
|
---|
| 106 | ;
|
---|
| 107 | 15(IB0,IBEGBL,IBEOB) ; Record '15'
|
---|
| 108 | ; Moved due to space constraints
|
---|
| 109 | Q15 Q $$15^IBCEOB00(IB0,IBEGBL,IBEOB)
|
---|
| 110 | ;
|
---|
| 111 | 17(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"
|
---|
| 116 | Q17 Q IBOK
|
---|
| 117 | ;
|
---|
| 118 | 20(IB0,IBEGBL,IBEOB) ; Record '20'
|
---|
| 119 | ; Moved due to space constraints
|
---|
| 120 | Q20 Q $$20^IBCEOB00(IB0,IBEGBL,IBEOB)
|
---|
| 121 | ;
|
---|
| 122 | 30(IB0,IBEGBL,IBEOB) ; Record '30'
|
---|
| 123 | ;
|
---|
| 124 | N IBOK
|
---|
| 125 | D 30^IBCEOB0(IB0,IBEOB,.IBOK)
|
---|
| 126 | Q30 Q $G(IBOK)
|
---|
| 127 | ;
|
---|
| 128 | 35(IB0,IBEGBL,IBEOB) ; Record '35'
|
---|
| 129 | ; Moved due to space constraints
|
---|
| 130 | Q35 Q $$35^IBCEOB00(IB0,IBEGBL,IBEOB)
|
---|
| 131 | ;
|
---|
| 132 | 37(IB0,IBEGBL,IBEOB) ; Record '37'
|
---|
| 133 | ; Moved due to space constraints
|
---|
| 134 | Q37 Q $$37^IBCEOB00(IB0,IBEGBL,IBEOB)
|
---|
| 135 | ;
|
---|
| 136 | 40(IB0,IBEGBL,IBEOB) ; Record '40'
|
---|
| 137 | ;
|
---|
| 138 | N IBOK
|
---|
| 139 | D 40^IBCEOB0(IB0,IBEOB,.IBOK)
|
---|
| 140 | Q40 Q $G(IBOK)
|
---|
| 141 | ;
|
---|
| 142 | 41(IB0,IBEGBL,IBEOB) ; Record '41'
|
---|
| 143 | ;
|
---|
| 144 | N IBOK
|
---|
| 145 | D 41^IBCEOB0(IB0,IBEOB,.IBOK)
|
---|
| 146 | Q41 Q $G(IBOK)
|
---|
| 147 | ;
|
---|
| 148 | 42(IB0,IBEGBL,IBEOB) ; Record '42'
|
---|
| 149 | ;
|
---|
| 150 | N IBOK
|
---|
| 151 | D 42^IBCEOB0(IB0,IBEOB,.IBOK)
|
---|
| 152 | Q42 Q $G(IBOK)
|
---|
| 153 | ;
|
---|
| 154 | 45(IB0,IBEGBL,IBEOB) ; Record '45'
|
---|
| 155 | ;
|
---|
| 156 | N IBOK
|
---|
| 157 | D 45^IBCEOB0(IB0,IBEOB,.IBOK)
|
---|
| 158 | Q $G(IBOK)
|
---|
| 159 | ;
|
---|
| 160 | MSG(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
|
---|
| 170 | MSGX ;
|
---|
| 171 | Q
|
---|
| 172 | ;
|
---|
| 173 | DOLLAR(X) ; Convert value in X to dollar format XXX.XX
|
---|
| 174 | Q $S(+X:$J(X/100,$L(+X),2),1:0)
|
---|
| 175 | ;
|
---|
| 176 | ADD3611(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 | ;
|
---|
| 198 | UPD3611(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 | ;
|
---|
| 214 | ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed
|
---|
| 215 | D WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","")
|
---|
| 216 | Q
|
---|
| 217 | ;
|
---|
| 218 | ;
|
---|
| 219 | DUP(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
|
---|
| 247 | DUPX ;
|
---|
| 248 | Q DUP
|
---|
| 249 | ;
|
---|