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

IBCEMU4.m

Go to the documentation of this file. 
  1. IBCEMU4 ;ALB/ESG - MRA UTILITIES ;25-OCT-2004
  1.  ;;2.0;INTEGRATED BILLING;**288,432,447,592**;21-MAR-94;Build 58
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. 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)
  1.  NEW IBX,IBM,LINE,DUP,ADJ
  1.  S IBX=0,IBM=$G(^IBM(361.1,+$G(IBEOB),0))
  1.  I '$G(IBMRANOT),$P(IBM,U,4)'=1 G DENDUPX    ; not an MRA  ;WCJ IB*2.0*432
  1.  I $G(IBMRANOT),$P(IBM,U,4)'=0 G DENDUPX    ; not an EOB ;WCJ IB*2.0*432
  1.  I $P(IBM,U,13)'=2 G DENDUPX   ; not Denied
  1.  ;
  1.  ; check line item adjustments for reason code 18
  1.  S LINE=0,DUP=0
  1.  F  S LINE=$O(^IBM(361.1,IBEOB,15,LINE)) Q:'LINE  D  Q:DUP
  1.  . S ADJ=0
  1.  . F  S ADJ=$O(^IBM(361.1,IBEOB,15,LINE,1,ADJ)) Q:'ADJ  D  Q:DUP
  1.  .. I $D(^IBM(361.1,IBEOB,15,LINE,1,ADJ,1,"B",18)) S DUP=1 Q
  1.  .. Q
  1.  . Q
  1.  ;
  1.  I DUP S IBX=1
  1. DENDUPX ;
  1.  Q IBX
  1.  ;
  1.  ; the remaining functions are all new w/ IB*2.0*447 and have to do with calculating
  1.  ; different amounts based on percentages stored in the effective date multiple of
  1.  ; the TYPE OF PLAN file (#355.1) for Medicare Supplemental plans
  1.  ;
  1. 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
  1.  ; if type of plan is a Medicare supplemental or EGHP plan secondary to Medicare, PR 
  1.  ; calculations are determined based on the effective date multiple in the TYPE OF PLAN file
  1.  ; and may or may not included Excess charges (CO-45), based on Plan Type.
  1.  ; need to pass in:
  1.  ;  IBIFN (REQUIRED) = claim ien
  1.  ;  IBEXF = Excess Flag, set to 1 if NOT to include excess charges in calculation but to
  1.  ;          return "e" (IBE) for excess indicator if plan allows excess and there are 
  1.  ;          excess charges.  Used by PR column of MRW screen to show PR without excess
  1.  ;          amounts included in calculation.
  1.  ;  IBTYPLAN = ien in TYPE OF PLAN file (355.1)
  1.  ;  returns "" if no effective date for type of plan to calculate on
  1.  ;
  1.  N IBFRMTYP,IBPNCAT,IBINPAT,IBMGBD,IBEOB,LNLVL,EOBADJ,IBPCE,IBEDT,IBE,IBTOT
  1.  Q:$G(IBIFN)="" ""
  1.  S:$G(IBTYPLAN)="" IBTYPLAN=$$TYPLN(IBIFN)
  1.  S IBEDT=$$MSEDT(IBIFN,IBTYPLAN) Q:IBEDT="" ""
  1.  S IBINPAT=$$INPAT^IBCEF(IBIFN)     ;Inpat/Outpat Flag
  1.  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
  1.  ; plan category - PART A is Inpatient Institutional, B is all Outpatient and Inpatient Professional
  1.  S IBPNCAT="B"
  1.  I IBINPAT=1,IBFRMTYP=3 S IBPNCAT="A" Q:IBPNCAT="" ""
  1.  ; Medicare supplemental plan  Offset amount = total charges - what medicare secondary plan will pay
  1.  ; so balance due = whatever medicare secondary will pay
  1.  ;
  1.  ; plan category - PART A =1st piece of AEDT Index, B =2nd
  1.  S IBPCE=$S(IBPNCAT="B":2,1:1)
  1.  S IBMGBD=0,IBEOB=0
  1.  F  S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB  D
  1.  .N I
  1.  .F I=0,1,2 S IBEOB(I)=$G(^IBM(361.1,IBEOB,I))
  1.  .I $P(IBEOB(0),U,4)'=1 Q  ;make sure it's an MRA
  1.  .;
  1.  .; Handle CMS-1500 Form Type and UB Outpatient:
  1.  .;JRA IB*2.0*592 Do the same for Dental J430D as for CMS-1500
  1.  .;I IBFRMTYP=2!('IBINPAT) D  Q  ;JRA IB*2.0*592 ';'
  1.  .I IBFRMTYP=2!(IBFRMTYP=7!('IBINPAT)) D  Q  ;JRA IB*2.0*592
  1.  ..; calculate Medicare unpaid amount from line-level (outpatient)
  1.  ..S LNLVL=0 F  S LNLVL=$O(^IBM(361.1,IBEOB,15,LNLVL)) Q:'LNLVL  D  ;
  1.  ...K EOBADJ
  1.  ...M EOBADJ=^IBM(361.1,IBEOB,15,LNLVL,1)
  1.  ...; Total up the Medicare Contract Adjustment across ALL Service Lines to find
  1.  ...; Medicare supplemental Balance Due
  1.  ...S IBTOT=$$CALC(.EOBADJ,IBTYPLAN,IBPCE,IBEDT,$G(IBEXF)),IBE=$P(IBTOT,U,2)
  1.  ...S IBMGBD=$G(IBMGBD)+$P(IBTOT,U)
  1.  .;
  1.  .; Handle Inpatient UB Form Type Next:  Calculate from Claim level data
  1.  .K EOBADJ
  1.  .M EOBADJ=^IBM(361.1,IBEOB,10)
  1.  .S IBTOT=$$CALC(.EOBADJ,IBTYPLAN,IBPCE,IBEDT,$G(IBEXF)),IBE=$P(IBTOT,U,2)
  1.  .S IBMGBD=$G(IBMGBD)+$P(IBTOT,U)
  1.  Q IBMGBD_$G(IBE)
  1.  ;
  1. 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.
  1.  ; If those reason codes have an entry in the effective date mutliple, multiples that
  1.  ; reason amount by the % the Type of plan will pay.  If no entry, assume 100% payment for PR.
  1.  ; any other Group and reason codes would be 0%. 
  1.  ; Adds up all those sums and returns that value as the total PR&CO the Medicare 
  1.  ; Supplemental plan will pay.
  1.  ;
  1.  ; Input  EOBADJ = Array of Group Codes & Reason Codes from either the Claim 
  1.  ;                 Level (10) or Service Line Level (15) of EOB file (#361.1)
  1.  ; IBTYPLAN = ien in TYPE OF PLAN file 
  1.  ; IBPCE = 2 for PART A, 3 for PART B - REQUIRED
  1.  ; IBEDT = effective date of plan rates 
  1.  ; IBEXF = Excess Flag, set to 1 if NOT to include excess charges in calculation but to
  1.  ;          return "e" for excess indicator if plan allows excess and there are excess 
  1.  ;          charges.   Used by PR column of MRW screen to show PR without excess
  1.  ;          amounts included in calculation.
  1.  ; Output  amount that Medicare supplemental plan will pay
  1.  ;
  1.  N GRPLVL,RSNLVL,RSNAMT,MCA,GRPCD,RSNCD,RSN0,CALC,IBIND
  1.  Q:$G(IBPCE)="" ""
  1.  S:$G(IBTYPLAN)="" IBTYPLAN=$$TYPLN(IBIFN)
  1.  I $G(IBEDT)="" S IBEDT=$$MSEDT(IBIFN,IBTYPLAN) Q:IBEDT="" ""
  1.  S (GRPLVL,MCA)=0
  1.  F  S GRPLVL=$O(EOBADJ(GRPLVL)) Q:'GRPLVL  D 
  1.  .S GRPCD=$P($G(EOBADJ(GRPLVL,0)),U)
  1.  .; For now they want to calculate all PR but only apply %age calcs to PR-1,2 & 3 
  1.  .I GRPCD'="PR" Q:'$D(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD))
  1.  .S RSNLVL=0
  1.  .F  S RSNLVL=$O(EOBADJ(GRPLVL,1,RSNLVL)) Q:'RSNLVL  D  ;
  1.  ..S RSN0=$G(EOBADJ(GRPLVL,1,RSNLVL,0)),RSNAMT=$P(RSN0,U,2),RSNCD=$P(RSN0,U)
  1.  ..I GRPCD="PR",RSNCD="AAA" Q  ; ignore PR-AAA
  1.  ..; For now they want to calculate all PR but only apply %age calcs to PR-1,2 & 3
  1.  ..I GRPCD="PR","1^2^3"'[RSNCD,'$D(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)) S MCA=MCA+RSNAMT Q
  1.  ..Q:'$D(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD))
  1.  ..; 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.
  1.  ..; for MRW, don't add up excess charges if IBEXF=1, just send back an "e" indicator to alert user of excess  
  1.  ..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
  1.  ..S CALC=$P($G(^IBE(355.1,IBTYPLAN,14,"AEDT",IBEDT,GRPCD,RSNCD)),U,IBPCE)/100
  1.  ..S MCA=MCA+(RSNAMT*CALC)
  1.  Q MCA_U_$G(IBIND)
  1.  ;
  1. 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
  1.  ; IBIFN = claim ien - REQUIRED
  1.  ; IBTYPLAN = Type of Plan ien
  1.  ; returns eff.date calculation multiple to use or null
  1.  ; called from SKIP^IBCCCB, BLD^IBCECOB1, TOT^IBCECOB2, CRIT^IBCEMQC, & SECOND^IBCEMSR
  1.  ;
  1.  ; IB*2.0*447:  the below quit statement has been added because CBO has decided not to implement
  1.  ; these changes with patch 447 after all.  Once a long-term maintenance plan for the plan type
  1.  ; calculations can be worked out and CBO is ready to implement the special calculations, the
  1.  ; below quit statement and these comments should be removed and the type of plan special calculations 
  1.  ; will immediately take effect.  For now, returning a null will allow existing code to bypass 
  1.  ; the special calculation table in file 355.1 and calculate everything as 100% of Patient Responsibility (PR).
  1.  Q ""
  1.  ;
  1.  N IBSVDT
  1.  Q:$G(IBIFN)="" ""
  1.  S:$G(IBTYPLAN)="" IBTYPLAN=+$$TYPLN(IBIFN)
  1.  S IBSVDT=+$P($G(^DGCR(399,IBIFN,"U")),U)
  1.  Q:$D(^IBE(355.1,IBTYPLAN,14,"B",IBSVDT)) IBSVDT
  1.  Q $O(^IBE(355.1,IBTYPLAN,14,"B",IBSVDT),-1)
  1.  ;
  1. TYPLN(IBIFN) ; find type of plan for claim
  1.  ; IBIFN = claim ien - REQUIRED
  1.  ; returns ien from file 355.1 or null if none found
  1.  ;
  1.  Q:$G(IBIFN)="" ""
  1.  N IBCOBN,IBGRPNO
  1.  S IBCOBN=$$COBN^IBCEF(IBIFN)+1 ;find next payer
  1.  S IBGRPNO=+$P($G(^DGCR(399,IBIFN,"I"_IBCOBN)),U,18) ; group plan number
  1.  Q $P($G(^IBA(355.3,IBGRPNO,0)),U,9) ; type of plan - IEN
  1.  ;