- 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 Mar 13, 2025@20:47:21 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