- 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 Feb 18, 2025@23:09:05 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