IBCNSBL2 ;ALB/CPM - 'BILL NEXT PAYOR' BULLETIN ;08-AUG-96
;;2.0;INTEGRATED BILLING;**52,80,153,240,432,568**;21-MAR-94;Build 40
;;Per VA Directive 6402, this routine should not be modified.
;
EOB(IBIFN,IBORIG,IBPYMT,IBTXT) ; determine if there may be another payer for this claim that should be billed
; in general the EOB of the current bill is required to be sent with the next TP bill in the series
; if there is another Third Party Payer then returns true, if any other payer (including patient) then set array
;
; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399)
; IBORIG -- Original amount of the claim
; IBPYMT -- Total Amount paid on the claim
;
; Output: IBTXT -- Array, pass by reference, if needed
; If a another payer (third party or patient) for the claim can be found,
; this array will contain the text that explains who the next payer is
;
; Returns: 0 -- no need to forward EOB (no next Third Party payer found or payment=>amount due)
; 'true^Next payer' -- if the EOB of the bill needs to be forwarded for inclusion in the next bill,
; generally there must be another payer for the bill that is
; third party, non-patient, and payment was not the amount due
;
N X,IB,IBPOL,IBCS,IBARCAT,IBSEC,IBRETURN,IBSEQ,IBINS S IBRETURN=0
I '$G(IBIFN) G EOBQ
I $G(^PRCA(430,IBIFN,0))="" G EOBQ
I '$G(IBORIG) G EOBQ
I $G(IBPYMT)="" G EOBQ
;
S IB=$G(^DGCR(399,IBIFN,0)) I IB="" G EOBQ
;
; - quit if there is no remaining balance on the bill
I IBPYMT'<IBORIG G EOBQ
;
S IBARCAT=$P($G(^DGCR(399.3,+$P(IB,"^",7),0)),"^",6) I 'IBARCAT G EOBQ
;
; for Emergency/Humanitarian Reimb. IB*2.0*568
I IBARCAT=46 D G EOBQ
. S IBRETURN="2^Emergency/Humanitarian Reimb."
. S IBTXT(14)="You should balance bill this patient using the appropriate cost-based rate type."
;
; for Ineligible Hosp. Reimb. IB*2.0*568
I IBARCAT=47 D G EOBQ
. S IBRETURN="2^Ineligible Hosp. Reimb."
. S IBTXT(14)="You should balance bill this patient using the appropriate cost-based rate type."
;
; - for Champva third party claims, bill the Champva Center next
I IBARCAT=28 D G EOBQ
. S IBTXT(14)="You should prepare a claim to be sent to the CHAMPVA Center.",IBRETURN="1^CHAMPVA Center"
;
; - for Tricare third party claims, next bill Tricare or the patient
I IBARCAT=32 D G EOBQ
. ;
. ; - third party bill went to Tricare Supplemental carrier, bill patient next
. S IBSEQ=$P($G(^DGCR(399,IBIFN,0)),U,21),IBSEQ=$S(IBSEQ="P":"I1",IBSEQ="S":"I2",IBSEQ="T":"I3",1:-1)
. S IBPOL=$G(^DGCR(399,IBIFN,IBSEQ))
. S IBCS=$D(^IBE(355.1,"D","CS",+$P($G(^IBA(355.3,+$P(IBPOL,"^",18),0)),"^",9)))>0
. I IBCS D Q
.. S IBTXT(14)="This claim was sent to the TRICARE Supplemental insurance carrier."
.. S IBTXT(15)="You should send a copayment charge to the patient."
. ;
. ; - otherwise third party bill went to patients Reimb. Ins carrier, bill the tricare FI next
. S IBRETURN="1^TRICARE Fiscal Intermediary"
. S IBTXT(14)="You should prepare a claim to send to the TRICARE Fiscal Intermediary."
;
; - for Tricare claims, bill the patient or Tricare supplemental policy
I IBARCAT=30 D G EOBQ
. ;
. ; - if the patient has a Tricare supplemental policy, bill it
. I $$CHPSUP(+$P(IB,"^",2)) D Q
.. S IBRETURN="1^TRICARE Supplemental policy"
.. S IBTXT(14)="The patient has a TRICARE Supplemental policy."
.. S IBTXT(15)="You should prepare a claim to be sent to that carrier."
. ;
. ; - otherwise, bill the patient
. S IBTXT(14)="You should send a copayment charge to the patient."
;
; - all other bills: if there is a next payer in the series then a bill needs to be created for that payer
S IBSEQ=$P($G(^DGCR(399,IBIFN,0)),U,21),IBSEQ=$S(IBSEQ="P":2,IBSEQ="S":3,1:"")
I +IBSEQ S IBINS=$P($G(^DGCR(399,IBIFN,"M")),U,IBSEQ) I +IBINS D
. S IBRETURN=+IBINS_U_$P($G(^DIC(36,+IBINS,0)),U,1)
. S IBTXT(14)="There is a "_$S(IBSEQ=2:"secondary",1:"tertiary")_" payor associated with this claim."
. S IBTXT(15)="You may need to prepare a claim to be sent to "_$P(IBRETURN,U,2)_"."
;
EOBQ Q IBRETURN
;
BULL(IBIFN,IBORIG,IBPYMT) ; Generate bulletin detailing next payer for a claim, if any
;
; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399)
; IBORIG -- Original amount of the claim
; IBPYMT -- Total Amount paid on the claim
;
; Output: Bulletin: Mail Group MEANS TEST BILLING MAIL GROUP: IB MEANS TEST (350.9,.11)
; If a secondary payor for the claim can be found, a bulletin will be sent
; to the billing unit to alert them to forward the claim to that payor.
;
N X,IB,IBX,IBTXT,IBP,IBGRP,IBWLF ;WCJ;IB*2.0*432
;
S IBX=$$EOB($G(IBIFN),$G(IBORIG),$G(IBPYMT),.IBTXT) I '$D(IBTXT) D WLCK(IBIFN) G BULLQ
;
; WCJ;IB*2.0*432;Trigger commercial auto processing.
; This will replace the bulletin when activated.
; (not using a master switch just yet so it's automatically activated)
;I $$GET1^DIQ(350.9,1,8.18) D G BULLQ
; check if these should go directly to the worklist
S IBWLF=$S('IBX:1,".CHAMPVA Center.TRICARE Fiscal Intermediary.TRICARE Supplemental policy."[("."_$P(IBX,U,2)_"."):1,".Ineligible Hosp. Reimb..Emergency/Humanitarian Reimb.."[("."_$P(IBX,U,2)_"."):2,1:0)
D EN^IBCAPP(IBIFN,IBORIG,IBPYMT,IBWLF)
G BULLQ
; WCJ;IB*2.0*432;end changes
;
S IB=$G(^DGCR(399,IBIFN,0)) I IB="" G BULLQ
S IBP=$$PT^IBEFUNC(+$P(IB,"^",2))
;
; - create remainder of bulletin
N XMDUZ,XMTEXT,XMY,XMSUB
S XMSUB="Notification of Subsequent Payor"
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBTXT("
K XMY S XMY(DUZ)=""
;
S IBTXT(1)="A payment has been made on the following claim, which has been identified"
S IBTXT(2)="as potentially having a subsequent payor:"
S IBTXT(3)=" "
S IBTXT(4)=" Bill Number: "_$P($G(^PRCA(430,IBIFN,0)),"^")
S IBTXT(5)=" Patient: "_$E($P(IBP,"^"),1,30)_" Pt. Id: "_$P(IBP,"^",2)
S IBTXT(6)=" Bill Type: "_$P($G(^DGCR(399.3,+$P(IB,"^",7),0)),"^")
S IBTXT(7)=" Orig Amount: $"_$J(IBORIG,0,2)
S IBTXT(8)=" Amount Paid: $"_$J(IBPYMT,0,2)
S IBTXT(9)=" "
;
S IBX=$G(^DGCR(399,IBIFN,0))
S IBTXT(10)="Bill Sequence: "_$$EXSET^IBEFUNC($P(IBX,U,21),399,.21)
S IBTXT(11)=" Bill Payer: "_$E($P($G(^DIC(36,+$G(^DGCR(399,IBIFN,"MP")),0)),U,1),1,20)
;
S IBX=$G(^DGCR(399,IBIFN,"M"))
I IBX S IBTXT(10)=IBTXT(10)_$J("",(40-$L(IBTXT(10))))_" Primary Carrier: "_$E($P($G(^DIC(36,+IBX,0)),U,1),1,20)
I +$P(IBX,U,2) S IBTXT(11)=IBTXT(11)_$J("",(40-$L(IBTXT(11))))_"Secondary Carrier: "_$E($P($G(^DIC(36,+$P(IBX,U,2),0)),U,1),1,20)
I +$P(IBX,U,3) S IBTXT(12)=$J("",40)_" Tertiary Carrier: "_$E($P($G(^DIC(36,+$P(IBX,U,3),0)),U,1),1,20)
S IBTXT(13)=" "
;
; - send to the Means Test billing mailgroup (for now)
S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
;
D ^XMD
;
BULLQ Q
;
;
CHPSUP(DFN) ; Does the patient have a TRICARE Supplemental policy?
; Input: DFN -- Pointer to the patient in file #2
; Output: 0 - Has no TRICARE Supplemental policy
; 1 - Yes, patient has such a policy.
;
N X,IBINS,IBCS
D ALL^IBCNS1(DFN,"IBINS",1,DT)
S (IBCS,X)=0 F S X=$O(IBINS(X)) Q:'X D Q:IBCS
.I $D(^IBE(355.1,"D","CS",+$P($G(IBINS(X,355.3)),"^",9))) S IBCS=1
Q IBCS
;
WLCK(IBIFN) ; does this claim need to be removed from the worklist?
; IBIFN = claim ien, if collected/closed and NO subsequent payer, remove from worklist if there
;
N X
Q:$P($$BILL^RCJIBFN2(IBIFN),U,2)'=22 ; AR status DBIA 1452
Q:'$D(^DGCR(399,"CAP",1,IBIFN)) ; not on worklist
S X=$$WLRMVF^IBCECOB1(IBIFN,"RM",1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSBL2 7928 printed Jan 18, 2025@03:18:04 Page 2
IBCNSBL2 ;ALB/CPM - 'BILL NEXT PAYOR' BULLETIN ;08-AUG-96
+1 ;;2.0;INTEGRATED BILLING;**52,80,153,240,432,568**;21-MAR-94;Build 40
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EOB(IBIFN,IBORIG,IBPYMT,IBTXT) ; determine if there may be another payer for this claim that should be billed
+1 ; in general the EOB of the current bill is required to be sent with the next TP bill in the series
+2 ; if there is another Third Party Payer then returns true, if any other payer (including patient) then set array
+3 ;
+4 ; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399)
+5 ; IBORIG -- Original amount of the claim
+6 ; IBPYMT -- Total Amount paid on the claim
+7 ;
+8 ; Output: IBTXT -- Array, pass by reference, if needed
+9 ; If a another payer (third party or patient) for the claim can be found,
+10 ; this array will contain the text that explains who the next payer is
+11 ;
+12 ; Returns: 0 -- no need to forward EOB (no next Third Party payer found or payment=>amount due)
+13 ; 'true^Next payer' -- if the EOB of the bill needs to be forwarded for inclusion in the next bill,
+14 ; generally there must be another payer for the bill that is
+15 ; third party, non-patient, and payment was not the amount due
+16 ;
+17 NEW X,IB,IBPOL,IBCS,IBARCAT,IBSEC,IBRETURN,IBSEQ,IBINS
SET IBRETURN=0
+18 IF '$GET(IBIFN)
GOTO EOBQ
+19 IF $GET(^PRCA(430,IBIFN,0))=""
GOTO EOBQ
+20 IF '$GET(IBORIG)
GOTO EOBQ
+21 IF $GET(IBPYMT)=""
GOTO EOBQ
+22 ;
+23 SET IB=$GET(^DGCR(399,IBIFN,0))
IF IB=""
GOTO EOBQ
+24 ;
+25 ; - quit if there is no remaining balance on the bill
+26 IF IBPYMT'<IBORIG
GOTO EOBQ
+27 ;
+28 SET IBARCAT=$PIECE($GET(^DGCR(399.3,+$PIECE(IB,"^",7),0)),"^",6)
IF 'IBARCAT
GOTO EOBQ
+29 ;
+30 ; for Emergency/Humanitarian Reimb. IB*2.0*568
+31 IF IBARCAT=46
Begin DoDot:1
+32 SET IBRETURN="2^Emergency/Humanitarian Reimb."
+33 SET IBTXT(14)="You should balance bill this patient using the appropriate cost-based rate type."
End DoDot:1
GOTO EOBQ
+34 ;
+35 ; for Ineligible Hosp. Reimb. IB*2.0*568
+36 IF IBARCAT=47
Begin DoDot:1
+37 SET IBRETURN="2^Ineligible Hosp. Reimb."
+38 SET IBTXT(14)="You should balance bill this patient using the appropriate cost-based rate type."
End DoDot:1
GOTO EOBQ
+39 ;
+40 ; - for Champva third party claims, bill the Champva Center next
+41 IF IBARCAT=28
Begin DoDot:1
+42 SET IBTXT(14)="You should prepare a claim to be sent to the CHAMPVA Center."
SET IBRETURN="1^CHAMPVA Center"
End DoDot:1
GOTO EOBQ
+43 ;
+44 ; - for Tricare third party claims, next bill Tricare or the patient
+45 IF IBARCAT=32
Begin DoDot:1
+46 ;
+47 ; - third party bill went to Tricare Supplemental carrier, bill patient next
+48 SET IBSEQ=$PIECE($GET(^DGCR(399,IBIFN,0)),U,21)
SET IBSEQ=$SELECT(IBSEQ="P":"I1",IBSEQ="S":"I2",IBSEQ="T":"I3",1:-1)
+49 SET IBPOL=$GET(^DGCR(399,IBIFN,IBSEQ))
+50 SET IBCS=$DATA(^IBE(355.1,"D","CS",+$PIECE($GET(^IBA(355.3,+$PIECE(IBPOL,"^",18),0)),"^",9)))>0
+51 IF IBCS
Begin DoDot:2
+52 SET IBTXT(14)="This claim was sent to the TRICARE Supplemental insurance carrier."
+53 SET IBTXT(15)="You should send a copayment charge to the patient."
End DoDot:2
QUIT
+54 ;
+55 ; - otherwise third party bill went to patients Reimb. Ins carrier, bill the tricare FI next
+56 SET IBRETURN="1^TRICARE Fiscal Intermediary"
+57 SET IBTXT(14)="You should prepare a claim to send to the TRICARE Fiscal Intermediary."
End DoDot:1
GOTO EOBQ
+58 ;
+59 ; - for Tricare claims, bill the patient or Tricare supplemental policy
+60 IF IBARCAT=30
Begin DoDot:1
+61 ;
+62 ; - if the patient has a Tricare supplemental policy, bill it
+63 IF $$CHPSUP(+$PIECE(IB,"^",2))
Begin DoDot:2
+64 SET IBRETURN="1^TRICARE Supplemental policy"
+65 SET IBTXT(14)="The patient has a TRICARE Supplemental policy."
+66 SET IBTXT(15)="You should prepare a claim to be sent to that carrier."
End DoDot:2
QUIT
+67 ;
+68 ; - otherwise, bill the patient
+69 SET IBTXT(14)="You should send a copayment charge to the patient."
End DoDot:1
GOTO EOBQ
+70 ;
+71 ; - all other bills: if there is a next payer in the series then a bill needs to be created for that payer
+72 SET IBSEQ=$PIECE($GET(^DGCR(399,IBIFN,0)),U,21)
SET IBSEQ=$SELECT(IBSEQ="P":2,IBSEQ="S":3,1:"")
+73 IF +IBSEQ
SET IBINS=$PIECE($GET(^DGCR(399,IBIFN,"M")),U,IBSEQ)
IF +IBINS
Begin DoDot:1
+74 SET IBRETURN=+IBINS_U_$PIECE($GET(^DIC(36,+IBINS,0)),U,1)
+75 SET IBTXT(14)="There is a "_$SELECT(IBSEQ=2:"secondary",1:"tertiary")_" payor associated with this claim."
+76 SET IBTXT(15)="You may need to prepare a claim to be sent to "_$PIECE(IBRETURN,U,2)_"."
End DoDot:1
+77 ;
EOBQ QUIT IBRETURN
+1 ;
BULL(IBIFN,IBORIG,IBPYMT) ; Generate bulletin detailing next payer for a claim, if any
+1 ;
+2 ; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399)
+3 ; IBORIG -- Original amount of the claim
+4 ; IBPYMT -- Total Amount paid on the claim
+5 ;
+6 ; Output: Bulletin: Mail Group MEANS TEST BILLING MAIL GROUP: IB MEANS TEST (350.9,.11)
+7 ; If a secondary payor for the claim can be found, a bulletin will be sent
+8 ; to the billing unit to alert them to forward the claim to that payor.
+9 ;
+10 ;WCJ;IB*2.0*432
NEW X,IB,IBX,IBTXT,IBP,IBGRP,IBWLF
+11 ;
+12 SET IBX=$$EOB($GET(IBIFN),$GET(IBORIG),$GET(IBPYMT),.IBTXT)
IF '$DATA(IBTXT)
DO WLCK(IBIFN)
GOTO BULLQ
+13 ;
+14 ; WCJ;IB*2.0*432;Trigger commercial auto processing.
+15 ; This will replace the bulletin when activated.
+16 ; (not using a master switch just yet so it's automatically activated)
+17 ;I $$GET1^DIQ(350.9,1,8.18) D G BULLQ
+18 ; check if these should go directly to the worklist
+19 SET IBWLF=$SELECT('IBX:1,".CHAMPVA Center.TRICARE Fiscal Intermediary.TRICARE Supplemental policy."[("."_$PIECE(IBX,U,2)_"."):1,".Ineligible Hosp. Reimb..Emergency/Humanitarian Reimb.."[("."_$PIECE(IBX,U,2)_"."):2,1:0)
+20 DO EN^IBCAPP(IBIFN,IBORIG,IBPYMT,IBWLF)
+21 GOTO BULLQ
+22 ; WCJ;IB*2.0*432;end changes
+23 ;
+24 SET IB=$GET(^DGCR(399,IBIFN,0))
IF IB=""
GOTO BULLQ
+25 SET IBP=$$PT^IBEFUNC(+$PIECE(IB,"^",2))
+26 ;
+27 ; - create remainder of bulletin
+28 NEW XMDUZ,XMTEXT,XMY,XMSUB
+29 SET XMSUB="Notification of Subsequent Payor"
+30 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBTXT("
+31 KILL XMY
SET XMY(DUZ)=""
+32 ;
+33 SET IBTXT(1)="A payment has been made on the following claim, which has been identified"
+34 SET IBTXT(2)="as potentially having a subsequent payor:"
+35 SET IBTXT(3)=" "
+36 SET IBTXT(4)=" Bill Number: "_$PIECE($GET(^PRCA(430,IBIFN,0)),"^")
+37 SET IBTXT(5)=" Patient: "_$EXTRACT($PIECE(IBP,"^"),1,30)_" Pt. Id: "_$PIECE(IBP,"^",2)
+38 SET IBTXT(6)=" Bill Type: "_$PIECE($GET(^DGCR(399.3,+$PIECE(IB,"^",7),0)),"^")
+39 SET IBTXT(7)=" Orig Amount: $"_$JUSTIFY(IBORIG,0,2)
+40 SET IBTXT(8)=" Amount Paid: $"_$JUSTIFY(IBPYMT,0,2)
+41 SET IBTXT(9)=" "
+42 ;
+43 SET IBX=$GET(^DGCR(399,IBIFN,0))
+44 SET IBTXT(10)="Bill Sequence: "_$$EXSET^IBEFUNC($PIECE(IBX,U,21),399,.21)
+45 SET IBTXT(11)=" Bill Payer: "_$EXTRACT($PIECE($GET(^DIC(36,+$GET(^DGCR(399,IBIFN,"MP")),0)),U,1),1,20)
+46 ;
+47 SET IBX=$GET(^DGCR(399,IBIFN,"M"))
+48 IF IBX
SET IBTXT(10)=IBTXT(10)_$JUSTIFY("",(40-$LENGTH(IBTXT(10))))_" Primary Carrier: "_$EXTRACT($PIECE($GET(^DIC(36,+IBX,0)),U,1),1,20)
+49 IF +$PIECE(IBX,U,2)
SET IBTXT(11)=IBTXT(11)_$JUSTIFY("",(40-$LENGTH(IBTXT(11))))_"Secondary Carrier: "_$EXTRACT($PIECE($GET(^DIC(36,+$PIECE(IBX,U,2),0)),U,1),1,20)
+50 IF +$PIECE(IBX,U,3)
SET IBTXT(12)=$JUSTIFY("",40)_" Tertiary Carrier: "_$EXTRACT($PIECE($GET(^DIC(36,+$PIECE(IBX,U,3),0)),U,1),1,20)
+51 SET IBTXT(13)=" "
+52 ;
+53 ; - send to the Means Test billing mailgroup (for now)
+54 SET IBGRP=$PIECE($GET(^XMB(3.8,+$PIECE($GET(^IBE(350.9,1,0)),"^",11),0)),"^")
+55 IF IBGRP]""
SET XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
+56 ;
+57 DO ^XMD
+58 ;
BULLQ QUIT
+1 ;
+2 ;
CHPSUP(DFN) ; Does the patient have a TRICARE Supplemental policy?
+1 ; Input: DFN -- Pointer to the patient in file #2
+2 ; Output: 0 - Has no TRICARE Supplemental policy
+3 ; 1 - Yes, patient has such a policy.
+4 ;
+5 NEW X,IBINS,IBCS
+6 DO ALL^IBCNS1(DFN,"IBINS",1,DT)
+7 SET (IBCS,X)=0
FOR
SET X=$ORDER(IBINS(X))
if 'X
QUIT
Begin DoDot:1
+8 IF $DATA(^IBE(355.1,"D","CS",+$PIECE($GET(IBINS(X,355.3)),"^",9)))
SET IBCS=1
End DoDot:1
if IBCS
QUIT
+9 QUIT IBCS
+10 ;
WLCK(IBIFN) ; does this claim need to be removed from the worklist?
+1 ; IBIFN = claim ien, if collected/closed and NO subsequent payer, remove from worklist if there
+2 ;
+3 NEW X
+4 ; AR status DBIA 1452
if $PIECE($$BILL^RCJIBFN2(IBIFN),U,2)'=22
QUIT
+5 ; not on worklist
if '$DATA(^DGCR(399,"CAP",1,IBIFN))
QUIT
+6 SET X=$$WLRMVF^IBCECOB1(IBIFN,"RM",1)
+7 QUIT
