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 ---[H[J[2J[HRCBMILLC 9562 printed Dec 13, 2024@01:43:02 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")