VERSION 5.00
Begin VB.UserControl SPA_Main 
   ClientHeight    =   9765
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15255
   ScaleHeight     =   9765
   ScaleMode       =   0  'User
   ScaleWidth      =   15250
   Begin VB.Frame fra_Detail 
      Caption         =   "#SPA_Header detail"
      Height          =   7980
      Left            =   105
      TabIndex        =   17
      Tag             =   "fra_DetailSpaHeader"
      Top             =   720
      Width           =   15015
      Begin VB.TextBox txt_SPM_Desc 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   6195
         TabIndex        =   121
         Text            =   "SPM_Desc"
         Top             =   -30
         Visible         =   0   'False
         Width           =   810
      End
      Begin VB.TextBox txt_SPM_Code 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   5190
         TabIndex        =   120
         Text            =   "SPM_Code"
         Top             =   -60
         Visible         =   0   'False
         Width           =   885
      End
      Begin VB.Frame frm_linkedEmails 
         Caption         =   "#Linked emails"
         Height          =   3300
         Left            =   2040
         TabIndex        =   89
         Tag             =   "frm_linkedEmails"
         Top             =   480
         Width           =   11160
         Begin VB.CommandButton btn_closeLinkedEmails 
            Caption         =   "#Close"
            Height          =   360
            Left            =   10020
            TabIndex        =   91
            Tag             =   "btn_closeValidTo"
            Top             =   2820
            Width           =   1035
         End
         Begin VB.CommandButton btn_deleteLinkedEmails 
            Caption         =   "#Delete selection"
            Height          =   360
            Left            =   120
            TabIndex        =   90
            Tag             =   "btn_deleteLinkedEmails"
            Top             =   2820
            Width           =   1800
         End
         Begin Project1.ArmGrid grd_linkedEmails 
            Height          =   2460
            Left            =   120
            TabIndex        =   92
            TabStop         =   0   'False
            Tag             =   "grd_linkedEmails"
            Top             =   240
            Width           =   10935
            _ExtentX        =   19288
            _ExtentY        =   4339
         End
      End
      Begin VB.TextBox txt_SPA_ApprovalStatus_Desc 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   9720
         TabIndex        =   78
         Text            =   "SPA_ApprovalStatus_Desc"
         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox txt_SPA_Used_Comment 
         Height          =   315
         Left            =   2760
         MaxLength       =   80
         TabIndex        =   77
         Text            =   "SPA_Used_Comment"
         Top             =   2760
         Width           =   6975
      End
      Begin VB.CheckBox chk_usedInSAP 
         Height          =   255
         Left            =   2400
         TabIndex        =   76
         Tag             =   "chk_UsedInSAP"
         Top             =   2760
         Width           =   255
      End
      Begin VB.TextBox txt_Date_Submitted 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   13080
         TabIndex        =   75
         TabStop         =   0   'False
         Text            =   "Date_Submitted"
         Top             =   6015
         Width           =   1815
      End
      Begin VB.TextBox txt_SPA_Comment 
         Height          =   885
         Left            =   120
         MaxLength       =   1000
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   74
         Text            =   "SPA_Main.ctx":0000
         Top             =   7005
         Width           =   4035
      End
      Begin VB.TextBox txt_PricingDate 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   12840
         TabIndex        =   73
         TabStop         =   0   'False
         Text            =   "SPA_PridingDate"
         Top             =   2760
         Width           =   2055
      End
      Begin VB.TextBox txt_CT_Desc 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   5460
         TabIndex        =   72
         Text            =   "CT_Desc"
         Top             =   2040
         Width           =   2115
      End
      Begin VB.TextBox txt_Email 
         Height          =   315
         Left            =   9720
         MaxLength       =   80
         TabIndex        =   71
         Text            =   "Email"
         Top             =   2400
         Width           =   5175
      End
      Begin VB.TextBox txt_Fax 
         Height          =   315
         Left            =   9720
         MaxLength       =   80
         TabIndex        =   70
         Text            =   "Fax"
         Top             =   2040
         Width           =   5175
      End
      Begin VB.TextBox txt_Phone 
         Height          =   315
         Left            =   9720
         MaxLength       =   80
         TabIndex        =   69
         Text            =   "Phone"
         Top             =   1680
         Width           =   5175
      End
      Begin VB.CommandButton btn_pickProject 
         Caption         =   "..."
         Height          =   315
         Left            =   6240
         TabIndex        =   68
         Top             =   1350
         Width           =   375
      End
      Begin VB.CommandButton btn_pickContact 
         Caption         =   "..."
         Height          =   315
         Left            =   14520
         TabIndex        =   67
         Top             =   960
         Width           =   375
      End
      Begin VB.CommandButton btn_pickCustomer 
         Caption         =   "..."
         Height          =   315
         Left            =   7170
         TabIndex        =   66
         Top             =   990
         Width           =   375
      End
      Begin VB.TextBox txt_SPA_ID 
         BackColor       =   &H80000004&
         Height          =   285
         Left            =   13440
         TabIndex        =   65
         TabStop         =   0   'False
         Text            =   "SPA_ID"
         Top             =   240
         Width           =   1455
      End
      Begin VB.Frame fra_item 
         Caption         =   "#Items"
         Height          =   2940
         Left            =   120
         TabIndex        =   41
         Tag             =   "fra_item"
         Top             =   3030
         Width           =   14775
         Begin VB.Frame frm_SPA_Item_Detail 
            Caption         =   "#Detail of SPA Item"
            Height          =   630
            Left            =   120
            TabIndex        =   42
            Tag             =   "fra_DetailSpaItem"
            Top             =   240
            Width           =   14535
            Begin VB.CheckBox chk_rebate_exempt 
               Caption         =   "Rebate Exempt"
               Height          =   495
               Left            =   13560
               TabIndex        =   123
               Tag             =   "lbl_RebateExempt"
               ToolTipText     =   "Rebate Exempt"
               Top             =   105
               Width           =   855
            End
            Begin VB.TextBox txt_SPA_CURR_Code 
               BackColor       =   &H80000004&
               Enabled         =   0   'False
               Height          =   285
               Left            =   11895
               TabIndex        =   122
               TabStop         =   0   'False
               Text            =   "SPA_CURR_Code"
               Top             =   225
               Width           =   615
            End
            Begin VB.TextBox txt_BI_SAP_Code 
               BackColor       =   &H80000004&
               Height          =   285
               Left            =   1155
               Locked          =   -1  'True
               TabIndex        =   53
               Text            =   "BI_SAP_Code"
               Top             =   225
               Width           =   1215
            End
            Begin VB.TextBox txt_BI_Desc 
               BackColor       =   &H80000004&
               Height          =   285
               Left            =   2475
               Locked          =   -1  'True
               TabIndex        =   52
               Text            =   "BI_Desc"
               Top             =   225
               Width           =   3135
            End
            Begin VB.CommandButton btn_pickProduct 
               Caption         =   "..."
               Height          =   315
               Left            =   5640
               TabIndex        =   51
               Top             =   195
               Width           =   315
            End
            Begin VB.TextBox txt_SPA_Qty 
               Height          =   285
               Left            =   6900
               MaxLength       =   7
               TabIndex        =   50
               Text            =   "SPA_Qty"
               Top             =   225
               Width           =   645
            End
            Begin VB.TextBox txt_Std_Price 
               BackColor       =   &H80000004&
               Height          =   285
               Left            =   11025
               Locked          =   -1  'True
               TabIndex        =   49
               TabStop         =   0   'False
               Text            =   "Std_Price"
               Top             =   225
               Width           =   735
            End
            Begin VB.TextBox txt_SPA_Price 
               Height          =   285
               Left            =   9255
               MaxLength       =   7
               TabIndex        =   48
               Text            =   "SPA_Price"
               Top             =   225
               Width           =   735
            End
            Begin VB.TextBox txt_SPA_Discount 
               BackColor       =   &H80000004&
               Height          =   285
               Left            =   12600
               Locked          =   -1  'True
               TabIndex        =   47
               TabStop         =   0   'False
               Text            =   "SPA_Discount"
               Top             =   225
               Width           =   615
            End
            Begin VB.TextBox txt_SPI_ID 
               BackColor       =   &H80000004&
               Enabled         =   0   'False
               Height          =   285
               Left            =   1800
               TabIndex        =   46
               Text            =   "SPI_ID"
               Top             =   0
               Visible         =   0   'False
               Width           =   735
            End
            Begin VB.TextBox txt_change 
               BackColor       =   &H80000004&
               Enabled         =   0   'False
               Height          =   285
               Left            =   2760
               TabIndex        =   45
               Text            =   "change"
               Top             =   0
               Visible         =   0   'False
               Width           =   735
            End
            Begin VB.TextBox txt_iConcurrency 
               BackColor       =   &H80000004&
               Enabled         =   0   'False
               Height          =   285
               Left            =   3720
               TabIndex        =   44
               Text            =   "iConcurrency"
               Top             =   0
               Visible         =   0   'False
               Width           =   735
            End
            Begin VB.TextBox txt_SPGAM_Id 
               BackColor       =   &H80000004&
               Enabled         =   0   'False
               Height          =   285
               Left            =   4680
               TabIndex        =   43
               Text            =   "SPGAM_Id"
               Top             =   0
               Visible         =   0   'False
               Width           =   735
            End
            Begin Project1.ArmCombobox cbo_UOM 
               Height          =   345
               Left            =   7680
               TabIndex        =   54
               Top             =   165
               Width           =   795
               _ExtentX        =   1402
               _ExtentY        =   609
            End
            Begin VB.Label lbl_labels 
               Caption         =   "#Product"
               Height          =   255
               Index           =   25
               Left            =   135
               TabIndex        =   60
               Tag             =   "lbl_Product"
               Top             =   255
               Width           =   900
            End
            Begin VB.Label lbl_labels 
               Caption         =   "#Quantity"
               Height          =   255
               Index           =   26
               Left            =   6000
               TabIndex        =   59
               Tag             =   "lbl_Quantity"
               Top             =   255
               Width           =   915
            End
            Begin VB.Label lbl_labels 
               Caption         =   "#SAP price"
               Height          =   255
               Index           =   28
               Left            =   10050
               TabIndex        =   58
               Tag             =   "lbl_STDprice"
               Top             =   255
               Width           =   990
            End
            Begin VB.Label lbl_labels 
               Caption         =   "#Price"
               Height          =   255
               Index           =   27
               Left            =   8490
               TabIndex        =   57
               Tag             =   "lbl_SPAprice"
               Top             =   255
               Width           =   780
            End
            Begin VB.Label lbl_labels 
               Caption         =   "#%"
               Height          =   255
               Index           =   20
               Left            =   13245
               TabIndex        =   56
               Tag             =   "lbl_Discount"
               Top             =   255
               Width           =   255
            End
            Begin VB.Label lbl_labels 
               Caption         =   "#Unit of measure"
               Height          =   255
               Index           =   31
               Left            =   6960
               TabIndex        =   55
               Tag             =   "lbl_UOM"
               Top             =   0
               Visible         =   0   'False
               Width           =   3135
            End
         End
         Begin Project1.ToolbarControl tlb_item 
            Height          =   1860
            Left            =   13920
            TabIndex        =   61
            Top             =   915
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   3281
         End
         Begin Project1.ArmGrid grd_items 
            Height          =   1890
            Left            =   120
            TabIndex        =   62
            TabStop         =   0   'False
            Tag             =   "grd_Items"
            Top             =   930
            Width           =   13575
            _ExtentX        =   23945
            _ExtentY        =   3334
         End
      End
      Begin VB.TextBox txt_SR_Code 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   1560
         TabIndex        =   40
         Text            =   "SR_Code"
         Top             =   1680
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_CT_Code 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   4650
         TabIndex        =   39
         Text            =   "CT_Code"
         Top             =   2040
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_SPA_ApprovalStatus 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   9000
         TabIndex        =   38
         Text            =   "SPA_ApprovalStatus"
         Top             =   240
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.TextBox txt_Date_Completed 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   9000
         TabIndex        =   37
         Text            =   "Date_Completed"
         Top             =   600
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.CheckBox chk_SPA_Sent 
         Enabled         =   0   'False
         Height          =   255
         Left            =   8520
         TabIndex        =   36
         Tag             =   "chk_SPA_Sent"
         Top             =   600
         Visible         =   0   'False
         Width           =   255
      End
      Begin VB.TextBox txt_Date_PolicyCheck 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   9720
         TabIndex        =   35
         Text            =   "Date_PolicyCheck"
         Top             =   600
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.TextBox txt_SPACT_Id 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   3000
         TabIndex        =   34
         Text            =   "SPACT_Id"
         Top             =   0
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.TextBox txt_SPAMU_Id_Creator 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   3720
         TabIndex        =   33
         Text            =   "SPAMU_Id_Creator"
         Top             =   0
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.TextBox txt_SPAMU_Id_RaisedFor 
         Alignment       =   2  'Center
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   315
         Left            =   4440
         TabIndex        =   32
         Text            =   "SPAMU_Id_RaisedFor"
         Top             =   0
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.TextBox txt_CUST_Code 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   1560
         TabIndex        =   31
         Text            =   "CUST_Code"
         Top             =   1350
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_SR_Name 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   2400
         TabIndex        =   30
         Text            =   "SR_Name"
         Top             =   1680
         Width           =   5175
      End
      Begin VB.TextBox txt_CCU_Town 
         Enabled         =   0   'False
         Height          =   315
         Left            =   1590
         TabIndex        =   28
         Text            =   "CCU_Town"
         Top             =   2010
         Width           =   2175
      End
      Begin VB.CommandButton btn_PickContractor 
         Caption         =   "..."
         Height          =   315
         Left            =   14520
         TabIndex        =   26
         Top             =   1335
         Width           =   375
      End
      Begin VB.CommandButton btn_MakeProject 
         Caption         =   "#New"
         Height          =   315
         Left            =   6690
         TabIndex        =   25
         Tag             =   "btn_makeProject"
         Top             =   1350
         Width           =   885
      End
      Begin VB.TextBox txt_Internal_comment 
         Height          =   885
         Left            =   4185
         MaxLength       =   1000
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   24
         Text            =   "SPA_Main.ctx":0028
         Top             =   7005
         Width           =   4035
      End
      Begin VB.TextBox txt_SAP_Message 
         Height          =   480
         Left            =   2175
         MaxLength       =   250
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   23
         Text            =   "SPA_Main.ctx":0055
         Top             =   7470
         Visible         =   0   'False
         Width           =   4035
      End
      Begin VB.CommandButton btn_validToHistory 
         Caption         =   "..."
         Height          =   330
         Left            =   10575
         TabIndex        =   22
         Tag             =   "btn_valitToHistory"
         Top             =   6015
         Width           =   420
      End
      Begin VB.CommandButton btn_showLinkedEmails 
         Caption         =   "#Linked emails"
         Height          =   315
         Left            =   9960
         TabIndex        =   21
         Tag             =   "btn_showLinkedEmails"
         Top             =   600
         Width           =   1815
      End
      Begin VB.TextBox txt_SR_U_Code 
         BackColor       =   &H80000004&
         Enabled         =   0   'False
         Height          =   285
         Left            =   1215
         TabIndex        =   20
         Text            =   "SR_U_Code"
         Top             =   1695
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.CommandButton btn_resendApprovalEmails 
         Caption         =   "#Resend approval requests"
         Height          =   315
         Left            =   7665
         TabIndex        =   19
         Tag             =   "btn_resendApprovalEmails"
         Top             =   600
         Width           =   2175
      End
      Begin VB.TextBox txt_SPA_CUST_REF 
         Height          =   285
         Left            =   13440
         MaxLength       =   10
         TabIndex        =   18
         Text            =   "SPA_CUST_R"
         Top             =   600
         Width           =   1455
      End
      Begin Project1.ArmCombobox cbo_pricegroup 
         Height          =   345
         Left            =   1560
         TabIndex        =   27
         Top             =   2370
         Width           =   2235
         _ExtentX        =   3942
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_slsorg 
         Height          =   345
         Left            =   5460
         TabIndex        =   29
         Top             =   2370
         Width           =   2115
         _ExtentX        =   3731
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_requestor 
         Height          =   345
         Left            =   2400
         TabIndex        =   63
         Top             =   240
         Width           =   5175
         _ExtentX        =   9128
         _ExtentY        =   609
      End
      Begin Project1.ArmGrid grd_approvalPath 
         Height          =   1485
         Left            =   8280
         TabIndex        =   64
         TabStop         =   0   'False
         Tag             =   "grd_ApprovalPath"
         Top             =   6450
         Width           =   6615
         _ExtentX        =   11668
         _ExtentY        =   2619
      End
      Begin Project1.A_calocx cal_Date_Required 
         Height          =   360
         Left            =   2175
         TabIndex        =   79
         Top             =   6015
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   635
      End
      Begin Project1.A_calocx cal_valid_From 
         Height          =   360
         Left            =   6120
         TabIndex        =   80
         Top             =   6015
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   635
      End
      Begin Project1.A_calocx cal_valid_To 
         Height          =   360
         Left            =   8640
         TabIndex        =   81
         Top             =   6015
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   635
      End
      Begin Project1.ArmCombobox cbo_SPA_Type 
         Height          =   345
         Left            =   2400
         TabIndex        =   82
         Top             =   600
         Width           =   5175
         _ExtentX        =   9128
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_customer 
         Height          =   345
         Left            =   2400
         TabIndex        =   83
         Top             =   960
         Width           =   4695
         _ExtentX        =   8281
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_project 
         Height          =   345
         Left            =   2400
         TabIndex        =   84
         Top             =   1320
         Width           =   3795
         _ExtentX        =   6694
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_contact 
         Height          =   345
         Left            =   9720
         TabIndex        =   85
         Top             =   960
         Width           =   4695
         _ExtentX        =   8281
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_ceilingContractor 
         Height          =   345
         Left            =   9720
         TabIndex        =   86
         Top             =   1320
         Width           =   4695
         _ExtentX        =   8281
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_Delivery_Method1 
         Height          =   345
         Left            =   2175
         TabIndex        =   87
         Top             =   6450
         Width           =   2850
         _ExtentX        =   5027
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_Delivery_Method2 
         Height          =   345
         Left            =   5130
         TabIndex        =   88
         Top             =   6435
         Width           =   2895
         _ExtentX        =   5106
         _ExtentY        =   609
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Status"
         Height          =   255
         Index           =   7
         Left            =   7680
         TabIndex        =   118
         Tag             =   "lbl_Status"
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Date submited"
         Height          =   240
         Index           =   24
         Left            =   11280
         TabIndex        =   117
         Tag             =   "lbl_DateSubmited"
         Top             =   6030
         Width           =   1815
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#to"
         Height          =   240
         Index           =   23
         Left            =   8040
         TabIndex        =   116
         Tag             =   "lbl_ValidTo"
         Top             =   6075
         Width           =   495
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Valid from"
         Height          =   240
         Index           =   22
         Left            =   4575
         TabIndex        =   115
         Tag             =   "lbl_ValidFrom"
         Top             =   6075
         Width           =   1455
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Approval needed by"
         Height          =   240
         Index           =   21
         Left            =   135
         TabIndex        =   114
         Tag             =   "lbl_Approval"
         Top             =   6075
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Comment"
         Height          =   255
         Index           =   19
         Left            =   120
         TabIndex        =   113
         Tag             =   "lbl_Comment"
         Top             =   6765
         Width           =   2175
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Pricing Date"
         Height          =   255
         Index           =   6
         Left            =   10785
         TabIndex        =   112
         Tag             =   "lbl_PricingDate"
         Top             =   2775
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Sales organization"
         Height          =   255
         Index           =   10
         Left            =   3870
         TabIndex        =   111
         Tag             =   "lbl_SalesOrganization"
         Top             =   2430
         Width           =   1515
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Country"
         Height          =   255
         Index           =   9
         Left            =   3870
         TabIndex        =   110
         Tag             =   "lbl_Country"
         Top             =   2070
         Width           =   1365
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Sales rep"
         Height          =   255
         Index           =   8
         Left            =   120
         TabIndex        =   109
         Tag             =   "lbl_SalesRep"
         Top             =   1680
         Width           =   2175
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Email"
         Height          =   255
         Index           =   18
         Left            =   7680
         TabIndex        =   108
         Tag             =   "lbl_Email"
         Top             =   2415
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Fax"
         Height          =   255
         Index           =   17
         Left            =   7680
         TabIndex        =   107
         Tag             =   "lbl_Fax"
         Top             =   2055
         Width           =   1935
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Phone"
         Height          =   255
         Index           =   16
         Left            =   7680
         TabIndex        =   106
         Tag             =   "lbl_Phone"
         Top             =   1695
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Project"
         Height          =   255
         Index           =   5
         Left            =   120
         TabIndex        =   105
         Tag             =   "lbl_Project"
         Top             =   1320
         Width           =   2175
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Contact"
         Height          =   255
         Index           =   4
         Left            =   7680
         TabIndex        =   104
         Tag             =   "llbl_Contact"
         Top             =   960
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Customer"
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   103
         Tag             =   "lbl_Customer"
         Top             =   960
         Width           =   2175
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Type"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   102
         Tag             =   "lbl_Type"
         Top             =   600
         Width           =   2175
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#SPA_ID"
         Height          =   255
         Index           =   1
         Left            =   11880
         TabIndex        =   101
         Tag             =   "lbl_SpaID"
         Top             =   240
         Width           =   1455
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Requestor"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   100
         Tag             =   "lbl_Requestor"
         Top             =   240
         Width           =   2295
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Used in SAP"
         Height          =   255
         Index           =   29
         Left            =   120
         TabIndex        =   99
         Tag             =   "lbl_UsedInSAP"
         Top             =   2760
         Width           =   2175
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Ceiling contractor"
         Height          =   255
         Index           =   30
         Left            =   7680
         TabIndex        =   98
         Tag             =   "llbl_CeilingContractor"
         Top             =   1320
         Width           =   2055
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Town"
         Height          =   285
         Index           =   32
         Left            =   120
         TabIndex        =   97
         Tag             =   "lbl_Town"
         Top             =   2040
         Width           =   1275
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Price group"
         Height          =   240
         Index           =   33
         Left            =   120
         TabIndex        =   96
         Tag             =   "lbl_PriceGroup"
         Top             =   2430
         Width           =   1305
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Delivery method"
         Height          =   255
         Index           =   34
         Left            =   120
         TabIndex        =   95
         Tag             =   "lbl_Delivery_Method"
         Top             =   6480
         Width           =   1935
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Internal comment"
         Height          =   255
         Index           =   35
         Left            =   4185
         TabIndex        =   94
         Tag             =   "lbl_internal_comment"
         Top             =   6795
         Width           =   3900
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Cust. ref. nb"
         Height          =   255
         Index           =   36
         Left            =   11880
         TabIndex        =   93
         Tag             =   "lbl_SpaCustID"
         ToolTipText     =   "Customer SPA Reference number"
         Top             =   600
         Width           =   1455
      End
   End
   Begin VB.Frame fra_manipulation 
      Caption         =   "#Manipulation"
      Height          =   735
      Left            =   127
      TabIndex        =   4
      Tag             =   "frm_maintenance"
      Top             =   8745
      Width           =   14970
      Begin VB.CheckBox chk_dropped 
         Caption         =   "#Dropped"
         Height          =   255
         Left            =   13680
         TabIndex        =   11
         TabStop         =   0   'False
         Tag             =   "Drop_flag"
         Top             =   360
         Width           =   1155
      End
      Begin VB.TextBox txt_dropDate 
         Alignment       =   2  'Center
         Enabled         =   0   'False
         Height          =   315
         Left            =   12360
         TabIndex        =   10
         TabStop         =   0   'False
         Tag             =   "txt_dropDate"
         Text            =   "02/02/2001"
         Top             =   285
         Width           =   1095
      End
      Begin VB.TextBox txt_updUser 
         Enabled         =   0   'False
         Height          =   315
         Left            =   9120
         TabIndex        =   9
         TabStop         =   0   'False
         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        =   8
         TabStop         =   0   'False
         Tag             =   "txt_lastUpd"
         Text            =   "02/02/2001"
         Top             =   285
         Width           =   1095
      End
      Begin VB.TextBox txt_creator 
         Enabled         =   0   'False
         Height          =   315
         Left            =   3480
         TabIndex        =   7
         TabStop         =   0   'False
         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        =   6
         TabStop         =   0   'False
         Tag             =   "txt_Date"
         Text            =   "02/02/2001"
         Top             =   285
         Width           =   1095
      End
      Begin VB.TextBox txt_Creator_Code 
         Enabled         =   0   'False
         Height          =   315
         Left            =   0
         TabIndex        =   5
         Tag             =   "Txt_Creator_Code"
         Top             =   0
         Visible         =   0   'False
         Width           =   1815
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Drop date"
         Height          =   255
         Index           =   15
         Left            =   11070
         TabIndex        =   16
         Tag             =   "lbl_dropDate"
         Top             =   360
         Width           =   1290
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#By"
         Height          =   255
         Index           =   14
         Left            =   8430
         TabIndex        =   15
         Tag             =   "lbl_creator"
         Top             =   360
         Width           =   690
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Last updade"
         Height          =   255
         Index           =   13
         Left            =   5430
         TabIndex        =   14
         Tag             =   "lbl_dateUpd"
         Top             =   360
         Width           =   1530
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#By"
         Height          =   255
         Index           =   12
         Left            =   2910
         TabIndex        =   13
         Tag             =   "lbl_ByUser"
         Top             =   360
         Width           =   570
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Creation date"
         Height          =   255
         Index           =   11
         Left            =   150
         TabIndex        =   12
         Tag             =   "lbl_date"
         Top             =   360
         Width           =   1410
      End
   End
   Begin VB.Frame frm_ValidToHistory 
      Caption         =   "#Validity date history"
      Height          =   3300
      Left            =   11205
      TabIndex        =   1
      Tag             =   "frm_ValidToHistory"
      Top             =   3885
      Width           =   3840
      Begin VB.CommandButton btn_closeValidTo 
         Caption         =   "#Close"
         Height          =   360
         Left            =   90
         TabIndex        =   3
         Tag             =   "btn_closeValidTo"
         Top             =   2835
         Width           =   1035
      End
      Begin Project1.ArmGrid grd_validToHistory 
         Height          =   2460
         Left            =   120
         TabIndex        =   2
         TabStop         =   0   'False
         Tag             =   "grd_validToHistory"
         Top             =   270
         Width           =   3630
         _ExtentX        =   6403
         _ExtentY        =   4339
      End
   End
   Begin Project1.CapPrj mo_CapPrj 
      Height          =   1995
      Left            =   12945
      TabIndex        =   0
      Top             =   5190
      Width           =   2400
      _ExtentX        =   4233
      _ExtentY        =   3519
   End
   Begin Project1.ToolbarControl tlb_main 
      Height          =   690
      Left            =   45
      TabIndex        =   119
      TabStop         =   0   'False
      Top             =   15
      Width           =   15135
      _ExtentX        =   26696
      _ExtentY        =   1217
   End
End
Attribute VB_Name = "SPA_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new
'2.6.9 : valid to date update, history grid, email sent (JN)
'2.6.9 : linked emails + drag and drop from ms outlook 2003 (JN)
'2.7.1 : new check -> Selected requestor is not defined as owner of a customer. (JN)
'2.7.1 : automatic linked emails creation of sent SPA emails (JN)
'2.8.1 : allow other users to resend approval request (JN)
'3.1.6 : added support for CURR_Code on item level (JN)

Private Declare Function GetLastError Lib "Kernel32" () As Long

' **************************************************************************************************
' ************************************* 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 LOCALE_SGROUPING = &H10   ' Grouping 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_MAIN"              ' for error log
Private Const C_SCREENNAME As String = "SPA_Main"           ' 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_ADD As String = "1"
Private Const C_TOOLBARFACE_ITEM_UPD As String = "2"
Private Const C_TOOLBARFACE_ITEM_DEL As String = "3"
Private Const SIFYB_CM_ERROR_MESSAGE = 8000                 ' const for base of error messages ids
Private Const C_ID_KEY = "SPA_Main"                         ' A_ID entry for new record
Private Const C_ID_KEY_ITEM = "SPA_Item"                    ' A_ID entry for new record item linked to header
' ****************************************** 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
    ErrMsgNumericRequired = SIFYB_CM_ERROR_MESSAGE + 5
    ErrMsgItemIsDeleted = SIFYB_CM_ERROR_MESSAGE + 19
    ErrMsgUpdateDeletedSPA = SIFYB_CM_ERROR_MESSAGE + 27
    ErrMsg_M000 = SIFYB_CM_ERROR_MESSAGE + 0                ' undefined message
    ErrMsg_M110 = SIFYB_CM_ERROR_MESSAGE + 110              'You cannot edit this SPA because the current status is not NEW.
    ErrMsg_M120 = SIFYB_CM_ERROR_MESSAGE + 120              'You cannot delete this SPA because the current Status is not NEW or SUBMITTED for approval
    ErrMsg_M130 = SIFYB_CM_ERROR_MESSAGE + 130              'You cannot email this SPA because the status is not APPROVED
    ErrMsg_M150 = SIFYB_CM_ERROR_MESSAGE + 150              'This email address does not appear to be the correct format (User@domain)
    ErrMsg_M160 = SIFYB_CM_ERROR_MESSAGE + 160              'You cannot submit this SPA for approval because the current status is not NEW.
    ErrMsg_M170 = SIFYB_CM_ERROR_MESSAGE + 170              'You cannot submit this SPA for approval because it contains no item lines
    ErrMsg_M190 = SIFYB_CM_ERROR_MESSAGE + 190              'You do not not have rights on this customers market
    ErrMsg_M200 = SIFYB_CM_ERROR_MESSAGE + 200              'The requestor does not have rights on this customers market
    ErrMsg_M201 = SIFYB_CM_ERROR_MESSAGE + 201              'Selected requestor is not defined as owner of a customer.
    ErrMsg_M210 = SIFYB_CM_ERROR_MESSAGE + 210              'You cannot use this customer as the customer is not a buying customer
    ErrMsg_M220 = SIFYB_CM_ERROR_MESSAGE + 220              'You do not not have rights on this projects market
    ErrMsg_M230 = SIFYB_CM_ERROR_MESSAGE + 230              'The requestor does not have rights on this projects market
    ErrMsg_M240 = SIFYB_CM_ERROR_MESSAGE + 240              'The Valid from date must be less than or equal to the Valid to date
    ErrMsg_M250 = SIFYB_CM_ERROR_MESSAGE + 250              'The Valid to date must be greater than today
    ErrMsg_M260 = SIFYB_CM_ERROR_MESSAGE + 260              'The SAP Item $BI_SAP_CODE$ is not sold in the market of the customer
    ErrMsg_M270 = SIFYB_CM_ERROR_MESSAGE + 270              'The SPA requestor is not authorised to raise an SPA for SAP Item $BI_SAP_CODE$ because of authorised market restiction. Contact the SPA System administrator
    ErrMsg_M280 = SIFYB_CM_ERROR_MESSAGE + 280              'The SAP Item $BI_SAP_CODE$ is not configured in a product group for the SPA's authorisation market. Contact the SPA System administrator
    ErrMsg_M300 = SIFYB_CM_ERROR_MESSAGE + 300              'The Field $FIELD_NAME$ must be entered
    ErrMsg_M330 = SIFYB_CM_ERROR_MESSAGE + 330              'This SPA cannot be marked used because the status is not RELEASED
    ErrMsg_M340 = SIFYB_CM_ERROR_MESSAGE + 340              'This SPA must be SUBMITTED before it can be APPROVED
    ErrMsg_M350 = SIFYB_CM_ERROR_MESSAGE + 350              'This SPA does not require your approval at this time
    ErrMsg_M360 = SIFYB_CM_ERROR_MESSAGE + 360              'Do you really want to delete this record
    ErrMsg_M370 = SIFYB_CM_ERROR_MESSAGE + 370              'This SAP item cannot appear in this SPA twice
    ErrMsg_M650 = SIFYB_CM_ERROR_MESSAGE + 650              'This SPA cannot be marked used because the status is not APPROVED
    ErrMsg_M701 = SIFYB_CM_ERROR_MESSAGE + 701              'SAP say:$SAP_MSG$ /n do you want to continue without prices?
    ErrMsg_M702 = SIFYB_CM_ERROR_MESSAGE + 702              'SAP service error: $SAP_MSG$
    ErrMsg_M703 = SIFYB_CM_ERROR_MESSAGE + 703              'SAP service unexpected response: $SAP_MSG$
    ErrMsg_M704 = SIFYB_CM_ERROR_MESSAGE + 704              'SAP service not responding ($SAP_MSG$)
    ErrMsg_M705 = SIFYB_CM_ERROR_MESSAGE + 705              'Country is not linked to any market
    ErrMsg_M706 = SIFYB_CM_ERROR_MESSAGE + 706              'This phone number does not appear to be the correct format (00xxx)
    ErrMsg_M724 = SIFYB_CM_ERROR_MESSAGE + 724              'The field $FIELD_NAME$ must be between $C_MIN_VAL$ and $C_MAX_VAL$.
    ErrMsg_M725 = SIFYB_CM_ERROR_MESSAGE + 725              'You are not releaser for the market of SPA
    ErrMsg_M726 = SIFYB_CM_ERROR_MESSAGE + 726              'Sales rep is not defined as Aprrover for the country of SPA
    ErrMsg_M727 = SIFYB_CM_ERROR_MESSAGE + 727              'The Approved by date must be equal or greater than today
    ErrMsg_M732 = SIFYB_CM_ERROR_MESSAGE + 732              'Alternative Item available ($MATERIAL$) Do you want to use it instead of $MAT_ENTRD$?
    ErrMsg_M733 = SIFYB_CM_ERROR_MESSAGE + 733              'Different currency ($CURRENCY$) found on COND.
    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.
    ErrMsg_M780 = SIFYB_CM_ERROR_MESSAGE + 780              'Only creator of SPA can resend the email.
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
Dim moa_DetailFieldsMandatory As Variant  ' all mandatory controls
Dim moa_DetailFieldsNumeric As Variant    ' all numeric controls


#If LIVE = 1 Then
    Dim mo_Sys As Object
#Else
    Dim mo_Sys As ARMSYSCOMLib.ArmSYS
#End If

#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 ml_SPM_Code             As Long             ' market to which currently loaded record belong to
Private md_old_validTo          As Double           ' old value loaded at initialization of a item
Private mo_userRghts            As TSPAUserRights
Private mo_tokenManager         As ArmToken
Private mo_A_Config             As Dictionary
Private mo_SPA_Approval         As SPA_Approval

Private ms_MsgInfo() As String


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

Private Enum ArmScreenMode
    smRefreshOnly
    smMain
    smAdd
    smCopy
    smUpdate
    smUpdateUsedInSAP
    smUpdateStauts
    smUpdateValidTo
    smDelete
    smView
    smAddItem
    smUpdateItem
    smDeleteItem
    smProjectView
End Enum


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

' 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 Sub Run(ByVal ae_ScrMode As SPA_Mode, ByVal av_Key As Variant, Optional ByVal al_newStatus As eSPA_ApprovalStatus = SPAS_New)
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.emUpdateUsedInSAP
            Call Item_UpdateUsedInSAPInit(av_Key)
        Case SPA_Mode.emUpdateStauts
            Call Item_UpdateStatusInit(av_Key, al_newStatus)
        Case SPA_Mode.emCopy
            Call Item_CopyInit(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


    ' 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"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        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
    
    Set mo_A_Config = New Dictionary
    mo_A_Config.CompareMode = TextCompare
    
    ' 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 mo_Sys = CreateObject("ARMSYSCOM.ArmSYS")
    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not InitUserRights(ml_U_Code) Then
        Exit Sub
    End If
    
    cal_Date_Required.opening_toward_top = 1
    cal_valid_From.opening_toward_top = 1
    cal_valid_To.opening_toward_top = 1
    
    ReDim Preserve mua_ActiveMode(0)
    mua_ActiveMode(UBound(mua_ActiveMode)) = ArmScreenMode.smMain

    ' init controls
    
    ReDim moa_ListFieldsMandatory(0 To 9) As Variant
    moa_ListFieldsMandatory(0) = Array(cbo_requestor, 0)
    moa_ListFieldsMandatory(1) = Array(cbo_SPA_Type, 2)
    moa_ListFieldsMandatory(2) = Array(cbo_customer, 3)
    moa_ListFieldsMandatory(3) = Array(cbo_contact, 4)
    moa_ListFieldsMandatory(4) = Array(Txt_phone, 16)
    moa_ListFieldsMandatory(5) = Array(cal_valid_From, 22)
    moa_ListFieldsMandatory(6) = Array(cal_valid_To, 23)
    moa_ListFieldsMandatory(7) = Array(cbo_slsorg, 10)
    moa_ListFieldsMandatory(8) = Array(cbo_Project, 5)
    moa_ListFieldsMandatory(9) = Array(cbo_pricegroup, 33)

    ReDim moa_ListFieldsNumeric(0 To 2) As Variant
    moa_ListFieldsNumeric(0) = Array(Txt_phone, 16)
    moa_ListFieldsNumeric(1) = Array(Txt_fax, 17)
    moa_ListFieldsNumeric(2) = Array(txt_Email, 18)
    
    InitMandatoryLabels (moa_ListFieldsMandatory)

    ' subdetail settings
    ReDim moa_DetailFieldsMandatory(0 To 3) As Variant
    moa_DetailFieldsMandatory(0) = Array(txt_BI_SAP_Code, 25)
    moa_DetailFieldsMandatory(1) = Array(txt_SPA_Qty, 26)
    moa_DetailFieldsMandatory(2) = Array(txt_SPA_Price, 27)
    moa_DetailFieldsMandatory(3) = Array(cbo_UOM, 31)
    
    ReDim moa_DetailFieldsNumeric(0 To 1) As Variant
    moa_DetailFieldsNumeric(0) = Array(txt_SPA_Qty, 26)
    moa_DetailFieldsNumeric(1) = Array(txt_SPA_Price, 27)
'mmmm
    InitMandatoryLabels (moa_DetailFieldsMandatory)

    Call FillControlArray(moa_ListFieldsToDisable, Array(txt_SPA_ID, txt_SR_Code, txt_SR_U_Code, txt_CT_Code, txt_PricingDate, chk_usedInSAP, txt_SPA_Used_Comment, txt_Std_Price, txt_SPA_CURR_Code, txt_SPA_Discount, txt_BI_SAP_Code, txt_BI_Desc, txt_Date_Submitted, txt_Date, Txt_Creator, txt_lastUpd, txt_updUser, txt_dropDate, chk_dropped))
    
    Call InitComponents
    
    Call LoadLabels(UserControl.Controls, C_SCREENNAME, ms_Language_Code)
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    
    Call Components_Settings
    
    ' init CapPrj embeded component >>
    Dim lt_CstValues As Type_CstValues
    
    Set lt_CstValues = New Type_CstValues

    mo_CapPrj.Visible = False
    Call mo_CapPrj.Move(0, 0, UserControl.Width, UserControl.Height + 200) 'height of SPA is too small
    
    mo_CapPrj.Language = ms_Language_Code
    
    mo_CapPrj.ConnectString = prg.CurrentServerIP & prg.ServerInstance & CH_LDELIMIT & prg.DBName & CH_LDELIMIT & prg.LoginName & CH_LDELIMIT & prg.U_PWD & CH_LDELIMIT & "SPA_Main"
    Set mo_CapPrj.ArmDb = mo_Db
    
    Call mo_CapPrj.FrameWorkInit(lt_CstValues, "SPAName")
    
    Call mo_CapPrj.Load_A_COM(False)
    Set lt_CstValues = Nothing
    
    ' << init CapPrj embeded component
    
    ' 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
    Call mo_tokenManager.Unload_A_COM
    Call mo_SPA_Approval.Unload_A_COM
    Call mo_CapPrj.Unload_A_COM
    
    Set mo_A_Config = Nothing
    Set mo_tokenManager = Nothing
    Set mo_SPA_Approval = Nothing
    Set mo_Db = Nothing
    Set mo_FSO = Nothing
    Set mo_Sys = Nothing
    Set mo_CapPrj = 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_SPA_ID, "SPA_Id" & SEP & "Text")
    Call Component_SetUp(txt_SPA_CUST_REF, "SPA_CUST_REF" & SEP & "Text")
    
    Call Component_SetUp(cbo_requestor, "Raised_For_U_Code" & SEP & "Raised_For_U_Name" & SEP & "SPM_Code" & SEP & "SPM_Desc")
    Call Component_SetUp(cbo_SPA_Type, "SPA_TypeFlag" & SEP & "RF_Desc")
    Call Component_SetUp(cbo_customer, "CCU_CapKey" & SEP & "CCU_Desc")
    Call Component_SetUp(cbo_contact, "CNT_Code" & SEP & "CNT_Name")
    Call Component_SetUp(cbo_Project, "SP_CapKey" & SEP & "SP_Desc")
    Call Component_SetUp(cbo_ceilingContractor, "CC_CCU_CapKey" & SEP & "CC_CCU_Desc")
    Call Component_SetUp(cbo_slsorg, "SLSORG" & SEP & "SLSORG_Desc")
    Call Component_SetUp(cbo_pricegroup, "Price_Grp" & SEP & "Price_Grp_Desc")
    Call Component_SetUp(cbo_Delivery_Method1, "Delivery_Method1" & SEP & "Delivery_Method_Desc1")
    Call Component_SetUp(cbo_Delivery_Method2, "Delivery_Method2" & SEP & "Delivery_Method_Desc2")
    
    Call Component_SetUp(txt_SPA_ApprovalStatus, "SPA_ApprovalStatus" & SEP & "Num")
    Call Component_SetUp(txt_SPA_ApprovalStatus_Desc, "RF_Status" & SEP & "Text")
    Call Component_SetUp(Txt_phone, "Phone" & SEP & "Tel")
    Call Component_SetUp(Txt_fax, "Fax" & SEP & "Tel")
    Call Component_SetUp(txt_Email, "EMail" & SEP & "Email")
    Call Component_SetUp(txt_SR_Code, "SR_Code" & SEP & "Text")
    Call Component_SetUp(txt_SR_U_Code, "SR_U_Code" & SEP & "Text")
    Call Component_SetUp(txt_SR_Name, "SR_Name" & SEP & "Text")
    Call Component_SetUp(txt_CT_Code, "CT_Code" & SEP & "Text")
    Call Component_SetUp(txt_CT_Desc, "CT_Desc" & SEP & "Text")
    Call Component_SetUp(txt_SPA_Used_Comment, "SPA_Used_Comment" & SEP & "Text")
    Call Component_SetUp(txt_PricingDate, "SPA_PricingDate" & SEP & "Date")
    Call Component_SetUp(txt_SPA_Comment, "SPA_Comment" & SEP & "Text")
    Call Component_SetUp(txt_Internal_comment, "Internal_comment" & SEP & "Text")
    Call Component_SetUp(txt_SAP_Message, "SAP_Message" & SEP & "Text")
    Call Component_SetUp(txt_Date_Submitted, "Date_Submitted" & SEP & "Date")
    
    Call Component_SetUp(chk_usedInSAP, "SPA_Used_Flag")
    
    Call Component_SetUp(cal_Date_Required, "Date_Required")
    Call Component_SetUp(cal_valid_From, "Valid_From")
    Call Component_SetUp(cal_valid_To, "Valid_To")

    Call Component_SetUp(txt_CCU_Town, "CCU_Town" & SEP & "Text")

    Call Component_SetUp(btn_MakeProject, "btn_makeProject" & SEP & "Text")

    'subitem controls
    Call Component_SetUp(txt_SPI_ID, "SPI_ID" & SEP & "Text")
    Call Component_SetUp(txt_change, "change" & SEP & "Text")
    Call Component_SetUp(txt_iConcurrency, "subiConcurrency" & SEP & "Num")
    
    
    Call Component_SetUp(cbo_UOM, "SPA_UoM" & SEP & "SPA_UoM")
    Call Component_SetUp(txt_BI_SAP_Code, "BI_SAP_Code" & SEP & "Text")
    Call Component_SetUp(txt_BI_Desc, "BI_Desc" & SEP & "Text")
    Call Component_SetUp(txt_SPA_Qty, "SPA_Qty" & SEP & "Num" & SEP & QTY_FORMAT)
    Call Component_SetUp(txt_SPA_Price, "SPA_Price" & SEP & "Num" & SEP & MONEY_FORMAT)
    Call Component_SetUp(txt_SPA_CURR_Code, "SPA_CURR_Code" & SEP & "Text")                     ' 9.1.2018 JN added support for CURR_Code on item level
    
    Call Component_SetUp(txt_Std_Price, "Std_Price" & SEP & "Num" & SEP & MONEY_FORMAT_PRECISE) ' 16.4. JN - fix to display 4 deciml places
    Call Component_SetUp(txt_SPA_Discount, "SPA_Discount" & SEP & "Num" & SEP & PERCENT_FORMAT)
    
    Call Component_SetUp(chk_rebate_exempt, "SPI_RebateExempt")

    ' invisible controls
    Call Component_SetUp(txt_Date_Completed, "Date_Completed" & SEP & "Date")
    Call Component_SetUp(chk_SPA_Sent, "SPA_Sent_Flag")
    Call Component_SetUp(txt_Date_PolicyCheck, "Date_PolicyCheck" & SEP & "Date")
    Call Component_SetUp(txt_SPACT_Id, "SPACT_Id" & SEP & "Num")
    Call Component_SetUp(txt_SPAMU_Id_Creator, "SPAMU_Id_Creator" & SEP & "Num")
    Call Component_SetUp(txt_SPAMU_Id_RaisedFor, "SPAMU_Id_RaisedFor" & SEP & "Num")
    Call Component_SetUp(txt_SPGAM_Id, "SPGAM_Id" & SEP & "Num")
    Call Component_SetUp(txt_Cust_Code, "CUST_Code" & SEP & "Text")
    Call Component_SetUp(txt_SPM_Code, "SPM_Code" & SEP & "Num")
    Call Component_SetUp(txt_SPM_Desc, "SPM_Desc" & SEP & "Text")
    
    


    
    ' 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_Creator_Code, "Z_Creator" & 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
    frm_SPA_Item_Detail.Visible = False
    fra_Detail.Visible = False
    fra_manipulation.Visible = False
    tlb_Main.Visible = False
    mo_CapPrj.Visible = False
    btn_MakeProject.Visible = False
    frm_ValidToHistory.Visible = False
    frm_linkedEmails.Visible = False

    ' we have clean screen we can display proper controls
    Select Case activeScreenMode
        Case smMain
        Case smAdd, smCopy
            fra_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            btn_MakeProject.Visible = True
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_ADD)
            Call tlb_item.DisplayFace("0")
        Case smUpdate
            fra_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            If Not cbo_SPA_Type.SelectedItem Is Nothing Then
                If cbo_SPA_Type.SelectedItem.Key = eSPA_Type.SPAT_Project Then
                    btn_MakeProject.Visible = True
                End If
            End If
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_UPD)
            Call tlb_item.DisplayFace("0")
        Case smUpdateUsedInSAP
            fra_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_UPD)
            Call tlb_item.DisplayFace("1")
        Case smUpdateStauts
            fra_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_DEL)       ' only validate or exit
            Call tlb_item.DisplayFace("1")
        Case smView, smUpdateStauts, smUpdateValidTo
            fra_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            If activeScreenMode = smUpdateValidTo Then
                Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_UPD)
                Call tlb_item.DisplayFace("0")
            Else
                Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_VIEW)
                Call tlb_item.DisplayFace("1")
            End If
        Case smDelete
            fra_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_DEL)
            Call tlb_item.DisplayFace("1")
        Case smAddItem, smUpdateItem, smDeleteItem
            fra_Detail.Visible = True
            frm_SPA_Item_Detail.Visible = True
            fra_manipulation.Visible = True
            tlb_Main.Visible = True
            Call tlb_item.DisplayFace("2")
        Case smProjectView
            mo_CapPrj.Visible = True
        Case Else
            Debug.Assert (False)
    End Select
    
    ' apply rights on toolbar
    Call UpdateMainToolbar(mo_userRghts)
    
    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, 2816, $id$"

On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    Dim ll_Cursor As Long
    Dim ll_i As Long
    
    ' main toolbar
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$id$", "NULL"))
    If mo_Db.Find(ll_Cursor, "id", TLB_SPA_DETAIL_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_DETAIL_ID & ") not found in DB")
    End If
    
    If mo_Db.Find(ll_Cursor, "id", TLB_SPA_SUBDETAIL_ID) >= 0 Then
        Call tlb_item.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_SUBDETAIL_ID & ") not found in DB")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    cbo_requestor.FirstBlankItem = False
    cbo_requestor.Request = ReplaceCommonPlaceholders(REQ_REQUESTOR_CBO)
    
    cbo_SPA_Type.FirstBlankItem = False
    cbo_SPA_Type.Request = ReplaceCommonPlaceholders(REQ_SPA_TYPE_CBO)

    cbo_UOM.FirstBlankItem = False
    cbo_UOM.Request = ReplaceCommonPlaceholders(REQ_SPA_UOM_CBO)

    cbo_Project.FirstBlankItem = True
    cbo_Project.Request = ""

    cbo_customer.FirstBlankItem = False
    cbo_customer.Request = ""

    cbo_contact.FirstBlankItem = False
    cbo_contact.Request = ""
    
    cbo_ceilingContractor.FirstBlankItem = True
    cbo_ceilingContractor.Request = ""

    cbo_slsorg.FirstBlankItem = False
    cbo_slsorg.Request = ""
    
    cbo_pricegroup.FirstBlankItem = False
    cbo_pricegroup.Request = ReplaceCommonPlaceholders(REQ_PRICE_GRP_CBO)
    
    cbo_Delivery_Method1.FirstBlankItem = True
    cbo_Delivery_Method1.Request = ReplaceCommonPlaceholders(REQ_DELIVERY_METHOD1_CBO)
    
    cbo_Delivery_Method2.FirstBlankItem = True
    cbo_Delivery_Method2.Request = ReplaceCommonPlaceholders(REQ_DELIVERY_METHOD2_CBO)
    
    grd_items.Title = "#Items"
    grd_items.AllowExcelExport = True
    grd_items.ExportTitles = True
    grd_items.ExportOnlyVisibleColumns = True
'mmmm
    ' 16.4. JN - fix to display 4 deciml places for Std_price
    Call grd_items.SetColumns(Array( _
          Join(Array("SPI_Id", 0, 1, "SPI_Id", "", "String", "", "Left"), SEP) _
        , Join(Array("BI_SAP_Code", 1000, 0, "BI_SAP_Code", "#SAP Code", "String", "", "Left"), SEP) _
        , Join(Array("BI_Desc", 1500, 0, "BI_Desc", "#Description", "String", "", "Left"), SEP) _
        , Join(Array("SPA_Qty", 1200, 0, "SPA_Qty", "#Quantity", "Float", QTY_FORMAT, "Left"), SEP) _
        , Join(Array("SPA_UoM", 600, 0, "SPA_UoM", "#UoM", "String", "", "Left"), SEP) _
        , Join(Array("Std_Price", 1200, 0, "Std_Price", "#Std Price", "Float", MONEY_FORMAT_PRECISE, "Left"), SEP) _
        , Join(Array("SPA_Price", 1200, 0, "SPA_Price", "#Price", "Float", MONEY_FORMAT, "Left"), SEP) _
        , Join(Array("SPA_CURR_Code", 900, 0, "SPA_CURR_Code", "#Currency", "String", "", "Left"), SEP) _
        , Join(Array("SPA_Discount", 1500, 0, "SPA_Discount", "#Discount", "Float", PERCENT_FORMAT, "Left"), SEP) _
        , Join(Array("SPI_RebateExempt", 800, 0, "SPI_RebateExempt", "#Rebate Exempt", "String", "", "Left"), SEP) _
        , Join(Array("subiConcurrency", 0, 0, "subiConcurrency", "", "Number", "", "Left"), SEP) _
        , Join(Array("SPGAM_Id", 0, 0, "SPGAM_Id", "", "Number", "", "Left"), SEP) _
        , Join(Array("change", 0, 0, "change", "", "String", "", "Left"), SEP) _
        , Join(Array("NumberOfCartons", 1500, 0, "NumberOfCartons", "", "Float", "", "Left"), SEP) _
        , Join(Array("NumberOfPallets", 1500, 0, "NumberOfPallets", "", "Float", "", "Left"), SEP) _
        , Join(Array("SPI_SAP_message", 0, 0, "SPI_SAP_message", "#SAP message", "String", "", "Left"), SEP) _
        , Join(Array("SAP_processed", 0, 0, "", "#SAP_Processed", "Number", "", "Left"), SEP) _
        ))
    
    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) _
        ))
        
    grd_validToHistory.Title = "#Valid to date history"
    grd_validToHistory.AllowExcelExport = True
    grd_validToHistory.ExportTitles = True
    grd_validToHistory.AllowSort = False
    grd_validToHistory.ExportOnlyVisibleColumns = True
    Call grd_validToHistory.SetColumns(Array( _
          Join(Array("Z_User", 1500, 0, "Z_User", "#User", "String", "", "Left"), SEP) _
        , Join(Array("Valid_to", 1500, 0, "Valid_to", "#Valid_to", "Date", "", "Left"), SEP) _
        ))
        
    grd_linkedEmails.Title = "#Linked emails list"
    grd_linkedEmails.AllowExcelExport = True
    grd_linkedEmails.ExportTitles = True
    grd_linkedEmails.AllowSort = False
    grd_linkedEmails.ExportOnlyVisibleColumns = True
    grd_linkedEmails.OleDropMode = flexOLEDragAutomatic
    Call grd_linkedEmails.SetColumns(Array( _
          Join(Array("SPA_EML_ID", 0, 1, "SPA_EML_ID", "#SPA_EML_ID", "Number", "", "Left"), SEP) _
        , Join(Array("SPA_EML_ZIP_ID", 0, 0, "SPA_EML_ZIP_ID", "#SPA_EML_ZIP_ID", "Number", "", "Left"), SEP) _
        , Join(Array("EML_Subject", 4000, 0, "EML_Subject", "#Subject", "String", "", "Left"), SEP) _
        , Join(Array("EML_SenderName", 2300, 0, "EML_SenderName", "#From", "String", "", "Left"), SEP) _
        , Join(Array("EML_To", 2300, 0, "EML_To", "#To", "String", "", "Left"), SEP) _
        , Join(Array("EML_Attachements", 500, 0, "EML_Attachements", "#Attachements", "Number", "", "Left"), SEP) _
        , Join(Array("EML_CreationTime", 1200, 0, "EML_CreationTime", "#Creation time", "Date", "", "Left"), SEP) _
        , Join(Array("iConcurrency", 0, 0, "iConcurrency", "", "Number", "", "Left"), SEP) _
        ))
    
    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_labels(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", "Tel", "Email"
                                        lControl.Text = mo_Db.GetFields(ac_Cursor, lValues(0))
                                    Case "Num"
                                        If UBound(lValues) >= 3 Then
                                            ' formated number
                                            lControl.Text = Format(mo_Db.GetFields(ac_Cursor, lValues(0)), lValues(2))  'Replace(Format(mo_Db.GetFields(ac_Cursor, lValues(0)), lValues(2)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                        Else
                                            lControl.Text = mo_Db.GetFields(ac_Cursor, lValues(0))  'Replace(mo_Db.GetFields(ac_Cursor, lValues(0)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                        End If
                                    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"
                        If mo_Db.GetFields(ac_Cursor, lControl.Tag) <> 0 Then
                        lControl.date_courte = Format(mo_Db.GetFields(ac_Cursor, lControl.Tag), "dd\/mm\/yyyy")
                        Else
                            lControl.date_courte = 0
                        End If
                        
                    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", "Tel", "Email"
                                        lControl.Text = as_detailData(lValues(0))
                                    Case "Num"
                                        If UBound(lValues) >= 3 Then
                                            ' formated number
                                            lControl.Text = Format(as_detailData(lValues(0)), lValues(2))  'Replace(Format(as_detailData(lValues(0)), lValues(2)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                        Else
                                            lControl.Text = as_detailData(lValues(0))   'Replace(as_detailData(lValues(0)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                        End If
                                    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 = as_detailData(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 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_Main 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"
        Case "TOOLBARCONTROL"
            ao_ctrl.Enabled = ab_Value
        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
    Dim ll_Cursor As Long
    mb_Initializing = True
    If as_Key <> "" Then
        Debug.Assert (isNumeric(as_Key))
        
        ' load main record
        ls_req = Replace(ReplaceCommonPlaceholders(REQ_SELECT_SPA), "$SPA_Id$", as_Key, , , vbTextCompare)
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        
        txt_SPA_ID.Text = as_Key
        
        Call LoadDataToForm(ll_Cursor, UserControl.Controls, Me)
        
        If Not grd_items.Load(Replace(ReplaceCommonPlaceholders(REQ_SELECT_DETAIL_ITEMS_GRID), "$SPA_Id$", as_Key, , , vbTextCompare), True, , , False) Then
            Call Err.Raise(ArmErr.CompFncFailed, "grd_items.Load", "Loading grid of items failed!")
        End If
        
        ' must load grid to get iconcurrency for approvalPath
        If Not grd_approvalPath.Load(Replace(ReplaceCommonPlaceholders(REQ_SELECT_DETAIL_APPROVALS_GRID), "$SPA_Id$", as_Key, , , vbTextCompare), True, , , False) Then
            Call Err.Raise(ArmErr.CompFncFailed, "grd_approvalPath.Load", "Loading grid of approvals failed!")
        End If
        
        If mo_Db.GetFields(ll_Cursor, "SPA_TypeFlag") = eSPA_Type.SPAT_Project Then
            cbo_customer.Request = Replace(ReplaceCommonPlaceholders(REQ_CUSTOMER_CBO), "$SP_CapKey$", SqlStr(mo_Db.GetFields(ll_Cursor, "SP_CapKey")), , , vbTextCompare)
            cbo_ceilingContractor.Request = Replace(ReplaceCommonPlaceholders(REQ_CEILING_CONTRACTOR_CBO), "$SP_CapKey$", SqlStr(mo_Db.GetFields(ll_Cursor, "SP_CapKey")), , , vbTextCompare)
        End If
        cbo_Project.Request = Replace(ReplaceCommonPlaceholders(REQ_PROJECT_CBO), "$CCU_CapKey$", SqlStr(mo_Db.GetFields(ll_Cursor, "CCU_CapKey")), , , vbTextCompare)
        cbo_contact.Request = Replace(ReplaceCommonPlaceholders(REQ_CONTACT_CBO), "$CCU_CapKey$", SqlStr(mo_Db.GetFields(ll_Cursor, "CCU_CapKey")), , , vbTextCompare)
        cbo_slsorg.Request = Replace(ReplaceCommonPlaceholders(REQ_SLSORG_CBO), "$CCU_CapKey$", SqlStr(mo_Db.GetFields(ll_Cursor, "CCU_CapKey")), , , vbTextCompare)
        
        grd_validToHistory.Requests = "EXEC SPA_ValidToHistory_Lst " & txt_SPA_ID.Text
        
        grd_linkedEmails.Requests = "EXEC SPA_LinkedEmail_lst " & txt_SPA_ID.Text

        Call ApplySPATypeUI(mo_Db.GetFields(ll_Cursor, "SPA_TypeFlag"))

        ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
        ml_SPM_Code = mo_Db.GetFields(ll_Cursor, "SPM_Code")
        md_old_validTo = cal_valid_To.date_dt
        
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
        
    Else
        ' load default values
        txt_SPA_ID.Text = "NEW"
        txt_SPA_CUST_REF.Text = ""
        txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_New
        txt_SPA_ApprovalStatus_Desc.Text = GetSPAStatusDesc(eSPA_ApprovalStatus.SPAS_New)
        txt_Date.Text = Format(Now, "dd\/mm\/yyyy")
        txt_Date_PolicyCheck.Text = Format(Now, "dd\/mm\/yyyy")
        Txt_Creator.Text = ms_LoginName
        txt_Creator_Code.Text = ml_U_Code
        txt_lastUpd.Text = ""
        txt_updUser.Text = ""
        txt_dropDate.Text = ""
        chk_dropped.Value = vbUnchecked
        
        grd_items.Requests = ""
        grd_approvalPath.Requests = ""
        cbo_customer.Request = ""
        cbo_Project.Request = ""
        cbo_contact.Request = ""
        cbo_ceilingContractor.Request = ""
        cbo_slsorg.Request = ""
        grd_validToHistory.Requests = ""
        grd_linkedEmails.Requests = ""
        
        cal_Date_Required.date_courte = Format(Now, "dd\/mm\/yyyy")
        md_old_validTo = 0
    End If
    Call UpdateCustSpecialCombo(lbl_labels(33), cbo_pricegroup, C_A_CONFIG_Price_Grp, txt_CT_Code.Text)
    Call UpdateCustSpecialCombo(lbl_labels(34), cbo_Delivery_Method1, C_A_CONFIG_DelMeth1, txt_CT_Code.Text)
    Call UpdateCustSpecialCombo(lbl_labels(34), cbo_Delivery_Method2, C_A_CONFIG_DelMeth2, txt_CT_Code.Text)
    mb_Initializing = False

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

Private Function GetSPAStatusDesc(ByVal al_ApprovalStatus As eSPA_ApprovalStatus) As String
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT RF_Desc FROM A_References_ML WHERE GR_Code=202 AND RF_Code=$AS_ID$ AND Language_Code=$Language_Code$"
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplaceCommonPlaceholders(C_REQ)
    ls_req = ReplacePlaceHolder(ls_req, "$AS_ID$", al_ApprovalStatus)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    GetSPAStatusDesc = mo_Db.GetFields(ll_Cursor, "RF_Desc")
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".GetSPAStatusDesc")
End Function

Private Function GetBaseItemDesc(ByVal as_BI_SAP_Code As String) As String
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC Base_Item_Desc_t_sel '$BI_SAP_CODE$', $Language_Code$"
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplaceCommonPlaceholders(C_REQ)
    ls_req = ReplacePlaceHolder(ls_req, "$BI_SAP_CODE$", as_BI_SAP_Code)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    GetBaseItemDesc = mo_Db.GetFields(ll_Cursor, "BI_Desc")
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".GetBaseItemDesc")
End Function

Private Function GetCustomer(ByVal as_CNT_Code As String) As String
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT CCU_CapKey FROM Cap_Contact WHERE CNT_Code='$CNT_Code$' and Language_Code = 'E'"
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ, "$CNT_Code$", as_CNT_Code)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    GetCustomer = mo_Db.GetFields(ll_Cursor, "CCU_CapKey")
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".GetCustomer")
End Function

Private Sub ClearCustomerData()
On Error GoTo ErrHandler

    ' CUST_Code
    txt_Cust_Code.Text = ""

    ' sales rep
    txt_SR_Code.Text = ""
    txt_SR_U_Code.Text = ""
    txt_SR_Name.Text = ""
    
    ' country
    txt_CT_Code.Text = ""
    txt_CT_Desc.Text = ""
    
    'town
    txt_CCU_Town.Text = ""
    
    ' slsorg
    Set cbo_slsorg.SelectedItem = Nothing
    Call cbo_pricegroup.Clear
    Call cbo_Delivery_Method1.Clear
    Call cbo_Delivery_Method2.Clear
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetCustomer")
End Sub

Private Function FillCustomerData(ByVal as_CCU_Capkey As String, Optional ByVal ab_CleanCCU As Boolean = True) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC SPA_CustomerData_sel '$CAPKEY$', $Language_Code$"
    Dim ll_Cursor As Long
    Dim ls_req As String
    FillCustomerData = False
    
    ls_req = ReplaceCommonPlaceholders(C_REQ)
    ls_req = ReplacePlaceHolder(ls_req, "$CAPKEY$", as_CCU_Capkey)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    If mo_Db.GetFields(ll_Cursor, "CUST_Code") <> "" Then
    
        Call LoadDataToForm(ll_Cursor, UserControl.Controls, fra_Detail)
        
        If IsDate(mo_A_Config.Item(C_A_CONFIG_VALIDFROMDATE & txt_CT_Code.Text)) Then
            cal_valid_From.date_courte = mo_A_Config.Item(C_A_CONFIG_VALIDFROMDATE & txt_CT_Code.Text)
        Else
            cal_valid_From.date_courte = Format(Now, "dd\/mm\/yyyy")            ' JN 07/02/2014 Defaulted to Today in case if it is not set by a_config
        End If
        
        If IsDate(mo_A_Config.Item(C_A_CONFIG_VALIDTODATE & txt_CT_Code.Text)) Then
            cal_valid_To.date_courte = mo_A_Config.Item(C_A_CONFIG_VALIDTODATE & txt_CT_Code.Text)
        End If
        
        If mo_A_Config.Item(C_A_CONFIG_SPA_TYPE_SUPPORT & txt_CT_Code.Text) <> "" Then
            If cbo_SPA_Type.SelectedItem Is Nothing Then
                cbo_SPA_Type.Clear
                cbo_SPA_Type.Load
            End If
            Call LimitComboByConfig(cbo_SPA_Type, C_A_CONFIG_SPA_TYPE_SUPPORT & txt_CT_Code.Text)
        End If
        
        'Call cbo_SPA_Type.Load
        
        
        FillCustomerData = True
    End If
    Call mo_Db.Close(ll_Cursor)
    
    If ab_CleanCCU Then
        Call cbo_pricegroup.Clear
    End If
    Call UpdateCustSpecialCombo(lbl_labels(33), cbo_pricegroup, C_A_CONFIG_Price_Grp, txt_CT_Code.Text)
    If ab_CleanCCU Then
        Call cbo_Delivery_Method1.Clear
        ' task 254 JN
        Call cbo_Delivery_Method1.Load
        Call cbo_Delivery_Method1.SearchItem(mo_A_Config.Item(C_A_CONFIG_DelMeth1_def & "_" & txt_CT_Code.Text))
        Call LimitComboByConfig(cbo_Delivery_Method1, C_A_CONFIG_DelMeth1 & "_" & txt_CT_Code.Text)
    End If
    Call UpdateCustSpecialCombo(lbl_labels(34), cbo_Delivery_Method1, C_A_CONFIG_DelMeth1, txt_CT_Code.Text)
    If ab_CleanCCU Then
        Call cbo_Delivery_Method2.Clear
        ' task 254 JN
        Call cbo_Delivery_Method2.Load
        Call cbo_Delivery_Method2.SearchItem(mo_A_Config.Item(C_A_CONFIG_DelMeth2_def & "_" & txt_CT_Code.Text))
        Call LimitComboByConfig(cbo_Delivery_Method2, C_A_CONFIG_DelMeth2 & "_" & txt_CT_Code.Text)
    End If
    Call UpdateCustSpecialCombo(lbl_labels(34), cbo_Delivery_Method2, C_A_CONFIG_DelMeth2, txt_CT_Code.Text)
    

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

Private Sub UpdateCustSpecialCombo(ByVal ao_Label As Object, ByVal ao_Combo As Object, ByVal as_Config_Key As String, ByVal as_CT_Code As String)
On Error GoTo ErrHandler

    If GetComboKey(ao_Combo) = "" Then
        If mo_A_Config.Item(as_Config_Key & "_" & as_CT_Code) <> "" Then
            ao_Combo.Visible = True
            ao_Label.Visible = True
        Else
            ao_Combo.Visible = False
            ao_Label.Visible = False
        End If
    Else
        ao_Combo.Visible = True
        ao_Label.Visible = True
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UpdateCustSpecialCombo")
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)
    ml_SPM_Code = 0
    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)))
    
    Dim ll_errMsg As Long
    ll_errMsg = Item_CanDelete()
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be deleted."), vbInformation)
        ' move to previous screen
        Call pushScreenMode(smView)              ' only to imitate UpdateUI
        Call Item_Exit
        Exit Sub
    End If
    
    Call UpdateUI(ArmScreenMode.smDelete)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_DeleteInit")
End Sub


' initialize Add mode
Private Sub Item_AddInit()
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smAdd)
    Call Item_Clear
        
    Call Item_LoadValues("")
    
    Dim ll_errMsg As Long
    ll_errMsg = Item_CanAdd()
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be added."), vbInformation)
        ' move to previous screen
        Call pushScreenMode(smView)              ' only to imitate UpdateUI
        Call Item_Exit
        Exit Sub
    End If
    
    Call UpdateUI(ArmScreenMode.smAdd)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_AddInit")
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 Item_LoadValues(CStr(as_detailKey(0)))
    
    Dim ll_errMsg As Long
    ll_errMsg = Item_CanUpdate()
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be updated."), vbInformation)
        If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Approved And _
            isUserType(mo_userRghts.SPARights, SPA_ValidToUpdater, ml_SPM_Code) Then
            ' allow to update validityTo date       JN 06/10/2012
            Call ResetScreen(ArmScreenMode.smUpdateValidTo)
            Call UpdateUI(ArmScreenMode.smUpdateValidTo)
        Else
            ' move to previous screen
            Call pushScreenMode(smView)              ' only to imitate UpdateUI
            Call Item_Exit
        End If
        Exit Sub
    End If
    
    If GetComboKey(cbo_requestor) <> txt_SR_U_Code.Text Or txt_SR_U_Code.Text = "" Then
        ' show message
        Call MsgBox(MsgText(ErrMsg_M201, ms_Language_Code, "#Selected requestor is not defined as owner of a customer."), vbInformation)
    End If
    
    Call UpdateUI(ArmScreenMode.smUpdate)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateInit")
End Sub



' initialize update mode
Private Sub Item_UpdateStatusInit(ByVal as_detailKey As Variant, ByVal al_newSataus As eSPA_ApprovalStatus)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smUpdateStauts)
    Call Item_Clear
        
    Call Item_LoadValues(CStr(as_detailKey(0)))
    
    Dim ll_errMsg As Long
    ll_errMsg = Item_CanUpdateStatus(al_newSataus)
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be updated."), vbInformation)
        ' move to previous screen
        Call pushScreenMode(smView)              ' only to imitate UpdateUI
        Call Item_Exit
        Exit Sub
    End If
    
    Select Case al_newSataus
        Case eSPA_ApprovalStatus.SPAS_Approved
            ll_errMsg = Item_CanApprove()
        Case eSPA_ApprovalStatus.SPAS_Rejected
            ll_errMsg = Item_CanReject()
        Case eSPA_ApprovalStatus.SPAS_Released
            ll_errMsg = Item_CanRelease()
        Case eSPA_ApprovalStatus.SPAS_Submited
            ll_errMsg = Item_CanSubmit()
    End Select
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be updated."), vbInformation)
        ' move to previous screen
        Call pushScreenMode(smView)              ' only to imitate UpdateUI
        Call Item_Exit
        Exit Sub
    End If
    
    ' set new status
    txt_SPA_ApprovalStatus.Text = al_newSataus
    txt_SPA_ApprovalStatus_Desc.Text = GetSPAStatusDesc(al_newSataus)
    
    If al_newSataus = SPAS_Submited Then txt_Date_Submitted.Text = Format(Now, "dd\/mm\/yyyy")      ' fix jn 03/02/2011
    
    Call UpdateUI(ArmScreenMode.smUpdateStauts)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateStatusInit")
End Sub


' initialize copy mode
Private Sub Item_CopyInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smCopy)
    Call Item_Clear
        
    Call Item_LoadValues(CStr(as_detailKey(0)))
    
    Dim ll_errMsg As Long
    ll_errMsg = Item_CanCopy()
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be copied."), vbInformation)
        ' move to previous screen
        Call pushScreenMode(smView)              ' only to imitate UpdateUI
        Call Item_Exit
        Exit Sub
    End If
    
    Call Item_CopyReset(as_detailKey(0))
    
    If GetComboKey(cbo_requestor) <> txt_SR_U_Code.Text Or txt_SR_U_Code.Text = "" Then
        ' show message
        Call MsgBox(MsgText(ErrMsg_M201, ms_Language_Code, "#Selected requestor is not defined as owner of a customer."), vbInformation)
    End If

    
    Call UpdateUI(ArmScreenMode.smCopy)
        
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_CopyInit")
End Sub

Private Sub Item_CopyReset(ByVal al_SPA_ID As Long)
On Error GoTo ErrHandler
    txt_SPA_ID.Text = "COPY_" & al_SPA_ID
    
    ' clear fields as per doc 'Copy SPA Screen 170'
    
    If cal_Date_Required.date_dt() + 1 < Now() Then
        cal_Date_Required.date_courte = Format(Now, "dd\/mm\/yyyy")
    End If
    If cal_valid_From.date_dt() + 1 < Now() Then Call cal_valid_From.reinit_cal
    If cal_valid_To.date_dt() + 1 < Now() Then Call cal_valid_To.reinit_cal
    txt_SPA_ApprovalStatus.Text = SPAS_New
    txt_SPA_ApprovalStatus_Desc.Text = GetSPAStatusDesc(SPAS_New)
    Call grd_approvalPath.ClearGrid
    grd_approvalPath.Requests = ""
    Call grd_validToHistory.ClearGrid
    grd_validToHistory.Requests = ""
    Call grd_linkedEmails.ClearGrid
    grd_linkedEmails.Requests = ""
    

    ' used things
    chk_usedInSAP.Value = vbUnchecked
    txt_SPA_Used_Comment.Text = ""
    
    

'    Date_Raised    ?????????????????????????????????????????????????????????????? WHAT DATE IS THAT???????
    txt_Date_Completed.Text = ""
    txt_Date_Submitted.Text = ""
    txt_Date_PolicyCheck.Text = ""
    txt_PricingDate.Text = ""
    
    ' SOMETHING TO REFRESH
    If FillCustomerData(cbo_customer.SelectedItem.Key, False) Then
        txt_Date_PolicyCheck.Text = Format(Now, "dd\/mm\/yyyy")       ' field is not nullable in db
    Else
        Call ClearCustomerData
    End If

    ' MARK ITEMS AS NEW
    Dim ll_i As Long
    For ll_i = 0 To grd_items.Rows - 1
        grd_items.Data(ll_i, "SPI_ID") = "NEW#" & (ll_i + 1)
        grd_items.Data(ll_i, "change") = "A"
        ' clear SAP prices
        grd_items.Data(ll_i, "Std_Price") = 0
        grd_items.Data(ll_i, "SPA_Discount") = 100
        grd_items.Data(ll_i, "SPI_SAP_message") = ""
    Next
    
    ' reset system data
    Txt_Creator.Text = ms_LoginName
    txt_Creator_Code.Text = ml_U_Code
    txt_lastUpd.Text = ""
    txt_updUser.Text = ""
    txt_dropDate.Text = ""
    chk_dropped.Value = vbUnchecked

    ' todo:refresh std_pice, discount, txt_Date_PolicyCheck

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

' initialize update mode
Private Sub Item_UpdateUsedInSAPInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smUpdateUsedInSAP)
    Call Item_Clear
        
    Call Item_LoadValues(CStr(as_detailKey(0)))
    
    Dim ll_errMsg As Long
    ll_errMsg = Item_CanUpdateUsedInSAP()
    
    If ll_errMsg <> 0 Then
        ' deleted task cannot by edited
        Call MsgBox(MsgText(ll_errMsg, ms_Language_Code, "#Item cannot be updated."), vbInformation)
        ' move to previous screen
        Call pushScreenMode(smView)              ' only to imitate UpdateUI
        Call Item_Exit
        Exit Sub
    End If
    
    
    Call UpdateUI(ArmScreenMode.smUpdateUsedInSAP)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateUsedInSAPInit")
End Sub

' deletes item
Private Function Item_Delete(ByVal av_oldKey As Variant) As Variant
On Error GoTo ErrHandler
    
    If SendMessage(MsgText(ErrMsg_M360, ms_Language_Code, "#Do you really want to delete this record."), vbQuestion + vbYesNo) = vbYes Then
    
        Call Item_DeleteDB(av_oldKey(0))
    
        ' set status
        txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_NotRequired
        txt_SPA_ApprovalStatus_Desc.Text = GetSPAStatusDesc(eSPA_ApprovalStatus.SPAS_NotRequired)

        RaiseEvent OnItemDelete(av_oldKey, Build_SrzString(UserControl.Controls, Me), _
                                           Build_SrzStringFromGrid(grd_items))

        Call Item_Exit
        
        Item_Delete = av_oldKey
    End If
    Exit Function
ErrHandler:
   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)))
    
    If activeScreenMode = smCopy Then
        Call Item_CopyReset(CLng(as_detailKey(0)))
    End If
    
    Call UpdateUI
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Restore")
End Sub

' adds current edited item
Private Function Item_Add() As Variant
On Error GoTo ErrHandler
Dim lb_InTran As Boolean
    lb_InTran = False
    
    Call Item_UpdateConfigFields(Now)

    ' check values and throw message if neccessary
    If Not Item_Check(moa_ListFieldsMandatory, moa_ListFieldsNumeric) Then
        Exit Function
    End If
    
    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

    If cal_Date_Required.date_dt() + 1 < Now Then
        Call MsgBox(MsgText(ErrMsg_M727, ms_Language_Code, "The Approved by date must be equal or greater than today"), vbInformation)
        Call cal_Date_Required.SetFocus
        Exit Function
    End If
    
    Dim ll_i As Long
    
    ' reset SAP_processed field
    For ll_i = 0 To grd_items.Rows - 1
        If grd_items.Data(ll_i, "change") <> "D" Then
            grd_items.Data(ll_i, "SAP_processed") = 0
        End If
    Next
    
    Dim ls_ITM_NUMBER As String
    Dim ls_CURR_Code As String
    Dim ll_errMsgCode As ErrMsg
    Dim ls_ErrMessage As String
    Dim lo_retXML As MSXML2.DOMDocument
    
nextSAPCall:
    ll_errMsgCode = SubItem_UpdateSAPPrices(ls_ErrMessage, lo_retXML)
    
    If ll_errMsgCode = ErrMsg_M701 Then
        ' this error can sometimes be fixed by user
        If MsgBox(ReplacePlaceHolder(MsgText(ll_errMsgCode, ms_Language_Code, "#MSG:. $SAP_MSG$"), "$SAP_MSG$", ls_ErrMessage), vbQuestion + vbYesNo, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision) = vbNo Then
            Call Item_ReleaseSubmitToken
            Exit Function
        End If
        
        GoTo nextSAPCall
    
    End If
    
    If ll_errMsgCode <> ErrMsgNone Then
    
        ' call line by line with currency expected( if some specific expected)
        Dim lb_SupportZNPR_ZPRC As Boolean
        lb_SupportZNPR_ZPRC = SupportZNPR_ZPRC()
        
        For ll_i = 0 To grd_items.Rows - 1
        
            If grd_items.Data(ll_i, "change") <> "D" And _
                grd_items.Data(ll_i, "SAP_processed") = 0 Then
                
                If lb_SupportZNPR_ZPRC Then

                    ls_ITM_NUMBER = lo_retXML.selectSingleNode("/Return/ORDER_ITEMS_OUT/ROW[MAT_ENTRD='" & grd_items.Data(ll_i, "BI_SAP_Code") & "']/ITM_NUMBER").nodeTypedValue
                    ls_CURR_Code = GetZNPR_ZPRC_CURRENCY(lo_retXML, ls_ITM_NUMBER)
                
                Else
                    ls_CURR_Code = ""
                End If
                
                Dim ll_errMsgCode_line As ErrMsg
                ll_errMsgCode_line = SubItem_UpdateSAPPrices_line(grd_items, ll_i, ls_ErrMessage, ls_CURR_Code)
                
                Select Case ll_errMsgCode_line
                    Case ErrMsgNone
                        ' do nothing
                    Case ErrMsg_M732
                        If UseAlternateItem(ll_errMsgCode_line, ls_ErrMessage) Then
                            Exit Function
                        End If
                    Case Else
                        ' other error means quit the process
                        Call Item_ReleaseSubmitToken
                        MsgBox ReplacePlaceHolder(MsgText(ll_errMsgCode_line, ms_Language_Code, "#MSG:. $SAP_MSG$"), "$SAP_MSG$", ls_ErrMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
                        Exit Function
                End Select

            End If
        Next

    End If
    
    txt_SAP_Message.Text = ls_ErrMessage        ' JN 9.8.2012 set or reset message before save
    txt_PricingDate.Text = Format(Now, "dd\/mm\/yyyy")
            
    ' ErrMsg_M705
    If txt_SPACT_Id.Text = "0" Then
        MsgBox MsgText(ErrMsg_M705, ms_Language_Code, "#Country is not linked to any market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    
    'ErrMsg_M190
    If txt_SPAMU_Id_Creator.Text = "0" Then
        MsgBox MsgText(ErrMsg_M190, ms_Language_Code, "#You do not not have rights on this customers market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    
    'ErrMsg_M200
    If txt_SPAMU_Id_RaisedFor.Text = "0" Then
        MsgBox MsgText(ErrMsg_M200, ms_Language_Code, "#The requestor does not have rights on this customers market ."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    
    If cbo_SPA_Type.SelectedItem.Key = eSPA_Type.SPAT_Project And Not cbo_Project.SelectedItem Is Nothing Then
        Dim ll_Err As Long
        ll_Err = Item_CheckSP(ml_U_Code)
        If ll_Err <> 0 Then
            MsgBox MsgText(ll_Err, ms_Language_Code, "#Something wrong with project."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If
    End If

    ' check if sr_code is approver in country of spa
    ll_Err = Item_CheckSR_Code(txt_SR_Code.Text, txt_CT_Code.Text)
    If ll_Err <> 0 Then
        Call MsgBox(MsgText(ll_Err, ms_Language_Code, "#Sales rep is not defined as APPROVER for country of SPA."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End If
    
    
    ' update again SPGAM_Id to all new/updated items
    For ll_i = 0 To grd_items.Rows - 1
        If grd_items.Data(ll_i, "change") = "A" Or _
           grd_items.Data(ll_i, "change") = "U" Then
            grd_items.Data(ll_i, "SPGAM_Id") = SubItem_GET_SPGAM_Id(Now, grd_items.Data(ll_i, "BI_SAP_Code"), txt_CT_Code.Text)
        End If
        
        ' test for message M260
        If Not Is_BI_LMK_OK(grd_items.Data(ll_i, "BI_SAP_Code"), txt_CT_Code.Text) Then
            MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M260, ms_Language_Code, "#MSG M260."), "$BI_SAP_CODE$", grd_items.Data(ll_i, "BI_SAP_Code")), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If
    
            ' test for message M280
        If grd_items.Data(ll_i, "SPGAM_Id") = 0 Then
            MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M280, ms_Language_Code, "#MSG M280."), "$BI_SAP_CODE$", grd_items.Data(ll_i, "BI_SAP_Code")), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If

        ' test for message M270
        If Not Is_BI_USER_SPM_OK(grd_items.Data(ll_i, "BI_SAP_Code"), cbo_requestor.SelectedItem.Key) Then
            MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M270, ms_Language_Code, "#MSG M270."), "$BI_SAP_CODE$", grd_items.Data(ll_i, "BI_SAP_Code")), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If
    Next

    Dim ls_newCode As String
    ' get new code
    ls_newCode = mo_Db.SQLNextID(C_ID_KEY)
    txt_SPA_ID.Text = ls_newCode
    
    ' get new codes for new grid items
    Call SQLNextIDToGrid(grd_items, C_ID_KEY_ITEM)
    
    Call ExecuteSQLSafe(mo_Db, "BEGIN TRAN Item_Add")
    lb_InTran = True
    
    Call Item_AddDB(ls_newCode)

    Call ExecuteSQLSafe(mo_Db, "COMMIT TRAN Item_Add")
    lb_InTran = False
    
    RaiseEvent OnItemAdd(CVar(Array(ls_newCode)), Build_SrzString(UserControl.Controls, Me) & "Date_Sent®®©", _
                                                  Build_SrzStringFromGrid(grd_items))
    
    Call Item_Exit
    
    Item_Add = CVar(Array(ls_newCode))
    Exit Function
ErrHandler:
    If lb_InTran Then
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Add")
        lb_InTran = False
    End If
    If Err.Number = SQLBadRowAffectedCount Then
        Call MsgBox("Error occured while inserting record, please contact IT")
        Exit Function
    End If

    Call ErrorHandler(Extender.Name & ".Item_Add")
End Function

Private Function UseAlternateItem(ByVal al_errMsgCode As Long, ByVal as_ErrMessage As String) As Boolean
On Error GoTo ErrHandler
    UseAlternateItem = False
    
    ' it is for alternate product price returned
    Dim lsa_mt() As String
    lsa_mt = Split(as_ErrMessage, SEP, , vbTextCompare)
    
    Dim ls_BI_SAP_Code As String
    Dim ls_BI_SAP_Code_entrd As String
    
    ReDim ms_MsgInfo(1, 1)
    ms_MsgInfo(0, 0) = "$MATERIAL$"
    If UBound(lsa_mt) >= 0 Then
        ls_BI_SAP_Code = lsa_mt(0)
    End If
    ms_MsgInfo(0, 1) = ls_BI_SAP_Code
    
    ms_MsgInfo(1, 0) = "$MAT_ENTRD$"
    If UBound(lsa_mt) >= 1 Then
        ls_BI_SAP_Code_entrd = lsa_mt(1)
    End If
    ms_MsgInfo(1, 1) = ls_BI_SAP_Code_entrd
    
    If MsgBox(MsgText(al_errMsgCode, ms_Language_Code, "#Alternate Item available ($MATERIAL$) Do you want to use it instead of $MAT_ENTRD$?", ms_MsgInfo), vbQuestion + vbYesNo, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision) = vbYes Then
    
        Call Item_ReleaseSubmitToken
        ' replace item in the grid
        Dim ll_i As Long
        For ll_i = 0 To grd_items.Rows - 1
            If grd_items.Data(ll_i, "BI_SAP_Code") = ls_BI_SAP_Code_entrd Then
                grd_items.Data(ll_i, "BI_SAP_Code") = ls_BI_SAP_Code
                Exit For
            End If
        Next
        
        UseAlternateItem = True
        Exit Function
    Else
        grd_items.Data(ll_i, "SAP_Processed") = 1
    End If
    
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UseAlternateItem")
End Function


' TAKE TOKEN ONLY IF STATUS IS SUBMITED
Private Function Item_GetSubmitToken() As Boolean
On Error GoTo ErrHandler
    Item_GetSubmitToken = True
    If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
        Item_GetSubmitToken = mo_tokenManager.GetToken(C_ABPE_SPA_TOKEN, StandardToken)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_GetSubmitToken")
End Function

Private Sub Item_ReleaseSubmitToken()
On Error GoTo ErrHandler
'    If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
    If mo_tokenManager.haveToken Then
        Call mo_tokenManager.ReleaseToken
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ReleaseSubmitToken")
End Sub

' update current edited item
Private Function Item_Update(ByVal av_oldKey As Variant) As Variant
On Error GoTo ErrHandler
Dim lb_InTran As Boolean
    lb_InTran = False
    
    If activeScreenMode <> smUpdateValidTo Then
        Select Case txt_SPA_ApprovalStatus.Text
            Case eSPA_ApprovalStatus.SPAS_Approved
                    Item_Update = Item_ApproveReject(av_oldKey, True)
                    Exit Function
            Case eSPA_ApprovalStatus.SPAS_Rejected
                    Item_Update = Item_ApproveReject(av_oldKey, False)
                    Exit Function
        End Select
    Else
        ' check if valid_to date has changed
        If cal_valid_To.date_dt = md_old_validTo Then
            Call Item_Exit
            Item_Update = CVar(Array(av_oldKey(0)))
            Exit Function
        End If
    End If
    
    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Released Then
    
        If txt_Cust_Code.Text = "" Then
            ' M210 not buying customer
            Call MsgBox(MsgText(ErrMsg_M210, ms_Language_Code, "M210 - You cannot use this customer as the customer is not a buying customer."), vbInformation)
            Exit Function
        End If
        
        ' standard update
        If Not Item_GetSubmitToken Then
            Call MsgBox(MsgText(mo_tokenManager.LastErrorCode, ms_Language_Code, mo_tokenManager.lastErrorMsg), vbInformation)
            Exit Function
        End If
    
        Call Item_UpdateConfigFields(Now)
    
        If Not Item_Check(moa_ListFieldsMandatory, moa_ListFieldsNumeric) Then
            Call Item_ReleaseSubmitToken
            Exit Function
        End If
    
        If cal_valid_From.date_dt > cal_valid_To.date_dt Then
            Call Item_ReleaseSubmitToken
            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 Item_ReleaseSubmitToken
            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
    
    If activeScreenMode <> smUpdateValidTo Then                 ' 06/10/2012 JN do the chceck only in standard update mode
        If cal_Date_Required.date_dt() + 1 < Now Then
            Call Item_ReleaseSubmitToken
            Call MsgBox(MsgText(ErrMsg_M727, ms_Language_Code, "The Approved by date must be equal or greater than today"), vbInformation)
            Call cal_Date_Required.SetFocus
            Exit Function
        End If
        
        ' reset SAP_processed field
        Dim ll_i As Long
        
        For ll_i = 0 To grd_items.Rows - 1
            If grd_items.Data(ll_i, "change") <> "D" Then
                grd_items.Data(ll_i, "SAP_processed") = 0
            End If
        Next
        
        Dim ls_ITM_NUMBER As String
        Dim ls_CURR_Code As String
        Dim ll_errMsgCode As ErrMsg
        Dim ls_ErrMessage As String
        Dim lo_retXML As MSXML2.DOMDocument
        
nextSAPCall:
        ll_errMsgCode = SubItem_UpdateSAPPrices(ls_ErrMessage, lo_retXML)
        
        If ll_errMsgCode = ErrMsg_M701 Then
            ' this error can sometimes be fixed by user
            If MsgBox(ReplacePlaceHolder(MsgText(ll_errMsgCode, ms_Language_Code, "#MSG:. $SAP_MSG$"), "$SAP_MSG$", ls_ErrMessage), vbQuestion + vbYesNo, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision) = vbNo Then
                Call Item_ReleaseSubmitToken
                Exit Function
            End If
            
            GoTo nextSAPCall
        
        End If
            
        
        If ll_errMsgCode <> ErrMsgNone Then

            ' call line by line with currency expected( if some specific expected)
            Dim lb_SupportZNPR_ZPRC As Boolean
            lb_SupportZNPR_ZPRC = SupportZNPR_ZPRC()
            
            For ll_i = 0 To grd_items.Rows - 1
            
                If grd_items.Data(ll_i, "change") <> "D" And _
                    grd_items.Data(ll_i, "SAP_processed") = 0 Then
                    
                    If lb_SupportZNPR_ZPRC Then
    
                        ls_ITM_NUMBER = lo_retXML.selectSingleNode("/Return/ORDER_ITEMS_OUT/ROW[MAT_ENTRD='" & grd_items.Data(ll_i, "BI_SAP_Code") & "']/ITM_NUMBER").nodeTypedValue
                        ls_CURR_Code = GetZNPR_ZPRC_CURRENCY(lo_retXML, ls_ITM_NUMBER)
                    
                    Else
                        ls_CURR_Code = ""
                    End If
                    
                    Dim ll_errMsgCode_line As ErrMsg
                    ll_errMsgCode_line = SubItem_UpdateSAPPrices_line(grd_items, ll_i, ls_ErrMessage, ls_CURR_Code)
                    
                    Select Case ll_errMsgCode_line
                        Case ErrMsgNone
                            ' do nothing
                        Case ErrMsg_M732
                            If UseAlternateItem(ll_errMsgCode_line, ls_ErrMessage) Then
                                Exit Function
                            End If
                        Case Else
                            ' other error means quit the process
                            Call Item_ReleaseSubmitToken
                            MsgBox ReplacePlaceHolder(MsgText(ll_errMsgCode_line, ms_Language_Code, "#MSG:. $SAP_MSG$"), "$SAP_MSG$", ls_ErrMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
                            Exit Function
                    End Select
                    
                End If
            Next
        
        End If
        txt_SAP_Message.Text = ls_ErrMessage        ' JN 9.8.2012 set or reset message before save
        txt_PricingDate.Text = Format(Now, "dd\/mm\/yyyy")
    End If
    
    ' undefined messasge
    If txt_SPACT_Id.Text = "0" Then
        Call Item_ReleaseSubmitToken
        MsgBox MsgText(ErrMsg_M705, ms_Language_Code, "#Country is not linked to any market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    
    'ErrMsg_M190
    If txt_SPAMU_Id_Creator.Text = "0" Then
        Call Item_ReleaseSubmitToken
        MsgBox MsgText(ErrMsg_M190, ms_Language_Code, "#You do not not have rights on this customers market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    
    'ErrMsg_M200
    If txt_SPAMU_Id_RaisedFor.Text = "0" Then
        Call Item_ReleaseSubmitToken
        MsgBox MsgText(ErrMsg_M200, ms_Language_Code, "#The requestor does not have rights on this customers market ."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    
    If cbo_SPA_Type.SelectedItem.Key = eSPA_Type.SPAT_Project And Not cbo_Project.SelectedItem Is Nothing Then
        Dim ll_Err As Long
        ll_Err = Item_CheckSP(ml_U_Code)
        If ll_Err <> 0 Then
            Call Item_ReleaseSubmitToken
            MsgBox MsgText(ll_Err, ms_Language_Code, "#Something wrong with project."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If
    End If

        ' update again SPGAM_Id to all new/updated items
    For ll_i = 0 To grd_items.Rows - 1
        If grd_items.Data(ll_i, "change") = "A" Or _
           grd_items.Data(ll_i, "change") = "U" Then
            grd_items.Data(ll_i, "SPGAM_Id") = SubItem_GET_SPGAM_Id(Now, grd_items.Data(ll_i, "BI_SAP_Code"), txt_CT_Code.Text)
        End If
        
            
        ' test for message M260
        If Not Is_BI_LMK_OK(grd_items.Data(ll_i, "BI_SAP_Code"), txt_CT_Code.Text) Then
            Call Item_ReleaseSubmitToken
            MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M260, ms_Language_Code, "#MSG M260."), "$BI_SAP_CODE$", grd_items.Data(ll_i, "BI_SAP_Code")), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If
    
        ' test for message M280
        If grd_items.Data(ll_i, "SPGAM_Id") = 0 Then
            Call Item_ReleaseSubmitToken
            MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M280, ms_Language_Code, "#MSG M280."), "$BI_SAP_CODE$", grd_items.Data(ll_i, "BI_SAP_Code")), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If

        ' test for message M270
        If Not Is_BI_USER_SPM_OK(grd_items.Data(ll_i, "BI_SAP_Code"), cbo_requestor.SelectedItem.Key) Then
            Call Item_ReleaseSubmitToken
            MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M270, ms_Language_Code, "#MSG M270."), "$BI_SAP_CODE$", grd_items.Data(ll_i, "BI_SAP_Code")), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            Exit Function
        End If
    Next
    End If

    Dim ls_AC_code As String
    Dim ls_MEM_Code As String
    ls_AC_code = ""
    ls_MEM_Code = ""
    
    Select Case txt_SPA_ApprovalStatus.Text
        Case eSPA_ApprovalStatus.SPAS_Submited
            ' check if sr_code is approver in country of spa
            ll_Err = Item_CheckSR_Code(txt_SR_Code.Text, txt_CT_Code.Text)
            If ll_Err <> 0 Then
                Call Item_ReleaseSubmitToken
                Call MsgBox(MsgText(ll_Err, ms_Language_Code, "#Sales rep is not defined as APPROVER for country of SPA."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
                Exit Function
            End If
            ' BUG 290
'            ' initialize approval path
'            If Not mo_SPA_Approval.BuildApprovalPath(av_oldKey(0)) Then
'                ' build failed
'                Call Item_ReleaseSubmitToken
'                MsgBox MsgText(mo_SPA_Approval.lastErrorCode, ms_Language_Code, mo_SPA_Approval.LastErrorMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
'                Exit Function
'            End If
'
'            ' get next free actionID
'            ls_AC_code = mo_Db.SQLNextID("Cap_Action")
'            ls_MEM_Code = mo_Db.SQLNextID("Cap_Memo")
    End Select
    
    ' get new codes for new grid items
    Call SQLNextIDToGrid(grd_items, C_ID_KEY_ITEM)
    
    Call ExecuteSQLSafe(mo_Db, "BEGIN TRAN Item_Upd")
    lb_InTran = True
    
    Select Case txt_SPA_ApprovalStatus.Text
        Case eSPA_ApprovalStatus.SPAS_Submited
            
            ' BUG 290
            ls_AC_code = mo_Db.SQLNextID("Cap_Action")
            ls_MEM_Code = mo_Db.SQLNextID("Cap_Memo")
            Call Item_UpdateDB(av_oldKey(0), ls_AC_code, ls_MEM_Code)
            
            ' initialize approval path
            If Not mo_SPA_Approval.BuildApprovalPath(av_oldKey(0)) Then
                ' build failed
                Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
                lb_InTran = False
                Call Item_ReleaseSubmitToken
                MsgBox MsgText(mo_SPA_Approval.LastErrorCode, ms_Language_Code, mo_SPA_Approval.LastErrorMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
                Exit Function
            End If
            
            
            ' save approval path
            If Not mo_SPA_Approval.SaveApprovalPath() Then
                ' save failed
                Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
                lb_InTran = False
                Call Item_ReleaseSubmitToken
                MsgBox MsgText(mo_SPA_Approval.LastErrorCode, ms_Language_Code, mo_SPA_Approval.LastErrorMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
                Exit Function
            End If
            
            ' now if every line is approved, the status of current SPA becomes approved
            ' reload grid
            Call grd_approvalPath.Refresh
            Dim ll_new_Status As eSPA_ApprovalStatus
            ll_new_Status = SPAS_Approved
            For ll_i = 0 To grd_approvalPath.Rows - 1
                If grd_approvalPath.Data(ll_i, "Status_Code") <> eSPA_ApprovalPathStatus.SPAP_Approved Then
                    ' there is still something to approve => status stay
                    ll_new_Status = txt_SPA_ApprovalStatus.Text
                    Exit For
                End If
            Next
            
            If txt_SPA_ApprovalStatus.Text <> ll_new_Status Then
                txt_SPA_ApprovalStatus.Text = ll_new_Status
                txt_SPA_ApprovalStatus_Desc.Text = GetSPAStatusDesc(ll_new_Status)
            'Else
                ' update status into DB
               ' Call Item_UpdateDB(av_oldKey(0), ls_AC_code, ls_MEM_Code)
            End If
            
        Case Else
            Call Item_UpdateDB(av_oldKey(0), ls_AC_code, ls_MEM_Code)
    End Select
    
    Call ExecuteSQLSafe(mo_Db, "COMMIT TRAN Item_Upd")
    lb_InTran = False
    
    
    Call Item_ReleaseSubmitToken
    
    RaiseEvent OnItemUpdate(av_oldKey, Build_SrzString(UserControl.Controls, Me), _
                                       Build_SrzStringFromGrid(grd_items))
                                       
    If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then  ' in case of SAP message we send email to managers defined per country
        If ll_errMsgCode <> ErrMsgNone Then
            Call mo_SPA_Approval.SendWarningEmail(av_oldKey(0))
        End If
    End If
    
   If activeScreenMode = smUpdateValidTo Then
        Call mo_SPA_Approval.SendValidToChangedEmail(av_oldKey(0))
    End If


    Call Item_Exit

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

    Exit Function
    
ErrHandler:
    If lb_InTran Then
        Call mo_Db.ExecuteSQL("ROLLBACK TRAN Item_Upd")
        lb_InTran = False
    End If
    If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        Call Item_ReleaseSubmitToken
        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(av_oldKey)
        Exit Function
    End If
    Call UpdateError(True)
    Call Item_ReleaseSubmitToken
    Call UpdateError(False)
    Call ErrorHandler(Extender.Name & ".Item_Update")
End Function

Private Function Item_ApproveReject(ByVal av_oldKey As Variant, ByVal ab_Approve As Boolean) As Variant
On Error GoTo ErrHandler
    Dim ll_i As Long
    
    
    ' check if current user is superuser for this SPA market
    If isUserType(mo_userRghts.SPARights, SPA_SuperUser, ml_SPM_Code) Then
        ' super user can approve
    If Not mo_SPA_Approval.SetSPAStatus(ml_U_Code, av_oldKey(0), ab_Approve, True) Then
        MsgBox MsgText(mo_SPA_Approval.LastErrorCode, ms_Language_Code, mo_SPA_Approval.LastErrorMessage), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Function
    End If
    Else
        ' check if current user next on approval path
        ' find in grd_approvalPath who is next to approve
        For ll_i = 0 To grd_approvalPath.Rows - 1
            If grd_approvalPath.Data(ll_i, "Status_Code") = eSPA_ApprovalPathStatus.SPAP_ToBeApproved Then
                If grd_approvalPath.Data(ll_i, "Auth_U_Code") = ml_U_Code Then
                    Call mo_SPA_Approval.SetSIAStatus(ml_U_Code, av_oldKey(0), grd_approvalPath.Data(ll_i, "SIA_Id"), ab_Approve, -1, True)
                    Exit For
                End If
                MsgBox MsgText(ErrMsg_M350, ms_Language_Code, "This SPA does not require your approval at this time."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
                Exit Function
            End If
        Next
    End If
    
    ' setSPAStatus increased iconc for current record
    ml_iConcurrency = ml_iConcurrency + 1
    
    ' reload grid
    Call grd_approvalPath.Refresh
    For ll_i = 0 To grd_approvalPath.Rows - 1
        If grd_approvalPath.Data(ll_i, "Status_Code") = eSPA_ApprovalPathStatus.SPAP_ToBeApproved Then
            ' there is still something to apporve => do not increase iConc
            ml_iConcurrency = ml_iConcurrency - 1
           ' do not update status to "Approved" or "Rejected"
            txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited
            txt_SPA_ApprovalStatus_Desc.Text = GetSPAStatusDesc(eSPA_ApprovalStatus.SPAS_Submited)
            Exit For
        End If
    Next
    
    
    RaiseEvent OnItemUpdate(av_oldKey, Build_SrzString(UserControl.Controls, Me), _
                                       Build_SrzStringFromGrid(grd_items))

    Call Item_Exit

    Item_ApproveReject = CVar(Array(av_oldKey(0)))

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

Private Sub Item_AddDB(ByVal as_Code As Long)
On Error GoTo ErrHandler
    Dim ls_req As String

    ' common placeholders
    ls_req = ReplaceCommonPlaceholders(REQ_INSERT_SPA)
    ls_req = Item_ReplacePlaceholders(ls_req)
    
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)

    'save grids
    Call SaveGridToDb(grd_items, REQ_INSERT_DETAIL_ITEM, REQ_UPDATE_DETAIL_ITEM, REQ_DELETE_DETAIL_ITEM)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_AddDb")
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)
            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, Optional ByVal as_ac_code As String = "", Optional ByVal as_MEM_Code As String = "")
On Error GoTo ErrHandler
    Dim ls_req As String
    
    ' common placeholders
    ls_req = ReplaceCommonPlaceholders(REQ_UPDATE_SPA)
    ls_req = Item_ReplacePlaceholders(ls_req)
    
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    'save grids
    Call SaveGridToDb(grd_items, REQ_INSERT_DETAIL_ITEM, REQ_UPDATE_DETAIL_ITEM, REQ_DELETE_DETAIL_ITEM)
    
    ' create cap_action in case of submited status
    If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
        Debug.Assert (as_ac_code <> "")
        Debug.Assert (as_MEM_Code <> "")
        Call Item_InsertSumitCapAction(as_ac_code, as_MEM_Code)
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateDb")
End Sub

Private Sub Item_InsertSumitCapAction(ByVal as_ac_code As String, ByVal as_MEM_Code As String)
On Error GoTo ErrHandler
    Dim ls_req As String
    
    ls_req = ReplaceCommonPlaceholders(REQ_CAPACTION_INSERT)
    ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
    ls_req = ReplacePlaceHolder(ls_req, "$AC_code$", SqlStr(as_ac_code))
    ls_req = ReplacePlaceHolder(ls_req, "$AT_code$", SqlInt(27))                      ' action type SPA Request
    ls_req = ReplacePlaceHolder(ls_req, "$AS_code$", SqlInt(1))
    ls_req = ReplacePlaceHolder(ls_req, "$AR_code$", SqlInt(1))
    ls_req = ReplacePlaceHolder(ls_req, "$ACT_raisedFor$", SqlStr(txt_SR_Code.Text, 6)) ' SR_Code
    ls_req = ReplacePlaceHolder(ls_req, "$ACT_raisedBy$", SqlStr(ms_LoginName, 30))     ' Login_Name
    ls_req = ReplacePlaceHolder(ls_req, "$ACT_dueDate$", SqlDate(Now))
    
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    ' PROJECT
    If Not cbo_Project.SelectedItem Is Nothing Then
        ls_req = ReplaceRequestByFrameData(REQ_CAPACTIONPRJ_INSERT, fra_Detail)
        ls_req = ReplacePlaceHolder(ls_req, "$AC_code$", SqlStr(as_ac_code))
        
        Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    End If
    
    'COMMENT
    Dim ll_i As Long
    Dim ls_comment As String
    ls_comment = "SPA ID:" & txt_SPA_ID.Text & vbCrLf & vbCrLf
    
    For ll_i = 0 To grd_items.Rows - 1
        ls_comment = ls_comment & grd_items.Data(ll_i, "BI_Desc") & " ( " & grd_items.Data(ll_i, "BI_SAP_Code") & " )  " & Format(grd_items.Data(ll_i, "SPA_Qty"), QTY_FORMAT) & " " & grd_items.Data(ll_i, "SPA_UoM") & " @ "
        ls_comment = ls_comment & Format(grd_items.Data(ll_i, "SPA_Price"), MONEY_FORMAT) & " " & grd_items.Data(ll_i, "SPA_CURR_Code")
        ls_comment = ls_comment & "  (" & Format(grd_items.Data(ll_i, "SPA_Discount"), PERCENT_FORMAT) & "%)" & vbCrLf
    Next
    ls_req = ReplaceRequestByFrameData(REQ_CAPACTIONCOM_INSERT, fra_Detail)
    ls_req = ReplacePlaceHolder(ls_req, "$AC_code$", SqlStr(as_ac_code))
    ls_req = ReplacePlaceHolder(ls_req, "$MEM_code$", SqlStr(as_MEM_Code))
    ls_req = ReplacePlaceHolder(ls_req, "$Comment_desc$", SqlStr(ls_comment, 80))
    ls_req = ReplacePlaceHolder(ls_req, "$Comment$", SqlStr(ls_comment, 1024))
    
    Call ExecuteSQLSafe(mo_Db, ls_req)

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

Private Sub Item_DeleteDB(ByVal as_Code As String)
On Error GoTo ErrHandler
    Dim ls_req As String
    
    ' common placeholders
    ls_req = ReplaceCommonPlaceholders(REQ_DELETE_SPA)
    ls_req = Item_ReplacePlaceholders(ls_req)
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    'delete approvaPath
    '1. SLEEPING RECORDS ARE NOT IN GRID
    ls_req = ReplaceCommonPlaceholders(REQ_DELETE_SLEEPING_APPRPATH)
    ls_req = Item_ReplacePlaceholders(ls_req)
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    '2. RECORDS FROM GRID
    Call SaveGridToDb(grd_approvalPath, "", "", REQ_DELETE_APPRPATH)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_DeleteDb")
End Sub

' clear all controls values
Private Sub SubItem_Clear()
On Error GoTo ErrHandler
    mb_Initializing = True
    Call ClearForm(UserControl.Controls, frm_SPA_Item_Detail)
    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)
    
    frm_SPA_Item_Detail.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

' 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_Required", Format(Now, "dd\/mm\/yyyy"))
    
    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)
    
    Call UpdateUI(ArmScreenMode.smUpdateItem)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_UpdateInit")
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

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

    ' check values and throw message if neccessary
    If Not Item_Check(moa_DetailFieldsMandatory, moa_DetailFieldsNumeric) Then
        Exit Sub
    End If
    
    ' 15.3.2010 JN - to supress moving unformated numbers from UI into DB
    Debug.Assert (isNumeric(txt_SPA_Price.Text))
    txt_SPA_Price.Text = FormatNumber(txt_SPA_Price.Text, 2)
    
    ' just ensure that country is selected
    Debug.Assert (txt_CT_Code.Text <> "")
    Debug.Assert (Not cbo_requestor.SelectedItem Is Nothing)

    ' test for message M260
    If Not SubItem_CheckLMK() Then
        MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M260, ms_Language_Code, "#MSG M260."), "$BI_SAP_CODE$", txt_BI_SAP_Code.Text), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    ' test for message M280
    Call SubItem_UpdateConfigFields(Now)
    If txt_SPGAM_Id.Text = "0" Then
        MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M280, ms_Language_Code, "#MSG M280."), "$BI_SAP_CODE$", txt_BI_SAP_Code.Text), 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, frm_SPA_Item_Detail))
    
    ' task 155 add 2 fields for cartoons and pallets into array
    Call AddCartonsAndPallets(lo_detailData, txt_BI_SAP_Code.Text, cbo_UOM.SelectedItem.Key, txt_SPA_Qty.Text)
    
    ' test for message M370
    If TestGridContaintRow(grd_items, "BI_SAP_Code", lo_detailData("BI_SAP_Code"), True) Then
        MsgBox MsgText(ErrMsg_M370, ms_Language_Code, "#MSG M370."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Set lo_detailData = Nothing
        Exit Sub
    End If
    
    ' test for message M270
    If Not SubItem_CheckSPM(cbo_requestor.SelectedItem.Key) Then
        MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M270, ms_Language_Code, "#MSG M270."), "$BI_SAP_CODE$", txt_BI_SAP_Code.Text), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    
    ' add item message as empty string
    Call lo_detailData.Add("SPI_SAP_message", "")
            
    Call AddLineToGrid(grd_items, 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
    If Not Item_Check(moa_DetailFieldsMandatory, moa_DetailFieldsNumeric) Then
        Exit Sub
    End If
    
    ' 15.3.2010 JN - to supress moving unformated numbers from UI into DB
    Debug.Assert (isNumeric(txt_SPA_Price.Text))
    txt_SPA_Price.Text = FormatNumber(txt_SPA_Price.Text, 2, vbFalse, vbFalse, vbFalse)

    ' test for message M260
    If Not SubItem_CheckLMK() Then
        MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M260, ms_Language_Code, "#MSG M260."), "$BI_SAP_CODE$", txt_BI_SAP_Code.Text), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If
    
    ' test for message M280
    Call SubItem_UpdateConfigFields(Now)
    If txt_SPGAM_Id.Text = "0" Then
        MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M280, ms_Language_Code, "#MSG M280."), "$BI_SAP_CODE$", txt_BI_SAP_Code.Text), 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, frm_SPA_Item_Detail))
    
    ' task 155 add 2 fields for cartoons and pallets into array
    Call AddCartonsAndPallets(lo_detailData, txt_BI_SAP_Code.Text, cbo_UOM.SelectedItem.Key, txt_SPA_Qty.Text)

    
    ' test for message M370
    If TestGridContaintRow(grd_items, "BI_SAP_Code", lo_detailData("BI_SAP_Code"), False) Then
        MsgBox MsgText(ErrMsg_M370, ms_Language_Code, "#MSG M370."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Set lo_detailData = Nothing
        Exit Sub
    End If
    
    ' test for message M270
    If Not SubItem_CheckSPM(cbo_requestor.SelectedItem.Key) Then
        MsgBox ReplacePlaceHolder(MsgText(ErrMsg_M270, ms_Language_Code, "#MSG M270."), "$BI_SAP_CODE$", txt_BI_SAP_Code.Text), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        Exit Sub
    End If

    ' do local update of the grid
    Call UpdateLineToGrid(grd_items, lo_detailData, Array("SPI_Id"))
    
    ' unselect the row to see background color
    grd_items.DeselectRow

    Set lo_detailData = Nothing
    
    Call SubItem_Exit

    Exit Sub
ErrHandler:
    Set lo_detailData = Nothing
    Call ErrorHandler(Extender.Name & ".SubItem_Update")
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_items, Array("SPI_Id"), grd_items.SelectedKey(0))

        ' unselect the row to see background color
        grd_items.DeselectRow
        
        Call SubItem_Exit
        
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_Delete")
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, frm_SPA_Item_Detail)
    
    If txt_Std_Price.Text = "" Then txt_Std_Price.Text = "0"
    If txt_SPA_Discount.Text = "" Then txt_SPA_Discount.Text = Format(100, PERCENT_FORMAT)
    
    mb_Initializing = False

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

Private Sub AddCartonsAndPallets(ByRef ao_dataSrc As Dictionary, ByVal as_SAP_Code As String, ByVal as_UOM As String, ByVal as_QTY As String)
On Error GoTo ErrHandler
    Const C_REQ As String = "EXEC SPA_Item_BI_calc '$BI_SAP_code$', '$UOM$', $QTY$"
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ, "$BI_SAP_code$", as_SAP_Code)
    ls_req = ReplacePlaceHolder(ls_req, "$UOM$", as_UOM)
    ls_req = ReplacePlaceHolder(ls_req, "$QTY$", SqlDbl(as_QTY))
    
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        Call ao_dataSrc.Add("NumberOfCartons", mo_Db.GetFields(ll_Cursor, "NumberOfCartons"))
        Call ao_dataSrc.Add("NumberOfPallets", mo_Db.GetFields(ll_Cursor, "NumberOfPallets"))
    Else
        ' nothing from db?
        Call ao_dataSrc.Add("NumberOfCartons", "")
        Call ao_dataSrc.Add("NumberOfPallets", "")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    Exit Sub
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler(Extender.Name & ".AddCartonsAndPallets")
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", "Tel", "Email"
                        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
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & aControl.Text
               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
            If Not ao_dataSrc.Exists(lv_Values(0)) 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 UpdateItemGridLine(ByVal ao_grid As ArmGrid, ByRef ao_XMLparam As SvcXMLParam, ByRef ao_dataSrc As MSXML2.IXMLDOMNode, as_CURR_for_zero_price As String)
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
    Dim ls_SAPCode As String
    Dim ld_sapPrice As Double
    Dim ld_spa_Price As Double
    Dim ld_Qty_Req As Double  ' special number, divide subtotal by this number
    Dim ls_val As String
    Dim lb_isZeroPrice As Boolean
    
    lb_isZeroPrice = False
    
    ls_SAPCode = ao_XMLparam.GetXMLNodeValue(ao_dataSrc, "MATERIAL")
    ls_val = Replace(ao_XMLparam.GetXMLNodeValue(ao_dataSrc, "SUBTOTAL_2"), ".", ms_DecimalSeparator, , , vbTextCompare)
    If isNumeric(ls_val) Then
        
        ld_sapPrice = CDbl(ls_val)
        If ld_sapPrice = 0 Then lb_isZeroPrice = True
        
        'ls_val = Replace(ao_XMLParam.GetXMLNodeValue(ao_dataSrc, "REQ_QTY"), ".", ms_DecimalSeparator, , , vbTextCompare)
        ls_val = Replace(ao_XMLparam.GetXMLNodeValue(ao_dataSrc, "QTY_REQ_DT"), ".", ms_DecimalSeparator, , , vbTextCompare)
        If isNumeric(ls_val) Then
            ld_Qty_Req = CDbl(ls_val) / 10
        Else
            ld_Qty_Req = 0
        End If
        
        If ld_Qty_Req > 0 Then
            ld_sapPrice = Round((ld_sapPrice / ld_Qty_Req), 2)      ' 16.4. round sap_price to 2 decimal places
        Else
            ld_sapPrice = 0
        End If

    Else
        ld_sapPrice = 0
    End If


    ll_RowCount = ao_grid.Rows - 1
    For ll_Row = 0 To ll_RowCount
        If ao_grid.Data(ll_Row, "BI_SAP_Code") = ls_SAPCode And ao_grid.Data(ll_Row, "change") <> "D" Then
            For ll_Col = 0 To ao_grid.Cols - 1
                Set lo_Column = ao_grid.Columns(ll_Col)
                Select Case lo_Column.FieldName
                    Case "Std_Price"
                        Call lo_Column.SetData(ll_Row, ld_sapPrice)
                    Case "SPA_Price"
                        ld_spa_Price = lo_Column.GetData(ll_Row)
                    Case "SPA_Discount"
                        If ld_sapPrice > 0 Then
                            If ld_sapPrice > ld_spa_Price Then
                                Call lo_Column.SetData(ll_Row, (1 - (ld_spa_Price / ld_sapPrice)) * 100)
                            Else
                                ' no discount needed?
                                Call lo_Column.SetData(ll_Row, 0)
                            End If
                        Else
                            Call lo_Column.SetData(ll_Row, 100)
                        End If
                    Case "SPA_CURR_Code"
                        If lb_isZeroPrice And as_CURR_for_zero_price <> "" Then
                            Call lo_Column.SetData(ll_Row, as_CURR_for_zero_price)
                        Else
                            Call lo_Column.SetData(ll_Row, ao_XMLparam.GetXMLNodeValue(ao_dataSrc, "CURRENCY"))
                        End If
                    Case "change"
                        If lo_Column.GetData(ll_Row) = "" Then Call lo_Column.SetData(ll_Row, "U")
                    Case "SPI_SAP_message"
                        Call lo_Column.SetData(ll_Row, "")
                    Case "SAP_processed"
                        ' indicate SAP_processed
                        Call lo_Column.SetData(ll_Row, 1)
                End Select
            Next
        End If
    Next

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


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))
                        Call lo_Column.SetData(ll_Row, ao_dataSrc(lo_Column.FieldName))
                    Else
                        Call lo_Column.SetData(ll_Row, ao_dataSrc(lo_Column.FieldName))
                    End If
                End If
            Next
            ao_grid.LineColor(ll_Row) = COLOR_UPDLINE
            Call grd_items_RowLoaded(ll_Row)
        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)
                lsa_newRow(ll_Index) = ao_dataSrc.Item(lo_Column.FieldName)
            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)
    
    Item_ReplacePlaceholders = ls_ret
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ReplacePlaceholders")
End Function

' exits mode to main
Private Sub Item_Exit(Optional ByVal ab_reloadDetail As Boolean = False)
On Error GoTo ErrHandler
    
    ' pop last item in screen mode stack
'    Call popScreenModeUntil(smMain)
    Call popScreenMode
    
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    If activeScreenMode = smMain Then
        RaiseEvent OnExit
    ElseIf ab_reloadDetail Then Call Item_LoadValues(SPAMakeID(txt_SPA_ID.Text))
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Exit")
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


Private Function Item_Check(ByRef aoa_mandatory As Variant, ByRef aoa_numeric As Variant) 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(aoa_mandatory) Then
    
        For Each lo_mandatoryField In aoa_mandatory
            Set lo_Control = lo_mandatoryField(0)
                If lo_mandatoryField(1) >= 0 Then
                    ls_LabelCaption = lbl_labels(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 "A_CALOCX"
                    If lo_Control.Visible And lo_Control.date_dt() = 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 "ARMCHECKVIEW", "COMMANDBUTTON", "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
        Next
    End If
    

    ' check all numeric fields on detail
    If Not IsArray(aoa_numeric) 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 aoa_numeric
        Set lo_Control = lo_mandatoryField(0)
            If lo_mandatoryField(1) >= 0 Then
                ls_LabelCaption = lbl_labels(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 = lo_Control.Text
                            If lo_Control.Visible Then
                               If 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
                               If CDbl(ls_Str) < C_MIN_VAL Or CDbl(ls_Str) > C_MAX_VAL Then
                                   ls_TempTag = ReplacePlaceHolder(MsgText(ErrMsg_M724, ms_Language_Code, "The field $FIELD_NAME$ must be between $C_MIN_VAL$ and $C_MAX_VAL$."), "$FIELD_NAME$", ls_LabelCaption)
                                   ls_TempTag = ReplacePlaceHolder(ls_TempTag, "$C_MIN_VAL$", C_MIN_VAL)
                                   ls_TempTag = ReplacePlaceHolder(ls_TempTag, "$C_MAX_VAL$", C_MAX_VAL)
                                   Call MsgBox(ls_TempTag, vbInformation)
                                   lo_Control.SetFocus
                                   Exit Function
                               End If
                            End If
                        Case "Tel"
                            'bug 311 - remove tel/fax check
                            'If lo_Control.Visible And lo_Control.Text <> "" Then
                            '    If Not IsTelNum(lo_Control.Text) Then
                                    ' M150
                            '        Call MsgBox(MsgText(ErrMsg_M706, ms_Language_Code, "#M706 - This phone number does not appear to be the correct format (00xxx)."))
                            '        lo_Control.SetFocus
                            '        Exit Function
                            '    End If
                            'End If
                        Case "Email"
                            If lo_Control.Visible And lo_Control.Text <> "" Then
                            
                                If Not IsEmailValid(lo_Control.Text) Then
                                    ' M150
                                    Call MsgBox(MsgText(ErrMsg_M150, ms_Language_Code, "#M150 - This email address does not appear to be the correct format (User@domain)."))
                                    lo_Control.SetFocus
                                    Exit Function
                                End If

                            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
    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
    Dim lIdx As Long, lCount As Long

    grd_items.Enabled = True
    Select Case au_mode
        Case smMain
            ' enable filtering a browsing
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            Call SetEnabledCtrl(tlb_Main, True)
            
        Case smUpdate, smAdd, smCopy
            ' we are in Update section
            Call SetEnabled(GetContainedControlsChain(fra_Detail), True)
            
            ' disable subdetail
            Call SetEnabled(GetContainedControlsChain(frm_SPA_Item_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
            
            If au_mode <> smUpdate Then                             ' 06/10/2012 JN
                Call SetEnabledCtrl(btn_validToHistory, False)
                Call SetEnabledCtrl(btn_showLinkedEmails, False)
                Call SetEnabledCtrl(btn_resendApprovalEmails, False)
            End If
            
            Call SetEnabledCtrl(tlb_Main, True)

        Case smUpdateUsedInSAP
            ' we are in PreView section
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            Call SetEnabledCtrl(chk_usedInSAP, True)
            Call SetEnabledCtrl(txt_SPA_Used_Comment, True)
            Call SetEnabledCtrl(txt_SPA_Comment, True)
            Call SetEnabledCtrl(txt_Internal_comment, True)
            Call SetEnabledCtrl(btn_validToHistory, True)
            Call SetEnabledCtrl(btn_showLinkedEmails, True)
            Call SetEnabledCtrl(btn_closeValidTo, True)
            
        Case smDelete, smView, smUpdateStauts, smUpdateValidTo
            ' we are in PreView section
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            Call SetEnabled(GetContainedControlsChain(fra_manipulation), False)
            Call SetEnabled(GetContainedControlsChain(frm_linkedEmails), True)
            
            If au_mode = smUpdateValidTo Then               ' 06/10/2012 JN
                Call SetEnabledCtrl(cal_valid_To, True)
            End If
            Call SetEnabledCtrl(btn_validToHistory, True)
            Call SetEnabledCtrl(btn_showLinkedEmails, True)
            Call SetEnabledCtrl(btn_resendApprovalEmails, au_mode = smView)

        
        Case smAddItem, smUpdateItem
            Call SetEnabled(GetContainedControlsChain(fra_Detail), False)
            Call SetEnabled(GetContainedControlsChain(frm_SPA_Item_Detail), True)
            
            Call SetEnabledCtrl(btn_pickProduct, au_mode = smAddItem)
            
            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)
            grd_items.Enabled = 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)
            grd_items.Enabled = False
        Case Else
            Debug.Assert (False)
    End Select

    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.UnCheckAll lControl.GetVisibleList
                    Dim ll_Idx As Long
                    For ll_Idx = 1 To lControl.RoleCount
                        lControl.RoleList(ll_Idx).ClearList
                    Next
                    lControl.SetVisibleList lControl.GetVisibleList
                    
                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", "Tel", "Email"
                        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)
                            
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDbl(ao_Control.Text))
                            
                            
                        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_deleteLinkedEmails_Click()
On Error GoTo ErrHandler
    If grd_linkedEmails.SelectedCount = 0 Then Exit Sub
    Call LockScreen(True)
    
    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 DeleteLinkedEmails
    End If

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

Private Sub DeleteLinkedEmails()
Const C_REQ As String = "EXEC SPA_LinkedEmail_del $SPA_EML_ID$, $Z_Last_Upd_User$, $ICONC$"
On Error GoTo ErrHandler

    Dim ll_i As Long
    Dim ls_req As String
    
    For ll_i = 0 To grd_linkedEmails.SelectedCount - 1
    
        ls_req = ReplaceCommonPlaceholders(C_REQ)
        ls_req = ReplacePlaceHolder(ls_req, "$SPA_EML_ID$", grd_linkedEmails.SelectedKey(ll_i)(0))
        ls_req = ReplacePlaceHolder(ls_req, "$ICONC$", grd_linkedEmails.SelectedLine(ll_i, "iConcurrency"))
        
        Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    Next
    
    ' remove all selected lines
    Call grd_linkedEmails.DeleteSelectedLines

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

Private Sub btn_closeLinkedEmails_Click()
    frm_linkedEmails.Visible = False
End Sub

Private Sub btn_closeValidTo_Click()
    frm_ValidToHistory.Visible = False
End Sub


Private Sub btn_MakeProject_Click()
    On Error GoTo ErrHandler
        If mb_Initializing Then Exit Sub
        
        Call LockScreen(True)
        
        UpdateUI (smProjectView)
        mo_CapPrj.SPA = txt_SPA_ID.Text
        
        Call LockScreen(False)
        Exit Sub
ErrHandler:
        Call LockScreen(False)
        Call ErrorMessage(Extender.Name & ".btn_MakeProject_Click")
End Sub

Private Sub btn_pickContact_Click()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call SearchContact
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".btn_pickContact_Click")
End Sub

Private Sub btn_PickContractor_Click()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call SearchContractor
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".btn_PickContractor_Click")
End Sub

Private Sub btn_pickCustomer_Click()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call SearchCustomer
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".btn_pickCustomer_Click")
End Sub

Private Sub btn_pickProduct_Click()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call SearchProduct

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

Private Sub btn_pickProject_Click()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call SearchProject
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".btn_pickProject_Click")
End Sub

Private Sub btn_resendApprovalEmails_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 CStr(ml_U_Code) <> txt_Creator_Code.Text Then
        ' user is not approved to resend approval emails
'        Call MsgBox(MsgText(ErrMsg_M780, ms_Language_Code, "Only creator of SPA can resend the email."), vbInformation)
'      Exit Sub
'    End If
    Call LockScreen(True)
    
    Dim ll_Cursor As Long
    Dim ll_emlCode As Long
    ll_Cursor = OpenSQLSafe(mo_Db, ReplacePlaceHolder(C_SPA_CHK, "$SPA_ID$", txt_SPA_ID.Text))
    
    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$", txt_SPA_ID.Text))
    
    
    ' 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_resendApprovalEmails_Click")
End Sub

Private Sub btn_showLinkedEmails_Click()
On Error GoTo ErrHandler
    frm_linkedEmails.Visible = True
    Call frm_linkedEmails.Zorder
    grd_linkedEmails.Refresh
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".btn_showLinkedEmails_Click")
End Sub

Private Sub btn_validToHistory_Click()
On Error GoTo ErrHandler
    frm_ValidToHistory.Visible = True
    grd_validToHistory.Refresh
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".btn_validToHistory_Click")
End Sub

Private Sub cal_Date_Required_changeposition(y As Integer)
    cal_Date_Required.Zorder
    cal_Date_Required.Top = cal_Date_Required.Top + y
End Sub


Private Sub cal_valid_From_changeposition(y As Integer)
    cal_valid_From.Zorder
    cal_valid_From.Top = cal_valid_From.Top + y
End Sub

Private Sub cal_valid_To_changeposition(y As Integer)
    cal_valid_To.Zorder
    cal_valid_To.Top = cal_valid_To.Top + y
End Sub

Private Sub cbo_contact_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    Call LockScreen(True)
    
    Dim ls_tel As String
    Dim ls_fax As String
    Dim ls_Email As String
    
    ls_tel = cbo_contact.SelectedItem.GetData(2)    ' tel
    ls_fax = cbo_contact.SelectedItem.GetData(3)    ' fax
    ls_Email = cbo_contact.SelectedItem.GetData(4)  ' email
    
    If Not cbo_customer.SelectedItem Is Nothing Then
        If ls_tel = "" Then ls_tel = cbo_customer.SelectedItem.GetData(2)
        If ls_fax = "" Then ls_fax = cbo_customer.SelectedItem.GetData(3)
    End If
    
    If ls_tel <> "" Then Txt_phone.Text = ls_tel
    If ls_fax <> "" Then Txt_fax.Text = ls_fax
    If ls_Email <> "" Then txt_Email.Text = ls_Email

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

Private Sub cbo_customer_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call cbo_contact.Clear
    cbo_contact.Request = Replace(ReplaceCommonPlaceholders(REQ_CONTACT_CBO), "$CCU_CapKey$", SqlStr(cbo_customer.SelectedItem.Key), , , vbTextCompare)
    cbo_slsorg.Request = Replace(ReplaceCommonPlaceholders(REQ_SLSORG_CBO), "$CCU_CapKey$", SqlStr(cbo_customer.SelectedItem.Key), , , vbTextCompare)

    If Not FillCustomerData(cbo_customer.SelectedItem.Key) Then
        Call ClearCustomerData
    ElseIf Not cbo_requestor.SelectedItem Is Nothing Then
        If GetComboKey(cbo_requestor) <> txt_SR_U_Code.Text Or txt_SR_U_Code.Text = "" Then
            ' show message
            Call MsgBox(MsgText(ErrMsg_M201, ms_Language_Code, "#Selected requestor is not defined as owner of a customer."), vbInformation)
        End If
    End If
    ' clean the email field P.124
    txt_Email.Text = ""
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_customer_ComboItemSelected")
End Sub

Private Sub cbo_pricegroup_ComboDropDown()
On Error GoTo ErrHandler
    
    Call LockScreen(True)
    Call LimitComboByConfig(cbo_pricegroup, C_A_CONFIG_Price_Grp & "_" & txt_CT_Code.Text)
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_pricegroup_ComboDropDown")
End Sub

Private Sub cbo_Delivery_Method1_ComboDropDown()
On Error GoTo ErrHandler
    
    Call LockScreen(True)
    Call LimitComboByConfig(cbo_Delivery_Method1, C_A_CONFIG_DelMeth1 & "_" & txt_CT_Code.Text)
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_Delivery_Method1_ComboDropDown")
End Sub

Private Sub cbo_Delivery_Method2_ComboDropDown()
On Error GoTo ErrHandler
    
    Call LockScreen(True)
    Call LimitComboByConfig(cbo_Delivery_Method2, C_A_CONFIG_DelMeth2 & "_" & txt_CT_Code.Text)
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_Delivery_Method2_ComboDropDown")
End Sub

Private Sub cbo_SPA_Type_ComboDropDown()
On Error GoTo ErrHandler
    
    Call LockScreen(True)
    Call LimitComboByConfigSafe(cbo_SPA_Type, C_A_CONFIG_SPA_TYPE_SUPPORT & txt_CT_Code.Text)
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_SPA_Type_ComboDropDown")
End Sub

Private Sub LimitComboByConfig(ByVal ao_Combo As ArmCombobox, ByVal as_CFG_Key As String)
On Error GoTo ErrHandler
    
    Dim ls_Data As String
    Dim ll_Idx As Long
    
    ls_Data = SEP & mo_A_Config(as_CFG_Key) & SEP
    For ll_Idx = ao_Combo.Count To 1 Step -1
        If (CStr(ao_Combo.ComboItems(ll_Idx).Key) <> "") And (InStr(1, ls_Data, SEP & ao_Combo.ComboItems(ll_Idx).Key & SEP, vbTextCompare) <= 0) Then
            Call ao_Combo.DeleteItemIndex(ll_Idx)
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".LimitComboByConfig")
End Sub

Private Sub LimitComboByConfigSafe(ByVal ao_Combo As ArmCombobox, ByVal as_CFG_Key As String)
On Error GoTo ErrHandler
    
    Dim ls_Data As String
    Dim ls_selectedKey As String
    Dim ll_Idx As Long
    
    ls_Data = SEP & mo_A_Config(as_CFG_Key) & SEP
    If ls_Data = SEP & SEP Then Exit Sub
    
    If Not ao_Combo.SelectedItem Is Nothing Then
        ls_selectedKey = ao_Combo.SelectedItem.Key
    Else
        ls_selectedKey = ""
    End If
    
    For ll_Idx = ao_Combo.Count To 1 Step -1
        If (CStr(ao_Combo.ComboItems(ll_Idx).Key) <> "") And _
            (CStr(ao_Combo.ComboItems(ll_Idx).Key) <> ls_selectedKey) And _
            (InStr(1, ls_Data, SEP & ao_Combo.ComboItems(ll_Idx).Key & SEP, vbTextCompare) <= 0) Then
            Call ao_Combo.DeleteItemIndex(ll_Idx)
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".LimitComboByConfig")
End Sub

Private Sub cbo_project_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Call cbo_ceilingContractor.Clear
    If Not cbo_Project.SelectedItem Is Nothing Then
    cbo_ceilingContractor.Request = Replace(ReplaceCommonPlaceholders(REQ_CEILING_CONTRACTOR_CBO), "$SP_CapKey$", SqlStr(cbo_Project.SelectedItem.Key), , , vbTextCompare)
    End If
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_project_ComboItemSelected")
End Sub

Private Sub cbo_requestor_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    If txt_SR_Code.Text = "" Then Exit Sub
    Debug.Assert (isNumeric(txt_SR_U_Code.Text))
    Call LockScreen(True)
    'check if selected requestor is owner of a customer
    If GetComboKey(cbo_requestor) <> txt_SR_U_Code.Text Then
        ' show message
        Call MsgBox(MsgText(ErrMsg_M201, ms_Language_Code, "#Selected requestor is not defined as owner of a customer."), vbInformation)
    End If
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".cbo_project_ComboItemSelected")
End Sub

Private Sub cbo_SPA_Type_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    If cbo_SPA_Type.SelectedItem Is Nothing Then Exit Sub
    
    Call LockScreen(True)
    
    Call ApplySPATypeUI(cbo_SPA_Type.SelectedItem.Key)
    
    If cbo_SPA_Type.SelectedItem.Key = eSPA_Type.SPAT_Stock Then
        Set cbo_Project.SelectedItem = Nothing
        Set cbo_ceilingContractor.SelectedItem = Nothing
    End If

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

Private Sub ApplySPATypeUI(ByVal al_Type As eSPA_Type)
On Error GoTo ErrHandler
    If al_Type = eSPA_Type.SPAT_Project Then
        ' make procet combo visible
        cbo_Project.Visible = True
        btn_pickProject.Visible = True
        btn_MakeProject.Visible = True
        cbo_ceilingContractor.Visible = True
        btn_PickContractor.Visible = True
        lbl_labels(5).Visible = True
        lbl_labels(30).Visible = True
    Else
        cbo_Project.Visible = False
        btn_pickProject.Visible = False
        btn_MakeProject.Visible = False
        cbo_ceilingContractor.Visible = False
        btn_PickContractor.Visible = False
        lbl_labels(5).Visible = False
        lbl_labels(30).Visible = False
        
    End If

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

Private Sub cbo_UOM_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    
    ' reset std_price (SAP price) after selecting the UOM
    txt_Std_Price.Text = "0"
    txt_SPA_Discount.Text = Format(100, PERCENT_FORMAT)


    If activeScreenMode = smUpdateItem Then
        ' reset also selected SAP message
        Debug.Assert (grd_items.SelectedCount > 0)
        Debug.Assert (txt_BI_SAP_Code.Text = grd_items.SelectedLine(0, "BI_SAP_Code"))
        
        grd_items.SelectedLine(0, "SPI_SAP_message") = ""
        
    End If
                    
                    
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".cbo_UOM_ComboItemSelected")
End Sub

Private Sub grd_items_RowLoaded(ByVal al_Row As Long)
On Error GoTo ErrHandler

    Dim ld_Price As Double
    ld_Price = grd_items.Data(al_Row, "Std_Price")
    
    If ld_Price > 0 Then
        If ld_Price <= grd_items.Data(al_Row, "SPA_Price") Then
            grd_items.CellColor(al_Row, "Std_Price") = vbYellow
            grd_items.CellColor(al_Row, "SPA_Price") = vbYellow
        Else
            grd_items.CellColor(al_Row, "Std_Price") = grd_items.CellColor(al_Row, "BI_SAP_Code")
            grd_items.CellColor(al_Row, "SPA_Price") = grd_items.CellColor(al_Row, "BI_SAP_Code")
        End If
    End If

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

Private Sub grd_items_SelChange()
On Error GoTo ErrHandler

    If mb_Initializing Then Exit Sub
    If grd_items.SelectedCount = 0 Then Exit Sub
    
    Call LockScreen(True)
    
    'A250
    Dim lo_detailData As Dictionary
    Set lo_detailData = New Dictionary
    lo_detailData.CompareMode = TextCompare
    
    ' fill array from selected gridrow
    Call FillDataSrcArrayFromGrid(lo_detailData, grd_items, grd_items.Row)
    
    Call SubItem_ViewInit(lo_detailData)
    
    Set lo_detailData = Nothing
    
    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_linkedEmails_ItemSelected()
On Error GoTo ErrHandler
    CapMouseOff
    ' Open selected message in outlook application
    
    Call ShowMsg(grd_linkedEmails.SelectedLine(0, "SPA_EML_ZIP_ID"))
    CapMouseOn
    Exit Sub
    
ErrHandler:
    Call ErrorMessage("grd_linkedEmails_ItemSelected")
    CapMouseOn
End Sub

Private Function ShowMsg(ByVal al_ZipTableIndex As Long) As Boolean
On Error GoTo ErrHandler

Dim ls_TempDir As String
Dim ls_Filename As String
Dim lo_shell As Object

    ShowMsg = False
    If MsgBox(MsgText(5170, ms_Language_Code, "Are you sure to download outlook message file ? Operation can take long time"), vbYesNo) = vbNo Then Exit Function
    ls_TempDir = GetTempDir()
    If Not mo_FSO.FolderExists(ls_TempDir) Then
      Call mo_FSO.CreateFolder(ls_TempDir)
    End If
    ls_Filename = "File_" & al_ZipTableIndex & ".msg"
    If DownloadMSGToFile(al_ZipTableIndex, ls_TempDir & "\" & ls_Filename) Then
        Set lo_shell = CreateObject("Shell.Application")
        Call lo_shell.ShellExecute(ls_TempDir & "\" & ls_Filename, "", "", "open", 1)
        Set lo_shell = Nothing
        ShowMsg = True
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("ShowMSG")
End Function

Private Function DownloadMSGToFile(ByVal al_ZipTableIndex As Long, ByVal as_fileName As String) As Boolean
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim ls_RequestSel As String
Dim ls_RequestIns As String
Dim ls_Filename As String

    DownloadMSGToFile = False
    If mo_FSO.FileExists(as_fileName) Then
        If Not DeleteFile(as_fileName) Then
            Exit Function
        End If
    End If
    
    ls_RequestSel = "SELECT SPA_EML_ZIP FROM SPA_LinkedEmailZip WHERE SPA_EML_ZIP_ID=$SPA_EML_ZIP_ID$"
    ls_RequestSel = ReplacePlaceHolder(ls_RequestSel, "$SPA_EML_ZIP_ID$", al_ZipTableIndex)
    
    If Not mo_Db.BlobToFileSQL(ls_RequestSel, as_fileName, True, False) Then
        Err.Raise ArmErr.CompFncFailed, "FileToBlobSQL", mo_Db.LastErrorMessage & " Error writing blob: " & ls_RequestSel & " File: " & ls_Filename
    End If
    DownloadMSGToFile = True
    Exit Function
ErrHandler:
    Call ErrorHandler("DownloadMSGToFile as_FileName=" & _
                               " SPA_EML_ZIP_ID=" & al_ZipTableIndex)
End Function


Private Function GetTempDir() As String
Dim ls_Buff As String, ll_Count As Long

On Error GoTo ErrHandler
    ls_Buff = SPACE(4096)
    ll_Count = GetTempPath(4096, ls_Buff)
    
    ls_Buff = Left(ls_Buff, ll_Count)
    'this function can return path with trailing "\" character - strip it
    If ll_Count > 0 Then
      If right(ls_Buff, 1) = "\" Then
       ls_Buff = Left(ls_Buff, ll_Count - 1)
      End If
    End If
    GetTempDir = ls_Buff
  Exit Function
ErrHandler:
  Call ErrorHandler("GetTempDir")
End Function



Private Sub grd_linkedEmails_OLEDragDrop(Data As MSFlexGridLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

Const C_REQ_FILE As String = "INSERT INTO SPA_LinkedEmailZip VALUES($SPA_EML_ZIP_ID$, ?)"
Const C_REQ As String = "SPA_LinkedEmail_ins $SPA_EML_ID$, $SPA_ID$, $SPA_EML_ZIP_ID$, $EML_Subject$, $EML_SenderEmailAddress$, $EML_To$, $EML_SenderName$, $EML_Attachements$, $EML_CreationTime$, $Z_Creator$"
    Dim mo_OtlSel As Object
    Dim mo_OtlExp As Object
    Dim mo_OtlApp As Object
    Dim ll_Idx As Long
On Error GoTo ErrHandler
 
    If Not Data.GetFormat(vbCFText) Then
        Exit Sub
    End If
    
    ' it is not 100% that we have dropped an outolook message
    Set mo_OtlApp = CreateObject("Outlook.Application")
    If mo_OtlApp Is Nothing Then
        Call MsgBox("Outlook application not found!!", vbCritical)
        Exit Sub
    End If
    
    Set mo_OtlExp = mo_OtlApp.ActiveExplorer
    If mo_OtlExp Is Nothing Then
        Call MsgBox("Outlook ActiveExplorer not found!!", vbCritical)
        Set mo_OtlApp = Nothing
        Exit Sub
    End If
    
    Set mo_OtlSel = mo_OtlExp.selection
    If mo_OtlExp Is Nothing Then
        Call MsgBox("Outlook selection not found!!", vbCritical)
        Set mo_OtlExp = Nothing
        Set mo_OtlApp = Nothing
        Exit Sub
    End If
    
    CapMouseOff
    
    Dim ls_SPA_EML_ID As String
    Dim ls_SPA_EML_ZIP_ID As String
    Dim ls_req As String
    Dim ls_eml_file  As String
    Dim ls_Subject As String
    Dim ls_To As String
    Dim ls_SenderEmail As String
    Dim ls_SenderName As String
    Dim ld_creationTime As Date
    
    Dim ll_Attachements As Long

    For ll_Idx = 1 To mo_OtlSel.Count
'        Call MsgBox("Email detected: " & mo_OtlSel.Item(ll_Idx).Subject)
        ' getnext ID for the file
        ls_SPA_EML_ID = mo_Db.SQLNextID("SPA_LinkedEmail")
        If ls_SPA_EML_ID = "" Then
            Err.Raise ArmErr.CompFncFailed, "mo_Db.SQLNextID", "SQLNextID failed for: SPA_LinkedEmail"
        End If
        
        ls_SPA_EML_ZIP_ID = mo_Db.SQLNextID("SPA_LinkedEmailZip")
        If ls_SPA_EML_ZIP_ID = "" Then
            Err.Raise ArmErr.CompFncFailed, "mo_Db.SQLNextID", "SQLNextID failed for: SPA_LinkedEmailZip"
        End If
        
        ' get info before save
        ls_Subject = mo_OtlSel.Item(ll_Idx).Subject
        ls_To = mo_OtlSel.Item(ll_Idx).To
        ll_Attachements = mo_OtlSel.Item(ll_Idx).Attachments.Count
        ls_SenderEmail = mo_OtlSel.Item(ll_Idx).SenderEmailAddress
        ls_SenderName = mo_OtlSel.Item(ll_Idx).SenderName
        ld_creationTime = mo_OtlSel.Item(ll_Idx).CreationTime
        
        'Save the file
        ls_eml_file = App.Path & "\download\SPA_Email_" & ls_SPA_EML_ZIP_ID & ".msg"
        Call mo_OtlSel.Item(ll_Idx).SaveAs(ls_eml_file, 3)      'olMSG
        
        If InStr(1, ls_Subject, txt_SPA_ID.Text, vbTextCompare) = 0 Then
            If MsgBox("Email seems not to be related to selected SPA. Do you want to continue?", vbYesNo) = vbNo Then
                CapMouseOn
                Exit Sub
            End If
        End If
        
        'Insert the file
        ls_req = ReplacePlaceHolder(C_REQ_FILE, "$SPA_EML_ZIP_ID$", ls_SPA_EML_ZIP_ID)
        
        If Not mo_Db.FileToBlobSQL(ls_req, ls_eml_file, 9) Then
            Err.Raise ArmErr.CompFncFailed, "FileToBlobSQL", mo_Db.LastErrorMessage & " Error writing blob: " & ls_req & " File: " & ls_eml_file
        End If
        
        ' insert record
        ls_req = ReplaceCommonPlaceholders(C_REQ)
        ls_req = ReplacePlaceHolder(ls_req, "$SPA_EML_ID$", ls_SPA_EML_ID)
        ls_req = ReplacePlaceHolder(ls_req, "$SPA_ID$", txt_SPA_ID.Text)
        ls_req = ReplacePlaceHolder(ls_req, "$SPA_EML_ZIP_ID$", ls_SPA_EML_ZIP_ID)
        ls_req = ReplacePlaceHolder(ls_req, "$EML_Subject$", SqlStr(ls_Subject, 150))
        ls_req = ReplacePlaceHolder(ls_req, "$EML_SenderEmailAddress$", SqlStr(ls_SenderEmail, 150))
        ls_req = ReplacePlaceHolder(ls_req, "$EML_To$", SqlStr(ls_To, 150))
        ls_req = ReplacePlaceHolder(ls_req, "$EML_SenderName$", SqlStr(ls_SenderName, 150))
        ls_req = ReplacePlaceHolder(ls_req, "$EML_Attachements$", ll_Attachements)
        ls_req = ReplacePlaceHolder(ls_req, "$EML_CreationTime$", SqlDate(ld_creationTime))
        Call ExecuteSQLSafe(mo_Db, ls_req)
    Next
    
    Set mo_OtlExp = Nothing
    Set mo_OtlApp = Nothing
    
    Call grd_linkedEmails.Refresh
    
    CapMouseOn
    Exit Sub
    
ErrHandler:
    If Err.Number = 429 Then
        Resume Next
    End If
    Call ErrorMessage("grd_linkedEmails_OLEDragDrop")
    CapMouseOn
End Sub

Private Sub mo_CapPrj_Release()
On Error GoTo ErrHandler
Dim lo_activeScreenMode As ArmScreenMode

    CapMouseOff
    
    Call popScreenMode
    
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    CapMouseOn
    Exit Sub
    
ErrHandler:
    Call ErrorMessage("mo_CapPrj_Release")
    CapMouseOn
End Sub

Private Sub mo_CapPrj_Updated()
On Error GoTo ErrHandler
    
Dim lb_PrjCustLinked As Boolean

    ' pop screen mode
    Call popScreenMode
      
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
      
    mb_Initializing = True
        
    Call cbo_Project.Clear
    Call SetComboBoxText(cbo_Project, mo_CapPrj.CurrentKey(1), mo_CapPrj.projectName)
      
    lb_PrjCustLinked = False
    
    If Not (cbo_customer.SelectedItem Is Nothing) Then
    
        CapMouseOn
        lb_PrjCustLinked = CreateProjectCompanyLink("Add", mo_CapPrj.CurrentKey(1), cbo_customer.SelectedItem.Key)
        
    End If
      
    If lb_PrjCustLinked = False Then
        Call cbo_customer.Clear
        Call cbo_contact.Clear
        cbo_Project.Request = ""
        cbo_contact.Request = ""
        cbo_customer.Request = ""
        Call ClearCustomerData
    End If
    
    Call cbo_ceilingContractor.Clear
       
    cbo_customer.Request = Replace(ReplaceCommonPlaceholders(REQ_CUSTOMER_CBO), "$SP_CapKey$", SqlStr(mo_CapPrj.CurrentKey(1)), , , vbTextCompare)
    cbo_ceilingContractor.Request = Replace(ReplaceCommonPlaceholders(REQ_CEILING_CONTRACTOR_CBO), "$SP_CapKey$", SqlStr(mo_CapPrj.CurrentKey(1)), , , vbTextCompare)
        
    mb_Initializing = False
    
    Exit Sub
    
ErrHandler:
    mb_Initializing = False
    
    Call ErrorMessage("mo_CapPrj_Updated")
End Sub

Private Sub tlb_Item_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_item.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
            ll_msg = SubItem_CanAdd()
            If ll_msg = 0 Then
                Call FillDataSrcArray(lo_detailData, Join(Array( _
                                                                    Join(Array("SPI_Id", "NEW#" & (GetGridColMaxValue(grd_items, "SPI_Id", "NEW#") + 1)), SEP1), _
                                                                    Join(Array("change", "A"), SEP1)), SEP))
                Call SubItem_AddInit(lo_detailData)
            Else
                MsgBox MsgText(ll_msg, ms_Language_Code, "#Cannot Add."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
        Case "B"
            
            ll_msg = SubItem_CanUpdate()
            If ll_msg = 0 Then
                ' fill array from selected gridrow
                Call FillDataSrcArrayFromGrid(lo_detailData, grd_items, grd_items.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_items, grd_items.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"
            Call SubItem_Exit
        Case "I" ' restore changes
            Select Case activeScreenMode
                Case smAddItem
                    Call FillDataSrcArray(lo_detailData, Join(Array( _
                                                                        Join(Array("SPI_Id", "NEW#" & (GetGridColMaxValue(grd_items, "SPI_Id", "NEW#") + 1)), SEP1), _
                                                                        Join(Array("change", "A"), SEP1)), SEP))
                Case smUpdateItem
                    ' fill array from selected gridrow
                    Call FillDataSrcArrayFromGrid(lo_detailData, grd_items, grd_items.Row)
                Case Else
                    Err.Raise ArmErr.InvalidArgument, "tlb_item_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_item_action", "Unknown screenMode=" & activeScreenMode
            End Select
        Case Else
            Err.Raise ArmErr.InvalidArgument, "tlb_item_action", "Unknown item toolbar role as_Role=" & as_Role
    End Select

    Set lo_detailData = Nothing
    
    tlb_item.Enabled = True
    
    Call LockScreen(False)
    
    DoCheck = False

    Exit Sub

ErrHandler:
    
    DoCheck = False
    
    Set lo_detailData = Nothing
    tlb_item.Enabled = True
    Call LockScreen(False)
    
    Call LogMessage("tbl_product_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 Function SPAMakeID(ByVal as_currentID As String) As String
On Error GoTo ErrHandler
    SPAMakeID = ""
    If isNumeric(as_currentID) Then
        SPAMakeID = as_currentID
    Else
        If (Left(txt_SPA_ID.Text, 5) = "COPY_") Then SPAMakeID = right(txt_SPA_ID.Text, Len(txt_SPA_ID.Text) - 5)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SPAMakeID")
End Function

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Static DoCheck As Boolean
    Dim ll_msg As Long
    
    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_SPA_ID.Text)))
        Case "B" 'goto Update screen
            Call Run(SPA_Mode.emUpdate, Array(CLng(txt_SPA_ID.Text)))
        Case "D"
            ll_msg = Item_CanPrint()
            If ll_msg = 0 Then
                RaiseEvent OnPrint(Array(CLng(txt_SPA_ID.Text)), txt_CT_Code.Text)
            Else
                RaiseEvent OnPrintPreview(Array(CLng(txt_SPA_ID.Text)), txt_CT_Code.Text)
'                MsgBox MsgText(ll_msg, ms_Language_Code, "#Cannot Print."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
        Case "u"
            ll_msg = Item_CanEmail()
            If ll_msg = 0 Then
                RaiseEvent OnEmail(Array(CLng(txt_SPA_ID.Text)), txt_CT_Code.Text, txt_Email.Text)
            Else
                MsgBox MsgText(ll_msg, ms_Language_Code, "#Cannot Email."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
        Case "I" 'Refresh update
            Call Item_Cleanup
            Call Item_Restore(Array(SPAMakeID(txt_SPA_ID.Text)))

        Case "H" 'validate mode add
            Select Case activeScreenMode
                Case ArmScreenMode.smAdd, ArmScreenMode.smCopy
                    Call Item_Add
                Case ArmScreenMode.smUpdate, ArmScreenMode.smUpdateUsedInSAP, ArmScreenMode.smUpdateStauts, ArmScreenMode.smUpdateValidTo
                    Call Item_Update(Array(CLng(txt_SPA_ID.Text)))
                Case ArmScreenMode.smDelete
                    Call Item_Delete(Array(CLng(txt_SPA_ID.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 ScanControls
            Call Item_Cleanup
            Call Item_Exit(activeScreenMode <> smDelete)
        Case "h"    ' screen for used inSAP
            Call Run(SPA_Mode.emUpdateUsedInSAP, Array(CLng(txt_SPA_ID.Text)))
        Case "n"    ' set spa status to released
            Call Run(SPA_Mode.emUpdateStauts, Array(CLng(txt_SPA_ID.Text)), SPAS_Released)
        Case "v"     ' submit
            Call Run(SPA_Mode.emUpdateStauts, Array(CLng(txt_SPA_ID.Text)), SPAS_Submited)
        Case "q"     ' approve
            Call Run(SPA_Mode.emUpdateStauts, Array(CLng(txt_SPA_ID.Text)), SPAS_Approved)
        Case "r"     ' reject
            Call Run(SPA_Mode.emUpdateStauts, Array(CLng(txt_SPA_ID.Text)), SPAS_Rejected)
        Case "X"     ' copy
            Call Run(SPA_Mode.emCopy, Array(CLng(txt_SPA_ID.Text)))
    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 UpdateMainToolbar(ByRef ao_rights As TSPAUserRights)
On Error GoTo ErrHandler
    ' update toolbar according to user rights
    Dim lb_ITS As Boolean
    Dim lb_superUser As Boolean
    Dim lb_releaser As Boolean
    Dim lb_COS As Boolean
    Dim lb_requestor As Boolean
    Dim lb_approver As Boolean
    Dim lb_salesRepre As Boolean
    Dim lb_SAP_ErrorReciever  As Boolean
    Dim lb_ValidToUpdater As Boolean
    
    lb_ITS = isUserType(ao_rights.SPARights, SPA_ITS, ml_SPM_Code)
    lb_superUser = isUserType(ao_rights.SPARights, SPA_SuperUser, ml_SPM_Code)
    lb_releaser = isUserType(ao_rights.SPARights, SPA_Releaser, ml_SPM_Code)
    lb_COS = isUserType(ao_rights.SPARights, SPA_COS, ml_SPM_Code)
    lb_requestor = isUserType(ao_rights.SPARights, SPA_Requestor, ml_SPM_Code)
    lb_approver = isUserType(ao_rights.SPARights, SPA_Approver, ml_SPM_Code)
    lb_salesRepre = isUserType(ao_rights.SPARights, SPA_SalesRepresentative, ml_SPM_Code)
    lb_SAP_ErrorReciever = isUserType(ao_rights.SPARights, SAP_ErrorReciever, ml_SPM_Code)
    lb_ValidToUpdater = isUserType(ao_rights.SPARights, SPA_ValidToUpdater, ml_SPM_Code)

    
    tlb_Main.ButtonVisible("A") = lb_ITS Or lb_superUser
    tlb_Main.ButtonVisible("B") = lb_ITS Or lb_superUser
    tlb_Main.ButtonVisible("C") = lb_ITS Or lb_superUser
    tlb_Main.ButtonVisible("X") = lb_ITS Or lb_superUser
    tlb_Main.ButtonVisible("v") = lb_ITS Or lb_superUser

    tlb_Main.ButtonVisible("h") = lb_COS Or lb_superUser
    tlb_Main.ButtonVisible("n") = lb_releaser Or lb_superUser
    tlb_Main.ButtonVisible("q") = lb_approver Or lb_superUser
    tlb_Main.ButtonVisible("r") = lb_approver Or lb_superUser

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



' if at least for one market is defined as userType
Private Function isUserType(ByRef la_SPARights() As TSPARight, ByVal al_userType As eSPA_UserType_Code, Optional ByVal al_SPM_Code As Long = 0) As Boolean
On Error GoTo ErrHandler
    isUserType = False
    Dim ll_i As Long
    For ll_i = LBound(la_SPARights) To UBound(la_SPARights)
        If la_SPARights(ll_i).SPA_UserType_Code = al_userType Then
            If al_SPM_Code = 0 Or la_SPARights(ll_i).SPM_Code = al_SPM_Code Then
                isUserType = True
                Exit Function
            End If
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler("isUserType")
End Function

Private Function InitUserRights(ByVal al_U_Code As Long) As Boolean
On Error GoTo ErrHandler
    Const C_REQ1 As String = "EXEC SPA_AuthMarket_rights_lst $U_Code$"
    Const C_REQ2 As String = "EXEC SPA_Approver_rights_lst $U_Code$"
    Const C_REQ3 As String = "EXEC SPA_Online_config_sel"
    Dim ls_req As String
    Dim ll_Cursor As Long
    Dim ll_i As Long
    
    InitUserRights = False
    
    mo_userRghts.U_Code = al_U_Code
    
    ls_req = ReplacePlaceHolder(C_REQ1, "$U_Code$", al_U_Code)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        ReDim mo_userRghts.SPARights(0 To mo_Db.RowCount(ll_Cursor) - 1) As TSPARight
        For ll_i = 0 To mo_Db.RowCount(ll_Cursor) - 1
            mo_userRghts.SPARights(ll_i).SPM_Code = mo_Db.GetFields(ll_Cursor, "SPM_Code")
            mo_userRghts.SPARights(ll_i).SPM_Desc = mo_Db.GetFields(ll_Cursor, "SPM_Desc")
            mo_userRghts.SPARights(ll_i).SPA_UserType_Code = mo_Db.GetFields(ll_Cursor, "SPA_UserType_Code")
            mo_userRghts.SPARights(ll_i).SPA_UserType_Desc = mo_Db.GetFields(ll_Cursor, "SPA_UserType_Desc")
            Call mo_Db.Next(ll_Cursor)
        Next
    Else
        ReDim mo_userRghts.SPARights(-1 To -1) As TSPARight
    End If
    
    Call mo_Db.Close(ll_Cursor)
    
    ls_req = ReplacePlaceHolder(C_REQ2, "$U_Code$", al_U_Code)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        ReDim mo_userRghts.SPAApproverRight(0 To mo_Db.RowCount(ll_Cursor) - 1) As TSPAApproverRight
        For ll_i = 0 To mo_Db.RowCount(ll_Cursor) - 1
            mo_userRghts.SPAApproverRight(ll_i).SPGAM_Id = mo_Db.GetFields(ll_Cursor, "SPGAM_Id")
            mo_userRghts.SPAApproverRight(ll_i).SPR_Code = mo_Db.GetFields(ll_Cursor, "SPR_Code")
            mo_userRghts.SPAApproverRight(ll_i).SPR_Desc = mo_Db.GetFields(ll_Cursor, "SPR_Desc")
            mo_userRghts.SPAApproverRight(ll_i).DiscountPercent = mo_Db.GetFields(ll_Cursor, "DiscountPercent")
            mo_userRghts.SPAApproverRight(ll_i).SPM_Code = mo_Db.GetFields(ll_Cursor, "SPM_Code")
            mo_userRghts.SPAApproverRight(ll_i).SPM_Desc = mo_Db.GetFields(ll_Cursor, "SPM_Desc")
            mo_userRghts.SPAApproverRight(ll_i).SPG_Code = mo_Db.GetFields(ll_Cursor, "SPG_Code")
            mo_userRghts.SPAApproverRight(ll_i).SPG_Desc = mo_Db.GetFields(ll_Cursor, "SPG_Desc")
            Call mo_Db.Next(ll_Cursor)
        Next
    Else
        ReDim mo_userRghts.SPAApproverRight(-1 To -1) As TSPAApproverRight
    End If
    
    Call mo_Db.Close(ll_Cursor)
    
    ' config load
    ll_Cursor = OpenSQLSafe(mo_Db, C_REQ3)
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        For ll_i = 0 To mo_Db.RowCount(ll_Cursor) - 1
            Call mo_A_Config.Add(mo_Db.GetFields(ll_Cursor, "CFG_Key"), mo_Db.GetFields(ll_Cursor, "CFG_Value"))
            Call mo_Db.Next(ll_Cursor)
        Next
        If Not mo_A_Config.Exists(C_A_CONFIG_Distr_Chan) Then Call mo_A_Config.Add(C_A_CONFIG_Distr_Chan, "BP")
        If Not mo_A_Config.Exists(C_A_CONFIG_Division) Then Call mo_A_Config.Add(C_A_CONFIG_Division, "00")
        If Not mo_A_Config.Exists(C_A_CONFIG_Doc_Type) Then Call mo_A_Config.Add(C_A_CONFIG_Doc_Type, "TA")
        If Not mo_A_Config.Exists(C_A_CONFIG_Partn_Role) Then Call mo_A_Config.Add(C_A_CONFIG_Partn_Role, "AG")
    Else
        ReDim mo_userRghts.SPAApproverRight(-1 To -1) As TSPAApproverRight
    End If
    Call mo_Db.Close(ll_Cursor)
    
    InitUserRights = ((LBound(mo_userRghts.SPARights) = 0) Or (LBound(mo_userRghts.SPAApproverRight) = 0))
    
    Exit Function
ErrHandler:
    If ll_Cursor <> 0 Then Call mo_Db.Close(ll_Cursor)
    Call ErrorHandler("InitUserRights()")
End Function

Public Function ScanControls() As Boolean
On Error GoTo ErrHandler
    Dim lc_Control As Control
    Dim li_Counter As Integer
    Dim ls_StringBuilder As String
    Dim ll_Index As Long
    
    For Each lc_Control In UserControl.Controls
        'label
        If TypeOf lc_Control Is Label Then
            ll_Index = -1
            On Error Resume Next
            ll_Index = lc_Control.Index
            If ll_Index = -1 Then
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
            Else
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
            End If
        End If
        'check box
        If TypeOf lc_Control Is CheckBox Then
            Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
        End If
        'tabstrip
        If TypeOf lc_Control Is TabStrip Then
            Dim ls_screenC As String
            For li_Counter = 1 To lc_Control.Tabs.Count
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Tabs.Item(li_Counter))
            Next
        End If
        'option button
        If TypeOf lc_Control Is OptionButton Then
            Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
        End If
        'grid
        If TypeOf lc_Control Is ArmGrid Then
            Debug.Print (UserControl.Name & ";" & lc_Control.Tag & "_Title;E;E;;" & lc_Control.Title)
            If Not lc_Control.Cols = 0 Then
                ls_StringBuilder = ""
                For li_Counter = 0 To lc_Control.Cols - 1
                    If li_Counter = lc_Control.Cols - 1 Then
                        ls_StringBuilder = ls_StringBuilder & lc_Control.Columns(li_Counter).Title
                    Else
                        ls_StringBuilder = ls_StringBuilder & lc_Control.Columns(li_Counter).Title & SEP
                    End If
                Next
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & ls_StringBuilder)
            End If
        End If
    Next
    ScanControls = True
    
    Exit Function
ErrHandler:
    ScanControls = False
    Call ErrorHandler("ScanControls")
End Function

Private Sub SearchCustomer()
On Error GoTo ErrHandler
    
    Dim ls_CCUCapKey As String
    Dim ls_CCUDesc As String
    Dim lo_SearchForm As SeekForm

    ls_CCUCapKey = ""
    
    Set lo_SearchForm = New SeekForm
    Load lo_SearchForm
    
    Set lo_SearchForm.ArmDb = mo_Db
'    lo_SearchForm.ConnectString = ms_ConnectString
    lo_SearchForm.Language = ms_Language_Code
    lo_SearchForm.SYS_code = 11
    lo_SearchForm.ComponentType = "CUSTOMER"
    
    lo_SearchForm.TreeView_DateType = "0"

    lo_SearchForm.TreeViewFiltersDesc = ""
    lo_SearchForm.TreeViewFilters = "" & CH_LDELIMIT & "" & CH_LDELIMIT & "" & CH_LDELIMIT & "''"
    
    lo_SearchForm.Load_A_COM
    
    Dim lb_searchOK As Boolean
    Dim ls_currentCustSelected As String
    ls_currentCustSelected = GetComboKey(cbo_customer)
    
    
    lb_searchOK = False
    
    Do
        lo_SearchForm.show 1
        
        If lo_SearchForm.SelectedData = True Then
            ls_CCUCapKey = lo_SearchForm.SelectedItemCode
            ls_CCUDesc = lo_SearchForm.SelectedItemDesc
        Else
            Exit Do
        End If
        
        lb_searchOK = FillCustomerData(ls_CCUCapKey)
        
        If lb_searchOK Then
            ' clean the email field P.124
            txt_Email.Text = ""
            
            Call Item_UpdateConfigFields(Now)
            
            ' ErrMsg_M705
            If lb_searchOK And txt_SPACT_Id.Text = "0" Then
                lb_searchOK = False
                MsgBox MsgText(ErrMsg_M705, ms_Language_Code, "#Country is not linked to any market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
            
            'ErrMsg_M190
            If lb_searchOK And txt_SPAMU_Id_Creator.Text = "0" Then
                lb_searchOK = False
                MsgBox MsgText(ErrMsg_M190, ms_Language_Code, "#You do not not have rights on this customers market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
            
            'ErrMsg_M200
            If lb_searchOK And txt_SPAMU_Id_RaisedFor.Text = "0" Then
                lb_searchOK = False
                MsgBox MsgText(ErrMsg_M200, ms_Language_Code, "#The requestor does not have rights on this customers market ."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
        Else
            ' M210 not buying customer
            Call MsgBox(MsgText(ErrMsg_M210, ms_Language_Code, "M210 - You cannot use this customer as the customer is not a buying customer."), vbInformation)
        End If
        
    Loop Until lb_searchOK
    
    mb_Initializing = True
    If lb_searchOK Then
        'TODO: ACTION WHEN BUYING CUSTOMER IS SELECTED
        
        
        Call cbo_customer.Clear
        Call cbo_Project.Clear
        Call cbo_contact.Clear
        
        cbo_customer.Request = ""
        Call SetComboBoxText(cbo_customer, ls_CCUCapKey, ls_CCUDesc)
        
        cbo_Project.Request = Replace(ReplaceCommonPlaceholders(REQ_PROJECT_CBO), "$CCU_CapKey$", SqlStr(ls_CCUCapKey), , , vbTextCompare)
        cbo_contact.Request = Replace(ReplaceCommonPlaceholders(REQ_CONTACT_CBO), "$CCU_CapKey$", SqlStr(ls_CCUCapKey), , , vbTextCompare)
        cbo_slsorg.Request = Replace(ReplaceCommonPlaceholders(REQ_SLSORG_CBO), "$CCU_CapKey$", SqlStr(ls_CCUCapKey), , , vbTextCompare)
        
        
        If GetComboKey(cbo_requestor) <> txt_SR_U_Code.Text Or txt_SR_U_Code.Text = "" Then
            ' show message
            Call MsgBox(MsgText(ErrMsg_M201, ms_Language_Code, "#Selected requestor is not defined as owner of a customer."), vbInformation)
        End If

    Else    ' JN 3.6.2013 bugfix when there was customer selected and user play with the search
        If ls_currentCustSelected = "" Then
            Call ClearCustomerData
        ElseIf ls_currentCustSelected <> ls_CCUCapKey And ls_CCUCapKey <> "" Then
            Call FillCustomerData(ls_currentCustSelected)
        End If
    End If
    mb_Initializing = False
    
    lo_SearchForm.Unload_A_COM
    
    Unload lo_SearchForm
    Set lo_SearchForm = Nothing
    
    Exit Sub
    
ErrHandler:
    mb_Initializing = False
    If Not lo_SearchForm Is Nothing Then
        lo_SearchForm.Unload_A_COM
        Unload lo_SearchForm
        Set lo_SearchForm = Nothing
    End If
    Call ErrorHandler("SearchCustomer")
End Sub


Private Sub SearchContractor()
On Error GoTo ErrHandler
    
    Dim ls_CCUCapKey As String
    Dim ls_CCUDesc As String
    Dim lo_SearchForm As SeekForm

    ls_CCUCapKey = ""
    
    Set lo_SearchForm = New SeekForm
    Load lo_SearchForm
    
    Set lo_SearchForm.ArmDb = mo_Db
'    lo_SearchForm.ConnectString = ms_ConnectString
    lo_SearchForm.Language = ms_Language_Code
    lo_SearchForm.SYS_code = 11
    lo_SearchForm.ComponentType = "CUSTOMER"
    
    lo_SearchForm.TreeView_DateType = "0"

    lo_SearchForm.TreeViewFiltersDesc = ""
    lo_SearchForm.TreeViewFilters = "" & CH_LDELIMIT & "" & CH_LDELIMIT & "" & CH_LDELIMIT & "''"
    
    lo_SearchForm.Load_A_COM
    
    lo_SearchForm.show vbModal
    
    If lo_SearchForm.SelectedData = True Then
        ls_CCUCapKey = lo_SearchForm.SelectedItemCode
        ls_CCUDesc = lo_SearchForm.SelectedItemDesc
    
        mb_Initializing = True
        
        If GetComboKey(cbo_Project) <> "" Then
            If CreateProjectCompanyLink("ADD", cbo_Project.SelectedItem.Key, ls_CCUCapKey) Then
                Call SetComboBoxText(cbo_ceilingContractor, ls_CCUCapKey, ls_CCUDesc)
            End If
        Else
            Call SetComboBoxText(cbo_ceilingContractor, ls_CCUCapKey, ls_CCUDesc)
        End If
        
        mb_Initializing = False
    End If
    
    
    lo_SearchForm.Unload_A_COM
    
    Unload lo_SearchForm
    Set lo_SearchForm = Nothing
    
    Exit Sub
    
ErrHandler:
    mb_Initializing = False
    If Not lo_SearchForm Is Nothing Then
        lo_SearchForm.Unload_A_COM
        Unload lo_SearchForm
        Set lo_SearchForm = Nothing
    End If
    Call ErrorHandler("SearchContractor")
End Sub

Private Sub SearchProject()
On Error GoTo ErrHandler
    Dim ls_SPCapKey As String
    Dim ls_SPDesc As String
    Dim mo_SearchForm As SeekForm

    ls_SPCapKey = ""
    
    Set mo_SearchForm = New SeekForm
    Load mo_SearchForm
    Set mo_SearchForm.ArmDb = mo_Db
'    mo_SearchForm.ConnectString = ms_ConnectString
    mo_SearchForm.Language = ms_Language_Code
    mo_SearchForm.ComponentType = "PROJECT"
' task 298.8 begin
'    mo_SearchForm.ViewTypeSearch = GetCodeFromCombo(cbo_View)
'    mo_SearchForm.FolowUpMaxDate = md_folowUpMaxDate
' task 298.8 end
    
    
    mo_SearchForm.TreeView_DateType = "0"
    
    
    ' Put here the treeview filter desc and the treeview filter !
    mo_SearchForm.TreeViewFiltersDesc = "BU_Grouping = 'ACTIVE'"
    mo_SearchForm.TreeViewFilters = "ACTIVE" & CH_LDELIMIT & "" & CH_LDELIMIT & "" & CH_LDELIMIT & "" & CH_LDELIMIT & "NULL"
    
    mo_SearchForm.Load_A_COM
    
    mo_SearchForm.show 1
    
    If mo_SearchForm.SelectedData = True Then
        ls_SPCapKey = mo_SearchForm.SelectedItemCode
        ls_SPDesc = mo_SearchForm.SelectedItemDesc
    End If
    
    mo_SearchForm.Unload_A_COM
    Unload mo_SearchForm
    Set mo_SearchForm = Nothing
    
    If ls_SPCapKey <> "" Then
        'TODO: ACTION WHEN PROJECT IS SELECTED
        
        mb_Initializing = True
        
        
        If Not (cbo_customer.SelectedItem Is Nothing) Then
            If Not CreateProjectCompanyLink("Add", ls_SPCapKey, cbo_customer.SelectedItem.Key) Then
                mb_Initializing = False
                Exit Sub
            End If
        End If
        
        Call cbo_ceilingContractor.Clear
        cbo_ceilingContractor.Request = Replace(ReplaceCommonPlaceholders(REQ_CEILING_CONTRACTOR_CBO), "$SP_CapKey$", SqlStr(ls_SPCapKey), , , vbTextCompare)
        
        cbo_customer.Request = Replace(ReplaceCommonPlaceholders(REQ_CUSTOMER_CBO), "$SP_CapKey$", SqlStr(ls_SPCapKey), , , vbTextCompare)
        
        Call SetComboBoxText(cbo_Project, ls_SPCapKey, ls_SPDesc)
        
        mb_Initializing = False
        
    End If
    
    Exit Sub
    
ErrHandler:
    mb_Initializing = False
    If Not mo_SearchForm Is Nothing Then
        mo_SearchForm.Unload_A_COM
        Unload mo_SearchForm
        Set mo_SearchForm = Nothing
    End If
    Call ErrorHandler("SearchProject")
End Sub

Private Function CreateProjectCompanyLink(ByVal as_ActionType As String, ByVal as_SP_Capkey As String, ByVal as_CCU_Capkey As String) As Boolean
On Error GoTo ErrHandler

Dim lo_LinkForm As LinkForm
Dim lt_CstValues As Type_CstValues


    CreateProjectCompanyLink = False

    If IsProjectCompanyLinked(as_SP_Capkey, as_CCU_Capkey) Then
        CreateProjectCompanyLink = True
        Exit Function
    End If
    
    Set lt_CstValues = New Type_CstValues
    Set lo_LinkForm = New LinkForm
    Load lo_LinkForm
    
    Set lo_LinkForm.ArmDb = mo_Db
        
    lo_LinkForm.Language = ms_Language_Code
    Set lo_LinkForm.mt_CstValues = lt_CstValues
    
    lo_LinkForm.project = as_SP_Capkey
    lo_LinkForm.Customer = as_CCU_Capkey
    
    lo_LinkForm.SQLActionType = as_ActionType
    lo_LinkForm.Load_A_COM
    
    lo_LinkForm.show vbModal
    
    CreateProjectCompanyLink = lo_LinkForm.DataUpdated
    
    Unload lo_LinkForm
    Set lo_LinkForm = Nothing

    Set lt_CstValues = Nothing
    Exit Function
    
ErrHandler:
    If Not lo_LinkForm Is Nothing Then
        Unload lo_LinkForm
        Set lo_LinkForm = Nothing
    End If
    
    Set lt_CstValues = Nothing
    Call ErrorHandler("CreateProjectCompanyLink")
End Function

Private Function IsProjectCompanyLinked(ByVal as_SP_Capkey As String, ByVal as_CCU_Capkey As String) As Boolean
On Error GoTo ErrHandler

    Const C_PROJECTCOMPANYLINK_CHK As String = "EXEC SPA_ProjectCompanyLink_Chk $SP_Capkey$,$CCU_Capkey$"
    Dim ls_Request As String
    Dim ll_Cursor As Long
    
    ls_Request = C_PROJECTCOMPANYLINK_CHK
    ls_Request = ReplacePlaceHolder(ls_Request, "$SP_Capkey$", SqlStr(as_SP_Capkey))
    ls_Request = ReplacePlaceHolder(ls_Request, "$CCU_Capkey$", SqlStr(as_CCU_Capkey))
    ll_Cursor = OpenSQLSafe(mo_Db, ls_Request)
    IsProjectCompanyLinked = mo_Db.RowCount(ll_Cursor) > 0
    Call mo_Db.Close(ll_Cursor)
    Exit Function
ErrHandler:
    Call mo_Db.Close(ll_Cursor)
    Call ErrorHandler("IsProjectCompanyLinked")
End Function


Private Sub SearchContact()
On Error GoTo ErrHandler
    Dim ls_CNT_Code As String
    Dim ls_CNT_Desc As String
    Dim ls_CCUCapKey As String
    Dim ls_CCUDesc  As String
    Dim lo_SearchForm As SeekForm
    Dim lb_searchOK As Boolean

    ls_CNT_Code = ""
    
    Set lo_SearchForm = New SeekForm
    Load lo_SearchForm
    
    Set lo_SearchForm.ArmDb = mo_Db
'    lo_SearchForm.ConnectString = ms_ConnectString
    lo_SearchForm.Language = ms_Language_Code
    lo_SearchForm.ComponentType = "CONTACT"
    
    lo_SearchForm.TreeView_DateType = "0"
    lo_SearchForm.TreeViewFiltersDesc = ""
    lo_SearchForm.TreeViewFilters = "''"

    
    lo_SearchForm.Load_A_COM
    
    
    
    Do
    lo_SearchForm.show 1
    
    If lo_SearchForm.SelectedData = True Then
        ls_CNT_Code = lo_SearchForm.SelectedItemCode
        ls_CNT_Desc = lo_SearchForm.SelectedItemDesc
        Dim lsa_data() As String
        Dim ll_i As Long
        lsa_data = Split(lo_SearchForm.SelectedItemFull, SEP & SEP, , vbTextCompare)
        For ll_i = LBound(lsa_data) To UBound(lsa_data)
            Dim lsa_piece() As String
            lsa_piece = Split(lsa_data(ll_i), SEP, , vbTextCompare)
            If lsa_piece(LBound(lsa_piece)) = "CCU_Desc" Then
                ls_CCUDesc = lsa_piece(UBound(lsa_piece))
                Exit For
            End If
        Next
        
            ls_CCUCapKey = GetCustomer(ls_CNT_Code)
        Else
            Exit Do
        End If
        
        lb_searchOK = FillCustomerData(ls_CCUCapKey)
        
        If lb_searchOK Then
            ' clean the email field P.124
            txt_Email.Text = ""
            
            Call Item_UpdateConfigFields(Now)
            
            ' ErrMsg_M705
            If lb_searchOK And txt_SPACT_Id.Text = "0" Then
                lb_searchOK = False
                MsgBox MsgText(ErrMsg_M705, ms_Language_Code, "#Country is not linked to any market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
            
            'ErrMsg_M190
            If lb_searchOK And txt_SPAMU_Id_Creator.Text = "0" Then
                lb_searchOK = False
                MsgBox MsgText(ErrMsg_M190, ms_Language_Code, "#You do not not have rights on this customers market."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
            End If
            
            'ErrMsg_M200
            If lb_searchOK And txt_SPAMU_Id_RaisedFor.Text = "0" Then
                lb_searchOK = False
                MsgBox MsgText(ErrMsg_M200, ms_Language_Code, "#The requestor does not have rights on this customers market ."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End If
        Else
            ' M210 not buying customer
            Call MsgBox(MsgText(ErrMsg_M210, ms_Language_Code, "M210 - You cannot use this customer as the customer is not a buying customer."), vbInformation)
        End If
        
    
        If lb_searchOK Then
    
        'TODO: ACTION WHEN CONTACT IS SELECTED
        ' get customer for selected contact
        mb_Initializing = True
        
    
        Call cbo_customer.Clear
        Call cbo_Project.Clear
        Call cbo_contact.Clear

        cbo_Project.Request = Replace(ReplaceCommonPlaceholders(REQ_PROJECT_CBO), "$CCU_CapKey$", SqlStr(ls_CCUCapKey), , , vbTextCompare)
        cbo_contact.Request = Replace(ReplaceCommonPlaceholders(REQ_CONTACT_CBO), "$CCU_CapKey$", SqlStr(ls_CCUCapKey), , , vbTextCompare)
        cbo_slsorg.Request = Replace(ReplaceCommonPlaceholders(REQ_SLSORG_CBO), "$CCU_CapKey$", SqlStr(ls_CCUCapKey), , , vbTextCompare)
        cbo_customer.Request = ""
        
        Call SetComboBoxText(cbo_contact, ls_CNT_Code, ls_CNT_Desc)
        Call SetComboBoxText(cbo_customer, ls_CCUCapKey, ls_CCUDesc)
        
        
        mb_Initializing = False
    End If
    Loop Until lb_searchOK
    
    lo_SearchForm.Unload_A_COM
    Unload lo_SearchForm
    Set lo_SearchForm = Nothing
    
    Exit Sub
    
ErrHandler:
    mb_Initializing = False
    If Not lo_SearchForm Is Nothing Then
        lo_SearchForm.Unload_A_COM
        Unload lo_SearchForm
        Set lo_SearchForm = Nothing
    End If
    Call ErrorHandler("SearchContact")
End Sub

Private Sub SearchProduct()
On Error GoTo ErrHandler
    Dim ls_BI_SAP_Code As String
    
    Dim mo_SearchForm As Item_sel

    ls_BI_SAP_Code = ""
    
    gs_CGCode = ""
    gs_Photo = ""
    Set mo_SearchForm = New Item_sel
    Load mo_SearchForm
    mo_SearchForm.ms_TypeCodeReturn = 1
    mo_SearchForm.CalledFromSPA = True
    mo_SearchForm.show 1
    
    If gb_Return = OK Then
        ls_BI_SAP_Code = gs_Photo
    End If
    
    Unload mo_SearchForm
    Set mo_SearchForm = Nothing
    
    If ls_BI_SAP_Code <> "" Then
        'TODO: ACTION WHEN PRODUCT IS SELECTED
        
        txt_BI_SAP_Code = ls_BI_SAP_Code
        txt_BI_Desc = GetBaseItemDesc(ls_BI_SAP_Code)
        
    End If
    
    Exit Sub
    
ErrHandler:
    If Not mo_SearchForm Is Nothing Then
        Unload mo_SearchForm
        Set mo_SearchForm = Nothing
    End If
    Call ErrorHandler("SearchProduct")
End Sub

' date input is the date according to we update rules
Private Sub Item_UpdateConfigFields(ByVal ad_Date As Date)
Const C_REQ_HEADER As String = "exec SPA_Header_Config_Sel $DATE$, $CT_Code$, $U_Code$, $Raised_For_U_Code$"
On Error GoTo ErrHandler
    ' update SPA_Header.SPACT_Id
    ' update SPAMU_Id_Creator
    ' update SPAMU_Id_RaisedFor
    
    ' SPA_Item.SPGAM_Id for each item on SPA
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplaceCommonPlaceholders(C_REQ_HEADER)
    ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
    ls_req = ReplacePlaceHolder(ls_req, "$DATE$", "NULL")
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        txt_SPACT_Id.Text = mo_Db.GetFields(ll_Cursor, "SPACT_Id")
        txt_SPAMU_Id_Creator.Text = mo_Db.GetFields(ll_Cursor, "SPAMU_Id_Creator")
        txt_SPAMU_Id_RaisedFor.Text = mo_Db.GetFields(ll_Cursor, "SPAMU_Id_RaisedFor")
        txt_SPM_Code.Text = mo_Db.GetFields(ll_Cursor, "SPM_Code")
        txt_SPM_Desc.Text = mo_Db.GetFields(ll_Cursor, "SPM_Desc")
    Else
        txt_SPACT_Id.Text = "0"
        txt_SPAMU_Id_Creator.Text = "0"
        txt_SPAMU_Id_RaisedFor.Text = "0"
        txt_SPM_Code.Text = "0"
        txt_SPM_Desc.Text = ""
    End If
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Sub
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler("Item_UpdateConfigFields")
End Sub

Private Function SupportZNPR_ZPRC() As Boolean
On Error GoTo ErrHandler
    SupportZNPR_ZPRC = False
    
    If cbo_slsorg.SelectedItem Is Nothing Then Exit Function
    
    Dim lsa_orgs() As String
    lsa_orgs = Split(mo_A_Config.Item(C_A_CONFIG_ZNPR_ZPRC_ORG), SEP, , vbTextCompare)
    
    Dim ll_i As Long
    For ll_i = LBound(lsa_orgs) To UBound(lsa_orgs)
        If lsa_orgs(ll_i) = cbo_slsorg.SelectedItem.Key Then
            SupportZNPR_ZPRC = True
            Exit For
        End If
    Next ll_i
    Exit Function
ErrHandler:
    Call ErrorHandler("SupportZNPR_ZPRC")
End Function

#If LIVE = 1 Then
Private Function GetZNPR_ZPRC_CURRENCY(ByRef ao_XML As Object, ByVal as_ITM_NUMBER As String) As String
    Dim lo_XMLItemCond As Object
#Else
Private Function GetZNPR_ZPRC_CURRENCY(ByRef ao_XML As MSXML2.DOMDocument, ByVal as_ITM_NUMBER As String) As String
    Dim lo_XMLItemCond As MSXML2.IXMLDOMNode
#End If
On Error GoTo ErrHandler
    GetZNPR_ZPRC_CURRENCY = ""
    
    Set lo_XMLItemCond = ao_XML.selectSingleNode("/Return/ORDER_CONDITION_EX/ROW[ITM_NUMBER='" & as_ITM_NUMBER & "' and COND_TYPE='ZNPR']/CURRENCY")
    If lo_XMLItemCond Is Nothing Then
        ' try ZPRC
        Set lo_XMLItemCond = ao_XML.selectSingleNode("/Return/ORDER_CONDITION_EX/ROW[ITM_NUMBER='" & as_ITM_NUMBER & "' and COND_TYPE='ZPRC']/CURRENCY")
    End If
    
    If Not lo_XMLItemCond Is Nothing Then
        GetZNPR_ZPRC_CURRENCY = lo_XMLItemCond.nodeTypedValue
    End If

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

Private Function GetZeroPrice_CURRENCY() As String
On Error GoTo ErrHandler
    GetZeroPrice_CURRENCY = ""
    
    If cbo_slsorg.SelectedItem Is Nothing Then Exit Function
    
    Dim lsa_orgs() As String
    lsa_orgs = Split(mo_A_Config.Item(C_A_CONFIG_ZERO_PRICE_ORG), SEP, , vbTextCompare)
    
    Dim ll_i As Long
    For ll_i = LBound(lsa_orgs) To UBound(lsa_orgs)
        Dim lsa_org() As String
        lsa_org = Split(lsa_orgs(ll_i), SEP1, , vbTextCompare)
        
        If lsa_org(0) = cbo_slsorg.SelectedItem.Key Then
            GetZeroPrice_CURRENCY = lsa_org(1)
            Exit For
        End If
    Next ll_i
    Exit Function
ErrHandler:
    Call ErrorHandler("GetZeroPrice_CURRENCY")
End Function

Private Sub SAP_ORDER_HEADER_IN_add(ByRef ao_XMLparam As SvcXMLParam, ByVal as_slsorg As String, ByVal as_priceGroup As String, ByVal ad_price_date As Date, ByVal as_CURR_Code As String)
On Error GoTo ErrHandler

    Call ao_XMLparam.AddStruct("ORDER_HEADER_IN")
    Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "DOC_TYPE", mo_A_Config(C_A_CONFIG_Doc_Type))
    Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "SALES_ORG", as_slsorg)
    Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "DISTR_CHAN", mo_A_Config(C_A_CONFIG_Distr_Chan))
    Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "DIVISION", mo_A_Config(C_A_CONFIG_Division))
    Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "PRICE_DATE", Format(ad_price_date, mo_A_Config(C_A_CONFIG_SPA_WEBSERVICE_SAP_DATEFORMAT)))
    If as_priceGroup <> "" Then
        Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "PRICE_GRP", as_priceGroup)
    End If
    If as_CURR_Code <> "" Then
        Call ao_XMLparam.AddParameter("ORDER_HEADER_IN", "CURRENCY", as_CURR_Code)
    End If

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

Private Sub SAP_ORDER_ITEMS_IN_add(ByRef ao_XMLparam As SvcXMLParam, ByVal as_SAP_Code As String, ByVal ad_Qty As Double, ByVal as_UOM As String)
On Error GoTo ErrHandler
    Call ao_XMLparam.AddTableRow("ORDER_ITEMS_IN", _
            Array( _
                    Array("MATERIAL", as_SAP_Code), _
                    Array("REQ_QTY", CLng(ad_Qty * 1000)), _
                    Array("SALES_UNIT", as_UOM) _
            ))
    Exit Sub
ErrHandler:
    Call ErrorHandler("SAP_ORDER_ITEMS_IN")
End Sub

Private Sub ORDER_PARTNERS_add(ByRef ao_XMLparam As SvcXMLParam, ByVal as_CUST_Code As String)
On Error GoTo ErrHandler
    Call ao_XMLparam.AddTable("ORDER_PARTNERS")
    Call ao_XMLparam.AddTableRow("ORDER_PARTNERS", _
            Array( _
                    Array("PARTN_ROLE", mo_A_Config(C_A_CONFIG_Partn_Role)), _
                    Array("PARTN_NUMB", as_CUST_Code) _
            ))
    Exit Sub
ErrHandler:
    Call ErrorHandler("ORDER_PARTNERS_add")
End Sub

' date input is the date according to we update rules
#If LIVE = 1 Then
Private Function SubItem_UpdateSAPPrices(ByRef as_ErrMessage As String, ByRef lo_retXML As Object) As ErrMsg
#Else
Private Function SubItem_UpdateSAPPrices(ByRef as_ErrMessage As String, ByRef lo_retXML As MSXML2.DOMDocument) As ErrMsg
#End If
On Error GoTo ErrHandler
    Dim ls_retContent   As String
    Dim ls_retHeader    As String
    Dim lo_XMLParam     As SvcXMLParam
    Dim ll_i            As Long
    
    SubItem_UpdateSAPPrices = ErrMsgNone
    
    If grd_items.Rows = 0 Then Exit Function
    
    'A130
    Set lo_XMLParam = New SvcXMLParam
    Call SAP_ORDER_HEADER_IN_add(lo_XMLParam, cbo_slsorg.SelectedItem.Key, GetComboKey(cbo_pricegroup), Now(), "")  ' cal_valid_To.date_dt) task 1080 JN 11.1.2018
    
    Call lo_XMLParam.AddTable("ORDER_ITEMS_IN")
    
    For ll_i = 0 To grd_items.Rows - 1
        If grd_items.Data(ll_i, "change") <> "D" And _
            grd_items.Data(ll_i, "SAP_processed") = 0 Then
            Call SAP_ORDER_ITEMS_IN_add(lo_XMLParam, grd_items.Data(ll_i, "BI_SAP_Code"), CDbl(grd_items.Data(ll_i, "SPA_Qty")), grd_items.Data(ll_i, "SPA_UoM"))
        End If
    Next
    Call ORDER_PARTNERS_add(lo_XMLParam, txt_Cust_Code.Text)

    If mo_Sys.CallWebservice(mo_A_Config(C_A_CONFIG_UrlGetSalesOrder), C_SAP_LOGIN, C_SAP_PASSW, lo_XMLParam.SerializedXML, "text/xml", "", ls_retContent, ls_retHeader) Then
        If lo_XMLParam.CheckHTTPResponse(ls_retHeader) Then
            ' OK
            If lo_XMLParam.TestContentType(ls_retHeader, "text/xml") Then
                ' we have response type of xml
                Dim ll_X As Long, ll_c As Long

                Set lo_retXML = CreateObject("MSXML2.DOMDocument")
                If lo_retXML.loadXML(ls_retContent) Then
                    Dim ls_SAPCode As String
                    Dim lo_XMLItem As MSXML2.IXMLDOMNode
                    
                    Dim lb_SupportZNPR_ZPRC As Boolean
                    lb_SupportZNPR_ZPRC = SupportZNPR_ZPRC()
                    
                    Dim ls_zeroPriceCurr As String
                    ls_zeroPriceCurr = GetZeroPrice_CURRENCY()
                    
                    ' update item prices
                    Set lo_XMLItem = lo_retXML.selectSingleNode("/Return/ORDER_ITEMS_OUT/ROW")
                    
                    While Not lo_XMLItem Is Nothing
                        'Debug.Print (lo_XMLItem.xml)
                        
                        If lb_SupportZNPR_ZPRC Then
                            Dim ls_CURR_Code As String
                            
                            ' check if there are some ZNPR CONDITIONS_EX
                            ls_CURR_Code = GetZNPR_ZPRC_CURRENCY(lo_retXML, lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "ITM_NUMBER"))
                            
                            If ls_CURR_Code <> "" Then
                                ' take currency and if it is differenct from item currency then resend request
                                If lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "CURRENCY") <> ls_CURR_Code Then
                                    
                                    SubItem_UpdateSAPPrices = ErrMsg_M733
                                    as_ErrMessage = IIf(as_ErrMessage = "", "", vbCrLf) & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MATERIAL") & SEP & ls_CURR_Code

                                    GoTo NextItem
                                End If
                            End If
                        End If

                        If lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MATERIAL") <> lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MAT_ENTRD") Then
                            ' price returned is for alternative product
                            SubItem_UpdateSAPPrices = ErrMsg_M732
                            as_ErrMessage = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MATERIAL") & SEP & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MAT_ENTRD")
                        Else
                            Call UpdateItemGridLine(grd_items, lo_XMLParam, lo_XMLItem, ls_zeroPriceCurr)
                        End If
NextItem:
                        Set lo_XMLItem = lo_XMLItem.nextSibling
                    Wend

                    ' check if message is occured
                    Set lo_XMLItem = lo_retXML.selectSingleNode("/Return/MESSAGETABLE/ROW")
                    If Not lo_XMLItem Is Nothing Then
                        ' record messages per item
                        SubItem_UpdateSAPPrices = ErrMsg_M701
                        as_ErrMessage = vbCrLf
                    End If
                    
                    ' record messages per item
                    While Not lo_XMLItem Is Nothing
                        'Debug.Print (lo_XMLItem.xml)
                        ll_i = -1
                        Select Case lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "TYPE")
                        Case "E"        ' error
                            If lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "NUMBER") = "384" Then
                            
                                ' get l_li based on line number ( not deleted )
                                If isNumeric(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE_V2")) Then
                                    
                                    ll_X = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE_V2") / 10 - 1
                                    ll_c = 0
                                    For ll_i = 0 To grd_items.Rows - 1
                                        If grd_items.Data(ll_i, "change") <> "D" Then
                                            If ll_c = ll_X Then
                                                Exit For
                                            End If
                                            ll_c = ll_c + 1
                                        End If
                                    Next ll_i
                                    
                                End If
                            
                            
                            Else
                                ' get l_li based on item number
                                For ll_i = 0 To grd_items.Rows - 1
                                    If grd_items.Data(ll_i, "change") <> "D" Then
                                        If grd_items.Data(ll_i, "BI_SAP_Code") = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE_V1") Then
                                            Exit For
                                        End If
                                    End If
                                Next
                            End If
                        Case "W"        ' warning
                            ' get l_li based on line number ( not deleted )
                            If isNumeric(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE_V1")) Then
                                
                                ll_X = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE_V1") / 10 - 1
                                ll_c = 0
                                For ll_i = 0 To grd_items.Rows - 1
                                    If grd_items.Data(ll_i, "change") <> "D" Then
                                        If ll_c = ll_X Then
                                            Exit For
                                        End If
                                        ll_c = ll_c + 1
                                    End If
                                Next ll_i
                                
                            End If
                            
                        End Select
                        as_ErrMessage = as_ErrMessage & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "NUMBER") & " " & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE") & vbCrLf
                        If ll_i <> -1 Then
                            grd_items.Data(ll_i, "SPI_SAP_message") = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "NUMBER") & " " & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE")
                            
                            ' indicate SAP_processed field
                            grd_items.Data(ll_i, "SAP_processed") = 1
                            
                            If grd_items.Data(ll_i, "change") = "" Then grd_items.Data(ll_i, "change") = "U"
                        End If
                        Set lo_XMLItem = lo_XMLItem.nextSibling
                    Wend
                Else
                    SubItem_UpdateSAPPrices = ErrMsg_M703
                    as_ErrMessage = ls_retContent
                End If
                
            Else
                ' not axpected answer from the server, probably fatal error in server routine
                If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
                    as_ErrMessage = ls_retContent
                    SubItem_UpdateSAPPrices = ErrMsg_M703
                End If
            End If
        Else
            ' not axpected answer from the server, probably fatal error in server routine
            If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
                as_ErrMessage = ls_retContent
                SubItem_UpdateSAPPrices = ErrMsg_M702
            End If
        End If
'        Debug.Print ls_retContent
'        Debug.Print ls_retHeader
    Else
'        If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
            ' need to raise exception
            as_ErrMessage = "Webservice on '" & mo_A_Config(C_A_CONFIG_UrlGetSalesOrder) & "' call failed"
            SubItem_UpdateSAPPrices = ErrMsg_M704
'        End If
    End If
    
    Set lo_XMLParam = Nothing
    
    Exit Function
ErrHandler:
    Set lo_XMLParam = Nothing
    Call ErrorHandler("SubItem_UpdateSAPPrices")
End Function


' date input is the date according to we update rules
Private Function SubItem_UpdateSAPPrices_line(ByRef ao_grid As ArmGrid, ByVal al_Row As Long, ByRef as_ErrMessage As String, ByVal as_CURR_Code As String) As ErrMsg
On Error GoTo ErrHandler
    Dim ls_retContent   As String
    Dim ls_retHeader    As String
    Dim lo_XMLParam     As SvcXMLParam
    SubItem_UpdateSAPPrices_line = ErrMsg.ErrMsgNone
    
    If ao_grid.Data(al_Row, "change") = "D" Then
        Exit Function
    End If
    
    'A130
    Set lo_XMLParam = New SvcXMLParam
    Call SAP_ORDER_HEADER_IN_add(lo_XMLParam, cbo_slsorg.SelectedItem.Key, GetComboKey(cbo_pricegroup), Now(), as_CURR_Code)  ' cal_valid_To.date_dt) task 1080 JN 11.1.2018
    
    Call lo_XMLParam.AddTable("ORDER_ITEMS_IN")
    
    Call SAP_ORDER_ITEMS_IN_add(lo_XMLParam, ao_grid.Data(al_Row, "BI_SAP_Code"), CDbl(ao_grid.Data(al_Row, "SPA_Qty")), ao_grid.Data(al_Row, "SPA_UoM"))
    
    Call ORDER_PARTNERS_add(lo_XMLParam, txt_Cust_Code.Text)

    If mo_Sys.CallWebservice(mo_A_Config(C_A_CONFIG_UrlGetSalesOrder), C_SAP_LOGIN, C_SAP_PASSW, lo_XMLParam.SerializedXML, "text/xml", "", ls_retContent, ls_retHeader) Then
        If lo_XMLParam.CheckHTTPResponse(ls_retHeader) Then
            ' OK
            If lo_XMLParam.TestContentType(ls_retHeader, "text/xml") Then
                ' we have response type of xml
                Dim ll_X As Long, ll_c As Long

#If LIVE = 1 Then
                Dim lo_retXML As Object
#Else
                Dim lo_retXML As MSXML2.DOMDocument
#End If
                Set lo_retXML = CreateObject("MSXML2.DOMDocument")
                If lo_retXML.loadXML(ls_retContent) Then
                    Dim ls_SAPCode As String
                    Dim lo_XMLItem As MSXML2.IXMLDOMNode
                    
                    Dim lb_SupportZNPR_ZPRC As Boolean
                    lb_SupportZNPR_ZPRC = SupportZNPR_ZPRC()
                    
                    Dim ls_zeroPriceCurr As String
                    ls_zeroPriceCurr = GetZeroPrice_CURRENCY()
                    
                    ' update item prices
                    Set lo_XMLItem = lo_retXML.selectSingleNode("/Return/ORDER_ITEMS_OUT/ROW")
                    
                    While Not lo_XMLItem Is Nothing
                    
                        If lb_SupportZNPR_ZPRC Then
                            Dim ls_CURR_Code As String
                            
                            ' check if there are some ZNPR CONDITIONS_EX
                            ls_CURR_Code = GetZNPR_ZPRC_CURRENCY(lo_retXML, lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "ITM_NUMBER"))
                            
                            If ls_CURR_Code <> "" Then
                                ' take currency and if it is differenct from item currency then resend request
                                If lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "CURRENCY") <> ls_CURR_Code Then
                                    
                                    SubItem_UpdateSAPPrices_line = ErrMsg_M733
                                    as_ErrMessage = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MATERIAL") & SEP & ls_CURR_Code
                                    
                                    Set lo_XMLParam = Nothing
                                    Exit Function
                                End If
                            End If
                        End If
                        
                        'Debug.Print (lo_XMLItem.xml)
                        If lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MATERIAL") <> lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MAT_ENTRD") Then
                            ' price returned is for alternative product
                            SubItem_UpdateSAPPrices_line = ErrMsg_M732
                            as_ErrMessage = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MATERIAL") & SEP & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MAT_ENTRD")
                        Else
                            Call UpdateItemGridLine(ao_grid, lo_XMLParam, lo_XMLItem, ls_zeroPriceCurr)
                        End If
                        Set lo_XMLItem = lo_XMLItem.nextSibling
                    Wend

                    ' check if message is occured
                    Set lo_XMLItem = lo_retXML.selectSingleNode("/Return/MESSAGETABLE/ROW")
                    If Not lo_XMLItem Is Nothing Then
                        ' record messages per item
                        SubItem_UpdateSAPPrices_line = ErrMsg_M701
                        as_ErrMessage = as_ErrMessage & vbCrLf
                    End If
                    
                    ' record messages per item
                    While Not lo_XMLItem Is Nothing
                        'Debug.Print (lo_XMLItem.xml)
                        as_ErrMessage = as_ErrMessage & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "NUMBER") & " " & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE") & vbCrLf
                        ao_grid.Data(al_Row, "SPI_SAP_message") = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "NUMBER") & " " & lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "MESSAGE")
                        If ao_grid.Data(al_Row, "change") = "" Then ao_grid.Data(al_Row, "change") = "U"
                        Set lo_XMLItem = lo_XMLItem.nextSibling
                    Wend
                Else
                    SubItem_UpdateSAPPrices_line = ErrMsg_M703
                    as_ErrMessage = ls_retContent
                End If
                Set lo_retXML = Nothing
            Else
                ' not axpected answer from the server, probably fatal error in server routine
                If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
                    as_ErrMessage = ls_retContent
                    SubItem_UpdateSAPPrices_line = ErrMsg_M703
                End If
            End If
        Else
            ' not axpected answer from the server, probably fatal error in server routine
            If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
                as_ErrMessage = ls_retContent
                SubItem_UpdateSAPPrices_line = ErrMsg_M702
            End If
        End If
'        Debug.Print ls_retContent
'        Debug.Print ls_retHeader
    Else
    
'        If txt_SPA_ApprovalStatus.Text = eSPA_ApprovalStatus.SPAS_Submited Then
            ' need to raise exception
            as_ErrMessage = "Webservice on '" & mo_A_Config(C_A_CONFIG_UrlGetSalesOrder) & "' call failed"
            SubItem_UpdateSAPPrices_line = ErrMsg_M704
'        End If
    End If
    
    Set lo_XMLParam = Nothing
    
    Exit Function
ErrHandler:
    Set lo_XMLParam = Nothing
    Call ErrorHandler("SubItem_UpdateSAPPrices_line ")
End Function


' date input is the date according to we update rules
Private Sub SubItem_UpdateConfigFields(ByVal ad_Date As Date)
Const C_REQ_ITEM As String = "exec SPA_Item_Config_Sel $DATE$, $CT_Code$, $BI_SAP_Code$"
On Error GoTo ErrHandler
    ' SPA_Item.SPGAM_Id for each item on SPA
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplaceCommonPlaceholders(C_REQ_ITEM)
    ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
    ls_req = ReplacePlaceHolder(ls_req, "$DATE$", "NULL")
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        txt_SPGAM_Id.Text = mo_Db.GetFields(ll_Cursor, "SPGAM_Id")
    Else
        txt_SPGAM_Id.Text = "0"
    End If
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Sub
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler("SubItem_UpdateConfigFields")
End Sub

Private Function SubItem_GET_SPGAM_Id(ByVal ad_Date As Date, ByVal ls_SAP_Code As String, ByVal as_CT_Code As String) As Long
Const C_REQ_ITEM As String = "exec SPA_Item_Config_Sel $DATE$, $CT_Code$, $BI_SAP_Code$"
On Error GoTo ErrHandler
    SubItem_GET_SPGAM_Id = 0
    ' SPA_Item.SPGAM_Id for each item on SPA
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ_ITEM, "$BI_SAP_Code$", "'" & ls_SAP_Code & "'")
    ls_req = ReplacePlaceHolder(ls_req, "$CT_Code$", "'" & as_CT_Code & "'")
    ls_req = ReplacePlaceHolder(ls_req, "$DATE$", "NULL")
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        SubItem_GET_SPGAM_Id = mo_Db.GetFields(ll_Cursor, "SPGAM_Id")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler("SubItem_GET_SPGAM_Id")
End Function


Private Function Is_BI_LMK_OK(ByVal as_BI_SAP_Code As String, ByVal as_CT_Code As String) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "exec SPA_Item_BI_CT_LMK_chk $CT_Code$, $BI_SAP_Code$"
    Is_BI_LMK_OK = False
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ, "$CT_Code$", SqlStr(as_CT_Code))
    ls_req = ReplacePlaceHolder(ls_req, "$BI_SAP_Code$", SqlStr(as_BI_SAP_Code))
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    Is_BI_LMK_OK = (mo_Db.GetFields(ll_Cursor, "isOK") > 0)
    
    Call mo_Db.Close(ll_Cursor)

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

Private Function SubItem_CheckLMK() As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "exec SPA_Item_BI_CT_LMK_chk $CT_Code$, $BI_SAP_Code$"
    SubItem_CheckLMK = False
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplaceCommonPlaceholders(C_REQ)
    ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    SubItem_CheckLMK = (mo_Db.GetFields(ll_Cursor, "isOK") > 0)
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".SubItem_CheckLMK")
End Function

Private Function Is_BI_USER_SPM_OK(ByVal as_BI_SAP_Code As String, ByVal al_U_Code As Long) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "exec SPA_Item_BI_USER_SPM_chk $BI_SAP_Code$, $U_Code$"
    Is_BI_USER_SPM_OK = False
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ, "$U_Code$", al_U_Code)
    ls_req = ReplacePlaceHolder(ls_req, "$BI_SAP_Code$", SqlStr(as_BI_SAP_Code))
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    Is_BI_USER_SPM_OK = (mo_Db.GetFields(ll_Cursor, "isOK") > 0)
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".Is_BI_USER_SPM_OK")
End Function

Private Function SubItem_CheckSPM(ByVal al_U_Code As Long) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "exec SPA_Item_BI_USER_SPM_chk $BI_SAP_Code$, $U_Code$"
    SubItem_CheckSPM = False
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ, "$U_Code$", al_U_Code)
    ls_req = ReplaceRequestByFrameData(ls_req, frm_SPA_Item_Detail)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    SubItem_CheckSPM = (mo_Db.GetFields(ll_Cursor, "isOK") > 0)
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".SubItem_CheckSPM")
End Function

' 0 meas everything ok
Private Function SubItem_CanUpdate() As Long
On Error GoTo ErrHandler
    SubItem_CanUpdate = 0
    
    If grd_items.SelectedCount = 0 Then
        SubItem_CanUpdate = WarMsgSelectRow
        Exit Function
    End If
    If grd_items.CurrentLine("change") = "D" Then
        SubItem_CanUpdate = ErrMsgItemIsDeleted
        Exit Function
    End If
    
    If cbo_requestor.SelectedItem Is Nothing Then
        SubItem_CanUpdate = ErrMsgMandatoryAreEmpty
        Exit Function
    End If
    
    If txt_CT_Code.Text = "" Then
        SubItem_CanUpdate = ErrMsgMandatoryAreEmpty
        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
    
    If cbo_requestor.SelectedItem Is Nothing Then
        SubItem_CanAdd = ErrMsgMandatoryAreEmpty
        Exit Function
    End If
    
    If txt_CT_Code.Text = "" Then
        SubItem_CanAdd = ErrMsgMandatoryAreEmpty
        Exit Function
    End If
    
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_CanAdd")
End Function

' 0 meas everything ok
Private Function SubItem_CanDelete() As Long
On Error GoTo ErrHandler
    SubItem_CanDelete = 0
    
    If grd_items.SelectedCount = 0 Then
        SubItem_CanDelete = WarMsgSelectRow
        Exit Function
    End If
    If grd_items.CurrentLine("change") = "D" Then
        SubItem_CanDelete = ErrMsgItemIsDeleted
        Exit Function
    End If
    
    If cbo_requestor.SelectedItem Is Nothing Then
        SubItem_CanDelete = ErrMsgMandatoryAreEmpty
        Exit Function
    End If
    
    If txt_CT_Code.Text = "" Then
        SubItem_CanDelete = ErrMsgMandatoryAreEmpty
        Exit Function
    End If
    
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SubItem_CanDelete")
End Function

Private Function Item_CheckSP(ByVal al_U_Code As Long) As ErrMsg
On Error GoTo ErrHandler
Const C_REQ As String = "exec SPA_Head_SP_USER_SPM_chk $DATE$, $SP_CapKey$, $U_Code$, $Raised_For_U_Code$"
    Item_CheckSP = ErrMsgNone
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    Dim ll_SPAC As Long
    Dim ll_SPAMU_Id As Long
    Dim ll_SPAMU_Id_RaisedFor As Long
    
    ls_req = ReplacePlaceHolder(C_REQ, "$U_Code$", al_U_Code)
    ls_req = ReplacePlaceHolder(ls_req, "$DATE$", "NULL")
    ls_req = ReplaceRequestByFrameData(ls_req, fra_Detail)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    ll_SPAC = mo_Db.GetFields(ll_Cursor, "SPACT_Id")
    ll_SPAMU_Id = mo_Db.GetFields(ll_Cursor, "SPAMU_Id_Creator")
    ll_SPAMU_Id_RaisedFor = mo_Db.GetFields(ll_Cursor, "SPAMU_Id_RaisedFor")
    
    Call mo_Db.Close(ll_Cursor)
    
    ' undefined messasge
    If ll_SPAC = 0 Then
        Item_CheckSP = ErrMsg_M705
        Exit Function
    End If
    
    'ErrMsg_M220
    If ll_SPAMU_Id = 0 Then
        Item_CheckSP = ErrMsg_M220
        Exit Function
    End If
    
    'ErrMsg_M230
    If ll_SPAMU_Id_RaisedFor = 0 Then
        Item_CheckSP = ErrMsg_M230
        Exit Function
    End If
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".Item_CheckSP")
End Function

Private Function Item_CheckSR_Code(ByVal as_SR_Code As String, ByVal as_CT_Code As String) As ErrMsg
On Error GoTo ErrHandler
Const C_REQ As String = "exec SPA_Header_SR_chk $SR_Code$, $CT_Code$"
    Item_CheckSR_Code = ErrMsgNone
    
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = ReplacePlaceHolder(C_REQ, "$SR_Code$", SqlStr(as_SR_Code))
    ls_req = ReplacePlaceHolder(ls_req, "$CT_Code$", SqlStr(as_CT_Code))
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    ' check ErrMsg_M726
    If mo_Db.RowCount(ll_Cursor) = 0 Then
        Item_CheckSR_Code = ErrMsg_M726
    End If
    
    Call mo_Db.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler(Extender.Name & ".Item_CheckSR_Code")
End Function
Private Function Item_CanEmail() As Long
On Error GoTo ErrHandler
    Item_CanEmail = 0

    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Approved And _
        txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Released Then
        Item_CanEmail = ErrMsg_M130
        Exit Function
    End If
    
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_CanEmail")
End Function

Private Function Item_CanPrint() As Long
On Error GoTo ErrHandler
    Item_CanPrint = 0
    
    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Approved And _
        txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Released Then
        Item_CanPrint = ErrMsg_M130
        Exit Function
    End If

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

Private Function Item_CanSubmit() As Long
On Error GoTo ErrHandler
    Item_CanSubmit = 0

    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_New Then
        Item_CanSubmit = ErrMsg_M160
        Exit Function
    End If
    
    If grd_items.Rows = 0 Then
        Item_CanSubmit = ErrMsg_M170
        Exit Function
    End If
    
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_CanSubmit")
End Function

Private Function Item_CanRelease() As Long
On Error GoTo ErrHandler
    Item_CanRelease = 0
    
    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Approved Then
        Item_CanRelease = ErrMsg_M650
        Exit Function
    End If

    'test if user is SPA_Releaser
    If Not isUserType(mo_userRghts.SPARights, eSPA_UserType_Code.SPA_Releaser, ml_SPM_Code) Then
        Item_CanRelease = ErrMsg_M725   ' You are not releaser for the market of SPA
    Exit Function
    End If

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

Private Function Item_CanCopy() As Long
On Error GoTo ErrHandler
    Item_CanCopy = 0

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

Private Function Item_CanUpdate() As Long
On Error GoTo ErrHandler
    Item_CanUpdate = 0
    
    If chk_dropped.Value = vbChecked Then
        ' deleted task cannot by edited
        Item_CanUpdate = ErrMsgUpdateDeletedSPA
        Exit Function
    End If
    
    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_New Then
        Item_CanUpdate = ErrMsg_M110
        Exit Function
    End If

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

Private Function Item_CanDelete() As Long
On Error GoTo ErrHandler
    Item_CanDelete = 0
    
    If chk_dropped.Value = vbChecked Then
        ' deleted task cannot by edited
        Item_CanDelete = ErrMsgUpdateDeletedSPA
        Exit Function
    End If

    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_New And _
        txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Submited Then
        Item_CanDelete = ErrMsg_M120
        Exit Function
    End If

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

Private Function Item_CanUpdateUsedInSAP() As Long
On Error GoTo ErrHandler
    Item_CanUpdateUsedInSAP = 0
    
    If chk_dropped.Value = vbChecked Then
        ' deleted task cannot by edited
        Item_CanUpdateUsedInSAP = ErrMsgUpdateDeletedSPA
        Exit Function
    End If

    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Released Then
        Item_CanUpdateUsedInSAP = ErrMsg_M330
        Exit Function
    End If

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

Private Function Item_CanUpdateStatus(ByVal al_newStatus As eSPA_ApprovalStatus) As Long
On Error GoTo ErrHandler
    Item_CanUpdateStatus = 0
    
    If chk_dropped.Value = vbChecked Then
        ' deleted task cannot by edited
        Item_CanUpdateStatus = ErrMsgUpdateDeletedSPA
        Exit Function
    End If
    

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

Private Function Item_CanAdd() As Long
On Error GoTo ErrHandler
    Item_CanAdd = 0

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

Private Function Item_CanApprove() As Long
On Error GoTo ErrHandler
    Item_CanApprove = 0

    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Submited Then
        Item_CanApprove = ErrMsg_M340
        Exit Function
    End If
    
    ' check if current user is superuser for this SPA market
    If isUserType(mo_userRghts.SPARights, SPA_SuperUser, ml_SPM_Code) Then
        ' super user can approve
        Exit Function
    End If
    
    ' check if current user next on approval path
    ' find in grd_approvalPath who is next to approve
    Dim ll_i As Long
    For ll_i = 0 To grd_approvalPath.Rows - 1
        If grd_approvalPath.Data(ll_i, "Status_Code") = eSPA_ApprovalPathStatus.SPAP_ToBeApproved Then
            If grd_approvalPath.Data(ll_i, "Auth_U_Code") = ml_U_Code Then
                Exit For
            End If
            Item_CanApprove = ErrMsg_M350   ' This SPA does not require your approval at this time
            Exit Function
        End If
    Next
    
    
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_CanApprove")
End Function

Private Function Item_CanReject() As Long
On Error GoTo ErrHandler
    Item_CanReject = 0
    
    If txt_SPA_ApprovalStatus.Text <> eSPA_ApprovalStatus.SPAS_Submited Then
        Item_CanReject = ErrMsg_M340
        Exit Function
    End If
    
    ' check if current user is superuser for this SPA market
    If isUserType(mo_userRghts.SPARights, SPA_SuperUser, ml_SPM_Code) Then
        ' super user can approve
        Exit Function
    End If
    
    ' check if current user next on approval path
    ' find in grd_approvalPath who is next to approve
    Dim ll_i As Long
    For ll_i = 0 To grd_approvalPath.Rows - 1
        If grd_approvalPath.Data(ll_i, "Status_Code") = eSPA_ApprovalPathStatus.SPAP_ToBeApproved Then
            If grd_approvalPath.Data(ll_i, "Auth_U_Code") = ml_U_Code Then
                Exit For
            End If
            Item_CanReject = ErrMsg_M350   ' This SPA does not require your approval at this time
            Exit Function
        End If
    Next

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


Private Function IsTelNum(ByVal as_telNum As String) As Boolean
On Error GoTo ErrorMessage
    Dim ll_i  As Long
    IsTelNum = False
    ' must start with 00XXY
    If Len(as_telNum) < 5 Then Exit Function
'    If Left(as_telNum, 2) <> "00" Then Exit Function
    
    ' tel number must containt only digits 0..9
    For ll_i = 1 To Len(as_telNum)
        Select Case Mid(as_telNum, ll_i, 1)
            Case "+", "-", " ", "0" To "9"
            Case Else
                Exit Function
        End Select
    Next
    IsTelNum = True
    Exit Function
ErrorMessage:
    Call ErrorHandler(Extender.Name & ".IsTelNum()")
End Function

    
Private Function IsEmailValid(ByVal as_EmailText As String) As Boolean
On Error GoTo ErrHandler

Dim ls_Email
Dim las_Email() As String
Dim ll_Index As Long

IsEmailValid = True

  If Trim(as_EmailText) <> "" Then
    las_Email = Split(Replace(Trim(as_EmailText), ";", ","), ",")
    For ll_Index = 0 To UBound(las_Email)
      ls_Email = Trim(las_Email(ll_Index))
      If InStr(1, ls_Email, "/") Then
        If CheckLotusEmailFormat(ls_Email) = False Then
            IsEmailValid = False
            Exit Function
        End If
    Else
        If CheckNormalEmailFormat(ls_Email) = False Then
            IsEmailValid = False
            Exit Function
        End If
      End If
    Next
  End If
  Exit Function

ErrHandler:
    Call ErrorHandler("IsEmailValid")
End Function

Private Function CheckLotusEmailFormat(ByVal as_EmailCheck As String) As Boolean
On Error GoTo ErrHandler

Dim lb_CK As Boolean
Dim ll_Index As Long
Dim ll_Index2 As Long
Dim las_EmailParts() As String
Dim ls_EmailPart As String
Const sInvalidChars As String = "@"

    lb_CK = True
    
    las_EmailParts = Split(Trim(as_EmailCheck), "/")
    
    If UBound(las_EmailParts) < 2 Then
        lb_CK = False
        GoTo ExitFunction
    End If
    
    For ll_Index = 0 To UBound(las_EmailParts)
        ls_EmailPart = Trim(las_EmailParts(ll_Index))
        If Trim(ls_EmailPart) = "" Then
            lb_CK = False
            GoTo ExitFunction
        End If
        
        ' Check for invalid characters.
        If Len(as_EmailCheck) > Len(sInvalidChars) Then
            For ll_Index2 = 1 To Len(sInvalidChars)
                If InStr(as_EmailCheck, Mid(sInvalidChars, ll_Index2, 1)) > 0 Then
                    lb_CK = False
                    GoTo ExitFunction
                End If
            Next
        Else
            For ll_Index2 = 1 To Len(as_EmailCheck)
                If InStr(sInvalidChars, Mid(as_EmailCheck, ll_Index2, 1)) > 0 Then
                    lb_CK = False
                    GoTo ExitFunction
                End If
            Next
        End If
    
    Next
    
ExitFunction:
    CheckLotusEmailFormat = lb_CK
    Exit Function

ErrHandler:
    CheckLotusEmailFormat = False
    Call ErrorHandler("CheckLotusEmailFormat")

End Function

Private Function CheckNormalEmailFormat(ByVal as_EmailCheck As String) As Boolean
On Error GoTo ErrHandler

Dim lb_CK As Boolean
Dim ls_DomainType As String
Const sInvalidChars As String = "!#$%^&*()=+{}[]|\;:'/?>,< "
Dim ll_Index As Long

    lb_CK = Not InStr(1, as_EmailCheck, Chr(34)) > 0 'Check to see if there is a double quote
    If Not lb_CK Then GoTo ExitFunction
    
    lb_CK = Not InStr(1, as_EmailCheck, "..") > 0 'Check to see if there are consecutive dots
    If Not lb_CK Then GoTo ExitFunction
    
    ' Check for invalid characters.
    If Len(as_EmailCheck) > Len(sInvalidChars) Then
        For ll_Index = 1 To Len(sInvalidChars)
            If InStr(as_EmailCheck, Mid(sInvalidChars, ll_Index, 1)) > 0 Then
                lb_CK = False
                GoTo ExitFunction
            End If
        Next
    Else
        For ll_Index = 1 To Len(as_EmailCheck)
            If InStr(sInvalidChars, Mid(as_EmailCheck, ll_Index, 1)) > 0 Then
                lb_CK = False
                GoTo ExitFunction
            End If
        Next
    End If
    
    If InStr(1, as_EmailCheck, "@") > 1 Then 'Check for an @ symbol
        lb_CK = Len(Left(as_EmailCheck, InStr(1, as_EmailCheck, "@") - 1)) > 0
    Else
        lb_CK = False
    End If
    If Not lb_CK Then GoTo ExitFunction
    
    as_EmailCheck = right(as_EmailCheck, Len(as_EmailCheck) - InStr(1, as_EmailCheck, "@"))
    lb_CK = Not InStr(1, as_EmailCheck, "@") > 0 'Check to see if there are too many @'s
    If Not lb_CK Then GoTo ExitFunction
    
    If InStr(1, as_EmailCheck, ".") = 0 Then
        lb_CK = False
        GoTo ExitFunction
        End If
    
    ls_DomainType = right(as_EmailCheck, Len(as_EmailCheck) - InStr(1, as_EmailCheck, "."))
    lb_CK = Len(ls_DomainType) > 0 And InStr(1, as_EmailCheck, ".") < Len(as_EmailCheck)
    If Not lb_CK Then GoTo ExitFunction
    
    as_EmailCheck = Left(as_EmailCheck, Len(as_EmailCheck) - Len(ls_DomainType) - 1)
    Do Until InStr(1, as_EmailCheck, ".") <= 1
        If Len(as_EmailCheck) >= InStr(1, as_EmailCheck, ".") Then
            as_EmailCheck = Left(as_EmailCheck, Len(as_EmailCheck) - (InStr(1, as_EmailCheck, ".") - 1))
        Else
            lb_CK = False
            GoTo ExitFunction
    End If
    Loop
    If as_EmailCheck = "." Or Len(as_EmailCheck) = 0 Then lb_CK = False

ExitFunction:
    CheckNormalEmailFormat = lb_CK
    Exit Function
    
ErrHandler:
    CheckNormalEmailFormat = False
    Call ErrorHandler("CheckNormalEmailFormat")
End Function


