RCBECHGE ;WISC/RFJ-exempt interest/admin/penalty from bill ;1 Jun 00
;;4.5;Accounts Receivable;**153,162,165**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
EXEMPT(RCBILLDA,RCPAYDAT) ; exempt interest/admin/penalty charges
; added after the payment date
N ADMIN,BILLBAL,COMMENT,INTEREST,PENALTY,RCDATE,RCEXTRAN,RCFLAG,RCLIST,RCTRANDA,TRANDA
S BILLBAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
; no interest or admin to exempt
I ($P(BILLBAL,"^",2)+$P(BILLBAL,"^",3))=0 Q
; loop thru transactions after payment date and look for
; interest/admin charge transactions to exempt
S RCDATE=RCPAYDAT-.1
F S RCDATE=$O(RCLIST(RCDATE)) Q:'RCDATE D
. S RCTRANDA=0
. F S RCTRANDA=$O(RCLIST(RCDATE,RCTRANDA)) Q:'RCTRANDA D
. . I RCLIST(RCDATE,RCTRANDA)'["INTEREST/ADM. CHARGE" Q
. . ; interest/admin/penalty charge added after payment date
. . ; exempt the charge
. . ;
. . ; check to see if charge is already exempted
. . ; the charge would be on the same date
. . ; for example:
. . ; rclist(3000424,2742117)=INTEREST/ADM. CHARGE^^ .68^ .45^0^0
. . ; rclist(3000424,2750151)=EXEMPT INT/ADM. COST^^-.68^-.45^0^0
. . S RCFLAG=0
. . S TRANDA=RCTRANDA
. . F S TRANDA=$O(RCLIST(RCDATE,TRANDA)) Q:'TRANDA D I RCFLAG Q
. . . I RCLIST(RCDATE,TRANDA)'["EXEMPT INT/ADM. COST" Q
. . . ; compare interest values (p3) and admin (p4)
. . . I +$P(RCLIST(RCDATE,RCTRANDA),"^",3)'=-$P(RCLIST(RCDATE,TRANDA),"^",3) Q
. . . I +$P(RCLIST(RCDATE,RCTRANDA),"^",4)'=-$P(RCLIST(RCDATE,TRANDA),"^",4) Q
. . . ; transaction already exempted
. . . S RCFLAG=1
. . I $G(RCFLAG) Q
. . ;
. . S INTEREST=$P(RCLIST(RCDATE,RCTRANDA),"^",3)
. . S ADMIN=$P(RCLIST(RCDATE,RCTRANDA),"^",4)
. . I 'INTEREST,'ADMIN Q
. . ;
. . ; check to make sure the amount being exempted does not
. . ; exceed the balance of the bill
. . I INTEREST>$P(BILLBAL,"^",2) Q
. . I ADMIN>$P(BILLBAL,"^",3) Q
. . ;
. . ; get the penalty charge from the transaction. this charge is computed in the
. . ; admin value, so subtract it from admin
. . S PENALTY=$P($G(^PRCA(433,RCTRANDA,2)),"^",9)
. . I PENALTY S ADMIN=ADMIN-PENALTY S:ADMIN<0 ADMIN=0
. . ;
. . ; add the exempt transaction to file 433 with the date
. . ; equal to the date the int/admin charge created
. . S COMMENT(1)="Auto exemption of "_RCTRANDA_", charges applied "_$S(RCDATE=RCPAYDAT:"on",1:"after")_" payment date "_$$FORMATDT^RCBECHGA(RCPAYDAT)_"."
. . ; make sure the time is entered for date processed in file 433 1;9
. . ; if not, it will show as being out of balance on patient statement
. . ; this was added for patch 162.
. . ;
. . ; patch 165 removed the process date passed so the current date
. . ; and time would be used. this will prevent statements from
. . ; being out of balance.
. . ;N %,%H,%I,PROCDATE
. . ;D NOW^%DTC S PROCDATE=$P(RCDATE,".")_"."_$P(%,".",2)
. . S RCEXTRAN=$$EXEMPT^RCBEUTR2(RCBILLDA,INTEREST_"^"_ADMIN_"^"_PENALTY,.COMMENT,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBECHGE 3271 printed Dec 13, 2024@01:42:40 Page 2
RCBECHGE ;WISC/RFJ-exempt interest/admin/penalty from bill ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,162,165**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
EXEMPT(RCBILLDA,RCPAYDAT) ; exempt interest/admin/penalty charges
+1 ; added after the payment date
+2 NEW ADMIN,BILLBAL,COMMENT,INTEREST,PENALTY,RCDATE,RCEXTRAN,RCFLAG,RCLIST,RCTRANDA,TRANDA
+3 SET BILLBAL=$$GETTRANS^RCDPBTLM(RCBILLDA)
+4 ; no interest or admin to exempt
+5 IF ($PIECE(BILLBAL,"^",2)+$PIECE(BILLBAL,"^",3))=0
QUIT
+6 ; loop thru transactions after payment date and look for
+7 ; interest/admin charge transactions to exempt
+8 SET RCDATE=RCPAYDAT-.1
+9 FOR
SET RCDATE=$ORDER(RCLIST(RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+10 SET RCTRANDA=0
+11 FOR
SET RCTRANDA=$ORDER(RCLIST(RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+12 IF RCLIST(RCDATE,RCTRANDA)'["INTEREST/ADM. CHARGE"
QUIT
+13 ; interest/admin/penalty charge added after payment date
+14 ; exempt the charge
+15 ;
+16 ; check to see if charge is already exempted
+17 ; the charge would be on the same date
+18 ; for example:
+19 ; rclist(3000424,2742117)=INTEREST/ADM. CHARGE^^ .68^ .45^0^0
+20 ; rclist(3000424,2750151)=EXEMPT INT/ADM. COST^^-.68^-.45^0^0
+21 SET RCFLAG=0
+22 SET TRANDA=RCTRANDA
+23 FOR
SET TRANDA=$ORDER(RCLIST(RCDATE,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:3
+24 IF RCLIST(RCDATE,TRANDA)'["EXEMPT INT/ADM. COST"
QUIT
+25 ; compare interest values (p3) and admin (p4)
+26 IF +$PIECE(RCLIST(RCDATE,RCTRANDA),"^",3)'=-$PIECE(RCLIST(RCDATE,TRANDA),"^",3)
QUIT
+27 IF +$PIECE(RCLIST(RCDATE,RCTRANDA),"^",4)'=-$PIECE(RCLIST(RCDATE,TRANDA),"^",4)
QUIT
+28 ; transaction already exempted
+29 SET RCFLAG=1
End DoDot:3
IF RCFLAG
QUIT
+30 IF $GET(RCFLAG)
QUIT
+31 ;
+32 SET INTEREST=$PIECE(RCLIST(RCDATE,RCTRANDA),"^",3)
+33 SET ADMIN=$PIECE(RCLIST(RCDATE,RCTRANDA),"^",4)
+34 IF 'INTEREST
IF 'ADMIN
QUIT
+35 ;
+36 ; check to make sure the amount being exempted does not
+37 ; exceed the balance of the bill
+38 IF INTEREST>$PIECE(BILLBAL,"^",2)
QUIT
+39 IF ADMIN>$PIECE(BILLBAL,"^",3)
QUIT
+40 ;
+41 ; get the penalty charge from the transaction. this charge is computed in the
+42 ; admin value, so subtract it from admin
+43 SET PENALTY=$PIECE($GET(^PRCA(433,RCTRANDA,2)),"^",9)
+44 IF PENALTY
SET ADMIN=ADMIN-PENALTY
if ADMIN<0
SET ADMIN=0
+45 ;
+46 ; add the exempt transaction to file 433 with the date
+47 ; equal to the date the int/admin charge created
+48 SET COMMENT(1)="Auto exemption of "_RCTRANDA_", charges applied "_$SELECT(RCDATE=RCPAYDAT:"on",1:"after")_" payment date "_$$FORMATDT^RCBECHGA(RCPAYDAT)_"."
+49 ; make sure the time is entered for date processed in file 433 1;9
+50 ; if not, it will show as being out of balance on patient statement
+51 ; this was added for patch 162.
+52 ;
+53 ; patch 165 removed the process date passed so the current date
+54 ; and time would be used. this will prevent statements from
+55 ; being out of balance.
+56 ;N %,%H,%I,PROCDATE
+57 ;D NOW^%DTC S PROCDATE=$P(RCDATE,".")_"."_$P(%,".",2)
+58 SET RCEXTRAN=$$EXEMPT^RCBEUTR2(RCBILLDA,INTEREST_"^"_ADMIN_"^"_PENALTY,.COMMENT,0)
End DoDot:2
End DoDot:1
+59 QUIT
