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