RCBECHGP ;WISC/RFJ-add penalty charges to bills (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
;
;
PENALTY ; this is called by rcbechgs and is a continuation of that routine
; variables passed to this entry point:
; 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)
;
; penalty charges are not applied to first party bills, check to make
; sure the account does not contain DPT( before calling.
;
N DAYSPEN,FROMDATE,RCBILLDA,RCDATA6,RCDATE,RCFPEN,RCLASTDT,RCLET120,REPAYDAT,X
;
; penalty charges are assessed on each bill, not just the account
; loop all bills for the account
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 set up to not charge penalty, get next bill
. . I '$P($G(^PRCA(430.2,+$P(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",12) Q
. . S RCDATA6=$G(^PRCA(430,RCBILLDA,6))
. . ; get the last date penalty was charged to this bill
. . ; if the last date is not set in field .13, use field 67
. . S RCLASTDT=$P($G(^PRCA(430,RCBILLDA,.1)),"^",3) 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 penalty charges
. . ; get added) and subtract 1 month (this date will be the
. . ; last statement date). If the last penalty charge date
. . ; is greater than the last statement date, do not add
. . ; penalty a second time for the same month.
. . I RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1) Q
. . ;
. . ; calculate 4 months from initial notification. this
. . ; date is 120 days from letter1 date.
. . I '$P(RCDATA6,"^") Q
. . S RCLET120=$$FPS^RCAMFN01($P(RCDATA6,"^",1),4)
. . ;
. . ; if the current update date is greater than (the letter1
. . ; date + 4 months), it has not been 120 days from the
. . ; initial notification, do not add penalty charges
. . I RCUPDATE<RCLET120 Q
. . ;
. . ; get the repayment plan date
. . S REPAYDAT=$P($G(^PRCA(430,RCBILLDA,4)),"^")
. . ; check to see if it was established within 120 days of
. . ; initial notification. if not charge penalty on bill
. . I REPAYDAT>RCLET120 S REPAYDAT=0
. . ;
. . ; if no repayment plan date, penalty charge from initial
. . ; delinquency date (31st day).
. . ; calculate the number of days of penalty from the last
. . ; penalty charge date to the date the account is being
. . ; updated (rcupdate). rcupdate is usually the current
. . ; statement day. if the last penalty charge is not defined,
. . ; use the letter1 date. if not letter1 date, quit
. . I 'REPAYDAT D Q
. . . S FROMDATE=RCLASTDT I 'FROMDATE S FROMDATE=$P(RCDATA6,"^") I 'FROMDATE Q
. . . S DAYSPEN=$$FMDIFF^XLFDT(RCUPDATE,$P(FROMDATE,"."))
. . . I DAYSPEN<1 Q
. . . ; calculate the penalty
. . . S X=$$CALCPEN(RCBILLDA,DAYSPEN) I 'X Q
. . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",3)=X
. . . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",5)="Full payment or repayment plan not established in 120 days from initial notification."
. . ;
. . ; check to see if the account defaulted on the repayment
. . ; plan up to the date the penalty is being charged, if so
. . ; charge penalty on the bill
. . S RCFPEN=$$REPAYDEF^RCBECHGA(RCBILLDA,RCUPDATE) I 'RCFPEN Q
. . ;
. . ; account defaulted on repayment, charge penalty
. . ; charge penalty after the 121st day from the date of default
. . I $$FMADD^XLFDT($P(RCFPEN,"^",2),121)>RCUPDATE Q
. . ; charge penalty from the last penalty charge date or
. . ; back to the date of default on the repayment plan
. . S FROMDATE=RCLASTDT I 'FROMDATE S FROMDATE=$P(RCFPEN,"^",2)
. . S DAYSPEN=$$FMDIFF^XLFDT(RCUPDATE,FROMDATE)
. . I DAYSPEN<1 Q
. . ; calculate the penalty
. . S X=$$CALCPEN(RCBILLDA,DAYSPEN) I 'X Q
. . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",3)=X
. . S $P(^TMP("RCBECHGS",$J,"ADDCHG",RCBILLDA),"^",5)=$P(RCFPEN,"^",3)
Q
;
;
CALCPEN(RCBILLDA,DAYSPEN) ; calc the penalty for a number of days (dayspen)
N DATEPREP,PENALTY,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 penalty 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 penalty and by the
; principal balance
S PENALTY=+$J(+$$PEN^RCMSFN01(DATEPREP)/360*DAYSPEN*PRINCPAL,0,2)
Q PENALTY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGP 5278 printed Nov 22, 2024@16:52:54 Page 2
RCBECHGP ;WISC/RFJ-add penalty charges to bills (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 ;
PENALTY ; this is called by rcbechgs and is a continuation of that routine
+1 ; variables passed to this entry point:
+2 ; rcupdate = the fm date that charges are being added
+3 ; the rcupdate variable is the statement date for non-benefit
+4 ; debts or (statement date minus 3 days) for benefit (first
+5 ; party debts)
+6 ;
+7 ; penalty charges are not applied to first party bills, check to make
+8 ; sure the account does not contain DPT( before calling.
+9 ;
+10 NEW DAYSPEN,FROMDATE,RCBILLDA,RCDATA6,RCDATE,RCFPEN,RCLASTDT,RCLET120,REPAYDAT,X
+11 ;
+12 ; penalty charges are assessed on each bill, not just the account
+13 ; loop all bills for the account
+14 SET RCDATE=0
FOR
SET RCDATE=$ORDER(^TMP("RCBECHGS",$JOB,"LIST",RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+15 SET RCBILLDA=0
FOR
SET RCBILLDA=$ORDER(^TMP("RCBECHGS",$JOB,"LIST",RCDATE,RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:2
+16 ; bill category set up to not charge penalty, get next bill
+17 IF '$PIECE($GET(^PRCA(430.2,+$PIECE(^PRCA(430,RCBILLDA,0),"^",2),0)),"^",12)
QUIT
+18 SET RCDATA6=$GET(^PRCA(430,RCBILLDA,6))
+19 ; get the last date penalty was charged to this bill
+20 ; if the last date is not set in field .13, use field 67
+21 SET RCLASTDT=$PIECE($GET(^PRCA(430,RCBILLDA,.1)),"^",3)
IF 'RCLASTDT
SET RCLASTDT=$PIECE(RCDATA6,"^",7)
+22 ; take the current statement date in variable rcupdate
+23 ; (this is actually 3 days before the statement date for
+24 ; benefit first party debts and is when penalty charges
+25 ; get added) and subtract 1 month (this date will be the
+26 ; last statement date). If the last penalty charge date
+27 ; is greater than the last statement date, do not add
+28 ; penalty a second time for the same month.
+29 IF RCLASTDT>$$FPS^RCAMFN01(RCUPDATE,-1)
QUIT
+30 ;
+31 ; calculate 4 months from initial notification. this
+32 ; date is 120 days from letter1 date.
+33 IF '$PIECE(RCDATA6,"^")
QUIT
+34 SET RCLET120=$$FPS^RCAMFN01($PIECE(RCDATA6,"^",1),4)
+35 ;
+36 ; if the current update date is greater than (the letter1
+37 ; date + 4 months), it has not been 120 days from the
+38 ; initial notification, do not add penalty charges
+39 IF RCUPDATE<RCLET120
QUIT
+40 ;
+41 ; get the repayment plan date
+42 SET REPAYDAT=$PIECE($GET(^PRCA(430,RCBILLDA,4)),"^")
+43 ; check to see if it was established within 120 days of
+44 ; initial notification. if not charge penalty on bill
+45 IF REPAYDAT>RCLET120
SET REPAYDAT=0
+46 ;
+47 ; if no repayment plan date, penalty charge from initial
+48 ; delinquency date (31st day).
+49 ; calculate the number of days of penalty from the last
+50 ; penalty charge date to the date the account is being
+51 ; updated (rcupdate). rcupdate is usually the current
+52 ; statement day. if the last penalty charge is not defined,
+53 ; use the letter1 date. if not letter1 date, quit
+54 IF 'REPAYDAT
Begin DoDot:3
+55 SET FROMDATE=RCLASTDT
IF 'FROMDATE
SET FROMDATE=$PIECE(RCDATA6,"^")
IF 'FROMDATE
QUIT
+56 SET DAYSPEN=$$FMDIFF^XLFDT(RCUPDATE,$PIECE(FROMDATE,"."))
+57 IF DAYSPEN<1
QUIT
+58 ; calculate the penalty
+59 SET X=$$CALCPEN(RCBILLDA,DAYSPEN)
IF 'X
QUIT
+60 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^",3)=X
+61 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^",5)="Full payment or repayment plan not established in 120 days from initial notification."
End DoDot:3
QUIT
+62 ;
+63 ; check to see if the account defaulted on the repayment
+64 ; plan up to the date the penalty is being charged, if so
+65 ; charge penalty on the bill
+66 SET RCFPEN=$$REPAYDEF^RCBECHGA(RCBILLDA,RCUPDATE)
IF 'RCFPEN
QUIT
+67 ;
+68 ; account defaulted on repayment, charge penalty
+69 ; charge penalty after the 121st day from the date of default
+70 IF $$FMADD^XLFDT($PIECE(RCFPEN,"^",2),121)>RCUPDATE
QUIT
+71 ; charge penalty from the last penalty charge date or
+72 ; back to the date of default on the repayment plan
+73 SET FROMDATE=RCLASTDT
IF 'FROMDATE
SET FROMDATE=$PIECE(RCFPEN,"^",2)
+74 SET DAYSPEN=$$FMDIFF^XLFDT(RCUPDATE,FROMDATE)
+75 IF DAYSPEN<1
QUIT
+76 ; calculate the penalty
+77 SET X=$$CALCPEN(RCBILLDA,DAYSPEN)
IF 'X
QUIT
+78 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^",3)=X
+79 SET $PIECE(^TMP("RCBECHGS",$JOB,"ADDCHG",RCBILLDA),"^",5)=$PIECE(RCFPEN,"^",3)
End DoDot:2
End DoDot:1
+80 QUIT
+81 ;
+82 ;
CALCPEN(RCBILLDA,DAYSPEN) ; calc the penalty for a number of days (dayspen)
+1 NEW DATEPREP,PENALTY,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 penalty 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 penalty and by the
+9 ; principal balance
+10 SET PENALTY=+$JUSTIFY(+$$PEN^RCMSFN01(DATEPREP)/360*DAYSPEN*PRINCPAL,0,2)
+11 QUIT PENALTY
