RCBECHGE.m

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 ---RCBECHGE   3271     printed  Apr 09, 2024@20:50:47                                                                                                                                                                                                    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