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

IBCC.m

Go to the documentation of this file.
  1. IBCC ;ALB/MJB - CANCEL THIRD PARTY BILL ;Feb 09, 2018@10:11:43
  1. ;;2.0;INTEGRATED BILLING;**2,19,77,80,51,142,137,161,199,241,155,276,320,358,433,432,447,516,547,597,592,727,712**;21-MAR-94;Build 14
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRC
  1. ;
  1. I '$D(IBCAN) S IBCAN=1
  1. ASK ;
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
  1. ;S XRTL=$ZU(0),XRTN="IBCC-1" D T0^%ZOSV ;start rt clock
  1. ;
  1. ; If called at entry point PROCESS, variable IBNOASK will exist.
  1. ; First time through, IBNOASK=1
  1. ; Second time through, IBNOASK=2 and it will quit
  1. I $G(IBNOASK)=2 G Q
  1. I $G(IBNOASK)=1 S IBNOASK=2
  1. ;
  1. G Q:$G(IBCE("EDI"))
  1. D Q
  1. ; Release currently locked record IB*2.0*597
  1. I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) K IBLOCK
  1. ;
  1. S IBQUIT=0
  1. N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
  1. I '$G(IBNOASK) S DIC="^DGCR(399,",DIC(0)="AEMQZ",DIC("A")="Enter BILL NUMBER or Patient NAME: " W !! D ^DIC I Y<1 S IBQUIT=1 G Q1
  1. K IB364
  1. ; Lock file entry and display message if lock can't be obtained. IB*2.0*597
  1. S IBLOCK=Y
  1. L +^DGCR(399,IBLOCK):$G(DILOCKTM,5) I '$T D LOCKED G ASK
  1. ;
  1. NOPTF ; Note if IB364 is >0 it will be used as the ien to update in file 364
  1. N DA,I
  1. I '$G(IBNOASK) S IBIFN=+$G(Y)
  1. I '$G(IBIFN) G ASK
  1. I IBCAN>1 D NOPTF^IBCB2 I 'IBAC1 D NOPTF1^IBCB2 G ASK
  1. ;
  1. I $G(IBCNCRD)=1,$P($P($G(^DGCR(399,IBIFN,0)),U),"-",2)>98 D Q
  1. .W !!,"Please note that you have exceeded the maximum number of iterations (99) for this claim."
  1. .W "Copy and cancel (CLON) must be used to correct this bill."
  1. .I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
  1. .S IBQUIT=1 H 3
  1. ; Check if bill has been referred to Counsel
  1. I $P($G(^PRCA(430,IBIFN,6)),U,4) D G ASK
  1. . W !,"This bill has been referred to Regional Counsel and cannot be 'CANCELLED' in"
  1. . W !,"Integrated Billing. Please use the option 'TP Referred Follow-up'"
  1. . W !,"[PRCA RC ACTION MENU] in Accounts Receivable to request that Regional"
  1. . W !,"Counsel return the bill to your facility."
  1. . Q
  1. ;
  1. F I=0,"S","U1" S IB(I)=$G(^DGCR(399,IBIFN,I))
  1. S IBSTAT=$P(IB(0),U,13)
  1. ; REMOVE New messages for CRD option IB*2.0*433 in IB*2.0*447 IA#5630
  1. ;I $G(IBCNCRD)=1,IBSTAT'=2,'$$ACCK^PRCAACC(IBIFN) D Q
  1. ;.W !!,"This option cannot be used to correct some Billing Rate Types (Example: TRICARE)"
  1. ;.W "Copy and cancel (CLON) must be used to correct this bill."
  1. ;.S IBQUIT=1 H 3
  1. ;
  1. ; Restrict access to this process for REQUEST MRA bills
  1. I IBSTAT=2,'$G(IBCE("EDI")),$$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. ; IB*2.0*432 Restrict access to claims 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. ;
  1. ; Check if this is a paper claim. If not, check for split EOB. If split, don't allow CRD unless more than 1 EOB has been returned
  1. ; need to check if that
  1. ;WCJ;IB727;make sure if any MRAs are received that all MRAs are received
  1. ;I $G(IBCNCRD)=1,$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1,$$SPLTMRA^IBCEMU1(IBIFN)=1 D Q
  1. N IBRETSPLT
  1. I $G(IBCNCRD)=1,$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1,$$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)>0,$$SPLIT2^IBCEMU1($O(IBRETSPLT("")))=0 D Q
  1. .;W !!,"There is a split EOB associated with this claim. You cannot use this option to Correct this claim until the second EOB has been received."
  1. .W !!,"There is a split EOB associated with this claim. You cannot use this option to Correct this claim until all EOBs have been received."
  1. .I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
  1. .S IBQUIT=1 H 3
  1. .Q
  1. ;
  1. ; Warning message if in a REQUEST MRA status with no MRA on file
  1. ; IB*2.0*516/TAZ,MRD - Forbid the user from using the option CRD
  1. ; (Correct Rejected/Denied Bill) on an MRA claim if the status is
  1. ; REQUEST MRA (IBSTAT=2).
  1. I IBSTAT=2,'$$MRACNT^IBCEMU1(IBIFN) D I $G(IBQUIT) H 3 Q
  1. . N REJ
  1. . D TXSTS^IBCEMU2(IBIFN,,.REJ)
  1. . ;IB*2.0*516/TAZ - If CRD is from CSA allow a REJected claim to be CRD'ed without displaying a warning.
  1. . I $G(IBCNCSA),REJ Q
  1. . W *7,!!?4,$S('$G(IBCNCRD):"Warning! ",1:""),"This bill is in a status of REQUEST MRA."
  1. . W !?4,"No MRAs have been received"
  1. . I REJ W ", but the most recent transmission of this",!?4,"MRA request bill was rejected."
  1. . I 'REJ W " and there are no rejection messages on file",!?4,"for the most recent transmission of this MRA request bill."
  1. . I $G(IBCNCRD) S IBQUIT=1 I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
  1. . Q
  1. ;
  1. I IBCAN=2,IB("S")]"",+$P(IB("S"),U,16),$P(IB("S"),U,17)]"" D G 1
  1. . W !!,"This bill was cancelled on " S Y=$P(IB("S"),U,17) X ^DD("DD") W Y," by ",$S($P(IB("S"),U,18)']"":IBU,$D(^VA(200,$P(IB("S"),U,18),0)):$P(^(0),U,1),1:IBU),"."
  1. . S IBQUIT=1
  1. ;
  1. ; IB*2.0*516/TAZ,MRD - Forbid the user from using the option CRD
  1. ; (Correct Rejected/Denied Bill) on all but primary claims.
  1. I $G(IBCNCRD),($$COB^IBCEF(IBIFN)'="P") D Q
  1. . W !!,"Please note that COB data may exist for this bill."
  1. . W !,"Copy and cancel (CLON) must be used to correct this bill."
  1. . I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
  1. . S IBQUIT=1
  1. . H 3
  1. . Q
  1. ;
  1. ; Notify if a payment has been posted to this bill before cancel
  1. N PRCABILL
  1. S PRCABILL=$$TPR^PRCAFN(IBIFN)
  1. I PRCABILL=-1 W !!,"Please note: PRCA was unable to determine if a payment has been posted." I $G(IBCNCRD)=1 W !,"Copy and cancel (CLON) must be used to correct this bill." I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) S IBQUIT=1 H 3 Q
  1. I PRCABILL>0 W !!,"Please note a PAYMENT of **$"_$$TPR^PRCAFN(IBIFN)_"** has been POSTED to this bill."
  1. ; New message for CRD option
  1. I $G(IBCNCRD)=1,PRCABILL>0 W !,"Copy and cancel (CLON) must be used to correct this bill." I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) S IBQUIT=1 H 3 Q
  1. ;
  1. ; If bill was created via Electronic claims process then notify
  1. ; user that cancellation should occur using ECME package
  1. I $$GET1^DIQ(399,IBIFN_",",460)]"" D G:'Y ASK
  1. . W !!!?5,"This bill was created by the"
  1. . W !?5,"Electronic Claims Management Engine (ECME)."
  1. . W !?5,"Cancellation needs to occur in the ECME package by"
  1. . W !?5,"submitting a REVERSAL to the Payer.",!!
  1. . K DIR S DIR("A",1)="Has a REVERSAL for this e-Claim already been",DIR("A")="submitted to the payer via the ECME package (Y/N)",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
  1. . I Y=0 W !!,"<PLEASE SUBMIT A REVERSAL USING THE APPROPRIATE OPTION IN THE ECME PACKAGE>",$C(7)
  1. ;
  1. CHK ;
  1. ; if user came from CLON, make sure they know about the new CRD option IB*2.0*447 remove TRICARE msg.
  1. I $G(IBCNCOPY)=1 D
  1. .W !!,*7,"Warning: This option should NOT be used to correct Rejected/Denied claims."
  1. .W !," It should ONLY be used to correct DENIED claims which have payments"
  1. .W !," posted against them.***" ; and claims with certain Billing Rate Types (Example: TRICARE)."
  1. ;
  1. S (IBCCCC,IBQUIT)=0 I '$G(IBCEAUTO),'$G(IBMCSCAN) W !!,"ARE YOU SURE YOU WANT TO CANCEL THIS BILL" S %=2 D YN^DICN G:%=0 HELP I %'=1 S IBQUIT=1 G NO
  1. ;
  1. I '$G(IBCEAUTO) W !!,"LAST CHANCE TO CHANGE YOUR MIND..."
  1. S DIE=399,DA=IBIFN,DIE("NO^")=""
  1. S DR="16;S:'X Y=0;19;S IBCCCC=1;"
  1. I $G(IBCEAUTO) S DR="16////1;19////EDI/MRA TURNED OFF;S IBCCCC=1;"
  1. ;
  1. ; esg - 8/23/06 - IB*2*358 - fix semi-colon in free text field
  1. I $G(IBMCSRSC)'="" S DR="16;S:'X Y=0;19//^S X=IBMCSRSC;S IBCCCC=1;"
  1. D ^DIE K DIE,DR
  1. ;
  1. NO I 'IBCCCC W !!,"<NO ACTION TAKEN>",*7 S IBQUIT=1 G ASK:IBCAN<2,Q
  1. S IBCCR=$P($G(^DGCR(399,IBIFN,"S")),U,19)
  1. ; update claim # with new iteration IB*2.0*447 move to later in the process
  1. ;D:$G(IBCNCRD)=1 CRD
  1. W !!,"...Bill has been cancelled..." D BULL^IBCBULL,BSTAT^IBCDC(IBIFN),PRIOR^IBCCC2(IBIFN)
  1. ;
  1. ; cancelling in ingenix claimsmanager if ingenix is running
  1. ; clean-up of variables is OK if not coming in from ListMan screen
  1. I $$CM^IBCIUT1(IBIFN) S IBCISNT=4 D ST2^IBCIST I '$G(IBCICNCL) K IBCISNT,IBCISTAT,IBCIREDT,IBCIERR
  1. ;
  1. S IBEDI=$G(IB364)
  1. I 'IBEDI S IBEDI=+$$LAST364^IBCEF4(IBIFN)
  1. ; ib*2.0*547 don't cancel MRA if cloning a bill that is secondary to MRA (share the same claim#)
  1. I IBEDI D UPDEDI^IBCEM(IBEDI,"C",,$S($$MRASEC^IBCEF4(IBIFN):2,1:"")) ;Update EDI files, if needed
  1. ;
  1. F I="S","U1" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
  1. S PRCASV("ARREC")=IBIFN,PRCASV("AMT")=$S(IB("U1")']"":0,1:$P(IB("U1"),"^")),PRCASV("DATE")=$P(IB("S"),"^",17),PRCASV("BY")=$P(IB("S"),"^",18)
  1. S PRCASV("COMMENT")=$S($P(IB("S"),U,19)]"":$P(IB("S"),U,19),$P(^IBE(350.9,1,2),"^",7)]"":$P(^(2),"^",7),1:"BILL CANCELLED IN MAS")
  1. S PRCASV("BY")=$S($P(IB("S"),U,18)]"":$P(IB("S"),U,18),1:"")
  1. ; IA#3374/IB*2.0*433 Pass the CRD flag so FMS knows to send a cancel record before the new E record is sent
  1. ;S X=$$CANCEL^RCBEIB($G(PRCASV("ARREC")),$G(PRCASV("DATE")),$G(PRCASV("BY")),$G(PRCASV("AMT")),$G(PRCASV("COMMENT")))
  1. S PRCASV("ARCRD")=$G(IBCNCRD)
  1. S X=$$CANCEL^RCBEIB($G(PRCASV("ARREC")),$G(PRCASV("DATE")),$G(PRCASV("BY")),$G(PRCASV("AMT")),$G(PRCASV("COMMENT")),$G(PRCASV("ARCRD")))
  1. W !,$S(X:">> The receivable associated with the claim was cancelled.",1:">> The receivable associated with the claim was not cancelled.")
  1. I $P(X,U,2)]"" W !,">>> ",$P(X,U,2) ; The reason why the claim can not be cancelled.
  1. I IBCAN<2 D RNB^IBCC1 ;assign a reason not billable
  1. G ASK:IBCAN<2,Q
  1. ;
  1. HELP W !,?3,"Answer 'YES' or 'Y' if you wish to cancel this bill.",!,?3,"Answer 'NO' or 'N' if you want to abort." G CHK
  1. Q
  1. 1 I $P(IB(0),U,13)=1 W !,"This record was re-opened on " S Y=$P(IB(0),U,14) X ^DD("DD") W Y,"." G CHK
  1. G ASK
  1. Q1 K:IBCAN=1 IBQUIT K IBCAN
  1. Q K %,IBEPAR,IBSTAT,IBARST,IBAC1,IB,DFN,IBX,IBZ,DIC,DIE,DR,PRCASV,PRCASVC,X,Y,IBEDI
  1. I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) K IBLOCK ; IB*2.0*597
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
  1. Q
  1. CRD(IBIFN) ; entry to point to add iteration # to claim
  1. N IBFDA
  1. S IBITN=$$ITN^IBCCC(IBIFN)
  1. S IBFDA(399,IBIFN_",",.01)=IBITN
  1. D FILE^DIE("","IBFDA")
  1. ; this will re-open the claim, so reset to cancelled
  1. S DIE=399,DA=IBIFN
  1. S DR="16////1"
  1. D ^DIE K DIE,DR
  1. Q
  1. ;
  1. PROCESS(IBIFN,IBCAN) ;
  1. ; Entry point when the bill number is already known. Use this when
  1. ; you just want to try to cancel this bill and this bill only.
  1. ; Input:
  1. ; IBIFN - Internal bill# (Required)
  1. ; IBCAN - Cancel Flag (optional, defaults to 1 if not included)
  1. ;
  1. NEW IBNOASK
  1. S IBNOASK=1
  1. S IBCAN=$G(IBCAN,1)
  1. G ASK
  1. ;
  1. LOCKED ; -- write record locked message IB*2.0*597
  1. W !!,"Sorry, another user currently editing this entry."
  1. W !,"Try again later."
  1. D PAUSE^VALM1
  1. Q
  1. ;IBCC