VERSION 5.00
Begin VB.UserControl SPA_Admin_MKT_USER 
   ClientHeight    =   9705
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15255
   ScaleHeight     =   9705
   ScaleWidth      =   15255
   Begin VB.Frame fra_deleteUser 
      Height          =   2355
      Left            =   420
      TabIndex        =   40
      Top             =   3630
      Width           =   5415
      Begin VB.TextBox txt_P_First_Name_Del 
         Height          =   315
         Left            =   8310
         TabIndex        =   2
         Text            =   "P_First_Name"
         Top             =   330
         Width           =   3795
      End
      Begin VB.TextBox txt_P_Name_Del 
         Height          =   315
         Left            =   2250
         TabIndex        =   1
         Text            =   "P_Name"
         Top             =   330
         Width           =   3795
      End
      Begin Project1.ArmCombobox cbo_replacer 
         Height          =   345
         Left            =   2250
         TabIndex        =   3
         Top             =   840
         Width           =   3885
         _ExtentX        =   6853
         _ExtentY        =   609
      End
      Begin VB.Label lbl_label 
         Caption         =   "#Replacer"
         Height          =   375
         Index           =   14
         Left            =   180
         TabIndex        =   43
         Tag             =   "lbl_Replacer"
         Top             =   930
         Width           =   1695
      End
      Begin VB.Label lbl_label 
         Caption         =   "#First Name"
         Height          =   435
         Index           =   18
         Left            =   6210
         TabIndex        =   42
         Tag             =   "lbl_FirstName"
         Top             =   390
         Width           =   1635
      End
      Begin VB.Label lbl_label 
         Caption         =   "#Last Name"
         Height          =   435
         Index           =   16
         Left            =   180
         TabIndex        =   41
         Tag             =   "lbl_LastName"
         Top             =   360
         Width           =   1425
      End
   End
   Begin VB.Frame fra_detail 
      Height          =   8685
      Left            =   0
      TabIndex        =   16
      Tag             =   "fra_Detail"
      Top             =   690
      Width           =   15255
      Begin VB.CommandButton btn_showRequests 
         Caption         =   "#Show SPA requests"
         Height          =   375
         Left            =   11520
         TabIndex        =   57
         Tag             =   "btn_showRequests"
         Top             =   1365
         Width           =   1785
      End
      Begin VB.Frame fra_pendingSPArequests 
         Height          =   6690
         Left            =   5535
         TabIndex        =   54
         Tag             =   "fra_pendingSPArequests"
         Top             =   1785
         Visible         =   0   'False
         Width           =   9630
         Begin VB.Frame fra_spaRequestDetail 
            BorderStyle     =   0  'None
            ClipControls    =   0   'False
            Height          =   1680
            Left            =   120
            TabIndex        =   58
            Tag             =   "fra_spaRequestDetail"
            Top             =   4890
            Width           =   9345
            Begin VB.CheckBox chk_keepApprovals 
               Caption         =   "Keep approvals"
               Height          =   330
               Left            =   7095
               TabIndex        =   62
               Tag             =   "chk_keepApprovals"
               Top             =   75
               Width           =   2115
            End
            Begin VB.CommandButton btn_resentSPARequest 
               Caption         =   "#Resent existing SPA requests"
               Height          =   570
               Left            =   7095
               TabIndex        =   61
               Tag             =   "btn_resentSPARequest"
               Top             =   1065
               Width           =   2115
            End
            Begin VB.CommandButton btn_recreateSPARequest 
               Caption         =   "#Recreate SPA requests"
               Height          =   570
               Left            =   7095
               TabIndex        =   60
               Tag             =   "btn_recreateSPARequest"
               Top             =   420
               Width           =   2115
            End
            Begin Project1.ArmGrid grd_approvalPath 
               Height          =   1575
               Left            =   75
               TabIndex        =   59
               TabStop         =   0   'False
               Tag             =   "grd_ApprovalPath"
               Top             =   60
               Width           =   6615
               _ExtentX        =   11668
               _ExtentY        =   2778
            End
         End
         Begin Project1.ArmGrid grd_SPA_Requests 
            Height          =   4575
            Left            =   105
            TabIndex        =   56
            TabStop         =   0   'False
            Tag             =   "grd_SPA_Requests"
            Top             =   285
            Width           =   9330
            _ExtentX        =   16457
            _ExtentY        =   8070
         End
      End
      Begin VB.CheckBox chk_noSPAConfEmails 
         Alignment       =   1  'Right Justify
         Caption         =   "#Suppres SPA confirmation emails"
         Height          =   705
         Left            =   11625
         TabIndex        =   53
         Tag             =   "chk_noSPAConfEmails"
         Top             =   615
         Width           =   2730
      End
      Begin Project1.ArmGrid grd_UserMarkets 
         Height          =   2745
         Left            =   90
         TabIndex        =   10
         TabStop         =   0   'False
         Tag             =   "grd_UserMarkets"
         Top             =   5805
         Width           =   5160
         _ExtentX        =   9102
         _ExtentY        =   4842
      End
      Begin VB.Frame fra_UserRole 
         Height          =   1185
         Left            =   75
         TabIndex        =   46
         Top             =   525
         Width           =   11340
         Begin VB.TextBox txt_NextUser1 
            Height          =   345
            Left            =   8205
            TabIndex        =   52
            TabStop         =   0   'False
            Top             =   660
            Width           =   3000
         End
         Begin VB.TextBox txt_Role1 
            Height          =   345
            Left            =   8205
            TabIndex        =   51
            TabStop         =   0   'False
            Top             =   225
            Width           =   3000
         End
         Begin Project1.ArmCombobox cbo_nextUser 
            Height          =   345
            Left            =   2220
            TabIndex        =   7
            Top             =   705
            Width           =   3735
            _ExtentX        =   6588
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_role 
            Height          =   345
            Left            =   2220
            TabIndex        =   6
            Top             =   225
            Width           =   3735
            _ExtentX        =   6588
            _ExtentY        =   609
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Current role"
            Height          =   255
            Index           =   15
            Left            =   6030
            TabIndex        =   50
            Tag             =   "lbl_CurrentRole"
            Top             =   270
            Width           =   2055
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Current next user"
            Height          =   255
            Index           =   7
            Left            =   6030
            TabIndex        =   49
            Tag             =   "lbl_CurrentNextUser"
            Top             =   735
            Width           =   2055
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Next user"
            Height          =   255
            Index           =   6
            Left            =   60
            TabIndex        =   48
            Tag             =   "lbl_NextUser"
            Top             =   750
            Width           =   2055
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Role"
            Height          =   255
            Index           =   5
            Left            =   60
            TabIndex        =   47
            Tag             =   "lbl_Role"
            Top             =   285
            Width           =   2055
         End
      End
      Begin VB.TextBox txt_SPU_Id 
         Height          =   375
         Left            =   11580
         TabIndex        =   38
         Tag             =   "SPU_Id®©Num"
         Text            =   "SPU_Id"
         Top             =   195
         Visible         =   0   'False
         Width           =   1650
      End
      Begin VB.CommandButton btn_showReplacement 
         Caption         =   "#Show replacement"
         Height          =   375
         Left            =   13365
         TabIndex        =   8
         Tag             =   "btn_ShowReplacement"
         Top             =   1365
         Width           =   1785
      End
      Begin VB.Frame fra_manipulation 
         Caption         =   "#Manipulation"
         Height          =   390
         Left            =   13620
         TabIndex        =   26
         Tag             =   "frm_maintenance"
         Top             =   630
         Width           =   1365
         Begin VB.CheckBox chk_dropped 
            Caption         =   "#Dropped"
            Height          =   255
            Left            =   13680
            TabIndex        =   32
            Tag             =   "chk_dropped"
            Top             =   360
            Width           =   1155
         End
         Begin VB.TextBox txt_dropDate 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   315
            Left            =   12360
            TabIndex        =   31
            Tag             =   "txt_dropDate"
            Text            =   "02/02/2001"
            Top             =   285
            Width           =   1095
         End
         Begin VB.TextBox txt_updUser 
            Enabled         =   0   'False
            Height          =   315
            Left            =   9150
            TabIndex        =   30
            Tag             =   "txt_updUser"
            Text            =   "L. Cockayne"
            Top             =   285
            Width           =   1815
         End
         Begin VB.TextBox txt_lastUpd 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   315
            Left            =   7020
            TabIndex        =   29
            Tag             =   "txt_lastUpd"
            Text            =   "02/02/2001"
            Top             =   285
            Width           =   1095
         End
         Begin VB.TextBox txt_creator 
            Enabled         =   0   'False
            Height          =   315
            Left            =   3510
            TabIndex        =   28
            Tag             =   "txt_creator"
            Text            =   "L. Cockayne"
            Top             =   285
            Width           =   1815
         End
         Begin VB.TextBox txt_Date 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   315
            Left            =   1560
            TabIndex        =   27
            Tag             =   "txt_Date"
            Text            =   "02/02/2001"
            Top             =   285
            Width           =   1095
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Drop date"
            Height          =   255
            Index           =   13
            Left            =   11070
            TabIndex        =   37
            Tag             =   "lbl_dropDate"
            Top             =   360
            Width           =   1290
         End
         Begin VB.Label lbl_label 
            Caption         =   "#By"
            Height          =   255
            Index           =   12
            Left            =   8430
            TabIndex        =   36
            Tag             =   "lbl_creator"
            Top             =   360
            Width           =   690
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Last updade"
            Height          =   255
            Index           =   11
            Left            =   5430
            TabIndex        =   35
            Tag             =   "lbl_dateUpd"
            Top             =   360
            Width           =   1530
         End
         Begin VB.Label lbl_label 
            Caption         =   "#By"
            Height          =   255
            Index           =   10
            Left            =   2910
            TabIndex        =   34
            Tag             =   "lbl_ByUser"
            Top             =   360
            Width           =   570
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Creation date"
            Height          =   255
            Index           =   9
            Left            =   150
            TabIndex        =   33
            Tag             =   "lbl_date"
            Top             =   360
            Width           =   1410
         End
      End
      Begin Project1.ArmCheckView ckv_markets 
         Height          =   3930
         Left            =   75
         TabIndex        =   9
         Top             =   1785
         Width           =   5175
         _ExtentX        =   9128
         _ExtentY        =   6932
      End
      Begin VB.TextBox txt_P_Name 
         BackColor       =   &H80000004&
         Height          =   285
         Left            =   2280
         TabIndex        =   4
         Text            =   "P_Name"
         Top             =   240
         Width           =   3735
      End
      Begin VB.TextBox txt_P_First_Name 
         BackColor       =   &H80000004&
         Height          =   285
         Left            =   8280
         TabIndex        =   5
         Text            =   "P_First_Name"
         Top             =   240
         Width           =   3105
      End
      Begin VB.TextBox txt_Key 
         Height          =   330
         Left            =   13350
         TabIndex        =   19
         Tag             =   "USER_Code®©Text"
         Text            =   "USER_Code"
         Top             =   210
         Visible         =   0   'False
         Width           =   1785
      End
      Begin VB.Frame fra_userReplacement 
         Height          =   6315
         Left            =   5445
         TabIndex        =   17
         Tag             =   "fra_userReplacement"
         Top             =   1710
         Width           =   9585
         Begin VB.Frame fra_authLevelDetail 
            Caption         =   "#Temporary replacement detail "
            Height          =   3015
            Left            =   120
            TabIndex        =   18
            Tag             =   "fra_replacementDetail"
            Top             =   2520
            Width           =   9375
            Begin VB.TextBox txt_change 
               Height          =   345
               Left            =   6270
               TabIndex        =   45
               Text            =   "change"
               Top             =   1200
               Visible         =   0   'False
               Width           =   1065
            End
            Begin VB.TextBox txt_subKey 
               Height          =   375
               Left            =   7380
               TabIndex        =   44
               Text            =   "SPUR_Id"
               Top             =   810
               Visible         =   0   'False
               Width           =   1845
            End
            Begin VB.TextBox txt_iConcurrency 
               Height          =   345
               Left            =   7410
               TabIndex        =   39
               Text            =   "iConcurrency"
               Top             =   1200
               Visible         =   0   'False
               Width           =   1815
            End
            Begin VB.TextBox txt_Replacement_Comment 
               Height          =   1335
               Left            =   120
               TabIndex        =   15
               Text            =   "Replacement_Comment"
               Top             =   1560
               Width           =   9135
            End
            Begin Project1.A_calocx cal_date_Start 
               Height          =   375
               Left            =   2040
               TabIndex        =   12
               Tag             =   "Date_Start"
               Top             =   360
               Width           =   1815
               _ExtentX        =   3201
               _ExtentY        =   661
            End
            Begin Project1.A_calocx cal_date_end 
               Height          =   375
               Left            =   6480
               TabIndex        =   13
               Tag             =   "Date_End"
               Top             =   360
               Width           =   1815
               _ExtentX        =   3201
               _ExtentY        =   661
            End
            Begin Project1.ArmCombobox cbo_coveringUser 
               Height          =   345
               Left            =   2040
               TabIndex        =   14
               Top             =   840
               Width           =   3735
               _ExtentX        =   6588
               _ExtentY        =   609
            End
            Begin VB.Label lbl_label 
               Caption         =   "#Start date"
               Height          =   255
               Index           =   2
               Left            =   120
               TabIndex        =   25
               Tag             =   "lbl_StartDate"
               Top             =   480
               Width           =   1935
            End
            Begin VB.Label lbl_label 
               Caption         =   "#End date"
               Height          =   255
               Index           =   3
               Left            =   4680
               TabIndex        =   24
               Tag             =   "lbl_EndDate"
               Top             =   480
               Width           =   1695
            End
            Begin VB.Label lbl_label 
               Caption         =   "#Covering user"
               Height          =   255
               Index           =   4
               Left            =   120
               TabIndex        =   23
               Tag             =   "lbl_CoveringUser"
               Top             =   840
               Width           =   1815
            End
            Begin VB.Label lbl_label 
               Caption         =   "#Comment"
               Height          =   255
               Index           =   8
               Left            =   120
               TabIndex        =   22
               Tag             =   "lbl_Comment"
               Top             =   1200
               Width           =   2055
            End
         End
         Begin Project1.ToolbarControl tlb_replacement 
            Height          =   2235
            Left            =   8760
            TabIndex        =   11
            TabStop         =   0   'False
            Top             =   240
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   3942
         End
         Begin Project1.ArmGrid grd_replacement 
            Height          =   2160
            Left            =   120
            TabIndex        =   55
            TabStop         =   0   'False
            Tag             =   "grd_replacement"
            Top             =   255
            Width           =   8550
            _ExtentX        =   24395
            _ExtentY        =   3810
         End
      End
      Begin VB.Label lbl_label 
         Caption         =   "#Last Name"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   21
         Tag             =   "lbl_LastName"
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label lbl_label 
         Caption         =   "#First Name"
         Height          =   255
         Index           =   1
         Left            =   6120
         TabIndex        =   20
         Tag             =   "lbl_FirstName"
         Top             =   240
         Width           =   2055
      End
   End
   Begin Project1.ToolbarControl tlb_main 
      Height          =   690
      Left            =   0
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   15165
      _ExtentX        =   26749
      _ExtentY        =   1217
   End
End
Attribute VB_Name = "SPA_Admin_MKT_USER"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new
'2.7.1 : Suppress confirmation emails per user (JN)


' **************************************************************************************************
' ************************************* EXTERNAL DECLARATIONS **************************************
' **************************************************************************************************
Private Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetLocaleInfo Lib "Kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
' **************************************************************************************************

' **************************************************************************************************
' **************************************** TOOL CONSTANTS ******************************************
' **************************************************************************************************
Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator
Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SEP As String = SEP1 + SEP2
Private Const C_APPNAME As String = "SPA_MKT_USER"                ' for error log
Private Const C_SCREENNAME As String = "SPA_Admin_MKT_USER"  ' for loading screen constants
Private Const C_SCREENMODE_STACK_SIZE As Long = 5           ' size of stack for active screens
Private Const C_TOOLBARFACE_ITEM_VIEW As String = "0"
Private Const C_TOOLBARFACE_ITEM_UPD As String = "2"
Private Const C_TOOLBARFACE_ITEM_DEL As String = "1"
Private Const SIFYB_CM_ERROR_MESSAGE = 2400                 ' const for base of error messages ids
Private Const SIFYB_SPA_ERROR_MESSAGE = 8000
Private Const C_ID_KEY = "SPA_MKT_USER"                   ' A_ID entry for new record
Private Const C_ID_KEY_ROLES = "SPA_USER_ROLES"                   ' A_ID entry for new record
Private Const C_ID_KEY_MKT_USER = "SPA_AuthMarketUser_Link"  ' A_ID entry for new record
Private Const C_ID_KEY_ITEM = "SPA_USER_REPLACEMENT"        ' A_ID entry for new record
' ****************************************** TOOL CONSTANTS ***************************************

' **************************************************************************************************
' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
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
    CompFncFailed = vbObjectError + 6           ' when component function fail
    QuietException = vbObjectError + 7          ' do not display error message
    WarMsgSelectRow = vbObjectError + 8
    SQLBadRowAffectedCount = vbObjectError + 9  ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 10 ' A SQL request does not return the expected rowcount : select an item return nothing...
End Enum

Private Enum ErrMsg
    ErrMsgNone = 0
    ErrMsgMandatoryAreEmpty = SIFYB_CM_ERROR_MESSAGE + 1
    ErrMsgDuplicateOrder = SIFYB_CM_ERROR_MESSAGE + 2
    ErrMsgDuplicateLevel = SIFYB_CM_ERROR_MESSAGE + 3
    ErrMsgMissingLevel = SIFYB_CM_ERROR_MESSAGE + 4
    ErrMsgNumericRequired = SIFYB_CM_ERROR_MESSAGE + 5
    ErrMsgItemIsDeleted = SIFYB_CM_ERROR_MESSAGE + 19
    ErrMsgPlanNotSelected = SIFYB_CM_ERROR_MESSAGE + 20
    ErrMsgItemAlreadyInGrid = SIFYB_CM_ERROR_MESSAGE + 21
    ErrMsgActionInProgress = SIFYB_CM_ERROR_MESSAGE + 22
    ErrMsgActionIsCompleted = SIFYB_CM_ERROR_MESSAGE + 23
    QueMsgActionIsCompleted = SIFYB_CM_ERROR_MESSAGE + 24
    ErrMsgVendorNotSelected = SIFYB_CM_ERROR_MESSAGE + 25
    QueMsgUpdateCompletedTask = SIFYB_CM_ERROR_MESSAGE + 26
    ErrMsgUpdateDeletedTask = SIFYB_CM_ERROR_MESSAGE + 27
End Enum

Private Enum ErrMsg_SPA
    ErrMsg_M300 = SIFYB_SPA_ERROR_MESSAGE + 300              'The Field $FIELD_NAME$ must be entered
    ErrMsg_M360 = SIFYB_SPA_ERROR_MESSAGE + 360              'Do you really want to delete this record
    ErrMsg_M380 = SIFYB_SPA_ERROR_MESSAGE + 380              'You cannot edit this Vacation as the start date has passed.
    ErrMsg_M390 = SIFYB_SPA_ERROR_MESSAGE + 390              'You cannot edit this Vacation as the end date has passed.
    ErrMsg_M400 = SIFYB_SPA_ERROR_MESSAGE + 400              'The Vacation start date must be greater than today
    ErrMsg_M410 = SIFYB_SPA_ERROR_MESSAGE + 410              'You must choose at least one market where this user is an APPROVER
    ErrMsg_M420 = SIFYB_SPA_ERROR_MESSAGE + 420              'You must choose a role because you have selected a type of APPROVER
    ErrMsg_M430 = SIFYB_SPA_ERROR_MESSAGE + 430              'The next user must be an APPROVER for all markets you have chosen
    ErrMsg_M440 = SIFYB_SPA_ERROR_MESSAGE + 440              'The next user must be empty as you have selected the highest priority role.
    ErrMsg_M450 = SIFYB_SPA_ERROR_MESSAGE + 450              'The next user must be entered with a smaller priority number
    ErrMsg_M460 = SIFYB_SPA_ERROR_MESSAGE + 460              'The Replacement start date must be greater than today
    ErrMsg_M470 = SIFYB_SPA_ERROR_MESSAGE + 470              'The Replacement end date must be greater than or equal to the replacement start date
    ErrMsg_M480 = SIFYB_SPA_ERROR_MESSAGE + 480              'The Replacement period you have entered conflicts with another replacement for this user
    ErrMsg_M500 = SIFYB_SPA_ERROR_MESSAGE + 500              'The Replacement end date must be greater than today
    ErrMsg_M610 = SIFYB_SPA_ERROR_MESSAGE + 610              'This configuration will be active from today or tomorrow and you cannot change it again today.
    ErrMsg_M707 = SIFYB_SPA_ERROR_MESSAGE + 707              'The Replacement start date must be greater than today because there are open SPA’s for active approver

    ErrMsg_M740 = SIFYB_CM_ERROR_MESSAGE + 740              'No emails to resend for this SPA.
    ErrMsg_M750 = SIFYB_CM_ERROR_MESSAGE + 750              'The Email to resend was not processed yet. (contanct Application supprot please)
    ErrMsg_M760 = SIFYB_CM_ERROR_MESSAGE + 760              'Do you want to resend email?
    ErrMsg_M770 = SIFYB_CM_ERROR_MESSAGE + 770              'The email was successfully resent to Approver.
End Enum

' *************************************** USER DEFINED ERRORS **************************************

' **************************************************************************************************
' *************************************** CONTROL MEMBERS ******************************************
' **************************************************************************************************
Dim ml_U_Code As Long                   ' if this is user loging app, needed to log errors into A_Log
Dim ms_LoginName As String
Dim ms_Language_Code As String
Dim mb_Initialized As Boolean           ' True if the component is already initialized
Dim mb_Initializing As Boolean          ' Flag of initializing
Dim mua_ActiveMode() As ArmScreenMode
Dim ms_Title As String                  ' title of user control - can be assigned as Caption to the parent form or title for printing
Dim ml_iConcurrency As Long             ' iconc of the record curently loaded
Dim ms_DecimalSeparator As String       ' decimal separator obtained from local settings
Dim ms_ThousandSeparator As String      'locale thousand separator

Dim moa_ListFieldsMandatory As Variant  ' all mandatory controls
Dim moa_ListFieldsNumeric As Variant    ' all numeric controls
Dim moa_ListFieldsToDisable() As Control            ' common disabled control


Private Enum ArmScreenMode
    smRefreshOnly
    smMain
    smAdd
    smUpdate
    smDelete
    smView
    smAddItem
    smUpdateItem
    smDeleteItem
    smViewItem
End Enum

#If LIVE = 1 Then
    Dim mo_Db As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
#End If

#If LIVE = 1 Then
    Dim mo_FSO As Object
#Else
    Dim mo_FSO As Scripting.FileSystemObject
#End If
Private mo_SPA_Approval         As SPA_Approval

Dim ml_cursor_SelectedValues  As Long
Dim ma_MKT_USER_ID_LIST()     As Long
Dim ms_ErrMessage             As String
Dim md_ServerDate             As Date

Private mo_tokenManager       As ArmToken

' *************************************** CONTROL MEMBERS ******************************************
Public Event OnExit()
Public Event OnItemAdd(ByVal av_Key As Variant, ByVal as_SrzFields As String)
Public Event OnItemUpdate(ByVal av_Key As Variant, ByVal as_SrzFields As String)
Public Event OnItemDelete(ByVal av_Key As Variant)
Public Event OnItemNext()
Public Event OnItemPrevious()
Public Event OnPrint(ByVal av_Key As Variant)


' **************************************************************************************************
' **************************************************************************************************
' **************************************************************************************************


' mb_Initialized is a read-only property, indicates the status of the component
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 Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property
Public Sub Zorder()
  Call UserControl.Extender.Zorder
End Sub
Public Property Let U_Code(ByVal al_U_Code As Long)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    
    ml_U_Code = al_U_Code
    Exit Property
ErrHandler:
    Call ErrorHandler(Extender.Name & ".U_Code(Let)")
End Property

Public Property Let LoginName(ByVal as_loginName As String)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    
    ms_LoginName = as_loginName
    Exit Property
ErrHandler:
    Call ErrorHandler(Extender.Name & ".LoginName(Let)")
End Property

Public Property Let Language_Code(as_Language_code As String)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If Len(as_Language_code) <> 1 Then Call Err.Raise(ArmErr.InvalidArgument, "", "Language_code must contains only 1 char")
    
    ms_Language_Code = as_Language_code
    Exit Property
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Language(Let)")
End Property

Public Property Set Db(ByRef ao_Db As ArmDb)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If ao_Db Is Nothing Then Call Err.Raise(ArmErr.InvalidArgument)
    
    Set mo_Db = ao_Db
    Exit Property
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Db(Set)")
End Property

Public Property Get Title() As String
    Title = ms_Title
End Property

Public Property Let UserReplacementFrameVisible(ByVal ab_Visible As Boolean)
On Error GoTo ErrHandler
    fra_userReplacement.Visible = ab_Visible
    Exit Property
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UserReplacementFrameVisible")
End Property

Public Sub Run(ByVal ae_ScrMode As SPA_Mode, ByVal av_Key As Variant)
On Error GoTo ErrHandler

    Debug.Assert (mb_Initialized = True)
    
    Call LockScreen(True)       'JN: i am not sure if this is necessary if called from other control which already locked the screen
       
    Select Case ae_ScrMode
        Case SPA_Mode.emView
            Call Item_ViewInit(av_Key)
        Case SPA_Mode.emAdd
            'Call Item_AddInit
        Case SPA_Mode.emUpdate
            Call Item_UpdateInit(av_Key)
        Case SPA_Mode.emDelete
            Call Item_DeleteInit(av_Key)
            
    End Select
    
    Call LockScreen(False)
    
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".Run")
End Sub

Public Sub Load_A_COM()
Dim lo_Control As Object
On Error GoTo ErrHandler
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If mo_Db Is Nothing Then Call Err.Raise(ArmErr.PropertyNotSet, "", "mo_Db")
    If Len(ms_Language_Code) < 1 Then Call Err.Raise(ArmErr.PropertyNotSet, "", "ms_Language_Code")
    
    ' get decimal separator for conversion from string to double
    ms_DecimalSeparator = Format(0, ".")
    Dim sBuffer As String
    Dim nBufferLen As Long
    nBufferLen = 255
    sBuffer = String$(nBufferLen, vbNullChar)
    nBufferLen = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, sBuffer, nBufferLen)
    If nBufferLen > 0 Then
        ms_ThousandSeparator = Left$(sBuffer, nBufferLen - 1)
    End If

    ' init token manager
    Set mo_tokenManager = New ArmToken
    Set mo_tokenManager.Db = mo_Db
    Call mo_tokenManager.Load_A_COM
    
    'init mo_SPA_Approval
    Set mo_SPA_Approval = New SPA_Approval
    Set mo_SPA_Approval.Db = mo_Db
    mo_SPA_Approval.U_Code = ml_U_Code
    mo_SPA_Approval.MailBox = "SPA Approval"
    Call mo_SPA_Approval.Load_A_COM


    ' Set Db
    ' Call Load_A_Com
    ' Initialize toolbars
    Debug.Assert (Not mo_Db Is Nothing)
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        Case "ARMPICKER"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
            lo_Control.Locked = True
        Case "TOOLBARCONTROL"
            lo_Control.Language = ms_Language_Code
            lo_Control.HideTips = True
            lo_Control.Load_A_COM
        Case "ARMGRID"
            Dim lo_Grid As ArmGrid
            Set lo_Grid = lo_Control
            Set lo_Grid.ArmDb = mo_Db
            Call lo_Grid.Load_A_COM
            lo_Grid.ExportTitles = True
            lo_Grid.ExportOnlyVisibleColumns = True
        Case "ARMTREEVIEW"
            Set lo_Control.ArmDb = mo_Db
            lo_Control.Language = ms_Language_Code
            Call lo_Control.Load_A_COM
        Case "ARMCHECKVIEW"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        Case "A_CALOCX"
            lo_Control.Language = ms_Language_Code
            Call lo_Control.reinit_cal
        End Select
    Next
    
    Call fra_deleteUser.Move(0, tlb_Main.Height, tlb_Main.Width, Height)
    fra_manipulation.Visible = False

    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    ml_cursor_SelectedValues = 0
    
    ReDim Preserve mua_ActiveMode(0)
    mua_ActiveMode(UBound(mua_ActiveMode)) = ArmScreenMode.smMain

    ' init controls
    'ReDim moa_ListFieldsMandatory(0 To 2) As Variant
    'moa_ListFieldsMandatory(0) = Array(cbo_coveringUser, 4)
    'moa_ListFieldsMandatory(1) = Array(cal_date_Start, 2)
    'moa_ListFieldsMandatory(2) = Array(cal_date_end, 3)
    
    ReDim moa_ListFieldsMandatory(0 To 2) As Variant
    'moa_ListFieldsMandatory(0) = Array(cbo_coveringUser, 4)
    moa_ListFieldsMandatory(0) = Array(cal_date_Start, 2)
    moa_ListFieldsMandatory(1) = Array(cal_date_end, 3)
    moa_ListFieldsMandatory(2) = Array(cbo_coveringUser, 4)
    
    
    
    Call cal_date_Start.Zorder(0)
    Call cal_date_end.Zorder(0)
    
    ReDim moa_ListFieldsNumeric(-1 To -1) As Variant
'    moa_ListFieldsNumeric(0) = Array(txt_estCost, 9)
    
    InitMandatoryLabels (moa_ListFieldsMandatory)

    Call FillControlArray(moa_ListFieldsToDisable, _
        Array(txt_P_Name, txt_P_First_Name, txt_Key, txt_Date, Txt_Creator, txt_lastUpd, _
            txt_updUser, txt_dropDate, chk_dropped, txt_Role1, txt_NextUser1))
    
    Call InitComponents
    
    Call LoadLabels(UserControl.Controls, C_SCREENNAME, ms_Language_Code)
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    
    Call Components_Settings
    
    ' set layout
    Call InitCtrlSize
    
    mb_Initialized = True

    ' display starting face
    Call UpdateUI(ArmScreenMode.smMain)
    
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".Load_A_Com()")
End Sub

Private Sub FillControlArray(ByRef ao_ctrlArray() As Control, ByRef ao_array As Variant)
On Error GoTo ErrHandler
    Dim ll_i As Long
    If Not IsArray(ao_array) Then
        Exit Sub
    End If
    
    ReDim ao_ctrlArray(LBound(ao_array) To UBound(ao_array)) As Control
    
    For ll_i = LBound(ao_array) To UBound(ao_array)
        Set ao_ctrlArray(ll_i) = ao_array(ll_i)
    Next

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".FillControlArray()")
End Sub

Public Sub Unload_A_COM()
Dim lo_Control As Object
On Error GoTo ErrHandler
    If Not Initialized Then Call Err.Raise(ArmErr.CPTNotInitialized)
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX", "TOOLBARCONTROL", "ARMGRID", "ARMTREEVIEW", "ARMCHECKVIEW", "ARMPICKER", "SRM_TASKPRODUCT", "SRM_ACTION", "SRM_ATTACHMENT"
            Call lo_Control.Unload_A_COM
        End Select
    Next
    
    If ml_cursor_SelectedValues > 0 Then
        mo_Db.Close (ml_cursor_SelectedValues)
        ml_cursor_SelectedValues = 0
    End If
    
    Call mo_tokenManager.Unload_A_COM
    Call mo_SPA_Approval.Unload_A_COM
    
    Set mo_Db = Nothing
    Set mo_FSO = Nothing
    Set mo_tokenManager = Nothing
    Set mo_SPA_Approval = Nothing

    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".Unload_A_Com()")
End Sub

Private Sub Components_Settings()
On Error GoTo ErrHandler

    Call Component_SetUp(txt_Key, "USER_Code" & SEP & "Num")
    
    Call Component_SetUp(txt_P_Name, "P_Name" & SEP & "Text")
    Call Component_SetUp(txt_P_First_Name, "P_First_Name" & SEP & "Text")
    
    Call Component_SetUp(txt_P_Name_Del, "P_Name" & SEP & "Text")
    Call Component_SetUp(txt_P_First_Name_Del, "P_First_Name" & SEP & "Text")
    
    Call Component_SetUp(txt_Role1, "SPR_SDesc1" & SEP & "Text")
    Call Component_SetUp(txt_NextUser1, "Next_P_Name1" & SEP & "Text")
    
    Call Component_SetUp(cbo_replacer, "Replacer_U_Code" & SEP & "Replacer_P_Name")
    Call Component_SetUp(cbo_role, "SPR_Code2" & SEP & "SPR_SDesc2")
    Call Component_SetUp(cbo_nextUser, "Next_U_Code2" & SEP & "Next_P_Name2")
    
    Call Component_SetUp(chk_noSPAConfEmails, "SPA_no_conf_email")
    
    'subitem controls
    Call Component_SetUp(txt_subKey, "SPUR_Id" & SEP & "Text")
    Call Component_SetUp(txt_change, "change" & SEP & "Text")
    Call Component_SetUp(cbo_coveringUser, "Covering_U_Code" & SEP & "Covering_P_Name")
    Call Component_SetUp(txt_Replacement_Comment, "Replacement_Comment" & SEP & "Text")
    Call Component_SetUp(txt_iConcurrency, "subiConcurrency" & SEP & "Num")

    ' system controls
    Call Component_SetUp(txt_Date, "Z_Creation" & SEP & "Date")
    Call Component_SetUp(txt_lastUpd, "Z_Last_Upd" & SEP & "Date")
    Call Component_SetUp(txt_dropDate, "Drop_Date" & SEP & "Date")
    Call Component_SetUp(Txt_Creator, "Z_Creator_Name" & SEP & "Text")
    Call Component_SetUp(txt_updUser, "Z_Last_Upd_User_Name" & SEP & "Text")
    Call Component_SetUp(chk_dropped, "Drop_flag")
    
    Exit Sub
    
ErrHandler:
    Call ErrorHandler("Components_Settings")
End Sub

Private Sub Component_SetUp(ByVal ao_cpt As Object, ByVal as_Tag As String)

On Error GoTo ErrHandler
    
    ao_cpt.Tag = as_Tag
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Component_SetUp")
End Sub

Private Sub UpdateUI(Optional ByVal au_mode As ArmScreenMode = ArmScreenMode.smRefreshOnly)
On Error GoTo ErrHandler

    ' set active face
    If au_mode <> smRefreshOnly Then
        Call pushScreenMode(au_mode)
    End If

    tlb_Main.Redraw = False

    ' hide all frames
    fra_Detail.Visible = False
    tlb_Main.Visible = False
    tlb_Main.Enabled = True
    grd_replacement.Enabled = True
    grd_SPA_Requests.Enabled = True
    grd_UserMarkets.Enabled = True

    ' we have clean screen we can display proper controls
    Select Case activeScreenMode
        Case smMain
'        Case smAdd
'            fra_detail.Visible = True
'            tlb_main.Visible = True
'            fra_authLevelDetail.Visible = False
'            Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_ADD)
'            tlb_replacement.Visible = True
'            Call tlb_replacement.DisplayFace("0")
'           ckv_markets.ComboVisible = True
'           Call ckv_markets.SetVisibleList("ROLE0")
        Case smUpdate
            fra_Detail.Visible = True
            tlb_Main.Visible = True
            fra_deleteUser.Visible = False
            fra_authLevelDetail.Visible = False
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_UPD)
            tlb_replacement.Visible = True
            Call tlb_replacement.DisplayFace("0")
            ckv_markets.ComboVisible = True
            Call ckv_markets.SetVisibleList("ROLE0")
            fra_UserRole.Visible = IsApproverSelected
        Case smView
            fra_Detail.Visible = True
            tlb_Main.Visible = True
            fra_authLevelDetail.Visible = False
            fra_deleteUser.Visible = False
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_VIEW)
            tlb_replacement.Visible = False
            ckv_markets.ComboVisible = False
            Call ckv_markets.SetVisibleList("MAIN")
            fra_UserRole.Visible = IsApproverSelected
        Case smDelete
            fra_Detail.Visible = False
            tlb_Main.Visible = True
            fra_authLevelDetail.Visible = False
            fra_deleteUser.Visible = True
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_DEL)
            tlb_replacement.Visible = False
            ckv_markets.ComboVisible = False
            Call ckv_markets.SetVisibleList("MAIN")
        Case smAddItem, smUpdateItem, smDeleteItem
            fra_Detail.Visible = True
            fra_authLevelDetail.Visible = True
            tlb_Main.Visible = True
            tlb_Main.Enabled = False
            grd_replacement.Enabled = False
            grd_SPA_Requests.Enabled = False
            grd_UserMarkets.Enabled = False
            Call tlb_replacement.DisplayFace("1")
        Case Else
            Debug.Assert (False)
    End Select
    
    ' apply rights on toolbar
    Call UpdateMainToolbar
    
    tlb_Main.Redraw = True

    ' to display face immidiatelly
    UserControl.Refresh
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UpdateUI()")
End Sub

' ************************************************************************************
' **************************** FRAMEWORK FUNCTIONS ***********************************
' ************************************************************************************
Private Sub pushScreenMode(ByVal au_mode As ArmScreenMode)
On Error GoTo ErrHandler
    If UBound(mua_ActiveMode) = C_SCREENMODE_STACK_SIZE - 1 Then
        ' move array left
        Debug.Print ("Stack is too small. Increase C_SCREENMODE_STACK_SIZE constant please.")
        Dim ll_Index As Long
        For ll_Index = 1 To UBound(mua_ActiveMode)
            mua_ActiveMode(ll_Index - 1) = mua_ActiveMode(ll_Index)
        Next
    Else
        ' allocate one more item
        ReDim Preserve mua_ActiveMode(UBound(mua_ActiveMode) + 1)
    End If
    mua_ActiveMode(UBound(mua_ActiveMode)) = au_mode
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".pushScreenMode")
End Sub

Private Property Get activeScreenMode(Optional ByVal al_fromTop As Long = 0) As ArmScreenMode
On Error GoTo ErrHandler
    Debug.Assert (IsArray(mua_ActiveMode))
    activeScreenMode = mua_ActiveMode(UBound(mua_ActiveMode) - al_fromTop)
    Exit Property
ErrHandler:
     Call ErrorHandler(Extender.Name & ".activeScreenMode(Get)")
End Property

Private Sub popScreenMode()
On Error GoTo ErrHandler
    Debug.Assert (UBound(mua_ActiveMode) >= 1)
    ReDim Preserve mua_ActiveMode(UBound(mua_ActiveMode) - 1)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".popScreenMode")
End Sub

Private Sub popScreenModeUntil(ByVal ae_goTo As ArmScreenMode)
On Error GoTo ErrHandler
    While activeScreenMode <> ae_goTo
        Call popScreenMode
    Wend
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".popScreenModeUntil")
End Sub


Private Sub InitComponents()
'Const CL_REQUEST_TB As String = "SELECT Info FROM Toolbars_Definitions WHERE ID=$id$"
Const CL_REQUEST_TB As String = "A_ToolbarDef_sel 1, 2422, 2821, $id$"
Const CL_REQUEST_ROLES As String = "exec A_References_ML_Lst 203,$language_code$"

On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    Dim ll_Cursor As Long
    Dim ll_i As Long
    Dim ll_Idx As Long
    
    ' main toolbar
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$id$", "NULL"))
    If mo_Db.Find(ll_Cursor, "id", TLB_SPA_MKT_USER_MTNC_ID) >= 0 Then
        Call tlb_Main.SetToolbarInfoStringParameters(mo_Db.GetFields(ll_Cursor, "info"), Left(mo_Db.GetFields(ll_Cursor, "info"), 3))
    Else
        Call Err.Raise(ArmErr.InvalidArgument, "mo_Db.Find", "Toolbar id(" & TLB_SPA_MKT_USER_MTNC_ID & ") not found in DB")
    End If
    
    If mo_Db.Find(ll_Cursor, "id", TLB_SPA_MKT_USER_MTNC_REPLACE_ID) >= 0 Then
        Call tlb_replacement.SetToolbarInfoStringParameters(mo_Db.GetFields(ll_Cursor, "info"), Left(mo_Db.GetFields(ll_Cursor, "info"), 3))
    Else
        Call Err.Raise(ArmErr.InvalidArgument, "mo_Db.Find", "Toolbar id(" & TLB_SPA_MKT_USER_MTNC_REPLACE_ID & ") not found in DB")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    cbo_replacer.FirstBlankItem = True
    cbo_replacer.Request = ReplaceCommonPlaceholders(REQ_REPLACER_CBO)
    
    cbo_role.FirstBlankItem = True
    cbo_role.Request = ReplaceCommonPlaceholders(REQ_ROLES_CBO)
    
    cbo_nextUser.FirstBlankItem = True
    cbo_nextUser.Request = ReplaceCommonPlaceholders(REQ_NEXT_USER_CBO)
          
    cbo_coveringUser.FirstBlankItem = False
    cbo_coveringUser.Request = ReplaceCommonPlaceholders(REQ_COVERING_USER_CBO)
            
    Call grd_replacement.SetColumns(Array( _
          Join(Array("SPUR_Id", 0, 1, "SPUR_Id", "", "String"), SEP) _
        , Join(Array("Date_Start", 1200, 0, "Date_Start", "#Start date", "Date", "", "Left"), SEP) _
        , Join(Array("Date_End", 1200, 0, "Date_End", "#End date", "Date", "", "Left"), SEP) _
        , Join(Array("Covering_U_Code", 0, 0, "Covering_U_Code", "#Covering U_Code", "Number", "", "Left"), SEP) _
        , Join(Array("Covering_P_Name", 1500, 0, "Covering_P_Name", "#Covering user", "String", "", "Left"), SEP) _
        , Join(Array("Replacement_Comment", 4000, 0, "Replacement_Comment", "#Comment", "String", "", "Left"), SEP) _
        , Join(Array("subiConcurrency", 0, 0, "subiConcurrency", "", "Number", "", "Left"), SEP) _
        , Join(Array("change", 0, 0, "change", "", "String", "", "Left"), SEP) _
        ))
    grd_replacement.AllowExcelExport = True
    
    Call grd_SPA_Requests.SetColumns(Array( _
              Join(Array("SPA_Id", 700, 1, "SPA_Id", "SPA ID", "Number"), SEP), _
              Join(Array("Date_Submitted", 1000, 0, "Date_Submitted", "Submitted", "Date"), SEP), _
              Join(Array("Date_Required", 1000, 0, "Date_Required", "Required", "Date"), SEP), _
              Join(Array("Date_Emailed", 1000, 0, "Date_Emailed", "Emailed", "Date"), SEP), _
              Join(Array("Date_LastReminder", 1000, 0, "Date_LastReminder", "LastReminder", "Date"), SEP), _
              Join(Array("Auth_U_Code", 0, 0, "Auth_U_Code", "Auth_U_Code", "Number"), SEP), _
              Join(Array("Auth_U_Name", 1400, 0, "Auth_U_Name", "Auth Name", "String"), SEP), _
              Join(Array("Approving_U_Name", 1400, 0, "Approving_U_Name", "Approving Name", "String"), SEP), _
              Join(Array("Status_Desc", 1200, 0, "Status_Desc", "Status", "String"), SEP) _
              ))
    grd_SPA_Requests.AllowExcelExport = True
    
    grd_approvalPath.Title = "#Approvals"
    grd_approvalPath.AllowExcelExport = True
    grd_approvalPath.ExportTitles = True
    grd_approvalPath.AllowSort = False
    grd_approvalPath.ExportOnlyVisibleColumns = True
    Call grd_approvalPath.SetColumns(Array( _
          Join(Array("SIA_Id", 0, 1, "SIA_Id", ""), SEP) _
        , Join(Array("Auth_U_Code", 0, 0, "Auth_U_Code", "#Auth_U_Code", "Number", "", "Left"), SEP) _
        , Join(Array("Auth_U_Name", 1000, 0, "Auth_U_Name", "#Auth user", "String", "", "Left"), SEP) _
        , Join(Array("Approving_U_Name", 1500, 0, "Approving_U_Name", "#Approving user", "String", "", "Left"), SEP) _
        , Join(Array("Status_Code", 0, 0, "Status_Code", "#Status_Code", "Number", "", "Left"), SEP) _
        , Join(Array("Status", 1500, 0, "Status", "#Status", "Number", "", "Left"), SEP) _
        , Join(Array("Status_Change_Date", 1500, 0, "Status_Change_Date", "#Change date", "Date", "", "Left"), SEP) _
        , Join(Array("Auth_Comment", 1500, 0, "Auth_Comment", "#Comment", "String", "", "Left"), SEP) _
        , Join(Array("subiConcurrency", 0, 0, "subiConcurrency", "", "Number", "", "Left"), SEP) _
        , Join(Array("change", 0, 0, "change", "", "String", "", "Left"), SEP) _
        ))

    Call grd_UserMarkets.SetColumns(Array( _
          Join(Array("SPAMU_Id", 0, 0, "SPAMU_Id", "", "String"), SEP) _
        , Join(Array("SPA_UserType_Code", 0, 1, "SPA_UserType_Code", "#SPA_UserType_Code", "Number", "", "Left"), SEP) _
        , Join(Array("SPA_UserType_Name", 1200, 0, "SPA_UserType_Name", "#User type", "String", "", "Left"), SEP) _
        , Join(Array("SPM_Code", 0, 1, "SPM_Code", "#SPM_Code", "String", "", "Left"), SEP) _
        , Join(Array("SPM_SDesc", 1400, 0, "SPM_SDesc", "#Market", "String", "", "Left"), SEP) _
        , Join(Array("VDate_Start", 1000, 0, "VDate_Start", "#Start date", "Date", "", "Left"), SEP) _
        , Join(Array("VDate_End", 1000, 0, "VDate_End", "#End date", "Date", "", "Left"), SEP) _
        , Join(Array("subiConcurrency", 0, 0, "subiConcurrency", "", "Number", "", "Left"), SEP) _
        , Join(Array("change", 0, 0, "change", "", "String", "", "Left"), SEP) _
        ))
    grd_UserMarkets.AllowExcelExport = True
    
        ' init markets check view
    ckv_markets.Driven_By = "User"
        ckv_markets.Common_List_Load = True
        ckv_markets.Type_Of_Key = tkDependant
    ckv_markets.Calling_Key_Fields = "U_Code"
    ckv_markets.Calling_Key_Values = ""
    ckv_markets.Link_Key_Fields = "SPM_Code®©SPA_UserType_Code"
    ckv_markets.ComboVisible = True
    
    Dim lv_RoleList As Variant
    
    ll_Cursor = OpenSQLSafe(mo_Db, ReplaceCommonPlaceholders(CL_REQUEST_ROLES))
    ckv_markets.RoleCount = mo_Db.RowCount(ll_Cursor) + 1
    ReDim lv_RoleList(mo_Db.RowCount(ll_Cursor))
    lv_RoleList(0) = Array("MAIN", _
                            "VIEW", _
                            "", _
                            "", _
                            "Main view", _
                            "SPM_Code®©SPM_SDesc®©SPA_UserType_Code®©RF_Desc", _
                            "SPM_SDesc®©RF_Desc", _
                            "2350®©2350", _
                            "SPM_Code®©SPA_UserType_Code", _
                            "exec SPA_AuthMarketUser_Link_lst2 $U_Code$, NULL, '" & ms_Language_Code & "'", _
                            "", _
                            "", _
                            True, _
                            2, _
                            False, _
                            True, _
                            0, _
                            0)
    For ll_Idx = 0 To mo_Db.RowCount(ll_Cursor) - 1
        lv_RoleList(ll_Idx + 1) = Array("ROLE" & ll_Idx, _
                                        "EDIT", _
                                        "SPA_UserType_Code®©RF_Desc", _
                                        mo_Db.GetFieldsAt(ll_Cursor, ll_Idx, "RF_code") & "®©" & mo_Db.GetFieldsAt(ll_Cursor, ll_Idx, "RF_Desc"), _
                                        mo_Db.GetFieldsAt(ll_Cursor, ll_Idx, "RF_Desc"), _
                                        "SPM_Code®©SPM_SDesc", _
                                        "SPM_SDesc", _
                                        "4000", _
                                        "SPM_Code", _
                                        "exec SPA_MKT_lst", _
                                        "", _
                                        "", _
                                        False, _
                                        2, _
                                        False, _
                                        True, _
                                        0, _
                                        0)
    Next
    Call mo_Db.Close(ll_Cursor)
    If Not ckv_markets.SetRoleList(lv_RoleList) Then
            Err.Raise CompFncFailed, "ckv_markets.SetRoleList", "Setting CheckView parameters failed."
        End If
        
        
    ' update view when edit check list changed by user
        ckv_markets.Synchronize_View = True
    Exit Sub
ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler(Extender.Name & ".InitComponents()")
End Sub

Private Sub InitMandatoryLabels(ByRef av_ListFieldsMandatory As Variant)
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim lo_Label As Label

    For ll_Index = 0 To UBound(av_ListFieldsMandatory)
        If av_ListFieldsMandatory(ll_Index)(1) >= 0 Then
            Set lo_Label = lbl_Label(av_ListFieldsMandatory(ll_Index)(1))
            lo_Label.FontBold = True
        End If
    Next
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitMandatoryLabels")
End Sub

Private Function ReplaceCommonPlaceholders(ByVal as_Request As String) As String
On Error GoTo ErrHandler

    as_Request = ReplacePlaceHolder(as_Request, "$language_code$", SqlStr(ms_Language_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$Z_Creator$", SqlInt(ml_U_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$U_Code$", SqlInt(ml_U_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$Z_Last_Upd_User$", SqlInt(ml_U_Code))
    ReplaceCommonPlaceholders = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ReplaceCommonPlaceholders")
End Function

Private Function ReplacePlaceHolder(ByVal as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As String
On Error GoTo ErrHandler
    
    ReplacePlaceHolder = Replace(as_Request, as_PlaceHolder, as_DefaultValue, , , vbTextCompare)

    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ReplacePlaceholder")
End Function
Private Sub InitCtrlSize()
On Error GoTo ErrHandler
Const c_margin As Long = 60
    ' ??????????
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".InitCtrlSize()")
End Sub

Private Sub LoadDataToForm(ByVal ac_Cursor As Long, ByRef aControls As Variant, ByRef aContainer As Object)
On Error GoTo ErrHandler
   
    Dim lIdx As Long, lCount As Long
    Dim lControl As Control
    Dim lValues As Variant
    Dim ls_TempTag As String
    
        lCount = aControls.Count - 1
    
        For lIdx = 0 To lCount
            Set lControl = aControls.Item(lIdx)
            If HasContainer(lControl, aContainer) Then
                Select Case UCase(TypeName(lControl))
                    Case "TEXTBOX"
                            ls_TempTag = lControl.Tag & SEP
                            lValues = Split(ls_TempTag, SEP)
                            If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                                Select Case lValues(1)
                                    Case "Text"
                                        lControl.Text = mo_Db.GetFields(ac_Cursor, lValues(0))
                                    Case "Num"
                                        lControl.Text = Replace(mo_Db.GetFields(ac_Cursor, lValues(0)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                    Case "Date"
                                        If mo_Db.GetFields(ac_Cursor, lValues(0)) = 0 Then
                                            lControl.Text = ""
                                        Else
                                            lControl.Text = Format(mo_Db.GetFields(ac_Cursor, lValues(0)), "dd\/mm\/yyyy")
                                        End If
                                End Select
                            End If
                    
                    Case "ARMCOMBOBOX"
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                            If mo_Db.GetFields(ac_Cursor, lValues(0)) = 0 Or mo_Db.GetFields(ac_Cursor, lValues(0)) = "" Then
                                Set lControl.SelectedItem = Nothing
                            Else
                                If lControl.SearchItem(mo_Db.GetFields(ac_Cursor, lValues(0)), 0, 0, True) = False Then
                                    If lControl.AddItem(Array(mo_Db.GetFields(ac_Cursor, lValues(0)), mo_Db.GetFields(ac_Cursor, lValues(1))), True) Is Nothing Then
                                        Err.Raise 2222, "", ""
                                    End If
                                End If
                            End If
                        End If
                        
                    Case "OPTIONBUTTON"
                        lValues = Split(lControl.Tag, SEP)
                        If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                            If UCase(lValues(2)) Like UCase(mo_Db.GetFields(ac_Cursor, lValues(0))) Then
                                lControl.Value = True
                            End If
                        End If
                        
                    Case "CHECKBOX"
                        If mo_Db.GetFieldIndex(ac_Cursor, lControl.Tag) >= 0 Then
                            If UCase(mo_Db.GetFields(ac_Cursor, lControl.Tag)) Like "X" Then
                                lControl.Value = vbChecked
                            Else
                                lControl.Value = vbUnchecked
                            End If
                        End If
                        
                    Case "A_CALOCX"
                        lControl.date_courte = mo_Db.GetFields(ac_Cursor, lControl.Tag)
                        
                    Case "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL", "COMMANDBUTTON"
                        'Do Nothing
                    
                    Case "ARMGRID"
                        ' LOAD GRID
                    Case "ARMPICKER"
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                            lControl.ItemCode = mo_Db.GetFields(ac_Cursor, lValues(0))
                            lControl.ItemDescription = mo_Db.GetFields(ac_Cursor, lValues(1))
                            If lControl.ItemCode = "0" And lControl.ItemDescription = "" Then lControl.ItemCode = ""
                        End If
                    Case Else
                        Debug.Print "LoadDataToForm  -> " & UCase(TypeName(lControl))
                End Select
            End If
            Set lControl = Nothing
        Next

    Exit Sub

ErrHandler:
    If Not lControl Is Nothing Then Set lControl = Nothing
    Call ErrorHandler("LoadDataToForm")

End Sub

Private Sub LoadDataToSubForm(ByRef as_detailData As Dictionary, ByRef aControls As Variant, ByRef aContainer As Object)
On Error GoTo ErrHandler
   
    Dim lIdx As Long, lCount As Long
    Dim lControl As Control
    Dim lValues As Variant
    Dim ls_TempTag As String
    
        lCount = aControls.Count - 1
    
        For lIdx = 0 To lCount
            Set lControl = aControls.Item(lIdx)
            If HasContainer(lControl, aContainer) Then
                Select Case UCase(TypeName(lControl))
                    Case "TEXTBOX"
                            ls_TempTag = lControl.Tag & SEP
                            lValues = Split(ls_TempTag, SEP)
                            If as_detailData.Exists(lValues(0)) Then
                                Select Case lValues(1)
                                    Case "Text"
                                        lControl.Text = as_detailData(lValues(0))
                                    Case "Num"
                                        lControl.Text = Replace(as_detailData(lValues(0)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                    Case "Date"
                                        If as_detailData(lValues(0)) = "00:00:00" Or as_detailData(lValues(0)) = "" Then
                                            lControl.Text = ""
                                        Else
                                            lControl.Text = Format(as_detailData(lValues(0)), "dd\/mm\/yyyy")
                                        End If
                                End Select
                            End If
                    
                    Case "ARMCOMBOBOX"
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If as_detailData.Exists(lValues(0)) Then
                            If as_detailData(lValues(0)) = 0 Or as_detailData(lValues(0)) = "" Then
                                Set lControl.SelectedItem = Nothing
                            Else
                                If lControl.SearchItem(as_detailData(lValues(0)), 0, 0, True) = False Then
                                    If lControl.AddItem(Array(as_detailData(lValues(0)), as_detailData(lValues(1))), True) Is Nothing Then
                                        Err.Raise 2222, "", ""
                                    End If
                                End If
                            End If
                        End If
                        
                    Case "OPTIONBUTTON"
                        lValues = Split(lControl.Tag, SEP)
                        If as_detailData.Exists(lValues(0)) Then
                            If UCase(lValues(2)) Like UCase(as_detailData(lValues(0))) Then
                                lControl.Value = True
                            End If
                        End If
                        
                    Case "CHECKBOX"
                        If as_detailData.Exists(lControl.Tag) Then
                            If UCase(as_detailData(lControl.Tag)) Like "X" Then
                                lControl.Value = vbChecked
                            Else
                                lControl.Value = vbUnchecked
                            End If
                        End If
                        
                    Case "A_CALOCX"
                        lControl.date_courte = Format(as_detailData(lControl.Tag), "dd\/mm\/yyyy")
                        
                    Case "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL", "COMMANDBUTTON"
                        'Do Nothing
                    
                    Case "ARMGRID"
                        ' LOAD GRID
                    Case "ARMPICKER"
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If as_detailData.Exists(lValues(0)) Then
                            lControl.ItemCode = as_detailData(lValues(0))
                            lControl.ItemDescription = as_detailData(lValues(1))
                            If lControl.ItemCode = "0" And lControl.ItemDescription = "" Then lControl.ItemCode = ""
                        End If
                    
                    Case Else
                        Debug.Print "LoadDataToSubForm  -> " & UCase(TypeName(lControl))
                End Select
            End If
            Set lControl = Nothing
        Next

    Exit Sub

ErrHandler:
    If Not lControl Is Nothing Then Set lControl = Nothing
    Call ErrorHandler("LoadDataToSubForm")

End Sub

' Load the labels of a containers
Private Sub LoadLabels(ByRef aControls As Variant, ByVal as_ScreenName As String, ByVal as_Language As String)

On Error GoTo ErrHandler

    Dim lIdx As Long, lCount As Long, lLabels As Long
    Dim lControl As Control
    
    lLabels = OpenSQLSafe(mo_Db, "exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    Debug.Assert (lLabels <> 0)
    
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
            Select Case UCase(TypeName(lControl))
                Case "LABEL", "FRAME", "COMMANDBUTTON", "OPTIONBUTTON", "MENU", "CHECKBOX"
                    If lControl.Tag <> "" Then
                        If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                        ' once translation is done and control is not in array CLEAR tag
                        If Not TypeOf lControl Is Frame And Not TypeOf lControl Is Label Then
                            lControl.Tag = ""
                        End If
                    End If
                Case "ARMGRID"
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                      Call lControl.LoadConstants(ptStatic, mo_Db.GetFields(lLabels, "LOCAL_TEXT"), ctColumns)
                        End If
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag & "_Title", , 1) >= 0 Then
                      lControl.Title = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                    End If
                Case "TABSTRIP"
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                        Dim lsa_TextArr() As String
                        Dim ll_Index As Long
                        
                        lsa_TextArr = Split(mo_Db.GetFields(lLabels, "LOCAL_TEXT"), SEP)
                        
                        For ll_Index = LBound(lsa_TextArr, 1) To UBound(lsa_TextArr, 1)
                            lControl.Tabs(ll_Index + 1).Caption = lsa_TextArr(ll_Index)
                        Next
                    End If
                    ' once translation is done and control is not in array CLEAR tag
                    lControl.Tag = ""
                Case "MSFLEXGRID", "TOOLBARCONTROL", "TEXTBOX", "ARMCHECKVIEW", "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TOOLBR", "SPINBUTTON"
                    ' Do nothing !
                Case Else
                    'debug.print "LoadLabels " & UCase(TypeName(lControl))
            End Select
        Set lControl = Nothing
    Next
    
    ' SPECIAL INITIALIZATION
    ' Title
    If mo_Db.Find(lLabels, "FIELD_NAME", "title", , 1) >= 0 Then
        ms_Title = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
    End If

    Call mo_Db.Close(lLabels)

    Exit Sub

ErrHandler:
    If lLabels > 0 Then
        Call mo_Db.Close(lLabels)
    End If
    Call ErrorHandler(Extender.Name & ".LoadLabels")
End Sub

Private Function GetContainedControlsChain(ByVal ao_parent As Object) As Collection
On Error GoTo ErrHandler
    Dim lo_retCollection As New Collection
    Dim lo_Control As Object
    
    For Each lo_Control In Controls
        If Not TypeOf lo_Control.Container Is SPA_Admin_MKT_USER Then
            If ao_parent.hwnd = lo_Control.Container.hwnd Then
                If TypeOf lo_Control Is Frame Then
                    Dim lo_aux_collection As New Collection
                    Dim ll_i As Long
                    Set lo_aux_collection = GetContainedControlsChain(lo_Control)
                    For ll_i = 1 To lo_aux_collection.Count
                        lo_retCollection.Add (lo_aux_collection.Item(ll_i))
                    Next
                Else
                    Call lo_retCollection.Add(lo_Control)
                End If
            End If
        End If
    Next
    Set GetContainedControlsChain = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetContainedControlsChain()")
End Function

' as_Name equals to Tag definition string

Private Function GetControl(ByVal ao_array As Object, ByVal as_Name As String) As Object
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_array
        If StrComp(lo_ctrl.Tag, as_Name, vbTextCompare) = 0 Then
            Set GetControl = lo_ctrl
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetControl()")
End Function

Private Sub SetEnabled(ByVal ao_srcCtrl As Object, ByVal ab_Value As Boolean)
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_srcCtrl
        Call SetEnabledCtrl(lo_ctrl, ab_Value)
    Next
    Exit Sub
ErrHandler:
     Call ErrorHandler(Extender.Name & ".SetEnabled()")
End Sub

Private Sub SetEnabledCtrl(ByRef ao_ctrl As Control, ByVal ab_Value As Boolean)
On Error GoTo ErrHandler
        Select Case UCase(TypeName(ao_ctrl))
        Case "TEXTBOX"
            ao_ctrl.Locked = Not ab_Value
            ao_ctrl.BackColor = IIf(ab_Value, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
        Case "TABSTRIP", "A_CALOCX", "ARMCOMBOBOX", "FRAME", "DIRLISTBOX", "DRIVELISTBOX", "FILELISTBOX", "OPTIONBUTTON", "ARMTREEVIEW", "COMMANDBUTTON", "PICTUREBOX", "CHECKBOX", "IMAGECOMBO"
            ao_ctrl.Enabled = ab_Value
        Case "ARMPICKER"
            ao_ctrl.Enabled = ab_Value
        Case "ARMGRID"
        End Select
    Exit Sub
ErrHandler:
     Call ErrorHandler(Extender.Name & ".SetEnabledCtrl()")
End Sub


' loads values from cursor into form. if cursor=0 then reset whole detail
Private Sub Item_LoadValues(ByVal as_Key As String)
On Error GoTo ErrHandler
    Dim ls_req As String

    mb_Initializing = True
    If as_Key <> "" Then
        Debug.Assert (isNumeric(as_Key))
        
        If ml_cursor_SelectedValues > 0 Then
            Call mo_Db.Close(ml_cursor_SelectedValues)
            ml_cursor_SelectedValues = 0
        End If
        
        ' load main record
        ls_req = ReplacePlaceHolder(ReplaceCommonPlaceholders(REQ_SELECT_SPA_MKT_USER), "$SPA_U_Code$", as_Key)
        ml_cursor_SelectedValues = OpenSQLSafe(mo_Db, ls_req)
        
        txt_Key.Text = as_Key
        
        cbo_coveringUser.Request = ReplaceCommonPlaceholders(REQ_COVERING_USER_CBO)
        cbo_coveringUser.Request = ReplacePlaceHolder(cbo_coveringUser.Request, "$USER_Code$", as_Key)

        cbo_replacer.Request = ReplaceCommonPlaceholders(REQ_REPLACER_CBO)
        cbo_replacer.Request = ReplacePlaceHolder(cbo_replacer.Request, "$USER_Code$", as_Key)
        
        cbo_nextUser.Request = ReplaceCommonPlaceholders(REQ_NEXT_USER_CBO)
        cbo_nextUser.Request = ReplacePlaceHolder(cbo_nextUser.Request, "$USER_Code$", as_Key)

        Call LoadDataToForm(ml_cursor_SelectedValues, UserControl.Controls, Me)
        
        If Not grd_replacement.Load(ReplacePlaceHolder(ReplaceCommonPlaceholders(REQ_REPLACEMENT_GRID), "$SPA_U_Code$", as_Key), True, , , False) Then
            Call Err.Raise(ArmErr.CompFncFailed, "grd_replacement.Load", "Loading grid of replacement failed!")
        End If
        
        If Not grd_SPA_Requests.Load(ReplacePlaceHolder(ReplaceCommonPlaceholders(REQ_SPA_PENDING_REQUERSTS_GRID), "$Auth_U_Code$", as_Key), True, , , False) Then
            Call Err.Raise(ArmErr.CompFncFailed, "grd_SPA_Requests.Load", "Loading grid of pending SPA requests failed!")
        End If
        
        If Not grd_UserMarkets.Load(ReplacePlaceHolder(ReplaceCommonPlaceholders(REQ_USERMARKET_GRID), "$USER_Code$", as_Key), True, , , False) Then
            Call Err.Raise(ArmErr.CompFncFailed, "grd_UserMarkets.Load", "Loading grid of user markets failed!")
        End If

        'loads data to armcheckviews
        ckv_markets.Calling_Key_Values = as_Key
        ckv_markets.LoadList

        ml_iConcurrency = mo_Db.GetFields(ml_cursor_SelectedValues, "iConcurrency")
                
    Else
        ' load default values
        txt_Key.Text = "NEW"
        txt_Date.Text = Format(Now, "DD/MM/YYYY")
        Txt_Creator.Text = ms_LoginName
        grd_replacement.Requests = ""
        grd_SPA_Requests.Requests = ""
        grd_UserMarkets.Requests = ""
    
        ckv_markets.Calling_Key_Values = ""
        Call ckv_markets.Init
    End If
    
    mb_Initializing = False

    Exit Sub
ErrHandler:
    If ml_cursor_SelectedValues > 0 Then
        Call mo_Db.Close(ml_cursor_SelectedValues)
        ml_cursor_SelectedValues = 0
    End If
    Call ErrorHandler(Extender.Name & ".Item_LoadValues")
End Sub

' free resources
Private Sub Item_Cleanup()
On Error GoTo ErrHandler
    mb_Initializing = True
    mb_Initializing = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Cleanup")
End Sub

' clear all controls values
Private Sub Item_Clear()
On Error GoTo ErrHandler
    mb_Initializing = True
    Call ClearForm(UserControl.Controls, fra_Detail)
    mb_Initializing = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Clear")
End Sub

' initialize view mode
Private Sub Item_ViewInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    
    Call ResetScreen(ArmScreenMode.smView)
    Call Item_Clear
    
    ' loading values
    Call Item_LoadValues(CStr(as_detailKey(0)))
    
    Call UpdateUI(ArmScreenMode.smView)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ViewInit")
End Sub

' initialize delete mode
Private Sub Item_DeleteInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    
    Call ResetScreen(ArmScreenMode.smDelete)
    Call Item_Clear
        
    Call Item_LoadValues(CStr(as_detailKey(0)))
    
    Call UpdateUI(ArmScreenMode.smDelete)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_DeleteInit")
End Sub

' initialize update mode
Private Sub Item_UpdateInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smUpdate)
    Call Item_Clear
        
    Call ckv_markets.LoadEditLists
    
    Call Item_LoadValues(CStr(as_detailKey(0)))
    
    Call UpdateUI(ArmScreenMode.smUpdate)
    
    
'    If chk_dropped.value = vbChecked Then
'        ' deleted task cannot by edited
'        Call MsgBox(MsgText(ErrMsgUpdateDeletedTask, ms_Language_Code, "#It is not possible to update already deleted task!"), vbInformation)
'        ' move to view mode
'        Call popScreenMode
'        Call ResetScreen(ArmScreenMode.smView)
'        Call UpdateUI(ArmScreenMode.smView)
'    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateInit")
End Sub

' deletes item
Private Function Item_Delete(ByVal av_oldKey As Variant) As Variant
On Error GoTo ErrHandler
    
    If SendMessage("Delete record ?", vbQuestion + vbYesNo) = vbYes Then
    
        If Not GetToken Then
            Call MsgBox(MsgText(mo_tokenManager.LastErrorCode, ms_Language_Code, mo_tokenManager.lastErrorMsg), vbInformation)
            Exit Function
        End If
        
        ms_ErrMessage = ""
        
        Call Item_DeleteDB(av_oldKey(0))
        
        If ms_ErrMessage <> "" Then
            Call MsgBox(ms_ErrMessage, vbInformation)
            Exit Function
        End If
    
        Call ReleaseToken
        
        RaiseEvent OnItemDelete(av_oldKey)
        
        Call Item_Exit
        
        Item_Delete = av_oldKey
    End If
    Exit Function
ErrHandler:
    Call UpdateError(True)
    Call ReleaseToken
    Call UpdateError(False)
   
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        Call MsgBox(MsgText(ErrMsgDuplicateLevel, ms_Language_Code, "#Someone changed detail of this record and detail screen will be reloaded."), vbInformation)
        Call Item_Restore(av_oldKey)
        Exit Function
    End If
    
    Call ErrorHandler(Extender.Name & ".Item_Delete")
End Function

' workw with smView, smUpdate and smDelete mode
Private Sub Item_Restore(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(activeScreenMode)
    Call Item_Clear
    
    Call Item_LoadValues(CStr(as_detailKey(0)))
    Call UpdateUI
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Restore")
End Sub

' TAKE TOKEN FOR ADMIN
Private Function GetToken() As Boolean
On Error GoTo ErrHandler
    GetToken = mo_tokenManager.GetToken(C_ABPE_SPA_TOKEN, SPA_Admin_ScreenValidate)
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetToken")
End Function

Private Sub ReleaseToken()
On Error GoTo ErrHandler
    Call mo_tokenManager.ReleaseToken
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ReleaseToken")
End Sub

' update current edited item
Private Function Item_CanUpdate() As Boolean
Const REQ_GET_PRIORITY As String = "exec SPA_AuthRoles_get2 $SPR_Code2$"
Const REQ_GET_PRIORITY_UCODE As String = "exec SPA_AuthRoles_get $USER_Code$"
Const REQ_GET_USED_AS_NEXT_USER As String = "exec SPA_UserRoles_Exists2 $USER_Code$"
Const REQ_GET_APPROVER_FOR_UCODE As String = "exec SPA_AuthMarketUser_Link_lst3 $Next_U_Code$,4,'E'"

On Error GoTo ErrHandler
Dim ll_Idx                  As Long
Dim ll_Idx2                 As Long
Dim ll_Cursor               As Long
Dim ls_req                  As String
Dim ll_Priority             As Long
Dim ll_Priority_NextUser    As Long
Dim ll_Next_U_Code          As Long
Dim lb_NextUserSelected     As Boolean
Dim lb_ApproverSelected     As Boolean
Dim ld_ApproverMarkets()    As Long
    
    lb_ApproverSelected = False
    
    'check if this user is approver for at least one market
    For ll_Idx = 1 To ckv_markets.RoleCount
        If ckv_markets.RoleList(ll_Idx).Mode = clModeEdit Then
            If ckv_markets.RoleList(ll_Idx).CommonRoleValues(0) = eSPA_UserType_Code.SPA_Approver Then
                If ckv_markets.RoleList(ll_Idx).CheckedCount > 0 Then
                    lb_ApproverSelected = True
                End If
                
                For ll_Idx2 = 1 To ckv_markets.RoleList(ll_Idx).Count
                    If ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).CurrentChecked = False And _
                       ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).OriginalChecked = True Then
                       
                       'check if selected somewhere as NextUser
                        ls_req = Item_ReplacePlaceholders(REQ_GET_USED_AS_NEXT_USER)
                        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
                        If ll_Cursor > 0 Then
                            If mo_Db.RowCount(ll_Cursor) > 0 Then
                                ms_ErrMessage = "#You cannot uncheck markets because this user is selected as Next User for other user(s)."
                                Item_CanUpdate = False
                                Call mo_Db.Close(ll_Cursor)
                                ll_Cursor = 0
                                Exit Function
                            End If
                        End If
                        Call mo_Db.Close(ll_Cursor)
                        ll_Cursor = 0
                    End If
                Next
                Exit For
            End If
        End If
    Next

    If GetComboKey(cbo_role) = "" Then
    
        If lb_ApproverSelected = True Then
            ms_ErrMessage = MsgText(ErrMsg_SPA.ErrMsg_M420, ms_Language_Code, "#You must choose a role because you have selected a type of APPROVER")
            Item_CanUpdate = False
            Exit Function
        End If
    Else
        'he must have Approver selected
        If lb_ApproverSelected = False Then
            ms_ErrMessage = MsgText(ErrMsg_SPA.ErrMsg_M410, ms_Language_Code, "#You must choose at least one market where this user is an APPROVER")
            Item_CanUpdate = False
            Exit Function
        End If
        
        'get priority for currently selected role
        ls_req = Item_ReplacePlaceholders(REQ_GET_PRIORITY)
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
        If ll_Cursor > 0 Then
            ll_Priority = mo_Db.GetFields(ll_Cursor, "Priority")
        End If
        mo_Db.Close (ll_Cursor)
        ll_Cursor = 0
    
        If GetComboKey(cbo_nextUser) = "" Then
            lb_NextUserSelected = False
            ll_Next_U_Code = 0
        Else
            lb_NextUserSelected = True
            ll_Next_U_Code = cbo_nextUser.SelectedItem.Key
        End If
        
        'check priority and next user combination
        If ll_Priority = 0 And ll_Next_U_Code > 0 Then
            ms_ErrMessage = MsgText(ErrMsg_SPA.ErrMsg_M440, ms_Language_Code, "#The next user must be empty as you have selected the highest priority role.")
            Item_CanUpdate = False
            Exit Function
        End If
        
        If ll_Priority > 0 Then
            'get priority for currently selected next user
            If ll_Next_U_Code > 0 Then
                ls_req = Replace(REQ_GET_PRIORITY_UCODE, "$USER_Code$", ll_Next_U_Code, , , vbTextCompare)
                ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
                If ll_Cursor > 0 Then
                    If mo_Db.RowCount(ll_Cursor) = 1 Then
                    ll_Priority_NextUser = mo_Db.GetFields(ll_Cursor, "Priority")
                    Else
                        ll_Priority_NextUser = -1
                End If
                End If
                mo_Db.Close (ll_Cursor)
            Else
                ll_Priority_NextUser = -1
            End If
            
            If ll_Priority_NextUser = -1 Or ll_Priority_NextUser >= ll_Priority Then
                ms_ErrMessage = MsgText(ErrMsg_SPA.ErrMsg_M450, ms_Language_Code, "#The next user must be entered with a smaller priority number")
                Item_CanUpdate = False
                Exit Function
            End If
        End If
                
        'check if next user covers all markets with approver user type
        If ll_Next_U_Code > 0 And lb_ApproverSelected = True Then
            
            ls_req = Replace(REQ_GET_APPROVER_FOR_UCODE, "$Next_U_Code$", ll_Next_U_Code, , , vbTextCompare)
            ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
            ReDim ld_ApproverMarkets(-1 To -1)
            
            If ll_Cursor > 0 Then
                ReDim ld_ApproverMarkets(mo_Db.RowCount(ll_Cursor) - 1)
                ll_Idx = 0
                While Not mo_Db.EOF(ll_Cursor)
                    ld_ApproverMarkets(ll_Idx) = mo_Db.GetFields(ll_Cursor, "SPM_Code")
                    mo_Db.Next (ll_Cursor)
                    ll_Idx = ll_Idx + 1
                Wend
            End If
        
            mo_Db.Close (ll_Cursor)
            ll_Cursor = 0
            
            For ll_Idx = 1 To ckv_markets.RoleCount
                If ckv_markets.RoleList(ll_Idx).Mode = clModeEdit Then
                    If ckv_markets.RoleList(ll_Idx).CommonRoleValues(0) = 4 And ckv_markets.RoleList(ll_Idx).CheckedCount > 0 Then
                        For ll_Idx2 = 1 To ckv_markets.RoleList(ll_Idx).Count
                            If ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).CurrentChecked = True Then
                                If Not IsInList(ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).GetData(0), ld_ApproverMarkets) Then
                                    ms_ErrMessage = MsgText(ErrMsg_SPA.ErrMsg_M430, ms_Language_Code, "#The next user must be an APPROVER for all markets you have chosen")
                                    Item_CanUpdate = False
                                    Exit Function
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        End If
        
    End If
    
        Item_CanUpdate = True

    Exit Function
ErrHandler:
    Item_CanUpdate = False
    If ll_Cursor > 0 Then
        mo_Db.Close (ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler(Extender.Name & ".Item_CanUpdate")
End Function

Private Function IsApproverSelected() As Boolean
On Error GoTo ErrHandler
Dim ll_Idx As Long

    IsApproverSelected = False
    'check if this user is approver for at least one market
    For ll_Idx = 1 To ckv_markets.RoleCount
        If ckv_markets.RoleList(ll_Idx).Mode = clModeEdit Then
            If ckv_markets.RoleList(ll_Idx).CommonRoleValues(0) = eSPA_UserType_Code.SPA_Approver Then
                IsApproverSelected = ckv_markets.RoleList(ll_Idx).CheckedCount > 0
                Exit Function
            End If
        End If
    Next ll_Idx
    Exit Function
ErrHandler:
    IsApproverSelected = False
    Call ErrorHandler(Extender.Name & ".IsApproverSelected")
End Function

Private Function IsInList(ByVal al_Value As Long, ByRef al_List() As Long) As Boolean
On Error GoTo ErrHandler
Dim ll_Idx As Long

    IsInList = False
    
    For ll_Idx = 0 To UBound(al_List)
        If al_Value = al_List(ll_Idx) Then
            IsInList = True
            Exit Function
        End If
    Next
    
    Exit Function
ErrHandler:
    IsInList = False
    Call ErrorHandler(Extender.Name & ".IsInList")
End Function

' update current edited item
Private Function Item_Update(ByVal av_oldKey As Variant) As Variant
On Error GoTo ErrHandler
Dim ls_newUserRoleCode  As String
Dim ls_SrzString        As String
Dim ll_Idx              As Long
Dim ll_Idx2             As Long
Dim ll_MarketCount      As Long

    If Not GetToken Then
        Call MsgBox(MsgText(mo_tokenManager.LastErrorCode, ms_Language_Code, mo_tokenManager.lastErrorMsg), vbInformation)
        Exit Function
    End If
    
    md_ServerDate = GetServerDate()

' Nothing to check for main item
'    If Not Item_Check(fra_detail) Then
'        Exit Function
'    End If
    
    ms_ErrMessage = ""
    If Not Item_CanUpdate() Then
        Call ReleaseToken
        If ms_ErrMessage <> "" Then
            Call MsgBox(ms_ErrMessage, vbInformation)
        End If
        Exit Function
    End If
    
    ' get new code for SPA_UserRoles
    ls_newUserRoleCode = mo_Db.SQLNextID(C_ID_KEY_ROLES)
        
    ' get new codes for new grid items
    Call SQLNextIDToGrid(grd_replacement, C_ID_KEY_ITEM)
        
    ReDim ma_MKT_USER_ID_LIST(-1 To -1)
    
    ll_MarketCount = 0
    
    For ll_Idx = 1 To ckv_markets.RoleCount
        If ckv_markets.RoleList(ll_Idx).Mode = clModeEdit Then
            ll_MarketCount = ll_MarketCount + ckv_markets.RoleList(ll_Idx).CheckedCount
            For ll_Idx2 = 1 To ckv_markets.RoleList(ll_Idx).Count
                If ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).CurrentChecked = True And _
                   ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).CurrentChecked <> ckv_markets.RoleList(ll_Idx).Items(ll_Idx2).OriginalChecked Then
                    If UBound(ma_MKT_USER_ID_LIST) = -1 Then
                        ReDim ma_MKT_USER_ID_LIST(1)
                    Else
                        ReDim Preserve ma_MKT_USER_ID_LIST(UBound(ma_MKT_USER_ID_LIST) + 1)
                    End If
                    ma_MKT_USER_ID_LIST(UBound(ma_MKT_USER_ID_LIST) - 1) = mo_Db.SQLNextID(C_ID_KEY_MKT_USER)
                End If
            Next
        End If
    Next
        
    ms_ErrMessage = ""
    Call Item_UpdateDB(av_oldKey(0), ls_newUserRoleCode)
    
    If ms_ErrMessage <> "" Then
        Call ReleaseToken
        Call MsgBox(ms_ErrMessage, vbInformation)
        Exit Function
    End If
        
    ls_SrzString = Build_SrzString(UserControl.Controls, Me)
    'this needs to be set manualy to make auto update grid to work
    ls_SrzString = ls_SrzString & "MarketCount" & SEP1 & ll_MarketCount & SEP
    ls_SrzString = ls_SrzString & "L_Code" & SEP1 & mo_Db.GetFields(ml_cursor_SelectedValues, "L_Code") & SEP
    ls_SrzString = ls_SrzString & "C_Code" & SEP1 & mo_Db.GetFields(ml_cursor_SelectedValues, "C_Code") & SEP
    ls_SrzString = ls_SrzString & "U_Code" & SEP1 & mo_Db.GetFields(ml_cursor_SelectedValues, "U_Code") & SEP

    Call ReleaseToken
    
    RaiseEvent OnItemUpdate(av_oldKey, ls_SrzString)

    Call Item_Exit

    Item_Update = CVar(Array(av_oldKey(0)))

    Exit Function
ErrHandler:
    Call UpdateError(True)
    Call ReleaseToken
    Call UpdateError(False)
    Call ErrorHandler(Extender.Name & ".Item_Update")
End Function

' clear all controls values
Private Sub SubItem_Clear()
On Error GoTo ErrHandler
    mb_Initializing = True
    Call ClearForm(UserControl.Controls, fra_authLevelDetail)
    mb_Initializing = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Clear")
End Sub

' initialize view mode
Private Sub SubItem_ViewInit(ByRef ao_detailData As Dictionary)
On Error GoTo ErrHandler
    
    Call SubItem_Clear
    
    ' loading values
    Call SubItem_LoadValues(ao_detailData)
    
    fra_authLevelDetail.Visible = True
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_ViewInit")
End Sub

' initialize delete mode
Private Sub SubItem_DeleteInit(ByRef ao_detailData As Dictionary)
On Error GoTo ErrHandler
    
    Call ResetScreen(ArmScreenMode.smDeleteItem)
    Call SubItem_Clear
        
    Call SubItem_LoadValues(ao_detailData)
    
    Call UpdateUI(ArmScreenMode.smDeleteItem)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_DeleteInit")
End Sub

' deletes Subitem
Private Sub SubItem_Delete()
On Error GoTo ErrHandler
    
    If SendMessage(MsgText(ErrMsg_M360, ms_Language_Code, "#Do you really want to delete this record."), vbQuestion + vbYesNo) = vbYes Then
    
        ' do local update of the grid
        Call DeleteLineToGrid(grd_replacement, Array("SPUR_Id"), grd_replacement.SelectedKey(0))

        Call SubItem_Exit
        
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_Delete")
End Sub

' 0 means everything ok
Private Function SubItem_CanUpdate() As Long
On Error GoTo ErrHandler
    
    SubItem_CanUpdate = 0
    
    If grd_replacement.SelectedCount = 0 Then
        SubItem_CanUpdate = WarMsgSelectRow
        Exit Function
    End If
    
    If grd_replacement.CurrentLine("change") = "D" Then
        SubItem_CanUpdate = ErrMsgItemIsDeleted
        Exit Function
    End If
    
    If grd_replacement.CurrentLine("Date_End") <= GetServerDate() Then
        SubItem_CanUpdate = ErrMsg_M390
        Exit Function
    End If
    
        Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_CanUpdate")
End Function

' 0 meas everything ok
Private Function SubItem_CanAdd() As Long
On Error GoTo ErrHandler
    
    SubItem_CanAdd = 0
    
        Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_CanAdd")
End Function

Private Function OverlappedDates(ByVal ac_date_start As A_calocx, ByVal ac_date_end As A_calocx, ByVal as_CurrKey As String) As Boolean
On Error GoTo ErrHandler

    Debug.Assert (grd_replacement.Cols > 0)
    Dim ll_Row As Long, ll_RowCount As Long, ll_Col As Long
    Dim lo_Column As ArmColumn
    Dim ld_Date_Start   As Date
    Dim ld_Date_End     As Date
    Dim ls_Change       As String
    
    OverlappedDates = False
    
    ll_RowCount = grd_replacement.Rows - 1
    For ll_Row = 0 To ll_RowCount
        If grd_replacement.Data(ll_Row, "change") <> "D" And as_CurrKey <> grd_replacement.Data(ll_Row, "SPUR_Id") Then
            ld_Date_Start = grd_replacement.Data(ll_Row, "Date_Start")
            ld_Date_End = grd_replacement.Data(ll_Row, "Date_End")
            
            If ac_date_start.date_dt <= ld_Date_End And ac_date_start.date_dt >= ld_Date_Start Then
                OverlappedDates = True
                Exit Function
            End If
            
            If ac_date_end.date_dt <= ld_Date_End And ac_date_end.date_dt >= ld_Date_Start Then
                OverlappedDates = True
                Exit Function
            End If
            
        End If
    Next

    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".OverlappedDates")
End Function

' 0 meas everything ok
Private Function SubItem_CanDelete() As Long
On Error GoTo ErrHandler
    SubItem_CanDelete = 0
    
    If grd_replacement.SelectedCount = 0 Then
        SubItem_CanDelete = WarMsgSelectRow
        Exit Function
    End If
    
    If grd_replacement.CurrentLine("change") = "D" Then
        SubItem_CanDelete = ErrMsgItemIsDeleted
        Exit Function
    End If
    
    If grd_replacement.CurrentLine("Date_Start") <= GetServerDate() Then
        SubItem_CanDelete = ErrMsg_M400
        Exit Function
    End If
    
        Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_CanDelete")
End Function

' initialize add mode
Private Sub SubItem_AddInit(ByRef ao_detailData As Dictionary)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smAddItem)
    Call SubItem_Clear
    
    If ao_detailData.Exists("Z_Creation") Then
        ao_detailData("Z_Creation") = Format(Now, "DD/MM/YYYY")
    Else
        Call ao_detailData.Add("Z_Creation", Format(Now, "DD/MM/YYYY"))
    End If
    
    Call ao_detailData.Add("Date_Start", Format(Now, "DD/MM/YYYY"))
    Call ao_detailData.Add("Date_End", Format(Now, "DD/MM/YYYY"))
    
    ' initialize covering user
    If Not cbo_nextUser.SelectedItem Is Nothing Then
        Call ao_detailData.Add("Covering_U_Code", cbo_nextUser.SelectedItem.Key)
        Call ao_detailData.Add("Covering_P_Name", cbo_nextUser.SelectedItem.DisplayText)
    End If
    
    Call SubItem_LoadValues(ao_detailData)
    
    Call UpdateUI(ArmScreenMode.smAddItem)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_AddInit")
End Sub

' initialize update mode
Private Sub SubItem_UpdateInit(ByRef ao_detailData As Dictionary)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smUpdateItem)
    Call SubItem_Clear
    
    If ao_detailData("change") <> "A" Then ao_detailData("change") = "U"
    
    Call SubItem_LoadValues(ao_detailData)
    
    If cal_date_Start.date_dt < Date Then
        Call SetEnabledCtrl(cal_date_Start, False)
        Call SetEnabledCtrl(cbo_coveringUser, False)
    End If
    
    Call UpdateUI(ArmScreenMode.smUpdateItem)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_UpdateInit")
End Sub

' adds Subitem
Private Sub SubItem_Add()
On Error GoTo ErrHandler

Dim ls_ReqCheck As String
Dim lb_IsUsedToday   As Boolean
Dim ld_ServerDate As Date

    ' check values and throw message if neccessary
    If Not Item_Check(fra_authLevelDetail) Then
        Exit Sub
    End If
    
    If cal_date_Start.date_courte = "" Then
        MsgBox MsgText(ErrMsgMandatoryAreEmpty, ms_Language_Code, "#ErrMsgMandatoryAreEmpty."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    ls_ReqCheck = Item_ReplacePlaceholders(REQ_USER_HAS_OPEN_SPA)
    lb_IsUsedToday = EntryIsUsed(ls_ReqCheck)
    
    ld_ServerDate = GetServerDate()
    
    If lb_IsUsedToday = True And cal_date_Start.date_dt = DateValue(ld_ServerDate) Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M707, ms_Language_Code, "#The Replacement start date must be greater than today, because user has open SPA's"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If cal_date_Start.date_dt < DateValue(ld_ServerDate) Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M460, ms_Language_Code, "#The Replacement start date must be greater than today"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If cal_date_end.date_courte = "" Then
        MsgBox MsgText(ErrMsgMandatoryAreEmpty, ms_Language_Code, "#ErrMsgMandatoryAreEmpty."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If cal_date_end.date_dt < cal_date_Start.date_dt Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M470, ms_Language_Code, "#The Replacement end date must be greater than or equal to the replacement start date"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
'    If GetComboKey(cbo_coveringUser) = "" Then
 '       MsgBox MsgText(ErrMsgMandatoryAreEmpty, ms_Language_Code, "#ErrMsgMandatoryAreEmpty."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
 '       Exit Sub
  '  End If

    If OverlappedDates(cal_date_Start, cal_date_end, "") = True Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M480, ms_Language_Code, "#The Replacement period you have entered conflicts with another replacement for this user"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    Dim lo_detailData As Dictionary
    Set lo_detailData = New Dictionary
    lo_detailData.CompareMode = TextCompare
    
    ' do the local update of grid
    Call FillDataSrcArray(lo_detailData, Build_SrzString(UserControl.Controls, fra_authLevelDetail))
       
    Call AddLineToGrid(grd_replacement, lo_detailData)
    
    Set lo_detailData = Nothing
    
    Call SubItem_Exit
    
    Exit Sub
ErrHandler:
    Set lo_detailData = Nothing
    Call ErrorHandler(Extender.Name & ".SubItem_Add")
End Sub

' update current edited Subitem
Private Sub SubItem_Update()
On Error GoTo ErrHandler

Dim ls_ReqCheck As String
Dim lb_IsUsedToday   As Boolean
Dim ld_ServerDate As Date

    If Not Item_Check(fra_authLevelDetail) Then
        Exit Sub
    End If
    
    If cbo_coveringUser.SelectedItem Is Nothing Then
        MsgBox MsgText(ErrMsgMandatoryAreEmpty, ms_Language_Code, "#ErrMsgMandatoryAreEmpty."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    ls_ReqCheck = Item_ReplacePlaceholders(REQ_USER_HAS_OPEN_SPA)
    lb_IsUsedToday = EntryIsUsed(ls_ReqCheck)
    
    ld_ServerDate = GetServerDate()
    
    If lb_IsUsedToday = True And cal_date_Start.date_dt = DateValue(ld_ServerDate) Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M707, ms_Language_Code, "#The Replacement start date must be greater than today, because user has open SPA's"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If cal_date_Start.Enabled = True And cal_date_Start.date_dt < DateValue(ld_ServerDate) Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M460, ms_Language_Code, "#The Replacement start date must be greater than today"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If cal_date_end.date_dt < DateValue(ld_ServerDate) Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M500, ms_Language_Code, "#The Replacement end date must be greater than today"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If cal_date_end.date_dt < cal_date_Start.date_dt Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M470, ms_Language_Code, "#The Replacement end date must be greater than or equal to the replacement start date"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    If OverlappedDates(cal_date_Start, cal_date_end, grd_replacement.CurrentLine("SPUR_Id")) = True Then
        MsgBox MsgText(ErrMsg_SPA.ErrMsg_M480, ms_Language_Code, "#The Replacement period you have entered conflicts with another replacement for this user"), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    Dim lo_detailData As Dictionary
    Set lo_detailData = New Dictionary
    lo_detailData.CompareMode = TextCompare
    
    Call FillDataSrcArray(lo_detailData, Build_SrzString(UserControl.Controls, fra_authLevelDetail))
    
    ' do local update of the grid
    Call UpdateLineToGrid(grd_replacement, lo_detailData, Array("SPUR_Id"))
    
    Set lo_detailData = Nothing
    
    Call SubItem_Exit

    Exit Sub
ErrHandler:
    Set lo_detailData = Nothing
    Call ErrorHandler(Extender.Name & ".SubItem_Update")
End Sub

Private Sub SubItem_Exit()
On Error GoTo ErrHandler
    
    ' pop last item in screen mode stack
    Call popScreenMode
    
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_Exit")
End Sub

' workw with smViewItem, smUpdateItem and smDeleteItem mode
Private Sub SubItem_Restore(ByRef as_detailData As Dictionary)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(activeScreenMode)
    Call SubItem_Clear
    
    Call SubItem_LoadValues(as_detailData)
    Call UpdateUI

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_Restore")
End Sub

Private Sub SubItem_LoadValues(ByRef as_detailData As Dictionary)
On Error GoTo ErrHandler
    Dim ls_req As String
    mb_Initializing = True
    
    ' load main record
    Call LoadDataToSubForm(as_detailData, UserControl.Controls, fra_authLevelDetail)
    
    mb_Initializing = False

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_LoadValues")
End Sub

Private Function GetGridKeyColumnFieldName(ByRef ao_grid As ArmGrid) As String
On Error GoTo ErrHandler
    Dim ll_Col As Long
    
    GetGridKeyColumnFieldName = ""
    For ll_Col = 0 To ao_grid.Cols - 1
        If ao_grid.Columns(ll_Col).Key Then
            ' we have key
            GetGridKeyColumnFieldName = ao_grid.Columns(ll_Col).FieldName
            Exit For
        End If
    Next

    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetGridKeyColumnFieldName")
End Function

Private Sub SQLNextIDToGrid(ByRef ao_grid As ArmGrid, ByVal as_A_ID_KEY As String)
On Error GoTo ErrHandler
    Dim ll_Row As Long, ll_Col As Long
    Dim ls_keyColField As String
    Dim lo_Column  As ArmColumn

    ' find key column
    ls_keyColField = GetGridKeyColumnFieldName(ao_grid)
    If ls_keyColField = "" Then
        Call Err.Raise(ArmErr.InvalidArgument, "ao_grid", "Grid does not containt key column")
    End If
    
    ' iterate grid and create new ID
    For ll_Row = 0 To ao_grid.Rows - 1
        ' determine if row is new
        If ao_grid.Data(ll_Row, ls_keyColField) Like "NEW*" Then
            ao_grid.Data(ll_Row, ls_keyColField) = mo_Db.SQLNextID(as_A_ID_KEY)
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SQLNextIDToGrid")
End Sub

' works only for one key column grids
Private Sub SaveGridToDb(ByRef ao_grid As ArmGrid, ByVal as_addReq As String, ByVal as_updReq As String, ByVal as_delReq As String)
On Error GoTo ErrHandler
    Dim ll_Row As Long
    Dim ls_req  As String

    ' iterate grid and insert/update
    as_addReq = ReplaceCommonPlaceholders(as_addReq)
    as_updReq = ReplaceCommonPlaceholders(as_updReq)
    as_delReq = ReplaceCommonPlaceholders(as_delReq)
    
    For ll_Row = ao_grid.Rows - 1 To 0 Step -1
        Select Case ao_grid.Data(ll_Row, "change")
        Case "A"
            ls_req = ReplacePlaceholderByGridRow(as_addReq, ao_grid, ll_Row)
            ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
            Debug.Print ls_req
            Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        Case "U"
            ls_req = ReplacePlaceholderByGridRow(as_updReq, ao_grid, ll_Row)
            ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
            Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        Case "D"
            ls_req = ReplacePlaceholderByGridRow(as_delReq, ao_grid, ll_Row)
            ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
            Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        End Select
        ao_grid.Data(ll_Row, "change") = ""
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SaveGridToDb")
End Sub

' works only for one key column grids
Private Sub ClearGridToDb(ByRef ao_grid As ArmGrid, ByVal as_delReq As String)
On Error GoTo ErrHandler
    Dim ll_Row As Long
    Dim ls_req  As String

    ' iterate grid and insert/update
    as_delReq = ReplaceCommonPlaceholders(as_delReq)
    
    For ll_Row = 0 To ao_grid.Rows - 1
        Select Case ao_grid.Data(ll_Row, "change")
        Case "A"
            ls_req = ReplacePlaceholderByGridRow(as_delReq, ao_grid, ll_Row)
            Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        Case "U", "D"
        End Select
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ClearGridToDb")
End Sub

Private Sub Item_UpdateDB(ByVal as_Code As String, ByVal as_NewUserRoleCode As String)
On Error GoTo ErrHandler

Dim ls_ReqInsert        As String
Dim ls_ReqUpdate        As String
Dim ls_ReqClose         As String
Dim ls_ReqDelete        As String
Dim ls_ReqCheck         As String
Dim lb_InTran           As Boolean
Dim lb_IsUsedToday   As Boolean
Dim ls_ErrMessage       As String
Dim ls_req              As String
Dim ll_Cursor           As Long

    lb_InTran = False
        
    If mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_Start") = 0 Then
        ' insert, there is no current role in SPA_UserRole table
        

        ls_ReqInsert = ReplaceCommonPlaceholders(REQ_INSERT_SPA_USER_ROLE)
        ls_ReqInsert = Replace(ls_ReqInsert, "$SPU_Id$", as_NewUserRoleCode, , , vbTextCompare)
        ls_ReqInsert = Item_ReplacePlaceholders(ls_ReqInsert)

        Call ExecuteSQLSafe(mo_Db, "BEGIN TRAN Item_Upd")
        lb_InTran = True
        
        If UserRoleIsChanged Then
            ' insert new role
            If Not Insert_ValidityManager(ls_ReqInsert, ls_ErrMessage) Then
                GoTo ErrHandler
            End If
        End If
            
    Else
'        ls_ReqCheck = Item_ReplacePlaceholders(REQ_USERROLE_IS_USED)
'        lb_IsUsedToday = EntryIsUsed(ls_ReqCheck)
        lb_IsUsedToday = True
        
        ls_ReqClose = ReplaceCommonPlaceholders(REQ_CLOSE_SPA_USER_ROLE)
        ls_ReqClose = Item_ReplacePlaceholders(ls_ReqClose)
        
        ls_ReqDelete = ReplaceCommonPlaceholders(REQ_DELETE_SPA_USER_ROLE)
        ls_ReqDelete = Item_ReplacePlaceholders(ls_ReqDelete)
        
        ls_ReqInsert = ReplaceCommonPlaceholders(REQ_INSERT_SPA_USER_ROLE)
        ls_ReqInsert = ReplacePlaceHolder(ls_ReqInsert, "$SPU_Id$", as_NewUserRoleCode)
        ls_ReqInsert = Item_ReplacePlaceholders(ls_ReqInsert)
        
        Call ExecuteSQLSafe(mo_Db, "BEGIN TRAN Item_Upd")
        lb_InTran = True
        
        md_ServerDate = GetServerDate()
        
        If UserRoleIsChanged Then
            If GetComboKey(cbo_role) = "" Then
                'delete from SPA_UserRoles
                If Not Delete_ValidityManager(mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_Start"), _
                                          mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_End"), _
                                          ls_ReqClose, _
                                          ls_ReqDelete, _
                                          lb_IsUsedToday, _
                                          ls_ErrMessage) Then
                    GoTo ErrHandler
                End If
            Else
                'update SPA_UserRoles
                If Not Update_ValidityManager(mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_Start"), _
                                            mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_End"), _
                                            ls_ReqInsert, _
                                            ls_ReqClose, _
                                            ls_ReqDelete, _
                                            lb_IsUsedToday, _
                                            ls_ErrMessage) Then
                    GoTo ErrHandler
                End If
            End If
        End If
    End If

    'save grids
    Call SaveGridToDb(grd_replacement, REQ_REPLACEMENT_INS, REQ_REPLACEMENT_UPD, REQ_REPLACEMENT_DEL)
    
    ' save changed markets
    If ckv_markets.SaveList = False Then
        ls_ErrMessage = ms_ErrMessage
        GoTo ErrHandler
    End If
                
        
    Call ExecuteSQLSafe(mo_Db, "COMMIT TRAN Item_Upd")
    lb_InTran = False

    Exit Sub
ErrHandler:
    If lb_InTran Then
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
        lb_InTran = False
    End If
    If ls_ErrMessage <> "" Then
        ms_ErrMessage = ls_ErrMessage
        Exit Sub
    End If
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        Call MsgBox(MsgText(ErrMsgDuplicateLevel, ms_Language_Code, "#Someone changed detail of this record and detail screen will be reloaded."), vbInformation)
        Call Item_Cleanup
        Call Item_Restore(as_Code)
        Exit Sub
    End If
    Call ErrorHandler(Extender.Name & ".Item_UpdateDb")
End Sub

'insert values in tables with VDate_Start and VDate_End
Private Function Insert_ValidityManager(ByVal as_ReqIns As String, _
                                        ByRef as_ErrMessage As String) As Boolean
On Error GoTo ErrHandler
    
Dim ls_req      As String

    Insert_ValidityManager = False
    as_ErrMessage = ""
    
    'it means that there is no active entry for current user
    'that is why we can just insert new entry into SPA_UserRoles
            
    ls_req = Replace(as_ReqIns, "$VNewDate_Start$", SqlDate(md_ServerDate), , , vbTextCompare)
    ls_req = Replace(ls_req, "$VNewDate_End$", "NULL", , , vbTextCompare)
    
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        
    Insert_ValidityManager = True
    Exit Function
ErrHandler:
    Insert_ValidityManager = False
        
    Call ErrorHandler(Extender.Name & ".Insert_ValidityManager")
End Function

'update values in tables with VDate_Start and VDate_End
Private Function Update_ValidityManager(ByVal ad_CurrVDate_Start As Date, _
                                        ByVal ad_CurrVDate_End As Date, _
                                        ByVal as_ReqInsert As String, _
                                        ByVal as_ReqCloseCurrent As String, _
                                        ByVal as_ReqDelCurrentOrFuture As String, _
                                        ByVal ab_IsUsedToday As Boolean, _
                                        ByRef as_ErrMessage As String) As Boolean
On Error GoTo ErrHandler
    
Dim ls_Request As String

    Update_ValidityManager = False
    as_ErrMessage = ""
    
    Debug.Assert ad_CurrVDate_Start <> 0 'this should not happend for update
    
    If ad_CurrVDate_Start < md_ServerDate Then
        If ab_IsUsedToday Then
            
            ls_Request = Replace(as_ReqCloseCurrent, "$VNewDate_End$", SqlDate(md_ServerDate), , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request, 1)

            ls_Request = Replace(as_ReqInsert, "$VNewDate_Start$", SqlDate(md_ServerDate + 1), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$VNewDate_End$", "NULL", , , vbTextCompare)       ' JN fix 8.2.2011
            Call ExecuteSQLSafe(mo_Db, ls_Request)
        Else
        
            ls_Request = Replace(as_ReqCloseCurrent, "$VNewDate_End$", SqlDate(md_ServerDate - 1), , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request, 1)

            ls_Request = Replace(as_ReqInsert, "$VNewDate_Start$", SqlDate(md_ServerDate), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$VNewDate_End$", "NULL", , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request)
        End If
    ElseIf ad_CurrVDate_Start = md_ServerDate Then
        If ab_IsUsedToday Then
            ls_Request = Replace(as_ReqCloseCurrent, "$VNewDate_End$", SqlDate(md_ServerDate), , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request, 1)

            ls_Request = Replace(as_ReqInsert, "$VNewDate_Start$", SqlDate(md_ServerDate + 1), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$VNewDate_End$", "NULL", , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request)
        Else
            ls_Request = Replace(as_ReqDelCurrentOrFuture, "$VNewDate_Start$", SqlDate(md_ServerDate), , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request, 1)

            ls_Request = Replace(as_ReqInsert, "$VNewDate_Start$", SqlDate(md_ServerDate), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$VNewDate_End$", "NULL", , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request)
        End If
    Else
        ls_Request = Replace(as_ReqDelCurrentOrFuture, "$VNewDate_Start$", SqlDate(md_ServerDate + 1), , , vbTextCompare)
        Call ExecuteSQLSafe(mo_Db, ls_Request)
    End If
    
    Update_ValidityManager = True
    Exit Function
ErrHandler:
    Update_ValidityManager = False
    
    Call ErrorHandler(Extender.Name & ".Update_ValidityManager")
End Function

Private Function Delete_ValidityManager(ByVal ad_CurrVDate_Start As Date, _
                                        ByVal ad_CurrVDate_End As Date, _
                                        ByVal as_ReqCloseCurrent As String, _
                                        ByVal as_ReqDelCurrentOrFuture As String, _
                                        ByVal ab_IsUsedToday As Boolean, _
                                        ByRef as_ErrMessage As String) As Boolean
On Error GoTo ErrHandler
    
Dim ls_Request As String
Dim ld_OldEndDate   As Date
    
    Delete_ValidityManager = False
    as_ErrMessage = ""
    
    ' common placeholders
    If ad_CurrVDate_Start = 0 Then
        'it means that there is no active entry for current user
        ' so there is nothing to delete, should not happen
        Debug.Assert False
    Else
        If ad_CurrVDate_End = 0 Then
            'current rule record is not closed, we must delete it
            If ab_IsUsedToday Then
                ls_Request = Replace(as_ReqCloseCurrent, "$VNewDate_End$", SqlDate(md_ServerDate), , , vbTextCompare)
                Call ExecuteSQLSafe(mo_Db, ls_Request, 1)
            Else
                If (ad_CurrVDate_Start = md_ServerDate) Then
                    ' if rule not used and started today, we can physically delete it
                    ls_Request = Replace(as_ReqDelCurrentOrFuture, "$VNewDate_Start$", SqlDate(md_ServerDate), , , vbTextCompare)
                    Call ExecuteSQLSafe(mo_Db, ls_Request)
                Else
                    ' if rule not used today, we can close it yesterday
                    ls_Request = Replace(as_ReqCloseCurrent, "$VNewDate_End$", SqlDate(md_ServerDate - 1), , , vbTextCompare)
                    Call ExecuteSQLSafe(mo_Db, ls_Request, 1)
                End If
            End If
        ElseIf ad_CurrVDate_End = md_ServerDate Then
            ' this means, current record is already closed, so only solution is to delete FUTURE record rule
            ls_Request = Replace(as_ReqDelCurrentOrFuture, "$VNewDate_Start$", SqlDate(md_ServerDate + 1), , , vbTextCompare)
            Call ExecuteSQLSafe(mo_Db, ls_Request)
        Else
            ' this case cannot happen. Never ever, we should not see past record rule or future ending rule
            Debug.Assert False
        End If
    End If
    
    Delete_ValidityManager = True
    Exit Function
ErrHandler:
    Delete_ValidityManager = False
    
    Call ErrorHandler(Extender.Name & ".Delete_ValidityManager")
End Function

Private Function UserRoleIsChanged() As Boolean
On Error GoTo ErrHandler

    UserRoleIsChanged = False
    
    If GetComboKey(cbo_role) = "" Then
        If mo_Db.GetFields(ml_cursor_SelectedValues, "SPR_Code2") <> 0 Then
            UserRoleIsChanged = True
        End If
    Else
        If cbo_role.SelectedItem.Key <> mo_Db.GetFields(ml_cursor_SelectedValues, "SPR_Code2") Then
            UserRoleIsChanged = True
        End If
    End If
    
    If GetComboKey(cbo_nextUser) = "" Then
        If mo_Db.GetFields(ml_cursor_SelectedValues, "Next_U_Code2") <> 0 Then
            UserRoleIsChanged = True
        End If
    Else
        If cbo_nextUser.SelectedItem.Key <> mo_Db.GetFields(ml_cursor_SelectedValues, "Next_U_Code2") Then
            UserRoleIsChanged = True
        End If
    End If
    
    If chk_noSPAConfEmails.Value = 1 Then
        If mo_Db.GetFields(ml_cursor_SelectedValues, "SPA_no_conf_email") <> "X" Then
            UserRoleIsChanged = True
        End If
    Else
        If mo_Db.GetFields(ml_cursor_SelectedValues, "SPA_no_conf_email") = "X" Then
            UserRoleIsChanged = True
        End If
    End If
    
    Exit Function
ErrHandler:
    UserRoleIsChanged = False
    Call ErrorHandler(Extender.Name & ".UserRoleIsChanged")
End Function


Private Function EntryIsUsed(ByVal as_req As String) As Boolean
On Error GoTo ErrHandler
    
Dim ls_req As String
Dim ll_Cursor As Long
    
    EntryIsUsed = False
    
    ll_Cursor = OpenSQLSafe(mo_Db, as_req)
    
    Debug.Assert (ll_Cursor <> 0)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        EntryIsUsed = True
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Function
ErrHandler:
    EntryIsUsed = False
    Call ErrorHandler(Extender.Name & ".EntryIsUsed")
End Function

Public Function GetServerDate() As Date
Const REQ_GET_SERVER_DATE As String = "SELECT GetDate() as ServerDate"
On Error GoTo ErrHandler
Dim ls_req As String
Dim ll_Cursor As Long
    
    GetServerDate = 0
    
    ll_Cursor = OpenSQLSafe(mo_Db, REQ_GET_SERVER_DATE)
    
    Debug.Assert (ll_Cursor <> 0)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        GetServerDate = Int(mo_Db.GetFields(ll_Cursor, "ServerDate"))
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Function
ErrHandler:
    GetServerDate = 0
    Call ErrorHandler(Extender.Name & ".EntryIsUsed")
End Function

'delete or replace current user in SPA_UserRoles
'if new as_Code is empty, current user will be deleted
Private Sub Item_DeleteDB(ByVal as_Code As String)
Const REQ_USERREPLACEMENT_DEL As String = "exec SPA_UserReplacement_del2 $USER_Code$,$U_Code$"
Const REQ_USERROLE_NEXT_USER_UPD_1 As String = "exec SPA_UserRoles_upd3 $Replacer_U_Code$,$USER_Code$,$U_Code$"
Const REQ_USERROLE_NEXT_USER_UPD_2 As String = "exec SPA_UserRoles_upd3 $Next_U_Code2$,$USER_Code$,$U_Code$"
On Error GoTo ErrHandler
    
Dim ls_Request          As String
Dim ls_ReqClose       As String
Dim ls_ReqDelete       As String
Dim lb_InTran       As Boolean
Dim ls_ErrMessage   As String
Dim lb_IsUsedToday     As Boolean
Dim ls_ReqCheck     As String

    ls_ReqClose = ReplaceCommonPlaceholders(REQ_CLOSE_SPA_USER_ROLE)
    ls_ReqClose = Item_ReplacePlaceholders(ls_ReqClose)

    ls_ReqDelete = ReplaceCommonPlaceholders(REQ_DELETE_SPA_USER_ROLE)
    ls_ReqDelete = Item_ReplacePlaceholders(ls_ReqDelete)

'    ls_ReqCheck = Item_ReplacePlaceholders(REQ_USERROLE_IS_USED)
'    lb_IsUsedToday = EntryIsUsed(ls_ReqCheck)
    lb_IsUsedToday = True
    Call ExecuteSQLSafe(mo_Db, "BEGIN TRAN Item_Del")
    lb_InTran = True

    md_ServerDate = GetServerDate()
    
    If mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_Start") <> 0 Then
        ' there is some current or future role
        If Not Delete_ValidityManager(mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_Start"), _
                                  mo_Db.GetFields(ml_cursor_SelectedValues, "VDate_End"), _
                                  ls_ReqClose, _
                                  ls_ReqDelete, _
                                  lb_IsUsedToday, _
                                  ls_ErrMessage) Then
            GoTo ErrHandler
        End If
    End If
    
    'delete all SPA_AuthMarketUser_Link informations for this user
    ls_Request = ReplaceCommonPlaceholders(REQ_DELETE_ALL_SPA_MKT_USER_LINK)
    ls_Request = Replace(ls_Request, "$SPM_Code$", "NULL", , , vbTextCompare)
    ls_Request = Item_ReplacePlaceholders(ls_Request)
    
    If lb_IsUsedToday Then
        ls_Request = Replace(ls_Request, "$VNewDate_End$", SqlDate(md_ServerDate), , , vbTextCompare)
    Else
        ls_Request = Replace(ls_Request, "$VNewDate_End$", SqlDate(md_ServerDate - 1), , , vbTextCompare)
    End If
    Call ExecuteSQLSafe(mo_Db, ls_Request)

    If cbo_replacer.Text = "" Then
        'no replacer selected, use Next_U_Code from deleted user for all current users
        ls_Request = ReplaceCommonPlaceholders(REQ_USERROLE_NEXT_USER_UPD_2)
        ls_Request = Item_ReplacePlaceholders(ls_Request)
        ls_Request = ReplaceRequestByFrameData(ls_Request, fra_deleteUser)
    Else
        'replacer selected, use replacer U_Code for Next_U_Code for all curent users
        ls_Request = ReplaceCommonPlaceholders(REQ_USERROLE_NEXT_USER_UPD_1)
        ls_Request = Item_ReplacePlaceholders(ls_Request)
        ls_Request = ReplaceRequestByFrameData(ls_Request, fra_deleteUser)
    End If
    Call ExecuteSQLSafe(mo_Db, ls_Request)

    'delete all active entries from SPA_UserReplacement
    ls_Request = ReplaceCommonPlaceholders(REQ_USERREPLACEMENT_DEL)
    ls_Request = Item_ReplacePlaceholders(ls_Request)
    Call ExecuteSQLSafe(mo_Db, ls_Request)
    
    Call ExecuteSQLSafe(mo_Db, "COMMIT TRAN Item_Del")
    lb_InTran = False
        
    Exit Sub
ErrHandler:
    If lb_InTran Then
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Del")
        lb_InTran = False
    End If
    If ls_ErrMessage <> "" Then
        ms_ErrMessage = ls_ErrMessage
        Exit Sub
    End If
    Call ErrorHandler(Extender.Name & ".Item_DeleteDb")
End Sub

' specia type od serialized string filed1_name sep1 data1 sep1 data2 sep field2_name ....
Private Function Build_SrzStringFromGrid(ByRef ao_grid As Control) As String
On Error GoTo ErrHandler
    Dim ls_ret As String
    Dim ls_Data As String
    Dim ll_Row As Long
    Build_SrzStringFromGrid = ""
    
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        ls_Data = ""
        For ll_Row = 0 To ao_grid.Rows - 1
            ls_Data = IIf(ll_Row = 0, "", ls_Data & SEP1) & lo_Column.GetData(ll_Row)
        Next
        ls_ret = IIf(ll_Col = 0, "", ls_ret & SEP) & lo_Column.FieldName & SEP1 & ls_Data
    Next
    
    Build_SrzStringFromGrid = ls_ret
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Build_SrzStringFromGrid")
End Function

Private Function Build_SrzStringFromGridLine(ByRef ao_grid As Control, Optional ByVal al_Row As Long = -1) As String
On Error GoTo ErrHandler
    Dim ls_ret As String
    Build_SrzStringFromGridLine = ""
    If al_Row = -1 Then
        If ao_grid.SelectedCount > 0 Then
            al_Row = ao_grid.Row
        Else
            Call Err.Raise(ArmErr.InvalidArgument, "", "No row selected in grid.")
        End If
    End If
    
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        ls_ret = IIf(ll_Col = 0, "", ls_ret & SEP) & lo_Column.FieldName & SEP1 & lo_Column.GetData(al_Row)
    Next
    
    Build_SrzStringFromGridLine = ls_ret
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Build_SrzStringFromGridLine")
End Function

Private Function Build_SrzStringFromControl(ByRef aControl As Control) As String
On Error GoTo ErrHandler
    Dim ls_SrzString As String
    Dim lValues As Variant
    Dim ls_TempTag As String
    Dim ls_Str As String

    Build_SrzStringFromControl = ""
                
    ls_TempTag = aControl.Tag & SEP
    lValues = Split(ls_TempTag, SEP)
    
    Select Case UCase(TypeName(aControl))
        Case "TEXTBOX"
                Select Case lValues(1)
                    Case "Text", "Date"
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & aControl.Text
                    Case "Num"
                        ls_Str = Replace(aControl.Text, ms_ThousandSeparator, "")
                        ls_Str = Replace(ls_Str, ms_DecimalSeparator, ".")
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & ls_Str
               End Select
        
        Case "ARMCOMBOBOX"
            If Not aControl.SelectedItem Is Nothing Then
                ls_SrzString = ls_SrzString & lValues(0) & SEP1 & aControl.SelectedItem.Key & SEP
                ls_SrzString = ls_SrzString & lValues(1) & SEP1 & aControl.SelectedItem.GetData(1)
            Else
                ls_SrzString = ls_SrzString & lValues(0) & SEP1 & "NULL" & SEP
                ls_SrzString = ls_SrzString & lValues(1) & SEP1 & "" & SEP
            End If
        Case "OPTIONBUTTON"
            
        Case "CHECKBOX"
            ls_SrzString = ls_SrzString & lValues(0) & SEP1 & IIf(aControl.Value = vbChecked, "X", "") & SEP
        
        Case "A_CALOCX"
            ls_SrzString = ls_SrzString & lValues(0) & SEP1 & aControl.date_courte
            
            
        Case "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL"
            'Do Nothing
        
        Case "ARMGRID"
            ' do nothing
'            If aControl.SelectedCount > 0 Then
'                ls_SrzString = ls_SrzString & Build_SrzStringFromGridLine(aControl)
'            End If
        Case "ARMPICKER"
            ls_SrzString = ls_SrzString & lValues(0) & SEP1 & aControl.ItemCode & SEP
            ls_SrzString = ls_SrzString & lValues(1) & SEP1 & aControl.ItemDescription
        
        Case Else
            Debug.Print "Build_SrzStringFromControl  -> " & UCase(TypeName(aControl))
    End Select

    Build_SrzStringFromControl = ls_SrzString
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Build_SrzStringFromControl")
End Function


Private Function Build_SrzString(ByRef aControls As Variant, ByRef aContainer As Object) As String
On Error GoTo ErrHandler
    Dim ls_SrzString As String
    Dim lo_Control As CheckBox
    Dim lIdx As Long, lCount As Long
    
    Dim ls_Str As String
    Dim lControl As Control
   
    
        lCount = aControls.Count - 1
        ls_SrzString = ""
    
        For lIdx = 0 To lCount
            Set lControl = aControls.Item(lIdx)
            If HasContainer(lControl, aContainer) Then
                ls_Str = Build_SrzStringFromControl(lControl)
                If ls_Str <> "" Then
                    ls_SrzString = ls_SrzString & ls_Str & SEP
                End If
                
            End If
            Set lControl = Nothing
        Next

    ls_SrzString = Trim(ls_SrzString)
    Build_SrzString = ls_SrzString
    
    Exit Function
    
ErrHandler:
    Call ErrorHandler("Build_SrzString")
End Function

Private Sub FillDataSrcArray(ByRef ao_dataSrc As Dictionary, ByVal as_SrzFields As String)
On Error GoTo ErrHandler
    
    Dim ll_i As Long
    Dim lsa_DataFields() As String
    Dim lv_Values As Variant
    lsa_DataFields = Split(as_SrzFields, SEP)
    
    For ll_i = LBound(lsa_DataFields) To UBound(lsa_DataFields)
        lv_Values = Split(lsa_DataFields(ll_i), SEP1)
        If UBound(lv_Values) >= 1 Then
            Call ao_dataSrc.Add(lv_Values(0), lv_Values(1))
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillDataSrcArray")
End Sub

Private Function IsInArray(ByVal as_val As String, ByRef av_Array As Variant) As Boolean
On Error GoTo ErrHandler
    Dim ll_i As Long
    IsInArray = False
    For ll_i = LBound(av_Array) To UBound(av_Array)
        If StrComp(av_Array(ll_i), as_val, vbTextCompare) <> 0 Then Exit Function
    Next
    IsInArray = True
    Exit Function
ErrHandler:
    Call ErrorHandler("IsInArray")
End Function

' return number of realy deleted lines .. not the number of lines marked to be deleted
Private Function DeleteLineToGrid(ByVal ao_grid As ArmGrid, ByVal av_KeyFields As Variant, ByVal al_KeyVal As Variant) As Long
On Error GoTo ErrHandler
    DeleteLineToGrid = 0
    
    Dim ll_retVal As Long
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    Dim lba_bckKeys() As Boolean
    Dim lv_bckKey As Variant
    ReDim lba_bckKeys(0 To ao_grid.Cols - 1)
    
    ll_retVal = 0

    ' backup keys
    lv_bckKey = ao_grid.CurrentKey
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        lba_bckKeys(ll_Col) = lo_Column.Key
        lo_Column.Key = IsInArray(lo_Column.FieldName, av_KeyFields)
    Next

    ' delete all lines
    ao_grid.FirstLine
    Do While ao_grid.SearchKey(False, al_KeyVal)
        If ao_grid.CurrentLine("change") = "A" Then
            ' if line is new then delete line
            If ao_grid.DeleteLine Then
                ll_retVal = ll_retVal + 1
            End If
            
        Else
            ' line is not realy deletable
            ao_grid.CurrentLine("change") = "D"
            ao_grid.LineColor(ao_grid.Row) = COLOR_DELLINE
            If Not ao_grid.NextLine Then
                Exit Do
            End If
        End If
    Loop
    
    ' restore keys
    For ll_Col = 0 To ao_grid.Cols - 1
        ao_grid.Columns(ll_Col).Key = lba_bckKeys(ll_Col)
    Next
    Call ao_grid.SearchKey(True, lv_bckKey)
    
    DeleteLineToGrid = ll_retVal

    Exit Function
ErrHandler:
    Call ErrorHandler("DeleteLineToGrid")
End Function

Private Function IsKeyRow(ByVal ao_grid As ArmGrid, ByVal al_Row As Long, ByVal av_keyCols As Variant, ByRef ao_dataSrc As Dictionary) As Boolean
On Error GoTo ErrHandler
    IsKeyRow = False
    Dim ll_i As Long
    For ll_i = LBound(av_keyCols) To UBound(av_keyCols)
        If StrComp(ao_grid.Data(al_Row, av_keyCols(ll_i)), ao_dataSrc(av_keyCols(ll_i)), vbTextCompare) <> 0 Then
            Exit Function
        End If
    Next
    IsKeyRow = True
    Exit Function
ErrHandler:
    Call ErrorHandler("IsKeyRow")
End Function

Private Sub UpdateLineToGrid(ByVal ao_grid As ArmGrid, ByRef ao_dataSrc As Dictionary, ByVal av_keyCols As Variant)
On Error GoTo ErrHandler

    Debug.Assert (ao_grid.Cols > 0)
    Dim ll_Row As Long, ll_RowCount As Long, ll_Col As Long
    Dim lo_Column As ArmColumn
    
    ll_RowCount = ao_grid.Rows - 1
    For ll_Row = 0 To ll_RowCount
        If IsKeyRow(ao_grid, ll_Row, av_keyCols, ao_dataSrc) Then
            For ll_Col = 0 To ao_grid.Cols - 1
                Set lo_Column = ao_grid.Columns(ll_Col)
                If ao_dataSrc.Exists(lo_Column.FieldName) Then
                    If lo_Column.FieldType = DBTYPE_R4 Or lo_Column.FieldType = DBTYPE_R8 Then
                        Call lo_Column.SetData(ll_Row, Replace(ao_dataSrc(lo_Column.FieldName), ".", ms_DecimalSeparator))
                    Else
                    Call lo_Column.SetData(ll_Row, ao_dataSrc(lo_Column.FieldName))
                End If
                End If
            Next
            ao_grid.LineColor(ll_Row) = COLOR_UPDLINE
        End If
    Next

    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateLineToGrid")
End Sub

Private Sub AddLineToGrid(ByVal ao_grid As ArmGrid, ByRef ao_dataSrc As Dictionary, Optional ByVal ab_insertAtBeginning As Boolean = False)
On Error GoTo ErrHandler
    
    ' insert row at the end of grid
    Debug.Assert (ao_grid.Cols > 0)
    Dim lo_Column As ArmColumn
    Dim ll_Index As Long
    Dim lsa_newRow() As String
    ReDim lsa_newRow(0 To ao_grid.Cols - 1)
    
    Call ao_grid.DeselectRow
    
    For ll_Index = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Index)
        If ao_dataSrc.Exists(lo_Column.FieldName) Then
            If lo_Column.FieldType = DBTYPE_R4 Or lo_Column.FieldType = DBTYPE_R8 Then
                lsa_newRow(ll_Index) = Replace(ao_dataSrc(lo_Column.FieldName), ".", ms_DecimalSeparator)
            Else
            lsa_newRow(ll_Index) = ao_dataSrc.Item(lo_Column.FieldName)
            End If
        Else
            lsa_newRow(ll_Index) = "TODO:"
        End If
    Next
    
    If ab_insertAtBeginning Then
        Call ao_grid.InsertLine(0, lsa_newRow)
        Call ao_grid.FirstLine
    Else
        Call ao_grid.AddLine(lsa_newRow)
    End If
    ao_grid.LineColor(ao_grid.Row) = COLOR_ADDLINE
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("AddLineToGrid")
End Sub

Private Function GetFieldValueFromSrz(ByVal as_SrzFields As String, ByVal as_Param As String) As String
On Error GoTo ErrHandler
    
    Dim lv_SrzFields As Variant
    Dim lv_Values
    Dim ll_Count As Long
    Dim ll_Nb As Long
       
    If right(as_SrzFields, 2) <> SEP Then as_SrzFields = as_SrzFields & SEP
       
    lv_SrzFields = Split(as_SrzFields, SEP)
    ll_Nb = UBound(lv_SrzFields) - 1

    For ll_Count = 0 To ll_Nb
        lv_Values = Split(lv_SrzFields(ll_Count), SEP1)
         If UCase(as_Param) = UCase(lv_Values(0)) Then
           GetFieldValueFromSrz = lv_Values(1)
           Exit For
         End If
    Next ll_Count
    
    Exit Function
ErrHandler:
    Call ErrorHandler("GetFieldValueFromSrz")
End Function

Private Sub SetCheckBoxDB(ByVal al_Cursor As Long, ByVal as_keyField As String, ByRef ao_CheckBox As VB.CheckBox, Optional ByVal as_checked As String = "X")
On Error GoTo ErrHandler
    Dim lv_val As Variant
    lv_val = mo_Db.GetFields(al_Cursor, as_keyField)
    If Not IsEmpty(lv_val) Then
        ao_CheckBox.Value = IIf(lv_val = as_checked, vbChecked, vbUnchecked)
    Else
        ao_CheckBox.Value = vbUnchecked
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SetCheckBoxDB")
End Sub


Private Sub SetComboBoxTextDB(ByVal al_Cursor As Long, ByVal as_keyField As String, ByVal as_DescField As String, ByRef ao_Combobox As ArmCombobox, Optional ByVal ab_clearIfNotExists As Boolean = True)
On Error GoTo ErrHandler
    Dim lv_val As Variant
    lv_val = mo_Db.GetFields(al_Cursor, CVar(Array(as_keyField, as_DescField)))
    If Not IsEmpty(lv_val) Then
        Debug.Assert (UBound(lv_val) = 1)
        Call SetComboBoxText(ao_Combobox, CStr(lv_val(0)), CStr(lv_val(1)))
    Else
        If ab_clearIfNotExists Or mo_Db.GetFieldIndex(al_Cursor, as_keyField) <> -1 Then
            Call ao_Combobox.Clear
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SetComboBoxTextDB")
End Sub

' Sets combobox selected item
' Params:
' ao_ComboBox (ArmCombobox)
' as_Key (String)
' as_Desc (String)
Private Sub SetComboBoxText(ByRef ao_Combobox As ArmCombobox, ByVal as_Key As String, ByVal as_desc As String)
On Error GoTo ErrHandler
    If Not ao_Combobox.SearchItem(as_Key) Then
        ' key not found ... set value from parameter
        If as_Key = "" Or as_Key = "0" Then     ' zero or empty string is not valid key
            Set ao_Combobox.SelectedItem = Nothing
        Else
            Call ao_Combobox.AddItem(Array(as_Key, as_desc), True)
            ' to make vb raise event
            Call ao_Combobox.SearchItem(as_Key)
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SetComboBoxText")
End Sub

Private Function Item_ReplacePlaceholders(ByVal as_Request As String) As String
On Error GoTo ErrHandler
    ' general
    Dim ls_ret As String
    ls_ret = ReplaceRequestByFrameData(as_Request, fra_Detail)
    
    ' default
    ls_ret = ReplacePlaceHolder(ls_ret, "$iConcurrency$", ml_iConcurrency)
    ls_ret = ReplacePlaceHolder(ls_ret, "$EMail_Created_Sent$", "NULL")
    ls_ret = ReplacePlaceHolder(ls_ret, "$EMail_Completed_Sent$", "NULL")
    ls_ret = ReplacePlaceHolder(ls_ret, "$EMail_Created$", "''")
    ls_ret = ReplacePlaceHolder(ls_ret, "$EMail_Completed$", "''")
    
    Item_ReplacePlaceholders = ls_ret
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ReplacePlaceholders")
End Function

' exits mode to main
Private Sub Item_Exit()
On Error GoTo ErrHandler
    
    ' pop last item in screen mode stack
    Call popScreenModeUntil(smMain)
    
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    RaiseEvent OnExit
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Exit")
End Sub

Private Function Item_Check(ByRef ao_Container As Object) As Boolean
On Error GoTo ErrHandler
        
'    Dim lv_MsgReplaceInfo(0, 1) As String
    Dim lo_Control As Object
    Dim ls_LabelCaption As String
    Dim ll_CtrlIndex As Long
    Dim lb_Found As Boolean
    Dim lo_mandatoryField As Variant
    
    If IsArray(moa_ListFieldsMandatory) Then
    
        For Each lo_mandatoryField In moa_ListFieldsMandatory
            Set lo_Control = lo_mandatoryField(0)
            If HasContainer(lo_Control, ao_Container) Then
                If lo_mandatoryField(1) >= 0 Then
                    ls_LabelCaption = lbl_Label(lo_mandatoryField(1)).Caption
                Else
                    ls_LabelCaption = ""
                End If
                Select Case UCase(TypeName(lo_Control))
                    Case "FRAME", "LABEL", "MSFLEXGRID", "TOOLBARCONTROL"
                        ' Do nothing !

                    Case "TEXTBOX"
                        If lo_Control.Visible And (lo_Control.Text = "") Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            lo_Control.SetFocus
                            Exit Function
                        End If
                    Case "ARMCHECKVIEW"
                         If lo_Control.Visible And (lo_Control.RoleList("EDIT").CheckedCount = 0) Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            Call lo_Control.SetFocus
                            Exit Function
                          End If
                    Case "ARMGRID"
                        ' at least one non deleted row must be in grid
                        If lo_Control.Visible And GetGridNonDeletedRows(lo_Control) = 0 Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            Exit Function
                        End If
                    Case "ARMCHECKVIEW", "COMMANDBUTTON", "A_CALOCX", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TABSTRIP"
                    
                    Case "OPTIONBUTTON", "CHECKBOX"
                        'probably array of controls
                    Case "OBJECT"
                        lb_Found = False
                        For ll_CtrlIndex = 0 To lo_Control.Count - 1
                            If UCase(TypeName(lo_Control(ll_CtrlIndex))) = "CHECKBOX" Then
                                If lo_Control(ll_CtrlIndex).Value = vbChecked Then
                                    lb_Found = True
                                    Exit For
                                End If
                            ElseIf UCase(TypeName(lo_Control(ll_CtrlIndex))) = "OPTIONBUTTON" Then
                                If lo_Control(ll_CtrlIndex).Value Then
                                    lb_Found = True
                                    Exit For
                                End If
                            Else
                                ' unknown array ???
                                lb_Found = True
                                Exit For
                            End If
                        Next
                        If Not lb_Found Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            Exit Function
                        End If
                    Case "ARMCOMBOBOX"
                        If lo_Control.Visible And (lo_Control.SelectedItem Is Nothing) Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            Call lo_Control.SetFocus
                            Exit Function
                        End If
                    Case "ARMPICKER"
                        If lo_Control.Visible And (CStr(lo_Control.ItemCode) = "") Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            lo_Control.SetFocus
                            Exit Function
                        End If
                    Case "LISTVIEW"
                         If lo_Control.Visible And (GetCheckedCount(lo_Control) = 0) Then
                            Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                            Call lo_Control.SetFocus
                            Exit Function
                          End If
                    Case Else
                        Debug.Print "Item_CheckMandatory " & UCase(TypeName(lo_Control))
                End Select
            End If ' not in container
        Next
    End If
    
    ' custom check part
    'If cal_valid_From.date_dt > cal_valid_To.date_dt Then
    '    Call MsgBox(MsgText(ErrMsg_M240, ms_Language_Code, "The Valid from date must be less than or equal to the Valid to date."), vbInformation)
    '    Call cal_valid_From.SetFocus
    '    Exit Function
    'End If
    
    'If cal_valid_To.date_dt < Now Then
    '    Call MsgBox(MsgText(ErrMsg_M250, ms_Language_Code, "The Valid to date must be greater than today."), vbInformation)
    '    Call cal_valid_From.SetFocus
    '    Exit Function
    'End If
    
    
    ' check all numeric fields on detail
    If UBound(moa_ListFieldsNumeric) < 0 Then
        Item_Check = True
        Exit Function
    End If
    
    Dim lValues As Variant
    Dim ls_Str As String, ls_TempTag As String

    For Each lo_mandatoryField In moa_ListFieldsNumeric
        Set lo_Control = lo_mandatoryField(0)
        If HasContainer(lo_Control, ao_Container) Then
            If lo_mandatoryField(1) >= 0 Then
                ls_LabelCaption = lbl_Label(lo_mandatoryField(1)).Caption
            Else
                ls_LabelCaption = ""
            End If
            
            ls_TempTag = lo_Control.Tag & SEP
            lValues = Split(ls_TempTag, SEP)
            Select Case UCase(TypeName(lo_Control))
                Case "TEXTBOX"
                     Select Case lValues(1)
                         Case "Text"     ' no chceck needed
                         Case "Date"
                             If lo_Control.Visible And Not IsDate(lo_Control.Text) Then
                                Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                                lo_Control.SetFocus
                                Exit Function
                             End If
                         Case "Num"
                            ls_Str = Replace(lo_Control.Text, ".", ms_DecimalSeparator, , , vbTextCompare)
                            If lo_Control.Visible And Not isNumeric(ls_Str) Then
                                Call MsgBox(ReplacePlaceHolder(MsgText(ErrMsg_M300, ms_Language_Code, "The field is mandatory."), "$FIELD_NAME$", ls_LabelCaption), vbInformation)
                                lo_Control.SetFocus
                                Exit Function
                             End If
                    End Select
                
                Case "ARMCOMBOBOX", "OPTIONBUTTON", "CHECKBOX", "A_CALOCX", "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL", "ARMGRID", "ARMPICKER"
                    ' do nothing
                
                Case Else
                    Debug.Print "Item_Check  -> " & UCase(TypeName(lo_Control))
            End Select
        End If
    Next


    Item_Check = True

    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Check")
End Function

Private Function GetCheckedCount(ByRef ao_Listview As MSComctlLib.ListView) As Long
On Error GoTo ErrHandler

Dim lo_item As MSComctlLib.ListItem
Dim ll_Count As Long

    ll_Count = 0
    For Each lo_item In ao_Listview.ListItems
        If lo_item.Checked Then ll_Count = ll_Count + 1
    Next
    GetCheckedCount = ll_Count
    Exit Function
ErrHandler:
    Call ErrorHandler("GetCheckedCount")
End Function

Private Sub SetFocusToCtrl(ByRef ao_ctrl As Object)
On Error GoTo ErrHandler
    If ao_ctrl.Visible Then
        ao_ctrl.SetFocus
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".SetFocusToCtrl")
End Sub

Private Sub LockScreen(ByVal ab_lock As Boolean)

    Dim ll_errNumber As Long, ls_ErrSrc As String, ls_ErrDesc As String
    ll_errNumber = Err.Number
    ls_ErrSrc = Err.Source
    ls_ErrDesc = Err.Description

On Error GoTo ErrHandler
    Static ll_Count As Long
    Static ll_Mousepointer As Long
    Static lb_Locked As Boolean
      
    ll_Count = ll_Count + IIf(ab_lock, 1, -1)
    Debug.Assert (ll_Count >= 0)
    
    ' First lock
    If Not lb_Locked And ab_lock Then
        ll_Mousepointer = Screen.MousePointer
        Screen.MousePointer = vbHourglass
        LockWindowUpdate UserControl.hwnd
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        UserControl.Refresh ' Repaint immediately
        Screen.MousePointer = ll_Mousepointer
        lb_Locked = False
    End If
    
    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".LockScreen")
End Sub

Private Sub ResetScreen(ByVal au_mode As ArmScreenMode)
On Error GoTo ErrHandler
    ' apply face
    Dim lo_ctrl As Object

    Select Case au_mode
        Case smMain
            ' enable filtering a browsing
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            fra_userReplacement.Visible = False
            fra_pendingSPArequests.Visible = False
            
        Case smUpdate, smAdd
            ' we are in Update section
            Call SetEnabled(GetContainedControlsChain(fra_Detail), True)
            Call SetEnabled(GetContainedControlsChain(fra_authLevelDetail), False)
            
            Dim lIdx As Long, lCount As Long
            
            If IsArray(moa_ListFieldsToDisable) Then
                lCount = UBound(moa_ListFieldsToDisable)
            
                For lIdx = 0 To lCount
                    Call SetEnabledCtrl(moa_ListFieldsToDisable(lIdx), False)
                Next
            End If
            
        Case smView
            ' we are in PreView section
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
        
        Case smDelete
            ' we are in PreView section
            Call SetEnabled(GetContainedControlsChain(fra_deleteUser), False)
            Call SetEnabledCtrl(cbo_replacer, True)
            
        Case smAddItem, smUpdateItem
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            Call SetEnabled(GetContainedControlsChain(fra_authLevelDetail), True)
                        
            If IsArray(moa_ListFieldsToDisable) Then
                lCount = UBound(moa_ListFieldsToDisable)
            
                For lIdx = 0 To lCount
                    Call SetEnabledCtrl(moa_ListFieldsToDisable(lIdx), False)
                Next
            End If
            Call SetEnabledCtrl(tlb_Main, False)
        
        Case smDeleteItem
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            
            If IsArray(moa_ListFieldsToDisable) Then
                lCount = UBound(moa_ListFieldsToDisable)
            
                For lIdx = 0 To lCount
                    Call SetEnabledCtrl(moa_ListFieldsToDisable(lIdx), False)
                Next
            End If
            Call SetEnabledCtrl(tlb_Main, False)
        Case Else
            Debug.Assert (False)
    End Select

    Call SetEnabledCtrl(btn_showReplacement, True)
    Call SetEnabledCtrl(btn_showRequests, True)

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ResetScreen()")
End Sub


Private Function HasContainer(ByRef aControl As Control, ByRef aContainer As Object) As Boolean
    HasContainer = False
    Dim lControl As Control
 
    Set lControl = aControl
    While Not (lControl Is Nothing)
        On Error GoTo NotFound
        If lControl.Container Is aContainer Then
            Set lControl = Nothing
            HasContainer = True
            Exit Function
        End If
        Set lControl = lControl.Container
    Wend
 
NotFound:
    Set lControl = Nothing
    HasContainer = False
End Function
 
Private Function IsSub(ByVal av_Name As Object, ByRef aav_Names As Variant)
On Error GoTo ErrHandler
    IsSub = False
    
    Dim ll_Idx As Long
    For ll_Idx = LBound(aav_Names) To UBound(aav_Names)
    
        If av_Name Is aav_Names(ll_Idx) Then
            IsSub = True
            Exit Function
        End If
    Next ll_Idx
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".IsSub")
End Function

' Clear values for each control to not initiliazed
Private Sub ClearForm(ByRef aControls As Variant, ByRef aContainer As Object, Optional ByRef aav_Except As Variant)
On Error GoTo ErrHandler
 
    'mb_internal = True
 
    Dim lIdx As Long, lCount As Long, lControl As Object
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Dim lb_Process As Boolean
        lb_Process = True
        Set lControl = aControls.Item(lIdx)
        If Not IsMissing(aav_Except) Then
            If IsSub(lControl, aav_Except) Then
                lb_Process = False
            End If
        End If
        If HasContainer(lControl, aContainer) And lb_Process Then
            Select Case UCase(TypeName(lControl))
                Case "TEXTBOX"
                    lControl.Text = ""
                Case "ARMCOMBOBOX"
'                    Set lControl.SelectedItem = Nothing
                    Call lControl.Clear
                Case "A_CALOCX"
                    lControl.reinit_cal
                Case "CHECKBOX"
                    lControl.Value = vbUnchecked
                Case "ARMCHECKVIEW"
                    lControl.Init
                    
                Case "FRAME", "LABEL", "TOOLBARCONTROL", "PICTUREBOX", "COMMANDBUTTON"
 
                Case "ARMGRID"
                    lControl.ClearGrid
                Case "LISTBOX"
                    lControl.ListIndex = -1
                Case "OPTIONBUTTON"
                    lControl.Value = False
                Case "TABSTRIP", "DRIVELISTBOX", "DIRLISTBOX", "FILELISTBOX", "TOOLBARCONTROL", "LINE"
                
                Case "ARMPICKER"
                    Call lControl.Clear
                
                Case Else
                    Debug.Print "ClearForm " & UCase(TypeName(lControl))
            End Select
        End If
 
        Set lControl = Nothing
    Next
 
   ' mb_internal = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ClearForm")
End Sub

' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#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
        Call Err.Raise(CompFncFailed, "ao_Db.ExecuteSQL - " & "SQL : " & as_Request, "SQL Error: " & GetDbError(ao_Db))
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.SQLRowsAffected <> al_RowAffectedCount Then
            Call Err.Raise(SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected)
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ExecuteSQLSafe")
End Sub

#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
        Call Err.Raise(CompFncFailed, "ao_Db.OpenSQL - " & "SQL : " & as_Request, "SQL Error: " & GetDbError(ao_Db))
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.RowCount(lc_Data) <> al_RowExpectedCount Then
            Call Err.Raise(SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_Db.RowCount(lc_Data))
        End If
    End If
    OpenSQLSafe = lc_Data
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".OpenSQLSafe")
End Function

Private Function GetComboKey(ByVal ao_Combo As ArmCombobox) As String
On Error GoTo ErrHandler

    GetComboKey = ""
    If Not (ao_Combo.SelectedItem Is Nothing) Then
        GetComboKey = Trim(CStr(ao_Combo.SelectedItem.Key))
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetComboKey")
End Function

Private Function SqlInt(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlInt = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If Trim(CStr(av_Data)) <> "" Then
        SqlInt = CStr(av_Data)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SqlInt")
End Function

Private Function SqlDbl(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlDbl = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If Trim(CStr(av_Data)) <> "" Then
        SqlDbl = Str(av_Data)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SqlDbl")
End Function

Private Function SqlDate(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlDate = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
        SqlDate = "'" & Format(av_Data, "yyyy-mm-dd") & "'"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SqlDate")
End Function

Private Function SqlStr(ByVal as_str As String, Optional ByVal al_MaxLen As Long = 8000) As String
On Error GoTo ErrHandler
    SqlStr = "'" & Replace(Left(as_str, IIf(Len(as_str) <= al_MaxLen, Len(as_str), al_MaxLen)), "'", "''") & "'"
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SqlStr")
End Function

' safe retieving selected item from combobox
Private Function SQLComboBoxValue(ByRef ao_Combobox As ArmCombobox, Optional ByVal as_DefaultValue As String = "NULL", Optional ByVal ab_KeyTitle As Boolean = True) As String
On Error GoTo ErrHandler
    If IsComboboxSelected(ao_Combobox) Then
        SQLComboBoxValue = "'" & IIf(ab_KeyTitle, ao_Combobox.SelectedItem.Key, ao_Combobox.SelectedItem.DisplayText) & "'"
    Else
        SQLComboBoxValue = as_DefaultValue
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SQLComboBoxValue")
End Function

Private Function SQLOptionButtonValue(ByRef ao_options As Object) As String
On Error GoTo ErrHandler
    SQLOptionButtonValue = ""
    Dim opt_obj As OptionButton
    For Each opt_obj In ao_options
        If opt_obj.Value Then
            SQLOptionButtonValue = opt_obj.Tag
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SQLOptionButtonValue")
End Function

Private Function IsComboboxSelected(ByRef as_combo As ArmCombobox) As Boolean
On Error GoTo ErrHandler
    IsComboboxSelected = False
    If Not as_combo.SelectedItem Is Nothing Then
        If Not IsEmpty(as_combo.SelectedItem.Key) Then
            IsComboboxSelected = True
        End If
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".IsComboboxSelected")
End Function

' ************************************************************************************

' ************************************************************************************
' **************************** REDIM FUNCTION ****************************************
' ************************************************************************************
Sub SafeRedimString(ByRef as_Array() As String, al_NumElements As Long)

On Error GoTo ErrHandler

  If al_NumElements = 0 Then
          ReDim as_Array(-1 To -1)
  Else
          'MS REDIMM
          Call SafeRedimPreserve(as_Array, al_NumElements - 1)
  End If
  Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SafeRedimString()")
End Sub

Sub SafeRedim(ByRef av_Array() As Variant, al_NumElements As Long)

On Error GoTo ErrHandler

  If al_NumElements = 0 Then
          ReDim av_Array(-1 To -1)
  Else
          'MS REDIMM
          Call SafeRedimPreserve(av_Array, al_NumElements - 1)
  End If
  Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SafeRedim()")
End Sub
' **************************** REDIM FUNCTION ****************************************

' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function GetDbError(ByVal lo_Db As Object) As String
#Else
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
#End If
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(lo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetDbError()")
End Function

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

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    If Err.Number = QuietException Then Exit Sub
    Dim ll_oldMP As MousePointerConstants
    
    'save mouse pointer
    ll_oldMP = Screen.MousePointer
    Screen.MousePointer = vbDefault
    
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    
    Call LogMessage(App.ProductName & " exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_errDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT" & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, , "Error message: " & as_Fct)
    
    'restore mouse pointer
    Screen.MousePointer = ll_oldMP
End Sub

Function MsgText(ByVal aID As Long, ByVal aLang As String, ByVal aDefault As String, Optional ByVal aInfo As Variant) As String
On Error GoTo ErrHandler

Const DB_REQ As String = "SELECT message_text FROM error_message WHERE msgid = $id$ AND Language_code = '$lang$'"

    MsgText = ""
    
    Dim lRequest As String
    lRequest = ReplacePlaceHolder(DB_REQ, "$id$", aID)
    lRequest = ReplacePlaceHolder(lRequest, "$lang$", aLang)
    Dim lData As Long
    
    lData = OpenSQLSafe(mo_Db, lRequest)
    
    Dim lBuffer As String
    lBuffer = mo_Db.GetFields(lData, "message_text")
    mo_Db.Close (lData)
    If lBuffer = "" Then lBuffer = aDefault
    
    Dim li_idx As Integer
    If Not IsMissing(aInfo) Then
        For li_idx = 0 To UBound(aInfo)
            lBuffer = Replace(lBuffer, aInfo(li_idx, 0), aInfo(li_idx, 1), , , vbTextCompare)
        Next li_idx
    End If
    
    
    MsgText = lBuffer
    Exit Function
ErrHandler:
    mo_Db.Close (lData)
    Call MsgBox("Connection failure accessing message information.")
    MsgText = aDefault
End Function

Private Sub LogMessage(ByVal as_LogMsg As String, Optional ByVal as_LogType As String = "I", Optional ab_throwException As Boolean = True)
On Error GoTo ErrHandler
Const InsertReq As String = "EXEC A_log_ins $UCODE$, $LOGTYPE$, $MSG$, $APP$"
    Dim ls_req As String
    Dim ll_Cursor As Long
    
    ls_req = Replace(InsertReq, "$UCODE$", CStr(ml_U_Code))
    ls_req = Replace(ls_req, "$APP$", SqlStr(C_APPNAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision, 50))
    ls_req = Replace(ls_req, "$MSG$", SqlStr(as_LogMsg, 4000))
    ls_req = Replace(ls_req, "$LOGTYPE$", SqlStr(as_LogType), 1)
    
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    Exit Sub
ErrHandler:
    If ab_throwException Then Call ErrorHandler(Extender.Name & ".LogMessage()")
End Sub

' procedure save/restore err object
Private Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_ErrDesc As String
Static ls_ErrSource As String
Static ll_errNum As Long
    
    If ab_saveError Then
        ls_ErrDesc = Err.Description
        ls_ErrSource = Err.Source
        ll_errNum = Err.Number
    Else
        Err.Description = ls_ErrDesc
        Err.Source = ls_ErrSource
        Err.Number = ll_errNum
    End If
End Sub

Private Function SendMessage(ByVal as_msg As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
On Error GoTo ErrHandler
    Call LockScreen(True)
    SendMessage = MsgBox(as_msg, Buttons)
    Call LockScreen(False)
    Exit Function
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".SendMessage")
End Function

' function return original container
Private Function MoveControlToFront(ByRef ao_ctrl As Object) As Object
On Error GoTo ErrHandler
    Set MoveControlToFront = ao_ctrl.Container
    ao_ctrl.Top = ao_ctrl.Container.Top + ao_ctrl.Top
    ao_ctrl.Left = ao_ctrl.Container.Left + ao_ctrl.Left
    Set ao_ctrl.Container = ao_ctrl.Container.Container
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".MoveControlToFront")
End Function

' recalculate position correctly only in case of one level hierachical change
Private Function MoveControlToFrame(ByRef ao_ctrl As Object, ByRef ao_Frame As VB.Frame) As Object
On Error GoTo ErrHandler
    Set MoveControlToFrame = ao_ctrl.Container
    Set ao_ctrl.Container = ao_Frame
    ao_ctrl.Top = ao_ctrl.Top - ao_Frame.Top
    ao_ctrl.Left = ao_ctrl.Left - ao_Frame.Left
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".MoveControlToFrame")
End Function

' ************************************************************************************
' *************************** INTERNATIONAL FUNCTIONS ********************************
' ************************************************************************************

Private Function GetCodePageFromLanguage(ByRef ao_Armdb As Object, ByVal as_Language As String) As Long
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT Code_Page FROM Language WHERE Language_Code = '$Language_Code$'"
    Dim ls_req As String
    Dim ll_Cursor As Long
    Dim ll_CodePage As Long
    
    ls_req = ReplacePlaceHolder(C_REQ, "$Language_Code$", as_Language)

    ll_Cursor = OpenSQLSafe(ao_Armdb, ls_req)
    Debug.Assert (ll_Cursor <> 0)
    
    ll_CodePage = CLng(ao_Armdb.GetFields(ll_Cursor, "Code_Page"))
    Call ao_Armdb.Close(ll_Cursor)
    GetCodePageFromLanguage = ll_CodePage
    Exit Function
    
ErrHandler:
    If ll_Cursor <> 0 Then Call ao_Armdb.Close(ll_Cursor)
    Call ErrorHandler("GetCodePageFromLanguage()")
End Function

'convert code page into charset integer
Private Function GetCharSetFromCodePage(ByVal al_CodePage As Long) As Long

On Error GoTo ErrHandler

    Select Case CStr(al_CodePage)
        Case 932 ' Japanese
            GetCharSetFromCodePage = 128
        Case 936 ' Simplified Chinese
            GetCharSetFromCodePage = 134
        Case 949 ' Korean
            GetCharSetFromCodePage = 129
        Case 950 ' Traditional Chinese
            GetCharSetFromCodePage = 136
        Case 1250 ' Eastern Europe
            GetCharSetFromCodePage = 238
        Case 1251 ' Russian
            GetCharSetFromCodePage = 204
        Case 1252 ' Western European Languages
            GetCharSetFromCodePage = 0
        Case 1253 ' Greek
            GetCharSetFromCodePage = 161
        Case 1254 ' Turkish
            GetCharSetFromCodePage = 162
        Case 1255 ' Hebrew
            GetCharSetFromCodePage = 177
        Case 1256 ' Arabic
            GetCharSetFromCodePage = 178
        Case 1257 ' Baltic
            GetCharSetFromCodePage = 186
        Case Else
            GetCharSetFromCodePage = 0
    End Select
    
    Exit Function
    
ErrHandler:
    Call ErrorHandler("GetCharSetFromCodePage()")
End Function

Private Sub ChangeCharset(ByRef ao_Container As Object, Optional ByVal aCodePage As Long)
On Error GoTo ErrHandler
   
    Dim lc_Control As Control
    Dim ll_Charset As Long
    
    On Error Resume Next
    ll_Charset = GetCharSetFromCodePage(aCodePage)
    
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
        Case "TABSTRIP", "TEXTBOX", "LABEL", "FRAME", "COMMANDBUTTON", _
              "LISTVIEW", "CHECKBOX", "OPTIONBUTTON", _
              "ARMCHECKVIEW", "ARMTREEVIEW", "ARMGRID", "ARMCOMBOBOX", "ARMCHECKVIEW0"
            lc_Control.Font.Name = "Arial"
            lc_Control.Font.Charset = ll_Charset
        Case "A_SEEK", "A_SRCHTXT"
            lc_Control.Charset = ll_Charset
        End Select
    Next
    
    Exit Sub

ErrHandler:
    Call ErrorHandler(Extender.Name & ".ChangeCharset")
End Sub

Private Function ReplacePlaceholderByGridRow(ByVal as_Request As String, ByRef ao_grid As ArmGrid, ByVal al_Row As Long) As String
On Error GoTo ErrHandler
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        Select Case lo_Column.FieldType
            Case DBTYPE_DATE
                as_Request = ReplacePlaceHolder(as_Request, "$" & lo_Column.FieldName & "$", SqlDate(lo_Column.GetData(al_Row)))
            Case DBTYPE_STR, DBTYPE_BSTR
                as_Request = ReplacePlaceHolder(as_Request, "$" & lo_Column.FieldName & "$", SqlStr(lo_Column.GetData(al_Row)))
            Case DBTYPE_I4
                as_Request = ReplacePlaceHolder(as_Request, "$" & lo_Column.FieldName & "$", SqlInt(lo_Column.GetData(al_Row)))
            Case DBTYPE_R4, DBTYPE_R8
                as_Request = ReplacePlaceHolder(as_Request, "$" & lo_Column.FieldName & "$", SqlDbl(lo_Column.GetData(al_Row)))
            Case Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lo_Column.FieldName & "$", lo_Column.GetData(al_Row))
        End Select
    Next

    ReplacePlaceholderByGridRow = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ChangeCharset")
End Function

Private Function ReplacePlaceholderByControlValue(ByVal as_Request As String, ByRef ao_Control As Object) As String
On Error GoTo ErrHandler

Dim lsa_Columns() As String

    If Trim(ao_Control.Tag) = "" Then
        ReplacePlaceholderByControlValue = as_Request
        Exit Function
    End If
    
    Select Case UCase(TypeName(ao_Control))
        Case "ARMCOMBOBOX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            
            If UBound(lsa_Columns) >= 0 Then
                If GetComboKey(ao_Control) = "" Then
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                Else
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr(GetComboKey(ao_Control)))
                End If
            End If
            If UBound(lsa_Columns) >= 1 Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(1) & "$", SqlStr(ao_Control.Text))
            End If
        Case "ARMPICKER"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            
            If UBound(lsa_Columns) >= 0 Then
                If (Trim(CStr(ao_Control.ItemCode)) = "") Or (CStr(ao_Control.ItemCode) = "0") Then
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                Else
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr(Trim(CStr(ao_Control.ItemCode))))
                End If
            End If
            If UBound(lsa_Columns) >= 1 Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(1) & "$", SqlStr(Trim(ao_Control.ItemDescription)))
            End If
        Case "CHECKBOX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            If ao_Control.Value = vbChecked Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr("X"))
            Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr(""))
            End If
        Case "TEXTBOX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            If UBound(lsa_Columns) > 0 Then
                
                Select Case lsa_Columns(1)
                    Case "Text"
                        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr(ao_Control.Text))
                    Case "Num"
                        If ao_Control.Text = "" Then
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                        Else
                            Dim ls_number As String
                            ls_number = Replace(Trim(ao_Control.Text), ms_ThousandSeparator, "", , , vbTextCompare)
                            ls_number = Replace(ls_number, ms_DecimalSeparator, ".", , , vbTextCompare)
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", ls_number)
                        End If
                    Case "Date"
                        If Not IsDate(ao_Control.Text) Then
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                        Else
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDate(CDate(ao_Control.Text)))
                        End If
                End Select
            Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr(ao_Control.Text))
            End If
        Case "A_CALOCX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDate(ao_Control.date_dt))
        Case "TABSTRIP"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            If ao_Control.SelectedItem Is Nothing Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
            Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlStr(ao_Control.SelectedItem.Key))
            End If
    End Select
    ReplacePlaceholderByControlValue = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplacePlaceholderByControlValue")
End Function

Private Function ReplaceRequestByFrameData(ByVal as_Request As String, ByVal ao_Frame As Frame)
On Error GoTo ErrHandler

Dim lo_Control As Control
   
    For Each lo_Control In UserControl.Controls
        If HasContainer(lo_Control, ao_Frame) Then
            as_Request = ReplacePlaceholderByControlValue(as_Request, lo_Control)
        End If
    Next
    ReplaceRequestByFrameData = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplaceRequestByFrameData")
End Function


Private Sub btn_recreateSPARequest_Click()
On Error GoTo ErrHandler
Const C_REQ_DEL As String = "DELETE FROM SPA_ApprovalPath WHERE SPA_Id = $SPA_Id$"
Const C_REQ_CHK_FUTURE As String = "EXEC SPA_CheckFutureReplacement $U_CODE$"
    If mb_Initializing Then Exit Sub
    
    If grd_SPA_Requests.SelectedCount = 0 Then
        Exit Sub
    End If
    
    '0. check if user is to be replaced in the future
    Dim ll_cursor As Long
    ll_cursor = OpenSQLSafe(mo_Db, ReplacePlaceHolder(C_REQ_CHK_FUTURE, "$U_CODE$", txt_Key.Text))
    
    Dim ls_ConfigDate As String
    ls_ConfigDate = ""
    
    If mo_Db.RowCount(ll_cursor) > 0 Then
        ' we have replacement in the furture so ask if we want to use this date
        Dim ll_msgResult As VbMsgBoxResult
        ll_msgResult = SendMessage("User will be replaced in future between " & mo_Db.GetFields(ll_cursor, "Date_Start") & " and " & mo_Db.GetFields(ll_cursor, "Date_End") & " by " & mo_Db.GetFields(ll_cursor, "P_First_Name") & " " & mo_Db.GetFields(ll_cursor, "P_Name") & vbCrLf & _
                        "Do you want to create Approval request for replacer?", vbQuestion + vbYesNoCancel)
        If ll_msgResult = vbCancel Then
            Exit Sub
        End If
        
        If ll_msgResult = vbYes Then
            ls_ConfigDate = Format(mo_Db.GetFields(ll_cursor, "Date_Start"), "yyyy-mm-dd")
        End If
    Else
        If SendMessage("Realy recreate SPA approval path?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
    
    Call mo_Db.Close(ll_cursor)
    ll_cursor = 0
    
    Dim ll_SPA_Id As Long
    ll_SPA_Id = grd_SPA_Requests.SelectedKey(0)(0)
    
    Call LockScreen(True)
       
    Dim lb_InTran As Boolean
    
    Call ExecuteSQLSafe(mo_Db, "BEGIN TRAN Item_Upd")
    lb_InTran = True
    
    '1. delete existing approval path
    Call ExecuteSQLSafe(mo_Db, ReplacePlaceHolder(C_REQ_DEL, "$SPA_Id$", ll_SPA_Id))
    
    '2. build new approval path
    If Not mo_SPA_Approval.BuildApprovalPath(ll_SPA_Id, ls_ConfigDate) Then
        ' build failed
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
        lb_InTran = False
        
        Call LockScreen(False)
        MsgBox MsgText(mo_SPA_Approval.LastErrorCode, ms_Language_Code, mo_SPA_Approval.LastErrorMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    Dim ll_i As Long
    
    ' keep approved levels by user
    If chk_keepApprovals.Value Then
        For ll_i = 0 To grd_approvalPath.Rows
            If grd_approvalPath.Data(ll_i, "Status_Code") = 2 Then              'esisApproved = 2
                ' approve the line also for new approval path
                If Not mo_SPA_Approval.SetApprovalPartStatus(grd_approvalPath.Data(ll_i, "Auth_U_Code")) Then
                    ' end of approving
                    Exit For
                End If
            End If
        Next
    End If
    
    ' 3. save approval path
    If Not mo_SPA_Approval.SaveApprovalPath() Then
        ' save failed
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
        lb_InTran = False
        
        Call LockScreen(False)
        MsgBox MsgText(mo_SPA_Approval.LastErrorCode, ms_Language_Code, mo_SPA_Approval.LastErrorMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
            
    Call ExecuteSQLSafe(mo_Db, "COMMIT TRAN Item_Upd")
    lb_InTran = False
    
    '4. refresh the grid
    grd_approvalPath.Refresh
    
    ' 5. log if config date is not current date
    If ls_ConfigDate <> "" Then
        Call LogMessage("Approval path for SPA:" & ll_SPA_Id & " generated with future config date:" & ls_ConfigDate, "I", False)
    End If
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    If ll_cursor > 0 Then
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
    End If
    If lb_InTran Then
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
        lb_InTran = False
    End If
    Call LockScreen(False)
    Call ErrorHandler("btn_recreateSPARequest_Click")
End Sub

Private Sub btn_resentSPARequest_Click()
On Error GoTo ErrHandler
    Const C_SPA_CHK As String = "SELECT T1.EML_MailStatus, AP.SIA_Id, AP.EML_Code_Sent FROM EML_Mail T1 " & _
                                "   INNER JOIN SPA_ApprovalPath AP ON AP.EML_Code_Sent = T1.EML_Code " & _
                                "WHERE AP.Status_Code='1' AND AP.Date_Emailed is not NULL and ap.spa_id = $SPA_ID$"
                                
    Const C_SPA_UPDATE As String = "UPDATE T1 SET T1.EML_MailStatus='N' " & _
                                    "FROM EML_Mail T1 " & _
                                    "   INNER JOIN SPA_ApprovalPath AP ON AP.EML_Code_Sent = T1.EML_Code " & _
                                    "WHERE AP.Status_Code='1' AND AP.Date_Emailed is not NULL and ap.spa_id = $SPA_ID$"
                                    
    Const C_SAP_LIST As String = "exec EML_GetOutgoingEmails_lst"
    
    If mb_Initializing Then Exit Sub
    
    If grd_SPA_Requests.SelectedCount = 0 Then
        Exit Sub
    End If
    
    If SendMessage("Realy resent email for selected SPA?", vbQuestion + vbYesNo) = vbNo Then
        Exit Sub
    End If

    Call LockScreen(True)
    
    Dim ll_SPA_Id As Long
    ll_SPA_Id = grd_SPA_Requests.SelectedKey(0)(0)

    Dim ll_Cursor As Long
    Dim ll_emlCode As Long
    ll_Cursor = OpenSQLSafe(mo_Db, ReplacePlaceHolder(C_SPA_CHK, "$SPA_ID$", ll_SPA_Id))
    
    If mo_Db.RowCount(ll_Cursor) = 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
        Call LockScreen(False)
        Call MsgBox(MsgText(ErrMsg_M740, ms_Language_Code, "No emails to resend for this SPA."), vbInformation)
        Exit Sub
    End If
    
    If mo_Db.GetFields(ll_Cursor, "EML_MailStatus") <> "P" Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
        Call LockScreen(False)
        Call MsgBox(MsgText(ErrMsg_M750, ms_Language_Code, "The Email to resend was not processed yet. (contanct Application supprot please)"), vbInformation)
        Exit Sub
    End If
    
    ll_emlCode = mo_Db.GetFields(ll_Cursor, "EML_Code_Sent")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If MsgBox(MsgText(ErrMsg_M760, ms_Language_Code, "Do you want to resend email?"), vbYesNo) = vbNo Then
        Call LockScreen(False)
        Exit Sub
    End If
    
    Call ExecuteSQLSafe(mo_Db, ReplacePlaceHolder(C_SPA_UPDATE, "$SPA_ID$", ll_SPA_Id))
    
    
    ' check if email is to be processed
    ll_Cursor = OpenSQLSafe(mo_Db, C_SAP_LIST)
    Do While Not mo_Db.EOF(ll_Cursor)
        If ll_emlCode = mo_Db.GetFields(ll_Cursor, "EML_Code") Then
            Call MsgBox(MsgText(ErrMsg_M770, ms_Language_Code, "The email was successfully resent to Approver."), vbInformation)
            Exit Do
        End If
        Call mo_Db.Next(ll_Cursor)
    Loop
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorMessage(Extender.Name & ".btn_resentSPARequest_Click")

End Sub

Private Sub btn_showReplacement_Click()
On Error GoTo ErrHandler

    If mb_Initializing Then Exit Sub
    Call LockScreen(True)

    fra_pendingSPArequests.Visible = False
    fra_userReplacement.Visible = True
    If grd_replacement.Rows > 0 Then
        grd_replacement.FirstLine
        Call grd_replacement_SelChange
    End If
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".btn_showReplacement_Click")
End Sub

Private Sub btn_showRequests_Click()
On Error GoTo ErrHandler

    If mb_Initializing Then Exit Sub
    Call LockScreen(True)

    fra_userReplacement.Visible = False
    fra_pendingSPArequests.Visible = True
    If grd_SPA_Requests.Rows > 0 Then
        grd_SPA_Requests.FirstLine
        Call grd_SPA_Requests_SelChange
    End If
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".btn_showRequests_Click")
End Sub

Private Sub ckv_markets_ItemCheck(ByVal Item As MSComctlLib.ListItem)
On Error GoTo ErrHandler

    
    If mb_Initializing Then Exit Sub
    Call LockScreen(True)
    If IsApproverSelected Then
        fra_UserRole.Visible = True
    Else
        Set cbo_role.SelectedItem = Nothing
        Set cbo_nextUser.SelectedItem = Nothing
        fra_UserRole.Visible = False
    End If
    
    Dim lo_ChkList As ArmCheckList
    
    Set lo_ChkList = ckv_markets.RoleList(ckv_markets.GetVisibleList)
    
    Call UpdateUserMarketsGrid(lo_ChkList.CommonRoleValues(0), _
                                lo_ChkList.Caption, _
                                lo_ChkList.GetItemKey(Item.Tag)(0), _
                                Item.Text, _
                                Item.Checked)
                    
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".ckv_markets_ItemSave")
End Sub

Private Sub UpdateUserMarketsGrid(ByVal al_SPA_UserType_Code As Long, ByVal as_SPA_UserType_Name As String, _
                                ByVal al_SPM_Code As Long, ByVal as_SPM_SDesc As String, ByVal ab_Checked As Boolean)
On Error GoTo ErrHandler
Dim lv_Data As Variant
Dim ls_ReqCheck As String
Dim lb_IsUsedToday As Boolean

    If ab_Checked Then
        If grd_UserMarkets.SearchKey(True, Array(al_SPA_UserType_Code, al_SPM_Code)) Then
            ' item was already in grid, we can just remove end date
            grd_UserMarkets.SelectedLine(0, "VDate_End") = 0
        Else
            ' item was not in the grid, add it to start from today
            lv_Data = Array(0, al_SPA_UserType_Code, as_SPA_UserType_Name, al_SPM_Code, as_SPM_SDesc, Date, 0)
            Call grd_UserMarkets.AddLine(lv_Data)
        End If
    Else
        If grd_UserMarkets.SearchKey(True, Array(al_SPA_UserType_Code, al_SPM_Code)) Then
            If grd_UserMarkets.SelectedLine(0, "SPAMU_ID") = 0 Then
                'item was not saved in db, we can remove from grid
                Call grd_UserMarkets.DeleteLine
            Else
                'item was saved in db, we must check if it was used today or not
                'ls_ReqCheck = Item_ReplacePlaceholders(REQ_USERROLE_IS_USED)
                'lb_IsUsedToday = EntryIsUsed(ls_ReqCheck)
                lb_IsUsedToday = True
                If lb_IsUsedToday Then
                    ' user role is used, close it for today
                    grd_UserMarkets.SelectedLine(0, "VDate_End") = Date
                Else
                    ' user role is not used, we can close it yesterday
                    grd_UserMarkets.SelectedLine(0, "VDate_End") = Date - 1
                End If
            End If
        Else
            'this should never happen, if we something uncheck, it must be in the grid before, if not crash
            Err.Raise ArmErr.InvalidArgument, "", "Consistency failed for U_Code: " & txt_Key.Text & " User_Type_Code: " & al_SPA_UserType_Code & " SPM_Code:" & al_SPM_Code
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UpdateUserMarketsGrid")
End Sub

Private Sub ckv_markets_ItemSave(ByVal ao_ItemInfo As ArmItemInfo, Saved As Boolean)
Const REQ_GET_DATES As String = "exec SPA_AuthMarketUser_Link_sel $USER_Code$,$SPM_Code$,$SPA_UserType_Code$"
On Error GoTo ErrHandler

Dim ls_ReqIns           As String
Dim ls_ReqUpd           As String
Dim ls_ReqDelete           As String
Dim ls_ReqClose           As String
Dim ls_ReqCheck         As String
Dim lb_IsUsedToday   As Boolean
Dim ls_ErrMessage       As String
Dim ll_Cursor           As Long
Dim ld_VDateStart       As Date
Dim ld_VDateEnd         As Date

    Saved = False
    
    ' check if this user is used today for spa, this check can be done only once before calling savelist (todo optimalization)
    'ls_ReqCheck = Item_ReplacePlaceholders(REQ_USERROLE_IS_USED)
    'lb_IsUsedToday = EntryIsUsed(ls_ReqCheck)
    lb_IsUsedToday = True
    
    'get VDate_Start,VDate_End for this Market - UserType combination
    ld_VDateStart = 0
    ld_VDateEnd = 0
    ls_ReqCheck = Item_ReplacePlaceholders(REQ_GET_DATES)
    ls_ReqCheck = Replace(ls_ReqCheck, "$SPM_Code$", ao_ItemInfo.GetData(0), , , vbTextCompare)
    ls_ReqCheck = Replace(ls_ReqCheck, "$SPA_UserType_Code$", ao_ItemInfo.GetData(2), , , vbTextCompare)
    ls_ReqCheck = Item_ReplacePlaceholders(ls_ReqCheck)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_ReqCheck)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        ld_VDateStart = mo_Db.GetFields(ll_Cursor, "VDate_Start")
        ld_VDateEnd = mo_Db.GetFields(ll_Cursor, "VDate_End")
    End If
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ao_ItemInfo.CurrentChecked Then
        'insert new user - market link
        If (ld_VDateStart <> 0) Then
            ' normally there is only one possibility, that this link is closed today, DateEnd = Today
            Debug.Assert (ld_VDateEnd = Date)
            ' market is again checked, but already closed today, just update validity end date
            ls_ReqUpd = ReplaceCommonPlaceholders(REQ_UPDATE_SPA_MKT_USER_LINK)
            ls_ReqUpd = ReplacePlaceHolder(ls_ReqUpd, "$SPM_Code$", ao_ItemInfo.GetData(0))
            ls_ReqUpd = ReplacePlaceHolder(ls_ReqUpd, "$SPA_UserType_Code$", ao_ItemInfo.GetData(2))
            ls_ReqUpd = Item_ReplacePlaceholders(ls_ReqUpd)
            Call ExecuteSQLSafe(mo_Db, ls_ReqUpd, 1)
            Saved = True
        Else
            ' this is new market assigned to this user and user type, just add it
            If UBound(ma_MKT_USER_ID_LIST) > 0 Then
                ls_ReqIns = ReplaceCommonPlaceholders(REQ_INSERT_SPA_MKT_USER_LINK)
                ls_ReqIns = Replace(ls_ReqIns, "$SPM_Code$", ao_ItemInfo.GetData(0), , , vbTextCompare)
                ls_ReqIns = Replace(ls_ReqIns, "$SPA_UserType_Code$", ao_ItemInfo.GetData(2), , , vbTextCompare)
                ls_ReqIns = Replace(ls_ReqIns, "$SPAMU_Id$", ma_MKT_USER_ID_LIST(UBound(ma_MKT_USER_ID_LIST) - 1), , , vbTextCompare)
                ls_ReqIns = Item_ReplacePlaceholders(ls_ReqIns)
                
                ReDim Preserve ma_MKT_USER_ID_LIST(UBound(ma_MKT_USER_ID_LIST) - 1)
            End If
            
            If Insert_ValidityManager(ls_ReqIns, ls_ErrMessage) Then
                Saved = True
            Else
                ms_ErrMessage = ls_ErrMessage
            End If
        End If
    Else
        'delete user - market link
    
        ls_ReqClose = ReplaceCommonPlaceholders(REQ_CLOSE_SPA_MKT_USER_LINK)
        ls_ReqClose = Replace(ls_ReqClose, "$SPM_Code$", ao_ItemInfo.GetData(0), , , vbTextCompare)
        ls_ReqClose = Replace(ls_ReqClose, "$SPA_UserType_Code$", ao_ItemInfo.GetData(2), , , vbTextCompare)
        ls_ReqClose = Item_ReplacePlaceholders(ls_ReqClose)
        
        ls_ReqDelete = ReplaceCommonPlaceholders(REQ_DELETE_SPA_MKT_USER_LINK)
        ls_ReqDelete = Replace(ls_ReqDelete, "$SPM_Code$", ao_ItemInfo.GetData(0), , , vbTextCompare)
        ls_ReqDelete = Replace(ls_ReqDelete, "$SPA_UserType_Code$", ao_ItemInfo.GetData(2), , , vbTextCompare)
        ls_ReqDelete = Item_ReplacePlaceholders(ls_ReqDelete)
        
        If Delete_ValidityManager(ld_VDateStart, _
                                ld_VDateEnd, _
                                ls_ReqClose, _
                                ls_ReqDelete, _
                                lb_IsUsedToday, _
                                ls_ErrMessage) Then
            Saved = True
        Else
            ms_ErrMessage = ls_ErrMessage
        End If
    End If
    Exit Sub
    
ErrHandler:
    Saved = False
    
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    Call ErrorMessage(Extender.Name & ".ckv_markets_ItemSave")
    End
End Sub

Private Sub grd_replacement_SelChange()
On Error GoTo ErrHandler

    If mb_Initializing Then Exit Sub
    If grd_replacement.SelectedCount = 0 Then
        fra_authLevelDetail.Visible = False
        Exit Sub
    End If
    
    Call LockScreen(True)
    
    Dim lo_detailData As Dictionary
    Set lo_detailData = New Dictionary
    lo_detailData.CompareMode = TextCompare
    
    ' fill array from selected gridrow
    Call FillDataSrcArrayFromGrid(lo_detailData, grd_replacement, grd_replacement.Row)
    
    Call SubItem_ViewInit(lo_detailData)
    
    Set lo_detailData = Nothing
    
    fra_authLevelDetail.Visible = True

    Call LockScreen(False)

    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".grd_items_SelChange")
End Sub

Private Sub FillDataSrcArrayFromGrid(ByRef ao_dataSrc As Dictionary, ByRef ao_grid As ArmGrid, ByVal al_Row As Long)
On Error GoTo ErrHandler
    
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    
    Call ao_dataSrc.RemoveAll
    
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        If Not ao_dataSrc.Exists(lo_Column.FieldName) Then Call ao_dataSrc.Add(lo_Column.FieldName, lo_Column.GetData(al_Row))
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillDataSrcArray")
End Sub

Private Sub grd_SPA_Requests_SelChange()
On Error GoTo ErrHandler

    If mb_Initializing Then Exit Sub
    If grd_SPA_Requests.SelectedCount = 0 Then
        fra_pendingSPArequests.Visible = False
        Exit Sub
    End If
    
    Call LockScreen(True)
    
    If Not grd_approvalPath.Load(Replace(ReplaceCommonPlaceholders(REQ_SELECT_DETAIL_APPROVALS_GRID), "$SPA_Id$", grd_SPA_Requests.SelectedKey(0)(0), , , vbTextCompare), True, , , False) Then
        Call Err.Raise(ArmErr.CompFncFailed, "grd_approvalPath.Load", "Loading grid of approvals failed!")
    End If

    btn_recreateSPARequest.Enabled = (activeScreenMode = smUpdate)
    btn_resentSPARequest.Enabled = (activeScreenMode = smUpdate)
    chk_keepApprovals.Enabled = (activeScreenMode = smUpdate)
    
    fra_pendingSPArequests.Visible = True

    Call LockScreen(False)

    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".grd_SPA_Requests_SelChange")
End Sub

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Static DoCheck As Boolean
    
    If DoCheck = True Then Exit Sub
    DoCheck = True
    
    Call LockScreen(True)
    tlb_Main.Enabled = False

    Select Case as_Role
        Case "A"
            'Call Run(SPA_Mode.emAdd, Array(""))
        Case "C" 'delete button
            Call Run(SPA_Mode.emDelete, Array(CLng(txt_Key.Text)))
        Case "B" 'goto Update screen
            Call Run(SPA_Mode.emUpdate, Array(CLng(txt_Key.Text)))
        Case "D"
            RaiseEvent OnPrint(Array(CLng(txt_Key.Text)))
        Case "I" 'Refresh update
            Call Item_Cleanup
            If isNumeric(txt_Key.Text) Then
                Call Item_Restore(Array(CLng(txt_Key.Text)))
            Else
                Call Item_Restore(Array(""))
            End If
            
        Case "H" 'validate mode add
            Select Case activeScreenMode
                Case ArmScreenMode.smAdd
                    ' Call Item_Add
                Case ArmScreenMode.smUpdate
                    Call Item_Update(Array(CLng(txt_Key.Text)))
                Case ArmScreenMode.smDelete
                    Call Item_Delete(Array(CLng(txt_Key.Text)))
                Case Else
                    Debug.Assert (False)
            End Select
        
        Case "Y" 'Goto next item
            Call popScreenMode
            RaiseEvent OnItemNext
            
            If activeScreenMode <> smView Then
                Call pushScreenMode(smView)
            End If

        Case "Z" 'Goto previous item
            Call popScreenMode
            RaiseEvent OnItemPrevious
        
            If activeScreenMode <> smView Then
                Call pushScreenMode(smView)
            End If
        
        Case "T"
            Call Item_Cleanup
            Call Item_Exit
    End Select
    
    tlb_Main.Enabled = True
    
    Call LockScreen(False)
    
    DoCheck = False

    Exit Sub

ErrHandler:
    
    DoCheck = False
    
    tlb_Main.Enabled = True
    Call LockScreen(False)
    
    Select Case Err.Number
    Case 3007
        MsgBox MsgText(3054, ms_Language_Code, "#This data has been updated by another user. Please reload the data and try again."), vbInformation
    
    Case 3008
        MsgBox MsgText(2138, ms_Language_Code, "#The record you try to open has been deleted by an other user. Please refresh the grid."), vbInformation
        Call Item_Exit
    
    Case Else
        Call LogMessage("tlb_Main_action: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E", False)
        Call MsgBox("Error during the process, Contact immediatly your IT support.", vbCritical)
        End
    End Select

    Exit Sub
End Sub

Private Function TestGridContaintRow(ByRef ao_grid As ArmGrid, ByVal as_colName As String, ByVal as_colVal As String, ByVal ab_incSelectedRow As Boolean, Optional ByVal as_colChangeName As String = "change", Optional ByVal as_deletedValue As String = "D") As Boolean
On Error GoTo ErrHandler
    Dim ll_Row As Long
    TestGridContaintRow = False
    For ll_Row = 0 To ao_grid.Rows - 1
        If StrComp(ao_grid.Data(ll_Row, as_colChangeName), as_deletedValue, vbTextCompare) <> 0 Then
            If ab_incSelectedRow Or (Not ab_incSelectedRow And ll_Row <> ao_grid.Row) Then
                If StrComp(ao_grid.Data(ll_Row, as_colName), as_colVal, vbTextCompare) = 0 Then
                    TestGridContaintRow = True
                    Exit Function
                End If
            End If
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".TestGridContaintRow")
End Function

Private Function TestGridNotContaintRow(ByRef ao_grid As ArmGrid, ByVal as_colName As String, ByVal as_colVal As String, ByVal ab_incSelectedRow As Boolean, Optional ByVal as_colChangeName As String = "change", Optional ByVal as_deletedValue As String = "D") As Boolean
On Error GoTo ErrHandler
    Dim ll_Row As Long
    TestGridNotContaintRow = True
    For ll_Row = 0 To ao_grid.Rows - 1
        If StrComp(ao_grid.Data(ll_Row, as_colChangeName), as_deletedValue, vbTextCompare) <> 0 Then
            If ab_incSelectedRow Or (Not ab_incSelectedRow And ll_Row <> ao_grid.Row) Then
                If StrComp(ao_grid.Data(ll_Row, as_colName), as_colVal, vbTextCompare) <> 0 Then
                    ' this means grid containt row which is not of value as_colVal
                    TestGridNotContaintRow = False
                    Exit Function
                End If
            End If
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".TestGridNotContaintRow")
End Function

Private Function GetGridNonDeletedRows(ByRef ao_grid As ArmGrid, Optional ByVal as_colName As String = "change", Optional ByVal as_deletedValue As String = "D") As Long
On Error GoTo ErrHandler
    Dim ll_Row As Long
    Dim ll_retVal As Long
    ll_retVal = 0
    For ll_Row = 0 To ao_grid.Rows - 1
        If StrComp(ao_grid.Data(ll_Row, as_colName), as_deletedValue, vbTextCompare) <> 0 Then ll_retVal = ll_retVal + 1
    Next
    GetGridNonDeletedRows = ll_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetGridNonDeletedRows")
End Function
Private Function GetGridColMaxValue(ByRef ao_grid As ArmGrid, ByVal as_colName As String, ByVal as_like As String) As Long
On Error GoTo ErrHandler
    Dim ll_Row As Long
    Dim ls_Data As String
    Dim ll_retVal As Long
    ll_retVal = 0
    For ll_Row = 0 To ao_grid.Rows - 1
        ls_Data = ao_grid.Data(ll_Row, as_colName)
        If Len(ls_Data) > Len(as_like) Then
            If StrComp(Left(ls_Data, Len(as_like)), as_like, vbTextCompare) = 0 Then
                ls_Data = right(ao_grid.Data(ll_Row, as_colName), Len(ao_grid.Data(ll_Row, as_colName)) - Len(as_like))
                If isNumeric(ls_Data) Then
                    If CLng(ls_Data) > ll_retVal Then ll_retVal = CLng(ls_Data)
                End If
            End If
        End If
    Next
    GetGridColMaxValue = ll_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetGridColMaxValue")
End Function

Private Sub tlb_replacement_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Static DoCheck As Boolean
    
    If DoCheck = True Then Exit Sub
    DoCheck = True
    
    Call LockScreen(True)
    tlb_replacement.Enabled = False

    Dim lo_detailData As Dictionary
    Set lo_detailData = New Dictionary
    lo_detailData.CompareMode = TextCompare

    Dim ll_msg As Long

    Select Case as_Role
        Case "A"
            ' Want to Add
            Call FillDataSrcArray(lo_detailData, Join(Array( _
                                Join(Array("SPUR_Id", "NEW#" & (GetGridColMaxValue(grd_replacement, "SPUR_Id", "NEW#") + 1)), SEP1), _
                                Join(Array("change", "A"), SEP1)), SEP))
                        
            Call SubItem_AddInit(lo_detailData)
        Case "B"
            ll_msg = SubItem_CanUpdate()
            If ll_msg = 0 Then
                ' fill array from selected gridrow
                Call FillDataSrcArrayFromGrid(lo_detailData, grd_replacement, grd_replacement.Row)
                Call SubItem_UpdateInit(lo_detailData)
            Else
                MsgBox MsgText(ll_msg, ms_Language_Code, "#Cannot Update."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
        Case "C"
            ll_msg = SubItem_CanDelete()
            If ll_msg = 0 Then
                ' fill array from selected gridrow
                Call FillDataSrcArrayFromGrid(lo_detailData, grd_replacement, grd_replacement.Row)
                Call SubItem_DeleteInit(lo_detailData)
            Else
                MsgBox MsgText(ll_msg, ms_Language_Code, "#Cannot Delete."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
        Case "T"
            grd_replacement.DeselectRow
            Call SubItem_Exit
        Case "I" ' restore changes
            Select Case activeScreenMode
                Case smAddItem
                    Call FillDataSrcArray(lo_detailData, Join(Array( _
                                                                        Join(Array("SPUR_Id", "NEW#" & (GetGridColMaxValue(grd_replacement, "SPUR_Id", "NEW#") + 1)), SEP1), _
                                                                        Join(Array("change", "A"), SEP1)), SEP))
                    Call lo_detailData.Add("Date_Start", Format(Now, "DD/MM/YYYY"))
                    Call lo_detailData.Add("Date_End", Format(Now, "DD/MM/YYYY"))
                    
                    Call SubItem_LoadValues(lo_detailData)
                Case smUpdateItem
                    ' fill array from selected gridrow
                    Call FillDataSrcArrayFromGrid(lo_detailData, grd_replacement, grd_replacement.Row)
                Case Else
                    Err.Raise ArmErr.InvalidArgument, "tlb_replacement_action", "Unknown screenMode=" & activeScreenMode
            End Select
            Call SubItem_Restore(lo_detailData)
        Case "H" ' confirm changes
            Select Case activeScreenMode
                Case smAddItem
                        Call SubItem_Add
                Case smUpdateItem
                        Call SubItem_Update
                Case smDeleteItem
                    Call SubItem_Delete
                Case Else
                    Err.Raise ArmErr.InvalidArgument, "tlb_replacement_action", "Unknown screenMode=" & activeScreenMode
            End Select
        Case Else
            Err.Raise ArmErr.InvalidArgument, "tlb_replacement_action", "Unknown replacement toolbar role as_Role=" & as_Role
    End Select

    Set lo_detailData = Nothing

    tlb_replacement.Enabled = True
    
    Call LockScreen(False)
    
    DoCheck = False

    Exit Sub

ErrHandler:
    
    DoCheck = False
    
    tlb_replacement.Enabled = True
    Call LockScreen(False)
    
    Call LogMessage("tlb_replacement_action: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E", False)
    Call MsgBox("Error during the process, Contact immediatly your IT support.", vbCritical)

    Exit Sub
End Sub

Private Sub UpdateMainToolbar()
On Error GoTo ErrHandler
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateMainToolbar")
End Sub


Private Function AddNewTab(ByRef ao_TabStrip As MSComctlLib.TabStrip, ByVal as_Key As String, ByVal as_Tag As String, ByVal as_caption As String) As Object
On Error GoTo ErrHandler
    Dim lo_retTab As Object
    If (ao_TabStrip.Tabs.Count = 1) And (ao_TabStrip.Tabs(1).Tag = "") Then
        Set lo_retTab = ao_TabStrip.Tabs(1)
        lo_retTab.Key = as_Key
        lo_retTab.Tag = as_Tag
        lo_retTab.Caption = as_caption
    Else
        Set lo_retTab = ao_TabStrip.Tabs.Add(, as_Key, as_caption)
        lo_retTab.Tag = as_Tag
    End If

    Set AddNewTab = lo_retTab
    Exit Function
ErrHandler:
    Call ErrorHandler("AddNewTab")
End Function


