VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Begin VB.UserControl DC_PriceList 
   ClientHeight    =   7815
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   16380
   ScaleHeight     =   7815
   ScaleWidth      =   16380
   Begin VB.Frame frm_status 
      BorderStyle     =   0  'None
      Height          =   420
      Left            =   120
      TabIndex        =   52
      Top             =   7320
      Width           =   15525
      Begin MSComctlLib.ProgressBar prg_progres 
         Height          =   180
         Left            =   4560
         TabIndex        =   53
         Top             =   135
         Width           =   10815
         _ExtentX        =   19076
         _ExtentY        =   318
         _Version        =   393216
         Appearance      =   0
      End
      Begin VB.Label lbl_action 
         BorderStyle     =   1  'Fixed Single
         Caption         =   "Main screen"
         Height          =   270
         Left            =   150
         TabIndex        =   54
         Top             =   90
         Width           =   4140
      End
   End
   Begin VB.Frame frm_detail 
      Caption         =   "Price list detail"
      Height          =   5565
      Left            =   1965
      TabIndex        =   32
      Tag             =   "frm_detail"
      Top             =   1920
      Width           =   13770
      Begin VB.TextBox txt_recordID 
         BorderStyle     =   0  'None
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   10995
         TabIndex        =   10
         Tag             =   "DCPL_Code"
         Text            =   "DCPL_Code"
         Top             =   225
         Width           =   1245
      End
      Begin VB.TextBox txt_dropOffCost 
         Height          =   315
         Left            =   6105
         TabIndex        =   12
         Tag             =   "DropOff_Cost"
         Text            =   "DropOff_Cost"
         Top             =   630
         Width           =   780
      End
      Begin VB.Frame frm_listDetail 
         Caption         =   "#line detail"
         Height          =   2100
         Left            =   135
         TabIndex        =   33
         Tag             =   "frm_listDetail"
         Top             =   3000
         Width           =   11460
         Begin VB.CheckBox chk_isReturn 
            Alignment       =   1  'Right Justify
            Caption         =   "Is return price"
            Height          =   315
            Left            =   5250
            TabIndex        =   61
            Tag             =   "IsReturn"
            Top             =   1260
            Width           =   1350
         End
         Begin Project1.ArmCheckView ckv_surcharges 
            Height          =   1785
            Left            =   9240
            TabIndex        =   60
            Top             =   210
            Width           =   2055
            _ExtentX        =   3625
            _ExtentY        =   3149
         End
         Begin VB.CheckBox chk_isTrailer 
            Alignment       =   1  'Right Justify
            Caption         =   "Trailer cost"
            Height          =   315
            Left            =   7830
            TabIndex        =   59
            Tag             =   "IsTrailer"
            Top             =   1680
            Width           =   1275
         End
         Begin VB.TextBox txt_priceformula 
            Height          =   315
            Left            =   1110
            TabIndex        =   58
            Tag             =   "PriceFormula"
            Text            =   "PriceFormula"
            Top             =   1680
            Width           =   4035
         End
         Begin VB.TextBox txt_zipCode 
            Height          =   315
            Left            =   5280
            TabIndex        =   22
            Tag             =   "DCPLL_Zip_Code"
            Text            =   "DCPLL_Zip_Code"
            Top             =   675
            Width           =   1230
         End
         Begin VB.TextBox txt_leadTime 
            Height          =   315
            Left            =   8145
            TabIndex        =   23
            Tag             =   "DCPLL_LeadTime"
            Text            =   "DCPLL_LeadTime"
            Top             =   690
            Width           =   900
         End
         Begin VB.TextBox txt_qtyMin 
            Height          =   315
            Left            =   2910
            TabIndex        =   25
            Tag             =   "DCPLLI_Qty_min"
            Text            =   "DCPLLI_Qty_min"
            Top             =   1245
            Width           =   765
         End
         Begin VB.TextBox txt_qtyMax 
            Height          =   315
            Left            =   4350
            TabIndex        =   26
            Tag             =   "DCPLLI_Qty_max"
            Text            =   "DCPLLI_Qty_max"
            Top             =   1245
            Width           =   780
         End
         Begin VB.TextBox txt_price 
            Height          =   315
            Left            =   1110
            TabIndex        =   24
            Tag             =   "DCPLLI_Price"
            Text            =   "DCPLLI_Price"
            Top             =   1245
            Width           =   735
         End
         Begin VB.TextBox txt_lineID 
            BorderStyle     =   0  'None
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   9.75
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   285
            Left            =   7845
            TabIndex        =   20
            Tag             =   "DCPLL_Code"
            Text            =   "DCPLL_Code"
            Top             =   285
            Width           =   1245
         End
         Begin VB.TextBox txt_itemID 
            BorderStyle     =   0  'None
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   9.75
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   285
            Left            =   7860
            TabIndex        =   28
            Tag             =   "DCPLLI_Code"
            Text            =   "DCPLLI_Code"
            Top             =   1275
            Width           =   1245
         End
         Begin Project1.ArmCombobox cbo_country 
            Height          =   345
            Left            =   1305
            TabIndex        =   21
            Tag             =   "CT_Code"
            Top             =   645
            Width           =   2490
            _ExtentX        =   4392
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_lineID 
            Height          =   345
            Left            =   1485
            TabIndex        =   19
            Tag             =   "DCPLL_Code"
            Top             =   225
            Width           =   5010
            _ExtentX        =   8837
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_DCPLLI_CURR 
            Height          =   345
            Left            =   6420
            TabIndex        =   62
            Tag             =   "DCPLLI_CURR_Code"
            Top             =   1620
            Width           =   1335
            _ExtentX        =   2355
            _ExtentY        =   609
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Currency"
            Height          =   270
            Index           =   17
            Left            =   5250
            TabIndex        =   63
            Tag             =   "lbl_currency"
            Top             =   1710
            Width           =   1155
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Formula"
            Height          =   270
            Index           =   23
            Left            =   135
            TabIndex        =   57
            Tag             =   "lbl_priceFormula"
            Top             =   1725
            Width           =   885
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Price list Line"
            Height          =   270
            Index           =   20
            Left            =   195
            TabIndex        =   51
            Tag             =   "lbl_listLine"
            Top             =   300
            Width           =   1035
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Country"
            Height          =   270
            Index           =   10
            Left            =   210
            TabIndex        =   41
            Tag             =   "lbl_country"
            Top             =   705
            Width           =   1035
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Zip/DC code"
            Height          =   270
            Index           =   11
            Left            =   3855
            TabIndex        =   40
            Tag             =   "lbl_zip"
            Top             =   720
            Width           =   1275
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Lead time (HH:MM)"
            Height          =   270
            Index           =   12
            Left            =   6630
            TabIndex        =   39
            Tag             =   "lbl_leadTime"
            Top             =   720
            Width           =   1470
         End
         Begin VB.Label lbl_labels 
            Alignment       =   1  'Right Justify
            Caption         =   "Qty min"
            Height          =   270
            Index           =   13
            Left            =   1965
            TabIndex        =   38
            Tag             =   "lbl_qtyMin"
            Top             =   1320
            Width           =   825
         End
         Begin VB.Label lbl_labels 
            Alignment       =   1  'Right Justify
            Caption         =   "Qty max"
            Height          =   270
            Index           =   14
            Left            =   3705
            TabIndex        =   37
            Tag             =   "lbl_qtyMax"
            Top             =   1320
            Width           =   570
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Price"
            Height          =   270
            Index           =   15
            Left            =   180
            TabIndex        =   36
            Tag             =   "lbl_price"
            Top             =   1320
            Width           =   900
         End
         Begin VB.Label lbl_labels 
            Caption         =   "line ID"
            Height          =   255
            Index           =   18
            Left            =   7005
            TabIndex        =   35
            Tag             =   "lbl_lineID"
            Top             =   315
            Width           =   810
         End
         Begin VB.Label lbl_labels 
            Caption         =   "Price ID"
            Height          =   255
            Index           =   19
            Left            =   7035
            TabIndex        =   34
            Tag             =   "lbl_priceID"
            Top             =   1335
            Width           =   810
         End
         Begin VB.Line Line1 
            BorderWidth     =   2
            X1              =   210
            X2              =   9030
            Y1              =   1095
            Y2              =   1080
         End
      End
      Begin Project1.ToolbarControl tlb_item 
         Height          =   690
         Left            =   165
         TabIndex        =   18
         Top             =   2235
         Width           =   6075
         _ExtentX        =   10716
         _ExtentY        =   1217
      End
      Begin Project1.A_calocx cal_validityStart 
         Height          =   345
         Left            =   1350
         TabIndex        =   14
         Tag             =   "Validity_Start"
         Top             =   1050
         Width           =   1830
         _ExtentX        =   3228
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_DC 
         Height          =   345
         Left            =   1710
         TabIndex        =   7
         Tag             =   "DC_Code"
         Top             =   210
         Width           =   2790
         _ExtentX        =   4921
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_Carrier 
         Height          =   345
         Left            =   5790
         TabIndex        =   8
         Tag             =   "CARRIER_Code"
         Top             =   210
         Width           =   1800
         _ExtentX        =   3175
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_currency 
         Height          =   345
         Left            =   1350
         TabIndex        =   11
         Tag             =   "CURR_Code"
         Top             =   615
         Width           =   3165
         _ExtentX        =   5583
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_UOM 
         Height          =   345
         Left            =   9420
         TabIndex        =   9
         Tag             =   "UOM_Code"
         Top             =   210
         Width           =   1065
         _ExtentX        =   1879
         _ExtentY        =   609
      End
      Begin Project1.A_calocx cal_validityEnd 
         Height          =   345
         Left            =   3885
         TabIndex        =   15
         Tag             =   "Validity_End"
         Top             =   1050
         Width           =   1830
         _ExtentX        =   3228
         _ExtentY        =   609
      End
      Begin Project1.ArmGrid grd_lines 
         Height          =   1035
         Left            =   180
         TabIndex        =   17
         Tag             =   "grd_lines"
         Top             =   1560
         Width           =   12225
         _ExtentX        =   21564
         _ExtentY        =   1826
      End
      Begin Project1.ArmCombobox cbo_TT_Code 
         Height          =   345
         Left            =   6900
         TabIndex        =   16
         Tag             =   "TT_Code"
         Top             =   1050
         Width           =   2925
         _ExtentX        =   5159
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_fullTruckCalculation 
         Height          =   345
         Left            =   9345
         TabIndex        =   13
         Tag             =   "FullTruckCalculation"
         Top             =   615
         Width           =   2925
         _ExtentX        =   5159
         _ExtentY        =   609
      End
      Begin VB.Label lbl_labels 
         Alignment       =   1  'Right Justify
         Caption         =   "Full truck calculation"
         Height          =   270
         Index           =   22
         Left            =   7050
         TabIndex        =   56
         Tag             =   "lbl_fullTruckCalc"
         Top             =   675
         Width           =   1965
      End
      Begin VB.Label lbl_labels 
         Caption         =   "ID"
         Height          =   255
         Index           =   27
         Left            =   10650
         TabIndex        =   50
         Tag             =   "lbl_ID"
         Top             =   225
         Width           =   330
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Carrier"
         Height          =   270
         Index           =   3
         Left            =   4635
         TabIndex        =   49
         Tag             =   "lbl_carrier"
         Top             =   255
         Width           =   870
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Distribution center"
         Height          =   270
         Index           =   4
         Left            =   90
         TabIndex        =   48
         Tag             =   "lbl_distrCentre"
         Top             =   255
         Width           =   1515
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Currency"
         Height          =   270
         Index           =   5
         Left            =   90
         TabIndex        =   47
         Tag             =   "lbl_currency"
         Top             =   675
         Width           =   1170
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Unit of measure"
         Height          =   270
         Index           =   6
         Left            =   7800
         TabIndex        =   46
         Tag             =   "lbl_UOM"
         Top             =   255
         Width           =   1515
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Validity from"
         Height          =   270
         Index           =   7
         Left            =   90
         TabIndex        =   45
         Tag             =   "lbl_validFrom"
         Top             =   1110
         Width           =   1215
      End
      Begin VB.Label lbl_labels 
         Caption         =   "to"
         Height          =   270
         Index           =   8
         Left            =   3300
         TabIndex        =   44
         Tag             =   "lbl_validTo"
         Top             =   1110
         Width           =   510
      End
      Begin VB.Label lbl_labels 
         Alignment       =   1  'Right Justify
         Caption         =   "Drop off cost"
         Height          =   270
         Index           =   9
         Left            =   4875
         TabIndex        =   43
         Tag             =   "lbl_dropOffCost"
         Top             =   675
         Width           =   1155
      End
      Begin VB.Label lbl_labels 
         Alignment       =   1  'Right Justify
         Caption         =   "Valid for:"
         Height          =   270
         Index           =   16
         Left            =   5910
         TabIndex        =   42
         Tag             =   "lbl_validFor"
         Top             =   1125
         Width           =   765
      End
   End
   Begin Project1.A_calocx cal_fReferenceDate 
      Height          =   300
      Left            =   9375
      TabIndex        =   3
      Top             =   375
      Width           =   1860
      _ExtentX        =   3466
      _ExtentY        =   529
   End
   Begin VB.Frame frm_filters 
      Height          =   600
      Left            =   60
      TabIndex        =   27
      Top             =   885
      Width           =   16020
      Begin VB.CheckBox chk_active 
         Caption         =   "Active price lists only"
         Height          =   240
         Left            =   10695
         TabIndex        =   4
         Tag             =   "chk_active"
         Top             =   225
         Width           =   1845
      End
      Begin Project1.ArmCombobox cbo_fDC 
         Height          =   345
         Left            =   1755
         TabIndex        =   1
         Top             =   180
         Width           =   2100
         _ExtentX        =   3704
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_fCarrier 
         Height          =   345
         Left            =   5100
         TabIndex        =   2
         Top             =   180
         Width           =   2085
         _ExtentX        =   3678
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_fTT_Code 
         Height          =   345
         Left            =   13800
         TabIndex        =   5
         Top             =   180
         Width           =   2085
         _ExtentX        =   3678
         _ExtentY        =   609
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Valid for"
         Height          =   270
         Index           =   21
         Left            =   12855
         TabIndex        =   55
         Tag             =   "lbl_validFor"
         Top             =   240
         Width           =   870
      End
      Begin VB.Label lbl_labels 
         Alignment       =   1  'Right Justify
         Caption         =   "Reference date:"
         Height          =   270
         Index           =   2
         Left            =   7230
         TabIndex        =   31
         Tag             =   "lbl_refDate"
         Top             =   240
         Width           =   1395
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Carrier"
         Height          =   270
         Index           =   1
         Left            =   4155
         TabIndex        =   30
         Tag             =   "lbl_carrier"
         Top             =   240
         Width           =   870
      End
      Begin VB.Label lbl_labels 
         Caption         =   "Distribution center"
         Height          =   270
         Index           =   0
         Left            =   120
         TabIndex        =   29
         Tag             =   "lbl_distrCentre"
         Top             =   240
         Width           =   1515
      End
   End
   Begin Project1.ToolbarControl tlb_main 
      Height          =   690
      Left            =   135
      TabIndex        =   0
      Top             =   90
      Width           =   14835
      _ExtentX        =   26167
      _ExtentY        =   1217
   End
   Begin Project1.ArmGrid grd_lst 
      Height          =   3510
      Left            =   30
      TabIndex        =   6
      Tag             =   "grd_lst"
      Top             =   1590
      Width           =   15180
      _ExtentX        =   26776
      _ExtentY        =   6191
   End
   Begin MSComDlg.CommonDialog dlg_fileopen 
      Left            =   15735
      Top             =   5685
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "DC_PriceList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long

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

Private Const C_TOOLBARFACE_ITEM_LST As String = "0"
Private Const C_TOOLBARFACE_ITEM_UPD As String = "1"
Private Const C_TOOLBARFACE_ITEM_ADD As String = "2"
Private Const C_TOOLBARFACE_ITEM_DELETE As String = "3"
Private Const C_TOOLBARFACE_ITEM_VIEW As String = "4"


Private Const C_TOOLBARFACE_LINE_LST As String = "0"
Private Const C_TOOLBARFACE_LINE_UPD As String = "1"
Private Const C_TOOLBARFACE_LINE_DEL As String = "2"
Private Const C_TOOLBARFACE_LINE_LST2 As String = "3"

Private Const C_LEADING_INTRECO_TRAN As Long = 0

Private Const C_DCS_CODE_IDX As Long = 0
Private Const C_DCS_DESC_IDX As Long = 1
Private Const C_DCS_PRICE_IDX As Long = 2
Private Const C_DCS_FORMULA_IDX As Long = 3
Private Const C_DCS_DEFAULT_IDX As Long = 4
Private Const C_DCS_LINKED_IDX As Long = 5
Private Const C_DCS_ACTION_IDX As Long = 6

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

Private p_DefaultValues(MAX_VALUE) As DefaultValue
Private p_DefaultValuesCount As Integer
Private p_DefaultValuesLoaded As Boolean

Private mb_eventRunning As Boolean
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
    hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
Const EM_LINEFROMCHAR = &HC9

' HEADER ROWS
Private Const C_PARAMS_ROW As Long = 1
Private Const C_FLAG_ROW As Long = 2
Private Const C_FORMULA_ROW As Long = 3
Private Const C_QUANTITY_ROW As Long = 5

' HEADER COLUMNS
Private Const C_DC_CODE_COL As Long = 1
Private Const C_CURR_CODE_COL As Long = 2
Private Const C_CARRIER_CODE_COL As Long = 5
Private Const C_VALIDITY_START_COL As Long = 13
Private Const C_VALIDITY_END_COL As Long = 17
Private Const C_TT_CODE_COL As Long = 20
Private Const C_DROP_OFF_COL As Long = 25
Private Const C_FULL_TRUCK_CALC_COL As Long = 26
Private Const C_UOM_CODE_COL As Long = 28

' DATA COLUMNS
Private Const C_CT_CODE_COL As Long = 1
Private Const C_POST_CODE_COL As Long = 2
Private Const C_LEAD_TIME_COL As Long = 4
Private Const C_DATA_COL As Long = 5


Private mb_Initialized As Boolean
Private ms_inTranName As String
Private ms_reconnectServer As String
Private ms_reconnectDB As String
Private ms_reconnectUser As String
Private ms_reconnectPassword As String
Private ms_reconnectApp As String

Dim ms_MsgInfo As Variant

Private mo_ChargesDlg As DC_PriceListLineSurchargeDetail

#If LIVE = 1 Then
    Dim mo_Db As Object
    Dim mo_scriptObj As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
    Dim mo_scriptObj As MSScriptControl.ScriptControl       ' to calculate the price list formula
#End If

Private ms_Language_Code As String
Dim mu_ActiveMode As ArmScreenMode
Dim mu_ActiveLineMode As ArmScreenMode

Private ml_U_Code As Long
Private ms_LoginName As String
Private ml_iConcurrency As Long
Private mb_haveRights As Boolean
Private ml_TenderCarrier As Long

Const QTY_FOR_TRANSPORT As Boolean = True
Const QTY_FOR_COST As Boolean = False

Private Type tDCSurcharge_cost
    DCS_Code As String
    DCS_quantity As Double
    DCS_Price As Double
    SurchargeFormula As String
End Type

Private Type tDCTransport_cost
    TRANS_Code As Long
    UOM_Code As String
    Quantity As Double
    Quantity_loaded As Double
'    DCS_quantity As Double
    DCPL_Code As Long
    DCPLLI_code As Long
    DCPLLI_Price As Double
    DCPLLI_CURR_Code As String
'    DCS_Price As Double
    Manual_Cost As Double
    Surcharge_Cost As Double
    DCPLL_Full_Truck_Price As Double
    DCPLL_Full_Truck_Min As Double
    DCPLL_Full_Truck_Max As Double
    DCPLL_Trailer_min As Double
  
    PriceFormula As String
    FullTruckPriceFormula As String
'    SurchargeFormula As String
    
    SurchargeInfo() As tDCSurcharge_cost
End Type

Private Type tChargesLocal
    DCS_Code As String
    DCS_Desc As String
    DCS_Price As Double
    DCS_Formula As String
    DCS_Default As String           ' X=true
    DCS_LinkedTrans As Long
    action As String
End Type

Dim mb_chargesLocalOnly As Boolean                                 ' indicate that all charges for item are in moa_ChargesLocal
Dim moa_ChargesLocal As New Scripting.Dictionary

Dim moa_DCTransport_cost() As tDCTransport_cost

Public Event quit()
Private Enum ArmScreenMode
  smNone
  smMain
  smAdd
  smUpdate
  smDelete
  smView
End Enum

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("LockScreen")
End Sub

Public Sub SetReconnectParams(ByVal as_Server As String, ByVal as_Db As String, ByVal as_User As String, ByVal as_Password As String, ByVal as_App As String)
On Error GoTo ErrHandler
    ms_reconnectServer = as_Server
    ms_reconnectDB = as_Db
    ms_reconnectUser = as_User
    ms_reconnectPassword = as_Password
    ms_reconnectApp = as_App
    Exit Sub
ErrHandler:
    Call ErrorMessage("SetReconnectParams")
End Sub

Public Property Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property


Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property

Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
    Call Resize
End Sub

Property Let Language_Code(AString As String)
On Error GoTo ErrHandler

  ms_Language_Code = AString
  Exit Property
ErrHandler:
  Call ErrorMessage("Language_Code.Let")
End Property

Property Let U_Code(ByVal al_U_Code As Long)
On Error GoTo ErrHandler

  ml_U_Code = al_U_Code
  Exit Property
ErrHandler:
  Call ErrorMessage("U_Code.Let")
End Property

Public Property Let LoginName(ByVal as_loginName As String)
On Error GoTo ErrHandler
    
    ms_LoginName = as_loginName
    Exit Property
ErrHandler:
    Call ErrorMessage(Extender.Name & ".LoginName(Let)")
End Property

Public Property Set ArmDb(ByRef lo_Db As Object)
On Error GoTo ErrHandler
  
  Set mo_Db = lo_Db
  Exit Property
ErrHandler:
  Call ErrorHandler("ArmDb.Set")
End Property

Public Property Let TenderCarrier(ByVal al_TenderCarrier As Long)
On Error GoTo ErrHandler

    ml_TenderCarrier = al_TenderCarrier
    Exit Property
ErrHandler:
  Call ErrorHandler("TenderCarrier.Let")
End Property


Private Function EncodeChargesLocal(ByRef ao_charges As tChargesLocal) As Variant
On Error GoTo ErrHandler
    EncodeChargesLocal = Array(ao_charges.DCS_Code, ao_charges.DCS_Desc, ao_charges.DCS_Formula, ao_charges.DCS_Price, ao_charges.DCS_Default, ao_charges.DCS_LinkedTrans, ao_charges.action)
    Exit Function
ErrHandler:
  Call ErrorHandler("EncodeChargesLocal")
End Function

Private Sub DecodeChargesLocal(ByRef ao_variant As Variant, ByRef ao_charges As tChargesLocal)
On Error GoTo ErrHandler
    Debug.Assert (IsArray(ao_variant))
    Debug.Assert (UBound(ao_variant) = 6)
    
    ao_charges.DCS_Code = ao_variant(0)
    ao_charges.DCS_Desc = ao_variant(1)
    ao_charges.DCS_Formula = ao_variant(2)
    ao_charges.DCS_Price = ao_variant(3)
    ao_charges.DCS_Default = ao_variant(4)
    ao_charges.DCS_LinkedTrans = ao_variant(5)
    ao_charges.action = ao_variant(6)
    
    Exit Sub
ErrHandler:
  Call ErrorHandler("DecodeChargesLocal")
End Sub

Public Sub Load_A_COM()
    
On Error GoTo ErrHandler

    If mb_Initialized Then Exit Sub
    
    mb_Initialized = True
    
    mb_eventRunning = True
    
    ms_inTranName = ""
    
    p_DefaultValuesLoaded = False
    
    Dim lo_Control As Object
    Dim lo_ToolTip As Object
    
      For Each lo_Control In 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
        Case "TOOLBARCONTROL"
          lo_Control.Language = ms_Language_Code
'          Set lo_Control.ArmDb = mo_Db
          Call 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
        Case "TOOLBR"
          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_COM
        End Select
      Next
    
    dlg_fileopen.Filter = "2005 Excell files (*.xlsx)|*.xlsx|Excell files (*.xls)|*.xls"

#If LIVE = 1 Then
    Set mo_scriptObj = CreateObject("MSScriptControl.ScriptControl")
#Else
    Set mo_scriptObj = New MSScriptControl.ScriptControl
#End If

    mo_scriptObj.Language = "VBScript"
    
    If Not mo_Db.IsConnected Then
        Call ReconnectSafe
    End If
    
    mb_haveRights = HaveRight("DC_PLUSER")
    
    ' init toolbar
'336EESFGIDRW®05858®QE/BAC®CVVDGGEFFJTT
    Call tlb_Main.SetToolbarInfoStringParameters("001EESFGIDRW®011708®QE/BAC®AAABBBCCCHLLJGGLXXTTT®111708®QE/BAC®AHHBIITTT®211708®QE/BAC®AHHBIITTT®311708®QE/BAC®AHHTTT®411708®QE/BAC®BBBCCCFJJGKKLXXTTT", "001")
'    Call tlb_main.SetToolbarInfoStringParameters("001EESFGIDRW®011708®QE/BAC®AAABBBCCCHLLJGGTTT®111708®QE/BAC®AHHBIITTT®211708®QE/BAC®AHHBIITTT®311708®QE/BAC®AHHTTT®411708®QE/BAC®BBBCCCFJJGKKTTT", "001")
    
    ' init checkview
    ckv_surcharges.Driven_By = "Price list line"
    ckv_surcharges.Common_List_Load = True
    ckv_surcharges.ComboVisible = False
    ckv_surcharges.Type_Of_Key = tkDependant
    ckv_surcharges.Calling_Key_Fields = "DCPLL_Code"
    ckv_surcharges.Tag = "DCPLL_Code"
    ckv_surcharges.Link_Key_Fields = "DCS_Code"
    
    ckv_surcharges.RoleCount = 2
    ckv_surcharges.Synchronize_View = True
    ckv_surcharges.HideColumnHeaders = False
    ckv_surcharges.LoadConstants CVptStatic, "DCS_Desc" & CH_LDELIMIT & "Surcharge" & CH_LDELIMIT & "DCS_Price" & CH_LDELIMIT & "Price" & CH_LDELIMIT & "DCS_Formula" & CH_LDELIMIT & "Formula" & CH_LDELIMIT & "DCS_Default" & CH_LDELIMIT & "Default", CVctColumns
    
    mb_chargesLocalOnly = False
    
    ' init grig
    grd_lst.AllowExcelExport = True
    grd_lst.Title = "Price List listing"
    grd_lst.MultiSelect = False
    
    
    If Not grd_lst.SetColumns(Array( _
                Join(Array("DCPL_Code", 0, 1, "DCPL_Code", "#"), SEP) _
                , Join(Array("PL_CHECK", 250, 0, "PL_CHECK", "Check", "BITMAP"), SEP) _
                , Join(Array("DCPL_Name", 3300, 0, "DCPL_Name", "#Price list desc", "String"), SEP) _
                , Join(Array("DC_Code", 0, 0, "DC_Code", "DC_Code"), SEP) _
                , Join(Array("DC_Desc", 2200, 0, "DC_Desc", "#DC_Desc"), SEP) _
                , Join(Array("CARRIER_Code", 0, 0, "CARRIER_Code", "CARRIER_Code"), SEP) _
                , Join(Array("CARRIER_Name", 2200, 0, "CARRIER_Name", "#CARRIER_Name"), SEP) _
                , Join(Array("UOM_Code", 700, 0, "UOM_Code", "UOM_Code"), SEP) _
                , Join(Array("CURR_code", 0, 0, "CURR_code", "CURR_code", "String"), SEP) _
                , Join(Array("CURR_Desc", 1100, 0, "CURR_Desc", "#CURR_Desc", "String"), SEP) _
                , Join(Array("TT_Code", 800, 0, "TT_Code", "#Valid for", "String"), SEP) _
                , Join(Array("DropOff_Cost", 900, 0, "DropOff_Cost", "#Drop off cost", "FLOAT", "###0.00"), SEP) _
                , Join(Array("FullTruckCalculation", 900, 0, "FullTruckCalculation", "#Full truck calc.", "String"), SEP) _
                , Join(Array("Validity_Start", 1400, 0, "Validity_Start", "#Validity_Start", "Date"), SEP) _
                , Join(Array("Validity_End", 1400, 0, "Validity_End", "#Validity_End", "Date"), SEP) _
                , Join(Array("iConcurrency", 0, 0, "iConcurrency", "iConcurrency", "INT"), SEP) _
                )) Then
        MsgBox ("Grid not initialized!")
    End If
    
    cbo_fDC.FirstBlankItem = False
    cbo_fDC.Request = "EXEC DC_cbo2 " & SqlStr(ms_Language_Code, 1)
    cbo_fDC.Load
    
    cbo_fCarrier.FirstBlankItem = True
    
    cbo_fTT_Code.FirstBlankItem = True
    Call cbo_fTT_Code.AddItem(Array("", ""))
'    Call cbo_fTT_Code.AddItem(Array("T", "Container shippment"))
    Call cbo_fTT_Code.AddItem(Array("C", "Customer shippment"))
    Call cbo_fTT_Code.AddItem(Array("I", "Intercompany shippment"))
    Call cbo_fTT_Code.AddItem(Array("R", "Reciepts"))
    
    
    cbo_fullTruckCalculation.FirstBlankItem = False
    Call cbo_fullTruckCalculation.AddItem(Array("Y", "Yes"))
    Call cbo_fullTruckCalculation.AddItem(Array("N", "No"))
    
    cbo_TT_Code.FirstBlankItem = False
'    Call cbo_TT_Code.AddItem(Array("T", "Container shippment"))
    Call cbo_TT_Code.AddItem(Array("C", "Customer shippment"))
    Call cbo_TT_Code.AddItem(Array("I", "Intercompany shippment"))
    Call cbo_TT_Code.AddItem(Array("R", "Reciepts"))
    
    cal_fReferenceDate.opening_toward_top = 1
    cal_validityStart.opening_toward_top = 1
    cal_validityEnd.opening_toward_top = 1
    
    cal_fReferenceDate.date_courte = Format(Now(), "dd\/mm\/yyyy")
    chk_active.Value = vbChecked

    cbo_DC.FirstBlankItem = False
    cbo_DC.Request = "EXEC DC_cbo2 " & SqlStr(ms_Language_Code, 1)
    
    cbo_carrier.FirstBlankItem = False
    
    cbo_currency.FirstBlankItem = False
    cbo_currency.Request = "EXEC currencies_cbo " & SqlStr(ms_Language_Code, 1)
    
    cbo_DCPLLI_CURR.FirstBlankItem = False
    cbo_DCPLLI_CURR.Request = "SELECT CURR_code, CURR_code AS CURR_Desc FROM currencies WHERE drop_date is null AND language_code = " & SqlStr(ms_Language_Code, 1) & " ORDER BY 1"
    
    cbo_UOM.FirstBlankItem = False
    cbo_UOM.Request = "EXEC DC_UOM_cbo2"
    
    Call tlb_item.SetToolbarInfoStringParameters("001EESFGIDRW®05858®QE/BAC®AAABBBCCCEJJFKKHFF®15858®QE/BAC®AHHBIIJTT®25858®QE/BAC®AHHJTT®35858®QE/BAC®EJJFKKHFF", "001")
    
    grd_lines.AllowExcelExport = True
    grd_lines.Title = "Price List Items listing"
    grd_lines.MultiSelect = False
    
    If Not grd_lines.SetColumns(Array( _
                Join(Array("DCPLL_Code", 0, 1, "DCPLL_Code", "#", "STRING"), SEP) _
                , Join(Array("DCPLLI_Code", 0, 1, "DCPLLI_Code", "#", "STRING"), SEP) _
                , Join(Array("PL_CHECK", 250, 0, "PL_CHECK", "Check", "BITMAP"), SEP) _
                , Join(Array("CT_Code", 0, 0, "CT_Code", "CT_Code", "String"), SEP) _
                , Join(Array("CT_Desc", 1200, 0, "CT_Desc", "#CT_Desc", "String"), SEP) _
                , Join(Array("DCPLL_Zip_Code", 1000, 0, "DCPLL_Zip_Code", "DCPLL_Zip_Code", "String"), SEP) _
                , Join(Array("DCPLLI_Qty_min", 800, 0, "DCPLLI_Qty_min", "#DCPLLI_Qty_min", "FLOAT"), SEP) _
                , Join(Array("DCPLLI_Qty_max", 800, 0, "DCPLLI_Qty_max", "#DCPLLI_Qty_max", "FLOAT"), SEP) _
                , Join(Array("DCPLLI_Price", 1200, 0, "DCPLLI_Price", "#DCPLLI_Price", "FLOAT", "###0.00"), SEP) _
                , Join(Array("DCPLLI_CURR_Code", 650, 0, "CURR_Code", "#DCPLLI_CURR_Code", "String"), SEP) _
                , Join(Array("IsReturn", 1200, 0, "IsReturn", "#IsReturn", "String"), SEP) _
                , Join(Array("DCPLL_LeadTime", 1400, 0, "DCPLL_LeadTime", "#DCPLL_LeadTime", "String"), SEP) _
                , Join(Array("PriceFormula", 2120, 0, "PriceFormula", "#Price calulation formula", "String"), SEP) _
                , Join(Array("IsTrailer", 900, 0, "IsTrailer", "#Trailer", "String"), SEP) _
                , Join(Array("iConcurrency", 0, 0, "iConcurrency", "iConcurrency", "INT"), SEP) _
                , Join(Array("Action", 0, 0, "", "Action", "String"), SEP) _
                )) Then
        MsgBox ("Lines Grid not initialized!")
    End If
    
    
    cbo_country.FirstBlankItem = False
    cbo_country.Request = "EXEC countries_cbo " & SqlStr(ms_Language_Code, 1)
    
    cbo_lineID.FirstBlankItem = True
    cbo_lineID.Request = ""
    
    
    Call LoadLabels(UserControl.Controls, SCREEN_NAME, ms_Language_Code)
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    
    chk_isReturn.Tag = "IsReturn"
    chk_isTrailer.Tag = "IsTrailer"
    
    Call UpdateUI(ArmScreenMode.smMain, ArmScreenMode.smMain)
    
    Call ResetFilters

    mb_eventRunning = False

    If GetCboKey(cbo_fDC) = "" Then
        Call cbo_fDC.SearchItem("P510")     ' pontalier
    Else
        Call cbo_fDC_ComboItemSelected
    End If
    
    Exit Sub
    
ErrHandler:
    
    Call ErrorHandler("Load_A_COM")
    
End Sub


Private Function ItemLine_LoadSurcharges(ByVal al_DCPLL_Code As Long, ByVal as_CARRIER_Code As String, ByVal as_CT_Code As String, ByVal as_ZIP As String) As Boolean
On Error GoTo ErrHandler
    ItemLine_LoadSurcharges = False
    
    ckv_surcharges.Visible = False
    ckv_surcharges.Calling_Key_Values = al_DCPLL_Code
    
    If ckv_surcharges.GetVisibleList() = "" Then

      Dim la_Main As Variant
      Dim la_Linked As Variant
      
      la_Main = Array("MAIN", "VIEW", "", "", "Main view", "DCS_Code®©DCS_Desc®©DCS_Price®©DCS_Formula®©DCS_Default", "DCS_Desc®©DCS_Price®©DCS_Formula®©DCS_Default", "1900®©600®©500®©550®©300", "DCS_Code", "EXEC DC_PriceListLineSurcharge_lst $DCPLL_Code$,'" & ms_Language_Code & "'", "", "", True, 2, False, False, 0, 0)
      la_Linked = Array("CHARGES", "EDIT", "CARRIER_Code", as_CARRIER_Code, "Charges", "DCS_Code®©DCS_Desc®©DCS_Price®©DCS_Formula®©DCS_Default®©linkedCount®©Action", "DCS_Desc®©DCS_Price®©DCS_Formula®©DCS_Default", "1900®©600®©500®©550®©300", "DCS_Code", "EXEC DC_PriceListLineSurcharge_lst2 '$CARRIER_Code$', $DCPLL_Code$,'" & ms_Language_Code & "'", "", "", False, 2, False, True, 1, 0)
    
      If Not ckv_surcharges.SetRoleList(Array(la_Main, la_Linked)) Then
          Call ASC_SendMessage(mo_Db, ms_Language_Code, 932, "#Critical error, please contact it")
          End
      End If
    Else
        Call ckv_surcharges.Init
        ckv_surcharges.RoleList("CHARGES").CommonRoleValues = GetVariantArray(as_CARRIER_Code)
        
        Call ckv_surcharges.LoadEditLists
    End If
    
    If mb_chargesLocalOnly Then
        ' do not load list from database
        Call ckv_surcharges.Init                ' all items are set with originalychecked = false; we will delete them in updatedb
    Else
        Call ckv_surcharges.LoadList
    End If
    
    ' apply local changes
    Dim ll_i As Long
    Dim ls_Key As String
    For ll_i = 1 To ckv_surcharges.RoleList("CHARGES").Count
    
        Dim lo_Info As ArmItemInfo
        Set lo_Info = ckv_surcharges.RoleList("CHARGES").Items(ll_i)
        
        ls_Key = as_CT_Code & SEP & as_ZIP & SEP & lo_Info.GetData(C_DCS_CODE_IDX)
        If moa_ChargesLocal.Exists(ls_Key) Then
            ' item was locally updated
            Dim lo_charge As tChargesLocal
            Call DecodeChargesLocal(moa_ChargesLocal.Item(ls_Key), lo_charge)
            
            ' update surges rolelist items
            Call lo_Info.SetData(C_DCS_PRICE_IDX, lo_charge.DCS_Price)
            Call lo_Info.SetData(C_DCS_FORMULA_IDX, lo_charge.DCS_Formula)
            Call lo_Info.SetData(C_DCS_DEFAULT_IDX, lo_charge.DCS_Default)
            
            Select Case lo_charge.action
                Case "A"
                    Call ckv_surcharges.SetItemState("CHARGES", ckv_surcharges.RoleList("CHARGES").GetKey(ll_i), True)
                Case "D"
                    Call ckv_surcharges.SetItemState("CHARGES", ckv_surcharges.RoleList("CHARGES").GetKey(ll_i), False)
            End Select
            
            ' update main rolelist items
            Set lo_Info = ckv_surcharges.RoleList("MAIN").GetItem(lo_Info.CheckList.GetItemKey(lo_Info))
            Debug.Assert (Not lo_Info Is Nothing)
            Call lo_Info.SetData(C_DCS_PRICE_IDX, lo_charge.DCS_Price)
            Call lo_Info.SetData(C_DCS_FORMULA_IDX, lo_charge.DCS_Formula)
            Call lo_Info.SetData(C_DCS_DEFAULT_IDX, lo_charge.DCS_Default)

            ItemLine_LoadSurcharges = True
        End If
    Next
    
    ckv_surcharges.Visible = True

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

Private Sub ResetFilters()


    cal_fReferenceDate.date_courte = Format(Now, "dd\/mm\/yyyy")
    chk_active.Value = vbChecked
    
    Call cbo_fCarrier.Clear
    
    Call DisplayDefaultValues
    
    If GetCboKey(cbo_fDC) = "" Then
        Call cbo_fDC.SearchItem("P510")     ' pontalier
    End If
    
End Sub

Private Sub UpdateLineUI(ByVal au_LineMode As ArmScreenMode)
On Error GoTo ErrHandler
    mu_ActiveLineMode = au_LineMode
    tlb_item.Redraw = False
    frm_listDetail.Visible = False

    Select Case mu_ActiveLineMode
        Case smNone
            grd_lines.Visible = False
            tlb_item.Visible = False
        Case smMain
            Call EnableControl(grd_lines, True)
            Call EnableControl(tlb_Main, True)
            Call SetEnabled(GetContainedControlsChain(frm_listDetail), False)
    
            Call EnableControl(ckv_surcharges, True)
            Call ckv_surcharges.SetVisibleList("MAIN")
            
            Call tlb_item.DisplayFace(IIf(mu_ActiveMode = smAdd Or mu_ActiveMode = smUpdate, C_TOOLBARFACE_LINE_LST, C_TOOLBARFACE_LINE_LST2))
            
            grd_lines.Visible = True
            tlb_item.Visible = True
        Case smUpdate
            ' we are in Update section
            Call EnableControl(grd_lines, False)
            Call EnableControl(tlb_Main, False)
            Call SetEnabled(GetContainedControlsChain(frm_listDetail), True)
            Call EnableControl(txt_lineID, False)
            Call EnableControl(txt_itemID, False)
            
            Call EnableControl(cbo_lineID, False)
            Call EnableControl(cbo_country, False)
            Call EnableControl(txt_zipCode, False)
            
            Call ckv_surcharges.SetVisibleList("CHARGES")
            
            Call tlb_item.DisplayFace(C_TOOLBARFACE_LINE_UPD)
        
            frm_listDetail.Visible = True
            grd_lines.Visible = True
            tlb_item.Visible = True
        Case smAdd
            ' we are in Update section
            Call EnableControl(grd_lines, False)
            Call EnableControl(tlb_Main, False)
            Call SetEnabled(GetContainedControlsChain(frm_listDetail), True)
            Call EnableControl(txt_lineID, False)
            Call EnableControl(txt_itemID, False)
            
            Call EnableControl(cbo_lineID, True)
            Call EnableControl(cbo_country, True)
            Call EnableControl(txt_zipCode, True)
            
            Call ckv_surcharges.SetVisibleList("CHARGES")
            
            Call tlb_item.DisplayFace(C_TOOLBARFACE_LINE_UPD)
            
            grd_lines.Visible = True
            tlb_item.Visible = True
            frm_listDetail.Visible = True
       Case smView
            ' we are in PreView section
            Call EnableControl(tlb_Main, True)
            Call EnableControl(grd_lines, True)
            Call SetEnabled(GetContainedControlsChain(frm_listDetail), False)
            
            Call EnableControl(ckv_surcharges, True)
            Call ckv_surcharges.SetVisibleList("MAIN")
            
            Call tlb_item.DisplayFace(IIf(mu_ActiveMode = smAdd Or mu_ActiveMode = smUpdate, C_TOOLBARFACE_LINE_LST, C_TOOLBARFACE_LINE_LST2))
            
            frm_listDetail.Visible = True
            grd_lines.Visible = True
            tlb_item.Visible = True
            
        Case smDelete
            ' we are in PreView section
            Call EnableControl(tlb_Main, False)
            Call EnableControl(grd_lines, False)
            Call SetEnabled(GetContainedControlsChain(frm_listDetail), False)
            
            Call EnableControl(ckv_surcharges, True)
            Call ckv_surcharges.SetVisibleList("MAIN")
            
            Call tlb_item.DisplayFace(C_TOOLBARFACE_LINE_DEL)
            
            frm_listDetail.Visible = True
            grd_lines.Visible = True
            tlb_item.Visible = True
        Case Else
            Debug.Assert (False)
    End Select
    
    Call ApplyRights(tlb_item)
    ' to display face immidiatelly
    tlb_item.Redraw = True

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

Private Sub UpdateUI(ByVal au_Mode As ArmScreenMode, ByVal au_LineMode As ArmScreenMode)
On Error GoTo ErrHandler

    ' set active face
    mu_ActiveMode = au_Mode
    tlb_Main.Redraw = False
    

    ' apply face
    Dim lo_ctrl As Object

    ' hide all frames
    frm_detail.Visible = False
    grd_lst.Visible = False
    frm_filters.Visible = False
    cal_fReferenceDate.Visible = False

    ' we have clean screen we can display proper controls
    Select Case mu_ActiveMode
        Case smMain
            Call EnableControl(grd_lst, True)
            Call SetEnabled(GetContainedControlsChain(frm_filters), True)
            Call SetEnabled(GetContainedControlsChain(frm_detail), False)
    
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_LST)
            
            Call UpdateLineUI(smNone)
            
            grd_lst.Visible = True
            frm_filters.Visible = True
            cal_fReferenceDate.Visible = True
        Case smUpdate
            ' we are in Update section
            Call EnableControl(grd_lst, False)
            Call SetEnabled(GetContainedControlsChain(frm_filters), False)
            Call SetEnabled(GetContainedControlsChain(frm_detail), True)
            Call EnableControl(txt_recordID, False)
            Call EnableControl(cbo_DC, False)
            Call EnableControl(cbo_carrier, False)
            Call EnableControl(cbo_TT_Code, False)
            
            
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_UPD)
            
            Call UpdateLineUI(au_LineMode)
        
            frm_detail.Visible = True
        Case smAdd
            ' we are in Update section
            Call EnableControl(grd_lst, False)
            Call SetEnabled(GetContainedControlsChain(frm_filters), False)
            Call SetEnabled(GetContainedControlsChain(frm_detail), True)
            Call EnableControl(txt_recordID, False)
            
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_ADD)

            Call UpdateLineUI(au_LineMode)
            
            frm_detail.Visible = True
       Case smView
            ' we are in PreView section
            Call EnableControl(grd_lst, False)
            Call SetEnabled(GetContainedControlsChain(frm_filters), False)
            Call SetEnabled(GetContainedControlsChain(frm_detail), False)
            Call EnableControl(grd_lines, True)
            Call EnableControl(tlb_item, True)
            
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_VIEW)
            
            Call UpdateLineUI(au_LineMode)
            
            frm_detail.Visible = True
            
        Case smDelete
            ' we are in PreView section
            Call EnableControl(grd_lst, False)
            Call SetEnabled(GetContainedControlsChain(frm_filters), False)
            Call SetEnabled(GetContainedControlsChain(frm_detail), False)
            Call EnableControl(tlb_item, True)
            
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_DELETE)
            
            Call UpdateLineUI(au_LineMode)
            
            frm_detail.Visible = True
        Case Else
            Debug.Assert (False)
    End Select
    
    lbl_action.Caption = MainScreenDesc(mu_ActiveMode) & IIf(mu_ActiveLineMode = smMain Or mu_ActiveLineMode = smNone, "", " - " & DetailScreenDesc(mu_ActiveLineMode))
    
    Call ApplyRights(tlb_Main)
    ' to display face immidiatelly
    tlb_Main.Redraw = True
    UserControl.Refresh
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateUI()")
End Sub

Private Function MainScreenDesc(ByVal au_Mode As ArmScreenMode)
On Error GoTo ErrHandler

    MainScreenDesc = ""
    Select Case au_Mode
    
        Case ArmScreenMode.smMain
            MainScreenDesc = "Main screen"
        Case ArmScreenMode.smAdd
            MainScreenDesc = "Add Pricelist"
        Case ArmScreenMode.smUpdate
            MainScreenDesc = "Update pricelist"
        Case ArmScreenMode.smDelete
            MainScreenDesc = "Delete pricelist"
        Case ArmScreenMode.smView
            MainScreenDesc = "Show pricelist"
    End Select

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

Private Function DetailScreenDesc(ByVal au_Mode As ArmScreenMode)
On Error GoTo ErrHandler

    DetailScreenDesc = ""
    Select Case au_Mode
    
        Case ArmScreenMode.smMain
            DetailScreenDesc = "Main screen"
        Case ArmScreenMode.smAdd
            DetailScreenDesc = "Add Item"
        Case ArmScreenMode.smUpdate
            DetailScreenDesc = "Update Item"
        Case ArmScreenMode.smDelete
            DetailScreenDesc = "Delete Item"
        Case ArmScreenMode.smView
            DetailScreenDesc = "Show Item"
    End Select

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

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    Dim ls_Message As String
    
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    ls_Message = SCREEN_NAME & " exception. Nr:" & Err.Number & ",Desc: " & ls_errDescription & ",Src:" & ls_ErrSource & "@"
    Call LogMessage(ls_Message, "E")
    Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End
End Sub

' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, UserControl.Name & "." & UserControl.Ambient.DisplayName & "::" & as_Fct & SEP1 & Err.Source, Err.Description
End Sub

Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
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("GetDbError()")
End Function

' logs message to database
Private Sub LogMessage(ByVal as_LogMsg As String, Optional ByVal as_LogType As String = "E", Optional ab_ExitOnException As Boolean = False)
    Dim ll_errNumber As Long
    Dim ls_errDescription As String, ls_ErrSource As String
    
    ll_errNumber = Err.Number
    ls_errDescription = Err.Description
    ls_ErrSource = Err.Source

On Error GoTo ErrHandler

Const LOG_REQUEST As String = "EXEC A_log_ins $UCODE$,$LOGTYPE$,$MSG$,$APP$"
    Dim ls_req As String
    Dim ll_Cursor As Long
    Dim ls_Source As String, ls_Msg As String
    
    ls_Source = SCREEN_NAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    ls_Msg = as_LogMsg & SEP1 & ll_errNumber & " : " & ls_errDescription & " - " & ls_ErrSource
    
    ls_req = Replace(LOG_REQUEST, "$UCODE$", CStr(ml_U_Code))
    ls_req = Replace(ls_req, "$LOGTYPE$", SqlStr(as_LogType))
    ls_req = Replace(ls_req, "$MSG$", SqlStr(Trim(ls_Msg), 4000), , , vbTextCompare)
    ls_req = Replace(ls_req, "$APP$", SqlStr(Trim(ls_Source), 50), , , vbTextCompare)
    
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    Err.Number = ll_errNumber
    Err.Description = ls_errDescription
    Err.Source = ls_ErrSource
    Exit Sub
    
ErrHandler:
    If ab_ExitOnException Then
        Call MsgBox("A fatal error occured. Unable to log error into database, the application will be close. Please report the following message to your IT support: " & vbCrLf & _
            "Number:" & Err.Number & vbCrLf & "Description:" & Err.Description, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
        End
    End If
    Err.Number = ll_errNumber
    Err.Description = ls_errDescription
    Err.Source = ls_ErrSource
End Sub

Private Sub ApplyRights(ByRef ao_tlb As ToolbarControl)
On Error GoTo ErrHandler

    ao_tlb.ButtonVisible("A") = mb_haveRights
    ao_tlb.ButtonVisible("B") = mb_haveRights
    ao_tlb.ButtonVisible("C") = mb_haveRights
    ao_tlb.ButtonVisible("G") = mb_haveRights

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

Public Sub Unload_A_COM()
    
On Error GoTo ErrHandler
    mb_Initialized = False
    
    Dim lo_Control As Object

    For Each lo_Control In Controls
      Select Case UCase(TypeName(lo_Control))
      Case "ARMCOMBOBOX"
        Call lo_Control.Unload_A_COM
      Case "ARMPICKER"
        Call lo_Control.Unload_A_COM
      Case "TOOLBARCONTROL"
        Call lo_Control.Unload_A_COM
      Case "ARMGRID"
        Call lo_Control.Unload_A_COM
      Case "ARMTREEVIEW"
        Call lo_Control.Unload_A_COM
      Case "ARMCHECKVIEW"
        Call lo_Control.Unload_A_COM
      Case "TOOLBR"
        Call lo_Control.Unload_A_COM
      End Select
    Next
    
    Set mo_scriptObj = Nothing
    
    If Not mo_ChargesDlg Is Nothing Then
        Unload mo_ChargesDlg
        Set mo_ChargesDlg = Nothing
    End If
    
    Exit Sub
    
ErrHandler:
    
    Call ErrorHandler("UnLoad_A_Com")
    
End Sub

Public Sub Resize()
    Call InitCtrlSize
End Sub

Private Sub InitCtrlSize()
On Error GoTo ErrHandler
    If UserControl.Extender.Width < 12300 Then
        Exit Sub
    End If
    
    If UserControl.Extender.Height < 7000 Then
        Exit Sub
    End If
    
    Const SPACE As Long = 60
    Call tlb_Main.Move(SPACE, 0, UserControl.Extender.Width - 2 * SPACE, tlb_Main.Height)
    
    Call frm_filters.Move(tlb_Main.Left, tlb_Main.Top + tlb_Main.Height, tlb_Main.Width)
    
    Call grd_lst.Move(frm_filters.Left, frm_filters.Top + frm_filters.Height + SPACE, frm_filters.Width, UserControl.Extender.Height - SPACE - frm_filters.Top - frm_filters.Height - frm_status.Height)
    
    Call frm_status.Move(frm_filters.Left, grd_lst.Top + grd_lst.Height, grd_lst.Width)
    
    lbl_action.Left = 0
    prg_progres.Left = lbl_action.Left + lbl_action.Width + SPACE
    prg_progres.Width = frm_status.Width - prg_progres.Left - SPACE
    
    
    Call frm_detail.Move(frm_filters.Left, frm_filters.Top + SPACE, grd_lst.Width, grd_lst.Height + grd_lst.Top - frm_filters.Top - 2 * SPACE)
    
    
    Call cal_fReferenceDate.Move(frm_filters.Left + lbl_labels(2).Left + lbl_labels(2).Width + SPACE, frm_filters.Top + cbo_fCarrier.Top)
    
    
    Call grd_lines.Move(SPACE, grd_lines.Top, grd_lines.Width, frm_detail.Height - grd_lines.Top - tlb_item.Height - frm_listDetail.Height - 3 * SPACE)
    
    Call tlb_item.Move(grd_lines.Left, grd_lines.Top + grd_lines.Height + SPACE, grd_lines.Width)
    
    Call frm_listDetail.Move(tlb_item.Left, tlb_item.Top + tlb_item.Height + SPACE, tlb_item.Width)
    ckv_surcharges.Width = frm_listDetail.Width - ckv_surcharges.Left - SPACE
'    Call grd_values.Move(SPACE, SPACE + 250, frm_detail.Width - 2 * SPACE, frm_detail.Height - 2 * SPACE - 250)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitCtrlSize")
End Sub

Private Function OpenSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
On Error GoTo ErrHandler
    Dim lc_Data As Long
tryAgain:
    lc_Data = ao_Db.OpenSQL(as_Request)
    If lc_Data = 0 Then
        
        Dim ls_ErrMsg As String
        ls_ErrMsg = "SQL Error: " & GetDbError(ao_Db)
        
        If ReconnectSafe() Then
            GoTo tryAgain
        End If
        
        Call Err.Raise(1, "ao_Db.OpenSQL - " & "SQL : " & as_Request, ls_ErrMsg)
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.RowCount(lc_Data) <> al_RowExpectedCount Then
            Call Err.Raise(2, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_Db.RowCount(lc_Data))
        End If
    End If
    OpenSQLSafe = lc_Data
    Exit Function
ErrHandler:
    Call ErrorHandler("OpenSQLSafe")
End Function

Private Sub ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
On Error GoTo ErrHandler

tryAgain:
    ' First execute the request
    If Not ao_Db.ExecuteSQL(as_Request) Then
        If GetArrayValue(ao_Db.SQLErrorCodes, 0) = 547 Then
            Err.Raise 3, "SQL : " & as_Request, Join(ao_Db.SQLErrorCodes, SEP2) & SEP1 & Join(ao_Db.SQLErrorMessages, SEP2)
        End If
        
        Dim ls_ErrMsg As String
        ls_ErrMsg = Join(ao_Db.SQLErrorCodes, SEP2) & SEP1 & Join(ao_Db.SQLErrorMessages, SEP2)
        
        If ReconnectSafe() Then
            GoTo tryAgain
        End If
        
        Err.Raise 1, ls_ErrMsg & " SQL : " & as_Request
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.SQLRowsAffected <> al_RowAffectedCount Then
            
            If ab_DuplicityCheck Then
                Err.Raise 4, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            Else
                Err.Raise 5, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            End If
        End If
    End If
    
    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub

Private Sub ExecuteSQLSafeFront(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ab_run As Boolean = False)
On Error GoTo ErrHandler

    Static lsa_req() As String
    Static ls_req As String
    
    If as_Request <> "" Then
        ls_req = IIf(ls_req = "", "", ls_req & vbCrLf) & as_Request
        
        If Len(ls_req) > 10000 Then
        
            Call SafeRedimPreserve(lsa_req, SafeUbound(lsa_req) + 1)
            
            lsa_req(SafeUbound(lsa_req)) = ls_req
            
            ls_req = ""
        End If
        
    End If
    
    If ab_run And (ls_req <> "" Or SafeUbound(lsa_req) <> -1) Then
        
        Dim ll_i As Long
        For ll_i = 0 To SafeUbound(lsa_req)
            Call ExecuteSQLSafe(mo_Db, lsa_req(ll_i))
        Next
        
        Call SafeRedimPreserve(lsa_req, -1)
        
        If ls_req <> "" Then
            Call ExecuteSQLSafe(mo_Db, ls_req)
            ls_req = ""
        End If
        
    End If
    
    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafeFront")
End Sub

Private Sub EnableControl(ByVal ao_Control As Control, ByVal ab_Enabled As Boolean)
On Error GoTo ErrHandler

    Select Case UCase(TypeName(ao_Control))
        Case "FRAME", "LABEL", "MSFLEXGRID", "SHAPE", "ARMGRID", "ARMCHECKVIEW", "TABSTRIP"
            ao_Control.Enabled = ab_Enabled
            ' Do nothing !
        Case "LISTVIEW"
            ' Do nothing !
        Case "TEXTBOX"
            ao_Control.Locked = Not ab_Enabled
            ao_Control.BackColor = IIf(ab_Enabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
            ao_Control.TabStop = ab_Enabled
        Case "OPTIONBUTTON"
            ao_Control.Enabled = ab_Enabled
        Case "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "CHECKBOX", "COMMANDBUTTON", "TOOLBARCONTROL"
            ao_Control.Enabled = ab_Enabled
            ao_Control.TabStop = ab_Enabled
        Case Else
          Debug.Print ao_Control.Name
    End Select
  Exit Sub
ErrHandler:
  Call ErrorHandler("EnableControl")
End Sub

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 EnableControl(lo_ctrl, ab_Value)
    Next
    Exit Sub
ErrHandler:
     Call ErrorHandler("SetEnabled()")
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 Is CommonDialog Then
            If Not TypeOf lo_Control.Container Is DC_PriceList 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
        End If
    Next
    Set GetContainedControlsChain = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler("GetContainedControlsChain()")
End Function

' translate string to sql format
' Params:
' as_Value (String)
' ab_EmptyNULL (Boolean = False)
Private Function SqlStr(ByVal as_Value As String, Optional ByVal al_MaxLen As Long = 8000, Optional ByVal ab_EmptyNULL As Boolean = False) As String
    If as_Value = "" And ab_EmptyNULL Then
        SqlStr = "NULL"
    Else
        SqlStr = "'" & Replace(Left(as_Value, IIf(Len(as_Value) <= al_MaxLen, Len(as_Value), al_MaxLen)), "'", "''") & "'"
    End If
End Function

Private Function SqlDateH(ByVal av_Data As String) As String
On Error GoTo ErrHandler
    SqlDateH = "0"
    
    Dim lsa_aux() As String
    Dim ld_Date As Date
    
    lsa_aux = Split(av_Data, ":")
    
    Debug.Assert (UBound(lsa_aux) = 1)
    
    ld_Date = DateSerial(1900, 1, 1)        ' zero time for SQL
    
    ld_Date = DateAdd("h", CLng(lsa_aux(0)), ld_Date)   ' add hours
    
    ld_Date = DateAdd("n", CLng(lsa_aux(1)), ld_Date)   ' add minutes
    
    SqlDateH = SQLDateTime(ld_Date)
    
    Exit Function
ErrHandler:
End Function

Private Function SQLDateTime(ad_Date As Date) As String
On Error GoTo ErrHandler
  If ad_Date = 0 Then
    SQLDateTime = "Null"
  Else
    SQLDateTime = "{ ts '" & Format(ad_Date, "yyyy-mm-dd hh:mm:ss") & "'}"
  End If
    Exit Function
ErrHandler:

End Function

Private Function SqlDate(ByVal av_Data As String) 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:
End Function


Private Function SQLNum(ByVal as_str As String) As String
    SQLNum = Replace(as_str, ",", ".")
End Function

Private Function GetArrayValue(ByRef ao_variantArray As Variant, ByVal al_Index As Long) As Variant
    If IsArray(ao_variantArray) Then
        If UBound(ao_variantArray) <= al_Index Then
            GetArrayValue = ao_variantArray(al_Index)
        Else
            GetArrayValue = 0
        End If
    Else
        GetArrayValue = 0
    End If
End Function

Private Sub Item_Clear()
On Error GoTo ErrHandler
    Dim lo_Control As Control
    For Each lo_Control In Controls
        If lo_Control.Tag <> "" Then
            Select Case UCase(TypeName(lo_Control))
            Case "ARMCOMBOBOX"
                Set lo_Control.SelectedItem = Nothing
            Case "ARMPICKER"
            Case "TOOLBARCONTROL"
            Case "ARMGRID"
            Case "ARMTREEVIEW"
            Case "ARMCHECKVIEW"
                Call lo_Control.Init
            Case "A_CALOCX"
            Case "TOOLBR"
            Case "TEXTBOX"
                lo_Control.Text = ""
            Case "CHECKBOX"
                lo_Control.Value = vbUnchecked
            End Select
        End If
    Next
    ml_iConcurrency = 0
    Call moa_ChargesLocal.RemoveAll
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Clear()")
End Sub

Private Sub ItemLine_Clear()
On Error GoTo ErrHandler
    Dim lo_Control As Control
    For Each lo_Control In Controls
        If Not TypeOf lo_Control Is CommonDialog Then
            If Not TypeOf lo_Control.Container Is DC_PriceList Then
                If frm_listDetail.hwnd = lo_Control.Container.hwnd Then
                    If lo_Control.Tag <> "" Then
                        Select Case UCase(TypeName(lo_Control))
                        Case "ARMCOMBOBOX"
                            Call lo_Control.Clear
                            Set lo_Control.SelectedItem = Nothing
                        Case "ARMPICKER"
                        Case "TOOLBARCONTROL"
                        Case "ARMGRID"
                        Case "ARMTREEVIEW"
                        Case "ARMCHECKVIEW"
                        Case "A_CALOCX"
                        Case "TOOLBR"
                        Case "TEXTBOX"
                            lo_Control.Text = ""
                        Case "CHECKBOX"
                            lo_Control.Value = vbUnchecked
                        End Select
                    End If
                End If
            End If
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ItemLine_Clear()")
End Sub

Private Function UpdateGridAfterAction(ByVal ao_grid As ArmGrid, ByVal as_action As String, ByVal av_Key As Variant, Optional ByVal as_no_upd_Action As String = "") As Boolean
On Error GoTo ErrHandler
    Dim ll_Index As Long
    Dim lo_Column As ArmColumn
    
    UpdateGridAfterAction = False
    
    Select Case as_action
    Case "Add"
        ' insert row at the end of grid
        Debug.Assert (ao_grid.Cols > 0)
        Dim lsa_newRow() As String
        'MS REDIMM
        Call SafeRedimPreserve(lsa_newRow, ao_grid.Cols - 1)
        Dim ll_KeyIndex As Long
        ll_KeyIndex = 0
        
        For ll_Index = 0 To ao_grid.Cols - 1
            Set lo_Column = ao_grid.Columns(ll_Index)
            If lo_Column.Key Then
                Debug.Assert (UBound(av_Key) >= ll_KeyIndex)
                lsa_newRow(ll_Index) = av_Key(ll_KeyIndex)
                ll_KeyIndex = ll_KeyIndex + 1
            ElseIf lo_Column.Name = "Action" Then
                lsa_newRow(ll_Index) = "A"
            ElseIf lo_Column.Name = "iConcurrency" Then
                lsa_newRow(ll_Index) = 0
            Else
                lsa_newRow(ll_Index) = GetDataSrcForGrid(lo_Column)
            End If
        Next
        Call ao_grid.AddLine(lsa_newRow)
        ao_grid.LineColor(ao_grid.Row) = vbGreen
    Case "Upd"
        ' search and update row in the grid
        Debug.Assert (ao_grid.Cols > 0)
        
        If Not EqualKeys(ao_grid.SelectedKey(0), av_Key) Then
            If Not ao_grid.SearchKey(True, av_Key) Then
                Exit Function
            End If
        End If
        
        Dim ls_newData As String
        Dim lb_updated As Boolean
        lb_updated = False
        
        For ll_Index = 0 To ao_grid.Cols - 1
            Set lo_Column = ao_grid.Columns(ll_Index)
            If Not lo_Column.Key Then
                If lo_Column.Name = "Action" Then
                    If (lo_Column.GetData(ao_grid.Row) = "" And lb_updated) Or lo_Column.GetData(ao_grid.Row) = "D" Then
                        Call lo_Column.SetData(ao_grid.Row, "U")
                        ao_grid.LineColor(ao_grid.Row) = vbCyan
                    ElseIf lo_Column.GetData(ao_grid.Row) = "" And Not lb_updated Then
                        Call lo_Column.SetData(ao_grid.Row, as_no_upd_Action)
                    End If
                ElseIf lo_Column.Name <> "iConcurrency" Then
                    ls_newData = GetDataSrcForGrid(lo_Column)
                    If ls_newData <> CStr(lo_Column.GetData(ao_grid.Row)) Then
                        If Not lo_Column.SetData(ao_grid.Row, ls_newData) Then
                            Call Err.Raise(1, "lo_Column.SetData", "Cannot update grid.")
                        End If
                        lb_updated = True
                    End If
                End If
            End If
        Next

    Case "Del"
        Debug.Assert (ao_grid.Cols > 0)
        
        If Not EqualKeys(ao_grid.SelectedKey(0), av_Key) Then
            If Not ao_grid.SearchKey(True, av_Key) Then
                Exit Function
            End If
        End If
        
        Call ao_grid.DeleteSelectedLines
'        Call ao_grid.DeleteLine(av_key)
    
    Case "Del2"         ' mark as to be deleted
        Debug.Assert (ao_grid.Cols > 0)
        
        If Not EqualKeys(ao_grid.SelectedKey(0), av_Key) Then
            If Not ao_grid.SearchKey(True, av_Key) Then
                Exit Function
            End If
        End If
        
        If ao_grid.Data(ao_grid.Row, "Action") = "A" Then
            Call ao_grid.DeleteSelectedLines
        Else
            ao_grid.Data(ao_grid.Row, "Action") = "D"
            ao_grid.LineColor(ao_grid.Row) = vbRed
        End If
        
    Case Else
        Debug.Assert (False)
    End Select
    UpdateGridAfterAction = True
    Exit Function
ErrHandler:
     Call ErrorHandler("UpdateGridAfterAction()")
End Function

' when updating main grid from detail
Private Function GetDataSrcForGrid(ByVal ao_Column As ArmColumn) As String
On Error GoTo ErrHandler
    Select Case ao_Column.Name
        Case "DCPL_Code"        ' it should be a key
            Debug.Assert (False)
        Case "PL_CHECK"
            GetDataSrcForGrid = "LIGHTYELLOW"
        Case "DCPL_Name"
            GetDataSrcForGrid = GetPriceListName
        Case "DC_Code"
            GetDataSrcForGrid = GetCboKey(cbo_DC)
        Case "DC_Desc"
            GetDataSrcForGrid = GetCboValue(cbo_DC, ao_Column.FieldName)
        Case "CARRIER_Code"
            GetDataSrcForGrid = GetCboKey(cbo_carrier)
        Case "CARRIER_Name"
            GetDataSrcForGrid = GetCboValue(cbo_carrier, ao_Column.FieldName)
        Case "UOM_Code"
            GetDataSrcForGrid = GetCboKey(cbo_UOM)
        Case "CURR_code"
            GetDataSrcForGrid = GetCboKey(cbo_currency)
        Case "CURR_Desc"
            GetDataSrcForGrid = GetCboKey(cbo_currency)                     'GetCboValue(cbo_currency, ao_Column.FieldName)
        Case "TT_Code"
            GetDataSrcForGrid = GetCboKey(cbo_TT_Code)
        Case "DropOff_Cost"
            GetDataSrcForGrid = txt_dropOffCost.Text
        Case "FullTruckCalculation"
            GetDataSrcForGrid = GetCboKey(cbo_fullTruckCalculation)
        Case "Validity_Start"
            GetDataSrcForGrid = Format(cal_validityStart.date_courte, "dd\/mm\/yyyy")
        Case "Validity_End"
            If cal_validityEnd.date_dt = 0 Then
                GetDataSrcForGrid = ""
            Else
                GetDataSrcForGrid = Format(cal_validityEnd.date_courte, "dd\/mm\/yyyy")
            End If
        Case "Action", "iConcurrency"     ' shoul be managed outside
            Debug.Assert (False)
        
        Case "DCPLL_Code", "DCPLLI_Code"       ' it should be a key
            Debug.Assert (False)
        Case "CT_Code"
            GetDataSrcForGrid = GetCboKey(cbo_country)
        Case "CT_Desc"
            GetDataSrcForGrid = GetCboValue(cbo_country, "CT_Desc")
        Case "DCPLL_Zip_Code"
            GetDataSrcForGrid = txt_zipCode.Text
        Case "DCPLLI_Qty_min"
            GetDataSrcForGrid = txt_QtyMin.Text
        Case "DCPLLI_Qty_max"
            GetDataSrcForGrid = txt_QtyMax.Text
        Case "DCPLLI_Price"
            GetDataSrcForGrid = txt_Price.Text
        Case "DCPLLI_CURR_Code"
            GetDataSrcForGrid = GetCboKey(cbo_DCPLLI_CURR)
        Case "IsReturn"
            GetDataSrcForGrid = IIf(chk_isReturn.Value = vbChecked, "X", "")
        Case "DCPLL_LeadTime"
            GetDataSrcForGrid = txt_LeadTime.Text
        Case "PriceFormula"
            GetDataSrcForGrid = txt_priceformula.Text
        Case "IsTrailer"
            GetDataSrcForGrid = IIf(chk_isTrailer.Value = vbChecked, "Y", "N")
        Case Else
            Debug.Assert (False)
    End Select
    
    Exit Function
ErrHandler:
     Call ErrorHandler("GetDataSrcForGrid()")
End Function

Private Function GetCboKey(ByRef ao_cbo As ArmCombobox) As String
On Error GoTo ErrHandler
    GetCboKey = ""
    If Not ao_cbo.SelectedItem Is Nothing Then
        GetCboKey = ao_cbo.SelectedItem.Key
    End If
    Exit Function
ErrHandler:
     Call ErrorHandler("GetCboKey()")
End Function

Private Function GetCboValue(ByRef ao_cbo As ArmCombobox, ByVal av_field As Variant) As String
On Error GoTo ErrHandler
    GetCboValue = ""
    If Not ao_cbo.SelectedItem Is Nothing Then
        GetCboValue = ao_cbo.GetItemData(ao_cbo.SelectedItem.Key, av_field)
    End If
    Exit Function
ErrHandler:
     Call ErrorHandler("GetCboValue()")
End Function

Private Sub RefreshGrid()
On Error GoTo ErrHandler
Const REQ As String = "EXEC DC_PriceListHeader_lst $DC_CODE$, $CARRIER_CODE$, $TT_Code$, $REF_DATE$, $TenderCarrier$, $LANGUAGE_CODE$"
    Dim ls_req As String
    
    ls_req = Replace(REQ, "$LANGUAGE_CODE$", SqlStr(ms_Language_Code, 1, True), , , vbTextCompare)
    ls_req = Replace(ls_req, "$DC_CODE$", SqlStr(GetCboKey(cbo_fDC), 4, True), , , vbTextCompare)
    ls_req = Replace(ls_req, "$CARRIER_CODE$", SqlStr(GetCboKey(cbo_fCarrier), 10, True), , , vbTextCompare)
    ls_req = Replace(ls_req, "$TT_Code$", SqlStr(GetCboKey(cbo_fTT_Code), 10, True), , , vbTextCompare)
    ls_req = Replace(ls_req, "$TenderCarrier$", ml_TenderCarrier, , , vbTextCompare)
    If chk_active.Value = vbChecked Then
        ls_req = Replace(ls_req, "$REF_DATE$", SqlDate(cal_fReferenceDate.date_dt), , , vbTextCompare)
    Else
        ls_req = Replace(ls_req, "$REF_DATE$", "NULL", , , vbTextCompare)
    End If
    
    Call LoadGrid(grd_lst, ls_req, "Grid not loaded (DC_PriceListHeader_lst)!")
    
'    Call Item_Clear
    
    Exit Sub
ErrHandler:
     Call ErrorHandler("RefreshGrid()")
End Sub

Private Sub LoadGrid(ByRef ao_grd As ArmGrid, ByVal as_req As String, ByVal as_Message As String)
On Error GoTo ErrHandler

TyAgain:
    If Not ao_grd.Load(as_req, True) Then
    
        If ReconnectSafe Then
            GoTo TyAgain
        End If
        
        Call MsgBox(as_Message)
    End If

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

Private Function ReconnectSafe() As Boolean
On Error GoTo ErrHandler

    ReconnectSafe = False
    
    Dim ll_Counter As Long
    ll_Counter = 3              ' try 3 times to connect
    
    If IsLostConnection(mo_Db) Then
    
        Call mo_Db.Disconnect
        
        Do While ll_Counter > 0
        
            If mo_Db.Connect(ms_reconnectServer, ms_reconnectDB, ms_reconnectUser, ms_reconnectPassword, ms_reconnectApp) Then
                ReconnectSafe = True
                Exit Do
            End If
            
            ll_Counter = ll_Counter - 1
        Loop
        
    End If
    
    Exit Function
ErrHandler:
     Call ErrorHandler("ReconnectSafe()")
End Function

Private Function IsLostConnection(ByRef ao_Armdb As ArmDb) As Boolean
On Error GoTo ErrHandler
    
    IsLostConnection = Not ao_Armdb.IsConnected
    
    If IsArray(ao_Armdb.SQLErrorCodes) Then
        Dim lv_ErrCode As Variant
        Dim ll_Index As Long
        
        lv_ErrCode = ao_Armdb.SQLErrorCodes
        
        For ll_Index = LBound(lv_ErrCode) To UBound(lv_ErrCode)
            If lv_ErrCode(ll_Index) = 11 Then       '[DBNETLIB][ConnectionWrite (send()).]General network error. Check your network documentation.
                IsLostConnection = True
                Exit For
            End If
        Next

    End If
    
    Exit Function
ErrHandler:
     Call ErrorHandler("IsLostConnection()")
End Function

Private Sub cal_fReferenceDate_datechangee()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    Call RefreshGrid
    Exit Sub
ErrHandler:
     Call ErrorMessage("cal_fReferenceDate_datechangee()")
End Sub

Private Sub cbo_country_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub

    Call ItemLine_LoadSurcharges(IIf(GetCboKey(cbo_lineID) = "", 0, GetCboKey(cbo_lineID)), GetCboKey(cbo_carrier), GetCboKey(cbo_country), txt_zipCode.Text)

    Exit Sub
ErrHandler:
     Call ErrorMessage("cbo_country_ComboItemSelected()")
End Sub

Private Sub cbo_DC_ComboItemSelected()
On Error GoTo ErrHandler
Const C_REQ As String = "DC_Carrier_lst $DC_CODE$, $TenderCarrier$"
    
    Call cbo_carrier.Clear
    
    Dim ls_DC_Code As String
    ls_DC_Code = GetCboKey(cbo_DC)
    
    If ls_DC_Code = "" Then
        cbo_carrier.Request = ""
    Else
        cbo_carrier.Request = Replace(Replace(C_REQ, "$TenderCarrier$", ml_TenderCarrier, , , vbTextCompare), "$DC_CODE$", SqlStr(ls_DC_Code, 4, True))
    End If
    
    ' secrh for currency in combobox
    Dim ls_CURR_Code As String
    ls_CURR_Code = GetCboValue(cbo_DC, "CURR_Code")
    
    If ls_CURR_Code = "" Then
        cbo_currency.Clear
    Else
        If Not cbo_currency.SearchItem(ls_CURR_Code) Then
            cbo_currency.Load
            cbo_currency.SearchItem (ls_CURR_Code)
        End If
    End If
    
    Exit Sub
ErrHandler:
     Call ErrorMessage("cbo_DC_ComboItemSelected()")
End Sub

Private Sub cbo_fCarrier_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    Call RefreshGrid
    Exit Sub
ErrHandler:
     Call ErrorMessage("cbo_fCarrier_ComboItemSelected()")
End Sub

Private Sub cbo_fDC_ComboItemSelected()
On Error GoTo ErrHandler
Const C_REQ As String = "DC_Carrier_lst $DC_CODE$, $TenderCarrier$"
    
    If mb_eventRunning Then Exit Sub
    Set cbo_fCarrier.SelectedItem = Nothing
    
    Dim ls_DC_Code As String
    ls_DC_Code = GetCboKey(cbo_fDC)
    
    If ls_DC_Code = "" Then
        cbo_fCarrier.Request = ""
    Else
        cbo_fCarrier.Request = Replace(Replace(C_REQ, "$TenderCarrier$", ml_TenderCarrier, , , vbTextCompare), "$DC_CODE$", SqlStr(ls_DC_Code, 4, True))
    End If
    
    Call RefreshGrid

    Exit Sub
ErrHandler:
     Call ErrorMessage("cbo_DC_ComboItemSelected()")
End Sub


Private Sub cbo_fTT_Code_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    Call RefreshGrid
    Exit Sub
ErrHandler:
     Call ErrorMessage("cbo_fTT_Code_ComboItemSelected()")
End Sub

Private Sub cbo_lineID_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    
    mb_eventRunning = True
    If GetCboKey(cbo_lineID) = "" Then
        txt_lineID.Text = "NEW"
        Call EnableControl(cbo_country, True)
        Call EnableControl(txt_zipCode, True)
    Else
        txt_lineID.Text = GetCboKey(cbo_lineID)
        Call SetComboItemValue(cbo_country, GetCboValue(cbo_lineID, "CT_Code"))
        txt_zipCode.Text = GetCboValue(cbo_lineID, "DCPLL_Zip_Code")
        
        Call EnableControl(cbo_country, False)
        Call EnableControl(txt_zipCode, False)
    End If
    
    Call ItemLine_LoadSurcharges(IIf(GetCboKey(cbo_lineID) = "", 0, GetCboKey(cbo_lineID)), GetCboKey(cbo_carrier), GetCboKey(cbo_country), txt_zipCode.Text)
    
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    Call ErrorMessage("cbo_lineID_ComboItemSelected()")
End Sub

Private Sub chk_active_Click()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    Call RefreshGrid
    Exit Sub
ErrHandler:
     Call ErrorMessage("chk_active_Click()")
End Sub

Private Sub LoadSurchargeDetailDlg()
On Error GoTo ErrHandler
    
    If Not mo_ChargesDlg Is Nothing Then Exit Sub
    
    Set mo_ChargesDlg = New DC_PriceListLineSurchargeDetail
    Set mo_ChargesDlg.ArmDb = mo_Db
    mo_ChargesDlg.U_Code = ml_U_Code
    mo_ChargesDlg.LoginName = ms_LoginName
    mo_ChargesDlg.Language_Code = ms_Language_Code
    Call mo_ChargesDlg.SetReconnectParams(ms_reconnectServer, ms_reconnectDB, ms_reconnectUser, ms_reconnectPassword, ms_reconnectApp)
    
    Call mo_ChargesDlg.Load_A_COM

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

Private Sub ckv_surcharges_DblClick()
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    
'    If mu_ActiveLineMode <> smAdd And mu_ActiveLineMode <> smUpdate Then Exit Sub
    
    If Not ckv_surcharges.SelectedItem Is Nothing Then
    
        Dim lo_ItemInfo As ArmItemInfo
        ' find the record in edit echek list
        Set lo_ItemInfo = ckv_surcharges.RoleList("CHARGES").GetItem(ckv_surcharges.SelectedItem.Tag.CheckList.GetItemKey(ckv_surcharges.SelectedItem.Tag))
        
        If lo_ItemInfo.CurrentChecked Then
            Dim ls_oldDefault As String
            ls_oldDefault = lo_ItemInfo.GetData(C_DCS_DEFAULT_IDX)
            
            Call LoadSurchargeDetailDlg
            
            Call mo_ChargesDlg.Run(lo_ItemInfo.GetData(C_DCS_CODE_IDX), _
                                    lo_ItemInfo.GetData(C_DCS_DESC_IDX), _
                                    lo_ItemInfo.GetData(C_DCS_PRICE_IDX), _
                                    IIf(lo_ItemInfo.GetData(C_DCS_FORMULA_IDX) = "", "Price", lo_ItemInfo.GetData(C_DCS_FORMULA_IDX)), _
                                    lo_ItemInfo.GetData(C_DCS_DEFAULT_IDX) = "X", _
                                    lo_ItemInfo.GetData(C_DCS_LINKED_IDX), _
                                    GetCboKey(cbo_currency), _
                                    IIf(mu_ActiveLineMode = smAdd Or mu_ActiveLineMode = smUpdate, "U", "V"))
                                    
            If mo_ChargesDlg.Result Then
                Call lo_ItemInfo.SetData(C_DCS_PRICE_IDX, mo_ChargesDlg.DCS_Price)
                Call lo_ItemInfo.SetData(C_DCS_FORMULA_IDX, mo_ChargesDlg.DCS_Formula)
                Call lo_ItemInfo.SetData(C_DCS_DEFAULT_IDX, IIf(mo_ChargesDlg.DCS_Default, "X", ""))
                Call lo_ItemInfo.SetData(C_DCS_ACTION_IDX, "U")
                
                ' update main rolelist items
                Dim lo_infoMain As ArmItemInfo
                Set lo_infoMain = lo_ItemInfo.CheckList.ViewCheckList.GetItem(lo_ItemInfo.CheckList.GetItemKey(lo_ItemInfo))
                Debug.Assert (Not lo_infoMain Is Nothing)
                Call lo_infoMain.SetData(C_DCS_PRICE_IDX, mo_ChargesDlg.DCS_Price)
                Call lo_infoMain.SetData(C_DCS_FORMULA_IDX, mo_ChargesDlg.DCS_Formula)
                Call lo_infoMain.SetData(C_DCS_DEFAULT_IDX, IIf(mo_ChargesDlg.DCS_Default, "X", ""))
                
                ' if this is new default -> undefault the rest
                If ls_oldDefault = "" And mo_ChargesDlg.DCS_Default Then
                    Call Surcharge_CorrectDefault(lo_ItemInfo.GetData(C_DCS_CODE_IDX))
                End If
            
                Call lo_ItemInfo.CheckList.DisplayList
                
            End If
            
        End If
        
    End If
    
    Exit Sub
ErrHandler:
     Call ErrorMessage("ckv_surcharges_DblClick()")
End Sub

Private Sub Surcharge_CorrectDefault(ByVal as_DCS_Code_ex As String)
On Error GoTo ErrHandler
    
    Dim ll_i As Long
    For ll_i = 1 To ckv_surcharges.RoleList("CHARGES").Count
    
        Dim lo_Info As ArmItemInfo
        Set lo_Info = ckv_surcharges.RoleList("CHARGES").Items(ll_i)
        
        ' if not excluded, if checked and if default
        If lo_Info.GetData(C_DCS_CODE_IDX) <> as_DCS_Code_ex And _
            lo_Info.CurrentChecked And _
            lo_Info.GetData(C_DCS_DEFAULT_IDX) = "X" _
        Then
            ' unmark as default
            Call lo_Info.SetData(C_DCS_DEFAULT_IDX, "")
            Call lo_Info.SetData(C_DCS_ACTION_IDX, "U")
            
            ' unmark in MAIN rolelist
            Dim lo_infoMain As ArmItemInfo
            Set lo_infoMain = lo_Info.CheckList.ViewCheckList.GetItem(lo_Info.CheckList.GetItemKey(lo_Info))
            Debug.Assert (Not lo_infoMain Is Nothing)
            Call lo_infoMain.SetData(C_DCS_DEFAULT_IDX, "")
        End If
    Next

    Exit Sub
ErrHandler:
     Call ErrorMessage("Surcharge_CorrectDefault()")
End Sub

Private Sub ckv_surcharges_ItemCheck(ByVal Item As MSComctlLib.ListItem)
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub
    
    Dim lo_ItemInfo As ArmItemInfo
    Set lo_ItemInfo = Item.Tag
    
    If lo_ItemInfo.CurrentChecked And _
        lo_ItemInfo.GetData(C_DCS_PRICE_IDX) = 0 And _
        lo_ItemInfo.GetData(C_DCS_FORMULA_IDX) = "" _
    Then
        Call LoadSurchargeDetailDlg
        
        Call mo_ChargesDlg.Run(lo_ItemInfo.GetData(C_DCS_CODE_IDX), _
                                lo_ItemInfo.GetData(C_DCS_DESC_IDX), _
                                lo_ItemInfo.GetData(C_DCS_PRICE_IDX), _
                                "Price", _
                                False, _
                                lo_ItemInfo.GetData(C_DCS_LINKED_IDX), _
                                GetCboKey(cbo_currency), "U")
        If mo_ChargesDlg.Result Then
            Call lo_ItemInfo.SetData(C_DCS_PRICE_IDX, mo_ChargesDlg.DCS_Price)
            Call lo_ItemInfo.SetData(C_DCS_FORMULA_IDX, mo_ChargesDlg.DCS_Formula)
            Call lo_ItemInfo.SetData(C_DCS_DEFAULT_IDX, IIf(mo_ChargesDlg.DCS_Default, "X", ""))
            Call lo_ItemInfo.SetData(C_DCS_ACTION_IDX, "U")

            ' update main rolelist items
            Dim lo_infoMain As ArmItemInfo
            Set lo_infoMain = lo_ItemInfo.CheckList.ViewCheckList.GetItem(lo_ItemInfo.CheckList.GetItemKey(lo_ItemInfo))
            Debug.Assert (Not lo_infoMain Is Nothing)
            Call lo_infoMain.SetData(C_DCS_PRICE_IDX, mo_ChargesDlg.DCS_Price)
            Call lo_infoMain.SetData(C_DCS_FORMULA_IDX, mo_ChargesDlg.DCS_Formula)
            Call lo_infoMain.SetData(C_DCS_DEFAULT_IDX, IIf(mo_ChargesDlg.DCS_Default, "X", ""))

            Call lo_ItemInfo.CheckList.DisplayList
        End If
        
    ElseIf Not lo_ItemInfo.CurrentChecked And _
            lo_ItemInfo.GetData(C_DCS_LINKED_IDX) > 0 _
            Then
        ' display warning that item cannot be unchecked because it is ussed on some trasaction
        Call MsgBox("Item cannot be unchecked as it is ussed on some transport!")
        Call ckv_surcharges.SetItemState(lo_ItemInfo.CheckList.Name, lo_ItemInfo.CheckList.GetItemKey(lo_ItemInfo), True)
    End If

    Exit Sub
ErrHandler:
    Call ErrorMessage("ckv_surcharges_ItemCheck()")
End Sub

Private Sub grd_lines_RowLoaded(ByVal al_Row As Long)
On Error GoTo ErrHandler
    
    If grd_lines.Data(al_Row, "PL_CHECK") = "CHKFAIL" Then
        grd_lines.LineColor(al_Row) = vbYellow
    End If

    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_lines_RowLoaded()")
End Sub

Private Sub grd_lines_SelChange()
On Error GoTo ErrHandler
    If grd_lines.SelectedCount = 0 Then Exit Sub
    Call LockScreen(True)
    
    Call ItemLine_InitView(grd_lines.SelectedKey(0)(0))
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("grd_lines_SelChange()")
End Sub

Private Sub grd_lst_DblClick()
On Error GoTo ErrHandler
    If grd_lst.SelectedCount = 0 Then Exit Sub
    
    Call LockScreen(True)
    
    Call Item_InitView(grd_lst.SelectedKey(0)(0))
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("grd_lst_DblClick()")
End Sub


Private Sub grd_lst_RowLoaded(ByVal al_Row As Long)
On Error GoTo ErrHandler
    
    If grd_lst.Data(al_Row, "PL_CHECK") = "CHKFAIL" Then
        grd_lst.LineColor(al_Row) = vbYellow
    End If

    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_lst_RowLoaded()")
End Sub

Private Sub tlb_Item_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Call LockScreen(True)
    mb_eventRunning = True

    Select Case as_Role
    Case "A"
        Call ItemLine_InitAdd
    Case "B", "I"       ' Update, refresh detail
        If mu_ActiveLineMode = smAdd Then
            Call ItemLine_InitAdd
        ElseIf (mu_ActiveLineMode = smView) Or (mu_ActiveLineMode = smMain) Or (mu_ActiveLineMode = smUpdate) Then
            If grd_lines.SelectedCount > 0 Then
                Call ItemLine_InitUpdate(grd_lines.SelectedKey(0))
            Else
                Call MsgBox("Select a row please!")
            End If
        End If
    Case "C"
        If grd_lines.SelectedCount > 0 Then
            Call ItemLine_InitDelete(grd_lines.SelectedKey(0))
        Else
            Call MsgBox("Select a row please!")
        End If
    Case "J"
        If grd_lines.PreviousLine Then
            Call grd_lines_SelChange
        End If
    Case "K"
        If grd_lines.NextLine Then
            Call grd_lines_SelChange
        End If
    Case "F"        ' refresh grid
        Call grd_lines.Refresh
        
        Call UpdateUI(mu_ActiveMode, smMain)
    Case "H"
        If mu_ActiveLineMode = smAdd Then
            If ItemLine_Add(True) Then
                Call UpdateUI(mu_ActiveMode, ArmScreenMode.smView)
            End If
        ElseIf mu_ActiveLineMode = smUpdate Then
            If ItemLine_Update Then
                Call UpdateUI(mu_ActiveMode, ArmScreenMode.smView)
            End If
        ElseIf mu_ActiveLineMode = smDelete Then
            If ItemLine_Delete Then
                Call UpdateUI(mu_ActiveMode, ArmScreenMode.smMain)
            End If
        End If
    Case "T"
        Call UpdateUI(mu_ActiveMode, ArmScreenMode.smMain)
        
    End Select

    Call LockScreen(False)
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("tlb_item_action")
End Sub

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Call LockScreen(True)
    mb_eventRunning = True

    Select Case as_Role
    Case "A"
        Call Item_InitAdd
    Case "B", "I"       ' Update, refresh detail
        If mu_ActiveMode = smAdd Then
            Call Item_InitAdd
        ElseIf (mu_ActiveMode = smView) Or (mu_ActiveMode = smMain) Or (mu_ActiveMode = smUpdate) Then
            If grd_lst.SelectedCount > 0 Then
                Call Item_InitUpdate(grd_lst.SelectedKey(0)(0))
            Else
                Call MsgBox("Select a row please!")
            End If
        End If
    Case "C"
        If grd_lst.SelectedCount > 0 Then
            Call Item_InitDelete(grd_lst.SelectedKey(0)(0))
        Else
            Call MsgBox("Select a row please!")
        End If
    Case "J"
        If grd_lst.PreviousLine Then
            Call grd_lst_DblClick
        End If
    Case "K"
        If grd_lst.NextLine Then
            Call grd_lst_DblClick
        End If
    Case "L"        ' refresh grid
'        Call ResetFilters
        
        Call RefreshGrid
    Case "H"
        If mu_ActiveMode = smAdd Then
            If Item_Add Then
                Call UpdateUI(ArmScreenMode.smMain, ArmScreenMode.smMain)
            End If
        ElseIf mu_ActiveMode = smUpdate Then
            If Item_Update Then
                Call UpdateUI(ArmScreenMode.smMain, ArmScreenMode.smMain)
            End If
        ElseIf mu_ActiveMode = smDelete Then
            If Item_Delete Then
                Call UpdateUI(ArmScreenMode.smMain, ArmScreenMode.smMain)
            End If
        End If
    Case "T"
        If mu_ActiveMode = smMain Then
            RaiseEvent quit
        Else
            Call UpdateUI(ArmScreenMode.smMain, ArmScreenMode.smMain)
        End If
    Case "G"
        Call LockScreen(False)
        
        dlg_fileopen.DialogTitle = "Open a file to import."
        dlg_fileopen.FileName = ""
        dlg_fileopen.ShowOpen
        
        Call LockScreen(True)
        
        If dlg_fileopen.FileName <> "" Then
        
            ImportFromXLS (dlg_fileopen.FileName)
        
        End If
    Case "X"                ' copy selected pricelist
        If grd_lst.SelectedCount > 0 Then
            Call Item_InitAddx(grd_lst.SelectedKey(0)(0))
        Else
            Call MsgBox("Select a row please!")
        End If
    End Select

    Call LockScreen(False)
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("tlb_main_action")
End Sub


Private Sub Item_InitAddx(ByVal al_recordID As Long)
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC DC_PriceListSurcharge_lst $DCPL_Code$"
    mb_eventRunning = True
    
    mb_chargesLocalOnly = False
    
    Call Item_Clear
    
    Call UpdateUI(ArmScreenMode.smAdd, ArmScreenMode.smMain)
    
    Dim ll_Cursor As Long
    ll_Cursor = Item_LoadDB(al_recordID)
    
    Call Item_Load(ll_Cursor)
    
    ml_iConcurrency = 0
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    ' clean all ID to 'NEW'
    txt_recordID.Text = "NEW"
    
    ' reset validity range
    cal_validityStart.date_courte = cal_fReferenceDate.date_courte
    cal_validityEnd.reinit_cal
    
    cbo_lineID.Request = "SELECT 'NEW' AS DCPLL_Code, '' AS DCPLL_Desc, '' AS CT_Code, '' AS DCPLL_Zip_Code"
    
    ' mark all rows as 'added'
    If grd_lines.Rows <> 0 Then
        Call grd_lines.FirstLine
        
        Do
            grd_lines.SelectedLine(0, "DCPLL_Code") = "NEW"
            grd_lines.SelectedLine(0, "DCPLLI_Code") = "NEW"
            grd_lines.SelectedLine(0, "Action") = "A"
        Loop While grd_lines.NextLine
        
        Call grd_lines.DeselectRow
    End If
    
    ' copy surcharges
    
    Dim ls_Key As String
    Dim lo_charge As tChargesLocal
    
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(C_REQ, "$DCPL_Code$", al_recordID, , , vbTextCompare))
    
    While Not mo_Db.EOF(ll_Cursor)
        ls_Key = mo_Db.GetFields(ll_Cursor, "CT_Code") & SEP & mo_Db.GetFields(ll_Cursor, "DCPLL_Zip_Code") & SEP & mo_Db.GetFields(ll_Cursor, "DCS_Code")
        
        Debug.Assert (Not moa_ChargesLocal.Exists(ls_Key))
    
        lo_charge.DCS_Code = mo_Db.GetFields(ll_Cursor, "DCS_Code")
        lo_charge.DCS_Desc = mo_Db.GetFields(ll_Cursor, "DCS_Desc")
        lo_charge.DCS_Price = mo_Db.GetFields(ll_Cursor, "DCS_Price")
        lo_charge.DCS_Formula = mo_Db.GetFields(ll_Cursor, "DCS_Formula")
        lo_charge.DCS_Default = mo_Db.GetFields(ll_Cursor, "DCS_Default")
        lo_charge.DCS_LinkedTrans = 0
        lo_charge.action = "A"
        
        Call moa_ChargesLocal.Add(ls_Key, EncodeChargesLocal(lo_charge))
        
        Call mo_Db.Next(ll_Cursor)
    Wend
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    mb_eventRunning = False
    
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorMessage("Item_InitAddx")
End Sub

Private Sub Item_InitAdd()
On Error GoTo ErrHandler
    mb_eventRunning = True
    
    mb_chargesLocalOnly = False
    
    Call Item_Clear
    
    Call UpdateUI(ArmScreenMode.smAdd, ArmScreenMode.smMain)
    
    Call Item_LoadDefaultValues
    
    mb_eventRunning = False
    
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    Call ErrorMessage("Item_InitAdd")
End Sub

Private Sub ItemLine_InitAdd()
On Error GoTo ErrHandler
    mb_eventRunning = True

    Call ItemLine_Clear
    
    Call ItemLine_LoadDefaultValues
    
    Call UpdateUI(mu_ActiveMode, ArmScreenMode.smAdd)
    
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    Call ErrorMessage("ItemLine_InitAdd")
End Sub

Private Sub Item_InitDelete(ByVal al_recordID As Long)
On Error GoTo ErrHandler
    mb_eventRunning = True
    
    mb_chargesLocalOnly = False
    
    Call Item_Clear
    
    Call UpdateUI(ArmScreenMode.smDelete, ArmScreenMode.smMain)
    
    Dim ll_Cursor As Long
    
    ll_Cursor = Item_LoadDB(al_recordID)
    
    Call Item_Load(ll_Cursor)
        
    ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorMessage("Item_InitDelete")
End Sub

Private Sub Item_InitView(ByVal al_recordID As Long)
On Error GoTo ErrHandler
    mb_eventRunning = True
    
    mb_chargesLocalOnly = False

    Call Item_Clear
    
    Call UpdateUI(ArmScreenMode.smView, ArmScreenMode.smMain)
    
    Dim ll_Cursor As Long
    ll_Cursor = Item_LoadDB(al_recordID)
    
    Call Item_Load(ll_Cursor)
    
    ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorMessage("Item_InitView")
End Sub


Private Sub Item_InitUpdate(ByVal al_recordID As Long)
On Error GoTo ErrHandler
    mb_eventRunning = True
    
    mb_chargesLocalOnly = False
    
    Call Item_Clear
    
    Call UpdateUI(ArmScreenMode.smUpdate, ArmScreenMode.smMain)
    
    Dim ll_Cursor As Long
    ll_Cursor = Item_LoadDB(al_recordID)
    
    Call Item_Load(ll_Cursor)
    
    ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorMessage("Item_InitUpdate")
End Sub

Private Function Item_Update() As Boolean
On Error GoTo ErrHandler
    Item_Update = False
    If Not Item_Check() Then
        Exit Function
    End If
    
    Dim ls_overlapReq As String
    If Not Item_CheckValidityOverlap(ls_overlapReq) Then
        Exit Function
    End If

    Call Item_UpdateDB(CLng(txt_recordID.Text), ls_overlapReq)
    
    If Not UpdateGridAfterAction(grd_lst, "Upd", Array(CLng(txt_recordID.Text))) Then
        Call MsgBox("Record not found for current filters! (" & txt_recordID.Text & ")")
    End If
    
    Item_Update = True
    Exit Function
ErrHandler:
    Call ErrorMessage("Item_Update")
End Function

Private Function Item_Delete() As Boolean
On Error GoTo ErrHandler
    Item_Delete = False
    If MsgBox("Do you want to delete the record?", vbYesNo) <> vbYes Then
        Exit Function
    End If
    
    Call Item_DeleteDB(CLng(txt_recordID.Text))
    
    Call UpdateGridAfterAction(grd_lst, "Del", Array(CLng(txt_recordID.Text)))
    
    Item_Delete = True
    Exit Function
ErrHandler:
    Call ErrorMessage("Item_Delete")
End Function

Private Function Item_Add() As Boolean
On Error GoTo ErrHandler
    Item_Add = False
    If Not Item_Check() Then
        Exit Function
    End If
    
    Dim ls_overlapReq As String
    If Not Item_CheckValidityOverlap(ls_overlapReq) Then
        Exit Function
    End If
    
    Dim DCPL_Code As Long
    DCPL_Code = CLng(GetNextRecordID("DCPL_Code"))
    
    txt_recordID.Text = DCPL_Code
    
    Call Item_AddDB(DCPL_Code, ls_overlapReq)
    
    Call UpdateGridAfterAction(grd_lst, "Add", Array(DCPL_Code))
    
    Item_Add = True
    Exit Function
ErrHandler:
    Call ErrorMessage("Item_Add")
End Function

Private Sub ItemLine_InitUpdate(ByVal av_Key As Variant)
On Error GoTo ErrHandler
    mb_eventRunning = True
    
    Call ItemLine_Clear
    
    If Not EqualKeys(grd_lines.SelectedKey(0), av_Key) Then
        If Not grd_lines.SearchKey(True, av_Key) Then
            MsgBox ("Record not found!")
            Exit Sub
        End If
    End If
    
    Call ItemLine_Load(grd_lines)
    
    Call UpdateUI(mu_ActiveMode, ArmScreenMode.smUpdate)
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    Call ErrorMessage("ItemLine_InitUpdate")
End Sub

Private Sub ItemLine_InitView(ByVal al_DCPLL_Code As String)
On Error GoTo ErrHandler
    mb_eventRunning = True
    Call ItemLine_Clear
    
    If grd_lines.SelectedKey(0)(0) <> al_DCPLL_Code Then
        If Not grd_lines.SearchKey(True, al_DCPLL_Code) Then
            MsgBox ("Record not found!")
            Exit Sub
        End If
    End If
    
    Call ItemLine_Load(grd_lines)
    
    Call UpdateUI(mu_ActiveMode, ArmScreenMode.smView)
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    Call ErrorMessage("ItemLine_InitView")
End Sub

Private Sub ItemLine_InitDelete(ByVal av_Key As Variant)
On Error GoTo ErrHandler
    mb_eventRunning = False
    Call ItemLine_Clear
    
    If Not EqualKeys(grd_lines.SelectedKey(0), av_Key) Then
        If Not grd_lines.SearchKey(True, av_Key) Then
            MsgBox ("Record not found!")
            Exit Sub
        End If
    End If
    
    Call ItemLine_Load(grd_lines)
    
    Call UpdateUI(mu_ActiveMode, ArmScreenMode.smDelete)
    mb_eventRunning = False
    Exit Sub
ErrHandler:
    mb_eventRunning = False
    Call ErrorMessage("ItemLine_InitDelete")
End Sub

Private Function EqualKeys(ByRef av_Key1 As Variant, av_Key2 As Variant) As Boolean
On Error GoTo ErrHandler
    
    EqualKeys = False
    If IsEmpty(av_Key1) Or IsEmpty(av_Key2) Then Exit Function
    If LBound(av_Key1) <> LBound(av_Key2) Then Exit Function
    If UBound(av_Key1) <> UBound(av_Key2) Then Exit Function
    
    Dim ll_i As Long
    For ll_i = LBound(av_Key1) To UBound(av_Key1)
        If av_Key1(ll_i) <> av_Key2(ll_i) Then Exit Function
    Next
    
    EqualKeys = True
    Exit Function
ErrHandler:
    Call ErrorHandler("EqualKeys")
End Function

Private Function ItemLine_Add(ByVal ab_forceLinedIdSearch As Boolean) As Boolean
On Error GoTo ErrHandler
    ItemLine_Add = False
    If Not ItemLine_Check() Then
        Exit Function
    End If
    
    If ab_forceLinedIdSearch Then
        txt_lineID.Text = GetPLLineID(GetCboKey(cbo_country), txt_zipCode.Text, txt_lineID.Text)
    End If
    
    Call UpdateGridAfterAction(grd_lines, "Add", Array(txt_lineID.Text, txt_itemID.Text))
    
    Call UpdateLocalAfterAction
    
    ItemLine_Add = True
    Exit Function
ErrHandler:
    Call ErrorMessage("ItemLine_Add")
End Function

Private Function GetPLLineID(ByVal as_CT_Code As String, ByVal as_zip_code As String, ByVal as_defaultID As String) As String
On Error GoTo ErrHandler
    ' search inside the cbo_LineID
    
    GetPLLineID = ""
    
    If as_defaultID <> "NEW" Then
        GetPLLineID = as_defaultID
        Exit Function
    End If
    
    If cbo_lineID.Count = 0 Then
        Call cbo_lineID.Load
    End If
    
    Dim ll_i As Long
    Dim ls_Key As String
    For ll_i = 1 To cbo_lineID.Count
        
        ls_Key = cbo_lineID.ComboItems(ll_i).GetData(0) '.ComboItems(ll_i).Key
        If UCase(cbo_lineID.GetItemData(ls_Key, "CT_Code")) = UCase(as_CT_Code) And _
            cbo_lineID.GetItemData(ls_Key, "DCPLL_Zip_Code") = as_zip_code _
        Then
            Set cbo_lineID.SelectedItem = cbo_lineID.ComboItems(ll_i)
            GetPLLineID = ls_Key
            Exit Function
        End If
    Next
    
    GetPLLineID = as_defaultID
    Exit Function
ErrHandler:
    Call ErrorMessage("GetPLLineID")
End Function

Private Sub UpdateLocalAfterAction()
On Error GoTo ErrHandler

    If ckv_surcharges.GetVisibleList() = "" Then Exit Sub

    ' update local surcharges arrray
    Dim ll_i As Long
    For ll_i = 1 To ckv_surcharges.RoleList(ckv_surcharges.GetVisibleList).Count
    
        Dim lo_Info As ArmItemInfo
        Set lo_Info = ckv_surcharges.RoleList(ckv_surcharges.GetVisibleList).Items(ll_i)
    
    
        Dim ls_Key As String
        ls_Key = GetCboKey(cbo_country) & SEP & txt_zipCode.Text & SEP & lo_Info.GetData(C_DCS_CODE_IDX)
    
        Dim lo_charge As tChargesLocal
    
        If moa_ChargesLocal.Exists(ls_Key) Then
            Call DecodeChargesLocal(moa_ChargesLocal.Item(ls_Key), lo_charge)
            Call moa_ChargesLocal.Remove(ls_Key)
        
            If lo_Info.CurrentChecked = lo_Info.OriginalChecked And _
                lo_Info.GetData(C_DCS_PRICE_IDX) = lo_charge.DCS_Price And _
                lo_Info.GetData(C_DCS_FORMULA_IDX) = lo_charge.DCS_Formula And _
                lo_Info.GetData(C_DCS_DEFAULT_IDX) = lo_charge.DCS_Default _
            Then
                GoTo nextLoop
            End If
        
        Else
            If lo_Info.CurrentChecked = lo_Info.OriginalChecked And _
               lo_Info.GetData(C_DCS_ACTION_IDX) = "" _
            Then GoTo nextLoop
            
        End If
    
        lo_charge.DCS_Code = lo_Info.GetData(C_DCS_CODE_IDX)
        lo_charge.DCS_Desc = lo_Info.GetData(C_DCS_DESC_IDX)
        lo_charge.DCS_Price = lo_Info.GetData(C_DCS_PRICE_IDX)
        lo_charge.DCS_Formula = lo_Info.GetData(C_DCS_FORMULA_IDX)
        lo_charge.DCS_Default = lo_Info.GetData(C_DCS_DEFAULT_IDX)
        lo_charge.DCS_LinkedTrans = lo_Info.GetData(C_DCS_LINKED_IDX)
        lo_charge.action = IIf(lo_Info.CurrentChecked, "A", "D")
        
        Call moa_ChargesLocal.Add(ls_Key, EncodeChargesLocal(lo_charge))
        
nextLoop:
    Next

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

Private Function ItemLine_Update(Optional ByVal as_noUpdAction As String = "") As Boolean
On Error GoTo ErrHandler
    ItemLine_Update = False
    If Not ItemLine_Check() Then
        Exit Function
    End If
    
    If Not UpdateGridAfterAction(grd_lines, "Upd", Array(txt_lineID.Text, txt_itemID.Text), as_noUpdAction) Then
        Call MsgBox("Record not found for current filters! (" & txt_lineID.Text & "/" & txt_itemID.Text & ")")
    End If
    
    Call UpdateLocalAfterAction
    
    ItemLine_Update = True
    Exit Function
ErrHandler:
    Call ErrorMessage("ItemLine_Update")
End Function

Private Function ItemLine_Delete() As Boolean
On Error GoTo ErrHandler
    ItemLine_Delete = False
    If MsgBox("Do you want to delete the record?", vbYesNo) <> vbYes Then
        Exit Function
    End If
    
    Call UpdateGridAfterAction(grd_lines, "Del2", Array(txt_lineID.Text, txt_itemID.Text))
    
    ItemLine_Delete = True
    Exit Function
ErrHandler:
    Call ErrorMessage("ItemLine_Delete")
End Function

Private Function Item_Check() As Boolean
On Error GoTo ErrHandler
    Item_Check = False

    If (Trim(txt_dropOffCost.Text) <> "") And Not isNumeric(txt_dropOffCost.Text) Then
        Call MsgBox("Wrong Drop Off Cost number!")
        Call txt_dropOffCost.SetFocus
        Exit Function
    End If


    If GetCboKey(cbo_DC) = "" Then
        Call MsgBox("Missing DC!")
        Call cbo_DC.SetFocus
        Exit Function
    End If
    
    If GetCboKey(cbo_carrier) = "" Then
        Call MsgBox("Missing Carrier!")
        Call cbo_carrier.SetFocus
        Exit Function
    End If
    
    If GetCboKey(cbo_currency) = "" Then
        Call MsgBox("Missing Currency!")
        Call cbo_currency.SetFocus
        Exit Function
    End If
    
    If GetCboKey(cbo_UOM) = "" Then
        Call MsgBox("Missing UOM!")
        Call cbo_UOM.SetFocus
        Exit Function
    End If
    
    If GetCboKey(cbo_fullTruckCalculation) = "" Then
        Call MsgBox("Missing 'Full truck calculation'")
        Call cbo_fullTruckCalculation.SetFocus
        Exit Function
    End If
    
    
    If GetCboKey(cbo_TT_Code) = "" Then
        Call MsgBox("Wrong Valid For! (C,I,R,T)")
        Call cbo_TT_Code.SetFocus
        Exit Function
    End If
    
    If cal_validityStart.date_dt() = 0 Then
        Call MsgBox("Validity start canot be empty!")
        Call cal_validityStart.SetFocus
        Exit Function
    End If
    
    If cal_validityEnd.date_dt() <> 0 Then
        If cal_validityStart.date_dt() > cal_validityEnd.date_dt() Then
            Call MsgBox("Validity end must be before validity start!")
            Call cal_validityEnd.SetFocus
        End If
    End If
    
    Item_Check = True
    Exit Function
ErrHandler:
    Call ErrorMessage("Item_Check")
End Function

Private Function Item_CheckValidityOverlap(ByRef as_overlapReq As String) As Boolean
On Error GoTo ErrHandler
    Dim lb_Result As VbMsgBoxResult
    
    Item_CheckValidityOverlap = False
    
    as_overlapReq = ""
    
Const C_REQ_FUTURE As String = "EXEC DC_PriceList_OVERLAP_FUTURE_chk $DCPL_Code$, $DC_CARRIER_Code$, $UOM_Code$, $TT_Code$, $Validity_Start$, $Validity_End$"
Const C_REQ_PAST As String = "EXEC DC_PriceList_OVERLAP_PAST_chk $DCPL_Code$, $DC_CARRIER_Code$, $UOM_Code$, $TT_Code$, $Validity_Start$"
Const C_REQ_RET As String = "UPDATE DC_PriceListHeader SET Validity_End=$Validity_End$ WHERE DCPL_Code=$DCPL_Code$"

    '1 .. check if there is a price list active in the future
    Dim ll_Cursor As Long
    
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(Item_ReplacePlaceholders(C_REQ_FUTURE), "$DCPL_Code$", SQLNum(IIf(txt_recordID.Text = "NEW", 0, txt_recordID.Text)), , , vbTextCompare))
    Dim ld_validitystart As Date
    ld_validitystart = mo_Db.GetFields(ll_Cursor, "Validity_Start")
    
    Dim ls_DPCL_Name As String
    ls_DPCL_Name = mo_Db.GetFields(ll_Cursor, "DCPL_Name")
    
    Dim ll_Rows As Long
    ll_Rows = mo_Db.RowCount(ll_Cursor)
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ll_Rows > 0 Then
        ' we have to close current price list one day before start of existing
        lb_Result = MsgBox("There is another price list (" & ll_Rows & ") in the future (" & ls_DPCL_Name & ") that overlaps with current." & vbCrLf & "Do you want to close current on " & Format(ld_validitystart - 1, "dd\/mm\/yyyy") & "?", vbYesNoCancel)
        If lb_Result = vbYes Then
            ' close current one day before the one in future starts
            cal_validityEnd.date_courte = Format(ld_validitystart - 1, "dd\/mm\/yyyy")
        ElseIf lb_Result = vbCancel Then
            Exit Function
        End If
    End If
    
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(Item_ReplacePlaceholders(C_REQ_PAST), "$DCPL_Code$", SQLNum(IIf(txt_recordID.Text = "NEW", 0, txt_recordID.Text)), , , vbTextCompare))
    
    Dim ll_DCPL_Code As Long
    
    ll_DCPL_Code = mo_Db.GetFields(ll_Cursor, "DCPL_Code")
    
    ls_DPCL_Name = mo_Db.GetFields(ll_Cursor, "DCPL_Name")
    
    ll_Rows = mo_Db.RowCount(ll_Cursor)
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ll_Rows > 0 Then
        ' we have to close the price list in the past one day before start of current
        ld_validitystart = cal_validityStart.date_dt()
        
        lb_Result = MsgBox("There is another price list (" & ll_Rows & ") in the past (" & ls_DPCL_Name & ") that overlaps with current." & vbCrLf & "Do you want to close it on " & Format(ld_validitystart - 1, "dd\/mm\/yyyy") & "?", vbYesNoCancel)
        If lb_Result = vbYes Then
            
            as_overlapReq = Replace(C_REQ_RET, "$DCPL_Code$", SQLNum(ll_DCPL_Code), , , vbTextCompare)
            as_overlapReq = Replace(as_overlapReq, "$Validity_End$", SqlDate(ld_validitystart - 1), , , vbTextCompare)
        
        ElseIf lb_Result = vbCancel Then
            Exit Function
        End If
    End If
    
    Item_CheckValidityOverlap = True
    
    Exit Function
ErrHandler:
    Call ErrorMessage("Item_CheckValidityOverlap")
End Function

Private Function ItemLine_Check() As Boolean
On Error GoTo ErrHandler
    Dim ll_Cursor As Long
    ll_Cursor = 0
    ItemLine_Check = False

    If (Trim(txt_zipCode.Text) = "") Then
        Call MsgBox("Missing Zip code value!")
        Call txt_zipCode.SetFocus
        Exit Function
    End If
    
    If (Trim(txt_LeadTime.Text) = "") Then
        Call MsgBox("Missing Lead time value!")
        Call txt_LeadTime.SetFocus
        Exit Function
    End If
    
    Dim lsa_aux() As String
    Dim ll_Index As Long
    lsa_aux = Split(txt_LeadTime.Text, ":")
    
    For ll_Index = LBound(lsa_aux) To UBound(lsa_aux)
        If (Trim(lsa_aux(ll_Index)) = "") Or Not isNumeric(lsa_aux(ll_Index)) Then
            Call MsgBox("Wrong lead time format!")
            Call txt_LeadTime.SetFocus
            Exit Function
        End If
        
        If ll_Index <> LBound(lsa_aux) Then
            ' chcek if fragment is between 0..60
            If CLng(lsa_aux(ll_Index)) < 0 Or CLng(lsa_aux(ll_Index)) >= 60 Then
                Call MsgBox("Wrong lead time format!")
                Call txt_LeadTime.SetFocus
                Exit Function
            End If
        End If
        
        lsa_aux(ll_Index) = Format(CLng(lsa_aux(ll_Index)), "#00")
    Next
    
    
    txt_LeadTime.Text = Join(lsa_aux, ":")
    
    ' if only hour part specified then we add 00 as a minutes part
    If LBound(lsa_aux) = UBound(lsa_aux) Then
        txt_LeadTime.Text = txt_LeadTime.Text & ":00"
    End If
    
    If (Trim(txt_QtyMin.Text) <> "") And Not isNumeric(txt_QtyMin.Text) Then
        Call MsgBox("Wrong Qty min number!")
        Call txt_QtyMin.SetFocus
        Exit Function
    End If
    
    If (Trim(txt_QtyMax.Text) <> "") And Not isNumeric(txt_QtyMax.Text) Then
        Call MsgBox("Wrong Qty max number!")
        Call txt_QtyMax.SetFocus
        Exit Function
    End If
    
    
    If (Trim(txt_Price.Text) <> "") And Not isNumeric(txt_Price.Text) Then
        Call MsgBox("Wrong Price number!")
        Call txt_Price.SetFocus
        Exit Function
    End If
    
'    If (Trim(txt_returnPrice.Text) <> "") And Not isNumeric(txt_returnPrice.Text) Then
'        Call MsgBox("Wrong return Price number!")
'        Call txt_returnPrice.SetFocus
'        Exit Function
'    End If
    
    If GetCboKey(cbo_country) = "" Then
        Call MsgBox("Missing Country!")
        Call cbo_country.SetFocus
        Exit Function
    End If
    
    ' for Suppliers check also existance of SP_Code/CT_Code in table Suppliers
    If GetCboKey(cbo_TT_Code) = "R" Then
        ll_Cursor = OpenSQLSafe(mo_Db, Replace("SELECT CT_Code FROM Suppliers WHERE SP_Code=$SP_Code$ AND language_code='E'", "$SP_Code$", SqlStr(txt_zipCode.Text), , , vbTextCompare))
        
        If Not mo_Db.EOF(ll_Cursor) Then
            If GetCboKey(cbo_country) <> mo_Db.GetFields(ll_Cursor, "CT_Code") Then
                ReDim ms_MsgInfo(1, 1)
                ms_MsgInfo(0, 0) = "$CT_Code_expected$"
                ms_MsgInfo(0, 1) = mo_Db.GetFields(ll_Cursor, "CT_Code")
                ms_MsgInfo(1, 0) = "$CT_Code_entered$"
                ms_MsgInfo(1, 1) = GetCboKey(cbo_country)
                
                Call MsgBox(MsgText(5320, ms_Language_Code, "#Invalid Country/Supplier combination. Supplier is not defined for country $CT_Code_entered$. Country must be $CT_Code_expected$!", ms_MsgInfo), vbCritical)
                Call cbo_country.SetFocus
                Exit Function

            End If
        Else
            ' not existing supplier code
            Call MsgBox("Not existing supplier code!")
            txt_zipCode.SetFocus
            Exit Function
        End If
        
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    
    ItemLine_Check = True
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorMessage("ItemLine_Check")
End Function


Private Sub ItemLine_LoadDefaultValues()
On Error GoTo ErrHandler

    txt_lineID.Text = "NEW"
    txt_itemID.Text = "NEW"
    
    ' default country by carrier
    Call SetComboItemValue(cbo_country, GetCboValue(cbo_DC, "CT_Code"))
    
    txt_LeadTime.Text = "24:00"
    
    txt_priceformula.Text = "Price"
    
    Call SetComboItemValue(cbo_DCPLLI_CURR, GetCboKey(cbo_currency))
    
    Call ItemLine_LoadSurcharges(0, GetCboKey(cbo_carrier), GetCboKey(cbo_country), txt_zipCode.Text)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ItemLine_LoadDefaultValues()")
End Sub

Private Sub Item_LoadDefaultValues()
On Error GoTo ErrHandler

    txt_recordID.Text = "NEW"
    
    mb_eventRunning = False
    Call SetComboItemValue(cbo_DC, GetCboKey(cbo_fDC))
    
    mb_eventRunning = True
    
    Call SetComboItemValue(cbo_carrier, GetCboKey(cbo_fCarrier))
    
    Call SetComboItemValue(cbo_fullTruckCalculation, "N")
    
    cbo_lineID.Request = "SELECT 'NEW' AS DCPLL_Code, '' AS DCPLL_Desc, '' AS CT_Code, '' AS DCPLL_Zip_Code"
    
    cal_validityStart.date_courte = cal_fReferenceDate.date_courte
    
    cal_validityEnd.reinit_cal
    
    txt_dropOffCost.Text = "0"
    
    grd_lines.Requests = ""
    
    grd_lines.ClearGrid
    
    ml_iConcurrency = 0
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_LoadDefaultValues()")
End Sub

Private Function Item_LoadDB(ByVal al_record_ID As Long) As Long
On Error GoTo ErrHandler

Const C_REQ = "EXEC DC_PriceListHeader_sel $RECORD_ID$, $TenderCarrier$, $LANG_CODE$"
    Dim ll_retVal As Long
    Dim ls_req As String
    ls_req = Replace(C_REQ, "$LANG_CODE$", SqlStr(ms_Language_Code, 1), , , vbTextCompare)
    ls_req = Replace(ls_req, "$RECORD_ID$", al_record_ID)
    ls_req = Replace(ls_req, "$TenderCarrier$", ml_TenderCarrier)
    
    ll_retVal = OpenSQLSafe(mo_Db, ls_req)
    txt_recordID.Text = al_record_ID
    Item_LoadDB = ll_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler("Item_LoadDB()")
End Function


Private Sub Item_UpdateDB(ByVal al_record_ID As Long, ByVal as_overlapReq As String)
On Error GoTo ErrHandler
    Dim ls_req As String
    Dim lb_InTran As Boolean
    lb_InTran = False

Const CREQ = "EXEC DC_PriceListHeader_upd $DCPL_Code$, $UOM_Code$, $CURR_code$, $TT_Code$, $DropOff_Cost$, $FullTruckCalculation$, $Validity_Start$, $Validity_End$, $Z_Creator$, $iConcurrency$, $DCPL_Name$"
Const CREQ_DV = "EXEC DC_PriceListLine_del $DCPL_Code$,$Z_Creator$"
Const CREQ_DS = "EXEC DC_PriceListLineSurcharge_del $DCPL_Code$,$Z_Creator$"
Const CREQ_CHK = "EXEC DC_PriceListHeader_chk $DCPL_Code$, $UOM_Code$, $CURR_code$, $TT_Code$, $DropOff_Cost$, $FullTruckCalculation$, $Validity_Start$, $Validity_End$"
Const CREQ_DS2 = "EXEC DC_PriceListLineSurcharge_del2 $DCPLL_Code$,$DSC_CODE$"
Const CREQ_IUS = "EXEC DC_PriceListLineSurcharge_upsert $DCPLL_Code$,$DSC_CODE$,$DSC_PRICE$,$DSC_FORMULA$,$DSC_DEFAULT$,$Z_Creator$"
Const CREQ_DS_LOCAL = "EXEC DC_PriceListLineSurcharge_del3 $DCPL_Code$"
    
    Dim ll_Cursor As Long
    Dim lb_headerUpdated As Boolean
    ' check if there is a change compared to previous state
    ls_req = Replace(CREQ_CHK, "$DCPL_Code$", SQLNum(al_record_ID), , , vbTextCompare)
    ls_req = Item_ReplacePlaceholders(ls_req)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    lb_headerUpdated = (Not mo_Db.EOF(ll_Cursor))
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    ' common placeholders
    ls_req = Replace(CREQ, "$DCPL_Code$", SQLNum(al_record_ID), , , vbTextCompare)
    ls_req = Replace(ls_req, "$iConcurrency$", ml_iConcurrency, , , vbTextCompare)
    ls_req = Item_ReplacePlaceholders(ls_req)
    
    Progress = 0
    prg_progres.Max = 12

    Call BeginTran("DC_PRICELIST")
    lb_InTran = True
    
    Progress = 1
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    ' update values
    Dim ll_i As Long
    Dim ll_newID As Long
    Dim ls_CT_Code As String
    Dim ls_DCPLL_Zip_Code As String
    
    Call Item_UpdateLineItemValueDB(-1, "INIT_A_ID")
    Call Item_UpdateLineValueDB(-1, "INIT_A_ID")
    
    ' if local only then delete all existing links to surchages
    If mb_chargesLocalOnly Then
        ' delete links to pricelist EXCEPT ONES THAT ARE LINKED TO TRANSACTIONS
        Call ExecuteSQLSafe(mo_Db, Replace(CREQ_DS_LOCAL, "$DCPL_Code$", SQLNum(al_record_ID), , , vbTextCompare))
    End If
    
    Progress = 2
    'step 1 .... delete DC_PriceListLineItem records
    For ll_i = 0 To grd_lines.Rows - 1
        Call Item_UpdateLineItemValueDB(ll_i, "D")
    Next
    Progress = 3
    ' real database execution
    Call ExecuteSQLSafeFront(mo_Db, "", True)
    
    'step 2 .... generate/update DC_PriceListLine records
    Dim ls_DCPLL_Codes As String        ' the list of create lines
    
    Progress = 4
    For ll_i = 0 To grd_lines.Rows - 1
        ll_newID = Item_UpdateLineValueDB(ll_i, "")
        
        If grd_lines.Data(ll_i, "Action") <> "" Or lb_headerUpdated Then
            ls_DCPLL_Codes = IIf(ls_DCPLL_Codes = "", "", ls_DCPLL_Codes & ",") & grd_lines.Data(ll_i, "DCPLL_Code")
        End If
        
        If ll_newID <> 0 Then
            ' search for all the lines with the same CT_Code, DCPLL_Zip_Code
            ls_CT_Code = grd_lines.Data(ll_i, "CT_Code")
            ls_DCPLL_Zip_Code = grd_lines.Data(ll_i, "DCPLL_Zip_Code")
            
            If grd_lines.SearchKey(True, Array(grd_lines.Data(ll_i, "DCPLL_Code"), grd_lines.Data(ll_i, "DCPLLI_Code"))) Then
            
                grd_lines.Columns("DCPLL_Code").Key = False
                grd_lines.Columns("DCPLLI_Code").Key = False
            
                grd_lines.Columns("CT_Code").Key = True
                grd_lines.Columns("DCPLL_Zip_Code").Key = True
                
                Debug.Assert (grd_lines.Data(ll_i, "DCPLL_Code") = ll_newID)
                
                If grd_lines.NextLine Then
                    
                    Do While grd_lines.SearchKey(False, Array(ls_CT_Code, ls_DCPLL_Zip_Code))
                        Debug.Assert (grd_lines.SelectedLine(0, "DCPLL_Code") = "NEW")
                        
                        grd_lines.SelectedLine(0, "DCPLL_Code") = ll_newID
                        
                        If Not grd_lines.NextLine Then Exit Do
                    Loop
                End If
            
                grd_lines.Columns("CT_Code").Key = False
                grd_lines.Columns("DCPLL_Zip_Code").Key = False
                
                grd_lines.Columns("DCPLL_Code").Key = True
                grd_lines.Columns("DCPLLI_Code").Key = True
            
            End If
            
        End If
    Next
    Progress = 5
    ' real database execution
    Call ExecuteSQLSafeFront(mo_Db, "", True)
    
    'step 3 ..... Generate/update DC_PriceListLineItem records
    Progress = 6
    For ll_i = 0 To grd_lines.Rows - 1
        Call Item_UpdateLineItemValueDB(ll_i, "AU")
    Next
    Progress = 7
    ' real database execution
    Call ExecuteSQLSafeFront(mo_Db, "", True)
    
    Progress = 8
    'step 4 .... delete DC_PriceListLine records that remains without the price
    
    ls_req = Replace(CREQ_DV, "$DCPL_Code$", SQLNum(al_record_ID), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
    Call ExecuteSQLSafe(mo_Db, ls_req)
    
    ' step 5 .... update surcharges from local changes
    Progress = 9
    Dim lo_charge As tChargesLocal
    
    If moa_ChargesLocal.Count > 0 Then
                
        grd_lines.Columns("DCPLL_Code").Key = False
        grd_lines.Columns("DCPLLI_Code").Key = False
    
        grd_lines.Columns("CT_Code").Key = True
        grd_lines.Columns("DCPLL_Zip_Code").Key = True
    
        For ll_i = 0 To moa_ChargesLocal.Count - 1
            Call DecodeChargesLocal(moa_ChargesLocal.Items(ll_i), lo_charge)
            Dim la_Key As Variant
            la_Key = Split(moa_ChargesLocal.keys(ll_i), SEP, , vbTextCompare)
            
            If grd_lines.SearchKey(True, Array(la_Key(0), la_Key(1))) Then
            
'                If grd_lines.SelectedLine(0, "Action") = "" Then
                    If InStr(1, ls_DCPLL_Codes, "," & grd_lines.SelectedLine(0, "DCPLL_Code") & ",", vbTextCompare) <= 0 And _
                        Left(ls_DCPLL_Codes, Len(grd_lines.SelectedLine(0, "DCPLL_Code"))) <> grd_lines.SelectedLine(0, "DCPLL_Code") And _
                        right(ls_DCPLL_Codes, Len(grd_lines.SelectedLine(0, "DCPLL_Code"))) <> grd_lines.SelectedLine(0, "DCPLL_Code") _
                    Then
                        ' if there was no other upodate except surcharge then add the price list line into recalculation
                        ls_DCPLL_Codes = IIf(ls_DCPLL_Codes = "", "", ls_DCPLL_Codes & ",") & grd_lines.SelectedLine(0, "DCPLL_Code")
                    End If
'                End If
                
                Select Case lo_charge.action
                Case "A"
                    ' insert or update
                    ls_req = Replace(CREQ_IUS, "$DCPLL_Code$", SQLNum(grd_lines.SelectedLine(0, "DCPLL_Code")), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_CODE$", SqlStr(lo_charge.DCS_Code, 4), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_PRICE$", SQLNum(lo_charge.DCS_Price), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_FORMULA$", SqlStr(lo_charge.DCS_Formula, 255), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_DEFAULT$", SqlStr(lo_charge.DCS_Default, 1), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
                    Call ExecuteSQLSafeFront(mo_Db, ls_req)
                    
                Case "D"
                    ' delete surcharge link to pricelist
                    ls_req = Replace(CREQ_DS2, "$DCPLL_Code$", SQLNum(grd_lines.SelectedLine(0, "DCPLL_Code")), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_CODE$", SqlStr(lo_charge.DCS_Code, 4), , , vbTextCompare)
                    Call ExecuteSQLSafeFront(mo_Db, ls_req)
                    
                End Select
            End If
        Next
        
        grd_lines.Columns("CT_Code").Key = False
        grd_lines.Columns("DCPLL_Zip_Code").Key = False
        
        grd_lines.Columns("DCPLL_Code").Key = True
        grd_lines.Columns("DCPLLI_Code").Key = True
        
        Progress = 10
        ' real database execution
        Call ExecuteSQLSafeFront(mo_Db, "", True)
    End If
    
    Progress = 11
    'step 6 ... delete DC_PriceListLineSurcharge records that remains without the price
    ls_req = Replace(CREQ_DS, "$DCPL_Code$", SQLNum(al_record_ID), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
    Call ExecuteSQLSafe(mo_Db, ls_req)

    Progress = 12
    'step 7 .... update/close overpaled price list
    If as_overlapReq <> "" Then
        Call ExecuteSQLSafe(mo_Db, as_overlapReq, 1)
    End If

    Call Item_UpdateLineItemValueDB(-1, "SAVE_A_ID")
    Call Item_UpdateLineValueDB(-1, "SAVE_A_ID")
    
    Call CommitTran("DC_PRICELIST")
    lb_InTran = False
    
    If ls_DCPLL_Codes <> "" Then
        Call UpdateAffectedTransaction(ls_DCPLL_Codes, GetCboKey(cbo_TT_Code))
    End If
    
    Progress = 0
    Exit Sub
ErrHandler:
    If lb_InTran Then
        RollbackTran ("DC_PRICELIST")
    End If
    
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("Item_UpdateDb")
End Sub

Private Sub Item_DeleteDB(ByVal al_record_ID As Long)
On Error GoTo ErrHandler
    Dim ls_req As String

Const CREQ = "EXEC DC_PriceListHeader_del $Record_ID$,$Z_Creator$,$iConcurrency$"
Const CREQ_v = "EXEC DC_PriceListLine_del $Record_ID$,$Z_Creator$"
Const CREQ_vi = "EXEC DC_PriceListLineItem_del2 $Record_ID$,$Z_Creator$"
Const CREQ_vs = "EXEC DC_PriceListLineSurcharge_del $Record_ID$,$Z_Creator$"
    
    ' common placeholders
    ls_req = Replace(CREQ, "$Record_ID$", al_record_ID, , , vbTextCompare)
    ls_req = Replace(ls_req, "$iConcurrency$", ml_iConcurrency, , , vbTextCompare)
    ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)

    Call BeginTran("DC_PRICELIST_del")
    
    Call ExecuteSQLSafe(mo_Db, Replace(Replace(CREQ_vi, "$Record_ID$", al_record_ID, , , vbTextCompare), "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare))
    Call ExecuteSQLSafe(mo_Db, Replace(Replace(CREQ_vs, "$Record_ID$", al_record_ID, , , vbTextCompare), "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare))
    Call ExecuteSQLSafe(mo_Db, Replace(Replace(CREQ_v, "$Record_ID$", al_record_ID, , , vbTextCompare), "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare))
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    Call CommitTran("DC_PRICELIST_del")
    
    Exit Sub
ErrHandler:
    Call RollbackTran("DC_PRICELIST_del")
    Call ErrorHandler("Item_DeleteDB")
End Sub

Private Sub Item_AddDB(ByVal al_record_ID As Long, ByVal as_overlapReq As String)
On Error GoTo ErrHandler
    Dim ls_req As String
    Dim lb_InTran As Boolean
    lb_InTran = False

Const CREQ = "EXEC DC_PriceListHeader_ins $DCPL_Code$, $DCPL_Name$, $DC_CARRIER_Code$, $UOM_Code$, $CURR_code$, $TT_Code$, $DropOff_Cost$, $FullTruckCalculation$, $Validity_Start$, $Validity_End$, $Z_Creator$"
Const CREQ_IUS = "EXEC DC_PriceListLineSurcharge_upsert $DCPLL_Code$,$DSC_CODE$,$DSC_PRICE$,$DSC_FORMULA$,$DSC_DEFAULT$,$Z_Creator$"

    Progress = 0
    prg_progres.Max = grd_lines.Rows * 2 + 7
    
    ' common placeholders
    ls_req = Replace(CREQ, "$DCPL_Code$", al_record_ID, , , vbTextCompare)
    ls_req = Item_ReplacePlaceholders(ls_req)
    
    Call BeginTran("DC_PRICELIST")
    lb_InTran = True
    
    Progress = 1
    Call ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    ' update values
    Dim ll_i As Long
    Dim ll_newID As Long
    Dim ls_CT_Code As String
    Dim ls_DCPLL_Zip_Code As String
    
    Call Item_UpdateLineItemValueDB(-1, "INIT_A_ID")
    Call Item_UpdateLineValueDB(-1, "INIT_A_ID")

    'step 1 .... generate DC_PriceListLine records
    Dim ls_DCPLL_Codes As String        ' the list of create lines
    
    For ll_i = 0 To grd_lines.Rows - 1
        Progress = ll_i + 2
        ll_newID = Item_UpdateLineValueDB(ll_i, "")
        If ll_newID <> 0 Then
            ' save into array
            ls_DCPLL_Codes = IIf(ls_DCPLL_Codes = "", "", ls_DCPLL_Codes & ",") & ll_newID
            
            ' search for all the lines with the same CT_Code, DCPLL_Zip_Code
            ls_CT_Code = grd_lines.Data(ll_i, "CT_Code")
            ls_DCPLL_Zip_Code = grd_lines.Data(ll_i, "DCPLL_Zip_Code")
            
            If grd_lines.SearchKey(True, Array(grd_lines.Data(ll_i, "DCPLL_Code"), grd_lines.Data(ll_i, "DCPLLI_Code"))) Then
            
                grd_lines.Columns("DCPLL_Code").Key = False
                grd_lines.Columns("DCPLLI_Code").Key = False
            
                grd_lines.Columns("CT_Code").Key = True
                grd_lines.Columns("DCPLL_Zip_Code").Key = True
                
                Debug.Assert (grd_lines.Data(ll_i, "DCPLL_Code") = ll_newID)
                
                If grd_lines.NextLine Then
                
                    Do While grd_lines.SearchKey(False, Array(ls_CT_Code, ls_DCPLL_Zip_Code))
                        Debug.Assert (grd_lines.SelectedLine(0, "DCPLL_Code") = "NEW")
                        grd_lines.SelectedLine(0, "DCPLL_Code") = ll_newID
                        If Not grd_lines.NextLine Then Exit Do
                    Loop
                    
                End If
            
                grd_lines.Columns("CT_Code").Key = False
                grd_lines.Columns("DCPLL_Zip_Code").Key = False
                
                grd_lines.Columns("DCPLL_Code").Key = True
                grd_lines.Columns("DCPLLI_Code").Key = True
                
            End If
            
        End If
    Next
    Progress = ll_i + 3
    ' real database execution
    Call ExecuteSQLSafeFront(mo_Db, "", True)
    
    'step 2 ..... Generate DC_PriceListLineItem records
    For ll_i = 0 To grd_lines.Rows - 1
        Progress = grd_lines.Rows + ll_i + 4
        Call Item_UpdateLineItemValueDB(ll_i, "AU")
    Next
    ll_i = grd_lines.Rows + ll_i
    Progress = ll_i + 5
    ' real database execution
    Call ExecuteSQLSafeFront(mo_Db, "", True)
    
    ' step 5 .... update surcharges from local changes
    Progress = ll_i + 6
    Dim lo_charge As tChargesLocal
    
    If moa_ChargesLocal.Count > 0 Then
                
        grd_lines.Columns("DCPLL_Code").Key = False
        grd_lines.Columns("DCPLLI_Code").Key = False
    
        grd_lines.Columns("CT_Code").Key = True
        grd_lines.Columns("DCPLL_Zip_Code").Key = True
    
        For ll_i = 0 To moa_ChargesLocal.Count - 1
            Call DecodeChargesLocal(moa_ChargesLocal.Items(ll_i), lo_charge)
            Dim la_Key As Variant
            la_Key = Split(moa_ChargesLocal.keys(ll_i), SEP, , vbTextCompare)
            
            If grd_lines.SearchKey(True, Array(la_Key(0), la_Key(1))) Then
            
                Select Case lo_charge.action
                Case "A"
                    ' insert or update
                    ls_req = Replace(CREQ_IUS, "$DCPLL_Code$", SQLNum(grd_lines.SelectedLine(0, "DCPLL_Code")), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_CODE$", SqlStr(lo_charge.DCS_Code, 4), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_PRICE$", SQLNum(lo_charge.DCS_Price), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_FORMULA$", SqlStr(lo_charge.DCS_Formula, 255), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$DSC_DEFAULT$", SqlStr(lo_charge.DCS_Default, 1), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
                    Call ExecuteSQLSafeFront(mo_Db, ls_req)
                    
                End Select
            End If
        Next
        
        grd_lines.Columns("CT_Code").Key = False
        grd_lines.Columns("DCPLL_Zip_Code").Key = False
        
        grd_lines.Columns("DCPLL_Code").Key = True
        grd_lines.Columns("DCPLLI_Code").Key = True
        
        ' real database execution
        Call ExecuteSQLSafeFront(mo_Db, "", True)
    End If
    
    ' step 3 .... updated overlaped price list
    Progress = ll_i + 7
    If as_overlapReq <> "" Then
        Call ExecuteSQLSafe(mo_Db, as_overlapReq, 1)
    End If
    
    Call Item_UpdateLineItemValueDB(-1, "SAVE_A_ID")
    Call Item_UpdateLineValueDB(-1, "SAVE_A_ID")
    
    Call CommitTran("DC_PRICELIST")
    lb_InTran = False
    
    ' step 4 recalculate the cost of existing transaction based on this pricelist
    If ls_DCPLL_Codes <> "" Then
        Call UpdateAffectedTransaction(ls_DCPLL_Codes, GetCboKey(cbo_TT_Code))
    End If
    
    Progress = 0
    Exit Sub
ErrHandler:
    If lb_InTran Then
        Call RollbackTran("DC_PRICELIST")
    End If
    Call ErrorHandler("Item_AddDB")
End Sub

Private Sub UpdateAffectedTransaction(ByVal as_DCPLL_Codes As String, ByVal as_TT_Code As String)
On Error GoTo ErrHandler
Const C_R_X As String = "SELECT DISTINCT T.Master_TRANS_Code, T.TT_Code, H.DCPL_Code, H.DropOff_Cost, H.FullTruckCalculation " & _
                        "FROM DC_PriceListLine L " & _
                        "   INNER JOIN DC_PriceListHeader H ON L.DCPL_Code=H.DCPL_Code " & _
                        "        INNER JOIN DC_Transaction T ON " & _
                        "                                       T.DC_CARRIER_Code  = H.DC_CARRIER_Code AND " & _
                        "                                       T.Ship_To_CT_Code  = L.CT_Code AND " & _
                        "                                       T.Ship_To_Zip_Code = L.DCPLL_Zip_Code AND " & _
                        "                                       H.TT_code          = T.TT_Code AND " & _
                        "                                       T.UOM_Code         = H.UOM_Code AND " & _
                        "                                       T.TRANS_Date BETWEEN H.Validity_Start AND ISNULL(H.Validity_End, T.TRANS_Date) " & _
                        "WHERE L.DCPLL_Code in ($DCPLL_Codes$) AND T.Master_TRANS_Code = T.TRANS_Code"

'Const C_R_I As String = "SELECT DISTINCT T.Master_TRANS_Code, T.TT_Code, H.DCPL_Code, H.CURR_code, H.DropOff_Cost, H.FullTruckCalculation " & _
'                        "FROM DC_PriceListLine L " & _
'                        "   INNER JOIN DC_PriceListHeader H ON L.DCPL_Code=H.DCPL_Code " & _
'                        "        INNER JOIN DC_Carrier_link LH ON LH.DC_CARRIER_Code   = H.DC_CARRIER_Code " & _
'                        "        INNER JOIN DC_Transaction T ON " & _
'                        "                                       LH.DC_Code         = T.Receiving_DC AND " & _
'                        "                                       H.TT_code          = T.TT_Code AND " & _
'                        "                                       T.UOM_Code         = H.UOM_Code AND " & _
'                        "                                       T.TRANS_Date BETWEEN H.Validity_Start AND ISNULL(H.Validity_End, T.TRANS_Date) " & _
'                        "           INNER JOIN DC_Carrier_link LT ON LT.DC_CARRIER_Code = T.DC_CARRIER_Code AND LT.CARRIER_Code = LH.CARRIER_Code AND LT.DC_Code= L.DCPLL_Zip_Code " & _
'                        "WHERE L.DCPLL_Code in ($DCPLL_Codes$) AND T.Master_TRANS_Code = T.TRANS_Code AND T.TT_Code='I'"


    Dim ll_Cursor As Long
    Dim ls_req As String
    
    If as_TT_Code = "I" Then
        ls_req = Replace(C_R_X, "$DCPLL_Codes$", as_DCPLL_Codes, , , vbTextCompare)
    Else
        ls_req = Replace(C_R_X, "$DCPLL_Codes$", as_DCPLL_Codes, , , vbTextCompare)
    End If
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) > 0 Then
        
        ' ask if to recalculate the price
        ReDim ms_MsgInfo(0, 1)
        ms_MsgInfo(0, 0) = "$TRANS_Count$"
        ms_MsgInfo(0, 1) = mo_Db.RowCount(ll_Cursor)
        If MsgBox(MsgText(5310, ms_Language_Code, "#Do you want to recalculate $TRANS_Count$ shipments?", ms_MsgInfo), vbYesNo) = vbYes Then
        
            Progress = 0
            prg_progres.Max = mo_Db.RowCount(ll_Cursor)
            
            While Not mo_Db.EOF(ll_Cursor)
                Progress = mo_Db.Position(ll_Cursor) + 1
                Select Case mo_Db.GetFields(ll_Cursor, "TT_Code")
                Case "C"
                    Call UpdateCustomerShipmentPrice(mo_Db.GetFields(ll_Cursor, "Master_TRANS_Code"), mo_Db.GetFields(ll_Cursor, "DCPL_Code"), mo_Db.GetFields(ll_Cursor, "DropOff_Cost"), mo_Db.GetFields(ll_Cursor, "FullTruckCalculation"))
                Case "I"
                    Call UpdateIntercoShipmentPrice(mo_Db.GetFields(ll_Cursor, "Master_TRANS_Code"), mo_Db.GetFields(ll_Cursor, "DCPL_Code"))
                Case "R"
                    Call UpdateSupplierShipmentPrice(mo_Db.GetFields(ll_Cursor, "Master_TRANS_Code"), mo_Db.GetFields(ll_Cursor, "DCPL_Code"))
                End Select
                
                Call mo_Db.Next(ll_Cursor)
            Wend
        End If
        
    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("UpdateAffectedTransaction")
End Sub

Private Sub UpdateCustomerShipmentPrice(ByVal al_masterTransCode As Long, ByVal al_DCPL_Code As Long, ByVal ad_DropOff_Cost As Double, ByVal as_FullTruckCalculation As String)
On Error GoTo ErrHandler
    
    If InitTransportCost(al_masterTransCode, al_DCPL_Code) Then
    
        Call UpdateTransportCost_all(ad_DropOff_Cost, as_FullTruckCalculation)
    
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateCustomerShipmentPrice")
End Sub


Private Sub UpdateIntercoShipmentPrice(ByVal al_masterTransCode As Long, ByVal al_DCPL_Code As Long)
On Error GoTo ErrHandler
    
    If InitTransportCost(al_masterTransCode, al_DCPL_Code) Then
        
        ' propagate pricelist related values into return transaction for round trip
        Dim ll_i As Long
        For ll_i = LBound(moa_DCTransport_cost) + 1 To UBound(moa_DCTransport_cost)
            moa_DCTransport_cost(ll_i).DCPL_Code = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPL_Code
            moa_DCTransport_cost(ll_i).DCPLLI_code = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLLI_code
            moa_DCTransport_cost(ll_i).DCPLLI_Price = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLLI_Price
            moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLLI_CURR_Code
'            moa_DCTransport_cost(ll_i).DCS_Price = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCS_Price
            moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Price = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLL_Full_Truck_Price
            moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLL_Full_Truck_Min
            moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Max = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLL_Full_Truck_Max
            moa_DCTransport_cost(ll_i).DCPLL_Trailer_min = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).DCPLL_Trailer_min
            moa_DCTransport_cost(ll_i).PriceFormula = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).PriceFormula
            moa_DCTransport_cost(ll_i).FullTruckPriceFormula = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).FullTruckPriceFormula
'            moa_DCTransport_cost(ll_i).SurchargeFormula = moa_DCTransport_cost(C_LEADING_INTRECO_TRAN).SurchargeFormula

        Next
    
        Call UpdateTransportCost_Interco
    
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateIntercoShipmentPrice")
End Sub

Private Sub UpdateSupplierShipmentPrice(ByVal al_masterTransCode As Long, ByVal al_DCPL_Code As Long)
On Error GoTo ErrHandler
    
    If InitTransportCost(al_masterTransCode, al_DCPL_Code) Then
    
        Call UpdateTransportCost_Supplier
    
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateSupplierShipmentPrice")
End Sub

Private Property Let Progress(ByVal ai_Value As Integer)
On Error GoTo ErrHandler
    LockScreen (False)
    prg_progres.Value = ai_Value
    prg_progres.Refresh
    LockScreen (True)
    Exit Property
ErrHandler:
    Call ErrorHandler("Let Progress")
End Property

Private Function Item_UpdateLineValueDB(ByVal al_valueIndex As Long, ByVal as_allowedOperations As String) As Long
On Error GoTo ErrHandler
    Dim ls_req As String

Const CREQ_AV = "EXEC DC_PriceListLine_ins $DCPLL_Code$,$DCPL_Code$,$CT_Code$,$DCPLL_Zip_Code$,$DCPLL_LeadTime$,$Z_Creator$"
Const CREQ_UV = "EXEC DC_PriceListLine_upd $DCPLL_Code$,$CT_Code$,$DCPLL_Zip_Code$,$DCPLL_LeadTime$,$Z_Creator$"
    
    Static ll_DCPLL_Code As Long
    Item_UpdateLineValueDB = 0
    
    If as_allowedOperations = "INIT_A_ID" Then
        ll_DCPLL_Code = -1
        Exit Function
    End If
    
    If as_allowedOperations = "SAVE_A_ID" Then
        If ll_DCPLL_Code <> -1 Then
            Call ExecuteSQLSafe(mo_Db, "UPDATE A_ID SET ID_Value=" & SQLNum(ll_DCPLL_Code) & " WHERE ID_Key=" & SqlStr("DCPLL_Code"), 1)
        End If
        Exit Function
    End If
    
    ls_req = ""
    Select Case grd_lines.Data(al_valueIndex, "Action")
        Case "A"
            If grd_lines.Data(al_valueIndex, "DCPLL_Code") = "NEW" Then
            
                If ll_DCPLL_Code = -1 Then
                    ll_DCPLL_Code = CLng(GetNextRecordID("DCPLL_Code"))
                Else
                    ll_DCPLL_Code = ll_DCPLL_Code + 1
                End If

                grd_lines.Data(al_valueIndex, "DCPLL_Code") = ll_DCPLL_Code
                
                Item_UpdateLineValueDB = CLng(grd_lines.Data(al_valueIndex, "DCPLL_Code"))
                
                ls_req = CREQ_AV
            End If
        Case "U"
            ls_req = CREQ_UV
        Case "D"
            ' NO ACTION, record delete will be done for all not linked to any Item
    End Select
    
    If ls_req = "" Then
        Exit Function
    End If
    
    ls_req = Replace(ls_req, "$DCPLL_Code$", grd_lines.Data(al_valueIndex, "DCPLL_Code"), , , vbTextCompare)
    ls_req = ItemLine_ReplacePlaceholders(ls_req, al_valueIndex)
    
    Call ExecuteSQLSafeFront(mo_Db, ls_req)
    
    Exit Function
ErrHandler:
    Call ErrorHandler("Item_UpdateLineValueDB")
End Function

Private Function Item_UpdateLineItemValueDB(ByVal al_valueIndex As Long, ByVal as_allowedOperations As String) As Long
On Error GoTo ErrHandler
    Dim ls_req As String
    
    Static ll_DCPLLI_Code As Long
    Item_UpdateLineItemValueDB = 0
    
    If as_allowedOperations = "INIT_A_ID" Then
        ll_DCPLLI_Code = -1
        Exit Function
    End If
    
    If as_allowedOperations = "SAVE_A_ID" Then
        If ll_DCPLLI_Code <> -1 Then
            Call ExecuteSQLSafe(mo_Db, "UPDATE A_ID SET ID_Value=" & SQLNum(ll_DCPLLI_Code) & " WHERE ID_Key=" & SqlStr("DCPLLI_Code"), 1)
        End If
        Exit Function
    End If

    If InStr(as_allowedOperations, grd_lines.Data(al_valueIndex, "Action")) = 0 Then Exit Function
    
Const CREQ_AV = "EXEC DC_PriceListLineItem_ins $DCPLLI_Code$,$DCPLL_Code$,$DCPLLI_Qty_min$,$DCPLLI_Qty_max$,$DCPLLI_Price$,$CURR_code$,$PriceFormula$,$IsTrailer$,$IsReturn$,$Z_Creator$"
Const CREQ_UV = "EXEC DC_PriceListLineItem_upd $DCPLLI_Code$,$DCPLLI_Qty_min$,$DCPLLI_Qty_max$,$DCPLLI_Price$,$CURR_code$,$PriceFormula$,$IsTrailer$,$IsReturn$,$Z_Creator$"
Const CREQ_DV = "EXEC DC_PriceListLineItem_del $DCPLLI_Code$,$Z_Creator$,$iConcurrency$"
    
    ls_req = ""
    Select Case grd_lines.Data(al_valueIndex, "Action")
        Case "A"
            If grd_lines.Data(al_valueIndex, "DCPLLI_Code") = "NEW" Then
            
                If ll_DCPLLI_Code = -1 Then
                    ll_DCPLLI_Code = CLng(GetNextRecordID("DCPLLI_Code"))
                Else
                    ll_DCPLLI_Code = ll_DCPLLI_Code + 1
                End If

                grd_lines.Data(al_valueIndex, "DCPLLI_Code") = ll_DCPLLI_Code
                
                Item_UpdateLineItemValueDB = CLng(grd_lines.Data(al_valueIndex, "DCPLLI_Code"))
                
                ls_req = Replace(CREQ_AV, "$DCPLL_Code$", SQLNum(grd_lines.Data(al_valueIndex, "DCPLL_Code")), , , vbTextCompare)
            End If
        Case "U"
            ls_req = CREQ_UV
        Case "D"
            ls_req = CREQ_DV
    End Select
    
    If ls_req = "" Then
        Exit Function
    End If
    
    ls_req = Replace(ls_req, "$DCPLLI_Code$", grd_lines.Data(al_valueIndex, "DCPLLI_Code"), , , vbTextCompare)
    ls_req = ItemLine_ReplacePlaceholders(ls_req, al_valueIndex)
    
    Call ExecuteSQLSafeFront(mo_Db, ls_req)
    
    Exit Function
ErrHandler:
    Call ErrorHandler("Item_UpdateLineItemValueDB")
End Function

Private Function GetPriceListName() As String
On Error GoTo ErrHandler
    GetPriceListName = GetCboValue(cbo_carrier, "CARRIER_Name") & " since " & cal_validityStart.date_longue
    Exit Function
ErrHandler:
    Call ErrorHandler("GetPriceListName")
End Function

Private Function Item_ReplacePlaceholders(ByVal ls_retVal As String) As String
On Error GoTo ErrHandler

    ls_retVal = Replace(ls_retVal, "$DCPL_Name$", SqlStr(GetPriceListName, 50), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DC_CARRIER_Code$", SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$UOM_Code$", SqlStr(GetCboKey(cbo_UOM), 4), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$CURR_code$", SqlStr(GetCboKey(cbo_currency), 5), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$TT_Code$", SqlStr(GetCboKey(cbo_TT_Code), 1), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DropOff_Cost$", SQLNum(txt_dropOffCost.Text), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$FullTruckCalculation$", SqlStr(GetCboKey(cbo_fullTruckCalculation), 1), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Validity_Start$", SqlDate(cal_validityStart.date_dt), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Validity_End$", SqlDate(cal_validityEnd.date_dt), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
    
    Item_ReplacePlaceholders = ls_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler("Item_ReplacePlaceholders")
End Function

Private Function ItemLine_ReplacePlaceholders(ByVal ls_retVal As String, ByVal al_Row As Long) As String
On Error GoTo ErrHandler
    
    ls_retVal = Replace(ls_retVal, "$DCPL_Code$", SQLNum(txt_recordID.Text), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$CT_Code$", SqlStr(grd_lines.Data(al_Row, "CT_Code"), 4), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DCPLL_Zip_Code$", SqlStr(grd_lines.Data(al_Row, "DCPLL_Zip_Code"), 20), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DCPLLI_Qty_min$", SQLNum(grd_lines.Data(al_Row, "DCPLLI_Qty_min")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DCPLLI_Qty_max$", SQLNum(grd_lines.Data(al_Row, "DCPLLI_Qty_max")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DCPLLI_Price$", SQLNum(grd_lines.Data(al_Row, "DCPLLI_Price")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$CURR_code$", SqlStr(grd_lines.Data(al_Row, "DCPLLI_CURR_Code"), 5), , , vbTextCompare)
'    ls_retVal = Replace(ls_retVal, "$DCPLLI_ReturnPrice$", SQLNum(grd_lines.Data(al_Row, "DCPLLI_ReturnPrice")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DCPLL_LeadTime$", SqlDateH(grd_lines.Data(al_Row, "DCPLL_LeadTime")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$PriceFormula$", SqlStr(grd_lines.Data(al_Row, "PriceFormula"), 255), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$IsTrailer$", SqlStr(grd_lines.Data(al_Row, "IsTrailer"), 1), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$IsReturn$", SqlStr(grd_lines.Data(al_Row, "IsReturn"), 1), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$iConcurrency$", SQLNum(grd_lines.Data(al_Row, "iConcurrency")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)

    ItemLine_ReplacePlaceholders = ls_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler("ItemLine_ReplacePlaceholders")
End Function


Private Sub Item_Load(ByVal al_Cursor As Long)
On Error GoTo ErrHandler
    Dim lo_Control As Control
    For Each lo_Control In Controls
        If lo_Control.Tag <> "" Then
            Select Case UCase(TypeName(lo_Control))
            Case "ARMCOMBOBOX"
                If Not lo_Control.SearchItem(mo_Db.GetFields(al_Cursor, lo_Control.Tag)) Then
                    Call lo_Control.Load
                    lo_Control.SearchItem (mo_Db.GetFields(al_Cursor, lo_Control.Tag))
                End If
            Case "ARMPICKER"
            Case "TOOLBARCONTROL"
            Case "ARMGRID"
            Case "ARMTREEVIEW"
            Case "ARMCHECKVIEW"
            Case "A_CALOCX"
                If mo_Db.GetFields(al_Cursor, lo_Control.Tag) = 0 Then
                    lo_Control.reinit_cal
                Else
                    lo_Control.date_courte = Format(mo_Db.GetFields(al_Cursor, lo_Control.Tag), "dd\/mm\/yyyy")
                End If
            Case "TOOLBR"
            Case "TEXTBOX"
                lo_Control.Text = mo_Db.GetFields(al_Cursor, lo_Control.Tag)
            Case "CHECKBOX"
                lo_Control.Value = IIf(mo_Db.GetFields(al_Cursor, lo_Control.Tag) = "", vbUnchecked, vbChecked)
            End Select
        End If
    Next
    
    Call RefreshItemLineGrid
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Load()")
End Sub

Private Sub ItemLine_Load(ByRef ao_grid As ArmGrid)
On Error GoTo ErrHandler
    Dim lo_Control As Control
    
    For Each lo_Control In Controls
        If Not TypeOf lo_Control Is CommonDialog Then
            If Not TypeOf lo_Control.Container Is DC_PriceList Then
                If frm_listDetail.hwnd = lo_Control.Container.hwnd Then
                    If lo_Control.Tag <> "" Then
                        Select Case UCase(TypeName(lo_Control))
                        Case "ARMCOMBOBOX"
                            If Not lo_Control.SearchItem(ao_grid.SelectedLine(0, lo_Control.Tag)) Then
                                Call lo_Control.Load
                                lo_Control.SearchItem (ao_grid.SelectedLine(0, lo_Control.Tag))
                            End If
                        Case "ARMPICKER"
                        Case "TOOLBARCONTROL"
                        Case "ARMGRID"
                        Case "ARMTREEVIEW"
                        Case "ARMCHECKVIEW"
                            ' refresh from database!!!! - not from the grid
                            Call ItemLine_LoadSurcharges(IIf(ao_grid.SelectedLine(0, lo_Control.Tag) = "NEW", 0, ao_grid.SelectedLine(0, lo_Control.Tag)), GetCboKey(cbo_carrier), ao_grid.SelectedLine(0, cbo_country.Tag), ao_grid.SelectedLine(0, txt_zipCode.Tag))
                        Case "A_CALOCX"
                            If ao_grid.SelectedLine(0, lo_Control.Tag) = "" Then
                                lo_Control.reinit_cal
                            Else
                                lo_Control.date_courte = Format(ao_grid.SelectedLine(0, lo_Control.Tag), "dd\/mm\/yyyy")
                            End If
                        Case "TOOLBR"
                        Case "TEXTBOX"
                            lo_Control.Text = ao_grid.SelectedLine(0, lo_Control.Tag)
                        Case "CHECKBOX"
                            lo_Control.Value = IIf(ao_grid.SelectedLine(0, lo_Control.Tag) = "N" Or ao_grid.SelectedLine(0, lo_Control.Tag) = "", vbUnchecked, vbChecked)
                        End Select
                    End If
                End If
            End If
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ItemLine_Load()")
End Sub

Private Function GetVariantArray(ByVal as_Value As String) As Variant
Dim lv_StrArray As Variant, lv_Array As Variant
Dim ll_Index As Long

  If as_Value = "" Then
    lv_Array = Array(as_Value)
  Else
    lv_StrArray = Split(as_Value, SEP)
    ReDim lv_Array(UBound(lv_StrArray))
    For ll_Index = 0 To UBound(lv_StrArray)
      lv_Array(ll_Index) = lv_StrArray(ll_Index)
    Next
  End If
  GetVariantArray = lv_Array

End Function
Private Sub Item_Load_E(ByVal al_recordID As Long, ByVal as_DC_Code As String, ByVal as_CARRIER_Code As String, ByVal as_UOM_Code As String, ByVal ad_validityStart As Date, ByVal ad_validityEnd As Date, ByVal as_dropOffCost As Double, ByVal as_CURR_Code As String, ByVal as_TT_Code As String, ByVal as_fullTruckCalc As String)
On Error GoTo ErrHandler
    
    txt_recordID.Text = al_recordID
    
    If Not SetComboItemValue(cbo_DC, as_DC_Code) Then
        Call MsgBox("Invalid value for Distribution centre:" & as_DC_Code)
    End If
    
    If Not SetComboItemValue(cbo_carrier, as_CARRIER_Code) Then
        Call MsgBox("Invalid value for Carrier:" & as_CARRIER_Code)
    End If
    
'    ckv_surcharges.RoleList("CHARGES").CommonRoleValues = GetVariantArray(as_CARRIER_Code)

    
    If Not SetComboItemValue(cbo_UOM, as_UOM_Code) Then
        Call MsgBox("Invalid value for Units of measure:" & as_UOM_Code)
    End If
    
    If Not SetComboItemValue(cbo_currency, as_CURR_Code) Then
        Call MsgBox("Invalid value for Currency:" & as_CURR_Code)
    End If
    
    cal_validityStart.date_courte = Format(ad_validityStart, "dd\/mm\/yyyy")
    
    If ad_validityEnd = 0 Then
        cal_validityEnd.reinit_cal
    Else
        cal_validityEnd.date_courte = Format(ad_validityEnd, "dd\/mm\/yyyy")
    End If
    
    txt_dropOffCost.Text = as_dropOffCost
    
    Call cbo_TT_Code.SearchItem(as_TT_Code)
    
    Call cbo_fullTruckCalculation.SearchItem(as_fullTruckCalc)
    
    Call RefreshItemLineGrid
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Load_E()")
End Sub

Private Sub ItemLine_Load_E(ByVal av_recordID As Variant, ByVal as_CT_Code As String, ByVal as_zip_code As String, ByVal as_LeadTime As String, ByVal ad_qtyMin As Double, ByVal ad_qtyMax As Double, ByVal ad_Price As Double, ByVal as_CURR_Code As String, ByVal as_PriceFormula As String, ByVal as_IsTrailer As String, ByVal as_IsReturn As String)
On Error GoTo ErrHandler
    
    Debug.Assert (IsArray(av_recordID))
    
    txt_lineID.Text = av_recordID(0)
    
    txt_itemID.Text = av_recordID(1)
    
    If txt_lineID.Text = "NEW" Then
        Set cbo_lineID.SelectedItem = Nothing
    Else
        If Not SetComboItemValue(cbo_lineID, txt_lineID.Text) Then
            Call MsgBox("Invalid value for Price list Line:" & txt_lineID.Text)
        End If
    End If
    
    If Not SetComboItemValue(cbo_country, as_CT_Code) Then
        Call MsgBox("Invalid value for Country:" & as_CT_Code)
    End If
    
    txt_zipCode.Text = as_zip_code
    
    txt_QtyMin.Text = ad_qtyMin
    
    txt_QtyMax.Text = ad_qtyMax
    
    txt_LeadTime.Text = as_LeadTime
    
    txt_Price.Text = ad_Price
    
    If Not SetComboItemValue(cbo_DCPLLI_CURR, as_CURR_Code) Then
        Call MsgBox("Invalid value for Currency:" & as_CURR_Code)
    End If
    
    chk_isReturn.Value = IIf(InStr(1, as_IsReturn, "X", vbTextCompare) <> 0, vbChecked, vbUnchecked)
'    txt_returnPrice.Text = ad_ReturnPrice
    
    chk_isTrailer.Value = IIf(InStr(1, as_IsTrailer, "Y", vbTextCompare) <> 0, vbChecked, vbUnchecked)
    
    txt_priceformula.Text = IIf(as_PriceFormula = "", "Price", as_PriceFormula)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ItemLine_Load_E()")
End Sub


Private Sub RefreshItemLineGrid()
On Error GoTo ErrHandler
    
    ' load the lines grid
Const REQ As String = "EXEC DC_PriceListLine_lst $DCPL_Code$, $LANGUAGE_CODE$"
    Dim ls_req As String
    
    If isNumeric(txt_recordID.Text) Then
    
        ls_req = Replace(REQ, "$LANGUAGE_CODE$", SqlStr(ms_Language_Code, 1, True), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DCPL_Code$", SQLNum(txt_recordID.Text), , , vbTextCompare)
    
        Call LoadGrid(grd_lines, ls_req, "Grid not loaded (DC_PriceListLine_lst)!")
    Else
        grd_lines.Requests = ""
        grd_lines.ClearGrid
    End If

    cbo_lineID.Request = "EXEC DC_PriceListLine_cbo " & SQLNum(txt_recordID.Text) & "," & SqlStr(ms_Language_Code)

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

Private Function BeginTran(as_Tran As String) As Boolean

On Error GoTo ErrHandler
    BeginTran = False
    
    If ms_inTranName <> "" Then
        MsgBox ("Already in transaction!!!!! " & ms_inTranName)
        Exit Function
    End If
    
    ExecuteSQLSafe mo_Db, "BEGIN TRANSACTION " & as_Tran
    
    ms_inTranName = as_Tran

    BeginTran = True
    Exit Function
    
ErrHandler:
    'try to log error
'    Call LogMessage("BeginTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".BeginTran, your application will be close. Please contact your IT support", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End
End Function

Private Function CommitTran(as_Tran As String) As Boolean

On Error GoTo ErrHandler
    CommitTran = False
    
    If ms_inTranName <> as_Tran Then
        Call MsgBox("Warning!!! Commit transaction name does not match!!! " & as_Tran & "<>" & ms_inTranName, vbCritical)
    End If
    
    ExecuteSQLSafe mo_Db, "COMMIT TRANSACTION " & as_Tran

    ms_inTranName = ""
    CommitTran = True
    Exit Function
    
ErrHandler:
    'try to log error
'    Call LogMessage("CommitTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".CommitTran, your application will be close. Please contact your IT support", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End

End Function

Private Function RollbackTran(as_Tran As String) As Boolean
    
    Dim ll_errNumber As Long, ls_ErrSource As String, ls_ErrDesc As String
    ll_errNumber = Err.Number
    ls_ErrSource = Err.Source
    ls_ErrDesc = Err.Description

On Error GoTo ErrHandler
    RollbackTran = False
    
    If ms_inTranName <> as_Tran Then
        Call MsgBox("Warning!!! Rollback transaction name does not match!!! " & as_Tran & "<>" & ms_inTranName, vbCritical)
    End If
    
    ExecuteSQLSafe mo_Db, "ROLLBACK TRANSACTION " & as_Tran
    ms_inTranName = ""


    Err.Number = ll_errNumber
    Err.Source = ls_ErrSource
    Err.Description = ls_ErrDesc

    RollbackTran = True
    Exit Function
    
ErrHandler:
    'try to log error
'    Call LogMessage("RollbackTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".RollbackTran, your application will be close. Please contact your IT support", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End
End Function

Private Sub ImportFromXLS(ByVal as_fileName As String)
On Error GoTo ErrHandler

#If LIVE = 1 Then
    Dim lo_ExcelApp As Object
    Dim lo_WorkBook As Object
    Dim lo_WorkSheet As Object
#Else
    Dim lo_ExcelApp As Excel.Application
    Dim lo_WorkBook As Excel.Workbook
    Dim lo_WorkSheet As Excel.Worksheet
#End If

    Dim lo_found As Boolean

On Error GoTo Err_NotLoaded
        
    Set lo_ExcelApp = GetObject(, "Excel.Application")
    
    If lo_ExcelApp Is Nothing Then
        Set lo_ExcelApp = CreateObject("Excel.Application")
    End If
    
    If lo_ExcelApp Is Nothing Then GoTo ErrHandler
    
On Error GoTo ErrHandler

    Set lo_WorkBook = OpenExcelDocument(lo_ExcelApp, as_fileName, lo_found)
    lo_ExcelApp.ScreenUpdating = False
    lo_ExcelApp.CalculateFullRebuild
    Call lo_WorkBook.Activate
    
    ' collect the list of sheets to pick correct one
    Dim lo_dlg As New DC_PLPicker
    
    lo_dlg.Title = lo_WorkBook.Name & " - Select the sheet to import."
    Set lo_dlg.Db = mo_Db
    
    lo_dlg.TenderCarrier = ml_TenderCarrier
        
    Call lo_dlg.Load_A_COM
    
    Dim ll_firstRow As Long
    Dim lb_sheetFound As Boolean
    Dim lo_lvItem As ListItem
    
    Dim ls_DC_Code As String
    Dim ls_CARRIER_Code As String
    Dim ls_VALIDITY_START As String
    Dim ls_VALIDITY_END As String
    Dim ls_DROP_OFF As String
    Dim ls_UOM_Code As String
    Dim ls_TT_CODE As String
    Dim ls_FULL_TRUCK_CALC As String
    Dim ls_CURR_Code As String
    
    Dim ld_minQty As Double
    Dim ld_maxQty As Double
    Dim ld_qtyStep As Double
'    Dim ld_returnPrice As Double
    Dim ls_returnPrice As String
    Dim ls_Formula As String
    Dim ls_trailer As String
    
    Dim lo_charge As tChargesLocal
    Dim ls_DCS_Code As String
    Dim ls_DCS_formula As String
    Dim ls_DCS_Default As String
    Dim ls_DCPLLI_Curr_code As String
    
    lb_sheetFound = False
    
    For Each lo_WorkSheet In lo_WorkBook.Worksheets
        ll_firstRow = GetFirstDataRow(lo_WorkSheet, C_DC_CODE_COL, C_QUANTITY_ROW + 1)
        If ll_firstRow <> 0 Then
            Set lo_lvItem = lo_dlg.AddItem(lo_WorkSheet.Name, lo_WorkSheet.Name)
            ls_DC_Code = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_DC_CODE_COL))
            
            ls_CARRIER_Code = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_CARRIER_CODE_COL))
            
            ls_VALIDITY_START = lo_WorkSheet.cells(C_PARAMS_ROW, C_VALIDITY_START_COL)
            If Not IsDate(ls_VALIDITY_START) Then ls_VALIDITY_START = ""
            
            ls_VALIDITY_END = lo_WorkSheet.cells(C_PARAMS_ROW, C_VALIDITY_END_COL)
            If Not IsDate(ls_VALIDITY_END) Then ls_VALIDITY_END = ""
            
            ls_DROP_OFF = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_DROP_OFF_COL))
            If Not isNumeric(ls_DROP_OFF) Then ls_DROP_OFF = "0"
            
            ls_UOM_Code = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_UOM_CODE_COL))
            
            ls_CURR_Code = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_CURR_CODE_COL))
            
            ls_TT_CODE = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_TT_CODE_COL))
            
            ls_FULL_TRUCK_CALC = Trim(lo_WorkSheet.cells(C_PARAMS_ROW, C_FULL_TRUCK_CALC_COL))
            
            lo_lvItem.Tag = Join(Array(ll_firstRow, ls_DC_Code, ls_CARRIER_Code, ls_VALIDITY_START, ls_VALIDITY_END, ls_DROP_OFF, ls_UOM_Code, ls_CURR_Code, ls_TT_CODE, ls_FULL_TRUCK_CALC), SEP)
            Call lo_lvItem.ListSubItems.Add(, , lo_WorkSheet.Name)
            lb_sheetFound = True
        End If
    Next
    Set lo_dlg.lv_items.SelectedItem = lo_dlg.lv_items.ListItems(1)
    Call lo_dlg.lv_items_ItemClick(lo_dlg.lv_items.SelectedItem)
    
    Dim lb_closeWorkBook As Boolean
    lb_closeWorkBook = True
    
    If lb_sheetFound Then
        ' select a sheet to import
        Call LockScreen(False)
        Call lo_dlg.show(vbModal)
        DoEvents
        Call LockScreen(True)
        If lo_dlg.Result Then
            Set lo_WorkSheet = lo_WorkBook.Worksheets(lo_dlg.XLSSheetName)
            Call lo_WorkSheet.Activate
            
            ' we can read the data
            Dim ll_Row As Long
            Dim ll_recordID As Long
            Dim lv_recordLineID As Variant
            
            Dim lb_sheetUpdated As Boolean
            lb_sheetUpdated = False
            ll_Row = lo_dlg.FirstRow
            
            If lo_dlg.DC_Code <> lo_WorkSheet.cells(C_PARAMS_ROW, C_DC_CODE_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_DC_CODE_COL) = lo_dlg.DC_Code
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.CARRIER_code <> lo_WorkSheet.cells(C_PARAMS_ROW, C_CARRIER_CODE_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_CARRIER_CODE_COL) = lo_dlg.CARRIER_code
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.ValidityStart <> lo_WorkSheet.cells(C_PARAMS_ROW, C_VALIDITY_START_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_VALIDITY_START_COL) = lo_dlg.ValidityStart
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.ValidityEnd <> lo_WorkSheet.cells(C_PARAMS_ROW, C_VALIDITY_END_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_VALIDITY_END_COL) = lo_dlg.ValidityEnd
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.DropOffCost <> lo_WorkSheet.cells(C_PARAMS_ROW, C_DROP_OFF_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_DROP_OFF_COL) = lo_dlg.DropOffCost
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.UOM_Code <> lo_WorkSheet.cells(C_PARAMS_ROW, C_UOM_CODE_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_UOM_CODE_COL) = lo_dlg.UOM_Code
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.CURR_Code <> lo_WorkSheet.cells(C_PARAMS_ROW, C_CURR_CODE_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_CURR_CODE_COL) = lo_dlg.CURR_Code
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.TT_Code <> lo_WorkSheet.cells(C_PARAMS_ROW, C_TT_CODE_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_TT_CODE_COL) = lo_dlg.TT_Code
                lb_sheetUpdated = True
            End If
            
            If lo_dlg.FullTruckCalculation <> lo_WorkSheet.cells(C_PARAMS_ROW, C_FULL_TRUCK_CALC_COL) Then
                lo_WorkSheet.cells(C_PARAMS_ROW, C_FULL_TRUCK_CALC_COL) = lo_dlg.FullTruckCalculation
                lb_sheetUpdated = True
            End If
            
            ' load the header
            ll_recordID = GetRecordID(lo_dlg.DC_CARRIER_Code, lo_dlg.UOM_Code, lo_dlg.ValidityStart, lo_dlg.TT_Code)
            
            ' Init Updade/Add
            
            mb_chargesLocalOnly = True              ' all database charges are ignored in view and removed in update
            
            Call Item_Clear
            
            Call ItemLine_LoadSurcharges(0, lo_dlg.CARRIER_code, "", "")    ' we do not care about existing records for CT/ZIP
            
            Call LockScreen(False)
            
            If ll_recordID <> -1 Then
                Call Item_Load_E(ll_recordID, lo_dlg.DC_Code, lo_dlg.CARRIER_code, lo_dlg.UOM_Code, lo_dlg.ValidityStart, lo_dlg.ValidityEnd, lo_dlg.DropOffCost, lo_dlg.CURR_Code, lo_dlg.TT_Code, lo_dlg.FullTruckCalculation)
                Call UpdateUI(ArmScreenMode.smUpdate, ArmScreenMode.smMain)
            Else
                ' generate new record into DC_PriceListHeader
                ll_recordID = GetNextRecordID("DCPL_Code")
                Call Item_Load_E(ll_recordID, lo_dlg.DC_Code, lo_dlg.CARRIER_code, lo_dlg.UOM_Code, lo_dlg.ValidityStart, lo_dlg.ValidityEnd, lo_dlg.DropOffCost, lo_dlg.CURR_Code, lo_dlg.TT_Code, lo_dlg.FullTruckCalculation)
                Call UpdateUI(ArmScreenMode.smAdd, ArmScreenMode.smMain)
            End If
            
            ' smMain is with hidden detail screen and the rolelist for surcharges is 'MAIN', but in this case we prefere 'CHARGES'
            Call ckv_surcharges.SetVisibleList("CHARGES")
            
            grd_lines.Redraw = False
            
            Dim lb_detailedImport As Boolean
            lb_detailedImport = lo_WorkSheet.cells(ll_Row - 2, C_CT_CODE_COL) = "EXT"           ' If it is standard or extended
            
            While Not IsLastExcellRow(lo_WorkSheet, ll_Row)
            
                ll_Row = NextExcellRow(lo_WorkSheet, ll_Row)
                
                If lo_WorkSheet.cells(ll_Row, C_CT_CODE_COL) <> "" Then
                    Dim ll_Col As Long
                    
                    Dim ls_CT_Code As String
                    Dim ls_ZIP_Code As String
                    Dim ls_LeadTime As String
                    
                    ls_CT_Code = lo_WorkSheet.cells(ll_Row, C_CT_CODE_COL)
                    ls_ZIP_Code = lo_WorkSheet.cells(ll_Row, C_POST_CODE_COL).Text
                    ls_LeadTime = lo_WorkSheet.cells(ll_Row, C_LEAD_TIME_COL)
                    
                    If Trim(ls_LeadTime) = "" Then
                        ls_LeadTime = "0"
                    End If
                    
                    ld_qtyStep = 0
                    ld_minQty = -10000
                    ld_maxQty = 0
                    ls_Formula = ""
'                    ld_returnPrice = 0
                    ls_returnPrice = ""
                    ls_trailer = ""
                    ls_DCPLLI_Curr_code = lo_dlg.CURR_Code

                    
                    ls_DCS_Code = ""
                    ls_DCS_formula = ""
                    ls_DCS_Default = ""

                    ll_Col = C_DATA_COL
                    While Not IsLastExcellCol(lo_WorkSheet, C_QUANTITY_ROW, ll_Col)
                        
                        ll_Col = NextExcellCol(lo_WorkSheet, C_QUANTITY_ROW, ll_Col)
                        
                        ' check if there is no error in the cell
                        
                        If IsError(lo_WorkSheet.cells(ll_Row, ll_Col)) Then
                            Call MsgBox("Error on row " & ll_Row & " col " & ll_Col & " Import will skip the cell.", vbOKOnly Or vbExclamation)
                            GoTo continue
                        End If
                        
                        If Trim(lo_WorkSheet.cells(ll_Row, ll_Col)) <> "" Then
                        
                            If lb_detailedImport Then
                                ' It is APC style template ( more detailed )
                                
                                Select Case UCase(lo_WorkSheet.cells(C_QUANTITY_ROW, ll_Col))
                                Case "STEP"
                                    ld_qtyStep = lo_WorkSheet.cells(ll_Row, ll_Col)
                                Case "TRAILER"
                                    ls_trailer = lo_WorkSheet.cells(ll_Row, ll_Col)
                                Case "MIN QTY"
                                    ld_minQty = lo_WorkSheet.cells(ll_Row, ll_Col)
                                Case "F"
'                                    ls_Formula = lo_regex.Replace(lo_WorkSheet.cells(ll_Row, ll_col), ".")
                                    ls_Formula = ReplaceDecimalSeparator(lo_WorkSheet.cells(ll_Row, ll_Col))
                                Case "MAX QTY"
                                    If ld_minQty = -10000 Then
                                        ld_minQty = ld_maxQty + ld_qtyStep
                                    End If
                                    
                                    ld_maxQty = lo_WorkSheet.cells(ll_Row, ll_Col)
                                Case "RETURN PRICE"
                                    ls_returnPrice = lo_WorkSheet.cells(ll_Row, ll_Col)
'                                    ld_returnPrice = lo_WorkSheet.cells(ll_Row, ll_col)
                                Case "SCODE"
                                    ls_DCS_Code = Trim(lo_WorkSheet.cells(ll_Row, ll_Col))
                                Case "SF"
                                    ls_DCS_formula = ReplaceDecimalSeparator(lo_WorkSheet.cells(ll_Row, ll_Col))
                                Case "CURR"
                                    If Trim(lo_WorkSheet.cells(ll_Row, ll_Col)) <> "" Then
                                        ls_DCPLLI_Curr_code = lo_WorkSheet.cells(ll_Row, ll_Col)
                                    End If
                                Case "SDEFAULT"
                                    ls_DCS_Default = lo_WorkSheet.cells(ll_Row, ll_Col)
                                Case "SPRICE"
                                    ' insert the surcharge
                                    If ls_DCS_Code <> "" Then
                                        
                                        lo_charge.DCS_Code = ls_DCS_Code
                                        lo_charge.DCS_Desc = ""
                                        lo_charge.DCS_Formula = IIf(ls_DCS_formula = "", "Price", ls_DCS_formula)
                                        lo_charge.DCS_Default = ls_DCS_Default
                                        lo_charge.DCS_Price = lo_WorkSheet.cells(ll_Row, ll_Col)
                                        lo_charge.DCS_LinkedTrans = -1                  ' indicate uninitialized value
                                        lo_charge.action = "A"
                                        
                                        Call moa_ChargesLocal.Add(ls_CT_Code & SEP & ls_ZIP_Code & SEP & ls_DCS_Code, EncodeChargesLocal(lo_charge))
                                        
                                        ls_DCS_Default = ""
                                        ls_DCS_Code = ""
                                    End If

                                Case "PRICE"
                                    ' do the line insert
                                    lv_recordLineID = GetRecordLineID(grd_lines, ls_CT_Code, ls_ZIP_Code, ld_minQty, ld_maxQty)
                                    Debug.Assert (IsArray(lv_recordLineID))
                                    
                                    If lv_recordLineID(UBound(lv_recordLineID)) = "NEW" Then
                                        ' generate new record into DC_PriceListHeader
                                        Call ItemLine_Load_E(lv_recordLineID, ls_CT_Code, ls_ZIP_Code, ls_LeadTime, ld_minQty, ld_maxQty, lo_WorkSheet.cells(ll_Row, ll_Col), ls_DCPLLI_Curr_code, ls_Formula, ls_trailer, ls_returnPrice)
                                        Call ItemLine_Add(False)
                                    Else
                                        Call ItemLine_Load_E(lv_recordLineID, ls_CT_Code, ls_ZIP_Code, ls_LeadTime, ld_minQty, ld_maxQty, lo_WorkSheet.cells(ll_Row, ll_Col), ls_DCPLLI_Curr_code, ls_Formula, ls_trailer, ls_returnPrice)
                                        Call ItemLine_Update("x")
                                    End If
                                    
                                    ' Clean variables
                                    ld_minQty = -10000
'                                    ld_returnPrice = 0
                                    ls_trailer = ""
                                    
                                End Select
                                
                            Else
                                ' It is standard template
                                If UCase(lo_WorkSheet.cells(C_FLAG_ROW, ll_Col)) = "S" Then
                                    ' surcharge
                                    If lo_WorkSheet.cells(ll_Row, ll_Col) <> "" Then
                                        lo_charge.DCS_Code = lo_WorkSheet.cells(ll_Row, ll_Col)
                                        lo_charge.DCS_Desc = ""
                                        lo_charge.DCS_Formula = ReplaceDecimalSeparator(lo_WorkSheet.cells(ll_Row, ll_Col + 1))
                                        lo_charge.DCS_Default = lo_WorkSheet.cells(ll_Row, ll_Col + 2)
                                        lo_charge.DCS_Price = lo_WorkSheet.cells(ll_Row, ll_Col + 3)
                                        lo_charge.DCS_LinkedTrans = -1
                                        lo_charge.action = "A"
                                        
                                        Call moa_ChargesLocal.Add(ls_CT_Code & SEP & ls_ZIP_Code & SEP & Trim(lo_WorkSheet.cells(ll_Row, ll_Col)), EncodeChargesLocal(lo_charge))
                                    End If
                                    
                                    ll_Col = ll_Col + 3
                                Else
                                    ' standard price
                                    Dim lsa_minMaxQty() As String
                                    lsa_minMaxQty = Split(lo_WorkSheet.cells(C_QUANTITY_ROW, ll_Col), "-")
                                    
                                    If UBound(lsa_minMaxQty) = 0 Then
                                        ld_minQty = lsa_minMaxQty(0)
                                        ld_maxQty = lsa_minMaxQty(0)
                                    Else
                                        ld_minQty = lsa_minMaxQty(0)
                                        ld_maxQty = lsa_minMaxQty(1)
                                    End If
                            
                                    lv_recordLineID = GetRecordLineID(grd_lines, ls_CT_Code, ls_ZIP_Code, ld_minQty, ld_maxQty)
                                    Debug.Assert (IsArray(lv_recordLineID))
                                   
                                 If lv_recordLineID(UBound(lv_recordLineID)) = "NEW" Then
                                        ' generate new record into DC_PriceListHeader
                                        Call ItemLine_Load_E(lv_recordLineID, ls_CT_Code, ls_ZIP_Code, ls_LeadTime, ld_minQty, ld_maxQty, lo_WorkSheet.cells(ll_Row, ll_Col), ls_DCPLLI_Curr_code, ReplaceDecimalSeparator(Trim(lo_WorkSheet.cells(C_FORMULA_ROW, ll_Col))), Trim(lo_WorkSheet.cells(C_FLAG_ROW, ll_Col)), Trim(lo_WorkSheet.cells(C_FLAG_ROW, ll_Col)))
                                        Call ItemLine_Add(False)
                                    Else
                                        Call ItemLine_Load_E(lv_recordLineID, ls_CT_Code, ls_ZIP_Code, ls_LeadTime, ld_minQty, ld_maxQty, lo_WorkSheet.cells(ll_Row, ll_Col), ls_DCPLLI_Curr_code, ReplaceDecimalSeparator(Trim(lo_WorkSheet.cells(C_FORMULA_ROW, ll_Col))), Trim(lo_WorkSheet.cells(C_FLAG_ROW, ll_Col)), Trim(lo_WorkSheet.cells(C_FLAG_ROW, ll_Col)))
                                        Call ItemLine_Update("x")
                                    End If
                                End If
                            End If
                        End If
continue:
                        ll_Col = ll_Col + 1
                    Wend
                End If
                ll_Row = ll_Row + 1
            Wend
            
            ' each not updated line we update to to be dropped
            If grd_lines.FirstLine Then
                Do
                    If grd_lines.SelectedLine(0, "Action") = "" Then
                        Call UpdateGridAfterAction(grd_lines, "Del2", grd_lines.SelectedKey(0))
                    ElseIf grd_lines.SelectedLine(0, "Action") = "x" Then
                        grd_lines.SelectedLine(0, "Action") = ""
                    End If
                Loop While grd_lines.NextLine
                
            End If
            
            grd_lines.Redraw = True
            Call LockScreen(True)

            If lb_sheetUpdated Then
                Call lo_WorkBook.Save
                If Not lo_WorkBook.Saved Then
                    lb_closeWorkBook = False
                    lo_ExcelApp.ScreenUpdating = True
                    MsgBox ("File is locked by another instance. Please save it with different name and use as a souce for futher updates.")
                End If
            End If
        End If
    Else
        ' no valid sheet found
        Call MsgBox("No valid sheet found.")
    End If
    
    If lb_closeWorkBook Then
        Call lo_WorkBook.Close(True)
        lo_ExcelApp.ScreenUpdating = True
    End If
    
    Set lo_WorkSheet = Nothing
    Set lo_WorkBook = Nothing
    Set lo_ExcelApp = Nothing
    
    Exit Sub
    
Err_NotLoaded:
    If Err.Number = 429 Then
        Resume Next
    End If
ErrHandler:
    'Resume Next
    Call ErrorHandler("ImportFromXLS")
End Sub

Private Function ReplaceDecimalSeparator(ByVal as_String As String) As String
On Error GoTo ErrHandler

    as_String = Replace(as_String, DecimalSeparator & "0", ".0", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "1", ".1", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "2", ".2", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "3", ".3", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "4", ".4", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "5", ".5", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "6", ".6", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "7", ".7", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "8", ".8", , , vbTextCompare)
    as_String = Replace(as_String, DecimalSeparator & "9", ".9", , , vbTextCompare)
    
    ReplaceDecimalSeparator = as_String
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplaceDecimalSeparator")
End Function

Private Function GetRecordLineID(ByRef ao_grid As ArmGrid, ByVal as_CT_Code As String, ByVal as_ZipCode As String, ByVal ad_qtyMin As Double, ByVal as_qtyMax As Double) As Variant
On Error GoTo ErrHandler
    
    Dim ll_DCPLL_Code As String
    Dim ll_DCPLLI_Code As String
    
    ao_grid.Columns("DCPLL_Code").Key = False
    ao_grid.Columns("DCPLLI_Code").Key = False
    
    ao_grid.Columns("CT_Code").Key = True
    ao_grid.Columns("DCPLL_Zip_Code").Key = True
    
    If ao_grid.SearchKey(True, Array(as_CT_Code, as_ZipCode)) Then
        ll_DCPLL_Code = ao_grid.SelectedLine(0, "DCPLL_Code")
        
        ' try to search also qty
        ao_grid.Columns("DCPLLI_Qty_min").Key = True
        ao_grid.Columns("DCPLLI_Qty_max").Key = True
        
        If ao_grid.SearchKey(False, Array(as_CT_Code, as_ZipCode, ad_qtyMin, as_qtyMax)) Then
            ll_DCPLLI_Code = ao_grid.SelectedLine(0, "DCPLLI_Code")
        Else
            ll_DCPLLI_Code = "NEW"
        End If
        
        ao_grid.Columns("DCPLLI_Qty_min").Key = False
        ao_grid.Columns("DCPLLI_Qty_max").Key = False
        
    Else
        ll_DCPLL_Code = "NEW"
        ll_DCPLLI_Code = "NEW"
    End If
    
    ao_grid.Columns("CT_Code").Key = False
    ao_grid.Columns("DCPLL_Zip_Code").Key = False
    
    ao_grid.Columns("DCPLL_Code").Key = True
    ao_grid.Columns("DCPLLI_Code").Key = True
    
    GetRecordLineID = Array(ll_DCPLL_Code, ll_DCPLLI_Code)
    Exit Function
ErrHandler:
    Call ErrorHandler("GetRecordLineID")
End Function


Private Function GetRecordID(ByVal al_DC_CARRIER_Code As Long, ByVal as_UOM_Code As String, ByVal as_ValidityStart As String, ByVal as_TT_Code As String) As Long
On Error GoTo ErrHandler
    GetRecordID = -1
    Const C_REQ As String = "SELECT DCPL_Code, iConcurrency FROM DC_PriceListHeader " & _
                            "WHERE DC_CARRIER_Code=$DC_CARRIER_Code$ AND UOM_Code=$UOM_Code$ AND Validity_Start = $Validity_Start$ AND TT_Code=$TT_Code$ AND Drop_Flag <> 'X'"
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = Replace(C_REQ, "$DC_CARRIER_Code$", SQLNum(al_DC_CARRIER_Code), , , vbTextCompare)
    ls_req = Replace(ls_req, "$UOM_Code$", SqlStr(as_UOM_Code, 4), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Validity_Start$", SqlDate(as_ValidityStart), , , vbTextCompare)
    ls_req = Replace(ls_req, "$TT_Code$", SqlStr(as_TT_Code, 1), , , vbTextCompare)
    
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_Cursor) >= 1 Then
        GetRecordID = mo_Db.GetFields(ll_Cursor, "DCPL_Code")
        ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    Exit Function
ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("GetRecordID")
End Function

Private Function GetNextRecordID(ByVal as_ID As String) As Long
On Error GoTo ErrHandler
    

    Dim ls_retVal As String
    ls_retVal = mo_Db.SQLNextID(as_ID)
    If ls_retVal = "" Then
        Call Err.Raise(666, "SQLNextID", "Missing A_ID for '" & as_ID & "'")
    End If
    
    GetNextRecordID = ls_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler("GetNextRecordID")
End Function


Private Function GetFirstDataRow(ByRef ao_workSheet As Object, ByVal al_columNb As Long, ByVal al_Row As Long) As Long
    GetFirstDataRow = 0
    While ao_workSheet.cells(al_Row, al_columNb) = ""
        al_Row = al_Row + 1
        If al_Row > 10 Then
            Exit Function
        End If
    Wend
    GetFirstDataRow = al_Row
End Function

Private Function OpenExcelDocument(ByRef ao_ExcelApp As Object, ByVal as_Name As String, ByRef ab_found As Boolean) As Object
On Error GoTo ErrorHandler
    
    Set OpenExcelDocument = Nothing
    
    Dim lo_WorkBook As Object
    
    ab_found = False
    For Each lo_WorkBook In ao_ExcelApp.Workbooks
      If StrComp(lo_WorkBook.FullName, as_Name, vbTextCompare) = 0 Then
        Set OpenExcelDocument = lo_WorkBook
        ab_found = True
        Exit Function
      End If
    Next
    
    Set OpenExcelDocument = ao_ExcelApp.Workbooks.Open(as_Name)
    Exit Function
    
ErrorHandler:
    Call ErrorHandler("OpenExcelDocument")
End Function

Private Function SetComboItemValue(ByRef ao_cbo As ArmCombobox, ByVal as_Key As String) As Boolean
On Error GoTo ErrorHandler
    SetComboItemValue = True
    If Not ao_cbo.SearchItem(as_Key) Then
        Call ao_cbo.Load
        SetComboItemValue = ao_cbo.SearchItem(as_Key)
    End If
    Exit Function
ErrorHandler:
    Call ErrorHandler("SetComboItemValue")
End Function


' if there is 20 following lines emty we assume it is the last row
Private Function IsLastExcellRow(ByRef ao_workSheet As Object, ByVal al_Row As Long) As Boolean
On Error GoTo ErrorHandler
    IsLastExcellRow = True
    
    Dim ll_i As Long
    For ll_i = 0 To 20
        If ao_workSheet.cells(al_Row + ll_i, C_CT_CODE_COL) <> "" Then
            IsLastExcellRow = False
            Exit Function
        End If
    
    Next

    Exit Function
ErrorHandler:
    Call ErrorHandler("IsLastExcellRow")
End Function

Private Function IsLastExcellCol(ByRef ao_workSheet As Object, ByVal al_Row As Long, ByVal al_Col As Long) As Boolean
On Error GoTo ErrorHandler
    IsLastExcellCol = True
    
    Dim ll_i As Long
    For ll_i = 0 To 10
        If Trim(ao_workSheet.cells(al_Row, al_Col + ll_i)) <> "" Then
            IsLastExcellCol = False
            Exit Function
        End If
    
    Next

    Exit Function
ErrorHandler:
    Call ErrorHandler("IsLastExcellCol")
End Function


Private Function NextExcellRow(ByRef ao_workSheet As Object, ByVal al_Row As Long) As Long
On Error GoTo ErrorHandler
    While Trim(ao_workSheet.cells(al_Row, C_CT_CODE_COL)) = ""
        al_Row = al_Row + 1
    Wend

    NextExcellRow = al_Row
    Exit Function
ErrorHandler:
    Call ErrorHandler("NextExcellRow")
End Function

Private Function NextExcellCol(ByRef ao_workSheet As Object, ByVal al_Row As Long, ByVal al_Col As Long) As Long
On Error GoTo ErrorHandler
    While Trim(ao_workSheet.cells(al_Row, al_Col)) = ""
        al_Col = al_Col + 1
    Wend

    NextExcellCol = al_Col
    Exit Function
ErrorHandler:
    Call ErrorHandler("NextExcellCol")
End Function


Private 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 = Replace(DB_REQ, "$id$", aID, , , vbTextCompare)
    lRequest = Replace(lRequest, "$lang$", aLang, , , vbTextCompare)
    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


' ************************************* TRANSACTION COST RECALC SUPPORT **************************************

Private Function UniqueTransactions(ByVal al_Cursor As Long) As Long
On Error GoTo ErrHandler
    
    Call mo_Db.First(al_Cursor)
    
    Dim ll_oldTran As Long
    ll_oldTran = 0
    
    Dim ll_tranCount As Long
    ll_tranCount = 0
    
    While Not mo_Db.EOF(al_Cursor)
        If ll_oldTran <> mo_Db.GetFields(al_Cursor, "TRANS_Code") Then
            ll_oldTran = mo_Db.GetFields(al_Cursor, "TRANS_Code")
            ll_tranCount = ll_tranCount + 1
        End If
        Call mo_Db.Next(al_Cursor)
    Wend

    UniqueTransactions = ll_tranCount
    Exit Function
ErrHandler:
    Call ErrorHandler(".UniqueTransactions()")
End Function

Private Function UniqueSurcharges(ByVal al_Cursor As Long) As Long
On Error GoTo ErrHandler

    Dim ll_TRANS_Code As Long
    ll_TRANS_Code = mo_Db.GetFields(al_Cursor, "TRANS_code")
    
    Dim ll_surchCount As Long
    ll_surchCount = 0
    
    Dim ll_oldPos As Long
    ll_oldPos = mo_Db.Position(al_Cursor)
    
    While Not mo_Db.EOF(al_Cursor)
        If ll_TRANS_Code = mo_Db.GetFields(al_Cursor, "TRANS_Code") Then
            ll_surchCount = ll_surchCount + 1
        End If
        Call mo_Db.Next(al_Cursor)
    Wend
    
    mo_Db.Position(al_Cursor) = ll_oldPos
    
    UniqueSurcharges = ll_surchCount
    Exit Function
ErrHandler:
    Call ErrorHandler(".UniqueSurcharges()")
End Function

Private Function InitTransportCost(ByVal al_masterTran As Long, ByVal al_DCPL_Code As Long) As Boolean
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC DC_PriceListPrice_lst $DCPL_Code$, $MASTER_TRANS_code$, NULL"
    
    InitTransportCost = False
    
    Dim ll_Cursor As Long
    Dim ll_Rows As Long
    ll_Rows = 0
    
    Dim ll_surchRows As Long
    Dim ll_i As Long
    Dim ll_i_surch As Long
    
    Dim ls_req As String

    ls_req = Replace(C_REQ, "$DCPL_Code$", SQLNum(al_DCPL_Code), , , vbTextCompare)
    ls_req = Replace(ls_req, "$MASTER_TRANS_code$", SQLNum(al_masterTran), , vbTextCompare)

    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    ll_Rows = UniqueTransactions(ll_Cursor)
        
    If ll_Rows > 0 Then

        ReDim moa_DCTransport_cost(ll_Rows - 1) As tDCTransport_cost
    
        ll_i = LBound(moa_DCTransport_cost)
        Call mo_Db.First(ll_Cursor)

        Dim ll_oldTran As Long
        ll_oldTran = 0
            
        While Not mo_Db.EOF(ll_Cursor)
            If ll_oldTran <> mo_Db.GetFields(ll_Cursor, "TRANS_Code") Then
                ll_oldTran = mo_Db.GetFields(ll_Cursor, "TRANS_Code")
                    
                moa_DCTransport_cost(ll_i).DCPL_Code = al_DCPL_Code
                moa_DCTransport_cost(ll_i).TRANS_Code = mo_Db.GetFields(ll_Cursor, "TRANS_code")
                moa_DCTransport_cost(ll_i).UOM_Code = mo_Db.GetFields(ll_Cursor, "UOM_code")
                moa_DCTransport_cost(ll_i).Quantity = mo_Db.GetFields(ll_Cursor, "Quantity")
                moa_DCTransport_cost(ll_i).Quantity_loaded = mo_Db.GetFields(ll_Cursor, "Quantity_loaded")
            
                moa_DCTransport_cost(ll_i).DCPLLI_code = mo_Db.GetFields(ll_Cursor, "DCPLLI_Code")
                moa_DCTransport_cost(ll_i).DCPLLI_Price = mo_Db.GetFields(ll_Cursor, "DCPLLI_Price")
                moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code = mo_Db.GetFields(ll_Cursor, "DCPLLI_CURR_Code")
                moa_DCTransport_cost(ll_i).Manual_Cost = mo_Db.GetFields(ll_Cursor, "Manual_Cost")
                moa_DCTransport_cost(ll_i).Surcharge_Cost = mo_Db.GetFields(ll_Cursor, "Surcharge_Cost")
                
                moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Price = mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_Price")
            
                If mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_min") <> 0 Then
                    moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min = mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_min")
                Else
                    moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min = GetTranQty(ll_i, QTY_FOR_TRANSPORT)
                End If
            
                If mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_max") <> 0 Then
                    moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Max = mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_max")
                Else
                    moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Max = GetTranQty(ll_i, QTY_FOR_COST)
                End If
                moa_DCTransport_cost(ll_i).DCPLL_Trailer_min = mo_Db.GetFields(ll_Cursor, "DCPLL_Trailer_min")
        
                moa_DCTransport_cost(ll_i).PriceFormula = mo_Db.GetFields(ll_Cursor, "PriceFormula")
                moa_DCTransport_cost(ll_i).FullTruckPriceFormula = mo_Db.GetFields(ll_Cursor, "FullTruckPriceFormula")
                    
                ' dimension for surcharge info
                ll_surchRows = UniqueSurcharges(ll_Cursor)
                ReDim moa_DCTransport_cost(ll_i).SurchargeInfo(ll_surchRows - 1) As tDCSurcharge_cost
                ll_i_surch = LBound(moa_DCTransport_cost(ll_i).SurchargeInfo)
                
                moa_DCTransport_cost(ll_i).SurchargeInfo(ll_i_surch).DCS_Code = mo_Db.GetFields(ll_Cursor, "DCS_Code")
                moa_DCTransport_cost(ll_i).SurchargeInfo(ll_i_surch).SurchargeFormula = mo_Db.GetFields(ll_Cursor, "SurchargeFormula")
                moa_DCTransport_cost(ll_i).SurchargeInfo(ll_i_surch).DCS_Price = mo_Db.GetFields(ll_Cursor, "DCS_Price")
                moa_DCTransport_cost(ll_i).SurchargeInfo(ll_i_surch).DCS_quantity = mo_Db.GetFields(ll_Cursor, "DCS_quantity")

                ll_i_surch = ll_i_surch + 1
                ll_i = ll_i + 1
            Else
                ' only load next surcharge
                moa_DCTransport_cost(ll_i - 1).SurchargeInfo(ll_i_surch).DCS_Code = mo_Db.GetFields(ll_Cursor, "DCS_Code")
                moa_DCTransport_cost(ll_i - 1).SurchargeInfo(ll_i_surch).SurchargeFormula = mo_Db.GetFields(ll_Cursor, "SurchargeFormula")
                moa_DCTransport_cost(ll_i - 1).SurchargeInfo(ll_i_surch).DCS_Price = mo_Db.GetFields(ll_Cursor, "DCS_Price")
                moa_DCTransport_cost(ll_i - 1).SurchargeInfo(ll_i_surch).DCS_quantity = mo_Db.GetFields(ll_Cursor, "DCS_quantity")
                ll_i_surch = ll_i_surch + 1
            End If
            
            Call mo_Db.Next(ll_Cursor)
        Wend
        InitTransportCost = True
    Else
        ReDim moa_DCTransport_cost(0) As tDCTransport_cost
        ReDim moa_DCTransport_cost(0).SurchargeInfo(0) As tDCSurcharge_cost

        moa_DCTransport_cost(0).SurchargeInfo(0).DCS_Code = ""       ' to indicate no surchage
    End If

    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("InitTransportCost()")
End Function

Private Function GetDCTransportLine(ByVal al_TRANS_Code As Long) As Long
On Error GoTo ErrHandler
    Dim ll_i As Long
    
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
        If moa_DCTransport_cost(ll_i).TRANS_Code = al_TRANS_Code Then
            GetDCTransportLine = ll_i
            Exit For
        End If
    Next

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

Private Function GetTranQty(ByVal al_Idx As Long, ByVal ab_forTransport As Boolean) As Double
On Error GoTo ErrHandler
    
    Dim ld_orderQty As Double
    Dim ld_realQty As Double
    
    ld_orderQty = moa_DCTransport_cost(al_Idx).Quantity
    
    ld_realQty = moa_DCTransport_cost(al_Idx).Quantity_loaded
    
    If ab_forTransport Then
        GetTranQty = IIf(ld_realQty = 0, ld_orderQty, ld_realQty)
    Else
        GetTranQty = Max(ld_orderQty, ld_realQty)
    End If
    
    Exit Function
ErrHandler:
    Call ErrorHandler("GetTranQty()")
End Function

Private Function Max(ByVal ad_val1 As Double, ByVal ad_val2 As Double) As Double
On Error GoTo ErrHandler

    Max = IIf(ad_val1 > ad_val2, ad_val1, ad_val2)

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

Private Sub UpdateTransportCost_all(ByVal ad_dropOffCost As Double, ByVal as_FullTruckCalculation As String)
On Error GoTo ErrHandler
    
    Dim lb_isFullTruck As Boolean
    Dim lb_isFullTruckCost As Boolean
    Dim lb_overLoaded As Boolean
    Dim lb_overLoadedCost As Boolean
    Dim lb_mixedUOM As Boolean
    Dim lb_isTrailer As Boolean
    
    Call CheckTransportCost(ad_dropOffCost, as_FullTruckCalculation, lb_isFullTruck, lb_overLoaded, lb_overLoadedCost, lb_mixedUOM, lb_isFullTruckCost, lb_isTrailer)
    
    Debug.Assert (Not lb_overLoaded)
    Debug.Assert (Not lb_mixedUOM)
    
    Dim ll_mostExpensiveLine As Long
    ll_mostExpensiveLine = GetMostExpensiveTransportLine()
    
Const C_REQ_DEL As String = "DELETE FROM DC_Cost WHERE TRANS_Code=$TRANS_Code$ AND DCC_type IN ('T', 'D', 'S')"
Const C_REQ_INS As String = "EXEC DC_Cost_ins $TRANS_Code$,$DCC_type$,$DCPLLI_Code$,$CURR_code$,$DC_Cost$,$DC_Comment$, $Z_Creator$"

    ' update the transport cost for each transaction
    Dim ld_qtyCost As Double
    ld_qtyCost = GetTotalQty(QTY_FOR_COST)
    
    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
    
        Dim ll_TRANS_Code As Long
        ll_TRANS_Code = moa_DCTransport_cost(ll_i).TRANS_Code
        
        'DELETE EXISTING PRICES
        Call ExecuteSQLSafe(mo_Db, Replace(C_REQ_DEL, "$TRANS_Code$", SQLNum(ll_TRANS_Code), , , vbTextCompare))
        
        Dim ls_req As String
    
        ' get the data and update them
        ls_req = Replace(C_REQ_INS, "$TRANS_Code$", SQLNum(ll_TRANS_Code), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DCPLLI_Code$", SQLNum(moa_DCTransport_cost(ll_i).DCPLLI_code), , , vbTextCompare)
        
        Dim ld_transportCost As Double
        ld_transportCost = 0
        
        If lb_isFullTruckCost Then
            ' if we are not in master transaction then generate dropoff cost
            If ll_mostExpensiveLine = ll_i Then
                If moa_DCTransport_cost(ll_i).DCPLLI_code <> 0 Then
                    ' insert full truck transport cost for most expensive transport
                    ls_req = Replace(ls_req, "$DCC_type$", SqlStr("T", 1), , , vbTextCompare)
                    
                    If lb_isTrailer Then
                        ' have to go into database for specific trailer cost
                        Call UpdatePriceTrailer_tran(moa_DCTransport_cost(ll_i), ld_qtyCost)
                    End If
                    
                    ld_transportCost = GetPriceFullTruck(moa_DCTransport_cost(ll_i), ld_qtyCost)
                Else
                    ' cancel creation of transport cost
                    ls_req = ""
                End If
            Else
                ' generate dropoff cost
                ld_transportCost = ad_dropOffCost
                ls_req = Replace(ls_req, "$DCC_type$", SqlStr("D", 1), , , vbTextCompare)
            End If
        Else
            ' generate the transport cost
            If moa_DCTransport_cost(ll_i).DCPLLI_code <> 0 Then
                ld_transportCost = GetPrice(moa_DCTransport_cost(ll_i))
                ls_req = Replace(ls_req, "$DCC_type$", SqlStr("T", 1), , , vbTextCompare)
            Else
                ' cancel creation of transport cost
                ls_req = ""
            End If
        End If
        
        If ls_req <> "" Then
            ls_req = Replace(ls_req, "$DC_Cost$", SQLNum(ld_transportCost), , , vbTextCompare)
            ls_req = Replace(ls_req, "$DC_Comment$", SqlStr(""), , , vbTextCompare)
            ls_req = Replace(ls_req, "$CURR_code$", SqlStr(moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code), , , vbTextCompare)
            ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
        
            Call ExecuteSQLSafe(mo_Db, ls_req)
        End If
        
        ' generate surcharge if there is some price
        Call UpdateSurchargeCost(moa_DCTransport_cost(ll_i), ld_transportCost)
    
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateTransportCost_all()")
End Sub

Private Sub UpdateSurchargeCost(ByRef ao_cost As tDCTransport_cost, ByVal ad_transportCost As Double)
On Error GoTo ErrHandler
Const C_REQ_INS As String = "EXEC DC_Cost_ins $TRANS_Code$,$DCC_type$,$DCPLLI_Code$,$CURR_code$,$DC_Cost$,$DC_Comment$, $Z_Creator$"

    ' generate surcharge if there is some price
    Debug.Assert (UBound(ao_cost.SurchargeInfo) >= 0)
    
    If ao_cost.SurchargeInfo(0).DCS_Code <> "" Then

        ao_cost.Surcharge_Cost = 0
        
        Dim ll_surchI As Long
        For ll_surchI = 0 To UBound(ao_cost.SurchargeInfo)
            ao_cost.Surcharge_Cost = ao_cost.Surcharge_Cost + GetSurchargePrice(ao_cost.SurchargeInfo(ll_surchI), ad_transportCost)
        Next
        
        Dim ls_req  As String
        ls_req = Replace(C_REQ_INS, "$TRANS_Code$", SQLNum(ao_cost.TRANS_Code), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DCPLLI_Code$", "NULL", , , vbTextCompare)
        ls_req = Replace(ls_req, "$DCC_type$", SqlStr("S", 1), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DC_Cost$", SQLNum(ao_cost.Surcharge_Cost), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DC_Comment$", SqlStr(""), , , vbTextCompare)
        ls_req = Replace(ls_req, "$CURR_code$", SqlStr(ao_cost.DCPLLI_CURR_Code), , , vbTextCompare)
        ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)

        Call ExecuteSQLSafe(mo_Db, ls_req)
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateSurchargeCost()")
End Sub

Private Sub UpdateTransportCost_Interco()
On Error GoTo ErrHandler
'    If Not SupportPriceList Then Exit Sub
    
'    Debug.Assert (GetCboKey(cbo_UOM) <> "")
    

    Dim lb_isFullTruck As Boolean
    Dim lb_overLoaded As Boolean
    Dim lb_mixedUOM As Boolean
    
    Call CheckTransportCost_Interco(lb_isFullTruck, lb_overLoaded, lb_mixedUOM)
    Debug.Assert (Not lb_overLoaded)
    Debug.Assert (Not lb_mixedUOM)
    
    Dim ll_nbOfTrans As Long
    ll_nbOfTrans = UBound(moa_DCTransport_cost) + 1
    
Const C_REQ_DEL As String = "DELETE FROM DC_Cost WHERE TRANS_Code=$TRANS_Code$ AND DCC_type IN ('T', 'D', 'S')"
Const C_REQ_UPD As String = "UPDATE C SET C.DC_Cost = DCPLLI.DCPLLI_Price FROM DC_Cost C INNER JOIN DC_PriceListLineItem DCPLLI ON DCPLLI.DCPLLI_Code=C.DCPLLI_Code WHERE C.TRANS_Code=$TRANS_Code$ AND DCC_type = 'T'"
Const C_REQ_INS As String = "EXEC DC_Cost_ins $TRANS_Code$,$DCC_type$,$DCPLLI_Code$,$CURR_code$,$DC_Cost$,$DC_Comment$,$Z_Creator$"

    ' update the transport cost for each transaction
    
    
    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
    
        Dim ll_TRANS_Code As Long
        ll_TRANS_Code = moa_DCTransport_cost(ll_i).TRANS_Code
        
        'DELETE EXISTING PRICES
        Call ExecuteSQLSafe(mo_Db, Replace(C_REQ_DEL, "$TRANS_Code$", SQLNum(ll_TRANS_Code), , , vbTextCompare))
        
        
        Dim ld_transportCost As Double
        ld_transportCost = 0
        
        If moa_DCTransport_cost(ll_i).DCPLLI_code <> 0 Then
        
            Dim ls_req As String
    
            ' get the data and update them
            ls_req = Replace(C_REQ_INS, "$TRANS_Code$", SQLNum(ll_TRANS_Code), , , vbTextCompare)
            ls_req = Replace(ls_req, "$DCC_type$", SqlStr("T", 1), , , vbTextCompare)
            ls_req = Replace(ls_req, "$DCPLLI_Code$", SQLNum(moa_DCTransport_cost(ll_i).DCPLLI_code), , , vbTextCompare)
        
            If lb_isFullTruck Then
                ld_transportCost = GetPriceFullTruck(moa_DCTransport_cost(ll_i), moa_DCTransport_cost(ll_i).Quantity) / ll_nbOfTrans
            Else
                ld_transportCost = GetPrice(moa_DCTransport_cost(ll_i)) / ll_nbOfTrans
            End If
        
        
            ls_req = Replace(ls_req, "$DC_Cost$", SQLNum(ld_transportCost), , , vbTextCompare)
            ls_req = Replace(ls_req, "$DC_Comment$", SqlStr(""), , , vbTextCompare)
            ls_req = Replace(ls_req, "$CURR_code$", SqlStr(moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code), , , vbTextCompare)
            ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
        
            Call ExecuteSQLSafe(mo_Db, ls_req)
        End If
        
        ' generate surcharge if there is some price
        Call UpdateSurchargeCost(moa_DCTransport_cost(ll_i), ld_transportCost)
    
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateTransportCost_Interco()")
End Sub


Private Sub UpdateTransportCost_Supplier()
On Error GoTo ErrHandler
'    If Not SupportPriceList Then Exit Sub
    
'    Debug.Assert (GetCboKey(cbo_UOM) <> "")
    

    Dim lb_isFullTruck As Boolean
    Dim lb_overLoaded As Boolean
    Dim lb_mixedUOM As Boolean
    
    Call CheckTransportCost_Supplier(lb_isFullTruck, lb_overLoaded, lb_mixedUOM)
    Debug.Assert (Not lb_overLoaded)
    Debug.Assert (Not lb_mixedUOM)
    
    Dim ll_nbOfTrans As Long
    ll_nbOfTrans = UBound(moa_DCTransport_cost) + 1
    Debug.Assert (ll_nbOfTrans = 1)
    
Const C_REQ_DEL As String = "DELETE FROM DC_Cost WHERE TRANS_Code=$TRANS_Code$ AND DCC_type IN ('T', 'D', 'S')"
Const C_REQ_UPD As String = "UPDATE C SET C.DC_Cost = DCPLLI.DCPLLI_Price FROM DC_Cost C INNER JOIN DC_PriceListLineItem DCPLLI ON DCPLLI.DCPLLI_Code=C.DCPLLI_Code WHERE C.TRANS_Code=$TRANS_Code$ AND DCC_type = 'T'"
Const C_REQ_INS As String = "EXEC DC_Cost_ins $TRANS_Code$,$DCC_type$,$DCPLLI_Code$,$CURR_code$,$DC_Cost$,$DC_Comment$,$Z_Creator$"

    ' update the transport cost for each transaction
    
    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
    
        Dim ll_TRANS_Code As Long
        ll_TRANS_Code = moa_DCTransport_cost(ll_i).TRANS_Code
        
        'DELETE EXISTING PRICES
        Call ExecuteSQLSafe(mo_Db, Replace(C_REQ_DEL, "$TRANS_Code$", SQLNum(ll_TRANS_Code), , , vbTextCompare))
        
        Dim ls_req As String
    
        ' get the data and update them
        ls_req = Replace(C_REQ_INS, "$TRANS_Code$", SQLNum(ll_TRANS_Code), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DCC_type$", SqlStr("T", 1), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DCPLLI_Code$", SQLNum(moa_DCTransport_cost(ll_i).DCPLLI_code), , , vbTextCompare)
        
        Dim ld_transportCost As Double
        ld_transportCost = 0
        
        If lb_isFullTruck Then
            ' if we are not in master transaction then generate dropoff cost
            ld_transportCost = GetPriceFullTruck(moa_DCTransport_cost(ll_i), Max(moa_DCTransport_cost(ll_i).Quantity, moa_DCTransport_cost(ll_i).Quantity_loaded)) / ll_nbOfTrans
        Else
            ld_transportCost = GetPrice(moa_DCTransport_cost(ll_i)) / ll_nbOfTrans
        End If
        
        ls_req = Replace(ls_req, "$DC_Cost$", SQLNum(ld_transportCost), , , vbTextCompare)
        ls_req = Replace(ls_req, "$DC_Comment$", SqlStr(""), , , vbTextCompare)
        ls_req = Replace(ls_req, "$CURR_code$", SqlStr(moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code), , , vbTextCompare)
        ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
        
        Call ExecuteSQLSafe(mo_Db, ls_req)
        
        ' generate surcharge if there is some price ( better check would be if there is a dcs_code linked to current transaction )
        Call UpdateSurchargeCost(moa_DCTransport_cost(ll_i), ld_transportCost)
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateTransportCost_Supplier()")
End Sub


Private Sub UpdatePriceTrailer_tran(ByRef ao_priceData As tDCTransport_cost, ByVal ad_Qty As Double)
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC DC_Transaction_sel $TRANS_Code$"

    Dim ll_Cursor  As Long
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(C_REQ, "$TRANS_Code$", SQLNum(ao_priceData.TRANS_Code), , , vbTextCompare))
    
    If Not mo_Db.EOF(ll_Cursor) Then
    
        Call UpdatePriceTrailer(ao_priceData, ad_Qty, mo_Db.GetFields(ll_Cursor, "Ship_To_CT_Code"), mo_Db.GetFields(ll_Cursor, "Ship_To_Zip_Code"))
    
    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("UpdatePriceTrailer_tran")
End Sub

Private Sub UpdatePriceTrailer(ByRef ao_priceData As tDCTransport_cost, ByVal ad_Qty As Double, ByVal as_CT_Code As String, ByVal as_zip_code As String)
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC DC_PriceListPriceTrailer_sel $DCPL_Code$, $Ship_To_CT_Code$, $Ship_To_Zip_Code$, $Quantity_for_cost$"

    Dim ls_req As String
    ls_req = Replace(C_REQ, "$DCPL_Code$", SQLNum(ao_priceData.DCPL_Code), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Quantity_for_cost$", SQLNum(ad_Qty), , vbTextCompare)
    ls_req = Replace(ls_req, "$Ship_To_CT_Code$", SqlStr(as_CT_Code, 4, True), , vbTextCompare)
    ls_req = Replace(ls_req, "$Ship_To_Zip_Code$", SqlStr(Trim(as_zip_code), 20, True), , vbTextCompare)
    
    Dim ll_Cursor  As Long
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If Not mo_Db.EOF(ll_Cursor) Then
        
        ao_priceData.DCPLLI_code = mo_Db.GetFields(ll_Cursor, "DCPLLI_Code")
        ao_priceData.DCPLL_Full_Truck_Price = mo_Db.GetFields(ll_Cursor, "DCPLLI_Price")
        ao_priceData.FullTruckPriceFormula = mo_Db.GetFields(ll_Cursor, "PriceFormula")

    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("UpdatePriceTrailer")
End Sub

Private Function GetMostExpensiveTransportLine() As Long
On Error GoTo ErrHandler
    Dim ll_expensiveTransport As Long
    
    Dim ll_i As Long
    
    Dim ld_mostExpensiveCost As Double
    Dim ld_currentCost As Double
    
    Debug.Assert (UBound(moa_DCTransport_cost) >= 0)
    
    ll_expensiveTransport = 0
    ld_mostExpensiveCost = GetPriceFullTruck(moa_DCTransport_cost(0), moa_DCTransport_cost(0).DCPLL_Full_Truck_Min)
    
    For ll_i = LBound(moa_DCTransport_cost) + 1 To UBound(moa_DCTransport_cost)
    
        ld_currentCost = GetPriceFullTruck(moa_DCTransport_cost(ll_i), moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min)
        
        If ld_currentCost > ld_mostExpensiveCost Then
            
            ll_expensiveTransport = ll_i
            ld_mostExpensiveCost = ld_currentCost
            
        ElseIf ld_currentCost = ld_mostExpensiveCost Then
            If GetTranQty(ll_i, QTY_FOR_COST) > GetTranQty(ll_expensiveTransport, QTY_FOR_COST) Then
                ll_expensiveTransport = ll_i
            End If
        End If
    Next

    GetMostExpensiveTransportLine = ll_expensiveTransport
    Exit Function
ErrHandler:
    Call ErrorHandler("GetMostExpensiveTransportLine()")
End Function


Private Function GetLeadingTransportLine() As Long
On Error GoTo ErrHandler
    
    ' Ordere by trans_order -> first record is allways leading transaction
    GetLeadingTransportLine = 0
    
    Exit Function
ErrHandler:
    Call ErrorHandler("GetLeadingTransportLine()")
End Function

Private Sub CheckTransportCost(ByVal as_dropOffCost As Double, ByVal as_FullTruckCalculation As String, ByRef ab_isFullTruck As Boolean, ByRef ab_overLoaded As Boolean, ByRef ab_overLoadedCost As Boolean, ByRef ab_mixedUOM As Boolean, ByRef ab_isFullTruckCost As Boolean, ByRef ab_isTrailer As Boolean)
On Error GoTo ErrHandler
    
    Debug.Assert (UBound(moa_DCTransport_cost) >= 0)
    
    ab_isFullTruck = False
    ab_overLoaded = False
    ab_overLoadedCost = False
    ab_mixedUOM = False
    ab_isFullTruckCost = False
    ab_isTrailer = False
    
    Dim ls_UOM_Code As String
    ls_UOM_Code = moa_DCTransport_cost(LBound(moa_DCTransport_cost)).UOM_Code
    
    
    Dim ll_mostExpensiveLine As Long
    ll_mostExpensiveLine = GetMostExpensiveTransportLine()

    Dim ll_i As Long
    
    For ll_i = LBound(moa_DCTransport_cost) + 1 To UBound(moa_DCTransport_cost)
     
        If ls_UOM_Code <> moa_DCTransport_cost(ll_i).UOM_Code Then
            ab_mixedUOM = True
        End If
    
    Next
    
    Dim ld_QtyTotalCost As Double
    ld_QtyTotalCost = GetTotalQty(QTY_FOR_COST)

    If moa_DCTransport_cost(ll_mostExpensiveLine).DCPLLI_code <> 0 Then
        ' if we have some cost -> we calculate overloaded truck
    
        Dim ld_QtyTotal As Double
        ld_QtyTotal = GetTotalQty(QTY_FOR_TRANSPORT)
        
        If ld_QtyTotal >= moa_DCTransport_cost(ll_mostExpensiveLine).DCPLL_Full_Truck_Min Then
            
            If ld_QtyTotal <= moa_DCTransport_cost(ll_mostExpensiveLine).DCPLL_Full_Truck_Max Then
                ab_isFullTruck = True
                If moa_DCTransport_cost(ll_mostExpensiveLine).DCPLL_Trailer_min > 0 And _
                    ld_QtyTotal >= moa_DCTransport_cost(ll_mostExpensiveLine).DCPLL_Trailer_min _
                Then
                    ab_isTrailer = True
                End If
            Else
                'overloaded
                ab_overLoaded = True
            End If
            
        End If
        
        If ld_QtyTotalCost > moa_DCTransport_cost(ll_mostExpensiveLine).DCPLL_Full_Truck_Max Then
            ab_overLoadedCost = True
        End If
    End If
    
    If as_FullTruckCalculation = "N" Then
        ' if the drop off cost is zero then we count each delivery
        If as_dropOffCost = 0 Then
            ab_isFullTruckCost = False
        ElseIf UBound(moa_DCTransport_cost) <> LBound(moa_DCTransport_cost) Then
            ' if there is some dropoff and more than 1 transaction we count as full truck
            ab_isFullTruckCost = True
        End If
    Else
        ' calculate from real qty
        If ld_QtyTotalCost >= moa_DCTransport_cost(ll_mostExpensiveLine).DCPLL_Full_Truck_Min Then
            ab_isFullTruckCost = True
        End If
    End If

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

' if at leas one way is full truck -> complete transport is full truck
Private Sub CheckTransportCost_Interco(ByRef ab_isFullTruck As Boolean, ByRef ab_overLoaded As Boolean, ByRef ab_mixedUOM As Boolean)
On Error GoTo ErrHandler
    
    Debug.Assert (UBound(moa_DCTransport_cost) >= 0)
    
    ab_isFullTruck = False
    ab_overLoaded = False
    ab_mixedUOM = False
    
    Dim ls_UOM_Code As String
    ls_UOM_Code = moa_DCTransport_cost(LBound(moa_DCTransport_cost)).UOM_Code
    
    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
     
        If ls_UOM_Code <> moa_DCTransport_cost(ll_i).UOM_Code Then
            ab_mixedUOM = True
        End If
    
        If moa_DCTransport_cost(ll_i).Quantity >= moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min Then
            If moa_DCTransport_cost(ll_i).Quantity <= moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Max Then
                ab_isFullTruck = True
            Else
                'overloaded
                ab_overLoaded = True
            End If
            
        End If
    
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("CheckTransportCost_Interco()")
End Sub

Private Sub CheckTransportCost_Supplier(ByRef ab_isFullTruck As Boolean, ByRef ab_overLoaded As Boolean, ByRef ab_mixedUOM As Boolean)
On Error GoTo ErrHandler
    
    Debug.Assert (UBound(moa_DCTransport_cost) >= 0)
    
    ab_isFullTruck = False
    ab_overLoaded = False
    ab_mixedUOM = False
    
    Dim ls_UOM_Code As String
    ls_UOM_Code = moa_DCTransport_cost(LBound(moa_DCTransport_cost)).UOM_Code
    
    
    Dim ll_LeadingLine As Long
    ll_LeadingLine = 0

    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
        If ls_UOM_Code <> moa_DCTransport_cost(ll_i).UOM_Code Then
            ab_mixedUOM = True
        End If
    
    Next
    
    Dim ld_QtyTotal As Double
    ld_QtyTotal = GetTotalQty(QTY_FOR_TRANSPORT)
    
    If ld_QtyTotal >= moa_DCTransport_cost(ll_LeadingLine).DCPLL_Full_Truck_Min Then
        If ld_QtyTotal <= moa_DCTransport_cost(ll_LeadingLine).DCPLL_Full_Truck_Max Then
            ab_isFullTruck = True
        Else
            'overloaded
            ab_overLoaded = True
        End If
        
    End If

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


Private Function GetTotalQty(ByVal ab_forTransport As Boolean) As Double
On Error GoTo ErrHandler
    Dim ld_TotalQty As Double
    Dim ll_i As Long
    
    ld_TotalQty = 0
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
        If ab_forTransport Then
            ld_TotalQty = ld_TotalQty + IIf(moa_DCTransport_cost(ll_i).Quantity_loaded = 0, moa_DCTransport_cost(ll_i).Quantity, moa_DCTransport_cost(ll_i).Quantity_loaded)
        Else
            ld_TotalQty = ld_TotalQty + Max(moa_DCTransport_cost(ll_i).Quantity, moa_DCTransport_cost(ll_i).Quantity_loaded)
        End If
    Next

    GetTotalQty = ld_TotalQty
    Exit Function
ErrHandler:
    Call ErrorHandler("GetTotalQty()")
End Function

Private Function GetSurchargePrice(ByRef ao_priceData As tDCSurcharge_cost, ByVal ad_tansportCost As Double) As Double
On Error GoTo ErrHandler
    
    Call VBScriptReset
        
    Call mo_scriptObj.AddCode("Price=" & Replace(ao_priceData.DCS_Price, DecimalSeparator, ".") & vbCrLf & "Quantity=" & Replace(ao_priceData.DCS_quantity, DecimalSeparator, ".") & vbCrLf & "Cost=" & Replace(ad_tansportCost, DecimalSeparator, "."))
    
    GetSurchargePrice = mo_scriptObj.Eval(ao_priceData.SurchargeFormula)
    
    Exit Function
    
ErrHandler:
    Call ErrorHandler("GetSurchargePrice code:" & "Price=" & Replace(ao_priceData.DCS_Price, DecimalSeparator, ".") & vbCrLf & "Quantity=" & Replace(ao_priceData.DCS_quantity, DecimalSeparator, "."))
End Function

Private Function GetPrice(ByRef ao_priceData As tDCTransport_cost) As Double
On Error GoTo ErrHandler
    
    Call VBScriptReset
    
    Call mo_scriptObj.AddCode("Price=" & Replace(ao_priceData.DCPLLI_Price, DecimalSeparator, ".") & vbCrLf & "Quantity=" & Replace(Max(ao_priceData.Quantity, ao_priceData.Quantity_loaded), DecimalSeparator, "."))
    
    GetPrice = mo_scriptObj.Eval(ao_priceData.PriceFormula)
    
    Exit Function
    
ErrHandler:
    Call ErrorHandler("GetPrice code:" & "Price=" & Replace(ao_priceData.DCPLLI_Price, DecimalSeparator, ".") & vbCrLf & "Quantity=" & Replace(Max(ao_priceData.Quantity, ao_priceData.Quantity_loaded), DecimalSeparator, "."))
End Function

Private Function GetPriceFullTruck(ByRef ao_priceData As tDCTransport_cost, ByVal ad_Qty As Double) As Double
On Error GoTo ErrHandler
    
    Call VBScriptReset
    
    Call mo_scriptObj.AddCode("Price=" & Replace(ao_priceData.DCPLL_Full_Truck_Price, DecimalSeparator, ".") & vbCrLf & "Quantity=" & Replace(ad_Qty, DecimalSeparator, "."))
    
    GetPriceFullTruck = mo_scriptObj.Eval(ao_priceData.FullTruckPriceFormula)
    
    Exit Function
    
ErrHandler:
    Call ErrorHandler("GetPriceFullTruck code:" & "Price=" & Replace(ao_priceData.DCPLL_Full_Truck_Price, DecimalSeparator, ".") & vbCrLf & "Quantity=" & Replace(ad_Qty, DecimalSeparator, ".") & vbCrLf & ao_priceData.FullTruckPriceFormula)
End Function

Private Sub VBScriptReset()
On Error GoTo ErrHandler

    Call mo_scriptObj.Reset
    
    Call mo_scriptObj.AddCode("Function IIf(bClause, sTrue, sFalse) " & vbCrLf & _
                              "If CBool(bClause) Then " & vbCrLf & _
                              "IIf = sTrue " & vbCrLf & _
                              "    Else " & vbCrLf & _
                              "IIf = sFalse " & vbCrLf & _
                              "End If " & vbCrLf & _
                              "End Function")
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("VBScriptReset")
End Sub

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


Public Function DecimalSeparator() As String
    DecimalSeparator = Mid(Format("0", "0.0"), 2, 1)
End Function

Private Function HaveRight(ByVal as_RightKey As String) As Boolean
On Error GoTo ErrHandler

    Dim mb_Ok As Boolean
    
    mb_Ok = False
    Dim lv_ArrUpd As Variant
    lv_ArrUpd = Split(Get_A_Config(as_RightKey), SEP, , vbTextCompare)
    
    Dim ll_Idx As Long, ll_Count As Long
    ll_Count = UBound(lv_ArrUpd)
    For ll_Idx = 0 To ll_Count
        If lv_ArrUpd(ll_Idx) = prg.U_Code Then
            mb_Ok = True
            Exit For
        End If
    Next
    HaveRight = mb_Ok

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

Private Function Get_A_Config(ByVal TheKey As String) As String
On Error GoTo Get_A_Config_er
Dim curs As Long
Dim ls_req As String

    Get_A_Config = ""
    ls_req = "select cfg_value from A_config where cfg_Key ='" & UCase(TheKey) & "'"
    curs = OpenSQLSafe(mo_Db, ls_req, 1)
    
    Get_A_Config = mo_Db.GetFields(curs, 0)
    Call mo_Db.Close(curs)
    curs = 0
    
Exit Function
Get_A_Config_er:
    If curs > 0 Then
        Call mo_Db.Close(curs)
        curs = 0
    End If
    Call ErrorHandler("Get_A_Config()")
End Function


' 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
    Dim lControl As Control
    
    Dim ll_ScreenLabels As Long

    ll_ScreenLabels = OpenSQLSafe(mo_Db, "exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    Debug.Assert (ll_ScreenLabels <> 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(ll_ScreenLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Caption = mo_Db.GetFields(ll_ScreenLabels, "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(ll_ScreenLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                      Call lControl.LoadConstants(ptStatic, mo_Db.GetFields(ll_ScreenLabels, "LOCAL_TEXT"), ctColumns)
                        End If
                    If mo_Db.Find(ll_ScreenLabels, "FIELD_NAME", lControl.Tag & "_Title", , 1) >= 0 Then
                      lControl.Title = mo_Db.GetFields(ll_ScreenLabels, "LOCAL_TEXT")
                    End If
                Case "TABSTRIP"
                    If mo_Db.Find(ll_ScreenLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                        Dim lsa_TextArr() As String
                        Dim ll_Index As Long
                        
                        lsa_TextArr = Split(mo_Db.GetFields(ll_ScreenLabels, "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
    
    Exit Sub

ErrHandler:
    Call ErrorHandler("LoadLabels")
End Sub

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("ChangeCharset")
End Sub


Private Sub txt_zipCode_Validate(Cancel As Boolean)
On Error GoTo ErrHandler
    If mb_eventRunning Then Exit Sub

    Call ItemLine_LoadSurcharges(IIf(GetCboKey(cbo_lineID) = "", 0, GetCboKey(cbo_lineID)), GetCboKey(cbo_carrier), GetCboKey(cbo_country), txt_zipCode.Text)

    Exit Sub
ErrHandler:
     Call ErrorMessage("txt_zipCode_Validate()")
End Sub


Private Sub DisplayDefaultValues()
Dim i As Integer
Dim TheControl As Control
Dim TheControlName As String
    
    On Error GoTo ErrHandler
    
    If p_DefaultValuesLoaded = False Then
        p_DefaultValuesCount = GetScreenDefaultValues(mo_Db, ms_LoginName, ms_Language_Code, SCREEN_NAME, p_DefaultValues)
        p_DefaultValuesLoaded = True
    End If
    
    
    Call DisplayScreenDefaultValues(UserControl.Controls, p_DefaultValues, p_DefaultValuesCount)

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


