VERSION 5.00
Begin VB.Form DC_Intercompany 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Intercompany Shipments"
   ClientHeight    =   9045
   ClientLeft      =   75
   ClientTop       =   375
   ClientWidth     =   9705
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   9045
   ScaleWidth      =   9705
   ShowInTaskbar   =   0   'False
   Begin VB.ComboBox cbo_delivery 
      Height          =   315
      ItemData        =   "INTERCO.frx":0000
      Left            =   6843
      List            =   "INTERCO.frx":0002
      TabIndex        =   9
      Tag             =   "Delivery_Number"
      Top             =   1545
      Width           =   2772
   End
   Begin VB.CommandButton btn_SAP_SearchData 
      Caption         =   ">"
      Height          =   285
      Left            =   4440
      TabIndex        =   8
      Top             =   2055
      Width           =   285
   End
   Begin VB.Frame Fr_Actual 
      Caption         =   "Actual"
      Height          =   2970
      Left            =   120
      TabIndex        =   46
      Top             =   5115
      Width           =   9495
      Begin VB.TextBox txt_ArrivalTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   20
         Tag             =   "Load_Arrival_Time"
         Top             =   240
         Width           =   2052
      End
      Begin VB.TextBox txt_LoadStartTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   21
         Tag             =   "Load_Starting_Time"
         Top             =   720
         Width           =   2052
      End
      Begin VB.TextBox txt_LoadBy 
         Height          =   288
         Left            =   1440
         MaxLength       =   15
         TabIndex        =   22
         Tag             =   "Load_By"
         Top             =   1200
         Width           =   2772
      End
      Begin VB.TextBox txt_TrailerNb 
         Height          =   288
         Left            =   2040
         MaxLength       =   15
         TabIndex        =   23
         Tag             =   "Trailer_Number"
         Top             =   1680
         Width           =   2172
      End
      Begin VB.TextBox txt_LoadEndTime 
         Height          =   288
         Left            =   2040
         MaxLength       =   5
         TabIndex        =   24
         Tag             =   "Load_Ending_Time"
         Top             =   2160
         Width           =   2172
      End
      Begin Project1.DCCost DCCost1 
         Height          =   2535
         Left            =   4440
         TabIndex        =   25
         Top             =   360
         Width           =   4935
         _ExtentX        =   8705
         _ExtentY        =   4471
      End
      Begin VB.Label lbl_ArrivalTime 
         Caption         =   "Arrival time"
         Height          =   255
         Left            =   120
         TabIndex        =   51
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label lbl_LoadStartTime 
         Caption         =   "Load starting time"
         Height          =   255
         Left            =   120
         TabIndex        =   50
         Top             =   720
         Width           =   2055
      End
      Begin VB.Label lbl_LoadBy 
         Caption         =   "Load by"
         Height          =   255
         Left            =   120
         TabIndex        =   49
         Top             =   1200
         Width           =   1935
      End
      Begin VB.Label lbl_TrailerNb 
         Caption         =   "Trailer n°"
         Height          =   255
         Left            =   120
         TabIndex        =   48
         Top             =   1680
         Width           =   2175
      End
      Begin VB.Label lbl_LoadEndTime 
         Caption         =   "Load ending time"
         Height          =   255
         Left            =   120
         TabIndex        =   47
         Top             =   2160
         Width           =   2175
      End
   End
   Begin VB.Frame Fr_Schedule 
      Caption         =   "Shedule"
      Height          =   1095
      Left            =   120
      TabIndex        =   41
      Top             =   3975
      Width           =   9495
      Begin VB.TextBox txt_HaulierBookNb 
         Height          =   288
         Left            =   2160
         MaxLength       =   15
         TabIndex        =   16
         Tag             =   "Haulier_Booking_Number"
         Top             =   240
         Width           =   2052
      End
      Begin VB.TextBox txt_LoadPlanStartTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   18
         Tag             =   "Load_Planned_Starting_Time"
         Top             =   720
         Width           =   2052
      End
      Begin VB.TextBox txt_LoadPlanEndTime 
         Height          =   288
         Left            =   6960
         MaxLength       =   5
         TabIndex        =   19
         Tag             =   "Load_Planned_Ending_Time"
         Top             =   720
         Width           =   2172
      End
      Begin VB.TextBox txt_ArrivingTrailerNb 
         Height          =   288
         Left            =   6960
         MaxLength       =   15
         TabIndex        =   17
         Tag             =   "Arriving_Trailer_Number"
         Top             =   240
         Width           =   2172
      End
      Begin VB.Label lbl_HaulierBookNb 
         Caption         =   "Haulier bookin n°"
         Height          =   255
         Left            =   120
         TabIndex        =   45
         Top             =   240
         Width           =   2295
      End
      Begin VB.Label lbl_LoadPlanStartTime 
         Caption         =   "Load planned starting time"
         Height          =   255
         Left            =   120
         TabIndex        =   44
         Top             =   720
         Width           =   1935
      End
      Begin VB.Label lbl_LoadPlanEndTime 
         Caption         =   "Load planned ending time"
         Height          =   255
         Left            =   4800
         TabIndex        =   43
         Top             =   720
         Width           =   2175
      End
      Begin VB.Label lbl_ArrivingTrailerNb 
         Caption         =   "Arriving trailer n°"
         Height          =   255
         Left            =   4800
         TabIndex        =   42
         Top             =   240
         Width           =   2055
      End
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   615
      Left            =   8295
      Style           =   1  'Graphical
      TabIndex        =   26
      Top             =   8340
      Width           =   615
   End
   Begin VB.CommandButton ssp_quit 
      Cancel          =   -1  'True
      CausesValidation=   0   'False
      Height          =   615
      Left            =   9015
      Style           =   1  'Graphical
      TabIndex        =   27
      Top             =   8340
      Width           =   615
   End
   Begin VB.CommandButton SSDeliveryDate 
      Height          =   276
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   2520
      Width           =   252
   End
   Begin VB.CommandButton SSShipDate 
      Height          =   276
      Left            =   7920
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   120
      Width           =   252
   End
   Begin VB.TextBox txt_Quantity 
      Height          =   288
      Left            =   1560
      MaxLength       =   6
      TabIndex        =   13
      Tag             =   "Quantity"
      Top             =   2925
      Width           =   1452
   End
   Begin VB.TextBox txt_HaulierCpy 
      Height          =   288
      Left            =   1560
      MaxLength       =   15
      TabIndex        =   28
      Tag             =   "Haulier_Company"
      Top             =   1560
      Width           =   2772
   End
   Begin VB.TextBox txt_ShipFromDC 
      Height          =   288
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   1
      Tag             =   "DC_Name"
      Text            =   "Pontarlier"
      Top             =   120
      Width           =   2772
   End
   Begin VB.TextBox txt_CLSOrderNb 
      Height          =   288
      Left            =   1560
      MaxLength       =   20
      TabIndex        =   7
      Tag             =   "Order_Number"
      Top             =   2040
      Width           =   2772
   End
   Begin VB.TextBox txt_CLSShipNb 
      Height          =   288
      Left            =   6843
      MaxLength       =   20
      TabIndex        =   10
      Tag             =   "Shipment_Number"
      Top             =   2040
      Width           =   2772
   End
   Begin VB.TextBox txt_DeliveryDate 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   11
      TabStop         =   0   'False
      Tag             =   "Delivery_Date"
      Top             =   2520
      Width           =   1212
   End
   Begin VB.TextBox txt_RSRequire 
      Height          =   525
      Left            =   1560
      MaxLength       =   240
      MultiLine       =   -1  'True
      TabIndex        =   15
      Tag             =   "Remark"
      Top             =   3360
      Width           =   8055
   End
   Begin VB.TextBox txt_ShipDate 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   6600
      Locked          =   -1  'True
      TabIndex        =   0
      TabStop         =   0   'False
      Tag             =   "TRANS_Date"
      Text            =   "txt_ShipDate"
      Top             =   120
      Width           =   1212
   End
   Begin Project1.ArmCombobox cbo_carrier 
      Height          =   345
      Left            =   1560
      TabIndex        =   5
      Tag             =   "CARRIER_Code"
      Top             =   1020
      Width           =   3165
      _ExtentX        =   5583
      _ExtentY        =   609
   End
   Begin Project1.ArmCombobox cbo_UOM 
      Height          =   345
      Left            =   4545
      TabIndex        =   14
      Tag             =   "UOM_Code"
      Top             =   2895
      Width           =   1650
      _ExtentX        =   2910
      _ExtentY        =   609
   End
   Begin Project1.ArmCombobox cbo_Equipement 
      Height          =   345
      Left            =   6255
      TabIndex        =   6
      Tag             =   "EQ_Code"
      Top             =   1020
      Width           =   3360
      _ExtentX        =   5927
      _ExtentY        =   609
   End
   Begin Project1.ArmCombobox cbo_ShipToDC 
      Height          =   345
      Left            =   1560
      TabIndex        =   3
      Tag             =   "ShipToDC_Code"
      Top             =   555
      Width           =   3165
      _ExtentX        =   5583
      _ExtentY        =   609
   End
   Begin Project1.ArmCombobox cbo_returnTransaction 
      Height          =   345
      Left            =   6255
      TabIndex        =   4
      Tag             =   "returnTRANS_Code"
      Top             =   555
      Width           =   3360
      _ExtentX        =   5927
      _ExtentY        =   609
   End
   Begin Project1.ArmCheckView0 ckv_surcharges 
      Height          =   885
      Left            =   6270
      TabIndex        =   55
      Top             =   2400
      Width           =   3330
      _ExtentX        =   5874
      _ExtentY        =   1561
   End
   Begin VB.Label lbl_surcharges 
      Caption         =   "Additional surcharge"
      Height          =   255
      Left            =   4365
      TabIndex        =   54
      Top             =   2430
      Width           =   1755
   End
   Begin VB.Label lbl_returnTransaction 
      Caption         =   "Reuse truck"
      Height          =   255
      Left            =   5040
      TabIndex        =   53
      Top             =   615
      Width           =   1095
   End
   Begin VB.Label lbl_CLSDeliveryNb 
      Caption         =   "CLS Delivery  n°"
      Height          =   255
      Left            =   5040
      TabIndex        =   52
      Top             =   1590
      Width           =   1455
   End
   Begin VB.Label lbl_Quantity 
      Caption         =   "Quantity"
      Height          =   255
      Left            =   120
      TabIndex        =   40
      Top             =   2925
      Width           =   1335
   End
   Begin VB.Label lbl_UOM 
      Caption         =   "UOM"
      Height          =   255
      Left            =   3360
      TabIndex        =   39
      Top             =   2955
      Width           =   1095
   End
   Begin VB.Label lbl_HaulierCpy 
      Caption         =   "Haulier company"
      Height          =   252
      Left            =   120
      TabIndex        =   38
      Top             =   1560
      Width           =   1452
   End
   Begin VB.Label lbl_CarrierCpy 
      Caption         =   "Carrier company"
      Height          =   252
      Left            =   120
      TabIndex        =   37
      Top             =   1080
      Width           =   1452
   End
   Begin VB.Label lbl_Equipement 
      Caption         =   "Equipement"
      Height          =   255
      Left            =   5040
      TabIndex        =   36
      Top             =   1110
      Width           =   1455
   End
   Begin VB.Label lbl_CLSOrderNb 
      Caption         =   "CLS Order n°"
      Height          =   252
      Left            =   120
      TabIndex        =   35
      Top             =   2040
      Width           =   1452
   End
   Begin VB.Label lbl_CLSShipNb 
      Caption         =   "CLS Shipment n°"
      Height          =   255
      Left            =   5040
      TabIndex        =   34
      Top             =   2070
      Width           =   1545
   End
   Begin VB.Label lbl_DeliveryDate 
      Caption         =   "Delivery date"
      Height          =   252
      Left            =   120
      TabIndex        =   33
      Top             =   2520
      Width           =   1452
   End
   Begin VB.Label lbl_RSRequire 
      Caption         =   "R/S requirements"
      Height          =   255
      Left            =   120
      TabIndex        =   32
      Top             =   3360
      Width           =   1455
   End
   Begin VB.Label lbl_ShipToDC 
      Caption         =   "Ship to DC"
      Height          =   252
      Left            =   120
      TabIndex        =   31
      Top             =   600
      Width           =   1452
   End
   Begin VB.Label lbl_ShipDate 
      Caption         =   "Shipping date"
      Height          =   252
      Left            =   5040
      TabIndex        =   30
      Top             =   120
      Width           =   1452
   End
   Begin VB.Label lbl_DCNameFrom 
      Caption         =   "Ship from DC"
      Height          =   252
      Left            =   120
      TabIndex        =   29
      Top             =   120
      Width           =   1452
   End
End
Attribute VB_Name = "DC_Intercompany"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'what is new
'2.9.5 : armsyscom support into the control
'2.9.5 : Price list support
'3.0.5 : Surcharges into pricelist support


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

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

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

' screen constants for title
Private ms_Title As String
Private ms_titleA As String
Private ms_titleU As String
Private ms_titleD As String

Private ml_U_Code As Long
Private ms_LoginName As String
Private mb_Initialized As Boolean
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
Private ms_Language_Code As String
Private mb_eventRunning As Boolean
'Private mb_PL_STYLE_ENABLED As Boolean
Private ms_inTranName As String

Private ms_UrlWebServicePurchase As String
Private ms_UrlWebServiceOrder As String

Private ms_TableName As String
Private ms_DC_Code As String
Private ms_DC_Name As String
Private md_shippingDay As Date
'Private msa_PLs() As String                 ' A_Config entry backup

Dim mb_OverLoadChange As Boolean
Dim ml_d As Long
Dim ml_prevMasterTran As Long
Dim md_manualCost As Double
Dim ml_iConcurrency As Long

Private Enum SURCHARGE_COLS
    DCS_Price = 1
    DCPLL_Code = 2
    UOM_Code = 3
    DCS_Default = 4
    DCS_Formula = 5
    DCS_quantity = 6
End Enum

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
    DCPL_Code As Long
    DCPLLI_code As Long
    DCPLLI_Price As Double
    DCPLLI_CURR_Code As String
    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

    PriceFormula As String
    FullTruckPriceFormula As String
    SurchargeInfo() As tDCSurcharge_cost
End Type

Dim moa_DCTransport_cost() As tDCTransport_cost

Public Event RowAdded(ByVal av_Data As Variant)
Public Event RowUpdated(ByVal av_Data As Variant)
Public Event RowDeleted(ByVal av_Key As Variant)

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

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(Me.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 DC_Code(ByVal as_DC_Code As String)
    ms_DC_Code = as_DC_Code
End Property

Public Property Let DC_name(ByVal as_DC_Name As String)
    ms_DC_Name = as_DC_Name
End Property

Public Property Let ShippingDay(ByVal ad_shippingDay As Date)
    md_shippingDay = ad_shippingDay
End Property

Public Property Let TRANS_Code(ByVal al_Code As Long)
    ml_d = al_Code
End Property

Private Property Get SupportPriceList() As Boolean
On Error GoTo errhandler
'    SupportPriceList = mb_PL_STYLE_ENABLED And Val(GetCboValue(cbo_carrier, "DCPL_Count")) > 0 And txt_ShipDate.Text <> ""
    SupportPriceList = Val(GetCboValue(cbo_carrier, "DCPL_Count")) > 0 And txt_ShipDate.Text <> ""
    Exit Property
errhandler:
    Call ErrorHandler("SupportPriceList()")
End Property

Private Sub UpdatePriceListUI()
On Error GoTo errhandler
    Dim lb_supportSurcharge As Boolean
    lb_supportSurcharge = Val(GetCboValue(cbo_carrier, "DCS_Count")) > 0
    
    ckv_surcharges.Visible = lb_supportSurcharge
    lbl_surcharges.Visible = lb_supportSurcharge
    
    Exit Sub
errhandler:
    Call ErrorHandler("UpdatePriceListUI()")
End Sub

Public Property Let TableName(ByVal as_tableName As String)
    ms_TableName = as_tableName
End Property

Private Sub AddDay()
Dim ll_Statement As Long
Dim li_Status As Integer
Dim li_Day As Integer
Dim ls_req As String
Dim ld_AddDate As Date

On Error GoTo suite

If txt_DeliveryDate.Visible Then
    ls_req = "EXEC DC_AddDay_sel 'Interco', '" _
            & DC_Choice.cbo_ShipDC_code.List(DC_Choice.cbo_ShipDC.ListIndex) & "', " _
            & SqlStr(GetCboKey(cbo_ShipToDC))
            
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLFetch(ll_Statement)
        If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
            li_Day = ODBCData(ll_Statement, 1)
        End If
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    
    ld_AddDate = StringToDate(right(txt_ShipDate, 10))
    txt_DeliveryDate = DateToString(DateAdd("d", li_Day, ld_AddDate))
End If
Exit Sub

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Sub

Private Sub btn_SAP_SearchData_Click()
On Error GoTo errhandler

    If Trim(txt_CLSOrderNb.Text) = "" Then Exit Sub

    Call LockScreen(True)

    Dim lsa_order() As String
    lsa_order = Split(txt_CLSOrderNb.Text, " ")
    
    Call UpdateSAPData(ReturnNonAlpha(lsa_order(UBound(lsa_order))))
    
    Call LockScreen(False)
    Exit Sub
errhandler:
    Call LockScreen(False)
    ErrorMessage ("btn_SAP_SearchData_Click")
End Sub

Private Function ReturnNonAlpha(ByVal as_str As String) As String
On Error GoTo errhandler
    ReturnNonAlpha = ""
    
    Dim ls_retVal As String
    ls_retVal = ""
    
    Dim ll_i As Long
    For ll_i = 1 To Len(as_str)
        If isNumeric(Mid(as_str, ll_i, 1)) Then
            ls_retVal = ls_retVal & Mid(as_str, ll_i, 1)
        End If
    Next
    
    ReturnNonAlpha = ls_retVal
    Exit Function
errhandler:
    Call ErrorHandler("ReturnNonAlpha")
End Function

Private Sub cbo_Carrier_ComboItemSelected()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    
    mb_OverLoadChange = OK
    
    Call LockScreen(True)
    
    mb_eventRunning = True
    
    Call RefreshUOMInfo(True)
    
    Call RefreshSurchargeInfo(True)
    
    Call RefreshMasterTran(GetCboKey(cbo_carrier), True)
    
    Call UpdatePriceListUI
    
    mb_eventRunning = False
    
    Dim ll_Index As Long
    ll_Index = GetDCTransportLine(ml_d)
    
    Dim ll_newDCPL_Code As Long
    
    ll_newDCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code"))
    
    If moa_DCTransport_cost(ll_Index).DCPL_Code = ll_newDCPL_Code Then
        Call LockScreen(False)
        Exit Sub
    End If
    
    moa_DCTransport_cost(ll_Index).DCPL_Code = ll_newDCPL_Code
    moa_DCTransport_cost(ll_Index).UOM_Code = GetCboKey(cbo_UOM)
    
    Call GenerateTransportCost
    
    Call GenerateSurchargeCost
    
    Call UpdateTotalCost
    
    Call LockScreen(False)
    
    Exit Sub
errhandler:
    Call LockScreen(False)
    mb_eventRunning = False
    ErrorMessage ("cbo_carrier_ComboItemSelected")
End Sub

Private Sub cbo_delivery_Click()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    
    Call LockScreen(True)

    Dim lsa_Array() As String
    
    lsa_Array = Split(cbo_delivery.Text, "/", , vbTextCompare)
    Debug.Assert (UBound(lsa_Array) >= 0)
    
    If UBound(lsa_Array) >= 1 Then
        Call SearchSAPData(lsa_Array(0), lsa_Array(1))
    Else
        Call SearchSAPData(lsa_Array(0), "")
    End If
    
    Call LockScreen(False)
    Exit Sub
errhandler:
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("cbo_delivery_Change")
End Sub

Private Sub cbo_returnTransaction_ComboItemSelected()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub

    mb_eventRunning = True
    
    Call LockScreen(True)
    
'    Call SetupPL_STYLE(IIf(Val(GetCboKey(cbo_returnTransaction)) = ml_d, ms_DC_Code, GetCboKey(cbo_ShipToDC)))
    
    Call RefreshCarrierInfo(True)

    Call RefreshSurchargeInfo(True)

    If GetCboKey(cbo_returnTransaction) <> "" Then
        Call FillMasterTrans(cbo_returnTransaction.SelectedItem.Key)
    End If
    
    Call InitTransportCost
        
    Call GenerateTransportCost
    
    Call GenerateSurchargeCost
    
    Call UpdateTotalCost
    
    Call UpdatePriceListUI

    Call UpdateMasterTransUI
    
    mb_eventRunning = False
    
    Call LockScreen(False)
    
    Exit Sub
    
errhandler:
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("cbo_returnTransaction_ComboItemSelected")
End Sub

'Private Sub SetupPL_STYLE(ByVal as_DC_Code As String)
'On Error GoTo ErrHandler

'    mb_PL_STYLE_ENABLED = False
    
'    If as_DC_Code <> "" Then
    
'        Dim ll_i As Long
'        For ll_i = LBound(msa_PLs) To UBound(msa_PLs)
'            If msa_PLs(ll_i) = as_DC_Code Then
'                mb_PL_STYLE_ENABLED = True
'                Exit For
'            End If
'        Next
    
'    End If

'    Exit Sub
'ErrHandler:
'    Call ErrorHandler("SetupPL_STYLE")
'End Sub

Private Sub cbo_ShipToDC_ComboItemSelected()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    
    mb_eventRunning = True
    
    Call LockScreen(True)
    
'    Call SetupPL_STYLE(IIf(Val(GetCboKey(cbo_returnTransaction)) = ml_d, ms_DC_Code, GetCboKey(cbo_ShipToDC)))
    
    Call AddDay
    
    Call RefreshCarrierInfo(True)
    
    Call RefreshSurchargeInfo(True)
    
    Call RefreshMasterTran(GetCboKey(cbo_carrier), True)
    
    Call UpdatePriceListUI
    
    mb_eventRunning = False
    
    Call GenerateTransportCost
    
    Call GenerateSurchargeCost
    
    Call UpdateTotalCost
    
    Call LockScreen(False)
    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage(Me.Name & ".cbo_ShipToDC_ComboItemSelected()")
End Sub

Private Sub cbo_UOM_ComboItemSelected()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub

    Call LockScreen(True)

    Dim ll_Index As Long
    ll_Index = GetDCTransportLine(ml_d)
    
    Dim ll_newDCPL_Code As Long
    
    ll_newDCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code"))
    
    If moa_DCTransport_cost(ll_Index).DCPL_Code = ll_newDCPL_Code And ll_newDCPL_Code <> 0 Then
        Call LockScreen(False)
        Exit Sub
    End If
    
    moa_DCTransport_cost(ll_Index).DCPL_Code = ll_newDCPL_Code
    moa_DCTransport_cost(ll_Index).UOM_Code = GetCboKey(cbo_UOM)
    
    Call GenerateTransportCost
    
    Call GenerateSurchargeCost
    
    Call UpdateTotalCost
    
    Call LockScreen(False)
    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage(Me.Name & ".cbo_UOM_ComboItemSelected()")
End Sub


Private Sub ckv_surcharges_ItemCheck(ByVal Item As MSComctlLib.ListItem)
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    mb_eventRunning = True
    
    Call LockScreen(True)
    
    Call GenerateSurchargeCost
    
    Call UpdateTotalCost

    mb_eventRunning = False

    Call LockScreen(False)
    
    Exit Sub
errhandler:
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("ckv_surcharges_ItemCheck")
End Sub


Private Sub DCCost1_RowUpdated(ByVal as_action As String, ByVal as_CostType As String, ByVal ad_Value As Double)
On Error GoTo errhandler
    
    Dim ll_CurrentLine As Long
    ll_CurrentLine = GetDCTransportLine(ml_d)
    
    Select Case as_action
    
        Case "Add", "Update"
            If as_CostType = "M" Then
                moa_DCTransport_cost(ll_CurrentLine).Manual_Cost = ad_Value
            Else
                moa_DCTransport_cost(ll_CurrentLine).DCPLLI_Price = ad_Value
            End If
        Case "Delete"
            If as_CostType = "M" Then
                moa_DCTransport_cost(ll_CurrentLine).Manual_Cost = 0
            Else
                moa_DCTransport_cost(ll_CurrentLine).DCPLLI_Price = 0
            End If
    End Select

    Exit Sub
errhandler:
    Call ErrorMessage("DCCost1_RowUpdated")
End Sub

Private Sub Form_Activate()
On Error GoTo errhandler

    If gs_Action = "Delete" Then
        spp_save.SetFocus
    ElseIf gs_Action = "MoreInfo" Then
        ssp_quit.SetFocus
    ElseIf ms_TableName = "DC_Interco" Then
        cbo_ShipToDC.SetFocus
    ElseIf ms_TableName = "DC_Int_End" Then
        txt_HaulierBookNb.SetFocus
    End If

    Exit Sub
errhandler:
    Call ErrorMessage("Form_Activate")
End Sub

Private Sub spp_save_Click()
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    
    Call Me.ValidateControls
    mb_eventRunning = True

    Call LockScreen(True)

    gb_Return = OK
    Select Case gs_Action
    Case "Add":
        If Add_Table Then
            Call Item_Clear
            Call Item_Load(0)
        End If
    Case "Update":
        If Upd_Table Then
            Call LockScreen(False)
            Me.Hide
            mb_eventRunning = False
            Exit Sub
        End If
    Case "Delete":
        If Dlt_Table Then
            Call LockScreen(False)
            Me.Hide
            mb_eventRunning = False
            Exit Sub
        End If
    End Select

    Call LockScreen(False)
    Me.Refresh
    DoEvents
    mb_eventRunning = False
    Exit Sub
errhandler:
    If Err.Number = 380 Then        ' validation failed
        Exit Sub
    End If
    
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("spp_save_Click")
End Sub

Private Sub SSDeliveryDate_Click()
On Error GoTo suite
    Call LockScreen(True)
    gb_Return = KO
    gs_Date = txt_DeliveryDate
    Dates.show 1
    If gb_Return Then
        txt_DeliveryDate = gs_Date
    End If
    Call LockScreen(False)
    Exit Sub
suite:
    Call LockScreen(False)
    Call ErrorMessage("SSDeliveryDate_Click")
End Sub


Private Sub ssp_quit_Click()
    Me.Hide
End Sub


Private Sub SSShipDate_Click()
On Error GoTo suite
    If mb_eventRunning Then Exit Sub
    mb_eventRunning = True
    
    Call LockScreen(True)
    gb_Return = KO
    gs_Date = txt_ShipDate
    Dates.show 1
    If gb_Return Then
        txt_ShipDate = gs_Date
        md_shippingDay = gs_Date
    
        Call RefreshMasterTran(GetCboKey(cbo_carrier), True)
    
    End If
    Call LockScreen(False)
    mb_eventRunning = False
Exit Sub
suite:
    Call LockScreen(False)
    mb_eventRunning = False
    Call ErrorMessage("SSShipDate_Click")
End Sub

Private Sub txt_ArrivalTime_GotFocus()
On Error GoTo errhandler
        
    If Len(txt_ArrivalTime) = 5 Then
        txt_ArrivalTime = Left(txt_ArrivalTime, 2) & right(txt_ArrivalTime, 2)
    End If
    
    txt_ArrivalTime.SelStart = 0
    txt_ArrivalTime.SelLength = Len(txt_ArrivalTime)

    Exit Sub
errhandler:
    Call ErrorMessage("txt_ArrivalTime_GotFocus")
End Sub

Private Sub txt_ArrivalTime_LostFocus()
On Error GoTo errhandler

    Call LockScreen(True)

    If Len(txt_ArrivalTime) = 5 And Mid(txt_ArrivalTime, 3, 1) = ":" Then
        txt_ArrivalTime = Left(txt_ArrivalTime, 2) & right(txt_ArrivalTime, 2)
    End If
    
    If Not CheckNumericValue(txt_ArrivalTime) Then
        SendMessage 5130, "Only numeric field is valid !", gut_LangLogin.Code
        txt_ArrivalTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If
    
    If Len(txt_ArrivalTime) <> 4 Then
        SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
        txt_ArrivalTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_ArrivalTime, 2) > 23 Or right(txt_ArrivalTime, 2) > 59 Then
            SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
            txt_ArrivalTime.SetFocus
        Else
            txt_ArrivalTime = Left(txt_ArrivalTime, 2) & ":" & right(txt_ArrivalTime, 2)
        End If
    End If
    
    Call LockScreen(False)
    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage("txt_ArrivalTime_LostFocus")
End Sub


Private Sub txt_deliverydate_Change()
    If mb_eventRunning Then Exit Sub
On Error GoTo errhandler

    mb_OverLoadChange = OK

    If txt_DeliveryDate = "" Then Exit Sub

    If DateDiff("d", StringToDate(txt_DeliveryDate), StringToDate(txt_ShipDate)) > 0 Then
        SendMessage 5150, "The delivery date must be greater" & Chr(10) & "than the shipping date", gut_LangLogin.Code
        txt_DeliveryDate.SetFocus
    End If
    
    Exit Sub
errhandler:
    Call ErrorMessage("txt_deliverydate_Change")
End Sub

Private Sub txt_LoadEndTime_GotFocus()
On Error GoTo errhandler

    If Len(txt_LoadEndTime) = 5 Then
        txt_LoadEndTime = Left(txt_LoadEndTime, 2) & right(txt_LoadEndTime, 2)
    End If
    
    txt_LoadEndTime.SelStart = 0
    txt_LoadEndTime.SelLength = Len(txt_LoadEndTime)

    
    Exit Sub
errhandler:
    Call ErrorMessage("txt_LoadEndTime_GotFocus")
End Sub


Private Sub txt_LoadEndTime_LostFocus()
On Error GoTo errhandler

    Call LockScreen(True)

    If Len(txt_LoadEndTime) = 5 Then
        txt_LoadEndTime = Left(txt_LoadEndTime, 2) & right(txt_LoadEndTime, 2)
    End If
    
    If Not CheckNumericValue(txt_LoadEndTime) Then
        SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
        txt_LoadEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If
    
    If Len(txt_LoadEndTime) <> 4 Then
        SendMessage 8, "Wrong time format !", gut_LangLogin.Code
        txt_LoadEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_LoadEndTime, 2) > 23 Or right(txt_LoadEndTime, 2) > 59 Then
            SendMessage 8, "Wrong time format !", gut_LangLogin.Code
            txt_LoadEndTime.SetFocus
        Else
            txt_LoadEndTime = Left(txt_LoadEndTime, 2) & ":" & right(txt_LoadEndTime, 2)
        End If
    End If
    
    Call LockScreen(False)

    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage("txt_LoadEndTime_LostFocus")
End Sub


Private Sub txt_LoadPlanEndTime_GotFocus()
On Error GoTo errhandler

    If Len(txt_LoadPlanEndTime) = 5 Then
        txt_LoadPlanEndTime = Left(txt_LoadPlanEndTime, 2) & right(txt_LoadPlanEndTime, 2)
    End If
    
    txt_LoadPlanEndTime.SelStart = 0
    txt_LoadPlanEndTime.SelLength = Len(txt_LoadPlanEndTime)
    
    Exit Sub
errhandler:
    Call ErrorMessage("txt_LoadPlanEndTime_GotFocus")

End Sub


Private Sub txt_LoadPlanEndTime_LostFocus()
On Error GoTo errhandler

    Call LockScreen(True)
    
    If Len(txt_LoadPlanEndTime) = 5 Then
        txt_LoadPlanEndTime = Left(txt_LoadPlanEndTime, 2) & right(txt_LoadPlanEndTime, 2)
    End If
    
    If Not CheckNumericValue(txt_LoadPlanEndTime) Then
        SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
        txt_LoadPlanEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If
    
    If Len(txt_LoadPlanEndTime) <> 4 Then
        SendMessage 8, "Wrong time format !", gut_LangLogin.Code
        txt_LoadPlanEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_LoadPlanEndTime, 2) > 23 Or right(txt_LoadPlanEndTime, 2) > 59 Then
            SendMessage 8, "Wrong time format !", gut_LangLogin.Code
            txt_LoadPlanEndTime.SetFocus
        Else
            txt_LoadPlanEndTime = Left(txt_LoadPlanEndTime, 2) & ":" & right(txt_LoadPlanEndTime, 2)
        End If
    End If

    Call LockScreen(False)

    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage("txt_LoadPlanEndTime_LostFocus")
End Sub


Private Sub txt_LoadPlanStartTime_GotFocus()
On Error GoTo errhandler

    If Len(txt_LoadPlanStartTime) = 5 Then
        txt_LoadPlanStartTime = Left(txt_LoadPlanStartTime, 2) & right(txt_LoadPlanStartTime, 2)
    End If
    
    txt_LoadPlanStartTime.SelStart = 0
    txt_LoadPlanStartTime.SelLength = Len(txt_LoadPlanStartTime)

    Exit Sub
errhandler:
    Call ErrorMessage("txt_LoadPlanStartTime_GotFocus")
End Sub


Private Sub txt_LoadPlanStartTime_LostFocus()
On Error GoTo errhandler

    Call LockScreen(True)
    
    If Len(txt_LoadPlanStartTime) = 5 Then
        txt_LoadPlanStartTime = Left(txt_LoadPlanStartTime, 2) & right(txt_LoadPlanStartTime, 2)
    End If
    
    If Not CheckNumericValue(txt_LoadPlanStartTime) Then
        SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
        txt_LoadPlanStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If
    
    If Len(txt_LoadPlanStartTime) <> 4 Then
        SendMessage 8, "Wrong time format !", gut_LangLogin.Code
        txt_LoadPlanStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_LoadPlanStartTime, 2) > 23 Or right(txt_LoadPlanStartTime, 2) > 59 Then
            SendMessage 8, "Wrong time format !", gut_LangLogin.Code
            txt_LoadPlanStartTime.SetFocus
        Else
            txt_LoadPlanStartTime = Left(txt_LoadPlanStartTime, 2) & ":" & right(txt_LoadPlanStartTime, 2)
        End If
    End If
    
    Call LockScreen(False)

    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage("txt_LoadPlanStartTime_LostFocus")
End Sub


Private Sub txt_LoadStartTime_GotFocus()
On Error GoTo errhandler

    If Len(txt_LoadStartTime) = 5 Then
        txt_LoadStartTime = Left(txt_LoadStartTime, 2) & right(txt_LoadStartTime, 2)
    End If
    
    txt_LoadStartTime.SelStart = 0
    txt_LoadStartTime.SelLength = Len(txt_LoadStartTime)

    Exit Sub
errhandler:
    Call ErrorMessage("txt_LoadStartTime_GotFocus")
End Sub


Private Sub txt_LoadStartTime_LostFocus()
On Error GoTo errhandler

    Call LockScreen(True)
    
    If Len(txt_LoadStartTime) = 5 Then
        txt_LoadStartTime = Left(txt_LoadStartTime, 2) & right(txt_LoadStartTime, 2)
    End If
    
    If Not CheckNumericValue(txt_LoadStartTime) Then
        SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
        txt_LoadStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If
    
    If Len(txt_LoadStartTime) <> 4 Then
        SendMessage 8, "Wrong time format !", gut_LangLogin.Code
        txt_LoadStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_LoadStartTime, 2) > 23 Or right(txt_LoadStartTime, 2) > 59 Then
            SendMessage 8, "Wrong time format !", gut_LangLogin.Code
            txt_LoadStartTime.SetFocus
        Else
            txt_LoadStartTime = Left(txt_LoadStartTime, 2) & ":" & right(txt_LoadStartTime, 2)
        End If
    End If
    
    Call LockScreen(False)

    Exit Sub
errhandler:
    Call LockScreen(False)
    Call ErrorMessage("txt_LoadStartTime_LostFocus")
End Sub



Private Function Control()
On Error GoTo errhandler
Control = KO

    If GetCboKey(cbo_ShipToDC) = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        cbo_ShipToDC.SetFocus
        Exit Function
    End If
    If GetCboKey(cbo_carrier) = "" Then
        cbo_carrier.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If GetCboKey(cbo_Equipement) = "" Then
        cbo_Equipement.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If txt_CLSOrderNb = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_CLSOrderNb.SetFocus
        Exit Function
    End If
    If txt_DeliveryDate = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_DeliveryDate.SetFocus
        Exit Function
    End If
    If DateDiff("d", StringToDate(txt_DeliveryDate), StringToDate(txt_ShipDate)) > 0 Then
        SendMessage 8, "The delivery date must be greater" & Chr(10) & "than the shipping date", gut_LangLogin.Code
        txt_DeliveryDate.SetFocus
        Exit Function
    End If
    If txt_Quantity = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_Quantity.SetFocus
        Exit Function
    End If
    If Not CheckNumericValue(txt_Quantity) Then
        SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
        Call SetTextBoxFocus(txt_Quantity)
        Exit Function
    End If
    If GetCboKey(cbo_UOM) = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        cbo_UOM.SetFocus
        Exit Function
    End If
    
    If SupportPriceList Then
    
        ' check the cost
        Dim lb_isFullTruck As Boolean
        Dim lb_overLoaded As Boolean
        Dim lb_mixedUOM As Boolean
    
        Call CheckTransportCost(lb_isFullTruck, lb_overLoaded, lb_mixedUOM)
    
        If lb_overLoaded Then
            ReDim ms_MsgInfo(1, 1)
            ms_MsgInfo(0, 0) = "$QTY_FOR_TRANSPORT$"
            ms_MsgInfo(0, 1) = txt_Quantity.Text
            ms_MsgInfo(1, 0) = "$UOM$"
            ms_MsgInfo(1, 1) = GetCboKey(cbo_UOM)
            Call MsgBox(MsgText(5120, ms_Language_Code, "#Truck is overloaded!!! ($QTY_FOR_TRANSPORT$ $UOM$)", ms_MsgInfo), vbCritical Or vbOKOnly)
            
            txt_Quantity.SetFocus
            Exit Function
        End If
    
        If lb_mixedUOM Then
            Call MsgBox(MsgText(5070, ms_Language_Code, "#Mixed UOM!"), vbCritical Or vbOKOnly)
            
            cbo_UOM.SetFocus
            Exit Function
        End If
    End If
    
    Control = OK
    Exit Function
errhandler:
    Call ErrorHandler("Control")
End Function

Private Sub Interco_constants()
Dim ls_Field As String, ls_Text As String
Dim ll_Statement As Long
Dim li_Status As Integer

On Error GoTo suite

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, "EXEC Screen_Csts 'mtnc_DC_Interco' , " & SqlStr(ms_Language_Code, 1)) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or _
         li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or _
       li_Status = SQL_SUCCESS_WITH_INFO Then
        ls_Field = ODBCData(ll_Statement, 1)
        ls_Text = Left(ODBCData(ll_Statement, 2), 30)
        Select Case ls_Field
            Case "title": ms_Title = ls_Text
            Case "titleA": ms_titleA = ls_Text
            Case "titleU": ms_titleU = ls_Text
            Case "titleD": ms_titleD = ls_Text
            Case "lbl_DCNameFrom": lbl_DCNameFrom = ls_Text
            Case "lbl_shipToDC": lbl_ShipToDC = ls_Text
            Case "lbl_ShipDate": lbl_ShipDate = ls_Text
            Case "lbl_CarrierCpy": lbl_CarrierCpy = ls_Text
            Case "lbl_Equipement": lbl_Equipement = ls_Text
            Case "lbl_HaulierCpy": lbl_HaulierCpy = ls_Text
            Case "lbl_CLSOrderNb": lbl_CLSOrderNb = ls_Text
            Case "lbl_CLSShipNb": lbl_CLSShipNb = ls_Text
            Case "lbl_CLSDeliveryNb": lbl_CLSDeliveryNb = ls_Text
            Case "lbl_DeliveryDate": Lbl_DeliveryDate = ls_Text
            Case "lbl_Quantity": Lbl_Quantity = ls_Text
            Case "lbl_UOM": lbl_UOM = ls_Text
            Case "lbl_RSRequire": lbl_RSRequire = ls_Text
            Case "Fr_Schedule": Fr_Schedule.Caption = ls_Text
            Case "lbl_HaulierBookNb": lbl_HaulierBookNb = ls_Text
            Case "lbl_ArrivingTrailerN": lbl_ArrivingTrailerNb = ls_Text
            Case "lbl_LoadPlanStartTim": lbl_LoadPlanStartTime = ls_Text
            Case "lbl_LoadPlanEndTime": lbl_LoadPlanEndTime = ls_Text
            Case "Fr_Actual": Fr_Actual.Caption = ls_Text
            Case "lbl_ArrivalTime": lbl_ArrivalTime = ls_Text
            Case "lbl_TrailerNb": lbl_TrailerNb = ls_Text
            Case "lbl_LoadStartTime": lbl_LoadStartTime = ls_Text
            Case "lbl_LoadEndTime": lbl_LoadEndTime = ls_Text
            Case "lbl_LoadBy": lbl_LoadBy = ls_Text
            Case "lbl_returnTransaction": lbl_returnTransaction = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError

End Sub

Private Function Add_Table() As Boolean
Const C_REQ As String = "EXEC DC_Interco_ins $TRANS_code$,$DC_CARRIER_Code$,$TRANS_Date$,$MASTER_TRANS_code$,$DC_Name$,$Supplier_Name$,$ShipToDC_code$, $ShipToDC_Name$, $EQ_code$,$Haulier_Company$,$Order_Number$,$Shipment_Number$,$Delivery_Number$,$Delivery_Date$,$Quantity$,$UOM_code$,$Remark$,$Haulier_Booking_Number$,$Arriving_Trailer_Number$,$Load_Planned_Starting_Time$,$Load_Planned_Ending_Time$,$Load_Arrival_Time$,$Trailer_Number$,$Load_Starting_Time$,$Load_Ending_Time$,$Load_By$"
    
    Dim ls_req As String

On Error GoTo errhandler

    Dim lb_InTran As Boolean
    lb_InTran = False
    
    Add_Table = KO

    If Control Then
        If ControlOver Then
            
            Dim ls_newID As String
            
            ls_newID = mo_Db.SQLNextID("TRANS_code")
            If ls_newID = "" Then
                Call Err.Raise(1, "SQLNextID", "Missing definition for new ID:TRANS_code")
            End If
            
            ml_d = Val(ls_newID)
            
            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 = 0 Then
                    moa_DCTransport_cost(ll_i).TRANS_Code = ml_d
                    Exit For
                End If
            Next
            
            ls_req = Replace(C_REQ, "$TRANS_code$", ml_d, , , vbTextCompare)
            ls_req = Replace(ls_req, "$DC_CARRIER_Code$", SQLNum(GetDC_CARRIER_Code(ms_DC_Code, GetCboKey(cbo_carrier))), , , vbTextCompare)
            Call Item_ReplacePlaceholders(ls_req)
            
            Call BeginTran("DC_TRANSACTION")
            lb_InTran = True
            
            Call ExecuteSQLSafe(mo_Db, ls_req, 1)
            
            ' add surcharge link
            Call SaveCkvSurcharges(ml_d)
            
            DCCost1.TransCode = ml_d
            DCCost1.GridSave
            
            Call UpdateTransportCost(ml_d, ml_d)

            Call CommitTran("DC_TRANSACTION")
            lb_InTran = False
                                
            RaiseEvent RowAdded(Array(ml_d, 1, GetCboValue(cbo_ShipToDC, "DC_Desc"), txt_DeliveryDate.Text, txt_CLSOrderNb.Text, GetCboKey(cbo_carrier), GetCboValue(cbo_carrier, "CARRIER_Name"), DCCost1.Cost_Comment))
            Add_Table = OK
            
        End If
    End If
    
Exit Function

errhandler:
    If lb_InTran Then
        Call RollbackTran("DC_TRANSACTION")
        lb_InTran = False
    End If
    Call ErrorHandler("Add_Table")
End Function

Private Function DateFormat(datedeb As String) As String

If Len(datedeb) = 5 Then
    DateFormat = Left(datedeb, 2) + right(datedeb, 2)
Else
    DateFormat = datedeb
End If

End Function

Private Function Dlt_Table() As Boolean

Const C_REQ As String = "EXEC DC_Interco_del $TRANS_code$,$iConc$"
Const C_REQ_SURCHARGE_DEL As String = "EXEC DC_Tran_Surcharge_del $TRANS_code$"

On Error GoTo errhandler
    Dim ls_req As String
    Dim lb_InTran  As Boolean
    lb_InTran = False

    Dlt_Table = KO

    Call LockScreen(False)
    If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
        Call LockScreen(True)
        mb_eventRunning = True
        
        txt_Quantity.Text = "0"
        
        mb_eventRunning = False
        
        Call BeginTran("DC_TRANSACTION")
        lb_InTran = True
        
        DCCost1.GridDelete
        
        ls_req = Replace(C_REQ, "$TRANS_code$", SQLNum(ml_d), , , vbTextCompare)
        ls_req = Replace(ls_req, "$iConc$", SQLNum(ml_iConcurrency), , , vbTextCompare)
        
        Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        
        Call ExecuteSQLSafe(mo_Db, Replace(C_REQ_SURCHARGE_DEL, "$TRANS_code$", SQLNum(ml_d), , , vbTextCompare))

        Call UpdateTransportCost(ml_d, ml_prevMasterTran)
                
        Call CommitTran("DC_TRANSACTION")
        lb_InTran = False
        
        RaiseEvent RowDeleted(Array(ml_d))
        Dlt_Table = OK
    Else
        Call LockScreen(True)
    End If
    Exit Function
errhandler:
    Call LockScreen(False)
    If lb_InTran Then
        Call RollbackTran("DC_TRANSACTION")
        lb_InTran = False
    End If

    Call ErrorHandler("Dlt_Table")
End Function

Private Sub PropagateDCPLLInfo()
On Error GoTo errhandler
    Dim ll_LeadingLine As Long
    ll_LeadingLine = GetLeadingTransportLine()
    
    ' propagate pricelist related values into return transaction for round trip
    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
        If ll_i <> ll_LeadingLine Then
            
            moa_DCTransport_cost(ll_i).DCPL_Code = moa_DCTransport_cost(ll_LeadingLine).DCPL_Code
            moa_DCTransport_cost(ll_i).DCPLLI_code = moa_DCTransport_cost(ll_LeadingLine).DCPLLI_code
            moa_DCTransport_cost(ll_i).DCPLLI_Price = moa_DCTransport_cost(ll_LeadingLine).DCPLLI_Price
            moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code = moa_DCTransport_cost(ll_LeadingLine).DCPLLI_CURR_Code
'            moa_DCTransport_cost(ll_i).DCS_Price = moa_DCTransport_cost(ll_LeadingLine).DCS_Price
            moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Price = moa_DCTransport_cost(ll_LeadingLine).DCPLL_Full_Truck_Price
            moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min = moa_DCTransport_cost(ll_LeadingLine).DCPLL_Full_Truck_Min
            moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Max = moa_DCTransport_cost(ll_LeadingLine).DCPLL_Full_Truck_Max
'            moa_DCTransport_cost(ll_i).DCPLL_Trailer_min = moa_DCTransport_cost(ll_LeadingLine).DCPLL_Trailer_min
            moa_DCTransport_cost(ll_i).PriceFormula = moa_DCTransport_cost(ll_LeadingLine).PriceFormula
            moa_DCTransport_cost(ll_i).FullTruckPriceFormula = moa_DCTransport_cost(ll_LeadingLine).FullTruckPriceFormula
'            moa_DCTransport_cost(ll_i).SurchargeFormula = moa_DCTransport_cost(ll_LeadingLine).SurchargeFormula
        End If
    Next
    Exit Sub
errhandler:
    Call ErrorHandler("PropagateDCPLLInfo")
End Sub

Private Function Upd_Table() As Boolean
Const C_REQ As String = "EXEC DC_Interco_upd $TRANS_code$,$iConc$,$DC_CARRIER_Code$,$TRANS_Date$,$MASTER_TRANS_code$,$DC_Name$,$Supplier_Name$,$ShipToDC_code$, $ShipToDC_Name$, $EQ_code$,$Haulier_Company$,$Order_Number$,$Shipment_Number$,$Delivery_Number$,$Delivery_Date$,$Quantity$,$UOM_code$,$Remark$,$Haulier_Booking_Number$,$Arriving_Trailer_Number$,$Load_Planned_Starting_Time$,$Load_Planned_Ending_Time$,$Load_Arrival_Time$,$Trailer_Number$,$Load_Starting_Time$,$Load_Ending_Time$,$Load_By$"
Const C_REQ_END As String = "EXEC DC_Int_End_upd $TRANS_code$,$iConc$,$Haulier_Booking_Number$,$Arriving_Trailer_Number$,$Load_Planned_Starting_Time$,$Load_Planned_Ending_Time$,$Load_Arrival_Time$,$Trailer_Number$,$Load_Starting_Time$,$Load_Ending_Time$,$Load_By$"

On Error GoTo errhandler
    
    Dim ls_req As String
    Dim lb_InTran As Boolean
    
    lb_InTran = False
    Upd_Table = KO

    If Control Then
    
        ' propagate some values from leadnig line into rest of transaction
        Call PropagateDCPLLInfo
        
        If ms_TableName = "DC_Interco" Then
            
            ls_req = Replace(C_REQ, "$TRANS_code$", SQLNum(ml_d), , , vbTextCompare)
            ls_req = Replace(ls_req, "$DC_CARRIER_Code$", SQLNum(GetDC_CARRIER_Code(ms_DC_Code, GetCboKey(cbo_carrier))), , , vbTextCompare)
        
        ElseIf ms_TableName = "DC_Int_End" Then
            
            ls_req = Replace(C_REQ_END, "$TRANS_code$", SQLNum(ml_d), , , vbTextCompare)
        
        End If
        
        ls_req = Replace(ls_req, "$iConc$", SQLNum(ml_iConcurrency), , , vbTextCompare)
        Call Item_ReplacePlaceholders(ls_req)
        
        Call BeginTran("DC_TRANSACTION")
        lb_InTran = True
        
        Call ExecuteSQLSafe(mo_Db, ls_req, 1)

        ' manage surcharge link
        Call SaveCkvSurcharges(ml_d)
        
        DCCost1.GridSave
        
        Call UpdateTransportCost(ml_d, ml_prevMasterTran)

        Call CommitTran("DC_TRANSACTION")
        lb_InTran = False
        
        RaiseEvent RowUpdated(Array(ml_d, 1, GetCboValue(cbo_ShipToDC, "DC_Desc"), txt_DeliveryDate.Text, txt_CLSOrderNb.Text, GetCboKey(cbo_carrier), GetCboValue(cbo_carrier, "CARRIER_Name"), DCCost1.Cost_Comment))
        Upd_Table = OK
    End If
Exit Function

errhandler:
    If lb_InTran Then
        Call RollbackTran("DC_TRANSACTION")
        lb_InTran = False
    End If
    Call ErrorHandler("Upd_Table")
End Function

Private Function ControlOver() As Boolean
Dim ls_req As String
Dim ll_Cursor As Long

ControlOver = KO

    Dim ls_OverDCFrom As String
    Dim ls_OverDCTo As String

    ls_OverDCFrom = "N"
    ls_OverDCTo = "N"
    
    Dim Msg1 As String
    Dim Msg2 As String
    
    Msg1 = "Intercompany Calendar Max quantity exceeded !" & Chr(10) & "Confirm ?"
    Msg2 = "Receipts Calendar Max quantity exceeded !" & Chr(10) & "Confirm ?"

On Error GoTo suite

    If mb_OverLoadChange And gs_Action = "Update" Then
        ControlOver = OK
        Exit Function
    End If

    ls_req = "EXEC DC_WFInterco '" _
        & QuoteParam(ms_DC_Code) & "', '" _
        & QuoteParam(FormatD(txt_ShipDate, "mm/dd/yyyy")) & "', '" _
        & QuoteParam(GetCboKey(cbo_ShipToDC)) & "', '" _
        & QuoteParam(FormatD(txt_DeliveryDate, "mm/dd/yyyy")) & "'"
    
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)

    ls_OverDCFrom = mo_Db.GetFields(ll_Cursor, "OverDCFrom")
    ls_OverDCTo = mo_Db.GetFields(ll_Cursor, "OverDCTo")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ls_OverDCFrom = "Y" Then
        If MsgBox(Msg1, vbQuestion + vbYesNo, "Over Load") = vbNo Then
            ssp_quit.SetFocus
            Exit Function
        End If

    End If

    If ls_OverDCTo = "Y" Then
        If MsgBox(Msg2, vbQuestion + vbYesNo, "Over Load") = vbNo Then
            ssp_quit.SetFocus
            Exit Function
        End If
    End If

    If ls_OverDCFrom = "Y" Then
        ls_req = "EXEC Workflow_DCLoadPlan '" _
            & QuoteParam(ms_DC_Code) & "', '" _
            & QuoteParam(FormatD(txt_ShipDate, "mm/dd/yyyy")) _
            & "', 'Interco', ' Intercompany. Date : '"
    
        Call ExecuteSQLSafe(mo_Db, ls_req)
    End If

    If ls_OverDCTo = "Y" Then
        ls_req = "EXEC Workflow_DCLoadPlan '" _
            & QuoteParam(GetCboKey(cbo_ShipToDC)) & "', '" _
            & QuoteParam(FormatD(txt_DeliveryDate, "mm/dd/yyyy")) _
            & "', 'Receipt', ' Receipt. Date : '"
        
        Call ExecuteSQLSafe(mo_Db, ls_req)
    End If

    ControlOver = OK
Exit Function

suite:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    
    Call ErrorHandler("ControlOver")
End Function


Private Sub Item_Load(ByVal al_TRANS_Code As Long)
Dim ll_Cursor As Long

On Error GoTo errhandler
    ml_d = al_TRANS_Code
    
    If al_TRANS_Code = 0 Then
        
        md_manualCost = 0
        ml_prevMasterTran = 0
        txt_ShipFromDC = ms_DC_Name
        txt_ShipDate = DateToString(md_shippingDay)
        AddDay
        txt_LoadPlanStartTime = "0000"
        txt_LoadPlanEndTime = "0000"
        txt_LoadStartTime = "0000"
        txt_LoadEndTime = "0000"
        txt_ArrivalTime = "0000"
        
        DCCost1.TransCode = 0
        
        cbo_returnTransaction.FirstBlankItem = True
        
'        Call SetupPL_STYLE(ms_DC_Code)

        Call RefreshMasterTran("", False)
        Call RefreshUOMInfo(False)
    Else

        ll_Cursor = OpenSQLSafe(mo_Db, "EXEC Dc_Interco_dtl " & al_TRANS_Code)
        
        ' global vars
        DC_Code = mo_Db.GetFields(ll_Cursor, "DC_Code")
        DC_name = mo_Db.GetFields(ll_Cursor, "Supplier_Name")
        ShippingDay = mo_Db.GetFields(ll_Cursor, "TRANS_Date")
        ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
        ml_prevMasterTran = mo_Db.GetFields(ll_Cursor, "Master_TRANS_Code")
        
'        Call SetupPL_STYLE(IIf(mo_Db.GetFields(ll_cursor, "Master_TRANS_Code") = al_TRANS_Code, ms_DC_Code, mo_Db.GetFields(ll_cursor, "Receiving_DC")))
        
        ' ui data
        txt_ShipFromDC.Text = ms_DC_Name
        txt_ShipDate.Text = DateToString(md_shippingDay)
        Call SetComboItemValue(cbo_ShipToDC, mo_Db.GetFields(ll_Cursor, "Receiving_DC"))
        
        cbo_returnTransaction.FirstBlankItem = False
        Call RefreshMasterTran(mo_Db.GetFields(ll_Cursor, "CARRIER_Code"), False)
        
        If Not SetComboItemValue(cbo_returnTransaction, mo_Db.GetFields(ll_Cursor, "Master_TRANS_Code")) Then
            Debug.Assert (False)
            
            ' transaction is master and as 'In use' or 'Free'
            Debug.Assert (mo_Db.GetFields(ll_Cursor, "Master_TRANS_Code") = al_TRANS_Code)
            
            ' add a current transaction line is 'In use' or 'Free'
'            Call cbo_returnTransaction.AddItem(Array(al_TRANS_Code, IIf(mo_Db.GetFields(ll_cursor, "InUse") = 0, "One way shipment", "Reused shipment"), mo_Db.GetFields(ll_cursor, "Ship_To_CT_Code"), mo_Db.GetFields(ll_cursor, "Ship_To_ZIP_Code"), mo_Db.GetFields(ll_cursor, "Shipping_Date"), mo_Db.GetFields(ll_cursor, "InUse")), True)
        Else
            ' add a current transaction line is 'In use' or 'Free'
'            Call cbo_returnTransaction.AddItem(Array(al_TRANS_Code, IIf(mo_Db.GetFields(ll_cursor, "InUse") = 0, "One way shipment", "Reused shipment"), mo_Db.GetFields(ll_cursor, "Ship_To_CT_Code"), mo_Db.GetFields(ll_cursor, "Ship_To_ZIP_Code"), mo_Db.GetFields(ll_cursor, "Shipping_Date"), mo_Db.GetFields(ll_cursor, "InUse")))
        End If
        
        If gs_Action <> "MoreInfo" Then
            Call EnableControl(cbo_returnTransaction, Val(GetCboValue(cbo_returnTransaction, "InUse")) = 0)
        End If
        
        Call RefreshCarrierInfo(False)
        Call SetComboItemValue(cbo_carrier, mo_Db.GetFields(ll_Cursor, "CARRIER_Code"))
            
        Call RefreshUOMInfo(False)
        Call SetComboItemValue(cbo_UOM, mo_Db.GetFields(ll_Cursor, "UOM_Code"))
        
        Call SetComboItemValue(cbo_Equipement, mo_Db.GetFields(ll_Cursor, "EQ_code"))
        
'        Call RefreshZIPInfo(False)
        
        txt_HaulierCpy.Text = mo_Db.GetFields(ll_Cursor, "Haulier_Company")
        txt_CLSOrderNb = mo_Db.GetFields(ll_Cursor, "Order_Number")
        txt_CLSShipNb = mo_Db.GetFields(ll_Cursor, "Shipment_Number")
        cbo_delivery.Text = mo_Db.GetFields(ll_Cursor, "Delivery_Number")
        txt_DeliveryDate = DateToString(mo_Db.GetFields(ll_Cursor, "Delivery_Date"))
        txt_Quantity = mo_Db.GetFields(ll_Cursor, "Quantity")
        txt_RSRequire = mo_Db.GetFields(ll_Cursor, "remark")
        
        Call RefreshSurchargeInfo(False)    ' call after delivery date set
'        Call SetComboItemValue(cbo_surcharges, mo_Db.GetFields(ll_Cursor, "DCS_Code"))

        txt_HaulierBookNb = mo_Db.GetFields(ll_Cursor, "Haulier_Booking_Number")
        txt_ArrivingTrailerNb = mo_Db.GetFields(ll_Cursor, "Arriving_Trailer_Number")
        txt_LoadPlanStartTime = mo_Db.GetFields(ll_Cursor, "Load_Planned_Starting_Time")
        txt_LoadPlanEndTime = mo_Db.GetFields(ll_Cursor, "Load_Planned_Ending_Time")
        txt_ArrivalTime = mo_Db.GetFields(ll_Cursor, "Load_Arrival_Time")
        txt_TrailerNb = mo_Db.GetFields(ll_Cursor, "Trailer_Number")
        txt_LoadStartTime = mo_Db.GetFields(ll_Cursor, "Load_Starting_Time")
        txt_LoadEndTime = mo_Db.GetFields(ll_Cursor, "Load_Ending_Time")
        txt_LoadBy = mo_Db.GetFields(ll_Cursor, "Load_By")
        
        Call mo_Db.Close(ll_Cursor)
        
        DCCost1.TransCode = al_TRANS_Code
    End If
    
    DCCost1.Grid_Init
    
    Call UpdatePriceListUI
    
    Call UpdateMasterTransUI
        
    Call InitTransportCost
    
    Call UpdateTotalCost
    
'    Call PropagateTotalQty(GetTotalQty(), GetTotalCost(False, Val(GetCboValue(cbo_UOM, "DropOff_Cost")), md_manualCost))
    
    Exit Sub

errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler("Item_load")
End Sub


Private Sub UpdateMasterTransUI()
On Error GoTo errhandler
    If gs_Action <> "Add" And gs_Action <> "Update" Or ms_TableName = "DC_Int_End" Then Exit Sub
    
    If Val(GetCboKey(cbo_returnTransaction)) <> ml_d Then
        Call EnableControl(SSShipDate, False)
        Call EnableControl(cbo_carrier, False)
        Call EnableControl(cbo_Equipement, False)
        Call EnableControl(cbo_ShipToDC, False)
    Else

        If Val(GetCboValue(cbo_returnTransaction, "InUse")) > 0 Then
            Call EnableControl(SSShipDate, False)
            Call EnableControl(cbo_carrier, False)
            Call EnableControl(cbo_Equipement, False)
            Call EnableControl(cbo_ShipToDC, False)
        Else
            Call EnableControl(SSShipDate, True)
            Call EnableControl(cbo_carrier, True)
            Call EnableControl(cbo_Equipement, True)
            Call EnableControl(cbo_ShipToDC, True)
        End If
        
    End If
    Exit Sub
errhandler:
    Call ErrorHandler("UpdateMasterTransUI()")
End Sub

Private Sub UpdateUI(ByVal as_Mode As String)
On Error GoTo errhandler
    Select Case as_Mode
        
        Case "Add"
            Call SetEnabled(GetContainedControlsChain(Me), True)
            Call EnableControl(txt_ShipFromDC, False)
            
            SSShipDate.Visible = False
            spp_save.Visible = True
        Case "Update"
            If ms_TableName = "DC_Int_End" Then
                Call SetEnabled(GetContainedControlsChain(Me), False)
                Call SetEnabled(GetContainedControlsChain(Fr_Schedule), True)
                Call SetEnabled(GetContainedControlsChain(Fr_Actual), True)
                
                Call EnableControl(spp_save, True)
                Call EnableControl(ssp_quit, True)
            Else
                Call SetEnabled(GetContainedControlsChain(Me), True)
                Call EnableControl(txt_ShipFromDC, False)
            End If
            
            SSShipDate.Visible = True
            spp_save.Visible = True
        Case "Delete"
            Call SetEnabled(GetContainedControlsChain(Me), False)
            SSShipDate.Visible = False
            spp_save.Visible = True
            Call EnableControl(spp_save, True)
            Call EnableControl(ssp_quit, True)
        Case "MoreInfo"
            Call SetEnabled(GetContainedControlsChain(Me), False)
            SSShipDate.Visible = False
            spp_save.Visible = False
            Call EnableControl(ssp_quit, True)
    End Select
    
    ' allways locked
    txt_ShipDate.Locked = True
    txt_DeliveryDate.Locked = True
    
    Exit Sub
errhandler:
    Call ErrorHandler("UpdateUI()")
End Sub

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"
                Call lo_Control.Clear
            Case "COMBOBOX"
                Call lo_Control.Clear
            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
    Next
    
'    cbo_surcharges.Request = ""
    Exit Sub
errhandler:
    Call ErrorHandler("Item_Clear()")
End Sub
' 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(mo_Db, ml_U_Code, SCREEN_NAME, 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, Me.Name & "::" & as_Fct & SEP1 & Err.Source, Err.Description
End Sub

' logs message to database
#If LIVE = 1 Then
    Public Sub LogMessage(ByVal ao_Db As Object, ByVal al_U_Code As Long, ByVal as_ScreenName As String, ByVal as_LogMsg As String, Optional ByVal as_LogType As String = "E", Optional ByVal ab_ExitOnException As Boolean = True)
#Else
    Public Sub LogMessage(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal al_U_Code As Long, ByVal as_ScreenName As String, ByVal as_LogMsg As String, Optional ByVal as_LogType As String = "E", Optional ByVal ab_ExitOnException As Boolean = True)
#End If
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 = as_ScreenName & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
  
  ls_req = Replace(LOG_REQUEST, "$UCODE$", SQLNum(al_U_Code), , , vbTextCompare)
  ls_req = Replace(ls_req, "$LOGTYPE$", SqlStr(as_LogType), , , vbTextCompare)
  ls_req = Replace(ls_req, "$MSG$", SqlStr(Trim(as_LogMsg), 4000), , , vbTextCompare)
  ls_req = Replace(ls_req, "$APP$", SqlStr(Trim(ls_Source), 50), , , vbTextCompare)
  
  Call ExecuteSQLSafe(ao_Db, ls_req)
  Exit Sub
errhandler:
  If ab_ExitOnException Then
    Call MsgBox("A fatal error occured. Unable to log error into database, the application will be closed. Please report the following message to your IT support: " & vbCrLf & _
      as_LogMsg & " - " & ls_Source & "LogMessage exception " & Err.Number & "-" & Err.Description, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End
  Else
    Call ao_Db.Disconnect
  End If
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(Me.Name & ".GetDbError()")
End Function

Public Sub Load_A_COM()
    
On Error GoTo errhandler

    If mb_Initialized Then Exit Sub
    
    mb_Initialized = True
    
    mb_eventRunning = True
    
    Dim lo_Control 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 "ARMCHECKVIEW0"
          Set lo_Control.ArmDb = mo_Db
          lo_Control.Language = ms_Language_Code
          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
    
    If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

#If LIVE = 1 Then
    Set mo_Sys = CreateObject("ArmSYSCOM.ArmSys")
    Set mo_sapXML = CreateObject("MSXML2.DOMDocument")
    Set mo_scriptObj = CreateObject("MSScriptControl.ScriptControl")
#Else
    Set mo_Sys = New ARMSYSCOMLib.ArmSYS
    Set mo_sapXML = New MSXML2.DOMDocument
    Set mo_scriptObj = New MSScriptControl.ScriptControl
#End If

    mo_scriptObj.Language = "VBScript"
    
    spp_save.Picture = LoadResPicture(RES_OK, vbResIcon)
    ssp_quit.Picture = LoadResPicture(RES_QUIT, vbResIcon)
    SSShipDate.Picture = LoadResPicture(RES_DOWN2, vbResIcon)
    SSDeliveryDate.Picture = LoadResPicture(RES_DOWN2, vbResIcon)

    If Not mo_Db.IsConnected Then
        Call ReconnectSafe
    End If
    
    DCCost1.dc_user = prg.LoginName
    Set DCCost1.ArmDb = mo_Db
    Call DCCost1.SetReconnectParams(ms_reconnectServer, ms_reconnectDB, ms_reconnectUser, ms_reconnectPassword, ms_reconnectApp)
    DCCost1.Lang = gut_LangLogin.Code
    DCCost1.U_Code = ml_U_Code
    Call DCCost1.Load_A_COM

    ckv_surcharges.Columns = 8  ' Checked,DCS_Price, DCPLL_Code, UOM_Code, DCS_Default, DCS_Formula, DCS_quantity
    ckv_surcharges.HeaderSizes = Array(3000, 0, 0, 0, 0, 0, 0, 0)
    
    Call Interco_constants
    
    cbo_carrier.FirstBlankItem = False
    
    cbo_returnTransaction.FirstBlankItem = True
    
    cbo_ShipToDC.FirstBlankItem = False
    cbo_ShipToDC.Request = "EXEC DC_cbo"

    cbo_Equipement.FirstBlankItem = False
    cbo_Equipement.Request = "EXEC DC_Equipement_cbo"
    
    cbo_UOM.FirstBlankItem = False
    cbo_UOM.Request = "EXEC DC_UOM_cbo2"
    
    mb_eventRunning = False
    
    Exit Sub
    
errhandler:
    
    Call ErrorMessage("Load_A_COM")
    
End Sub

Public Sub InitControl()
On Error GoTo errhandler
    mb_eventRunning = True
    
'    msa_PLs = Split(Get_A_Config("DC_PL_STYLE"), SEP)
    
'    mb_PL_STYLE_ENABLED = False
    
    ms_UrlWebServicePurchase = Get_A_Config("DC_WEBSERVICE_PURCHASE_DATA")
    ms_UrlWebServiceOrder = Get_A_Config("DC_WEBSERVICE_ORDER_DATA")

    
    Call Item_Clear
    
    cbo_carrier.Request = "EXEC DC_Carrier_lst2 " & SqlStr(ms_DC_Code, 4) & ", 'I', " & SqlDate(md_shippingDay) & ", NULL"
    
    Call UpdateUI(gs_Action)
    
    If gs_Action = "Add" Then
        Caption = ms_Title & " - " & ms_titleA
    ElseIf gs_Action = "Update" Then
        Caption = ms_Title & " - " & ms_titleU
    ElseIf gs_Action = "Delete" Then
        Caption = ms_Title & " - " & ms_titleD
    Else
        Caption = ms_Title
    End If
    
    If gs_Action = "Add" Then
        Call Item_Load(0)
        DCCost1.Enabled = True
    Else
        Call Item_Load(ml_d)
        DCCost1.Enabled = (gs_Action = "Update")
    End If
    
    mb_eventRunning = False

    Exit Sub
errhandler:
    mb_eventRunning = False
    Call ErrorMessage("InitControl")
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
    
    Call DCCost1.Unload_A_COM
    
    Set mo_Sys = Nothing
    
    Set mo_scriptObj = Nothing
    
    Exit Sub
    
errhandler:
    
    Call ErrorHandler("UnLoad_A_Com")
    
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 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(Me.Name & ".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, "SQL : " & as_Request, ls_ErrMsg
    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(Me.Name & ".ExecuteSQLSafe")
End Sub

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

    SqlDate = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
        SqlDate = "'" & Format(av_Data, "yyyy-mm-dd") & "'"
    End If
    Exit Function
errhandler:
    Call ErrorHandler("SqlDate")
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 SQLNum(ByVal as_str As String) As String
    If as_str = "" Then
        SQLNum = "NULL"
    Else
        SQLNum = Replace(as_str, ",", ".")
    End If
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 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

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(Me.Name & ".SetComboItemValue")
End Function

Private Function Item_ReplacePlaceholders(ls_retVal As String) As String
On Error GoTo errhandler

    ls_retVal = Replace(ls_retVal, "$TRANS_Date$", SqlDate(StringToDate(txt_ShipDate.Text)), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$MASTER_TRANS_code$", SQLNum(GetCboKey(cbo_returnTransaction)), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$DC_Name$", SqlStr(ms_DC_Name, 30), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Supplier_Name$", SqlStr(txt_ShipFromDC.Text, 80), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$ShipToDC_code$", SqlStr(GetCboKey(cbo_ShipToDC), 4), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$ShipToDC_Name$", SqlStr(GetCboValue(cbo_ShipToDC, "DC_Desc"), 80), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Ship_To_CT_Code$", SqlStr(GetCboValue(cbo_ShipToDC, "CT_Code"), 4), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$EQ_code$", SqlStr(cbo_Equipement.Text, 30, True), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Haulier_Company$", SqlStr(txt_HaulierCpy.Text, 15), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Order_Number$", SqlStr(txt_CLSOrderNb.Text, 20), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Shipment_Number$", SqlStr(txt_CLSShipNb.Text, 20), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Delivery_Number$", SqlStr(cbo_delivery.Text, 20), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Delivery_Date$", SqlDate(StringToDate(txt_DeliveryDate.Text)), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Quantity$", SQLNum(txt_Quantity.Text), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$UOM_code$", SqlStr(cbo_UOM.Text, 4, True), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Remark$", SqlStr(txt_RSRequire.Text, 240), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Haulier_Booking_Number$", SqlStr(txt_HaulierBookNb, 15), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Arriving_Trailer_Number$", SqlStr(txt_ArrivingTrailerNb.Text, 15), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Load_Planned_Starting_Time$", SqlStr(DateFormat(txt_LoadPlanStartTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Load_Planned_Ending_Time$", SqlStr(DateFormat(txt_LoadPlanEndTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Load_Arrival_Time$", SqlStr(DateFormat(txt_ArrivalTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Trailer_Number$", SqlStr(txt_TrailerNb, 15), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Load_Starting_Time$", SqlStr(DateFormat(txt_LoadStartTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Load_Ending_Time$", SqlStr(DateFormat(txt_LoadEndTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Load_By$", SqlStr(txt_LoadBy.Text, 15), , vbTextCompare)

    Item_ReplacePlaceholders = ls_retVal
    Exit Function
errhandler:
    Call ErrorHandler(Me.Name & ".Item_ReplacePlaceholders")
End Function

Private Function GetCT_Code(ByVal as_DC_Code As String) As String
On Error GoTo errhandler
' search is based on cbo_ShipToDC

    GetCT_Code = ""

    If cbo_ShipToDC.Count = 0 Then
        Call cbo_ShipToDC.Load
    End If
    
    Dim ll_i As Long
    For ll_i = 1 To cbo_ShipToDC.Count
        If cbo_ShipToDC.ComboItems(ll_i).Key = as_DC_Code Then
            GetCT_Code = cbo_ShipToDC.GetItemData(cbo_ShipToDC.ComboItems(ll_i).Key, "CT_Code")
            Exit For
        End If
    Next
 
    Exit Function
errhandler:
     Call ErrorHandler("GetCT_Code()")
End Function

Private Function GetDC_CARRIER_Code(ByVal as_DC_Code As String, ByVal as_CARRIER_Code As String) As Long
On Error GoTo errhandler
Const C_REQ  As String = "SELECT DC_CARRIER_Code FROM DC_Carrier_link WHERE DC_Code=$DC_Code$ AND CARRIER_Code=$CARRIER_Code$ AND Drop_Flag <> 'X'"
    Dim ls_req As String
    ls_req = Replace(C_REQ, "$DC_Code$", SqlStr(as_DC_Code, 4), , , vbTextCompare)
    ls_req = Replace(ls_req, "$CARRIER_Code$", SqlStr(as_CARRIER_Code, 10), , , vbTextCompare)
    
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    GetDC_CARRIER_Code = mo_Db.GetFields(ll_Cursor, "DC_CARRIER_Code")
    
    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("GetDC_CARRIER_Code()")
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, Optional ByVal as_DefaultValue As String = "") As String
On Error GoTo errhandler
    GetCboValue = as_DefaultValue
    If Not ao_cbo.SelectedItem Is Nothing Then
    
        Dim ls_retVal As String
        ls_retVal = ao_cbo.GetItemData(ao_cbo.SelectedItem.Key, av_field)
        
        If ls_retVal <> "" Then
            GetCboValue = ls_retVal
        End If
    
    End If
    Exit Function
errhandler:
     Call ErrorHandler("GetCboValue()")
End Function



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", "CHECKBOX", "COMBOBOX", "PICTUREBOX", "COMMANDBUTTON", "TOOLBARCONTROL"
            ao_Control.Enabled = ab_Enabled
            ao_Control.TabStop = ab_Enabled
        Case "DCCOST"
            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(Me.Name & ".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 ao_parent.hwnd = lo_Control.Container.hwnd Then
                    If TypeOf lo_Control Is Frame Then
                        Dim lo_aux_collection As New Collection
                        Dim ll_i As Long
                        Set lo_aux_collection = GetContainedControlsChain(lo_Control)
                        For ll_i = 1 To lo_aux_collection.Count
                            lo_retCollection.Add (lo_aux_collection.Item(ll_i))
                        Next
                    Else
                        Call lo_retCollection.Add(lo_Control)
                    End If
                End If
        End If
    Next
    Set GetContainedControlsChain = lo_retCollection
    Exit Function
errhandler:
    Call ErrorHandler(Me.Name & ".GetContainedControlsChain()")
End Function

Private Sub txt_Quantity_Validate(Cancel As Boolean)
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    
    If Not CheckNumericValue(txt_Quantity.Text) Then
        Cancel = True
        txt_Quantity.SelStart = 0
        txt_Quantity.SelLength = Len(txt_Quantity.Text)
        Exit Sub
    End If
    
    Dim ll_Index As Long
    ll_Index = GetDCTransportLine(ml_d)
    
    Dim ld_newQty As Double
    
    If CheckNumericValue(txt_Quantity.Text) And Trim(txt_Quantity.Text) <> "" Then
        
        ld_newQty = Val(txt_Quantity.Text)
    
    Else
    
        ld_newQty = 0
    
    End If
    
    If moa_DCTransport_cost(ll_Index).Quantity = ld_newQty Then
        Exit Sub
    End If
    
    moa_DCTransport_cost(ll_Index).Quantity = ld_newQty
    
    Cancel = Not GenerateTransportCost
    
    If Not Cancel Then
        Call UpdateTotalCost
    End If
    
    Exit Sub
errhandler:
    Call ErrorMessage(Me.Name & ".txt_Quantity_Validate()")

End Sub

Private Function GetLeadingTransportLine() As Long
On Error GoTo errhandler
    
    Dim ll_leadingTransport As Long
    ll_leadingTransport = 0
    
    Dim ll_TRANS_Code As Long
    ll_TRANS_Code = Val(GetCboKey(cbo_returnTransaction))
    
    If ll_TRANS_Code <> 0 Then
        
        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 = ll_TRANS_Code Then
            
                ll_leadingTransport = ll_i
                Exit For
                
            End If
        Next
        
    End If

    GetLeadingTransportLine = ll_leadingTransport
    Exit Function
errhandler:
    Call ErrorHandler(Me.Name & ".GetLeadingTransportLine()")
End Function

Private Sub CheckTransportCost(ByRef ab_isFullTruck As Boolean, ByRef ab_overLoaded As Boolean, ByRef ab_mixedUOM As Boolean)
On Error GoTo errhandler
    
'    Debug.Assert (CheckNumericValue(txt_Quantity.Text) And Trim(txt_Quantity.Text) <> "")
'    Debug.Assert (GetCboKey(cbo_UOM) <> "")
    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 = GetCboKey(cbo_UOM)
    
    
    Dim ll_LeadingLine As Long
    ll_LeadingLine = GetLeadingTransportLine()

    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()
    
    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(Me.Name & ".CheckTransportCost()")
End Sub

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(Me.Name & ".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(Me.Name & ".UniqueSurcharges()")
End Function

Private Sub InitTransportCost()
On Error GoTo errhandler
Const C_REQ As String = "EXEC DC_PriceListPrice_lst $DCPL_Code$, $MASTER_TRANS_code$, $IsReturn$"
    
    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
    
    If GetCboKey(cbo_returnTransaction) <> "" Then
        
        Dim ls_req As String
    
        ls_req = Replace(C_REQ, "$DCPL_Code$", SQLNum(GetCboValue(cbo_UOM, "DCPL_Code")), , , vbTextCompare)
        ls_req = Replace(ls_req, "$IsReturn$", SqlStr(IIf(IsReturnTransaction(), "X", ""), 1), , , vbTextCompare)
        ls_req = Item_ReplacePlaceholders(ls_req)
    
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        ll_Rows = UniqueTransactions(ll_Cursor)
        
        If ll_Rows > 0 Then
            
            ' check if ml_d exists in cursor
            If mo_Db.FindBinary(ll_Cursor, "TRANS_Code", ml_d) < 0 Then
                ReDim moa_DCTransport_cost(ll_Rows) As tDCTransport_cost
                ll_Rows = 0
            Else
                ReDim moa_DCTransport_cost(ll_Rows - 1) As tDCTransport_cost
            End If
        
            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 = Val(GetCboValue(cbo_UOM, "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).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 = Val(txt_Quantity.Text)
                    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 = Val(txt_Quantity.Text)
                    End If
                
                    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")

                    ' current data are loaded from UI
                    If moa_DCTransport_cost(ll_i).TRANS_Code = ml_d Then
                        moa_DCTransport_cost(ll_i).Quantity = Val(txt_Quantity.Text)
                        moa_DCTransport_cost(ll_i).SurchargeInfo(ll_i_surch).DCS_quantity = 1
                        
                        Debug.Assert (moa_DCTransport_cost(ll_i).UOM_Code = GetCboKey(cbo_UOM))
                    End If
                
                    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
        Else
            ReDim moa_DCTransport_cost(0) As tDCTransport_cost
            ReDim moa_DCTransport_cost(0).SurchargeInfo(0) As tDCSurcharge_cost
        End If

        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    Else
        ' we are in Add screen => initialize moa_DCTransport_cost
        ReDim moa_DCTransport_cost(0) As tDCTransport_cost
        ReDim moa_DCTransport_cost(0).SurchargeInfo(0) As tDCSurcharge_cost
    End If
    
    If ll_Rows = 0 Then
        ll_i = UBound(moa_DCTransport_cost)
    
        moa_DCTransport_cost(ll_i).DCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code"))
        
        moa_DCTransport_cost(ll_i).TRANS_Code = ml_d
        moa_DCTransport_cost(ll_i).Quantity = Val(txt_Quantity.Text)
        moa_DCTransport_cost(ll_i).UOM_Code = GetCboKey(cbo_UOM)
        
        moa_DCTransport_cost(ll_i).DCPLLI_code = 0
        moa_DCTransport_cost(ll_i).DCPLLI_Price = 0
        moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code = "EUR"                     ' todo:
        moa_DCTransport_cost(ll_i).Manual_Cost = DCCost1.ManualCost
        moa_DCTransport_cost(ll_i).Surcharge_Cost = DCCost1.SurchargeCost
        
        moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Price = 0
        moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Min = 0
        moa_DCTransport_cost(ll_i).DCPLL_Full_Truck_Max = 0
        
        moa_DCTransport_cost(ll_i).PriceFormula = "Price"
        moa_DCTransport_cost(ll_i).FullTruckPriceFormula = "Price"
    
        ' init surcharges from UI
        ll_surchRows = ckv_surcharges.CheckedCount
        If ll_surchRows > 0 Then
            ReDim moa_DCTransport_cost(ll_i).SurchargeInfo(ll_surchRows - 1) As tDCSurcharge_cost
        
            Dim ll_checked_ind  As Long
            ll_checked_ind = 0
        
            For ll_i_surch = 1 To ckv_surcharges.Count
                If ckv_surcharges.ListItems(ll_i_surch).Checked Then
                    moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).DCS_Code = ckv_surcharges.ListItems(ll_i_surch).Tag.Id
                    moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).SurchargeFormula = ckv_surcharges.ListItems(ll_i_surch).Tag.GetData(SURCHARGE_COLS.DCS_Formula)
                    moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).DCS_Price = ckv_surcharges.ListItems(ll_i_surch).Tag.GetData(SURCHARGE_COLS.DCS_Price)
                    moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).DCS_quantity = ckv_surcharges.ListItems(ll_i_surch).Tag.GetData(SURCHARGE_COLS.DCS_quantity)
                    ll_checked_ind = ll_checked_ind + 1
                End If
            Next
        Else
            ReDim moa_DCTransport_cost(ll_i).SurchargeInfo(0) As tDCSurcharge_cost
            moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).DCS_Code = ""
            moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).SurchargeFormula = "Price"
            moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).DCS_Price = 0
            moa_DCTransport_cost(ll_i).SurchargeInfo(ll_checked_ind).DCS_quantity = 1
        End If
        
    End If
    
    Exit Sub
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler(Me.Name & ".InitTransportCost()")
End Sub

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(Me.Name & ".GetDCTransportLine()")
End Function


' update transport cost for the transactions direct into database
' cbo_UOM must be selected !!!
' txt_QuantityWeight.Text must be valid numeric !!!!!
Private Sub UpdateTransportCost(ByVal al_currerntTransaction As Long, ByVal al_prevMasterTran As Long)
On Error GoTo errhandler
    If Not SupportPriceList Then Exit Sub
    
    Debug.Assert (GetCboKey(cbo_UOM) <> "")
    Debug.Assert (CheckNumericValue(txt_Quantity.Text))
    

    Dim lb_isFullTruck As Boolean
    Dim lb_overLoaded As Boolean
    Dim lb_mixedUOM As Boolean
    
    Call CheckTransportCost(lb_isFullTruck, lb_overLoaded, lb_mixedUOM)
    Debug.Assert (Not lb_overLoaded)
    Debug.Assert (Not lb_mixedUOM)
    
    Dim ll_nbOfTrans As Long
    ll_nbOfTrans = IIf(IsReturnTransaction(), 2, 1)
    
Const C_REQ_DEL As String = "DELETE FROM DC_Cost WHERE TRANS_Code=$TRANS_Code$ AND DCC_type IN ('T', 'D')"
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 lb_prevTranupdated As Boolean
    lb_prevTranupdated = (al_currerntTransaction = al_prevMasterTran)
    
    Dim ll_i As Long
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
    
        If al_currerntTransaction <> moa_DCTransport_cost(ll_i).TRANS_Code Then
        
            If moa_DCTransport_cost(ll_i).TRANS_Code = al_prevMasterTran Then
                lb_prevTranupdated = True
            End If
        
            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))
            
            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)
                ls_req = Replace(ls_req, "$CURR_code$", SQLNum(moa_DCTransport_cost(ll_i).DCPLLI_CURR_Code), , , vbTextCompare)
                
                If lb_isFullTruck Then
                    ls_req = Replace(ls_req, "$DC_Cost$", SQLNum(GetPriceFullTruck(moa_DCTransport_cost(ll_i), _
                                                           moa_DCTransport_cost(ll_i).Quantity _
                                                           ) / ll_nbOfTrans), , , vbTextCompare)
                Else
                    ls_req = Replace(ls_req, "$DC_Cost$", SQLNum(GetPrice(moa_DCTransport_cost(ll_i)) / ll_nbOfTrans), , , vbTextCompare)
                    
                End If
                
                If ls_req <> "" Then
                    ls_req = Replace(ls_req, "$DC_Comment$", SqlStr(""), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$Z_Creator$", SqlStr(ms_LoginName, 15), , , vbTextCompare)
                
                    Call ExecuteSQLSafe(mo_Db, ls_req)
                End If
            End If
        End If
    Next
    
    If Not lb_prevTranupdated Then
        ' user probably selected another master transaction => update the price as per current pricelist
        
        'UPDATE EXISTING PRICES
        Call ExecuteSQLSafe(mo_Db, Replace(C_REQ_UPD, "$TRANS_Code$", SQLNum(al_prevMasterTran), , , vbTextCompare))
        
    End If
    
    Exit Sub
errhandler:
    Call ErrorHandler(Me.Name & ".UpdateTransportCost()")
End Sub


' generate surcharge cost for currently edited record
Private Function GenerateSurchargeCost() As Boolean
On Error GoTo errhandler
    
    GenerateSurchargeCost = False
    
    ' clean generated cost info
    Call DCCost1.DeleteCostLine("S")
    
    Dim ll_CurrentLine As Long
    ll_CurrentLine = GetDCTransportLine(ml_d)
    
    If Not SupportPriceList _
        Or GetCboKey(cbo_UOM) = "" _
        Or GetCboKey(cbo_ShipToDC) = "" _
        Or ckv_surcharges.CheckedCount = 0 Then
        
        Debug.Assert (moa_DCTransport_cost(ll_CurrentLine).DCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code")))

        ' set prices at zero
        ReDim moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(0) As tDCSurcharge_cost
        
        moa_DCTransport_cost(ll_CurrentLine).Surcharge_Cost = 0
        moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(0).DCS_Code = ""
        moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(0).DCS_Price = 0
        moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(0).DCS_quantity = 1
        moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(0).SurchargeFormula = "Price"
    Else
        
        ' 1. update current line with surcharge price and formula
        Dim ld_surchargeCost As Double
        ld_surchargeCost = 0
        
        Dim ll_i As Long
        
        Dim ll_checked_ind  As Long
        ll_checked_ind = 0
        
        Dim ll_surchRows As Long
        ll_surchRows = ckv_surcharges.CheckedCount
        If ll_surchRows > 0 Then
            ReDim moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_surchRows - 1) As tDCSurcharge_cost
        
            For ll_i = 1 To ckv_surcharges.Count
                If ckv_surcharges.ListItems(ll_i).Checked Then
                    moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).DCS_Code = ckv_surcharges.ListItems(ll_i).Tag.Id
                    moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).SurchargeFormula = ckv_surcharges.ListItems(ll_i).Tag.GetData(SURCHARGE_COLS.DCS_Formula)
                    moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).DCS_Price = ckv_surcharges.ListItems(ll_i).Tag.GetData(SURCHARGE_COLS.DCS_Price)
                    moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).DCS_quantity = ckv_surcharges.ListItems(ll_i).Tag.GetData(SURCHARGE_COLS.DCS_quantity)
                    
                    ' generate the surcharge cost
                    ld_surchargeCost = ld_surchargeCost + GetSurchargePrice(moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind), DCCost1.TransportCost)
                
                    ll_checked_ind = ll_checked_ind + 1
                End If
            Next
        Else
            ReDim moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(0) As tDCSurcharge_cost
            moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).DCS_Code = ""
            moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).SurchargeFormula = "Price"
            moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).DCS_Price = 0
            moa_DCTransport_cost(ll_CurrentLine).SurchargeInfo(ll_checked_ind).DCS_quantity = 1
        End If
        
        moa_DCTransport_cost(ll_CurrentLine).Surcharge_Cost = ld_surchargeCost
        
        Call DCCost1.UpdateCostLine("S", 0, moa_DCTransport_cost(ll_CurrentLine).Surcharge_Cost, moa_DCTransport_cost(ll_CurrentLine).DCPLLI_CURR_Code)
        
    End If
    
    GenerateSurchargeCost = True

    Exit Function
errhandler:
    Call ErrorHandler(Me.Name & ".GenerateSurchargeCost()")
End Function

' generate the cost for currently edited record
Private Function GenerateTransportCost() As Boolean
On Error GoTo errhandler
Const C_REQ As String = "EXEC DC_PriceListPrice_sel $DCPL_Code$, $Ship_To_CT_Code$, $ShipToDC_code$, $Quantity$, $IsReturn$"
    
    GenerateTransportCost = True
    
    Dim ll_CurrentLine As Long
    Dim lb_isFullTruck As Boolean
    Dim lb_overLoaded As Boolean
    Dim lb_mixedUOM As Boolean
    
    ll_CurrentLine = GetDCTransportLine(ml_d)
    
    If Not SupportPriceList _
        Or GetCboKey(cbo_UOM) = "" _
        Or (txt_Quantity.Text = "" Or Not CheckNumericValue(txt_Quantity.Text)) Then
        
        moa_DCTransport_cost(ll_CurrentLine).DCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code"))

        ' set prices at zero
        moa_DCTransport_cost(ll_CurrentLine).DCPLLI_code = 0
        moa_DCTransport_cost(ll_CurrentLine).DCPLLI_Price = 0
        moa_DCTransport_cost(ll_CurrentLine).DCPLLI_CURR_Code = "EUR"       ' todo:
        moa_DCTransport_cost(ll_CurrentLine).UOM_Code = GetCboKey(cbo_UOM)
    
        moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Price = 0
        moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Min = Val(txt_Quantity.Text)
        moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Max = Val(txt_Quantity.Text)

        moa_DCTransport_cost(ll_CurrentLine).PriceFormula = "Price"
        moa_DCTransport_cost(ll_CurrentLine).FullTruckPriceFormula = "Price"
        
        GenerateTransportCost = False
    
        lb_isFullTruck = False
        lb_overLoaded = False
        lb_mixedUOM = False
    Else
        
        GenerateTransportCost = False
        
        ' 1. update current line with full truck and the prices
        Dim ll_Cursor As Long
        
        Dim ls_req As String
        ls_req = Replace(C_REQ, "$DCPL_Code$", SQLNum(GetCboValue(cbo_UOM, "DCPL_Code")), , , vbTextCompare)
        
'        If GetCboKey(cbo_returnTransaction) <> "" Then
        If IsReturnTransaction Then
            ' use the price of a master transsaction
            ls_req = Replace(ls_req, "$Ship_To_CT_Code$", SqlStr(GetCboValue(cbo_returnTransaction, "Ship_To_CT_Code"), 4), , , vbTextCompare)
            ls_req = Replace(ls_req, "$ShipToDC_code$", SqlStr(GetCboValue(cbo_returnTransaction, "Ship_To_ZIP_Code"), 4), , , vbTextCompare)
            ls_req = Replace(ls_req, "$IsReturn$", SqlStr(IIf(IsReturnTransaction(), "X", ""), 1), , , vbTextCompare)
        Else
            ls_req = Replace(ls_req, "$IsReturn$", SqlStr("", 1), , , vbTextCompare)
        End If
        
        Call Item_ReplacePlaceholders(ls_req)
        
        ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
        If mo_Db.RowCount(ll_Cursor) > 0 Then
            
            moa_DCTransport_cost(ll_CurrentLine).DCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code"))
            moa_DCTransport_cost(ll_CurrentLine).DCPLLI_code = mo_Db.GetFields(ll_Cursor, "DCPLLI_Code")
            moa_DCTransport_cost(ll_CurrentLine).DCPLLI_Price = mo_Db.GetFields(ll_Cursor, "DCPLLI_Price")
            moa_DCTransport_cost(ll_CurrentLine).DCPLLI_CURR_Code = mo_Db.GetFields(ll_Cursor, "DCPLLI_CURR_Code")
        
            moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Price = mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_Price")
            moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Min = mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_min")
            moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Max = mo_Db.GetFields(ll_Cursor, "DCPLL_Full_Truck_max")
        
            moa_DCTransport_cost(ll_CurrentLine).PriceFormula = mo_Db.GetFields(ll_Cursor, "PriceFormula")
            moa_DCTransport_cost(ll_CurrentLine).FullTruckPriceFormula = mo_Db.GetFields(ll_Cursor, "FullTruckPriceFormula")
        Else
            
            moa_DCTransport_cost(ll_CurrentLine).DCPLLI_code = 0
            moa_DCTransport_cost(ll_CurrentLine).DCPLLI_Price = 0
            moa_DCTransport_cost(ll_CurrentLine).DCPLLI_CURR_Code = "EUR"           ' todo:
        
            moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Price = 0
            moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Min = Val(txt_Quantity.Text)
            moa_DCTransport_cost(ll_CurrentLine).DCPLL_Full_Truck_Max = Val(txt_Quantity.Text)
        
            moa_DCTransport_cost(ll_CurrentLine).PriceFormula = "Price"
            moa_DCTransport_cost(ll_CurrentLine).FullTruckPriceFormula = "Price"
            
    '        GenerateTransportCost = True
            ReDim ms_MsgInfo(0, 1)
            ms_MsgInfo(0, 0) = "$QTY_FOR_COST$"
            ms_MsgInfo(0, 1) = txt_Quantity.Text
            
            Call MsgBox(MsgText(5110, ms_Language_Code, "#Qty not supported by price list!!! ($QTY_FOR_COST$)", ms_MsgInfo), vbOKOnly)
            
        End If
        
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
        
        Call CheckTransportCost(lb_isFullTruck, lb_overLoaded, lb_mixedUOM)
    End If
    
    Dim ld_Qty As Double
    ld_Qty = GetTotalQty()
    
    If lb_overLoaded Then
        ReDim ms_MsgInfo(1, 1)
        ms_MsgInfo(0, 0) = "$QTY_FOR_TRANSPORT$"
        ms_MsgInfo(0, 1) = ld_Qty
        ms_MsgInfo(1, 0) = "$UOM$"
        ms_MsgInfo(1, 1) = GetCboKey(cbo_UOM)
        Call MsgBox(MsgText(5120, ms_Language_Code, "#Truck is overloaded!!! ($QTY_FOR_TRANSPORT$ $UOM$)", ms_MsgInfo), vbCritical Or vbOKOnly)
        Exit Function
    End If
    
    If lb_mixedUOM Then
        Call MsgBox(MsgText(5070, ms_Language_Code, "#Mixed UOM!"), vbCritical Or vbOKOnly)
        Exit Function
    End If
    
    Dim ll_nbOfTrans As Long
    ll_nbOfTrans = IIf(IsReturnTransaction(), 2, 1)
    
    If lb_isFullTruck Then
        Call DCCost1.DeleteCostLine("D")
        Call DCCost1.UpdateCostLine("T", moa_DCTransport_cost(ll_CurrentLine).DCPLLI_code, _
                                         GetPriceFullTruck(moa_DCTransport_cost(ll_CurrentLine), _
                                                           moa_DCTransport_cost(ll_CurrentLine).Quantity _
                                                           ) / ll_nbOfTrans, _
                                         moa_DCTransport_cost(ll_CurrentLine).DCPLLI_CURR_Code)
    Else
            ' generate the one way transport cost
        Call DCCost1.DeleteCostLine("D")
        Call DCCost1.UpdateCostLine("T", moa_DCTransport_cost(ll_CurrentLine).DCPLLI_code, _
                                         GetPrice(moa_DCTransport_cost(ll_CurrentLine)) / ll_nbOfTrans, _
                                         moa_DCTransport_cost(ll_CurrentLine).DCPLLI_CURR_Code)
    End If
    
    GenerateTransportCost = True

    Exit Function
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler(Me.Name & ".GenerateTransportCost()")
End Function

Private Sub PropagateTotalQty(ByVal al_totalQty As Double, ByVal al_totalCost As Double)
On Error GoTo errhandler

    If al_totalQty <> 0 Then
        DCCost1.PartialCost = (Val(txt_Quantity.Text) / al_totalQty) * (al_totalCost - md_manualCost)
    Else
        DCCost1.PartialCost = 0
    End If
    
    Exit Sub

errhandler:
    Call ErrorHandler("PropagateTotalQty")
End Sub

Private Sub UpdateTotalCost()
On Error GoTo errhandler

    Dim lb_isFullTruck As Boolean
    Dim lb_overLoaded As Boolean
    Dim lb_mixedUOM As Boolean

    Call CheckTransportCost(lb_isFullTruck, lb_overLoaded, lb_mixedUOM)

    Call PropagateTotalQty(GetTotalQty(), GetTotalCost(lb_isFullTruck, Val(GetCboValue(cbo_UOM, "DropOff_Cost")), md_manualCost, False))

    Exit Sub
errhandler:
    Call ErrorHandler(Me.Name & ".UpdateTotalCost()")
End Sub

Private Function GetTotalCost(ByVal ab_fullTruck As Boolean, ByVal ad_dropOffCost As Double, ByRef ad_manualCost As Double, ByVal ab_allSurcharges As Boolean) As Double
On Error GoTo errhandler
    Dim ll_i As Long
    Dim ld_totalCost As Double
    
    ad_manualCost = 0
    
    Dim ll_LeadingLine As Long
    ll_LeadingLine = GetLeadingTransportLine()
    
    Dim ll_nbOfTrans As Long
    ll_nbOfTrans = IIf(IsReturnTransaction(), 2, 1)
    
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
        If ll_LeadingLine = ll_i Then
            If ab_fullTruck Then
                
                ld_totalCost = ld_totalCost + (GetPriceFullTruck(moa_DCTransport_cost(ll_i), _
                                                                GetTotalQty() _
                                                                ) / ll_nbOfTrans)
            
            Else
                
                ld_totalCost = ld_totalCost + (GetPrice(moa_DCTransport_cost(ll_i)) / ll_nbOfTrans)
            
            End If
        End If
        
        ld_totalCost = ld_totalCost + moa_DCTransport_cost(ll_i).Manual_Cost
        
        If ab_allSurcharges Then
            
            ld_totalCost = ld_totalCost + moa_DCTransport_cost(ll_i).Surcharge_Cost
        
        ElseIf moa_DCTransport_cost(ll_i).TRANS_Code = ml_d Then
            
            ld_totalCost = ld_totalCost + moa_DCTransport_cost(ll_i).Surcharge_Cost
        
        End If
        ad_manualCost = ad_manualCost + moa_DCTransport_cost(ll_i).Manual_Cost
    
    Next
    
    GetTotalCost = ld_totalCost
    Exit Function
errhandler:
    Call ErrorHandler(Me.Name & ".GetTotalCost()")
End Function

Private Function GetTotalQty() As Double
On Error GoTo errhandler
    GetTotalQty = Val(txt_Quantity.Text)
    Exit Function
errhandler:
    Call ErrorHandler(Me.Name & ".GetTotalQty()")
End Function

Private Sub UpdateSAPData(ByVal as_orderNo As String)
On Error GoTo errhandler

    Dim ls_retContent As String
    Dim ls_retHeader As String
    Dim lo_XMLParam     As New SvcXMLParam
    
    If Not mo_Sys.CallWebservice(ms_UrlWebServicePurchase, C_SAP_LOGIN, C_SAP_PASSW, "as_EBELN=" & as_orderNo, "application/x-www-form-urlencoded", "", ls_retContent, ls_retHeader) Then
        ' no service
        Call MsgBox("SAP sales document service call failed with error: No service (" & ms_UrlWebServicePurchase & ")")
        Exit Sub
    End If
    
    If Not lo_XMLParam.CheckHTTPResponse(ls_retHeader) Then
        ' no 200 response
        Call MsgBox("SAP sales document service return with HTTP error.")
        Exit Sub
    End If
    
    If Not lo_XMLParam.TestContentType(ls_retHeader, "text/xml") Then
        ' unexpected return type
        Call MsgBox("SAP sales document service call failed with error: Unexpected content type")
        Exit Sub
    End If
    
    If Not mo_sapXML.loadXML(ls_retContent) Then
        Call MsgBox("SAP sales order service call failed with error: Error in reading XML")
        Exit Sub
    End If
    
        ' display sales order data data
        
    Dim lo_XMLItem As MSXML2.IXMLDOMNode
    Dim lo_XMLItems As MSXML2.IXMLDOMNodeList
    
    Set lo_XMLItems = mo_sapXML.selectNodes("/Result/clientMsg")
    If lo_XMLItems.length > 0 Then
        For Each lo_XMLItem In lo_XMLItems
            Call MsgBox(lo_XMLItem.Text)
        Next
        Exit Sub
    End If

    Set lo_XMLItems = mo_sapXML.selectNodes("/DataSet/EKBE-VTTP/row")
    
    Dim ls_delivNb As String
    Dim ls_delivItem As String

    If lo_XMLItems.length > 0 Then
        
        Call cbo_delivery.Clear
        For Each lo_XMLItem In lo_XMLItems
            If Val(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")) <> 0 Then
                cbo_delivery.AddItem (Val(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")) & "/" & Val(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_ITEM")))
                ls_delivNb = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")
                ls_delivItem = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_ITEM")
            End If
        Next
    Else
        ' get sales order SAP data
        If Not mo_Sys.CallWebservice(ms_UrlWebServiceOrder, C_SAP_LOGIN, C_SAP_PASSW, "as_order_No=" & as_orderNo, "application/x-www-form-urlencoded", "", ls_retContent, ls_retHeader) Then
            ' no service
            Call MsgBox("SAP sales document service call failed with error: No service (" & ms_UrlWebServiceOrder & ")")
            Exit Sub
        End If
        
        If Not lo_XMLParam.CheckHTTPResponse(ls_retHeader) Then
            ' no 200 response
            Call MsgBox("SAP sales document service return with HTTP error.")
            Exit Sub
        End If
        
        If Not lo_XMLParam.TestContentType(ls_retHeader, "text/xml") Then
            ' unexpected return type
            Call MsgBox("SAP sales document service call failed with error: Unexpected content type")
            Exit Sub
        End If
        
        If Not mo_sapXML.loadXML(ls_retContent) Then
            Call MsgBox("SAP sales order service call failed with error: Error in reading XML")
            Exit Sub
        End If
    
        Set lo_XMLItems = mo_sapXML.selectNodes("/Result/clientMsg")
        If lo_XMLItems.length > 0 Then
            For Each lo_XMLItem In lo_XMLItems
                Call MsgBox(lo_XMLItem.Text)
            Next
            Exit Sub
        End If
        
        Set lo_XMLItems = mo_sapXML.selectNodes("/DataSet/inforow")
        
        Call cbo_delivery.Clear
        For Each lo_XMLItem In lo_XMLItems
            If Val(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")) <> 0 Then
                cbo_delivery.AddItem (Val(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")) & "/" & Val(lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_ITEM")))
                ls_delivNb = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")
                ls_delivItem = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_ITEM")
            End If
        Next
        
    End If
    
    If ls_delivNb <> "" Then
        Call SearchSAPData(ls_delivNb, ls_delivItem)
    End If
    
    Exit Sub
errhandler:
    Call ErrorHandler(Me.Name & ".UpdateSAPData()")
End Sub

Private Sub SearchSAPData(ByVal as_delivery As String, ByVal as_deliveryItem As String)
On Error GoTo errhandler
    
    If Not isNumeric(as_delivery) Then Exit Sub
    
    as_delivery = Format(Val(as_delivery), "0000000000")
    
    Dim lo_XMLParam     As New SvcXMLParam
    
    Dim lo_XMLItem As MSXML2.IXMLDOMNode
    
    If as_deliveryItem = "" Or Not isNumeric(as_deliveryItem) Then
        Set lo_XMLItem = mo_sapXML.selectSingleNode("/DataSet/EKBE-VTTP/row[DELIV_NUMB='" & as_delivery & "']")
    Else
        Set lo_XMLItem = mo_sapXML.selectSingleNode("/DataSet/EKBE-VTTP/row[DELIV_NUMB='" & as_delivery & "' and DELIV_ITEM='" & Format(Val(as_deliveryItem), "0000") & "' ]")
    End If
    
    If Not (lo_XMLItem Is Nothing) Then
    
        cbo_delivery.Text = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")
        
        txt_CLSShipNb.Text = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "TKNUM")
        
    Else
        
        If as_deliveryItem = "" Or Not isNumeric(as_deliveryItem) Then
            Set lo_XMLItem = mo_sapXML.selectSingleNode("/DataSet/inforow[DELIV_NUMB='" & as_delivery & "']")
        Else
            Set lo_XMLItem = mo_sapXML.selectSingleNode("/DataSet/inforow[DELIV_NUMB='" & as_delivery & "' and DELIV_ITEM='" & Format(Val(as_deliveryItem), "000000") & "' ]")
        End If
        
        
        If Not (lo_XMLItem Is Nothing) Then
            cbo_delivery.Text = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "DELIV_NUMB")
            
            txt_CLSShipNb.Text = lo_XMLParam.GetXMLNodeValue(lo_XMLItem, "VTTP/row/TKNUM")
        Else
            Call MsgBox(MsgText(5050, ms_Language_Code, "#No SAP data found!!!"), vbInformation Or vbOKOnly)
        End If
    End If

    Exit Sub
errhandler:
    mb_eventRunning = False
    Call ErrorHandler("SearchSAPData")
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 RefreshMasterTran(ByVal as_CARRIER_Code As String, ByVal ab_keepSelection As Boolean)
    On Error GoTo errhandler
    Dim ll_prevTran As Long
    
    If ab_keepSelection Then
        ll_prevTran = Val(GetCboKey(cbo_returnTransaction))
    End If
        
    Call cbo_returnTransaction.Clear
    cbo_returnTransaction.Request = "EXEC DC_MasterTrans_Interco_cbo " & SqlStr(ms_DC_Code, 4) & ", " & SqlStr(GetCboKey(cbo_ShipToDC), 4) & ", " & SqlStr(as_CARRIER_Code, 10) & ", " & SqlDate(md_shippingDay) & "," & ml_d
    
    If ab_keepSelection And ll_prevTran <> 0 Then
        
        If Not SetComboItemValue(cbo_returnTransaction, ll_prevTran) Then
            
            ' transaction is master and as 'In use' or 'Free'
            Debug.Assert (ll_prevTran = ml_d)
            
            ' add a current transaction line is 'In use' or 'Free'
            Call cbo_returnTransaction.AddItem(Array(ll_prevTran, "One way shipment", "FR", "P510", "", 0), True)
        End If

    End If

    Exit Sub
errhandler:
    Call ErrorHandler("RefreshMasterTran")
End Sub

Private Sub RefreshSurchargeInfo(ByVal ab_keepSelection As Boolean)
On Error GoTo errhandler

Const C_REQ_EDIT As String = "EXEC DC_PriceListSurcharge_lst2 $0$ ,$DC_CARRIER_Code$, 'I', $TRANS_Date$, $Ship_To_CT_Code$, $ShipToDC_code$, $LANGUAGE_CODE$"
Const C_REQ_VIEW As String = "EXEC DC_PriceListSurcharge_lst3 $0$ , $LANGUAGE_CODE$"

    Dim ls_req As String
    Dim ll_i As Long
    Dim lb_hasSelection As Boolean
    lb_hasSelection = False

    If SupportPriceList And GetCboKey(cbo_ShipToDC) <> "" Then
        Dim lla_prevDCS_Code() As String
        If ab_keepSelection Then
            If ckv_surcharges.CheckedCount > 0 Then
                ReDim lla_prevDCS_Code(ckv_surcharges.CheckedCount - 1) As String
                Dim ll_checked_ind As Long
                ll_checked_ind = LBound(lla_prevDCS_Code)
                For ll_i = 1 To ckv_surcharges.Count
                    If ckv_surcharges.ListItems(ll_i).Checked Then
                        lla_prevDCS_Code(ll_checked_ind) = ckv_surcharges.ListItems(ll_i).Tag.Id
                        ll_checked_ind = ll_checked_ind + 1
                    End If
                Next
                lb_hasSelection = True
            End If
        End If
        
        ckv_surcharges.Visible = False
        ckv_surcharges.Clear
        
        Select Case gs_Action
    
            Case "Add", "Update"
                ls_req = Replace(C_REQ_EDIT, "$LANGUAGE_CODE$", SqlStr(ms_Language_Code, 1), , , vbTextCompare)
                ls_req = Replace(ls_req, "$DC_CARRIER_Code$", SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")), , , vbTextCompare)
        
                If ml_d <> Val(GetCboKey(cbo_returnTransaction)) And Val(GetCboKey(cbo_returnTransaction)) <> 0 Then

                    ' use pricelist from ship to DC
                    ls_req = Replace(ls_req, "$Ship_To_CT_Code$", SqlStr(GetCT_Code(ms_DC_Code), 4), , , vbTextCompare)
                    ls_req = Replace(ls_req, "$ShipToDC_code$", SqlStr(ms_DC_Code, 4), , , vbTextCompare)
'        If IsReturnTransaction Then
'            ls_req = Replace(ls_req, "$Ship_To_CT_Code$", SqlStr(GetCboValue(cbo_returnTransaction, "Ship_To_CT_Code"), 4), , , vbTextCompare)
'            ls_req = Replace(ls_req, "$ShipToDC_code$", SqlStr(GetCboValue(cbo_returnTransaction, "Ship_To_ZIP_Code"), 4), , , vbTextCompare)
                
                End If
                
                ckv_surcharges.EditRequest = Item_ReplacePlaceholders(ls_req)
                ckv_surcharges.MasterID = ml_d
                ckv_surcharges.Mode = ListLoadMode.ModeEdit
            
            Case Else
                ckv_surcharges.ViewRequest = Replace(C_REQ_VIEW, "$LANGUAGE_CODE$", SqlStr(ms_Language_Code, 1), , , vbTextCompare)
                ckv_surcharges.MasterID = ml_d
                ckv_surcharges.Mode = ListLoadMode.ModeView
        End Select
        
        ckv_surcharges.LoadList
        ckv_surcharges.Visible = True
        
        If ab_keepSelection Then
            If lb_hasSelection Then
                For ll_checked_ind = LBound(lla_prevDCS_Code) To UBound(lla_prevDCS_Code)
                    For ll_i = 1 To ckv_surcharges.Count
                        If ckv_surcharges.ListItems(ll_i).Tag.Id = lla_prevDCS_Code(ll_checked_ind) Then
                            ckv_surcharges.ListItems(ll_i).Checked = True
                        End If
                    Next
                Next
            Else
                For ll_i = 1 To ckv_surcharges.Count
                    If ckv_surcharges.ListItems(ll_i).Tag.GetData(SURCHARGE_COLS.DCS_Default) = "X" Then
                        ckv_surcharges.ListItems(ll_i).Checked = True
                    End If
                Next
            End If
        End If
        
    Else
        ckv_surcharges.Clear
    End If
    Exit Sub
errhandler:
    Call ErrorHandler("RefreshSurchargeInfo")
End Sub

Private Function SaveCkvSurcharges(ml_TRANS_Code As Long) As Boolean
Const C_REQ_SURCHARGE_INS As String = "EXEC DC_Tran_Surcharge_ins $0$,$1$,1,$3$"
Const C_REQ_SURCHARGE_DEL As String = "EXEC DC_Tran_Surcharge_del2 $0$,$1$"

On Error GoTo errhHandler
    
    SaveCkvSurcharges = False
    
    ckv_surcharges.CheckRequest = C_REQ_SURCHARGE_INS
    ckv_surcharges.UnCheckRequest = C_REQ_SURCHARGE_DEL
    ckv_surcharges.MasterID = ml_TRANS_Code

    SaveCkvSurcharges = ckv_surcharges.SaveList
    Exit Function
    
errhHandler:
    Call ErrorHandler("SaveCkvSurcharges")
End Function

Private Sub RefreshCarrierInfo(ByVal ab_keepSelection As Boolean)
On Error GoTo errhandler
    Dim ls_prevCARRIER_Code As String
    
    If ab_keepSelection Then
        ls_prevCARRIER_Code = GetCboKey(cbo_carrier)
    End If

    cbo_carrier.Clear
    If ml_d = Val(GetCboKey(cbo_returnTransaction)) Or Val(GetCboKey(cbo_returnTransaction)) = 0 Then
        cbo_carrier.Request = "EXEC DC_Carrier_lst3 " & SqlStr(ms_DC_Code, 4) & ", " & SqlStr(GetCboValue(cbo_ShipToDC, "CT_Code"), 4) & ", " & SqlStr(GetCboKey(cbo_ShipToDC), 20) & ", 'I', " & SqlDate(md_shippingDay)
    Else
        ' use pricelist from ship to DC
        cbo_carrier.Request = "EXEC DC_Carrier_lst3 " & SqlStr(GetCboKey(cbo_ShipToDC), 4) & ", " & SqlStr(GetCboValue(cbo_returnTransaction, "Ship_To_CT_Code"), 4) & ", " & SqlStr(GetCboValue(cbo_returnTransaction, "Ship_To_ZIP_Code"), 20) & ", 'I', " & SqlDate(GetCboValue(cbo_returnTransaction, "Shipping_Date"))
    End If

    If ab_keepSelection Then
        
        If ls_prevCARRIER_Code <> "" Then
            Call SetComboItemValue(cbo_carrier, ls_prevCARRIER_Code)
        End If
        
        Call RefreshUOMInfo(ab_keepSelection)
    Else
        ' clear UOM
        cbo_UOM.Clear
        cbo_UOM.Request = "EXEC DC_UOM_cbo2"
    
    End If
    Exit Sub
errhandler:
    Call ErrorHandler("RefreshCarrierInfo")
End Sub

Private Sub RefreshUOMInfo(ByVal ab_keepSelection As Boolean)
On Error GoTo errhandler

    Dim ls_prevUOM_Code As String
    
    If ab_keepSelection Then
        ls_prevUOM_Code = GetCboKey(cbo_UOM)
    End If
    
    If SupportPriceList Then
        
        cbo_UOM.Clear
        cbo_UOM.Request = "EXEC DC_PriceListUOM_cbo " & SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")) & ", 'I', " & SqlDate(md_shippingDay) & "," & SqlStr(ms_Language_Code, 1)

        If ab_keepSelection Then
            
            If ls_prevUOM_Code <> "" Then
                Call SetComboItemValue(cbo_UOM, ls_prevUOM_Code)
            End If
        
        End If
    
    Else
        
        cbo_UOM.Clear
        cbo_UOM.Request = "EXEC DC_UOM_cbo2"
        
        If ab_keepSelection Then
            
            If ls_prevUOM_Code <> "" Then
                Call SetComboItemValue(cbo_UOM, ls_prevUOM_Code)
            End If
        
        End If

    End If
    Exit Sub
errhandler:
    Call ErrorHandler("RefreshUOMInfo")
End Sub


Private Sub SetTextBoxFocus(ByRef ao_tb As TextBox)
On Error GoTo errhandler
    
    ao_tb.SelStart = 0
    ao_tb.SelLength = Len(ao_tb.Text)
    Call ao_tb.SetFocus

    Exit Sub
errhandler:
    Call ErrorHandler(Me.Name & ".SetTextBoxFocus")
End Sub


Private Sub FillMasterTrans(ByVal al_TRANS_Code As Long)
On Error GoTo errhandler

Const C_REQ As String = "EXEC DC_MasterTrans_sel $TRANS_Code$"

Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(C_REQ, "$TRANS_Code$", al_TRANS_Code))

    If Not mo_Db.EOF(ll_Cursor) Then

        txt_HaulierCpy = mo_Db.GetFields(ll_Cursor, "Haulier_Company")
        txt_HaulierBookNb = mo_Db.GetFields(ll_Cursor, "Haulier_Booking_Number")
        txt_ArrivingTrailerNb = mo_Db.GetFields(ll_Cursor, "Arriving_Trailer_Number")
        txt_TrailerNb = mo_Db.GetFields(ll_Cursor, "Trailer_Number")
        txt_LoadBy = mo_Db.GetFields(ll_Cursor, "Load_By")
        
        
        Call SetComboItemValue(cbo_Equipement, mo_Db.GetFields(ll_Cursor, "EQ_code"))
        
        Call SetComboItemValue(cbo_UOM, mo_Db.GetFields(ll_Cursor, "UOM_code"))
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Dim ll_CurrentLine As Long
    
    ll_CurrentLine = GetDCTransportLine(ml_d)
    
    moa_DCTransport_cost(ll_CurrentLine).DCPL_Code = Val(GetCboValue(cbo_UOM, "DCPL_Code"))
    moa_DCTransport_cost(ll_CurrentLine).UOM_Code = GetCboKey(cbo_UOM)
    
    Exit Sub
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("FillMasterTrans")
End Sub

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

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 Me.hwnd
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        Me.Refresh
        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

Private Function IsReturnTransaction() As Boolean
On Error GoTo errhandler
    IsReturnTransaction = False
    
    If ml_d <> Val(GetCboKey(cbo_returnTransaction)) Then
        IsReturnTransaction = (Val(GetCboKey(cbo_returnTransaction)) <> 0)
        Exit Function
    End If
    
    If ml_d = 0 Then Exit Function
    
    IsReturnTransaction = (Val(GetCboValue(cbo_returnTransaction, "InUse")) > 0)

    Exit Function
errhandler:
    Call ErrorHandler("IsReturnTransaction")
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(ao_priceData.Quantity, 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(ao_priceData.Quantity, 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 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 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


