RCBMILLC.m

RCBMILLC ;WISC/RFJ-millennium bill (calculations top routine) ;27 Jun 2001 11:10 AM

 ;;4.5;Accounts Receivable;**170,174**;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

BILLFUND(RCBILLDA,RCDATEND) ;  for a bill up to a given date,

 ;  calculate the amount that should be paid to MCCF and HSIF

 ;  returns:

 ;    tmp("rcbmilldata",$j,rcbillda,rctranda) = transaction type (P I D)

 ;                    piece 2 = principal amt of transaction

 ;                    piece 3 = amount owed to mccf

 ;                    piece 4 = amount owed to hsif

 ;                    piece 5 = for payment, amount already paid to mccf

 ;                    piece 6 = for payment, amount already paid to hsif

 ;

 ;  returns amt owed to mccf for bill

 ;          amt owed to hsif for bill

 ;          amt paid to mccf for bill

 ;          amt paid to hsif for bill

 ;

 N AMTPAID,AMTOHSIF,AMTOMCCF,CHARGES,PRINCPAL,RCBALANC,RCCHARGE,RCDATA1,RCEFFDAT,RCTOHSIF,RCTOMCCF,RCTOTAL,RCTRANDA,RCVALUE

 K ^TMP($J,"RCBMILLDATA",RCBILLDA)

 ;

 I '$G(RCDATEND) N RCDATEND S RCDATEND=9999999

 ;

 ;  this is the effective date for splitting the dollars

 ;  should be in the form 3020204 for feb 4, 2002

 S RCEFFDAT=3020204

 ;

 ;  this is the standard charge amount.  the total increase or

 ;  decrease adjustment must be evenly divisable by this amount

 ;  for splitting into separate funds

 S RCCHARGE=7

 ;

 ;  this is the amount of RCCHARGE that goes to mccf and hsif

 S RCTOMCCF=2

 S RCTOHSIF=RCCHARGE-RCTOMCCF

 ;

 ;  initialize the amounts owed to mccf and hsif for a bill

 ;  these variables are returned with the quit at the end

 S RCTOTAL("OWED TO MCCF")=0

 S RCTOTAL("OWED TO HSIF")=0

 S RCTOTAL("PAID TO MCCF")=0

 S RCTOTAL("PAID TO HSIF")=0

 ;

 ;  initialize running balance, used internally to track amounts

 S RCBALANC("MCCF AFTER EFF DATE")=0

 ;

 ;  if it is an old bill that has an orignal amt, set it up

 S RCBALANC("MCCF BEFORE EFF DATE")=0

 S RCBALANC("HSIF")=0

 I $P($G(^PRCA(430,RCBILLDA,0)),"^",3) D

 .   S RCVALUE=$P(^PRCA(430,RCBILLDA,0),"^",3)

 .   S AMTOMCCF("BEFORE EFF DATE")=RCVALUE

 .   S AMTOMCCF("AFTER EFF DATE")=0

 .   S RCTRANDA=0

 .   D SETTEMP^RCBMILLD("I*",RCVALUE,.AMTOMCCF,0)

 ;

 S RCTRANDA=0 F  S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) Q:'RCTRANDA  D

 .   ;

 .   ;  make sure the transaction is before the ending date

 .   S RCDATA1=$G(^PRCA(433,RCTRANDA,1))

 .   I $P(RCDATA1,"^",9)>RCDATEND Q

 .   ;

 .   ;  get the principal of the transaction, this call

 .   ;  also verifies this is a valid "complete" transaction

 .   S RCVALUE=$$TRANBAL^RCRJRCOT(RCTRANDA)

 .   ;  if no principal, quit

 .   I '$P(RCVALUE,"^") Q

 .   ;

 .   ;

 .   ;  * * *  I N C R E A S E  * * *

 .   I $P(RCDATA1,"^",2)=1 D  Q

 .   .   ;  the date of the transaction must be after the effective

 .   .   ;  date or all of the principal goes to mccf

 .   .   I $P(RCDATA1,"^",9)<RCEFFDAT D  Q

 .   .   .   S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")

 .   .   .   S AMTOMCCF("AFTER EFF DATE")=0

 .   .   .   D SETTEMP^RCBMILLD("I*",$P(RCVALUE,"^"),.AMTOMCCF,0)

 .   .   ;

 .   .   ;  the principal amount has to be evenly divisable by [the standard

 .   .   ;  charge: in rccharge].  if not all principal goes to mccf

 .   .   I $P(RCVALUE,"^")#RCCHARGE'=0 D  Q

 .   .   .   S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")

 .   .   .   S AMTOMCCF("AFTER EFF DATE")=0

 .   .   .   D SETTEMP^RCBMILLD("I*",$P(RCVALUE,"^"),.AMTOMCCF,0)

 .   .   ;

 .   .   ;  after the effective date

 .   .   S AMTOMCCF("BEFORE EFF DATE")=0

 .   .   ;

 .   .   ;  the amount to MCCF is the number of times [the standard charge:

 .   .   ;  in rccharge] goes into the principal, multiplied by the amount

 .   .   ;  that goes to mccf: in rctomccf

 .   .   S AMTOMCCF("AFTER EFF DATE")=($P(RCVALUE,"^")/RCCHARGE)*RCTOMCCF

 .   .   ;

 .   .   ;  the amount to MCCF is the difference

 .   .   S AMTOHSIF=$P(RCVALUE,"^")-AMTOMCCF("AFTER EFF DATE")

 .   .   ;

 .   .   D SETTEMP^RCBMILLD("I",$P(RCVALUE,"^"),.AMTOMCCF,AMTOHSIF)

 .   ;

 .   ;

 .   ;  * * *  D E C R E A S E  * * *

 .   I $P(RCDATA1,"^",2)=35 D  Q

 .   .   ;  the date of the transaction must be after the effective

 .   .   ;  date or all of the principal comes from mccf

 .   .   I $P(RCDATA1,"^",9)<RCEFFDAT D  Q

 .   .   .   S AMTOMCCF("BEFORE EFF DATE")=-$P(RCVALUE,"^")

 .   .   .   S AMTOMCCF("AFTER EFF DATE")=0

 .   .   .   D SETTEMP^RCBMILLD("D*",-$P(RCVALUE,"^"),.AMTOMCCF,0)

 .   .   ;

 .   .   ;  calculate the number of copayment charges that make up

 .   .   ;  the principal.  this number is used to calculate the

 .   .   ;  dollars to hsif

 .   .   S CHARGES=$P(RCVALUE,"^")\RCCHARGE

 .   .   ;

 .   .   ;  calculate the amount that should go to hsif

 .   .   S AMTOHSIF=+$J(CHARGES*RCTOHSIF,0,2)

 .   .   ;

 .   .   ;  remainder goes to mccf

 .   .   S AMTOMCCF=$P(RCVALUE,"^")-AMTOHSIF

 .   .   ;

 .   .   ;  if the amount coming from hsif exceeds the amount owed to hsif,

 .   .   ;  move it to mccf

 .   .   I AMTOHSIF>RCBALANC("HSIF") S AMTOHSIF=RCBALANC("HSIF"),AMTOMCCF=$P(RCVALUE,"^")-AMTOHSIF

 .   .   ;

 .   .   ;  if the amount to mccf exceeds amount owed to mccf,

 .   .   ;  move more to hsif

 .   .   I AMTOMCCF>(RCBALANC("MCCF AFTER EFF DATE")+RCBALANC("MCCF BEFORE EFF DATE")) D

 .   .   .   S AMTOMCCF=RCBALANC("MCCF AFTER EFF DATE")+RCBALANC("MCCF BEFORE EFF DATE")

 .   .   .   S AMTOHSIF=$P(RCVALUE,"^")-AMTOMCCF

 .   .   ;

 .   .   ;  split the amount before and after effective date,

 .   .   ;  default is allocate all to after effective date

 .   .   S AMTOMCCF("AFTER EFF DATE")=AMTOMCCF

 .   .   S AMTOMCCF("BEFORE EFF DATE")=0

 .   .   ;

 .   .   ;  if the amount to mccf after the effective date exceeds the amount owed to mccf after the

 .   .   ;  effective date, place more in mccf before the effective date

 .   .   I AMTOMCCF("AFTER EFF DATE")>RCBALANC("MCCF AFTER EFF DATE") D

 .   .   .   S AMTOMCCF("BEFORE EFF DATE")=AMTOMCCF("AFTER EFF DATE")-RCBALANC("MCCF AFTER EFF DATE")

 .   .   .   S AMTOMCCF("AFTER EFF DATE")=RCBALANC("MCCF AFTER EFF DATE")

 .   .   ;

 .   .   ;  make amounts negative for decrease

 .   .   S AMTOMCCF("BEFORE EFF DATE")=-AMTOMCCF("BEFORE EFF DATE")

 .   .   S AMTOMCCF("AFTER EFF DATE")=-AMTOMCCF("AFTER EFF DATE")

 .   .   ;

 .   .   D SETTEMP^RCBMILLD("D",-$P(RCVALUE,"^"),.AMTOMCCF,-AMTOHSIF)

 .   ;

 .   ;

 .   ;  * * *  P A Y M E N T S  * * *

 .   ;  if it is a payment transaction, get the amount

 .   ;  already paid to the funds

 .   I $P(RCDATA1,"^",2)=2!($P(RCDATA1,"^",2)=34) D  Q

 .   .   ;  calculate the amount of this payment that should go to MCCF

 .   .   ;  for transactions created prior to the effective date

 .   .   S AMTOMCCF("BEFORE EFF DATE")=RCBALANC("MCCF BEFORE EFF DATE")

 .   .   I AMTOMCCF("BEFORE EFF DATE")>$P(RCVALUE,"^") S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")

 .   .   ;

 .   .   ;  recalculate principal remaining after the mandatory amount

 .   .   ;  is given to MCCF

 .   .   S PRINCPAL=$P(RCVALUE,"^")-AMTOMCCF("BEFORE EFF DATE")

 .   .   ;

 .   .   ;  calculate the number of copayment charges that make up

 .   .   ;  the principal remaining.  this number is used to calculate the

 .   .   ;  dollars to hsif.  calculate the remainder after the standard

 .   .   ;  charge is allocated to mccf and hsif.

 .   .   S CHARGES=PRINCPAL\RCCHARGE

 .   .   S PRINCPAL=PRINCPAL#RCCHARGE

 .   .   ;

 .   .   ;  calculate the amount that should go to mccf

 .   .   ;    it is the number of standard charges times the

 .   .   ;    amount of each standard charge allocated to mccf

 .   .   S AMTOMCCF("AFTER EFF DATE")=+$J(CHARGES*RCTOMCCF,0,2)

 .   .   ;

 .   .   ;  if the remainder is less than the standard charge

 .   .   ;  allocated to mccf, add it also

 .   .   I PRINCPAL<RCTOMCCF S AMTOMCCF("AFTER EFF DATE")=AMTOMCCF("AFTER EFF DATE")+PRINCPAL

 .   .   ;

 .   .   ;  if the remainder is more than the standard charge

 .   .   ;  allocated to mccf, add one more standard charge to

 .   .   ;  mccf and give the rest to hsif

 .   .   I PRINCPAL>RCTOMCCF S AMTOMCCF("AFTER EFF DATE")=AMTOMCCF("AFTER EFF DATE")+RCTOMCCF

 .   .   ;

 .   .   ;  if the amount to mccf exceeds the amount owed to mccf,

 .   .   ;  place more in hsif

 .   .   I AMTOMCCF("AFTER EFF DATE")>RCBALANC("MCCF AFTER EFF DATE") D

 .   .   .   S AMTOMCCF("AFTER EFF DATE")=RCBALANC("MCCF AFTER EFF DATE")

 .   .   ;

 .   .   ;  balance of payment goes to hsif

 .   .   S AMTOHSIF=$P(RCVALUE,"^")-AMTOMCCF("BEFORE EFF DATE")-AMTOMCCF("AFTER EFF DATE")

 .   .   ;

 .   .   ;  get the amount paid to the funds

 .   .   S AMTPAID=$G(^PRCA(433,RCTRANDA,9))

 .   .   ;

 .   .   ;  make amounts negative for payment

 .   .   S AMTOMCCF("BEFORE EFF DATE")=-AMTOMCCF("BEFORE EFF DATE")

 .   .   S AMTOMCCF("AFTER EFF DATE")=-AMTOMCCF("AFTER EFF DATE")

 .   .   ;

 .   .   D SETTEMP^RCBMILLD("P",-$P(RCVALUE,"^"),.AMTOMCCF,-AMTOHSIF,$P(AMTPAID,"^"),$P(AMTPAID,"^",2))

 .   ;

 .   ;

 .   ;  * * *  R E E S T A B L I S H  * * *

 .   ;  if it is a restablish transaction, add the amount to mccf

 .   I $P(RCDATA1,"^",2)=43 D  Q

 .   .   S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")

 .   .   S AMTOMCCF("AFTER EFF DATE")=0

 .   .   D SETTEMP^RCBMILLD("R",$P(RCVALUE,"^"),.AMTOMCCF,0)

 ;

 Q RCTOTAL("OWED TO MCCF")_"^"_RCTOTAL("OWED TO HSIF")_"^"_RCTOTAL("PAID TO MCCF")_"^"_RCTOTAL("PAID TO HSIF")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCBMILLC   9562     printed  Feb 18, 2025@23:09:26                                                                                                                                                                                                    Page 2

RCBMILLC  ;WISC/RFJ-millennium bill (calculations top routine) ;27 Jun 2001 11:10 AM

 +1       ;;4.5;Accounts Receivable;**170,174**;Mar 20, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

BILLFUND(RCBILLDA,RCDATEND) ;  for a bill up to a given date,

 +1       ;  calculate the amount that should be paid to MCCF and HSIF

 +2       ;  returns:

 +3       ;    tmp("rcbmilldata",$j,rcbillda,rctranda) = transaction type (P I D)

 +4       ;                    piece 2 = principal amt of transaction

 +5       ;                    piece 3 = amount owed to mccf

 +6       ;                    piece 4 = amount owed to hsif

 +7       ;                    piece 5 = for payment, amount already paid to mccf

 +8       ;                    piece 6 = for payment, amount already paid to hsif

 +9       ;

 +10      ;  returns amt owed to mccf for bill

 +11      ;          amt owed to hsif for bill

 +12      ;          amt paid to mccf for bill

 +13      ;          amt paid to hsif for bill

 +14      ;

 +15       NEW AMTPAID,AMTOHSIF,AMTOMCCF,CHARGES,PRINCPAL,RCBALANC,RCCHARGE,RCDATA1,RCEFFDAT,RCTOHSIF,RCTOMCCF,RCTOTAL,RCTRANDA,RCVALUE

 +16       KILL ^TMP($JOB,"RCBMILLDATA",RCBILLDA)

 +17      ;

 +18       IF '$GET(RCDATEND)

               NEW RCDATEND

               SET RCDATEND=9999999

 +19      ;

 +20      ;  this is the effective date for splitting the dollars

 +21      ;  should be in the form 3020204 for feb 4, 2002

 +22       SET RCEFFDAT=3020204

 +23      ;

 +24      ;  this is the standard charge amount.  the total increase or

 +25      ;  decrease adjustment must be evenly divisable by this amount

 +26      ;  for splitting into separate funds

 +27       SET RCCHARGE=7

 +28      ;

 +29      ;  this is the amount of RCCHARGE that goes to mccf and hsif

 +30       SET RCTOMCCF=2

 +31       SET RCTOHSIF=RCCHARGE-RCTOMCCF

 +32      ;

 +33      ;  initialize the amounts owed to mccf and hsif for a bill

 +34      ;  these variables are returned with the quit at the end

 +35       SET RCTOTAL("OWED TO MCCF")=0

 +36       SET RCTOTAL("OWED TO HSIF")=0

 +37       SET RCTOTAL("PAID TO MCCF")=0

 +38       SET RCTOTAL("PAID TO HSIF")=0

 +39      ;

 +40      ;  initialize running balance, used internally to track amounts

 +41       SET RCBALANC("MCCF AFTER EFF DATE")=0

 +42      ;

 +43      ;  if it is an old bill that has an orignal amt, set it up

 +44       SET RCBALANC("MCCF BEFORE EFF DATE")=0

 +45       SET RCBALANC("HSIF")=0

 +46       IF $PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",3)

               Begin DoDot:1

 +47               SET RCVALUE=$PIECE(^PRCA(430,RCBILLDA,0),"^",3)

 +48               SET AMTOMCCF("BEFORE EFF DATE")=RCVALUE

 +49               SET AMTOMCCF("AFTER EFF DATE")=0

 +50               SET RCTRANDA=0

 +51               DO SETTEMP^RCBMILLD("I*",RCVALUE,.AMTOMCCF,0)

               End DoDot:1

 +52      ;

 +53       SET RCTRANDA=0

           FOR 

               SET RCTRANDA=$ORDER(^PRCA(433,"C",RCBILLDA,RCTRANDA))

               if 'RCTRANDA

                   QUIT 

               Begin DoDot:1

 +54      ;

 +55      ;  make sure the transaction is before the ending date

 +56               SET RCDATA1=$GET(^PRCA(433,RCTRANDA,1))

 +57               IF $PIECE(RCDATA1,"^",9)>RCDATEND

                       QUIT 

 +58      ;

 +59      ;  get the principal of the transaction, this call

 +60      ;  also verifies this is a valid "complete" transaction

 +61               SET RCVALUE=$$TRANBAL^RCRJRCOT(RCTRANDA)

 +62      ;  if no principal, quit

 +63               IF '$PIECE(RCVALUE,"^")

                       QUIT 

 +64      ;

 +65      ;

 +66      ;  * * *  I N C R E A S E  * * *

 +67               IF $PIECE(RCDATA1,"^",2)=1

                       Begin DoDot:2

 +68      ;  the date of the transaction must be after the effective

 +69      ;  date or all of the principal goes to mccf

 +70                       IF $PIECE(RCDATA1,"^",9)<RCEFFDAT

                               Begin DoDot:3

 +71                               SET AMTOMCCF("BEFORE EFF DATE")=$PIECE(RCVALUE,"^")

 +72                               SET AMTOMCCF("AFTER EFF DATE")=0

 +73                               DO SETTEMP^RCBMILLD("I*",$PIECE(RCVALUE,"^"),.AMTOMCCF,0)

                               End DoDot:3

                               QUIT 

 +74      ;

 +75      ;  the principal amount has to be evenly divisable by [the standard

 +76      ;  charge: in rccharge].  if not all principal goes to mccf

 +77                       IF $PIECE(RCVALUE,"^")#RCCHARGE'=0

                               Begin DoDot:3

 +78                               SET AMTOMCCF("BEFORE EFF DATE")=$PIECE(RCVALUE,"^")

 +79                               SET AMTOMCCF("AFTER EFF DATE")=0

 +80                               DO SETTEMP^RCBMILLD("I*",$PIECE(RCVALUE,"^"),.AMTOMCCF,0)

                               End DoDot:3

                               QUIT 

 +81      ;

 +82      ;  after the effective date

 +83                       SET AMTOMCCF("BEFORE EFF DATE")=0

 +84      ;

 +85      ;  the amount to MCCF is the number of times [the standard charge:

 +86      ;  in rccharge] goes into the principal, multiplied by the amount

 +87      ;  that goes to mccf: in rctomccf

 +88                       SET AMTOMCCF("AFTER EFF DATE")=($PIECE(RCVALUE,"^")/RCCHARGE)*RCTOMCCF

 +89      ;

 +90      ;  the amount to MCCF is the difference

 +91                       SET AMTOHSIF=$PIECE(RCVALUE,"^")-AMTOMCCF("AFTER EFF DATE")

 +92      ;

 +93                       DO SETTEMP^RCBMILLD("I",$PIECE(RCVALUE,"^"),.AMTOMCCF,AMTOHSIF)

                       End DoDot:2

                       QUIT 

 +94      ;

 +95      ;

 +96      ;  * * *  D E C R E A S E  * * *

 +97               IF $PIECE(RCDATA1,"^",2)=35

                       Begin DoDot:2

 +98      ;  the date of the transaction must be after the effective

 +99      ;  date or all of the principal comes from mccf

 +100                      IF $PIECE(RCDATA1,"^",9)<RCEFFDAT

                               Begin DoDot:3

 +101                              SET AMTOMCCF("BEFORE EFF DATE")=-$PIECE(RCVALUE,"^")

 +102                              SET AMTOMCCF("AFTER EFF DATE")=0

 +103                              DO SETTEMP^RCBMILLD("D*",-$PIECE(RCVALUE,"^"),.AMTOMCCF,0)

                               End DoDot:3

                               QUIT 

 +104     ;

 +105     ;  calculate the number of copayment charges that make up

 +106     ;  the principal.  this number is used to calculate the

 +107     ;  dollars to hsif

 +108                      SET CHARGES=$PIECE(RCVALUE,"^")\RCCHARGE

 +109     ;

 +110     ;  calculate the amount that should go to hsif

 +111                      SET AMTOHSIF=+$JUSTIFY(CHARGES*RCTOHSIF,0,2)

 +112     ;

 +113     ;  remainder goes to mccf

 +114                      SET AMTOMCCF=$PIECE(RCVALUE,"^")-AMTOHSIF

 +115     ;

 +116     ;  if the amount coming from hsif exceeds the amount owed to hsif,

 +117     ;  move it to mccf

 +118                      IF AMTOHSIF>RCBALANC("HSIF")

                               SET AMTOHSIF=RCBALANC("HSIF")

                               SET AMTOMCCF=$PIECE(RCVALUE,"^")-AMTOHSIF

 +119     ;

 +120     ;  if the amount to mccf exceeds amount owed to mccf,

 +121     ;  move more to hsif

 +122                      IF AMTOMCCF>(RCBALANC("MCCF AFTER EFF DATE")+RCBALANC("MCCF BEFORE EFF DATE"))

                               Begin DoDot:3

 +123                              SET AMTOMCCF=RCBALANC("MCCF AFTER EFF DATE")+RCBALANC("MCCF BEFORE EFF DATE")

 +124                              SET AMTOHSIF=$PIECE(RCVALUE,"^")-AMTOMCCF

                               End DoDot:3

 +125     ;

 +126     ;  split the amount before and after effective date,

 +127     ;  default is allocate all to after effective date

 +128                      SET AMTOMCCF("AFTER EFF DATE")=AMTOMCCF

 +129                      SET AMTOMCCF("BEFORE EFF DATE")=0

 +130     ;

 +131     ;  if the amount to mccf after the effective date exceeds the amount owed to mccf after the

 +132     ;  effective date, place more in mccf before the effective date

 +133                      IF AMTOMCCF("AFTER EFF DATE")>RCBALANC("MCCF AFTER EFF DATE")

                               Begin DoDot:3

 +134                              SET AMTOMCCF("BEFORE EFF DATE")=AMTOMCCF("AFTER EFF DATE")-RCBALANC("MCCF AFTER EFF DATE")

 +135                              SET AMTOMCCF("AFTER EFF DATE")=RCBALANC("MCCF AFTER EFF DATE")

                               End DoDot:3

 +136     ;

 +137     ;  make amounts negative for decrease

 +138                      SET AMTOMCCF("BEFORE EFF DATE")=-AMTOMCCF("BEFORE EFF DATE")

 +139                      SET AMTOMCCF("AFTER EFF DATE")=-AMTOMCCF("AFTER EFF DATE")

 +140     ;

 +141                      DO SETTEMP^RCBMILLD("D",-$PIECE(RCVALUE,"^"),.AMTOMCCF,-AMTOHSIF)

                       End DoDot:2

                       QUIT 

 +142     ;

 +143     ;

 +144     ;  * * *  P A Y M E N T S  * * *

 +145     ;  if it is a payment transaction, get the amount

 +146     ;  already paid to the funds

 +147              IF $PIECE(RCDATA1,"^",2)=2!($PIECE(RCDATA1,"^",2)=34)

                       Begin DoDot:2

 +148     ;  calculate the amount of this payment that should go to MCCF

 +149     ;  for transactions created prior to the effective date

 +150                      SET AMTOMCCF("BEFORE EFF DATE")=RCBALANC("MCCF BEFORE EFF DATE")

 +151                      IF AMTOMCCF("BEFORE EFF DATE")>$PIECE(RCVALUE,"^")

                               SET AMTOMCCF("BEFORE EFF DATE")=$PIECE(RCVALUE,"^")

 +152     ;

 +153     ;  recalculate principal remaining after the mandatory amount

 +154     ;  is given to MCCF

 +155                      SET PRINCPAL=$PIECE(RCVALUE,"^")-AMTOMCCF("BEFORE EFF DATE")

 +156     ;

 +157     ;  calculate the number of copayment charges that make up

 +158     ;  the principal remaining.  this number is used to calculate the

 +159     ;  dollars to hsif.  calculate the remainder after the standard

 +160     ;  charge is allocated to mccf and hsif.

 +161                      SET CHARGES=PRINCPAL\RCCHARGE

 +162                      SET PRINCPAL=PRINCPAL#RCCHARGE

 +163     ;

 +164     ;  calculate the amount that should go to mccf

 +165     ;    it is the number of standard charges times the

 +166     ;    amount of each standard charge allocated to mccf

 +167                      SET AMTOMCCF("AFTER EFF DATE")=+$JUSTIFY(CHARGES*RCTOMCCF,0,2)

 +168     ;

 +169     ;  if the remainder is less than the standard charge

 +170     ;  allocated to mccf, add it also

 +171                      IF PRINCPAL<RCTOMCCF

                               SET AMTOMCCF("AFTER EFF DATE")=AMTOMCCF("AFTER EFF DATE")+PRINCPAL

 +172     ;

 +173     ;  if the remainder is more than the standard charge

 +174     ;  allocated to mccf, add one more standard charge to

 +175     ;  mccf and give the rest to hsif

 +176                      IF PRINCPAL>RCTOMCCF

                               SET AMTOMCCF("AFTER EFF DATE")=AMTOMCCF("AFTER EFF DATE")+RCTOMCCF

 +177     ;

 +178     ;  if the amount to mccf exceeds the amount owed to mccf,

 +179     ;  place more in hsif

 +180                      IF AMTOMCCF("AFTER EFF DATE")>RCBALANC("MCCF AFTER EFF DATE")

                               Begin DoDot:3

 +181                              SET AMTOMCCF("AFTER EFF DATE")=RCBALANC("MCCF AFTER EFF DATE")

                               End DoDot:3

 +182     ;

 +183     ;  balance of payment goes to hsif

 +184                      SET AMTOHSIF=$PIECE(RCVALUE,"^")-AMTOMCCF("BEFORE EFF DATE")-AMTOMCCF("AFTER EFF DATE")

 +185     ;

 +186     ;  get the amount paid to the funds

 +187                      SET AMTPAID=$GET(^PRCA(433,RCTRANDA,9))

 +188     ;

 +189     ;  make amounts negative for payment

 +190                      SET AMTOMCCF("BEFORE EFF DATE")=-AMTOMCCF("BEFORE EFF DATE")

 +191                      SET AMTOMCCF("AFTER EFF DATE")=-AMTOMCCF("AFTER EFF DATE")

 +192     ;

 +193                      DO SETTEMP^RCBMILLD("P",-$PIECE(RCVALUE,"^"),.AMTOMCCF,-AMTOHSIF,$PIECE(AMTPAID,"^"),$PIECE(AMTPAID,"^",2))

                       End DoDot:2

                       QUIT 

 +194     ;

 +195     ;

 +196     ;  * * *  R E E S T A B L I S H  * * *

 +197     ;  if it is a restablish transaction, add the amount to mccf

 +198              IF $PIECE(RCDATA1,"^",2)=43

                       Begin DoDot:2

 +199                      SET AMTOMCCF("BEFORE EFF DATE")=$PIECE(RCVALUE,"^")

 +200                      SET AMTOMCCF("AFTER EFF DATE")=0

 +201                      DO SETTEMP^RCBMILLD("R",$PIECE(RCVALUE,"^"),.AMTOMCCF,0)

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +202     ;

 +203      QUIT RCTOTAL("OWED TO MCCF")_"^"_RCTOTAL("OWED TO HSIF")_"^"_RCTOTAL("PAID TO MCCF")_"^"_RCTOTAL("PAID TO HSIF")