Attribute VB_Name = "x01_Readparameters"
Option Explicit
Option Base 1

Public parm_death(1999 To 2110, 0 To 106, 2) As Double
Public parm_death_er(17 To 65, 2) As Double

Public parm_macro(1992 To 2110, 1 To 27) As Double
Public parm_beginner(1993 To 2050, 1 To 2, 1 To 2) As Double
Public parm_studycount(1993 To 2050, 1 To 3, 1 To 3) As Double
Public parm_takeupkv(1992 To 2005, 1 To 10) As Double
Public parm_takeuphs(1992 To 2005, 1 To 4) As Double

'*** The following parameter matrices are not used in the code right now!! TP 011114
'Public parm_wanted(1993 To 2100, 1 To 2) ' wanted deaths (1) and births(2)
'Public parm_work(19 To 64, 1 To 2) As Double
'Public parm_fertility(1996 To 2037, 16 To 49) As Double

'*** Alignment data for mortality: counts for five-year groups (0-4, 5-9, ..., 95-)
'*** by sex and year
Public parm_align_mortality(2000 To 2110, 1 To 20, 1 To 2) As Double

' Alignment data for fertility: wanted # of births by year
Public parm_align_fertility(1999 To 2110) As Long

'Wanted number of emigrants, men and women. Ändrat från 1998 till 1997. Av Fredrik 24/10-01
'*** Emigrants differentiated by origin: swedish or foreign (TP 020906)
Public n_em(1999 To 2110, 2) As Long

'Wanted total number of immigrants, men and women. Ändrat från 1998 till 1997. Av Fredrik 24/10-01
'*** Immigrants differentiated by origin: swedish or foreign (TP 020906)
Public n_im(1999 To 2110, 2) As Long

'Transition matrix for distribution of new immigrants
Public n_im_trans(1 To 4, 1 To 24) As Single

' Age(grop) and sex distribution of emigrants and immigrants (regardless of nationality). Data
' for alignment of migration in order to get correct age and sex distribution. Age-indexation
' according to idx = min(21, floor(i_age / 5) + 1), that is 1: 0-4, 2: 5-9, ..., 20: 95-99
' and 21: 100+. TP 060522
Public agedist_immigration(2000 To 2110, 1 To 2, 1 To 21) As Long
Public agedist_emigration(2000 To 2110, 1 To 2, 1 To 21) As Long

'Pension liability in regard to individuals paying contributions, supplementary pension
Public TPinSA(2000 To 2018) As Double

'Public pconst As New Collection
Public Parm As New Collection

' Datatype used for storage of run-time scale parameters for alignment
Private Type parm_scale
  name As String
  time_from  As Long
  time_to As Long
  scalefactor As Double
  active As Integer
End Type
Private parm_scalefactor() As parm_scale
Private tabell As New ADODB.Recordset, db As New ADODB.Connection
Dim i As Long


Public Sub read_parameters()
   Printdok "read_parameters"
   
   Call read_BASE_parametrar
   If error_flag = 0 Then Call read_MY_parametrar
End Sub


' -- Opens an Excel-file
' Assumes that db is declared as a private variable in actual module
' Note: Explicit closing required

Public Sub Open_Excel(name As String)
  With db
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & name & ";" & _
    "Extended Properties=Excel 8.0;"
    .Open
  End With
End Sub


' -- Reads a complete sheet from an open Excel-file
' Assumes that db is open and tabell declared as a private variable in actual module
' Note: Explicit closing required

Public Sub Read_Excel(name As String)
  Set tabell.ActiveConnection = db
  tabell.Open "Select * from [" & name & "$]", db, adOpenStatic, adLockBatchOptimistic
End Sub



Public Sub read_BASE_parametrar()
  Dim year As Integer
  Dim age As Integer, ad
  Dim i As Integer
  Dim txtFilename As String
  
  ' Handle errors...
  On Error Resume Next
  
  Call read_scaleparm(0)
 
  status "Reading BASE parameters"
  
  If Err.Number <> 0 Then
    status "ERROR in scale parameters"
    Err.Clear
  End If

  txtFilename = controlcenter.txt2BASEparameterfilname.text
  If Mid$(txtFilename, 2, 1) <> ":" And Mid$(txtFilename, 2, 1) <> "\" Then txtFilename = sesimpath & "\" & txtFilename
  If Dir(txtFilename) = "" Then
    MsgBox "Error: Can't find parameterfile:" & vbCrLf & txtFilename
    End
  End If
  Printdok ("Excel file with demographic assumptions: " & txtFilename)
  Open_Excel txtFilename
  
  '*** One-year hazards (Statistics Sweden) ***
  Read_Excel "p_death"
  Do While tabell.EOF = False And IsNull(tabell("year")) = False
    year = tabell("year")
    age = tabell("age")
    parm_death(year, age, 1) = tabell("men") / 1000000#
    parm_death(year, age, 2) = tabell("women") / 1000000#
    tabell.MoveNext
  Loop
  tabell.Close
  
  '*** Alignment data for mortality ***
  Read_Excel "align_mortality"
  Dim agegrp As Integer
  agegrp = 1
  Do While tabell.EOF = False And IsNull(tabell("year")) = False
    year = tabell("year")
    parm_align_mortality(year, agegrp, 1) = tabell("men")
    parm_align_mortality(year, agegrp, 2) = tabell("women")
    tabell.MoveNext
    agegrp = agegrp + 1
    If agegrp > 20 Then agegrp = 1
  Loop
  tabell.Close
  
  '*** Alignment data for fertility
  Read_Excel "align_fertility"
  'Do While tabell("year") <> "" '.EOF = False '
  Do While tabell.EOF = False And IsNull(tabell("year")) = False
    year = tabell("year")
    parm_align_fertility(year) = tabell("wanted")
    tabell.MoveNext
  Loop
  tabell.Close
   
  '*** Excess risk for early retired individuals ***
  Read_Excel "p_death_er"
  Do While tabell.EOF = False And IsNull(tabell("age")) = False
    age = tabell("age")
    parm_death_er(age, 1) = tabell("men") / 1000000#
    parm_death_er(age, 2) = tabell("women") / 1000000#
    tabell.MoveNext
  Loop
  tabell.Close
  
  
  '*** Alignment data for migration ***
  Read_Excel "migration"
  Do While tabell.EOF = False And IsNull(tabell("year")) = False
    year = tabell("year")
    n_em(year, 1) = tabell("em_swe") '*** Swedish emigrants
    n_em(year, 2) = tabell("em_for") '*** Foreign emigrants
    n_im(year, 1) = tabell("im_swe") '*** Swedish immigrants
    n_im(year, 2) = tabell("im_for") '*** Foreign immigrants
    tabell.MoveNext
  Loop
  tabell.Close
  
  Dim sex As Byte
  Read_Excel "migration_agedist"
  Do While tabell.EOF = False And IsNull(tabell("year")) = False
    year = tabell("year")
    agegrp = tabell("ageidx")
    sex = tabell("sex")
    agedist_emigration(year, sex, agegrp) = tabell("emig")
    agedist_immigration(year, sex, agegrp) = tabell("immig")
    tabell.MoveNext
  Loop
  tabell.Close
  
  '*** Transition matrix for new immigrants ***
  Read_Excel "new_immigration"
  Do While tabell.EOF = False And IsNull(tabell("counter")) = False
    year = tabell("counter")
    n_im_trans(1, year) = tabell("low_age") '*** Swedish emigrants
    n_im_trans(2, year) = tabell("high_age") '*** Foreign emigrants
    n_im_trans(3, year) = tabell("h_size") '*** Swedish immigrants
    n_im_trans(4, year) = tabell("probability") '*** Foreign immigrants
    tabell.MoveNext
  Loop
  tabell.Close
  
  db.Close

  If Err.Number <> 0 Then
    status "ERROR IN BASE PARAMETERS!!"
    Err.Clear
  End If
  
End Sub




Public Sub read_MY_parametrar()
  Dim year As Integer
  Dim age As Integer
  Dim i As Integer
  Dim txtFilename As String
  Dim check_if_null As Variant
  
  ' Handle errors...
  On Error Resume Next
  
  Call read_scaleparm(1)
  
  If Err.Number <> 0 Then
    status "ERROR in scale parameters"
    Err.Clear
  End If
  status "Reading MY parameters"
  txtFilename = controlcenter.txt2MYparameterfilname.text
  If Mid$(txtFilename, 2, 1) <> ":" And Mid$(txtFilename, 2, 1) <> "\" Then _
    txtFilename = sesimpath & "\" & txtFilename
    
  If Dir(txtFilename) = "" Then
    MsgBox "Error: Can't find parameterfile:" & vbCrLf & txtFilename
    End
  End If
  Printdok ("Excel file with macro assumptions: " & txtFilename)
  Open_Excel txtFilename

   '*************** macro ********************
  Dim LastVal(1 To 27) As Double
  Read_Excel "Macro"
  Do While tabell.EOF = False

    check_if_null = tabell("year")
    If IsNull(check_if_null) = True Then Exit Do

    year = tabell("year")
     
    If IsNull(tabell("realwage")) = False Then
        parm_macro(year, 1) = tabell("realwage")
        LastVal(1) = parm_macro(year, 1)
    Else
        parm_macro(year, 1) = LastVal(1)
    End If
    
    If IsNull(tabell("inflation")) = False Then
        parm_macro(year, 2) = tabell("inflation")
        LastVal(2) = parm_macro(year, 2)
    Else
        parm_macro(year, 2) = LastVal(2)
    End If
        
    If IsNull(tabell("basbelopp")) = False Then
        parm_macro(year, 3) = tabell("basbelopp")
        LastVal(3) = parm_macro(year, 3)
    Else
        parm_macro(year, 3) = LastVal(3)
    End If
    
    If IsNull(tabell("basbelopp_förhöjt")) = False Then
        parm_macro(year, 4) = tabell("basbelopp_förhöjt")
        LastVal(4) = parm_macro(year, 4)
    Else
        parm_macro(year, 4) = LastVal(4)
    End If
    
    If IsNull(tabell("shares_dividends")) = False Then
        parm_macro(year, 5) = tabell("shares_dividends")
        LastVal(5) = parm_macro(year, 5)
    Else
        parm_macro(year, 5) = LastVal(5)
    End If
    
    If IsNull(tabell("shares_rate")) = False Then
        parm_macro(year, 6) = tabell("shares_rate")
        LastVal(6) = parm_macro(year, 6)
    Else
        parm_macro(year, 6) = LastVal(6)
    End If
    
    If IsNull(tabell("historicwage")) = False Then
        parm_macro(year, 7) = tabell("historicwage")
        LastVal(7) = parm_macro(year, 7)
    Else
        parm_macro(year, 7) = LastVal(7)
    End If
    
    If IsNull(tabell("to_price99")) = False Then
        parm_macro(year, 8) = tabell("to_price99")
        LastVal(8) = parm_macro(year, 8)
    Else
        parm_macro(year, 8) = LastVal(8)
    End If
    
    If IsNull(tabell("interest_long")) = False Then
        parm_macro(year, 9) = tabell("interest_long")
        LastVal(9) = parm_macro(year, 9)
    Else
        parm_macro(year, 9) = LastVal(9)
    End If
    
    If IsNull(tabell("interest_short")) = False Then
        parm_macro(year, 10) = tabell("interest_short")
        LastVal(10) = parm_macro(year, 10)
    Else
        parm_macro(year, 10) = LastVal(10)
    End If
    
    If IsNull(tabell("inkomstindex")) = False Then
        parm_macro(year, 11) = tabell("inkomstindex")
        LastVal(11) = parm_macro(year, 11)
    Else
        parm_macro(year, 11) = LastVal(11)
    End If
    
    If IsNull(tabell("earnings")) = False Then
        parm_macro(year, 12) = tabell("earnings")
        LastVal(12) = parm_macro(year, 12)
    Else
        parm_macro(year, 12) = LastVal(12)
    End If
    
    If IsNull(tabell("pgb")) = False Then
        parm_macro(year, 13) = tabell("pgb")
        LastVal(13) = parm_macro(year, 13)
    Else
        parm_macro(year, 13) = LastVal(13)
    End If
    
    If IsNull(tabell("trf_taxable")) = False Then
        parm_macro(year, 14) = tabell("trf_taxable")
        LastVal(14) = parm_macro(year, 14)
    Else
        parm_macro(year, 14) = LastVal(14)
    End If
    
    If IsNull(tabell("inc_taxable")) = False Then
        parm_macro(year, 15) = tabell("inc_taxable")
        LastVal(15) = parm_macro(year, 15)
    Else
        parm_macro(year, 15) = LastVal(15)
    End If
    
    If IsNull(tabell("AAKBEF1664")) = False Then
        parm_macro(year, 16) = tabell("AAKBEF1664")
        LastVal(16) = parm_macro(year, 16)
    Else
        parm_macro(year, 16) = LastVal(16)
    End If
    
    If IsNull(tabell("AAL1664")) = False Then
        parm_macro(year, 17) = tabell("AAL1664")
        LastVal(17) = parm_macro(year, 17)
    Else
        parm_macro(year, 17) = LastVal(17)
    End If
    
    If IsNull(tabell("AAPTOT")) = False Then
        parm_macro(year, 18) = tabell("AAPTOT")
        LastVal(18) = parm_macro(year, 18)
    Else
        parm_macro(year, 18) = LastVal(18)
    End If
    
    If IsNull(tabell("AAPSYS")) = False Then
        parm_macro(year, 19) = tabell("AAPSYS")
        LastVal(19) = parm_macro(year, 19)
    Else
        parm_macro(year, 19) = LastVal(19)
    End If
    
    If IsNull(tabell("TIESYS")) = False Then
        parm_macro(year, 20) = tabell("TIESYS")
        LastVal(20) = parm_macro(year, 20)
    Else
        parm_macro(year, 20) = LastVal(20)
    End If
    
    If IsNull(tabell("BNPAL")) = False Then
        parm_macro(year, 21) = tabell("BNPAL")
        LastVal(21) = parm_macro(year, 21)
    Else
        parm_macro(year, 21) = LastVal(21)
    End If
    
    If IsNull(tabell("BNPAF")) = False Then
        parm_macro(year, 22) = tabell("BNPAF")
        LastVal(22) = parm_macro(year, 22)
    Else
        parm_macro(year, 22) = LastVal(22)
    End If
    
    If IsNull(tabell("PB_IP")) = False Then
        parm_macro(year, 23) = tabell("PB_IP")
        LastVal(23) = parm_macro(year, 23)
    Else
        parm_macro(year, 23) = LastVal(23)
    End If
    
    If IsNull(tabell("PB_PP")) = False Then
        parm_macro(year, 24) = tabell("PB_PP")
        LastVal(24) = parm_macro(year, 24)
    Else
        parm_macro(year, 24) = LastVal(24)
    End If
    
    If IsNull(tabell("m_price_rw_home")) = False Then
        parm_macro(year, 25) = tabell("m_price_rw_home")
        LastVal(25) = parm_macro(year, 25)
    Else
        parm_macro(year, 25) = LastVal(25)
    End If
    
    If IsNull(tabell("m_price_rw_other")) = False Then
        parm_macro(year, 26) = tabell("m_price_rw_other")
        LastVal(26) = parm_macro(year, 26)
    Else
        parm_macro(year, 26) = LastVal(26)
    End If
    
    tabell.MoveNext
  Loop
  tabell.Close

  '*************** kommundata ********************
  ReDim kommundata(1 To 289)
  Dim index As Long
  Read_Excel "Kommundata"
  Do While tabell.EOF = False
    index = tabell("index")
    If IsNull(index) = True Then Exit Do
    
    kommundata(index).name = tabell("name")
    kommundata(index).taxvalue = tabell("taxvalue")
    kommundata(index).kb = tabell("kb")
    kommundata(index).kod = tabell("kod")
    kommundata(index).h_region = tabell("h_region")
    kommundata(index).abcd_region = tabell("abcd_region")
    kommundata(index).bklimat = tabell("bklimat")
    kommundata(index).immig_loc = tabell("immig_loc")
    kommundata(index).pop_loc = tabell("pop_loc")
    kommundata(index).skatt99 = tabell("skatt99")
    kommundata(index).skatt00 = tabell("skatt00")
    kommundata(index).skatt01 = tabell("skatt01")
    kommundata(index).skatt02 = tabell("skatt02")
    kommundata(index).skatt03 = tabell("skatt03")
    kommundata(index).skatt04 = tabell("skatt04")
    kommundata(index).skatt05 = tabell("skatt05")
    kommundata(index).skatt06 = tabell("skatt06")
    kommundata(index).LA_region = tabell("LA_region")
    
    tabell.MoveNext
  Loop
  tabell.Close
  db.Close

  If Err.Number <> 0 Then
    status "ERROR IN MY PARAMETERS!!"
    Err.Clear
  End If
  
End Sub



Public Sub read_scaleparm(param_to_log As Byte)
  If param_to_log = 1 Then Printdok "read_scaleparm: ************ ACTUAL SELECTIONS BELOW *********"
  'Dim db As Database
  'Dim tabell As Recordset
  'Set db = OpenDatabase(sesimpath & "\parameterdata\sesimrun.mdb", , vbReadOnly)
  'Set tabell = db.OpenRecordset("parm_scale")
  ' OS 2002-02-12 Byte t ADO för att fungera med standatd Win 2000 datorer
  Dim tabell As New ADODB.Recordset, db As New ADODB.Connection
  Dim i As Integer
  db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
      & sesimpath & "\parameterdata\sesimrun.mdb"
  db.Open
  ' db.CursorLocation = adUseClient
  Set tabell.ActiveConnection = db
  tabell.Open "parm_scale", db, adOpenStatic, adLockBatchOptimistic
    
  i = 0
  
  ' If tabell is non-empty then point to first record else create "false"
  ' record to prevent errors
  If tabell.EOF = False Then
    tabell.MoveFirst
  Else
    ReDim parm_scalefactor(1 To 1)
    parm_scalefactor(1).name = "false record"
  End If
  
  Do While tabell.EOF = False
    i = i + 1
    ReDim Preserve parm_scalefactor(1 To i)
    parm_scalefactor(i).name = tabell("Name")
    parm_scalefactor(i).time_from = tabell("From")
    parm_scalefactor(i).time_to = tabell("To")
    parm_scalefactor(i).scalefactor = tabell("Value")
    parm_scalefactor(i).active = tabell("On")
    tabell.MoveNext
    If param_to_log = 1 Then
        Printdok (parm_scalefactor(i).name & " ative from " & parm_scalefactor(i).time_from & _
        " to " & parm_scalefactor(i).time_to & " Value: " & parm_scalefactor(i).scalefactor & _
        " On: " & parm_scalefactor(i).active)
    End If
  Loop
  If param_to_log = 1 Then Printdok ("************* End of scaleparams *******************")
End Sub



Public Function get_scalefactor(name)
  Dim i As Integer, year As Integer
  
  year = base_year + model_time
  get_scalefactor = 1#
    
  For i = 1 To UBound(parm_scalefactor)
    If parm_scalefactor(i).active = 1 And _
       LCase(parm_scalefactor(i).name) = LCase(name) And _
       parm_scalefactor(i).time_from <= year And _
       parm_scalefactor(i).time_to >= year Then
         get_scalefactor = parm_scalefactor(i).scalefactor
       End If
  Next
  
End Function



Public Function get_scalefactor_active(name)
  Dim i As Integer, year As Integer
  year = base_year + model_time
  get_scalefactor_active = 0#
    
  For i = 1 To UBound(parm_scalefactor)
    If LCase(parm_scalefactor(i).name) = LCase(name) And _
       parm_scalefactor(i).time_from <= year And _
       parm_scalefactor(i).time_to >= year Then
         get_scalefactor_active = parm_scalefactor(i).active
    End If
  Next
End Function