| 1 | IBCCCB ;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
|
|---|
| 7 | ASK ;
|
|---|
| 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 | ;
|
|---|
| 39 | CHKB ; 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 | ;
|
|---|
| 47 | CHKB1 ; 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 | ;
|
|---|
| 74 | NEXTP ; 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 | ;
|
|---|
| 125 | SKIP ; 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 | ;
|
|---|
| 158 | END ;
|
|---|
| 159 | Q
|
|---|
| 160 | ;
|
|---|
| 161 | ;
|
|---|
| 162 | ASK1 ; If entering thru EDI COB processing, don't ask for new bill, quit
|
|---|
| 163 | I $G(IBCBASK) G EXIT
|
|---|
| 164 | G ASK
|
|---|
| 165 | ;
|
|---|
| 166 | ERROR ; 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 | ;
|
|---|
| 173 | EXIT K IBCAN,IBCOB,IBU
|
|---|
| 174 | KVAR 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 | ;
|
|---|
| 178 | DSPRB(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 | ;
|
|---|
| 198 | CTCOPY(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 | ;
|
|---|
