Attribute VB_Name = "a06_Pension_Rules"
'*************************************************************************************
'*** This module contains subroutines that handles old age pensions, both public,
'*** occupational and private.
'*** There are two versions of all subroutines - standard version and BabyBoom version.
'*** A conditional compilation is performed that uses the BabyBoom version if the
'*** conditional compilation constant BBPens (see Projekt->Properties->Make) equals 1
'*** and otherwise the standard version. TP050222
'*************************************************************************************

#If BBPens = 1 Then

'******* a06_Pension_Rules - Calculates pension benefits, pension rights etc *******

' ----------------------------------------------------------
' -- Approximative mneumonics (in swenglish)
' i_{tt}_{ss}_{ee}
'    tt      = type of pension
'         ss = program
'              qq = qualifying part
' i_ap       = ålderspension = old age pensions
' i_ftp      = förtidspension = disabilty pensions
' i_op       = avtalspension = occupational pensions
' i_surv     = efterlevandepension = survivors pensions
' i_pi       = private insurance
' i_pr_      = pensionsunderlag = pension rights
' i_pb_      = pensionsbehållning = cumulative pension rights
' i_{tt}_fp  = folkpension = basic pension
' i_{tt}_atp = ATP = national supplemental pension
' i_{tt}_fp  = folkpension = national basic pension
' i_{tt}_ip  = inkomstpension
' i_{tt}_gp  = garantipension
' i_{tt}_tp  = reformerad ATP = reformed supplemental pe
' i_{tt}_pp  = national premium pension
' i_{tt}_ap  = other old age pension
' i_{tt}_pts = PTS = basic pension supplement
' barn
' ank
' f_         = prefix indicating function
' ----------------------------------------------------------

Option Explicit
Option Base 1
'Private f_utfasning_ATP As Double
Public z_ap_atp As Double
Private year As Integer
Dim pnames(100) As String
Dim pvalues(100) As Variant
    

Public Sub Calculate_Disability_Pension(i As Long)
'! Calculation of disability pension benefits
'*** EGENTLIGEN SKA FÖRÄLDRAR TILL FÖRTIDSPENSIONÄRER YNGRE ÄN 19 HA VÅRDBIDRAG
    Dim ftp_antag_p As Double   ' Pensionsrätt för förtidspensionärer, antagandepoäng
    Dim ftp_antag_p1 As Double  ' do hjälpvariabel
    Dim ftp_antag_p2 As Double  ' do hjälpvariabel
    Dim pp4(4) As Double        ' do hjälpvariabel Vektor med senaste 4 årens pensionspoäng
    Dim n As Long, y As Long    ' do hjälpvariabel
    Dim antag_bo_tid As Long    ' Antagen bosättningstid (qualifying years for disabled)
    Dim bokvot As Double        ' Bosättningstidskvot
    Dim ftp_pts_kvot As Double  ' Parameter för beräkning av PTS för förtidpens och sjukbidrag
    Dim ftp_fp_kvot_gifta As Double ' Parameter vid beräkning av folkpension, gifta
    Dim ftp_fp_kvot_ogifta As Double ' Parameter vid beräkning av folkpension, ogifta
    
    ftp_pts_kvot = 1.129        ' *** Kan ligga i parameterfil
    ftp_fp_kvot_gifta = 0.725       ' *** Kan ligga i parameterfil
    ftp_fp_kvot_ogifta = 0.9        ' *** Kan ligga i parameterfil
    
    year = model_time + base_year
  
    ' -- Calculate & updates qualifying points     antagandepoäng / antagandeinkomst
    If i_status1(i) <> 4 Or (i_status1(i) = 4 And i_age(i) = 19) Then ' New Disability pensioner
        If year < 2003 Then '-- Old system
            ' Villkor: Antingen ATP-poäng för minst 2 av de 4 åren närmast föregående pensionsfallet
            ' eller SGI > basb samt minst 1 historisk ATP-poäng
            If pp_hist(i).n_years >= 4 Then
                n = 0
                For y = pp_hist(i).n_years - 3 To pp_hist(i).n_years
                    If pp_hist(i).pp_years(y) >= year - 4 Then
                        pp4(n + 1) = pp_hist(i).pp(y)
                        n = n + 1
                    End If
                Next
            End If
            ' -- Förvärvsvillkor
            If (i_inc_taxable(i) >= m_basbelopp And pp_hist(i).n_years > 0) Or n >= 2 Then
                ' Alt 1: Average of ATP-points: The 2 best years of the last 4
                If pp_hist(i).n_years >= 4 Then
                    Select Case n
                        Case Is > 1 ' -- Snitt av två bästa
                            Call Sort(pp4, True)
                            ftp_antag_p1 = (pp4(1) + pp4(2)) / 2
                        Case 1 ' -- Om endast 1 år 50% av detta
                            ftp_antag_p1 = pp4(1) / 2
                        Case 0  ' -- Det kan hända att inget av åren var nära i tiden
                            ftp_antag_p1 = 0
                    End Select
                End If
                ' Alt 2: Medeltalet av bästa hälften av alla
                Dim pp_sort() As Integer  ' -- Kopierar vektorn för sortering
                pp_sort = pp_hist(i).pp
                Call Sort(pp_sort, True)
                ftp_antag_p2 = 0
                If pp_hist(i).n_years > 1 Then
                    For y = 1 To Int((pp_hist(i).n_years / 2) + 0.5)
                        ftp_antag_p2 = ftp_antag_p2 + pp_sort(y) '****pp_hist(i).pp(y)
                    Next
                    ftp_antag_p2 = ftp_antag_p2 / Int((pp_hist(i).n_years / 2) + 0.5)
                  Else
                    ftp_antag_p2 = pp_sort(1)
                End If
                ' -- Choosing best alternative for the disabled
                ftp_antag_p = maxi(ftp_antag_p1, ftp_antag_p2)
              '-- Updating pension history       pensionspoängsvektorn
              Call Update_pp_hist(i, CInt(ftp_antag_p))
              '-- Calculating qualifying income in SEK
              i_ftp_antag(i) = ((ftp_antag_p / 100) + 1) * m_basbelopp_f
            End If
          Else '-- New system from 2003
            'Qualifying points in new system
            If i_pgi(i) > 0 Or pp_hist(i).n_years > 0 Then '-- Right to income based disab pens if 1 or more PGI-years
                i_ftp_antag(i) = f_qualif_inc(i)
              '-- Updating pension history      pensionspoängsvektorn
              '   LÄGGER TILL VILLKOR SÅ ATT PP-VEKTORN ENDAST UPPDATERAS MED VÄRDEN STÖRRE ÄN 1 BASBELOPP
              If (i_ftp_antag(i) - m_basbelopp_f) > 0 Then
                Call Update_pp_hist(i, CInt(((i_ftp_antag(i) - m_basbelopp_f) / m_basbelopp_f) * 100))
              End If
            End If 'pgi
        End If ' year < 2003
      
      
      Else    '-- This individual was disabled last year
        ' -- Only disability pensioners with qualifying points
        If pp_hist(i).n_years > 0 Then
            ' -- Disab pensioner last year, gets same pensionrights as last year
            If m_ftp_Inkindex_On = 0 Then '-- Optional income indexation of paid out disability pensions
                ftp_antag_p = pp_hist(i).pp(pp_hist(i).n_years)
                i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f)
              Else
                ftp_antag_p = (((((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1)) * _
                    ((m_ap_inkind / m_ap_inkind1) - (m_KPI - 1))) - 1) * 100
                i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f)
             End If
             Call Update_pp_hist(i, CInt(ftp_antag_p))
        End If
     End If '-- i_status1(i) <> 4

    ' -- Calculate benefits with price-correction
    If year < 2004 Then
        ' -- ATP
        If pp_hist(i).n_years > 0 Then
            i_ftp_atp(i) = 0.6 * (pp_hist(i).pp(pp_hist(i).n_years) / 100) _
                * m_basbelopp * mini(1, (pp_hist(i).n_years + (65 - i_age(i)) / 30))
        End If
        ' -- Folkpension & PTS
        antag_bo_tid = i_botid(i) + (65 - i_age(i)) * _
            mini(1, i_botid(i) / 0.8 * (maxi(i_age(i), 17) - 16))
        bokvot = maxi(mini(1, antag_bo_tid / 40), mini(1, pp_hist(i).n_years / 30))
        If antag_bo_tid >= 3 Then ' -- Minst 3 bosättningsår krävs f folkpen & PTS
            ' -- Folkpension
            If i_civ_stat(i) = 0 Then
                i_ftp_fp(i) = ftp_fp_kvot_ogifta * m_basbelopp * bokvot
              Else
                i_ftp_fp(i) = ftp_fp_kvot_gifta * m_basbelopp * bokvot
            End If
            ' -- PTS
            i_ftp_pts(i) = bokvot * maxi((ftp_pts_kvot * m_basbelopp) - i_ftp_atp(i), 0)
          Else
            i_ftp_fp(i) = 0
            i_ftp_pts(i) = 0
         End If
        i_ftp(i) = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
    End If
    '-- New disabbility pension system after 2002
    If year >= 2003 Then
        If i_age(i) >= 19 Then
           If i_age(i) = 19 Or (i_status1(i) <> 4 And i_age(i) < 30) Then
               i_ftp_typ(i) = 1
             ElseIf i_ftp_typ(i) = 1 And i_age(i) >= 30 Then
           End If
           If i_ftp_typ(i) = 1 And i_age(i) >= 30 Then
               i_ftp_typ(i) = 0
           End If
           '-- Income related part
           i_ftp_ink(i) = 0.64 * i_ftp_antag(i) '-- i_ftp_antag optionally income indexed, see above
           i_ftp_just(i) = (i_ftp_just(i) / m_basbelopp1) * m_basbelopp '** No income indexation: Transitional
           
           '-- Guaranteed level  (Rules on limit on insurance time not implemented
           '   m_ftp_Inkindex_On = 0 0> m_basbelopp_ftp = m_basbelopp, else income indexed
           i_ftp_gar(i) = maxi(0, (f_disab_guarantee(i_age(i)) * m_basbelopp_ftp * _
                mini(1, (i_botid(i) + (65 - i_age(i))) / 40)) - i_ftp_ink(i))
           i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up
         Else
           i_ftp(i) = 0
           i_ftp_ink(i) = 0
           i_ftp_gar(i) = 0
           i_ftp_just(i) = 0
        End If
    End If
    
    '-- Transition rules: Recalculation of old disab pension rights
    Dim omv_bruttoers As Long
    Dim fakt_bruttoers As Long
    Dim SGA_bel As Long
    Dim ber_gar As Long
    If year = 2003 And i_status1(i) = 4 Then '-- Only for old disablity pensioners
        If i_age(i) >= 19 Then
            fakt_bruttoers = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
            SGA_bel = maxi(0, (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _
                (f_SGA_2002(fakt_bruttoers, i_civ_stat(i), m_basbelopp) - _
                f_basic_deduction_2002(fakt_bruttoers, m_basbelopp)))
            omv_bruttoers = fakt_bruttoers + SGA_bel
            ber_gar = (omv_bruttoers - (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _
            (f_basic_deduction_2002(omv_bruttoers, m_basbelopp) - _
            f_basic_deduction_2002(fakt_bruttoers, m_basbelopp))) _
            - i_ftp_ink(i)
            'i_ftp_just(i) = ber_gar - i_ftp_gar(i)
            i_ftp_just(i) = maxi(0, ber_gar - i_ftp_gar(i)) '-- Not negative
            i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up
         Else
            i_ftp(i) = 0
            i_ftp_ink(i) = 0
            i_ftp_gar(i) = 0
            i_ftp_just(i) = 0
        End If
    End If
    '-- New system replaces old benefits 2003
    If year = 2003 Then
        i_ftp_atp(i) = 0
        i_ftp_fp(i) = 0
        i_ftp_pts(i) = 0
    End If

End Sub

'****** EJ KLAR!! ARBETAR MED DENNA PROCEDUR *****
Public Sub Calculate_Work_Injuries() Dim i As Long For i = 1 To m_icount If i_trf_skada(i) > 0 Then If i_age(i) >= 65 Then i_trf_skada(i) = 0 Else 'Indexation i_trf_skada(i) = i_trf_skada(i) End If End If Next i End Sub
Public Function f_local_taxrate(idx As Long, year) '!-- Local tax rate for different years Select Case year Case Is >= 2006 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt06 / 100 Case 1999 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt99 / 100 Case 2000 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt00 / 100 'satserna efter 99 betydligt lägre ?? Case 2001 ' ThP beror kanske på kyrkoavgiften?? f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt01 / 100 Case 2002 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt02 / 100 Case 2003 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt03 / 100 Case 2004 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt04 / 100 Case 2005 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt05 / 100 End Select End Function
Public Function f_ramtid(age As Byte) As Byte '!-- Qualifying time in new disability pension system Select Case age Case Is < 47 f_ramtid = 8 Case Is < 50 f_ramtid = 7 Case Is < 53 f_ramtid = 6 Case Is >= 53 f_ramtid = 5 End Select End Function
'-- Antagandeinkomst from 2003 enligt lag 1963:381 "Om antagandeinkomst" ' Funktionen bortser från specialregler i 8§ om aktivitetsersättningen
Public Function f_qualif_inc(idx As Long) As Long '!-- Disablity pensions qualifying income from 2003 Dim i As Integer Dim n As Integer Dim inc_average As Long Dim inc(1 To 8) As Double Dim ramtid As Byte inc(1) = i_inc_taxable1(idx) * 1.07 / m_basbelopp1 inc(2) = i_inc_taxable2(idx) * 1.07 / m_basbelopp2 inc(3) = i_inc_taxable3(idx) * 1.07 / m_basbelopp3 inc(4) = i_inc_taxable4(idx) * 1.07 / m_basbelopp4 inc(5) = i_inc_taxable5(idx) * 1.07 / m_basbelopp5 '-- Note: pp_hist truncated for incomes from 0 to 1 basic amount Select Case pp_hist(idx).n_years Case Is > 7 inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07 inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07 inc(8) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 7) / 100) + 1) * 1.07 Case 7 inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07 inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07 inc(8) = 0 Case 6 inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07 inc(7) = 0 inc(8) = 0 Case Else inc(6) = 0 inc(7) = 0 inc(8) = 0 End Select '-- Truncation at 7.5 basic amounts For n = 1 To 5 inc(n) = mini(7.5, inc(n)) Next 'sortera inc 1 to f_ramtid(i_age(idx) till inc_sort ramtid = f_ramtid(i_age(idx)) ReDim inc_sort(1 To ramtid) As Double ' -- Kopierar vektorn för sortering For n = 1 To ramtid inc_sort(n) = inc(n) Next Call Sort(inc_sort, True) f_qualif_inc = ((inc_sort(1) + inc_sort(2) + inc_sort(3)) / 3) * m_basbelopp ' **** NOT IMPLEMENTED **** '-- Lite andra villkor för aktivitetsers ' If i_age(idx) < 30 Then ' Select Case n ' Case 1 ' Case 2 ' Case 3 ' End Select ' End If End Function
Public Function f_disab_guarantee(age As Byte) As Double '!-- Calculates guaranteed level in basic amounts in new disability pensions system Select Case age Case Is >= 30 f_disab_guarantee = 2.4 Case Is < 21 f_disab_guarantee = 2.1 Case Is < 23 f_disab_guarantee = 2.15 Case Is < 25 f_disab_guarantee = 2.2 Case Is < 27 f_disab_guarantee = 2.25 Case Is < 29 f_disab_guarantee = 2.3 Case 29 f_disab_guarantee = 2.35 End Select End Function
Public Function f_SGA_2002(ink As Long, civ_stat As Byte, basbelopp As Long) As Double '!-- Särskilt grundavdrag 2002 (Bygger på a05 f_basic_deduction) '! Used for calculation of transition to new disability pension system Dim sga As Double Dim sgae As Double Dim sgag As Double Dim sgaproc As Double Dim sgamax As Double Dim sgared As Double sgae = 1.5749 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS sgag = 1.3969 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDRAG '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) f_SGA_2002 = round(sgared, -2) If f_SGA_2002 > ink Then f_SGA_2002 = ink End Function
Public Function f_basic_deduction_2002(ink, basbelopp As Long) As Double '!-- Basic deduction 2002 (Bygger på a05 f_basic_deduction) Dim g As Double Dim i As Integer Dim limits(1 To 9) As Double Dim lutning(1 To 8) As Double Dim xgr As Double limits(1) = 0 limits(2) = 0.293 * basbelopp limits(3) = 1.86 * basbelopp limits(4) = 2.89 * basbelopp limits(5) = 3.04 * basbelopp limits(6) = 9E+99 * basbelopp limits(7) = 0 limits(8) = 0 limits(9) = 0 lutning(1) = 1 lutning(2) = 0 lutning(3) = 0.25 lutning(4) = 0 lutning(5) = -0.1 lutning(6) = 0 lutning(7) = 0 lutning(8) = 0 xgr = Int((0.293 * basbelopp + 99) / 100) * 100 ' LÄGSTA GRUNDAVDRAG g = 0 i = LBound(limits) + 1 Do Until ink <= limits(i) If ink > limits(i) Then g = g + (limits(i) - limits(i - 1)) * lutning(i - 1) i = i + 1 Loop g = g + (ink - limits(i - 1)) * lutning(i - 1) If g < limits(LBound(limits) + 1) Then g = limits(LBound(limits) + 1) If ink > xgr Then g = maxi(xgr, g) If base_year + model_time < 2001 Then g = Int(g / 100) * 100 Else g = Int((g + 99.9) / 100) * 100 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 f_basic_deduction_2002 = g End Function
'-- Calculation of survivors pension Efterlevandepensioner ' Call from x03_Service - delete_individuals whenever a cohabiting person dies ' Only calculation of widow and children pensions currently ' Se also procedure Update_Survivors_pension in this module '**** Only calc of aggregate i_surv, not divided in i_surv_atp and i_surv_fp now '**** Som det är nu är endast en schablonregel med ett basb per änke och barnpens med ' 1 stämmer ungefär för 2005. '**** Egentligen ska man ha 90% av basb+PTS 62,9% (bökiga reglöer f inkomstprövning) ' 40% av mannens ATP, 35% om det finns barn, 15% f 1:a barnet, 10% f ytterligare barn ' (fördelas lika mellan barnen)
Public Sub Calculate_Survivors_pension(i As Long) '!-- Calculation of survivors pension Efterlevandepensioner Dim surv_nr As Long 'Indexnr for survivor 'Dim child_nr As Long 'Indexnr for surviving child Dim civ_stat_dat As Integer Dim widow_base_atp As Double, child_base_atp As Double, widow_base_fp As Double Dim child_base_fp As Double, surv_base_omst As Double Dim basbelopp As Long surv_nr = i_indnr(i) civ_stat_dat = h_form_year(hhnr2index(i_hhnr(i))) 'Household formation year '-- Koefficienter hämtade f RFV:s budgetunderlag år 2001 ' PTS modelleras ej - FP-koeff avser såväl FP som PTS widow_base_atp = 0.877 '>=18 år **** Provisoriskt: Senare ordentlig beräkning child_base_atp = 0.635 '<18 år **** Provisoriskt: -"- widow_base_fp = 0.678 '>=18 år & <65 år inkl PTS **** Provisoriskt: Senare ordentlig beräkning child_base_fp = 0.282 '<18 år **** Provisoriskt: -"- surv_base_omst = 1.22 ' Samma f omst o förlängd omst pens ' Note: Indexation in Update_Survivors_pension, even the first year If year < 2001 Then ' therefore back-indexation here basbelopp = m_basbelopp_f / m_KPI1 Else basbelopp = m_basbelopp_income * (m_ap_inkind1 / m_ap_inkind) End If '-- Widow's pension Övergångsvis änkepension TP 'If i_sex(i) = 1 And h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if the husband dies If h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if more than one person in household 'Searching for survivors indexnr surv_nr = h_first_indnr(hhnr2index(i_hhnr(i))) Do Until (i_bvux(indnr2index(surv_nr)) = 1 And i_sex(indnr2index(surv_nr)) <> i_sex(i)) Or surv_nr = 0 surv_nr = i_next_indnr(indnr2index(surv_nr)) Loop '-- Widows pension If i_sex(i) = 1 And surv_nr <> 0 And civ_stat_dat < 1990 And civ_stat_dat > 0 Then 'Only to widows married before 1990 i_surv_atp(indnr2index(surv_nr)) = widow_base_atp * basbelopp If i_age(indnr2index(surv_nr)) < 65 Then i_surv_fp(indnr2index(surv_nr)) = widow_base_fp * basbelopp Else i_surv_fp(indnr2index(surv_nr)) = 0 End If i_surv_year(indnr2index(surv_nr)) = model_time + base_year i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _ i_surv_atp(indnr2index(surv_nr)) '-- Transitional survivors pension ElseIf i_age(indnr2index(surv_nr)) < 65 And i_age(indnr2index(surv_nr)) > 17 Then i_surv_omst(indnr2index(surv_nr)) = surv_base_omst * basbelopp i_surv_year(indnr2index(surv_nr)) = model_time + base_year i_surv(indnr2index(surv_nr)) = i_surv_omst(indnr2index(surv_nr)) Else i_surv_atp(indnr2index(surv_nr)) = 0 i_surv_fp(indnr2index(surv_nr)) = 0 i_surv(indnr2index(surv_nr)) = 0 End If Else i_surv_atp(indnr2index(surv_nr)) = 0 i_surv_fp(indnr2index(surv_nr)) = 0 i_surv(indnr2index(surv_nr)) = 0 End If '-- Childrens pension ' Only if parents with children in household dies If i_bvux(i) = 1 And h_n_child(hhnr2index(i_hhnr(i))) > 0 Then 'Searching for childrens indexnr surv_nr = h_first_indnr(hhnr2index(i_hhnr(i))) Do Until surv_nr = 0 If i_age(indnr2index(surv_nr)) < 18 Then i_surv_year(indnr2index(surv_nr)) = model_time + base_year i_surv_atp(indnr2index(surv_nr)) = child_base_atp * basbelopp i_surv_fp(indnr2index(surv_nr)) = child_base_fp * basbelopp i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _ i_surv_atp(indnr2index(surv_nr)) End If surv_nr = i_next_indnr(indnr2index(surv_nr)) Loop ' Else ' i_surv_atp(indnr2index(surv_nr)) = 0 ' i_surv_fp(indnr2index(surv_nr)) = 0 ' i_surv(indnr2index(surv_nr)) = 0 End If End Sub
Public Sub Update_Survivors_pension(i As Long) '!-- Yearly updating of previously calculated survivors pensiona Efterlevandepensioner If i_surv(i) > 0 Then If i_age(i) = 18 Then '-- Barnpension upphör då man blir 18 i_surv_fp(i) = 0 i_surv_atp(i) = 0 ' i_surv(i) = 0 End If ' Änkor antas avstå från att gifta om sig formellt ' If i_civ_stat(i) = 1 Then '-- Rätt till änkepension upphör om man gifter sig ' i_surv_fp(i) = 0 ' i_surv_atp(i) = 0 ' i_surv(i) = 0 ' End If If i_status(i) = 2 Then '-- Folkpensionsdelen av änkepension upphör vid ålderpensionen i_surv_fp(i) = 0 ' i_surv(i) = i_surv_atp(i) End If 'Transitional survivors pension If i_surv_omst(i) > 0 Then If (i_surv_year(i) = model_time + base_year) Or (i_surv_year(i) = model_time + base_year - 1 _ And h_n_child(hhnr2index(i_hhnr(i))) > 0) Or _ h_n_childlt12(hhnr2index(i_hhnr(i))) > 0 Then i_surv_omst(i) = i_surv_omst(i) * f_pens_index("ATP", 65) Else i_surv_omst(i) = 0 End If End If ' Indexering i_surv_fp(i) = i_surv_fp(i) * f_pens_index("ATP", 65) i_surv_atp(i) = i_surv_atp(i) * f_pens_index("ATP", 65) i_surv(i) = i_surv_fp(i) + i_surv_atp(i) + i_surv_omst(i) End If End Sub
'-- Defined benefit occupational pensions
Public Function f_Occupational_DB_pension_benefits(i As Long, Sector As Byte, pensmonth As Integer) Dim op_ap_db As Long Dim cv_rate As Double cv_rate = -0.03 ' cv_rate = -0.03 gives results that are close to tables supplied by Dan-Evert Eriksson ' interest rate for calculating capital values, i.e., present values (PV), and alike. ' PV = \sum_{t=1}^T (1+r)^{-t}B_t = \sum_{t=1}^T (1+r)^{-t}(1+d)^{t}B_0 ' = \sum_{t=1}^T [(1+d)/(1+r)]^{t}B_0 = \sum_{t=1}^T [1+(d-r)/(1+r)]^{t}B_0 ' = \sum_{t=1}^T [1+cv_rate]^{-t}B_0 ' where cv_rate = (r-d)/(1+d) and d is the growth rate of pension benefits (indexed) ' and r is the long interest rate. If cv_rate = 0 we assume that these are identical. ' cv_rate > 0 => interest rate is higher than growth rate of benefits. ' cv_rate < 0 => interest rate is lower than growth rate of benefits Select Case Sector Case 1 '-- Blue collar '-- Defined benefit part STP (Transitional rule) If i_status1(i) <> 2 Then '-- New pensioner If i_born_year(i) >= 1932 And i_born_year(i) < 1968 Then op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 10, 10, 10, mini(1, (f_pp_years(i, 1995) / 37))) Else op_ap_db = 0 End If Else '-- Retired last year: Indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If Case 2 '-- White collar ' OLD VERSION WITHOUT EARLY WITHDRAWAL OF OCCUPATIONAL PENSION ' If i_status1(i) <> 2Then '-- New pensioner ' op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ ' 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30)) ' ' Else '-- Retired last year: Indexation ' op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) ' End If ' ' BABY_BOOM VERSION WITH HIGHER REPLACEMENT RATIOS FOR EARLY WITHDRAWAL: ' In this version the individual recieves a replacement ratio of 65 percent of average ' past income upto his/hers 65 birthday. At this point the replacement ratio ' is reduced to the standard 10 percent (up to 7.5 basic amounts). Hence, we need ' to calculate the levels at two points in time. First, when the individual retires ' and second, when the individual turns 65 years old. For other ages, the benefits ' are calculated using indexation. (ME 2004-10-04) ' If individual retires before age 65, we store the average income for the past 5 years. ' This value is then re-used as we re-calculate the pension benefits from age 65. If i_status1(i) <> 2 And i_age(i) > 60 And i_age(i) < 65 Then '-- New pensioner younger than 65 i_avg_inc_at_retirement(i) = f_avg_income(i) ' we need this to re-calculate benefits after 65 If i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019) op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 80, 70, 40, mini(1, i_op_pp_years(i) / 30), i_age(i), 0#, 0#) ElseIf i_op_erp(i) = 0 Then op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 65, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i), 0.005, 0.006) End If ElseIf i_status1(i) <> 2 And i_age(i) > 64 Then ' new pensioneer older than 64 op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i), 0.005, 0.006) ElseIf i_status1(i) = 2 And i_age(i) = 65 Then ' previously retired individual turns 65, re-calculate benefits If i_op_erp(i) = 0 Then op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0.005, 0.006) ElseIf i_op_erp(i) = 1 Then ' No actuarial adjustment for early withdrawal if there is an early retirement program (ME 051019) op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0#, 0.006) End If Else '-- Retired last year: Indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If Case 3 '-- State '-- Part-time pension agreement from age 61 to 65 If i_status1(i) <> 2 And i_age(i) > 60 And i_age(i) < 65 And i_work_share(i) > 0 Then op_ap_db = f_avg_income(i) * 0.6 * (1 - i_work_share(i)) Else '-- Normal occup pens '-- Defined benefit part If (i_status1(i) <> 2) Or _ (i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner ' Select Case year ' Case Is > 2002 '-- PA03 ' According to transition rules in PA03 (p. 47 "Övergångsbestämmelser"), PA03 applies to individuals ' born after 1942. For individuals born before 1943, PA91 applies. Hence, PA91 is still in effect for ' individuals born in 1942 until 2007 (=1942+65). In previous version of SESIM, this is handled by the f_op_pa03 ' procedure where replacement ratios for individuals born before 1942 is in line with replacement ratios in PA91. ' However, these replacement ratios does not handle the case of higher repl. ratios if retiring before age 65. ' Hence, in this new version we use the actual PA91 rules for individuals born before 1943. If year > 2002 And i_born_year(i) > 1942 Then If i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019) op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 80, 70, 40, mini(1, i_op_pp_years(i) / 30), 65, 0, 0) ElseIf i_op_erp(i) = 0 Then op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ f_op_pa03(i_born_year(i), 1), _ f_op_pa03(i_born_year(i), 2), _ f_op_pa03(i_born_year(i), 3), mini(1, i_op_pp_years(i) / 30)) ' Calculate annual benefits if using temporary pension according to §21 PA03 If 60 < i_age(i) And i_age(i) < 65 Then ' Capital value of future stream of benefits when retiring at age 65 Dim op_cv_db As Long ' PV(rate,Nper,Pmt) such that PV = sum_{t=1}^Nper [1/(1+rate)]^t Pmt ' Pmt < 0 cash-out, Pmt>0 cash-in. See help for Pmt-function. op_cv_db = PV(cv_rate, explife(65), -op_ap_db) ' Calculate maximum annuity allowed according to tax legislation §21 PA03 Dim lim As Long If i_inc_taxable1(i) < 7.5 * m_basbelopp Then lim = 0.8 * i_inc_taxable1(i) ElseIf i_inc_taxable1(i) < 20 * m_basbelopp Then lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (i_inc_taxable1(i) - 7.5 * m_basbelopp) ElseIf i_inc_taxable1(i) < 30 * m_basbelopp Then lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (20 - 7.5) * m_basbelopp + 0.4 * (i_inc_taxable1(i) - 20 * m_basbelopp) Else lim = (0.8 * 7.5 + 0.7 * (20 - 7.5) + 0.4 * (30 - 20)) * m_basbelopp End If ' Calculate annuities (pmt) before 65 limited by lim Dim op_an_db_before_65 As Long, xpmt As Long xpmt = Pmt(cv_rate, 65 - i_age(i), -op_cv_db) op_an_db_before_65 = mini(lim, xpmt) ' Calculate annuities after 65 as a payments from remainder of the capital value Dim op_cv_remainder_at_65 As Long, op_an_db_after_65 As Long op_cv_remainder_at_65 = op_cv_db - PV(cv_rate, 65 - i_age(i), -op_an_db_before_65) op_an_db_after_65 = maxi(0, Pmt(cv_rate, explife(65), -op_cv_remainder_at_65)) i_op_an_db_before_65(i) = op_an_db_before_65 i_op_an_db_after_65(i) = op_an_db_after_65 i_using_temp_pension(i) = 1 ' Flags the use of temporary pension op_ap_db = op_an_db_before_65 End If End If Else ' Case Else '-- PA-91 ' In PA-91 the individuals are allowed to withdraw benefits from age 60. ' If so, the benefit ratios are given in §17 PA91 uptil age 65, and in §16 PA91 ' thereafter. If 60 < i_age(i) And i_age(i) < 65 Then 'Early withdrawal, higher repl. ratios i_avg_inc_at_retirement(i) = f_avg_income(i) If i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019) op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 80, 70, 40, mini(1, i_op_pp_years(i) / 30), i_age(i), 0, 0) ElseIf i_op_erp(i) = 0 Then op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 65, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i), 0.004, 0.004) ' We also need to add a small amount stemming from the fact that the ' replacement ratio is 101% for 0-1 BA rather then 65% as assumed above. ' pensmonth is negative for early withdrawal op_ap_db = op_ap_db + (1.01 - 0.65) * mini(f_avg_income(i), m_basbelopp) * _ (1 + pensmonth * 0.004) End If Else op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), maxi(i_age(i), 65), 0.004, 0.004) End If ' End Select End If Else '-- Retired last year If i_work_share(i) > 0 Then '-- Correction for changed work-time op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i)) End If '-- Indexation If i_age(i) = 65 Then 'we need to recalculate benefits if previously retired and aged 65 If i_using_temp_pension(i) = 1 Then ' use annuities after 65 for temporary pensions op_ap_db = i_op_an_db_after_65(i) Else ' QUESTION: Shouldn't we inflate i_avg_inc_at_retirement(i) to the price level of the ' year in which the individual turns 65? Otherwise the average income will be in the ' price level of the year the individual first retired. (ME 041015) If i_op_erp(i) = 1 Then ' No actuarial adjustement for early withdrawal with early retirement program (ME 051019) op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0#, 0#) ElseIf i_op_erp(i) = 0 Then op_ap_db = f_op_db_comp(i_avg_inc_at_retirement(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30), i_age(i) + pensmonth / 12, 0.004, 0.004) End If End If Else '-- standard indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) ' we also need to index the annuities paid out after age 65. i_op_an_db_after_65(i) = i_op_an_db_after_65(i) * f_pens_index("OP", 65) ' ' we also update the "average income at retirement" ' i_avg_inc_at_retirement(i) = i_avg_inc_at_retirement(i) * f_pens_index("OP", 65) End If End If End If Case 4 '-- Local government '-- Defined benefit part If (i_status1(i) <> 2) Then '-- New pensioner i_avg_inc_at_retirement(i) = f_avg_income(i) ' we need this to re-calculate benefits after 65 If i_age(i) < 65 And i_op_erp(i) = 1 Then ' Benefits if early retirement program offer (ME 051019) op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 80, 70, 40, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0#, 0#) Else ' No early retirement program op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 0, 62.5, 31.25, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0.004, 0.004) '-- Simplified transitional rule PA-KL ' Note: Extra 10% compens level below social insur ceiling ' corrected for actual work experience 1997 If i_born_year(i) < 1969 And i_born_year(i) > 1933 Then If i_op_erp(i) = 0 Then op_ap_db = op_ap_db + _ f_op_db_comp(i_avg_income_1997(i) * m_basbelopp / 100, _ f_pens_bas("OP"), 10, 0, 0, _ mini(1, f_pp_years(i, 1997) / 30), f_ap_pensage(pensmonth), 0.004, 0.001) End If End If End If '-- Correction for work-time op_ap_db = op_ap_db * (1 - i_work_share(i)) Else '-- Retired last year If i_work_share(i) > 0 Then '-- Correction for changed work-time op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i)) End If '-- Indexation If i_op_erp(i) = 1 And i_age(i) = 65 Then ' We need to recalculate pension benefits when ERP turns 65, no actuarial adjustment op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 0, 62.5, 31.25, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0#, 0#) '-- Simplified transitional rule PA-KL ' Note: Extra 10% compens level below social insur ceiling ' corrected for actual work experience 1997 If i_born_year(i) < 1969 And i_born_year(i) > 1933 Then If i_op_erp(i) = 0 Then op_ap_db = op_ap_db + _ f_op_db_comp(i_avg_income_1997(i) * m_basbelopp / 100, _ f_pens_bas("OP"), 10, 0, 0, _ mini(1, f_pp_years(i, 1997) / 30), f_ap_pensage(pensmonth), 0#, 0#) End If End If Else ' Standard indexation when no ERP op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If End If Case Else '-- Other If i_status1(i) <> 2 Then '-- New pensioner op_ap_db = 0 Else '-- Indexation (individuals with occup pens in start data op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If End Select f_Occupational_DB_pension_benefits = op_ap_db End Function
'********************************************************************** ' Function for calculation of occupational pensions Tjänstepensioner '**********************************************************************
Public Function f_Occupational_pension_benefits(i As Long) '! Calculation of occupational pension Tjänstepensioner Dim m_op_rate As Double '-- Return on pension fund during pay out period Dim pensmonth As Integer, n_pens_years As Integer, payout_time As Integer Dim op As Long, op_ap_db As Long, op_ap_dc As Long, op_ap_tp As Long Dim pb_op_ap As Long, pb_op_tp As Long year = model_time + base_year Dim cv_rate As Double cv_rate = -0.03 ' see comments in f_Occupational_DB_pension_benefits() above m_op_rate = m_interest_long '-- Standard assumption payout_time = 5 '-- Payout time for supplemental benefits If i_status(i) = 2 Then pensmonth = i_ap_pensmonth(i) If i_work_share(i) > 0 Then '-- If part-time retired no pension years counted n_pens_years = 0 Else n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth) End If Else pensmonth = (i_age(i) - 65) * 12 n_pens_years = 0 End If '-- Defined benefit occupational pensions op_ap_db = f_Occupational_DB_pension_benefits(i, i_sector(i), pensmonth) '-- Defined contribution occupational pensions Select Case i_sector(i) Case 1 '-- Blue collar '-- Defined contribution part If i_status1(i) <> 2 Then '-- New pensioner op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector Else '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) op_ap_tp = i_op_ap_tp(i) End If Case 2 '-- White collar '-- Defined contribution part If i_status1(i) <> 2 Then '-- New pensioner may have rights from earlier sector op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) Else '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) End If '-- Defined contribution suppl part: ITPK payed out in payout_time years If n_pens_years < payout_time And i_pb_op_tp(i) > 0 Then op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i)) pb_op_tp = i_pb_op_tp(i) - _ PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0) Else op_ap_tp = 0 pb_op_tp = 0 End If Case 3 '-- State '-- Defined contribution part PA03 If (i_status1(i) <> 2) Or (i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) If i_age(i) > 60 And i_age(i) < 65 And year > 2002 Then ' Calculate temporary pension annuities according to §12 PA03 ' Capital value calculated as if individual retires at age 65 ' Hence, we need to add employers contributions upto age 65. We assume that ' contributions are based on last years taxable income (max 30 BA). ' The contributions are defined in §9 PA03. ' We assume that real wage rates are constant (hence rate=0 in PV below) Dim op_cv_dc As Long, contr_to_65 As Long contr_to_65 = PV(0, 65 - i_age(i), -0.023 * mini(i_inc_taxable1(i), 30 * m_basbelopp)) op_cv_dc = i_pb_op_ap(i) + contr_to_65 ' Calculate maximum annuity allowed according to tax ' legislation (and §12 PA03) Dim lim As Long If i_inc_taxable(i) < 7.5 * m_basbelopp Then lim = 0.8 * i_inc_taxable1(i) ElseIf i_inc_taxable1(i) < 20 * m_basbelopp Then lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (i_inc_taxable1(i) - 7.5 * m_basbelopp) ElseIf i_inc_taxable1(i) < 30 * m_basbelopp Then lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (20 - 7.5) * m_basbelopp + 0.4 * (i_inc_taxable1(i) - 20 * m_basbelopp) Else lim = (0.8 * 7.5 + 0.7 * (20 - 7.5) + 0.4 * (30 - 20)) * m_basbelopp End If ' The sum of annuities from DB and DC are limited by §12 PA03 Dim op_an_dc_before_65 As Long op_an_dc_before_65 = Pmt(cv_rate, 65 - i_age(i), -op_cv_dc) op_an_dc_before_65 = mini(lim - i_op_an_db_before_65(i), op_an_dc_before_65) ' Calculate annuities after 65 as a payment from remainder of capital values Dim op_cv_remainder_at_65 As Long, op_an_dc_after_65 As Long op_cv_remainder_at_65 = op_cv_dc - PV(cv_rate, 65 - i_age(i), -op_an_dc_before_65) op_an_dc_after_65 = Pmt(m_interest_long / 100, explife(65), -op_cv_remainder_at_65) i_op_an_dc_before_65(i) = op_an_dc_before_65 i_op_an_dc_after_65(i) = op_an_dc_after_65 i_using_temp_pension(i) = 1 ' Flags the use of temporary pension op_ap_dc = op_an_dc_before_65 End If Else '-- DC payed out as an life-long annuity without indexation ' However, if paid out as temporary pensions, then they should be indexed according to ' Dan-Evert Eriksson at SPV (ME 041025) If i_age(i) = 65 And i_using_temp_pension(i) = 1 Then op_ap_dc = i_op_an_dc_after_65(i) Else op_ap_dc = i_op_ap_dc(i) End If ' We also need to index annuities paid out after 65 i_op_an_dc_after_65(i) = i_op_an_dc_after_65(i) * f_pens_index("OP", 65) End If '-- Supplemental defined contribution part, extra KÅPAN, payed out in payout_time years If n_pens_years < payout_time And i_pb_op_tp(i) > 0 And i_work_share(i) = 0 Then op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i)) pb_op_tp = i_pb_op_tp(i) - _ PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0) Else op_ap_tp = 0 pb_op_tp = 0 End If Case 4 '-- Local government '-- Defined contribution part: Yearly recalculation if part-time retired If i_work_share1(i) > 0 Or i_status1(i) <> 2 Then '-- Part-time or new op_ap_dc = (i_pb_op_ap(i) / dtalpp(i_age(i))) * (1 - i_work_share(i)) ' In PFA-98 the individual is allowed for temporary pension for the defined ' contribution part. This is calculated as for the state sector. If i_age(i) > 60 And i_age(i) < 65 Then ' Calculate temporary pension annuities according to §12 PFA-98 mom. 4 ' We ignore the fact that only the part below 7.5BA is contributing to the ' temporary pension. ' Capital value calculated as if individual retires at age 65 ' Hence, we need to add the employer's contributions upto age 65. We assume that ' contributions are based on last years taxable income (max 7.5BA). ' The contributions are defined in §8 PFA-98. ' We assume that real wage rates are constant (hence rate=0 in PV below) ' Dim op_cv_dc As Long, contr_to_65 As Long contr_to_65 = PV(0, 65 - i_age(i), -0.034 * mini(i_inc_taxable1(i), 7.5 * m_basbelopp)) op_cv_dc = i_pb_op_ap(i) + contr_to_65 ' Calculate maximum annuity allowed according to tax ' legislation (and §12 PFA-98, see also §12 PA03) ' Dim lim As Long If i_inc_taxable(i) < 7.5 * m_basbelopp Then lim = 0.8 * i_inc_taxable1(i) ElseIf i_inc_taxable1(i) < 20 * m_basbelopp Then lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (i_inc_taxable1(i) - 7.5 * m_basbelopp) ElseIf i_inc_taxable1(i) < 30 * m_basbelopp Then lim = 0.8 * 7.5 * m_basbelopp + 0.7 * (20 - 7.5) * m_basbelopp + 0.4 * (i_inc_taxable1(i) - 20 * m_basbelopp) Else lim = (0.8 * 7.5 + 0.7 * (20 - 7.5) + 0.4 * (30 - 20)) * m_basbelopp End If ' The sum of annuities from DB and DC are limited by §12 PFA-98 mom. 6 ' Dim op_an_dc_before_65 As Long op_an_dc_before_65 = Pmt(cv_rate, 65 - i_age(i), -op_cv_dc) op_an_dc_before_65 = mini(lim - i_op_an_db_before_65(i), op_an_dc_before_65) ' Calculate annuities after 65 as a payment from remainder of capital values ' Dim op_cv_remainder_at_65 As Long, op_an_dc_after_65 As Long op_cv_remainder_at_65 = op_cv_dc - PV(cv_rate, 65 - i_age(i), -op_an_dc_before_65) op_an_dc_after_65 = Pmt(m_interest_long / 100, explife(65), -op_cv_remainder_at_65) i_op_an_dc_before_65(i) = op_an_dc_before_65 i_op_an_dc_after_65(i) = op_an_dc_after_65 i_using_temp_pension(i) = 1 ' Flags the use of temporary pension op_ap_dc = op_an_dc_before_65 End If Else '-- DC payed out as an life-long annuity without indexation from last work year If i_age(i) = 65 And i_using_temp_pension(i) = 1 Then op_ap_dc = i_op_an_dc_after_65(i) Else op_ap_dc = i_op_ap_dc(i) End If ' We also need to index annuities paid out after 65 i_op_an_dc_after_65(i) = i_op_an_dc_after_65(i) * f_pens_index("OP", 65) End If '-- Supplemental defined contribution part If i_status1(i) <> 2 And i_work_share1(i) = 0 Then '-- New full-time pensioner op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector Else '-- DC payed out as an life-long annuity without indexation op_ap_tp = i_op_ap_tp(i) End If Case Else '-- Other '-- Defined contribution part If i_status1(i) <> 2 Then '-- New pensioner op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) Else '-- Indexation (individuals with occup pens in start data '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) op_ap_tp = i_op_ap_tp(i) End If End Select '-- Summing up Dim opx As Long op = op_ap_db + op_ap_dc + op_ap_tp opx = op '-- Updating global variables if retired ' Updating accum pens rights i_pb_op_ap in Calc_Occup_Pens_Rights() If i_status(i) = 2 Then i_op_ap_db(i) = op_ap_db i_op_ap_dc(i) = op_ap_dc i_op_ap_tp(i) = op_ap_tp i_op(i) = op i_pb_op_tp(i) = pb_op_tp End If ' If i_sector(i) = 3 Then ' Dim f1 As Integer 'writing to disc, see also init... ' f1 = FreeFile ' Open "C:\sesim\microdata\op.txt" For Append As #f1 ' Write #f1, year, i_indnr(i), i_age(i), i_ap_pensmonth(i), i_sector(i), _ ' i_inc_taxable1(i) / 12, i_using_temp_pension(i), op_ap_db / 12, op_ap_dc / 12, op_ap_tp / 12, _ ' (op_ap_db + op_ap_dc + op_ap_tp) / 12 ' Close #f1 ' End If 'AW testar 'f_Occupational_pension_benefits = op f_Occupational_pension_benefits = i_op(i) End Function
' Used for calculation of occupational pensions benefits in defined benefit systems ' Note: Not indepent function. Uses index as input ' Eg borde man definiera inkomsterna noggrannare. Kräver dock även laggade status.
Public Function f_avg_income(idxnr As Long) As Long '!-- Calculation of fixed price average income for the last five years f_avg_income = (i_inc_taxable1(idxnr) / m_basbelopp1 + _ i_inc_taxable2(idxnr) / m_basbelopp2 + _ i_inc_taxable3(idxnr) / m_basbelopp3 + _ i_inc_taxable4(idxnr) / m_basbelopp4 + _ i_inc_taxable5(idxnr) / m_basbelopp5) * m_basbelopp1 / 5 End Function
'*** Occupational pension: Calculation of compensation level in defined benefit systems ' Input: ' income = qualifying wage = pensionsmedförande lön ' basb = basic amount = basbelopp för beräkning av skiktgränser ' comp_tak = compensation level below social insurance limit ' comp_tak_20 = compensation level between social insurance limit and 20 basic amounts ' comp_20_30 = compensation level between 10 and 30 basic amounts ' NOTE: COMPENSATION LEVEL IN PERCENT EG 10, 30 ETC ' time = time in service = tjänstetidsfaktor ' early = monthly down correction if early pension. Optional, default=005% per month ' early=-999 means actuarial calculation ' late = monthly up correction if late pension. Optional, default=007% per month ' -----------------------------------------------------------------------------------
Public Function f_op_db_comp(income As Long, basb As Long, comp_tak As Double, _ comp_tak_20 As Double, comp_20_30 As Double, Optional time_factor As Double = 1, _ Optional pensage As Byte = 65, Optional Early As Double = 0.005, _ Optional Late As Double = 0.007) As Long '!-- Occupational pensions: General procedure for Calculation of compensation levels in defined benefit systems '-- Scaling of comp level comp_tak = comp_tak / 100 comp_tak_20 = comp_tak_20 / 100 comp_20_30 = comp_20_30 / 100 Select Case income Case Is <= 7.5 * basb f_op_db_comp = income * comp_tak Case Is <= 20 * basb f_op_db_comp = (7.5 * basb * comp_tak) + _ (income - 7.5 * basb) * comp_tak_20 Case Is <= 30 * basb f_op_db_comp = (7.5 * basb * comp_tak) + _ ((20 - 7.5) * basb) * comp_tak_20 + _ (income - 20 * basb) * comp_20_30 Case Is > 30 * basb f_op_db_comp = (7.5 * basb * comp_tak) + _ ((20 - 7.5) * basb) * comp_tak_20 + _ ((30 - 20) * basb) * comp_20_30 Case Else f_op_db_comp = 0 End Select '-- Correction for empoyment time and early or late withdrawal f_op_db_comp = f_op_db_comp * time_factor * f_fu_kvot(pensage, Early, Late) End Function
'**** Occupational pension, State employed PA03 ' Calculates compensations levels, transitional rules ' Input: Year = born year YYYY ' Intervall = income intervall ' 1 = income <7,5 basbelopp ' 2 = 7,5 basbelopp < income < 20 basbelopp ' 3 = 20 basbelopp < income < 30 basbelopp ' -----------------------------
Public Function f_op_pa03(year As Integer, intervall As Byte) As Double 'Occupational pension: Transitional rules PA03 Dim pa03(31, 3) As Double pa03(1, 1) = 9.5: pa03(1, 2) = 64.85: pa03(1, 3) = 32.4 pa03(2, 1) = 9.3: pa03(2, 2) = 64.7: pa03(2, 3) = 32.3 pa03(3, 1) = 9.1: pa03(3, 2) = 64.55: pa03(3, 3) = 32.2 pa03(4, 1) = 8.9: pa03(4, 2) = 64.4: pa03(4, 3) = 32.1 pa03(5, 1) = 8.7: pa03(5, 2) = 64.25: pa03(5, 3) = 32# pa03(6, 1) = 8.4: pa03(6, 2) = 64.1: pa03(6, 3) = 31.9 pa03(7, 1) = 8.2: pa03(7, 2) = 63.95: pa03(7, 3) = 31.8 pa03(8, 1) = 7.9: pa03(8, 2) = 63.8: pa03(8, 3) = 31.7 pa03(9, 1) = 7.7: pa03(9, 2) = 63.65: pa03(9, 3) = 31.6 pa03(10, 1) = 7.4: pa03(10, 2) = 63.5: pa03(10, 3) = 31.5 pa03(11, 1) = 7.2: pa03(11, 2) = 63.35: pa03(11, 3) = 31.4 pa03(12, 1) = 6.9: pa03(12, 2) = 63.2: pa03(12, 3) = 31.3 pa03(13, 1) = 6.6: pa03(13, 2) = 63.05: pa03(13, 3) = 31.2 pa03(14, 1) = 6.3: pa03(14, 2) = 62.9: pa03(14, 3) = 31.1 pa03(15, 1) = 6: pa03(15, 2) = 62.75: pa03(15, 3) = 31# pa03(16, 1) = 5.7: pa03(16, 2) = 62.6: pa03(16, 3) = 30.9 pa03(17, 1) = 5.4: pa03(17, 2) = 62.45: pa03(17, 3) = 30.8 pa03(18, 1) = 5.1: pa03(18, 2) = 62.3: pa03(18, 3) = 30.7 pa03(19, 1) = 4.7: pa03(19, 2) = 62.15: pa03(19, 3) = 30.6 pa03(20, 1) = 4.3: pa03(20, 2) = 62#: pa03(20, 3) = 30.5 pa03(21, 1) = 3.9: pa03(21, 2) = 61.85: pa03(21, 3) = 30.4 pa03(22, 1) = 3.6: pa03(22, 2) = 61.7: pa03(22, 3) = 30.3 pa03(23, 1) = 3.2: pa03(23, 2) = 61.5: pa03(23, 3) = 30.2 pa03(24, 1) = 2.9: pa03(24, 2) = 61.3: pa03(24, 3) = 30.1 pa03(25, 1) = 2.5: pa03(25, 2) = 61.1: pa03(25, 3) = 30# pa03(26, 1) = 2.1: pa03(26, 2) = 60.9: pa03(26, 3) = 30# pa03(27, 1) = 1.7: pa03(27, 2) = 60.7: pa03(27, 3) = 30# pa03(28, 1) = 1.3: pa03(28, 2) = 60.5: pa03(28, 3) = 30# pa03(29, 1) = 0.9: pa03(29, 2) = 60.3: pa03(29, 3) = 30# pa03(30, 1) = 0.5: pa03(30, 2) = 60.1: pa03(30, 3) = 30# pa03(31, 1) = 0: pa03(31, 2) = 60#: pa03(31, 3) = 30# If year <= 1942 Then Select Case intervall Case 1 f_op_pa03 = 10 Case 2 f_op_pa03 = 65 Case 3 f_op_pa03 = 32.5 Case Else f_op_pa03 = 0 End Select ElseIf year > 1942 And year < 1973 Then f_op_pa03 = pa03(year - 1942, intervall) ElseIf year > 1972 Then Select Case intervall Case 1 f_op_pa03 = 0 Case 2 f_op_pa03 = 60 Case 3 f_op_pa03 = 30 Case Else f_op_pa03 = 0 End Select Else f_op_pa03 = 0 End If End Function
' -- Function returns pontential or paid out sum of public pensions depending on status. ' If individual retired the function also updates public pension variables '-- Antar normalt att alla går i pension 1/1. Vidare antas alla som dör göra det den 1/1. Approximativt ' innebär detta att folk i genomsnitt får pension 1/2 år för tidigt, men å andra sidan förlorar ' 1/2 år i slutet av livet. För IP & TP beräknas även utgiftsmässiga belopp (suffix _ut)
Public Function f_Public_Pension_Benefits(i As Long) As Long '!-- Calculation of old age public pension benefits ' BABYBOOM VERSION: (ME 2004-10-29) ' We assume that individuals do not withdraw public pensions until 65 years old. ' This assumption is motivated by observed data. ' As an individual could be flagged as a pensioneer last year without having withdrawn ' public pension benefits, we need to modify the concept of "retired last year". ' We consider an individual "non-retired" last year (i_status1(i)<>2) if ' public pension benefits are zero last year. If i_age(i) < 65 And i_sector(i) <> 1 Then ' Blue collars are allowed to withdraw public pension before 65 (ME 2005-12-02) f_Public_Pension_Benefits = 0 Else Dim status1 As Integer, ap_pensmonth As Integer status1 = i_status1(i) ' These are used to restore the lagged status at the end of this else-statment ap_pensmonth = i_ap_pensmonth(i) ' There is something strange with i=267. This person is 82 years old in 2000 and has no public pensions pay-outs! If i_ap(i) = 0 And i_age(i) <= 70 Then ' There was no public pension pay-outs last year, hence the individual ' is considered as a "new pensioneer" i_ap_pensmonth(i) = maxi(0, (i_age(i) - 65) * 12) ' pensmonth is either 0 (at 65) or positive if i_age>65 i_status1(i) = 0 ' This variable is reset before we exit this procedure End If Dim bokvot As Double ' Bosättningstidskvot Dim ap_fp_kvot As Double Dim ap_fp_kvot1 As Double Dim ap_berund As Long 'Beräkningsunderlag för garantipension 'Dim ap_atp_1994, ap_fp30_1994 As Double '-- Dim as local variables. If retired also global variables calculated Dim ap_atp As Long, ap_atp_old As Long, ap_pts As Long, ap_fp As Long Dim ap_fp30 As Long, ap_tp As Long, ap_gp As Long, ap_ip As Long, ap_fiktiv As Long Dim ap_pp As Long, ap_fp30_1994 As Long, ap_atp_1994 As Long, ap_gartill As Long Dim ap As Long, ap_ap As Long, pensmonth As Integer, ap_ip_ut As Long Dim PB_IP As Long, pb_pp As Long, pb_fiktiv As Long Dim ap_atp_ut As Long, ap_fp30_ut As Long, ap_tp_ut As Long, ap_pp_ut As Long year = model_time + base_year If i_status(i) = 2 Then pensmonth = i_ap_pensmonth(i) Else pensmonth = (i_age(i) - 65) * 12 End If ' -- Diverse kvoter 'deltid= 1 '-- Parameter för uttagsandel **** Skall implementeras senare. Tv. endast heltidspension bokvot = mini(1, maxi(i_botid(i) / 40, pp_hist(i).n_years / f_krav_atp_ar(i_born_year(i)))) ' -- Ersättningsnivå för folkpen etc beroende på civilstånd ap_fp_kvot = f_ap_fp_kvot(i_civ_stat(i)) 'Basic pension ratio depends on civil status ap_fp_kvot1 = f_ap_fp_kvot(i_civ_stat1(i)) ' -"- last year '! -- Old system Gamla systemet '! -- ATP - National supplementary pension Allmän tilläggspension ' We assume that the individuals do not withdraw public pensions before age 65. If i_status1(i) <> 2 Then '-- New pensioner If i_age(i) >= 61 And pp_hist(i).n_years >= 3 Then ap_atp = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _ (pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ (1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) ' Korrigering för halvårseffekt av utfasningen. ' Also adjusted for deceased persons in a02, new_economy2 ap_atp_ut = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _ (pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ ((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _ + (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2 ap_atp_old = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _ (pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) Else ap_atp = 0 ap_atp_ut = 0 ap_atp_old = 0 End If Else ' -- Retired last year ap_atp = i_ap_atp(i) * f_pens_index("ATP", i_age(i)) If ap_atp < 0 Then i = i End If ap_atp_ut = i_ap_atp_ut(i) * f_pens_index("ATP", i_age(i)) ap_atp_old = i_ap_atp_old(i) * (m_basbelopp / m_basbelopp1) End If '! -- Basic pension & pension supplement Folkpension & PTS If i_age(i) > 61 And i_botid(i) >= 3 Then ' *** Behövs vid beräkn Ö-garpAnd year < 2003 Then ap_fp = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * ap_fp_kvot * m_basbelopp '**** PTS-kvot 0,555 för 990601 ap_pts = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * _ maxi((0.569 * m_basbelopp) - (ap_atp + i_surv(i)), 0) Else ap_fp = 0 ap_pts = 0 End If '! -- Reformed system Reformerat system ' Balance indexing of suppl pens for transition generation (LIP 6 kap, § 8a) If year > 2003 And (i_born_year(i) >= 1938 And i_born_year(i) <= 1953) And i_age(i) = 65 Then i_ap_atp(i) = i_ap_atp(i) * m_ap_balanstal_accum End If '! -- FP30 - Old part Reformed basic pension If i_age(i) >= 61 And pp_hist(i).n_years >= 3 And year >= 2001 Then If i_status1(i) <> 2 Or (year = 2001 And i_status(i) = 2) Then ' -- Not retired last year If ap_atp > 0 Then '-- Only calculated for individuals with ATP ap_fp30 = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ ap_fp_kvot * m_basbelopp * (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth))) ap_fp30_ut = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ ap_fp_kvot * m_basbelopp * _ ((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _ + (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2 Else ap_fp30 = 0 ap_fp30_ut = 0 End If Else ' Retired last year - Indexation and correction for changed civil status ap_fp30 = i_ap_fp30(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation ap_fp30_ut = i_ap_fp30_ut(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation End If Else ap_fp30 = 0 ap_fp30_ut = 0 End If '! -- IP - Income pension Inkomstpension If i_age(i) >= 61 And year >= 2001 Then If (i_status1(i) <> 2) Then ' -- Not retired last year '-- Special rules for indexing the year of retirement: No indexation 'PB_IP = i_pb_ip(i) + i_pr_ip1(i) '-- Tidigare metod PB_IP = i_pb_ip(i) ap_ip = PB_IP / dtalip(i_age(i)) '-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt ' f att få rätt makro. Nya får endast halv IP utbetald 1:a året. ap_ip_ut = ap_ip * 0.5 Else ' -- Retired last year ap_ip = i_ap_ip(i) * f_pens_index("IP", i_age(i)) ' -- Indexation ap_ip_ut = ap_ip '-- ap_ip_ut later adjusted for deceased persons in a02 End If Else ap_ip = 0 End If '! -- Calculates fictious pension. Used in calc of reformed basic pension ' and ap_gartill. If i_age(i) >= 65 And year >= 2003 Then If (i_status1(i) <> 2 Or i_age(i) = 65) Then ' -- Not retired last year ' pb_fiktiv = i_pb_fiktiv(i) + i_pr_ip1(i) + i_pr_pp1(i) 'Tidigare metod pb_fiktiv = i_pb_fiktiv(i) ap_fiktiv = pb_fiktiv / dtalip(65) ' or 65 years Else ' -- Retired last year ap_fiktiv = i_ap_fiktiv(i) * f_pens_index("IP", i_age(i)) ' -- Indexation End If Else ap_fiktiv = 0 End If '! -- PP - PremiePension If i_status1(i) <> 2 Then ' New pensioner ' Man kan välja om pp skall utbetalas som en livränta eller kvarstå i fonder ' Man kan välja att ta ut pp från 61-79:11 års ålder, välja 25, 50, 75 ' eller 100%:s uttag. Det går att göra uppehåll i uttaget och ändra den andel som tas ut. ' Som standardantagande antas att alla väljer livränta, räknar som en annuitet, och ' 100% från 65 år för alla. ' Note: Discounting facor=1 + ((m_interest_long / 100) - m_favg_pp) in call to Calculate_Dtal '*** OBS: Delningstal beräknade på detta sätt låga jämfört med PPM:s *** 'pb_pp = i_pb_pp(i) + i_pr_pp1(i) 'Tidigare metod pb_pp = i_pb_pp(i) ap_pp = pb_pp / dtalpp(i_age(i)) '-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt ' f att få rätt makro. Nya får endast halv IP utbetald 1:a året. ap_pp_ut = ap_pp * 0.5 Else '-- Retired last year: Note - No indexation of PP, just an annuity ap_pp = i_ap_pp(i) ap_pp_ut = ap_pp '-- ap_pp_ut later adjusted for deceased persons in a02 End If '! -- Retirement pension, Reformed transitional supplement Garantitillägg ' Endast till mellagenerationen, ej vid uttag av enbart PP, tidigast from 65 år '**** Eg inget gartill vid uttag vid enbart PP If i_born_year(i) > 1937 And i_born_year(i) <= 1953 And i_age(i) >= 65 Then If i_age(i) = 65 Or i_status1(i) <> 2 Then '-- 65 years old OR newly retired ap_fp30_1994 = ap_fp_kvot * m_basbelopp * f_fu_kvot(f_ap_pensage(pensmonth)) _ * mini(1, (i_ATP_ar_1994(i) / 30)) ap_atp_1994 = 0.6 * (i_mATP_1994(i) / 100) * m_basbelopp * mini(1, _ (i_ATP_ar_1994(i) / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) Else ' -- Indexation and correction for changed civil status ap_fp30_1994 = i_ap_fp30_1994(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("IP", i_age(i)) ap_atp_1994 = i_ap_atp_1994(i) * f_pens_index("IP", i_age(i)) End If ap_gartill = maxi(0, ((ap_fp30_1994 + ap_atp_1994) - _ (ap_fiktiv + ap_fp30 + ap_atp))) Else ap_gartill = 0 End If '! -- GP - Reformed basic retirement pensions Garantipension ' If i_age(i) >= 61 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then 'AW Testar en reform If i_age(i) >= 65 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then Select Case i_born_year(i) Case Is > 1937 '!-- . Persons born 1938 and later Garantipension ap_tp = ap_fp30 + ap_atp + ap_gartill ap_gp = f_ap_garp_38_(i_civ_stat(i), f_pens_bas("GP"), _ ap_tp, ap_fiktiv, i_surv(i)) Case Is <= 1937 '! -- Transitional reformed basic retirement pension ' f.d. Övergångsvis garantipension ap_gp = f_ap_garp_37(i_civ_stat(i), f_pens_bas("GP"), _ ap_atp, ap_fp30, ap_fp, ap_pts, _ i_surv(i), i_op(i), i_botid(i)) End Select Else ap_gp = 0 End If '! -- Summing up different pension components If year < 2003 Then '-- Old system ap = ap_fp + ap_pts + ap_atp If ap_atp > 0 Then ap_ap = ap_fp + ap_atp Else ap_ap = 0 End If Else '-- Reformed system ap_tp = ap_fp30 + ap_atp + ap_gartill ' -- Supplemental pension Tilläggspension ap_tp_ut = ap_fp30_ut + ap_atp_ut + ap_gartill ap = ap_tp + ap_ip + ap_pp + ap_gp ' -- Total old age ap_ap = ap_tp_ut + ap_ip_ut End If If i_status(i) = 2 Then i_ap_atp(i) = ap_atp i_ap_atp_ut(i) = ap_atp_ut i_ap_atp_old(i) = ap_atp_old i_ap_pts(i) = ap_pts i_ap_fp(i) = ap_fp i_ap_fp30(i) = ap_fp30 i_ap_fp30_ut(i) = ap_fp30_ut i_ap_tp(i) = ap_tp i_ap_tp_ut(i) = ap_tp_ut i_ap_gp(i) = ap_gp i_ap_ip(i) = ap_ip i_ap_ip_ut(i) = ap_ip_ut i_ap_fiktiv(i) = ap_fiktiv i_ap_pp(i) = ap_pp i_ap_pp_ut(i) = ap_pp_ut i_ap_fp30_1994(i) = ap_fp30_1994 i_ap_atp_1994(i) = ap_atp_1994 i_ap_gartill(i) = ap_gartill i_ap_tp(i) = ap_tp i_ap(i) = ap i_ap_ap(i) = ap_ap If (i_status1(i) <> 2) Then i_pb_ip1(i) = i_pb_ip(i) i_pb_ip(i) = PB_IP i_pb_pp(i) = pb_pp i_pb_fiktiv(i) = pb_fiktiv End If End If f_Public_Pension_Benefits = i_ap(i) i_status1(i) = status1 ' Restore status i_ap_pensmonth(i) = ap_pensmonth ' Restore pensmonth End If ' age < 65 End Function
' -- Function returns sum of private pensions. ' If individual retired the function also updates private pension variables ' Note: i_wealth_pension_total not a part private wealth or the wealth tax base
Public Function f_Private_Pension_Benefits(i As Long, payout_time As Integer) As Long Dim pp As Long, wealth_pension_total As Long Dim pensmonth As Integer, pp_rate As Double, n_pens_years As Integer pp_rate = m_interest_long '-- Standard assumption If i_status(i) = 2 Then pensmonth = i_ap_pensmonth(i) n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth) Else pensmonth = (i_age(i) - 65) * 12 n_pens_years = 0 End If If i_age(i) >= 55 And payout_time <> 0 Then 'minimum 55 years age and savings '-- Assumed that pension captital payed out in payout_time years from pension time If payout_time < 0 Then '-- Lifelong annuity If i_status1(i) <> 2 Then '-- New private pensioner with annuity pp = Pmt((pp_rate * (1 - 0.15)) / 100, explife(i_age(i)), -i_wealth_pension_total(i)) 'pp = i_wealth_pension_total(i) / dtalpp(i_age(i)) Else pp = i_pp(i) End If wealth_pension_total = maxi(0, i_wealth_pension_total(i) + _ ((i_wealth_pension_total(i) - pp / 2) * ((pp_rate * (1 - 0.15)) / 100)) - pp) Else '-- Fixed pay out time If n_pens_years < payout_time Then pp = Pmt((pp_rate * (1 - 0.15)) / 100, payout_time - n_pens_years, -i_wealth_pension_total(i)) wealth_pension_total = i_wealth_pension_total(i) - _ PPmt((pp_rate * (1 - 0.15)) / 100, 1, payout_time - n_pens_years, -i_wealth_pension_total(i), 0) Else pp = 0 wealth_pension_total = 0 payout_time = 0 End If End If If i_status(i) = 2 Then i_pp(i) = pp i_wealth_pension_total(i) = wealth_pension_total i_wealth_pension_year(i) = 0 '*** Not simultanous saving and pay out i_pp_payout_time(i) = payout_time End If Else i_pp(i) = 0 End If f_Private_Pension_Benefits = i_pp(i) End Function
Sub Pension_debugging_files() '!-- Optional printing of pension debugging files (micro data) status "Printing pension debugging files" Dim utvar As String Dim demofile As Integer Dim i As Long year = model_time + base_year If model_time = 0 Then Open sesimpath & "\tempdata\valid_pens.txt" For Output As #11 utvar = f_Concat_string("i", "bidnr", "year", "i_age", "i_sex", "i_civ_stat", "i_abroad", _ "i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _ "i_ap_atp", "f_mean_ATP", "m_basbelopp", "i_botid", "ATP_years", _ "f_krav_atp_ar", "f_fu_kvot", "f_utfasning_ATP", "i_born_year ", "f_ap_pensyear", _ "i_ap_fp30", "i_ap_ip", "i_pb_ip", "dtal", _ "i_ap_fiktiv", "i_pb_fiktiv", _ "m_interest_short", "i_ap_pp", "explife", "i_pb_pp", "i_ap_gp", _ "i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", _ "i_pu", "i_pgi", "i_pgb", "i_pgb_barn", "i_pgb_plikt", _ "i_pgb_stud", "i_pgb_antag", "i_pb_op_ap", "i_pb_op_tp", "i_pbhi", "i_status1", _ "i_indnr", "i_ap", "i_p_andel", "i_ap_pensmonth", "i_pp", "i_pp_payout_time") Print #11, utvar Else Open sesimpath & "\tempdata\valid_pens.txt" For Append As #11 End If For i = 1 To m_icount If i_status(i) = 2 And i_status1(i) <> 2 Then '-- Only for new pensioners ' If i_status(i) = 2 And i_ap_gp(i) > 0 Then '-- Pensionärer med garantipension utvar = f_Concat_string(i, i_bidnr(i), year, i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), _ i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _ i_ap_atp(i), f_mean_ATP(i), m_basbelopp, i_botid(i), pp_hist(i).n_years, _ f_krav_atp_ar(i_born_year(i)), f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i))), _ f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i))), _ i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _ i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), dtalip(65), _ i_ap_fiktiv(i), i_pb_fiktiv(i), _ m_interest_short, i_ap_pp(i), explife(65), i_pb_pp(i), i_ap_gp(i), _ i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), _ i_pu(i), i_pgi(i), i_pgb(i), i_pgb_barn(i), i_pgb_plikt(i), _ i_pgb_stud(i), i_pgb_antag(i), i_pb_op_ap(i), i_pb_op_tp(i), i_pbhi(i), i_status1(i), _ i_indnr(i), i_ap(i), i_p_andel(i), i_ap_pensmonth(i), i_pp(i), i_pp_payout_time(i)) '***** m_interest_short, i_ap_pp(i), explife(i_age(i)), i_pb_pp(i), i_ap_gp(i), Print #11, utvar End If Next i Close #11 'If year <= 2020 Then If model_time = 0 Then Open sesimpath & "\tempdata\valid_pgi.txt" For Output As #12 utvar = f_Concat_string("year", "i", "bidnr", "i_status", "i_sector", "i_abroad", _ "m_interest_short", "m_interest_long", "m_ap_inkind", "m_ap_balind", "m_basbelopp", _ "i_age", "i_sex", "i_civ_stat", "i_inc_taxable", "i_born_year ", _ "i_pu", "i_pgi", "i_pgb", _ "i_pgb_barn", "i_pgb_plikt", "i_pgb_stud", "i_pgb_antag", _ "i_pb_ip", "i_pbhi", "i_pb_pp", "i_pb_fiktiv", "i_pb_op_ap", "i_pb_op_tp", _ "i_wealth_pension_total", "i_wealth_pension_year") Print #12, utvar Else Open sesimpath & "\tempdata\valid_pgi.txt" For Append As #12 End If For i = 1 To m_icount If i_born_year(i) >= 1938 And i_born_year(i) < 1984 Then ' If i_bidnr(i) <> 0 And _ ' i_born_year(i) >= 1938 And i_born_year(i) < 1984 And i_abroad(i) = 1 Then 'And Rnd < 0.05 Then ' var 20:e individ skrivs ut utvar = f_Concat_string(year, i, i_bidnr(i), i_status(i), i_sector(i), i_abroad(i), _ m_interest_short, m_interest_long, m_ap_inkind, m_ap_balind, m_basbelopp, _ i_age(i), i_sex(i), i_civ_stat(i), i_inc_taxable(i), i_born_year(i), _ i_pu(i), i_pgi(i), i_pgb(i), _ i_pgb_barn(i), i_pgb_plikt(i), i_pgb_stud(i), i_pgb_antag(i), _ i_pb_ip(i), i_pbhi(i), i_pb_pp(i), i_pb_fiktiv(i), i_pb_op_ap(i), i_pb_op_tp(i), _ i_wealth_pension_total(i), i_wealth_pension_year(i)) Print #12, utvar End If Next i 'End If Close #12 End Sub
Sub Pension_micro_file() '!-- Optional printing of pension micro file (micro data) status "Printing pension micro file" Dim utvar As String Dim demofile As Integer Dim i As Long year = model_time + base_year If model_time = 0 Then Open sesimpath & "\tempdata\pension_micro.txt" For Output As #13 utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_age", "i_sex", _ "i_civ_stat", "i_abroad", "i_status", "i_sector", _ "i_edlevel", "i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _ "i_ap_atp", "i_born_year ", "f_ap_pensyear", _ "i_ap_fp30", "i_ap_ip", "i_pb_ip", "i_ap_pp", "i_pb_pp", "i_ap_gp", _ "i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", "i_pu", "i_pgi", "i_pgb", _ "i_pb_op_ap", "i_pb_op_tp", _ "i_ap", "i_ap_tp", "i_p_andel", "i_pp", "i_pp_payout_time", _ "i_wealth_pension_total", "i_wealth_pension_year", "i_ap_tp") Print #13, utvar Else Open sesimpath & "\tempdata\pension_micro.txt" For Append As #13 End If For i = 1 To m_icount utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_age(i), i_sex(i), _ i_civ_stat(i), i_abroad(i), i_status(i), i_sector(i), _ i_edlevel(i), i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _ i_ap_atp(i), i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _ i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), i_ap_pp(i), i_pb_pp(i), i_ap_gp(i), _ i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), i_pu(i), i_pgi(i), i_pgb(i), _ i_pb_op_ap(i), i_pb_op_tp(i), _ i_ap(i), i_ap_tp(i), i_p_andel(i), i_pp(i), i_pp_payout_time(i), _ i_wealth_pension_total(i), i_wealth_pension_year(i), i_ap_tp(i)) Print #13, utvar Next i Close #13 End Sub
'********************************************************************** ' Calculation of pension rights for ' - the ATP pension system (tilläggspension, TP ' - the reformed pension system (inkomstpension, IP and premiepension, PP) '********************************************************************** '**** KVAR ATT GÖRA: '**** - TA EV BORT 16-ÅRS GRÄNSEN FÖR INTJÄNANDET.
Public Sub Calculate_Public_Pension_Rights() '!-- Calculation of pension rights ATP-system and new system PGI & PGB status "Calculate public pensions rights" Printdok " Calculate_Public_Pension_Rights" Dim i As Long Dim j As Long Dim tak As Double ' Social insurance limit (Intjänandetak) ' Dim atak As Double ' Social insurance limit plus employee contribution (Avgiftstak) Dim pgi_snitt As Double ' Average taxable income Dim pgb_barn1 As Long ' Pension rights f child years, alternative 1 Dim pgb_barn2 As Long ' Pension rights f child years, alternative 2 Dim pgb_barn3 As Long ' Pension rights f child years, alternative 3 Dim rand As Double ' Help variable for calc of random number Dim randvek() As Double Dim basb As Long ' Price basic amount or income basic amount Dim sum As Double Dim n As Long Dim pgi_bas As Long '-- Optional aligning OT regarding the career effect, see below Dim OTfix2 As Byte If get_scalefactor_active("OTfix2") = 1 Then OTfix2 = 1 Else OTfix2 = 0 End If sum = 0 n = 0 m_pgi = 0 m_pgb = 0 Dim year As Integer Dim maxyear As Integer year = model_time + base_year 'If year <= 2050 Then maxyear = year Else maxyear = 2050 'If year <= 2150 Then maxyear = year Else maxyear = 2150 If year <= 2110 Then maxyear = year Else maxyear = 2110 '-- Calculation of administration costs and fee on income pension funds m_pb_ip_active_n = cnt0(i_pb_ip) * m_weight m_pb_ip_active = L_SUMVEC(i_pb_ip(1), m_icount) * m_weight ' Förvaltningskostnad 0.075 Källa: Pensionsystemets årsredovisning 2001, sid 20 ' -- Costs of insurance administarion: A function of the number of active savers ' m_ap_admin_ip_ins_pers exognous for outcome years: Source Pension System annual report 'm_pensadmin_ip_ins_pers = (m_pensadmin_ip_ins / m_cnt_pb_ip_active) * m_inkind If f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension") <> 0 Then m_ap_adm_ip_ins_p = f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension") Else m_ap_adm_ip_ins_p = m_ap_adm_ip_ins_p * (m_ap_inkind / m_ap_inkind1) End If m_ap_adm_ip_ins = m_ap_adm_ip_ins_p * m_pb_ip_active_n '-- Note: t-1 value ' -- Costs of AP-fund administration: A function of the fund value ' m_ap_admin_ip_ap_p exognous for outcome years: Source Pension System annual report If f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension") <> 0 Then m_ap_adm_ip_ap_p = f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension") End If m_ap_adm_ip_ap = (m_ap_adm_ip_ap_p / 100) * m_ap_apfond '-- Note: t-1 value ' -- Total administration costs m_ap_adm_ip = m_ap_adm_ip_ins + m_ap_adm_ip_ap ' Administration fee as a part of pension liabilities to active savers m_ap_adm_ip_p = m_ap_adm_ip / m_pb_ip_active '-- Note: t-1 value ' -- Reduced administration fee on pension liabilities: ' Gradual transition from 62% to 100% fee on individual accounts until 2021 ' Infasing t 2021 för att de med behållningar i nya systemet ej ska subventionera gamla ATP ' (Lag 1998:674 5 kap 8§) Select Case year Case Is <= 2001 m_favg_ip = 0.6 * m_ap_adm_ip_p Case Is < 2022 m_favg_ip = (((year - 1999) * 0.02) + 0.56) * m_ap_adm_ip_p Case Else m_favg_ip = m_ap_adm_ip_p End Select '-- Basic amount and income limit Aktuellt basbelopp och intjänandetak If year < 2001 Then basb = m_basbelopp_f Else basb = m_basbelopp_income tak = 7.5 * basb '!-- Calculate pensionable income Beräknar pensionsgrundande inkomst PGI '!-- Helpvariables for calculation of pension income index and income basic amount j = 0 m_inc_taxable_snitt4 = m_inc_taxable_snitt3 m_inc_taxable_snitt3 = m_inc_taxable_snitt2 m_inc_taxable_snitt2 = m_inc_taxable_snitt1 m_inc_taxable_snitt1 = m_inc_taxable_snitt m_inc_taxable_snitt = 0 For i = 1 To m_icount pgi_bas = 0 If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI pgi_bas = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i) i_pgi_bas(i) = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i) If i_pgi_bas(i) < 0 Then i = i End If If (pgi_bas * (1 - m_egenavg_pens_p)) <= tak Then i_pgi(i) = round((pgi_bas * (1 - m_egenavg_pens_p)) - 50, -2) Else i_pgi(i) = round(tak - 50, -2) End If '-- For disab pensioners. Pension rights only based on qualifying points before 2003 If i_status(i) = 4 And year < 2003 Then i_pgi(i) = 0 End If ' -- Individual comparison pension base PU (Used in calculation of i_pgb_barn) If exist_child0_3(i_hhnr(i)) <> 1 Then i_pu_ind_comp(i) = i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) End If ' -- Cumulation of base for income index If pgi_bas > 0 Then j = j + 1 m_inc_taxable_snitt = m_inc_taxable_snitt + (pgi_bas * (1 - m_egenavg_pens_p)) End If Else i_pgi(i) = 0 End If Next i If j > 0 Then m_inc_taxable_snitt = (m_inc_taxable_snitt / j) / m_price_change99 Else m_inc_taxable_snitt = 0 Debug.Print "Calculate_public_pension_rights: ingen har nollskild PGI!" End If '-- Calculate average pensionable income Beräknar genomsnittlig PGI ' and averge income used for calculation of pension income index j = 0 pgi_snitt = 0 For i = 1 To m_icount If i_age(i) > 15 And i_age(i) < 65 And i_abroad(i) = 0 And i_pgi(i) > 0 Then j = j + 1 pgi_snitt = pgi_snitt + i_pgi(i) End If Next pgi_snitt = pgi_snitt / j '*** Draw vector of standard normal variates ReDim randvek(1 To m_icount) Call RANNOR(m_icount, randvek(1), model_time + base_year + random * Rnd) '!-- Pensionable amounts, pension rights Pensionsgrundande belopp och pensionsunderlag For i = 1 To m_icount If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI '! -- Pensionable amounts, military service ' Endast 20 åriga män antas göra värnplikt '0.45 = Andel som gör lumpen enligt Pliktverkets hemsida (avser 1999) 'För varje dag tjänstgöringenpågår pågår > 120 dagar. Beräknas som '50% av PGI för alla försäkrade < 65 år/365 * antalet dagar 'Vägt genomsnitt för olika utbildniugskategoriers (enl Pliktverket) 'tjänstgöringstider ger ca 250 dagar ' ***** OBS Info om antal finns i AKU. Kolla detta. ' ***** LF har skattat modell. Ev implementera denna If i_sex(i) = 1 And i_age(i) = 20 And Rnd < 0.45 Then i_pgb_plikt(i) = 0.5 * (pgi_snitt / 365) * 250 Else i_pgb_plikt(i) = 0 End If '! -- Pensionable amounts, studies 138% of study grants (Endast av bidragsbeloppet) If i_status(i) = 3 Then i_pgb_stud(i) = 1.38 * i_trf_study_grant(i) Else i_pgb_stud(i) = 0 End If '!-- Pensionable amounts, disability pension (Antagandeinkomst) ' Only if qualifying points for the current year has been calculated in new_economy If i_status(i) = 4 And pp_hist(i).n_years > 0 Then ' If disab pens AND ATP-points If pp_hist(i).pp_years(pp_hist(i).n_years) = year Then '..and points the current year If year < 2003 Then i_pgb_antag(i) = ((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1) _ * m_basbelopp_f Else '-- Note: No contribution from the disability pensioner i_pgb_antag(i) = i_ftp_antag(i) - i_pgi(i) End If End If Else i_pgb_antag(i) = 0 End If '! -- Pensionable amounts, child years ' Women with child age 0 to 3 years. Kvinna får t.v. all pensrätt för barn '**** ÄNDRA SÅ ATT DEN MED LÄGST INKOMST FÅR POÄNGEN **** i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 If i_sex(i) = 2 And exist_child0_3(i_hhnr(i)) = 1 Then ' Check for gainful employment limit: PGI>2 inc basic i minst 5 år ( <2001 2 basbf) If pp_hist_limit(i, 100) >= 5 Then '-- Best of 3 alternatives Bäst av tre alternativ ' 1) Individual comp PGI Utfyllnad till inkomst året före barnets födelse pgb_barn1 = maxi(0, i_pu_ind_comp(i) - i_pgi(i)) ' 2) General comp PGI Utfyllnad t 75% av genomsnittl PGI pgb_barn2 = maxi(0, 0.75 * pgi_snitt - _ (i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i))) ' 3) One income base amount Ett inkomstbasbelopp (ett förh prisbasb före 2001) pgb_barn3 = basb '-- Choosing best alternative i_pgb_barn(i) = maxi(pgb_barn1, maxi(pgb_barn2, pgb_barn3)) Select Case i_pgb_barn(i) Case pgb_barn1 i_pgb_barn_typ(i) = 1 Case pgb_barn2 i_pgb_barn_typ(i) = 2 Case pgb_barn3 i_pgb_barn_typ(i) = 3 End Select End If End If '! -- Summing up pensionable amounts i_pgb(i) = i_pgb_barn(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_antag(i) ' -- PGB + PGI max social insurance income limit Select Case tak Case Is < i_pgi(i) i_pgb_antag(i) = 0 i_pgb_plikt(i) = 0 i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) i_pgb_antag(i) = tak - i_pgi(i) i_pgb_plikt(i) = 0 i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) i_pgb_plikt(i) = tak - i_pgi(i) - (i_pgb_antag(i)) i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) i_pgb_stud(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i)) i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i) i_pgb_barn(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)) End Select i_pgb(i) = round((i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i)) - 50, -2) '-- Optional aligning OT regarding the career effect ' OTfix2: Justerar PGI (inkomstprofilen) för äldre för att få OT enl RFV ' Note: Förutsätter att även PGI alignas If OTfix2 = 1 Then Select Case i_age(i) Case Is = 57 And i_status(i) <> 2 i_pgi(i) = 0.96 * i_pgi(i) Case Is = 58 And i_status(i) <> 2 i_pgi(i) = 0.92 * i_pgi(i) Case Is = 59 And i_status(i) <> 2 i_pgi(i) = 0.87 * i_pgi(i) Case Is = 60 And i_status(i) <> 2 i_pgi(i) = 0.82 * i_pgi(i) Case Is > 61 And i_status(i) <> 2 i_pgi(i) = 0.78 * i_pgi(i) End Select End If i_pu(i) = i_pgb(i) + i_pgi(i) Else i_pgb(i) = 0 i_pgb_antag(i) = 0 i_pgb_plikt(i) = 0 i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 1 i_pgi(i) = 0 i_pu(i) = 0 End If '-- Macro for aligning m_pgi = m_pgi + i_pgi(i) m_pgb = m_pgb + i_pgb(i) Next i '!-- Optional calculation of determinstic pension rights ' Samma procedur som i Orange kuvert Dim Orange As Byte Dim growth As Double If get_scalefactor_active("Pension_Orange") = 1 Then growth = get_scalefactor("Pension_Orange") For i = 1 To m_icount ' AW Inga pensionsgrundande belopp i orange brev i framtiden, sätter pu=pgi i_pu_orange(i) = i_pu_orange(i) * growth i_pu(i) = i_pu_orange(i) i_pgi_orange(i) = i_pgi_orange(i) * growth i_pgi(i) = round(i_pgi_orange(i) - 50, -2) Next i End If '!-- Optional aligning of pensionable income etc Dim Align_PGI As Byte Dim pgb As Double Dim pgi As Double Dim pu As Double If get_scalefactor_active("Align_PGI") = 1 Then ' pgb = parm_macro(maxyear, 13) ' pgi = parm_macro(maxyear, 15) m_zpgb_korr = parm_macro(maxyear, 13) m_zpgi_korr = parm_macro(maxyear, 15) If m_zpgi_korr = 0 Then m_zpgi_korr = 1 If m_zpgb_korr = 0 Then m_zpgb_korr = 1 ' If pgi > 1 Then m_zpgi_korr = pgi / (m_pgi * m_weight) ' If pgb > 1 Then m_zpgb_korr = pgb / (m_pgb * m_weight) For i = 1 To m_icount i_pgi(i) = i_pgi(i) * m_zpgi_korr i_pgb(i) = i_pgb(i) * m_zpgb_korr i_pu(i) = i_pgi(i) + i_pgb(i) Next i End If If get_scalefactor_active("Align_PGI2") = 1 Then '-- Align t RFV årsredov ' -- PGI & PGB aggregerat, endast mått på PU nivå f RFV pu = parm_macro(maxyear, 15) 'Hack: Lägger PU i PGI-kolumnen pgi = pu - (m_pgb * m_weight) If pgi > 0 Then m_zpgi_korr = pgi / (m_pgi * m_weight) Else m_zpgi_korr = 1 End If Debug.Print pu & " " & pgi & " " & m_zpgi_korr For i = 1 To m_icount i_pgi(i) = i_pgi(i) * m_zpgi_korr i_pu(i) = i_pgi(i) + i_pgb(i) Next i End If '! -- Cumulative pension rights PR m_ap_arv_59 = 0: m_ap_arv60_ = 0: m_ap_index = 0: m_ap_favg = 0 For i = 1 To m_icount i_pr_ip1(i) = i_pr_ip(i) i_pr_pp1(i) = i_pr_pp(i) i_pb_ip1(i) = i_pb_ip(i) If i_age(i) >= 16 And i_status(i) <> 2 Then '! -- Pension rights for the ATP-system ' PP-vector for disab pens already updated in Calculate_Disablity_Pension_Benefits If i_pgi(i) > m_basbelopp_f + 100 And i_status(i) <> 4 Then Call Update_pp_hist(i, CInt(((i_pgi(i) - m_basbelopp_f) / m_basbelopp_f) * 100)) End If '! -- Pension rights and pension contributions for the reformed system Select Case i_pu(i) Case Is < f_bas_deduct_min(year) i_pr_ip(i) = 0 i_pr_pp(i) = 0 Case Else '-- Tidigare version utkommenterad 'i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) 'i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) '-- Snabb uppskruvning av avgifterna kräver korr för halvårseffekt i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _ + f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2 i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _ + f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2 End Select '! -- Cumulative pension rights '! -- Income pension Inkomstpension ' -- First calculation of some aggregated variables for balancing If i_age(i) < 60 Then m_ap_arv_59 = m_ap_arv_59 + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i)))) Else m_ap_arv60_ = m_ap_arv60_ + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i)))) End If m_ap_index = m_ap_index + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _ * ((m_ap_balind / m_ap_balind1) - 1)) m_ap_favg = m_ap_favg + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _ * m_favg_ip) '! -- Cumulative pension rights ' -- Then individual pension rights '! -- Income pension Inkomstpension ' Tidigare version 'i_pb_ip(i) = ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i) - 1) + i_pr_ip1(i)) _ ' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2)) 'i_pb_fiktiv(i) = ((i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) _ ' + (i_pr_ip1(i) + i_pr_pp1(i))) _ ' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2)) If m_RFV_PB_On <> 1 Then i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _ (m_ap_balind / m_ap_balind1)) + i_pr_ip(i) i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _ (m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i)) Else 'RFV:s förvaltningskostnadsavdrag i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _ (m_ap_balind / m_ap_balind1)) + i_pr_ip(i) i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _ (m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i)) End If '! -- Premium pension ' Parameter i fördeln nedan avsedd att modellera osäkerheten i placeringarna ' Räknar med årsgenomsnitt på tillfälliga avkastningen,dvs div m 2 ' Förenkling nedan. Eg så skall pengarna ha tillf placering i snitt 1,5 år rand = randvek(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100)) i_pb_pp(i) = (i_pb_pp(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_pp) * rand) + _ (i_pr_pp(i) * (1 + (m_interest_short / 100) / 2)) Else i_pr_ip(i) = 0 i_pr_pp(i) = 0 End If Next i m_ap_arv_59 = m_ap_arv_59 * m_weight m_ap_arv60_ = m_ap_arv60_ * m_weight m_ap_arv = m_ap_arv_59 + m_ap_arv60_ m_ap_index = m_ap_index * m_weight m_ap_favg = m_ap_favg * m_weight '!-- Optional aligning of cumulative pension rights ' Proportional adjustment factor updated i Default_parameters2 Dim Align_PB As Byte 'Dim PB_IP As Double Dim pb_fiktiv As Double Dim pb_pp As Double Dim yy As Integer If get_scalefactor_active("Align_PB") = 1 And year = 2000 Then ' cohort sex {1=RFV,2=Sesim,3=Quota} Dim PB_IP(1938 To 1987, 2, 3) As Double '-- Read RFV values per cohort and sex f Sesim.mdb For yy = 1938 To 1987 PB_IP(yy, 1, 1) = f_GetMakro("PB_IP_M", year, CStr(yy)) PB_IP(yy, 2, 1) = f_GetMakro("PB_IP_F", year, CStr(yy)) Next '-- Aggregate Sesim values per cohort and sex For i = 1 To m_icount If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then PB_IP(i_born_year(i), i_sex(i), 2) = _ PB_IP(i_born_year(i), i_sex(i), 2) + (i_pb_ip(i) * m_weight) End If Next i '-- Calculation of aligning factors For yy = 1938 To 1987 If PB_IP(yy, 1, 2) > 0 And PB_IP(yy, 2, 2) > 0 Then PB_IP(yy, 1, 3) = PB_IP(yy, 1, 1) / PB_IP(yy, 1, 2) PB_IP(yy, 2, 3) = PB_IP(yy, 2, 1) / PB_IP(yy, 2, 2) Else PB_IP(yy, 1, 3) = 1 PB_IP(yy, 2, 3) = 1 End If Next '-- Printing align factors for pension rights Open sesimpath & "\tempdata\PB_align.prn" For Output As #93 Print #93, "Cohort Male Female" For yy = 1938 To 1987 Print #93, yy & " " & PB_IP(yy, 1, 3) & " " & PB_IP(yy, 2, 3) Next Close #93 '-- Aligning For i = 1 To m_icount If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then i_pb_ip(i) = i_pb_ip(i) * PB_IP(i_born_year(i), i_sex(i), 3) i_pb_fiktiv(i) = i_pb_fiktiv(i) * PB_IP(i_born_year(i), i_sex(i), 3) 'i_pb_pp(i) = i_pb_pp(i) * m_zpb_pp_korr End If Next i End If End Sub
Public Sub Calculate_Occupational_Pension_Rights() '!-- Calculation of occupational pension rights for defined contribution systems status "Calculate occupational pensions rights" Printdok " Calculate_Occupational_Pension_Rights" Dim i As Long, pgi_bas As Long Dim tak As Double, rand() As Double, r1 As Double, r2 As Double year = model_time + base_year If year < 2001 Then tak = 7.5 * m_basbelopp_f Else tak = 7.5 * m_basbelopp_income '*** Draw random numbers ReDim rand(1 To 2 * m_icount) Call RANNOR(2 * m_icount, rand(1), model_time + base_year + random * Rnd) For i = 1 To m_icount If (i_status(i) <> 2 And i_abroad(i) = 0) Or _ (i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65) Then '-- Simplified calc of pension rights for part-time retired. Assumes that all ' all income qualifies for pension rights even pensions. pgi_bas = i_inc_earning(i) + i_trf_sickleave(i) If i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65 Then '-- Part-time retired normally gets pensions rights as if full-time to age 65 pgi_bas = (i_inc_earning(i) + i_trf_sickleave(i)) / i_work_share(i) '-- Rough calc of full-time pay Else pgi_bas = i_inc_earning(i) + i_trf_sickleave(i) End If Select Case i_sector(i) Case 1 '-- Blue collar: SAF-LO i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.035, , tak, 21, 1932) i_pr_op_tp(i) = 0 i_op_pp_years_Blue(i) = i_op_pp_years_Blue(i) + 1 Case 2 '-- White collar: ITPK i_pr_op_ap(i) = 0 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.02, , tak, 28, 1939) i_op_pp_years_White(i) = i_op_pp_years_White(i) + 1 Case 3 '-- State: PA03 & Kåpan If year >= 2003 Then '-- PA03 i_pr_op_ap(i) = f_op_pens_rights(mini(pgi_bas, 30 * m_basbelopp_income), _ i_age(i), i_born_year(i), 0.023, , tak, 23, 1943) Else i_pr_op_ap(i) = 0 End If Select Case year '-- Extra Kåpan Case Is < 2003 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.015, , tak, 28) Case 2003 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.019, , tak, 28) Case Is > 2003 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.02, , tak, 28) End Select i_op_pp_years_State(i) = i_op_pp_years_State(i) + 1 Case 4 '-- Local goverment: PFA-01 Select Case year '-- PFA98 (Kommunalarbetareförbundets premier) Case Is < 2004 i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.045, 0.021, tak, 28, 1938) i_pr_op_tp(i) = 0 Case Is >= 2004 '-- Employed 2003, minimum age 28, still 4,5% fee If i_born_year(i) < 1976 Then i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.045, 0.011, tak, 28, 1938) Else '-- Still 28 year age limit above social insurance limit i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.04, 0, tak, 21, 1938) + _ f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0, 0.011, tak, 28, 1938) End If i_pr_op_tp(i) = 0 End Select i_op_pp_years_Local(i) = i_op_pp_years_Local(i) + 1 Case Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End Select Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End If '! -- Cumulative occupational pension rights ' Parameter in distribution below measures uncertainty in investment ' Assumes same average return on occupational pension funds as public premium pension ' Also tax on return 15% (avkastningsskatt) on occup pens rights r1 = rand(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100)) r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_shares_return / 100)) If i_status(i) = 2 And i_work_share(i) > 0 Then '-- Updating the stock i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _ + i_pr_op_ap(i) - i_op_ap_dc(i) Else i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _ + i_pr_op_ap(i) i_pb_op_tp(i) = (i_pb_op_tp(i) * r2 * (1 - ((m_interest_long / 100) * 0.15))) _ + i_pr_op_tp(i) End If ' -- DB-rights for persons who has changed sector capitalized and added to DC-rights ' Upparbetade DB-rätter omvandlas t DC-rätter f 65 års ålder If i_sector(i) <> i_sector1(i) And (i_sector1(i) <> 0 And i_sector1(i) <> 5) Then i_pb_op_ap(i) = i_pb_op_ap(i) + mini(1, (i_op_pp_years(i) / 30)) * _ (PV(m_interest_long / 100, explife(65), _ -f_Occupational_DB_pension_benefits(i, i_sector1(i), 0))) i_op_pp_years(i) = 0 i_op_pp_years_trans(i) = 0 Else i_op_pp_years(i) = i_op_pp_years(i) + 1 End If Next i End Sub
' Note: ' No information about lagged statuses. Uses the status for the base year for whole period ' Note: Possible to move this procedure to start data program ' Procedure call from c00_Init
Public Sub Init_Occupational_Pension_Rights() '!-- Initiation of occupational pension stocks in DC systems status "Init occupational pensions" Printdok " Init_Occupational_Pension_Rights" Dim i As Long Dim tak As Double Dim yr As Integer Dim rand() As Double, r1 As Double, r2 As Double Dim Interest_long As Double For yr = 1977 To base_year Interest_long = f_GetMakro("Interest_long", yr) m_basbelopp_f = f_GetMakro("BASBF", yr) tak = 7.5 * m_basbelopp_f '*** Draw random numbers ReDim rand(1 To 2 * m_icount) Call RANNOR(2 * m_icount, rand(1), yr * 10 + random * Rnd) For i = 1 To m_icount '-- Loops all individuals If i_status(i) = 8 And i_abroad(i) = 0 Then '**** Syntax for function call: x = f_op_pens_rights(fee,fee top, age, born) Select Case i_sector(i) Case 1 '-- Blue collar: SAF-LO If yr >= 1996 Then i_pr_op_ap(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _ i_age(i), i_born_year(i), 0.02, , tak, 21, 1932) Else i_pr_op_ap(i) = 0 End If i_pr_op_tp(i) = 0 Case 2 '-- White collar: ITPK i_pr_op_ap(i) = 0 If yr >= 1977 Then i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _ i_age(i), i_born_year(i), 0.02, , tak, 28, 1939) Else i_pr_op_tp(i) = 0 End If Case 3 '-- State: PA03 & Kåpan i_pr_op_ap(i) = 0 If yr >= 1991 Then '-- Kåpan i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _ i_age(i), i_born_year(i), 0.015, , tak, 28) Else i_pr_op_tp(i) = 0 End If Case 4 '-- Local goverment: PFA98 If yr >= 1998 Then '-- PFA98 (Kommunalarbetareförbundets premier) i_pr_op_ap(i) = f_op_pens_rights(i_inc_taxable1(i), i_age(i), i_born_year(i), _ 0.045, 0.021, tak, 28, 1938) Else i_pr_op_ap(i) = 0 End If If yr >= 1998 Then End If i_pr_op_tp(i) = 0 Case Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End Select Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End If '! -- Cumulative occupational pension rights ' Parameter in distribution below measures uncertainty in investment ' Assumes same average return on occupational pension funds as public premium pension r1 = rand(i) * Sqr(0.0000001) + (1 + (m_interest_long / 100)) r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_interest_long / 100)) i_pb_op_ap(i) = i_pb_op_ap(i) * r1 + i_pr_op_ap(i) i_pb_op_tp(i) = i_pb_op_tp(i) * r2 + i_pr_op_tp(i) Next i Next yr ' -- Saving 4 year averaged income 1997 x 100 / basb ' Used primarily in cal of transitional rules for local government employees For i = 1 To m_icount '-- Loops all individuals i_avg_income_1997(i) = (i_inc_taxable2(i) / m_basbelopp2 + _ i_inc_taxable3(i) / m_basbelopp3 + _ i_inc_taxable4(i) / m_basbelopp4 + _ i_inc_taxable5(i) / m_basbelopp5) * 100 / 4 Next i End Sub
' Note: Uses truncated pp_hist values years less than base_year-5 years, ' lagged income variables for base_year-5 to base_year '-- Syntax for function call: ' x = f_hist_income(ix,y) ' ix = index for actual individual ' y = historical year ' basb = basic amount for the historical year
Public Function f_hist_income(ix As Long, y As Integer, basb As Long) As Long '!-- Returns the historical income for a certain year Dim j As Integer f_hist_income = 0 If y < base_year - 5 Then If pp_hist(ix).n_years > 0 Then For j = 1 To pp_hist(ix).n_years If pp_hist(ix).pp_years(j) = y Then f_hist_income = (pp_hist(ix).pp(j) + 100) * basb / 100 Exit For End If Next End If Else Select Case y Case base_year - 5 f_hist_income = i_inc_taxable5(ix) Case base_year - 4 f_hist_income = i_inc_taxable4(ix) Case base_year - 3 f_hist_income = i_inc_taxable3(ix) Case base_year - 2 f_hist_income = i_inc_taxable2(ix) Case base_year - 1 f_hist_income = i_inc_taxable1(ix) Case base_year f_hist_income = i_inc_taxable(ix) Case Else f_hist_income = 0 End Select End If End Function
'-- Syntax for function call: ' x = f_op_pens_rights(income,age,born,fee,fee top, top limit, agelimit, bornlimit) ' income = pensionsmedförande lön (i kr) ' age = age of individual ' born = year of birth of individual ' fee = premium (eg 0.035) below a certain limit, eg the social security limit 7,5 basb. ' fee top = premie above the limit (eg 0.035) Optional: Default= fee ' toplim = The limit (eg 7,5 basb) Optional: Default=7.5 basb ' agelim = åldergräns för intjänande (tex 28) Optional: Default= 19 ' bornlim = gäller personer födda efter detta år (tex 1943) Optional: Default= 1900
Public Function f_op_pens_rights(income As Long, age As Byte, born As Integer, _ fee As Double, Optional feetop As Double = -1, Optional toplim As Double = -1, _ Optional agelim As Integer = 19, Optional bornlim As Integer = 1900) As Long '!-- Calculation of occupational pension rights (defined contribution systems) ' for different labour market sectors If feetop = -1 Then feetop = fee End If If toplim = -1 Then toplim = 7.5 * m_basbelopp End If If age > agelim And born > bornlim Then If income <= toplim Then f_op_pens_rights = fee * income Else f_op_pens_rights = (fee * toplim) + (feetop * (income - toplim)) End If End If End Function
'-- Updates the pension history vectors in pp_hist ' Input: ' ix = index for actual individual ' pp = calculated value for pp_hist(i).pp ' Automatically updated: ' Number of years in pp_hist(i).n_years = n_years + 1 ' Income year in pp_hist(i).pp_years = year ' Output: Nothing
Public Sub Update_pp_hist(ix As Long, pp As Integer) '!-- Updates pension history vectors in pp_hist ReDim Preserve pp_hist(ix).pp(pp_hist(ix).n_years + 1) ReDim Preserve pp_hist(ix).pp_years(pp_hist(ix).n_years + 1) pp_hist(ix).n_years = pp_hist(ix).n_years + 1 pp_hist(ix).pp(pp_hist(ix).n_years) = pp pp_hist(ix).pp_years(pp_hist(ix).n_years) = year End Sub
'-- Returns number of ATP years for individual i up to year y ' Input: ' ix = index for actual individual ' year = number of ATP years up to this year
Public Function f_pp_years(ix As Long, year As Integer) As Byte '!-- Number of ATP years for individual i up to year y Dim y As Integer f_pp_years = 0 If pp_hist(ix).n_years > 0 Then For y = 1 To pp_hist(ix).n_years If pp_hist(ix).pp_years(y) <= year Then f_pp_years = f_pp_years + 1 Else Exit For End If Next End If End Function
' -- Returns the ratio used for adjustment of calculated ATP-pension for early / ' late retirement (Note: time unit = month) ' Default values from public ATP system ' Input: pensage = early or late pension in years compared to 65 year ' early = monthly down correction if early pension. Optional, default=005% per month ' early=-999 means actuarial calculation ' late = monthly up correction if late pension. Optional, default=007% per month ' Note: explife and m_interest_short must be defined before execution 'Examples: x=f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i)),0.005,0.007) or x=f_fu_kvot(f_ap_pensage(i),-999) '-----------------------------------------------------------------------------------------
Public Function f_fu_kvot(pensage As Byte, Optional Early As Double = 0.005, Optional Late As Double = 0.007) As Double '!-- Returns the ratio used for adjustment of calculated ATP-pension for early / '! late retirement (Note: time unit = month) Dim rate As Double '-- Yearly discounting factor rate = m_interest_long / 100 'Standardantagande: Långränta If Early = -999 Then '-- Code -999 for actuarial calculation (Ja, jag vet: Ett hack) f_fu_kvot = Pmt(rate, explife(pensage), PV(rate, explife(65), 1)) Else Select Case pensage Case Is < 60 ' No pensions before 60 MsgBox ("Error in f_fu_kvot: Pension age less than 60. Check pension age in function call") Case Is < 65 ' -- Early withdrawal f_fu_kvot = 1 + ((pensage - 65) * Early * 12) Case 65 ' -- 65 years f_fu_kvot = 1 Case Is <= 70 ' -- Late withdrawal f_fu_kvot = 1 + ((pensage - 65) * Late * 12) Case Is > 70 MsgBox ("Error in f_fu_kvot: Pension age greater than 70. Check pension age in function call") End Select End If End Function
'-- Returns basic pension ratio used for calculation of i_ap_fp, i_ap_fp30, i_ap_pts etc ' Input: Civil status 0=Not married, 1= Married ' Note: m_ap_fp_kvot_ogifta and m_ap_fp_kvot_gifta must be initiated before execution
Public Function f_ap_fp_kvot(civ_stat As Byte) As Double If civ_stat = 0 Then f_ap_fp_kvot = m_ap_fp_kvot_ogifta ElseIf civ_stat = 1 Then f_ap_fp_kvot = m_ap_fp_kvot_gifta Else MsgBox "Fel i f_ap_fp_kvot: Parameter ska vara 0 eller 1" End If End Function
'-- Reduction of benefits on account of inadequate period of service ' In swedish: Tjänstetidsfaktor 'Note: Not indepent. Uses pp-history ' Examples: x= f_red_service_time(i,f_krav_atp_ar(i_borm_year(i))
Public Function f_red_service_time(ix As Long, Optional limit As Integer = 30) As Double '!-- Tjänstetidsfaktor f_red_service_time = mini(1, (pp_hist(ix).n_years) / limit) End Function
'-- Calculates the income pension annuity factors (delningstal), annuity facors for ' premium pension and inheritance gains ' Annuity factors caculated on death hazards in assumptions file ' Income pension: dtalip(age 50-106) with 1,6% norm growth as default ' Premium pension: dtalpp(age 50-106) default 3.2%. If 0 expected remaining lifetime ' Inheritance gains based on a direct and simplified method based on death hazards ' i.e. no summing up of actual cumulated pension funds for persons younger than 60 ' Creates a public array defined from 0 to 106 years: Arvsvinstfactor(y=0-106) ' Note: Call and defintion of global variables in new_economy_2 once a year
Public Sub Calculate_Deltal(Optional norm As Double = 1.016, Optional normpp As Double = 1) '!-- Calculates pension annuity factors (delningstal) '!-- and inheritance factors (arvsvinstfaktor) Printdok " Calculate_Deltal" Dim maxyear As Long Dim B(0 To 106, 1 To 2) As Double Dim q(0 To 106, 1 To 2) As Double Dim lx(0 To 106, 1 To 2) As Double Dim lx_(0 To 106) As Double Dim sex As Long, year As Long, age As Long, n As Long, x As Long, k As Long, j As Long Dim pop As Double, d As Double, e As Double, r As Double year = model_time + base_year maxyear = mini(2050, year) Dim q_lag As Double, l As Integer For sex = 1 To 2 pop = 100000 For age = 0 To 106 q_lag = 1 For l = 1 To 5 '-- 5-year smoothed hazards q_lag = q_lag * parm_death(mini(2110, maxi(1999, year - l)), age, sex) Next q_lag = q_lag ^ (1 / 5) pop = pop * (1 - q_lag) B(age, sex) = pop Next Next For sex = 1 To 2 For age = 0 To 106 If age < 106 Then lx(age, sex) = (B(age, sex) + B(age + 1, sex)) / 2 Else lx(age, sex) = B(age, sex) End If Next Next For age = 1 To 106 '-- Note: One year shift i age, i.e age 0 = -1 etc. lx_(age) = (lx(age - 1, 1) * 0.5145) + (lx(age - 1, 2) * (1 - 0.5145)) Next For n = 50 To 106 d = 0 e = 0 r = 0 For x = 0 To 11 For k = n To 105 d = d + ((norm) ^ (-(k - n))) * _ (lx_(k) + (lx_(k + 1) - lx_(k)) _ * (x / 12)) * (norm) ^ (-x / 12) e = e + (normpp) ^ (-(k - n)) * _ (lx_(k) + (lx_(k + 1) - lx_(k)) _ * (x / 12)) * (normpp) ^ (-x / 12) r = r + (1) ^ (-(k - n)) * _ (lx_(k) + (lx_(k + 1) - lx_(k)) _ * (x / 12)) * (1) ^ (-x / 12) Next Next dtalip(n) = round(d / (12 * lx_(n)), 2) dtalpp(n) = round(e / (12 * lx_(n)), 2) explife(n) = r / (12 * lx_(n)) Next For age = 1 To 106 Arvsvinstfaktor(age) = 1 + ((lx_(age - 1) - lx_(age)) / lx_(age)) Next '-- Optional switch to exogenous "Orange envelopes"-annuity factors If get_scalefactor_active("Pension_Orange") = 1 And year >= 2003 Then dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249") dtalpp(65) = f_GetMakro("dtal_rfvpp", CInt(maxyear), "dtal_rfv") End If '-- Optional switch to exognous discounted expected remaining lifetime according to ' RFV 2002. ' Note: Only active if pensions at age 65, and for year 2003 to 2100. If get_scalefactor_active("Deltal_RFV") = 1 Then If year > 2002 Then dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249") End If End If End Sub
Public Function f_krav_atp_ar(born_year As Integer) As Integer '! -- Calculates required number of years for ATP for different cohorts Select Case born_year Case Is > 1923 f_krav_atp_ar = 30 Case 1915 To 1923 f_krav_atp_ar = 20 + born_year - 1914 Case Else f_krav_atp_ar = 20 End Select End Function
Public Function f_utfasning_ATP(born_year As Integer, ap_pens_year As Integer) As Double '! -- Calculates parameter for phasing out the ATP system Note: > 1953 = 1 and <1938 = 0 ' Includes transitions rules for persons born 1938 and 1939 Select Case born_year Case Is > 1953 f_utfasning_ATP = 1 Case 1938 To 1953 If born_year <= 1939 And ap_pens_year <= 2000 And year <= 2003 Then f_utfasning_ATP = 0 Else f_utfasning_ATP = (born_year - 1937 + 3) / 20 End If Case Else f_utfasning_ATP = 0 End Select End Function
' Note: If i_ap_pensmonth <0 => early withdrawal (in months), >0 late, 0 = pensage=65 ' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal 'Public Function f_ap_pensage(idxnr As Long) As Byte
Public Function f_ap_pensage(pensmonth As Integer) As Byte '! -- Calculates pension age in years f_ap_pensage = 65 + Int(pensmonth / 12) End Function
' -- Calculates pension year (ex post and ex ante). ' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal ' from the default value 65. 'Public Function f_ap_pensyear(idxnr As Long) As Integer
Public Function f_ap_pensyear(year As Integer, age As Byte, pensmonth As Integer) As Integer '! -- Calculates pension year 'f_ap_pensyear = year - (i_age(idxnr) - (65 + Int(i_ap_pensmonth(idxnr) / 12))) f_ap_pensyear = year - (age - (65 + Int(pensmonth / 12))) End Function
' -- Choice of price indexation method ' Note: Price indexation m_basbelopp / m_basbelopp1 not m_KPI, but same result in steady state.
Public Function f_pens_index(program As String, age As Byte) As Double '! -- Calculates actual price indexation method for different pension programs and years Select Case year Case Is >= 2003 Select Case program Case "ATP" '-- LIP 5 kap, 14§ If age < 65 Then '-- Before age 65 only price indexing f_pens_index = m_basbelopp / m_basbelopp1 Else '-- Discounted income indexation after age 65 (Följsamhetsindexering) f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm) End If Case "IP" f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm) Case "GP" f_pens_index = m_basbelopp / m_basbelopp1 Case "OP" '-- Payed out defined benefit occupational pensions f_pens_index = m_basbelopp / m_basbelopp1 Case Else f_pens_index = 0 End Select Case Is <= 2001 Select Case program Case "ATP" f_pens_index = m_basbelopp / m_basbelopp1 Case "FP" f_pens_index = m_basbelopp / m_basbelopp1 Case "PTS" f_pens_index = m_basbelopp / m_basbelopp1 Case "IP" '-- Eg kan uttag av IP ske f 2001, men ej Sesim f_pens_index = 0 Case "OP" '-- Payed out defined benefit occupational pensions f_pens_index = m_basbelopp / m_basbelopp1 Case Else f_pens_index = 0 End Select Case 2002 Select Case program Case "ATP" '-- Enl Prop 1999/00:138, sid 72 'f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / m_ap_norm) f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996) Case "FP" f_pens_index = m_basbelopp / m_basbelopp1 Case "PTS" f_pens_index = m_basbelopp / m_basbelopp1 Case "IP" ' **** Skall ev vara 1.026 i nämnaren??? f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996) Case "OP" '-- Payed out defined benefit occupational pensions f_pens_index = m_basbelopp / m_basbelopp1 Case Else f_pens_index = 0 End Select End Select End Function
'! -- Reformed basic retirement pensions for individuals born from 1938 on ' Garantipension för personer födda from 1938 ' Output: Reformed basic pension, current SEK Utbetald garantipension
Public Function f_ap_garp_38_(civ_stat As Byte, basbelopp As Long, ap_tp As Long, _ ap_fiktiv As Long, surv As Long) As Long '! -- Reformed basic retirement pensions Garantipension Dim berunderlag As Long berunderlag = ap_tp + ap_fiktiv + surv Select Case civ_stat '-- Marital status Case 0 '-- Not married If berunderlag <= 1.26 * basbelopp Then f_ap_garp_38_ = (2.13 * basbelopp) - berunderlag Else f_ap_garp_38_ = maxi(0, ((2.13 - 1.26) * basbelopp) - 0.48 * _ (berunderlag - (1.26 * basbelopp))) End If Case 1 '-- Married If berunderlag <= 1.14 * basbelopp Then f_ap_garp_38_ = 1.9 * basbelopp - berunderlag Else f_ap_garp_38_ = maxi(0, ((1.9 - 1.14) * basbelopp) - 0.48 * _ (berunderlag - (1.14 * basbelopp))) End If End Select End Function
'! -- Transitional reformed basic retirement pension for individuals born until 1938 ' f.d. Övergångsvis garantipension för indvider födda tom 1937
Public Function f_ap_garp_37(civ_stat As Byte, basbelopp As Long, _ ap_atp As Long, ap_fp30 As Long, ap_fp As Long, ap_pts As Long, _ surv As Long, op As Long, botid As Integer) As Long Dim berunderlag As Long Dim berunderlag_korr As Long '!-- 1: Beräkning av beräkningsunderlag berunderlag = ap_atp + maxi(ap_fp30, ap_fp) + ap_pts + surv + op '!-- 2: Uppräkning av beräkningsunderlag som komp för SGA If berunderlag <= 0.25 * basbelopp Then berunderlag_korr = berunderlag * 1.04 ElseIf berunderlag > 0.25 * basbelopp And berunderlag < 1.354 * basbelopp Then berunderlag_korr = 1.5174 * berunderlag - 0.1193 * basbelopp Else Select Case civ_stat '-- Marital status Case 0 '-- Not married If berunderlag >= 1.354 * basbelopp And berunderlag < 1.529 * basbelopp Then berunderlag_korr = 1.343 * berunderlag + 0.1168 * basbelopp ElseIf berunderlag >= 1.529 * basbelopp And berunderlag < 3.16 * basbelopp Then berunderlag_korr = 2.17 * basbelopp + 0.6 * (berunderlag - 1.51 * basbelopp) Else berunderlag_korr = berunderlag End If Case 1 '-- Married If berunderlag >= 1.354 * basbelopp And berunderlag < 2.8275 * basbelopp Then berunderlag_korr = 1.935 * basbelopp + 0.6 * (berunderlag - 1.34 * basbelopp) Else berunderlag_korr = berunderlag End If End Select End If '!-- 3: Beräkning av garantipension mht inkomst, civilstånd etc f_ap_garp_37 = maxi(0, berunderlag_korr - (ap_atp + ap_fp30 + surv + op)) _ * mini(1, botid / 40) End Function
' Note: Do NOT use in loops
Public Function f_GetMakro(Namn As String, yr As Integer, Optional typ As String = "Macro") As Double '!-- Reading data from table T_DATA in Sesimrun.MDB '! If no hit in the database the latest number is retained On Error Resume Next Dim rs As New ADODB.Recordset, cn As New ADODB.Connection Dim SQL As String SQL = "select * from T_Data where (Type='" & typ & "' AND Name='" & Namn & "' AND year=" & yr & ")" rs.Open SQL, _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sesimpath & "\source\sesim.mdb" _ & "; Persist Security Info=False" f_GetMakro = rs![value] End Function
'**** Note: Its faster write direct to a file witout open and close within the loop as in the procedure ' below ' Syntax: Print_to_file ' "filenamne" ' "{Y/N}" = "Y" if New file, "N" if append ' any number of variable names incl index within () or text strings ' within "", all comma separated ' Example: Print_to_file "valid_pens.txt", "N", i, year, i_age(i), i_sex(i) ' Examples also in procedure "Pension_debugging_files" in this module
Sub Print_to_file(filn As String, Clear As String, ParamArray var() As Variant) '!-- General procedure for printing of text or variables to a file Dim demofile As Integer Dim x As Variant Dim utvar As String demofile = FreeFile If Clear = "Y" Then Open sesimpath & "\" & filn For Output As #demofile Else Open sesimpath & "\" & filn For Append As #demofile End If For Each x In var utvar = utvar & CStr(x) & Chr$(9) Next x Print #demofile, utvar Close #demofile End Sub
Public Function f_Concat_string(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string = f_Concat_string & CStr(x) & Chr$(9) Next x End Function
Public Function f_Concat_string_space(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string_space = f_Concat_string_space & CStr(round(x, 5)) & Chr$(32) Next x End Function
Public Function f_Concat_string_comma(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string_comma = f_Concat_string_comma & CStr(x) & Chr$(44) Next x End Function
Public Function f_Concat_string_cita(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string_cita = f_Concat_string_cita & Chr$(34) & CStr(x) & Chr$(34) & Chr$(32) Next x End Function
Public Function f_pens_bas(program As String) As Double '! -- Choice of basic amount definition for different pension programs and years Select Case year Case Is >= 2003 Select Case program Case "ATP" f_pens_bas = m_basbelopp_income Case "OP" f_pens_bas = m_basbelopp_income Case "IP" f_pens_bas = m_basbelopp_income Case "GP" '-- Optional choce of income indexation in Control Center - Parameters ' If income indexation wanted set m_ap_gp_Inkindex_On On=1 for actual years f_pens_bas = m_basbelopp_gp Case Else f_pens_bas = 0 End Select Case 1997 To 1998 '-- Minskat basbelopp tom 1998 Select Case program Case "ATP" f_pens_bas = m_basbelopp * 0.98 Case "OP" f_pens_bas = m_basbelopp * 0.98 Case "FP" f_pens_bas = m_basbelopp * 0.98 Case "PTS" f_pens_bas = m_basbelopp * 0.98 Case Else f_pens_bas = 0 End Select Case 1999 To 2001 Select Case program Case "ATP" f_pens_bas = m_basbelopp Case "OP" f_pens_bas = m_basbelopp Case "FP" f_pens_bas = m_basbelopp Case "PTS" f_pens_bas = m_basbelopp Case Else f_pens_bas = 0 End Select Case 2002 Select Case program Case "ATP" f_pens_bas = m_basbelopp_income Case "OP" f_pens_bas = m_basbelopp_income Case "FP" f_pens_bas = m_basbelopp Case "PTS" f_pens_bas = m_basbelopp Case Else f_pens_bas = 0 End Select End Select End Function
'-- Calculation of some macro variables for reporting
Public Sub Calculate_Macro() Dim Bef(1 To 6) As Double, p(1 To 6) As Double, status(1 To 9) As Long Dim Bef_Status_Sex() As Long, maxyear As Integer Dim i As Long, j As Long, s As Long Dim Bef5(1 To 22) As Long, Bef5_M(1 To 22) As Long, Bef5_K(1 To 22) As Long Dim AK5(1 To 22) As Long, AK5_M(1 To 22) As Long, AK5_K(1 To 22) As Long Dim AL5(1 To 22) As Long, AL5_M(1 To 22) As Long, AL5_K(1 To 22) As Long Dim akbef1664_p As Double, al1664_p As Double, aptot_p As Double, apsys_p As Double year = model_time + base_year 'If year <= 2050 Then maxyear = year Else maxyear = 2050 'If year <= 2150 Then maxyear = year Else maxyear = 2150 If year <= 2110 Then maxyear = year Else maxyear = 2110 '!-- Calculation and aggregation of some macro variables Printdok " Calculate_Macro" m_inc_earning = L_SUMVEC(i_inc_earning(1), m_icount) * m_weight m_arbavg = L_SUMVEC(i_arbavg(1), m_icount) * m_weight ' m_arbavg_p * m_inc_earning m_arbavg_pens = L_SUMVEC(i_arbavg_pens(1), m_icount) * m_weight ' m_arbavg_pens_p * m_inc_earning m_arbavg_ovr = m_arbavg - m_arbavg_pens m_pr_op = (L_SUMVEC(i_pr_op_ap(1), m_icount) + L_SUMVEC(i_pr_op_tp(1), m_icount)) * m_weight m_arbavg_slon = m_arbavg_slon_p * m_pr_op m_pgi_bas = L_SUMVEC(i_pgi_bas(1), m_icount) * m_weight m_pgi_bas_n = cnt0(i_pgi_bas) * m_weight m_pgi_bas_gt_basb = sumif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight m_pgi_bas_gt_basb_n = cntif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight / 1000 '-- Participation rate etc. ReDim Bef_Status_Sex(0 To 106, 1 To 9, 1 To 2) As Long For i = 1 To m_icount If i_abroad(i) = 0 Then Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) = _ Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) + 1 End If Next For i = 0 To 106 For j = 1 To 8 Bef5_M(Int(i / 5) + 1) = Bef5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1) Bef5_K(Int(i / 5) + 1) = Bef5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 2) Bef5(Int(i / 5) + 1) = Bef5(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1) + _ Bef_Status_Sex(i, j, 2) Next AK5_M(Int(i / 5) + 1) = AK5_M(Int(i / 5) + 1) + _ Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) AK5_K(Int(i / 5) + 1) = AK5_K(Int(i / 5) + 1) + _ Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2) AK5(Int(i / 5) + 1) = AK5(Int(i / 5) + 1) + _ Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) + _ Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2) AL5_M(Int(i / 5) + 1) = AL5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 1) AL5_K(Int(i / 5) + 1) = AL5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 2) Next For j = 1 To 9 For i = 0 To 106 status(j) = status(j) + Bef_Status_Sex(i, j, 1) + Bef_Status_Sex(i, j, 2) Next Next m_BEFM0015 = 0 m_BEFK0015 = 0 m_BEFM1664 = 0 m_BEFK1664 = 0 m_BEFM65WW = 0 m_BEFK65WW = 0 Dim AK1664 As Long For i = 0 To 15 For j = 1 To 8 m_BEFM0015 = m_BEFM0015 + Bef_Status_Sex(i, j, 1) m_BEFK0015 = m_BEFK0015 + Bef_Status_Sex(i, j, 2) Next Next For i = 16 To 64 AK1664 = AK1664 + Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) _ + Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2) For j = 1 To 8 m_BEFM1664 = m_BEFM1664 + Bef_Status_Sex(i, j, 1) m_BEFK1664 = m_BEFK1664 + Bef_Status_Sex(i, j, 2) Next Next For i = 65 To 106 For j = 1 To 8 m_BEFM65WW = m_BEFM65WW + Bef_Status_Sex(i, j, 1) m_BEFK65WW = m_BEFK65WW + Bef_Status_Sex(i, j, 2) Next Next '-- Definition of macrovariables for different agegroups ' Labour supply = Sesim status 5+6+8. ' Note: Persons in labour market programs out of labour force included m_AKM1619 = (AK5_M(4)) * m_weight / 1000 m_AKK1619 = (AK5_K(4)) * m_weight / 1000 m_AKM2024 = (AK5_M(5)) * m_weight / 1000 m_AKK2024 = (AK5_K(5)) * m_weight / 1000 m_AKM2529 = (AK5_M(6)) * m_weight / 1000 m_AKK2529 = (AK5_K(6)) * m_weight / 1000 m_AKM3034 = (AK5_M(7)) * m_weight / 1000 m_AKK3034 = (AK5_K(7)) * m_weight / 1000 m_AKM3539 = (AK5_M(8)) * m_weight / 1000 m_AKK3539 = (AK5_K(8)) * m_weight / 1000 m_AKM4044 = (AK5_M(9)) * m_weight / 1000 m_AKK4044 = (AK5_K(9)) * m_weight / 1000 m_AKM4549 = (AK5_M(10)) * m_weight / 1000 m_AKK4549 = (AK5_K(10)) * m_weight / 1000 m_AKM5054 = (AK5_M(11)) * m_weight / 1000 m_AKK5054 = (AK5_K(11)) * m_weight / 1000 m_AKM5559 = (AK5_M(12)) * m_weight / 1000 m_AKK5559 = (AK5_K(12)) * m_weight / 1000 m_AKM6064 = (AK5_M(13)) * m_weight / 1000 m_AKK6064 = (AK5_K(13)) * m_weight / 1000 m_AKM6569 = (AK5_M(14)) * m_weight / 1000 m_AKK6569 = (AK5_K(14)) * m_weight / 1000 m_AKM7074 = (AK5_M(15)) * m_weight / 1000 m_AKK7074 = (AK5_K(15)) * m_weight / 1000 m_AKT1664 = AK1664 * m_weight / 1000 ' -- Unemployed m_ALM1619 = (AL5_M(4)) * m_weight / 1000 m_ALK1619 = (AL5_K(4)) * m_weight / 1000 m_ALM2024 = (AL5_M(5)) * m_weight / 1000 m_ALK2024 = (AL5_K(5)) * m_weight / 1000 m_ALM2529 = (AL5_M(6)) * m_weight / 1000 m_ALK2529 = (AL5_K(6)) * m_weight / 1000 m_ALM3034 = (AL5_M(7)) * m_weight / 1000 m_ALK3034 = (AL5_K(7)) * m_weight / 1000 m_ALM3539 = (AL5_M(8)) * m_weight / 1000 m_ALK3539 = (AL5_K(8)) * m_weight / 1000 m_ALM4044 = (AL5_M(9)) * m_weight / 1000 m_ALK4044 = (AL5_K(9)) * m_weight / 1000 m_ALM4549 = (AL5_M(10)) * m_weight / 1000 m_ALK4549 = (AL5_K(10)) * m_weight / 1000 m_ALM5054 = (AL5_M(11)) * m_weight / 1000 m_ALK5054 = (AL5_K(11)) * m_weight / 1000 m_ALM5559 = (AL5_M(12)) * m_weight / 1000 m_ALK5559 = (AL5_K(12)) * m_weight / 1000 m_ALM6064 = (AL5_M(13)) * m_weight / 1000 m_ALK6064 = (AL5_K(13)) * m_weight / 1000 m_ALM6569 = (AL5_M(14)) * m_weight / 1000 m_ALK6569 = (AL5_K(14)) * m_weight / 1000 m_ALM7074 = (AL5_M(15)) * m_weight / 1000 m_ALK7074 = (AL5_K(15)) * m_weight / 1000 ' Population = Status 1 to 8. Not persons abroad. m_BEFM0014 = (Bef5_M(1) + Bef5_M(2) + Bef5_M(3)) * m_weight / 1000 m_BEFK0014 = (Bef5_K(1) + Bef5_K(2) + Bef5_K(3)) * m_weight / 1000 m_BEFM0015 = m_BEFM0015 * m_weight / 1000 m_BEFK0015 = m_BEFK0015 * m_weight / 1000 m_BEFM1519 = (Bef5_M(4)) * m_weight / 1000 m_BEFK1519 = (Bef5_K(4)) * m_weight / 1000 m_BEFM1619 = (Bef5_M(4) - Bef_Status_Sex(15, 1, 1)) * m_weight / 1000 m_BEFK1619 = (Bef5_K(4) - Bef_Status_Sex(15, 1, 2)) * m_weight / 1000 m_BEFM2024 = Bef5_M(5) * m_weight / 1000 m_BEFK2024 = Bef5_K(5) * m_weight / 1000 m_BEFM2529 = (Bef5_M(6)) * m_weight / 1000 m_BEFK2529 = (Bef5_K(6)) * m_weight / 1000 m_BEFM3034 = (Bef5_M(7)) * m_weight / 1000 m_BEFK3034 = (Bef5_K(7)) * m_weight / 1000 m_BEFM3539 = (Bef5_M(8)) * m_weight / 1000 m_BEFK3539 = (Bef5_K(8)) * m_weight / 1000 m_BEFM4044 = (Bef5_M(9)) * m_weight / 1000 m_BEFK4044 = (Bef5_K(9)) * m_weight / 1000 m_BEFM4549 = (Bef5_M(10)) * m_weight / 1000 m_BEFK4549 = (Bef5_K(10)) * m_weight / 1000 m_BEFM5054 = (Bef5_M(11)) * m_weight / 1000 m_BEFK5054 = (Bef5_K(11)) * m_weight / 1000 m_BEFM5559 = (Bef5_M(12)) * m_weight / 1000 m_BEFK5559 = (Bef5_K(12)) * m_weight / 1000 m_BEFM6064 = (Bef5_M(13)) * m_weight / 1000 m_BEFK6064 = (Bef5_K(13)) * m_weight / 1000 m_BEFM6569 = (Bef5_M(14)) * m_weight / 1000 m_BEFK6569 = (Bef5_K(14)) * m_weight / 1000 m_BEFM7074 = (Bef5_M(15)) * m_weight / 1000 m_BEFK7074 = (Bef5_K(15)) * m_weight / 1000 m_BEFM1664 = m_BEFM1664 * m_weight / 1000 m_BEFK1664 = m_BEFK1664 * m_weight / 1000 m_BEFM65WW = m_BEFM65WW * m_weight / 1000 m_BEFK65WW = m_BEFK65WW * m_weight / 1000 '!-- Effective retirement age. (Ministry of Health and Social affairs definition) For i = 1 To 6 p(i) = AK5(i + 9) / Bef5(i + 9) Next m_pensage = ((p(1) - p(2)) * 50 + (p(2) - p(3)) * 55 + (p(3) - p(4)) * 60 + _ (p(4) - p(5)) * 65 + (p(5) - p(6)) * 70 + p(6) * 72) / p(1) '-- Labour market macro variables with labour market survey (AKU) definitions '-- Reading data from assumptions file akbef1664_p = parm_macro(maxyear, 16) / 100 al1664_p = parm_macro(maxyear, 17) / 100 aptot_p = parm_macro(maxyear, 18) / 100 apsys_p = parm_macro(maxyear, 19) / 100 ' Fix if data is missing ' If akbef1664_p = 0 Then akbef1664_p = 0.78 ' If al1664_p = 0 Then al1664_p = 0.04 ' If aptot_p = 0 Then aptot_p = 0.02 ' If apsys_p = 0 Then apsys_p = 0.004 If (al1664_p + aptot_p) > 0 Then m_AAL1664 = ((al1664_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000 m_AAPTOT = ((aptot_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000 m_AAPSYS = ((apsys_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000 End If m_ASY1664 = (status(5) + status(8) - (AK5(14) + AK5(15))) * (m_weight / 1000) + m_AAPSYS m_AAK1664 = m_ASY1664 + m_AAL1664 '-- Reguljär sysselsättning 20-64 enligt målet m_ASY2064R = 0 For i = 1 To m_icount If i_age(i) >= 20 And i_age(i) < 65 And (i_status(i) = 5 Or i_status(i) = 8) Then m_ASY2064R = m_ASY2064R + 1 End If Next m_ASY2064R = m_ASY2064R * (m_weight / 1000) '-- Summering av stockar - sum of pension assets ' -- Public premium pension fund - Premiepensionsfonder m_ap_ppfond = (m_ap_ppfond * (1 + (m_shares_return / 100)) * (1 - m_favg_pp)) + _ (((L_SUMVEC(i_pr_pp(1), m_icount) * m_weight) - m_ap_pp_ut) * (1 + (m_interest_short / 100) / 2)) ' -- Occupational pension funds - Avtalspensionsfonder m_op_fond = (m_op_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _ ((L_SUMVEC(i_pr_op_ap(1), m_icount) - L_SUMVEC(i_op_ap_dc(1), m_icount) + _ L_SUMVEC(i_pr_op_tp(1), m_icount) - L_SUMVEC(i_op_ap_tp(1), m_icount)) * _ (1 + (m_interest_short * (1 - 0.15) / 100) / 2) * m_weight) ' -- Private tax deductible pension saving funds - Privat pensionssparande ' Note: 15 % tax (avkastningskatt) on return of pension capital (15% av statslåneräntan egentligen) m_pp_fond = (m_pp_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _ ((L_SUMVEC(i_wealth_pension_year(1), m_icount) - L_SUMVEC(i_pp(1), m_icount)) * _ (1 + ((m_interest_short * (1 - 0.15)) / 100) / 2) * m_weight) '-- Summering av pensionsutgifter från AP-systemet ' If year >= 2003 Then ' m_ap_ip_ut = (L_SUMVEC(i_ap_ip(1), m_icount) * m_weight) _ ' + (0.5 * m_ap_ip_dead) ' End If '-- BNP etc m_bnpaf = parm_macro(maxyear, 22) m_bnpal = parm_macro(maxyear, 21) End Sub
Sub Print_Pension_Cohort() '-- Printing of cohort data for pensions ' age sex abroad variable Dim pens(0 To 106, 2, 2, 15) As Double, pens_n(0 To 106, 2, 2, 15) As Double Dim age As Integer, i As Long, utvar As String Dim A As Integer, s As Integer, v As Integer, u As Integer '-- Summing up For i = 1 To m_icount age = mini(i_age(i), 106) '-- 1 PGI, 2 PGB, 3 PU, 4 PR_IP, 5 PB_IP, 6 AP_AP, 7 AP_TP, 8 AP_IP, ' 9 AP_GP, 10 PR_PP, 11 PB_PP, 12 AP_PP, 13 AP_AVG_AP '-- 1 I_PGI pens(age, i_sex(i), i_abroad(i) + 1, 1) = pens(age, i_sex(i), _ i_abroad(i) + 1, 1) + (i_pgi(i) * m_weight / 1000000) If i_pgi(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 1) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 1) + m_weight End If '-- 2 I_PGB pens(age, i_sex(i), i_abroad(i) + 1, 2) = pens(age, i_sex(i), _ i_abroad(i) + 1, 2) + (i_pgb(i) * m_weight / 1000000) If i_pgb(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 2) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 2) + m_weight End If '-- 3 I_PU pens(age, i_sex(i), i_abroad(i) + 1, 3) = pens(age, i_sex(i), _ i_abroad(i) + 1, 3) + (i_pu(i) * m_weight / 1000000) If i_pu(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 3) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 3) + m_weight End If '-- 4 I_PR_IP pens(age, i_sex(i), i_abroad(i) + 1, 4) = pens(age, i_sex(i), _ i_abroad(i) + 1, 4) + (i_pr_ip(i) * m_weight / 1000000) If i_pr_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 4) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 4) + m_weight End If '-- 5 I_PB_IP pens(age, i_sex(i), i_abroad(i) + 1, 5) = pens(age, i_sex(i), _ i_abroad(i) + 1, 5) + (i_pb_ip(i) * m_weight / 1000000) If i_pb_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 5) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 5) + m_weight End If '-- 6 I_AP_AP pens(age, i_sex(i), i_abroad(i) + 1, 6) = pens(age, i_sex(i), _ i_abroad(i) + 1, 6) + (i_ap_ap(i) * m_weight / 1000000) If i_ap_ap(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 6) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 6) + m_weight End If '-- 7 I_AP_TP pens(age, i_sex(i), i_abroad(i) + 1, 7) = pens(age, i_sex(i), _ i_abroad(i) + 1, 7) + (i_ap_tp(i) * m_weight / 1000000) If i_ap_tp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 7) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 7) + m_weight End If '-- 8 I_AP_IP pens(age, i_sex(i), i_abroad(i) + 1, 8) = pens(age, i_sex(i), _ i_abroad(i) + 1, 8) + (i_ap_ip(i) * m_weight / 1000000) If i_ap_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 8) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 8) + m_weight End If '-- 9 I_AP_GP pens(age, i_sex(i), i_abroad(i) + 1, 9) = pens(age, i_sex(i), _ i_abroad(i) + 1, 9) + (i_ap_gp(i) * m_weight / 1000000) If i_ap_gp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 9) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 9) + m_weight End If '-- 10 I_PR_PP pens(age, i_sex(i), i_abroad(i) + 1, 10) = pens(age, i_sex(i), _ i_abroad(i) + 1, 10) + (i_pr_pp(i) * m_weight / 1000000) If i_pr_pp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 10) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 10) + m_weight End If '-- 11 I_PB_PP pens(age, i_sex(i), i_abroad(i) + 1, 11) = pens(age, i_sex(i), _ i_abroad(i) + 1, 11) + (i_pb_pp(i) * m_weight / 1000000) If i_pb_pp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 11) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 11) + m_weight End If '-- 12 I_AP_PP pens(age, i_sex(i), i_abroad(i) + 1, 12) = pens(age, i_sex(i), _ i_abroad(i) + 1, 12) + (i_ap_pp(i) * m_weight / 1000000) If i_ap_pp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 12) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 12) + m_weight End If '-- 13 I_AVG_IP pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _ i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000) If i_avg_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight End If '-- 13 I_AVG_IP pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _ i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000) If i_avg_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight End If '-- 14 I_PR_IP1 pens(age, i_sex(i), i_abroad(i) + 1, 14) = pens(age, i_sex(i), _ i_abroad(i) + 1, 14) + (i_pr_ip1(i) * m_weight / 1000000) If i_pr_ip1(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 14) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 14) + m_weight End If '-- 15 I_PB_IP1 pens(age, i_sex(i), i_abroad(i) + 1, 15) = pens(age, i_sex(i), _ i_abroad(i) + 1, 15) + (i_pb_ip1(i) * m_weight / 1000000) If i_pb_ip1(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 15) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 15) + m_weight End If Next '-- Printing to file If model_time = 1 Then Open sesimpath & "\tempdata\Pension_Cohort.prn" For Output As #71 utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _ "PGI", "PGB", "PU", "PR_IP", "PB_IP", "AP_AP", "AP_TP", "AP_IP", _ "AP_GP", "PR_PP", "PB_PP", "AP_PP", "AP_AVG_AP", "PR_IP1", "PB_IP1", _ "Arvsv", "ap_favg", "balind", "inkind") Print #71, utvar Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Output As #72 utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _ "PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PB_IP_N", "AP_AP_N", "AP_TP_N", "AP_IP_N", _ "AP_GP_N", "PR_PP_N", "PB_PP_N", "AP_PP_N", "AP_AVG_AP_N""PR_IP1_N", "PB_IP1_N") Print #72, utvar Else Open sesimpath & "\tempdata\Pension_Cohort.prn" For Append As #71 Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Append As #72 End If For A = 0 To 106 For s = 1 To 2 For u = 1 To 2 utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _ pens(A, s, u, 1), pens(A, s, u, 2), pens(A, s, u, 3), pens(A, s, u, 4), _ pens(A, s, u, 5), pens(A, s, u, 6), pens(A, s, u, 7), pens(A, s, u, 8), _ pens(A, s, u, 9), pens(A, s, u, 10), pens(A, s, u, 11), pens(A, s, u, 12), _ pens(A, s, u, 13), pens(A, s, u, 14), pens(A, s, u, 15), _ Arvsvinstfaktor(A), m_favg_ip, m_ap_balind, m_ap_inkind) Print #71, utvar utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _ pens_n(A, s, u, 1), pens_n(A, s, u, 2), pens_n(A, s, u, 3), pens_n(A, s, u, 4), _ pens_n(A, s, u, 5), pens_n(A, s, u, 6), pens_n(A, s, u, 7), pens_n(A, s, u, 8), _ pens_n(A, s, u, 9), pens_n(A, s, u, 10), pens_n(A, s, u, 11), pens_n(A, s, u, 12), _ pens_n(A, s, u, 13), pens_n(A, s, u, 14), pens_n(A, s, u, 15)) Print #72, utvar Next u Next s Next A Close #71 Close #72 End Sub
Sub Print_Pensions_Macro() '!-- Optional printing of macro variables to Aremos-format status "Printing macro variables to Aremos-format" Dim utvar As String Dim demofile As Integer Dim i As Long, h As Long, wm As Double, wk As Double year = model_time + base_year wm = m_weight / 1000000 wk = m_weight / 1000 '-- Some variables for EU AWG04-calculations that requires nested conditions ' Scaling when printing Dim ap_ut As Double, ovr_pens As Double, ovr_pens_n As Long Dim ap_inc_ut As Double, ap_inc_off_ut As Double, pr_op As Double, avg_off As Double Dim ap_ut_n As Long, pens_n As Long, pens_54_n As Long, pens55_59_n As Long, pens60_64_n As Long, pens65_n As Long Dim ap_inc_ut_n As Long, ap_inc_off_ut_n As Long, pr_op_n As Long, avg_off_n As Long Dim afs As Double, afs_n As Long, inc_taxable_2 As Double, tax_income_2 As Double Dim op_off As Double, op_off_n As Long, op_65 As Double, surv_65 As Double For i = 1 To m_icount If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i)) > 0 Then ap_ut = ap_ut + (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i)) ap_ut_n = ap_ut_n + 1 End If If (i_ap_ap(i) + i_ap_pp_ut(i)) > 0 Then ap_inc_ut = ap_inc_ut + (i_ap_ap(i) + i_ap_pp_ut(i)) ap_inc_ut_n = ap_inc_ut_n + 1 If (i_sector(i) = 3 Or i_sector(i) = 4) Then ap_inc_off_ut = ap_inc_off_ut + (i_ap_ap(i) + i_ap_pp_ut(i)) ap_inc_off_ut_n = ap_inc_off_ut_n + 1 End If End If If (i_ftp(i) + i_surv(i)) > 0 Then ovr_pens = ovr_pens + i_ftp(i) + i_surv(i) ovr_pens_n = ovr_pens_n + 1 End If If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i) + i_ftp(i) + i_surv(i) + i_op(i)) > 0 Then pens_n = pens_n + 1 Select Case i_age(i) Case Is < 54 pens_54_n = pens_54_n + 1 Case Is < 59 pens55_59_n = pens55_59_n + 1 Case Is < 64 pens60_64_n = pens60_64_n + 1 Case Else pens65_n = pens65_n + 1 End Select End If If (i_sector(i) = 3 Or i_sector(i) = 4) And i_avg(i) > 0 Then avg_off = avg_off + i_avg(i) avg_off_n = avg_off_n + 1 End If If (i_sector(i) = 3 Or i_sector(i) = 4) Then op_off = op_off + i_op(i) op_off_n = op_off_n + 1 End If If (i_pr_op_ap(i) + i_pr_op_tp(i)) > 0 Then pr_op = pr_op + i_pr_op_ap(i) + i_pr_op_tp(i) pr_op_n = pr_op_n + 1 End If If i_age(i) > 64 Then surv_65 = surv_65 + i_surv(i) op_65 = op_65 + i_op(i) End If If i_status(i) = 2 Then inc_taxable_2 = inc_taxable_2 + i_inc_taxable(i) tax_income_2 = tax_income_2 + i_tax_income(i) End If Next For h = 1 To m_hcount If h_max_age(h) > 64 Then afs = afs + h_trf_socialassistance(h) afs_n = afs_n + 1 End If Next If model_time = 0 Then Open sesimpath & "\tempdata\Labour_macro.prn" For Output As #41 utvar = f_Concat_string_cita("DATE", "AKT1664", "BEFM1664", "BEFK1664", _ "AKM1619", "AKM2024", "AKM2529", "AKM3034", "AKM3539", "AKM4044", "AKM4549", _ "AKM5054", "AKM5559", "AKM6064", "AKM6569", "AKM7074", _ "AKK1619", "AKK2024", "AKK2529", "AKK3034", "AKK3539", "AKK4044", "AKK4549", _ "AKK5054", "AKK5559", "AKK6064", "AKK6569", "AKM7074", _ "BEFM1619", "BEFM2024", "BEFM2529", "BEFM3034", "BEFM3539", "BEFM4044", "BEFM4549", _ "BEFM5054", "BEFM5559", "BEFM6064", "BEFM6569", "BEFM7074", _ "BEFK1619", "BEFK2024", "BEFK2529", "BEFK3034", "BEFK3539", "BEFK4044", "BEFK4549", _ "BEFK5054", "BEFK5559", "BEFK6064", "BEFK6569", "BEFM7074", _ "BEFM0015", "BEFK0015", "BEFM65WW", "BEFK65WW", _ "BEFM0014", "BEFK0014", "BEFM1519", "BEFK1519", _ "AAL1664", "AAPTOT", "AAPSYS", "ASY1664", "AAK1664", "ASY2064R", _ "ALM1619", "ALM2024", "ALM2529", "ALM3034", "ALM3539", "ALM4044", "ALM4549", _ "ALM5054", "ALM5559", "ALM6064", "ALM6569", "ALM7074", _ "ALK1619", "ALK2024", "ALK2529", "ALK3034", "ALK3539", "ALK4044", "ALK4549", _ "ALK5054", "ALK5559", "ALK6064", "ALK6569", "ALM7074") Print #41, utvar Open sesimpath & "\tempdata\Pensions_macro.prn" For Output As #42 utvar = f_Concat_string_cita("DATE", _ "INC_TAX", "PGI", "PGB", "PU", "PR_IP", "PR_PP", "PB_IP", "PB_PP", "FP", "ATP", "AP", _ "AP_IP", "AP_PP", "AP_GP", "AP_TP", "OP", "SURV", "FTP", "AVG_IP", "AVG", "INC_WORK", _ "INC_EARN", "INC_MARK", _ "RWAGE", "RWAGE_99", "INFLATION", "PRICE_99", "BASB", _ "BASB_F", "BASB_INC", "INKIND", "BALIND", "Int_short", "Int_long", _ "PENSAGE", "DTALIP_65", "DTALPP_65", "ARVSV_60", "Shares_Return", "PP", _ "AP_GP_EJ_AP", "AP_AP_SV", "AP_AP_UTL", "pgi_bas", "pgi_bas_gt", _ "PR_IP1", "PR_PP1", _ "AP_IP_UT", "AP_TP_UT", "AP_ATP_UT", "AP_FP30_UT", "AP_PP_UT", "EXPLIFE65", _ "PP_fund", "PP_save") Print #42, utvar Open sesimpath & "\tempdata\Pensions_count.prn" For Output As #43 utvar = f_Concat_string_cita("DATE", _ "INC_TAX_N", "PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PR_PP_N", "PB_IP_N", "PB_PP_N", _ "FP_N", "ATP_N", "AP_N", "AP_IP_N", "AP_PP_N", "AP_GP_N", "AP_TP_N", "OP_N", _ "SURV_N", "FTP_N", "AVG_IP_N", "AVG_N", "INC_WORK_N", "INC_EARN_N", "INC_MARK_N", "PP_N", _ "AP_GP_EJ_AP_N", "AP_AP_NSV", "AP_AP_NUTL", "pgi_bas_n", "pgi_bas_gt_n", "PP_fund_n", "PP_save_n") Print #43, utvar Open sesimpath & "\tempdata\Transfers_macro.prn" For Output As #44 utvar = f_Concat_string_cita("DATE", "STSHPEAVT", "STKHPEAVT", "ap", "atp", _ "tp", "ip", "ap_pp", "gp", "fp", "STSHFORT", "STSHEFTANK", "STSHEFTBARN", _ "STSHBTP", "STSHSJUK", "STSHFORF", "STSHARBSK", "unemployed", "STSHBARN", _ "study", "STSHSTUDMED", "Study_loan", "STSHBOBI", _ "bidfor_brutto", "STKHSOCBI", "PGI_BAS", "BNPAF", "BNPAL", "STSHBTP_65") Print #44, utvar Open sesimpath & "\tempdata\AWG04_macro.prn" For Output As #45 utvar = f_Concat_string_cita("DATE", "ap_ut", "ap_inc_ut", "ap_inc_off_ut", _ "ovr_pens", "avg_off", "pr_op", "ap_ut_n", "ap_inc_ut_n", "ap_inc_off_ut_n", "ovr_pens_n", _ "pens_n", "pens_54_n", "pens55_59_n", "pens60_64_n", "pens65_n", "avg_off_n", "pr_op_n", _ "AFS", "AFS_n", "inc_taxable_2", "tax_income_2", "ap_ppfond", "pp_fond", "op_fond", _ "op_off", "op_off_n", "surv_65", "op_65") Print #45, utvar Else Open sesimpath & "\tempdata\Labour_macro.prn" For Append As #41 Open sesimpath & "\tempdata\Pensions_macro.prn" For Append As #42 Open sesimpath & "\tempdata\Pensions_count.prn" For Append As #43 Open sesimpath & "\tempdata\Transfers_macro.prn" For Append As #44 Open sesimpath & "\tempdata\AWG04_macro.prn" For Append As #45 End If utvar = f_Concat_string_space(year & "01", m_AKT1664, m_BEFM1664, m_BEFK1664, _ m_AKM1619, m_AKM2024, m_AKM2529, m_AKM3034, m_AKM3539, m_AKM4044, m_AKM4549, _ m_AKM5054, m_AKM5559, m_AKM6064, m_AKM6569, m_AKM7074, _ m_AKK1619, m_AKK2024, m_AKK2529, m_AKK3034, m_AKK3539, m_AKK4044, m_AKK4549, _ m_AKK5054, m_AKK5559, m_AKK6064, m_AKK6569, m_AKM7074, _ m_BEFM1619, m_BEFM2024, m_BEFM2529, m_BEFM3034, m_BEFM3539, m_BEFM4044, m_BEFM4549, _ m_BEFM5054, m_BEFM5559, m_BEFM6064, m_BEFM6569, m_BEFM7074, _ m_BEFK1619, m_BEFK2024, m_BEFK2529, m_BEFK3034, m_BEFK3539, m_BEFK4044, m_BEFK4549, _ m_BEFK5054, m_BEFK5559, m_BEFK6064, m_BEFK6569, m_BEFM7074, _ m_BEFM0015, m_BEFK0015, m_BEFM65WW, m_BEFK65WW, _ m_BEFM0014, m_BEFK0014, m_BEFM1519, m_BEFK1519, _ m_AAL1664, m_AAPTOT, m_AAPSYS, m_ASY1664, m_AAK1664, m_ASY2064R, _ m_ALM1619, m_ALM2024, m_ALM2529, m_ALM3034, m_ALM3539, m_ALM4044, m_ALM4549, _ m_ALM5054, m_ALM5559, m_ALM6064, m_ALM6569, m_ALM7074, _ m_ALK1619, m_ALK2024, m_ALK2529, m_ALK3034, m_ALK3539, m_ALK4044, m_ALK4549, _ m_ALK5054, m_ALK5559, m_ALK6064, m_ALK6569, m_ALK7074) Print #41, utvar Close #41 utvar = f_Concat_string_space(year & "01", _ (L_SUMVEC(i_inc_taxable(1), m_icount) * wm), (L_SUMVEC(i_pgi(1), m_icount) * wm), _ (L_SUMVEC(i_pgb(1), m_icount) * wm), (L_SUMVEC(i_pu(1), m_icount) * wm), _ (L_SUMVEC(i_pr_ip(1), m_icount) * wm), (L_SUMVEC(i_pr_pp(1), m_icount) * wm), _ (L_SUMVEC(i_pb_ip(1), m_icount) * wm), (L_SUMVEC(i_pb_pp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _ (L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _ (L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_op(1), m_icount) * wm), _ (L_SUMVEC(i_surv(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _ (L_SUMVEC(i_avg_ip(1), m_icount) * wm), (L_SUMVEC(i_avg(1), m_icount) * wm), _ (L_SUMVEC(i_inc_work(1), m_icount) * wm), _ (L_SUMVEC(i_inc_earning(1), m_icount) * wm), (L_SUMVEC(i_inc_market(1), m_icount) * wm), _ m_realwage, m_realwage_change99, m_inflation, m_price_change99, m_basbelopp, _ m_basbelopp_f, m_basbelopp_income, m_ap_inkind, m_ap_balind, m_interest_short, m_interest_long, _ m_pensage, m_dtalip_65, m_dtalpp_65, m_arvsvinst_60, m_shares_return, (L_SUMVEC(i_pp(1), m_icount) * wm), _ (sumif(i_ap_gp, i_ap_ap, "EQ", 0) * wm), (sumif(i_ap_ap, i_abroad, "EQ", 0) * wm), _ (sumif(i_ap_ap, i_abroad, "EQ", 1) * wm), m_pgi_bas / 1000000, m_pgi_bas_gt_basb / 1000000, _ (L_SUMVEC(i_pr_ip1(1), m_icount) * wm), (L_SUMVEC(i_pr_pp1(1), m_icount) * wm), _ m_ap_ip_ut / 1000000, m_ap_tp_ut / 1000000, m_ap_atp_ut / 1000000, _ m_ap_fp30_ut / 1000000, m_ap_pp_ut / 1000000, explife(65), _ (L_SUMVEC(i_wealth_pension_total(1), m_icount) * wm), (L_SUMVEC(i_wealth_pension_year(1), m_icount) * wm)) Print #42, utvar Close #42 utvar = f_Concat_string_space(year & "01", _ cnt0(i_inc_taxable) * wk, cnt0(i_pgi) * wk, _ cnt0(i_pgb) * wk, cnt0(i_pu) * wk, _ cnt0(i_pr_ip) * wk, cnt0(i_pr_pp) * wk, _ cnt0(i_pb_ip) * wk, cnt0(i_pb_pp) * wk, _ cnt0(i_ap_fp) * wk, cnt0(i_ap_atp) * wk, _ cnt0(i_ap) * wk, cnt0(i_ap_ip) * wk, _ cnt0(i_ap_pp) * wk, cnt0(i_ap_gp) * wk, _ cnt0(i_ap_tp) * wk, cnt0(i_op) * wk, _ cnt0(i_surv) * wk, cnt0(i_ftp) * wk, _ cnt0(i_avg_ip) * wk, cnt0(i_avg) * wk, _ cnt0(i_inc_work) * wk, _ cnt0(i_inc_earning) * wk, cnt0(i_inc_market) * wk, _ cnt0(i_pp) * wk, _ cntstatusif(i_ap_gp, i_ap_ap, "EQ", 0, 2) * wk, _ cntstatusif(i_ap_ap, i_abroad, "EQ", 0, 2) * wk, _ cntstatusif(i_ap_ap, i_abroad, "EQ", 1, 2) * wk, _ m_pgi_bas_n, m_pgi_bas_gt_basb_n, _ cnt0(i_wealth_pension_total) * wk, cnt0(i_wealth_pension_year) * wk) Print #43, utvar Close #43 utvar = f_Concat_string_space(year & "01", _ (sumif(i_op, i_sector, "EQ", 3) * wm), (sumif(i_op, i_sector, "EQ", 4) * wm), _ (L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _ (L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _ (sumif(i_surv, i_age, "GT", 17) * wm), (sumif(i_surv, i_age, "LT", 18) * wm), _ (L_SUMVEC(h_trf_btp(1), m_hcount) * wm), (L_SUMVEC(i_trf_sickleave(1), m_icount) * wm), _ (L_SUMVEC(i_trf_parentleave(1), m_icount) * wm), (L_SUMVEC(i_trf_skada(1), m_icount) * wm), _ (L_SUMVEC(i_trf_unemployed(1), m_icount) * wm), (L_SUMVEC(h_trf_childallowance(1), m_hcount) * wm), _ (L_SUMVEC(i_trf_study(1), m_icount) * wm), (L_SUMVEC(i_trf_study_grant(1), m_icount) * wm), _ (L_SUMVEC(i_trf_study_loan(1), m_icount) * wm), (L_SUMVEC(h_trf_housingallowance(1), m_hcount) * wm), _ (L_SUMVEC(h_maintenance_received(1), m_hcount) * wm), (L_SUMVEC(h_trf_socialassistance(1), m_hcount) * wm), _ (L_SUMVEC(i_pgi_bas(1), m_icount) * wm), m_bnpaf, m_bnpal, (sumif(h_trf_btp, i_age, "GT", 64) * wm)) Print #44, utvar Close #44 utvar = f_Concat_string_space(year & "01", _ ap_ut * wm, ap_inc_ut * wm, ap_inc_off_ut * wm, ovr_pens * wm, avg_off * wm, pr_op * wm, _ ap_ut_n * wk, ap_inc_ut_n * wk, ap_inc_off_ut_n * wk, ovr_pens_n * wk, _ pens_n * wk, pens_54_n * wk, pens55_59_n * wk, pens60_64_n * wk, pens65_n * wk, _ avg_off_n * wk, pr_op_n * wk, afs * wm, afs_n * wk, inc_taxable_2 * wm, tax_income_2 * wm, _ m_ap_ppfond / 1000000, m_pp_fond / 1000000, m_op_fond / 1000000, op_off * wm, op_off_n * wk, _ surv_65 * wk, op_65 * wk) Print #45, utvar Close #45 End Sub
'-- Counts element i vector not equal 0
Public Function cnt0(x) As Long Dim i As Long cnt0 = 0 For i = 1 To UBound(x) If x(i) <> 0 Then cnt0 = cnt0 + 1 End If Next End Function
'-- Count number of persons in a status conditioned on an other vector
Public Function cntstatusif(x, ifvar, ifop, ifval, status) As Long Dim i As Long cntstatusif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) = ifval And i_status(i) = status Then cntstatusif = cntstatusif + 1 End If Next Case "GT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) > ifval And i_status(i) = status Then cntstatusif = cntstatusif + 1 End If Next Case "LT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) < ifval And i_status(i) = status Then cntstatusif = cntstatusif + 1 End If Next End Select End Function
'-- Sum of vector conditioned on an other vector
Public Function sumif(x, ifvar, ifop, ifval) As Double Dim i As Long sumif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If ifvar(i) = ifval Then sumif = sumif + x(i) End If Next Case "GT" For i = 1 To UBound(x) If ifvar(i) > ifval Then sumif = sumif + x(i) End If Next Case "LT" For i = 1 To UBound(x) If ifvar(i) < ifval Then sumif = sumif + x(i) End If Next Case "NE" For i = 1 To UBound(x) If ifvar(i) <> ifval Then sumif = sumif + x(i) End If Next End Select End Function
Public Function f_m_ap_pensage() As Double Dim n As Long, i As Long n = 1 For i = 1 To m_icount If i_status(i) = 2 And i_status1(i) <> 2 Then f_m_ap_pensage = f_m_ap_pensage + i_ap_pensmonth(i) n = n + 1 End If Next f_m_ap_pensage = Int(f_m_ap_pensage / 12) / n + 65 End Function
'-- Count number of persons conditioned on an other vector
Public Function cntif(x, ifvar, ifop, ifval) As Long Dim i As Long cntif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) = ifval Then cntif = cntif + 1 End If Next Case "GT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) > ifval Then cntif = cntif + 1 End If Next Case "LT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) < ifval Then cntif = cntif + 1 End If Next End Select End Function
Sub Print_elderly_care_micro() '!-- Optional printing of data for analysis of elderly care(micro data) status "Printing elderly care micro file" Dim utvar As String Dim demofile As Integer Dim i As Long, h As Long year = model_time + base_year If year = 1999 Then Open sesimpath & "\tempdata\i_elderly_micro.txt" For Output As #33 utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_hhnr", _ "i_age", "i_sex", "i_civ_stat", "i_abroad", "i_status", _ "i_edlevel", "i_born_year ", _ "i_inc_taxable", "i_inc_capital", "i_pc_elderly", "m_basbelopp", "m_basbelopp_income") Print #33, utvar Close #33 Open sesimpath & "\tempdata\h_elderly_micro.txt" For Output As #34 utvar = f_Concat_string_comma("h", "year", "h_hhnr", "h_size", "h_max_age", _ "h_inc_disposable", "h_wealth_financial", "h_wealth_real", _ "h_n_child", "h_n_adults", "h_house_cost") Print #34, utvar Close #34 End If If year = 1999 Or year = 2003 Or year = 2015 Or year = 2025 Then Open sesimpath & "\tempdata\i_elderly_micro.txt" For Append As #33 For i = 1 To m_icount utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_hhnr(i), _ i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), i_status(i), _ i_edlevel(i), i_born_year(i), _ i_inc_taxable(i), i_inc_capital(i), i_pc_elderly(i), m_basbelopp, m_basbelopp_income) Print #33, utvar Next i Close #33 Open sesimpath & "\tempdata\h_elderly_micro.txt" For Append As #34 For h = 1 To m_hcount utvar = f_Concat_string_comma(h, year, h_hhnr(h), h_size(h), h_max_age(h), _ h_inc_disposable(h), h_wealth_financial(h), h_wealth_real(h), _ h_n_child(h), h_n_adults(h), h_house_cost(h)) Print #34, utvar Next h Close #34 End If 'year End Sub
'************************************************************************************* '************************************************************************************* '************************************************************************************* '************************************************************************************* #Else ' End compilation of BabyBoom version '******* a06_Pension_Rules - Calculates pension benefits, pension rights etc ******* ' ---------------------------------------------------------- ' -- Approximative mneumonics (in swenglish) ' i_{tt}_{ss}_{ee} ' tt = type of pension ' ss = program ' qq = qualifying part ' i_ap = ålderspension = old age pensions ' i_ftp = förtidspension = disabilty pensions ' i_op = avtalspension = occupational pensions ' i_surv = efterlevandepension = survivors pensions ' i_pi = private insurance ' i_pr_ = pensionsunderlag = pension rights ' i_pb_ = pensionsbehållning = cumulative pension rights ' i_{tt}_fp = folkpension = basic pension ' i_{tt}_atp = ATP = national supplemental pension ' i_{tt}_fp = folkpension = national basic pension ' i_{tt}_ip = inkomstpension ' i_{tt}_gp = garantipension ' i_{tt}_tp = reformerad ATP = reformed supplemental pe ' i_{tt}_pp = national premium pension ' i_{tt}_ap = other old age pension ' i_{tt}_pts = PTS = basic pension supplement ' barn ' ank ' f_ = prefix indicating function ' ---------------------------------------------------------- Option Explicit Option Base 1 'Private f_utfasning_ATP As Double Public z_ap_atp As Double Private year As Integer Dim pnames(100) As String Dim pvalues(100) As Variant
Public Sub Calculate_Disability_Pension(i As Long) '! Calculation of disability pension benefits '*** EGENTLIGEN SKA FÖRÄLDRAR TILL FÖRTIDSPENSIONÄRER YNGRE ÄN 19 HA VÅRDBIDRAG Dim ftp_antag_p As Double ' Pensionsrätt för förtidspensionärer, antagandepoäng Dim ftp_antag_p1 As Double ' do hjälpvariabel Dim ftp_antag_p2 As Double ' do hjälpvariabel Dim pp4(4) As Double ' do hjälpvariabel Vektor med senaste 4 årens pensionspoäng Dim n As Long, y As Long ' do hjälpvariabel Dim antag_bo_tid As Long ' Antagen bosättningstid (qualifying years for disabled) Dim bokvot As Double ' Bosättningstidskvot Dim ftp_pts_kvot As Double ' Parameter för beräkning av PTS för förtidpens och sjukbidrag Dim ftp_fp_kvot_gifta As Double ' Parameter vid beräkning av folkpension, gifta Dim ftp_fp_kvot_ogifta As Double ' Parameter vid beräkning av folkpension, ogifta ftp_pts_kvot = 1.129 ' *** Kan ligga i parameterfil ftp_fp_kvot_gifta = 0.725 ' *** Kan ligga i parameterfil ftp_fp_kvot_ogifta = 0.9 ' *** Kan ligga i parameterfil year = model_time + base_year ' -- Calculate & updates qualifying points antagandepoäng / antagandeinkomst If i_status1(i) <> 4 Or (i_status1(i) = 4 And i_age(i) = 19) Then ' New Disability pensioner If year < 2003 Then '-- Old system ' Villkor: Antingen ATP-poäng för minst 2 av de 4 åren närmast föregående pensionsfallet ' eller SGI > basb samt minst 1 historisk ATP-poäng If pp_hist(i).n_years >= 4 Then n = 0 For y = pp_hist(i).n_years - 3 To pp_hist(i).n_years If pp_hist(i).pp_years(y) >= year - 4 Then pp4(n + 1) = pp_hist(i).pp(y) n = n + 1 End If Next End If ' -- Förvärvsvillkor If (i_inc_taxable(i) >= m_basbelopp And pp_hist(i).n_years > 0) Or n >= 2 Then ' Alt 1: Average of ATP-points: The 2 best years of the last 4 If pp_hist(i).n_years >= 4 Then Select Case n Case Is > 1 ' -- Snitt av två bästa Call Sort(pp4, True) ftp_antag_p1 = (pp4(1) + pp4(2)) / 2 Case 1 ' -- Om endast 1 år 50% av detta ftp_antag_p1 = pp4(1) / 2 Case 0 ' -- Det kan hända att inget av åren var nära i tiden ftp_antag_p1 = 0 End Select End If ' Alt 2: Medeltalet av bästa hälften av alla Dim pp_sort() As Integer ' -- Kopierar vektorn för sortering pp_sort = pp_hist(i).pp Call Sort(pp_sort, True) ftp_antag_p2 = 0 If pp_hist(i).n_years > 1 Then For y = 1 To Int((pp_hist(i).n_years / 2) + 0.5) ftp_antag_p2 = ftp_antag_p2 + pp_sort(y) '****pp_hist(i).pp(y) Next ftp_antag_p2 = ftp_antag_p2 / Int((pp_hist(i).n_years / 2) + 0.5) Else ftp_antag_p2 = pp_sort(1) End If ' -- Choosing best alternative for the disabled ftp_antag_p = maxi(ftp_antag_p1, ftp_antag_p2) '-- Updating pension history pensionspoängsvektorn Call Update_pp_hist(i, CInt(ftp_antag_p)) '-- Calculating qualifying income in SEK i_ftp_antag(i) = ((ftp_antag_p / 100) + 1) * m_basbelopp_f End If Else '-- New system from 2003 'Qualifying points in new system If i_pgi(i) > 0 Or pp_hist(i).n_years > 0 Then '-- Right to income based disab pens if 1 or more PGI-years i_ftp_antag(i) = f_qualif_inc(i) '-- Updating pension history pensionspoängsvektorn ' LÄGGER TILL VILLKOR SÅ ATT PP-VEKTORN ENDAST UPPDATERAS MED VÄRDEN STÖRRE ÄN 1 BASBELOPP If (i_ftp_antag(i) - m_basbelopp_f) > 0 Then Call Update_pp_hist(i, CInt(((i_ftp_antag(i) - m_basbelopp_f) / m_basbelopp_f) * 100)) End If End If 'pgi End If ' year < 2003 Else '-- This individual was disabled last year ' -- Only disability pensioners with qualifying points If pp_hist(i).n_years > 0 Then ' -- Disab pensioner last year, gets same pensionrights as last year If m_ftp_Inkindex_On = 0 Then '-- Optional income indexation of paid out disability pensions ftp_antag_p = pp_hist(i).pp(pp_hist(i).n_years) i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f) Else '-- Antagandeinkomsten assumed income indexed ftp_antag_p = (((((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1)) * _ ((m_ap_inkind / m_ap_inkind1) - (m_KPI - 1))) - 1) * 100 i_ftp_antag(i) = (((ftp_antag_p / 100) + 1) * m_basbelopp_f) End If Call Update_pp_hist(i, CInt(ftp_antag_p)) End If End If '-- i_status1(i) <> 4 ' -- Calculate benefits with price-correction If year < 2004 Then ' -- ATP If pp_hist(i).n_years > 0 Then i_ftp_atp(i) = 0.6 * (pp_hist(i).pp(pp_hist(i).n_years) / 100) _ * m_basbelopp * mini(1, (pp_hist(i).n_years + (65 - i_age(i)) / 30)) End If ' -- Folkpension & PTS antag_bo_tid = i_botid(i) + (65 - i_age(i)) * _ mini(1, i_botid(i) / 0.8 * (maxi(i_age(i), 17) - 16)) bokvot = maxi(mini(1, antag_bo_tid / 40), mini(1, pp_hist(i).n_years / 30)) If antag_bo_tid >= 3 Then ' -- Minst 3 bosättningsår krävs f folkpen & PTS ' -- Folkpension If i_civ_stat(i) = 0 Then i_ftp_fp(i) = ftp_fp_kvot_ogifta * m_basbelopp * bokvot Else i_ftp_fp(i) = ftp_fp_kvot_gifta * m_basbelopp * bokvot End If ' -- PTS i_ftp_pts(i) = bokvot * maxi((ftp_pts_kvot * m_basbelopp) - i_ftp_atp(i), 0) Else i_ftp_fp(i) = 0 i_ftp_pts(i) = 0 End If i_ftp(i) = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i) End If '-- New disabbility pension system after 2002 If year >= 2003 Then If i_age(i) >= 19 Then If i_age(i) = 19 Or (i_status1(i) <> 4 And i_age(i) < 30) Then i_ftp_typ(i) = 1 ElseIf i_ftp_typ(i) = 1 And i_age(i) >= 30 Then End If If i_ftp_typ(i) = 1 And i_age(i) >= 30 Then i_ftp_typ(i) = 0 End If '-- Income related part i_ftp_ink(i) = 0.64 * i_ftp_antag(i) '-- i_ftp_antag optionally income indexed, see above i_ftp_just(i) = (i_ftp_just(i) / m_basbelopp1) * m_basbelopp '** No income indexation: Transitional '-- Guaranteed level (Rules on limit on insurance time not implemented ' m_ftp_Inkindex_On = 0 0> m_basbelopp_ftp = m_basbelopp, else income indexed i_ftp_gar(i) = maxi(0, (f_disab_guarantee(i_age(i)) * m_basbelopp_ftp * _ mini(1, (i_botid(i) + (65 - i_age(i))) / 40)) - i_ftp_ink(i)) i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up Else i_ftp(i) = 0 i_ftp_ink(i) = 0 i_ftp_gar(i) = 0 i_ftp_just(i) = 0 End If End If '-- Transition rules: Recalculation of old disab pension rights Dim omv_bruttoers As Long Dim fakt_bruttoers As Long Dim SGA_bel As Long Dim ber_gar As Long If year = 2003 And i_status1(i) = 4 Then '-- Only for old disablity pensioners If i_age(i) >= 19 Then fakt_bruttoers = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i) SGA_bel = maxi(0, (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _ (f_SGA_2002(fakt_bruttoers, i_civ_stat(i), m_basbelopp) - _ f_basic_deduction_2002(fakt_bruttoers, m_basbelopp))) omv_bruttoers = fakt_bruttoers + SGA_bel ber_gar = (omv_bruttoers - (f_local_taxrate(i, 2002) / (1 - f_local_taxrate(i, 2002))) * _ (f_basic_deduction_2002(omv_bruttoers, m_basbelopp) - _ f_basic_deduction_2002(fakt_bruttoers, m_basbelopp))) _ - i_ftp_ink(i) i_ftp_just(i) = maxi(0, ber_gar - i_ftp_gar(i)) '-- Not negative 'i_ftp_just(i) = ber_gar - i_ftp_gar(i) i_ftp(i) = i_ftp_ink(i) + i_ftp_gar(i) + i_ftp_just(i) '-- Summing up Else i_ftp(i) = 0 i_ftp_ink(i) = 0 i_ftp_gar(i) = 0 i_ftp_just(i) = 0 End If End If '-- New system replaces old benefits 2003 If year = 2003 Then i_ftp_atp(i) = 0 i_ftp_fp(i) = 0 i_ftp_pts(i) = 0 End If End Sub
'****** EJ KLAR!! ARBETAR MED DENNA PROCEDUR *****
Public Sub Calculate_Work_Injuries() Dim i As Long For i = 1 To m_icount If i_trf_skada(i) > 0 Then If i_age(i) >= 65 Then i_trf_skada(i) = 0 Else 'Indexation i_trf_skada(i) = i_trf_skada(i) End If End If Next i End Sub
Public Function f_local_taxrate(idx As Long, year) '!-- Local tax rate for different years Select Case year Case Is >= 2006 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt06 / 100 Case 1999 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt99 / 100 Case 2000 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt00 / 100 'satserna efter 99 betydligt lägre ?? Case 2001 ' ThP beror kanske på kyrkoavgiften?? f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt01 / 100 Case 2002 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt02 / 100 Case 2003 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt03 / 100 Case 2004 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt04 / 100 Case 2005 f_local_taxrate = kommundata(h_kommunindex(hhnr2index(i_hhnr(idx)))).skatt05 / 100 End Select End Function
Public Function f_ramtid(age As Byte) As Byte '!-- Qualifying time in new disability pension system Select Case age Case Is < 47 f_ramtid = 8 Case Is < 50 f_ramtid = 7 Case Is < 53 f_ramtid = 6 Case Is >= 53 f_ramtid = 5 End Select End Function
'-- Antagandeinkomst from 2003 enligt lag 1963:381 "Om antagandeinkomst" ' Funktionen bortser från specialregler i 8§ om aktivitetsersättningen
Public Function f_qualif_inc(idx As Long) As Long '!-- Disablity pensions qualifying income from 2003 Dim i As Integer Dim n As Integer Dim inc_average As Long Dim inc(1 To 8) As Double Dim ramtid As Byte inc(1) = i_inc_taxable1(idx) * 1.07 / m_basbelopp1 inc(2) = i_inc_taxable2(idx) * 1.07 / m_basbelopp2 inc(3) = i_inc_taxable3(idx) * 1.07 / m_basbelopp3 inc(4) = i_inc_taxable4(idx) * 1.07 / m_basbelopp4 inc(5) = i_inc_taxable5(idx) * 1.07 / m_basbelopp5 '-- Note: pp_hist truncated for incomes from 0 to 1 basic amount Select Case pp_hist(idx).n_years Case Is > 7 inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07 inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07 inc(8) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 7) / 100) + 1) * 1.07 Case 7 inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07 inc(7) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 6) / 100) + 1) * 1.07 inc(8) = 0 Case 6 inc(6) = ((pp_hist(idx).pp(pp_hist(idx).n_years - 5) / 100) + 1) * 1.07 inc(7) = 0 inc(8) = 0 Case Else inc(6) = 0 inc(7) = 0 inc(8) = 0 End Select '-- Truncation at 7.5 basic amounts For n = 1 To 5 inc(n) = mini(7.5, inc(n)) Next 'sortera inc 1 to f_ramtid(i_age(idx) till inc_sort ramtid = f_ramtid(i_age(idx)) ReDim inc_sort(1 To ramtid) As Double ' -- Kopierar vektorn för sortering For n = 1 To ramtid inc_sort(n) = inc(n) Next Call Sort(inc_sort, True) f_qualif_inc = ((inc_sort(1) + inc_sort(2) + inc_sort(3)) / 3) * m_basbelopp ' **** NOT IMPLEMENTED **** '-- Lite andra villkor för aktivitetsers ' If i_age(idx) < 30 Then ' Select Case n ' Case 1 ' Case 2 ' Case 3 ' End Select ' End If End Function
Public Function f_disab_guarantee(age As Byte) As Double '!-- Calculates guaranteed level in basic amounts in new disability pensions system Select Case age Case Is >= 30 f_disab_guarantee = 2.4 Case Is < 21 f_disab_guarantee = 2.1 Case Is < 23 f_disab_guarantee = 2.15 Case Is < 25 f_disab_guarantee = 2.2 Case Is < 27 f_disab_guarantee = 2.25 Case Is < 29 f_disab_guarantee = 2.3 Case 29 f_disab_guarantee = 2.35 End Select End Function
Public Function f_SGA_2002(ink As Long, civ_stat As Byte, basbelopp As Long) As Double '!-- Särskilt grundavdrag 2002 (Bygger på a05 f_basic_deduction) '! Used for calculation of transition to new disability pension system Dim sga As Double Dim sgae As Double Dim sgag As Double Dim sgaproc As Double Dim sgamax As Double Dim sgared As Double sgae = 1.5749 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR OGIFT FOLKPENS sgag = 1.3969 * basbelopp 'SÄRSKILT GRUNDAVDR FÖR GIFT FOLKPENS sgaproc = 0.665 'NEDTRAPPNINGSPROC SÄRSKILT GRUNDAVDRAG '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) f_SGA_2002 = round(sgared, -2) If f_SGA_2002 > ink Then f_SGA_2002 = ink End Function
Public Function f_basic_deduction_2002(ink, basbelopp As Long) As Double '!-- Basic deduction 2002 (Bygger på a05 f_basic_deduction) Dim g As Double Dim i As Integer Dim limits(1 To 9) As Double Dim lutning(1 To 8) As Double Dim xgr As Double limits(1) = 0 limits(2) = 0.293 * basbelopp limits(3) = 1.86 * basbelopp limits(4) = 2.89 * basbelopp limits(5) = 3.04 * basbelopp limits(6) = 9E+99 * basbelopp limits(7) = 0 limits(8) = 0 limits(9) = 0 lutning(1) = 1 lutning(2) = 0 lutning(3) = 0.25 lutning(4) = 0 lutning(5) = -0.1 lutning(6) = 0 lutning(7) = 0 lutning(8) = 0 xgr = Int((0.293 * basbelopp + 99) / 100) * 100 ' LÄGSTA GRUNDAVDRAG g = 0 i = LBound(limits) + 1 Do Until ink <= limits(i) If ink > limits(i) Then g = g + (limits(i) - limits(i - 1)) * lutning(i - 1) i = i + 1 Loop g = g + (ink - limits(i - 1)) * lutning(i - 1) If g < limits(LBound(limits) + 1) Then g = limits(LBound(limits) + 1) If ink > xgr Then g = maxi(xgr, g) If base_year + model_time < 2001 Then g = Int(g / 100) * 100 Else g = Int((g + 99.9) / 100) * 100 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 f_basic_deduction_2002 = g End Function
'-- Calculation of survivors pension Efterlevandepensioner ' Call from x03_Service - delete_individuals whenever a cohabiting person dies ' Only calculation of widow and children pensions currently ' Se also procedure Update_Survivors_pension in this module '**** Only calc of aggregate i_surv, not divided in i_surv_atp and i_surv_fp now '**** Som det är nu är endast en schablonregel med ett basb per änke och barnpens med ' 1 stämmer ungefär för 2005. '**** Egentligen ska man ha 90% av basb+PTS 62,9% (bökiga reglöer f inkomstprövning) ' 40% av mannens ATP, 35% om det finns barn, 15% f 1:a barnet, 10% f ytterligare barn ' (fördelas lika mellan barnen)
Public Sub Calculate_Survivors_pension(i As Long) '!-- Calculation of survivors pension Efterlevandepensioner Dim surv_nr As Long 'Indexnr for survivor 'Dim child_nr As Long 'Indexnr for surviving child Dim civ_stat_dat As Integer Dim widow_base_atp As Double, child_base_atp As Double, widow_base_fp As Double Dim child_base_fp As Double, surv_base_omst As Double Dim basbelopp As Long surv_nr = i_indnr(i) civ_stat_dat = h_form_year(hhnr2index(i_hhnr(i))) 'Household formation year '-- Koefficienter hämtade f RFV:s budgetunderlag år 2001 ' PTS modelleras ej - FP-koeff avser såväl FP som PTS widow_base_atp = 0.877 '>=18 år **** Provisoriskt: Senare ordentlig beräkning child_base_atp = 0.635 '<18 år **** Provisoriskt: -"- widow_base_fp = 0.678 '>=18 år & <65 år inkl PTS **** Provisoriskt: Senare ordentlig beräkning child_base_fp = 0.282 '<18 år **** Provisoriskt: -"- surv_base_omst = 1.22 ' Samma f omst o förlängd omst pens ' Note: Indexation in Update_Survivors_pension, even the first year If year < 2001 Then ' therefore back-indexation here basbelopp = m_basbelopp_f / m_KPI1 Else basbelopp = m_basbelopp_income * (m_ap_inkind1 / m_ap_inkind) End If '-- Widow's pension Övergångsvis änkepension TP 'If i_sex(i) = 1 And h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if the husband dies If h_n_adults(hhnr2index(i_hhnr(i))) > 1 Then ' Only if more than one person in household 'Searching for survivors indexnr surv_nr = h_first_indnr(hhnr2index(i_hhnr(i))) Do Until (i_bvux(indnr2index(surv_nr)) = 1 And i_sex(indnr2index(surv_nr)) <> i_sex(i)) Or surv_nr = 0 surv_nr = i_next_indnr(indnr2index(surv_nr)) Loop '-- Widows pension If i_sex(i) = 1 And surv_nr <> 0 And civ_stat_dat < 1990 And civ_stat_dat > 0 Then 'Only to widows married before 1990 i_surv_atp(indnr2index(surv_nr)) = widow_base_atp * basbelopp If i_age(indnr2index(surv_nr)) < 65 Then i_surv_fp(indnr2index(surv_nr)) = widow_base_fp * basbelopp Else i_surv_fp(indnr2index(surv_nr)) = 0 End If i_surv_year(indnr2index(surv_nr)) = model_time + base_year i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _ i_surv_atp(indnr2index(surv_nr)) '-- Transitional survivors pension ElseIf i_age(indnr2index(surv_nr)) < 65 And i_age(indnr2index(surv_nr)) > 17 Then i_surv_omst(indnr2index(surv_nr)) = surv_base_omst * basbelopp i_surv_year(indnr2index(surv_nr)) = model_time + base_year i_surv(indnr2index(surv_nr)) = i_surv_omst(indnr2index(surv_nr)) Else i_surv_atp(indnr2index(surv_nr)) = 0 i_surv_fp(indnr2index(surv_nr)) = 0 i_surv(indnr2index(surv_nr)) = 0 End If Else i_surv_atp(indnr2index(surv_nr)) = 0 i_surv_fp(indnr2index(surv_nr)) = 0 i_surv(indnr2index(surv_nr)) = 0 End If '-- Childrens pension ' Only if parents with children in household dies If i_bvux(i) = 1 And h_n_child(hhnr2index(i_hhnr(i))) > 0 Then 'Searching for childrens indexnr surv_nr = h_first_indnr(hhnr2index(i_hhnr(i))) Do Until surv_nr = 0 If i_age(indnr2index(surv_nr)) < 18 Then i_surv_year(indnr2index(surv_nr)) = model_time + base_year i_surv_atp(indnr2index(surv_nr)) = child_base_atp * basbelopp i_surv_fp(indnr2index(surv_nr)) = child_base_fp * basbelopp i_surv(indnr2index(surv_nr)) = i_surv_fp(indnr2index(surv_nr)) + _ i_surv_atp(indnr2index(surv_nr)) End If surv_nr = i_next_indnr(indnr2index(surv_nr)) Loop ' Else ' i_surv_atp(indnr2index(surv_nr)) = 0 ' i_surv_fp(indnr2index(surv_nr)) = 0 ' i_surv(indnr2index(surv_nr)) = 0 End If End Sub
Public Sub Update_Survivors_pension(i As Long) '!-- Yearly updating of previously calculated survivors pensiona Efterlevandepensioner If i_surv(i) > 0 Then If i_age(i) = 18 Then '-- Barnpension upphör då man blir 18 i_surv_fp(i) = 0 i_surv_atp(i) = 0 ' i_surv(i) = 0 End If ' Änkor antas avstå från att gifta om sig formellt ' If i_civ_stat(i) = 1 Then '-- Rätt till änkepension upphör om man gifter sig ' i_surv_fp(i) = 0 ' i_surv_atp(i) = 0 ' i_surv(i) = 0 ' End If If i_status(i) = 2 Then '-- Folkpensionsdelen av änkepension upphör vid ålderpensionen i_surv_fp(i) = 0 ' i_surv(i) = i_surv_atp(i) End If 'Transitional survivors pension If i_surv_omst(i) > 0 Then If (i_surv_year(i) = model_time + base_year) Or (i_surv_year(i) = model_time + base_year - 1 _ And h_n_child(hhnr2index(i_hhnr(i))) > 0) Or _ h_n_childlt12(hhnr2index(i_hhnr(i))) > 0 Then i_surv_omst(i) = i_surv_omst(i) * f_pens_index("ATP", 65) Else i_surv_omst(i) = 0 End If End If ' Indexering i_surv_fp(i) = i_surv_fp(i) * f_pens_index("ATP", 65) i_surv_atp(i) = i_surv_atp(i) * f_pens_index("ATP", 65) i_surv(i) = i_surv_fp(i) + i_surv_atp(i) + i_surv_omst(i) End If End Sub
'-- Defined benefit occupational pensions
Public Function f_Occupational_DB_pension_benefits(i As Long, Sector As Byte, pensmonth As Integer) Dim op_ap_db As Long Select Case Sector Case 1 '-- Blue collar '-- Defined benefit part STP (Transitional rule) If i_status1(i) <> 2 Then '-- New pensioner If i_born_year(i) >= 1932 And i_born_year(i) < 1968 Then op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 10, 10, 10, mini(1, (f_pp_years(i, 1995) / 37))) Else op_ap_db = 0 End If Else '-- Retired last year: Indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If Case 2 '-- White collar If i_status1(i) <> 2 Then '-- New pensioner op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30)) Else '-- Retired last year: Indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If Case 3 '-- State '-- Part-time pension agreement from age 61 to 65 If i_status1(i) <> 2 And i_age(i) >= 61 And i_age(i) < 65 And i_work_share(i) > 0 Then op_ap_db = f_avg_income(i) * 0.6 * (1 - i_work_share(i)) Else '-- Normal occup pens '-- Defined benefit part If (i_status1(i) <> 2) Or _ (i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner Select Case year Case Is > 2002 op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ f_op_pa03(i_born_year(i), 1), _ f_op_pa03(i_born_year(i), 2), _ f_op_pa03(i_born_year(i), 3), mini(1, i_op_pp_years(i) / 30)) Case Else op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 10, 65, 32.5, mini(1, i_op_pp_years(i) / 30)) End Select Else '-- Retired last year If i_work_share(i) > 0 Then '-- Correction for changed work-time op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i)) End If '-- Indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If End If Case 4 '-- Local government '-- Defined benefit part If (i_status1(i) <> 2) Then '-- New pensioner op_ap_db = f_op_db_comp(f_avg_income(i), f_pens_bas("OP"), _ 0, 62.5, 31.25, mini(1, i_op_pp_years(i) / 30), f_ap_pensage(pensmonth), 0.004, 0.004) '-- Simplified transitional rule PA-KL ' Note: Extra 10% compens level below social insur ceiling ' corrected for actual work experience 1997 If i_born_year(i) < 1969 And i_born_year(i) > 1933 Then op_ap_db = op_ap_db + _ f_op_db_comp(i_avg_income_1997(i) * m_basbelopp / 100, _ f_pens_bas("OP"), 10, 0, 0, _ mini(1, f_pp_years(i, 1997) / 30), f_ap_pensage(pensmonth), 0.004, 0.001) End If '-- Correction for work-time op_ap_db = op_ap_db * (1 - i_work_share(i)) Else '-- Retired last year If i_work_share(i) > 0 Then '-- Correction for changed work-time op_ap_db = op_ap_db * (1 - i_work_share(i)) / (1 - i_work_share1(i)) End If '-- Indexation op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If Case Else '-- Other If i_status1(i) <> 2 Then '-- New pensioner op_ap_db = 0 Else '-- Indexation (individuals with occup pens in start data op_ap_db = i_op_ap_db(i) * f_pens_index("OP", 65) End If End Select f_Occupational_DB_pension_benefits = op_ap_db End Function
'********************************************************************** ' Function for calculation of occupational pensions Tjänstepensioner '**********************************************************************
Public Function f_Occupational_pension_benefits(i As Long) '! Calculation of occupational pension Tjänstepensioner Dim m_op_rate As Double '-- Return on pension fund during pay out period Dim pensmonth As Integer, n_pens_years As Integer, payout_time As Integer Dim op As Long, op_ap_db As Long, op_ap_dc As Long, op_ap_tp As Long Dim pb_op_ap As Long, pb_op_tp As Long m_op_rate = m_interest_long '-- Standard assumption payout_time = 5 '-- Payout time for supplemental benefits If i_status(i) = 2 Then pensmonth = i_ap_pensmonth(i) If i_work_share(i) > 0 Then '-- If part-time retired no pension years counted n_pens_years = 0 Else n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth) End If Else pensmonth = (i_age(i) - 65) * 12 n_pens_years = 0 End If '-- Defined benefit occupational pensions op_ap_db = f_Occupational_DB_pension_benefits(i, i_sector(i), pensmonth) '-- Defined contribution occupational pensions Select Case i_sector(i) Case 1 '-- Blue collar '-- Defined contribution part If i_status1(i) <> 2 Then '-- New pensioner op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector Else '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) op_ap_tp = i_op_ap_tp(i) End If Case 2 '-- White collar '-- Defined contribution part If i_status1(i) <> 2 Then '-- New pensioner may have rights from earlier sector op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) Else '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) End If '-- Defined contribution suppl part: ITPK payed out in payout_time years If n_pens_years < payout_time And i_pb_op_tp(i) > 0 Then op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i)) pb_op_tp = i_pb_op_tp(i) - _ PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0) Else op_ap_tp = 0 pb_op_tp = 0 End If Case 3 '-- State '-- Defined contribution part PA03 If (i_status1(i) <> 2) Or _ (i_work_share(i) = 0 And i_work_share1(i) > 0) Then '-- New full-time pensioner op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) Else '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) End If '-- Supplemental defined contribution part, extra KÅPAN, payd out in payout_time years If n_pens_years < payout_time And i_pb_op_tp(i) > 0 And i_work_share(i) = 0 Then op_ap_tp = Pmt(m_op_rate / 100, payout_time - n_pens_years, -i_pb_op_tp(i)) pb_op_tp = i_pb_op_tp(i) - _ PPmt(m_op_rate / 100, 1, payout_time - n_pens_years, -i_pb_op_tp(i), 0) Else op_ap_tp = 0 pb_op_tp = 0 End If Case 4 '-- Local government '-- Defined contribution part: Yearly recalculation if part-time retired If i_work_share1(i) > 0 Or i_status1(i) <> 2 Then '-- Part-time or new op_ap_dc = (i_pb_op_ap(i) / dtalpp(i_age(i))) * (1 - i_work_share(i)) Else '-- DC payed out as an life-long annuity without indexation from last work year op_ap_dc = i_op_ap_dc(i) End If '-- Supplemental defined contribution part If i_status1(i) <> 2 And i_work_share1(i) = 0 Then '-- New full-time pensioner op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) ' may have rights from different sector Else '-- DC payed out as an life-long annuity without indexation op_ap_tp = i_op_ap_tp(i) End If Case Else '-- Other '-- Defined contribution part If i_status1(i) <> 2 Then '-- New pensioner op_ap_dc = i_pb_op_ap(i) / dtalpp(i_age(i)) op_ap_tp = i_pb_op_tp(i) / dtalpp(i_age(i)) Else '-- Indexation (individuals with occup pens in start data '-- DC payed out as an life-long annuity without indexation op_ap_dc = i_op_ap_dc(i) op_ap_tp = i_op_ap_tp(i) End If End Select '-- Summing up op = op_ap_db + op_ap_dc + op_ap_tp '-- Updating global variables if retired ' Updating accum pens rights i_pb_op_ap in Calc_Occup_Pens_Rights) If i_status(i) = 2 Then i_op_ap_db(i) = op_ap_db i_op_ap_dc(i) = op_ap_dc i_op_ap_tp(i) = op_ap_tp i_op(i) = op i_pb_op_tp(i) = pb_op_tp End If 'AW testar 'f_Occupational_pension_benefits = op f_Occupational_pension_benefits = i_op(i) End Function
' Used for calculation of occupational pensions benefits in defined benefit systems ' Note: Not indepent function. Uses index as input ' Eg borde man definiera inkomsterna noggrannare. Kräver dock även laggade status.
Public Function f_avg_income(idxnr As Long) As Long '!-- Calculation of fixed price average income for the last five years f_avg_income = (i_inc_taxable1(idxnr) / m_basbelopp1 + _ i_inc_taxable2(idxnr) / m_basbelopp2 + _ i_inc_taxable3(idxnr) / m_basbelopp3 + _ i_inc_taxable4(idxnr) / m_basbelopp4 + _ i_inc_taxable5(idxnr) / m_basbelopp5) * m_basbelopp1 / 5 End Function
'*** Occupational pension: Calculation of compensation level in defined benefit systems ' Input: ' income = qualifying wage = pensionsmedförande lön ' basb = basic amount = basbelopp för beräkning av skiktgränser ' comp_tak = compensation level below social insurance limit ' comp_tak_20 = compensation level between social insurance limit and 20 basic amounts ' comp_20_30 = compensation level between 10 and 30 basic amounts ' NOTE: COMPENSATION LEVEL IN PERCENT EG 10, 30 ETC ' time = time in service = tjänstetidsfaktor ' early = monthly down correction if early pension. Optional, default=005% per month ' early=-999 means actuarial calculation ' late = monthly up correction if late pension. Optional, default=007% per month ' -----------------------------------------------------------------------------------
Public Function f_op_db_comp(income As Long, basb As Long, comp_tak As Double, _ comp_tak_20 As Double, comp_20_30 As Double, Optional time_factor As Double = 1, _ Optional pensage As Byte = 65, Optional Early As Double = 0.005, _ Optional Late As Double = 0.007) As Long '!-- Occupational pensions: General procedure for Calculation of compensation levels in defined benefit systems '-- Scaling of comp level comp_tak = comp_tak / 100 comp_tak_20 = comp_tak_20 / 100 comp_20_30 = comp_20_30 / 100 Select Case income Case Is <= 7.5 * basb f_op_db_comp = income * comp_tak Case Is <= 20 * basb f_op_db_comp = (7.5 * basb * comp_tak) + _ (income - 7.5 * basb) * comp_tak_20 Case Is <= 30 * basb f_op_db_comp = (7.5 * basb * comp_tak) + _ ((20 - 7.5) * basb) * comp_tak_20 + _ (income - 20 * basb) * comp_20_30 Case Is > 30 * basb f_op_db_comp = (7.5 * basb * comp_tak) + _ ((20 - 7.5) * basb) * comp_tak_20 + _ ((30 - 20) * basb) * comp_20_30 Case Else f_op_db_comp = 0 End Select '-- Correction for empoyment time and early or late withdrawal f_op_db_comp = f_op_db_comp * time_factor * f_fu_kvot(pensage, Early, Late) End Function
'**** Occupational pension, State employed PA03 ' Calculates compensations levels, transitional rules ' Input: Year = born year YYYY ' Intervall = income intervall ' 1 = income <7,5 basbelopp ' 2 = 7,5 basbelopp < income < 20 basbelopp ' 3 = 20 basbelopp < income < 30 basbelopp ' -----------------------------
Public Function f_op_pa03(year As Integer, intervall As Byte) As Double 'Occupational pension: Transitional rules PA03 Dim pa03(31, 3) As Double pa03(1, 1) = 9.5: pa03(1, 2) = 64.85: pa03(1, 3) = 32.4 pa03(2, 1) = 9.3: pa03(2, 2) = 64.7: pa03(2, 3) = 32.3 pa03(3, 1) = 9.1: pa03(3, 2) = 64.55: pa03(3, 3) = 32.2 pa03(4, 1) = 8.9: pa03(4, 2) = 64.4: pa03(4, 3) = 32.1 pa03(5, 1) = 8.7: pa03(5, 2) = 64.25: pa03(5, 3) = 32# pa03(6, 1) = 8.4: pa03(6, 2) = 64.1: pa03(6, 3) = 31.9 pa03(7, 1) = 8.2: pa03(7, 2) = 63.95: pa03(7, 3) = 31.8 pa03(8, 1) = 7.9: pa03(8, 2) = 63.8: pa03(8, 3) = 31.7 pa03(9, 1) = 7.7: pa03(9, 2) = 63.65: pa03(9, 3) = 31.6 pa03(10, 1) = 7.4: pa03(10, 2) = 63.5: pa03(10, 3) = 31.5 pa03(11, 1) = 7.2: pa03(11, 2) = 63.35: pa03(11, 3) = 31.4 pa03(12, 1) = 6.9: pa03(12, 2) = 63.2: pa03(12, 3) = 31.3 pa03(13, 1) = 6.6: pa03(13, 2) = 63.05: pa03(13, 3) = 31.2 pa03(14, 1) = 6.3: pa03(14, 2) = 62.9: pa03(14, 3) = 31.1 pa03(15, 1) = 6: pa03(15, 2) = 62.75: pa03(15, 3) = 31# pa03(16, 1) = 5.7: pa03(16, 2) = 62.6: pa03(16, 3) = 30.9 pa03(17, 1) = 5.4: pa03(17, 2) = 62.45: pa03(17, 3) = 30.8 pa03(18, 1) = 5.1: pa03(18, 2) = 62.3: pa03(18, 3) = 30.7 pa03(19, 1) = 4.7: pa03(19, 2) = 62.15: pa03(19, 3) = 30.6 pa03(20, 1) = 4.3: pa03(20, 2) = 62#: pa03(20, 3) = 30.5 pa03(21, 1) = 3.9: pa03(21, 2) = 61.85: pa03(21, 3) = 30.4 pa03(22, 1) = 3.6: pa03(22, 2) = 61.7: pa03(22, 3) = 30.3 pa03(23, 1) = 3.2: pa03(23, 2) = 61.5: pa03(23, 3) = 30.2 pa03(24, 1) = 2.9: pa03(24, 2) = 61.3: pa03(24, 3) = 30.1 pa03(25, 1) = 2.5: pa03(25, 2) = 61.1: pa03(25, 3) = 30# pa03(26, 1) = 2.1: pa03(26, 2) = 60.9: pa03(26, 3) = 30# pa03(27, 1) = 1.7: pa03(27, 2) = 60.7: pa03(27, 3) = 30# pa03(28, 1) = 1.3: pa03(28, 2) = 60.5: pa03(28, 3) = 30# pa03(29, 1) = 0.9: pa03(29, 2) = 60.3: pa03(29, 3) = 30# pa03(30, 1) = 0.5: pa03(30, 2) = 60.1: pa03(30, 3) = 30# pa03(31, 1) = 0: pa03(31, 2) = 60#: pa03(31, 3) = 30# If year <= 1942 Then Select Case intervall Case 1 f_op_pa03 = 10 Case 2 f_op_pa03 = 65 Case 3 f_op_pa03 = 32.5 Case Else f_op_pa03 = 0 End Select ElseIf year > 1942 And year < 1973 Then f_op_pa03 = pa03(year - 1942, intervall) ElseIf year > 1972 Then Select Case intervall Case 1 f_op_pa03 = 0 Case 2 f_op_pa03 = 60 Case 3 f_op_pa03 = 30 Case Else f_op_pa03 = 0 End Select Else f_op_pa03 = 0 End If End Function
' -- Function returns pontential or paid out sum of public pensions depending on status. ' If individual retired the function also updates public pension variables '-- Antar normalt att alla går i pension 1/1. Vidare antas alla som dör göra det den 1/1. Approximativt ' innebär detta att folk i genomsnitt får pension 1/2 år för tidigt, men å andra sidan förlorar ' 1/2 år i slutet av livet. För IP & TP beräknas även utgiftsmässiga belopp (suffix _ut)
Public Function f_Public_Pension_Benefits(i As Long) As Long '!-- Calculation of old age public pension benefits Dim bokvot As Double ' Bosättningstidskvot Dim ap_fp_kvot As Double Dim ap_fp_kvot1 As Double Dim ap_berund As Long 'Beräkningsunderlag för garantipension 'Dim ap_atp_1994, ap_fp30_1994 As Double '-- Dim as local variables. If retired also global variables calculated Dim ap_atp As Long, ap_atp_old As Long, ap_pts As Long, ap_fp As Long Dim ap_fp30 As Long, ap_tp As Long, ap_gp As Long, ap_ip As Long, ap_fiktiv As Long Dim ap_pp As Long, ap_fp30_1994 As Long, ap_atp_1994 As Long, ap_gartill As Long Dim ap As Long, ap_ap As Long, pensmonth As Integer, ap_ip_ut As Long Dim PB_IP As Long, pb_pp As Long, pb_fiktiv As Long Dim ap_atp_ut As Long, ap_fp30_ut As Long, ap_tp_ut As Long, ap_pp_ut As Long year = model_time + base_year If i_status(i) = 2 Then pensmonth = i_ap_pensmonth(i) Else pensmonth = (i_age(i) - 65) * 12 End If ' -- Diverse kvoter 'deltid= 1 '-- Parameter för uttagsandel **** Skall implementeras senare. Tv. endast heltidspension bokvot = mini(1, maxi(i_botid(i) / 40, pp_hist(i).n_years / f_krav_atp_ar(i_born_year(i)))) ' -- Ersättningsnivå för folkpen etc beroende på civilstånd ap_fp_kvot = f_ap_fp_kvot(i_civ_stat(i)) 'Basic pension ratio depends on civil status ap_fp_kvot1 = f_ap_fp_kvot(i_civ_stat1(i)) ' -"- last year '! -- Old system Gamla systemet '! -- ATP - National supplementary pension Allmän tilläggspension If i_status1(i) <> 2 Then '-- New pensioner If i_age(i) >= 61 And pp_hist(i).n_years >= 3 Then ap_atp = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _ (pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ (1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) ' Korrigering för halvårseffekt av utfasningen. ' Also adjusted for deceased persons in a02, new_economy2 ap_atp_ut = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _ (pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ ((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _ + (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2 ap_atp_old = 0.6 * (f_mean_ATP(i) / 100) * m_basbelopp * mini(1, _ (pp_hist(i).n_years) / f_krav_atp_ar(i_born_year(i))) * f_fu_kvot(f_ap_pensage(pensmonth)) Else ap_atp = 0 ap_atp_ut = 0 ap_atp_old = 0 End If Else ' -- Retired last year ap_atp = i_ap_atp(i) * f_pens_index("ATP", i_age(i)) If ap_atp < 0 Then i = i End If ap_atp_ut = i_ap_atp_ut(i) * f_pens_index("ATP", i_age(i)) ap_atp_old = i_ap_atp_old(i) * (m_basbelopp / m_basbelopp1) End If '! -- Basic pension & pension supplement Folkpension & PTS If i_age(i) > 61 And i_botid(i) >= 3 Then ' *** Behövs vid beräkn Ö-garpAnd year < 2003 Then ap_fp = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * ap_fp_kvot * m_basbelopp '**** PTS-kvot 0,555 för 990601 ap_pts = bokvot * f_fu_kvot(f_ap_pensage(pensmonth)) * _ maxi((0.569 * m_basbelopp) - (ap_atp + i_surv(i)), 0) Else ap_fp = 0 ap_pts = 0 End If '! -- Reformed system Reformerat system ' Balance indexing of suppl pens for transition generation (LIP 6 kap, § 8a) If year > 2003 And (i_born_year(i) >= 1938 And i_born_year(i) <= 1953) And i_age(i) = 65 Then i_ap_atp(i) = i_ap_atp(i) * m_ap_balanstal_accum End If '! -- FP30 - Old part Reformed basic pension If i_age(i) >= 61 And pp_hist(i).n_years >= 3 And year >= 2001 Then If i_status1(i) <> 2 Or (year = 2001 And i_status(i) = 2) Then ' -- Not retired last year If ap_atp > 0 Then '-- Only calculated for individuals with ATP ap_fp30 = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ ap_fp_kvot * m_basbelopp * (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth))) ap_fp30_ut = mini(1, (pp_hist(i).n_years / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) * _ ap_fp_kvot * m_basbelopp * _ ((1 - f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), pensmonth))) _ + (1 - f_utfasning_ATP(i_born_year(i) + 1, f_ap_pensyear(year, i_age(i), pensmonth)))) / 2 Else ap_fp30 = 0 ap_fp30_ut = 0 End If Else ' Retired last year - Indexation and correction for changed civil status ap_fp30 = i_ap_fp30(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation ap_fp30_ut = i_ap_fp30_ut(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("ATP", i_age(i)) ' -- Indexation End If Else ap_fp30 = 0 ap_fp30_ut = 0 End If '! -- IP - Income pension Inkomstpension If i_age(i) >= 61 And year >= 2001 Then If (i_status1(i) <> 2) Then ' -- Not retired last year '-- Special rules for indexing the year of retirement: No indexation 'PB_IP = i_pb_ip(i) + i_pr_ip1(i) '-- Tidigare metod PB_IP = i_pb_ip(i) ap_ip = PB_IP / dtalip(i_age(i)) '-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt ' f att få rätt makro. Nya får endast halv IP utbetald 1:a året. ap_ip_ut = ap_ip * 0.5 Else ' -- Retired last year ap_ip = i_ap_ip(i) * f_pens_index("IP", i_age(i)) ' -- Indexation ap_ip_ut = ap_ip '-- ap_ip_ut later adjusted for deceased persons in a02 End If Else ap_ip = 0 End If '! -- Calculates fictious pension. Used in calc of reformed basic pension ' and ap_gartill. If i_age(i) >= 65 And year >= 2003 Then If (i_status1(i) <> 2 Or i_age(i) = 65) Then ' -- Not retired last year ' pb_fiktiv = i_pb_fiktiv(i) + i_pr_ip1(i) + i_pr_pp1(i) 'Tidigare metod pb_fiktiv = i_pb_fiktiv(i) ap_fiktiv = pb_fiktiv / dtalip(65) ' or 65 years Else ' -- Retired last year ap_fiktiv = i_ap_fiktiv(i) * f_pens_index("IP", i_age(i)) ' -- Indexation End If Else ap_fiktiv = 0 End If '! -- PP - PremiePension If i_status1(i) <> 2 Then ' New pensioner ' Man kan välja om pp skall utbetalas som en livränta eller kvarstå i fonder ' Man kan välja att ta ut pp från 61-79:11 års ålder, välja 25, 50, 75 ' eller 100%:s uttag. Det går att göra uppehåll i uttaget och ändra den andel som tas ut. ' Som standardantagande antas att alla väljer livränta, räknar som en annuitet, och ' 100% från 65 år för alla. ' Note: Discounting facor=1 + ((m_interest_long / 100) - m_favg_pp) in call to Calculate_Dtal '*** OBS: Delningstal beräknade på detta sätt låga jämfört med PPM:s *** 'pb_pp = i_pb_pp(i) + i_pr_pp1(i) 'Tidigare metod pb_pp = i_pb_pp(i) ap_pp = pb_pp / dtalpp(i_age(i)) '-- Snabb ökn av IP medför att man måste ta hänsyn t halvårseffekt ' f att få rätt makro. Nya får endast halv IP utbetald 1:a året. ap_pp_ut = ap_pp * 0.5 Else '-- Retired last year: Note - No indexation of PP, just an annuity ap_pp = i_ap_pp(i) ap_pp_ut = ap_pp '-- ap_pp_ut later adjusted for deceased persons in a02 End If '! -- Retirement pension, Reformed transitional supplement Garantitillägg ' Endast till mellagenerationen, ej vid uttag av enbart PP, tidigast from 65 år '**** Eg inget gartill vid uttag vid enbart PP If i_born_year(i) > 1937 And i_born_year(i) <= 1953 And i_age(i) >= 65 Then If i_age(i) = 65 Or i_status1(i) <> 2 Then '-- 65 years old OR newly retired ap_fp30_1994 = ap_fp_kvot * m_basbelopp * f_fu_kvot(f_ap_pensage(pensmonth)) _ * mini(1, (i_ATP_ar_1994(i) / 30)) ap_atp_1994 = 0.6 * (i_mATP_1994(i) / 100) * m_basbelopp * mini(1, _ (i_ATP_ar_1994(i) / 30)) * f_fu_kvot(f_ap_pensage(pensmonth)) Else ' -- Indexation and correction for changed civil status ap_fp30_1994 = i_ap_fp30_1994(i) / ap_fp_kvot1 * ap_fp_kvot * f_pens_index("IP", i_age(i)) ap_atp_1994 = i_ap_atp_1994(i) * f_pens_index("IP", i_age(i)) End If ap_gartill = maxi(0, ((ap_fp30_1994 + ap_atp_1994) - _ (ap_fiktiv + ap_fp30 + ap_atp))) Else ap_gartill = 0 End If '! -- GP - Reformed basic retirement pensions Garantipension 'If i_age(i) >= 61 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then 'AW Testar en reform If i_age(i) >= 65 And i_botid(i) >= 3 And year >= 2003 And i_abroad(i) = 0 Then Select Case i_born_year(i) Case Is > 1937 '!-- . Persons born 1938 and later Garantipension ap_tp = ap_fp30 + ap_atp + ap_gartill ap_gp = f_ap_garp_38_(i_civ_stat(i), f_pens_bas("GP"), _ ap_tp, ap_fiktiv, i_surv(i)) Case Is <= 1937 '! -- Transitional reformed basic retirement pension ' f.d. Övergångsvis garantipension ap_gp = f_ap_garp_37(i_civ_stat(i), f_pens_bas("GP"), _ ap_atp, ap_fp30, ap_fp, ap_pts, _ i_surv(i), i_op(i), i_botid(i)) End Select Else ap_gp = 0 End If '! -- Summing up different pension components If year < 2003 Then '-- Old system ap = ap_fp + ap_pts + ap_atp If ap_atp > 0 Then ap_ap = ap_fp + ap_atp Else ap_ap = 0 End If Else '-- Reformed system ap_tp = ap_fp30 + ap_atp + ap_gartill ' -- Supplemental pension Tilläggspension ap_tp_ut = ap_fp30_ut + ap_atp_ut + ap_gartill ap = ap_tp + ap_ip + ap_pp + ap_gp ' -- Total old age ap_ap = ap_tp_ut + ap_ip_ut End If If i_status(i) = 2 Then i_ap_atp(i) = ap_atp i_ap_atp_ut(i) = ap_atp_ut i_ap_atp_old(i) = ap_atp_old i_ap_pts(i) = ap_pts i_ap_fp(i) = ap_fp i_ap_fp30(i) = ap_fp30 i_ap_fp30_ut(i) = ap_fp30_ut i_ap_tp(i) = ap_tp i_ap_tp_ut(i) = ap_tp_ut i_ap_gp(i) = ap_gp i_ap_ip(i) = ap_ip i_ap_ip_ut(i) = ap_ip_ut i_ap_fiktiv(i) = ap_fiktiv i_ap_pp(i) = ap_pp i_ap_pp_ut(i) = ap_pp_ut i_ap_fp30_1994(i) = ap_fp30_1994 i_ap_atp_1994(i) = ap_atp_1994 i_ap_gartill(i) = ap_gartill i_ap_tp(i) = ap_tp i_ap(i) = ap i_ap_ap(i) = ap_ap If (i_status1(i) <> 2) Then i_pb_ip1(i) = i_pb_ip(i) i_pb_ip(i) = PB_IP i_pb_pp(i) = pb_pp i_pb_fiktiv(i) = pb_fiktiv End If End If f_Public_Pension_Benefits = i_ap(i) End Function
' -- Function returns sum of private pensions. ' If individual retired the function also updates private pension variables ' Note: i_wealth_pension_total not a part private wealth or the wealth tax base
Public Function f_Private_Pension_Benefits(i As Long, payout_time As Integer) As Long Dim pp As Long, wealth_pension_total As Long Dim pensmonth As Integer, pp_rate As Double, n_pens_years As Integer pp_rate = m_interest_long '-- Standard assumption If i_status(i) = 2 Then pensmonth = i_ap_pensmonth(i) n_pens_years = year - f_ap_pensyear(year, i_age(i), pensmonth) Else pensmonth = (i_age(i) - 65) * 12 n_pens_years = 0 End If If i_age(i) >= 55 And payout_time <> 0 Then 'minimum 55 years age and savings '-- Assumed that pension captital payed out in payout_time years from pension time If payout_time < 0 Then '-- Lifelong annuity If i_status1(i) <> 2 Then '-- New private pensioner with annuity pp = Pmt((pp_rate * (1 - 0.15)) / 100, explife(i_age(i)), -i_wealth_pension_total(i)) 'pp = i_wealth_pension_total(i) / dtalpp(i_age(i)) Else pp = i_pp(i) End If wealth_pension_total = maxi(0, i_wealth_pension_total(i) + _ ((i_wealth_pension_total(i) - pp / 2) * ((pp_rate * (1 - 0.15)) / 100)) - pp) Else '-- Fixed pay out time If n_pens_years < payout_time Then pp = Pmt((pp_rate * (1 - 0.15)) / 100, payout_time - n_pens_years, -i_wealth_pension_total(i)) wealth_pension_total = i_wealth_pension_total(i) - _ PPmt((pp_rate * (1 - 0.15)) / 100, 1, payout_time - n_pens_years, -i_wealth_pension_total(i), 0) Else pp = 0 wealth_pension_total = 0 payout_time = 0 End If End If If i_status(i) = 2 Then i_pp(i) = pp i_wealth_pension_total(i) = wealth_pension_total i_wealth_pension_year(i) = 0 '*** Not simultanous saving and pay out i_pp_payout_time(i) = payout_time End If Else i_pp(i) = 0 End If f_Private_Pension_Benefits = i_pp(i) End Function
Sub Pension_debugging_files() '!-- Optional printing of pension debugging files (micro data) status "Printing pension debugging files" Dim utvar As String Dim demofile As Integer Dim i As Long year = model_time + base_year If model_time = 0 Then Open sesimpath & "\tempdata\valid_pens.txt" For Output As #11 utvar = f_Concat_string("i", "bidnr", "year", "i_age", "i_sex", "i_civ_stat", "i_abroad", _ "i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _ "i_ap_atp", "f_mean_ATP", "m_basbelopp", "i_botid", "ATP_years", _ "f_krav_atp_ar", "f_fu_kvot", "f_utfasning_ATP", "i_born_year ", "f_ap_pensyear", _ "i_ap_fp30", "i_ap_ip", "i_pb_ip", "dtal", _ "i_ap_fiktiv", "i_pb_fiktiv", _ "m_interest_short", "i_ap_pp", "explife", "i_pb_pp", "i_ap_gp", _ "i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", _ "i_pu", "i_pgi", "i_pgb", "i_pgb_barn", "i_pgb_plikt", _ "i_pgb_stud", "i_pgb_antag", "i_pb_op_ap", "i_pb_op_tp", "i_pbhi", "i_status1", _ "i_indnr", "i_ap", "i_p_andel", "i_ap_pensmonth", "i_pp", "i_pp_payout_time") Print #11, utvar Else Open sesimpath & "\tempdata\valid_pens.txt" For Append As #11 End If For i = 1 To m_icount If i_status(i) = 2 And i_status1(i) <> 2 Then '-- Only for new pensioners ' If i_status(i) = 2 And i_ap_gp(i) > 0 Then '-- Pensionärer med garantipension utvar = f_Concat_string(i, i_bidnr(i), year, i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), _ i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _ i_ap_atp(i), f_mean_ATP(i), m_basbelopp, i_botid(i), pp_hist(i).n_years, _ f_krav_atp_ar(i_born_year(i)), f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i))), _ f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i))), _ i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _ i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), dtalip(65), _ i_ap_fiktiv(i), i_pb_fiktiv(i), _ m_interest_short, i_ap_pp(i), explife(65), i_pb_pp(i), i_ap_gp(i), _ i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), _ i_pu(i), i_pgi(i), i_pgb(i), i_pgb_barn(i), i_pgb_plikt(i), _ i_pgb_stud(i), i_pgb_antag(i), i_pb_op_ap(i), i_pb_op_tp(i), i_pbhi(i), i_status1(i), _ i_indnr(i), i_ap(i), i_p_andel(i), i_ap_pensmonth(i), i_pp(i), i_pp_payout_time(i)) '***** m_interest_short, i_ap_pp(i), explife(i_age(i)), i_pb_pp(i), i_ap_gp(i), Print #11, utvar End If Next i Close #11 'If year <= 2020 Then If model_time = 0 Then Open sesimpath & "\tempdata\valid_pgi.txt" For Output As #12 utvar = f_Concat_string("year", "i", "bidnr", "i_status", "i_sector", "i_abroad", _ "m_interest_short", "m_interest_long", "m_ap_inkind", "m_ap_balind", "m_basbelopp", _ "i_age", "i_sex", "i_civ_stat", "i_inc_taxable", "i_born_year ", _ "i_pu", "i_pgi", "i_pgb", _ "i_pgb_barn", "i_pgb_plikt", "i_pgb_stud", "i_pgb_antag", _ "i_pb_ip", "i_pbhi", "i_pb_pp", "i_pb_fiktiv", "i_pb_op_ap", "i_pb_op_tp", _ "i_wealth_pension_total", "i_wealth_pension_year") Print #12, utvar Else Open sesimpath & "\tempdata\valid_pgi.txt" For Append As #12 End If For i = 1 To m_icount If i_born_year(i) >= 1938 And i_born_year(i) < 1984 Then ' If i_bidnr(i) <> 0 And _ ' i_born_year(i) >= 1938 And i_born_year(i) < 1984 And i_abroad(i) = 1 Then 'And Rnd < 0.05 Then ' var 20:e individ skrivs ut utvar = f_Concat_string(year, i, i_bidnr(i), i_status(i), i_sector(i), i_abroad(i), _ m_interest_short, m_interest_long, m_ap_inkind, m_ap_balind, m_basbelopp, _ i_age(i), i_sex(i), i_civ_stat(i), i_inc_taxable(i), i_born_year(i), _ i_pu(i), i_pgi(i), i_pgb(i), _ i_pgb_barn(i), i_pgb_plikt(i), i_pgb_stud(i), i_pgb_antag(i), _ i_pb_ip(i), i_pbhi(i), i_pb_pp(i), i_pb_fiktiv(i), i_pb_op_ap(i), i_pb_op_tp(i), _ i_wealth_pension_total(i), i_wealth_pension_year(i)) Print #12, utvar End If Next i 'End If Close #12 End Sub
Sub Pension_micro_file() '!-- Optional printing of pension micro file (micro data) status "Printing pension micro file" Dim utvar As String Dim demofile As Integer Dim i As Long year = model_time + base_year If model_time = 0 Then Open sesimpath & "\tempdata\pension_micro.txt" For Output As #13 utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_age", "i_sex", _ "i_civ_stat", "i_abroad", "i_status", "i_sector", _ "i_edlevel", "i_ap_fp", "i_ap_pts", "i_surv", "i_inc_taxable", _ "i_ap_atp", "i_born_year ", "f_ap_pensyear", _ "i_ap_fp30", "i_ap_ip", "i_pb_ip", "i_ap_pp", "i_pb_pp", "i_ap_gp", _ "i_op", "i_op_ap_db", "i_op_ap_dc", "i_op_ap_tp", "i_pu", "i_pgi", "i_pgb", _ "i_pb_op_ap", "i_pb_op_tp", _ "i_ap", "i_ap_tp", "i_p_andel", "i_pp", "i_pp_payout_time", _ "i_wealth_pension_total", "i_wealth_pension_year", "i_ap_tp") Print #13, utvar Else Open sesimpath & "\tempdata\pension_micro.txt" For Append As #13 End If For i = 1 To m_icount utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_age(i), i_sex(i), _ i_civ_stat(i), i_abroad(i), i_status(i), i_sector(i), _ i_edlevel(i), i_ap_fp(i), i_ap_pts(i), i_surv(i), i_inc_taxable(i), _ i_ap_atp(i), i_born_year(i), f_ap_pensyear(year, i_age(i), i_ap_pensmonth(i)), _ i_ap_fp30(i), i_ap_ip(i), i_pb_ip(i), i_ap_pp(i), i_pb_pp(i), i_ap_gp(i), _ i_op(i), i_op_ap_db(i), i_op_ap_dc(i), i_op_ap_tp(i), i_pu(i), i_pgi(i), i_pgb(i), _ i_pb_op_ap(i), i_pb_op_tp(i), _ i_ap(i), i_ap_tp(i), i_p_andel(i), i_pp(i), i_pp_payout_time(i), _ i_wealth_pension_total(i), i_wealth_pension_year(i), i_ap_tp(i)) Print #13, utvar Next i Close #13 End Sub
'********************************************************************** ' Calculation of pension rights for ' - the ATP pension system (tilläggspension, TP ' - the reformed pension system (inkomstpension, IP and premiepension, PP) '********************************************************************** '**** KVAR ATT GÖRA: '**** - TA EV BORT 16-ÅRS GRÄNSEN FÖR INTJÄNANDET.
Public Sub Calculate_Public_Pension_Rights() '!-- Calculation of pension rights ATP-system and new system PGI & PGB status "Calculate public pensions rights" Printdok " Calculate_Public_Pension_Rights" Dim i As Long Dim j As Long Dim tak As Double ' Social insurance limit (Intjänandetak) ' Dim atak As Double ' Social insurance limit plus employee contribution (Avgiftstak) Dim pgi_snitt As Double ' Average taxable income Dim pgb_barn1 As Long ' Pension rights f child years, alternative 1 Dim pgb_barn2 As Long ' Pension rights f child years, alternative 2 Dim pgb_barn3 As Long ' Pension rights f child years, alternative 3 Dim rand As Double ' Help variable for calc of random number Dim randvek() As Double Dim basb As Long ' Price basic amount or income basic amount Dim sum As Double Dim n As Long Dim pgi_bas As Long '-- Optional aligning OT regarding the career effect, see below Dim OTfix2 As Byte If get_scalefactor_active("OTfix2") = 1 Then OTfix2 = 1 Else OTfix2 = 0 End If sum = 0 n = 0 m_pgi = 0 m_pgb = 0 Dim year As Integer Dim maxyear As Integer year = model_time + base_year 'If year <= 2050 Then maxyear = year Else maxyear = 2050 'If year <= 2150 Then maxyear = year Else maxyear = 2150 If year <= 2110 Then maxyear = year Else maxyear = 2110 '-- Calculation of administration costs and fee on income pension funds m_pb_ip_active_n = cnt0(i_pb_ip) * m_weight m_pb_ip_active = L_SUMVEC(i_pb_ip(1), m_icount) * m_weight ' Förvaltningskostnad 0.075 Källa: Pensionsystemets årsredovisning 2001, sid 20 ' -- Costs of insurance administarion: A function of the number of active savers ' m_ap_admin_ip_ins_pers exognous for outcome years: Source Pension System annual report 'm_pensadmin_ip_ins_pers = (m_pensadmin_ip_ins / m_cnt_pb_ip_active) * m_inkind If f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension") <> 0 Then m_ap_adm_ip_ins_p = f_GetMakro("m_ap_adm_ip_ins_p", year, "Pension") Else m_ap_adm_ip_ins_p = m_ap_adm_ip_ins_p * (m_ap_inkind / m_ap_inkind1) End If m_ap_adm_ip_ins = m_ap_adm_ip_ins_p * m_pb_ip_active_n '-- Note: t-1 value ' -- Costs of AP-fund administration: A function of the fund value ' m_ap_admin_ip_ap_p exognous for outcome years: Source Pension System annual report If f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension") <> 0 Then m_ap_adm_ip_ap_p = f_GetMakro("m_ap_adm_ip_ap_p", year, "Pension") End If If get_scalefactor_active("ap_adm_ip_ap_p") = 1 Then m_ap_adm_ip_ap_p = get_scalefactor("ap_adm_ip_ap_p") End If m_ap_adm_ip_ap = (m_ap_adm_ip_ap_p / 100) * m_ap_apfond '-- Note: t-1 value ' -- Total administration costs m_ap_adm_ip = m_ap_adm_ip_ins + m_ap_adm_ip_ap ' Administration fee as a part of pension liabilities to active savers m_ap_adm_ip_p = m_ap_adm_ip / m_pb_ip_active '-- Note: t-1 value ' -- Reduced administration fee on pension liabilities: ' Gradual transition from 62% to 100% fee on individual accounts until 2021 ' Infasing t 2021 för att de med behållningar i nya systemet ej ska subventionera gamla ATP ' (Lag 1998:674 5 kap 8§) Select Case year Case Is <= 2001 m_favg_ip = 0.6 * m_ap_adm_ip_p Case Is < 2022 m_favg_ip = (((year - 1999) * 0.02) + 0.56) * m_ap_adm_ip_p Case Else m_favg_ip = m_ap_adm_ip_p End Select '-- Basic amount and income limit Aktuellt basbelopp och intjänandetak If year < 2001 Then basb = m_basbelopp_f Else basb = m_basbelopp_income tak = 7.5 * basb '!-- Calculate pensionable income Beräknar pensionsgrundande inkomst PGI '!-- Helpvariables for calculation of pension income index and income basic amount j = 0 m_inc_taxable_snitt4 = m_inc_taxable_snitt3 m_inc_taxable_snitt3 = m_inc_taxable_snitt2 m_inc_taxable_snitt2 = m_inc_taxable_snitt1 m_inc_taxable_snitt1 = m_inc_taxable_snitt m_inc_taxable_snitt = 0 For i = 1 To m_icount pgi_bas = 0 If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI pgi_bas = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i) i_pgi_bas(i) = i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i) - i_ftp_gar(i) If i_pgi_bas(i) < 0 Then i = i End If If (pgi_bas * (1 - m_egenavg_pens_p)) <= tak Then i_pgi(i) = round((pgi_bas * (1 - m_egenavg_pens_p)) - 50, -2) Else i_pgi(i) = round(tak - 50, -2) End If '-- For disab pensioners. Pension rights only based on qualifying points before 2003 If i_status(i) = 4 And year < 2003 Then i_pgi(i) = 0 End If ' -- Individual comparison pension base PU (Used in calculation of i_pgb_barn) If exist_child0_3(i_hhnr(i)) <> 1 Then i_pu_ind_comp(i) = i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) End If ' -- Cumulation of base for income index If pgi_bas > 0 Then j = j + 1 m_inc_taxable_snitt = m_inc_taxable_snitt + (pgi_bas * (1 - m_egenavg_pens_p)) End If Else i_pgi(i) = 0 End If Next i If j > 0 Then m_inc_taxable_snitt = (m_inc_taxable_snitt / j) / m_price_change99 Else m_inc_taxable_snitt = 0 Debug.Print "Calculate_public_pension_rights: ingen har nollskild PGI!" End If '-- Calculate average pensionable income Beräknar genomsnittlig PGI ' and averge income used for calculation of pension income index j = 0 pgi_snitt = 0 For i = 1 To m_icount If i_age(i) > 15 And i_age(i) < 65 And i_abroad(i) = 0 And i_pgi(i) > 0 Then j = j + 1 pgi_snitt = pgi_snitt + i_pgi(i) End If Next pgi_snitt = pgi_snitt / j '*** Draw vector of standard normal variates ReDim randvek(1 To m_icount) Call RANNOR(m_icount, randvek(1), model_time + base_year + random * Rnd) '!-- Pensionable amounts, pension rights Pensionsgrundande belopp och pensionsunderlag For i = 1 To m_icount If i_age(i) >= 16 And i_status(i) <> 2 And i_abroad(i) = 0 Then '*** Senare ska pensionärer kunna tjäna PGI '! -- Pensionable amounts, military service ' Endast 20 åriga män antas göra värnplikt '0.45 = Andel som gör lumpen enligt Pliktverkets hemsida (avser 1999) 'För varje dag tjänstgöringenpågår pågår > 120 dagar. Beräknas som '50% av PGI för alla försäkrade < 65 år/365 * antalet dagar 'Vägt genomsnitt för olika utbildniugskategoriers (enl Pliktverket) 'tjänstgöringstider ger ca 250 dagar ' ***** OBS Info om antal finns i AKU. Kolla detta. ' ***** LF har skattat modell. Ev implementera denna If i_sex(i) = 1 And i_age(i) = 20 And Rnd < 0.45 Then i_pgb_plikt(i) = 0.5 * (pgi_snitt / 365) * 250 Else i_pgb_plikt(i) = 0 End If '! -- Pensionable amounts, studies 138% of study grants (Endast av bidragsbeloppet) If i_status(i) = 3 Then i_pgb_stud(i) = 1.38 * i_trf_study_grant(i) Else i_pgb_stud(i) = 0 End If '!-- Pensionable amounts, disability pension (Antagandeinkomst) ' Only if qualifying points for the current year has been calculated in new_economy If i_status(i) = 4 And pp_hist(i).n_years > 0 Then ' If disab pens AND ATP-points If pp_hist(i).pp_years(pp_hist(i).n_years) = year Then '..and points the current year If year < 2003 Then i_pgb_antag(i) = ((pp_hist(i).pp(pp_hist(i).n_years) / 100) + 1) _ * m_basbelopp_f Else '-- Note: No contribution from the disability pensioner ' gamla koden i_pgb_antag(i) = i_ftp_antag(i) - i_pgi(i) If year < 2007 Then i_pgb_antag(i) = (i_ftp_antag(i) * (1 - 0.07)) - i_pgi(i) Else i_pgb_antag(i) = (i_ftp_antag(i) * (1 - 0.2)) - i_pgi(i) End If End If End If Else i_pgb_antag(i) = 0 End If '! -- Pensionable amounts, child years ' Women with child age 0 to 3 years. Kvinna får t.v. all pensrätt för barn '**** ÄNDRA SÅ ATT DEN MED LÄGST INKOMST FÅR POÄNGEN **** i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 If i_sex(i) = 2 And exist_child0_3(i_hhnr(i)) = 1 Then ' Check for gainful employment limit: PGI>2 inc basic i minst 5 år ( <2001 2 basbf) If pp_hist_limit(i, 100) >= 5 Then '-- Best of 3 alternatives Bäst av tre alternativ ' 1) Individual comp PGI Utfyllnad till inkomst året före barnets födelse pgb_barn1 = maxi(0, i_pu_ind_comp(i) - i_pgi(i)) ' 2) General comp PGI Utfyllnad t 75% av genomsnittl PGI pgb_barn2 = maxi(0, 0.75 * pgi_snitt - _ (i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i))) ' 3) One income base amount Ett inkomstbasbelopp (ett förh prisbasb före 2001) pgb_barn3 = basb '-- Choosing best alternative i_pgb_barn(i) = maxi(pgb_barn1, maxi(pgb_barn2, pgb_barn3)) Select Case i_pgb_barn(i) Case pgb_barn1 i_pgb_barn_typ(i) = 1 Case pgb_barn2 i_pgb_barn_typ(i) = 2 Case pgb_barn3 i_pgb_barn_typ(i) = 3 End Select End If End If '! -- Summing up pensionable amounts i_pgb(i) = i_pgb_barn(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_antag(i) ' -- PGB + PGI max social insurance income limit Select Case tak Case Is < i_pgi(i) i_pgb_antag(i) = 0 i_pgb_plikt(i) = 0 i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) i_pgb_antag(i) = tak - i_pgi(i) i_pgb_plikt(i) = 0 i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) i_pgb_plikt(i) = tak - i_pgi(i) - (i_pgb_antag(i)) i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) i_pgb_stud(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i)) i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 0 Case Is < i_pgi(i) + i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i) i_pgb_barn(i) = tak - i_pgi(i) - (i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i)) End Select i_pgb(i) = round((i_pgb_antag(i) + i_pgb_plikt(i) + i_pgb_stud(i) + i_pgb_barn(i)) - 50, -2) '-- Optional aligning OT regarding the career effect ' OTfix2: Justerar PGI (inkomstprofilen) för äldre för att få OT enl RFV ' Note: Förutsätter att även PGI alignas If OTfix2 = 1 Then Select Case i_age(i) Case Is = 57 And i_status(i) <> 2 i_pgi(i) = 0.96 * i_pgi(i) Case Is = 58 And i_status(i) <> 2 i_pgi(i) = 0.92 * i_pgi(i) Case Is = 59 And i_status(i) <> 2 i_pgi(i) = 0.87 * i_pgi(i) Case Is = 60 And i_status(i) <> 2 i_pgi(i) = 0.82 * i_pgi(i) Case Is > 61 And i_status(i) <> 2 i_pgi(i) = 0.78 * i_pgi(i) End Select End If i_pu(i) = i_pgb(i) + i_pgi(i) Else i_pgb(i) = 0 i_pgb_antag(i) = 0 i_pgb_plikt(i) = 0 i_pgb_stud(i) = 0 i_pgb_barn(i) = 0 i_pgb_barn_typ(i) = 1 i_pgi(i) = 0 i_pu(i) = 0 End If '-- Macro for aligning m_pgi = m_pgi + i_pgi(i) m_pgb = m_pgb + i_pgb(i) Next i '!-- Optional calculation of determinstic pension rights ' Samma procedur som i Orange kuvert Dim Orange As Byte Dim growth As Double If get_scalefactor_active("Pension_Orange") = 1 Then growth = get_scalefactor("Pension_Orange") For i = 1 To m_icount ' AW Inga pensionsgrundande belopp i orange brev i framtiden, sätter pu=pgi i_pu_orange(i) = i_pu_orange(i) * growth i_pu(i) = i_pu_orange(i) i_pgi_orange(i) = i_pgi_orange(i) * growth i_pgi(i) = round(i_pgi_orange(i) - 50, -2) Next i End If '!-- Optional aligning of pensionable income etc Dim Align_PGI As Byte Dim pgb As Double Dim pgi As Double Dim pu As Double If get_scalefactor_active("Align_PGI") = 1 Then ' pgb = parm_macro(maxyear, 13) ' pgi = parm_macro(maxyear, 15) m_zpgb_korr = parm_macro(maxyear, 13) m_zpgi_korr = parm_macro(maxyear, 15) If m_zpgi_korr = 0 Then m_zpgi_korr = 1 If m_zpgb_korr = 0 Then m_zpgb_korr = 1 ' If pgi > 1 Then m_zpgi_korr = pgi / (m_pgi * m_weight) ' If pgb > 1 Then m_zpgb_korr = pgb / (m_pgb * m_weight) For i = 1 To m_icount i_pgi(i) = i_pgi(i) * m_zpgi_korr i_pgb(i) = i_pgb(i) * m_zpgb_korr i_pu(i) = i_pgi(i) + i_pgb(i) Next i End If If get_scalefactor_active("Align_PGI2") = 1 Then '-- Align t RFV årsredov ' -- PGI & PGB aggregerat, endast mått på PU nivå f RFV pu = parm_macro(maxyear, 15) 'Hack: Lägger PU i PGI-kolumnen pgi = pu - (m_pgb * m_weight) If pgi > 0 Then m_zpgi_korr = pgi / (m_pgi * m_weight) Else m_zpgi_korr = 1 End If Debug.Print pu & " " & pgi & " " & m_zpgi_korr For i = 1 To m_icount i_pgi(i) = i_pgi(i) * m_zpgi_korr i_pu(i) = i_pgi(i) + i_pgb(i) Next i End If '! -- Cumulative pension rights PR m_ap_arv_59 = 0: m_ap_arv60_ = 0: m_ap_index = 0: m_ap_favg = 0 For i = 1 To m_icount i_pr_ip1(i) = i_pr_ip(i) i_pr_pp1(i) = i_pr_pp(i) i_pb_ip1(i) = i_pb_ip(i) If i_age(i) >= 16 And i_status(i) <> 2 Then '! -- Pension rights for the ATP-system ' PP-vector for disab pens already updated in Calculate_Disablity_Pension_Benefits If i_pgi(i) > m_basbelopp_f + 100 And i_status(i) <> 4 Then Call Update_pp_hist(i, CInt(((i_pgi(i) - m_basbelopp_f) / m_basbelopp_f) * 100)) End If '! -- Pension rights and pension contributions for the reformed system Select Case i_pu(i) Case Is < f_bas_deduct_min(year) i_pr_ip(i) = 0 i_pr_pp(i) = 0 Case Else '-- Tidigare version utkommenterad 'i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) 'i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) '-- Snabb uppskruvning av avgifterna kräver korr för halvårseffekt i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _ + f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2 i_pr_pp(i) = m_ap_pp_avs * i_pu(i) * (f_utfasning_ATP(i_born_year(i), f_ap_pensyear(year, i_age(i), 0)) _ + f_utfasning_ATP(i_born_year(i) - 1, f_ap_pensyear(year, i_age(i), 0))) / 2 End Select '! -- Cumulative pension rights '! -- Income pension Inkomstpension ' -- First calculation of some aggregated variables for balancing If i_age(i) < 60 Then m_ap_arv_59 = m_ap_arv_59 + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i)))) Else m_ap_arv60_ = m_ap_arv60_ + (i_pb_ip(i) * (1 - Arvsvinstfaktor(i_age(i)))) End If m_ap_index = m_ap_index + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _ * ((m_ap_balind / m_ap_balind1) - 1)) m_ap_favg = m_ap_favg + ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) + i_pr_ip1(i)) _ * m_favg_ip) '! -- Cumulative pension rights ' -- Then individual pension rights '! -- Income pension Inkomstpension ' Tidigare version 'i_pb_ip(i) = ((i_pb_ip(i) * Arvsvinstfaktor(i_age(i) - 1) + i_pr_ip1(i)) _ ' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2)) 'i_pb_fiktiv(i) = ((i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) _ ' + (i_pr_ip1(i) + i_pr_pp1(i))) _ ' * (1 - m_favg_ip) * (m_ap_balind1 / m_ap_balind2)) If m_RFV_PB_On <> 1 Then i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _ (m_ap_balind / m_ap_balind1)) + i_pr_ip(i) i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_ip) * _ (m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i)) Else 'RFV:s förvaltningskostnadsavdrag i_pb_ip(i) = (i_pb_ip(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _ (m_ap_balind / m_ap_balind1)) + i_pr_ip(i) i_pb_fiktiv(i) = (i_pb_fiktiv(i) * Arvsvinstfaktor(i_age(i)) * 0.995 * _ (m_ap_balind / m_ap_balind1)) + (i_pr_ip(i) + i_pr_pp(i)) End If '! -- Premium pension ' Parameter i fördeln nedan avsedd att modellera osäkerheten i placeringarna ' Räknar med årsgenomsnitt på tillfälliga avkastningen,dvs div m 2 ' Förenkling nedan. Eg så skall pengarna ha tillf placering i snitt 1,5 år rand = randvek(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100)) i_pb_pp(i) = (i_pb_pp(i) * Arvsvinstfaktor(i_age(i)) * (1 - m_favg_pp) * rand) + _ (i_pr_pp(i) * (1 + (m_interest_short / 100) / 2)) Else i_pr_ip(i) = 0 i_pr_pp(i) = 0 End If Next i m_ap_arv_59 = m_ap_arv_59 * m_weight m_ap_arv60_ = m_ap_arv60_ * m_weight m_ap_arv = m_ap_arv_59 + m_ap_arv60_ m_ap_index = m_ap_index * m_weight m_ap_favg = m_ap_favg * m_weight '!-- Optional aligning of cumulative pension rights ' Proportional adjustment factor updated i Default_parameters2 Dim Align_PB As Byte 'Dim PB_IP As Double Dim pb_fiktiv As Double Dim pb_pp As Double Dim yy As Integer If get_scalefactor_active("Align_PB") = 1 And year = 2000 Then ' cohort sex {1=RFV,2=Sesim,3=Quota} Dim PB_IP(1938 To 1987, 2, 3) As Double '-- Read RFV values per cohort and sex f Sesim.mdb For yy = 1938 To 1987 PB_IP(yy, 1, 1) = f_GetMakro("PB_IP_M", year, CStr(yy)) PB_IP(yy, 2, 1) = f_GetMakro("PB_IP_F", year, CStr(yy)) Next '-- Aggregate Sesim values per cohort and sex For i = 1 To m_icount If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then PB_IP(i_born_year(i), i_sex(i), 2) = _ PB_IP(i_born_year(i), i_sex(i), 2) + (i_pb_ip(i) * m_weight) End If Next i '-- Calculation of aligning factors For yy = 1938 To 1987 If PB_IP(yy, 1, 2) > 0 And PB_IP(yy, 2, 2) > 0 Then PB_IP(yy, 1, 3) = PB_IP(yy, 1, 1) / PB_IP(yy, 1, 2) PB_IP(yy, 2, 3) = PB_IP(yy, 2, 1) / PB_IP(yy, 2, 2) Else PB_IP(yy, 1, 3) = 1 PB_IP(yy, 2, 3) = 1 End If Next '-- Printing align factors for pension rights Open sesimpath & "\tempdata\PB_align.prn" For Output As #93 Print #93, "Cohort Male Female" For yy = 1938 To 1987 Print #93, yy & " " & PB_IP(yy, 1, 3) & " " & PB_IP(yy, 2, 3) Next Close #93 '-- Aligning For i = 1 To m_icount If i_born_year(i) >= 1938 And i_born_year(i) <= 1987 Then i_pb_ip(i) = i_pb_ip(i) * PB_IP(i_born_year(i), i_sex(i), 3) i_pb_fiktiv(i) = i_pb_fiktiv(i) * PB_IP(i_born_year(i), i_sex(i), 3) 'i_pb_pp(i) = i_pb_pp(i) * m_zpb_pp_korr End If Next i End If End Sub
Public Sub Calculate_Occupational_Pension_Rights() '!-- Calculation of occupational pension rights for defined contribution systems status "Calculate occupational pensions rights" Printdok " Calculate_Occupational_Pension_Rights" Dim i As Long, pgi_bas As Long Dim tak As Double, rand() As Double, r1 As Double, r2 As Double year = model_time + base_year If year < 2001 Then tak = 7.5 * m_basbelopp_f Else tak = 7.5 * m_basbelopp_income '*** Draw random numbers ReDim rand(1 To 2 * m_icount) Call RANNOR(2 * m_icount, rand(1), model_time + base_year + random * Rnd) For i = 1 To m_icount If (i_status(i) <> 2 And i_abroad(i) = 0) Or _ (i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65) Then '-- Simplified calc of pension rights for part-time retired. Assumes that all ' all income qualifies for pension rights even pensions. pgi_bas = i_inc_earning(i) + i_trf_sickleave(i) If i_status(i) = 2 And i_work_share(i) > 0 And i_age(i) < 65 Then '-- Part-time retired normally gets pensions rights as if full-time to age 65 pgi_bas = (i_inc_earning(i) + i_trf_sickleave(i)) / i_work_share(i) '-- Rough calc of full-time pay Else pgi_bas = i_inc_earning(i) + i_trf_sickleave(i) End If Select Case i_sector(i) Case 1 '-- Blue collar: SAF-LO i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.035, , tak, 21, 1932) i_pr_op_tp(i) = 0 i_op_pp_years_Blue(i) = i_op_pp_years_Blue(i) + 1 Case 2 '-- White collar: ITPK i_pr_op_ap(i) = 0 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.02, , tak, 28, 1939) i_op_pp_years_White(i) = i_op_pp_years_White(i) + 1 Case 3 '-- State: PA03 & Kåpan If year >= 2003 Then '-- PA03 i_pr_op_ap(i) = f_op_pens_rights(mini(pgi_bas, 30 * m_basbelopp_income), _ i_age(i), i_born_year(i), 0.023, , tak, 23, 1943) Else i_pr_op_ap(i) = 0 End If Select Case year '-- Extra Kåpan Case Is < 2003 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.015, , tak, 28) Case 2003 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.019, , tak, 28) Case Is > 2003 i_pr_op_tp(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.02, , tak, 28) End Select i_op_pp_years_State(i) = i_op_pp_years_State(i) + 1 Case 4 '-- Local goverment: PFA-01 Select Case year '-- PFA98 (Kommunalarbetareförbundets premier) Case Is < 2004 i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.045, 0.021, tak, 28, 1938) i_pr_op_tp(i) = 0 Case Is >= 2004 '-- Employed 2003, minimum age 28, still 4,5% fee If i_born_year(i) < 1976 Then i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.045, 0.011, tak, 28, 1938) Else '-- Still 28 year age limit above social insurance limit i_pr_op_ap(i) = f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0.04, 0, tak, 21, 1938) + _ f_op_pens_rights(pgi_bas, i_age(i), i_born_year(i), _ 0, 0.011, tak, 28, 1938) End If i_pr_op_tp(i) = 0 End Select i_op_pp_years_Local(i) = i_op_pp_years_Local(i) + 1 Case Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End Select Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End If '! -- Cumulative occupational pension rights ' Parameter in distribution below measures uncertainty in investment ' Assumes same average return on occupational pension funds as public premium pension ' Also tax on return 15% (avkastningsskatt) on occup pens rights r1 = rand(i) * Sqr(0.0000001) + (1 + (m_shares_return / 100)) r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_shares_return / 100)) 'VARFÖR INTE RÄKNA NER STOCKEN ÄVEN FÖR DE SOM INTE ARBETAR DELTID, ALLTSÅ 'VARFÖR INTE TA BORT VILLKORET OM work_share If i_status(i) = 2 And i_work_share(i) > 0 Then '-- Updating the stock i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _ + i_pr_op_ap(i) - i_op_ap_dc(i) Else i_pb_op_ap(i) = (i_pb_op_ap(i) * r1 * (1 - ((m_interest_long / 100) * 0.15))) _ + i_pr_op_ap(i) i_pb_op_tp(i) = (i_pb_op_tp(i) * r2 * (1 - ((m_interest_long / 100) * 0.15))) _ + i_pr_op_tp(i) End If ' -- DB-rights for persons who has changed sector capitalized and added to DC-rights ' Upparbetade DB-rätter omvandlas t DC-rätter f 65 års ålder If i_sector(i) <> i_sector1(i) And (i_sector1(i) <> 0 And i_sector1(i) <> 5) Then i_pb_op_ap(i) = i_pb_op_ap(i) + mini(1, (i_op_pp_years(i) / 30)) * _ (PV(m_interest_long / 100, explife(65), _ -f_Occupational_DB_pension_benefits(i, i_sector1(i), 0))) i_op_pp_years(i) = 0 i_op_pp_years_trans(i) = 0 Else i_op_pp_years(i) = i_op_pp_years(i) + 1 End If Next i End Sub
' Note: ' No information about lagged statuses. Uses the status for the base year for whole period ' Note: Possible to move this procedure to start data program ' Procedure call from c00_Init
Public Sub Init_Occupational_Pension_Rights() '!-- Initiation of occupational pension stocks in DC systems status "Init occupational pensions" Printdok " Init_Occupational_Pension_Rights" Dim i As Long Dim tak As Double Dim yr As Integer Dim rand() As Double, r1 As Double, r2 As Double Dim Interest_long As Double For yr = 1977 To base_year Interest_long = f_GetMakro("Interest_long", yr) m_basbelopp_f = f_GetMakro("BASBF", yr) tak = 7.5 * m_basbelopp_f '*** Draw random numbers ReDim rand(1 To 2 * m_icount) Call RANNOR(2 * m_icount, rand(1), yr * 10 + random * Rnd) For i = 1 To m_icount '-- Loops all individuals If i_status(i) = 8 And i_abroad(i) = 0 Then '**** Syntax for function call: x = f_op_pens_rights(fee,fee top, age, born) Select Case i_sector(i) Case 1 '-- Blue collar: SAF-LO If yr >= 1996 Then i_pr_op_ap(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _ i_age(i), i_born_year(i), 0.02, , tak, 21, 1932) Else i_pr_op_ap(i) = 0 End If i_pr_op_tp(i) = 0 Case 2 '-- White collar: ITPK i_pr_op_ap(i) = 0 If yr >= 1977 Then i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _ i_age(i), i_born_year(i), 0.02, , tak, 28, 1939) Else i_pr_op_tp(i) = 0 End If Case 3 '-- State: PA03 & Kåpan i_pr_op_ap(i) = 0 If yr >= 1991 Then '-- Kåpan i_pr_op_tp(i) = f_op_pens_rights(f_hist_income(i, yr, m_basbelopp_f), _ i_age(i), i_born_year(i), 0.015, , tak, 28) Else i_pr_op_tp(i) = 0 End If Case 4 '-- Local goverment: PFA98 If yr >= 1998 Then '-- PFA98 (Kommunalarbetareförbundets premier) i_pr_op_ap(i) = f_op_pens_rights(i_inc_taxable1(i), i_age(i), i_born_year(i), _ 0.045, 0.021, tak, 28, 1938) Else i_pr_op_ap(i) = 0 End If If yr >= 1998 Then End If i_pr_op_tp(i) = 0 Case Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End Select Else i_pr_op_ap(i) = 0 i_pr_op_tp(i) = 0 End If '! -- Cumulative occupational pension rights ' Parameter in distribution below measures uncertainty in investment ' Assumes same average return on occupational pension funds as public premium pension r1 = rand(i) * Sqr(0.0000001) + (1 + (m_interest_long / 100)) r2 = rand(i + m_icount) * Sqr(0.0000001) + (1 + (m_interest_long / 100)) i_pb_op_ap(i) = i_pb_op_ap(i) * r1 + i_pr_op_ap(i) i_pb_op_tp(i) = i_pb_op_tp(i) * r2 + i_pr_op_tp(i) Next i Next yr ' -- Saving 4 year averaged income 1997 x 100 / basb ' Used primarily in cal of transitional rules for local government employees For i = 1 To m_icount '-- Loops all individuals i_avg_income_1997(i) = (i_inc_taxable2(i) / m_basbelopp2 + _ i_inc_taxable3(i) / m_basbelopp3 + _ i_inc_taxable4(i) / m_basbelopp4 + _ i_inc_taxable5(i) / m_basbelopp5) * 100 / 4 Next i End Sub
' Note: Uses truncated pp_hist values years less than base_year-5 years, ' lagged income variables for base_year-5 to base_year '-- Syntax for function call: ' x = f_hist_income(ix,y) ' ix = index for actual individual ' y = historical year ' basb = basic amount for the historical year
Public Function f_hist_income(ix As Long, y As Integer, basb As Long) As Long '!-- Returns the historical income for a certain year Dim j As Integer f_hist_income = 0 If y < base_year - 5 Then If pp_hist(ix).n_years > 0 Then For j = 1 To pp_hist(ix).n_years If pp_hist(ix).pp_years(j) = y Then f_hist_income = (pp_hist(ix).pp(j) + 100) * basb / 100 Exit For End If Next End If Else Select Case y Case base_year - 5 f_hist_income = i_inc_taxable5(ix) Case base_year - 4 f_hist_income = i_inc_taxable4(ix) Case base_year - 3 f_hist_income = i_inc_taxable3(ix) Case base_year - 2 f_hist_income = i_inc_taxable2(ix) Case base_year - 1 f_hist_income = i_inc_taxable1(ix) Case base_year f_hist_income = i_inc_taxable(ix) Case Else f_hist_income = 0 End Select End If End Function
'-- Syntax for function call: ' x = f_op_pens_rights(income,age,born,fee,fee top, top limit, agelimit, bornlimit) ' income = pensionsmedförande lön (i kr) ' age = age of individual ' born = year of birth of individual ' fee = premium (eg 0.035) below a certain limit, eg the social security limit 7,5 basb. ' fee top = premie above the limit (eg 0.035) Optional: Default= fee ' toplim = The limit (eg 7,5 basb) Optional: Default=7.5 basb ' agelim = åldergräns för intjänande (tex 28) Optional: Default= 19 ' bornlim = gäller personer födda efter detta år (tex 1943) Optional: Default= 1900
Public Function f_op_pens_rights(income As Long, age As Byte, born As Integer, _ fee As Double, Optional feetop As Double = -1, Optional toplim As Double = -1, _ Optional agelim As Integer = 19, Optional bornlim As Integer = 1900) As Long '!-- Calculation of occupational pension rights (defined contribution systems) ' for different labour market sectors If feetop = -1 Then feetop = fee End If If toplim = -1 Then toplim = 7.5 * m_basbelopp End If If age > agelim And born > bornlim Then If income <= toplim Then f_op_pens_rights = fee * income Else f_op_pens_rights = (fee * toplim) + (feetop * (income - toplim)) End If End If End Function
'-- Updates the pension history vectors in pp_hist ' Input: ' ix = index for actual individual ' pp = calculated value for pp_hist(i).pp ' Automatically updated: ' Number of years in pp_hist(i).n_years = n_years + 1 ' Income year in pp_hist(i).pp_years = year ' Output: Nothing
Public Sub Update_pp_hist(ix As Long, pp As Integer) '!-- Updates pension history vectors in pp_hist ReDim Preserve pp_hist(ix).pp(pp_hist(ix).n_years + 1) ReDim Preserve pp_hist(ix).pp_years(pp_hist(ix).n_years + 1) pp_hist(ix).n_years = pp_hist(ix).n_years + 1 pp_hist(ix).pp(pp_hist(ix).n_years) = pp pp_hist(ix).pp_years(pp_hist(ix).n_years) = year End Sub
'-- Returns number of ATP years for individual i up to year y ' Input: ' ix = index for actual individual ' year = number of ATP years up to this year
Public Function f_pp_years(ix As Long, year As Integer) As Byte '!-- Number of ATP years for individual i up to year y Dim y As Integer f_pp_years = 0 If pp_hist(ix).n_years > 0 Then For y = 1 To pp_hist(ix).n_years If pp_hist(ix).pp_years(y) <= year Then f_pp_years = f_pp_years + 1 Else Exit For End If Next End If End Function
' -- Returns the ratio used for adjustment of calculated ATP-pension for early / ' late retirement (Note: time unit = month) ' Default values from public ATP system ' Input: pensage = early or late pension in years compared to 65 year ' early = monthly down correction if early pension. Optional, default=005% per month ' early=-999 means actuarial calculation ' late = monthly up correction if late pension. Optional, default=007% per month ' Note: explife and m_interest_short must be defined before execution 'Examples: x=f_fu_kvot(f_ap_pensage(i_ap_pensmonth(i)),0.005,0.007) or x=f_fu_kvot(f_ap_pensage(i),-999) '-----------------------------------------------------------------------------------------
Public Function f_fu_kvot(pensage As Byte, Optional Early As Double = 0.005, Optional Late As Double = 0.007) As Double '!-- Returns the ratio used for adjustment of calculated ATP-pension for early / '! late retirement (Note: time unit = month) Dim rate As Double '-- Yearly discounting factor rate = m_interest_long / 100 'Standardantagande: Långränta If Early = -999 Then '-- Code -999 for actuarial calculation (Ja, jag vet: Ett hack) f_fu_kvot = Pmt(rate, explife(pensage), PV(rate, explife(65), 1)) Else Select Case pensage Case Is < 60 ' No pensions before 60 MsgBox ("Error in f_fu_kvot: Check pension age in function call") Case Is < 65 ' -- Early withdrawal f_fu_kvot = 1 + ((pensage - 65) * Early * 12) Case 65 ' -- 65 years f_fu_kvot = 1 Case Is <= 70 ' -- Late withdrawal f_fu_kvot = 1 + ((pensage - 65) * Late * 12) Case Is > 70 MsgBox ("Error in f_fu_kvot: Check pension age in function call") End Select End If End Function
'-- Returns basic pension ratio used for calculation of i_ap_fp, i_ap_fp30, i_ap_pts etc ' Input: Civil status 0=Not married, 1= Married ' Note: m_ap_fp_kvot_ogifta and m_ap_fp_kvot_gifta must be initiated before execution
Public Function f_ap_fp_kvot(civ_stat As Byte) As Double If civ_stat = 0 Then f_ap_fp_kvot = m_ap_fp_kvot_ogifta ElseIf civ_stat = 1 Then f_ap_fp_kvot = m_ap_fp_kvot_gifta Else MsgBox "Fel i f_ap_fp_kvot: Parameter ska vara 0 eller 1" End If End Function
'-- Reduction of benefits on account of inadequate period of service ' In swedish: Tjänstetidsfaktor 'Note: Not indepent. Uses pp-history ' Examples: x= f_red_service_time(i,f_krav_atp_ar(i_borm_year(i))
Public Function f_red_service_time(ix As Long, Optional limit As Integer = 30) As Double '!-- Tjänstetidsfaktor f_red_service_time = mini(1, (pp_hist(ix).n_years) / limit) End Function
'-- Calculates the income pension annuity factors (delningstal), annuity facors for ' premium pension and inheritance gains ' Annuity factors caculated on death hazards in assumptions file ' Income pension: dtalip(age 50-106) with 1,6% norm growth as default ' Premium pension: dtalpp(age 50-106) default 3.2%. If 0 expected remaining lifetime ' Inheritance gains based on a direct and simplified method based on death hazards ' i.e. no summing up of actual cumulated pension funds for persons younger than 60 ' Creates a public array defined from 0 to 106 years: Arvsvinstfactor(y=0-106) ' Note: Call and defintion of global variables in new_economy_2 once a year
Public Sub Calculate_Deltal(Optional norm As Double = 1.016, Optional normpp As Double = 1) '!-- Calculates pension annuity factors (delningstal) '!-- and inheritance factors (arvsvinstfaktor) Printdok " Calculate_Deltal" Dim maxyear As Long Dim B(0 To 106, 1 To 2) As Double Dim q(0 To 106, 1 To 2) As Double Dim lx(0 To 106, 1 To 2) As Double Dim lx_(0 To 106) As Double Dim sex As Long, year As Long, age As Long, n As Long, x As Long, k As Long, j As Long Dim pop As Double, d As Double, e As Double, r As Double year = model_time + base_year maxyear = mini(2050, year) Dim q_lag As Double, l As Integer For sex = 1 To 2 pop = 100000 For age = 0 To 106 q_lag = 1 For l = 1 To 5 '-- 5-year smoothed hazards q_lag = q_lag * parm_death(mini(2110, maxi(1999, year - l)), age, sex) Next q_lag = q_lag ^ (1 / 5) pop = pop * (1 - q_lag) B(age, sex) = pop Next Next For sex = 1 To 2 For age = 0 To 106 If age < 106 Then lx(age, sex) = (B(age, sex) + B(age + 1, sex)) / 2 Else lx(age, sex) = B(age, sex) End If Next Next For age = 1 To 106 '-- Note: One year shift i age, i.e age 0 = -1 etc. lx_(age) = (lx(age - 1, 1) * 0.5145) + (lx(age - 1, 2) * (1 - 0.5145)) Next For n = 50 To 106 d = 0 e = 0 r = 0 For x = 0 To 11 For k = n To 105 d = d + ((norm) ^ (-(k - n))) * _ (lx_(k) + (lx_(k + 1) - lx_(k)) _ * (x / 12)) * (norm) ^ (-x / 12) e = e + (normpp) ^ (-(k - n)) * _ (lx_(k) + (lx_(k + 1) - lx_(k)) _ * (x / 12)) * (normpp) ^ (-x / 12) r = r + (1) ^ (-(k - n)) * _ (lx_(k) + (lx_(k + 1) - lx_(k)) _ * (x / 12)) * (1) ^ (-x / 12) Next Next dtalip(n) = round(d / (12 * lx_(n)), 2) dtalpp(n) = round(e / (12 * lx_(n)), 2) explife(n) = r / (12 * lx_(n)) Next For age = 1 To 106 Arvsvinstfaktor(age) = 1 + ((lx_(age - 1) - lx_(age)) / lx_(age)) Next '-- Optional switch to exogenous "Orange envelopes"-annuity factors If get_scalefactor_active("Pension_Orange") = 1 And year >= 2003 Then dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249") dtalpp(65) = f_GetMakro("dtal_rfvpp", CInt(maxyear), "dtal_rfv") End If '-- Optional switch to exognous discounted expected remaining lifetime according to ' RFV 2002. ' Note: Only active if pensions at age 65, and for year 2003 to 2100. If get_scalefactor_active("Deltal_RFV") = 1 Then If year > 2002 Then dtalip(65) = f_GetMakro("dtal_rfvip", CInt(maxyear), "dtal_rfv249") End If End If End Sub
Public Function f_krav_atp_ar(born_year As Integer) As Integer '! -- Calculates required number of years for ATP for different cohorts Select Case born_year Case Is > 1923 f_krav_atp_ar = 30 Case 1915 To 1923 f_krav_atp_ar = 20 + born_year - 1914 Case Else f_krav_atp_ar = 20 End Select End Function
Public Function f_utfasning_ATP(born_year As Integer, ap_pens_year As Integer) As Double '! -- Calculates parameter for phasing out the ATP system Note: > 1953 = 1 and <1938 = 0 ' Includes transitions rules for persons born 1938 and 1939 Select Case born_year Case Is > 1953 f_utfasning_ATP = 1 Case 1938 To 1953 If born_year <= 1939 And ap_pens_year <= 2000 And year <= 2003 Then f_utfasning_ATP = 0 Else f_utfasning_ATP = (born_year - 1937 + 3) / 20 End If Case Else f_utfasning_ATP = 0 End Select End Function
' Note: If i_ap_pensmonth <0 => early withdrawal (in months), >0 late, 0 = pensage=65 ' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal 'Public Function f_ap_pensage(idxnr As Long) As Byte
Public Function f_ap_pensage(pensmonth As Integer) As Byte '! -- Calculates pension age in years f_ap_pensage = 65 + Int(pensmonth / 12) End Function
' -- Calculates pension year (ex post and ex ante). ' Uses the variable i_ap_pensmonth = Number of months of early or late withdrawal ' from the default value 65. 'Public Function f_ap_pensyear(idxnr As Long) As Integer
Public Function f_ap_pensyear(year As Integer, age As Byte, pensmonth As Integer) As Integer '! -- Calculates pension year 'f_ap_pensyear = year - (i_age(idxnr) - (65 + Int(i_ap_pensmonth(idxnr) / 12))) f_ap_pensyear = year - (age - (65 + Int(pensmonth / 12))) End Function
' -- Choice of price indexation method ' Note: Price indexation m_basbelopp / m_basbelopp1 not m_KPI, but same result in steady state.
Public Function f_pens_index(program As String, age As Byte) As Double '! -- Calculates actual price indexation method for different pension programs and years Select Case year Case Is >= 2003 Select Case program Case "ATP" '-- LIP 5 kap, 14§ If age < 65 Then '-- Before age 65 only price indexing f_pens_index = m_basbelopp / m_basbelopp1 Else '-- Discounted income indexation after age 65 (Följsamhetsindexering) f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm) End If Case "IP" f_pens_index = (m_ap_balind / m_ap_balind1) * (1 / m_ap_norm) Case "GP" f_pens_index = m_basbelopp / m_basbelopp1 Case "OP" '-- Payed out defined benefit occupational pensions f_pens_index = m_basbelopp / m_basbelopp1 Case Else f_pens_index = 0 End Select Case Is <= 2001 Select Case program Case "ATP" f_pens_index = m_basbelopp / m_basbelopp1 Case "FP" f_pens_index = m_basbelopp / m_basbelopp1 Case "PTS" f_pens_index = m_basbelopp / m_basbelopp1 Case "IP" '-- Eg kan uttag av IP ske f 2001, men ej Sesim f_pens_index = 0 Case "OP" '-- Payed out defined benefit occupational pensions f_pens_index = m_basbelopp / m_basbelopp1 Case Else f_pens_index = 0 End Select Case 2002 Select Case program Case "ATP" '-- Enl Prop 1999/00:138, sid 72 'f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / m_ap_norm) f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996) Case "FP" f_pens_index = m_basbelopp / m_basbelopp1 Case "PTS" f_pens_index = m_basbelopp / m_basbelopp1 Case "IP" ' **** Skall ev vara 1.026 i nämnaren??? f_pens_index = (m_ap_inkind / m_ap_inkind1) * (1 / 0.996) Case "OP" '-- Payed out defined benefit occupational pensions f_pens_index = m_basbelopp / m_basbelopp1 Case Else f_pens_index = 0 End Select End Select End Function
'! -- Reformed basic retirement pensions for individuals born from 1938 on ' Garantipension för personer födda from 1938 ' Output: Reformed basic pension, current SEK Utbetald garantipension
Public Function f_ap_garp_38_(civ_stat As Byte, basbelopp As Long, ap_tp As Long, _ ap_fiktiv As Long, surv As Long) As Long '! -- Reformed basic retirement pensions Garantipension Dim berunderlag As Long berunderlag = ap_tp + ap_fiktiv + surv Select Case civ_stat '-- Marital status Case 0 '-- Not married If berunderlag <= 1.26 * basbelopp Then f_ap_garp_38_ = (2.13 * basbelopp) - berunderlag Else f_ap_garp_38_ = maxi(0, ((2.13 - 1.26) * basbelopp) - 0.48 * _ (berunderlag - (1.26 * basbelopp))) End If Case 1 '-- Married If berunderlag <= 1.14 * basbelopp Then f_ap_garp_38_ = 1.9 * basbelopp - berunderlag Else f_ap_garp_38_ = maxi(0, ((1.9 - 1.14) * basbelopp) - 0.48 * _ (berunderlag - (1.14 * basbelopp))) End If End Select End Function
'! -- Transitional reformed basic retirement pension for individuals born until 1938 ' f.d. Övergångsvis garantipension för indvider födda tom 1937
Public Function f_ap_garp_37(civ_stat As Byte, basbelopp As Long, _ ap_atp As Long, ap_fp30 As Long, ap_fp As Long, ap_pts As Long, _ surv As Long, op As Long, botid As Integer) As Long Dim berunderlag As Long Dim berunderlag_korr As Long '!-- 1: Beräkning av beräkningsunderlag berunderlag = ap_atp + maxi(ap_fp30, ap_fp) + ap_pts + surv + op '!-- 2: Uppräkning av beräkningsunderlag som komp för SGA If berunderlag <= 0.25 * basbelopp Then berunderlag_korr = berunderlag * 1.04 ElseIf berunderlag > 0.25 * basbelopp And berunderlag < 1.354 * basbelopp Then berunderlag_korr = 1.5174 * berunderlag - 0.1193 * basbelopp Else Select Case civ_stat '-- Marital status Case 0 '-- Not married If berunderlag >= 1.354 * basbelopp And berunderlag < 1.529 * basbelopp Then berunderlag_korr = 1.343 * berunderlag + 0.1168 * basbelopp ElseIf berunderlag >= 1.529 * basbelopp And berunderlag < 3.16 * basbelopp Then berunderlag_korr = 2.17 * basbelopp + 0.6 * (berunderlag - 1.51 * basbelopp) Else berunderlag_korr = berunderlag End If Case 1 '-- Married If berunderlag >= 1.354 * basbelopp And berunderlag < 2.8275 * basbelopp Then berunderlag_korr = 1.935 * basbelopp + 0.6 * (berunderlag - 1.34 * basbelopp) Else berunderlag_korr = berunderlag End If End Select End If '!-- 3: Beräkning av garantipension mht inkomst, civilstånd etc f_ap_garp_37 = maxi(0, berunderlag_korr - (ap_atp + ap_fp30 + surv + op)) _ * mini(1, botid / 40) End Function
' Note: Do NOT use in loops
Public Function f_GetMakro(Namn As String, yr As Integer, Optional typ As String = "Macro") As Double '!-- Reading data from table T_DATA in Sesimrun.MDB '! If no hit in the database the latest number is retained On Error Resume Next Dim rs As New ADODB.Recordset, cn As New ADODB.Connection Dim SQL As String SQL = "select * from T_Data where (Type='" & typ & "' AND Name='" & Namn & "' AND year=" & yr & ")" rs.Open SQL, _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sesimpath & "\source\sesim.mdb" _ & "; Persist Security Info=False" f_GetMakro = rs![value] End Function
'**** Note: Its faster write direct to a file witout open and close within the loop as in the procedure ' below ' Syntax: Print_to_file ' "filenamne" ' "{Y/N}" = "Y" if New file, "N" if append ' any number of variable names incl index within () or text strings ' within "", all comma separated ' Example: Print_to_file "valid_pens.txt", "N", i, year, i_age(i), i_sex(i) ' Examples also in procedure "Pension_debugging_files" in this module
Sub Print_to_file(filn As String, Clear As String, ParamArray var() As Variant) '!-- General procedure for printing of text or variables to a file Dim demofile As Integer Dim x As Variant Dim utvar As String demofile = FreeFile If Clear = "Y" Then Open sesimpath & "\" & filn For Output As #demofile Else Open sesimpath & "\" & filn For Append As #demofile End If For Each x In var utvar = utvar & CStr(x) & Chr$(9) Next x Print #demofile, utvar Close #demofile End Sub
Public Function f_Concat_string(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string = f_Concat_string & CStr(x) & Chr$(9) Next x End Function
Public Function f_Concat_string_space(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string_space = f_Concat_string_space & CStr(round(x, 5)) & Chr$(32) Next x End Function
Public Function f_Concat_string_comma(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string_comma = f_Concat_string_comma & CStr(x) & Chr$(44) Next x End Function
Public Function f_Concat_string_cita(ParamArray var() As Variant) '-- Concatenates any number of arguments to a string (tab separated) Dim x As Variant For Each x In var f_Concat_string_cita = f_Concat_string_cita & Chr$(34) & CStr(x) & Chr$(34) & Chr$(32) Next x End Function
Public Function f_pens_bas(program As String) As Double '! -- Choice of basic amount definition for different pension programs and years Select Case year Case Is >= 2003 Select Case program Case "ATP" f_pens_bas = m_basbelopp_income Case "OP" f_pens_bas = m_basbelopp_income Case "IP" f_pens_bas = m_basbelopp_income Case "GP" '-- Optional choce of income indexation in Control Center - Parameters ' If income indexation wanted set m_ap_gp_Inkindex_On On=1 for actual years f_pens_bas = m_basbelopp_gp Case Else f_pens_bas = 0 End Select Case 1997 To 1998 '-- Minskat basbelopp tom 1998 Select Case program Case "ATP" f_pens_bas = m_basbelopp * 0.98 Case "OP" f_pens_bas = m_basbelopp * 0.98 Case "FP" f_pens_bas = m_basbelopp * 0.98 Case "PTS" f_pens_bas = m_basbelopp * 0.98 Case Else f_pens_bas = 0 End Select Case 1999 To 2001 Select Case program Case "ATP" f_pens_bas = m_basbelopp Case "OP" f_pens_bas = m_basbelopp Case "FP" f_pens_bas = m_basbelopp Case "PTS" f_pens_bas = m_basbelopp Case Else f_pens_bas = 0 End Select Case 2002 Select Case program Case "ATP" f_pens_bas = m_basbelopp_income Case "OP" f_pens_bas = m_basbelopp_income Case "FP" f_pens_bas = m_basbelopp Case "PTS" f_pens_bas = m_basbelopp Case Else f_pens_bas = 0 End Select End Select End Function
'-- Calculation of some macro variables for reporting
Public Sub Calculate_Macro() Dim Bef(1 To 6) As Double, p(1 To 6) As Double, status(1 To 9) As Long Dim Bef_Status_Sex() As Long, maxyear As Integer Dim i As Long, j As Long, s As Long Dim Bef5(1 To 22) As Long, Bef5_M(1 To 22) As Long, Bef5_K(1 To 22) As Long Dim AK5(1 To 22) As Long, AK5_M(1 To 22) As Long, AK5_K(1 To 22) As Long Dim AL5(1 To 22) As Long, AL5_M(1 To 22) As Long, AL5_K(1 To 22) As Long Dim akbef1664_p As Double, al1664_p As Double, aptot_p As Double, apsys_p As Double year = model_time + base_year 'If year <= 2050 Then maxyear = year Else maxyear = 2050 'If year <= 2150 Then maxyear = year Else maxyear = 2150 If year <= 2110 Then maxyear = year Else maxyear = 2110 '!-- Calculation and aggregation of some macro variables Printdok " Calculate_Macro" m_inc_earning = L_SUMVEC(i_inc_earning(1), m_icount) * m_weight m_arbavg = L_SUMVEC(i_arbavg(1), m_icount) * m_weight ' m_arbavg_p * m_inc_earning m_arbavg_pens = L_SUMVEC(i_arbavg_pens(1), m_icount) * m_weight ' m_arbavg_pens_p * m_inc_earning m_arbavg_ovr = m_arbavg - m_arbavg_pens m_pr_op = (L_SUMVEC(i_pr_op_ap(1), m_icount) + L_SUMVEC(i_pr_op_tp(1), m_icount)) * m_weight m_arbavg_slon = m_arbavg_slon_p * m_pr_op m_pgi_bas = L_SUMVEC(i_pgi_bas(1), m_icount) * m_weight m_pgi_bas_n = cnt0(i_pgi_bas) * m_weight m_pgi_bas_gt_basb = sumif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight m_pgi_bas_gt_basb_n = cntif(i_pgi_bas, i_pgi_bas, "GT", m_basbelopp_income) * m_weight / 1000 '-- Participation rate etc. ReDim Bef_Status_Sex(0 To 106, 1 To 9, 1 To 2) As Long For i = 1 To m_icount If i_abroad(i) = 0 Then Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) = _ Bef_Status_Sex(mini(106, i_age(i)), i_status(i), i_sex(i)) + 1 End If Next For i = 0 To 106 For j = 1 To 8 Bef5_M(Int(i / 5) + 1) = Bef5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1) Bef5_K(Int(i / 5) + 1) = Bef5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 2) Bef5(Int(i / 5) + 1) = Bef5(Int(i / 5) + 1) + Bef_Status_Sex(i, j, 1) + _ Bef_Status_Sex(i, j, 2) Next AK5_M(Int(i / 5) + 1) = AK5_M(Int(i / 5) + 1) + _ Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) AK5_K(Int(i / 5) + 1) = AK5_K(Int(i / 5) + 1) + _ Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2) AK5(Int(i / 5) + 1) = AK5(Int(i / 5) + 1) + _ Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) + _ Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2) AL5_M(Int(i / 5) + 1) = AL5_M(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 1) AL5_K(Int(i / 5) + 1) = AL5_K(Int(i / 5) + 1) + Bef_Status_Sex(i, 6, 2) Next For j = 1 To 9 For i = 0 To 106 status(j) = status(j) + Bef_Status_Sex(i, j, 1) + Bef_Status_Sex(i, j, 2) Next Next m_BEFM0015 = 0 m_BEFK0015 = 0 m_BEFM1664 = 0 m_BEFK1664 = 0 m_BEFM65WW = 0 m_BEFK65WW = 0 Dim AK1664 As Long For i = 0 To 15 For j = 1 To 8 m_BEFM0015 = m_BEFM0015 + Bef_Status_Sex(i, j, 1) m_BEFK0015 = m_BEFK0015 + Bef_Status_Sex(i, j, 2) Next Next For i = 16 To 64 AK1664 = AK1664 + Bef_Status_Sex(i, 5, 1) + Bef_Status_Sex(i, 6, 1) + Bef_Status_Sex(i, 8, 1) _ + Bef_Status_Sex(i, 5, 2) + Bef_Status_Sex(i, 6, 2) + Bef_Status_Sex(i, 8, 2) For j = 1 To 8 m_BEFM1664 = m_BEFM1664 + Bef_Status_Sex(i, j, 1) m_BEFK1664 = m_BEFK1664 + Bef_Status_Sex(i, j, 2) Next Next For i = 65 To 106 For j = 1 To 8 m_BEFM65WW = m_BEFM65WW + Bef_Status_Sex(i, j, 1) m_BEFK65WW = m_BEFK65WW + Bef_Status_Sex(i, j, 2) Next Next '-- Definition of macrovariables for different agegroups ' Labour supply = Sesim status 5+6+8. ' Note: Persons in labour market programs out of labour force included m_AKM1619 = (AK5_M(4)) * m_weight / 1000 m_AKK1619 = (AK5_K(4)) * m_weight / 1000 m_AKM2024 = (AK5_M(5)) * m_weight / 1000 m_AKK2024 = (AK5_K(5)) * m_weight / 1000 m_AKM2529 = (AK5_M(6)) * m_weight / 1000 m_AKK2529 = (AK5_K(6)) * m_weight / 1000 m_AKM3034 = (AK5_M(7)) * m_weight / 1000 m_AKK3034 = (AK5_K(7)) * m_weight / 1000 m_AKM3539 = (AK5_M(8)) * m_weight / 1000 m_AKK3539 = (AK5_K(8)) * m_weight / 1000 m_AKM4044 = (AK5_M(9)) * m_weight / 1000 m_AKK4044 = (AK5_K(9)) * m_weight / 1000 m_AKM4549 = (AK5_M(10)) * m_weight / 1000 m_AKK4549 = (AK5_K(10)) * m_weight / 1000 m_AKM5054 = (AK5_M(11)) * m_weight / 1000 m_AKK5054 = (AK5_K(11)) * m_weight / 1000 m_AKM5559 = (AK5_M(12)) * m_weight / 1000 m_AKK5559 = (AK5_K(12)) * m_weight / 1000 m_AKM6064 = (AK5_M(13)) * m_weight / 1000 m_AKK6064 = (AK5_K(13)) * m_weight / 1000 m_AKM6569 = (AK5_M(14)) * m_weight / 1000 m_AKK6569 = (AK5_K(14)) * m_weight / 1000 m_AKM7074 = (AK5_M(15)) * m_weight / 1000 m_AKK7074 = (AK5_K(15)) * m_weight / 1000 m_AKT1664 = AK1664 * m_weight / 1000 ' -- Unemployed m_ALM1619 = (AL5_M(4)) * m_weight / 1000 m_ALK1619 = (AL5_K(4)) * m_weight / 1000 m_ALM2024 = (AL5_M(5)) * m_weight / 1000 m_ALK2024 = (AL5_K(5)) * m_weight / 1000 m_ALM2529 = (AL5_M(6)) * m_weight / 1000 m_ALK2529 = (AL5_K(6)) * m_weight / 1000 m_ALM3034 = (AL5_M(7)) * m_weight / 1000 m_ALK3034 = (AL5_K(7)) * m_weight / 1000 m_ALM3539 = (AL5_M(8)) * m_weight / 1000 m_ALK3539 = (AL5_K(8)) * m_weight / 1000 m_ALM4044 = (AL5_M(9)) * m_weight / 1000 m_ALK4044 = (AL5_K(9)) * m_weight / 1000 m_ALM4549 = (AL5_M(10)) * m_weight / 1000 m_ALK4549 = (AL5_K(10)) * m_weight / 1000 m_ALM5054 = (AL5_M(11)) * m_weight / 1000 m_ALK5054 = (AL5_K(11)) * m_weight / 1000 m_ALM5559 = (AL5_M(12)) * m_weight / 1000 m_ALK5559 = (AL5_K(12)) * m_weight / 1000 m_ALM6064 = (AL5_M(13)) * m_weight / 1000 m_ALK6064 = (AL5_K(13)) * m_weight / 1000 m_ALM6569 = (AL5_M(14)) * m_weight / 1000 m_ALK6569 = (AL5_K(14)) * m_weight / 1000 m_ALM7074 = (AL5_M(15)) * m_weight / 1000 m_ALK7074 = (AL5_K(15)) * m_weight / 1000 ' Population = Status 1 to 8. Not persons abroad. m_BEFM0014 = (Bef5_M(1) + Bef5_M(2) + Bef5_M(3)) * m_weight / 1000 m_BEFK0014 = (Bef5_K(1) + Bef5_K(2) + Bef5_K(3)) * m_weight / 1000 m_BEFM0015 = m_BEFM0015 * m_weight / 1000 m_BEFK0015 = m_BEFK0015 * m_weight / 1000 m_BEFM1519 = (Bef5_M(4)) * m_weight / 1000 m_BEFK1519 = (Bef5_K(4)) * m_weight / 1000 m_BEFM1619 = (Bef5_M(4) - Bef_Status_Sex(15, 1, 1)) * m_weight / 1000 m_BEFK1619 = (Bef5_K(4) - Bef_Status_Sex(15, 1, 2)) * m_weight / 1000 m_BEFM2024 = Bef5_M(5) * m_weight / 1000 m_BEFK2024 = Bef5_K(5) * m_weight / 1000 m_BEFM2529 = (Bef5_M(6)) * m_weight / 1000 m_BEFK2529 = (Bef5_K(6)) * m_weight / 1000 m_BEFM3034 = (Bef5_M(7)) * m_weight / 1000 m_BEFK3034 = (Bef5_K(7)) * m_weight / 1000 m_BEFM3539 = (Bef5_M(8)) * m_weight / 1000 m_BEFK3539 = (Bef5_K(8)) * m_weight / 1000 m_BEFM4044 = (Bef5_M(9)) * m_weight / 1000 m_BEFK4044 = (Bef5_K(9)) * m_weight / 1000 m_BEFM4549 = (Bef5_M(10)) * m_weight / 1000 m_BEFK4549 = (Bef5_K(10)) * m_weight / 1000 m_BEFM5054 = (Bef5_M(11)) * m_weight / 1000 m_BEFK5054 = (Bef5_K(11)) * m_weight / 1000 m_BEFM5559 = (Bef5_M(12)) * m_weight / 1000 m_BEFK5559 = (Bef5_K(12)) * m_weight / 1000 m_BEFM6064 = (Bef5_M(13)) * m_weight / 1000 m_BEFK6064 = (Bef5_K(13)) * m_weight / 1000 m_BEFM6569 = (Bef5_M(14)) * m_weight / 1000 m_BEFK6569 = (Bef5_K(14)) * m_weight / 1000 m_BEFM7074 = (Bef5_M(15)) * m_weight / 1000 m_BEFK7074 = (Bef5_K(15)) * m_weight / 1000 m_BEFM1664 = m_BEFM1664 * m_weight / 1000 m_BEFK1664 = m_BEFK1664 * m_weight / 1000 m_BEFM65WW = m_BEFM65WW * m_weight / 1000 m_BEFK65WW = m_BEFK65WW * m_weight / 1000 '!-- Effective retirement age. (Ministry of Health and Social affairs definition) For i = 1 To 6 p(i) = AK5(i + 9) / Bef5(i + 9) Next m_pensage = ((p(1) - p(2)) * 50 + (p(2) - p(3)) * 55 + (p(3) - p(4)) * 60 + _ (p(4) - p(5)) * 65 + (p(5) - p(6)) * 70 + p(6) * 72) / p(1) '-- Labour market macro variables with labour market survey (AKU) definitions '-- Reading data from assumptions file akbef1664_p = parm_macro(maxyear, 16) / 100 al1664_p = parm_macro(maxyear, 17) / 100 aptot_p = parm_macro(maxyear, 18) / 100 apsys_p = parm_macro(maxyear, 19) / 100 ' Fix if data is missing ' If akbef1664_p = 0 Then akbef1664_p = 0.78 ' If al1664_p = 0 Then al1664_p = 0.04 ' If aptot_p = 0 Then aptot_p = 0.02 ' If apsys_p = 0 Then apsys_p = 0.004 If (al1664_p + aptot_p) > 0 Then m_AAL1664 = ((al1664_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000 m_AAPTOT = ((aptot_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000 m_AAPSYS = ((apsys_p / (al1664_p + aptot_p)) * status(6)) * m_weight / 1000 End If m_ASY1664 = (status(5) + status(8) - (AK5(14) + AK5(15))) * (m_weight / 1000) + m_AAPSYS m_AAK1664 = m_ASY1664 + m_AAL1664 '-- Reguljär sysselsättning 20-64 enligt målet m_ASY2064R = 0 For i = 1 To m_icount If i_age(i) >= 20 And i_age(i) < 65 And (i_status(i) = 5 Or i_status(i) = 8) Then m_ASY2064R = m_ASY2064R + 1 End If Next m_ASY2064R = m_ASY2064R * (m_weight / 1000) '-- Summering av stockar - sum of pension assets ' -- Public premium pension fund - Premiepensionsfonder m_ap_ppfond = (m_ap_ppfond * (1 + (m_shares_return / 100)) * (1 - m_favg_pp)) + _ (((L_SUMVEC(i_pr_pp(1), m_icount) * m_weight) - m_ap_pp_ut) * (1 + (m_interest_short / 100) / 2)) ' -- Occupational pension funds - Avtalspensionsfonder m_op_fond = (m_op_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _ ((L_SUMVEC(i_pr_op_ap(1), m_icount) - L_SUMVEC(i_op_ap_dc(1), m_icount) + _ L_SUMVEC(i_pr_op_tp(1), m_icount) - L_SUMVEC(i_op_ap_tp(1), m_icount)) * _ (1 + (m_interest_short * (1 - 0.15) / 100) / 2) * m_weight) ' -- Private tax deductible pension saving funds - Privat pensionssparande ' Note: 15 % tax (avkastningskatt) on return of pension capital (15% av statslåneräntan egentligen) m_pp_fond = (m_pp_fond * (1 + (m_shares_return / 100)) * (1 - ((m_interest_long / 100) * 0.15))) + _ ((L_SUMVEC(i_wealth_pension_year(1), m_icount) - L_SUMVEC(i_pp(1), m_icount)) * _ (1 + ((m_interest_short * (1 - 0.15)) / 100) / 2) * m_weight) '-- Summering av pensionsutgifter från AP-systemet ' If year >= 2003 Then ' m_ap_ip_ut = (L_SUMVEC(i_ap_ip(1), m_icount) * m_weight) _ ' + (0.5 * m_ap_ip_dead) ' End If '-- BNP etc m_bnpaf = parm_macro(maxyear, 22) m_bnpal = parm_macro(maxyear, 21) End Sub
Sub Print_Pension_Cohort() '-- Printing of cohort data for pensions ' age sex abroad variable Dim pens(0 To 106, 2, 2, 15) As Double, pens_n(0 To 106, 2, 2, 15) As Double Dim age As Integer, i As Long, utvar As String Dim A As Integer, s As Integer, v As Integer, u As Integer '-- Summing up For i = 1 To m_icount age = mini(i_age(i), 106) '-- 1 PGI, 2 PGB, 3 PU, 4 PR_IP, 5 PB_IP, 6 AP_AP, 7 AP_TP, 8 AP_IP, ' 9 AP_GP, 10 PR_PP, 11 PB_PP, 12 AP_PP, 13 AP_AVG_AP '-- 1 I_PGI pens(age, i_sex(i), i_abroad(i) + 1, 1) = pens(age, i_sex(i), _ i_abroad(i) + 1, 1) + (i_pgi(i) * m_weight / 1000000) If i_pgi(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 1) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 1) + m_weight End If '-- 2 I_PGB pens(age, i_sex(i), i_abroad(i) + 1, 2) = pens(age, i_sex(i), _ i_abroad(i) + 1, 2) + (i_pgb(i) * m_weight / 1000000) If i_pgb(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 2) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 2) + m_weight End If '-- 3 I_PU pens(age, i_sex(i), i_abroad(i) + 1, 3) = pens(age, i_sex(i), _ i_abroad(i) + 1, 3) + (i_pu(i) * m_weight / 1000000) If i_pu(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 3) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 3) + m_weight End If '-- 4 I_PR_IP pens(age, i_sex(i), i_abroad(i) + 1, 4) = pens(age, i_sex(i), _ i_abroad(i) + 1, 4) + (i_pr_ip(i) * m_weight / 1000000) If i_pr_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 4) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 4) + m_weight End If '-- 5 I_PB_IP pens(age, i_sex(i), i_abroad(i) + 1, 5) = pens(age, i_sex(i), _ i_abroad(i) + 1, 5) + (i_pb_ip(i) * m_weight / 1000000) If i_pb_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 5) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 5) + m_weight End If '-- 6 I_AP_AP pens(age, i_sex(i), i_abroad(i) + 1, 6) = pens(age, i_sex(i), _ i_abroad(i) + 1, 6) + (i_ap_ap(i) * m_weight / 1000000) If i_ap_ap(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 6) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 6) + m_weight End If '-- 7 I_AP_TP pens(age, i_sex(i), i_abroad(i) + 1, 7) = pens(age, i_sex(i), _ i_abroad(i) + 1, 7) + (i_ap_tp(i) * m_weight / 1000000) If i_ap_tp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 7) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 7) + m_weight End If '-- 8 I_AP_IP pens(age, i_sex(i), i_abroad(i) + 1, 8) = pens(age, i_sex(i), _ i_abroad(i) + 1, 8) + (i_ap_ip(i) * m_weight / 1000000) If i_ap_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 8) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 8) + m_weight End If '-- 9 I_AP_GP pens(age, i_sex(i), i_abroad(i) + 1, 9) = pens(age, i_sex(i), _ i_abroad(i) + 1, 9) + (i_ap_gp(i) * m_weight / 1000000) If i_ap_gp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 9) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 9) + m_weight End If '-- 10 I_PR_PP pens(age, i_sex(i), i_abroad(i) + 1, 10) = pens(age, i_sex(i), _ i_abroad(i) + 1, 10) + (i_pr_pp(i) * m_weight / 1000000) If i_pr_pp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 10) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 10) + m_weight End If '-- 11 I_PB_PP pens(age, i_sex(i), i_abroad(i) + 1, 11) = pens(age, i_sex(i), _ i_abroad(i) + 1, 11) + (i_pb_pp(i) * m_weight / 1000000) If i_pb_pp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 11) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 11) + m_weight End If '-- 12 I_AP_PP pens(age, i_sex(i), i_abroad(i) + 1, 12) = pens(age, i_sex(i), _ i_abroad(i) + 1, 12) + (i_ap_pp(i) * m_weight / 1000000) If i_ap_pp(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 12) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 12) + m_weight End If '-- 13 I_AVG_IP pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _ i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000) If i_avg_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight End If '-- 13 I_AVG_IP pens(age, i_sex(i), i_abroad(i) + 1, 13) = pens(age, i_sex(i), _ i_abroad(i) + 1, 13) + (i_avg_ip(i) * m_weight / 1000000) If i_avg_ip(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 13) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 13) + m_weight End If '-- 14 I_PR_IP1 pens(age, i_sex(i), i_abroad(i) + 1, 14) = pens(age, i_sex(i), _ i_abroad(i) + 1, 14) + (i_pr_ip1(i) * m_weight / 1000000) If i_pr_ip1(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 14) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 14) + m_weight End If '-- 15 I_PB_IP1 pens(age, i_sex(i), i_abroad(i) + 1, 15) = pens(age, i_sex(i), _ i_abroad(i) + 1, 15) + (i_pb_ip1(i) * m_weight / 1000000) If i_pb_ip1(i) > 0 Then pens_n(age, i_sex(i), i_abroad(i) + 1, 15) = _ pens_n(age, i_sex(i), i_abroad(i) + 1, 15) + m_weight End If Next '-- Printing to file If model_time = 1 Then Open sesimpath & "\tempdata\Pension_Cohort.prn" For Output As #71 utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _ "PGI", "PGB", "PU", "PR_IP", "PB_IP", "AP_AP", "AP_TP", "AP_IP", _ "AP_GP", "PR_PP", "PB_PP", "AP_PP", "AP_AVG_AP", "PR_IP1", "PB_IP1", _ "Arvsv", "ap_favg", "balind", "inkind") Print #71, utvar Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Output As #72 utvar = f_Concat_string_cita("DATE", "AGE", "BORN", "SEX", "ABROAD", _ "PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PB_IP_N", "AP_AP_N", "AP_TP_N", "AP_IP_N", _ "AP_GP_N", "PR_PP_N", "PB_PP_N", "AP_PP_N", "AP_AVG_AP_N""PR_IP1_N", "PB_IP1_N") Print #72, utvar Else Open sesimpath & "\tempdata\Pension_Cohort.prn" For Append As #71 Open sesimpath & "\tempdata\Pension_Cohort_n.prn" For Append As #72 End If For A = 0 To 106 For s = 1 To 2 For u = 1 To 2 utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _ pens(A, s, u, 1), pens(A, s, u, 2), pens(A, s, u, 3), pens(A, s, u, 4), _ pens(A, s, u, 5), pens(A, s, u, 6), pens(A, s, u, 7), pens(A, s, u, 8), _ pens(A, s, u, 9), pens(A, s, u, 10), pens(A, s, u, 11), pens(A, s, u, 12), _ pens(A, s, u, 13), pens(A, s, u, 14), pens(A, s, u, 15), _ Arvsvinstfaktor(A), m_favg_ip, m_ap_balind, m_ap_inkind) Print #71, utvar utvar = f_Concat_string_space(year & "01", A, year - A, s, u - 1, _ pens_n(A, s, u, 1), pens_n(A, s, u, 2), pens_n(A, s, u, 3), pens_n(A, s, u, 4), _ pens_n(A, s, u, 5), pens_n(A, s, u, 6), pens_n(A, s, u, 7), pens_n(A, s, u, 8), _ pens_n(A, s, u, 9), pens_n(A, s, u, 10), pens_n(A, s, u, 11), pens_n(A, s, u, 12), _ pens_n(A, s, u, 13), pens_n(A, s, u, 14), pens_n(A, s, u, 15)) Print #72, utvar Next u Next s Next A Close #71 Close #72 End Sub
Sub Print_Pensions_Macro() '!-- Optional printing of macro variables to Aremos-format status "Printing macro variables to Aremos-format" Dim utvar As String Dim demofile As Integer Dim i As Long, h As Long, wm As Double, wk As Double year = model_time + base_year wm = m_weight / 1000000 wk = m_weight / 1000 '-- Some variables for EU AWG04-calculations that requires nested conditions ' Scaling when printing Dim ap_ut As Double, ovr_pens As Double, ovr_pens_n As Long Dim ap_inc_ut As Double, ap_inc_off_ut As Double, pr_op As Double, avg_off As Double Dim ap_ut_n As Long, pens_n As Long, pens_54_n As Long, pens55_59_n As Long, pens60_64_n As Long, pens65_n As Long Dim ap_inc_ut_n As Long, ap_inc_off_ut_n As Long, pr_op_n As Long, avg_off_n As Long Dim afs As Double, afs_n As Long, inc_taxable_2 As Double, tax_income_2 As Double Dim op_off As Double, op_off_n As Long, op_65 As Double, surv_65 As Double For i = 1 To m_icount If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i)) > 0 Then ap_ut = ap_ut + (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i)) ap_ut_n = ap_ut_n + 1 End If If (i_ap_ap(i) + i_ap_pp_ut(i)) > 0 Then ap_inc_ut = ap_inc_ut + (i_ap_ap(i) + i_ap_pp_ut(i)) ap_inc_ut_n = ap_inc_ut_n + 1 If (i_sector(i) = 3 Or i_sector(i) = 4) Then ap_inc_off_ut = ap_inc_off_ut + (i_ap_ap(i) + i_ap_pp_ut(i)) ap_inc_off_ut_n = ap_inc_off_ut_n + 1 End If End If If (i_ftp(i) + i_surv(i)) > 0 Then ovr_pens = ovr_pens + i_ftp(i) + i_surv(i) ovr_pens_n = ovr_pens_n + 1 End If If (i_ap_ap(i) + i_ap_pp_ut(i) + i_ap_gp(i) + i_ftp(i) + i_surv(i) + i_op(i)) > 0 Then pens_n = pens_n + 1 Select Case i_age(i) Case Is < 54 pens_54_n = pens_54_n + 1 Case Is < 59 pens55_59_n = pens55_59_n + 1 Case Is < 64 pens60_64_n = pens60_64_n + 1 Case Else pens65_n = pens65_n + 1 End Select End If If (i_sector(i) = 3 Or i_sector(i) = 4) And i_avg(i) > 0 Then avg_off = avg_off + i_avg(i) avg_off_n = avg_off_n + 1 End If If (i_sector(i) = 3 Or i_sector(i) = 4) Then op_off = op_off + i_op(i) op_off_n = op_off_n + 1 End If If (i_pr_op_ap(i) + i_pr_op_tp(i)) > 0 Then pr_op = pr_op + i_pr_op_ap(i) + i_pr_op_tp(i) pr_op_n = pr_op_n + 1 End If If i_age(i) > 64 Then surv_65 = surv_65 + i_surv(i) op_65 = op_65 + i_op(i) End If If i_status(i) = 2 Then inc_taxable_2 = inc_taxable_2 + i_inc_taxable(i) tax_income_2 = tax_income_2 + i_tax_income(i) End If Next For h = 1 To m_hcount If h_max_age(h) > 64 Then afs = afs + h_trf_socialassistance(h) afs_n = afs_n + 1 End If Next If model_time = 0 Then Open sesimpath & "\tempdata\Labour_macro.prn" For Output As #41 utvar = f_Concat_string_cita("DATE", "AKT1664", "BEFM1664", "BEFK1664", _ "AKM1619", "AKM2024", "AKM2529", "AKM3034", "AKM3539", "AKM4044", "AKM4549", _ "AKM5054", "AKM5559", "AKM6064", "AKM6569", "AKM7074", _ "AKK1619", "AKK2024", "AKK2529", "AKK3034", "AKK3539", "AKK4044", "AKK4549", _ "AKK5054", "AKK5559", "AKK6064", "AKK6569", "AKM7074", _ "BEFM1619", "BEFM2024", "BEFM2529", "BEFM3034", "BEFM3539", "BEFM4044", "BEFM4549", _ "BEFM5054", "BEFM5559", "BEFM6064", "BEFM6569", "BEFM7074", _ "BEFK1619", "BEFK2024", "BEFK2529", "BEFK3034", "BEFK3539", "BEFK4044", "BEFK4549", _ "BEFK5054", "BEFK5559", "BEFK6064", "BEFK6569", "BEFM7074", _ "BEFM0015", "BEFK0015", "BEFM65WW", "BEFK65WW", _ "BEFM0014", "BEFK0014", "BEFM1519", "BEFK1519", _ "AAL1664", "AAPTOT", "AAPSYS", "ASY1664", "AAK1664", "ASY2064R", _ "ALM1619", "ALM2024", "ALM2529", "ALM3034", "ALM3539", "ALM4044", "ALM4549", _ "ALM5054", "ALM5559", "ALM6064", "ALM6569", "ALM7074", _ "ALK1619", "ALK2024", "ALK2529", "ALK3034", "ALK3539", "ALK4044", "ALK4549", _ "ALK5054", "ALK5559", "ALK6064", "ALK6569", "ALM7074") Print #41, utvar Open sesimpath & "\tempdata\Pensions_macro.prn" For Output As #42 utvar = f_Concat_string_cita("DATE", _ "INC_TAX", "PGI", "PGB", "PU", "PR_IP", "PR_PP", "PB_IP", "PB_PP", "FP", "ATP", "AP", _ "AP_IP", "AP_PP", "AP_GP", "AP_TP", "OP", "SURV", "FTP", "AVG_IP", "AVG", "INC_WORK", _ "INC_EARN", "INC_MARK", _ "RWAGE", "RWAGE_99", "INFLATION", "PRICE_99", "BASB", _ "BASB_F", "BASB_INC", "INKIND", "BALIND", "Int_short", "Int_long", _ "PENSAGE", "DTALIP_65", "DTALPP_65", "ARVSV_60", "Shares_Return", "PP", _ "AP_GP_EJ_AP", "AP_AP_SV", "AP_AP_UTL", "pgi_bas", "pgi_bas_gt", _ "PR_IP1", "PR_PP1", _ "AP_IP_UT", "AP_TP_UT", "AP_ATP_UT", "AP_FP30_UT", "AP_PP_UT", "EXPLIFE65", _ "PP_fund", "PP_save", "SURV55", "FTP55") Print #42, utvar Open sesimpath & "\tempdata\Pensions_count.prn" For Output As #43 utvar = f_Concat_string_cita("DATE", _ "INC_TAX_N", "PGI_N", "PGB_N", "PU_N", "PR_IP_N", "PR_PP_N", "PB_IP_N", "PB_PP_N", _ "FP_N", "ATP_N", "AP_N", "AP_IP_N", "AP_PP_N", "AP_GP_N", "AP_TP_N", "OP_N", _ "SURV_N", "FTP_N", "AVG_IP_N", "AVG_N", "INC_WORK_N", "INC_EARN_N", "INC_MARK_N", "PP_N", _ "AP_GP_EJ_AP_N", "AP_AP_NSV", "AP_AP_NUTL", "pgi_bas_n", "pgi_bas_gt_n", "PP_fund_n", "PP_save_n", _ "SURV55_N", "FTP55_N") Print #43, utvar Open sesimpath & "\tempdata\Transfers_macro.prn" For Output As #44 utvar = f_Concat_string_cita("DATE", "STSHPEAVT", "STKHPEAVT", "ap", "ap_atp", _ "ap_tp", "ap_ip", "ap_pp", "ap_gp", "ap_fp", "STSHFORT", "STSHEFTANK", "STSHEFTBARN", _ "STSHBTP", "STSHSJUK", "STSHFORF", "STSHARBSK", "unemployed", "STSHBARN", _ "study", "STSHSTUDMED", "Study_loan", "STSHBOBI", _ "bidfor_brutto", "STKHSOCBI", "PGI_BAS", "BNPAF", "BNPAL", "STSHBTP_65") Print #44, utvar Open sesimpath & "\tempdata\ftp_macro.prn" For Output As #45 utvar = f_Concat_string_cita("DATE", "ap_ut", "ap_inc_ut", "ap_inc_off_ut", _ "ovr_pens", "avg_off", "pr_op", "ap_ut_n", "ap_inc_ut_n", "ap_inc_off_ut_n", "ovr_pens_n", _ "pens_n", "pens_54_n", "pens55_59_n", "pens60_64_n", "pens65_n", "avg_off_n", "pr_op_n", _ "AFS", "AFS_n", "inc_taxable_2", "tax_income_2", "ap_ppfond", "pp_fond", "op_fond", _ "op_off", "op_off_n", "surv_65", "op_65", _ "PR_IP_4", "PR_PP_4", "AP_IP_UT_4", "AP_TP_UT_4", "AP_PP_UT_4", "AP_4", "AP_AP_4", _ "AP_GP_4", "STSHBTP_4", "FTP_INK", "FTP_GAR", "FTP_JUST", _ "PR_IP_4_n", "PR_PP_4_n", "AP_IP_UT_4_n", "AP_TP_UT_4_n", "AP_PP_UT_4_n", "AP_4_n", "AP_AP_4_n", _ "AP_GP_4_n", "STSHBTP_4_n", "FTP_INK_n", "FTP_GAR_n", "FTP_JUST_n", _ "INC_TAX_4", "INC_TAX_4_N") ', "DISP2", "DISP4", "DISP2_4", "DISP") Print #45, utvar Else Open sesimpath & "\tempdata\Labour_macro.prn" For Append As #41 Open sesimpath & "\tempdata\Pensions_macro.prn" For Append As #42 Open sesimpath & "\tempdata\Pensions_count.prn" For Append As #43 Open sesimpath & "\tempdata\Transfers_macro.prn" For Append As #44 Open sesimpath & "\tempdata\ftp_macro.prn" For Append As #45 End If utvar = f_Concat_string_space(year & "01", m_AKT1664, m_BEFM1664, m_BEFK1664, _ m_AKM1619, m_AKM2024, m_AKM2529, m_AKM3034, m_AKM3539, m_AKM4044, m_AKM4549, _ m_AKM5054, m_AKM5559, m_AKM6064, m_AKM6569, m_AKM7074, _ m_AKK1619, m_AKK2024, m_AKK2529, m_AKK3034, m_AKK3539, m_AKK4044, m_AKK4549, _ m_AKK5054, m_AKK5559, m_AKK6064, m_AKK6569, m_AKM7074, _ m_BEFM1619, m_BEFM2024, m_BEFM2529, m_BEFM3034, m_BEFM3539, m_BEFM4044, m_BEFM4549, _ m_BEFM5054, m_BEFM5559, m_BEFM6064, m_BEFM6569, m_BEFM7074, _ m_BEFK1619, m_BEFK2024, m_BEFK2529, m_BEFK3034, m_BEFK3539, m_BEFK4044, m_BEFK4549, _ m_BEFK5054, m_BEFK5559, m_BEFK6064, m_BEFK6569, m_BEFM7074, _ m_BEFM0015, m_BEFK0015, m_BEFM65WW, m_BEFK65WW, _ m_BEFM0014, m_BEFK0014, m_BEFM1519, m_BEFK1519, _ m_AAL1664, m_AAPTOT, m_AAPSYS, m_ASY1664, m_AAK1664, m_ASY2064R, _ m_ALM1619, m_ALM2024, m_ALM2529, m_ALM3034, m_ALM3539, m_ALM4044, m_ALM4549, _ m_ALM5054, m_ALM5559, m_ALM6064, m_ALM6569, m_ALM7074, _ m_ALK1619, m_ALK2024, m_ALK2529, m_ALK3034, m_ALK3539, m_ALK4044, m_ALK4549, _ m_ALK5054, m_ALK5559, m_ALK6064, m_ALK6569, m_ALK7074) Print #41, utvar Close #41 utvar = f_Concat_string_space(year & "01", _ (L_SUMVEC(i_inc_taxable(1), m_icount) * wm), (L_SUMVEC(i_pgi(1), m_icount) * wm), _ (L_SUMVEC(i_pgb(1), m_icount) * wm), (L_SUMVEC(i_pu(1), m_icount) * wm), _ (L_SUMVEC(i_pr_ip(1), m_icount) * wm), (L_SUMVEC(i_pr_pp(1), m_icount) * wm), _ (L_SUMVEC(i_pb_ip(1), m_icount) * wm), (L_SUMVEC(i_pb_pp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _ (L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _ (L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_op(1), m_icount) * wm), _ (L_SUMVEC(i_surv(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _ (L_SUMVEC(i_avg_ip(1), m_icount) * wm), (L_SUMVEC(i_avg(1), m_icount) * wm), _ (L_SUMVEC(i_inc_work(1), m_icount) * wm), _ (L_SUMVEC(i_inc_earning(1), m_icount) * wm), (L_SUMVEC(i_inc_market(1), m_icount) * wm), _ m_realwage, m_realwage_change99, m_inflation, m_price_change99, m_basbelopp, _ m_basbelopp_f, m_basbelopp_income, m_ap_inkind, m_ap_balind, m_interest_short, m_interest_long, _ m_pensage, m_dtalip_65, m_dtalpp_65, m_arvsvinst_60, m_shares_return, (L_SUMVEC(i_pp(1), m_icount) * wm), _ (sumif(i_ap_gp, i_ap_ap, "EQ", 0) * wm), (sumif(i_ap_ap, i_abroad, "EQ", 0) * wm), _ (sumif(i_ap_ap, i_abroad, "EQ", 1) * wm), m_pgi_bas / 1000000, m_pgi_bas_gt_basb / 1000000, _ (L_SUMVEC(i_pr_ip1(1), m_icount) * wm), (L_SUMVEC(i_pr_pp1(1), m_icount) * wm), _ m_ap_ip_ut / 1000000, m_ap_tp_ut / 1000000, m_ap_atp_ut / 1000000, _ m_ap_fp30_ut / 1000000, m_ap_pp_ut / 1000000, explife(65), _ (L_SUMVEC(i_wealth_pension_total(1), m_icount) * wm), (L_SUMVEC(i_wealth_pension_year(1), m_icount) * wm), _ (sumif(i_surv, i_age, "GT", 54) * wm), (sumif(i_ftp, i_age, "GT", 54) * wm)) Print #42, utvar Close #42 utvar = f_Concat_string_space(year & "01", _ cnt0(i_inc_taxable) * wk, cnt0(i_pgi) * wk, _ cnt0(i_pgb) * wk, cnt0(i_pu) * wk, _ cnt0(i_pr_ip) * wk, cnt0(i_pr_pp) * wk, _ cnt0(i_pb_ip) * wk, cnt0(i_pb_pp) * wk, _ cnt0(i_ap_fp) * wk, cnt0(i_ap_atp) * wk, _ cnt0(i_ap) * wk, cnt0(i_ap_ip) * wk, _ cnt0(i_ap_pp) * wk, cnt0(i_ap_gp) * wk, _ cnt0(i_ap_tp) * wk, cnt0(i_op) * wk, _ cnt0(i_surv) * wk, cnt0(i_ftp) * wk, _ cnt0(i_avg_ip) * wk, cnt0(i_avg) * wk, _ cnt0(i_inc_work) * wk, _ cnt0(i_inc_earning) * wk, cnt0(i_inc_market) * wk, _ cnt0(i_pp) * wk, _ cntstatusif(i_ap_gp, i_ap_ap, "EQ", 0, 2) * wk, _ cntstatusif(i_ap_ap, i_abroad, "EQ", 0, 2) * wk, _ cntstatusif(i_ap_ap, i_abroad, "EQ", 1, 2) * wk, _ m_pgi_bas_n, m_pgi_bas_gt_basb_n, _ cnt0(i_wealth_pension_total) * wk, cnt0(i_wealth_pension_year) * wk, _ (cntif(i_surv, i_age, "GT", 54) * wm), (cntif(i_ftp, i_age, "GT", 54) * wm)) Print #43, utvar Close #43 utvar = f_Concat_string_space(year & "01", _ (sumif(i_op, i_sector, "EQ", 3) * wm), (sumif(i_op, i_sector, "EQ", 4) * wm), _ (L_SUMVEC(i_ap(1), m_icount) * wm), (L_SUMVEC(i_ap_atp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_tp(1), m_icount) * wm), (L_SUMVEC(i_ap_ip(1), m_icount) * wm), _ (L_SUMVEC(i_ap_pp(1), m_icount) * wm), (L_SUMVEC(i_ap_gp(1), m_icount) * wm), _ (L_SUMVEC(i_ap_fp(1), m_icount) * wm), (L_SUMVEC(i_ftp(1), m_icount) * wm), _ (sumif(i_surv, i_age, "GT", 17) * wm), (sumif(i_surv, i_age, "LT", 18) * wm), _ (L_SUMVEC(h_trf_btp(1), m_hcount) * wm), (L_SUMVEC(i_trf_sickleave(1), m_icount) * wm), _ (L_SUMVEC(i_trf_parentleave(1), m_icount) * wm), (L_SUMVEC(i_trf_skada(1), m_icount) * wm), _ (L_SUMVEC(i_trf_unemployed(1), m_icount) * wm), (L_SUMVEC(h_trf_childallowance(1), m_hcount) * wm), _ (L_SUMVEC(i_trf_study(1), m_icount) * wm), (L_SUMVEC(i_trf_study_grant(1), m_icount) * wm), _ (L_SUMVEC(i_trf_study_loan(1), m_icount) * wm), (L_SUMVEC(h_trf_housingallowance(1), m_hcount) * wm), _ (L_SUMVEC(h_maintenance_received(1), m_hcount) * wm), (L_SUMVEC(h_trf_socialassistance(1), m_hcount) * wm), _ (L_SUMVEC(i_pgi_bas(1), m_icount) * wm), m_bnpaf, m_bnpal, (sumif(h_trf_btp, i_age, "GT", 64) * wm)) Print #44, utvar Close #44 utvar = f_Concat_string_space(year & "01", _ ap_ut * wm, ap_inc_ut * wm, ap_inc_off_ut * wm, ovr_pens * wm, avg_off * wm, pr_op * wm, _ ap_ut_n * wk, ap_inc_ut_n * wk, ap_inc_off_ut_n * wk, ovr_pens_n * wk, _ pens_n * wk, pens_54_n * wk, pens55_59_n * wk, pens60_64_n * wk, pens65_n * wk, _ avg_off_n * wk, pr_op_n * wk, afs * wm, afs_n * wk, inc_taxable_2 * wm, tax_income_2 * wm, _ m_ap_ppfond / 1000000, m_pp_fond / 1000000, m_op_fond / 1000000, op_off * wm, op_off_n * wk, _ surv_65 * wk, op_65 * wk, _ sumif(i_pr_ip, i_status, "EQ", 4) * wm, sumif(i_pr_pp, i_status, "EQ", 4) * wm, _ sumif(i_ap_ip_ut, i_ftp_64, "EQ", 1) * wm, sumif(i_ap_tp_ut, i_ftp_64, "EQ", 1) * wm, _ sumif(i_ap_pp_ut, i_ftp_64, "EQ", 1) * wm, sumif(i_ap, i_ftp_64, "EQ", 1) * wm, _ sumif(i_ap_ap, i_ftp_64, "EQ", 1) * wm, sumif(i_ap_gp, i_ftp_64, "EQ", 1) * wm, _ sumif(h_trf_btp, i_ftp_64, "EQ", 1) * wm, sum(i_ftp_ink), sum(i_ftp_gar), sum(i_ftp_just), _ cntif(i_pr_ip, i_status, "EQ", 4) * wk, cntif(i_pr_pp, i_status, "EQ", 4) * wk, _ cntif(i_ap_ip_ut, i_ftp_64, "EQ", 1) * wk, cntif(i_ap_tp_ut, i_ftp_64, "EQ", 1) * wk, _ cntif(i_ap_pp_ut, i_ftp_64, "EQ", 1) * wk, cntif(i_ap, i_ftp_64, "EQ", 1) * wk, _ cntif(i_ap_ap, i_ftp_64, "EQ", 1) * wk, cntif(i_ap_gp, i_ftp_64, "EQ", 1) * wk, _ cntif(h_trf_btp, i_ftp_64, "EQ", 1) * wk, cnt0(i_ftp_ink) * wk, cnt0(i_ftp_gar) * wk, _ cnt0(i_ftp_just) * wk, _ sumif(i_inc_taxable, i_status, "EQ", 4) * wm, cntif(i_inc_taxable, i_status, "EQ", 4) * wk) ', DISP2 * wm, DISP4 * wm, DISP2_4 * wm, sum(h_inc_disposable) * wm) Print #45, utvar Close #45 End Sub
'-- Counts element i vector not equal 0
Public Function cnt0(x) As Long Dim i As Long cnt0 = 0 For i = 1 To UBound(x) If x(i) <> 0 Then cnt0 = cnt0 + 1 End If Next End Function
'-- Count number of persons in a status conditioned on an other vector
Public Function cntstatusif(x, ifvar, ifop, ifval, status) As Long Dim i As Long cntstatusif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) = ifval And i_status(i) = status Then cntstatusif = cntstatusif + 1 End If Next Case "GT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) > ifval And i_status(i) = status Then cntstatusif = cntstatusif + 1 End If Next Case "LT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) < ifval And i_status(i) = status Then cntstatusif = cntstatusif + 1 End If Next End Select End Function
'-- Sum of vector conditioned on status and an other vector
Public Function sumstatusif(x, ifvar, ifop, ifval, status) As Long Dim i As Long sumstatusif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) = ifval And i_status(i) = status Then sumstatusif = sumstatusif + x(i) End If Next Case "GT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) > ifval And i_status(i) = status Then sumstatusif = sumstatusif + x(i) End If Next Case "LT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) < ifval And i_status(i) = status Then sumstatusif = sumstatusif + x(i) End If Next End Select End Function
'-- Sum of vector conditioned on an other vector
Public Function sumif(x, ifvar, ifop, ifval) As Double Dim i As Long sumif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If ifvar(i) = ifval Then sumif = sumif + x(i) End If Next Case "GT" For i = 1 To UBound(x) If ifvar(i) > ifval Then sumif = sumif + x(i) End If Next Case "LT" For i = 1 To UBound(x) If ifvar(i) < ifval Then sumif = sumif + x(i) End If Next Case "NE" For i = 1 To UBound(x) If ifvar(i) <> ifval Then sumif = sumif + x(i) End If Next End Select End Function
'-- Sum of vector
Public Function sum(x) As Double Dim i As Long sum = 0 For i = 1 To UBound(x) sum = sum + x(i) Next End Function
Public Function f_m_ap_pensage() As Double Dim n As Long, i As Long n = 1 For i = 1 To m_icount If i_status(i) = 2 And i_status1(i) <> 2 Then f_m_ap_pensage = f_m_ap_pensage + i_ap_pensmonth(i) n = n + 1 End If Next f_m_ap_pensage = Int(f_m_ap_pensage / 12) / n + 65 End Function
'-- Count number of persons conditioned on an other vector
Public Function cntif(x, ifvar, ifop, ifval) As Long Dim i As Long cntif = 0 Select Case ifop Case "EQ" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) = ifval Then cntif = cntif + 1 End If Next Case "GT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) > ifval Then cntif = cntif + 1 End If Next Case "LT" For i = 1 To UBound(x) If x(i) <> 0 And ifvar(i) < ifval Then cntif = cntif + 1 End If Next End Select End Function
Sub Print_elderly_care_micro() '!-- Optional printing of data for analysis of elderly care(micro data) status "Printing elderly care micro file" Dim utvar As String Dim demofile As Integer Dim i As Long, h As Long year = model_time + base_year If year = 1999 Then Open sesimpath & "\tempdata\i_elderly_micro.txt" For Output As #33 utvar = f_Concat_string_comma("i", "bidnr", "i_indnr", "year", "i_hhnr", _ "i_age", "i_sex", "i_civ_stat", "i_abroad", "i_status", _ "i_edlevel", "i_born_year ", _ "i_inc_taxable", "i_inc_capital", "i_pc_elderly", "m_basbelopp", "m_basbelopp_income") Print #33, utvar Close #33 Open sesimpath & "\tempdata\h_elderly_micro.txt" For Output As #34 utvar = f_Concat_string_comma("h", "year", "h_hhnr", "h_size", "h_max_age", _ "h_inc_disposable", "h_wealth_financial", "h_wealth_real", _ "h_n_child", "h_n_adults", "h_house_cost") Print #34, utvar Close #34 End If If year = 1999 Or year = 2003 Or year = 2015 Or year = 2025 Then Open sesimpath & "\tempdata\i_elderly_micro.txt" For Append As #33 For i = 1 To m_icount utvar = f_Concat_string_comma(i, i_bidnr(i), i_indnr(i), year, i_hhnr(i), _ i_age(i), i_sex(i), i_civ_stat(i), i_abroad(i), i_status(i), _ i_edlevel(i), i_born_year(i), _ i_inc_taxable(i), i_inc_capital(i), i_pc_elderly(i), m_basbelopp, m_basbelopp_income) Print #33, utvar Next i Close #33 Open sesimpath & "\tempdata\h_elderly_micro.txt" For Append As #34 For h = 1 To m_hcount utvar = f_Concat_string_comma(h, year, h_hhnr(h), h_size(h), h_max_age(h), _ h_inc_disposable(h), h_wealth_financial(h), h_wealth_real(h), _ h_n_child(h), h_n_adults(h), h_house_cost(h)) Print #34, utvar Next h Close #34 End If 'year End Sub
#End If ' Compilation of standard version