Attribute VB_Name = "c00_Init"
Option Explicit
Public init_done As Integer



Public Sub Initsesim()
  
   Printdok "Initsesim"
   
   Dim i As Long
   
   Call check_new_base_data
         
   '-- Randomized checkbox marked
   If controlcenter.chkRandomize.value = 1 Then
        Randomize
        ' Flag. 0=same random seed. 1=different seed.
        random = 1
        Printdok ("Randomized: New random number seed generated")
   End If
     
  ' Flag. 0=same random seed. 1=different seed.
'  random = 0
  ' Reset random numbers
  If random = 0 Then
    Rnd (-1)
    'Randomize maxi(0, model_time)
    Randomize base_year
  End If
  
  For i = 1 To m_icount
    Call zero_i(i)
  Next
  For i = 1 To m_hcount
    Call zero_h(i)
  Next
  Call zero_m

  ' Delete old binary files
  If Dir(sesimpath & "\microdata\*.out") <> "" Then
    status "Deleting temporary files"
    Kill sesimpath & "\microdata\*.out"
  End If
  If Dir(sesimpath & "\microdata\*.sas") <> "" Then
    Kill sesimpath & "\microdata\*.sas"
  End If
  If Dir(sesimpath & "\microdata\*.mdb") <> "" Then
    Kill sesimpath & "\microdata\*.mdb"
  End If
  If Dir(sesimpath & "\microdata\*.ldb") <> "" Then
    Kill sesimpath & "\microdata\*.ldb"
  End If
  If Dir(sesimpath & "\tempdata\*.mdb") <> "" Then
    Kill sesimpath & "\tempdata\*.mdb"
  End If
  If Dir(sesimpath & "\tempdata\*.ldb") <> "" Then
    Kill sesimpath & "\tempdata\*.ldb"
  End If
    
  ' Reading variables from controlcenter form
  ' Weight
  m_weight = controlcenter.txtWeight
  Printdok ("Sample weight = " & m_weight & _
        " Percent of sample = " & controlcenter.txtPercentofsample.text)
  ' -- Pension age
  chkRetire65 = controlcenter.chkRetire65.value
  txtRetire = CByte(controlcenter.txtRetire.text)
  Printdok ("Exogenous pension = " & chkRetire65 & "  at age " & txtRetire)
  
  status "Reading data"
  Call read_data(-1)
  If m_icount = 0 Or m_hcount = 0 Then
    status "No data!"
    Exit Sub
  End If

  Dim percent_of_sample As Double
  
  If IsNumeric(controlcenter.txtPercentofsample.text) Then
    percent_of_sample = CLng(controlcenter.txtPercentofsample.text)
    If percent_of_sample < 0 Then percent_of_sample = 0
    If percent_of_sample > 100 Then percent_of_sample = 100
  End If
  
  ' Subsampling to obtain percent_of_sample % of the original sample population
  If percent_of_sample < 100 Then
    Dim last_hhnr As Long, first_indnr As Long, last_indnr As Long, m_hcount1 As Long
    
    m_hcount1 = m_hcount
    m_hcount = CLng(percent_of_sample / 100 * m_hcount)
    
    If m_hcount < 1 Then
      m_hcount = 1
      percent_of_sample = 1 / m_hcount1
    End If
    
    Call dyn_vect_h(m_hcount)
    
    ReDim Preserve hhnr2index(1 To m_hcount)
    största_hhnr = m_hcount

    last_hhnr = h_hhnr(m_hcount)
    
    Dim indnr As Long
    indnr = h_first_indnr(hhnr2index(last_hhnr))
    Do Until i_next_indnr(indnr) = 0
      indnr = i_next_indnr(indnr2index(indnr))
    Loop
    
    m_icount = indnr
    Call dyn_vect_i(m_icount)
    ReDim Preserve indnr2index(1 To m_icount)
    största_indnr = m_icount
    
    controlcenter.antalindivider.Caption = m_icount
    controlcenter.antalhushåll.Caption = m_hcount
    controlcenter.antalindivider.Refresh
    controlcenter.antalhushåll.Refresh
    
    m_weight = m_weight * 100 / percent_of_sample
  End If
    
  For i = 0 To controlcenter.chkDataexist.count - 1
    controlcenter.chkDataexist(i).ToolTipText = base_year + i
  Next

  ' Assignment of individual error components or "luck factors" for
  ' the panel data regression models
  
  Dim rand() As Double
  ReDim rand(1 To 2 * m_icount)
  Call RANNOR(2 * m_icount, rand(1), model_time + base_year + random * Rnd)
  
   'Lösning för att generera en slumpvektor för tilldelning av sigma_my(i) _
   vektorn töms när init är färdig. Subrutinen finns i a01_economics_2
   ReDim randomValues(1 To 100000, 1 To 3)
   Call randomnumbers
   
   'Lösning för att fördela individer som i startdata pensionerats före den
   'specificerade pensionsålder på övriga status. FJ 2004-03-02
   
   Dim StatusAtAge61ToX() As Double
   If chkRetire65 = True Then
      StatusAtAge61ToX = f_calc_StatusAtAge61ToX(txtRetire)  'Generera fördelningen
   End If
  '-- Runtime option: Don't reactivate already retired in startdata
  Dim set_StatusAtAge61ToX_Off As Byte
  Call read_MY_parametrar
  If get_scalefactor_active("Reactivate_Off") = 1 Then
        set_StatusAtAge61ToX_Off = 1
  End If
'
  For i = 1 To m_icount
    i_inc_ivariance(i) = sigma_my(i)    'Assign indvidual value corresponding to previous wage
    i_unemp_ivariance(i) = rand(i) * Sqr(0.648)
    i_sickleave_ivariance(i) = rand(i + m_icount) * Sqr(0.638)
    
    ' Assumed zero postponed housetax values at base year
    i_housetax_postponed(i) = 0
    
    ' Calculate household capital income
    h_inc_capital(hhnr2index(i_hhnr(i))) = h_inc_capital(hhnr2index(i_hhnr(i))) + _
      i_inc_capital(i)
    
    ' The income is truncated at zero
    If i_inc_earning(i) < 0 Then i_inc_earning(i) = 0
    If i_inc_taxable(i) < 0 Then i_inc_taxable(i) = 0
      
    '*** Possible to move this block to startdata

    ' -- PGI transformed to definitions in a06_Pension_Rules
    If i_status(i) = 2 Then
        i_pgi(i) = 0
    End If
    
    'Tilldela individer som pensionerats innan specificerad ålder en annan status
    'Hjälp mig fundera på om detta ställer till problem med definitionen på andra
    'variabler för individen!? FJ 2004-03-02
    If chkRetire65 = True And i_status(i) = 2 And i_age(i) < txtRetire Then
        If set_StatusAtAge61ToX_Off <> 1 Then
            i_status(i) = f_set_StatusAtAge61ToX(StatusAtAge61ToX, i)
            i_ap_pensmonth(i) = (txtRetire - 65) * 12
                        
            '-- 0-ställer alla pensionsförmåner
            i_ap_atp(i) = 0
            i_ap_atp_old(i) = 0
            i_ap_pts(i) = 0
            i_ap_fp(i) = 0
            i_ap_fp30(i) = 0
            i_ap_tp(i) = 0
            i_ap_gp(i) = 0
            i_ap_ip(i) = 0
            i_ap_fiktiv(i) = 0
            i_ap_pp(i) = 0
            i_ap_fp30_1994(i) = 0
            i_ap_atp_1994(i) = 0
            i_ap_gartill(i) = 0
            i_ap_tp(i) = 0
            i_ap(i) = 0
            i_ap_ap(i) = 0
            i_op(i) = 0
        End If
    End If

    If i_status(i) = 4 Then
        i_pgb_antag(i) = i_pgi(i)
        i_pgb(i) = i_pgi(i)
        i_pgi(i) = 0
        i_ftp(i) = i_ftp_atp(i) + i_ftp_fp(i) + i_ftp_pts(i)
    End If
    i_pu(i) = i_pgi(i) + i_pgb(i)
    i_pu_orange(i) = i_pu(i)
    i_pgi_orange(i) = i_pgi(i)
    
    ' -- Individual comparison pension base
    '    Register i_pu_ind_comp for year before child born. Used in calc pens rights child years
    i_pu_ind_comp(i) = i_pgi(i) 'Approx start value in lack of information
  Next
  
'Frigör utrymmet som randomValues och helpArrayRandomValues fälten upptagit
  Erase randomValues()
  Erase helpArrayRandomValues()
  
  error_flag = 0
  Call read_parameters
  
  If error_flag = 1 Then
    status "Error reading parameters"
    Exit Sub
  End If
   
  ' Initialize Socmod variables and parameters
'  Call Init_Socmod

  ' Imputation of educational attainment for elderly
  ' The imputation is also done when producing the SESIM base dataset. If one wishes to study
  ' the Monte Carlo variance contribution due to the imputation one should activate Sub ImputeEducation
  ' in the initialization.
  If get_scalefactor("ImputeEducationElderly") <> 1 Then Call ImputeEducation
  
  ' Do some macro calculations
  Call calc_newyear_macro
  
  ' Calculate household emigration year
  Call calc_hh_emig_year
  
  ' Calculate emigrant municipalities
  Call calc_emig_municipality
  
  ' Initial prediction of labor market sector
  ' This is needed to adjust the observed distribution
  ' of sectors due to the fact that sector is assigned
  ' on a permanent basis (does not change) in SESIM
  ' TP030402
'  For i = 1 To m_icount
'    If i_age(i) <= 30 And i_abroad(i) = 0 And _
'      (i_status(i) >= 6 And i_status(i) <= 8) Then
'       i_sector(i) = Sector(i)
'    End If
'  Next
  For i = 1 To m_icount
    If i_status(i) = 2 Or i_status(i) = 5 Or i_status(i) = 6 Or i_status(i) = 8 Then
      Update_Sector (i)
      Select Case i_sector(i) '-- Counting qalifying years in different sectors
        Case 1
            i_op_pp_years_Blue(i) = pp_hist(i).n_years
            i_op_pp_years_trans(i) = f_pp_years(i, 1995) 'STP
        Case 2
            i_op_pp_years_White(i) = pp_hist(i).n_years
        Case 3
            i_op_pp_years_State(i) = pp_hist(i).n_years
        Case 4
            i_op_pp_years_Local(i) = pp_hist(i).n_years
            i_op_pp_years_trans(i) = f_pp_years(i, 1997) 'PA-KL
      End Select
      i_op_pp_years(i) = pp_hist(i).n_years
    End If
  Next
  
  '*** TEST RELATIVES
  ' Matchningen måste göras i startdata - Testar bara att koppla ihop alla befintliga hushåll
'Dim mother_father(2) As Long
'Dim children(20) As Long, i_index As Long
'Dim i_nr As Long, c As Integer, h As Long, i_first_nr As Long
'    For h = 1 To m_hcount
'       i_nr = h_first_indnr(h)
'       i_first_nr = i_nr
'       Do While i_nr <> 0
'           i_index = indnr2index(i_nr)
'           If h_n_child(h) = 0 Then
'                Relatives(i_index).father = 0
'                Relatives(i_index).mother = 0
'            Else
'                ReDim mother_father(2) As Long
'                ReDim children(h_n_child(h)) As Integer
'                c = 0
'                If i_bvux = 1 Then
'                    mother_father(i_sex(i_index)) = i_indnr(i_index)
'                  Else
'                    c = c + 1
'                    children(c) = i_indnr(i_index)
'                End If
'            End If
'            i_nr = i_next_indnr(indnr2index(i_nr))
'    Loop
'
'    ReDim Relatives(mother_father(1)).children(h_n_children)
'    ReDim Relatives(mother_father(2)).children(h_n_children)
'    For c = 1 To h_n_child(h)
'         Relatives(children(c)).father = mother_father(1)
'         Relatives(children(c)).mother = mother_father(2)
'         Relatives(mother_father(1)).children(c) = children(c)
'         Relatives(mother_father(2)).children(c) = children(c)
'    Next

  ' Calculate some statistics
  Call demograf_stat

  ' Code some variables
  Call code_variables
  
'*** The number of days with sickleave is taken from base data and hence
'*** no simulation is required at initialization. TP051211
'  ' Simulate number of days with sickness absence
'  If get_scalefactor("BabyBoom_Active") <> 1 Then
'    Call Sick_leave_Health
'  Else
'    Call Sick_leave
'  End If
  
  Call Calculate_Deltal(m_ap_norm, 1 + (m_interest_long / 100))
    
  '**** Possible to move the block below to Start data program
  '-- Accumulation of occupational pension stocks up to base year
  Call Init_Occupational_Pension_Rights
  ' -- Transformations of survivors and occupational pensions
  Printdok "    -- I loop Initsesim: Init survivors pensions & som other pension variables"
  '-- Average taxable income e.g. used for calculation of pension income index
  Dim j As Long
  m_egenavg_pens_p = 0.0695   '*** Provisoriskt
  m_inc_taxable_snitt4 = 0
  m_inc_taxable_snitt3 = 0
  m_inc_taxable_snitt2 = 0
  m_inc_taxable_snitt1 = 0
  m_inc_taxable_snitt = 0
  j = 0
  
  For i = 1 To m_icount
      ' -- Pension rights and pension contributions for the reformed system
      Select Case i_pu(i)
        Case Is < f_bas_deduct_min(1999)
            i_pr_ip(i) = 0
            i_pr_pp(i) = 0
        Case Else
            i_pr_ip(i) = m_ap_ip_avs * i_pu(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(1999, 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(1999, i_age(i), 0))
      End Select
      
      '-- Calculates pension funds as a mix of real data from RFV for domestic persons
      '   and calculated for persons abroad
      '   Reindexation of RFV-data to 1999 pricelvel including correction for
      '   administration and inheritance gains
      Dim fiktiv_kvot As Double
      i_pr_ip1(i) = m_ap_ip_avs * i_pu_orange(i) * f_utfasning_ATP(i_born_year(i), f_ap_pensyear(1999, i_age(i), 0))
      If i_pbhi(i) > 0 Then ' -- Note: i_pbhi always missing for i_abroad=1
          If i_pb_ip(i) > 0 Then
                fiktiv_kvot = i_pb_fiktiv(i) / i_pb_ip(i)
            Else
                fiktiv_kvot = 1
          End If
          ' -- Tidigare def av PB
          'i_pb_ip(i) = ((i_pbhi(i) / 1.0173 / (1 - 0.00045)) - i_pr_ip1(i)) _
          '  / Arvsvinstfaktor(i_age(i))
           i_pb_ip(i) = (((i_pbhi(i) / (1.0145)) / (1 - 0.00045))) _
             / Arvsvinstfaktor(i_age(i))
          '-- Orange anger PB 2000 i 2001 års pris. Deflaterar
          i_pb_ip(i) = i_pb_ip(i) / (m_ap_balind1 / m_ap_balind)
          '   Proportionerar pb_fiktiv
          i_pb_fiktiv(i) = i_pb_fiktiv(i) * fiktiv_kvot
      End If
      '-- Tranformation of survivors pension variables from start data
      i_surv(i) = i_surv_fp(i) + i_surv_atp(i)
      '-- Ruff splitting up of i_op (occupational pensions)
      If i_status(i) = 2 Then '-- Old age
     '  If i_age(i) >= 55 Then
            i_op_ap_db(i) = i_op(i) '-- All current ocup pens supposed to life long defined benefit
    '    '-- Occupational disability benefits not implemented yet
    '    ElseIf i_status(i) = 4 Then '-- Disablity
    '        i_op_ftp(i) = i_op(i)
    '    '-- Occupational survivors benefits not implemented yet
    '    ElseIf i_surv(i) > 0 And i_age(i) > 18 And i_status(i) <> 4 And i_status(i) <> 2 Then
    '        i_surv_op (i) > 0
    '    ElseIf i_surv(i) > 0 And i_age(i) <= 18 And i_status(i) <> 4 And i_status(i) <> 2 Then
    '        i_surv_barn (i) > 0
        Else
            i_op(i) = 0
      End If
    
    '-- Compulsary retirement
    '   -- No one works after 70
    If i_age(i) > 70 And i_status(i) <> 2 Then
        i_status1(i) = i_status(i)
        i_status(i) = 2
        i_ap_pensmonth(i) = 60 ' (70-65) * 12 = 60 Not poosible to get more
    End If
    '   -- If exogenous retirement age
    If chkRetire65 = True Then
        If i_age(i) >= txtRetire And i_status(i) <> 2 Then
        'Debug.Print i & " " & i_age(i) & " " & i_inc_earning(i) & " " & i_abroad(i) & " " & i_trf_taxable(i) & " " & i_ap(i)
            i_status1(i) = i_status(i)
            i_status(i) = 2
            i_ap_pensmonth(i) = (txtRetire - 65) * 12
        End If
    End If
    '-- Private pensions
 '   If i_status(i) = 2 And i_wealth_pension_total(i) > 0 Then
 '       If Rnd > 0.7 Or i_wealth_pension_total(i) > 20 * m_basbelopp_f Then
 '           i_pp_payout_time(i) = -99 '-- Annuity
 '         Else
 '           i_pp_payout_time(i) = 5 '-- Fixed 5 year period
 '       End If
 '   End If
 '   i_pp(i) = f_Private_Pension_Benefits(i, i_pp_payout_time(i))
    
    '-- Lagged status if retired
    If i_status(i) = 2 Then
        i_status1(i) = 2
    End If
    
    '-- Aggregations
    i_ap(i) = i_ap_fp(i) + i_ap_pts(i) + i_ap_atp(i)
    i_ap_atp_old(i) = i_ap_atp(i)
    i_ap_atp_ut(i) = i_ap_atp(i)
    i_ap_fp30_ut(i) = i_ap_fp30(i)
    
    'i_trf_pension(i) = i_ap(i) + i_surv(i) + i_op(i) + i_ftp(i)
    '************** OBS Räknar av i_trf_sickleave ******************
   '*** i_inc_earning(i) = maxi(0, i_inc_earning(i) - i_trf_sickleave(i) + i_inc_selfemployed(i))
   '**** i_inc_selfemployed(i) = 0
    '************************************************************
   ' i_trf_taxable(i) = i_trf_pension(i) + i_trf_parentleave(i) + i_trf_sickleave(i) + i_trf_unemployed(i)
   ' i_inc_taxable(i) = i_inc_earning(i) + i_trf_taxable(i)
    
    If i_age(i) > 15 And i_age(i) < 65 And i_abroad(i) = 0 And _
        (i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i)) > 0 Then
       j = j + 1
       'm_inc_taxable_snitt = m_inc_taxable_snitt + (i_inc_taxable(i) * (1 - m_egenavg_pens_p))
       m_inc_taxable_snitt = m_inc_taxable_snitt + _
        ((i_inc_taxable(i) - i_ap(i) - i_surv(i) - i_op(i)) * (1 - m_egenavg_pens_p))
       m_inc_taxable_snitt1 = m_inc_taxable_snitt1 + (i_inc_taxable1(i) * (1 - m_egenavg_pens_p))
       m_inc_taxable_snitt2 = m_inc_taxable_snitt2 + (i_inc_taxable2(i) * (1 - m_egenavg_pens_p))
       m_inc_taxable_snitt3 = m_inc_taxable_snitt3 + (i_inc_taxable3(i) * (1 - m_egenavg_pens_p))
       m_inc_taxable_snitt4 = m_inc_taxable_snitt4 + (i_inc_taxable4(i) * (1 - m_egenavg_pens_p))
    End If
  Next
  m_inc_taxable_snitt = m_inc_taxable_snitt / j
  m_inc_taxable_snitt1 = m_inc_taxable_snitt1 / j
  m_inc_taxable_snitt2 = m_inc_taxable_snitt2 / j
  m_inc_taxable_snitt3 = m_inc_taxable_snitt3 / j
  m_inc_taxable_snitt4 = m_inc_taxable_snitt4 / j

    '-- Initiating some aggregated pension variables
    m_ap_apfond = f_GetMakro("m_ap_apfond", 1999, "Pension")
    
    '-- Accumultead premium pension funds
    m_ap_ppfond = L_SUMVEC(i_pb_pp(1), m_icount)
    '-- Accumultead occupational pension funds
    m_op_fond = L_SUMVEC(i_pb_op_ap(1), m_icount) + L_SUMVEC(i_pb_op_tp(1), m_icount)
     '-- Accumulated fund of private pension savings
    m_pp_fond = L_SUMVEC(i_wealth_pension_total(1), m_icount)
    
    '-- Initiation of guarantee pension base help variable
    m_basbelopp_gp = m_basbelopp
  
  ' Calculate wealth and pension savings
  Call Wealth_PensionSavings
  
  ' Imputation of housing costs
  Call ImputeHousingInfo
  
  ' Initialization of house purchase prices in base data
  Call InitializeHousePurchasePrice
  
  ' Beräkna vissa regler det som definieras i stardata räknas inte om
  Call calc_rules
  
  ' Various imputations for the Baby Boom modules
  If get_scalefactor("BabyBoom_Active") <> 1 Then
  
    ' Imputation of closeness to relative
    Call ClosenessToRelative
  
    ' Imputation of health index
    Call Health
  
    ' Imputation of days with inpatient care
    Call Inpatient_Care
  
    ' Imputation of disability (ADL)
    Call ADL
    
    ' Imputation of assistance for elderly
    Call AssistanceElderly
    
  End If
  
  ' Project number of contributors in pension system for year 1999, for balance ratio
  Call CalculatePensionContributors
  ' -- Optional printing of pension variables in PRN-format for export to eg. Aremos
  If get_scalefactor_active("Pensions_macro") = 1 Then
    Call Calculate_Macro
    Call Print_Pensions_Macro
  End If
  If get_scalefactor_active("pension_debug") = 1 Then
    Call Pension_debugging_files
  End If
  If get_scalefactor_active("pension_micro") = 1 Then
    Call Pension_micro_file
  End If
  If get_scalefactor_active("Print_elderly_care") = 1 Then
    Call Print_elderly_care_micro
  End If
  
  ' Write income history (if enabled)
  inchist.write_now
  
  ' Save binary data
  If controlcenter.chk2Saveoutfiles = 1 Then Call Write_Data
  If controlcenter.chk2SaveAccessdb = 1 Then Call MDIForm1.menu_writeaccess_Click
  
  ' Initiate output data type
  Call InitOutputData
  
  '*** Write output data.
  'Call Write_output_ludata
  Call Write_Output_Data_Old

  init_done = 1

  With controlcenter
    .cmd1run.SetFocus
    .cmdUnivar.enabled = True
    .cmdKernel.enabled = True
    .cmdDemo.enabled = True
    .cmdDemohist.enabled = True
    .cmdFreq.enabled = True
    .cmdMicrodata.enabled = True
    .CmdGlobalSelection.enabled = True
    .cmd_OutputData.enabled = True
    
    ' Most options are only available before SESIM is initialized
    .chk2Saveoutfiles.enabled = False
    .chk2SaveAccessdb.enabled = False
    .chk2Savehist.enabled = False
    .chk2Saveincomehist.enabled = False
    .chk2Price99.enabled = False
    .txt2MYparameterfilname.enabled = False
    .txt2BASEparameterfilname.enabled = False
    .cmdBrowsepar1.enabled = False
    .cmdBrowsepar2.enabled = False
    .cmdSaveOptions.enabled = False
    .txtWeight.enabled = False
    .txtPercentofsample.enabled = False
    .txt2Runsystem.enabled = False
    .chkRetire65.enabled = False
    .txtRetire.enabled = False
    .chkRandomize.enabled = False
  End With
  
    
  ' After initiation no selection exists and all individuals and
  ' households are therefore selected
  For i = 1 To m_icount
    select_i(i) = 1
    
    '*** DEBUG
    i_selected(i) = 1
    
    If i <= m_hcount Then
        select_h(i) = 1
        
        '*** DEBUG
        h_selected(i) = 1
    End If
  Next i
  
  status "*** Init done ***"
  Printdok " -- Initsesim ready"
End Sub

'********************************************************************************* '*** Sub check_new_base_data checks for new data on the server and downloads it '*** to the client if newer than the client data '*********************************************************************************
Public Sub check_new_base_data() Printdok " check_new_base_data" Const data_path = "S:\data\startdata\" ' If new microdata is available at the server then copy it to ' the local computer. Dim i As Long On Error GoTo ErrorNetwork If Dir(data_path & "ii.bin") <> "" And Dir(data_path & "hh.bin") <> "" Then Dim fcopy As Boolean fcopy = False If Dir(sesimpath & "\microdata\ii.bin") = "" _ Or Dir(sesimpath & "\microdata\hh.bin") = "" Then fcopy = True If Dir(sesimpath & "\microdata\ii.bin") <> "" Then If FileDateTime(sesimpath & "\microdata\ii.bin") < _ FileDateTime(data_path & "ii.bin") Then fcopy = True End If If Dir(sesimpath & "\microdata\hh.bin") <> "" Then If FileDateTime(sesimpath & "\microdata\hh.bin") < _ FileDateTime(data_path & "hh.bin") Then fcopy = True End If ErrorNetwork: If Err.Number = 52 Then 'Error. Tell user what happened. Then clear the Err object. MsgBox "Can't read network data", , "Error message" Err.Clear ' Clear Err object fields End If On Error GoTo 0 ' Turn off error trapping. If fcopy = True Then If vbYes = MsgBox("New data available. Do You wan't to copy?", vbYesNo) Then status "Copying ii.bin from network" FileCopy data_path & "ii.bin", sesimpath & "\microdata\ii.bin" status "Copying hh.bin from network" FileCopy data_path & "hh.bin", sesimpath & "\microdata\hh.bin" status "Copying done" End If End If End If ' if data exists on server End Sub
'***** 'Funktionen beräknar statusfördelningen för individer som är i ålder 61-64 år. Värdena 'som returneras används för att fördela pensionerade individer i denna ålder på 'andra status. Sannolikhetsfördelningen för respektive år aggregeras för varje 'ytterligare status. FJ 2004-03-02 Borde placeras i Service '*****
Public Function f_calc_StatusAtAge61ToX(retAge As Byte) As Variant 'Dimensioneras med 10 positioner där position 10 summan av övriga status 1-9 ReDim arr(61 To retAge - 1, 1 To 10) As Double ReDim probArr(61 To retAge - 1, 1 To 9) As Double Dim i As Long Dim j As Integer For i = 1 To m_icount If i_age(i) > 60 And i_age(i) < retAge And i_status(i) <> 2 Then arr(i_age(i), i_status(i)) = arr(i_age(i), i_status(i)) + 1 arr(i_age(i), 10) = arr(i_age(i), 10) + 1 End If Next For i = 1 To 9 For j = 61 To retAge - 1 If i = 1 Then probArr(j, i) = arr(j, i) / arr(j, 10) Else probArr(j, i) = probArr(j, i - 1) + arr(j, i) / arr(j, 10) End If Next Next f_calc_StatusAtAge61ToX = probArr End Function
'***** 'Generera ett slumptal och sök igenom probArr efter intervallet som omsluter detta 'slumpvärde. FJ 2004-03-02 Borde placeras i Service '*****
Public Function f_set_StatusAtAge61ToX(probArr() As Double, individ As Long) As Integer Dim i As Integer Dim rand As Double rand = Rnd() For i = 1 To 9 If i = 1 And rand < probArr(i_age(individ), i) Then Exit For ElseIf i > 1 And i < 9 Then If rand > probArr(i_age(individ), i - 1) And rand < probArr(i_age(individ), i) Then Exit For End If ElseIf i = 9 Then Exit For End If Next f_set_StatusAtAge61ToX = i End Function