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

IBCCCB.m

Go to the documentation of this file.
  1. IBCCCB ;ALB/ARH - COPY BILL FOR COB ;2/13/06 10:46am
  1. ;;2.0;INTEGRATED BILLING;**80,106,51,151,137,182,155,323,436,432,447,547,592,690**;21-MAR-94;Build 10
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to PAUSE^VALM1 in ICR #10116
  1. ; Copy bill for COB w/out cancelling, update some flds
  1. ; Primary->Secondary->Tertiary
  1. ASK ;
  1. S IBCBCOPY=1 ; flag that copy function entered thru Copy COB option
  1. ;
  1. D KVAR S IBCAN=2,IBU="UNSPECIFIED"
  1. ;
  1. 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
  1. I '$G(IBIFN) G EXIT
  1. ;
  1. ; IB*2.0*432 Restrict access to only allow claims that are NOT on the new CBW Worklist
  1. I $P($G(^DGCR(399,IBIFN,"S1")),U,7)=1,$G(IBMRANOT)'=1 D G ASK
  1. . W !!?4,"This bill appears on the CBW Management Work List. Please use the"
  1. . W !?4,"'CBW Management Menu' options for all processing related to this bill."
  1. . S IBQUIT=1 ;IB*2.0*592 JRA need to set quit flag after issuing this message
  1. . Q
  1. ; Restrict access to this process for REQUEST MRA bills in 2 Cases:
  1. ; 1. No MRA EOB's on File for bill
  1. I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,'$$CHK^IBCEMU1(IBIFN) D G ASK
  1. . W !!?4,"This bill is in a status of REQUEST MRA and it has No MRA EOB's"
  1. . W !?4,"on file. Access to this bill is restricted."
  1. ;
  1. ; 2. At least one MRA EOB appears on the MRA management worklist
  1. I $P($G(^DGCR(399,IBIFN,0)),U,13)=2,$$MRAWL^IBCEMU2(IBIFN) D G ASK
  1. . W !!?4,"This bill is in a status of REQUEST MRA and it does appear on the"
  1. . W !?4,"MRA Management Work List. Please use the 'MRA Management Menu' options"
  1. . W !?4,"for all processing related to this bill."
  1. . Q
  1. ;
  1. ; If MRA is Activated and bill is in Entered/Not Reviewed status and current insurance Co. is WNR -->
  1. ; ask if user wants to continue
  1. I $$EDIACTV^IBCEF4(2),$P($G(^DGCR(399,IBIFN,0)),U,13)=1,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) D I 'Y G ASK
  1. . W !!?4,"This bill is in a status of ENTERED/NOT REVIEWED and current payer is "
  1. . W !?4,"MEDICARE (WNR). No MRA has been requested for this bill."
  1. . S DIR(0)="YA",DIR("B")="NO",DIR("A")=" Are you sure you want to continue to process this bill?: "
  1. . D ^DIR K DIR
  1. ;
  1. ; Display related bills
  1. D DSPRB^IBCCCB0(IBIFN)
  1. ;
  1. CHKB ; Entrypoint-COB processing via EDI's COB Mgmt
  1. ; Ask if final EOB was received for previous bill
  1. I '$$FINALEOB^IBCCCB0(IBIFN) S IBSECHK=1
  1. I $G(IBSECHK)=1,$$MCRONBIL^IBEFUNC(IBIFN) G EXIT
  1. ;
  1. ; Warn if previous bill not at least authorized
  1. I '$$MCRONBIL^IBEFUNC(IBIFN) I '$$COBOK^IBCCCB0(IBIFN) G EXIT
  1. ;
  1. CHKB1 ; Entry point for Automatic/Silent COB Processing.
  1. ; No writes or reads can occur from this point forward if variable
  1. ; IBSILENT=1. Any and all error messages should be processed with
  1. ; the ERROR procedure below.
  1. ;
  1. S IBX=$G(^DGCR(399,+IBIFN,0)),DFN=$P(IBX,U,2),IBDT=$P(IBX,U,3)\1,IBER=""
  1. I IBCAN>1 D NOPTF^IBCB2 I 'IBAC1 D NOPTF1^IBCB2 G ASK1
  1. ;
  1. F IBI=0,"S","U1","M","MP","M1" S IB(IBI)=$G(^DGCR(399,IBIFN,IBI))
  1. I IB(0)="" S IBER="Invalid Bill Number" D PCERR G ASK1
  1. ;
  1. ; check to see if the bill has been cancelled
  1. I $P(IB("S"),U,16),$P(IB("S"),U,17) D G ASK1
  1. . N WHO
  1. . S IBER="This bill was cancelled on "
  1. . S IBER=IBER_$$FMTE^XLFDT($P(IB("S"),U,17),"1Z")_" by "
  1. . S WHO="UNSPECIFIED"
  1. . I $P(IB("S"),U,18) S WHO=$P($G(^VA(200,$P(IB("S"),U,18),0)),U,1)
  1. . S IBER=IBER_WHO_"."
  1. . D PCERR
  1. . Q
  1. ;
  1. S IBCOB=$$COB^IBCEF(IBIFN),IBCOBN=$TR(IBCOB,"PSTA","12")
  1. S IBMRAIO=+$$CURR^IBCEF2(IBIFN),IBMRAO=$$MCRWNR^IBEFUNC(IBMRAIO)
  1. S IBNMOLD=$S(IBCOB="P":"Primary",IBCOB="S":"Secondary",IBCOB="T":"Tertiary",IBCOB="A":"Patient",1:"")_$S(IBMRAO:"-MRA Only",1:"")
  1. S IBINSOLD=$G(^DIC(36,$S(IB("MP"):+IB("MP"),IBMRAO:IBMRAIO,1:0),0))
  1. ;
  1. NEXTP ; If current bill=MEDICARE WNR and valid 'next payer', use same
  1. ; bill for new payer
  1. ; If next valid 'payer' is ins co or MEDICARE WNR, create new bill
  1. S IBCOBN=IBCOBN+1,IBNM=$S(IBCOBN=2:"Secondary Payer",IBCOBN=3:"Tertiary Payer",1:"")
  1. ;
  1. I IBNM="" S IBER=$P(IB(0),U,1)_" is a "_IBNMOLD_" bill, there is no next bill in the series." D PCERR G ASK1
  1. ;
  1. S IBX=+$P(IB("M1"),U,(4+IBCOBN)),IBY=$G(^DGCR(399,+IBX,0)),IBCOBIL(+IBIFN)=""
  1. ;
  1. I $P(IBY,U,13)=7 S IBER="The "_$P(IBNM," ",1)_" bill "_$P(IBY,U,1)_" has been cancelled." D ERROR S IBX=""
  1. ;
  1. I +IBX,$D(IBCOBIL(+IBX)) S IBER="Next bill in series can not be determined." D PCERR G ASK1
  1. I +IBX S IBER=$P(IBNM," ",1)_" bill already defined for this series: "_$P(IBY,U,1) D PCERR S IBIFN=IBX G ASK1
  1. ;
  1. S IBINSN=$P(IB("M"),U,IBCOBN) I 'IBINSN S IBER="There is no "_IBNM_" for "_$P(IB(0),U,1)_"." D PCERR G ASK1
  1. 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 PCERR G ASK1
  1. ;
  1. S IBMRA=0
  1. I $P(IBINS,U,2)="N" S IBQ=0 D G:IBQ NEXTP
  1. . I $$MCRWNR^IBEFUNC(IBINSN) D Q
  1. .. ; Check if a valid tert ins if MCR WNR secondary
  1. .. I IBCOBN'>2 D
  1. ... N Z
  1. ... S Z=+$P(IB("M"),U,IBCOBN+1)
  1. ... I Z,$D(^DIC(36,Z,0)),$P(^(0),U,2)'="N" S IBMRA=1,IBNM=$P(IBNM," ")_"-MRA.Only"
  1. .. I 'IBMRA S IBER="MEDICARE will not reimburse and no further valid insurance for bill" D ERROR S IBQ=1
  1. . S IBER=$P(IB(0),U,1)_" "_IBNM_", "_$P(IBINS,U,1)_", will not Reimburse" D ERROR S IBQ=1
  1. ;
  1. ; If processing in silent mode, skip over the following reads
  1. I $G(IBSILENT) G SKIP
  1. ;
  1. W !!
  1. 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 ")
  1. S DIR("?")=DIR("?")_$S('IBMRA:"with the "_IBNM_" responsible for payment.",1:"and will request an MRA from MEDICARE.")
  1. 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
  1. ;
  1. W !
  1. S IBQ=0
  1. I '$G(IBMRAO) D G:IBQ ASK1
  1. . N Z
  1. . S DIR("?")="Enter the amount of the payment from the payer of the "_IBNMOLD_" bill."
  1. . 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."
  1. . S DIR("A")="Prior Payment from "_$P(IB(0),U,1)_" "_IBNMOLD_" Payer, "_$P(IBINSOLD,U,1)_": "
  1. . S Z=$$EOBTOT^IBCEU1(IBIFN,$$COBN^IBCEF(IBIFN))
  1. . S:Z DIR("B")=Z
  1. . S DIR(0)="NOA^0:99999999:2"
  1. . D ^DIR K DIR I Y=""!$D(DIRUT) S IBQ=1
  1. . K IBCOB
  1. . S IBCOB("U2",IBCOBN+2)=Y
  1. . Q
  1. ;
  1. SKIP ; Jump here if skipping over the preceeding reads
  1. ;
  1. ; If payer is Medicare (WNR) update payer sequence and quit
  1. I IBMRAO!($G(IBSTSM)=1) D I $G(IBSTSM)'=1 G END
  1. . N IBPRTOT,IBTOTCHG,IBPTRESP
  1. . S IBTOTCHG=0
  1. . ;
  1. . ; Get Total Charges from BILLS/CLAIMS (#399) file
  1. . S IBTOTCHG=$P($G(^DGCR(399,IBIFN,"U1")),U,1)
  1. . ; Calculate Patient Responsibility for Bill
  1. . ; IB*2.0*447 If claim's type of plan has effective date multiple, use those calculations
  1. . ;S IBPTRESP=$$PREOBTOT^IBCEU0(IBIFN,$G(IBSTSM))
  1. . ; Calculate Patient Primary/Secondary Prior Payment (field 218 or 219 of File 399)
  1. . ; These fields are stored in DGCR(399,IBIFN,"U2") pieces 4 and 5 respectively
  1. . ; Calculate: Prior Payment= Total Submitted Charges - Patient Responsibility
  1. . S:$G(IBSTSM)'=1 IBPTRESP=$S($$MSEDT^IBCEMU4(IBIFN)'="":$$MSPRE^IBCEMU4(IBIFN),1:$$PREOBTOT^IBCEU0(IBIFN,$G(IBSTSM))),IBPRTOT=IBTOTCHG-IBPTRESP
  1. . S:$G(IBSTSM)=1 IBPRTOT=$$EOBTOT^IBCEU1(IBIFN,$$COBN^IBCEF(IBIFN)) ;Pat Resp for non-medicare
  1. . I IBPRTOT<0 S IBPRTOT=0 ; don't allow negative prior payment or offset
  1. . S IBCOB("U2",IBCOBN+2)=IBPRTOT
  1. . ; IB*2.0*547 don't change status back to 1.5 if auto-creating secondary or tertiary in silent mode
  1. . ; D:$G(IBSTSM)'=1 COBCHG^IBCCC2(IBIFN,IBMRAIO,.IBCOB)
  1. . ; D STAT^IBCEMU2(IBIFN,1.5,1) ; mra eob status update
  1. . I $G(IBSTSM)'=1 D COBCHG^IBCCC2(IBIFN,IBMRAIO,.IBCOB),STAT^IBCEMU2(IBIFN,1.5,1) ; mra eob status update
  1. . I $G(IBSILENT) S IBERRMSG=""
  1. . Q
  1. ;
  1. ; We should NOT get to here in silent mode .... just in case
  1. I $G(IBSILENT),$G(IBSTSM)'=1 G END ; currently only MCRWNR in silent mode
  1. ;
  1. ; Payer is not Medicare (WNR) - Perform additional steps
  1. S IBCOB(0,15)=""
  1. S IBCOB(0,21)=$S(IBCOBN=2:"S",IBCOBN=3:"T",1:"")
  1. I IBCOB(0,21)="" G END
  1. S IBCOB("M1",IBCOBN+3)=IBIFN
  1. S IBIDS(.15)=IBIFN
  1. D KVAR
  1. G STEP2^IBCCC
  1. ;
  1. END ;
  1. Q
  1. ;
  1. ;
  1. ASK1 ; If entering thru EDI COB processing, don't ask for new bill, quit
  1. I $G(IBCBASK) G EXIT
  1. G ASK
  1. ;
  1. ERROR ; Display/Save error message
  1. I '$G(IBSILENT) W !,IBER,!
  1. E S IBERRMSG=IBER
  1. S IBER=""
  1. I $D(IBSECHK) S IBSECHK=1
  1. Q
  1. ;
  1. EXIT K IBCAN,IBCOB,IBU
  1. 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
  1. K ^UTILITY($J)
  1. Q
  1. ;
  1. DSPRB(IBIFN) ; display related bills
  1. ;
  1. D DSPRB^IBCCCB0(IBIFN) ; Code moved for size too big
  1. Q
  1. ;
  1. ; ==============
  1. ;
  1. ; Copy a bill for Reasonable Charges without cancelling it, update certain fields
  1. ;
  1. ; there is always both inpt inst (created first) and prof charges, always need both bills
  1. ; there may be both outpt inst (created first) and prof charges, may not need both bills
  1. ; if billing by episode rather than by day (current standard) then may need multiple prof bills per day
  1. ;
  1. ; Inst bills are copied to create prof Bills automatically
  1. ; Subsequent prof bills may be created if the user wants them
  1. ;
  1. ; Only the first bill in the COB series of bills should be copied for the next prof bill
  1. ; The primary inst bill should be copied to get the secondary inst bill
  1. ; The primary prof bill should be copied to get the secondary prof bill
  1. ;
  1. CTCOPY(IBIFN,IBMRA) ; based on the type of bill, copy without cancelling
  1. ; IBMRA = 1 if an MRA bill and copy for prof components is desired
  1. ;
  1. D CTCOPY^IBCCCB0(IBIFN,$G(IBMRA)) ;Moved due to routine size
  1. Q
  1. ;
  1. PCERR ; Display/pause error message for interaction - *690
  1. I '$G(IBSILENT) W !,IBER D PAUSE^VALM1
  1. I $G(IBSILENT) S IBERRMSG=IBER
  1. S IBER=""
  1. I $D(IBSECHK) S IBSECHK=1
  1. Q
  1. ;