source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBMILLC.m@ 1169

Last change on this file since 1169 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 9.1 KB
RevLine 
[613]1RCBMILLC ;WISC/RFJ-millennium bill (calculations top routine) ;27 Jun 2001 11:10 AM
2 ;;4.5;Accounts Receivable;**170,174**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7BILLFUND(RCBILLDA,RCDATEND) ; for a bill up to a given date,
8 ; calculate the amount that should be paid to MCCF and HSIF
9 ; returns:
10 ; tmp("rcbmilldata",$j,rcbillda,rctranda) = transaction type (P I D)
11 ; piece 2 = principal amt of transaction
12 ; piece 3 = amount owed to mccf
13 ; piece 4 = amount owed to hsif
14 ; piece 5 = for payment, amount already paid to mccf
15 ; piece 6 = for payment, amount already paid to hsif
16 ;
17 ; returns amt owed to mccf for bill
18 ; amt owed to hsif for bill
19 ; amt paid to mccf for bill
20 ; amt paid to hsif for bill
21 ;
22 N AMTPAID,AMTOHSIF,AMTOMCCF,CHARGES,PRINCPAL,RCBALANC,RCCHARGE,RCDATA1,RCEFFDAT,RCTOHSIF,RCTOMCCF,RCTOTAL,RCTRANDA,RCVALUE
23 K ^TMP($J,"RCBMILLDATA",RCBILLDA)
24 ;
25 I '$G(RCDATEND) N RCDATEND S RCDATEND=9999999
26 ;
27 ; this is the effective date for splitting the dollars
28 ; should be in the form 3020204 for feb 4, 2002
29 S RCEFFDAT=3020204
30 ;
31 ; this is the standard charge amount. the total increase or
32 ; decrease adjustment must be evenly divisable by this amount
33 ; for splitting into separate funds
34 S RCCHARGE=7
35 ;
36 ; this is the amount of RCCHARGE that goes to mccf and hsif
37 S RCTOMCCF=2
38 S RCTOHSIF=RCCHARGE-RCTOMCCF
39 ;
40 ; initialize the amounts owed to mccf and hsif for a bill
41 ; these variables are returned with the quit at the end
42 S RCTOTAL("OWED TO MCCF")=0
43 S RCTOTAL("OWED TO HSIF")=0
44 S RCTOTAL("PAID TO MCCF")=0
45 S RCTOTAL("PAID TO HSIF")=0
46 ;
47 ; initialize running balance, used internally to track amounts
48 S RCBALANC("MCCF AFTER EFF DATE")=0
49 ;
50 ; if it is an old bill that has an orignal amt, set it up
51 S RCBALANC("MCCF BEFORE EFF DATE")=0
52 S RCBALANC("HSIF")=0
53 I $P($G(^PRCA(430,RCBILLDA,0)),"^",3) D
54 . S RCVALUE=$P(^PRCA(430,RCBILLDA,0),"^",3)
55 . S AMTOMCCF("BEFORE EFF DATE")=RCVALUE
56 . S AMTOMCCF("AFTER EFF DATE")=0
57 . S RCTRANDA=0
58 . D SETTEMP^RCBMILLD("I*",RCVALUE,.AMTOMCCF,0)
59 ;
60 S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) Q:'RCTRANDA D
61 . ;
62 . ; make sure the transaction is before the ending date
63 . S RCDATA1=$G(^PRCA(433,RCTRANDA,1))
64 . I $P(RCDATA1,"^",9)>RCDATEND Q
65 . ;
66 . ; get the principal of the transaction, this call
67 . ; also verifies this is a valid "complete" transaction
68 . S RCVALUE=$$TRANBAL^RCRJRCOT(RCTRANDA)
69 . ; if no principal, quit
70 . I '$P(RCVALUE,"^") Q
71 . ;
72 . ;
73 . ; * * * I N C R E A S E * * *
74 . I $P(RCDATA1,"^",2)=1 D Q
75 . . ; the date of the transaction must be after the effective
76 . . ; date or all of the principal goes to mccf
77 . . I $P(RCDATA1,"^",9)<RCEFFDAT D Q
78 . . . S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")
79 . . . S AMTOMCCF("AFTER EFF DATE")=0
80 . . . D SETTEMP^RCBMILLD("I*",$P(RCVALUE,"^"),.AMTOMCCF,0)
81 . . ;
82 . . ; the principal amount has to be evenly divisable by [the standard
83 . . ; charge: in rccharge]. if not all principal goes to mccf
84 . . I $P(RCVALUE,"^")#RCCHARGE'=0 D Q
85 . . . S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")
86 . . . S AMTOMCCF("AFTER EFF DATE")=0
87 . . . D SETTEMP^RCBMILLD("I*",$P(RCVALUE,"^"),.AMTOMCCF,0)
88 . . ;
89 . . ; after the effective date
90 . . S AMTOMCCF("BEFORE EFF DATE")=0
91 . . ;
92 . . ; the amount to MCCF is the number of times [the standard charge:
93 . . ; in rccharge] goes into the principal, multiplied by the amount
94 . . ; that goes to mccf: in rctomccf
95 . . S AMTOMCCF("AFTER EFF DATE")=($P(RCVALUE,"^")/RCCHARGE)*RCTOMCCF
96 . . ;
97 . . ; the amount to MCCF is the difference
98 . . S AMTOHSIF=$P(RCVALUE,"^")-AMTOMCCF("AFTER EFF DATE")
99 . . ;
100 . . D SETTEMP^RCBMILLD("I",$P(RCVALUE,"^"),.AMTOMCCF,AMTOHSIF)
101 . ;
102 . ;
103 . ; * * * D E C R E A S E * * *
104 . I $P(RCDATA1,"^",2)=35 D Q
105 . . ; the date of the transaction must be after the effective
106 . . ; date or all of the principal comes from mccf
107 . . I $P(RCDATA1,"^",9)<RCEFFDAT D Q
108 . . . S AMTOMCCF("BEFORE EFF DATE")=-$P(RCVALUE,"^")
109 . . . S AMTOMCCF("AFTER EFF DATE")=0
110 . . . D SETTEMP^RCBMILLD("D*",-$P(RCVALUE,"^"),.AMTOMCCF,0)
111 . . ;
112 . . ; calculate the number of copayment charges that make up
113 . . ; the principal. this number is used to calculate the
114 . . ; dollars to hsif
115 . . S CHARGES=$P(RCVALUE,"^")\RCCHARGE
116 . . ;
117 . . ; calculate the amount that should go to hsif
118 . . S AMTOHSIF=+$J(CHARGES*RCTOHSIF,0,2)
119 . . ;
120 . . ; remainder goes to mccf
121 . . S AMTOMCCF=$P(RCVALUE,"^")-AMTOHSIF
122 . . ;
123 . . ; if the amount coming from hsif exceeds the amount owed to hsif,
124 . . ; move it to mccf
125 . . I AMTOHSIF>RCBALANC("HSIF") S AMTOHSIF=RCBALANC("HSIF"),AMTOMCCF=$P(RCVALUE,"^")-AMTOHSIF
126 . . ;
127 . . ; if the amount to mccf exceeds amount owed to mccf,
128 . . ; move more to hsif
129 . . I AMTOMCCF>(RCBALANC("MCCF AFTER EFF DATE")+RCBALANC("MCCF BEFORE EFF DATE")) D
130 . . . S AMTOMCCF=RCBALANC("MCCF AFTER EFF DATE")+RCBALANC("MCCF BEFORE EFF DATE")
131 . . . S AMTOHSIF=$P(RCVALUE,"^")-AMTOMCCF
132 . . ;
133 . . ; split the amount before and after effective date,
134 . . ; default is allocate all to after effective date
135 . . S AMTOMCCF("AFTER EFF DATE")=AMTOMCCF
136 . . S AMTOMCCF("BEFORE EFF DATE")=0
137 . . ;
138 . . ; if the amount to mccf after the effective date exceeds the amount owed to mccf after the
139 . . ; effective date, place more in mccf before the effective date
140 . . I AMTOMCCF("AFTER EFF DATE")>RCBALANC("MCCF AFTER EFF DATE") D
141 . . . S AMTOMCCF("BEFORE EFF DATE")=AMTOMCCF("AFTER EFF DATE")-RCBALANC("MCCF AFTER EFF DATE")
142 . . . S AMTOMCCF("AFTER EFF DATE")=RCBALANC("MCCF AFTER EFF DATE")
143 . . ;
144 . . ; make amounts negative for decrease
145 . . S AMTOMCCF("BEFORE EFF DATE")=-AMTOMCCF("BEFORE EFF DATE")
146 . . S AMTOMCCF("AFTER EFF DATE")=-AMTOMCCF("AFTER EFF DATE")
147 . . ;
148 . . D SETTEMP^RCBMILLD("D",-$P(RCVALUE,"^"),.AMTOMCCF,-AMTOHSIF)
149 . ;
150 . ;
151 . ; * * * P A Y M E N T S * * *
152 . ; if it is a payment transaction, get the amount
153 . ; already paid to the funds
154 . I $P(RCDATA1,"^",2)=2!($P(RCDATA1,"^",2)=34) D Q
155 . . ; calculate the amount of this payment that should go to MCCF
156 . . ; for transactions created prior to the effective date
157 . . S AMTOMCCF("BEFORE EFF DATE")=RCBALANC("MCCF BEFORE EFF DATE")
158 . . I AMTOMCCF("BEFORE EFF DATE")>$P(RCVALUE,"^") S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")
159 . . ;
160 . . ; recalculate principal remaining after the mandatory amount
161 . . ; is given to MCCF
162 . . S PRINCPAL=$P(RCVALUE,"^")-AMTOMCCF("BEFORE EFF DATE")
163 . . ;
164 . . ; calculate the number of copayment charges that make up
165 . . ; the principal remaining. this number is used to calculate the
166 . . ; dollars to hsif. calculate the remainder after the standard
167 . . ; charge is allocated to mccf and hsif.
168 . . S CHARGES=PRINCPAL\RCCHARGE
169 . . S PRINCPAL=PRINCPAL#RCCHARGE
170 . . ;
171 . . ; calculate the amount that should go to mccf
172 . . ; it is the number of standard charges times the
173 . . ; amount of each standard charge allocated to mccf
174 . . S AMTOMCCF("AFTER EFF DATE")=+$J(CHARGES*RCTOMCCF,0,2)
175 . . ;
176 . . ; if the remainder is less than the standard charge
177 . . ; allocated to mccf, add it also
178 . . I PRINCPAL<RCTOMCCF S AMTOMCCF("AFTER EFF DATE")=AMTOMCCF("AFTER EFF DATE")+PRINCPAL
179 . . ;
180 . . ; if the remainder is more than the standard charge
181 . . ; allocated to mccf, add one more standard charge to
182 . . ; mccf and give the rest to hsif
183 . . I PRINCPAL>RCTOMCCF S AMTOMCCF("AFTER EFF DATE")=AMTOMCCF("AFTER EFF DATE")+RCTOMCCF
184 . . ;
185 . . ; if the amount to mccf exceeds the amount owed to mccf,
186 . . ; place more in hsif
187 . . I AMTOMCCF("AFTER EFF DATE")>RCBALANC("MCCF AFTER EFF DATE") D
188 . . . S AMTOMCCF("AFTER EFF DATE")=RCBALANC("MCCF AFTER EFF DATE")
189 . . ;
190 . . ; balance of payment goes to hsif
191 . . S AMTOHSIF=$P(RCVALUE,"^")-AMTOMCCF("BEFORE EFF DATE")-AMTOMCCF("AFTER EFF DATE")
192 . . ;
193 . . ; get the amount paid to the funds
194 . . S AMTPAID=$G(^PRCA(433,RCTRANDA,9))
195 . . ;
196 . . ; make amounts negative for payment
197 . . S AMTOMCCF("BEFORE EFF DATE")=-AMTOMCCF("BEFORE EFF DATE")
198 . . S AMTOMCCF("AFTER EFF DATE")=-AMTOMCCF("AFTER EFF DATE")
199 . . ;
200 . . D SETTEMP^RCBMILLD("P",-$P(RCVALUE,"^"),.AMTOMCCF,-AMTOHSIF,$P(AMTPAID,"^"),$P(AMTPAID,"^",2))
201 . ;
202 . ;
203 . ; * * * R E E S T A B L I S H * * *
204 . ; if it is a restablish transaction, add the amount to mccf
205 . I $P(RCDATA1,"^",2)=43 D Q
206 . . S AMTOMCCF("BEFORE EFF DATE")=$P(RCVALUE,"^")
207 . . S AMTOMCCF("AFTER EFF DATE")=0
208 . . D SETTEMP^RCBMILLD("R",$P(RCVALUE,"^"),.AMTOMCCF,0)
209 ;
210 Q RCTOTAL("OWED TO MCCF")_"^"_RCTOTAL("OWED TO HSIF")_"^"_RCTOTAL("PAID TO MCCF")_"^"_RCTOTAL("PAID TO HSIF")
Note: See TracBrowser for help on using the repository browser.