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