Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEOB

IBCEOB.m

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