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

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

initial load of WorldVistAEHR

File size: 8.5 KB
Line 
1IBCCCB ;ALB/ARH - COPY BILL FOR COB ; 2/13/06 10:46am
2 ;;2.0;INTEGRATED BILLING;**80,106,51,151,137,182,155,323**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Copy bill for COB w/out cancelling, update some flds
6 ; Primary->Secondary->Tertiary
7ASK ;
8 S IBCBCOPY=1 ; flag that copy function entered thru Copy COB option
9 ;
10 D KVAR S IBCAN=2,IBU="UNSPECIFIED"
11 ;
12 S IBX=$$PB^IBJTU2 S:+IBX=2 IBIFN=$P(IBX,U,2) I +IBX=1 S DFN=$P(IBX,U,2),IBV=1,IBAC=5 D DATE^IBCB
13 I '$G(IBIFN) G EXIT
14 ;
15 ; Restrict access to this process for REQUEST MRA bills in 2 Cases:
16 ; 1. No MRA EOB's on File for bill
17 I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,'$$CHK^IBCEMU1(IBIFN) D G ASK
18 . W !!?4,"This bill is in a status of REQUEST MRA and it has No MRA EOB's"
19 . W !?4,"on file. Access to this bill is restricted."
20 ;
21 ; 2. At least one MRA EOB appears on the MRA management worklist
22 I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,$$MRAWL^IBCEMU2(IBIFN) D G ASK
23 . W !!?4,"This bill is in a status of REQUEST MRA and it does appear on the"
24 . W !?4,"MRA Management Work List. Please use the 'MRA Management Menu' options"
25 . W !?4,"for all processing related to this bill."
26 . Q
27 ;
28 ; If MRA is Activated and bill is in Entered/Not Reviewed status and current insurance Co. is WNR -->
29 ; ask if user wants to continue
30 I $$EDIACTV^IBCEF4(2),$P($G(^DGCR(399,IBIFN,0)),U,13)=1,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) D I 'Y G ASK
31 . W !!?4,"This bill is in a status of ENTERED/NOT REVIEWED and current payer is "
32 . W !?4,"MEDICARE (WNR). No MRA has been requested for this bill."
33 . S DIR(0)="YA",DIR("B")="NO",DIR("A")=" Are you sure you want to continue to process this bill?: "
34 . D ^DIR K DIR
35 ;
36 ; Display related bills
37 D DSPRB^IBCCCB0(IBIFN)
38 ;
39CHKB ; Entrypoint-COB processing via EDI's COB Mgmt
40 ; Ask if final EOB was received for previous bill
41 I '$$FINALEOB^IBCCCB0(IBIFN) S IBSECHK=1
42 I $G(IBSECHK)=1,$$MCRONBIL^IBEFUNC(IBIFN) G EXIT
43 ;
44 ; Warn if previous bill not at least authorized
45 I '$$MCRONBIL^IBEFUNC(IBIFN) I '$$COBOK^IBCCCB0(IBIFN) G EXIT
46 ;
47CHKB1 ; Entry point for Automatic/Silent COB Processing.
48 ; No writes or reads can occur from this point forward if variable
49 ; IBSILENT=1. Any and all error messages should be processed with
50 ; the ERROR procedure below.
51 ;
52 S IBX=$G(^DGCR(399,+IBIFN,0)),DFN=$P(IBX,U,2),IBDT=$P(IBX,U,3)\1,IBER=""
53 I IBCAN>1 D NOPTF^IBCB2 I 'IBAC1 D NOPTF1^IBCB2 G ASK1
54 ;
55 F IBI=0,"S","U1","M","MP","M1" S IB(IBI)=$G(^DGCR(399,IBIFN,IBI))
56 I IB(0)="" S IBER="Invalid Bill Number" D ERROR G ASK1
57 ;
58 ; check to see if the bill has been cancelled
59 I $P(IB("S"),U,16),$P(IB("S"),U,17) D G ASK1
60 . N WHO
61 . S IBER="This bill was cancelled on "
62 . S IBER=IBER_$$FMTE^XLFDT($P(IB("S"),U,17),"1Z")_" by "
63 . S WHO="UNSPECIFIED"
64 . I $P(IB("S"),U,18) S WHO=$P($G(^VA(200,$P(IB("S"),U,18),0)),U,1)
65 . S IBER=IBER_WHO_"."
66 . D ERROR
67 . Q
68 ;
69 S IBCOB=$$COB^IBCEF(IBIFN),IBCOBN=$TR(IBCOB,"PSTA","12")
70 S IBMRAIO=+$$CURR^IBCEF2(IBIFN),IBMRAO=$$MCRWNR^IBEFUNC(IBMRAIO)
71 S IBNMOLD=$S(IBCOB="P":"Primary",IBCOB="S":"Secondary",IBCOB="T":"Tertiary",IBCOB="A":"Patient",1:"")_$S(IBMRAO:"-MRA Only",1:"")
72 S IBINSOLD=$G(^DIC(36,$S(IB("MP"):+IB("MP"),IBMRAO:IBMRAIO,1:0),0))
73 ;
74NEXTP ; If current bill=MEDICARE WNR and valid 'next payer', use same
75 ; bill for new payer
76 ; If next valid 'payer' is ins co or MEDICARE WNR, create new bill
77 S IBCOBN=IBCOBN+1,IBNM=$S(IBCOBN=2:"Secondary Payer",IBCOBN=3:"Tertiary Payer",1:"")
78 ;
79 I IBNM="" S IBER=$P(IB(0),U,1)_" is a "_IBNMOLD_" bill, there is no next bill in the series." D ERROR G ASK1
80 ;
81 S IBX=+$P(IB("M1"),U,(4+IBCOBN)),IBY=$G(^DGCR(399,+IBX,0)),IBCOBIL(+IBIFN)=""
82 ;
83 I $P(IBY,U,13)=7 S IBER="The "_$P(IBNM," ",1)_" bill "_$P(IBY,U,1)_" has been cancelled." D ERROR S IBX=""
84 ;
85 I +IBX,$D(IBCOBIL(+IBX)) S IBER="Next bill in series can not be determined." D ERROR G ASK1
86 I +IBX S IBER=$P(IBNM," ",1)_" bill already defined for this series: "_$P(IBY,U,1) D ERROR S IBIFN=IBX G ASK1
87 ;
88 S IBINSN=$P(IB("M"),U,IBCOBN) I 'IBINSN S IBER="There is no "_IBNM_" for "_$P(IB(0),U,1)_"." D ERROR G ASK1
89 S IBINS=$G(^DIC(36,+IBINSN,0)) I IBINS="" S IBER="The "_IBNM_" for "_$P(IB(0),U,1)_" is not a valid Insurance Co." D ERROR G ASK1
90 ;
91 S IBMRA=0
92 I $P(IBINS,U,2)="N" S IBQ=0 D G:IBQ NEXTP
93 . I $$MCRWNR^IBEFUNC(IBINSN) D Q
94 .. ; Check if a valid tert ins if MCR WNR secondary
95 .. I IBCOBN'>2 D
96 ... N Z
97 ... S Z=+$P(IB("M"),U,IBCOBN+1)
98 ... I Z,$D(^DIC(36,Z,0)),$P(^(0),U,2)'="N" S IBMRA=1,IBNM=$P(IBNM," ")_"-MRA.Only"
99 .. I 'IBMRA S IBER="MEDICARE will not reimburse and no further valid insurance for bill" D ERROR S IBQ=1
100 . S IBER=$P(IB(0),U,1)_" "_IBNM_", "_$P(IBINS,U,1)_", will not Reimburse" D ERROR S IBQ=1
101 ;
102 ; If processing in silent mode, skip over the following reads
103 I $G(IBSILENT) G SKIP
104 ;
105 W !!
106 S DIR("?")="Enter Yes to "_$S('$G(IBMRAO):"create a new bill in the bill series for this care. The new bill will be the "_$P(IBNM," ")_" bill ",1:"enter the MRA information and change the payer to the "_$P($P(IBNM,"-")," ")_" payer ")
107 S DIR("?")=DIR("?")_$S('IBMRA:"with the "_IBNM_" responsible for payment.",1:"and will request an MRA from MEDICARE.")
108 S DIR(0)="YO",DIR("A")=$S('$G(IBMRAO):"Copy "_$P(IB(0),U,1)_" for a bill to the ",1:"Change payer on bill "_$P(IB(0),U,1)_" to ")_IBNM_", "_$P(IBINS,U,1) D ^DIR K DIR I Y'=1 S IBSECHK=1 G ASK1
109 ;
110 W !
111 S IBQ=0
112 I '$G(IBMRAO) D G:IBQ ASK1
113 . N Z
114 . S DIR("?")="Enter the amount of the payment from the payer of the "_IBNMOLD_" bill."
115 . S DIR("?")=DIR("?")_" This will be added to the new bill as a prior payment and subtracted from the charges due for the new bill."
116 . S DIR("A")="Prior Payment from "_$P(IB(0),U,1)_" "_IBNMOLD_" Payer, "_$P(IBINSOLD,U,1)_": "
117 . S Z=$$EOBTOT^IBCEU1(IBIFN,$$COBN^IBCEF(IBIFN))
118 . S:Z DIR("B")=Z
119 . S DIR(0)="NOA^0:99999999:2"
120 . D ^DIR K DIR I Y=""!$D(DIRUT) S IBQ=1
121 . K IBCOB
122 . S IBCOB("U2",IBCOBN+2)=Y
123 . Q
124 ;
125SKIP ; Jump here if skipping over the preceeding reads
126 ;
127 ; If payer is Medicare (WNR) update payer sequence and quit
128 I IBMRAO D G END
129 . N IBPRTOT,IBTOTCHG,IBPTRESP
130 . S IBTOTCHG=0
131 . ; Get Total Charges from BILLS/CLAIMS (#399) file
132 . S IBTOTCHG=$P($G(^DGCR(399,IBIFN,"U1")),U,1)
133 . ; Calculate Patient Responsibility for Bill
134 . S IBPTRESP=$$PREOBTOT^IBCEU0(IBIFN)
135 . ; Calculate Patient Primary/Secondary Prior Payment (field 218 or 219 of File 399)
136 . ; These fields are stored in DGCR(399,IBIFN,"U2") pieces 4 and 5 respectively
137 . ; Calculate: Prior Payment= Total Submitted Charges - Patient Responsibility
138 . S IBPRTOT=IBTOTCHG-IBPTRESP
139 . I IBPRTOT<0 S IBPRTOT=0 ; don't allow negative prior payment or offset
140 . S IBCOB("U2",IBCOBN+2)=IBPRTOT
141 . D COBCHG^IBCCC2(IBIFN,IBMRAIO,.IBCOB)
142 . D STAT^IBCEMU2(IBIFN,1.5,1) ; mra eob status update
143 . I $G(IBSILENT) S IBERRMSG=""
144 . Q
145 ;
146 ; We should NOT get to here in silent mode .... just in case
147 I $G(IBSILENT) G END ; currently only MCRWNR in silent mode
148 ;
149 ; Payer is not Medicare (WNR) - Perform additional steps
150 S IBCOB(0,15)=""
151 S IBCOB(0,21)=$S(IBCOBN=2:"S",IBCOBN=3:"T",1:"")
152 I IBCOB(0,21)="" G END
153 S IBCOB("M1",IBCOBN+3)=IBIFN
154 S IBIDS(.15)=IBIFN
155 D KVAR
156 G STEP2^IBCCC
157 ;
158END ;
159 Q
160 ;
161 ;
162ASK1 ; If entering thru EDI COB processing, don't ask for new bill, quit
163 I $G(IBCBASK) G EXIT
164 G ASK
165 ;
166ERROR ; Display/Save error message
167 I '$G(IBSILENT) W !,IBER,!
168 E S IBERRMSG=IBER
169 S IBER=""
170 I $D(IBSECHK) S IBSECHK=1
171 Q
172 ;
173EXIT K IBCAN,IBCOB,IBU
174KVAR K IBX,IBY,IBI,IBIFN,DFN,IBDT,IB,IBCOBN,IBNMOLD,IBINSOLD,IBNM,IBINSN,IBINS,IBER,DIR,IBAC,IBAC1,IBV,X,Y,IBDATA,IBT,IBND0,DIRUT,IBCOBIL,IBMRA,IBMRAI,IBMRAO,IBMRAIO,IBCBCOPY
175 K ^UTILITY($J)
176 Q
177 ;
178DSPRB(IBIFN) ; display related bills
179 ;
180 D DSPRB^IBCCCB0(IBIFN) ; Code moved for size too big
181 Q
182 ;
183 ; ==============
184 ;
185 ; Copy a bill for Reasonable Charges without cancelling it, update certain fields
186 ;
187 ; there is always both inpt inst (created first) and prof charges, always need both bills
188 ; there may be both outpt inst (created first) and prof charges, may not need both bills
189 ; if billing by episode rather than by day (current standard) then may need multiple prof bills per day
190 ;
191 ; Inst bills are copied to create prof Bills automatically
192 ; Subsequent prof bills may be created if the user wants them
193 ;
194 ; Only the first bill in the COB series of bills should be copied for the next prof bill
195 ; The primary inst bill should be copied to get the secondary inst bill
196 ; The primary prof bill should be copied to get the secondary prof bill
197 ;
198CTCOPY(IBIFN,IBMRA) ; based on the type of bill, copy without cancelling
199 ; IBMRA = 1 if an MRA bill and copy for prof components is desired
200 ;
201 D CTCOPY^IBCCCB0(IBIFN,$G(IBMRA)) ;Moved due to routine size
202 Q
203 ;
Note: See TracBrowser for help on using the repository browser.