IBCEOB ;ALB/TMP/PJH - 835 EDI EOB MESSAGE PROCESSING ; 8/19/10 6:33pm
;;2.0;INTEGRATED BILLING;**137,135,265,155,377,407,431,432,488,639,718**;21-MAR-94;Build 73
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
UPDEOB(IBTDA) ; Update EXPLANATION OF BENEFITS file (#361.1) from return msg
; IBTDA = ien of return message
; Function returns ien of EOB file entry or "" if errors found
; the data. Any errors found are
; stored in array ^TMP("IBCERR-EOB",$J,n) in text format
; n = seq # and are stored with the EOB in a wp field
;
N IB0,IB100,IBBTCH,IBE,IBMNUM,IBT,DLAYGO,DIC,DD,DO,X,Y,Z,Z0,Z1,IBEOB,IBBAD,IBOK,IB,IBA1,IBIFN,IBFILE
K ^TMP($J),^TMP("IBCERR-EOB",$J)
;
S (IBBAD,IBEOB)=""
S IB0=$G(^IBA(364.2,IBTDA,0))
S IBMNUM=+$P(IB0,U)
S X=+$G(^IBA(364,+$P(IB0,U,5),0))
;
I IBMNUM=""!(X="") G UPDQ
;
; Duplicate EOB Check
S IBFILE="^IBA(364.2,"_IBTDA_",2)"
I $$DUP(IBFILE,X) D DELMSG^IBCESRV2(IBTDA) G UPDQ
;
I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock msg file 364.2
S IBEOB=+$$ADD3611(IBMNUM,$P(IB0,U,5),$P(IB0,U,4),X,0,IBFILE)
L -^IBA(364.2,IBTDA,0)
;
I IBEOB<0 S IBEOB="" G UPDQ
D UPD3611(IBEOB,IBTDA,0)
;
UPDQ I IBEOB,$O(^TMP("IBCERR-EOB",$J,0)) D ERRUPD(IBEOB,"IBCERR-EOB")
;
K ^TMP($J),^TMP("IBCERR-EOB",$J)
D CLEAN^DILF
Q +IBEOB
;
;
; NOTE: **** For all variables IB0,IBEGBL,IBEOB below:
; IB0 = raw data received for this record type on the 835 flat file
; IBEGBL = subscript to use in error global
; IBEOB = ien in file 361.1 for this EOB
;
835(IB0,IBEGBL,IBEOB) ; Store header
;
Q $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB,.HIPAA)
;
5(IB0,IBEGBL,IBEOB) ; Record '05'
;
N IBOK,DA,DR,DIE,X,Y
K IBZDATA
S DR=";",IBOK=1
S DIE="^IBM(361.1,",DA=IBEOB
;
I $P(IB0,U,9) S DR=DR_"1.1///"_$$DATE^IBCEU($P(IB0,U,9))_";" ; statement start date
I $P(IB0,U,10) S DR=DR_"1.11///"_$$DATE^IBCEU($P(IB0,U,10))_";" ; statement end date
I $P(IB0,U,11) S DR=DR_"1.12///"_$$DATE^IBCEU($P(IB0,U,11))_";" ; claim received date
S DR=$P(DR,";",2,$L(DR,";")-1)
I DR'="" D ^DIE S IBOK=$D(Y)=0
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 5 data"
Q IBOK
;
6(IB0,IBEGBL,IBEOB) ; Record '06' - corrected patient name and/or ID#
; 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
; not interrupt the filing process of the EOB/MRA data into file 361.1.
;
; perform overall integrity checks on the incoming 06 record. If anything is out of place, don't update anything
; and report the problem and get out.
NEW CLM,SITE,IBM,IBIFN,IBIFN1,DFN,SEQ,DIE,DA,DR
S DIE=361.1,DA=IBEOB,DR="61.01////^S X=IB0" D ^DIE ; archive the raw 06 record data
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
S IBM=$G(^IBM(361.1,IBEOB,0))
I $P(IBM,U,4)'=1 D MSG(IBEOB,"This is a non-Medicare EOB.") G Q6
S IBIFN=+$P(IBM,U,1) ; claim# from MRA
S IBIFN1=+$O(^DGCR(399,"B",CLM,"")) ; claim# from 06 record
I IBIFN'=IBIFN1 D MSG(IBEOB,"Claim mismatch error."_IBIFN_","_IBIFN1_","_CLM_".") G Q6
I $P($$SITE^VASITE,U,3)'=SITE D MSG(IBEOB,"Invalid station# mismatch."_$P($$SITE^VASITE,U,3)_","_SITE_".") G Q6
S SEQ=$$COBN^IBCEF(IBIFN) ; current payer sequence# on claim
I '$$WNRBILL^IBEFUNC(IBIFN,SEQ) D MSG(IBEOB,"The current payer on this claim is not MEDICARE (WNR).") G Q6
S DFN=+$P($G(^DGCR(399,IBIFN,0)),U,2) ; patient ien
I 'DFN D MSG(IBEOB,"The patient DFN cannot be determined.") G Q6
;
D UPD^IBCEOB01(IB0,IBEOB,IBIFN,DFN,SEQ) ; update patient insurance policy data
;
Q6 ; exit point for $$6 function
Q 1
;
10(IB0,IBEGBL,IBEOB) ; Record '10'
;
N DA,DR,DIE,X,Y,VAL,IBOK,IB361
S DIE="^IBM(361.1,",DA=IBEOB
; put denied non-MRA claims on the worklist IB*2.0*432
;S IB361=$G(^IBM(361.1,DA,0))
;I $P(IB361,U,4)=0,$P(IB0,U,4)="Y" D PUTONWL^IBCAPP($P(IB361,U),"IB804:EOB Claim Status must be PROCESSED")
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)
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:"")
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)
I $P(IB0,U,8)'="" S DR=DR_";.08////"_$P(IB0,U,8)_$S($P(IB0,U,9)'="":";.09///"_$P(IB0,U,9),1:"")
I HIPAA,$P(IB0,U,16) S DR=DR_";1.13///"_$$DATE^IBCEU($P(IB0,U,16))_";" ; coverage exp. date
;
D ^DIE
S IBOK=($D(Y)=0)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 10 data" G Q10
;
; File ICN in Bill
D ICN^IBCEOB00(IBEOB,$P(IB0,U,12),$P($G(^IBM(361.1,IBEOB,0)),U,15),.IBOK)
;
Q10 Q IBOK
;
12(IB0,IBEGL,IBEOB) ; Record '12'
;
N DA,DR,DIE,X,Y,VAL,IBOK
I HIPAA'=5010 S IBOK=1 G Q12
S DIE="^IBM(361.1,",DA=IBEOB,DR=";"
I $P(IB0,U,3)'="" S DR=DR_"1.14////"_$P(IB0,U,3)_";"
I $P(IB0,U,4)'="" S DR=DR_"1.15////"_$P(IB0,U,4)_";"
I $P(IB0,U,5)'="" S DR=DR_"1.16////"_$P(IB0,U,5)_";"
S DR=$P(DR,";",2,$L(DR,";")-1)
;
D ^DIE
S IBOK=($D(Y)=0)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 12 data"
;
Q12 Q IBOK
;
13(IB0,IBEGL,IBEOB) ; Record '13'
;
N DA,DR,DIE,X,Y,VAL,IBOK,NAME
I HIPAA'=5010 S IBOK=1 G Q13
S DIE="^IBM(361.1,",DA=IBEOB
S NAME=$P(IB0,U,3) I NAME="" S IBOK=1 G Q13
I $P(IB0,U,4)'="" S NAME=NAME_","_$P(IB0,U,4)
I $P(IB0,U,5)'="" S NAME=NAME_","_$P(IB0,U,5)
S DR="1.17////"_NAME ; Other Subscriber Name
;
D ^DIE
S IBOK=($D(Y)=0)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 13 data"
;
Q13 Q IBOK
;
15(IB0,IBEGBL,IBEOB) ; Record '15'
; Moved due to space constraints
Q15 Q $$15^IBCEOB00(IB0,IBEGBL,IBEOB)
;
17(IB0,IBEGBL,IBEOB) ; Record '17'
N A,DATA,IBOK
;Old Format
S DATA=IB0
;New Format - store incoming data in first available field
I HIPAA>0 D
.N CNT
.S CNT=4,DATA=$P(DATA,U,1,3) ;Claim Contact Name
.I $P(IB0,U,4)'="" S $P(DATA,U,CNT)=$P(IB0,U,4),$P(DATA,U,CNT+1)="TE",CNT=CNT+2 ;Tel
.I $P(IB0,U,5)'="" S $P(DATA,U,CNT)=$P(IB0,U,5),$P(DATA,U,CNT+1)="FX",CNT=CNT+2 ;Fax
.I $P(IB0,U,6)'="" S $P(DATA,U,CNT)=$P(IB0,U,6),$P(DATA,U,CNT+1)="EM" ;email
;
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"
S IBOK=$$STORE^IBCEOB1(A,DATA,IBEOB)
I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 17 data"
Q17 Q IBOK
;
20(IB0,IBEGBL,IBEOB) ; Record '20'
; Moved due to space constraints
Q20 Q $$20^IBCEOB00(IB0,IBEGBL,IBEOB)
;
30(IB0,IBEGBL,IBEOB) ; Record '30'
;
N IBOK
D 30^IBCEOB0(IB0,IBEOB,.IBOK)
Q30 Q $G(IBOK)
;
35(IB0,IBEGBL,IBEOB) ; Record '35'
; Moved due to space constraints
Q35 Q $$35^IBCEOB00(IB0,IBEGBL,IBEOB)
;
37(IB0,IBEGBL,IBEOB) ; Record '37'
; Moved due to space constraints
Q37 Q $$37^IBCEOB00(IB0,IBEGBL,IBEOB)
;
40(IB0,IBEGBL,IBEOB) ; Record '40'
;
N IBOK
D 40^IBCEOB0(IB0,IBEOB,.IBOK)
Q40 Q $G(IBOK)
;
41(IB0,IBEGBL,IBEOB) ; Record '41'
;
N IBOK
D 41^IBCEOB0(IB0,IBEOB,.IBOK)
Q41 Q $G(IBOK)
;
42(IB0,IBEGBL,IBEOB) ; Record '42'
;
N IBOK
D 42^IBCEOB0(IB0,IBEOB,.IBOK)
Q42 Q $G(IBOK)
;
45(IB0,IBEGBL,IBEOB) ; Record '45'
;
N IBOK
D 45^IBCEOB0(IB0,IBEOB,.IBOK)
Q $G(IBOK)
;
;
46(IB0,IBEGBL,IBEOB) ; Record '46'
;
N IBOK
I HIPAA'=5010 S IBOK=1 G Q46
D 46^IBCEOB0(IB0,IBEOB,.IBOK)
Q46 Q $G(IBOK)
;
MSG(IBEOB,MSG) ; procedure to file message into field 6.03
; Results of processing of the "06" record type
N DIE,DA,DR,Z
S DIE=361.1,DA=+$G(IBEOB)
I $G(MSG)="" G MSGX
S Z=$P($G(^IBM(361.1,DA,6)),U,3) ; already existing message
I Z'="" S MSG=Z_" "_MSG ; append new message to existing message
S MSG=$E(MSG,1,190)
S DR="6.03///^S X=MSG"
D ^DIE
MSGX ;
Q
;
DOLLAR(X) ; Convert value in X to dollar format XXX.XX
Q $S(+X:$J(X/100,$L(+X),2),1:0)
;
ADD3611(IBMNUM,IBTBILL,IBBATCH,X,IBAR,IBFILE) ; Add stub record to file 361.1
; X = the ien of the referenced bill in file 399
; IBTBILL = ien of transmitted bill (optional)
; IBBATCH = ien of batch # the transmitted bill was in (optional)
; IBMNUM = the message # from which this record originally came
; IBAR = 1 only if called from AR
; IBFILE = array reference of raw EOB data
;
N DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS,MMI
F L +^IBM(361.1,0):10 Q:$T
;
; default proper review status
S BS=$P($G(^DGCR(399,X,0)),U,13) ; bill status
S REVSTAT=$S(BS=7:9,BS=3:3,BS=4:3,1:0)
S MMI=$$NET^XMRENT(IBMNUM) ; MailMan header info
S DIC(0)="L",DIC="^IBM(361.1,",DLAYGO=361.1
S DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$S('$G(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"")
S DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)_";62.01////^S X=MMI"
D FILE^DICN
L -^IBM(361.1,0)
Q +Y
;
UPD3611(IBEOB,IBTDA,IBAR) ; From flat file 835 format, add EOB record
; IBEOB = the ien of the entry in file 361.1 being updated
; IBTDA = the ien in the source file
; IBAR = 1 if being called from AR
N HIPAA,IBA1,IBFILE,IBEGBL,Z,IBREC,Q,DASHES
S IBFILE=$S('$G(IBAR):"^IBA(364.2,"_IBTDA_",2)",1:"^TMP("_$J_",""RCDP-EOB"","_IBTDA_")")
S IBEGBL=$S('$G(IBAR):"IBCERR-EOB",1:"RCDPERR-EOB")
S DASHES="---------------------------------------------------------------------"
S HIPAA=0
I $G(IBAR),'$$HDR^IBCEOB1($G(^TMP($J,"RCDPEOB","HDR")),IBEGBL,IBEOB,.HIPAA) Q
S IBA1=0
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
. S IBREC=+IB0
. I IBREC'=37 K ^TMP($J,37)
. ;;;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
. 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)=DASHES
;
; WCJ;IB*2.0*718 v23;additional check for message storage errors since not filed just yet
; check if this is an MRA and was split but not marked as such
; If so we need to change the REVIEW STATUS of this MRA to be ACCEPTED-INTERIM EOB.
; only check this specific one so the second parameter is needed
; set PARTIAL EOB filed is this MRA does not cover all the lines on the claim.
I '$O(^TMP(IBEGBL,$J,0)),$$SPLIT2^IBCEMU1(IBEOB,1)=0 D ; check TMP global since errors aren't filed just yet
. N DA,DIE,DR,DIC
. S DA=IBEOB,DIE=361.1,DR=".16////2;.22////1" D ^DIE
. Q
;
; If a DENIED non MRA EOB with no filing errors is updated, put on the CBW worklist if the
; claim isn't already COLLECTED/CLOSED and there is a subsequent payer (incl. Tricare & ChampVA)
I IBEOB,'$O(^TMP(IBEGBL,$J,0)) D ; check TMP global since errors aren't filed just yet
.N IB361,IBIFN,IBX,IBTXT,IBPYMT
.; must be non-MRA EOB and DENIED
.S IB361=$G(^IBM(361.1,IBEOB,0)),IBIFN=$P(IB361,U)
.Q:$P(IB361,U,4)'=0
.Q:$P(IB361,U,13)'=2
.Q:$P($$ARSTATA^IBJTU4(IBIFN),U)="COLLECTED/CLOSED"
.; payment on this bill from A/R IA#380 OR payer paid amount from EOB
.S IBPYMT=$$TPR^PRCAFN(IBIFN) S:IBPYMT="" IBPYMT=+$G(^IBM(361.1,IBEOB,1))
.; check for subsequent payer
.S IBX=$$EOB^IBCNSBL2($G(IBIFN),+$G(^DGCR(399,IBIFN,"U1")),$G(IBPYMT),.IBTXT) Q:'$D(IBTXT)
.D PUTONWL^IBCAPP($P(IB361,U),"IB804:EOB Claim Status must be PROCESSED")
;
Q
;
ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed
D WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","")
Q
;
;
DUP(IBARRAY,IBIFN) ; Duplicate Check
; This function determines if the EOB data already exists in file
; 361.1 by comparing the checksums of the raw 835 data.
;
; IBARRAY = Literal array reference where the raw 835 data exists.
; The data exists at @IBARRAY@(n,0), where n is the seq#.
; For example, IBARRAY = "^IBA(364.2,IBIEN,2)"
;
; IBIFN = the bill # (ptr to 399). The checksums of the EOB's on
; file for this bill will be compared to the checksum of the
; 835 raw data in the IBARRAY reference.
;
; This function returns 0 if the entry is not found (no duplicate),
; Otherwise, the IEN of the entry in file 361.1 is returned if this
; is a duplicate EOB.
;
NEW DUP,IBEOB,CHKSUM1,CHKSUM2
S DUP=0,IBIFN=+$G(IBIFN)
I $G(IBARRAY)=""!'IBIFN G DUPX
I '$D(^IBM(361.1,"B",IBIFN)) G DUPX ; no EOB's on file yet
S CHKSUM1=$$CHKSUM^IBCEMU1(IBARRAY) ; checksum of current EOB
I 'CHKSUM1 G DUPX ; must be able to be calculated
S IBEOB=0
F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D Q:DUP
. S CHKSUM2=+$P($G(^IBM(361.1,IBEOB,100)),U,5) ; checksum of old EOB
. I 'CHKSUM2 Q
. I CHKSUM1=CHKSUM2 S DUP=IBEOB Q ; comparison
. Q
DUPX ;
Q DUP
;
ERADET(IBEOB,ERADET) ; EP - Update EOB with reference to ERA detail - Subroutine added for IB*2.0*639
; Input: IBEOB - Internal entry number to file 361.1
; ERADET - IENS reference to ERA detail in the format "nnn,nnnnnn,"
; Output: None
;
N FDA
S FDA(361.1,IBEOB_",",104)=ERADET ; DBIA 7017 Allows storage of ERA Detail IENS in file 361.1
D FILE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEOB 13411 printed Apr 09, 2024@21:35:23 Page 2
IBCEOB ;ALB/TMP/PJH - 835 EDI EOB MESSAGE PROCESSING ; 8/19/10 6:33pm
+1 ;;2.0;INTEGRATED BILLING;**137,135,265,155,377,407,431,432,488,639,718**;21-MAR-94;Build 73
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
UPDEOB(IBTDA) ; Update EXPLANATION OF BENEFITS file (#361.1) from return msg
+1 ; IBTDA = ien of return message
+2 ; Function returns ien of EOB file entry or "" if errors found
+3 ; the data. Any errors found are
+4 ; stored in array ^TMP("IBCERR-EOB",$J,n) in text format
+5 ; n = seq # and are stored with the EOB in a wp field
+6 ;
+7 NEW IB0,IB100,IBBTCH,IBE,IBMNUM,IBT,DLAYGO,DIC,DD,DO,X,Y,Z,Z0,Z1,IBEOB,IBBAD,IBOK,IB,IBA1,IBIFN,IBFILE
+8 KILL ^TMP($JOB),^TMP("IBCERR-EOB",$JOB)
+9 ;
+10 SET (IBBAD,IBEOB)=""
+11 SET IB0=$GET(^IBA(364.2,IBTDA,0))
+12 SET IBMNUM=+$PIECE(IB0,U)
+13 SET X=+$GET(^IBA(364,+$PIECE(IB0,U,5),0))
+14 ;
+15 IF IBMNUM=""!(X="")
GOTO UPDQ
+16 ;
+17 ; Duplicate EOB Check
+18 SET IBFILE="^IBA(364.2,"_IBTDA_",2)"
+19 IF $$DUP(IBFILE,X)
DO DELMSG^IBCESRV2(IBTDA)
GOTO UPDQ
+20 ;
+21 ;Lock msg file 364.2
IF '$$LOCK^IBCEM(IBTDA)
GOTO UPDQ
+22 SET IBEOB=+$$ADD3611(IBMNUM,$PIECE(IB0,U,5),$PIECE(IB0,U,4),X,0,IBFILE)
+23 LOCK -^IBA(364.2,IBTDA,0)
+24 ;
+25 IF IBEOB<0
SET IBEOB=""
GOTO UPDQ
+26 DO UPD3611(IBEOB,IBTDA,0)
+27 ;
UPDQ IF IBEOB
IF $ORDER(^TMP("IBCERR-EOB",$JOB,0))
DO ERRUPD(IBEOB,"IBCERR-EOB")
+1 ;
+2 KILL ^TMP($JOB),^TMP("IBCERR-EOB",$JOB)
+3 DO CLEAN^DILF
+4 QUIT +IBEOB
+5 ;
+6 ;
+7 ; NOTE: **** For all variables IB0,IBEGBL,IBEOB below:
+8 ; IB0 = raw data received for this record type on the 835 flat file
+9 ; IBEGBL = subscript to use in error global
+10 ; IBEOB = ien in file 361.1 for this EOB
+11 ;
835(IB0,IBEGBL,IBEOB) ; Store header
+1 ;
+2 QUIT $$HDR^IBCEOB1(IB0,IBEGBL,IBEOB,.HIPAA)
+3 ;
5(IB0,IBEGBL,IBEOB) ; Record '05'
+1 ;
+2 NEW IBOK,DA,DR,DIE,X,Y
+3 KILL IBZDATA
+4 SET DR=";"
SET IBOK=1
+5 SET DIE="^IBM(361.1,"
SET DA=IBEOB
+6 ;
+7 ; statement start date
IF $PIECE(IB0,U,9)
SET DR=DR_"1.1///"_$$DATE^IBCEU($PIECE(IB0,U,9))_";"
+8 ; statement end date
IF $PIECE(IB0,U,10)
SET DR=DR_"1.11///"_$$DATE^IBCEU($PIECE(IB0,U,10))_";"
+9 ; claim received date
IF $PIECE(IB0,U,11)
SET DR=DR_"1.12///"_$$DATE^IBCEU($PIECE(IB0,U,11))_";"
+10 SET DR=$PIECE(DR,";",2,$LENGTH(DR,";")-1)
+11 IF DR'=""
DO ^DIE
SET IBOK=$DATA(Y)=0
+12 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad record 5 data"
+13 QUIT IBOK
+14 ;
6(IB0,IBEGBL,IBEOB) ; Record '06' - corrected patient name and/or ID#
+1 ; 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
+2 ; not interrupt the filing process of the EOB/MRA data into file 361.1.
+3 ;
+4 ; perform overall integrity checks on the incoming 06 record. If anything is out of place, don't update anything
+5 ; and report the problem and get out.
+6 NEW CLM,SITE,IBM,IBIFN,IBIFN1,DFN,SEQ,DIE,DA,DR
+7 ; archive the raw 06 record data
SET DIE=361.1
SET DA=IBEOB
SET DR="61.01////^S X=IB0"
DO ^DIE
+8 SET CLM=$PIECE(IB0,U,2)
SET SITE=+CLM
SET CLM=$PIECE(CLM,"-",2)
IF CLM=""
DO MSG(IBEOB,"The claim# in piece 2 is invalid.")
GOTO Q6
+9 SET IBM=$GET(^IBM(361.1,IBEOB,0))
+10 IF $PIECE(IBM,U,4)'=1
DO MSG(IBEOB,"This is a non-Medicare EOB.")
GOTO Q6
+11 ; claim# from MRA
SET IBIFN=+$PIECE(IBM,U,1)
+12 ; claim# from 06 record
SET IBIFN1=+$ORDER(^DGCR(399,"B",CLM,""))
+13 IF IBIFN'=IBIFN1
DO MSG(IBEOB,"Claim mismatch error."_IBIFN_","_IBIFN1_","_CLM_".")
GOTO Q6
+14 IF $PIECE($$SITE^VASITE,U,3)'=SITE
DO MSG(IBEOB,"Invalid station# mismatch."_$PIECE($$SITE^VASITE,U,3)_","_SITE_".")
GOTO Q6
+15 ; current payer sequence# on claim
SET SEQ=$$COBN^IBCEF(IBIFN)
+16 IF '$$WNRBILL^IBEFUNC(IBIFN,SEQ)
DO MSG(IBEOB,"The current payer on this claim is not MEDICARE (WNR).")
GOTO Q6
+17 ; patient ien
SET DFN=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
+18 IF 'DFN
DO MSG(IBEOB,"The patient DFN cannot be determined.")
GOTO Q6
+19 ;
+20 ; update patient insurance policy data
DO UPD^IBCEOB01(IB0,IBEOB,IBIFN,DFN,SEQ)
+21 ;
Q6 ; exit point for $$6 function
+1 QUIT 1
+2 ;
10(IB0,IBEGBL,IBEOB) ; Record '10'
+1 ;
+2 NEW DA,DR,DIE,X,Y,VAL,IBOK,IB361
+3 SET DIE="^IBM(361.1,"
SET DA=IBEOB
+4 ; put denied non-MRA claims on the worklist IB*2.0*432
+5 ;S IB361=$G(^IBM(361.1,DA,0))
+6 ;I $P(IB361,U,4)=0,$P(IB0,U,4)="Y" D PUTONWL^IBCAPP($P(IB361,U),"IB804:EOB Claim Status must be PROCESSED")
+7 SET DR=".13////"_$SELECT($PIECE(IB0,U,3)="Y":1,$PIECE(IB0,U,4)="Y":2,$PIECE(IB0,U,5)="Y":3,$PIECE(IB0,U,6)="Y":4,1:5)_";.21////"_$PIECE(IB0,U,7)
+8 SET DR=DR_";2.04////"_$$DOLLAR($PIECE(IB0,U,10))_";1.01////"_$$DOLLAR($PIECE(IB0,U,11))_$SELECT($PIECE(IB0,U,12)'="":";.14///"_$PIECE(IB0,U,12),1:"")
+9 SET DR=DR_$SELECT($PIECE(IB0,U,13)'="":";.1///"_$PIECE(IB0,U,13),1:"")_";.11///"_($PIECE(IB0,U,14)/10000)_";.12///"_($PIECE(IB0,U,15)/100)
+10 IF $PIECE(IB0,U,8)'=""
SET DR=DR_";.08////"_$PIECE(IB0,U,8)_$SELECT($PIECE(IB0,U,9)'="":";.09///"_$PIECE(IB0,U,9),1:"")
+11 ; coverage exp. date
IF HIPAA
IF $PIECE(IB0,U,16)
SET DR=DR_";1.13///"_$$DATE^IBCEU($PIECE(IB0,U,16))_";"
+12 ;
+13 DO ^DIE
+14 SET IBOK=($DATA(Y)=0)
+15 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad record 10 data"
GOTO Q10
+16 ;
+17 ; File ICN in Bill
+18 DO ICN^IBCEOB00(IBEOB,$PIECE(IB0,U,12),$PIECE($GET(^IBM(361.1,IBEOB,0)),U,15),.IBOK)
+19 ;
Q10 QUIT IBOK
+1 ;
12(IB0,IBEGL,IBEOB) ; Record '12'
+1 ;
+2 NEW DA,DR,DIE,X,Y,VAL,IBOK
+3 IF HIPAA'=5010
SET IBOK=1
GOTO Q12
+4 SET DIE="^IBM(361.1,"
SET DA=IBEOB
SET DR=";"
+5 IF $PIECE(IB0,U,3)'=""
SET DR=DR_"1.14////"_$PIECE(IB0,U,3)_";"
+6 IF $PIECE(IB0,U,4)'=""
SET DR=DR_"1.15////"_$PIECE(IB0,U,4)_";"
+7 IF $PIECE(IB0,U,5)'=""
SET DR=DR_"1.16////"_$PIECE(IB0,U,5)_";"
+8 SET DR=$PIECE(DR,";",2,$LENGTH(DR,";")-1)
+9 ;
+10 DO ^DIE
+11 SET IBOK=($DATA(Y)=0)
+12 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad record 12 data"
+13 ;
Q12 QUIT IBOK
+1 ;
13(IB0,IBEGL,IBEOB) ; Record '13'
+1 ;
+2 NEW DA,DR,DIE,X,Y,VAL,IBOK,NAME
+3 IF HIPAA'=5010
SET IBOK=1
GOTO Q13
+4 SET DIE="^IBM(361.1,"
SET DA=IBEOB
+5 SET NAME=$PIECE(IB0,U,3)
IF NAME=""
SET IBOK=1
GOTO Q13
+6 IF $PIECE(IB0,U,4)'=""
SET NAME=NAME_","_$PIECE(IB0,U,4)
+7 IF $PIECE(IB0,U,5)'=""
SET NAME=NAME_","_$PIECE(IB0,U,5)
+8 ; Other Subscriber Name
SET DR="1.17////"_NAME
+9 ;
+10 DO ^DIE
+11 SET IBOK=($DATA(Y)=0)
+12 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad record 13 data"
+13 ;
Q13 QUIT IBOK
+1 ;
15(IB0,IBEGBL,IBEOB) ; Record '15'
+1 ; Moved due to space constraints
Q15 QUIT $$15^IBCEOB00(IB0,IBEGBL,IBEOB)
+1 ;
17(IB0,IBEGBL,IBEOB) ; Record '17'
+1 NEW A,DATA,IBOK
+2 ;Old Format
+3 SET DATA=IB0
+4 ;New Format - store incoming data in first available field
+5 IF HIPAA>0
Begin DoDot:1
+6 NEW CNT
+7 ;Claim Contact Name
SET CNT=4
SET DATA=$PIECE(DATA,U,1,3)
+8 ;Tel
IF $PIECE(IB0,U,4)'=""
SET $PIECE(DATA,U,CNT)=$PIECE(IB0,U,4)
SET $PIECE(DATA,U,CNT+1)="TE"
SET CNT=CNT+2
+9 ;Fax
IF $PIECE(IB0,U,5)'=""
SET $PIECE(DATA,U,CNT)=$PIECE(IB0,U,5)
SET $PIECE(DATA,U,CNT+1)="FX"
SET CNT=CNT+2
+10 ;email
IF $PIECE(IB0,U,6)'=""
SET $PIECE(DATA,U,CNT)=$PIECE(IB0,U,6)
SET $PIECE(DATA,U,CNT+1)="EM"
End DoDot:1
+11 ;
+12 SET 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"
+13 SET IBOK=$$STORE^IBCEOB1(A,DATA,IBEOB)
+14 IF 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)="Bad record 17 data"
Q17 QUIT IBOK
+1 ;
20(IB0,IBEGBL,IBEOB) ; Record '20'
+1 ; Moved due to space constraints
Q20 QUIT $$20^IBCEOB00(IB0,IBEGBL,IBEOB)
+1 ;
30(IB0,IBEGBL,IBEOB) ; Record '30'
+1 ;
+2 NEW IBOK
+3 DO 30^IBCEOB0(IB0,IBEOB,.IBOK)
Q30 QUIT $GET(IBOK)
+1 ;
35(IB0,IBEGBL,IBEOB) ; Record '35'
+1 ; Moved due to space constraints
Q35 QUIT $$35^IBCEOB00(IB0,IBEGBL,IBEOB)
+1 ;
37(IB0,IBEGBL,IBEOB) ; Record '37'
+1 ; Moved due to space constraints
Q37 QUIT $$37^IBCEOB00(IB0,IBEGBL,IBEOB)
+1 ;
40(IB0,IBEGBL,IBEOB) ; Record '40'
+1 ;
+2 NEW IBOK
+3 DO 40^IBCEOB0(IB0,IBEOB,.IBOK)
Q40 QUIT $GET(IBOK)
+1 ;
41(IB0,IBEGBL,IBEOB) ; Record '41'
+1 ;
+2 NEW IBOK
+3 DO 41^IBCEOB0(IB0,IBEOB,.IBOK)
Q41 QUIT $GET(IBOK)
+1 ;
42(IB0,IBEGBL,IBEOB) ; Record '42'
+1 ;
+2 NEW IBOK
+3 DO 42^IBCEOB0(IB0,IBEOB,.IBOK)
Q42 QUIT $GET(IBOK)
+1 ;
45(IB0,IBEGBL,IBEOB) ; Record '45'
+1 ;
+2 NEW IBOK
+3 DO 45^IBCEOB0(IB0,IBEOB,.IBOK)
+4 QUIT $GET(IBOK)
+5 ;
+6 ;
46(IB0,IBEGBL,IBEOB) ; Record '46'
+1 ;
+2 NEW IBOK
+3 IF HIPAA'=5010
SET IBOK=1
GOTO Q46
+4 DO 46^IBCEOB0(IB0,IBEOB,.IBOK)
Q46 QUIT $GET(IBOK)
+1 ;
MSG(IBEOB,MSG) ; procedure to file message into field 6.03
+1 ; Results of processing of the "06" record type
+2 NEW DIE,DA,DR,Z
+3 SET DIE=361.1
SET DA=+$GET(IBEOB)
+4 IF $GET(MSG)=""
GOTO MSGX
+5 ; already existing message
SET Z=$PIECE($GET(^IBM(361.1,DA,6)),U,3)
+6 ; append new message to existing message
IF Z'=""
SET MSG=Z_" "_MSG
+7 SET MSG=$EXTRACT(MSG,1,190)
+8 SET DR="6.03///^S X=MSG"
+9 DO ^DIE
MSGX ;
+1 QUIT
+2 ;
DOLLAR(X) ; Convert value in X to dollar format XXX.XX
+1 QUIT $SELECT(+X:$JUSTIFY(X/100,$LENGTH(+X),2),1:0)
+2 ;
ADD3611(IBMNUM,IBTBILL,IBBATCH,X,IBAR,IBFILE) ; Add stub record to file 361.1
+1 ; X = the ien of the referenced bill in file 399
+2 ; IBTBILL = ien of transmitted bill (optional)
+3 ; IBBATCH = ien of batch # the transmitted bill was in (optional)
+4 ; IBMNUM = the message # from which this record originally came
+5 ; IBAR = 1 only if called from AR
+6 ; IBFILE = array reference of raw EOB data
+7 ;
+8 NEW DIC,DA,DR,DO,DD,DLAYGO,Y,REVSTAT,BS,MMI
+9 FOR
LOCK +^IBM(361.1,0):10
if $TEST
QUIT
+10 ;
+11 ; default proper review status
+12 ; bill status
SET BS=$PIECE($GET(^DGCR(399,X,0)),U,13)
+13 SET REVSTAT=$SELECT(BS=7:9,BS=3:3,BS=4:3,1:0)
+14 ; MailMan header info
SET MMI=$$NET^XMRENT(IBMNUM)
+15 SET DIC(0)="L"
SET DIC="^IBM(361.1,"
SET DLAYGO=361.1
+16 SET DIC("DR")=".16////"_REVSTAT_";.17////0"_";100.02////"_IBMNUM_$SELECT('$GET(IBAR):";.19////"_+IBTBILL_";100.01////"_IBBATCH,1:"")
+17 SET DIC("DR")=DIC("DR")_";100.05////"_$$CHKSUM^IBCEMU1(IBFILE)_";62.01////^S X=MMI"
+18 DO FILE^DICN
+19 LOCK -^IBM(361.1,0)
+20 QUIT +Y
+21 ;
UPD3611(IBEOB,IBTDA,IBAR) ; From flat file 835 format, add EOB record
+1 ; IBEOB = the ien of the entry in file 361.1 being updated
+2 ; IBTDA = the ien in the source file
+3 ; IBAR = 1 if being called from AR
+4 NEW HIPAA,IBA1,IBFILE,IBEGBL,Z,IBREC,Q,DASHES
+5 SET IBFILE=$SELECT('$GET(IBAR):"^IBA(364.2,"_IBTDA_",2)",1:"^TMP("_$JOB_",""RCDP-EOB"","_IBTDA_")")
+6 SET IBEGBL=$SELECT('$GET(IBAR):"IBCERR-EOB",1:"RCDPERR-EOB")
+7 SET DASHES="---------------------------------------------------------------------"
+8 SET HIPAA=0
+9 IF $GET(IBAR)
IF '$$HDR^IBCEOB1($GET(^TMP($JOB,"RCDPEOB","HDR")),IBEGBL,IBEOB,.HIPAA)
QUIT
+10 SET IBA1=0
+11 FOR
SET IBA1=$ORDER(@IBFILE@(IBA1))
if 'IBA1
QUIT
SET IB0=$SELECT('$GET(IBAR):$PIECE($GET(^(IBA1,0)),"##RAW DATA: ",2),1:$GET(@IBFILE@(IBA1,0)))
IF IB0'=""
Begin DoDot:1
+12 SET IBREC=+IB0
+13 IF IBREC'=37
KILL ^TMP($JOB,37)
+14 ;;;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
+15 IF IBREC
SET IB="S IBOK=$$"_IBREC_"(IB0,IBEGBL,IBEOB)"
SET Q=IBREC_"^IBCEOB"
IF $TEXT(@Q)'=""
XECUTE IB
if 'IBOK
SET ^TMP(IBEGBL,$JOB,+$ORDER(^TMP(IBEGBL,$JOB,""),-1)+1)=DASHES
End DoDot:1
+16 ;
+17 ; WCJ;IB*2.0*718 v23;additional check for message storage errors since not filed just yet
+18 ; check if this is an MRA and was split but not marked as such
+19 ; If so we need to change the REVIEW STATUS of this MRA to be ACCEPTED-INTERIM EOB.
+20 ; only check this specific one so the second parameter is needed
+21 ; set PARTIAL EOB filed is this MRA does not cover all the lines on the claim.
+22 ; check TMP global since errors aren't filed just yet
IF '$ORDER(^TMP(IBEGBL,$JOB,0))
IF $$SPLIT2^IBCEMU1(IBEOB,1)=0
Begin DoDot:1
+23 NEW DA,DIE,DR,DIC
+24 SET DA=IBEOB
SET DIE=361.1
SET DR=".16////2;.22////1"
DO ^DIE
+25 QUIT
End DoDot:1
+26 ;
+27 ; If a DENIED non MRA EOB with no filing errors is updated, put on the CBW worklist if the
+28 ; claim isn't already COLLECTED/CLOSED and there is a subsequent payer (incl. Tricare & ChampVA)
+29 ; check TMP global since errors aren't filed just yet
IF IBEOB
IF '$ORDER(^TMP(IBEGBL,$JOB,0))
Begin DoDot:1
+30 NEW IB361,IBIFN,IBX,IBTXT,IBPYMT
+31 ; must be non-MRA EOB and DENIED
+32 SET IB361=$GET(^IBM(361.1,IBEOB,0))
SET IBIFN=$PIECE(IB361,U)
+33 if $PIECE(IB361,U,4)'=0
QUIT
+34 if $PIECE(IB361,U,13)'=2
QUIT
+35 if $PIECE($$ARSTATA^IBJTU4(IBIFN),U)="COLLECTED/CLOSED"
QUIT
+36 ; payment on this bill from A/R IA#380 OR payer paid amount from EOB
+37 SET IBPYMT=$$TPR^PRCAFN(IBIFN)
if IBPYMT=""
SET IBPYMT=+$GET(^IBM(361.1,IBEOB,1))
+38 ; check for subsequent payer
+39 SET IBX=$$EOB^IBCNSBL2($GET(IBIFN),+$GET(^DGCR(399,IBIFN,"U1")),$GET(IBPYMT),.IBTXT)
if '$DATA(IBTXT)
QUIT
+40 DO PUTONWL^IBCAPP($PIECE(IB361,U),"IB804:EOB Claim Status must be PROCESSED")
End DoDot:1
+41 ;
+42 QUIT
+43 ;
ERRUPD(IBEOB,IBEGBL) ; Update error text in entry, if needed
+1 DO WP^DIE(361.1,IBEOB_",",20,"","^TMP(IBEGBL,$J)","")
+2 QUIT
+3 ;
+4 ;
DUP(IBARRAY,IBIFN) ; Duplicate Check
+1 ; This function determines if the EOB data already exists in file
+2 ; 361.1 by comparing the checksums of the raw 835 data.
+3 ;
+4 ; IBARRAY = Literal array reference where the raw 835 data exists.
+5 ; The data exists at @IBARRAY@(n,0), where n is the seq#.
+6 ; For example, IBARRAY = "^IBA(364.2,IBIEN,2)"
+7 ;
+8 ; IBIFN = the bill # (ptr to 399). The checksums of the EOB's on
+9 ; file for this bill will be compared to the checksum of the
+10 ; 835 raw data in the IBARRAY reference.
+11 ;
+12 ; This function returns 0 if the entry is not found (no duplicate),
+13 ; Otherwise, the IEN of the entry in file 361.1 is returned if this
+14 ; is a duplicate EOB.
+15 ;
+16 NEW DUP,IBEOB,CHKSUM1,CHKSUM2
+17 SET DUP=0
SET IBIFN=+$GET(IBIFN)
+18 IF $GET(IBARRAY)=""!'IBIFN
GOTO DUPX
+19 ; no EOB's on file yet
IF '$DATA(^IBM(361.1,"B",IBIFN))
GOTO DUPX
+20 ; checksum of current EOB
SET CHKSUM1=$$CHKSUM^IBCEMU1(IBARRAY)
+21 ; must be able to be calculated
IF 'CHKSUM1
GOTO DUPX
+22 SET IBEOB=0
+23 FOR
SET IBEOB=$ORDER(^IBM(361.1,"B",IBIFN,IBEOB))
if 'IBEOB
QUIT
Begin DoDot:1
+24 ; checksum of old EOB
SET CHKSUM2=+$PIECE($GET(^IBM(361.1,IBEOB,100)),U,5)
+25 IF 'CHKSUM2
QUIT
+26 ; comparison
IF CHKSUM1=CHKSUM2
SET DUP=IBEOB
QUIT
+27 QUIT
End DoDot:1
if DUP
QUIT
DUPX ;
+1 QUIT DUP
+2 ;
ERADET(IBEOB,ERADET) ; EP - Update EOB with reference to ERA detail - Subroutine added for IB*2.0*639
+1 ; Input: IBEOB - Internal entry number to file 361.1
+2 ; ERADET - IENS reference to ERA detail in the format "nnn,nnnnnn,"
+3 ; Output: None
+4 ;
+5 NEW FDA
+6 ; DBIA 7017 Allows storage of ERA Detail IENS in file 361.1
SET FDA(361.1,IBEOB_",",104)=ERADET
+7 DO FILE^DIE("","FDA")
+8 QUIT
