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