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")