- IBCC ;ALB/MJB - CANCEL THIRD PARTY BILL ;Feb 09, 2018@10:11:43
- ;;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
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;MAP TO DGCRC
- ;
- I '$D(IBCAN) S IBCAN=1
- ASK ;
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBCC-1" D T0^%ZOSV ;start rt clock
- ;
- ; If called at entry point PROCESS, variable IBNOASK will exist.
- ; First time through, IBNOASK=1
- ; Second time through, IBNOASK=2 and it will quit
- I $G(IBNOASK)=2 G Q
- I $G(IBNOASK)=1 S IBNOASK=2
- ;
- G Q:$G(IBCE("EDI"))
- D Q
- ; Release currently locked record IB*2.0*597
- I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) K IBLOCK
- ;
- S IBQUIT=0
- N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
- 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
- K IB364
- ; Lock file entry and display message if lock can't be obtained. IB*2.0*597
- S IBLOCK=Y
- L +^DGCR(399,IBLOCK):$G(DILOCKTM,5) I '$T D LOCKED G ASK
- ;
- NOPTF ; Note if IB364 is >0 it will be used as the ien to update in file 364
- N DA,I
- I '$G(IBNOASK) S IBIFN=+$G(Y)
- I '$G(IBIFN) G ASK
- I IBCAN>1 D NOPTF^IBCB2 I 'IBAC1 D NOPTF1^IBCB2 G ASK
- ;
- I $G(IBCNCRD)=1,$P($P($G(^DGCR(399,IBIFN,0)),U),"-",2)>98 D Q
- .W !!,"Please note that you have exceeded the maximum number of iterations (99) for this claim."
- .W "Copy and cancel (CLON) must be used to correct this bill."
- .I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
- .S IBQUIT=1 H 3
- ; Check if bill has been referred to Counsel
- I $P($G(^PRCA(430,IBIFN,6)),U,4) D G ASK
- . W !,"This bill has been referred to Regional Counsel and cannot be 'CANCELLED' in"
- . W !,"Integrated Billing. Please use the option 'TP Referred Follow-up'"
- . W !,"[PRCA RC ACTION MENU] in Accounts Receivable to request that Regional"
- . W !,"Counsel return the bill to your facility."
- . Q
- ;
- F I=0,"S","U1" S IB(I)=$G(^DGCR(399,IBIFN,I))
- S IBSTAT=$P(IB(0),U,13)
- ; REMOVE New messages for CRD option IB*2.0*433 in IB*2.0*447 IA#5630
- ;I $G(IBCNCRD)=1,IBSTAT'=2,'$$ACCK^PRCAACC(IBIFN) D Q
- ;.W !!,"This option cannot be used to correct some Billing Rate Types (Example: TRICARE)"
- ;.W "Copy and cancel (CLON) must be used to correct this bill."
- ;.S IBQUIT=1 H 3
- ;
- ; Restrict access to this process for REQUEST MRA bills
- I IBSTAT=2,'$G(IBCE("EDI")),$$MRAWL^IBCEMU2(IBIFN) D G ASK
- . W !!?4,"This bill is in a status of REQUEST MRA and it does appear on the"
- . W !?4,"MRA Management Work List. Please use the 'MRA Management Menu' options"
- . W !?4,"for all processing related to this bill."
- . Q
- ;
- ; IB*2.0*432 Restrict access to claims on the new CBW Worklist
- I $P($G(^DGCR(399,IBIFN,"S1")),U,7)=1,$G(IBMRANOT)'=1 D G ASK
- . W !!?4,"This bill appears on the CBW Management Work List. Please use the"
- . W !?4,"'CBW Management Menu' options for all processing related to this bill."
- . S IBQUIT=1 ;IB*2.0*592 JRA need to set quit flag after issuing this message
- . Q
- ;
- ; 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
- ; need to check if that
- ;WCJ;IB727;make sure if any MRAs are received that all MRAs are received
- ;I $G(IBCNCRD)=1,$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1,$$SPLTMRA^IBCEMU1(IBIFN)=1 D Q
- N IBRETSPLT
- 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
- .;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."
- .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."
- .I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
- .S IBQUIT=1 H 3
- .Q
- ;
- ; Warning message if in a REQUEST MRA status with no MRA on file
- ; IB*2.0*516/TAZ,MRD - Forbid the user from using the option CRD
- ; (Correct Rejected/Denied Bill) on an MRA claim if the status is
- ; REQUEST MRA (IBSTAT=2).
- I IBSTAT=2,'$$MRACNT^IBCEMU1(IBIFN) D I $G(IBQUIT) H 3 Q
- . N REJ
- . D TXSTS^IBCEMU2(IBIFN,,.REJ)
- . ;IB*2.0*516/TAZ - If CRD is from CSA allow a REJected claim to be CRD'ed without displaying a warning.
- . I $G(IBCNCSA),REJ Q
- . W *7,!!?4,$S('$G(IBCNCRD):"Warning! ",1:""),"This bill is in a status of REQUEST MRA."
- . W !?4,"No MRAs have been received"
- . I REJ W ", but the most recent transmission of this",!?4,"MRA request bill was rejected."
- . I 'REJ W " and there are no rejection messages on file",!?4,"for the most recent transmission of this MRA request bill."
- . I $G(IBCNCRD) S IBQUIT=1 I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
- . Q
- ;
- I IBCAN=2,IB("S")]"",+$P(IB("S"),U,16),$P(IB("S"),U,17)]"" D G 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),"."
- . S IBQUIT=1
- ;
- ; IB*2.0*516/TAZ,MRD - Forbid the user from using the option CRD
- ; (Correct Rejected/Denied Bill) on all but primary claims.
- I $G(IBCNCRD),($$COB^IBCEF(IBIFN)'="P") D Q
- . W !!,"Please note that COB data may exist for this bill."
- . W !,"Copy and cancel (CLON) must be used to correct this bill."
- . I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) ; IB*2.0*597
- . S IBQUIT=1
- . H 3
- . Q
- ;
- ; Notify if a payment has been posted to this bill before cancel
- N PRCABILL
- S PRCABILL=$$TPR^PRCAFN(IBIFN)
- 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
- I PRCABILL>0 W !!,"Please note a PAYMENT of **$"_$$TPR^PRCAFN(IBIFN)_"** has been POSTED to this bill."
- ; New message for CRD option
- 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
- ;
- ; If bill was created via Electronic claims process then notify
- ; user that cancellation should occur using ECME package
- I $$GET1^DIQ(399,IBIFN_",",460)]"" D G:'Y ASK
- . W !!!?5,"This bill was created by the"
- . W !?5,"Electronic Claims Management Engine (ECME)."
- . W !?5,"Cancellation needs to occur in the ECME package by"
- . W !?5,"submitting a REVERSAL to the Payer.",!!
- . 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
- . I Y=0 W !!,"<PLEASE SUBMIT A REVERSAL USING THE APPROPRIATE OPTION IN THE ECME PACKAGE>",$C(7)
- ;
- CHK ;
- ; if user came from CLON, make sure they know about the new CRD option IB*2.0*447 remove TRICARE msg.
- I $G(IBCNCOPY)=1 D
- .W !!,*7,"Warning: This option should NOT be used to correct Rejected/Denied claims."
- .W !," It should ONLY be used to correct DENIED claims which have payments"
- .W !," posted against them.***" ; and claims with certain Billing Rate Types (Example: TRICARE)."
- ;
- 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
- ;
- I '$G(IBCEAUTO) W !!,"LAST CHANCE TO CHANGE YOUR MIND..."
- S DIE=399,DA=IBIFN,DIE("NO^")=""
- S DR="16;S:'X Y=0;19;S IBCCCC=1;"
- I $G(IBCEAUTO) S DR="16////1;19////EDI/MRA TURNED OFF;S IBCCCC=1;"
- ;
- ; esg - 8/23/06 - IB*2*358 - fix semi-colon in free text field
- I $G(IBMCSRSC)'="" S DR="16;S:'X Y=0;19//^S X=IBMCSRSC;S IBCCCC=1;"
- D ^DIE K DIE,DR
- ;
- NO I 'IBCCCC W !!,"<NO ACTION TAKEN>",*7 S IBQUIT=1 G ASK:IBCAN<2,Q
- S IBCCR=$P($G(^DGCR(399,IBIFN,"S")),U,19)
- ; update claim # with new iteration IB*2.0*447 move to later in the process
- ;D:$G(IBCNCRD)=1 CRD
- W !!,"...Bill has been cancelled..." D BULL^IBCBULL,BSTAT^IBCDC(IBIFN),PRIOR^IBCCC2(IBIFN)
- ;
- ; cancelling in ingenix claimsmanager if ingenix is running
- ; clean-up of variables is OK if not coming in from ListMan screen
- I $$CM^IBCIUT1(IBIFN) S IBCISNT=4 D ST2^IBCIST I '$G(IBCICNCL) K IBCISNT,IBCISTAT,IBCIREDT,IBCIERR
- ;
- S IBEDI=$G(IB364)
- I 'IBEDI S IBEDI=+$$LAST364^IBCEF4(IBIFN)
- ; ib*2.0*547 don't cancel MRA if cloning a bill that is secondary to MRA (share the same claim#)
- I IBEDI D UPDEDI^IBCEM(IBEDI,"C",,$S($$MRASEC^IBCEF4(IBIFN):2,1:"")) ;Update EDI files, if needed
- ;
- F I="S","U1" S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),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)
- 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")
- S PRCASV("BY")=$S($P(IB("S"),U,18)]"":$P(IB("S"),U,18),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
- ;S X=$$CANCEL^RCBEIB($G(PRCASV("ARREC")),$G(PRCASV("DATE")),$G(PRCASV("BY")),$G(PRCASV("AMT")),$G(PRCASV("COMMENT")))
- S PRCASV("ARCRD")=$G(IBCNCRD)
- S X=$$CANCEL^RCBEIB($G(PRCASV("ARREC")),$G(PRCASV("DATE")),$G(PRCASV("BY")),$G(PRCASV("AMT")),$G(PRCASV("COMMENT")),$G(PRCASV("ARCRD")))
- W !,$S(X:">> The receivable associated with the claim was cancelled.",1:">> The receivable associated with the claim was not cancelled.")
- I $P(X,U,2)]"" W !,">>> ",$P(X,U,2) ; The reason why the claim can not be cancelled.
- I IBCAN<2 D RNB^IBCC1 ;assign a reason not billable
- G ASK:IBCAN<2,Q
- ;
- 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
- Q
- 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
- G ASK
- Q1 K:IBCAN=1 IBQUIT K IBCAN
- Q K %,IBEPAR,IBSTAT,IBARST,IBAC1,IB,DFN,IBX,IBZ,DIC,DIE,DR,PRCASV,PRCASVC,X,Y,IBEDI
- I $G(IBLOCK)'<1 L -^DGCR(399,IBLOCK) K IBLOCK ; IB*2.0*597
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- Q
- CRD(IBIFN) ; entry to point to add iteration # to claim
- N IBFDA
- S IBITN=$$ITN^IBCCC(IBIFN)
- S IBFDA(399,IBIFN_",",.01)=IBITN
- D FILE^DIE("","IBFDA")
- ; this will re-open the claim, so reset to cancelled
- S DIE=399,DA=IBIFN
- S DR="16////1"
- D ^DIE K DIE,DR
- Q
- ;
- PROCESS(IBIFN,IBCAN) ;
- ; Entry point when the bill number is already known. Use this when
- ; you just want to try to cancel this bill and this bill only.
- ; Input:
- ; IBIFN - Internal bill# (Required)
- ; IBCAN - Cancel Flag (optional, defaults to 1 if not included)
- ;
- NEW IBNOASK
- S IBNOASK=1
- S IBCAN=$G(IBCAN,1)
- G ASK
- ;
- LOCKED ; -- write record locked message IB*2.0*597
- W !!,"Sorry, another user currently editing this entry."
- W !,"Try again later."
- D PAUSE^VALM1
- Q
- ;IBCC
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCC 10986 printed Feb 18, 2025@23:35:26 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;MAP TO DGCRC
- +5 ;
- +6 IF '$DATA(IBCAN)
- SET IBCAN=1
- ASK ;
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- +3 ;S XRTL=$ZU(0),XRTN="IBCC-1" D T0^%ZOSV ;start rt clock
- +4 ;
- +5 ; If called at entry point PROCESS, variable IBNOASK will exist.
- +6 ; First time through, IBNOASK=1
- +7 ; Second time through, IBNOASK=2 and it will quit
- +8 IF $GET(IBNOASK)=2
- GOTO Q
- +9 IF $GET(IBNOASK)=1
- SET IBNOASK=2
- +10 ;
- +11 if $GET(IBCE("EDI"))
- GOTO Q
- +12 DO Q
- +13 ; Release currently locked record IB*2.0*597
- +14 IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- KILL IBLOCK
- +15 ;
- +16 SET IBQUIT=0
- +17 ;Suppress PATIENT file fuzzy lookups
- NEW DPTNOFZY
- SET DPTNOFZY=1
- +18 IF '$GET(IBNOASK)
- SET DIC="^DGCR(399,"
- SET DIC(0)="AEMQZ"
- SET DIC("A")="Enter BILL NUMBER or Patient NAME: "
- WRITE !!
- DO ^DIC
- IF Y<1
- SET IBQUIT=1
- GOTO Q1
- +19 KILL IB364
- +20 ; Lock file entry and display message if lock can't be obtained. IB*2.0*597
- +21 SET IBLOCK=Y
- +22 LOCK +^DGCR(399,IBLOCK):$GET(DILOCKTM,5)
- IF '$TEST
- DO LOCKED
- GOTO ASK
- +23 ;
- NOPTF ; Note if IB364 is >0 it will be used as the ien to update in file 364
- +1 NEW DA,I
- +2 IF '$GET(IBNOASK)
- SET IBIFN=+$GET(Y)
- +3 IF '$GET(IBIFN)
- GOTO ASK
- +4 IF IBCAN>1
- DO NOPTF^IBCB2
- IF 'IBAC1
- DO NOPTF1^IBCB2
- GOTO ASK
- +5 ;
- +6 IF $GET(IBCNCRD)=1
- IF $PIECE($PIECE($GET(^DGCR(399,IBIFN,0)),U),"-",2)>98
- Begin DoDot:1
- +7 WRITE !!,"Please note that you have exceeded the maximum number of iterations (99) for this claim."
- +8 WRITE "Copy and cancel (CLON) must be used to correct this bill."
- +9 ; IB*2.0*597
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- +10 SET IBQUIT=1
- HANG 3
- End DoDot:1
- QUIT
- +11 ; Check if bill has been referred to Counsel
- +12 IF $PIECE($GET(^PRCA(430,IBIFN,6)),U,4)
- Begin DoDot:1
- +13 WRITE !,"This bill has been referred to Regional Counsel and cannot be 'CANCELLED' in"
- +14 WRITE !,"Integrated Billing. Please use the option 'TP Referred Follow-up'"
- +15 WRITE !,"[PRCA RC ACTION MENU] in Accounts Receivable to request that Regional"
- +16 WRITE !,"Counsel return the bill to your facility."
- +17 QUIT
- End DoDot:1
- GOTO ASK
- +18 ;
- +19 FOR I=0,"S","U1"
- SET IB(I)=$GET(^DGCR(399,IBIFN,I))
- +20 SET IBSTAT=$PIECE(IB(0),U,13)
- +21 ; REMOVE New messages for CRD option IB*2.0*433 in IB*2.0*447 IA#5630
- +22 ;I $G(IBCNCRD)=1,IBSTAT'=2,'$$ACCK^PRCAACC(IBIFN) D Q
- +23 ;.W !!,"This option cannot be used to correct some Billing Rate Types (Example: TRICARE)"
- +24 ;.W "Copy and cancel (CLON) must be used to correct this bill."
- +25 ;.S IBQUIT=1 H 3
- +26 ;
- +27 ; Restrict access to this process for REQUEST MRA bills
- +28 IF IBSTAT=2
- IF '$GET(IBCE("EDI"))
- IF $$MRAWL^IBCEMU2(IBIFN)
- Begin DoDot:1
- +29 WRITE !!?4,"This bill is in a status of REQUEST MRA and it does appear on the"
- +30 WRITE !?4,"MRA Management Work List. Please use the 'MRA Management Menu' options"
- +31 WRITE !?4,"for all processing related to this bill."
- +32 QUIT
- End DoDot:1
- GOTO ASK
- +33 ;
- +34 ; IB*2.0*432 Restrict access to claims on the new CBW Worklist
- +35 IF $PIECE($GET(^DGCR(399,IBIFN,"S1")),U,7)=1
- IF $GET(IBMRANOT)'=1
- Begin DoDot:1
- +36 WRITE !!?4,"This bill appears on the CBW Management Work List. Please use the"
- +37 WRITE !?4,"'CBW Management Menu' options for all processing related to this bill."
- +38 ;IB*2.0*592 JRA need to set quit flag after issuing this message
- SET IBQUIT=1
- +39 QUIT
- End DoDot:1
- GOTO ASK
- +40 ;
- +41 ; 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
- +42 ; need to check if that
- +43 ;WCJ;IB727;make sure if any MRAs are received that all MRAs are received
- +44 ;I $G(IBCNCRD)=1,$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1,$$SPLTMRA^IBCEMU1(IBIFN)=1 D Q
- +45 NEW IBRETSPLT
- +46 IF $GET(IBCNCRD)=1
- IF $PIECE($GET(^DGCR(399,IBIFN,"TX")),U,8)'=1
- IF $$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)>0
- IF $$SPLIT2^IBCEMU1($ORDER(IBRETSPLT("")))=0
- Begin DoDot:1
- +47 ;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."
- +48 WRITE !!,"There is a split EOB associated with this claim. You cannot use this option to Correct this claim until all EOBs have been received."
- +49 ; IB*2.0*597
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- +50 SET IBQUIT=1
- HANG 3
- +51 QUIT
- End DoDot:1
- QUIT
- +52 ;
- +53 ; Warning message if in a REQUEST MRA status with no MRA on file
- +54 ; IB*2.0*516/TAZ,MRD - Forbid the user from using the option CRD
- +55 ; (Correct Rejected/Denied Bill) on an MRA claim if the status is
- +56 ; REQUEST MRA (IBSTAT=2).
- +57 IF IBSTAT=2
- IF '$$MRACNT^IBCEMU1(IBIFN)
- Begin DoDot:1
- +58 NEW REJ
- +59 DO TXSTS^IBCEMU2(IBIFN,,.REJ)
- +60 ;IB*2.0*516/TAZ - If CRD is from CSA allow a REJected claim to be CRD'ed without displaying a warning.
- +61 IF $GET(IBCNCSA)
- IF REJ
- QUIT
- +62 WRITE *7,!!?4,$SELECT('$GET(IBCNCRD):"Warning! ",1:""),"This bill is in a status of REQUEST MRA."
- +63 WRITE !?4,"No MRAs have been received"
- +64 IF REJ
- WRITE ", but the most recent transmission of this",!?4,"MRA request bill was rejected."
- +65 IF 'REJ
- WRITE " and there are no rejection messages on file",!?4,"for the most recent transmission of this MRA request bill."
- +66 ; IB*2.0*597
- IF $GET(IBCNCRD)
- SET IBQUIT=1
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- +67 QUIT
- End DoDot:1
- IF $GET(IBQUIT)
- HANG 3
- QUIT
- +68 ;
- +69 IF IBCAN=2
- IF IB("S")]""
- IF +$PIECE(IB("S"),U,16)
- IF $PIECE(IB("S"),U,17)]""
- Begin DoDot:1
- +70 WRITE !!,"This bill was cancelled on "
- SET Y=$PIECE(IB("S"),U,17)
- XECUTE ^DD("DD")
- WRITE Y," by ",$SELECT($PIECE(IB("S"),U,18)']"":IBU,$DATA(^VA(200,$PIECE(IB("S"),U,18),0)):$PIECE(^(0),U,1),1:IBU),"."
- +71 SET IBQUIT=1
- End DoDot:1
- GOTO 1
- +72 ;
- +73 ; IB*2.0*516/TAZ,MRD - Forbid the user from using the option CRD
- +74 ; (Correct Rejected/Denied Bill) on all but primary claims.
- +75 IF $GET(IBCNCRD)
- IF ($$COB^IBCEF(IBIFN)'="P")
- Begin DoDot:1
- +76 WRITE !!,"Please note that COB data may exist for this bill."
- +77 WRITE !,"Copy and cancel (CLON) must be used to correct this bill."
- +78 ; IB*2.0*597
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- +79 SET IBQUIT=1
- +80 HANG 3
- +81 QUIT
- End DoDot:1
- QUIT
- +82 ;
- +83 ; Notify if a payment has been posted to this bill before cancel
- +84 NEW PRCABILL
- +85 SET PRCABILL=$$TPR^PRCAFN(IBIFN)
- +86 IF PRCABILL=-1
- WRITE !!,"Please note: PRCA was unable to determine if a payment has been posted."
- IF $GET(IBCNCRD)=1
- WRITE !,"Copy and cancel (CLON) must be used to correct this bill."
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- SET IBQUIT=1
- HANG 3
- QUIT
- +87 IF PRCABILL>0
- WRITE !!,"Please note a PAYMENT of **$"_$$TPR^PRCAFN(IBIFN)_"** has been POSTED to this bill."
- +88 ; New message for CRD option
- +89 IF $GET(IBCNCRD)=1
- IF PRCABILL>0
- WRITE !,"Copy and cancel (CLON) must be used to correct this bill."
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- SET IBQUIT=1
- HANG 3
- QUIT
- +90 ;
- +91 ; If bill was created via Electronic claims process then notify
- +92 ; user that cancellation should occur using ECME package
- +93 IF $$GET1^DIQ(399,IBIFN_",",460)]""
- Begin DoDot:1
- +94 WRITE !!!?5,"This bill was created by the"
- +95 WRITE !?5,"Electronic Claims Management Engine (ECME)."
- +96 WRITE !?5,"Cancellation needs to occur in the ECME package by"
- +97 WRITE !?5,"submitting a REVERSAL to the Payer.",!!
- +98 KILL DIR
- SET DIR("A",1)="Has a REVERSAL for this e-Claim already been"
- SET DIR("A")="submitted to the payer via the ECME package (Y/N)"
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +99 IF Y=0
- WRITE !!,"<PLEASE SUBMIT A REVERSAL USING THE APPROPRIATE OPTION IN THE ECME PACKAGE>",$CHAR(7)
- End DoDot:1
- if 'Y
- GOTO ASK
- +100 ;
- CHK ;
- +1 ; if user came from CLON, make sure they know about the new CRD option IB*2.0*447 remove TRICARE msg.
- +2 IF $GET(IBCNCOPY)=1
- Begin DoDot:1
- +3 WRITE !!,*7,"Warning: This option should NOT be used to correct Rejected/Denied claims."
- +4 WRITE !," It should ONLY be used to correct DENIED claims which have payments"
- +5 ; and claims with certain Billing Rate Types (Example: TRICARE)."
- WRITE !," posted against them.***"
- End DoDot:1
- +6 ;
- +7 SET (IBCCCC,IBQUIT)=0
- IF '$GET(IBCEAUTO)
- IF '$GET(IBMCSCAN)
- WRITE !!,"ARE YOU SURE YOU WANT TO CANCEL THIS BILL"
- SET %=2
- DO YN^DICN
- if %=0
- GOTO HELP
- IF %'=1
- SET IBQUIT=1
- GOTO NO
- +8 ;
- +9 IF '$GET(IBCEAUTO)
- WRITE !!,"LAST CHANCE TO CHANGE YOUR MIND..."
- +10 SET DIE=399
- SET DA=IBIFN
- SET DIE("NO^")=""
- +11 SET DR="16;S:'X Y=0;19;S IBCCCC=1;"
- +12 IF $GET(IBCEAUTO)
- SET DR="16////1;19////EDI/MRA TURNED OFF;S IBCCCC=1;"
- +13 ;
- +14 ; esg - 8/23/06 - IB*2*358 - fix semi-colon in free text field
- +15 IF $GET(IBMCSRSC)'=""
- SET DR="16;S:'X Y=0;19//^S X=IBMCSRSC;S IBCCCC=1;"
- +16 DO ^DIE
- KILL DIE,DR
- +17 ;
- NO IF 'IBCCCC
- WRITE !!,"<NO ACTION TAKEN>",*7
- SET IBQUIT=1
- if IBCAN<2
- GOTO ASK
- GOTO Q
- +1 SET IBCCR=$PIECE($GET(^DGCR(399,IBIFN,"S")),U,19)
- +2 ; update claim # with new iteration IB*2.0*447 move to later in the process
- +3 ;D:$G(IBCNCRD)=1 CRD
- +4 WRITE !!,"...Bill has been cancelled..."
- DO BULL^IBCBULL
- DO BSTAT^IBCDC(IBIFN)
- DO PRIOR^IBCCC2(IBIFN)
- +5 ;
- +6 ; cancelling in ingenix claimsmanager if ingenix is running
- +7 ; clean-up of variables is OK if not coming in from ListMan screen
- +8 IF $$CM^IBCIUT1(IBIFN)
- SET IBCISNT=4
- DO ST2^IBCIST
- IF '$GET(IBCICNCL)
- KILL IBCISNT,IBCISTAT,IBCIREDT,IBCIERR
- +9 ;
- +10 SET IBEDI=$GET(IB364)
- +11 IF 'IBEDI
- SET IBEDI=+$$LAST364^IBCEF4(IBIFN)
- +12 ; ib*2.0*547 don't cancel MRA if cloning a bill that is secondary to MRA (share the same claim#)
- +13 ;Update EDI files, if needed
- IF IBEDI
- DO UPDEDI^IBCEM(IBEDI,"C",,$SELECT($$MRASEC^IBCEF4(IBIFN):2,1:""))
- +14 ;
- +15 FOR I="S","U1"
- SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
- +16 SET PRCASV("ARREC")=IBIFN
- SET PRCASV("AMT")=$SELECT(IB("U1")']"":0,1:$PIECE(IB("U1"),"^"))
- SET PRCASV("DATE")=$PIECE(IB("S"),"^",17)
- SET PRCASV("BY")=$PIECE(IB("S"),"^",18)
- +17 SET PRCASV("COMMENT")=$SELECT($PIECE(IB("S"),U,19)]"":$PIECE(IB("S"),U,19),$PIECE(^IBE(350.9,1,2),"^",7)]"":$PIECE(^(2),"^",7),1:"BILL CANCELLED IN MAS")
- +18 SET PRCASV("BY")=$SELECT($PIECE(IB("S"),U,18)]"":$PIECE(IB("S"),U,18),1:"")
- +19 ; 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
- +20 ;S X=$$CANCEL^RCBEIB($G(PRCASV("ARREC")),$G(PRCASV("DATE")),$G(PRCASV("BY")),$G(PRCASV("AMT")),$G(PRCASV("COMMENT")))
- +21 SET PRCASV("ARCRD")=$GET(IBCNCRD)
- +22 SET X=$$CANCEL^RCBEIB($GET(PRCASV("ARREC")),$GET(PRCASV("DATE")),$GET(PRCASV("BY")),$GET(PRCASV("AMT")),$GET(PRCASV("COMMENT")),$GET(PRCASV("ARCRD")))
- +23 WRITE !,$SELECT(X:">> The receivable associated with the claim was cancelled.",1:">> The receivable associated with the claim was not cancelled.")
- +24 ; The reason why the claim can not be cancelled.
- IF $PIECE(X,U,2)]""
- WRITE !,">>> ",$PIECE(X,U,2)
- +25 ;assign a reason not billable
- IF IBCAN<2
- DO RNB^IBCC1
- +26 if IBCAN<2
- GOTO ASK
- GOTO Q
- +27 ;
- HELP WRITE !,?3,"Answer 'YES' or 'Y' if you wish to cancel this bill.",!,?3,"Answer 'NO' or 'N' if you want to abort."
- GOTO CHK
- +1 QUIT
- 1 IF $PIECE(IB(0),U,13)=1
- WRITE !,"This record was re-opened on "
- SET Y=$PIECE(IB(0),U,14)
- XECUTE ^DD("DD")
- WRITE Y,"."
- GOTO CHK
- +1 GOTO ASK
- Q1 if IBCAN=1
- KILL IBQUIT
- KILL IBCAN
- Q KILL %,IBEPAR,IBSTAT,IBARST,IBAC1,IB,DFN,IBX,IBZ,DIC,DIE,DR,PRCASV,PRCASVC,X,Y,IBEDI
- +1 ; IB*2.0*597
- IF $GET(IBLOCK)'<1
- LOCK -^DGCR(399,IBLOCK)
- KILL IBLOCK
- +2 ;***
- +3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCC" D T1^%ZOSV ;stop rt clock
- +4 QUIT
- CRD(IBIFN) ; entry to point to add iteration # to claim
- +1 NEW IBFDA
- +2 SET IBITN=$$ITN^IBCCC(IBIFN)
- +3 SET IBFDA(399,IBIFN_",",.01)=IBITN
- +4 DO FILE^DIE("","IBFDA")
- +5 ; this will re-open the claim, so reset to cancelled
- +6 SET DIE=399
- SET DA=IBIFN
- +7 SET DR="16////1"
- +8 DO ^DIE
- KILL DIE,DR
- +9 QUIT
- +10 ;
- PROCESS(IBIFN,IBCAN) ;
- +1 ; Entry point when the bill number is already known. Use this when
- +2 ; you just want to try to cancel this bill and this bill only.
- +3 ; Input:
- +4 ; IBIFN - Internal bill# (Required)
- +5 ; IBCAN - Cancel Flag (optional, defaults to 1 if not included)
- +6 ;
- +7 NEW IBNOASK
- +8 SET IBNOASK=1
- +9 SET IBCAN=$GET(IBCAN,1)
- +10 GOTO ASK
- +11 ;
- LOCKED ; -- write record locked message IB*2.0*597
- +1 WRITE !!,"Sorry, another user currently editing this entry."
- +2 WRITE !,"Try again later."
- +3 DO PAUSE^VALM1
- +4 QUIT
- +5 ;IBCC