source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSBL2.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1IBCNSBL2 ;ALB/CPM - 'BILL NEXT PAYOR' BULLETIN ; 08-AUG-96
2 ;;2.0;INTEGRATED BILLING;**52,80,153,240**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EOB(IBIFN,IBORIG,IBPYMT,IBTXT) ; determine if there may be another payer for this claim that should be billed
6 ; in general the EOB of the current bill is required to be sent with the next TP bill in the series
7 ; if there is another Third Party Payer then returns true, if any other payer (including patient) then set array
8 ;
9 ; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399)
10 ; IBORIG -- Original amount of the claim
11 ; IBPYMT -- Total Amount paid on the claim
12 ;
13 ; Output: IBTXT -- Array, pass by reference, if needed
14 ; If a another payer (third party or patient) for the claim can be found,
15 ; this array will contain the text that explains who the next payer is
16 ;
17 ; Returns: 0 -- no need to forward EOB (no next Third Party payer found or payment=>amount due)
18 ; 'true^Next payer' -- if the EOB of the bill needs to be forwarded for inclusion in the next bill,
19 ; generally there must be another payer for the bill that is
20 ; third party, non-patient, and payment was not the amount due
21 ;
22 N X,IB,IBPOL,IBCS,IBARCAT,IBSEC,IBRETURN,IBSEQ,IBINS S IBRETURN=0
23 I '$G(IBIFN) G EOBQ
24 I $G(^PRCA(430,IBIFN,0))="" G EOBQ
25 I '$G(IBORIG) G EOBQ
26 I $G(IBPYMT)="" G EOBQ
27 ;
28 S IB=$G(^DGCR(399,IBIFN,0)) I IB="" G EOBQ
29 ;
30 ; - quit if there is no remaining balance on the bill
31 I IBPYMT'<IBORIG G EOBQ
32 ;
33 S IBARCAT=$P($G(^DGCR(399.3,+$P(IB,"^",7),0)),"^",6) I 'IBARCAT G EOBQ
34 ;
35 ; - for Champva third party claims, bill the Champva Center next
36 I IBARCAT=28 D G EOBQ
37 . S IBTXT(14)="You should prepare a claim to be sent to the CHAMPVA Center.",IBRETURN="1^CHAMPVA Center"
38 ;
39 ; - for Tricare third party claims, next bill Tricare or the patient
40 I IBARCAT=32 D G EOBQ
41 . ;
42 . ; - third party bill went to Tricare Supplemental carrier, bill patient next
43 . S IBSEQ=$P($G(^DGCR(399,IBIFN,0)),U,21),IBSEQ=$S(IBSEQ="P":"I1",IBSEQ="S":"I2",IBSEQ="T":"I3",1:-1)
44 . S IBPOL=$G(^DGCR(399,IBIFN,IBSEQ))
45 . S IBCS=$D(^IBE(355.1,"D","CS",+$P($G(^IBA(355.3,+$P(IBPOL,"^",18),0)),"^",9)))>0
46 . I IBCS D Q
47 .. S IBTXT(14)="This claim was sent to the TRICARE Supplemental insurance carrier."
48 .. S IBTXT(15)="You should send a copayment charge to the patient."
49 . ;
50 . ; - otherwise third party bill went to patients Reimb. Ins carrier, bill the tricare FI next
51 . S IBRETURN="1^TRICARE Fiscal Intermediary"
52 . S IBTXT(14)="You should prepare a claim to send to the TRICARE Fiscal Intermediary."
53 ;
54 ; - for Tricare claims, bill the patient or Tricare supplemental policy
55 I IBARCAT=30 D G EOBQ
56 . ;
57 . ; - if the patient has a Tricare supplemental policy, bill it
58 . I $$CHPSUP(+$P(IB,"^",2)) D Q
59 .. S IBRETURN="1^TRICARE Supplemental policy"
60 .. S IBTXT(14)="The patient has a TRICARE Supplemental policy."
61 .. S IBTXT(15)="You should prepare a claim to be sent to that carrier."
62 . ;
63 . ; - otherwise, bill the patient
64 . S IBTXT(14)="You should send a copayment charge to the patient."
65 ;
66 ; - all other bills: if there is a next payer in the series then a bill needs to be created for that payer
67 S IBSEQ=$P($G(^DGCR(399,IBIFN,0)),U,21),IBSEQ=$S(IBSEQ="P":2,IBSEQ="S":3,1:"")
68 I +IBSEQ S IBINS=$P($G(^DGCR(399,IBIFN,"M")),U,IBSEQ) I +IBINS D
69 . S IBRETURN=+IBINS_U_$P($G(^DIC(36,+IBINS,0)),U,1)
70 . S IBTXT(14)="There is a "_$S(IBSEQ=2:"secondary",1:"tertiary")_" payor associated with this claim."
71 . S IBTXT(15)="You may need to prepare a claim to be sent to "_$P(IBRETURN,U,2)_"."
72 ;
73EOBQ Q IBRETURN
74 ;
75BULL(IBIFN,IBORIG,IBPYMT) ; Generate bulletin detailing next payer for a claim, if any
76 ;
77 ; Input: IBIFN -- Pointer to AR (file #430), or Claim (file #399)
78 ; IBORIG -- Original amount of the claim
79 ; IBPYMT -- Total Amount paid on the claim
80 ;
81 ; Output: Bulletin: Mail Group MEANS TEST BILLING MAIL GROUP: IB MEANS TEST (350.9,.11)
82 ; If a secondary payor for the claim can be found, a bulletin will be sent
83 ; to the billing unit to alert them to forward the claim to that payor.
84 ;
85 N X,IB,IBX,IBTXT,IBP,IBGRP
86 ;
87 S IBX=$$EOB($G(IBIFN),$G(IBORIG),$G(IBPYMT),.IBTXT) I '$D(IBTXT) G BULLQ
88 ;
89 S IB=$G(^DGCR(399,IBIFN,0)) I IB="" G BULLQ
90 S IBP=$$PT^IBEFUNC(+$P(IB,"^",2))
91 ;
92 ; - create remainder of bulletin
93 N XMDUZ,XMTEXT,XMY,XMSUB
94 S XMSUB="Notification of Subsequent Payor"
95 S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBTXT("
96 K XMY S XMY(DUZ)=""
97 ;
98 S IBTXT(1)="A payment has been made on the following claim, which has been identified"
99 S IBTXT(2)="as potentially having a subsequent payor:"
100 S IBTXT(3)=" "
101 S IBTXT(4)=" Bill Number: "_$P($G(^PRCA(430,IBIFN,0)),"^")
102 S IBTXT(5)=" Patient: "_$E($P(IBP,"^"),1,30)_" Pt. Id: "_$P(IBP,"^",2)
103 S IBTXT(6)=" Bill Type: "_$P($G(^DGCR(399.3,+$P(IB,"^",7),0)),"^")
104 S IBTXT(7)=" Orig Amount: $"_$J(IBORIG,0,2)
105 S IBTXT(8)=" Amount Paid: $"_$J(IBPYMT,0,2)
106 S IBTXT(9)=" "
107 ;
108 S IBX=$G(^DGCR(399,IBIFN,0))
109 S IBTXT(10)="Bill Sequence: "_$$EXSET^IBEFUNC($P(IBX,U,21),399,.21)
110 S IBTXT(11)=" Bill Payer: "_$E($P($G(^DIC(36,+$G(^DGCR(399,IBIFN,"MP")),0)),U,1),1,20)
111 ;
112 S IBX=$G(^DGCR(399,IBIFN,"M"))
113 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)
114 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)
115 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)
116 S IBTXT(13)=" "
117 ;
118 ; - send to the Means Test billing mailgroup (for now)
119 S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
120 I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
121 ;
122 D ^XMD
123 ;
124BULLQ Q
125 ;
126 ;
127CHPSUP(DFN) ; Does the patient have a TRICARE Supplemental policy?
128 ; Input: DFN -- Pointer to the patient in file #2
129 ; Output: 0 - Has no TRICARE Supplemental policy
130 ; 1 - Yes, patient has such a policy.
131 ;
132 N X,IBINS,IBCS
133 D ALL^IBCNS1(DFN,"IBINS",1,DT)
134 S (IBCS,X)=0 F S X=$O(IBINS(X)) Q:'X D Q:IBCS
135 .I $D(^IBE(355.1,"D","CS",+$P($G(IBINS(X,355.3)),"^",9))) S IBCS=1
136 Q IBCS
Note: See TracBrowser for help on using the repository browser.