RCBECHGI ;WISC/RFJ-add interest charges to bill (called by rcbechgs) ;1 Jun 00
;;4.5;Accounts Receivable;**153**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
INTEREST ; this is called by rcbechgs and is a continuation of that routine
; variables passed to this entry point:
; rcdata0 = the 0th node for the debtor in file 340
; rcupdate = the fm date that charges are being added
; the rcupdate variable is the statement date for non-benefit
; debts or (statement date minus 3 days) for benefit (first
; party debts)
;
N DAYSINT,FROMDATE,RCBILLDA,RCDATA6,RCDATE,RCLASTDT
;
S RCDATE=0 F S RCDATE=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE)) Q:'RCDATE D
. S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBECHGS",$J,"LIST",RCDATE,RCBILLDA)) Q:'RCBILLDA D
. . ; bill category is set up to not charge interest
. . I '$P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",10) Q
. . S RCDATA6=$G(^PRCA(430,RCBILLDA,6))
. . ; get the last date interest was charged to this bill
. . ; if the last date is not set in field .11, use field 67
. . S RCLASTDT=$P($G(^PRCA(430,RCBILLDA,.1)),"^") I 'RCLASTDT S RCLASTDT=$P(RCDATA6,"^",7)
. . ; take the current statement date in variable rcupdate
. . ; (this is actually 3 days before the statement date for
. . ; benefit first party debts and is when interest charges
. . ; get added) and subtract 1 month (this date will be the
. . ; last statement date). If the last interest charge date
. . ; is greater than the last statement date, do not add
. . ; interest a second time for the same month.
. . I RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1) Q
. . ;
. . ; *** for benefit debts (first party) notified by CCPC ***
. . ; *** interest assessed unless payment is received within ***
. . ; *** the first 57 days after initial notification. after ***
. . ; *** initial charge, interest is assessed every 30 days ***
. . ; *** letter 1 = initial notification ***
. . ; *** letter 2 = 30 days from initial notification ***
. . ; *** letter 3 = 60 days from initial notification ***
. . ; if it is a first party bill (file 340 data node 0)
. . I $P(RCDATA0,"^")["DPT(" D Q
. . . ; if the letter3 date is not set and there is interest
. . . ; balance, then this bill has had interest charged for
. . . ; 57 days do not charge interest until after letter3 sent
. . . I '$P(RCDATA6,"^",3),$P($G(^PRCA(430,RCBILLDA,7)),"^",2)>0 Q
. . . ; calculate the days of interest. if the 2nd letter sent,
. . . ; then days of interest is 57. if the 3rd letter sent,
. . . ; then days of interest is 30
. . . S DAYSINT=0
. . . I $P(RCDATA6,"^",2) S DAYSINT=57
. . . I $P(RCDATA6,"^",3) S DAYSINT=30
. . . ; calculate the interest
. . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^")=$$CALCINT(RCBILLDA,DAYSINT)
. . ;
. . ; *** for non-benefit debts (vendor,ex-employee,employee) ***
. . ; *** interest is assessed unless payment is received with***
. . ; *** in 30 days of initial notification ***
. . ; has the initial notification been sent?
. . I '$P(RCDATA6,"^",1) Q
. . ; has it been 1 month since the initial notification?
. . I RCUPDATE<$$FPS^RCAMFN01($P(RCDATA6,"^",1),1) Q
. . ; calculate the number of days of interest from the last int
. . ; charge date to the date the account is being updated
. . ; (rcupdate). rcupdate is usually the current day (the
. . ; statement date). if the last int charge is not defined,
. . ; use the letter1 date.
. . S FROMDATE=RCLASTDT I 'FROMDATE S FROMDATE=$P(RCDATA6,"^",1)
. . S DAYSINT=$$FMDIFF^XLFDT(RCUPDATE,$P(FROMDATE,"."))
. . I DAYSINT<1 Q
. . ; calculate the interest
. . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^")=$$CALCINT(RCBILLDA,DAYSINT)
Q
;
;
CALCINT(RCBILLDA,DAYSINT) ; calc the interest for a number of days (daysint)
N DATEPREP,INTEREST,PRINCPAL
; get the date the bill was prepared
S DATEPREP=$P($G(^PRCA(430,RCBILLDA,0)),"^",10) I 'DATEPREP Q 0
; get the principal balance
S PRINCPAL=$P($G(^PRCA(430,RCBILLDA,7)),"^") I 'PRINCPAL Q 0
; the interest rate based on the date the bill is prepared (rcdate)
; divided by 360 days in the year equals the current daily rate.
; multiply by the number of days to charge interest and by the
; principal balance
S INTEREST=+$J(+$$INT^RCMSFN01(DATEPREP)/360*DAYSINT*PRINCPAL,0,2)
I 'INTEREST S INTEREST=""
Q INTEREST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGI 4809 printed Dec 13, 2024@01:42:41 Page 2
RCBECHGI ;WISC/RFJ-add interest charges to bill (called by rcbechgs) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
INTEREST ; this is called by rcbechgs and is a continuation of that routine
+1 ; variables passed to this entry point:
+2 ; rcdata0 = the 0th node for the debtor in file 340
+3 ; rcupdate = the fm date that charges are being added
+4 ; the rcupdate variable is the statement date for non-benefit
+5 ; debts or (statement date minus 3 days) for benefit (first
+6 ; party debts)
+7 ;
+8 NEW DAYSINT,FROMDATE,RCBILLDA,RCDATA6,RCDATE,RCLASTDT
+9 ;
+10 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^TMP("RCBECHGS",$JOB,"LIST",RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+11 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCBECHGS",$JOB,"LIST",RCDATE,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+12 ; bill category is set up to not charge interest
+13 IF '$PIECE($GET(^PRCA(430.2,+$PIECE(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",10)
QUIT
+14 SET RCDATA6=$GET(^PRCA(430,RCBILLDA,6))
+15 ; get the last date interest was charged to this bill
+16 ; if the last date is not set in field .11, use field 67
+17 SET RCLASTDT=$PIECE($GET(^PRCA(430,RCBILLDA,.1)),"^")
IF 'RCLASTDT
SET RCLASTDT=$PIECE(RCDATA6,"^",7)
+18 ; take the current statement date in variable rcupdate
+19 ; (this is actually 3 days before the statement date for
+20 ; benefit first party debts and is when interest charges
+21 ; get added) and subtract 1 month (this date will be the
+22 ; last statement date). If the last interest charge date
+23 ; is greater than the last statement date, do not add
+24 ; interest a second time for the same month.
+25 IF RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1)
QUIT
+26 ;
+27 ; *** for benefit debts (first party) notified by CCPC ***
+28 ; *** interest assessed unless payment is received within ***
+29 ; *** the first 57 days after initial notification. after ***
+30 ; *** initial charge, interest is assessed every 30 days ***
+31 ; *** letter 1 = initial notification ***
+32 ; *** letter 2 = 30 days from initial notification ***
+33 ; *** letter 3 = 60 days from initial notification ***
+34 ; if it is a first party bill (file 340 data node 0)
+35 IF $PIECE(RCDATA0,"^")["DPT("
Begin DoDot:3
+36 ; if the letter3 date is not set and there is interest
+37 ; balance, then this bill has had interest charged for
+38 ; 57 days do not charge interest until after letter3 sent
+39 IF '$PIECE(RCDATA6,"^",3)
IF $PIECE($GET(^PRCA(430,RCBILLDA,7)),"^",2)>0
QUIT
+40 ; calculate the days of interest. if the 2nd letter sent,
+41 ; then days of interest is 57. if the 3rd letter sent,
+42 ; then days of interest is 30
+43 SET DAYSINT=0
+44 IF $PIECE(RCDATA6,"^",2)
SET DAYSINT=57
+45 IF $PIECE(RCDATA6,"^",3)
SET DAYSINT=30
+46 ; calculate the interest
+47 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^")=$$CALCINT(RCBILLDA,DAYSINT)
End DoDot:3
QUIT
+48 ;
+49 ; *** for non-benefit debts (vendor,ex-employee,employee) ***
+50 ; *** interest is assessed unless payment is received with***
+51 ; *** in 30 days of initial notification ***
+52 ; has the initial notification been sent?
+53 IF '$PIECE(RCDATA6,"^",1)
QUIT
+54 ; has it been 1 month since the initial notification?
+55 IF RCUPDATE<$$FPS^RCAMFN01($PIECE(RCDATA6,"^",1),1)
QUIT
+56 ; calculate the number of days of interest from the last int
+57 ; charge date to the date the account is being updated
+58 ; (rcupdate). rcupdate is usually the current day (the
+59 ; statement date). if the last int charge is not defined,
+60 ; use the letter1 date.
+61 SET FROMDATE=RCLASTDT
IF 'FROMDATE
SET FROMDATE=$PIECE(RCDATA6,"^",1)
+62 SET DAYSINT=$$FMDIFF^XLFDT(RCUPDATE,$PIECE(FROMDATE,"."))
+63 IF DAYSINT<1
QUIT
+64 ; calculate the interest
+65 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^")=$$CALCINT(RCBILLDA,DAYSINT)
End DoDot:2
End DoDot:1
+66 QUIT
+67 ;
+68 ;
CALCINT(RCBILLDA,DAYSINT) ; calc the interest for a number of days (daysint)
+1 NEW DATEPREP,INTEREST,PRINCPAL
+2 ; get the date the bill was prepared
+3 SET DATEPREP=$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",10)
IF 'DATEPREP
QUIT 0
+4 ; get the principal balance
+5 SET PRINCPAL=$PIECE($GET(^PRCA(430,RCBILLDA,7)),"^")
IF 'PRINCPAL
QUIT 0
+6 ; the interest rate based on the date the bill is prepared (rcdate)
+7 ; divided by 360 days in the year equals the current daily rate.
+8 ; multiply by the number of days to charge interest and by the
+9 ; principal balance
+10 SET INTEREST=+$JUSTIFY(+$$INT^RCMSFN01(DATEPREP)/360*DAYSINT*PRINCPAL,0,2)
+11 IF 'INTEREST
SET INTEREST=""
+12 QUIT INTEREST
