Attribute VB_Name = "a05_Rules"
Option Explicit
'- Individual variables needed for calculating BTP from 2003
Dim btp_pens As Long, btp_pensm As Long, btp_market As Long, btp_marketm As Long, btp_inc As Long
Dim btp_incm As Long, socbid_old As Long
Dim btp_capital As Long, btp_capitalm As Long, btp_taxable As Long, btp_taxablem As Long
Dim btp_old As Long, bob_old As Long
Dim ftp_gar, ftp_garm As Double
Dim btptyp, btptypm As Integer
Dim n_child(1 To 7) As Integer
' ********************************************************
' *** Calculate rules
' ********************************************************
Public Sub calc_rules()
'! Main rule sub
Printdok "calc_rules: Calculating taxes/benefits"
status "Calculating taxes/benefits"
Dim h As Long
Dim i As Long
Dim i_nr As Long
Dim i_index As Long
' -- Calculate work injuries insurance (arbetsskadeförsäkring)
Call Calculate_Work_Injuries
' -- Calculate "pension rights"
' The pension rights for the base year and the corresponding cumulative
' pension rights have already been calculated
If model_time > 0 Then
Call Calculate_Public_Pension_Rights
Call Calculate_Occupational_Pension_Rights
End If
'*** Imputation of public service subsidies
Call impute_public_consumption
'*** Truncation of private pension savings according to tax rules
For i = 1 To m_icount
If i_status(i) = 2 Then '-- No private pension savings for retired
i_wealth_pension_year(i) = 0
'Note: i_wealth_pension_total for retired updated in calculate_private_pension_benefits
Else '-- Not retired: Tax rules apply
Select Case i_inc_taxable(i)
Case Is <= 10 * m_basbelopp
i_wealth_pension_year(i) = mini(i_wealth_pension_year(i), 0.5 * m_basbelopp)
Case Is <= 20 * m_basbelopp
i_wealth_pension_year(i) = mini(i_wealth_pension_year(i), 0.05 * i_inc_taxable(i))
Case Else
i_wealth_pension_year(i) = mini(i_wealth_pension_year(i), m_basbelopp)
End Select
'-- Accumulation of private pensions
' Note: 15 % tax (avkastningskatt) on return of pension capital
' (15% av statslåneräntan egentligen)
i_wealth_pension_total(i) = (i_wealth_pension_total(i) + i_wealth_pension_year(i)) + _
(i_wealth_pension_total(i) + i_wealth_pension_year(i) / 2) * _
((m_interest_long * (1 - 0.15)) / 100)
End If
Next i
' -- Calculating taxes/benefits and summing up household income
status "Calculate disposable incomes"
Printdok " h loop: calc_disp_household"
Printdok " i in h loop calc_disp_household: s_income_tax"
Printdok " i in h loop calc_disp_household: s_realestate_tax"
Printdok " i in h loop calc_disp_household: s_capital_tax"
Printdok " i in h loop calc_disp_household: s_wealth_tax"
Printdok " i in h loop calc_disp_household: Calculate_Study_transfers"
For h = 1 To m_hcount
'Save for take up
btp_old = h_trf_btp(h)
bob_old = h_trf_housingallowance(h)
socbid_old = h_trf_socialassistance(h)
'Set variables to zero
If model_time > 0 Then
i_nr = h_first_indnr(h)
Do While i_nr <> 0
i_index = indnr2index(i_nr)
i_trf_study_grant(i_index) = 0
i_trf_study_loan(i_index) = 0
i_trf_study(i_index) = 0
i_studyloan_repaid(i_index) = 0
i_arbavg(i_index) = 0
i_arbavg_pens(i_index) = 0
i_inc_taxed(i_index) = 0
i_tax_local(i_index) = 0
i_tax_national(i_index) = 0
i_tax_contribution(i_index) = 0
i_tax_income(i_index) = 0
i_tax_realestate(i_index) = 0
i_tax_capital(i_index) = 0
i_taxred_capital(i_index) = 0
i_tax_wealth(i_index) = 0
i_tax_total(i_index) = 0
i_maintenance_paid(i_index) = 0
i_inc_market(i_index) = 0
i_inc_work(i_index) = 0
i_nr = i_next_indnr(indnr2index(i_nr))
Loop
h_inc_market(h) = 0
h_inc_work(h) = 0
' h_inc_capital(h) = 0
h_trf_taxable(h) = 0
h_trf_study(h) = 0
h_studyloan_repaid(h) = 0
h_trf_pension(h) = 0
h_tax_total(h) = 0
h_tax_realestate(h) = 0
h_maintenance_paid(h) = 0
h_trf_childallowance(h) = 0
h_trf_housingallowance(h) = 0
h_trf_btp(h) = 0
h_trf_socialassistance(h) = 0
h_maintenance_received(h) = 0
h_trf_taxfree(h) = 0
h_inc_disposable(h) = 0
End If
'-- Calculate taxes, transfers and disposable income
If h_abroad(h) = 0 Then Call calc_disp_household(h_hhnr(h))
Next
Printdok "-- calc_rules ready"
End Sub
'! Calculate rules for houshold hh_nr
Public Sub calc_disp_household(hh_nr As Long)
'-- Calculate individual rules
Dim indnr As Long
Dim indexnr As Long
Dim h_i_market, h_i_work ', h_i_capital As Double
Dim h_tr_taxable As Double
Dim h_tr_study As Double
Dim h_std_repaid As Double
Dim h_tr_pension As Double
Dim h_ftp_gar As Double
Dim h_tx_total As Double
Dim h_tx_realestate As Double
Dim h_m_paid As Double
Dim h_n_apens, h_n_fpens As Integer
Dim n_vux As Integer
h_i_market = 0
h_i_work = 0
' h_i_capital = 0
h_tr_taxable = 0
h_tr_study = 0
h_std_repaid = 0
h_tr_pension = 0
h_tx_total = 0
h_tx_realestate = 0
h_m_paid = 0
h_n_apens = 0: h_n_fpens = 0
h_ftp_gar = 0: ftp_gar = 0: ftp_garm = 0
btp_pens = 0: btp_pensm = 0
btp_market = 0: btp_marketm = 0
btp_capital = 0: btp_capitalm = 0
btp_taxable = 0: btp_taxablem = 0
btp_inc = 0: btp_incm = 0
n_vux = 0
btptyp = 0: btptypm = 0
n_child(1) = 0: n_child(2) = 0: n_child(3) = 0: n_child(4) = 0
n_child(5) = 0: n_child(6) = 0: n_child(7) = 0
'-- Individual step
indnr = h_first_indnr(hhnr2index(hh_nr))
Do While indnr <> 0
indexnr = indnr2index(indnr)
' -- Calculate study grants, loans and repayments
Call Calculate_Study_transfers(indexnr)
'-- Calculates employers contributions
If i_age(indexnr) < 65 Then
'i_arbavg(indexnr) = m_arbavg_p * i_inc_earning(indexnr)
i_arbavg_pens(indexnr) = m_arbavg_pens_p * i_inc_earning(indexnr)
i_arbavg_sjuk(indexnr) = m_arbavg_sjuk_p * i_inc_earning(indexnr)
i_arbavg_eft(indexnr) = m_arbavg_eft_p * i_inc_earning(indexnr)
i_arbavg_forp(indexnr) = m_arbavg_forp_p * i_inc_earning(indexnr)
i_arbavg_arsk(indexnr) = m_arbavg_arsk_p * i_inc_earning(indexnr)
i_arbavg_akas(indexnr) = m_arbavg_akas_p * i_inc_earning(indexnr)
i_arbavg_alon(indexnr) = m_arbavg_alon_p * i_inc_earning(indexnr)
i_arbavg(indexnr) = i_arbavg_pens(indexnr) + i_arbavg_sjuk(indexnr) + i_arbavg_eft(indexnr) + i_arbavg_forp(indexnr) + _
i_arbavg_arsk(indexnr) + i_arbavg_akas(indexnr) + i_arbavg_alon(indexnr)
End If
If i_age(indexnr) >= 65 Then
Select Case i_born_year(indexnr)
Case Is > 1937
i_arbavg_slon38(indexnr) = m_arbavg_slon38_p * i_inc_earning(indexnr)
i_arbavg_pens(indexnr) = m_arbavg_pens_p * i_inc_earning(indexnr)
i_arbavg(indexnr) = i_arbavg_pens(indexnr) + i_arbavg_slon38(indexnr)
Case Is < 1937
i_arbavg_slon(indexnr) = m_arbavg_slon_p * i_inc_earning(indexnr)
i_arbavg(indexnr) = i_arbavg_slon(indexnr)
End Select
End If
If model_time > 0 Then
'-- Income tax
Call s_income_tax(indexnr, hh_nr)
'-- Realestate tax
Call s_realestate_tax(indexnr, hh_nr)
'-- Capital income tax
Call s_capital_tax(indexnr)
'-- Wealth tax
Call s_wealth_tax(indexnr, hh_nr)
'-- Sum up total taxes
' SREDBO SKATTEREDUKTION FÖR FASTIGHETSSKATT and
' SREDFRM SKATTEREDUKTION FÖR FÖRMÖGENHETSSKATT not calculated
i_tax_total(indexnr) = maxi(i_tax_income(indexnr) + i_tax_realestate(indexnr) - i_taxred_capital(indexnr), 0) _
+ i_tax_capital(indexnr) + i_tax_wealth(indexnr)
'-- Maintenance paid
i_maintenance_paid(indexnr) = 0 'Fixa snare!!!!!
'--- Aggregate individual variables
i_inc_market(indexnr) = i_inc_earning(indexnr) + i_inc_selfemployed(indexnr) + i_inc_capital(indexnr)
i_inc_work(indexnr) = i_inc_earning(indexnr) + i_inc_selfemployed(indexnr) + i_trf_parentleave(indexnr) + i_trf_sickleave(indexnr)
'-- Aggregate to household level
h_i_market = h_i_market + i_inc_market(indexnr)
h_i_work = h_i_work + i_inc_work(indexnr)
' h_i_capital = h_i_capital + i_inc_capital(indexnr)
h_tr_taxable = h_tr_taxable + i_trf_taxable(indexnr)
h_tr_study = h_tr_study + i_trf_study(indexnr)
h_std_repaid = h_std_repaid + i_studyloan_repaid(indexnr)
h_tr_pension = h_tr_pension + i_trf_pension(indexnr)
h_tx_total = h_tx_total + i_tax_total(indexnr)
h_tx_realestate = h_tx_realestate + i_tax_realestate(indexnr)
h_m_paid = h_m_paid + i_maintenance_paid(indexnr)
'Count number of children in different age groups
If i_bvux(indexnr) = 0 Then
Select Case (i_age(indexnr))
Case 0
n_child(1) = n_child(1) + 1
Case 1 To 2
n_child(2) = n_child(2) + 1
Case 3
n_child(3) = n_child(3) + 1
Case 4 To 6
n_child(4) = n_child(4) + 1
Case 7 To 10
n_child(5) = n_child(5) + 1
Case 11 To 14
n_child(6) = n_child(6) + 1
Case Is >= 15
n_child(7) = n_child(7) + 1
End Select
End If
'Count number of pensioners in hh for BTP
If i_bvux(indexnr) = 1 And i_status(indexnr) = 2 Then h_n_apens = h_n_apens + 1
If i_bvux(indexnr) = 1 And i_status(indexnr) = 4 Then h_n_fpens = h_n_fpens + 1
If i_bvux(indexnr) = 1 Then
If n_vux = 0 Then
btp_pens = i_trf_pension(indexnr) - i_op(indexnr) - i_pp(indexnr)
btp_market = i_inc_market(indexnr)
btp_capital = i_inc_capital(indexnr)
btp_taxable = i_trf_taxable(indexnr)
btp_inc = i_inc_taxable(indexnr)
If i_status(indexnr) = 2 Then btptyp = 1
If i_status(indexnr) = 4 Then
btptyp = 2
ftp_gar = f_disab_guarantee(i_age(indexnr)) * m_basbelopp_ftp
End If
n_vux = n_vux + 1
Else
btp_pensm = i_trf_pension(indexnr) - i_op(indexnr) - i_pp(indexnr)
btp_marketm = i_inc_market(indexnr)
btp_capitalm = i_inc_capital(indexnr)
btp_taxablem = i_trf_taxable(indexnr)
btp_incm = i_inc_taxable(indexnr)
If i_status(indexnr) = 2 Then btptypm = 1
If i_status(indexnr) = 4 Then
btptypm = 2
ftp_garm = f_disab_guarantee(i_age(indexnr)) * m_basbelopp_ftp
End If
n_vux = n_vux + 1
End If
End If
End If 'modeltime > 0
indnr = i_next_indnr(indnr2index(indnr)) ' Get next indnr
Loop
'-- Household level
indexnr = hhnr2index(hh_nr)
If model_time > 0 Then
'-- Assign values to household variables
h_inc_market(indexnr) = h_i_market
h_inc_work(indexnr) = h_i_work
' h_inc_capital(indexnr) = h_i_capital
h_trf_taxable(indexnr) = h_tr_taxable
h_trf_study(indexnr) = h_tr_study
h_studyloan_repaid(indexnr) = h_std_repaid
h_trf_pension(indexnr) = h_tr_pension
h_tax_total(indexnr) = h_tx_total
h_tax_realestate(indexnr) = h_tx_realestate
h_maintenance_paid(indexnr) = h_m_paid
'-- Child allowance
h_trf_childallowance(indexnr) = f_childallowance(indexnr)
'-- Housing allowance, families
h_trf_housingallowance(indexnr) = f_housingallowance(indexnr) 'Flood 020410
'-- Housing allowance, pensioners
h_trf_btp(indexnr) = f_btp(indexnr, h_n_apens, h_n_fpens)
'-- Maintenance received (Förbättras ev. senare med omgifta och studerande barn över 17)
If h_n_adults(indexnr) = 1 Then
If base_year + model_time < 2006 Then h_maintenance_received(indexnr) = h_n_child(indexnr) * 1173# * 12#
If base_year + model_time > 2005 Then h_maintenance_received(indexnr) = h_n_child(indexnr) * 1273# * 12#
If base_year + model_time > 2009 Then h_maintenance_received(indexnr) = h_n_child(indexnr) * 1273# * 12# * m_wage_change09
End If
'-- Tax free transfers
h_trf_taxfree(indexnr) = h_trf_housingallowance(indexnr) + h_trf_btp(indexnr) + h_trf_childallowance(indexnr) + _
h_maintenance_received(indexnr) + h_trf_study(indexnr)
'-- Disposable income
h_inc_disposable(indexnr) = h_inc_market(indexnr) + h_trf_taxable(indexnr) + h_trf_taxfree(indexnr) - _
h_tax_total(indexnr) - h_maintenance_paid(indexnr) - h_studyloan_repaid(indexnr)
'-- Social assistance (including "äldreförsörjningsstöd")
h_trf_socialassistance(indexnr) = f_socialassistance(indexnr)
'*** Add social welfare benefit to income aggregates
h_inc_disposable(indexnr) = h_inc_disposable(indexnr) + h_trf_socialassistance(indexnr)
h_trf_taxfree(indexnr) = h_trf_taxfree(indexnr) + h_trf_socialassistance(indexnr)
End If 'modeltime > 0
End Sub
'-- Study loans, grants and repayments Studiemedel & studielån
' Source: Studistödslag(1999:1395)
' Assumes all full time students 40 weeks per year, 100 % take up rate
' Only the current system implemented. No transition rules.
Public Sub Calculate_Study_transfers(indexnr)
'! -- Study loans, grants and repayments Studiemedel & studielån
Dim interest As Double
Dim year As Integer
Dim study_interest As Long, study_repayment As Long
interest = (m_KPI - 1) + 0.02
year = model_time + base_year
If i_status(indexnr) = 3 And i_age(indexnr) >= 20 And i_age(indexnr) <= 50 Then
If model_time > 0 Then
i_trf_study(indexnr) = 0.0439 * 40 * m_basbelopp
'ThP Inkomstindexerar studiemedel from 2010
If year > 2009 Then i_trf_study(indexnr) = i_trf_study(indexnr) * m_realwage_change09
'-- Income test Inkomstprövning
i_trf_study(indexnr) = i_trf_study(indexnr) - _
maxi(0, 0.5 * (i_inc_taxable(indexnr) - (2 * 1.25) * m_basbelopp))
'-- Below 0.25 base amounts per week not payed out
If i_trf_study(indexnr) <= (0.0025 * 40) * m_basbelopp Then i_trf_study(indexnr) = 0
'-- Proportional reduction of grants and loans
i_trf_study_grant(indexnr) = (0.0151 / 0.0439) * i_trf_study(indexnr)
i_trf_study_loan(indexnr) = i_trf_study(indexnr) - i_trf_study_grant(indexnr)
'-- Ackumulation of study loans
' Fix: Using CPI+2% as interest
i_study_debt(indexnr) = (i_study_debt(indexnr) * (1 + interest)) + _
(i_trf_study_loan(indexnr) * (1 + (interest / 2)))
Else
i_trf_study_grant(indexnr) = (0.0151 / 0.0439) * i_trf_study(indexnr)
i_trf_study_loan(indexnr) = i_trf_study(indexnr) - i_trf_study_grant(indexnr)
End If
Else '-- Repayment of study loans (simplified)
' Source: Studistödslag(1999:1395) §§ 7 ff
If model_time > 0 Then
i_trf_study_grant(indexnr) = 0
i_trf_study_loan(indexnr) = 0
i_trf_study(indexnr) = 0
' -- Note: 8 §, 4 st about profile of repayments not implemented
If i_age(indexnr) < 67 And i_study_debt(indexnr) > 0 Then
i_studyloan_repaid(indexnr) = Pmt(interest, _
mini(25, maxi(61 - i_age(indexnr), 1)), -i_study_debt(indexnr))
' -- Repayment including interest max 5 % of taxed income
' Note: Additional rules in § 14 not implemented
If i_studyloan_repaid(indexnr) > 0.05 * i_inc_taxable(indexnr) Then
i_studyloan_repaid(indexnr) = 0.05 * i_inc_taxable(indexnr)
' -- § 14 4:e st about floor for payments (fribelopp)
If i_studyloan_repaid(indexnr) < 0.05 * m_basbelopp Then
i_studyloan_repaid(indexnr) = 0
End If
End If
' -- Debt
study_interest = i_study_debt(indexnr) * interest
i_study_debt(indexnr) = (i_study_debt(indexnr) * (1 + interest)) _
- i_studyloan_repaid(indexnr)
Else
i_studyloan_repaid(indexnr) = 0
i_study_debt(indexnr) = 0
End If
End If
End If
'-- Study help Studiehjälp for student <20
' Same as child allowance (except 2006) during semesters i.e 10 months a year
' Utbetalas under terminerna med samma belopp som för barnbidraget
If i_status(indexnr) = 3 And i_age(indexnr) < 20 And model_time > 0 Then
Dim xgrund As Long
Select Case year
Case Is > 2006
xgrund = 12600 * (10 / 12)
Case Is = 2006
xgrund = (0.75 * 11400 + 0.25 * 12600) * (10 / 12)
Case 2001 To 2005
xgrund = 11400 * (10 / 12)
Case Is = 2000
xgrund = 10200 * (10 / 12)
Case Is = 1999
xgrund = 9000 * (10 / 12)
End Select
'ThP Inkomstindexerar studiemedel from 2009
If year > 2009 Then xgrund = xgrund * m_wage_change09
i_trf_study_grant(indexnr) = xgrund
i_trf_study_loan(indexnr) = 0
i_trf_study(indexnr) = xgrund
End If
' If i_study_debt(indexnr) <> 0 Then
'' If (i_indnr(indexnr) = 85 Or i_indnr(indexnr) = 3080) Then
' Print_to_file "stud.txt", "N", year, i_bidnr(indexnr), i_indnr(indexnr), i_age(indexnr), i_status(indexnr), _
' i_trf_study(indexnr), i_trf_study_grant(indexnr), i_trf_study_loan(indexnr), _
' i_studyloan_repaid(indexnr), i_study_debt(indexnr)
' End If
End Sub
' ********************************************************
' *** Income tax
' ********************************************************
Public Sub s_income_tax(indexnr As Long, hh_nr As Long)
'Const kifskatt = 0.3148 ' Genomsnitt 1999 är 31.48
Dim kifskatt As Double ' Faktiska skattesatser 1999
Const stats1 = 0.2
Const stats2 = 0.05
'Const stats1 = 0#
'Const stats2 = 0#
Dim avgift As Double
Dim avtak As Double
Dim xsredpen As Double
Dim sbryt1 As Double
Dim sbryt2 As Double
Dim gniva As Double
Dim besk As Double
Dim bb As Double
Dim ibb As Double
Dim egen As Double
Dim overbryt1 As Double
Dim overbryt2 As Double
Dim minstat As Double
Dim grund As Double
Dim pgi As Double
Dim skfvi As Double
Dim ssfvi As Double
Dim Max_rabatt As Double
Dim Rab_gr As Double
Dim Redproc As Double
Dim srab As Double
Dim zsrab As Double
Dim sredpen As Double
Dim taxink As Long
Dim sreds As Long
Dim XABEL1 As Double
Dim XABEL2 As Double
Dim XAINK1 As Double
Dim XAINK2 As Double
Dim XAINK3 As Double
Dim XAARB As Double
Dim ZAINK As Double
Dim sredarb As Double
bb = m_basbelopp
If base_year + model_time < 2001 Then ibb = m_basbelopp_f Else ibb = m_basbelopp_income
taxink = i_inc_taxable(indexnr) - i_wealth_pension_year(indexnr)
grund = f_basic_deduction(taxink, i_status(indexnr), i_civ_stat(indexnr))
'Parametrar
Select Case (base_year + model_time)
Case 1999
avgift = 0.0695 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.06 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
sbryt1 = 219300
sbryt2 = 360000
Case 2000
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 0.25 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 232600 'SKIKTGRÄNS 1
sbryt2 = 374000 'SKIKTGRÄNS 2
Case 2001
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 0.5 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 252000 'SKIKTGRÄNS 1
sbryt2 = 390400 'SKIKTGRÄNS 2
Case 2002
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 0.75 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 273800 'SKIKTGRÄNS 1
sbryt2 = 414200 'SKIKTGRÄNS 2
Case 2003
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 0.75 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 284300 'SKIKTGRÄNS 1
sbryt2 = 430000 'SKIKTGRÄNS 2
Case 2004
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 0.75 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 291800 'SKIKTGRÄNS 1
sbryt2 = 441300 'SKIKTGRÄNS 2
Case 2005
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 0.875 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 298600 'SKIKTGRÄNS 1
sbryt2 = 450500 'SKIKTGRÄNS 2
Case 2006
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 1 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 306000 'SKIKTGRÄNS 1
sbryt2 = 460600 'SKIKTGRÄNS 2
Case 2007
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 1 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 316700 'Från HEK04v4 070131
sbryt2 = 476700 'Från HEK04v4 070131
'Jobbskattevadraget
XABEL1 = 1.176 * m_basbelopp 'BELOPP FÖR YNGRE
XABEL2 = 1.816 * m_basbelopp 'BELOPP FÖR ÄLDRE
XAINK1 = 0.79 * m_basbelopp 'INKOMSTGRÄNS FÖR YNGRE
XAINK2 = 1.59 * m_basbelopp 'INKOMSTGRÄNS FÖR ÄLDRE
XAINK3 = 2.72 * m_basbelopp 'ÖVRE INKOMSTGRÄNS
XAARB = 0.2 'ANDELSTAL
Case 2008
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 1 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 327700 'Från HEK04v4 070131
sbryt2 = 493400 'Från HEK04v4 070131
'Jobbskattevadraget
XABEL1 = 1.176 * m_basbelopp 'BELOPP FÖR YNGRE
XABEL2 = 1.816 * m_basbelopp 'BELOPP FÖR ÄLDRE
XAINK1 = 0.79 * m_basbelopp 'INKOMSTGRÄNS FÖR YNGRE
XAINK2 = 1.59 * m_basbelopp 'INKOMSTGRÄNS FÖR ÄLDRE
XAINK3 = 2.72 * m_basbelopp 'ÖVRE INKOMSTGRÄNS
XAARB = 0.2 'ANDELSTAL
Case 2009
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 1 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
sbryt1 = 341100 'Från HEK04v4 070131
sbryt2 = 513600 'Från HEK04v4 070131
'Jobbskattevadraget
XABEL1 = 1.176 * m_basbelopp 'BELOPP FÖR YNGRE
XABEL2 = 1.816 * m_basbelopp 'BELOPP FÖR ÄLDRE
XAINK1 = 0.79 * m_basbelopp 'INKOMSTGRÄNS FÖR YNGRE
XAINK2 = 1.59 * m_basbelopp 'INKOMSTGRÄNS FÖR ÄLDRE
XAINK3 = 2.72 * m_basbelopp 'ÖVRE INKOMSTGRÄNS
XAARB = 0.2 'ANDELSTAL
Case Is > 2009
avgift = 0.07 'PROCENTANDEL ALLMÄN PENSIONSAVGIFT
avtak = 8.07 'TAK FÖR UTTAG ALLMÄN PENSIONSAVGIFT
xsredpen = 1 'PROCENTANDEL SKATTERED. ALLM PENS.AVG
'Skiktgränserna skrivs upp med nominallönerna
sbryt1 = 341100 * m_wage_change09 'Från HEK04v4 070131
sbryt2 = 513600 * m_wage_change09 'Från HEK04v4 070131
'Jobbskattevadraget
XABEL1 = 1.176 * m_basbelopp * m_realwage_change09 'BELOPP FÖR YNGRE
XABEL2 = 1.816 * m_basbelopp * m_realwage_change09 'BELOPP FÖR ÄLDRE
XAINK1 = 0.79 * m_basbelopp * m_realwage_change09 'INKOMSTGRÄNS FÖR YNGRE
XAINK2 = 1.59 * m_basbelopp * m_realwage_change09 'INKOMSTGRÄNS FÖR ÄLDRE
XAINK3 = 2.72 * m_basbelopp * m_realwage_change09 'ÖVRE INKOMSTGRÄNS
XAARB = 0.2 'ANDELSTAL
End Select
gniva = f_bas_deduct_min(base_year + model_time) ' LÄGSTA GRUNDAVDRAG
'SÄRSKILD SKATTEREDUKTION (t.o.m 2002)
Max_rabatt = 1320 'MAXIMAL SKATTERABATT
Rab_gr = 135000 'STARTPUNKT FÖR REDUCERING
Redproc = 0.012 'REDUCERINGSFAKTOR
'SKATTEREDUKTION FÖR FACKFÖRENINGSAVGIFT OCH AVGIFT TILL ARBETSLÖSHETSKASSA
' Gäller fr.o.m 2002 men implementeras inte i SESIM
'XFACK=0.25
'XAKASSA=0.4
'XFACKGR=400
'Allmän pensionsavgift
egen = 0
If i_age(indexnr) <= 65 Then
pgi = taxink
If pgi > avtak * ibb Then pgi = avtak * ibb
pgi = Int(pgi / 100) * 100
egen = avgift * pgi
If base_year + model_time = 1999 Then
egen = round((egen - 1), -2)
Else
egen = Int((egen + 49) / 100) * 100
End If
If pgi < gniva Then egen = 0
If i_status(indexnr) = 4 Then egen = 0
End If
'Skattereduktion för allmän pensionsavgift
sredpen = 0
If base_year + model_time > 1999 Then sredpen = Int(xsredpen * egen / 100) * 100
'Beskattningsbar inkomst
besk = taxink - grund - egen + sredpen
besk = Int(besk / 100) * 100
If besk < 0 Then besk = 0
'Kommunal skatt (HAR VI DIFFERENTIERADE SKATTESATSER NU OCH DE VARIERAR ÖVER TIDEN)
Select Case (base_year + model_time)
Case Is >= 2006
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt06 / 100
Case 1999
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt99 / 100
Case 2000
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt00 / 100 'satserna efter 99 är lägre pga kyrkskatt
Case 2001
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt01 / 100
Case 2002
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt02 / 100
Case 2003
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt03 / 100
Case 2004
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt04 / 100
Case 2005
kifskatt = kommundata(h_kommunindex(hhnr2index(hh_nr))).skatt05 / 100
End Select
skfvi = kifskatt * besk
If besk > 0 And base_year + model_time < 2005 Then skfvi = skfvi + 200
skfvi = Int(skfvi)
'Jobbskatteavdraget fr.o.m 2007
sredarb = 0
If (base_year + model_time) >= 2007 Then
ZAINK = i_inc_earning(indexnr)
ZAINK = Int(ZAINK / 100) * 100
'SKATTEREDUKTION FÖR PERSONER <66 ÅR
If i_age(indexnr) <= 65 Then
If ZAINK <= XAINK1 Then
sredarb = (ZAINK - grund) * kifskatt
ElseIf ZAINK > XAINK1 And ZAINK <= XAINK3 Then
sredarb = (XAINK1 + XAARB * (ZAINK - XAINK1) - grund) * kifskatt
ElseIf ZAINK > XAINK3 Then
sredarb = (XABEL1 - grund) * kifskatt
End If
End If
'SKATTEREDUKTION FÖR PERSONER >65 ÅR
If i_age(indexnr) > 65 Then
If ZAINK <= XAINK2 Then
sredarb = (ZAINK - grund) * kifskatt
ElseIf ZAINK > XAINK2 And ZAINK <= XAINK3 Then
sredarb = (XAINK2 + XAARB * (ZAINK - XAINK2) - grund) * kifskatt
ElseIf ZAINK > XAINK3 Then
sredarb = (XABEL2 - grund) * kifskatt
End If
End If
sredarb = maxi(Int(sredarb), 0)
End If
'Skatterabatt
srab = 0
If base_year + model_time < 2002 Then
If pgi < Rab_gr Then
srab = mini(Max_rabatt, pgi)
Else
srab = maxi(0, Max_rabatt - Redproc * (pgi - Rab_gr))
End If
srab = mini(srab, skfvi)
srab = Int(srab)
End If
If base_year + model_time = 2001 And grund > 0 And besk <= 9500 Then
zsrab = Max_rabatt
If besk > 4300 Then zsrab = maxi(0, Max_rabatt - 0.25 * (besk - 4300))
'ZSRAB=ZSRAB*(BGAMAN/12) månadsjustering??
If zsrab > srab Then srab = Int(zsrab)
End If
If base_year + model_time = 2002 Then
If taxink < Rab_gr Then
srab = mini(Max_rabatt, taxink)
Else
srab = maxi(0, Max_rabatt - Redproc * (taxink - Rab_gr))
End If
If i_status(indexnr) <> 2 And i_status(indexnr) <> 4 Then srab = mini(srab, skfvi)
srab = Int(srab)
End If
'SÄRSKILD SKATTEREDUKTION VID 2005 ÅRS TAXERING
sreds = 0
If base_year + model_time = 2004 And besk >= 100 Then sreds = 200
'Statlig skatt
overbryt1 = besk - sbryt1
If overbryt1 < 0 Then overbryt1 = 0
overbryt2 = besk - sbryt2
If overbryt2 < 0 Then overbryt2 = 0
ssfvi = stats1 * overbryt1 + stats2 * overbryt2
ssfvi = Int(ssfvi)
i_inc_taxed(indexnr) = besk
i_tax_local(indexnr) = skfvi
i_tax_national(indexnr) = ssfvi
i_tax_contribution(indexnr) = egen
i_tax_workcredit(indexnr) = sredarb
i_tax_income(indexnr) = maxi((maxi(skfvi - sredarb, 0) + ssfvi - srab - sredpen - sreds), 0) + egen
End Sub
'*** Basic deduction
Public Function f_basic_deduction(ink, status, civ_stat) As Double
Dim g As Double
Dim sga As Double
Dim sgae As Double
Dim sgag As Double
Dim sgaproc As Double
Dim sgamax As Double
Dim sgared As Double
Dim i As Integer
Dim Upp_gr1 As Double
Dim Upp_gr2 As Double
Dim Ned_gr As Double
Dim Upp_proc As Double
Dim Ned_proc As Double
Dim Gnivå1 As Double
Dim Gnivå2 As Double
Dim xgr As Double
Select Case (base_year + model_time)
Case Is < 2001
Gnivå1 = 0.24 * m_basbelopp
Gnivå2 = 0.24 * m_basbelopp
Upp_gr1 = 1.86 * m_basbelopp
Upp_gr2 = 2.89 * m_basbelopp
Ned_gr = 3.04 * m_basbelopp
Upp_proc = 0.25
Ned_proc = 0.1
Case 2001
Gnivå1 = 0.27 * m_basbelopp
Gnivå2 = 0.27 * m_basbelopp
Upp_gr1 = 1.86 * m_basbelopp
Upp_gr2 = 2.89 * m_basbelopp
Ned_gr = 3.04 * m_basbelopp
Upp_proc = 0.25
Ned_proc = 0.1
Case 2002
Gnivå1 = 0.293 * m_basbelopp
Gnivå2 = 0.293 * m_basbelopp
Upp_gr1 = 1.86 * m_basbelopp
Upp_gr2 = 2.89 * m_basbelopp
Ned_gr = 3.04 * m_basbelopp
Upp_proc = 0.25
Ned_proc = 0.1
Case 2003 To 2004
Gnivå1 = 0.423 * m_basbelopp
Gnivå2 = 0.293 * m_basbelopp
Upp_gr1 = 1.49 * m_basbelopp
Upp_gr2 = 2.72 * m_basbelopp
Ned_gr = 3.1 * m_basbelopp
Upp_proc = 0.2
Ned_proc = 0.1
Case 2005
Gnivå1 = 0.423 * m_basbelopp
Gnivå2 = 0.293 * m_basbelopp
Upp_gr1 = 1.185 * m_basbelopp
Upp_gr2 = 2.72 * m_basbelopp
Ned_gr = 3.11 * m_basbelopp
Upp_proc = 0.2
Ned_proc = 0.1
Case Else
Gnivå1 = 0.423 * m_basbelopp
Gnivå2 = 0.293 * m_basbelopp
Upp_gr1 = 0.99 * m_basbelopp
Upp_gr2 = 2.72 * m_basbelopp
Ned_gr = 3.11 * m_basbelopp
Upp_proc = 0.2
Ned_proc = 0.1
End Select
g = 0
If ink <= Gnivå1 Then g = ink
If ink > Gnivå1 And ink <= Upp_gr1 Then g = Gnivå1
If ink > Upp_gr1 And ink <= Upp_gr2 Then g = Gnivå1 + Upp_proc * (ink - Upp_gr1)
If ink > Upp_gr2 And ink <= Ned_gr Then g = Gnivå1 + Upp_proc * (Upp_gr2 - Upp_gr1)
If ink > Ned_gr Then g = Gnivå1 + Upp_proc * (Upp_gr2 - Upp_gr1) - Ned_proc * (ink - Ned_gr)
If g < Gnivå2 And ink > Ned_gr Then g = Gnivå2
'Löneindexerat från 2010
If base_year + model_time > 2009 Then g = g * m_realwage_change09
If base_year + model_time < 2001 Then
g = Int(g / 100) * 100
Else
g = Int((g + 99.9) / 100) * 100
End If
'Särskilt grundavdrag
sga = 0
If base_year + model_time < 2003 And (status = 2 Or status = 4) Then
Select Case base_year + model_time
Case 1999
sgae = 1.5232 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS
sgag = 1.3482 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS
sgaproc = 0.65 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDR
Case 2000
sgae = 1.529 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS
sgag = 1.354 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS
sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDR
Case 2001
sgae = 1.559 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS
sgag = 1.381 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS
sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDR
Case 2002
sgae = 1.5749 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS
sgag = 1.3969 * m_basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS
sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDRAG
End Select
'REDUCERING
If civ_stat = 0 Then
sgamax = sgae 'Ogift
Else
sgamax = sgag 'Gift
End If
sgared = sgaproc * maxi(ink - sgamax, 0)
sgared = maxi(sgamax - sgared, 0)
'SPÄRREGELN
'Skall detta vara med? kolla med olle
'IF BFPSGA IN(11 21) AND BGAMAN=12 THEN
'ASGA=MIN(MAX(TPENSA+PARBLF,PFPTOT),ZSGARED);
'IF (BFPSGA IN(12 13 22 23) OR BGAMAN<12) THEN
'ASGA=MIN(PFPTOT,ZSGARED);
If base_year + model_time < 2001 Then
sga = Int(sgared / 100) * 100
Else
sga = round(sgared, -2)
End If
'JÄMFÖRELSE MED G
If g > sga Then sga = g
g = 0
If sga > ink Then sga = ink
End If
f_basic_deduction = g + sga
End Function
'*** Minimum basic deduction level
' Grundavdragets grundnivå
Public Function f_bas_deduct_min(year)
Select Case (year)
Case Is > 2002
f_bas_deduct_min = Int((0.423 * m_basbelopp + 99) / 100) * 100
Case 2002
f_bas_deduct_min = Int((0.293 * m_basbelopp + 99) / 100) * 100
Case 2001
f_bas_deduct_min = Int((0.27 * m_basbelopp + 99) / 100) * 100
Case Is < 2001
f_bas_deduct_min = Int(0.24 * m_basbelopp / 100) * 100
End Select
'Löneindexerat från 2009
If base_year + model_time > 2009 Then f_bas_deduct_min = f_bas_deduct_min * m_realwage_change09
End Function
' ********************************************************
' *** Realestate tax
' ********************************************************
'Alla betalar full fastighetsskatt (delas mellen de vuxna i hh)
Public Sub s_realestate_tax(indexnr As Long, hh_nr As Long)
Dim xfastp As Double
If base_year + model_time < 2001 Then
xfastp = 0.015
Else
xfastp = 0.01
End If
If (i_bvux(indexnr) = 1 And h_house_tax(hhnr2index(hh_nr)) > 0) Then
i_tax_realestate(indexnr) = h_house_tax(hhnr2index(hh_nr)) * xfastp / h_n_adults(hhnr2index(hh_nr))
' Individual real estate tax is added to the household housing costs
h_house_cost(hhnr2index(hh_nr)) = h_house_cost(hhnr2index(hh_nr)) + i_tax_realestate(indexnr)
End If
End Sub
' ********************************************************
' *** Capital tax
' ********************************************************
Public Sub s_capital_tax(indexnr As Long)
Dim ctax As Double, ctaxred As Double
Dim income_capital As Double
Dim zmaxred As Double
Const xcapital = 0.3
Const xgransp = 0.7
Dim xgransv As Double
ctax = 0
ctaxred = 0
If base_year + model_time < 2010 Then
xgransv = 100000
Else
xgransv = 100000 * m_wage_change09
End If
income_capital = i_inc_capital(indexnr)
If income_capital >= 100 Then ctax = Int(xcapital * income_capital)
If income_capital < 0 Then
If Abs(income_capital) < xgransv Then
ctaxred = Int(xcapital * Abs(income_capital))
Else
ctaxred = xcapital * xgransv + xcapital * xgransp * (Abs(income_capital) - xgransv)
End If
zmaxred = i_tax_local(indexnr) + i_tax_national(indexnr) + i_tax_realestate(indexnr) - i_tax_workcredit(indexnr)
If (ctaxred > zmaxred) Then ctaxred = zmaxred
End If
i_tax_capital(indexnr) = ctax
i_taxred_capital(indexnr) = ctaxred
End Sub
' ********************************************************
' *** Wealth tax
' ********************************************************
Public Sub s_wealth_tax(indexnr As Long, hh_nr As Long)
Dim xforgr As Long
Const xfint = 0.015
Const xsparrp = 0.6
Dim fsp, fsph, zsprr, zsumma, zneds, zform50, tax_national, tdiff As Double
'Makar delar lika på förmögenheten, reglerna förberdda för olika andelar
fsph = Int(h_wealth_financial(hhnr2index(hh_nr)) / 1000) * 1000
fsp = fsph / h_n_adults(hhnr2index(hh_nr))
Select Case (base_year + model_time)
Case Is > 2004
If h_n_adults(hhnr2index(hh_nr)) = 2 Then
xforgr = 1500000
Else
xforgr = 3000000
End If
Case Is < 2001
xforgr = 900000
Case Is = 2001
If h_n_adults(hhnr2index(hh_nr)) = 2 Then
xforgr = 1000000
Else
xforgr = 1500000
End If
Case Else
If h_n_adults(hhnr2index(hh_nr)) = 2 Then
xforgr = 1500000
Else
xforgr = 2000000
End If
End Select
If (base_year + model_time) > 2009 Then xforgr = xforgr * m_wage_change09
If fsph > xforgr And fsp > 0 Then
i_tax_wealth(indexnr) = xfint * (fsph - xforgr)
i_tax_wealth(indexnr) = Int(mini(1, fsp / fsph) * i_tax_wealth(indexnr))
End If
'-- "Limitation rule"
' SPÄRR- OCH SKATTEBELOPP SKA EGENTLIGEN BERÄKNAS GEMENSAMT MEN SKAPAS I PROGRAMMET NEDAN INVIDIUELLT
' Hämtat från FASIT
zsprr = Int(xsparrp * (i_inc_taxed(indexnr) + maxi(0, i_inc_capital(indexnr)))) ' "Limitincome"
zsumma = i_tax_local(indexnr) + i_tax_national(indexnr) + i_tax_wealth(indexnr) + i_tax_capital(indexnr)
If zsumma > zsprr Then
zneds = zsumma - zsprr ' "Excess tax"
If fsph / 2 > xforgr Then
zform50 = xfint * (fsph / 2 - xforgr)
zform50 = Int(mini(1, fsp / fsph) * zform50)
End If
'Reduce taxes in the following order: wealth, capital, income
Select Case zneds
Case Is < (i_tax_wealth(indexnr) - zform50)
i_tax_wealth(indexnr) = i_tax_wealth(indexnr) - zneds
Case Is < (i_tax_wealth(indexnr) + i_tax_capital(indexnr) - zform50)
i_tax_capital(indexnr) = i_tax_capital(indexnr) - (zneds - (i_tax_wealth(indexnr) - zform50))
i_tax_wealth(indexnr) = zform50
Case Is < (i_tax_wealth(indexnr) + i_tax_capital(indexnr) + i_tax_national(indexnr) - zform50)
tax_national = Int(i_tax_national(indexnr) - (zneds - (i_tax_wealth(indexnr) + i_tax_capital(indexnr) - zform50)))
i_tax_wealth(indexnr) = zform50
i_tax_capital(indexnr) = 0
tdiff = i_tax_national(indexnr) - tax_national
i_tax_national(indexnr) = tax_national
i_tax_income(indexnr) = maxi((i_tax_income(indexnr) - tdiff), 0)
Case Else
i_tax_wealth(indexnr) = zform50
i_tax_capital(indexnr) = 0
tax_national = i_tax_national(indexnr)
i_tax_national(indexnr) = 0
i_tax_income(indexnr) = maxi((i_tax_income(indexnr) - tax_national), 0)
End Select
End If
If i_tax_wealth(indexnr) < 0 Then i_tax_wealth(indexnr) = 0
i_tax_wealth(indexnr) = round(i_tax_wealth(indexnr), -1)
End Sub
'****************
'* Childsupport *
'****************
Public Function f_childallowance(h) As Double
Dim inr As Long
Dim i As Integer
Dim j As Integer
Dim h_n_child15 As Integer
Dim xgrund As Double
Dim xtill(1 To 4) As Double
Dim grundbel As Double
Dim fbtill As Double
Select Case (base_year + model_time)
Case Is > 2005
xgrund = 12600
xtill(1) = 1200
xtill(2) = 4248
xtill(3) = 10320
xtill(4) = 12600
Case Is = 1999
xgrund = 9000
xtill(1) = 0
xtill(2) = 2400
xtill(3) = 7200
xtill(4) = 9000
Case Is = 2000
xgrund = 10200
xtill(1) = 0
xtill(2) = 2724
xtill(3) = 8160
xtill(4) = 10200
Case Is = 2005
xgrund = 0.75 * 11400 + 0.25 * 12600
xtill(1) = 0.25 * 1200
xtill(2) = 0.75 * 3048 + 0.25 * 4248
xtill(3) = 0.75 * 9120 + 0.25 * 10320
xtill(4) = 0.75 * 11400 + 0.25 * 12600
Case Else '2001 to 2004
xgrund = 11400
xtill(1) = 0
xtill(2) = 3048
xtill(3) = 9120
xtill(4) = 11400
End Select
'Beräkna antal barn under 16
h_n_child15 = 0
inr = h_first_indnr(h) 'First i-nr
If i_age(indnr2index(inr)) < 16 Then h_n_child15 = h_n_child15 + 1
Do Until inr = 0
inr = i_next_indnr(indnr2index(inr)) 'Next i-nr
If inr > 0 Then If i_age(indnr2index(inr)) < 16 Then h_n_child15 = h_n_child15 + 1
Loop
'Beräkna barnbidrag
'Alla barn får grundbelopp t.o.m hela det år de fyller femton
'Alla barn räknas med för flerbarnstillägg t.o.m hela det år de fyller 17
'Dessa förenklingar är kopierade från FASIT
grundbel = xgrund * h_n_child15
fbtill = 0
If h_n_child(h) > 1 Then
For i = 2 To h_n_child(h)
j = mini((i - 1), 4)
fbtill = fbtill + xtill(j)
Next
End If
f_childallowance = grundbel + fbtill
'Löneuppräknat fr.o.m 2010
If base_year + model_time > 2009 Then f_childallowance = f_childallowance * m_wage_change09
End Function
'*******************************
'* Calculate housing allowance *
'*******************************
' 2003-01-13 inkomstgränser justeras med reallöneutveckling och boendekostnadsgränser med prisutvecklingen
' 2005-12-14 inkomstgränser justeras med löneutveckling och boendekostnadsgränser med prisutvecklingen fr 2009
' Bob för umgängesbarn modelleras inte
Public Function f_housingallowance(h) As Double
Dim ZFORMNEH, IBOSTBH, ZFORMNEX, ZFOINKH, CSBINK, ZBOST, ZRANTA, ZZRANTA As Single
Dim XGAR1, XGAR2, XGAR3, XGAR4, XGAR5, XFOGRAN, XN5, XM5, XO5, XFMB, XUNGE, XUNGS As Single
Dim xslump As Double
Dim inr, h_n_child18, ZBARNSUM, ZBANTBRN, ZBANTSAR, status As Integer
Dim h_bincome As Double
Dim zn(1 To 3) As Single
Dim zm(1 To 3) As Single
Dim zo(1 To 3) As Single
Dim zg(1 To 5) As Single
Const xksats As Single = 0.3 ' Tax on capital income
Const xinterest As Single = 0.08 ' Interest rate on property loan
' BEGRÄNSNING AV BIDRAGSGRUNDANDE BOYTA
Const XBOYTAU As Single = 60 ' UNGDOMAR 18-29 ÅR UTAN BARN
Const XBOYTA1 As Single = 80 ' HUSHÅLL MED ETT BARN
Const XBOYTA2 As Single = 100 ' HUSHÅLL MED TVÅ BARN
Const XBOYTA3 As Single = 120 ' HUSHÅLL MED TRE BARN
Const XBOYTA4 As Single = 140 ' HUSHÅLL MED FYRA BARN
Const XBOYTA5 As Single = 160 ' HUSHÅLL MED FEM ELLER FL BARN
' GARANTINIVÅ AVSEENDE BOSTADSKOSTNAD
XGAR1 = 3000 ' HUSHÅLL MED 1 BARN
XGAR2 = 3300 ' HUSHÅLL MED 2 BARN
XGAR3 = 3600 ' HUSHÅLL MED 3 BARN
XGAR4 = 3900 ' HUSHÅLL MED 4 BARN
XGAR5 = 4200 ' HUSHÅLL MED 5-BARN
' FÖRMÖGENHET I EGNA HEM OCH BOSTADSRÄTTER
Const XKASKU As Single = 0.03 ' PROCENTSATS
' FÖRMÖGENHETSPRÖVNING
Const XFOPROC As Single = 0.15 ' PROCENTSATS
XFOGRAN = 100000 ' FÖRMÖGENHETSGRÄNS
Const XAND1 As Single = 0.75 ' PROCENTANDEL MELLAN - NEDRE GRÄNS
Const XAND2 As Single = 0.5 ' PROCENTANDEL ÖVRE - MELLAN GRÄNS
' HYRESGRÄNSER M M UNGDOMAR UNDER 29 ÅR
XN5 = 1800 'NEDRE
XM5 = 2600 'MELLAN
XO5 = 3600 'ÖVRE
Const XAND4 As Single = 0.75 ' PROCENTANDEL FÖRSTA INT
Const XAND5 As Single = 0.5 ' PROCENTANDEL ANDRA INT
' REDUCERINGEN
' FAMILJER MED BARN
XFMB = 117000 'MININKOMST
Const XRFMB As Single = 0.2 'REDFAKTOR
' UNGDOMAR ENSAMSTÅENDE
XUNGE = 41000 'MININKOMST
Const XRUNGE As Single = 0.33 'REDFAKTOR
' UNGDOMAR SAMBOENDE
XUNGS = 58000 'MININKOMST
Const XRUNGS As Single = 0.33 'REDFAKTOR
' HYRESGRÄNSER M M BARNFAMILJER
' NEDRE
zn(1) = 2000 ' FAMILJ MED 1 BARN
zn(2) = 2000 ' " 2 BARN
zn(3) = 2000 ' " 3-BARN
' MELLAN
zm(1) = 3000 ' FAMILJ MED 1 BARN
zm(2) = 3300 ' " 2 BARN
zm(3) = 3600 ' " 3-BARN
' ÖVRE
zo(1) = 5300 ' FAMILJ MED 1 BARN
zo(2) = 5900 ' " 2 BARN
zo(3) = 6600 ' " 3-BARN
If (base_year + model_time) < 2006 Then
zg(1) = 600 ' FAST BELOPP FAMILJ MED 1 BARN
zg(2) = 900 ' FAST BELOPP " 2 BARN
zg(3) = 1200 ' FAST BELOPP " 3-BARN
zg(4) = 1200 ' FAST BELOPP " 4 BARN
zg(5) = 1200 ' FAST BELOPP " 5-BARN
Else
zg(1) = 950 ' FAST BELOPP FAMILJ MED 1 BARN
zg(2) = 1325 ' FAST BELOPP " 2 BARN
zg(3) = 1750 ' FAST BELOPP " 3-BARN
zg(4) = 1750 ' FAST BELOPP " 4 BARN
zg(5) = 1750 ' FAST BELOPP " 5-BARN
End If
Dim take_up_bob As Double
'--- Indexation
If base_year + model_time > 2009 Then
Dim ii As Integer
'Housingcost
XGAR1 = XGAR1 * m_price_change09
XGAR2 = XGAR2 * m_price_change09
XGAR3 = XGAR3 * m_price_change09
XGAR4 = XGAR4 * m_price_change09
XGAR5 = XGAR5 * m_price_change09
For ii = 1 To 5
If ii < 4 Then
zn(ii) = zn(ii) * m_price_change09
zm(ii) = zm(ii) * m_price_change09
zo(ii) = zo(ii) * m_price_change09
End If
zg(ii) = zg(ii) * m_wage_change09
Next
'Income and wealth
XFOGRAN = XFOGRAN * m_wage_change09
XFMB = XFMB * m_wage_change09
XUNGE = XUNGE * m_wage_change09
XUNGS = XUNGS * m_wage_change09
End If
' ----------------------------------------------------------------
' Income needed for calculation of housing allowance (bidragsgrundande)
' the income is the sum of income for all household members
' h_income household Income
' h_trf_childallowance household chils allowance
'h_capital = get_hh_sum(indnr2index(h_first_indnr(h)), "i_inc_capital") 'h_capital household income of capital
'h_bincome = h_income + h_capital + h_trf_childallowance(h) ' Bidragsgrundande income
'Korr ThP 020723
h_bincome = h_inc_market(h) + h_trf_taxable(h)
'Beräkna antal barn över 17 år som studerar
h_n_child18 = 0
inr = h_first_indnr(h) 'First i-nr
If i_hhstatus(indnr2index(inr)) = 3 And i_status(indnr2index(inr)) = 3 Then h_n_child18 = h_n_child18 + 1
Do Until inr = 0
inr = i_next_indnr(indnr2index(inr)) 'Next i-nr
If inr > 0 Then If i_hhstatus(indnr2index(inr)) = 3 And i_status(indnr2index(inr)) = 3 Then h_n_child18 = h_n_child18 + 1
Loop
'Net Wealth (förmögenhet och skuld från eget hem ingår inte, hela skulden borde inte dras)
'ZFORMNEH = maxi((h_wealth_real_home(h) + h_wealth_real_other(h) + h_wealth_financial(h) - h_wealth_debt(h)), 0)
ZFORMNEH = maxi((h_wealth_real_other(h) + h_wealth_financial(h) - h_wealth_debt(h)), 0)
'*-------------------------------------------------------------------*
'* HÄR BERÄKNAS BOSTADSBIDRAG FÖR BARNFAMILJER OCH UNGDOMAR *
'*-------------------------------------------------------------------*
IBOSTBH = 0 'NOLLSTÄLLNING AV BOSTADSBIDRAG
'*********************************************************************
'* HÄR BERÄKNAS DEN BIDRAGSGRUNDANDE INKOMSTEN *
'*********************************************************************
'UTRÄKNING AV DEN ANDEL AV FÖRMÖGENHETEN SOM SKA
'LÄGGAS TILL BIDRAGSGRUNDANDE INKOMSTEN
ZFORMNEX = Int(ZFORMNEH / 10000) * 10000
If ZFORMNEX > XFOGRAN Then
ZFOINKH = (ZFORMNEX - XFOGRAN) * XFOPROC
Else
ZFOINKH = 0
End If
CSBINK = h_bincome + ZFOINKH 'BIDRAGSGRUNDANDE INKOMST
'*********************************************************************
'* HÄR TAS UPPGIFTER FRAM FÖR BOENDEKOSTNADSBERÄKNINGAR *
'*********************************************************************;
'* BERÄKNING AV: *
'* -ANTAL BARN VID FASTSTÄLLANDE AV HYRESGRÄNSER *
'* -ANTAL BARN VID BERÄKNING AV DET SÄRSKILDA BIDRAGET *
'* -REDUKTION AV BOSTADSKOSTNAD FÖR EGET HEM O BOSTADSRÄTT *
'* -BIDRAGSGRUNDANDE BOSTADSYTA *
'*-------------------------------------------------------------------*;
ZBARNSUM = h_n_child(h) + h_n_child18 ' ÄLDRE HEMMAVARANDE BARN ADDERAS
ZBANTBRN = mini(3, ZBARNSUM) ' ANTAL BARN VID FASTSTÄLLANDE AV HYRESGRÄNSER
ZBANTSAR = ZBANTBRN ' ANTAL BARN FÖR BERÄKNING AV DET SÄRSKILDA BIDRAGET
ZBOST = h_house_cost(h) / 12 ' BOENDEKOSTNAD PER MÅNAD
' HÄR SKER REDUKTION AV BOENDEKOSTNADEN FÖR EGET HEM OCH BOSTADSRÄTT
'**** BORTKOMMENTERAD BOENDEKOSTNADSJUSTERING (TP & THP 050525). DETTA INNEBÄR EN FÖRENKLING SOM
'**** AVVIKER FRÅN DET BEFINTLIGA REGELVERKET.
' If h_house_owner(h) = 1 Then
' ZRANTA = 0.08
' If h_house_debt(h) > 0 Then ZZRANTA = h_house_interest(h) / h_house_debt(h)
' If ZZRANTA > 0.04 And ZZRANTA < 0.12 Then ZRANTA = ZZRANTA
' ZBOST = ZBOST - (XKASKU / ZRANTA) * h_house_interest(h) / 12 * (1 - xksats)
' If ZBOST < 0 Then ZBOST = 0
' End If
' HÄR SKER REDUKTION AV BOENDEKOSTNADEN PÅ GRUND AV ATT
' DEN BIDRAGSGRUNDANDE BOSTADSYTAN ÄR BEGRÄNSAD
' DOCK LÄNGST NER TILL GARANTINIVÅN
If ZBARNSUM = 0 And h_house_area(h) > XBOYTAU Then ZBOST = XBOYTAU / h_house_area(h) * ZBOST
If (ZBARNSUM = 1 And h_house_area(h) > XBOYTA1 And ZBOST > XGAR1) Then ZBOST = maxi(XGAR1, XBOYTA1 / h_house_area(h) * ZBOST)
If (ZBARNSUM = 2 And h_house_area(h) > XBOYTA2 And ZBOST > XGAR2) Then ZBOST = maxi(XGAR2, XBOYTA2 / h_house_area(h) * ZBOST)
If (ZBARNSUM = 3 And h_house_area(h) > XBOYTA3 And ZBOST > XGAR3) Then ZBOST = maxi(XGAR3, XBOYTA3 / h_house_area(h) * ZBOST)
If (ZBARNSUM = 4 And h_house_area(h) > XBOYTA4 And ZBOST > XGAR4) Then ZBOST = maxi(XGAR4, XBOYTA4 / h_house_area(h) * ZBOST)
If (ZBARNSUM > 4 And h_house_area(h) > XBOYTA5 And ZBOST > XGAR5) Then ZBOST = maxi(XGAR5, XBOYTA5 / h_house_area(h) * ZBOST)
ZBOST = 25 * Int(ZBOST / 25) ' 25-KRONORSAVRUNDNING AV MÅNADSHYRAN
'*-------------------------------------------------------------------*
'* BERÄKNING AV BOSTADSBIDRAGEN SAMT REDUCERING *
'*-------------------------------------------------------------------*
'*-------------------------------------------------------------------*
'* BARNFAMILJER *
'*-------------------------------------------------------------------*
If ZBARNSUM > 0 Then
If ZBOST <= zn(ZBANTBRN) Then ' MINDRE ÄN NEDRE HYRESGRÄNS
IBOSTBH = 12 * zg(ZBANTSAR)
ElseIf ZBOST <= zm(ZBANTBRN) Then ' MINDRE ÄN MELLAN HYRESGRÄNS
IBOSTBH = 12 * (zg(ZBANTSAR) + (ZBOST - zn(ZBANTBRN)) * XAND1)
ElseIf ZBOST <= zo(ZBANTBRN) Then ' MINDRE ÄN ÖVRE HYRESGRÄNS
IBOSTBH = 12 * (zg(ZBANTSAR) + (zm(ZBANTBRN) - zn(ZBANTBRN)) * XAND1 + _
(ZBOST - zm(ZBANTBRN)) * XAND2)
Else ' STÖRRE ÄN ÖVRE HYRESGRÄNS
IBOSTBH = 12 * (zg(ZBANTSAR) + (zm(ZBANTBRN) - zn(ZBANTBRN)) * XAND1 + _
(zo(ZBANTBRN) - zm(ZBANTBRN)) * XAND2)
End If
' R E D U C E R I N G E N
If CSBINK > XFMB And IBOSTBH > 0 Then IBOSTBH = IBOSTBH - (XRFMB * (CSBINK - XFMB))
If IBOSTBH < 0 Then IBOSTBH = 0
End If
'*--------------------------------------------------------------------*
'* UNGDOMAR UNDER 29 ÅR *
'*-------------------------------------------------------------------*
If h_n_adults(h) > 1 Then status = 1 Else status = 0 '0=single, 1=non-single
If ZBARNSUM = 0 And h_max_age(h) < 29 Then
If ZBOST < XN5 Then
IBOSTBH = 0
ElseIf ZBOST < XM5 Then
IBOSTBH = 12 * (ZBOST - XN5) * XAND4
ElseIf ZBOST < XO5 Then
IBOSTBH = 12 * ((XM5 - XN5) * XAND4 + (ZBOST - XM5) * XAND5)
Else
IBOSTBH = 12 * ((XM5 - XN5) * XAND4 + (XO5 - XM5) * XAND5)
End If
If status = 0 Then
If CSBINK > XUNGE And IBOSTBH > 0 Then ' REDUCERINGEN
IBOSTBH = IBOSTBH - (XRUNGE * (CSBINK - XUNGE)) ' ENSAMSTÅENDE
If IBOSTBH < 0 Then IBOSTBH = 0
End If
End If
If status = 1 Then
If CSBINK > XUNGS And IBOSTBH > 0 Then ' REDUCERINGEN
IBOSTBH = IBOSTBH - (XRUNGS * (CSBINK - XUNGS)) ' GIFTA SAMBO
If IBOSTBH < 0 Then IBOSTBH = 0
End If
End If
End If
'-------------------------------------------------------------------
If IBOSTBH > h_house_cost(h) Then IBOSTBH = h_house_cost(h) ' EJ STÖRRE BOSTADSBIDRAG ÄN ÅRSHYRAN
If IBOSTBH < 1200 Then IBOSTBH = 0 ' MINST 100 KR PER MÅNAD
' Take up
Select Case (base_year + model_time)
Case Is > 2007
take_up_bob = 0.3
' take_up_bob = 0.4
Case 2000
take_up_bob = 0.4
Case 2001 To 2002
take_up_bob = 0.4
Case 2003
take_up_bob = 0.4
Case 2004
take_up_bob = 0.5
Case 2005
take_up_bob = 0.7
Case 2006
take_up_bob = 0.3
Case 2007
take_up_bob = 0.3
End Select
xslump = Rnd
If IBOSTBH > 0 And bob_old = 0 And xslump > take_up_bob Then IBOSTBH = 0
f_housingallowance = round(IBOSTBH, 0)
End Function
'**********************************************
'* Calculate housing allowance for pensioners *
'**********************************************
'OBS ingen samordning med änkepensionerna!!! Bör ordnas
Public Function f_btp(h, h_n_apens, h_n_fpens) As Double
Dim XBOMAX As Long ' HÖGSTA BOSTADSKOSTNAD PER ÅR SOM KAN GE BTP
Dim XBOMAXG As Long ' från 2005 HÖGSTA BOSTADSKOSTNAD PER ÅR SOM KAN GE BTP för +65 år
Dim ZBOMAX As Long
Dim XBOMIN As Long ' LÄGSTA BOSTADSKOSTNAD PER ÅR SOM KAN GE BTP
Dim XBOAND As Double ' ERSÄTTNINGSNIVÅ MELLAN GRÄNSERNA OVAN
Dim XPRK As Double ' KOEFF FÖR AVKASTN AV FÖRMÖGENHET
Dim XFGRANS1 As Long ' GRÄNS FÖRM. AVKASTN. OGIFT
Dim XFGRANS2 As Long ' GRÄNS FÖRM. AVKASTN. GIFT
Dim XSAVK As Double ' AVKASTNINGSPROC VID STOR FÖRM.
Const XSKULDR = 0.05 ' SKULDRÄNTESATS PÅ SKULDER SOM EJ HÄNFÖRS TILL FASTIGHET
Dim XRFAKT1 As Double ' REDUCERINFSFAKTOR nedre intervall
Dim XRFAKT2 As Double ' REDUCERINFSFAKTOR övre intervall
Dim xrgrans As Double ' Intervallgräns
Const XIVIKT = 0.8 ' FAKTOR FÖR VIKTNING AV INKOMST
Const XLUTB = 300 ' LÄGSTA BELOPP FÖR UTBETALNING, 25 KR PER MÅNAD
Const XFTPRED = 0.25 ' REDUKTIONSFAKTOR FÖRTIDSPENS (SBTP)
Dim XBOREG As Long ' HÖGSTA GODTAGBARA BOSTADSKOSTNAD för SBTP
' SOCIALSTYRELSENS NORMBELOPP FÖR SKÄLIG LEVNADSNIVÅ I PRISBASBELOPP
Dim XBOREGG As Long ' +65 år från 2005
Dim ZBOREG As Long
Dim XNORMOG As Double ' OGIFT
Dim XNORMG As Double ' GIFT/SAMBO
Dim ZNORM As Double
Dim IBTPH, IBTPSH, IALDFH, ZUBOENDE, ZBOENDE, MAXBTP, ZFNETTO, ZFBTP, h_btpincome, ibtpred, ibtpredm As Double
Dim XFGRANS As Long
Dim bcivbtp, not_3040 As Byte
Const XAFPKOF1 = 0.96 'folkpension OGIFT ÅP
Const XAFPKOF2 = 0.785 'folkpension GIFT/SAMBO ÅP
Const XFFPKOF1 = 0.9 'folkpension OGIFT ftp
Const XFFPKOF2 = 0.725 'folkpension GIFT/SAMBO ftp
Dim XPTSKOF5 As Double 'pts HEL FÖRTIDSPENSION
Dim XPTSKOF1 As Double 'pts HEL ÅLDERSPENSION
Dim zavd As Double
Const XGAPKOF1 = 2.17 'Garp-nivå OGIFT -1937
Const XGAPKOF2 = 1.935 'Garp-nivå GIFT/SAMBO -1937 */
Dim ZBASG, ZBASGm, ZBASSE, ZBASSEm, zfrib, zfribm, ZBTP, ZBTPS, ZBTPSm, ZINK, ZINKm, BBTPS, ZDISP, ZDISPm, kifskatt As Double
Dim antag_bo_tid, arb_tid As Integer
Dim aga, zaga, agam, zagam As Double
Dim IALDINK, ZINKA, ZDISPA, ZALDF As Double
Const xksats = 0.3
Dim xslump As Double
Dim take_up As Double
Dim inr As Long
' Tidsvarierande parametrar
Select Case (base_year + model_time)
Case Is > 2009
XBOMAX = 54000 * m_price_change09
XBOMAXG = 60000 * m_price_change09
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000 * m_wage_change09
XFGRANS2 = 200000 * m_wage_change09
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700 * m_price_change09
XBOREGG = 6200 * m_price_change09
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt06 / 100
take_up = 1#
Case Is = 1999
XBOMAX = 48000
XBOMAXG = 48000
XBOMIN = 1200
XBOAND = 0.9
XPRK = 0.05
XFGRANS1 = 75000
XFGRANS2 = 120000
XSAVK = 0.1
XRFAKT1 = 0.4
XRFAKT2 = 0.45
xrgrans = 1
XBOREG = 5200
XBOREGG = 5200
XNORMOG = (5 * 1.22 + 7 * 1.234) / 12
XNORMG = (5 * 2.02 + 7 * 2.048) / 12
XPTSKOF5 = (5 * 1.115 + 7 * 1.129) / 12
XPTSKOF1 = (5 * 0.555 + 7 * 0.569) / 12
take_up = 0.7
Case Is = 2000
XBOMAX = 48000
XBOMAXG = 48000
XBOMIN = 1200
XBOAND = 0.9
XPRK = 0.05
XFGRANS1 = 75000
XFGRANS2 = 120000
XSAVK = 0.1
XRFAKT1 = 0.4
XRFAKT2 = 0.45
xrgrans = 1
XBOREG = 5200
XBOREGG = 5200
XNORMOG = 1.234
XNORMG = 2.048
XPTSKOF5 = 1.129
XPTSKOF1 = 0.569
take_up = 0.4
Case Is = 2001
XBOMAX = 54000
XBOMAXG = 54000
XBOMIN = 0
XBOAND = 0.9
XPRK = 0.05
XFGRANS1 = 75000
XFGRANS2 = 120000
XSAVK = 0.1
XRFAKT1 = 0.4
XRFAKT2 = 0.45
xrgrans = 1
XBOREG = 5700
XBOREGG = 5700
XNORMOG = 1.294
XNORMG = 2.168
XPTSKOF5 = 1.129
XPTSKOF1 = 0.569
take_up = 0.3
Case Is = 2002
XBOMAX = 54000
XBOMAXG = 54000
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.05
XFGRANS1 = 75000
XFGRANS2 = 120000
XSAVK = 0.1
XRFAKT1 = 0.4
XRFAKT2 = 0.45
xrgrans = 1
XBOREG = 5700
XBOREGG = 5700
XNORMOG = 1.294
XNORMG = 2.168
XPTSKOF5 = 1.129
XPTSKOF1 = 0.569
take_up = 0.3
Case 2003
XBOMAX = 54000
XBOMAXG = 54000
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000
XFGRANS2 = 200000
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700
XBOREGG = 5700
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt03 / 100
take_up = 0.6
Case 2004
XBOMAX = 54000
XBOMAXG = 54000
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000
XFGRANS2 = 200000
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700
XBOREGG = 5700
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt04 / 100
take_up = 1#
Case 2005
XBOMAX = 54000
XBOMAXG = 56040
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000
XFGRANS2 = 200000
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700
XBOREGG = 5870
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt05 / 100
take_up = 1#
Case 2006
XBOMAX = 54000
XBOMAXG = 58200
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000
XFGRANS2 = 200000
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700
XBOREGG = 6050
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt06 / 100
take_up = 1#
Case 2007 To 2008
XBOMAX = 54000
XBOMAXG = 60000
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000
XFGRANS2 = 200000
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700
XBOREGG = 6200
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt06 / 100
take_up = 1#
Case 2009
XBOMAX = 54000
XBOMAXG = 60000
XBOMIN = 0
XBOAND = 0.91
XPRK = 0.15
XFGRANS1 = 100000
XFGRANS2 = 200000
XRFAKT1 = 0.62
XRFAKT2 = 0.5
xrgrans = 1.5
XBOREG = 5700
XBOREGG = 6200
XNORMOG = 1.294
XNORMG = 2.168
kifskatt = kommundata(h_kommunindex(h)).skatt06 / 100
take_up = 1#
End Select
f_btp = 0
ZBTP = 0: ZBTPS = 0: IBTPH = 0: IBTPSH = 0: IALDFH = 0
If h_n_apens + h_n_fpens > 0 Then
If h_n_adults(h) = 1 Then
bcivbtp = 3
Else
bcivbtp = h_n_apens + h_n_fpens
End If
' KORRIGERING AV BOENDEKOSTNADEN
ZUBOENDE = maxi((h_house_cost(h) - h_trf_housingallowance(h)), 0)
' MAXBTP = MAXIMALT UTGÅENDE BTP VID AKTUELL BOENDEKOSTNAD
MAXBTP = 0
ZBOMAX = XBOMAX
If h_max_age(h) >= 65 Then ZBOMAX = XBOMAXG
ZBOENDE = mini(ZUBOENDE, ZBOMAX) ' MAXIMAL HYRA SOM FÅR UTNYTTJAS
MAXBTP = maxi(ZBOENDE - XBOMIN, 0) * XBOAND
'Net Wealth (förmögenhet och skuld från eget hem ingår inte, hela skulden borde inte dras)
' ZFNETTO = maxi((h_wealth_real_home(h) + h_wealth_real_other(h) + h_wealth_financial(h) - h_wealth_debt(h)), 0)
ZFNETTO = maxi((h_wealth_real_other(h) + h_wealth_financial(h) - h_wealth_debt(h)), 0)
' AVKASTNING AV FÖRMÖGENHET
If bcivbtp = 3 Then
XFGRANS = XFGRANS1 ' ENSAMSTÅENDE FOLKPENSIONÄR
Else
XFGRANS = XFGRANS2 ' GIFT, SAMBO
End If
If base_year + model_time < 2003 Then
ZFBTP = ZFNETTO * XPRK
If ZFNETTO > XFGRANS Then ZFBTP = ZFBTP + (ZFNETTO - XFGRANS) * XSAVK
Else
If ZFNETTO > XFGRANS Then ZFBTP = (ZFNETTO - XFGRANS) * XPRK
ZFBTP = Int(ZFBTP / 1000) * 1000
If bcivbtp < 3 Then ZFBTP = ZFBTP / 2
End If
If base_year + model_time < 2003 Then
' HÄR UTRÄKNAS DEN DEL AV PENSIONEN HUSHÅLLET FÅR DRA AV FRÅN ÅRSINKOMSTEN (T.O.M 2002) NÄMLIGEN
' FOLKPENSION+PENSIONSTILLSKOTT (ELLER MOTSVARANDE ATP)
' ENSAMSTÅENDE FOLKPENSIONÄR
If bcivbtp = 3 Then
If h_n_fpens > 0 Then
zavd = (XFFPKOF1 + XPTSKOF5) * m_basbelopp
BBTPS = (XFFPKOF1 + XPTSKOF5)
Else
zavd = (XAFPKOF1 + XPTSKOF1) * m_basbelopp
BBTPS = (XAFPKOF1 + XPTSKOF1)
End If
'GIFT, SAMBO
Else
'1 FOLKPENSIONÄR
If h_n_apens + h_n_fpens = 1 Then
If h_n_fpens > 0 Then
zavd = (XFFPKOF2 + XPTSKOF5) * m_basbelopp
BBTPS = (XFFPKOF2 + XPTSKOF5)
Else
zavd = (XAFPKOF2 + XPTSKOF1) * m_basbelopp
BBTPS = (XAFPKOF2 + XPTSKOF1)
End If
'BÅDA MAKARNA FOLKPENSIONÄRER
Else
If h_n_apens = 1 And h_n_fpens = 1 Then
zavd = (XAFPKOF2 + XPTSKOF1 + XFFPKOF2 + XPTSKOF5) * m_basbelopp
BBTPS = (XAFPKOF2 + XPTSKOF1 + XFFPKOF2 + XPTSKOF5)
End If
If h_n_apens = 2 And h_n_fpens = 0 Then
zavd = 2 * (XAFPKOF2 + XPTSKOF1) * m_basbelopp
BBTPS = 2 * (XAFPKOF2 + XPTSKOF1)
End If
If h_n_apens = 0 And h_n_fpens = 2 Then
zavd = 2 * (XFFPKOF2 + XPTSKOF5) * m_basbelopp
BBTPS = 2 * (XFFPKOF2 + XPTSKOF5)
End If
End If
End If
'HÄR UTRÄKNAS ÅRSINKOMSTEN
h_btpincome = h_inc_market(h) - h_inc_capital(h) + ZFBTP + h_trf_taxable(h) - zavd 'Belopp som reducerar äpnkepens skall dras här
If h_btpincome < 0 Then h_btpincome = 0
If (bcivbtp = 1 Or bcivbtp = 2) Then
h_btpincome = h_btpincome / 2 'ÅRSINKOMST DELAS OM GIFT,SAMBO
h_btpincome = round(h_btpincome, 0)
End If
'HÄR REDUCERAS BTP OM FÖR HÖG ÅRSINKOMST
If bcivbtp = 2 Then MAXBTP = MAXBTP / 2
'REDUCERINGEN
If h_btpincome < 1.5 * m_basbelopp Then
ZBTP = maxi(MAXBTP - h_btpincome * XRFAKT1, 0)
Else
ZBTP = maxi(MAXBTP - 1.5 * m_basbelopp * XRFAKT1 - (h_btpincome - 1.5 * m_basbelopp) * XRFAKT2, 0)
End If
If bcivbtp = 2 Then
IBTPH = 2 * ZBTP
Else
IBTPH = ZBTP
End If
'PERSONER SOM HAR FÖRTIDA UTTAG OCH ÄR YNGRE ÄN 65 ÅR KAN EJ FÅ BTP
If h_max_age(h) < 65 And h_n_fpens = 0 And bcivbtp <> 2 Then IBTPH = 0
If bcivbtp = 2 Then
If (h_max_age(h) < 65 And h_n_fpens = 0) Then IBTPH = 0
If (h_max_age(h) < 65 And h_n_fpens = 1) Then IBTPH = IBTPH / 2
'IF (en "riktig" ÅP och förtida uttag) THEN ibtph = ibtph / 2
End If
'Take up
xslump = Rnd
If btp_old = 0 And IBTPH > 0 And xslump > take_up Then IBTPH = 0
' HÄR BERÄKNAS SÄRSKILT BOSTADSTILLÄGG
If IBTPH > 0 Then
'HÖGSTA GODTAGBARA BOSTADSKOSTNAD
ZUBOENDE = mini(ZUBOENDE, 12 * XBOREG)
If (h_n_adults(h) = 2 And bcivbtp = 2) Then ZUBOENDE = ZUBOENDE * 0.5
'SKÄLIG LEVNADSNIVÅ
If h_n_adults(h) = 1 Then
ZNORM = XNORMOG * m_basbelopp
Else
ZNORM = XNORMG * m_basbelopp * 0.5
End If
'ENSAMSTÅENDE
If h_n_adults(h) = 1 Then
ZINK = h_btpincome * 0.5 + ZBTP + BBTPS * m_basbelopp
If h_n_fpens > 0 Then ZINK = ZINK - XFTPRED * m_basbelopp ' FÖRTIDSPENSIONÄR
If ZINK < 0 Then ZINK = 0
ZDISP = ZINK - ZUBOENDE
If ZDISP < 0 Then ZDISP = 0
If ZDISP < ZNORM Then ZBTPS = ZNORM - ZDISP
'GIFTA-SAMBO
Else
If bcivbtp = 2 Then
ZINK = h_btpincome + 2 * ZBTP + BBTPS * m_basbelopp
Else
ZINK = h_btpincome / 2 + ZBTP + BBTPS * m_basbelopp
End If
ZINK = ZINK - h_n_fpens * XFTPRED * m_basbelopp 'FÖRTIDSPENSIONÄR
If ZINK < 0 Then ZINK = 0
ZDISP = ZINK - ZUBOENDE
If bcivbtp = 2 Then ZDISP = ZDISP - ZUBOENDE '2 pensionärer => *2
If ZDISP < 0 Then ZDISP = 0
If ZDISP < ZNORM Then ZBTPS = ZNORM - ZDISP
End If
IBTPSH = ZBTPS
End If
'SMÅ BOSTADSTILLÄGG BETALAS INTE UT
If ZBTPS = 0 And IBTPH < XLUTB Then IBTPH = 0
'Fr.o.m. 2003
Else
'HÄR BERÄKNAS FRIBELOPPET (skall egentligen göras individuellt)
zfrib = 0: zfribm = 0
ZBASG = 0: ZBASGm = 0
ZBASSE = 0: ZBASSEm = 0
' Ensamstående
If h_n_adults(h) = 1 Then
If btptyp = 1 Then ZBASG = XGAPKOF1 * m_basbelopp_gp 'ENSAMSTÅENDE Ålderspensionär
If btptyp = 2 Then ZBASSE = ftp_gar 'ENSAMSTÅENDE Förtidspensionär
'Samboende
Else
'EJ KVALIFICERAD FÖR BTP
If btptyp = 0 Then ZBASG = XGAPKOF2 * m_basbelopp_gp
If btptypm = 0 Then ZBASGm = XGAPKOF2 * m_basbelopp_gp
'Ålderspensionärer
If btptyp = 1 Then ZBASG = XGAPKOF2 * m_basbelopp_gp
If btptypm = 1 Then ZBASGm = XGAPKOF2 * m_basbelopp_gp
'Förtidspensionärer
If btptyp = 2 Then ZBASSE = ftp_gar
If btptypm = 2 Then ZBASSEm = ftp_garm
End If
zfrib = maxi(ZBASG, ZBASSE)
zfribm = maxi(ZBASGm, ZBASSEm)
'HÄR BERÄKNAS REDUCERINGSINKOMSTEN
ibtpred = btp_pens + btp_capital + ZFBTP + _
(XIVIKT * (btp_market - btp_capital + btp_taxable - btp_pens)) - zfrib
ibtpredm = btp_pensm + btp_capitalm + ZFBTP + _
(XIVIKT * (btp_marketm - btp_capitalm + btp_taxablem - btp_pensm)) - zfribm
If ibtpred < 0 Then ibtpred = 0
If ibtpredm < 0 Then ibtpredm = 0
h_btpincome = ibtpred + ibtpredm
If h_n_adults(h) = 2 Then
MAXBTP = MAXBTP / 2
h_btpincome = h_btpincome / 2
End If
h_btpincome = round(h_btpincome, 0)
'BTP AVRÄKNAS MED DEL AV REDUCERINGSINKOMSTEN
If h_btpincome < m_basbelopp Then
ZBTP = maxi(MAXBTP - h_btpincome * XRFAKT1, 0)
Else
ZBTP = maxi(MAXBTP - m_basbelopp * XRFAKT1 - (h_btpincome - m_basbelopp) * XRFAKT2, 0)
End If
If bcivbtp = 2 Then
IBTPH = 2 * ZBTP
Else
IBTPH = ZBTP
End If
'Take up
xslump = Rnd
If btp_old = 0 And IBTPH > 0 And xslump > take_up Then IBTPH = 0
'HÄR BERÄKNAS SÄRSKILT BOSTADSTILLÄGG
If IBTPH > 0 Then
If h_n_adults(h) = 1 Then
ZNORM = XNORMOG * m_basbelopp
Else
ZNORM = XNORMG * m_basbelopp * 0.5
End If
'2005-12-14 normen löneindexeras
If (base_year + model_time) > 2009 Then ZNORM = ZNORM * m_realwage_change09
ZINK = 0: ZINKm = 0
ZDISP = 0: ZDISPm = 0
ZBTPS = 0: ZBTPSm = 0
'SKÄLIG BOSTADSKOSTNAD
ZBOREG = XBOREG
If h_max_age(h) >= 65 Then ZBOREG = XBOREGG
ZUBOENDE = mini(ZUBOENDE, 12 * ZBOREG)
If h_n_adults(h) = 2 Then ZUBOENDE = ZUBOENDE * 0.5
'Grundavdrag
aga = f_basic_deduction(btp_inc, 1, 1)
agam = f_basic_deduction(btp_incm, 1, 1)
zaga = f_basic_deduction(zfrib, 1, 1)
zagam = f_basic_deduction(zfribm, 1, 1)
'ENSAMSTÅENDE
If h_n_adults(h) = 1 Then
ZINK = maxi((btp_market - btp_capital + btp_taxable - kifskatt * _
(btp_market - btp_capital + btp_taxable - aga) + _
(1 - xksats) * btp_capital), zfrib - kifskatt * (zfrib - zaga)) + ZFBTP + IBTPH
If ZINK < 0 Then ZINK = 0
ZDISP = maxi(ZINK - ZUBOENDE, 0)
If ZDISP < ZNORM Then ZBTPS = ZNORM - ZDISP
IBTPSH = round(ZBTPS, 0)
'GIFTA-SAMBO
Else
If bcivbtp = 2 Then
ZINK = maxi((btp_market - btp_capital + btp_taxable - kifskatt * _
(btp_market - btp_capital + btp_taxable - aga) + _
(1 - xksats) * btp_capital), zfrib - kifskatt * (zfrib - zaga)) + ZFBTP + 0.5 * IBTPH
If ZINK < 0 Then ZINK = 0
ZDISP = maxi(ZINK - ZUBOENDE, 0)
If ZDISP < ZNORM Then ZBTPS = ZNORM - ZDISP
ZINKm = maxi((btp_marketm - btp_capitalm + btp_taxablem - kifskatt * _
(btp_marketm - btp_capitalm + btp_taxablem - agam) + _
(1 - xksats) * btp_capitalm), zfribm - kifskatt * (zfribm - zagam)) + ZFBTP + 0.5 * IBTPH
If ZINKm < 0 Then ZINKm = 0
ZDISPm = maxi(ZINKm - ZUBOENDE, 0)
If ZDISPm < ZNORM Then ZBTPSm = ZNORM - ZDISPm
'EN FOLKPENSIONÄR I HUSHÅLLET
Else
If btptyp = 0 Then
ZBTPS = 0
Else
ZINK = maxi((btp_market - btp_capital + btp_taxable - kifskatt * _
(btp_market - btp_capital + btp_taxable - aga) + _
(1 - xksats) * btp_capital), zfrib - kifskatt * (zfrib - zaga)) + ZFBTP + IBTPH
If ZINK < 0 Then ZINK = 0
ZDISP = maxi(ZINK - ZUBOENDE, 0)
If ZDISP < ZNORM Then ZBTPS = ZNORM - ZDISP
End If
If btptypm = 0 Then
ZBTPSm = 0
Else
ZINKm = maxi((btp_marketm - btp_capitalm + btp_taxablem - kifskatt * _
(btp_marketm - btp_capitalm + btp_taxablem - agam) + _
(1 - xksats) * btp_capitalm), zfribm - kifskatt * (zfribm - zagam)) + ZFBTP + IBTPH
If ZINKm < 0 Then ZINKm = 0
ZDISPm = maxi(ZINKm - ZUBOENDE, 0)
If ZDISPm < ZNORM Then ZBTPSm = ZNORM - ZDISPm
End If
IBTPSH = round(ZBTPS + ZBTPSm, 0)
End If
End If 'Gifta/sambo
End If 'IBTPH > 0
'HÄR BERÄKNAS ÄLDREFÖRSÖRJNINGSSTÖD
'Kolla om någon vuxen i hh inte uppfyller bosättnings- eller intjänandekraven
not_3040 = 0
inr = h_first_indnr(h) 'First i-nr
Do Until inr = 0
antag_bo_tid = i_botid(indnr2index(inr)) + (65 - i_age(indnr2index(inr))) * _
mini(1, i_botid(indnr2index(inr)) / 0.8 * (maxi(i_age(indnr2index(inr)), 17) - 16)) '40
arb_tid = pp_hist(indnr2index(inr)).n_years '30
If i_bvux(indnr2index(inr)) = 1 And (antag_bo_tid < 40 Or arb_tid < 30) Then not_3040 = not_3040 + 1
inr = i_next_indnr(indnr2index(inr)) 'Next i-nr
Loop
If h_max_age(h) >= 65 And not_3040 > 0 Then
If h_n_adults(h) = 1 Then '/* ENSAMSTÅENDE */
ZINKA = (1 - kifskatt) * (h_inc_market(h) - h_inc_capital(h) + h_trf_taxable(h)) + _
(1 - xksats) * h_inc_capital(h) + ZFBTP + h_trf_housingallowance(h) + IBTPH + IBTPSH
If ZINKA < 0 Then ZINKA = 0
IALDINK = ZINKA
ZDISPA = IALDINK - ZUBOENDE
If ZDISPA < 0 Then ZDISPA = 0
If ZDISPA < ZNORM Then ZALDF = ZNORM - ZDISPA
IALDFH = ZALDF
Else ' /* GIFTA-SAMBO */
ZINKA = (1 - kifskatt) * (h_inc_market(h) - h_inc_capital(h) + h_trf_taxable(h)) + _
(1 - xksats) * h_inc_capital(h) + ZFBTP + h_trf_housingallowance(h) + IBTPH + IBTPSH
If ZINKA < 0 Then ZINKA = 0
IALDINK = ZINKA
ZDISPA = IALDINK - ZUBOENDE
If ZDISPA < 0 Then ZDISPA = 0
If ZDISPA < ZNORM Then ZALDF = ZNORM - ZDISPA
If not_3040 = 1 Then
IALDFH = ZALDF / 2
Else
IALDFH = ZALDF
End If
End If 'Gifta/samboende
End If 'h_maxage >= 65
'SMÅ BOSTADSTILLÄGG BETALAS INTE UT
If IBTPSH = 0 And IALDFH = 0 And IBTPH < XLUTB Then IBTPH = 0
End If 'Fr.o.m. 2003
f_btp = IBTPH + IBTPSH + IALDFH
End If 'h_n_apens + h_n_fpens > 0
End Function
Public Function f_socialassistance(h)
Const XFLNIVA = 30000 'LIKVID NETTOFÖRMÖGENHET SOM INTE BEAKTAS VID FÖRMÖGENHETSPRÖVNINGEN
Const xresor = 350 'Resor
Const xfack = 200 'Fackavgift
Dim XENSAM, XSAMBON As Long
Dim xbarn(1 To 7) As Long
Dim xgem(1 To 7) As Long
Dim XUNORME1, XUNORME2, XUNORMG1, XUNORMG2, XUNORMB1, XUNORMB2 As Long
Dim vnorm, bnorm, hhnorm, norm As Long
Dim s_disp, socbid As Long
Dim maxbo As Long
Dim socbo As Long
Dim j As Integer
Select Case (base_year + model_time)
Case Is > 2006
XENSAM = 2640 'NORM ENSAMSTÅENDE
XSAMBON = 4770 'NORM GIFTA/SAMMANBOENDE
xbarn(1) = 1430 'NORM BARN 0 ÅR, EJ LUNCH
xbarn(2) = 1610 'NORM BARN 1-2 ÅR, EJ LUNCH
xbarn(3) = 1290 'NORM BARN 3 ÅR, EJ LUNCH
xbarn(4) = 1550 'NORM BARN 4-6 ÅR, EJ LUNCH
xbarn(5) = 1980 'NORM BARN 7-10 ÅR
xbarn(6) = 2270 'NORM BARN 11-14 ÅR
xbarn(7) = 2550 'NORM BARN 15-18 ÅR (även äldre barn)
xgem(1) = 830 'NORM GEMENSAM 1 PERSON
xgem(2) = 930 'NORM GEMENSAM 2 PERSONER
xgem(3) = 1160 'NORM GEMENSAM 3 PERSONER
xgem(4) = 1340 'NORM GEMENSAM 4 PERSONER
xgem(5) = 1530 'NORM GEMENSAM 5 PERSONER
xgem(6) = 1740 'NORM GEMENSAM 6 PERSONER
xgem(7) = 1910 'NORM GEMENSAM 7 PERSONER
Case 1999
XENSAM = 2320 'NORM ENSAMSTÅENDE */
XSAMBON = 4200 'NORM GIFTA/SAMMANBOENDE */
xbarn(1) = 1230 'NORM BARN 0 ÅR, MED LUNCH */
xbarn(2) = 1440 'NORM BARN 1-2 ÅR, MED LUNCH */
xbarn(3) = 1120 'NORM BARN 3 ÅR, MED LUNCH */
xbarn(4) = 1410 'NORM BARN 4-6 ÅR, MED LUNCH */
xbarn(5) = 1530 'NORM BARN 7-10 ÅR */
xbarn(6) = 1830 'NORM BARN 11-14 ÅR */
xbarn(7) = 2070 'NORM BARN 15-18 ÅR */
xgem(1) = 580 'NORM GEMENSAM 1 PERSON */
xgem(2) = 670 'NORM GEMENSAM 2 PERSONER */
xgem(3) = 760 'NORM GEMENSAM 3 PERSONER */
xgem(4) = 820 'NORM GEMENSAM 4 PERSONER */
xgem(5) = 910 'NORM GEMENSAM 5 PERSONER */
xgem(6) = 960 'NORM GEMENSAM 6 PERSONER */
xgem(7) = 1020 'NORM GEMENSAM 7 PERSONER */
Case 2000
XENSAM = 2400 'NORM ENSAMSTÅENDE */
XSAMBON = 4360 'NORM GIFTA/SAMMANBOENDE */
xbarn(1) = 1220 'NORM BARN 0 ÅR, MED LUNCH */
xbarn(2) = 1470 'NORM BARN 1-2 ÅR, MED LUNCH */
xbarn(3) = 1160 'NORM BARN 3 ÅR, MED LUNCH */
xbarn(4) = 1440 'NORM BARN 4-6 ÅR, MED LUNCH */
xbarn(5) = 1590 'NORM BARN 7-10 ÅR */
xbarn(6) = 1890 'NORM BARN 11-14 ÅR */
xbarn(7) = 2140 'NORM BARN 15-18 ÅR */
xgem(1) = 600 'NORM GEMENSAM 1 PERSON */
xgem(2) = 680 'NORM GEMENSAM 2 PERSONER */
xgem(3) = 780 'NORM GEMENSAM 3 PERSONER */
xgem(4) = 840 'NORM GEMENSAM 4 PERSONER */
xgem(5) = 940 'NORM GEMENSAM 5 PERSONER */
xgem(6) = 1000 'NORM GEMENSAM 6 PERSONER */
xgem(7) = 1060 'NORM GEMENSAM 7 PERSONER */
Case 2001
XENSAM = 2400 'NORM ENSAMSTÅENDE */
XSAMBON = 4370 'NORM GIFTA/SAMMANBOENDE */
xbarn(1) = 1220 'NORM BARN 0 ÅR, MED LUNCH */
xbarn(2) = 1470 'NORM BARN 1-2 ÅR, MED LUNCH */
xbarn(3) = 1160 'NORM BARN 3 ÅR, MED LUNCH */
xbarn(4) = 1440 'NORM BARN 4-6 ÅR, MED LUNCH */
xbarn(5) = 1600 'NORM BARN 7-10 ÅR */
xbarn(6) = 1890 'NORM BARN 11-14 ÅR */
xbarn(7) = 2130 'NORM BARN 15-18 ÅR */
xgem(1) = 600 'NORM GEMENSAM 1 PERSON */
xgem(2) = 680 'NORM GEMENSAM 2 PERSONER */
xgem(3) = 770 'NORM GEMENSAM 3 PERSONER */
xgem(4) = 840 'NORM GEMENSAM 4 PERSONER */
xgem(5) = 930 'NORM GEMENSAM 5 PERSONER */
xgem(6) = 980 'NORM GEMENSAM 6 PERSONER */
xgem(7) = 1040 'NORM GEMENSAM 7 PERSONER */
Case 2002
XENSAM = 2520 'NORM ENSAMSTÅENDE */
XSAMBON = 4570 'NORM GIFTA/SAMMANBOENDE */
xbarn(1) = 1360 'NORM BARN 0 ÅR, MED LUNCH */
xbarn(2) = 1610 'NORM BARN 1-2 ÅR, MED LUNCH */
xbarn(3) = 1280 'NORM BARN 3 ÅR, MED LUNCH */
xbarn(4) = 1610 'NORM BARN 4-6 ÅR, MED LUNCH */
xbarn(5) = 1770 'NORM BARN 7-10 ÅR */
xbarn(6) = 2050 'NORM BARN 11-14 ÅR */
xbarn(7) = 2320 'NORM BARN 15-18 ÅR */
xgem(1) = 620 'NORM GEMENSAM 1 PERSON */
xgem(2) = 710 'NORM GEMENSAM 2 PERSONER */
xgem(3) = 810 'NORM GEMENSAM 3 PERSONER */
xgem(4) = 870 'NORM GEMENSAM 4 PERSONER */
xgem(5) = 970 'NORM GEMENSAM 5 PERSONER */
xgem(6) = 1030 'NORM GEMENSAM 6 PERSONER */
xgem(7) = 1090 'NORM GEMENSAM 7 PERSONER */
Case 2003
XENSAM = 2575 'NORM ENSAMSTÅENDE
XSAMBON = 4685 'NORM GIFTA/SAMMANBOENDE
xbarn(1) = 1405 'NORM BARN 0 ÅR, EJ LUNCH
xbarn(2) = 1625 'NORM BARN 1-2 ÅR, EJ LUNCH
xbarn(3) = 1305 'NORM BARN 3 ÅR, EJ LUNCH
xbarn(4) = 1635 'NORM BARN 4-6 ÅR, EJ LUNCH
xbarn(5) = 1815 'NORM BARN 7-10 ÅR
xbarn(6) = 2090 'NORM BARN 11-14 ÅR
xbarn(7) = 2360 'NORM BARN 15-18 ÅR (även äldre barn)
xgem(1) = 680 'NORM GEMENSAM 1 PERSON
xgem(2) = 770 'NORM GEMENSAM 2 PERSONER
xgem(3) = 890 'NORM GEMENSAM 3 PERSONER
xgem(4) = 950 'NORM GEMENSAM 4 PERSONER
xgem(5) = 1050 'NORM GEMENSAM 5 PERSONER
xgem(6) = 1125 'NORM GEMENSAM 6 PERSONER
xgem(7) = 1195 'NORM GEMENSAM 7 PERSONER
Case 2004
XENSAM = 2650 'NORM ENSAMSTÅENDE
XSAMBON = 4840 'NORM GIFTA/SAMMANBOENDE
xbarn(1) = 1470 'NORM BARN 0 ÅR, EJ LUNCH
xbarn(2) = 1670 'NORM BARN 1-2 ÅR, EJ LUNCH
xbarn(3) = 1350 'NORM BARN 3 ÅR, EJ LUNCH
xbarn(4) = 1680 'NORM BARN 4-6 ÅR, EJ LUNCH
xbarn(5) = 1880 'NORM BARN 7-10 ÅR
xbarn(6) = 2160 'NORM BARN 11-14 ÅR
xbarn(7) = 2440 'NORM BARN 15-18 ÅR (även äldre barn)
xgem(1) = 720 'NORM GEMENSAM 1 PERSON
xgem(2) = 800 'NORM GEMENSAM 2 PERSONER
xgem(3) = 970 'NORM GEMENSAM 3 PERSONER
xgem(4) = 1040 'NORM GEMENSAM 4 PERSONER
xgem(5) = 1130 'NORM GEMENSAM 5 PERSONER
xgem(6) = 1230 'NORM GEMENSAM 6 PERSONER
xgem(7) = 1320 'NORM GEMENSAM 7 PERSONER
Case 2005
XENSAM = 2590 'NORM ENSAMSTÅENDE
XSAMBON = 4720 'NORM GIFTA/SAMMANBOENDE
xbarn(1) = 1440 'NORM BARN 0 ÅR, EJ LUNCH
xbarn(2) = 1640 'NORM BARN 1-2 ÅR, EJ LUNCH
xbarn(3) = 1330 'NORM BARN 3 ÅR, EJ LUNCH
xbarn(4) = 1630 'NORM BARN 4-6 ÅR, EJ LUNCH
xbarn(5) = 1840 'NORM BARN 7-10 ÅR
xbarn(6) = 2120 'NORM BARN 11-14 ÅR
xbarn(7) = 2400 'NORM BARN 15-18 ÅR (även äldre barn)
xgem(1) = 770 'NORM GEMENSAM 1 PERSON
xgem(2) = 870 'NORM GEMENSAM 2 PERSONER
xgem(3) = 1030 'NORM GEMENSAM 3 PERSONER
xgem(4) = 1100 'NORM GEMENSAM 4 PERSONER
xgem(5) = 1190 'NORM GEMENSAM 5 PERSONER
xgem(6) = 1290 'NORM GEMENSAM 6 PERSONER
xgem(7) = 1360 'NORM GEMENSAM 7 PERSONER
Case 2006
XENSAM = 2600 'NORM ENSAMSTÅENDE
XSAMBON = 4690 'NORM GIFTA/SAMMANBOENDE
xbarn(1) = 1410 'NORM BARN 0 ÅR, EJ LUNCH
xbarn(2) = 1580 'NORM BARN 1-2 ÅR, EJ LUNCH
xbarn(3) = 1270 'NORM BARN 3 ÅR, EJ LUNCH
xbarn(4) = 1530 'NORM BARN 4-6 ÅR, EJ LUNCH
xbarn(5) = 1950 'NORM BARN 7-10 ÅR
xbarn(6) = 2230 'NORM BARN 11-14 ÅR
xbarn(7) = 2510 'NORM BARN 15-18 ÅR (även äldre barn)
xgem(1) = 820 'NORM GEMENSAM 1 PERSON
xgem(2) = 920 'NORM GEMENSAM 2 PERSONER
xgem(3) = 1140 'NORM GEMENSAM 3 PERSONER
xgem(4) = 1320 'NORM GEMENSAM 4 PERSONER
xgem(5) = 1510 'NORM GEMENSAM 5 PERSONER
xgem(6) = 1710 'NORM GEMENSAM 6 PERSONER
xgem(7) = 1880 'NORM GEMENSAM 7 PERSONER
End Select
'Maximal boendekostnad (från FASIT 99_97)
Select Case h_n_child(h)
Case 0
maxbo = 4950
Case 1
maxbo = 6175
Case 2
maxbo = 7525
Case 3
maxbo = 9250
Case Else
maxbo = 9250 + 1200 * (h_n_child(h) - 3)
End Select
maxbo = 12 * maxbo * m_price_change99
socbo = mini(maxi(h_house_cost(h) - h_tax_realestate(h), 0), maxbo)
'Månadsbelopp vuxna
If h_n_adults(h) = 1 Then vnorm = XENSAM Else vnorm = XSAMBON
'Månadsbelopp barn
bnorm = 0
For j = 1 To 7
bnorm = bnorm + n_child(j) * xbarn(j)
Next
'Månadsbelopp hushållsgemensam
If h_size(h) < 8 Then
hhnorm = xgem(h_size(h))
Else
hhnorm = xgem(7) + (h_size(h) - 7) * 60
End If
'Årsbelopp
norm = (vnorm + bnorm + hhnorm + h_n_adults(h) * (xresor + xfack)) * 12
'Indexera från 2010
If base_year + model_time > 2009 Then norm = norm * m_wage_change09
norm = norm + socbo
'LIKVIDA FÖRMÖGENHETSVÄRDEN ÖVER VISST BELOPP
'LÄGGS TILL INKOMSTEN
If (h_wealth_real_other(h) + h_wealth_financial(h) - h_wealth_debt(h)) > XFLNIVA Then
s_disp = h_inc_disposable(h) + ((h_wealth_real_other(h) + h_wealth_financial(h) - h_wealth_debt(h)) - XFLNIVA)
Else
s_disp = h_inc_disposable(h)
End If
'*** Do not allow negative diposable incomes
s_disp = maxi(0, s_disp)
'*** If the household is elegible for social welfare benefit
'*** then determine if the household applies or not (take-up)
socbid = 0
If norm > s_disp Then
If takeup_social_welfare(norm, s_disp, h) = 1 Then
socbid = maxi((norm - s_disp), 0)
End If
End If
If socbid < 600 Then socbid = 0
f_socialassistance = socbid
End Function
'*******************************************************************
'*** Subsidies for public services are imputed using estimated
'*** models.
'*** For documentation see S:\SESIM\Projekt\LU_03\Offkons
'***
'*** NOTES:
'*** - The subsidies are indexes by price (INDEX BY WAGES???)
'*** - In the first stage a yearly deterministic imputation of
'*** subsidies is done using mean values from regression models.
'*** If information about who is using the public services is not
'*** available in SESIM models for imputation of use/non use
'*** randomizes individuals to use the services.
'*** - Since most models take regional variation into account in
'*** the estimation the intercept term is automatically related
'*** to some specific region (due to the coding of the regional
'*** dummy variables). Hence the estimated intercept term is
'*** generally replaced by a term (determined by iteration) that
'*** when used for prediction regenerates the correct average
'*** national level.
'*******************************************************************
Public Sub impute_public_consumption()
'! Subsidies for public services are imputed using estimated models
Dim bald6_7 As Long, i As Long, ed0 As Long, ed1 As Long, ed2 As Long
Dim age1_4 As Long, age5_8 As Long, age9_ As Long, j As Long
Dim age65_69 As Long, age70_79 As Long, ap_q_lt80 As Long
Dim age25_35 As Long, age45_64 As Long
Dim working As Long, ap_q_12 As Long, ap_q_3 As Long
Dim ap_q1 As Long, ap_q2 As Long, ap_q3 As Long, ap_q4 As Long
Dim h_ed0 As Long, h_ed1 As Long, ftp As Long
Dim counter As Long, counter2 As Long
Dim xbeta As Double, prob As Double
Dim temp_pens() As Double, temp_inc_tax() As Double
Dim ap_q As Variant, q_inc_taxable As Variant
Dim q_inc_taxable1 As Long, q_inc_taxable2 As Long, q_inc_taxable3 As Long
Dim q_inc_taxable4 As Long, year As Long
Dim age_adj As Single
status "Public consumption"
Printdok "impute_public_consumption Public consumption"
ReDim temp_pens(1 To m_icount), temp_inc_tax(1 To m_icount)
counter = 0
counter2 = 0
' -- Optional switch for indexing public consumption with income growth
' Default: price indexation
' Note: m_basbelopp_f = m_basbelopp_income until 2003
Dim basbelopp As Long
If get_scalefactor_active("pc_income_index") <> 1 Then
basbelopp = m_basbelopp_f
Else
basbelopp = m_basbelopp_income
End If
'*** The following code is used when simulating a scenario where care and health care
'*** for elderly (65+) is assumed to be postponed by the yearly increase in residual
'*** mean life at age 65.
'*** All calculations are differentiated by sex
Dim d_age() As Double ' mrl(x) at current year - mrl(x) at base year
ReDim d_age(1 To 2, 65 To 106) As Double
If get_scalefactor_active("adj_healthcare_age") = 1 And model_time > 0 Then
Dim lx_base(1 To 2, 0 To 106) As Double, lx(1 To 2, 0 To 106) As Double
Dim llx_base(1 To 2, 0 To 106) As Double, llx(1 To 2, 0 To 106) As Double
Dim tx_base(1 To 2, 0 To 106) As Double, tx(1 To 2, 0 To 106) As Double
Dim ex_base(1 To 2, 0 To 106) As Double, ex(1 To 2, 0 To 106) As Double
year = mini(2110, base_year + model_time)
'*** Calculation of mrl(65) at base year and at current year
' Number of survivors
lx_base(1, 0) = 100000 * (1 - parm_death(base_year, 0, 1))
lx_base(2, 0) = 100000 * (1 - parm_death(base_year, 0, 2))
lx(1, 0) = 100000 * (1 - parm_death(year, 0, 1))
lx(2, 0) = 100000 * (1 - parm_death(year, 0, 2))
Dim age As Integer, sex As Byte
For age = 1 To 106
For sex = 1 To 2
lx_base(sex, age) = lx_base(sex, age - 1) * (1 - parm_death(base_year, age, sex))
lx(sex, age) = lx(sex, age - 1) * (1 - parm_death(year, age, sex))
Next
Next
' Number of years lived in each age-interval
llx_base(1, 0) = lx_base(1, 0) + (100000 - lx_base(1, 0)) / 2
llx_base(2, 0) = lx_base(2, 0) + (100000 - lx_base(2, 0)) / 2
llx(1, 0) = lx(1, 0) + (100000 - lx(1, 0)) / 2
llx(2, 0) = lx(2, 0) + (100000 - lx(2, 0)) / 2
For age = 1 To 106
For sex = 1 To 2
llx_base(sex, age) = lx_base(sex, age) + (lx_base(sex, age - 1) - lx_base(sex, age)) / 2
llx(sex, age) = lx(sex, age) + (lx(sex, age - 1) - lx(sex, age)) / 2
Next
Next
' Cumulative number of years lived by survivors and
' expected residual life
For age = 106 To 65 Step -1
For sex = 1 To 2
If age = 106 Then
tx_base(sex, age) = llx_base(sex, age)
tx(sex, age) = llx(sex, age)
Else
tx_base(sex, age) = tx_base(sex, age + 1) + llx_base(sex, age)
tx(sex, age) = tx(sex, age + 1) + llx(sex, age)
End If
ex_base(sex, age) = tx_base(sex, age) / lx_base(sex, age)
ex(sex, age) = tx(sex, age) / lx(sex, age)
d_age(sex, age) = ex(sex, age) - ex_base(sex, age)
' Debug.Print model_time & " " & age & " " & sex & " " & d_age(sex, age)
Next
Next
Else
' Sets all elements to zero
ReDim d_age(1 To 2, 65 To 106) As Double
End If
For i = 1 To m_icount
If i_age(i) >= 65 And i_abroad(i) = 0 Then
counter = counter + 1
'*** NOTE: the atp variable is not defined after 2003 -> check which
'*** variable should be used instead!!!!!!!!
temp_pens(counter) = i_ap_atp(i)
End If
If i_age(i) >= 20 And i_age(i) <= 64 Then
counter2 = counter2 + 1
temp_inc_tax(counter2) = i_inc_taxable(i)
End If
Next
'*** Calculate quintiles for old age pension
ReDim Preserve temp_pens(1 To counter)
ap_q = arr_Percentile(temp_pens, 20, 40, 60, 80)
'*** Calculate quintiles for taxable income
ReDim Preserve temp_inc_tax(1 To counter2)
q_inc_taxable = arr_Percentile(temp_inc_tax, 20, 40, 60, 80)
'*** Subsidies for medicin (scaled to BA/1000).
'*** Ordered by sex and agegroup:
'*** male (0-4, 5-9, ..., 90+), female (0-4, 5-9, ..., 90+)
Dim pc_medicine
pc_medicine = Array(7, 14, 20, 18, 12, 15, 18, 24, 29, 37, 48, 65, _
72, 94, 106, 116, 110, 114, 117, 6, 7, 12, 16, 20, 25, 30, 33, 39, _
47, 64, 79, 77, 88, 96, 102, 98, 96, 74)
For i = 1 To m_icount
'*** Delete subsidies from previous years
i_pc_care(i) = 0
i_pc_childcare(i) = 0
i_pc_elderly(i) = 0
i_pc_high_school(i) = 0
i_pc_labor(i) = 0
i_pc_MAE(i) = 0
i_pc_medicine(i) = 0
i_pc_school(i) = 0
i_pc_school_adult(i) = 0
i_pc_univ(i) = 0
i_pc_total(i) = 0
'*** Only individuals living in Sweden can be subsidised
If i_abroad(i) = 0 Then
' Calculate "adjusted age" due to assumed changes in age-related health
If i_age(i) >= 65 Then age_adj = i_age(i) - d_age(i_sex(i), mini(106, i_age(i)))
'*** dummy variables
If i_edlevel(i) = 0 Then ed0 = 1 Else ed0 = 0
If i_edlevel(i) = 1 Then ed1 = 1 Else ed1 = 0
If i_edlevel(i) = 2 Then ed2 = 1 Else ed2 = 0
If i_age(i) >= 1 And i_age(i) <= 4 Then age1_4 = 1 Else age1_4 = 0
If i_age(i) >= 5 And i_age(i) <= 8 Then age5_8 = 1 Else age5_8 = 0
If i_age(i) >= 9 Then age9_ = 1 Else age9_ = 0
If i_age(i) >= 65 And i_age(i) <= 69 Then age65_69 = 1 Else age65_69 = 0
If i_age(i) >= 70 And i_age(i) <= 79 Then age70_79 = 1 Else age70_79 = 0
If i_age(i) >= 25 And i_age(i) <= 35 Then age25_35 = 1 Else age25_35 = 0
If i_age(i) >= 45 And i_age(i) <= 64 Then age45_64 = 1 Else age45_64 = 0
If i_ap_atp(i) < ap_q(4, 2) Then ap_q_lt80 = 1 Else ap_q_lt80 = 0
If i_ap_atp(i) <= ap_q(2, 2) Then ap_q_12 = 1 Else ap_q_12 = 0
If i_ap_atp(i) > ap_q(2, 2) And _
i_ap_atp(i) <= ap_q(3, 2) Then ap_q_3 = 1 Else ap_q_3 = 0
If i_status(i) = 8 Then working = 1 Else working = 0
If h_max_edlevel(hhnr2index(i_hhnr(i))) = 0 Then h_ed0 = 1 Else h_ed0 = 0
If h_max_edlevel(hhnr2index(i_hhnr(i))) = 1 Then h_ed1 = 1 Else h_ed1 = 0
If i_status(i) = 4 Then ftp = 1 Else ftp = 0
If i_inc_taxable(i) <= q_inc_taxable(1, 2) Then q_inc_taxable1 = 1 Else q_inc_taxable1 = 0
If i_inc_taxable(i) > q_inc_taxable(1, 2) And _
i_inc_taxable(i) <= q_inc_taxable(2, 2) Then q_inc_taxable2 = 1 Else q_inc_taxable2 = 0
If i_inc_taxable(i) > q_inc_taxable(2, 2) And _
i_inc_taxable(i) <= q_inc_taxable(3, 2) Then q_inc_taxable3 = 1 Else q_inc_taxable3 = 0
If i_inc_taxable(i) > q_inc_taxable(3, 2) And _
i_inc_taxable(i) <= q_inc_taxable(4, 2) Then q_inc_taxable4 = 1 Else q_inc_taxable4 = 0
If i_ap_atp(i) <= ap_q(1, 2) Then ap_q1 = 1 Else ap_q1 = 0
If i_ap_atp(i) > ap_q(1, 2) And _
i_ap_atp(i) <= ap_q(2, 2) Then ap_q2 = 1 Else ap_q2 = 0
If i_ap_atp(i) > ap_q(2, 2) And _
i_ap_atp(i) <= ap_q(3, 2) Then ap_q3 = 1 Else ap_q3 = 0
If i_ap_atp(i) > ap_q(3, 2) And _
i_ap_atp(i) <= ap_q(4, 2) Then ap_q4 = 1 Else ap_q4 = 0
'*************************
'*** Compulsory school ***
'*************************
'*** Users determined by SESIM - model for amount
If i_age(i) >= 6 And i_age(i) <= 15 And i_abroad(i) = 0 Then
bald6_7 = 0
If i_age(i) >= 6 And i_age(i) <= 7 Then bald6_7 = 1
i_pc_school(i) = 1534 + _
bald6_7 * -5663.254642 + _
bald6_7 * i_age(i) * 758.259598
End If
'*******************
'*** High school ***
'*******************
'*** Users determined by SESIM - model for amount
If i_student(i) = 1 Then
i_pc_high_school(i) = 1642 + _
Abs(i_sex(i) - 2) * 97.085813 + _
Abs(i_born_abroad(i) - 1) * 115.367459
End If
'*********************************
'*** Municipal Adult Education ***
'*********************************
'*** Users determined by SESIM - model for amount
If i_student(i) = 2 Then
i_pc_MAE(i) = 445 + _
Abs(i_sex(i) - 2) * -58.0629246 + _
Abs(i_born_abroad(i) - 1) * -64.2340878 + _
i_age(i) * -1.6812555 + _
i_age(i) * Abs(i_sex(i) - 2) * 1.7585633
End If
'**************************************
'*** Adult education other that MAE ***
'**************************************
'*** Users are not determined by SESIM other that not being
'*** students. Users are therefore predikted using a model
'*** based approach. User subsidies are then predikted using
'*** a model based approach.
If i_student(i) = 0 And i_age(i) >= 20 And i_age(i) <= 50 Then
'*** 1) Randomize users
xbeta = -4.6 + _
(i_sex(i) - 1) * 1.7222 + _
i_age(i) * -0.0329 + _
i_age(i) * (i_sex(i) - 1) * -0.0301 + _
ed1 * -0.6067 + _
ed2 * -0.0349 + _
i_born_abroad(i) * 2.6732
prob = 1 / (1 + Exp(-xbeta))
'*** If user randomized then calculate subsidy
If Rnd < prob Then
i_pc_school_adult(i) = 480.60734717 + 316.0353066 + _
Abs((i_sex(i) - 2)) * -206.769824 + _
i_age(i) * -3.345291 + _
ed0 * -210.926779 + _
ed1 * -259.531027 + _
Abs(i_born_abroad(i) - 1) * 92.925345
End If
End If
'******************
'*** University ***
'******************
'*** Users determined by SESIM - model for amount
If i_student(i) = 3 Then
i_pc_univ(i) = 1734 + _
Abs(i_sex(i) - 2) * 206.177251 + _
i_age(i) * -20.571459 + _
i_age(i) * Abs(i_sex(i) - 2) * -7.86986
End If
'*****************************
'*** Labor market programs ***
'*****************************
'*** Users are randomized within the group of unemployed.
'*** For randomized users a subsidy is determined.
If i_status(i) = 6 Then
xbeta = 1.2 + _
Abs(i_sex(i) - 2) * 0.0472 + _
ed0 * 0.2478 + _
ed1 * -0.2561 + _
Abs(i_born_abroad(i) - 1) * -0.1481
prob = 1 / (1 + Exp(-xbeta))
'*** If user randomized then calculate subsidy
If Rnd < prob Then
i_pc_labor(i) = 982 + 413 + _
i_age(i) * 8.935473 + _
(i_age(i) ^ 2) * -0.14157 + _
ed0 * -221.413433 + _
ed1 * -45.95155 + _
Abs(i_born_abroad(i) - 1) * 50.71684
End If
End If
'******************
'*** Child care ***
'******************
'*** Users are randomized within ages 1-12.
'*** For randomized users a subsidy is determined.
If i_age(i) >= 1 And i_age(i) <= 12 And i_abroad(i) = 0 Then
xbeta = -1.3 + _
i_age(i) * 1.3071 + _
(i_age(i) ^ 2) * -0.1311 + _
Abs(i_born_abroad(i) - 1) * 0.7913 + _
h_ed0 * -0.4956 + _
h_ed1 * -0.381 + _
Abs(h_bvux_work(hhnr2index(i_hhnr(i))) - 1) * -0.8264
prob = 1 / (1 + Exp(-xbeta))
'*** If user randomized then calculate subsidy
If Rnd < prob Then
i_pc_childcare(i) = 636 + _
age1_4 * 938.072371 + _
age5_8 * 3043.621349 + _
age1_4 * i_age(i) * 16.202643 + _
age5_8 * i_age(i) * -401.74145 + _
age9_ * i_age(i) * -16.953771 + _
Abs(i_born_abroad(i) - 1) * -31.081517 + _
h_ed0 * 60.14472 + _
h_ed1 * -12.98235
End If
End If
'************************
'*** Care for elderly ***
'************************
'*** Users are randomized in ages 65 and above.
'*** For randomized users a subsidy is determined.
If i_age(i) >= 65 And i_abroad(i) = 0 Then
If age_adj >= 65 And age_adj <= 69 Then age65_69 = 1 Else age65_69 = 0
If age_adj >= 70 And age_adj <= 79 Then age70_79 = 1 Else age70_79 = 0
xbeta = -16.3 + _
age65_69 * 19.3768 + _
age70_79 * -4.6725 + _
age_adj * 0.1345 + _
age_adj * age65_69 * -0.271 + _
age_adj * age70_79 * 0.0576 + _
Abs(i_sex(i) - 2) * -0.1064 + _
Abs(i_born_abroad(i) - 1) * 1.9974 + _
Abs(i_born_abroad(i) - 1) * age65_69 * -2.9055 + _
Abs(i_born_abroad(i) - 1) * age70_79 * -1.2558 + _
ap_q_lt80 * 0.4337 + _
Abs(i_civ_stat(i) - 1) * 0.582 + _
age65_69 * Abs(i_civ_stat(i) - 1) * 0.5936 + _
age70_79 * Abs(i_civ_stat(i) - 1) * 1.159 + _
Abs(working - 1) * 1.8198
prob = 1 / (1 + Exp(-xbeta))
'*** If user randomized then calculate subsidy
If Rnd < prob Then
i_pc_elderly(i) = -1530 + _
age_adj * 91.04904 + _
ap_q_12 * -349.82211 + _
ap_q_3 * 419.90341 + _
Abs(i_sex(i) - 2) * -166.88443 + _
Abs(i_born_abroad(i) - 1) * 805.03459
End If
End If
'***************
'*** Medicin ***
'***************
'*** Information about users is not available. An average
'*** amount (by sex and agegroup) is layed out on everyone.
i_pc_medicine(i) = pc_medicine(mini(18, Floor(i_age(i) / 5)) + 19 * (i_sex(i) - 1))
'******************
'*** Healthcare ***
'******************
'*** All individuals in ages 0 - 19 are assigned a healthcare subsidy
If i_age(i) <= 19 Then
i_pc_care(i) = 123 + _
i_age(i) * -10.4904327 + _
(i_age(i) ^ 2) * 0.51495 + _
Abs(i_sex(i) - 2) * -4.2299982 + _
Abs(i_born_abroad(i) - 1) * -22.4716537 + _
h_ed0 * 14.5325611 + _
h_ed1 * 7.328382
End If
'*** Randomize users in ages 20 - 64
If i_age(i) >= 20 And i_age(i) <= 64 Then
xbeta = 2.3 + _
i_age(i) * 0.0264 + _
Abs(i_sex(i) - 2) * -0.6863 + _
Abs(ftp - 1) * -0.6924 + _
Abs(working - 1) * -0.1073 + _
Abs(i_born_abroad(i) - 1) * 0.4429 + _
Abs(i_civ_stat(i) - 1) * -0.3081 + _
q_inc_taxable1 * -0.3607 + _
q_inc_taxable2 * -0.2232 + _
q_inc_taxable3 * -0.0927 + _
q_inc_taxable4 * -0.1124
prob = 1 / (1 + Exp(-xbeta))
'*** If user randomized then calculate subsidy
If Rnd < prob Then
i_pc_care(i) = 129 + _
i_age(i) * 2.8595397 + _
age25_35 * 69.0291135 + _
Abs(i_sex(i) - 2) * -9.5539516 + _
Abs(i_born_abroad(i) - 1) * -24.4130534 + _
ed0 * 14.2136262 + _
ed1 * 9.905306 + _
q_inc_taxable1 * 24.4371204 + _
q_inc_taxable2 * 31.4822668 + _
q_inc_taxable3 * 12.7291515 + _
q_inc_taxable4 * 1.8572042 + _
age25_35 * Abs(i_sex(i) - 2) * -72.5146218 + _
Abs(ftp - 1) * -138.057538 + _
Abs(age45_64 - 1) * 121.181382 + _
Abs(age45_64 - 1) * i_age(i) * -2.7715088
End If
End If
'*** Randomize users in ages 65-
If i_age(i) >= 65 Then
xbeta = -20.7 + _
age_adj * 0.6164 + _
age_adj ^ 2 * -0.00372 + _
Abs(i_sex(i) - 2) * -0.5712 + _
Abs(i_born_abroad(i) - 1) * 0.1607 + _
Abs(i_civ_stat(i) - 1) * -0.5486 + _
ap_q1 * -1.2302 + _
ap_q2 * -0.8379 + _
ap_q3 * -0.6018 + _
ap_q4 * -0.469
prob = 1 / (1 + Exp(-xbeta))
'*** If user randomized then calculate subsidy
If Rnd < prob Then
i_pc_care(i) = -785 + _
age_adj * 19.467723 + _
Abs(i_sex(i) - 2) * 55.556962 + _
Abs(i_abroad(i) - 1) * -405.934681 + _
Abs(i_civ_stat(i) - 1) * 163.683087 + _
ap_q1 * 14.665889 + _
ap_q2 * 151.974989 + _
ap_q3 * -76.545223 + _
ap_q4 * 35.082795
End If
End If
'*** scale to SEK in current years prices
i_pc_school(i) = (i_pc_school(i) / 1000) * basbelopp
i_pc_high_school(i) = (i_pc_high_school(i) / 1000) * basbelopp
i_pc_MAE(i) = (i_pc_MAE(i) / 1000) * basbelopp
i_pc_school_adult(i) = (i_pc_school_adult(i) / 1000) * basbelopp
i_pc_univ(i) = (i_pc_univ(i) / 1000) * basbelopp
i_pc_labor(i) = (i_pc_labor(i) / 1000) * basbelopp
i_pc_childcare(i) = (i_pc_childcare(i) / 1000) * basbelopp
i_pc_elderly(i) = (i_pc_elderly(i) / 1000) * basbelopp
i_pc_medicine(i) = (i_pc_medicine(i) / 1000) * basbelopp
i_pc_care(i) = (i_pc_care(i) / 1000) * basbelopp
'*** Alignment of the general level of subsidies for health care
'*** TP 021216
i_pc_care(i) = i_pc_care(i) * 1.5
'*** No negative values
If i_pc_school(i) < 0 Then i_pc_school(i) = 0
If i_pc_high_school(i) < 0 Then i_pc_high_school(i) = 0
If i_pc_MAE(i) < 0 Then i_pc_MAE(i) = 0
If i_pc_school_adult(i) < 0 Then i_pc_school_adult(i) = 0
If i_pc_univ(i) < 0 Then i_pc_univ(i) = 0
If i_pc_labor(i) < 0 Then i_pc_labor(i) = 0
If i_pc_childcare(i) < 0 Then i_pc_childcare(i) = 0
If i_pc_elderly(i) < 0 Then i_pc_elderly(i) = 0
If i_pc_medicine(i) < 0 Then i_pc_medicine(i) = 0
If i_pc_care(i) < 0 Then i_pc_care(i) = 0
'************************************
'*** Aggregated public consumtion ***
'************************************
i_pc_total(i) = i_pc_care(i) + i_pc_childcare(i) + i_pc_elderly(i) + _
i_pc_high_school(i) + i_pc_labor(i) + i_pc_MAE(i) + i_pc_medicine(i) + _
i_pc_school(i) + i_pc_school_adult(i) + i_pc_univ(i)
End If '*** if i_abroad(i) = 0
Next
End Sub
'*******************************************************************
'*** Function takeup_social_welfare randomizes applications for
'*** social welfare participation for eligible households. The
'*** function returns one for applying households and zero for the
'*** other.
'*** The take-up is modelled separately for one-adult and two-adult
'*** households. Also, newly formed households have a separate
'*** model containing no information about lagged social assistance.
'*** Arguments:
'*** eq_norm (IN): social welfare benefit norm (national)
'*** hhidx (IN): household index number
'*** disp (IN): household disposable income + financial wealth
'*** (above 10000 SEK)
'***
'*******************************************************************
Public Function takeup_social_welfare(ByVal norm As Double, ByVal disp As Long, _
ByVal hhidx As Long) As Byte
Dim xbeta As Double, prob As Double
Dim male As Byte, ed1 As Byte, ed2 As Byte, lag As Byte
Dim unemp As Byte, exper As Byte, stud As Byte, city As Byte, divorced As Byte
Dim unempf As Byte, unempm As Byte, ed1m As Byte, ed1f As Byte
Dim ed2m As Byte, ed2f As Byte, expm As Byte, expf As Byte
Dim indexnr As Long, indexnrm As Long, indexnrf As Long
Dim kommun As Integer
Dim soc_add As Double
'*** Living in Stockholm, Göteborg or Malmö
kommun = h_kommunindex(hhidx)
city = 0
If kommun = 17 Or kommun = 163 Or kommun = 115 Then city = 1
'*** Lagged social assistance
lag = 0
If socbid_old > 0 Then lag = 1
'*** Calculations conditional on number of adults in household
Select Case h_n_adults(hhidx)
'*** If single adult household
Case 1
'*** Index number of single adult
If h_indnr_male(hhidx) <> 0 Then
indexnr = indnr2index(h_indnr_male(hhidx))
Else
indexnr = indnr2index(h_indnr_female(hhidx))
End If
'*** Define covariates
male = 0
If i_sex(indexnr) = 1 Then male = 1
ed1 = 0
If i_edlevel(indexnr) = 1 Then ed1 = 1
ed2 = 0
If i_edlevel(indexnr) = 2 Then ed1 = 1
unemp = 0
If i_status(indexnr) = 6 Then unemp = 1
'*** Approximate experience using the number of years with
'*** public pension rights
'exper = pp_hist(indexnr).n_years
'*** Work experience
exper = i_workexperience(indexnr)
stud = 0
If i_status(indexnr) = 3 Then stud = 1
divorced = 0
If i_year_sep(indexnr) > 0 Then divorced = 1
'*** Newly formed single households: separated, new adults or new
'*** immigrants
If i_year_sep(indexnr) = base_year + model_time Or _
i_bvux1(indexnr) = 0 Or i_binvar(indexnr) = base_year + model_time Then
xbeta = 0.586 + _
i_age(indexnr) * -0.0353 + _
male * 0.1181 + _
h_n_child(hhidx) * 0.0597 + _
h_n_childlt7(hhidx) * 0.2974 + _
ed1 * -0.3157 + _
ed2 * -0.9884 + _
unemp * 1.055 + _
((norm - disp) / 100000) * 1.8314 + _
exper * -0.0145 + _
((exper ^ 2) / 100) * 0.0412 + _
stud * -0.734 + _
Abs(i_born_abroad(indexnr) - 1) * -0.4384 + _
city * 0.1486 + _
divorced * 0.4587
Else
'*** Old households
xbeta = -1.0861 + _
i_age(indexnr) * -0.0268 + _
male * 0.0308 + _
h_n_child(hhidx) * 0.0273 + _
h_n_childlt7(hhidx) * 0.1904 + _
ed1 * -0.2192 + _
ed2 * -0.6981 + _
unemp * 0.7025 + _
((norm - disp) / 100000) * 1.5081 + _
exper * 0.000042 + _
((exper ^ 2) / 100) * 0.0311 + _
stud * -0.4279 + _
Abs(i_born_abroad(indexnr) - 1) * -0.2768 + _
city * 0.0742 + _
divorced * 0.1403 + _
lag * 3.1848
End If
'*** if two-adult household
Case 2
'*** Find indexnumbers for adults
indexnrm = indnr2index(h_indnr_male(hhidx))
indexnrf = indnr2index(h_indnr_female(hhidx))
'*** Define covariates
ed1f = 0
If i_edlevel(indexnrf) = 1 Then ed1f = 1
ed1m = 0
If i_edlevel(indexnrm) = 1 Then ed1m = 1
unempf = 0
If i_status(indexnrf) = 6 Then unempf = 1
unempm = 0
If i_status(indexnrm) = 6 Then unempm = 1
expf = i_workexperience(indexnrf)
expm = i_workexperience(indexnrm)
'*** Newly formed households: new couple or immigrants
If h_form_year(hhidx) = base_year + model_time Or _
i_binvar(indexnrf) = base_year + model_time Or _
i_binvar(indexnrm) = base_year + model_time Then
xbeta = 1.5717 + _
i_age(indexnrf) * -0.0421 + _
i_age(indexnrm) * 0.0232 + _
h_n_child(hhidx) * 0.3152 + _
h_n_childlt7(hhidx) * -0.2399 + _
ed1f * -0.2747 + _
ed2f * -0.7232 + _
ed1m * -0.0677 + _
ed2m * -0.3474 + _
unempf * 0.5132 + _
unempm * 1.3179 + _
((norm - disp) / 100000) * 1.004 + _
expf * -0.1574 + _
((expf ^ 2) / 100) * 0.4107 + _
expm * -0.1394 + _
((expm ^ 2) / 100) * 0.2276 + _
Abs(i_born_abroad(indexnrf) - 1) * -0.1528 + _
Abs(i_born_abroad(indexnrm) - 1) * -0.2729 + _
city * 0.052
Else
'*** Old households
xbeta = -0.8909 + _
i_age(indexnrf) * -0.0298 + _
i_age(indexnrm) * 0.00612 + _
h_n_child(hhidx) * 0.1681 + _
h_n_childlt7(hhidx) * -0.2249 + _
ed1f * -0.1091 + _
ed2f * -0.3493 + _
ed1m * -0.0729 + _
ed2m * -0.3343 + _
unempf * 0.3658 + _
unempm * 0.8582 + _
((norm - disp) / 100000) * 0.9341 + _
expf * -0.0816 + _
((expf ^ 2) / 100) * 0.2348 + _
expm * -0.0328 + _
((expm ^ 2) / 100) * 0.0461 + _
Abs(i_born_abroad(indexnrf) - 1) * -0.00358 + _
Abs(i_born_abroad(indexnrm) - 1) * -0.1974 + _
city * 0.125 + _
lag * 3.7654
End If
'*** Erroneous case - print debug info
Case Else
Debug.Print "ERROR: Household nr " & h_hhnr(hhidx) & _
" contains " & h_n_adults(hhidx) & " adults!"
End Select
'*** ALIGNMENT: the total take-up rate is increased
Select Case (base_year + model_time)
Case 2000
soc_add = 1.1
Case 2001
soc_add = 1.1
Case 2002
soc_add = 0.5
Case 2003
soc_add = 0.9
Case 2004
soc_add = 1.3
Case 2005
soc_add = 1.7
Case 2006
soc_add = 1.1
Case 2007
soc_add = 0.2
Case Else
soc_add = 0#
End Select
xbeta = xbeta + soc_add
'*** Calculate probability and draw from it
prob = 1 / (1 + Exp(-xbeta))
takeup_social_welfare = 0
If Rnd < prob Then takeup_social_welfare = 1
' '*** Debug information
' Call Print_to_file("\tempdata\debug_takeup_soc.txt", "N", _
' base_year + model_time, h_n_adults(hhidx), male, ed1, ed2, _
' unemp, exper, stud, city, divorced, unempf, unempm, ed1m, ed1f, _
' ed2m, ed2f, expm, expf, kommun, norm, prob)
End Function