IBCEMU4 ;ALB/ESG - MRA UTILITIES ;25-OCT-2004
;;2.0;INTEGRATED BILLING;**288,432,447,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
DENDUP(IBEOB,IBMRANOT) ; Denied for Duplicate Function ;WCJ IB*2.0*432
; Function returns true if MRA is Denied AND Reason code 18 is present (Duplicate claim/service)
NEW IBX,IBM,LINE,DUP,ADJ
S IBX=0,IBM=$G(^IBM(361.1,+$G(IBEOB),0))
I '$G(IBMRANOT),$P(IBM,U,4)'=1 G DENDUPX ; not an MRA ;WCJ IB*2.0*432
I $G(IBMRANOT),$P(IBM,U,4)'=0 G DENDUPX ; not an EOB ;WCJ IB*2.0*432
I $P(IBM,U,13)'=2 G DENDUPX ; not Denied
;
; check line item adjustments for reason code 18
S LINE=0,DUP=0
F S LINE=$O(^IBM(361.1,IBEOB,15,LINE)) Q:'LINE D Q:DUP
. S ADJ=0
. F S ADJ=$O(^IBM(361.1,IBEOB,15,LINE,1,ADJ)) Q:'ADJ D Q:DUP
.. I $D(^IBM(361.1,IBEOB,15,LINE,1,ADJ,1,"B",18)) S DUP=1 Q
.. Q
. Q
;
I DUP S IBX=1
DENDUPX ;
Q IBX
;
; the remaining functions are all new w/ IB*2.0*447 and have to do with calculating
; different amounts based on percentages stored in the effective date multiple of
; the TYPE OF PLAN file (#355.1) for Medicare Supplemental plans
;
MSPRE(IBIFN,IBEXF,IBTYPLAN) ; Medicare supplemental PR and Excess calculations
; determine PR amount in order to calculate balance due after medicare for secondary/tertiary
; if type of plan is a Medicare supplemental or EGHP plan secondary to Medicare, PR
; calculations are determined based on the effective date multiple in the TYPE OF PLAN file
; and may or may not included Excess charges (CO-45), based on Plan Type.
; need to pass in:
; IBIFN (REQUIRED) = claim ien
; IBEXF = Excess Flag, set to 1 if NOT to include excess charges in calculation but to
; return "e" (IBE) for excess indicator if plan allows excess and there are
; excess charges. Used by PR column of MRW screen to show PR without excess
; amounts included in calculation.
; IBTYPLAN = ien in TYPE OF PLAN file (355.1)
; returns "" if no effective date for type of plan to calculate on
;
N IBFRMTYP,IBPNCAT,IBINPAT,IBMGBD,IBEOB,LNLVL,EOBADJ,IBPCE,IBEDT,IBE,IBTOT
Q:$G(IBIFN)="" ""
S:$G(IBTYPLAN)="" IBTYPLAN=$$TYPLN(IBIFN)
S IBEDT=$$MSEDT(IBIFN,IBTYPLAN) Q:IBEDT="" ""
S IBINPAT=$$INPAT^IBCEF(IBIFN) ;Inpat/Outpat Flag
S IBFRMTYP=$P($G(^DGCR(399,IBIFN,0)),U,19) ; Form Type 2=1500, 3=UB, 7=J430D ;JRA IB*2.0*592 Add Dental form 7
; plan category - PART A is Inpatient Institutional, B is all Outpatient and Inpatient Professional
S IBPNCAT="B"
I IBINPAT=1,IBFRMTYP=3 S IBPNCAT="A" Q:IBPNCAT="" ""
; Medicare supplemental plan Offset amount = total charges - what medicare secondary plan will pay
; so balance due = whatever medicare secondary will pay
;
; plan category - PART A =1st piece of AEDT Index, B =2nd
S IBPCE=$S(IBPNCAT="B":2,1:1)
S IBMGBD=0,IBEOB=0
F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D
.N I
.F I=0,1,2 S IBEOB(I)=$G(^IBM(361.1,IBEOB,I))
.I $P(IBEOB(0),U,4)'=1 Q ;make sure it's an MRA
.;
.; Handle CMS-1500 Form Type and UB Outpatient:
.;JRA IB*2.0*592 Do the same for Dental J430D as for CMS-1500
.;I IBFRMTYP=2!('IBINPAT) D Q ;JRA IB*2.0*592 ';'
.I IBFRMTYP=2!(IBFRMTYP=7!('IBINPAT)) D Q ;JRA IB*2.0*592
..; calculate Medicare unpaid amount from line-level (outpatient)
..S LNLVL=0 F S LNLVL=$O(^IBM(361.1,IBEOB,15,LNLVL)) Q:'LNLVL D ;
...K EOBADJ
...M EOBADJ=^IBM(361.1,IBEOB,15,LNLVL,1)
...; Total up the Medicare Contract Adjustment across ALL Service Lines to find
...; Medicare supplemental Balance Due
...S IBTOT=$$CALC(.EOBADJ,IBTYPLAN,IBPCE,IBEDT,$G(IBEXF)),IBE=$P(IBTOT,U,2)
...S IBMGBD=$G(IBMGBD)+$P(IBTOT,U)
.;
.; Handle Inpatient UB Form Type Next: Calculate from Claim level data
.K EOBADJ
.M EOBADJ=^IBM(361.1,IBEOB,10)
.S IBTOT=$$CALC(.EOBADJ,IBTYPLAN,IBPCE,IBEDT,$G(IBEXF)),IBE=$P(IBTOT,U,2)
.S IBMGBD=$G(IBMGBD)+$P(IBTOT,U)
Q IBMGBD_$G(IBE)
;
CALC(EOBADJ,IBTYPLAN,IBPCE,IBEDT,IBEXF) ; FUNCTION - Calculate Medicare Supplemental Balance due
; Sums up Amounts on ALL Reason Codes under ALL Group Codes = 'PR' and CO/Reason code=45.
; If those reason codes have an entry in the effective date mutliple, multiples that
; reason amount by the % the Type of plan will pay. If no entry, assume 100% payment for PR.
; any other Group and reason codes would be 0%.
; Adds up all those sums and returns that value as the total PR&CO the Medicare
; Supplemental plan will pay.
;
; Input EOBADJ = Array of Group Codes & Reason Codes from either the Claim
; Level (10) or Service Line Level (15) of EOB file (#361.1)
; IBTYPLAN = ien in TYPE OF PLAN file
; IBPCE = 2 for PART A, 3 for PART B - REQUIRED
; IBEDT = effective date of plan rates
; IBEXF = Excess Flag, set to 1 if NOT to include excess charges in calculation but to
; return "e" for excess indicator if plan allows excess and there are excess
; charges. Used by PR column of MRW screen to show PR without excess
; amounts included in calculation.
; Output amount that Medicare supplemental plan will pay
;
N GRPLVL,RSNLVL,RSNAMT,MCA,GRPCD,RSNCD,RSN0,CALC,IBIND
Q:$G(IBPCE)="" ""
S:$G(IBTYPLAN)="" IBTYPLAN=$$TYPLN(IBIFN)
I $G(IBEDT)="" S IBEDT=$$MSEDT(IBIFN,IBTYPLAN) Q:IBEDT="" ""
S (GRPLVL,MCA)=0
F S GRPLVL=$O(EOBADJ(GRPLVL)) Q:'GRPLVL D
.S GRPCD=$P($G(EOBADJ(GRPLVL,0)),U)
.; For now they want to calculate all PR but only apply %age calcs to PR-1,2 & 3
.I GRPCD'="PR" Q:'$D(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD))
.S RSNLVL=0
.F S RSNLVL=$O(EOBADJ(GRPLVL,1,RSNLVL)) Q:'RSNLVL D ;
..S RSN0=$G(EOBADJ(GRPLVL,1,RSNLVL,0)),RSNAMT=$P(RSN0,U,2),RSNCD=$P(RSN0,U)
..I GRPCD="PR",RSNCD="AAA" Q ; ignore PR-AAA
..; For now they want to calculate all PR but only apply %age calcs to PR-1,2 & 3
..I GRPCD="PR","1^2^3"'[RSNCD,'$D(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)) S MCA=MCA+RSNAMT Q
..Q:'$D(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD))
..; if there is an entry in the effective date multiple for this grp/rsn code use it to calculate amount for PART A and B.
..; for MRW, don't add up excess charges if IBEXF=1, just send back an "e" indicator to alert user of excess
..I $G(IBEXF)=1,GRPCD="CO",RSNCD=45,$P($G(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)),U,IBPCE)>0 S IBIND="e" Q
..S CALC=$P($G(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)),U,IBPCE)/100
..S MCA=MCA+(RSNAMT*CALC)
Q MCA_U_$G(IBIND)
;
MSEDT(IBIFN,IBTYPLAN) ; does this claim's TYPE OF PLAN have an effective date multiple on or before the
; claim 'statement covers from' date
; IBIFN = claim ien - REQUIRED
; IBTYPLAN = Type of Plan ien
; returns eff.date calculation multiple to use or null
; called from SKIP^IBCCCB, BLD^IBCECOB1, TOT^IBCECOB2, CRIT^IBCEMQC, & SECOND^IBCEMSR
;
; IB*2.0*447: the below quit statement has been added because CBO has decided not to implement
; these changes with patch 447 after all. Once a long-term maintenance plan for the plan type
; calculations can be worked out and CBO is ready to implement the special calculations, the
; below quit statement and these comments should be removed and the type of plan special calculations
; will immediately take effect. For now, returning a null will allow existing code to bypass
; the special calculation table in file 355.1 and calculate everything as 100% of Patient Responsibility (PR).
Q ""
;
N IBSVDT
Q:$G(IBIFN)="" ""
S:$G(IBTYPLAN)="" IBTYPLAN=+$$TYPLN(IBIFN)
S IBSVDT=+$P($G(^DGCR(399,IBIFN,"U")),U)
Q:$D(^IBE(355.1,IBTYPLAN,14,"B",IBSVDT)) IBSVDT
Q $O(^IBE(355.1,IBTYPLAN,14,"B",IBSVDT),-1)
;
TYPLN(IBIFN) ; find type of plan for claim
; IBIFN = claim ien - REQUIRED
; returns ien from file 355.1 or null if none found
;
Q:$G(IBIFN)="" ""
N IBCOBN,IBGRPNO
S IBCOBN=$$COBN^IBCEF(IBIFN)+1 ;find next payer
S IBGRPNO=+$P($G(^DGCR(399,IBIFN,"I"_IBCOBN)),U,18) ; group plan number
Q $P($G(^IBA(355.3,IBGRPNO,0)),U,9) ; type of plan - IEN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMU4 8151 printed Jun 11, 2024@21:56:09 Page 2
IBCEMU4 ;ALB/ESG - MRA UTILITIES ;25-OCT-2004
+1 ;;2.0;INTEGRATED BILLING;**288,432,447,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
DENDUP(IBEOB,IBMRANOT) ; Denied for Duplicate Function ;WCJ IB*2.0*432
+1 ; Function returns true if MRA is Denied AND Reason code 18 is present (Duplicate claim/service)
+2 NEW IBX,IBM,LINE,DUP,ADJ
+3 SET IBX=0
SET IBM=$GET(^IBM(361.1,+$GET(IBEOB),0))
+4 ; not an MRA ;WCJ IB*2.0*432
IF '$GET(IBMRANOT)
IF $PIECE(IBM,U,4)'=1
GOTO DENDUPX
+5 ; not an EOB ;WCJ IB*2.0*432
IF $GET(IBMRANOT)
IF $PIECE(IBM,U,4)'=0
GOTO DENDUPX
+6 ; not Denied
IF $PIECE(IBM,U,13)'=2
GOTO DENDUPX
+7 ;
+8 ; check line item adjustments for reason code 18
+9 SET LINE=0
SET DUP=0
+10 FOR
SET LINE=$ORDER(^IBM(361.1,IBEOB,15,LINE))
if 'LINE
QUIT
Begin DoDot:1
+11 SET ADJ=0
+12 FOR
SET ADJ=$ORDER(^IBM(361.1,IBEOB,15,LINE,1,ADJ))
if 'ADJ
QUIT
Begin DoDot:2
+13 IF $DATA(^IBM(361.1,IBEOB,15,LINE,1,ADJ,1,"B",18))
SET DUP=1
QUIT
+14 QUIT
End DoDot:2
if DUP
QUIT
+15 QUIT
End DoDot:1
if DUP
QUIT
+16 ;
+17 IF DUP
SET IBX=1
DENDUPX ;
+1 QUIT IBX
+2 ;
+3 ; the remaining functions are all new w/ IB*2.0*447 and have to do with calculating
+4 ; different amounts based on percentages stored in the effective date multiple of
+5 ; the TYPE OF PLAN file (#355.1) for Medicare Supplemental plans
+6 ;
MSPRE(IBIFN,IBEXF,IBTYPLAN) ; Medicare supplemental PR and Excess calculations
+1 ; determine PR amount in order to calculate balance due after medicare for secondary/tertiary
+2 ; if type of plan is a Medicare supplemental or EGHP plan secondary to Medicare, PR
+3 ; calculations are determined based on the effective date multiple in the TYPE OF PLAN file
+4 ; and may or may not included Excess charges (CO-45), based on Plan Type.
+5 ; need to pass in:
+6 ; IBIFN (REQUIRED) = claim ien
+7 ; IBEXF = Excess Flag, set to 1 if NOT to include excess charges in calculation but to
+8 ; return "e" (IBE) for excess indicator if plan allows excess and there are
+9 ; excess charges. Used by PR column of MRW screen to show PR without excess
+10 ; amounts included in calculation.
+11 ; IBTYPLAN = ien in TYPE OF PLAN file (355.1)
+12 ; returns "" if no effective date for type of plan to calculate on
+13 ;
+14 NEW IBFRMTYP,IBPNCAT,IBINPAT,IBMGBD,IBEOB,LNLVL,EOBADJ,IBPCE,IBEDT,IBE,IBTOT
+15 if $GET(IBIFN)=""
QUIT ""
+16 if $GET(IBTYPLAN)=""
SET IBTYPLAN=$$TYPLN(IBIFN)
+17 SET IBEDT=$$MSEDT(IBIFN,IBTYPLAN)
if IBEDT=""
QUIT ""
+18 ;Inpat/Outpat Flag
SET IBINPAT=$$INPAT^IBCEF(IBIFN)
+19 ; Form Type 2=1500, 3=UB, 7=J430D ;JRA IB*2.0*592 Add Dental form 7
SET IBFRMTYP=$PIECE($GET(^DGCR(399,IBIFN,0)),U,19)
+20 ; plan category - PART A is Inpatient Institutional, B is all Outpatient and Inpatient Professional
+21 SET IBPNCAT="B"
+22 IF IBINPAT=1
IF IBFRMTYP=3
SET IBPNCAT="A"
if IBPNCAT=""
QUIT ""
+23 ; Medicare supplemental plan Offset amount = total charges - what medicare secondary plan will pay
+24 ; so balance due = whatever medicare secondary will pay
+25 ;
+26 ; plan category - PART A =1st piece of AEDT Index, B =2nd
+27 SET IBPCE=$SELECT(IBPNCAT="B":2,1:1)
+28 SET IBMGBD=0
SET IBEOB=0
+29 FOR
SET IBEOB=$ORDER(^IBM(361.1,"B",IBIFN,IBEOB))
if 'IBEOB
QUIT
Begin DoDot:1
+30 NEW I
+31 FOR I=0,1,2
SET IBEOB(I)=$GET(^IBM(361.1,IBEOB,I))
+32 ;make sure it's an MRA
IF $PIECE(IBEOB(0),U,4)'=1
QUIT
+33 ;
+34 ; Handle CMS-1500 Form Type and UB Outpatient:
+35 ;JRA IB*2.0*592 Do the same for Dental J430D as for CMS-1500
+36 ;I IBFRMTYP=2!('IBINPAT) D Q ;JRA IB*2.0*592 ';'
+37 ;JRA IB*2.0*592
IF IBFRMTYP=2!(IBFRMTYP=7!('IBINPAT))
Begin DoDot:2
+38 ; calculate Medicare unpaid amount from line-level (outpatient)
+39 ;
SET LNLVL=0
FOR
SET LNLVL=$ORDER(^IBM(361.1,IBEOB,15,LNLVL))
if 'LNLVL
QUIT
Begin DoDot:3
+40 KILL EOBADJ
+41 MERGE EOBADJ=^IBM(361.1,IBEOB,15,LNLVL,1)
+42 ; Total up the Medicare Contract Adjustment across ALL Service Lines to find
+43 ; Medicare supplemental Balance Due
+44 SET IBTOT=$$CALC(.EOBADJ,IBTYPLAN,IBPCE,IBEDT,$GET(IBEXF))
SET IBE=$PIECE(IBTOT,U,2)
+45 SET IBMGBD=$GET(IBMGBD)+$PIECE(IBTOT,U)
End DoDot:3
End DoDot:2
QUIT
+46 ;
+47 ; Handle Inpatient UB Form Type Next: Calculate from Claim level data
+48 KILL EOBADJ
+49 MERGE EOBADJ=^IBM(361.1,IBEOB,10)
+50 SET IBTOT=$$CALC(.EOBADJ,IBTYPLAN,IBPCE,IBEDT,$GET(IBEXF))
SET IBE=$PIECE(IBTOT,U,2)
+51 SET IBMGBD=$GET(IBMGBD)+$PIECE(IBTOT,U)
End DoDot:1
+52 QUIT IBMGBD_$GET(IBE)
+53 ;
CALC(EOBADJ,IBTYPLAN,IBPCE,IBEDT,IBEXF) ; FUNCTION - Calculate Medicare Supplemental Balance due
+1 ; Sums up Amounts on ALL Reason Codes under ALL Group Codes = 'PR' and CO/Reason code=45.
+2 ; If those reason codes have an entry in the effective date mutliple, multiples that
+3 ; reason amount by the % the Type of plan will pay. If no entry, assume 100% payment for PR.
+4 ; any other Group and reason codes would be 0%.
+5 ; Adds up all those sums and returns that value as the total PR&CO the Medicare
+6 ; Supplemental plan will pay.
+7 ;
+8 ; Input EOBADJ = Array of Group Codes & Reason Codes from either the Claim
+9 ; Level (10) or Service Line Level (15) of EOB file (#361.1)
+10 ; IBTYPLAN = ien in TYPE OF PLAN file
+11 ; IBPCE = 2 for PART A, 3 for PART B - REQUIRED
+12 ; IBEDT = effective date of plan rates
+13 ; IBEXF = Excess Flag, set to 1 if NOT to include excess charges in calculation but to
+14 ; return "e" for excess indicator if plan allows excess and there are excess
+15 ; charges. Used by PR column of MRW screen to show PR without excess
+16 ; amounts included in calculation.
+17 ; Output amount that Medicare supplemental plan will pay
+18 ;
+19 NEW GRPLVL,RSNLVL,RSNAMT,MCA,GRPCD,RSNCD,RSN0,CALC,IBIND
+20 if $GET(IBPCE)=""
QUIT ""
+21 if $GET(IBTYPLAN)=""
SET IBTYPLAN=$$TYPLN(IBIFN)
+22 IF $GET(IBEDT)=""
SET IBEDT=$$MSEDT(IBIFN,IBTYPLAN)
if IBEDT=""
QUIT ""
+23 SET (GRPLVL,MCA)=0
+24 FOR
SET GRPLVL=$ORDER(EOBADJ(GRPLVL))
if 'GRPLVL
QUIT
Begin DoDot:1
+25 SET GRPCD=$PIECE($GET(EOBADJ(GRPLVL,0)),U)
+26 ; For now they want to calculate all PR but only apply %age calcs to PR-1,2 & 3
+27 IF GRPCD'="PR"
if '$DATA(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD))
QUIT
+28 SET RSNLVL=0
+29 ;
FOR
SET RSNLVL=$ORDER(EOBADJ(GRPLVL,1,RSNLVL))
if 'RSNLVL
QUIT
Begin DoDot:2
+30 SET RSN0=$GET(EOBADJ(GRPLVL,1,RSNLVL,0))
SET RSNAMT=$PIECE(RSN0,U,2)
SET RSNCD=$PIECE(RSN0,U)
+31 ; ignore PR-AAA
IF GRPCD="PR"
IF RSNCD="AAA"
QUIT
+32 ; For now they want to calculate all PR but only apply %age calcs to PR-1,2 & 3
+33 IF GRPCD="PR"
IF "1^2^3"'[RSNCD
IF '$DATA(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD))
SET MCA=MCA+RSNAMT
QUIT
+34 if '$DATA(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD))
QUIT
+35 ; if there is an entry in the effective date multiple for this grp/rsn code use it to calculate amount for PART A and B.
+36 ; for MRW, don't add up excess charges if IBEXF=1, just send back an "e" indicator to alert user of excess
+37 IF $GET(IBEXF)=1
IF GRPCD="CO"
IF RSNCD=45
IF $PIECE($GET(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)),U,IBPCE)>0
SET IBIND="e"
QUIT
+38 SET CALC=$PIECE($GET(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)),U,IBPCE)/100
+39 SET MCA=MCA+(RSNAMT*CALC)
End DoDot:2
End DoDot:1
+40 QUIT MCA_U_$GET(IBIND)
+41 ;
MSEDT(IBIFN,IBTYPLAN) ; does this claim's TYPE OF PLAN have an effective date multiple on or before the
+1 ; claim 'statement covers from' date
+2 ; IBIFN = claim ien - REQUIRED
+3 ; IBTYPLAN = Type of Plan ien
+4 ; returns eff.date calculation multiple to use or null
+5 ; called from SKIP^IBCCCB, BLD^IBCECOB1, TOT^IBCECOB2, CRIT^IBCEMQC, & SECOND^IBCEMSR
+6 ;
+7 ; IB*2.0*447: the below quit statement has been added because CBO has decided not to implement
+8 ; these changes with patch 447 after all. Once a long-term maintenance plan for the plan type
+9 ; calculations can be worked out and CBO is ready to implement the special calculations, the
+10 ; below quit statement and these comments should be removed and the type of plan special calculations
+11 ; will immediately take effect. For now, returning a null will allow existing code to bypass
+12 ; the special calculation table in file 355.1 and calculate everything as 100% of Patient Responsibility (PR).
+13 QUIT ""
+14 ;
+15 NEW IBSVDT
+16 if $GET(IBIFN)=""
QUIT ""
+17 if $GET(IBTYPLAN)=""
SET IBTYPLAN=+$$TYPLN(IBIFN)
+18 SET IBSVDT=+$PIECE($GET(^DGCR(399,IBIFN,"U")),U)
+19 if $DATA(^IBE(355.1,IBTYPLAN,14,"B",IBSVDT))
QUIT IBSVDT
+20 QUIT $ORDER(^IBE(355.1,IBTYPLAN,14,"B",IBSVDT),-1)
+21 ;
TYPLN(IBIFN) ; find type of plan for claim
+1 ; IBIFN = claim ien - REQUIRED
+2 ; returns ien from file 355.1 or null if none found
+3 ;
+4 if $GET(IBIFN)=""
QUIT ""
+5 NEW IBCOBN,IBGRPNO
+6 ;find next payer
SET IBCOBN=$$COBN^IBCEF(IBIFN)+1
+7 ; group plan number
SET IBGRPNO=+$PIECE($GET(^DGCR(399,IBIFN,"I"_IBCOBN)),U,18)
+8 ; type of plan - IEN
QUIT $PIECE($GET(^IBA(355.3,IBGRPNO,0)),U,9)
+9 ;
