- RCBEADJ ;WISC/RFJ-adjustment ;Jun 06, 2014@19:11:19
- ;;4.5;Accounts Receivable;**169,172,204,173,208,233,298,301,315,326,338,371,420**;Mar 20, 1995;Build 1
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- ;
- DECREASE ; menu option: create a decrease adjustment
- D ADJUST("DECREASE")
- Q
- ;
- ;
- INCREASE ; menu option: create an increase adjustment
- D ADJUST("INCREASE")
- Q
- ;
- ADJUST(RCBETYPE,RCEDI) ; create an adjustment
- ; rcbetype = INCREASE for increase or DECREASE for decrease
- ; rcedi = the ien of the bill selected via the EDI Worklist;ien of
- ; XX the ERA entry or null/undefined if bill should be selected
- I '$G(GOTBILL) N RCBILLDA ;PRCA*4.5*315 If entering from worklist
- F D Q:RCBILLDA<0!$G(RCEDI)!$G(GOTBILL)
- . K RCTRANDA,RCLIST,RCTRREV
- . ;
- . ; select a bill
- . I '$G(GOTBILL) S RCBILLDA=$S('$G(RCEDI):$$GETABILL^RCBEUBIL,1:+RCEDI) ;PRCA*4.5*315
- . I RCBILLDA<1 Q
- . I $D(^PRCA(430,"TCSP",RCBILLDA)),(RCBETYPE="INCREASE") D ;PRCA*4.5*315/DRF
- .. S RCTRREV=$$ASKREV()
- .. W !
- . I $D(^PRCA(430,"TCSP",RCBILLDA)),(RCBETYPE="DECREASE") S %=$$ASKCM Q:(%'=1) ; prca*4.5*301 & *315
- . ;
- . ; adjust the bill
- . D ADJBILL(RCBETYPE,RCBILLDA,$P($G(RCEDI),";",2))
- Q
- ;
- ADJBILL(RCBETYPE,RCBILLDA,RCEDIWL) ; adjust a bill
- ; RCEDIWL = ien of ERA entry if called from worklist
- N RCAMOUNT,RCBALANC,RCDATA7,RCLIST,RCONTADJ,RCTRANDA,TOTALCAL,TOTALSTO,I,X,Y,RCFDA
- ; lock the bill
- L +^PRCA(430,RCBILLDA):5 E W !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL." Q
- ;
- ; show data for the bill
- D SHOWBILL^RCWROFF1(RCBILLDA)
- ;
- ; check the balance of the bill
- W !!,"Checking the bill's balance ..."
- S RCBALANC=$$OUTOFBAL^RCBDBBAL(RCBILLDA)
- I RCBALANC="" W " IN Balance!"
- ;
- ; out of balance, ask to fix it
- I RCBALANC'="" D I RCBILLDA<1 D UNLOCK Q
- . S TOTALCAL=$P(RCBALANC,"^")+$P(RCBALANC,"^",2)+$P(RCBALANC,"^",3)+$P(RCBALANC,"^",4)+$P(RCBALANC,"^",5)
- . S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
- . S TOTALSTO=$P(RCDATA7,"^")+$P(RCDATA7,"^",2)+$P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5)
- . W " OUT of Balance!"
- . W !!," BALANCE:",$J("Calculated",12),$J("Stored",12)
- . W !," ------- ",$J("------------",12),$J("------------",12)
- . W !," Principal Balance:",$J($P(RCBALANC,"^",1),12,2),$J($P(RCDATA7,"^",1),12,2)
- . I +$P(RCBALANC,"^",1)'=+$P(RCDATA7,"^",1) W " <<-- OUT OF BALANCE"
- . W !," Interest Balance:",$J($P(RCBALANC,"^",2),12,2),$J($P(RCDATA7,"^",2),12,2)
- . I +$P(RCBALANC,"^",2)'=+$P(RCDATA7,"^",2) W " <<-- OUT OF BALANCE"
- . W !," Admin Balance:",$J($P(RCBALANC,"^",3),12,2),$J($P(RCDATA7,"^",3),12,2)
- . I +$P(RCBALANC,"^",3)'=+$P(RCDATA7,"^",3) W " <<-- OUT OF BALANCE"
- . W !," MF Balance:",$J($P(RCBALANC,"^",4),12,2),$J($P(RCDATA7,"^",4),12,2)
- . I +$P(RCBALANC,"^",4)'=+$P(RCDATA7,"^",4) W " <<-- OUT OF BALANCE"
- . W !," CC Balance:",$J($P(RCBALANC,"^",5),12,2),$J($P(RCDATA7,"^",5),12,2)
- . I +$P(RCBALANC,"^",5)'=+$P(RCDATA7,"^",5) W " <<-- OUT OF BALANCE"
- . W !," ------- ",$J("-------------",12),$J("-------------",12)
- . W !," TOTAL:",$J(TOTALCAL,12,2),$J(TOTALSTO,12,2)
- . I +TOTALCAL'=+TOTALSTO W " <<-- OUT OF BALANCE"
- . ;
- . ; ask to fix the balances
- . S Y=$$ASKFIX I Y'=1 W !," NOTE: You must fix the Balance Discrepancy before processing an adjustment!" S RCBILLDA=0 Q
- . ;
- . ; fix it
- . ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
- . S RCFDA(430,RCBILLDA_",",71)=+$P(RCBALANC,"^",1) ; principal
- . S RCFDA(430,RCBILLDA_",",72)=+$P(RCBALANC,"^",2) ; interest
- . S RCFDA(430,RCBILLDA_",",73)=+$P(RCBALANC,"^",3) ; admin
- . S RCFDA(430,RCBILLDA_",",74)=+$P(RCBALANC,"^",4) ; marshal fee
- . S RCFDA(430,RCBILLDA_",",75)=+$P(RCBALANC,"^",5) ; court cost
- . D FILE^DIE(,"RCFDA")
- . ;
- . W !," Balance Discrepancy FIXED!"
- ;
- ; if the principal balance is zero, do not allow it to be adjusted
- ; ask to close/cancel it
- I RCBETYPE="DECREASE",'$G(^PRCA(430,RCBILLDA,7)) W !!,"Note: This bill has NO PRINCIPAL BALANCE to decrease !" D INTADMIN(RCBILLDA),UNLOCK Q
- ;
- ; If entry is from EDI Lockbox worklist, display total adjustments in ERA
- N AP D
- .N BILL,EOB,ERA,SEQ S ERA="",AP=0
- .F S ERA=$O(^RCY(344.4,"AP",1,ERA)) Q:'ERA D Q:AP
- ..S SEQ=0
- ..F S SEQ=$O(^RCY(344.4,"AP",1,ERA,SEQ)) Q:'SEQ D Q:AP
- ...S EOB=$P($G(^RCY(344.4,ERA,1,SEQ,0)),U,2) Q:'EOB
- ...S:$P($G(^IBM(361.1,EOB,0)),U)=RCBILLDA AP=1 ;IA #4051
- ;
- ; Ask to enter transaction even though it is marked for autopost PRCA*4.5*298
- I RCBETYPE="DECREASE",AP S Y=$$ASKAUPO() I Y'=1 W !,"Exiting bill adjustment." D UNLOCK Q
- ;
- ; Display warning for decrease adjustment if pending payments exist
- I RCBETYPE="DECREASE" D WARN^RCBEADJ1(RCBILLDA) ; PRCA*4.5*326
- ;
- ; ask to enter adjustment amount
- S RCAMOUNT=$$AMOUNT(RCBILLDA,RCBETYPE)
- I RCAMOUNT<0 D UNLOCK Q
- ;
- ; if decrease, make negative
- I RCBETYPE="DECREASE" S RCAMOUNT=-RCAMOUNT
- ;
- ; ask if it is a contract adjustment (Community Care added check for all 3rd party categories PRCA*4.5*338)
- I RCBETYPE="DECREASE",$$THRDPRTY(RCBILLDA) S RCONTADJ=$$ASKCONT I RCONTADJ<0 D UNLOCK Q
- ;
- ; show what the new transaction will look like
- S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
- W !!,"If you process the transaction, the bill will look like:"
- W !,"Current Principal Balance: ",$J($P(RCDATA7,"^"),11,2)
- W !," NEW ",RCBETYPE," Adjustment: ",$J(RCAMOUNT,11,2)
- W !," -----------"
- W !," NEW Principal Balance: ",$J($P(RCDATA7,"^")+RCAMOUNT,11,2)
- ;
- ; ask to enter transaction
- S Y=$$ASKOK(RCBETYPE) I Y'=1 D UNLOCK Q
- ;
- ADDADJ ; add adjustment
- N BILL
- S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,RCAMOUNT,"","","",$G(RCONTADJ))
- S BILL=RCBILLDA ; used in ^RCTCSPD5 PRCA*4.5*420
- I 'RCTRANDA W !," *** W A R N I N G: Adjustment NOT Processed! ***" D UNLOCK Q
- I RCTRANDA W !," Adjustment Transaction: ",RCTRANDA," has been added."
- I RCTRANDA,'$G(RCEDIWL),(RCBETYPE="DECREASE"),$D(^PRCA(430,"TCSP",RCBILLDA)) D DECADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;prca*4.5*301 add cs decrease adjustment
- I RCTRANDA,$G(RCTRREV)=0 S PRCABN=RCBILLDA D CSITRN^RCTCSPD5
- I RCTRANDA,$G(RCTRREV)=0,'$G(RCEDIWL),(RCBETYPE="INCREASE"),$D(^PRCA(430,"TCSP",RCBILLDA)) S PRCABN=RCBILLDA D INCADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;PRCA*4.5*315/DRF add cs increase adjustment
- I $G(RCTRREV)=1 S PRCABN=RCBILLDA D CSITRY^RCTCSPD5
- I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
- ;
- ; ask to enter a comment
- W !!,"Enter a comment for the ",RCBETYPE," Adjustment:"
- S Y=$$EDIT433^RCBEUTRA(RCTRANDA,"41;")
- ;
- ; ask to exempt interest and admin charges
- I RCBETYPE="DECREASE" D INTADMIN(RCBILLDA)
- ;
- ; notification of subsequent payer bulletin
- S RCDATA7=$G(^PRCA(430,RCBILLDA,7)),X=0
- F I=1:1:5 S X=X+$P(RCDATA7,"^",I)
- I RCDATA7'="",'X D
- . N PRCABN,PRCAEN,PRCAMT
- . S PRCABN=RCBILLDA,PRCAEN=RCTRANDA,PRCAMT=+$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
- . D EOB^PRCADJ
- ;
- ; unlock and ask the next bill to adjust
- D UNLOCK
- Q
- ;
- ;
- UNLOCK ; unlock bill and transaction
- L -^PRCA(430,RCBILLDA)
- I $G(RCTRANDA) L -^PRCA(433,RCTRANDA)
- Q
- ;
- ;
- INTADMIN(RCBILLDA) ; ask and adjust the interest and admin
- N RCAMOUNT,RCTRANDA,Y
- ;
- ; check to see if there is interest and admin charges
- S RCAMOUNT=$G(^PRCA(430,RCBILLDA,7))
- I '$P(RCAMOUNT,"^",2),'$P(RCAMOUNT,"^",3),'$P(RCAMOUNT,"^",4),'$P(RCAMOUNT,"^",5) Q
- ;
- ; only ask if there is no principal
- I RCAMOUNT Q
- ;
- W !!,"You have the option to automatically EXEMPT the interest"
- W !,"and administrative charges. This will close the bill."
- S Y=$$ASKEXEMP I Y'=1 Q
- ;
- W !!,"Creating an EXEMPT transaction ..."
- S RCTRANDA=$$EXEMPT^RCBEUTR2(RCBILLDA,$P(RCAMOUNT,"^",2)_"^"_$P(RCAMOUNT,"^",3)_"^^"_$P(RCAMOUNT,"^",4)_"^"_$P(RCAMOUNT,"^",5))
- I 'RCTRANDA W !," *** W A R N I N G: EXEMPTION NOT Processed! ***" Q
- I RCTRANDA W !," Exempt Transaction: ",RCTRANDA," has been added."
- INTC35B ;Check if CS5B entry needed for exempt transaction
- I RCTRANDA,'$G(RCEDIWL),(RCBETYPE="DECREASE"),$D(^PRCA(430,"TCSP",RCBILLDA)) D DECADJ^RCTCSPU(RCBILLDA,RCTRANDA) ;prca*4.5*301 add cs exempt
- I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
- ;
- W !," Current Bill Status: ",$P($G(^PRCA(430.3,+$P($G(^PRCA(430,RCBILLDA,0)),"^",8),0)),"^")
- Q
- ;
- ASKOK(RCBETYPE) ; ask record decrease or increase transaction
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="YES"
- S DIR("A")="Are you sure you want to enter this "_RCBETYPE_" adjustment "
- W ! D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ASKAUPO() ; ask record even though marked for auto post PRCA*4.5*298
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YOA",DIR("B")="NO"
- S DIR("A")="Marked for Auto-Post. Are you sure? (Y/N) "
- W ! D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ;PATCH 313
- ASKFIX() ; ask to fix bill's balance
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="YES"
- ;S DIR(0)="YO",DIR("B")="NO"
- S DIR("A")=" Do you want to FIX the balance discrepancy "
- W ! D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ;
- ASKEXEMP() ; ask to record an exempt transaction
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="NO"
- S DIR("A")=" Would you like to EXEMPT the interest and admin charges "
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ;
- ASKCONT() ; ask if contract adjustment
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="YES"
- S DIR("A")=" Is this a CONTRACT adjustment "
- W ! D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ;
- ASKREV() ; Ask if Treasury reversal *315/DRF
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="NO"
- S DIR("A")=" Is this a TREASURY reversal "
- W ! D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ;
- ADJNUM(RCBILLDA) ; get next adjustment number for a bill
- N %,ADJUST,DATA1,RCTRANDA
- S RCTRANDA=0
- F S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) Q:'RCTRANDA S DATA1=$G(^PRCA(433,RCTRANDA,1)) I $P(DATA1,"^",4),$P(DATA1,"^",2)=1!($P(DATA1,"^",2)=35) S ADJUST=$P(DATA1,"^",4)+1
- Q ADJUST
- ;
- ;
- AMOUNT(RCBILLDA,RCBETYPE) ; enter the adjustment amount for a bill
- N DIR,DIRUT,DTOUT,DUOUT,PRINBAL,X,Y
- S PRINBAL=+$P($G(^PRCA(430,RCBILLDA,7)),"^")
- I RCBETYPE="INCREASE" S PRINBAL=9999999.99
- W !!,"Enter the ",RCBETYPE," Adjustment AMOUNT, from .01 to ",$J(PRINBAL,0,2),"."
- S DIR(0)="NAO^.01:"_PRINBAL_":2"
- S DIR("A")=" "_RCBETYPE_" PRINCIPAL BALANCE BY: "
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q $S(Y'="":Y,1:-1)
- ;
- ASKCM() ; ask if the action is being performed due to the claims matching process *315
- N DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="YO",DIR("B")="NO"
- S DIR("A")="Is this action being performed due to the CLAIMS MATCHING process "
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) S Y=-1 I $G(GOTBILL) S RCDPGQ=1 ; account profile listman quit flag *315
- Q Y
- ;
- ;
- THRDPRTY(RCBILLDA) ; check whether or not bill is THIRD PARTY
- N CAT
- S CAT=$$GET1^DIQ(430,RCBILLDA,2,"I") ; get account receivable category
- I $$GET1^DIQ(430.2,CAT,5,"I")="T" Q 1 ; return true if AR Category is THIRD PARTY
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEADJ 12066 printed Feb 18, 2025@23:09 Page 2
- RCBEADJ ;WISC/RFJ-adjustment ;Jun 06, 2014@19:11:19
- +1 ;;4.5;Accounts Receivable;**169,172,204,173,208,233,298,301,315,326,338,371,420**;Mar 20, 1995;Build 1
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- DECREASE ; menu option: create a decrease adjustment
- +1 DO ADJUST("DECREASE")
- +2 QUIT
- +3 ;
- +4 ;
- INCREASE ; menu option: create an increase adjustment
- +1 DO ADJUST("INCREASE")
- +2 QUIT
- +3 ;
- ADJUST(RCBETYPE,RCEDI) ; create an adjustment
- +1 ; rcbetype = INCREASE for increase or DECREASE for decrease
- +2 ; rcedi = the ien of the bill selected via the EDI Worklist;ien of
- +3 ; XX the ERA entry or null/undefined if bill should be selected
- +4 ;PRCA*4.5*315 If entering from worklist
- IF '$GET(GOTBILL)
- NEW RCBILLDA
- +5 FOR
- Begin DoDot:1
- +6 KILL RCTRANDA,RCLIST,RCTRREV
- +7 ;
- +8 ; select a bill
- +9 ;PRCA*4.5*315
- IF '$GET(GOTBILL)
- SET RCBILLDA=$SELECT('$GET(RCEDI):$$GETABILL^RCBEUBIL,1:+RCEDI)
- +10 IF RCBILLDA<1
- QUIT
- +11 ;PRCA*4.5*315/DRF
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- IF (RCBETYPE="INCREASE")
- Begin DoDot:2
- +12 SET RCTRREV=$$ASKREV()
- +13 WRITE !
- End DoDot:2
- +14 ; prca*4.5*301 & *315
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- IF (RCBETYPE="DECREASE")
- SET %=$$ASKCM
- if (%'=1)
- QUIT
- +15 ;
- +16 ; adjust the bill
- +17 DO ADJBILL(RCBETYPE,RCBILLDA,$PIECE($GET(RCEDI),";",2))
- End DoDot:1
- if RCBILLDA<0!$GET(RCEDI)!$GET(GOTBILL)
- QUIT
- +18 QUIT
- +19 ;
- ADJBILL(RCBETYPE,RCBILLDA,RCEDIWL) ; adjust a bill
- +1 ; RCEDIWL = ien of ERA entry if called from worklist
- +2 NEW RCAMOUNT,RCBALANC,RCDATA7,RCLIST,RCONTADJ,RCTRANDA,TOTALCAL,TOTALSTO,I,X,Y,RCFDA
- +3 ; lock the bill
- +4 LOCK +^PRCA(430,RCBILLDA):5
- IF '$TEST
- WRITE !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL."
- QUIT
- +5 ;
- +6 ; show data for the bill
- +7 DO SHOWBILL^RCWROFF1(RCBILLDA)
- +8 ;
- +9 ; check the balance of the bill
- +10 WRITE !!,"Checking the bill's balance ..."
- +11 SET RCBALANC=$$OUTOFBAL^RCBDBBAL(RCBILLDA)
- +12 IF RCBALANC=""
- WRITE " IN Balance!"
- +13 ;
- +14 ; out of balance, ask to fix it
- +15 IF RCBALANC'=""
- Begin DoDot:1
- +16 SET TOTALCAL=$PIECE(RCBALANC,"^")+$PIECE(RCBALANC,"^",2)+$PIECE(RCBALANC,"^",3)+$PIECE(RCBALANC,"^",4)+$PIECE(RCBALANC,"^",5)
- +17 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
- +18 SET TOTALSTO=$PIECE(RCDATA7,"^")+$PIECE(RCDATA7,"^",2)+$PIECE(RCDATA7,"^",3)+$PIECE(RCDATA7,"^",4)+$PIECE(RCDATA7,"^",5)
- +19 WRITE " OUT of Balance!"
- +20 WRITE !!," BALANCE:",$JUSTIFY("Calculated",12),$JUSTIFY("Stored",12)
- +21 WRITE !," ------- ",$JUSTIFY("------------",12),$JUSTIFY("------------",12)
- +22 WRITE !," Principal Balance:",$JUSTIFY($PIECE(RCBALANC,"^",1),12,2),$JUSTIFY($PIECE(RCDATA7,"^",1),12,2)
- +23 IF +$PIECE(RCBALANC,"^",1)'=+$PIECE(RCDATA7,"^",1)
- WRITE " <<-- OUT OF BALANCE"
- +24 WRITE !," Interest Balance:",$JUSTIFY($PIECE(RCBALANC,"^",2),12,2),$JUSTIFY($PIECE(RCDATA7,"^",2),12,2)
- +25 IF +$PIECE(RCBALANC,"^",2)'=+$PIECE(RCDATA7,"^",2)
- WRITE " <<-- OUT OF BALANCE"
- +26 WRITE !," Admin Balance:",$JUSTIFY($PIECE(RCBALANC,"^",3),12,2),$JUSTIFY($PIECE(RCDATA7,"^",3),12,2)
- +27 IF +$PIECE(RCBALANC,"^",3)'=+$PIECE(RCDATA7,"^",3)
- WRITE " <<-- OUT OF BALANCE"
- +28 WRITE !," MF Balance:",$JUSTIFY($PIECE(RCBALANC,"^",4),12,2),$JUSTIFY($PIECE(RCDATA7,"^",4),12,2)
- +29 IF +$PIECE(RCBALANC,"^",4)'=+$PIECE(RCDATA7,"^",4)
- WRITE " <<-- OUT OF BALANCE"
- +30 WRITE !," CC Balance:",$JUSTIFY($PIECE(RCBALANC,"^",5),12,2),$JUSTIFY($PIECE(RCDATA7,"^",5),12,2)
- +31 IF +$PIECE(RCBALANC,"^",5)'=+$PIECE(RCDATA7,"^",5)
- WRITE " <<-- OUT OF BALANCE"
- +32 WRITE !," ------- ",$JUSTIFY("-------------",12),$JUSTIFY("-------------",12)
- +33 WRITE !," TOTAL:",$JUSTIFY(TOTALCAL,12,2),$JUSTIFY(TOTALSTO,12,2)
- +34 IF +TOTALCAL'=+TOTALSTO
- WRITE " <<-- OUT OF BALANCE"
- +35 ;
- +36 ; ask to fix the balances
- +37 SET Y=$$ASKFIX
- IF Y'=1
- WRITE !," NOTE: You must fix the Balance Discrepancy before processing an adjustment!"
- SET RCBILLDA=0
- QUIT
- +38 ;
- +39 ; fix it
- +40 ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
- +41 ; principal
- SET RCFDA(430,RCBILLDA_",",71)=+$PIECE(RCBALANC,"^",1)
- +42 ; interest
- SET RCFDA(430,RCBILLDA_",",72)=+$PIECE(RCBALANC,"^",2)
- +43 ; admin
- SET RCFDA(430,RCBILLDA_",",73)=+$PIECE(RCBALANC,"^",3)
- +44 ; marshal fee
- SET RCFDA(430,RCBILLDA_",",74)=+$PIECE(RCBALANC,"^",4)
- +45 ; court cost
- SET RCFDA(430,RCBILLDA_",",75)=+$PIECE(RCBALANC,"^",5)
- +46 DO FILE^DIE(,"RCFDA")
- +47 ;
- +48 WRITE !," Balance Discrepancy FIXED!"
- End DoDot:1
- IF RCBILLDA<1
- DO UNLOCK
- QUIT
- +49 ;
- +50 ; if the principal balance is zero, do not allow it to be adjusted
- +51 ; ask to close/cancel it
- +52 IF RCBETYPE="DECREASE"
- IF '$GET(^PRCA(430,RCBILLDA,7))
- WRITE !!,"Note: This bill has NO PRINCIPAL BALANCE to decrease !"
- DO INTADMIN(RCBILLDA)
- DO UNLOCK
- QUIT
- +53 ;
- +54 ; If entry is from EDI Lockbox worklist, display total adjustments in ERA
- +55 NEW AP
- Begin DoDot:1
- +56 NEW BILL,EOB,ERA,SEQ
- SET ERA=""
- SET AP=0
- +57 FOR
- SET ERA=$ORDER(^RCY(344.4,"AP",1,ERA))
- if 'ERA
- QUIT
- Begin DoDot:2
- +58 SET SEQ=0
- +59 FOR
- SET SEQ=$ORDER(^RCY(344.4,"AP",1,ERA,SEQ))
- if 'SEQ
- QUIT
- Begin DoDot:3
- +60 SET EOB=$PIECE($GET(^RCY(344.4,ERA,1,SEQ,0)),U,2)
- if 'EOB
- QUIT
- +61 ;IA #4051
- if $PIECE($GET(^IBM(361.1,EOB,0)),U)=RCBILLDA
- SET AP=1
- End DoDot:3
- if AP
- QUIT
- End DoDot:2
- if AP
- QUIT
- End DoDot:1
- +62 ;
- +63 ; Ask to enter transaction even though it is marked for autopost PRCA*4.5*298
- +64 IF RCBETYPE="DECREASE"
- IF AP
- SET Y=$$ASKAUPO()
- IF Y'=1
- WRITE !,"Exiting bill adjustment."
- DO UNLOCK
- QUIT
- +65 ;
- +66 ; Display warning for decrease adjustment if pending payments exist
- +67 ; PRCA*4.5*326
- IF RCBETYPE="DECREASE"
- DO WARN^RCBEADJ1(RCBILLDA)
- +68 ;
- +69 ; ask to enter adjustment amount
- +70 SET RCAMOUNT=$$AMOUNT(RCBILLDA,RCBETYPE)
- +71 IF RCAMOUNT<0
- DO UNLOCK
- QUIT
- +72 ;
- +73 ; if decrease, make negative
- +74 IF RCBETYPE="DECREASE"
- SET RCAMOUNT=-RCAMOUNT
- +75 ;
- +76 ; ask if it is a contract adjustment (Community Care added check for all 3rd party categories PRCA*4.5*338)
- +77 IF RCBETYPE="DECREASE"
- IF $$THRDPRTY(RCBILLDA)
- SET RCONTADJ=$$ASKCONT
- IF RCONTADJ<0
- DO UNLOCK
- QUIT
- +78 ;
- +79 ; show what the new transaction will look like
- +80 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
- +81 WRITE !!,"If you process the transaction, the bill will look like:"
- +82 WRITE !,"Current Principal Balance: ",$JUSTIFY($PIECE(RCDATA7,"^"),11,2)
- +83 WRITE !," NEW ",RCBETYPE," Adjustment: ",$JUSTIFY(RCAMOUNT,11,2)
- +84 WRITE !," -----------"
- +85 WRITE !," NEW Principal Balance: ",$JUSTIFY($PIECE(RCDATA7,"^")+RCAMOUNT,11,2)
- +86 ;
- +87 ; ask to enter transaction
- +88 SET Y=$$ASKOK(RCBETYPE)
- IF Y'=1
- DO UNLOCK
- QUIT
- +89 ;
- ADDADJ ; add adjustment
- +1 NEW BILL
- +2 SET RCTRANDA=$$INCDEC^RCBEUTR1(RCBILLDA,RCAMOUNT,"","","",$GET(RCONTADJ))
- +3 ; used in ^RCTCSPD5 PRCA*4.5*420
- SET BILL=RCBILLDA
- +4 IF 'RCTRANDA
- WRITE !," *** W A R N I N G: Adjustment NOT Processed! ***"
- DO UNLOCK
- QUIT
- +5 IF RCTRANDA
- WRITE !," Adjustment Transaction: ",RCTRANDA," has been added."
- +6 ;prca*4.5*301 add cs decrease adjustment
- IF RCTRANDA
- IF '$GET(RCEDIWL)
- IF (RCBETYPE="DECREASE")
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- DO DECADJ^RCTCSPU(RCBILLDA,RCTRANDA)
- +7 IF RCTRANDA
- IF $GET(RCTRREV)=0
- SET PRCABN=RCBILLDA
- DO CSITRN^RCTCSPD5
- +8 ;PRCA*4.5*315/DRF add cs increase adjustment
- IF RCTRANDA
- IF $GET(RCTRREV)=0
- IF '$GET(RCEDIWL)
- IF (RCBETYPE="INCREASE")
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- SET PRCABN=RCBILLDA
- DO INCADJ^RCTCSPU(RCBILLDA,RCTRANDA)
- +9 IF $GET(RCTRREV)=1
- SET PRCABN=RCBILLDA
- DO CSITRY^RCTCSPD5
- +10 IF '$GET(REFMS)&(DT>$$LDATE^RCRJR(DT))
- SET Y=$EXTRACT($$FPS^RCAMFN01(DT,1),1,5)_"01"
- DO DD^%DT
- WRITE !!," * * * * Transmission will be held until "_Y_" * * * *"
- +11 ;
- +12 ; ask to enter a comment
- +13 WRITE !!,"Enter a comment for the ",RCBETYPE," Adjustment:"
- +14 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,"41;")
- +15 ;
- +16 ; ask to exempt interest and admin charges
- +17 IF RCBETYPE="DECREASE"
- DO INTADMIN(RCBILLDA)
- +18 ;
- +19 ; notification of subsequent payer bulletin
- +20 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
- SET X=0
- +21 FOR I=1:1:5
- SET X=X+$PIECE(RCDATA7,"^",I)
- +22 IF RCDATA7'=""
- IF 'X
- Begin DoDot:1
- +23 NEW PRCABN,PRCAEN,PRCAMT
- +24 SET PRCABN=RCBILLDA
- SET PRCAEN=RCTRANDA
- SET PRCAMT=+$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5)
- +25 DO EOB^PRCADJ
- End DoDot:1
- +26 ;
- +27 ; unlock and ask the next bill to adjust
- +28 DO UNLOCK
- +29 QUIT
- +30 ;
- +31 ;
- UNLOCK ; unlock bill and transaction
- +1 LOCK -^PRCA(430,RCBILLDA)
- +2 IF $GET(RCTRANDA)
- LOCK -^PRCA(433,RCTRANDA)
- +3 QUIT
- +4 ;
- +5 ;
- INTADMIN(RCBILLDA) ; ask and adjust the interest and admin
- +1 NEW RCAMOUNT,RCTRANDA,Y
- +2 ;
- +3 ; check to see if there is interest and admin charges
- +4 SET RCAMOUNT=$GET(^PRCA(430,RCBILLDA,7))
- +5 IF '$PIECE(RCAMOUNT,"^",2)
- IF '$PIECE(RCAMOUNT,"^",3)
- IF '$PIECE(RCAMOUNT,"^",4)
- IF '$PIECE(RCAMOUNT,"^",5)
- QUIT
- +6 ;
- +7 ; only ask if there is no principal
- +8 IF RCAMOUNT
- QUIT
- +9 ;
- +10 WRITE !!,"You have the option to automatically EXEMPT the interest"
- +11 WRITE !,"and administrative charges. This will close the bill."
- +12 SET Y=$$ASKEXEMP
- IF Y'=1
- QUIT
- +13 ;
- +14 WRITE !!,"Creating an EXEMPT transaction ..."
- +15 SET RCTRANDA=$$EXEMPT^RCBEUTR2(RCBILLDA,$PIECE(RCAMOUNT,"^",2)_"^"_$PIECE(RCAMOUNT,"^",3)_"^^"_$PIECE(RCAMOUNT,"^",4)_"^"_$PIECE(RCAMOUNT,"^",5))
- +16 IF 'RCTRANDA
- WRITE !," *** W A R N I N G: EXEMPTION NOT Processed! ***"
- QUIT
- +17 IF RCTRANDA
- WRITE !," Exempt Transaction: ",RCTRANDA," has been added."
- INTC35B ;Check if CS5B entry needed for exempt transaction
- +1 ;prca*4.5*301 add cs exempt
- IF RCTRANDA
- IF '$GET(RCEDIWL)
- IF (RCBETYPE="DECREASE")
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- DO DECADJ^RCTCSPU(RCBILLDA,RCTRANDA)
- +2 IF '$GET(REFMS)&(DT>$$LDATE^RCRJR(DT))
- SET Y=$EXTRACT($$FPS^RCAMFN01(DT,1),1,5)_"01"
- DO DD^%DT
- WRITE !!," * * * * Transmission will be held until "_Y_" * * * *"
- +3 ;
- +4 WRITE !," Current Bill Status: ",$PIECE($GET(^PRCA(430.3,+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",8),0)),"^")
- +5 QUIT
- +6 ;
- ASKOK(RCBETYPE) ; ask record decrease or increase transaction
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YO"
- SET DIR("B")="YES"
- +3 SET DIR("A")="Are you sure you want to enter this "_RCBETYPE_" adjustment "
- +4 WRITE !
- DO ^DIR
- +5 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +6 QUIT Y
- +7 ;
- ASKAUPO() ; ask record even though marked for auto post PRCA*4.5*298
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YOA"
- SET DIR("B")="NO"
- +3 SET DIR("A")="Marked for Auto-Post. Are you sure? (Y/N) "
- +4 WRITE !
- DO ^DIR
- +5 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +6 QUIT Y
- +7 ;
- +8 ;PATCH 313
- ASKFIX() ; ask to fix bill's balance
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YO"
- SET DIR("B")="YES"
- +3 ;S DIR(0)="YO",DIR("B")="NO"
- +4 SET DIR("A")=" Do you want to FIX the balance discrepancy "
- +5 WRITE !
- DO ^DIR
- +6 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +7 QUIT Y
- +8 ;
- +9 ;
- ASKEXEMP() ; ask to record an exempt transaction
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YO"
- SET DIR("B")="NO"
- +3 SET DIR("A")=" Would you like to EXEMPT the interest and admin charges "
- +4 DO ^DIR
- +5 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +6 QUIT Y
- +7 ;
- +8 ;
- ASKCONT() ; ask if contract adjustment
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YO"
- SET DIR("B")="YES"
- +3 SET DIR("A")=" Is this a CONTRACT adjustment "
- +4 WRITE !
- DO ^DIR
- +5 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +6 QUIT Y
- +7 ;
- +8 ;
- ASKREV() ; Ask if Treasury reversal *315/DRF
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YO"
- SET DIR("B")="NO"
- +3 SET DIR("A")=" Is this a TREASURY reversal "
- +4 WRITE !
- DO ^DIR
- +5 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +6 QUIT Y
- +7 ;
- +8 ;
- ADJNUM(RCBILLDA) ; get next adjustment number for a bill
- +1 NEW %,ADJUST,DATA1,RCTRANDA
- +2 SET RCTRANDA=0
- +3 FOR
- SET RCTRANDA=$ORDER(^PRCA(433,"C",RCBILLDA,RCTRANDA))
- if 'RCTRANDA
- QUIT
- SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
- IF $PIECE(DATA1,"^",4)
- IF $PIECE(DATA1,"^",2)=1!($PIECE(DATA1,"^",2)=35)
- SET ADJUST=$PIECE(DATA1,"^",4)+1
- +4 QUIT ADJUST
- +5 ;
- +6 ;
- AMOUNT(RCBILLDA,RCBETYPE) ; enter the adjustment amount for a bill
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,PRINBAL,X,Y
- +2 SET PRINBAL=+$PIECE($GET(^PRCA(430,RCBILLDA,7)),"^")
- +3 IF RCBETYPE="INCREASE"
- SET PRINBAL=9999999.99
- +4 WRITE !!,"Enter the ",RCBETYPE," Adjustment AMOUNT, from .01 to ",$JUSTIFY(PRINBAL,0,2),"."
- +5 SET DIR(0)="NAO^.01:"_PRINBAL_":2"
- +6 SET DIR("A")=" "_RCBETYPE_" PRINCIPAL BALANCE BY: "
- +7 DO ^DIR
- +8 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +9 QUIT $SELECT(Y'="":Y,1:-1)
- +10 ;
- ASKCM() ; ask if the action is being performed due to the claims matching process *315
- +1 NEW DIR,DIQ2,DIRUT,DTOUT,DUOUT,X,Y
- +2 SET DIR(0)="YO"
- SET DIR("B")="NO"
- +3 SET DIR("A")="Is this action being performed due to the CLAIMS MATCHING process "
- +4 DO ^DIR
- +5 ; account profile listman quit flag *315
- IF $GET(DTOUT)!($GET(DUOUT))
- SET Y=-1
- IF $GET(GOTBILL)
- SET RCDPGQ=1
- +6 QUIT Y
- +7 ;
- +8 ;
- THRDPRTY(RCBILLDA) ; check whether or not bill is THIRD PARTY
- +1 NEW CAT
- +2 ; get account receivable category
- SET CAT=$$GET1^DIQ(430,RCBILLDA,2,"I")
- +3 ; return true if AR Category is THIRD PARTY
- IF $$GET1^DIQ(430.2,CAT,5,"I")="T"
- QUIT 1
- +4 QUIT 0