VERSION 5.00
Begin VB.Form DC_Receipts 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Receipts"
   ClientHeight    =   8085
   ClientLeft      =   -30
   ClientTop       =   705
   ClientWidth     =   9645
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   8085
   ScaleWidth      =   9645
   ShowInTaskbar   =   0   'False
   Begin VB.CheckBox chk_manualPrice 
      Alignment       =   1  'Right Justify
      Caption         =   "#Manual Supplier"
      Height          =   255
      Left            =   60
      TabIndex        =   42
      Top             =   1020
      Width           =   1830
   End
   Begin VB.ComboBox cbo_supplier 
      Height          =   315
      ItemData        =   "RECEIPTS.frx":0000
      Left            =   1680
      List            =   "RECEIPTS.frx":0002
      TabIndex        =   41
      Tag             =   "Supplier_Name"
      Text            =   "cbo_supplier"
      Top             =   585
      Width           =   2772
   End
   Begin VB.TextBox txt_TransCode 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   8430
      Locked          =   -1  'True
      TabIndex        =   38
      TabStop         =   0   'False
      Tag             =   "TRANS_Code"
      Text            =   "txt_TransCode"
      Top             =   120
      Width           =   1125
   End
   Begin VB.CommandButton btn_SAP_SearchData 
      Caption         =   ">"
      Height          =   285
      Left            =   4380
      TabIndex        =   36
      Top             =   1545
      Width           =   285
   End
   Begin VB.ComboBox cbo_delivery 
      Height          =   315
      ItemData        =   "RECEIPTS.frx":0004
      Left            =   6390
      List            =   "RECEIPTS.frx":0006
      TabIndex        =   34
      Tag             =   "Delivery_Number"
      Top             =   1035
      Width           =   3165
   End
   Begin VB.Frame Fr_Actual 
      Caption         =   "Actual"
      Height          =   2790
      Left            =   90
      TabIndex        =   22
      Top             =   4500
      Width           =   9465
      Begin VB.TextBox txt_UnLoadEndTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   27
         Tag             =   "Unload_Ending_Time"
         Top             =   2295
         Width           =   2172
      End
      Begin VB.TextBox txt_NbContainer 
         Height          =   288
         Left            =   2160
         MaxLength       =   15
         TabIndex        =   26
         Tag             =   "Container_Number"
         Top             =   1785
         Width           =   2172
      End
      Begin VB.TextBox txt_UnLoadBy 
         Height          =   288
         Left            =   1560
         MaxLength       =   30
         TabIndex        =   25
         Tag             =   "Unload_By"
         Top             =   1305
         Width           =   2772
      End
      Begin VB.TextBox txt_UnLoadStartTime 
         Height          =   288
         Left            =   2280
         MaxLength       =   5
         TabIndex        =   24
         Tag             =   "Unload_Starting_Time"
         Top             =   750
         Width           =   2052
      End
      Begin VB.TextBox txt_ArrivalTime 
         Height          =   288
         Left            =   2280
         MaxLength       =   5
         TabIndex        =   23
         Tag             =   "Unload_Arrival_Time"
         Top             =   240
         Width           =   2052
      End
      Begin Project1.DCCost DCCost1 
         Height          =   2505
         Left            =   4455
         TabIndex        =   33
         Top             =   225
         Width           =   4815
         _ExtentX        =   8493
         _ExtentY        =   4419
      End
      Begin VB.Label lbl_LoadEndTime 
         Caption         =   "Unload ending time"
         Height          =   255
         Left            =   120
         TabIndex        =   32
         Top             =   2295
         Width           =   1995
      End
      Begin VB.Label lbl_NbContainer 
         Caption         =   "Container n°"
         Height          =   255
         Left            =   120
         TabIndex        =   31
         Top             =   1785
         Width           =   1995
      End
      Begin VB.Label lbl_LoadBy 
         Caption         =   "Unload by"
         Height          =   255
         Left            =   120
         TabIndex        =   30
         Top             =   1305
         Width           =   1455
      End
      Begin VB.Label lbl_LoadStartTime 
         Caption         =   "Unload starting time"
         Height          =   255
         Left            =   120
         TabIndex        =   29
         Top             =   750
         Width           =   2175
      End
      Begin VB.Label lbl_ArrivalTime 
         Caption         =   "Arrival time"
         Height          =   255
         Left            =   120
         TabIndex        =   28
         Top             =   240
         Width           =   2055
      End
   End
   Begin VB.Frame Fr_Schedule 
      Caption         =   "Schedule"
      Height          =   855
      Left            =   120
      TabIndex        =   17
      Top             =   3525
      Width           =   9435
      Begin VB.TextBox txt_UnLoadPlanEndTime 
         Height          =   288
         Left            =   7065
         MaxLength       =   5
         TabIndex        =   19
         Tag             =   "Unload_Planned_Ending_Time"
         Top             =   360
         Width           =   2172
      End
      Begin VB.TextBox txt_UnLoadPlanStartTime 
         Height          =   288
         Left            =   2280
         MaxLength       =   5
         TabIndex        =   18
         Tag             =   "Unload_Planned_Starting_Time"
         Top             =   360
         Width           =   2052
      End
      Begin VB.Label lbl_LoadPlanEndTime 
         Caption         =   "Unload planned ending time"
         Height          =   255
         Left            =   4785
         TabIndex        =   21
         Top             =   360
         Width           =   2295
      End
      Begin VB.Label lbl_LoadPlanStartTime 
         Caption         =   "Unload planned starting time"
         Height          =   255
         Left            =   120
         TabIndex        =   20
         Top             =   360
         Width           =   2175
      End
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   8220
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   7365
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   8940
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   7365
      Width           =   612
   End
   Begin VB.TextBox txt_Quantity 
      Height          =   288
      Left            =   1710
      MaxLength       =   10
      TabIndex        =   3
      Tag             =   "Quantity"
      Top             =   2505
      Width           =   1275
   End
   Begin VB.TextBox txt_ReceivingDC 
      Height          =   288
      Left            =   1680
      Locked          =   -1  'True
      TabIndex        =   7
      Tag             =   "DC_desc"
      Top             =   120
      Width           =   2772
   End
   Begin VB.TextBox txt_RSRequire 
      Height          =   525
      Left            =   1710
      MaxLength       =   240
      MultiLine       =   -1  'True
      TabIndex        =   4
      Tag             =   "remark"
      Top             =   2895
      Width           =   7845
   End
   Begin VB.TextBox txt_CLSShipNb 
      Height          =   288
      Left            =   6390
      MaxLength       =   20
      TabIndex        =   2
      Tag             =   "Shipment_Number"
      Top             =   1500
      Width           =   3165
   End
   Begin VB.TextBox txt_CLSOrderNb 
      Height          =   288
      Left            =   1710
      MaxLength       =   20
      TabIndex        =   1
      Tag             =   "Order_Number"
      Top             =   1545
      Width           =   2550
   End
   Begin VB.TextBox txt_ReceiveDate 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   6372
      Locked          =   -1  'True
      MaxLength       =   10
      TabIndex        =   0
      Tag             =   "Receiving_Date"
      Text            =   "txt_Receiv"
      Top             =   120
      Width           =   1212
   End
   Begin Project1.ArmCombobox cbo_carrier 
      Height          =   345
      Left            =   6390
      TabIndex        =   37
      Tag             =   "CARRIER_Code"
      Top             =   570
      Width           =   3165
      _ExtentX        =   5583
      _ExtentY        =   609
   End
   Begin Project1.ArmCombobox cbo_UOM 
      Height          =   345
      Left            =   4215
      TabIndex        =   40
      Tag             =   "UOM_Code"
      Top             =   2475
      Width           =   1800
      _ExtentX        =   3175
      _ExtentY        =   609
   End
   Begin Project1.ArmCheckView0 ckv_surcharges 
      Height          =   885
      Left            =   6225
      TabIndex        =   44
      Top             =   1935
      Width           =   3330
      _ExtentX        =   5874
      _ExtentY        =   1561
   End
   Begin VB.Label lbl_surcharges 
      Caption         =   "Additional surcharge"
      Height          =   255
      Left            =   4170
      TabIndex        =   43
      Top             =   1995
      Width           =   1890
   End
   Begin VB.Label lbl_TRANS_Code 
      Alignment       =   1  'Right Justify
      Caption         =   "ID"
      Height          =   255
      Left            =   7755
      TabIndex        =   39
      Tag             =   "lbl_TRANS_Code"
      Top             =   135
      Width           =   570
   End
   Begin VB.Label lbl_CLSDeliveryNb 
      Caption         =   "CLS Delivery  n°"
      Height          =   255
      Left            =   4800
      TabIndex        =   35
      Top             =   1080
      Width           =   1560
   End
   Begin VB.Label lbl_Quantity 
      Caption         =   "Quantity"
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   2505
      Width           =   1545
   End
   Begin VB.Label lbl_UOM 
      Alignment       =   1  'Right Justify
      Caption         =   "UOM"
      Height          =   255
      Left            =   3480
      TabIndex        =   15
      Top             =   2550
      Width           =   615
   End
   Begin VB.Label lbl_RSRequire 
      Caption         =   "R/S requirements"
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   2895
      Width           =   1545
   End
   Begin VB.Label lbl_CLSShipNb 
      Caption         =   "CLS Shipment n°"
      Height          =   255
      Left            =   4800
      TabIndex        =   13
      Top             =   1545
      Width           =   1545
   End
   Begin VB.Label lbl_CLSOrderNb 
      Caption         =   "CLS Order n°"
      Height          =   255
      Left            =   150
      TabIndex        =   12
      Top             =   1545
      Width           =   1545
   End
   Begin VB.Label lbl_Supplier 
      Caption         =   "Supplier"
      Height          =   252
      Left            =   120
      TabIndex        =   11
      Top             =   600
      Width           =   1545
   End
   Begin VB.Label lbl_CarrierCpy 
      Caption         =   "Carrier company"
      Height          =   252
      Left            =   4800
      TabIndex        =   10
      Top             =   600
      Width           =   1452
   End
   Begin VB.Label lbl_ShipDate 
      Caption         =   "Receiving date"
      Height          =   252
      Left            =   4800
      TabIndex        =   9
      Top             =   120
      Width           =   1332
   End
   Begin VB.Label lbl_ReceivingDC 
      Caption         =   "Receiving DC"
      Height          =   252
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   1545
   End
End
Attribute VB_Name = "DC_Receipts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'what is new
'3.0.0 : armsyscom support into the control
'3.0.0 : Price list support

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

Private Const SCREEN_NAME As String = "DC_Receipt"
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 ms_inTranName As String

Private ms_UrlWebServicePurchase As String
Private ms_UrlWebServiceOrder As String
Private mc_Suppliers As Long

Private ms_TableName As String
Private ms_DC_Code As String
Private ms_DC_Name As String
Private ms_TT_Code As String
Private ms_Ship_To_CT_Code As String        ' intercompany usage
Private ms_Ship_To_Zip_Code As String       ' intercompany usage
Private md_receivingDay As Date
'Private msa_PLs() As String                 ' A_Config entry backup

Dim ml_d 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 ReceivingDay(ByVal ad_receivingDay As Date)
    md_receivingDay = ad_receivingDay
End Property

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

Private Property Get SupportPriceList_Interco() As Boolean
On Error GoTo errhandler
'    SupportPriceList = mb_PL_STYLE_ENABLED And Val(GetCboValue(cbo_carrier, "DCPL_Count")) > 0 And txt_ShipDate.Text <> ""
    SupportPriceList_Interco = Val(GetCboValue(cbo_carrier, "DCPL_Count")) > 0 And txt_ReceiveDate.Text <> ""
    Exit Property
errhandler:
    Call ErrorHandler("SupportPriceList_Interco()")
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 = cbo_SupplierPL_Count <> 0 And Val(GetCboValue(cbo_carrier, "DCPL_Count")) > 0 And txt_ReceiveDate.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 Function ControlOver() As Boolean

Dim ls_req As String
Dim ll_Cursor As Long

ControlOver = KO

    Dim ls_OverDCFrom As String
    ls_OverDCFrom = "N"
    
    Dim ls_Msg As String
    ls_Msg = "Receipts Calendar Max quantity exceeded !" & Chr(10) & "Confirm ?"
    
On Error GoTo suite

        
    ls_req = "EXEC DC_WFReceipt '" _
        & QuoteParam(ms_DC_Code) & "', '" _
        & QuoteParam(FormatD(txt_ReceiveDate, "mm/dd/yyyy")) & "'"
        
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    ls_OverDCFrom = mo_Db.GetFields(ll_Cursor, "OverDCFrom")
        
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ls_OverDCFrom = "Y" Then
        If MsgBox(ls_Msg, vbQuestion + vbYesNo, "Over Load") = vbNo Then
            ls_OverDCFrom = "N"
            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_ReceiveDate, "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
    
    Dim ld_totalCost As Double
    ld_totalCost = 0
    
    If al_TRANS_Code = 0 Then
        
        md_manualCost = 0
        ms_TT_Code = "R"
        ms_Ship_To_CT_Code = ""
        ms_Ship_To_Zip_Code = ""
        
        txt_TransCode.Text = "NEW"
        
        chk_manualPrice.Value = vbUnchecked
        txt_ReceivingDC = ms_DC_Name
        txt_ReceiveDate = DateToString(md_receivingDay)
        
        txt_UnLoadPlanStartTime = "0000"
        txt_UnLoadPlanEndTime = "0000"
        txt_UnLoadStartTime = "0000"
        txt_UnLoadEndTime = "0000"
        txt_ArrivalTime = "0000"
        cbo_carrier.Request = "EXEC DC_Carrier_lst2 " & SqlStr(ms_DC_Code, 4) & ", '" & ms_TT_Code & "', " & SqlDate(md_receivingDay) & ", NULL"
        
        DCCost1.TransCode = 0
        
        Call RefreshUOMInfo(False)
    Else

        ll_Cursor = OpenSQLSafe(mo_Db, "EXEC DC_Receipts_dtl " & al_TRANS_Code)
        
        ' global vars
        DC_Code = mo_Db.GetFields(ll_Cursor, "DC_Code")
        DC_name = mo_Db.GetFields(ll_Cursor, "DC_Desc")
        ReceivingDay = mo_Db.GetFields(ll_Cursor, "Receiving_Date")
        ms_TT_Code = mo_Db.GetFields(ll_Cursor, "TT_Code")
        ms_Ship_To_CT_Code = mo_Db.GetFields(ll_Cursor, "Ship_To_CT_Code")
        ms_Ship_To_Zip_Code = mo_Db.GetFields(ll_Cursor, "Ship_To_Zip_Code")
        ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
        ld_totalCost = mo_Db.GetFields(ll_Cursor, "Total_Cost")
        md_manualCost = mo_Db.GetFields(ll_Cursor, "Total_Cost_Manual")
            
        ' ui data
        txt_TransCode.Text = al_TRANS_Code
        txt_ReceivingDC = ms_DC_Name                                        'ODBCData(ll_Statement, 1)
        txt_ReceiveDate = DateToString(md_receivingDay)                     'ODBCData(ll_Statement, 2)
        
        cbo_carrier.Request = "EXEC DC_Carrier_lst2 " & SqlStr(ms_DC_Code, 4) & ", '" & ms_TT_Code & "', " & SqlDate(md_receivingDay) & ", NULL"
        
        If mo_Db.GetFields(ll_Cursor, "Supplier_Code") = "" Then
            cbo_supplier.Text = mo_Db.GetFields(ll_Cursor, "Supplier_Name")          'ODBCData(ll_Statement, 3)
        Else
            cbo_SupplierCode = mo_Db.GetFields(ll_Cursor, "Supplier_Code")
        End If
        
        Call SetComboItemValue(cbo_carrier, mo_Db.GetFields(ll_Cursor, "CARRIER_Code"))
        
        chk_manualPrice.Value = vbUnchecked
                
        Call RefreshUOMInfo(False)
        If Not SetComboItemValue(cbo_UOM, mo_Db.GetFields(ll_Cursor, "UOM_Code")) Then
            chk_manualPrice.Value = vbChecked
            Call RefreshUOMInfo(False)
            If Not SetComboItemValue(cbo_UOM, mo_Db.GetFields(ll_Cursor, "UOM_Code")) Then
                Call MsgBox(MsgText(666, ms_Language_Code, "#Difficulties to load the UOM!"), vbInformation Or vbOKOnly)
            End If
        End If
        
        txt_CLSOrderNb = mo_Db.GetFields(ll_Cursor, "Order_Number")         'ODBCData(ll_Statement, 6)
        txt_CLSShipNb = mo_Db.GetFields(ll_Cursor, "Shipment_Number")        'ODBCData(ll_Statement, 7)
        cbo_delivery.Text = mo_Db.GetFields(ll_Cursor, "Delivery_Number")
        
        txt_Quantity = mo_Db.GetFields(ll_Cursor, "Quantity")          'ODBCData(ll_Statement, 8)
        
        txt_RSRequire = mo_Db.GetFields(ll_Cursor, "remark")          'ODBCData(ll_Statement, 10)
        
        Call RefreshSurchargeInfo(False)    ' call after delivery date set
'        Call SetComboItemValue(cbo_surcharges, mo_Db.GetFields(ll_Cursor, "DCS_Code"))
        
        txt_UnLoadPlanStartTime = mo_Db.GetFields(ll_Cursor, "Unload_Planned_Starting_Time")          'ODBCData(ll_Statement, 11)
        txt_UnLoadPlanEndTime = mo_Db.GetFields(ll_Cursor, "Unload_Planned_Ending_Time")          'ODBCData(ll_Statement, 12)
        txt_ArrivalTime = mo_Db.GetFields(ll_Cursor, "Unload_Arrival_Time")          'ODBCData(ll_Statement, 13)
        txt_NbContainer = mo_Db.GetFields(ll_Cursor, "Container_Number")          'ODBCData(ll_Statement, 14)
        txt_UnLoadStartTime = mo_Db.GetFields(ll_Cursor, "Unload_Starting_Time")          'ODBCData(ll_Statement, 15)
        txt_UnLoadEndTime = mo_Db.GetFields(ll_Cursor, "Unload_Ending_Time")          'ODBCData(ll_Statement, 16)
        txt_UnLoadBy = mo_Db.GetFields(ll_Cursor, "Unload_By")          'ODBCData(ll_Statement, 17)

        Call mo_Db.Close(ll_Cursor)
        
        DCCost1.TransCode = al_TRANS_Code
    End If
    
    DCCost1.Grid_Init
    
    Call UpdatePriceListUI
        
    Call InitTransportCost
    
    If ms_TT_Code = "R" Then
        Call UpdateTotalCost
'        Call PropagateTotalQty(GetTotalQty(), GetTotalCost(False, Val(GetCboValue(cbo_UOM, "DropOff_Cost")), md_manualCost))
    Else
        Call PropagateTotalQty(GetTotalQty(), ld_totalCost)
    End If

    Exit Sub

errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    Call ErrorHandler("Item_load")
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
    
    Call LockScreen(True)
    
    mb_eventRunning = True
    
    Call RefreshUOMInfo(True)
    
    Call RefreshSurchargeInfo(True)
    
    Call UpdatePriceListUI
    
    mb_eventRunning = False
    
    Dim ll_Index As Long
    ll_Index = 0
    
    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_supplier_Validate(Cancel As Boolean)
On Error GoTo errhandler
    If mb_eventRunning Then Exit Sub
    If ms_TT_Code <> "R" Then Exit Sub
    
    If chk_manualPrice.Value = vbUnchecked Then
        If cbo_supplier.ListIndex = -1 And cbo_supplier.Text <> "" Then
            
            ' just check if supplier is in the list
            Dim ls_Text As String
            ls_Text = cbo_supplier.Text
    
            Dim ll_i As Long
            For ll_i = 0 To cbo_supplier.ListCount - 1
                If cbo_supplier.List(ll_i) = ls_Text Then
                    cbo_supplier.ListIndex = ll_i
                    Exit For
                End If
            Next
            
            If cbo_supplier.ListIndex = -1 Then
                Cancel = True
                Exit Sub
            End If
            
        End If
    End If
    
    mb_eventRunning = True
    
    Call LockScreen(True)
    
    mb_eventRunning = True
    
    Call RefreshUOMInfo(True)
    
    Call RefreshSurchargeInfo(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_supplier_Validate()")
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 = 0
    
    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 chk_manualPrice_Click()
On Error GoTo errhandler

    If chk_manualPrice.Value = vbUnchecked And cbo_supplier.ListIndex = -1 Then
        cbo_supplier.Text = ""
    End If

    cbo_Carrier_ComboItemSelected

    Exit Sub
    
errhandler:
    Call ErrorMessage("chk_manualPrice_Click")
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 Form_Activate()
On Error GoTo errhandler

    If gs_Action = "Delete" Then
        spp_save.SetFocus
    ElseIf gs_Action = "MoreInfo" Then
        ssp_quit.SetFocus
    ElseIf gs_TableName = "DC_Receipts" Then
        cbo_supplier.SetFocus
    ElseIf gs_TableName = "DC_Rec_End" Then
        txt_UnLoadPlanStartTime.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 ssp_quit_Click()
    Me.Hide
End Sub

Private Sub txt_ArrivalTime_GotFocus()
On Error GoTo errhandler
    Call LockScreen(True)

    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)

    Call LockScreen(False)
    Exit Sub
errhandler:
    Call LockScreen(False)
    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_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 = 0
    
    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
    
    Exit Sub
errhandler:
    Call ErrorMessage(Me.Name & ".txt_Quantity_Validate()")
End Sub

Private Sub txt_UnLoadEndTime_GotFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadEndTime) = 5 Then
        txt_UnLoadEndTime = Left(txt_UnLoadEndTime, 2) & right(txt_UnLoadEndTime, 2)
    End If

    txt_UnLoadEndTime.SelStart = 0
    txt_UnLoadEndTime.SelLength = Len(txt_UnLoadEndTime)

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


Private Sub txt_UnLoadEndTime_LostFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadEndTime) = 5 Then
        txt_UnLoadEndTime = Left(txt_UnLoadEndTime, 2) & right(txt_UnLoadEndTime, 2)
    End If

    If Not CheckNumericValue(txt_UnLoadEndTime) Then
        SendMessage 5130, "Only numeric field is valid !", gut_LangLogin.Code
        txt_UnLoadEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If

    If Len(txt_UnLoadEndTime) <> 4 Then
        SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
        txt_UnLoadEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_UnLoadEndTime, 2) > 23 Or right(txt_UnLoadEndTime, 2) > 59 Then
            SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
            txt_UnLoadEndTime.SetFocus
        Else
            txt_UnLoadEndTime = Left(txt_UnLoadEndTime, 2) & ":" & right(txt_UnLoadEndTime, 2)
        End If
    End If

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


Private Sub txt_UnLoadPlanEndTime_GotFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadPlanEndTime) = 5 Then
        txt_UnLoadPlanEndTime = Left(txt_UnLoadPlanEndTime, 2) & right(txt_UnLoadPlanEndTime, 2)
    End If

    txt_UnLoadPlanEndTime.SelStart = 0
    txt_UnLoadPlanEndTime.SelLength = Len(txt_UnLoadPlanEndTime)

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


Private Sub txt_UnLoadPlanEndTime_LostFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadPlanEndTime) = 5 Then
        txt_UnLoadPlanEndTime = Left(txt_UnLoadPlanEndTime, 2) & right(txt_UnLoadPlanEndTime, 2)
    End If

    If Not CheckNumericValue(txt_UnLoadPlanEndTime) Then
        SendMessage 5130, "Only numeric field is valid !", gut_LangLogin.Code
        txt_UnLoadPlanEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If

    If Len(txt_UnLoadPlanEndTime) <> 4 Then
        SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
        txt_UnLoadPlanEndTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_UnLoadPlanEndTime, 2) > 23 Or right(txt_UnLoadPlanEndTime, 2) > 59 Then
            SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
            txt_UnLoadPlanEndTime.SetFocus
        Else
            txt_UnLoadPlanEndTime = Left(txt_UnLoadPlanEndTime, 2) & ":" & right(txt_UnLoadPlanEndTime, 2)
        End If
    End If

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


Private Sub txt_UnLoadPlanStartTime_GotFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadPlanStartTime) = 5 Then
        txt_UnLoadPlanStartTime = Left(txt_UnLoadPlanStartTime, 2) & right(txt_UnLoadPlanStartTime, 2)
    End If

    txt_UnLoadPlanStartTime.SelStart = 0
    txt_UnLoadPlanStartTime.SelLength = Len(txt_UnLoadPlanStartTime)

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


Private Sub txt_UnLoadPlanStartTime_LostFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadPlanStartTime) = 5 Then
        txt_UnLoadPlanStartTime = Left(txt_UnLoadPlanStartTime, 2) & right(txt_UnLoadPlanStartTime, 2)
    End If

    If Not CheckNumericValue(txt_UnLoadPlanStartTime) Then
        SendMessage 5130, "Only numeric field is valid !", gut_LangLogin.Code
        txt_UnLoadPlanStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If

    If Len(txt_UnLoadPlanStartTime) <> 4 Then
        SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
        txt_UnLoadPlanStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
        If Left(txt_UnLoadPlanStartTime, 2) > 23 Or right(txt_UnLoadPlanStartTime, 2) > 59 Then
            SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
            txt_UnLoadPlanStartTime.SetFocus
        Else
            txt_UnLoadPlanStartTime = Left(txt_UnLoadPlanStartTime, 2) & ":" & right(txt_UnLoadPlanStartTime, 2)
        End If
    End If

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


Private Sub txt_UnLoadStartTime_GotFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadStartTime) = 5 Then
        txt_UnLoadStartTime = Left(txt_UnLoadStartTime, 2) & right(txt_UnLoadStartTime, 2)
    End If

    txt_UnLoadStartTime.SelStart = 0
    txt_UnLoadStartTime.SelLength = Len(txt_UnLoadStartTime)

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


Private Sub txt_UnLoadStartTime_LostFocus()
On Error GoTo errhandler
    Call LockScreen(True)
    
    If Len(txt_UnLoadStartTime) = 5 Then
        txt_UnLoadStartTime = Left(txt_UnLoadStartTime, 2) & right(txt_UnLoadStartTime, 2)
    End If

    If Not CheckNumericValue(txt_UnLoadStartTime) Then
        SendMessage 5130, "Only numeric field is valid !", gut_LangLogin.Code
        txt_UnLoadStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    End If

    If Len(txt_UnLoadStartTime) <> 4 Then
        SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
        txt_UnLoadStartTime.SetFocus
        Call LockScreen(False)
        Exit Sub
    Else
         If Left(txt_UnLoadStartTime, 2) > 23 Or right(txt_UnLoadStartTime, 2) > 59 Then
            SendMessage 5140, "Wrong time format !", gut_LangLogin.Code
            txt_UnLoadStartTime.SetFocus
        Else
            txt_UnLoadStartTime = Left(txt_UnLoadStartTime, 2) & ":" & right(txt_UnLoadStartTime, 2)
        End If
    End If

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



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

    If cbo_supplier = "" Then
        cbo_supplier.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        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 txt_CLSOrderNb = "" Then
        txt_CLSOrderNb.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If txt_Quantity = "" Then
        txt_Quantity.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If Not CheckNumericValue(txt_Quantity) Then
        SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
        txt_Quantity.SetFocus
        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
    
    Control = OK
    Exit Function
errhandler:
    Call ErrorHandler("Control")
End Function

Private Sub Receipts_Constants()
On Error GoTo errhandler

Dim ll_Cursor As Long
Dim ls_Text As String
    
    ll_Cursor = OpenSQLSafe(mo_Db, "EXEC Screen_Csts 'mtnc_DC_Receipts' , " & SqlStr(ms_Language_Code, 1))

    Do While Not mo_Db.EOF(ll_Cursor)

        ls_Text = mo_Db.GetFields(ll_Cursor, "local_text")
        Select Case mo_Db.GetFields(ll_Cursor, "field_name")
            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_ReceivingDC": lbl_ReceivingDC = ls_Text
            Case "lbl_ShipDate": lbl_ShipDate = ls_Text
            Case "lbl_Supplier": lbl_Supplier = ls_Text
            Case "lbl_CarrierCpy": lbl_CarrierCpy = ls_Text
            Case "lbl_CLSOrderNb": lbl_CLSOrderNb = ls_Text
            Case "lbl_CLSShipNb": lbl_CLSShipNb = 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_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_NbContainer": lbl_NbContainer = 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_CLSDeliveryNb": lbl_CLSDeliveryNb = ls_Text
            Case "chk_manualPrice": chk_manualPrice.Caption = ls_Text
        End Select
        Call mo_Db.Next(ll_Cursor)
    Loop
    
    Call mo_Db.Close(ll_Cursor)

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

Private Function Add_Table()
Const C_REQ As String = "EXEC DC_Receipts_ins $TRANS_code$,$DC_CARRIER_Code$,$TRANS_Date$,$Supplier_Code$,$Supplier_Name$,$Order_Number$,$Shipment_Number$,$Delivery_Number$,$Quantity$,$UOM_code$,$Remark$,$Unload_Planned_Starting_Time$,$Unload_Planned_Ending_Time$,$Unload_Arrival_Time$,$Container_Number$,$Unload_Starting_Time$,$Unload_Ending_Time$,$Unload_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)
            
            ls_req = Replace(C_REQ, "$TRANS_code$", ml_d, , , 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 CommitTran("DC_TRANSACTION")
            lb_InTran = False
                                
            RaiseEvent RowAdded(Array(ml_d, 1, txt_ReceiveDate.Text, cbo_supplier.Text, txt_CLSOrderNb, GetCboKey(cbo_carrier), GetCboValue(cbo_carrier, "CARRIER_Name"), txt_CLSShipNb, ms_TT_Code, txt_RSRequire.Text, 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()

Const C_REQ As String = "EXEC DC_Receipts_del $TRANS_code$,$iConc$"

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)
        
        ls_req = Replace(C_REQ, "$TRANS_code$", SQLNum(ml_d), , , vbTextCompare)
        ls_req = Replace(ls_req, "$iConc$", SQLNum(ml_iConcurrency), , , vbTextCompare)
    
        Call BeginTran("DC_TRANSACTION")
        lb_InTran = True
        
        DCCost1.GridDelete
        
        Call ExecuteSQLSafe(mo_Db, ls_req, 1)
        
        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 Function Upd_Table()
Const C_REQ As String = "EXEC DC_Receipts_upd $TRANS_code$,$iConc$,$DC_CARRIER_Code$,$TRANS_Date$,$Supplier_Code$,$Supplier_Name$,$Order_Number$,$Shipment_Number$,$Delivery_Number$,$Quantity$,$UOM_code$,$Remark$,$Unload_Planned_Starting_Time$,$Unload_Planned_Ending_Time$,$Unload_Arrival_Time$,$Container_Number$,$Unload_Starting_Time$,$Unload_Ending_Time$,$Unload_By$"
Const C_REQ_END As String = "EXEC DC_Rec_End_upd $TRANS_code$,$iConc$,$Unload_Planned_Starting_Time$,$Unload_Planned_Ending_Time$,$Unload_Arrival_Time$,$Container_Number$,$Unload_Starting_Time$,$Unload_Ending_Time$,$Unload_By$"

On Error GoTo errhandler

    Dim ls_req As String
    Dim lb_InTran As Boolean
    
    lb_InTran = False
    Upd_Table = KO

    If Control Then
    
        If gs_TableName = "DC_Receipts" And ms_TT_Code = "R" Then
            ls_req = C_REQ
        Else
            Debug.Assert (gs_TableName = "DC_Rec_End" Or ms_TT_Code <> "R")
            ls_req = C_REQ_END
        End If
    
        ls_req = Replace(ls_req, "$TRANS_code$", SQLNum(ml_d), , , vbTextCompare)
        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)
        ml_iConcurrency = ml_iConcurrency + 1

        ' manage surcharge link
        Call SaveCkvSurcharges(ml_d)
        
        DCCost1.GridSave
        
        Call CommitTran("DC_TRANSACTION")
        lb_InTran = False
    
        RaiseEvent RowUpdated(Array(ml_d, ml_iConcurrency, txt_ReceiveDate.Text, cbo_supplier.Text, txt_CLSOrderNb, GetCboKey(cbo_carrier), GetCboValue(cbo_carrier, "CARRIER_Name"), txt_CLSShipNb, ms_TT_Code, txt_RSRequire.Text, 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 Sub UpdateUI(ByVal as_Mode As String)
On Error GoTo errhandler
    txt_NbContainer.Visible = OK
    lbl_NbContainer.Visible = OK
    
    Select Case as_Mode
        
        Case "Add"
            Call SetEnabled(GetContainedControlsChain(Me), True)
            Call EnableControl(txt_ReceivingDC, False)
            
'            SSShipDate.Visible = False
            spp_save.Visible = True
        Case "Update"
            If ms_TableName = "DC_Rec_End" Then
                Call SetEnabled(GetContainedControlsChain(Me), False)
                Call SetEnabled(GetContainedControlsChain(Fr_Schedule), True)
                Call SetEnabled(GetContainedControlsChain(Fr_Actual), True)
                
            ElseIf ms_TT_Code <> "R" Then
                Call SetEnabled(GetContainedControlsChain(Me), False)
                Call SetEnabled(GetContainedControlsChain(Fr_Schedule), True)
                Call SetEnabled(GetContainedControlsChain(Fr_Actual), True)
                If ms_TT_Code = "I" Or ms_TT_Code = "C" Then
                    txt_NbContainer.Visible = KO
                    lbl_NbContainer.Visible = KO
                End If
            Else
                Call SetEnabled(GetContainedControlsChain(Me), True)
                Call EnableControl(txt_ReceivingDC, False)
            End If
            
            Call EnableControl(spp_save, True)
            Call EnableControl(ssp_quit, True)
'            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_TransCode.Locked = True
    txt_ReceiveDate.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"
                lo_Control.Text = ""
            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
    
    Call cbo_delivery.Clear
'    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, 1)
    ssp_quit.Picture = LoadResPicture(RES_QUIT, 1)

    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 Receipts_Constants
    
    cbo_carrier.FirstBlankItem = False
    
    cbo_UOM.FirstBlankItem = False

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

Public Sub InitControl()
On Error GoTo errhandler
    mb_eventRunning = True
    
    ms_UrlWebServicePurchase = Get_A_Config("DC_WEBSERVICE_PURCHASE_DATA")
    ms_UrlWebServiceOrder = Get_A_Config("DC_WEBSERVICE_ORDER_DATA")

    Call Item_Clear
    
    Call FillSuppliers(ms_DC_Code, md_receivingDay)
    
    cbo_UOM.Request = "EXEC DC_UOM_cbo2"
    
    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
    End If
    
    If gs_Action = "Add" Then
        Call Item_Load(0)
    Else
        Call Item_Load(ml_d)
    End If
    
    Call UpdateUI(gs_Action)
    
    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
    
    If mc_Suppliers > 0 Then
        Call mo_Db.Close(mc_Suppliers)
        mc_Suppliers = 0
    End If
    
    Set mo_Sys = Nothing
    
    Set mo_scriptObj = Nothing
    
    Exit Sub
    
errhandler:
    If mc_Suppliers > 0 Then
        Call mo_Db.Close(mc_Suppliers)
        mc_Suppliers = 0
    End If
    
    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


' fill cbo_suppliers with the suppliers + additional info about pricelist
Private Function FillSuppliers(ByVal as_DC_Code As String, ByVal ad_receivingDay As Date)
On Error GoTo ErrorHandler
    Const C_REQ As String = "EXEC DC_Supplier_lst $DC_Code$, 'R', $ReferenceDate$, $Language_Code$"

    Dim ls_req As String
    
    ls_req = Replace(C_REQ, "$DC_Code$", SqlStr(as_DC_Code, 4), , , vbTextCompare)
    ls_req = Replace(ls_req, "$ReferenceDate$", SqlDate(ad_receivingDay), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Language_Code$", SqlStr(ms_Language_Code, 1), , , vbTextCompare)
    
    If mc_Suppliers > 0 Then
        Call mo_Db.Close(mc_Suppliers)
        mc_Suppliers = 0
    End If
    mc_Suppliers = OpenSQLSafe(mo_Db, ls_req)
    
    Call cbo_supplier.Clear
    
    While Not mo_Db.EOF(mc_Suppliers)
        With cbo_supplier
            .AddItem (mo_Db.GetFields(mc_Suppliers, "SP_desc"))
            .ItemData(.NewIndex) = mo_Db.Position(mc_Suppliers)
        End With
    
        Call mo_Db.Next(mc_Suppliers)
    Wend
    
    Exit Function
ErrorHandler:
    If mc_Suppliers > 0 Then
        Call mo_Db.Close(mc_Suppliers)
        mc_Suppliers = 0
    End If
    Call ErrorHandler(Me.Name & ".FillSuppliers")
End Function

Private Property Get cbo_SupplierCode() As String
On Error GoTo ErrorHandler

    cbo_SupplierCode = ""

    If cbo_supplier.ListIndex = -1 Then Exit Property
    
    cbo_SupplierCode = mo_Db.GetFieldsAt(mc_Suppliers, cbo_supplier.ItemData(cbo_supplier.ListIndex), "SP_code")

    Exit Property
ErrorHandler:
    Call ErrorHandler(Me.Name & ".cbo_SupplierCode (Get)")
End Property

Private Property Get cbo_SupplierPL_Count() As Long
On Error GoTo ErrorHandler

    cbo_SupplierPL_Count = 0

    If cbo_supplier.ListIndex = -1 Then Exit Property
    
    cbo_SupplierPL_Count = mo_Db.GetFieldsAt(mc_Suppliers, cbo_supplier.ItemData(cbo_supplier.ListIndex), "DCPL_Count")

    Exit Property
ErrorHandler:
    Call ErrorHandler(Me.Name & ".cbo_SupplierPL_Count (Get)")
End Property

Private Property Let cbo_SupplierCode(ByVal as_SP_Code As String)
On Error GoTo ErrorHandler

    If mc_Suppliers = 0 Then Exit Property
    
    Dim ll_Pos As Long
    ll_Pos = mo_Db.Find(mc_Suppliers, "SP_code", as_SP_Code)
    
    If ll_Pos < 0 Then Exit Property
    
    Dim ll_ind As Long
    For ll_ind = 0 To cbo_supplier.ListCount
        If cbo_supplier.ItemData(ll_ind) = ll_Pos Then
            cbo_supplier.ListIndex = ll_ind
            Exit For
        End If
    Next
    
    Exit Property
ErrorHandler:
    Call ErrorHandler(Me.Name & ".cbo_SupplierCode (Let)")
End Property

Private Property Get cbo_SupplierCT_Code() As String
On Error GoTo ErrorHandler

    cbo_SupplierCT_Code = ""
    
    If cbo_supplier.ListIndex = -1 Then Exit Property
    
    cbo_SupplierCT_Code = mo_Db.GetFieldsAt(mc_Suppliers, cbo_supplier.ItemData(cbo_supplier.ListIndex), "CT_Code")

    Exit Property
ErrorHandler:
    Call ErrorHandler(Me.Name & ".cbo_SupplierCT_Code (Get)")
End Property

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

    ls_retVal = Replace(ls_retVal, "$DC_CARRIER_Code$", SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")), , , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$TRANS_Date$", SqlDate(StringToDate(txt_ReceiveDate.Text)), , , vbTextCompare)

    ls_retVal = Replace(ls_retVal, "$Supplier_Code$", SqlStr(cbo_SupplierCode, 12, True), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Supplier_Name$", SqlStr(cbo_supplier.Text, 80), , 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, "$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, "$Unload_Planned_Starting_Time$", SqlStr(DateFormat(txt_UnLoadPlanStartTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Unload_Planned_Ending_Time$", SqlStr(DateFormat(txt_UnLoadPlanEndTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Unload_Arrival_Time$", SqlStr(DateFormat(txt_ArrivalTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Container_Number$", SqlStr(txt_NbContainer, 15), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Unload_Starting_Time$", SqlStr(DateFormat(txt_UnLoadStartTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Unload_Ending_Time$", SqlStr(DateFormat(txt_UnLoadEndTime.Text), 4), , vbTextCompare)
    ls_retVal = Replace(ls_retVal, "$Unload_By$", SqlStr(txt_UnLoadBy.Text, 15), , vbTextCompare)

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

Private Function GetCboKey(ByRef ao_cbo As ArmCombobox) As String
On Error GoTo ErrorHandler
    GetCboKey = ""
    If Not ao_cbo.SelectedItem Is Nothing Then
        GetCboKey = ao_cbo.SelectedItem.Key
    End If
    Exit Function
ErrorHandler:
     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", "COMBOBOX"
            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", "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 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 RefreshSurchargeInfo(ByVal ab_keepSelection As Boolean)
On Error GoTo errhandler

Const C_REQ_EDIT As String = "EXEC DC_PriceListSurcharge_lst2 $0$ ,$DC_CARRIER_Code$, $TT_Code$, $TRANS_Date$, $Ship_To_CT_Code$, $Supplier_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 lla_prevDCS_Code() As String
    Dim lb_hasSelection As Boolean
    lb_hasSelection = False
    
    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
            
    ' if we are viuevin intercompany shipment transaction
    If ms_TT_Code = "I" Then
        If SupportPriceList_Interco Then
        
            ' For Interco transactions we can view only!!
    
            ckv_surcharges.Visible = False
            ckv_surcharges.Clear
        
            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

            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
                End If
            End If
        Else
            ckv_surcharges.Clear
        End If
        Exit Sub
    End If

    If SupportPriceList And cbo_SupplierCode <> "" Then
        ' we can fill list the post codes based on DC/Carrier/Shipping date/CT_Code
        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, "$TT_Code$", SqlStr(ms_TT_Code, 1), , , vbTextCompare)
                ls_req = Replace(ls_req, "$DC_CARRIER_Code$", SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")), , , vbTextCompare)
                ls_req = Replace(ls_req, "$Ship_To_CT_Code$", SqlStr(cbo_SupplierCT_Code, 4), , , vbTextCompare)
    
                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 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
        
        If chk_manualPrice.Value = vbChecked Then
            cbo_UOM.Request = "EXEC DC_PriceListUOM_cbo_all " & SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")) & ", '" & ms_TT_Code & "', " & SqlDate(md_receivingDay) & "," & SqlStr(ms_Language_Code, 1)
        Else
            cbo_UOM.Request = "EXEC DC_PriceListUOM_cbo " & SQLNum(GetCboValue(cbo_carrier, "DC_CARRIER_Code")) & ", '" & ms_TT_Code & "', " & SqlDate(md_receivingDay) & "," & SqlStr(ms_Language_Code, 1)
        End If

        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 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 ml_d <> 0 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, "$MASTER_TRANS_code$", SQLNum(ml_d), , , vbTextCompare)
        ls_req = Replace(ls_req, "$IsReturn$", SqlStr("", 1, True), , vbTextCompare)
        
        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 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 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


' 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 = 0
    
    If Not SupportPriceList _
        Or GetCboKey(cbo_UOM) = "" _
        Or (txt_Quantity.Text = "" Or Not CheckNumericValue(txt_Quantity.Text)) _
        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$, $Supplier_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 = 0
    
    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)
        
        ls_req = Replace(ls_req, "$Ship_To_CT_Code$", SqlStr(cbo_SupplierCT_Code, 4), , , vbTextCompare)
        ls_req = Replace(ls_req, "$IsReturn$", SqlStr("X", 1), , vbTextCompare)
        
        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"
            
'            If chk_manualPrice.Value = vbUnchecked Then
'                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
            
        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 = 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
        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
    
'    Call PropagateTotalQty(ld_Qty, GetTotalCost(lb_isFullTruck, Val(GetCboValue(cbo_UOM, "DropOff_Cost")), md_manualCost))

    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 = 0
    
    Dim ll_nbOfTrans As Long
    ll_nbOfTrans = 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 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 = 0

    Dim ll_i As Long
    
    For ll_i = LBound(moa_DCTransport_cost) To UBound(moa_DCTransport_cost)
     
        If ls_UOM_Code <> moa_DCTransport_cost(ll_i).UOM_Code Then
            ab_mixedUOM = True
        End If
    
    Next
    
    Dim ld_QtyTotal As Double
    ld_QtyTotal = GetTotalQty()
    
    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 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 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, ".") & vbCrLf & ao_priceData.FullTruckPriceFormula)
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


