VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.UserControl HR 
   ClientHeight    =   9390
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   12450
   ScaleHeight     =   9390
   ScaleWidth      =   12450
   Begin VB.Frame fra_Emp 
      Caption         =   "#Employee"
      Height          =   8775
      Left            =   840
      TabIndex        =   8
      Tag             =   "fra_Emp"
      Top             =   120
      Visible         =   0   'False
      Width           =   12135
      Begin Project1.ArmCombobox cbo_MovementType 
         Height          =   345
         Left            =   120
         TabIndex        =   29
         Top             =   1320
         Width           =   8055
         _ExtentX        =   14208
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_ITEuStatus 
         Height          =   345
         Left            =   120
         TabIndex        =   27
         Top             =   4200
         Width           =   4935
         _ExtentX        =   8705
         _ExtentY        =   609
      End
      Begin Project1.A_calocx cal_ChangeDate 
         Height          =   375
         Left            =   8280
         TabIndex        =   26
         Top             =   1320
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin Project1.ToolbarControl tlb_Record 
         Height          =   690
         Left            =   120
         TabIndex        =   25
         Top             =   240
         Width           =   11895
         _ExtentX        =   20981
         _ExtentY        =   1217
      End
      Begin VB.TextBox txt_Spare3 
         Height          =   375
         Left            =   8040
         TabIndex        =   21
         Top             =   1920
         Visible         =   0   'False
         Width           =   495
      End
      Begin VB.TextBox txt_Spare2 
         Height          =   375
         Left            =   7440
         TabIndex        =   20
         Top             =   1920
         Visible         =   0   'False
         Width           =   495
      End
      Begin VB.TextBox txt_Spare1 
         Height          =   375
         Left            =   6840
         TabIndex        =   19
         Top             =   1920
         Visible         =   0   'False
         Width           =   495
      End
      Begin VB.TextBox txt_UCode 
         Height          =   375
         Left            =   120
         MaxLength       =   10
         TabIndex        =   6
         Top             =   7440
         Width           =   2535
      End
      Begin VB.TextBox txt_HRComment 
         Height          =   1215
         Left            =   120
         MaxLength       =   1000
         TabIndex        =   3
         Top             =   2640
         Width           =   9975
      End
      Begin VB.TextBox txt_Location 
         Height          =   375
         Left            =   2760
         MaxLength       =   200
         TabIndex        =   7
         Top             =   7440
         Width           =   7335
      End
      Begin VB.TextBox txt_Name 
         Height          =   375
         Left            =   120
         MaxLength       =   50
         TabIndex        =   1
         Tag             =   "txt_Name"
         Top             =   1920
         Width           =   3495
      End
      Begin VB.TextBox txt_Surname 
         Height          =   375
         Left            =   3720
         MaxLength       =   50
         TabIndex        =   2
         Tag             =   "txt_Surname"
         Top             =   1920
         Width           =   6375
      End
      Begin VB.TextBox txt_ITEuComment 
         Height          =   2175
         Left            =   120
         MaxLength       =   1000
         MultiLine       =   -1  'True
         TabIndex        =   4
         Top             =   4920
         Width           =   4935
      End
      Begin VB.TextBox txt_ITLocComment 
         Height          =   2175
         Left            =   5160
         MaxLength       =   1000
         MultiLine       =   -1  'True
         TabIndex        =   5
         Top             =   4920
         Width           =   4935
      End
      Begin Project1.ArmCombobox cbo_ITLocStatus 
         Height          =   345
         Left            =   5160
         TabIndex        =   28
         Top             =   4200
         Width           =   4935
         _ExtentX        =   8705
         _ExtentY        =   609
      End
      Begin VB.Label lbl_Location 
         Caption         =   "#Location"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   2760
         TabIndex        =   22
         Tag             =   "lbl_Location"
         Top             =   7200
         Width           =   3135
      End
      Begin VB.Label lbl_UCode 
         Caption         =   "#User Code"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Tag             =   "lbl_UCode"
         Top             =   7200
         Width           =   1215
      End
      Begin VB.Label lbl_HRComment 
         Caption         =   "#HR Comment"
         Height          =   255
         Left            =   120
         TabIndex        =   17
         Tag             =   "lbl_HRComment"
         Top             =   2400
         Width           =   2895
      End
      Begin VB.Label lbl_MovementType 
         Caption         =   "#Movement Type"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Tag             =   "lbl_MovementType"
         Top             =   1080
         Width           =   3135
      End
      Begin VB.Label lbl_Validity 
         Caption         =   "#Validity"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   8400
         TabIndex        =   15
         Tag             =   "lbl_Validity"
         Top             =   1080
         Width           =   1095
      End
      Begin VB.Label lbl_Name 
         Caption         =   "#Name"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Tag             =   "lbl_Name"
         Top             =   1680
         Width           =   1575
      End
      Begin VB.Label lbl_Surname 
         Caption         =   "#Surname"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   3720
         TabIndex        =   13
         Tag             =   "lbl_Surname"
         Top             =   1680
         Width           =   1815
      End
      Begin VB.Label lbl_ITEuStatus 
         Caption         =   "#IT Europe Status"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Tag             =   "lbl_ITEuStatus"
         Top             =   3960
         Width           =   4335
      End
      Begin VB.Label lbl_ITLocStatus 
         Caption         =   "#IT Local Status"
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   5160
         TabIndex        =   11
         Tag             =   "lbl_ITLocStatus"
         Top             =   3960
         Width           =   4455
      End
      Begin VB.Label lbl_ITEuComment 
         Caption         =   "#Comment"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Tag             =   "lbl_ITEuComment"
         Top             =   4680
         Width           =   4335
      End
      Begin VB.Label lbl_ITLocComment 
         Caption         =   "#Comment"
         Height          =   255
         Left            =   5160
         TabIndex        =   9
         Tag             =   "lbl_ITLocComment"
         Top             =   4680
         Width           =   4455
      End
   End
   Begin VB.Frame fra_EMMain 
      Height          =   8775
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   12135
      Begin Project1.ArmGrid grd_Employees 
         Height          =   7575
         Left            =   120
         TabIndex        =   30
         Top             =   1080
         Width           =   11775
         _ExtentX        =   20770
         _ExtentY        =   13361
      End
      Begin Project1.ToolbarControl tlb_EMTasks 
         Height          =   690
         Left            =   120
         TabIndex        =   24
         Top             =   240
         Width           =   11775
         _ExtentX        =   20770
         _ExtentY        =   1217
      End
   End
   Begin MSComctlLib.TabStrip tbs_HumRes 
      Height          =   375
      Left            =   120
      TabIndex        =   23
      Top             =   8880
      Width           =   12135
      _ExtentX        =   21405
      _ExtentY        =   661
      Placement       =   1
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   1
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Employees Movement"
            Key             =   "tbs_empmov"
            Object.Tag             =   "tbs_empmov"
            ImageVarType    =   2
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "HR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Public Event quit()
Private Enum ArrEmpMovScr
    HrEmMain
    HrEmDet
    HrEmAdd
    HrEmEdit
    HrEmITUpdate
    HrEmRem
End Enum


Private me_EmplMovActiveScr As ArrEmpMovScr
Private ml_CurrEditedID As Long
Private ml_CurrIConcurrency As Long
Private ml_UserCode As Long

#If LIVE Then
    Dim mo_Db As Object
#Else
    Private mo_Db As ARMSYSCOMLib.ArmDb         ' ArmSysCom Library object
#End If


Private ms_LanguageCode As String           ' Language code

Private Const SEP As String = "®©"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F

Private Const MSG_WARNING As Long = 1
Private Const MSG_ERROR As Long = 2
Private Const MSG_INFO As Long = 3


Private Const SIFYB_HR_ERROR_MESSAGE = 2000
Private Const SIFYB_HR_A_REFERENCE = 2000


Private Enum ErrMsg
        ErrMsgNone = 0
        ErrMsgMandatoryAreEmpty = SIFYB_HR_ERROR_MESSAGE + 1
        WarMsgDoYouRemove = SIFYB_HR_ERROR_MESSAGE + 2
        ErrMsgIConcurency = SIFYB_HR_ERROR_MESSAGE + 3
        WarMsgSelectRow = SIFYB_HR_ERROR_MESSAGE + 4
        ErrMsgNumericRequired = SIFYB_HR_ERROR_MESSAGE + 5
End Enum


Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
End Enum

' User code used in logs
Public Property Let U_Code(ByVal al_UserCode As Long)
    ml_UserCode = al_UserCode
End Property

' User code used in logs
Public Property Get U_Code() As Long
    U_Code = ml_UserCode
End Property

' Set Employees Movement screen
' ae_Screen (ArrEmpMovScr)
Private Property Let EmplMovActiveScreen(ByVal ae_Screen As ArrEmpMovScr)
On Error GoTo ErrHandler
    me_EmplMovActiveScr = ae_Screen
    Call fra_Emp.Move(0, 0, Width, UserControl.Height - tbs_HumRes.Height)
    Call fra_EMMain.Move(0, 0, Width, UserControl.Height - tbs_HumRes.Height)
    Call tbs_HumRes.Move(0, UserControl.Height - tbs_HumRes.Height, UserControl.Width)
    Select Case ae_Screen
        Case HrEmAdd, HrEmEdit, HrEmITUpdate
            tlb_Record.DisplayFace "0"
            fra_Emp.Visible = True
            fra_EMMain.Visible = False
        Case HrEmDet
            tlb_Record.DisplayFace "1"
            fra_Emp.Visible = True
            fra_EMMain.Visible = False
        Case HrEmRem
            tlb_Record.DisplayFace "2"
            fra_Emp.Visible = True
            fra_EMMain.Visible = False
        Case HrEmMain
            fra_EMMain.Visible = True
            fra_Emp.Visible = False
    End Select
    
    SetControlsState ae_Screen
        
    Exit Property
ErrHandler:
     Call ErrorHandler("SfbHumRes.EmplMovActiveScreen")
End Property

' Get Employees Movement screen
Private Property Get EmplMovActiveScreen() As ArrEmpMovScr
'<EhHeader>
On Error GoTo ErrHandler
'</EhHeader>
    EmplMovActiveScreen = me_EmplMovActiveScr
    '<EhFooter>
    Exit Property
ErrHandler:
     Call ErrorHandler("SfbHumRes.EmplMovActiveScreen")
    '</EhFooter>
End Property



' database controler property
' Params:
' ao_db (ARMSYSCOMLib.ArmDb) - ArmSysCom instance
#If LIVE Then
Public Property Set ArmDb(ByRef ao_DB As Object)
#Else
Public Property Set ArmDb(ByRef ao_DB As ARMSYSCOMLib.ArmDb)
#End If

On Error GoTo ErrHandler
    If Not mo_Db Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_DB Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_Db = ao_DB
    
    Exit Property
ErrHandler:
    Call ErrorHandler("ArmDb(Set)")
End Property

Public Property Get Language_Code() As String
    Language_Code = ms_LanguageCode
End Property

Public Property Let Language_Code(ByVal as_newValue As String)
On Error GoTo ErrHandler
    ms_LanguageCode = as_newValue
    cal_ChangeDate.Language = as_newValue
    tlb_EMTasks.Language = as_newValue
    tlb_Record.Language = as_newValue
    
    
    Exit Property
ErrHandler:
     Call ErrorHandler("SfbHumRes.Language_Code")
End Property

Private Function LoadToolbars() As Boolean
On Error GoTo ErrHandler
    
    Const CL_REQUEST_TB As String = "SELECT Toolbar_Info FROM Toolbars_Users WHERE User_Code=$user_id$ AND App_Id=$App_Id$"
    Dim lc_Toolbar As Long
    Dim ls_ToolbarRequest As String, ls_ToolbarInfo As String

    ls_ToolbarRequest = Replace(CL_REQUEST_TB, "$user_id$", 0)
    ls_ToolbarRequest = Replace(ls_ToolbarRequest, "$App_Id$", 1)
    lc_Toolbar = OpenSQLSafe(mo_Db, ls_ToolbarRequest)
    ls_ToolbarInfo = mo_Db.GetFields(lc_Toolbar, "Toolbar_info")
    
    ' init toolbar
    Set tlb_Record.ArmDb = mo_Db
    tlb_Record.Load_A_Com
    Call tlb_Record.SetToolbarInfoStringParameters(ls_ToolbarInfo, "082")
    Call tlb_Record.DisplayFace("0")
    
    ' init employees movement tasks toolbar
    Set tlb_EMTasks.ArmDb = mo_Db
    tlb_EMTasks.Load_A_Com
    Call tlb_EMTasks.SetToolbarInfoStringParameters(ls_ToolbarInfo, "083")
    Call tlb_EMTasks.DisplayFace("0")
    
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = True
    Exit Function
ErrHandler:
    Call mo_Db.Close(lc_Toolbar)
    LoadToolbars = False
    Call ErrorHandler("LoadToolbars()")
End Function

' initalive user control
Public Function Load_A_Com()
On Error GoTo ErrHandler
    
    Load_A_Com = False
    EmplMovActiveScreen = HrEmMain
    
    ' init employees grid
    grd_Employees.Load_A_Com
    Set grd_Employees.ArmDb = mo_Db
    
    grd_Employees.MultiSelect = False

    grd_Employees.SetColumns (Array( _
        Join(Array("HRE_code", 0, 1, "HRE_code", "#Code"), SEP), _
        Join(Array("HRE_location", 2000, 0, "HRE_location", "#Location"), SEP), _
        Join(Array("HRE_validity_date", 1000, 0, "HRE_validity_date", "#Validity"), SEP), _
        Join(Array("HRE_name", 1500, 0, "HRE_name", "#Name"), SEP), _
        Join(Array("HRE_surname", 2000, 0, "HRE_surname", "#Surname"), SEP), _
        Join(Array("HRE_it_eu_status_desc", 2500, 0, "HRE_it_eu_status_desc", "#ITEuStatus"), SEP), _
        Join(Array("HRE_it_loc_status_desc", 2500, 0, "HRE_it_loc_status_desc", "#ITLocStatus"), SEP)))
    
    ' init change calendar
    cal_ChangeDate.reinit_cal
    cal_ChangeDate.date_courte = Format(Now, "dd\/mm\/yyyy")
    
    ' init eu status combo box
    Set cbo_ITEuStatus.ArmDb = mo_Db
    cbo_ITEuStatus.Load_A_Com
    cbo_ITEuStatus.FirstBlankItem = False
    cbo_ITEuStatus.Request = "A_Referencies_Cus_lst " & SIFYB_HR_A_REFERENCE + 1 & " , NULL"
                    
    ' init local status combo box
    Set cbo_ITLocStatus.ArmDb = mo_Db
    cbo_ITLocStatus.Load_A_Com
    cbo_ITLocStatus.FirstBlankItem = False
    cbo_ITLocStatus.Request = "A_Referencies_Cus_lst " & SIFYB_HR_A_REFERENCE + 2 & " , NULL"
    
    ' init movement type combo box
    Set cbo_MovementType.ArmDb = mo_Db
    cbo_MovementType.Load_A_Com
    cbo_MovementType.FirstBlankItem = False
    cbo_MovementType.Request = "A_Referencies_Cus_lst " & SIFYB_HR_A_REFERENCE + 3 & " , NULL"
    
    
    Call LoadToolbars
    
    Call LoadLabels(mo_Db, UserControl.Controls, "hum_res", ms_LanguageCode)
    
    ' loads data to grid
    Call LoadGrid
    Load_A_Com = True
    Exit Function
ErrHandler:
     Call ErrorHandler("SfbHumRes.Load_A_COM")
End Function

' unload variables, uninitialize component
Public Sub Unload_A_Com()
On Error GoTo ErrHandler
    
    grd_Employees.Unload_A_Com
    cbo_ITEuStatus.Unload_A_Com
    cbo_ITLocStatus.Unload_A_Com
    cbo_MovementType.Unload_A_Com
    tlb_EMTasks.Unload_A_Com
    tlb_Record.Unload_A_Com
    
    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.Unload_A_COM")
End Sub

' Validate form (check for empty required fields etc.)
Private Function ValidateForm() As ErrMsg
On Error GoTo ErrHandler
    

    If cal_ChangeDate.date_dt = 0 Then
        ValidateForm = ErrMsgMandatoryAreEmpty
        cal_ChangeDate.SetFocus
        Exit Function
    End If
     
    
    
    Select Case EmplMovActiveScreen
    
        Case HrEmAdd, HrEmEdit
            If cbo_MovementType.SelectedItem Is Nothing Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                cbo_MovementType.SetFocus
                Exit Function
            End If
            If Txt_name.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                Txt_name.SetFocus
                Exit Function
            End If
            If txt_Surname.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_Surname.SetFocus
                Exit Function
            End If
            If txt_Location.Text = "" Then
                ValidateForm = ErrMsgMandatoryAreEmpty
                txt_Location.SetFocus
                Exit Function
            End If
    
        Case HrEmITUpdate
            If Not isNumeric(txt_ucode.Text) And Not txt_ucode.Text = "" Then
                ValidateForm = ErrMsgNumericRequired
                txt_ucode.SetFocus
                Exit Function
            End If
    End Select
   
    ValidateForm = ErrMsgNone
    
    Exit Function
ErrHandler:
    ValidateForm = ErrMsgNone
    Call ErrorHandler("SfbHumRes.ValidateForm")
End Function


' Clears Form
Private Sub ClearForm()
On Error GoTo ErrHandler
    txt_HRComment.Text = ""
    txt_ITEuComment.Text = ""
    txt_ITLocComment.Text = ""
    txt_Location.Text = ""
    Txt_name.Text = ""
    txt_spare1.Text = ""
    txt_spare2.Text = ""
    txt_spare3.Text = ""
    txt_Surname.Text = ""
    txt_ucode.Text = ""
    
    
    Set cbo_ITEuStatus.SelectedItem = Nothing
    Set cbo_ITLocStatus.SelectedItem = Nothing
    Set cbo_MovementType.SelectedItem = Nothing
    
    cal_ChangeDate.date_courte = Format(Now, "dd\/mm\/yyyy")

    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.ClearForm")
End Sub

' Restores first record values
Private Sub EmplMovRestoreRerord()
On Error GoTo ErrHandler
    Select Case EmplMovActiveScreen
    
        Case HrEmAdd ' Clears controls
            ClearForm
        Case HrEmEdit, HrEmITUpdate ' Loads first values
            ClearForm
            LoadToForm grd_Employees.SelectedKey(0)(0)
    End Select
    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.EmplMovRestoreRerord")
End Sub


' Cancels typing of record
Private Sub EmplMovCancelRecord()
On Error GoTo ErrHandler
    EmplMovActiveScreen = HrEmMain
    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.EmplMovCancelRecord")
End Sub

' Removes record from database
Private Sub EmplMovRemoveRecord()
Dim ls_SQL As String

On Error GoTo ErrHandler
    If ASC_SendMessage(ms_LanguageCode, WarMsgDoYouRemove, "#Do you want to remove selected record ?", , vbYesNo) = vbYes Then
        ls_SQL = "hr_emplmovement_del $Code$, $UserCode$, $IConc$"
        ls_SQL = Replace(ls_SQL, "$Code$", ml_CurrEditedID)
        ls_SQL = Replace(ls_SQL, "$UserCode$", ml_UserCode)
        ls_SQL = Replace(ls_SQL, "$IConc$", ml_CurrIConcurrency)
        ExecuteSQLSafe mo_Db, ls_SQL, 1
        UpdateGrid
    End If
    fra_EMMain.Visible = True
    fra_Emp.Visible = False
    EmplMovActiveScreen = HrEmMain
    
    Exit Sub
ErrHandler:
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded."
        EmplMovRestoreRerord
        LoadGrid
        Exit Sub
    End If
    Call ErrorHandler("SfbHumRes.EmplMovRemoveRecord")
End Sub


' store redord to databaze
Private Sub EmplMovStoreRecord()
On Error GoTo ErrHandler
    Dim le_Msg As ErrMsg
    le_Msg = ValidateForm()
    Select Case le_Msg
        Case ErrMsgNumericRequired
            ASC_SendMessage ms_LanguageCode, ErrMsgNumericRequired, "#Number required."
            Exit Sub
        Case ErrMsgMandatoryAreEmpty
            ASC_SendMessage ms_LanguageCode, ErrMsgMandatoryAreEmpty, "#Mandatory fields are not filled."
            Exit Sub
    End Select
    
    Select Case EmplMovActiveScreen
        Case HrEmAdd
            ml_CurrEditedID = SaveNewForm
        Case HrEmEdit, HrEmITUpdate
            ml_CurrEditedID = UpdateForm
    End Select
    
    UpdateGrid
    EmplMovActiveScreen = HrEmMain

    Exit Sub
ErrHandler:
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        ASC_SendMessage ms_LanguageCode, ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded."
        EmplMovRestoreRerord
        
        Exit Sub
    End If

     Call ErrorHandler("SfbHumRes.EmplMovStoreRecord")
End Sub

' Sets controls state
Private Sub SetControlsState(ByVal ae_Screen As ArrEmpMovScr)
On Error GoTo ErrHandler
    Select Case ae_Screen
    
        Case HrEmDet, HrEmRem
            
            txt_HRComment.Enabled = False
            txt_ITLocComment.Enabled = False
            txt_ucode.Enabled = False
            Txt_name.Enabled = False
            txt_Surname.Enabled = False
            txt_Location.Enabled = False
            txt_ITEuComment.Enabled = False
            
            txt_HRComment.BackColor = CL_COLOR_DISABLED
            txt_ITEuComment.BackColor = CL_COLOR_DISABLED
            txt_ITLocComment.BackColor = CL_COLOR_DISABLED
            txt_ucode.BackColor = CL_COLOR_DISABLED
            Txt_name.BackColor = CL_COLOR_DISABLED
            txt_Surname.BackColor = CL_COLOR_DISABLED
            txt_Location.BackColor = CL_COLOR_DISABLED
            
            cbo_ITEuStatus.Enabled = False
            cbo_ITLocStatus.Enabled = False
            cbo_MovementType.Enabled = False
            cal_ChangeDate.Enabled = False
        Case HrEmAdd, HrEmEdit
            txt_HRComment.Enabled = True
            txt_ITLocComment.Enabled = False
            txt_ucode.Enabled = False
            Txt_name.Enabled = True
            txt_Surname.Enabled = True
            txt_Location.Enabled = True
            txt_ITEuComment.Enabled = False
            
            txt_HRComment.BackColor = CL_COLOR_ENABLED
            txt_ITEuComment.BackColor = CL_COLOR_DISABLED
            txt_ITLocComment.BackColor = CL_COLOR_DISABLED
            txt_ucode.BackColor = CL_COLOR_DISABLED
            Txt_name.BackColor = CL_COLOR_ENABLED
            txt_Surname.BackColor = CL_COLOR_ENABLED
            txt_Location.BackColor = CL_COLOR_ENABLED
            
            cbo_ITEuStatus.Enabled = False
            cbo_ITLocStatus.Enabled = False
            cbo_MovementType.Enabled = True
            cal_ChangeDate.Enabled = True
        Case HrEmITUpdate
            txt_ucode.Enabled = True
            txt_HRComment.Enabled = False
            txt_Location.Enabled = False
            txt_ITEuComment.Enabled = True
            txt_ITLocComment.Enabled = True
            Txt_name.Enabled = False
            txt_Surname.Enabled = False
            cbo_ITEuStatus.Enabled = True
            cbo_ITLocStatus.Enabled = True
            cbo_MovementType.Enabled = False
            cal_ChangeDate.Enabled = True
            
            Txt_name.BackColor = CL_COLOR_DISABLED
            txt_Surname.BackColor = CL_COLOR_DISABLED
            txt_Location.BackColor = CL_COLOR_DISABLED
            txt_HRComment.BackColor = CL_COLOR_DISABLED
            txt_ITEuComment.BackColor = CL_COLOR_ENABLED
            txt_ITLocComment.BackColor = CL_COLOR_ENABLED
            txt_ucode.BackColor = CL_COLOR_ENABLED
        
    End Select
    
    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.SetControlsState")
End Sub


' Shows detail of record
Private Sub grd_Employees_ItemSelected()
On Error GoTo ErrHandler
    Screen.MousePointer = vbHourglass
    EmplMovActiveScreen = HrEmDet
    ' clear form
    ClearForm
    ' and loads values
    LoadToForm grd_Employees.SelectedKey(0)(0)
    Screen.MousePointer = vbDefault
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("SfbHumRes.grd_Employees_ItemSelected")
End Sub

' Process toolbar click
' Params:
' as_Role (String)
' as_Language (String)
Private Sub tlb_EMTasks_Action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    If (as_Role = "B" Or as_Role = "C" Or as_Role = "D") And grd_Employees.SelectedCount = 0 Then
        ASC_SendMessage ms_LanguageCode, WarMsgSelectRow, "#Please select a row."
    Else
        Screen.MousePointer = vbHourglass
        Select Case as_Role
            Case "A" ' add new record
                EmplMovActiveScreen = HrEmAdd
                ClearForm ' clear form
            Case "B" ' edit selected record
                EmplMovActiveScreen = HrEmEdit
                ClearForm ' clears controls in form
                ' loads data of selected record to controls
                LoadToForm grd_Employees.SelectedKey(0)(0)
            Case "C" ' remove seleced record
                EmplMovActiveScreen = HrEmRem
                ClearForm   ' clear form
                LoadToForm grd_Employees.SelectedKey(0)(0) ' and loads values
            Case "D" 'Let "IT Support" do some comment
                EmplMovActiveScreen = HrEmITUpdate
                ClearForm            ' clears controls in form
                ' loads data of selected record to controls
                LoadToForm grd_Employees.SelectedKey(0)(0)
            Case "E" ' reloads data to grid
                LoadGrid
            Case "T" ' TERMINATE / EXIT / CLOSE
                RaiseEvent quit
        End Select
        Screen.MousePointer = vbDefault
    End If
    
    
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("SfbHumRes.tlb_EMTasks_Action")
End Sub

' Loads data to grid
Private Sub LoadGrid()
On Error GoTo ErrHandler
    grd_Employees.Load "HR_Emplmovement_lst " & (SIFYB_HR_A_REFERENCE + 1) & ", " & (SIFYB_HR_A_REFERENCE + 2), False
    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.LoadGrid")
End Sub


' Loads data from database to form
' Params:
' al_Key (Long)
Private Function LoadToForm(ByVal al_Key As Long) As Boolean
On Error GoTo ErrHandler
    
    Dim lc_Cursor As Long
    lc_Cursor = OpenSQLSafe(mo_Db, "hr_EmplMovement_sel " & al_Key & ", " & (SIFYB_HR_A_REFERENCE + 1) & ", " & (SIFYB_HR_A_REFERENCE + 2) & ", " & (SIFYB_HR_A_REFERENCE + 3), 1)
       
    ' store id and iconcurrency couter for update
    ml_CurrEditedID = mo_Db.GetFields(lc_Cursor, "HRE_code")
    ml_CurrIConcurrency = mo_Db.GetFields(lc_Cursor, "iConcurrency")
        
    ' setup combo boxes
    SetComboBoxText cbo_ITEuStatus, mo_Db.GetFields(lc_Cursor, "HRE_it_eu_status"), mo_Db.GetFields(lc_Cursor, "HRE_it_eu_status_desc")
    SetComboBoxText cbo_ITLocStatus, mo_Db.GetFields(lc_Cursor, "HRE_it_loc_status"), mo_Db.GetFields(lc_Cursor, "HRE_it_loc_status_desc")
    SetComboBoxText cbo_MovementType, mo_Db.GetFields(lc_Cursor, "HRE_mov_type"), mo_Db.GetFields(lc_Cursor, "HRE_mov_type_desc")
    
    ' setup textboxes
    txt_Location.Text = mo_Db.GetFields(lc_Cursor, "HRE_location")
    Txt_name.Text = mo_Db.GetFields(lc_Cursor, "HRE_name")
    txt_Surname.Text = mo_Db.GetFields(lc_Cursor, "HRE_surname")
    txt_HRComment.Text = mo_Db.GetFields(lc_Cursor, "HRE_hr_memo")
    txt_ITEuComment.Text = mo_Db.GetFields(lc_Cursor, "HRE_it_eu_comment")
    txt_ITLocComment.Text = mo_Db.GetFields(lc_Cursor, "HRE_it_loc_comment")
    txt_ucode.Text = IIf(mo_Db.GetFields(lc_Cursor, "HRE_u_code") = 0, "", mo_Db.GetFields(lc_Cursor, "HRE_u_code"))
    txt_spare1.Text = mo_Db.GetFields(lc_Cursor, "HRE_Spare1")
    txt_spare2.Text = mo_Db.GetFields(lc_Cursor, "HRE_Spare2")
    txt_spare3.Text = mo_Db.GetFields(lc_Cursor, "HRE_Spare3")
    
    ' setup calendar
    cal_ChangeDate.reinit_cal
    cal_ChangeDate.date_courte = Format(mo_Db.GetFields(lc_Cursor, "HRE_validity_date"), "dd\/mm\/yyyy")
      
    ' closes opened cursor
    mo_Db.Close lc_Cursor
    
    Exit Function
ErrHandler:
    If lc_Cursor <> 0 Then mo_Db.Close lc_Cursor
     Call ErrorHandler("SfbHumRes.LoadToForm")
End Function

' Saves new form to database
Private Function SaveNewForm() As Long
On Error GoTo ErrHandler
    
    SaveNewForm = 0
    ' retrieve new id
    Dim ls_ID As String
    ls_ID = mo_Db.SQLNextID("HR_EMPMOV")
    If ls_ID = "" Then
        Err.Raise vbObjectError + 514, Err.Source, "SQLNextID failed for DCM_LOG"
    End If
        
    Dim ls_SQL As String
    
    ls_SQL = "hr_emplmovement_ins $Code$, $MovType$, $ChangeDate$, $Location$, $Name$, $Surname$, $HRComment$, NULL, NULL, NULL, NULL, NULL, $UserCode$, NULL, NULL, NULL"
    
    ls_SQL = Replace(ls_SQL, "$Code$", ls_ID)
    ls_SQL = Replace(ls_SQL, "$MovType$", cbo_MovementType.SelectedItem.Key)
    ls_SQL = Replace(ls_SQL, "$ChangeDate$", SQLDateTime(cal_ChangeDate.date_dt))
    ls_SQL = Replace(ls_SQL, "$Location$", SQLStr(txt_Location.Text))
    ls_SQL = Replace(ls_SQL, "$Name$", SQLStr(Txt_name.Text))
    ls_SQL = Replace(ls_SQL, "$Surname$", SQLStr(txt_Surname.Text))
    ls_SQL = Replace(ls_SQL, "$HRComment$", SQLStr(txt_HRComment.Text, True))
    ls_SQL = Replace(ls_SQL, "$UserCode$", ml_UserCode)

    
    ExecuteSQLSafe mo_Db, ls_SQL, 1

    SaveNewForm = ls_ID
    Exit Function
ErrHandler:
    SaveNewForm = 0
    Call ErrorHandler("SfbHumRes.SaveNewForm")
End Function


' Update form to database
' Params:
'
Private Function UpdateForm() As Long
On Error GoTo ErrHandler
    UpdateForm = 0
    Dim ls_Pom1 As String, ls_Pom2 As String, ls_Pom3 As String
    
    If cbo_ITEuStatus.SelectedItem Is Nothing Then
        ls_Pom1 = "NULL"
    Else
        ls_Pom1 = cbo_ITEuStatus.SelectedItem.Key
    End If
         
    If cbo_ITLocStatus.SelectedItem Is Nothing Then
        ls_Pom2 = "NULL"
    Else
        ls_Pom2 = cbo_ITLocStatus.SelectedItem.Key
    End If
     
    
    
    If txt_ucode.Text = "" Then
        ls_Pom3 = "NULL"
    Else
        ls_Pom3 = txt_ucode.Text
    End If
     
     
    Dim ls_SQL As String
    
    ls_SQL = "hr_emplmovement_upd $Code$, $MovType$, $ChangeDate$, $Location$, $Name$, $Surname$, $HRComment$, $ITEuStatus$, $ITEuComment$, $ITLocStatus$, $ITLocComment$, $UCode$, $Spare1$, $Spare2$, $Spare3$, $UserCode$, $IConc$"
    
    ls_SQL = Replace(ls_SQL, "$Code$", ml_CurrEditedID)
    ls_SQL = Replace(ls_SQL, "$MovType$", cbo_MovementType.SelectedItem.Key)
    ls_SQL = Replace(ls_SQL, "$ChangeDate$", SQLDateTime(cal_ChangeDate.date_dt))
    ls_SQL = Replace(ls_SQL, "$Location$", SQLStr(txt_Location.Text))
    ls_SQL = Replace(ls_SQL, "$Name$", SQLStr(Txt_name.Text))
    ls_SQL = Replace(ls_SQL, "$Surname$", SQLStr(txt_Surname.Text))
    ls_SQL = Replace(ls_SQL, "$HRComment$", SQLStr(txt_HRComment.Text, True))
    ls_SQL = Replace(ls_SQL, "$ITEuStatus$", ls_Pom1)
    ls_SQL = Replace(ls_SQL, "$ITEuComment$", SQLStr(txt_ITEuComment.Text, True))
    ls_SQL = Replace(ls_SQL, "$ITLocStatus$", ls_Pom2)
    ls_SQL = Replace(ls_SQL, "$ITLocComment$", SQLStr(txt_ITLocComment.Text, True))
    ls_SQL = Replace(ls_SQL, "$UCode$", ls_Pom3)
    ls_SQL = Replace(ls_SQL, "$Spare1$", SQLStr(txt_spare1.Text, True))
    ls_SQL = Replace(ls_SQL, "$Spare2$", SQLStr(txt_spare2.Text, True))
    ls_SQL = Replace(ls_SQL, "$Spare3$", SQLStr(txt_spare3.Text, True))
    ls_SQL = Replace(ls_SQL, "$UserCode$", ml_UserCode)
    ls_SQL = Replace(ls_SQL, "$IConc$", ml_CurrIConcurrency)

    ExecuteSQLSafe mo_Db, ls_SQL, 1
    UpdateForm = ml_CurrEditedID
    
    Exit Function
ErrHandler:
    
    UpdateForm = 0
    Call ErrorHandler("SfbHumRes.UpdateForm")
End Function



' updates grid after add, update, del
Private Sub UpdateGrid()
On Error GoTo ErrHandler
    Select Case EmplMovActiveScreen
        Case HrEmEdit, HrEmITUpdate
            ' find line to be updated
            If grd_Employees.SearchKey(True, ml_CurrEditedID) Then
              ' update line
              grd_Employees.CurrentLine("HRE_location") = txt_Location.Text
              grd_Employees.CurrentLine("HRE_validity_date") = Format(cal_ChangeDate.date_dt, "dd\/mm\/yyyy")
              grd_Employees.CurrentLine("HRE_name") = Txt_name.Text
              grd_Employees.CurrentLine("HRE_surname") = txt_Surname.Text
              grd_Employees.CurrentLine("HRE_it_eu_status_desc") = cbo_ITEuStatus.Text
              grd_Employees.CurrentLine("HRE_it_loc_status_desc") = cbo_ITLocStatus.Text
            Else
              grd_Employees.InsertLine 0, Array(ml_CurrEditedID, txt_Location.Text, Format(cal_ChangeDate.date_dt, "dd\/mm\/yyyy"), Txt_name.Text, txt_Surname.Text, cbo_ITEuStatus.Text, cbo_ITLocStatus.Text)
              grd_Employees.Row = 0
            End If
        Case HrEmAdd
            grd_Employees.InsertLine 0, Array(ml_CurrEditedID, txt_Location.Text, Format(cal_ChangeDate.date_dt, "dd\/mm\/yyyy"), Txt_name.Text, txt_Surname.Text, cbo_ITEuStatus.Text, cbo_ITLocStatus.Text)
            grd_Employees.Row = 0
        Case HrEmRem
            Call grd_Employees.DeleteLine(ml_CurrEditedID)
    End Select
    
    DoEvents
    Exit Sub
ErrHandler:
     Call ErrorHandler("SfbHumRes.UpdateGrid")
End Sub




' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, as_Fct & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

' display standard error message
' Params:
' as_Fct (String) - Error CallStack
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_Pom As String
    ls_Pom = as_Fct & SEP1 & Err.Source & vbCrLf & Err.Description
    LogMessage Err.Number & ": " & Err.Description & SEP2 & as_Fct & SEP1 & Err.Source, MSG_ERROR
    MsgBox ls_Pom, , "Error message"
End Sub

' Load the labels of a containers
Private Sub LoadLabels(ByRef ao_Armdb As ArmDb, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String)
Dim lc_Labels As Long       ' The cursor of the labels
Dim lc_Control As Control   ' A control of the container
Dim li_Idx As Integer, li_Count As Integer
Dim li_Label As Integer      ' A label idx
Dim ls_Request As String
    
    On Error GoTo Trace_Err
    Screen.MousePointer = vbHourglass
    
    'Open "c:\ctrl.txt" For Output As #1

    ls_Request = "exec Screen_csts_secure '" & as_ScreenName & "','" & as_Language & "'"
    lc_Labels = OpenSQLSafe(ao_Armdb, ls_Request)
    
    If lc_Labels = 0 Then
        GoTo Trace_End
    End If
    
    On Error GoTo WithoutTag
    If ao_Container.Tag <> "" Then
        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", ao_Container.Tag, , 1)
        If li_Label >= 0 Then
            ao_Container.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
        End If
    End If
WithoutTag:
    
    On Error GoTo Trace_Err
    
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
            Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
                Dim lo_Tbs
                Set lo_Tbs = lc_Control ' Cast for use of intellisense
                li_Count = lo_Tbs.Tabs.Count
                For li_Idx = 1 To li_Count
                    If lo_Tbs.Tabs(li_Idx).Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Tbs.Tabs(li_Idx).Tag, , 1)
                        If li_Label >= 0 Then
                            lo_Tbs.Tabs(li_Idx).Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Next
                Set lo_Tbs = Nothing
            
            Case UCase("ListView") ' Component is a listview, we load the caption of each columns
                Dim lo_ListView As ListView
                Set lo_ListView = lc_Control
                li_Count = lo_ListView.ColumnHeaders.Count
                For li_Idx = 1 To li_Count
                    If lo_ListView.ColumnHeaders(li_Idx).Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_ListView.ColumnHeaders(li_Idx).Tag, , 1)
                        If li_Label >= 0 Then
                            lo_ListView.ColumnHeaders(li_Idx).Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Next
                Set lo_ListView = Nothing
        
            Case UCase("TextBox")  ' Component is a textbox
                Dim lo_TextBox As TextBox
                Set lo_TextBox = lc_Control
                If lo_TextBox.Tag <> "" Then
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_TextBox.Tag, , 1)
                    If li_Label >= 0 Then
                        lo_TextBox.Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
                Set lo_TextBox = Nothing
            
            Case UCase("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox"), UCase("OptionButton")
                If lc_Control.Tag <> "" Then
                    'Print #1, lc_Control.Tag & "," & lc_Control.Caption
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Tag, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
            Case UCase("ArmGrid")
                'Print #1, lc_Control.Tag & "," & lc_Control.GetConstants(ctColumns)
                'Print #1, lc_Control.Name & "," & lc_Control.Title
                li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Tag, , 1)
                If li_Label >= 0 Then
                  Call lc_Control.LoadConstants(ptStatic, ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT"), ctColumns)
                End If
                li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Name, , 1)
                If li_Label >= 0 Then
                  lc_Control.Title = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                End If
            Case UCase("Menu")
                If lc_Control.Name <> "" Then
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Name, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
        End Select
    Next
        
Trace_End:
    Call ao_Armdb.Close(lc_Labels)
    Screen.MousePointer = vbDefault
    'Close #1
    Exit Sub
    
Trace_Err:
    Call ao_Armdb.Close(lc_Labels)
    Screen.MousePointer = vbDefault
      
End Sub


' Display an error message
' Params:
' as_LG_Code (String)
' ai_MsgCode (Integer)
' as_MsgDefault (String)
' as_MsgCxt (String = "")
' Buttons (VbMsgBoxStyle = vbOKOnly)
Public Function ASC_SendMessage(ByVal as_LG_Code As String, ByVal ai_MsgCode As Integer, ByVal as_MsgDefault As String, Optional ByVal as_MsgCxt As String = "", Optional Buttons As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
Dim ls_Message As String
Dim ll_Mouse As Long

    On Error GoTo Trace_Err
    
    If mo_Db Is Nothing Then
        ls_Message = as_MsgDefault
    Else
        If mo_Db.IsConnected = False Then
            ls_Message = as_MsgDefault
        Else
            ls_Message = ASC_MsgText(as_LG_Code, ai_MsgCode, as_MsgDefault)
        End If
    End If
    ls_Message = ls_Message & vbCrLf & Trim(as_MsgCxt)
    ll_Mouse = Screen.MousePointer
    Screen.MousePointer = vbArrow
    ASC_SendMessage = MsgBox(ls_Message, Buttons)
    Screen.MousePointer = ll_Mouse
Trace_End:
    Exit Function
    
Trace_Err:
    ASC_SendMessage = vbAbort
End Function


' Get error text
' Params:
' as_LG_Code (String)
' ai_MsgID (Integer)
' as_MsgDefault (String = "")
Private Function ASC_MsgText(ByVal as_LG_Code As String, ByVal ai_MsgID As Integer, Optional ByVal as_MsgDefault As String = "")
Dim ls_Msg As String, ls_Request As String

    On Error GoTo Trace_Err
   
    ls_Request = "SELECT Message_Text FROM Error_Message WHERE Language_Code = '" & as_LG_Code & "' AND MsgID = " & ai_MsgID
    
    
    Dim lc_Msg  As Long
    lc_Msg = OpenSQLSafe(mo_Db, ls_Request, 1)
  
    
    ls_Msg = mo_Db.GetFields(lc_Msg, "MESSAGE_TEXT")
    mo_Db.Close lc_Msg
    ASC_MsgText = IIf(Len(ls_Msg) <> 0, ls_Msg, as_MsgDefault)
    Exit Function
Trace_Err:
    If Not lc_Msg = 0 Then
        mo_Db.Close lc_Msg
    End If
    ASC_MsgText = IIf(Len(ls_Msg) <> 0, ls_Msg, as_MsgDefault)
    
End Function


' tranlate date to sql format
' Params:
' ad_Date (Date)
Private Function SQLDateTime(ad_Date As Date) As String
On Error GoTo ErrHandler
  If ad_Date = 0 Then
    SQLDateTime = "Null"
  Else
    SQLDateTime = "{ ts '" & Format(ad_Date, "yyyy-mm-dd hh:mm:ss") & "'}"
  End If
    Exit Function
ErrHandler:
     Call ErrorHandler("SfbHumRes.SQLDateTime")
End Function

' translate string to sql format
' Params:
' as_Value (String)
' ab_EmptyNULL (Boolean = False)
Private Function SQLStr(ByVal as_Value As String, Optional ByVal ab_EmptyNULL As Boolean = False) As String
    If as_Value = "" And ab_EmptyNULL Then
        SQLStr = "NULL"
    Else
        SQLStr = "'" & Replace(as_Value, "'", "''") & "'"
    End If
End Function


' logs message to database
Private Sub LogMessage(ByVal as_Message As String, ByVal al_Type As Long)
On Error GoTo ErrHandler
    ExecuteSQLSafe mo_Db, "A_log_ins " & _
         ml_UserCode & ", " & _
         Choose(al_Type, "W", "E", "I") & ", " & _
         SQLStr(as_Message) & ", 'Human Resources'", 1
    Exit Sub
ErrHandler:
    MsgBox "SfbHumRes.LogMessage - " & Err.Number & ": " & Err.Description
End Sub



' Adds SQL Error messages to description
' Params:
' as_Desc (String)
Private Function AddSQLErrMsgsToDesc(ByVal as_Desc As String)
On Error GoTo ErrHandler
    Dim ls_PomCodes As String, ls_PomMessages As String
    GetErrorCodesAndErrorMessages ls_PomCodes, ls_PomMessages
    AddSQLErrMsgsToDesc = as_Desc & SEP2 & ls_PomCodes & SEP1 & ls_PomMessages
    Exit Function
ErrHandler:
     Call ErrorHandler("SfbHumRes.AddSQLErrMsgsToDesc")
End Function





Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
End Sub
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property


Private Sub GetErrorCodesAndErrorMessages(ByRef as_ErrorCodes As String, ByRef as_ErrorMessages As String, _
  Optional ByVal ab_Asynchronous As Boolean = False, Optional ByVal al_Cursor As Long = 0)
    Dim lv_SQLErrorCodes As Variant
    Dim lv_SQLErrorMessages As Variant

On Error GoTo ErrHandler:

    If Not (mo_Db Is Nothing) Then
      If ab_Asynchronous Then
          lv_SQLErrorCodes = mo_Db.SQLAsynchErrorCodes(al_Cursor)
          lv_SQLErrorMessages = mo_Db.SQLAsynchErrorMessages(al_Cursor)
      Else
          lv_SQLErrorCodes = mo_Db.SQLErrorCodes
          lv_SQLErrorMessages = mo_Db.SQLErrorMessages
      End If
      
      If IsArray(lv_SQLErrorCodes) Then
          as_ErrorCodes = Join(lv_SQLErrorCodes, ",")
          as_ErrorMessages = Join(lv_SQLErrorMessages, ",")
      Else
          as_ErrorCodes = ""
          as_ErrorMessages = ""
      End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("GetErrorCodesAndErrorMessages")
End Sub


' Do one of operations on record
' Params:
' as_Role (String)
' as_Language (String)

Private Sub tlb_Record_Action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler

    Screen.MousePointer = vbHourglass
    Select Case as_Role
        Case "A" ' save record
            EmplMovStoreRecord
        Case "B" ' restore start values
            EmplMovRestoreRerord
        Case "C" ' leaves record screen
            EmplMovCancelRecord
        Case "D" ' removes record
            EmplMovRemoveRecord
    End Select
    Screen.MousePointer = vbDefault
    Exit Sub
ErrHandler:
    Screen.MousePointer = vbDefault
    Call ErrorMessage("SfbHumRes.tlb_Record_Action")
End Sub

' Sets combobox selected item
' Params:
' ao_ComboBox (ArmCombobox)
' al_Key (Long)
' as_Request (String)
Private Sub SetComboBoxText(ByRef ao_ComboBox As ArmCombobox, ByVal al_Key As Long, ByVal as_Desc As String)
On Error GoTo ErrHandler
    If Not ao_ComboBox.SearchItem(al_Key) And Not al_Key = 0 Then
        ' key not found ... set value from parameter
        ao_ComboBox.AddItem Array(al_Key, as_Desc), True
            
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("SfbHumRes.SetControlText")
End Sub


    
    

' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If

On Error GoTo ErrHandler

    Dim lc_Data As Long
    lc_Data = ao_DB.OpenSQL(as_Request)
    
    If lc_Data = 0 Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_DB.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data

    Exit Function

ErrHandler:
    Call ErrorHandler("OpenSQLSafe")

End Function


' Execute a SQL request returning no data
' Convert SQL runtime errors and process errors to VB Error
' Params:
' ao_Db (Object)
' as_Request (String)
' al_RowAffectedCount (String)
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1)
#End If
On Error GoTo ErrHandler

    ' First execute the request
    If Not ao_DB.ExecuteSQL(as_Request) Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.SQLRowsAffected <> al_RowAffectedCount Then
            Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
        End If
    End If

    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub


