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