VERSION 5.00
Begin VB.Form DC_Containers 
   BorderStyle     =   1  'Fixed Single
   Caption         =   " Containers"
   ClientHeight    =   7875
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   9630
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   7875
   ScaleWidth      =   9630
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Fr_Schedule 
      Caption         =   "Schedule"
      Height          =   1092
      Left            =   120
      TabIndex        =   37
      Top             =   3360
      Width           =   9252
      Begin VB.TextBox txt_LoadPlanStartTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   40
         Top             =   720
         Width           =   2172
      End
      Begin VB.TextBox txt_LoadPlanEndTime 
         Height          =   288
         Left            =   6840
         MaxLength       =   5
         TabIndex        =   39
         Top             =   720
         Width           =   2292
      End
      Begin VB.TextBox txt_SchContainerNb 
         Height          =   288
         Left            =   2160
         MaxLength       =   15
         TabIndex        =   38
         Top             =   240
         Width           =   2172
      End
      Begin VB.Label lbl_SchContainerNb 
         Caption         =   "Container n°"
         Height          =   255
         Left            =   120
         TabIndex        =   43
         Top             =   240
         Width           =   1215
      End
      Begin VB.Label lbl_LoadPlanStartTime 
         Caption         =   "Load planned starting time"
         Height          =   255
         Left            =   120
         TabIndex        =   42
         Top             =   720
         Width           =   1935
      End
      Begin VB.Label lbl_LoadPlanEndTime 
         Caption         =   "Load planned ending time"
         Height          =   255
         Left            =   4680
         TabIndex        =   41
         Top             =   720
         Width           =   2175
      End
   End
   Begin VB.Frame Fr_Actual 
      Caption         =   "Actual"
      Height          =   2655
      Left            =   120
      TabIndex        =   44
      Top             =   4440
      Width           =   9375
      Begin VB.TextBox txt_ArrivalTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   51
         Top             =   240
         Width           =   2172
      End
      Begin VB.TextBox txt_LoadStartTime 
         Height          =   288
         Left            =   2160
         MaxLength       =   5
         TabIndex        =   50
         Top             =   720
         Width           =   2172
      End
      Begin VB.TextBox txt_LoadBy 
         Height          =   288
         Left            =   1560
         MaxLength       =   30
         TabIndex        =   49
         Top             =   1080
         Width           =   2772
      End
      Begin VB.TextBox txt_ActContainerNb 
         Height          =   288
         Left            =   2040
         MaxLength       =   15
         TabIndex        =   48
         Top             =   1560
         Width           =   2292
      End
      Begin VB.TextBox txt_LoadEndTime 
         Height          =   288
         Left            =   2040
         MaxLength       =   5
         TabIndex        =   47
         Top             =   1920
         Width           =   2292
      End
      Begin VB.TextBox txt_SealNb 
         Height          =   288
         Left            =   2040
         MaxLength       =   15
         TabIndex        =   46
         Top             =   2280
         Width           =   2292
      End
      Begin Project1.DCCost DCCost1 
         Height          =   2055
         Left            =   4440
         TabIndex        =   45
         Top             =   360
         Width           =   4815
         _ExtentX        =   8493
         _ExtentY        =   3625
      End
      Begin VB.Label lbl_ActContainerNb 
         Caption         =   "Container n°"
         Height          =   255
         Left            =   120
         TabIndex        =   57
         Top             =   1560
         Width           =   2175
      End
      Begin VB.Label lbl_ArrivalTime 
         Caption         =   "Arrival time"
         Height          =   255
         Left            =   120
         TabIndex        =   56
         Top             =   240
         Width           =   1935
      End
      Begin VB.Label lbl_LoadStartTime 
         Caption         =   "Load starting time"
         Height          =   255
         Left            =   120
         TabIndex        =   55
         Top             =   720
         Width           =   1935
      End
      Begin VB.Label lbl_LoadBy 
         Caption         =   "Load by"
         Height          =   255
         Left            =   120
         TabIndex        =   54
         Top             =   1080
         Width           =   1335
      End
      Begin VB.Label lbl_LoadEndTime 
         Caption         =   "Load ending time"
         Height          =   255
         Left            =   120
         TabIndex        =   53
         Top             =   1920
         Width           =   2175
      End
      Begin VB.Label lbl_SealNb 
         Caption         =   "Seal n°"
         Height          =   255
         Left            =   120
         TabIndex        =   52
         Top             =   2280
         Width           =   2175
      End
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   615
      Left            =   8040
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   7200
      Width           =   615
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   615
      Left            =   8760
      Style           =   1  'Graphical
      TabIndex        =   16
      Top             =   7200
      Width           =   615
   End
   Begin VB.CommandButton SSDeliveryDate 
      Height          =   276
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   25
      Top             =   2520
      Width           =   252
   End
   Begin VB.CommandButton SSShipDate 
      Height          =   276
      Left            =   7920
      Style           =   1  'Graphical
      TabIndex        =   36
      Top             =   120
      Width           =   252
   End
   Begin VB.TextBox txt_CustName 
      Height          =   288
      Left            =   1560
      MaxLength       =   80
      TabIndex        =   3
      Top             =   1080
      Width           =   2772
   End
   Begin VB.ComboBox cbo_Interco_code 
      Height          =   288
      Left            =   5400
      TabIndex        =   35
      Top             =   2040
      Visible         =   0   'False
      Width           =   312
   End
   Begin VB.ComboBox cbo_ContainerCpy_code 
      Height          =   288
      Left            =   3720
      TabIndex        =   34
      Top             =   600
      Visible         =   0   'False
      Width           =   312
   End
   Begin VB.OptionButton Opt_No 
      Caption         =   "No"
      Height          =   192
      Left            =   2400
      TabIndex        =   8
      Top             =   2040
      Value           =   -1  'True
      Width           =   612
   End
   Begin VB.ComboBox cbo_UOM 
      Height          =   288
      Left            =   7560
      Style           =   2  'Dropdown List
      TabIndex        =   13
      Top             =   2520
      Width           =   1812
   End
   Begin VB.ComboBox cbo_ContainerCpy 
      Height          =   288
      Left            =   1560
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   600
      Width           =   2772
   End
   Begin VB.OptionButton Opt_Yes 
      Caption         =   "Yes"
      Height          =   192
      Left            =   1560
      TabIndex        =   7
      Top             =   2040
      Width           =   612
   End
   Begin VB.TextBox txt_DCFromName 
      Height          =   288
      Left            =   1560
      Locked          =   -1  'True
      MaxLength       =   30
      TabIndex        =   31
      Top             =   120
      Width           =   2772
   End
   Begin VB.ComboBox Cbo_Equipement 
      Height          =   288
      Left            =   6600
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   600
      Width           =   2772
   End
   Begin VB.ComboBox cbo_Interco 
      Height          =   288
      Left            =   3840
      Style           =   2  'Dropdown List
      TabIndex        =   9
      Top             =   2040
      Visible         =   0   'False
      Width           =   2172
   End
   Begin VB.TextBox txt_ShipAdd 
      Height          =   288
      Left            =   6600
      MaxLength       =   80
      TabIndex        =   4
      Top             =   1080
      Width           =   2772
   End
   Begin VB.TextBox txt_COSContact 
      Height          =   288
      Left            =   7560
      TabIndex        =   10
      Top             =   2040
      Width           =   1812
   End
   Begin VB.TextBox txt_Weight 
      Height          =   288
      Left            =   4800
      MaxLength       =   6
      TabIndex        =   12
      Top             =   2520
      Width           =   1212
   End
   Begin VB.TextBox txt_ShipDate 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   6600
      Locked          =   -1  'True
      TabIndex        =   0
      Text            =   "txt_ShipDate"
      Top             =   120
      Width           =   1212
   End
   Begin VB.TextBox txt_RSRequire 
      Height          =   288
      Left            =   1560
      MaxLength       =   240
      TabIndex        =   14
      Top             =   3000
      Width           =   7812
   End
   Begin VB.TextBox txt_DeliveryDate 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   11
      Text            =   "txt_DeliveryDate"
      Top             =   2520
      Width           =   1212
   End
   Begin VB.TextBox txt_CLSShipNb 
      Height          =   288
      Left            =   6600
      TabIndex        =   6
      Top             =   1560
      Width           =   2772
   End
   Begin VB.TextBox txt_CLSOrder 
      Height          =   288
      Left            =   1560
      TabIndex        =   5
      Top             =   1560
      Width           =   2772
   End
   Begin VB.Label lbl_UOM 
      Caption         =   "UOM"
      Height          =   252
      Left            =   6360
      TabIndex        =   33
      Top             =   2520
      Width           =   1212
   End
   Begin VB.Label lbl_Interco 
      Caption         =   "Intercompany"
      Height          =   252
      Left            =   120
      TabIndex        =   32
      Top             =   2040
      Width           =   1452
   End
   Begin VB.Label lbl_ShipInterco 
      Caption         =   "Ship to"
      Height          =   252
      Left            =   3120
      TabIndex        =   30
      Top             =   2040
      Visible         =   0   'False
      Width           =   732
   End
   Begin VB.Label lbl_ShipAdd 
      Caption         =   "Ship to address"
      Height          =   252
      Left            =   4680
      TabIndex        =   29
      Top             =   1080
      Width           =   1932
   End
   Begin VB.Label lbl_COSContact 
      Caption         =   "COS Contact"
      Height          =   252
      Left            =   6360
      TabIndex        =   28
      Top             =   2040
      Width           =   1212
   End
   Begin VB.Label lbl_Weight 
      Caption         =   "Weight"
      Height          =   252
      Left            =   3840
      TabIndex        =   27
      Top             =   2520
      Width           =   972
   End
   Begin VB.Label lbl_CustName 
      Caption         =   "Customer name"
      Height          =   252
      Left            =   120
      TabIndex        =   26
      Top             =   1080
      Width           =   1452
   End
   Begin VB.Label lbl_RSRequire 
      Caption         =   "R/S requirements"
      Height          =   252
      Left            =   120
      TabIndex        =   24
      Top             =   3000
      Width           =   1332
   End
   Begin VB.Label lbl_DeliveryDate 
      Caption         =   "Delivery date"
      Height          =   252
      Left            =   120
      TabIndex        =   23
      Top             =   2520
      Width           =   1452
   End
   Begin VB.Label lbl_CLSShipNb 
      Caption         =   "CLS Shipment n°"
      Height          =   252
      Left            =   4680
      TabIndex        =   22
      Top             =   1560
      Width           =   1932
   End
   Begin VB.Label lbl_CLSOrderNb 
      Caption         =   "CLS Order n°"
      Height          =   252
      Left            =   120
      TabIndex        =   21
      Top             =   1560
      Width           =   1452
   End
   Begin VB.Label lbl_Equipement 
      Caption         =   "Equipement"
      Height          =   252
      Left            =   4680
      TabIndex        =   20
      Top             =   600
      Width           =   1932
   End
   Begin VB.Label lbl_ContainerCpy 
      Caption         =   "Container company"
      Height          =   252
      Left            =   120
      TabIndex        =   19
      Top             =   600
      Width           =   1452
   End
   Begin VB.Label lbl_ShipDate 
      Caption         =   "Shipping date"
      Height          =   252
      Left            =   4680
      TabIndex        =   18
      Top             =   120
      Width           =   1932
   End
   Begin VB.Label lbl_ShipFromDC 
      Caption         =   "Ship from DC"
      Height          =   252
      Left            =   120
      TabIndex        =   17
      Top             =   120
      Width           =   1452
   End
End
Attribute VB_Name = "DC_Containers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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

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

Dim ms_MsgInfo As Variant


Dim mb_CustLoad As Boolean
Dim mb_ContLoad As Boolean
Dim mb_EqLoad As Boolean
Dim mb_UOMLoad As Boolean
Dim mb_IntLoad As Boolean
Dim ms_OverDCFrom As String
Dim ms_OverDCTo As String
Dim mb_OverLoadChange As Boolean



#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

Dim ml_d As Long

Private ml_U_Code As Long
Private ms_loginName As String
Private mb_Initialized As Boolean
Private ms_reconnectServer As String
Private ms_reconnectDB As String
Private ms_reconnectUser As String
Private ms_reconnectPassword As String
Private ms_reconnectApp As String
Private ms_Language_Code As String
Private mb_eventRunning As Boolean
Private mb_PL_STYLE_ENABLED As Boolean
Private ms_inTranName As String

Private ms_UrlWebService As String

Private ms_TableName As String
Private ms_DC_Code As String
Private ms_DC_Name As String
Private md_shippingDay As Date

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

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

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

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

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

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

Public Property Let LoginName(ByVal as_loginName As String)
On Error GoTo errhandler
    
    ms_loginName = as_loginName
    Exit Property
errhandler:
    Call ErrorMessage(Me.Name & ".LoginName(Let)")
End Property

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

Public Property Let DC_Code(ByVal as_DC_Code As String)
    ms_DC_Code = as_DC_Code
End Property

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

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

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

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


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

On Error GoTo suite

ls_req = "EXEC DC_AddDay_sel 'Container', '" _
        & DC_Choice.cbo_ShipDC_code.List(DC_Choice.cbo_ShipDC.ListIndex) & "', ''"
        
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        li_Day = ODBCData(ll_Statement, 1)
    End If
End If
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)

ld_AddDate = StringToDate(right(txt_ShipDate, 10))
txt_DeliveryDate = DateToString(DateAdd("d", li_Day, ld_AddDate))
Exit Sub

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



Private Function ControlOver()
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim Msg1 As String
Dim Msg2 As String

ControlOver = KO
ms_OverDCFrom = "N"
ms_OverDCTo = "N"
Msg1 = "Container Calendar Max quantity exceeded !" & Chr(10) & "Confirm ?"
Msg2 = "Receipts Calendar Max quantity exceeded !" & Chr(10) & "Confirm ?"

On Error GoTo suite

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

ls_req = "EXEC DC_WFContainer '" _
    & QuoteParam(DC_Choice.cbo_ShipDC_code.List(DC_Choice.cbo_ShipDC.ListIndex)) & "', '" _
    & QuoteParam(FormatD(txt_ShipDate, "mm/dd/yyyy")) & "', '"
If Opt_Yes.Value = -1 Then
ls_req = ls_req _
    & QuoteParam(cbo_Interco_code.List(cbo_Interco.ListIndex)) & "', '" _
    & QuoteParam(FormatD(txt_DeliveryDate, "mm/dd/yyyy")) & "', 'Y'"
Else
ls_req = ls_req & "', '', 'N'"
End If

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        ms_OverDCFrom = ODBCData(ll_Statement, 1)
        ms_OverDCTo = ODBCData(ll_Statement, 2)
    End If
End If
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
If ms_OverDCFrom = "Y" Then
    If MsgBox(Msg1, vbQuestion + vbYesNo, "Over Load") = vbNo Then
        ms_OverDCFrom = "N"
        ssp_quit.SetFocus
        Exit Function
    End If
End If
If ms_OverDCTo = "Y" Then
    If MsgBox(Msg2, vbQuestion + vbYesNo, "Over Load") = vbNo Then
        ms_OverDCTo = "N"
        ssp_quit.SetFocus
        Exit Function
    End If
End If
If ms_OverDCFrom = "Y" Then
    ls_req = "EXEC Workflow_DCLoadPlan '" _
        & QuoteParam(DC_Choice.cbo_ShipDC_code.List(DC_Choice.cbo_ShipDC.ListIndex)) & "', '" _
        & QuoteParam(FormatD(txt_ShipDate, "mm/dd/yyyy")) _
        & "', 'Container', ' Container. Date : '"
    If Not SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 8, "Insert failed!", gut_LangLogin.Code
        Exit Function
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    End If
End If
If ms_OverDCTo = "Y" Then
    ls_req = "EXEC Workflow_DCLoadPlan '" _
        & QuoteParam(cbo_Interco_code.List(cbo_Interco.ListIndex)) & "', '" _
        & QuoteParam(FormatD(txt_DeliveryDate, "mm/dd/yyyy")) _
        & "', 'Receipt', ' Receipt. Date : '"
    If Not SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 8, "Insert failed!", gut_LangLogin.Code
        Exit Function
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    End If
End If
ControlOver = OK
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function Upd_Table() As Boolean

Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Line As String

Upd_Table = KO

On Error GoTo suite

If Control Then
    If ControlOver Then
        If gs_TableName = "DC_Containers" Then
            ls_req = gs_ParamReqUpd & " " & gs_TableCode & ", " & gs_TableCode2 & ", '" _
                & QuoteParam(cbo_ContainerCpy_code.List(cbo_ContainerCpy.ListIndex)) & "', '" _
                & QuoteParam(cbo_Equipement) & "', '" _
                & QuoteParam(txt_ShipAdd) & "', '" _
                & QuoteParam(txt_CLSOrder) & "', '" _
                & QuoteParam(txt_CLSShipNb) & "',"
                If Opt_Yes.Value = -1 Then
                    ls_req = ls_req & " 'Y', '" & cbo_Interco_code.List(cbo_Interco.ListIndex) & "', '" _
                            & QuoteParam(cbo_Interco) & "', '"
                Else
                    ls_req = ls_req & " 'N', '', '" _
                            & QuoteParam(txt_CustName) & "', '"
                End If
            ls_req = ls_req & QuoteParam(txt_COSContact) & "', '" _
                & QuoteParam(FormatD(txt_DeliveryDate, "mm/dd/yyyy")) & "','" _
                & QuoteParam(FormatD(txt_ShipDate, "mm/dd/yyyy")) & "', " _
                & txt_Weight & ", '" & QuoteParam(cbo_UOM) & "', '" _
                & QuoteParam(txt_RSRequire) & "', '" _
                & QuoteParam(txt_SchContainerNb) & "', '" _
                & QuoteParam(DateFormat(txt_LoadPlanStartTime)) & "', '" _
                & QuoteParam(DateFormat(txt_LoadPlanEndTime)) & "', '" _
                & QuoteParam(DateFormat(txt_ArrivalTime)) & "', '" _
                & QuoteParam(txt_ActContainerNb) & "', '"
            ls_req = ls_req & QuoteParam(DateFormat(txt_LoadStartTime)) & "', '" _
                & QuoteParam(DateFormat(txt_LoadEndTime)) & "', '" _
                & QuoteParam(txt_LoadBy) & "', '" _
                & QuoteParam(txt_SealNb) & "'"
        ElseIf gs_TableName = "DC_Cont_End" Then
            ls_req = gs_ParamReqUpd & " " & gs_TableCode & ", " & gs_TableCode2 & ", '" _
                & QuoteParam(txt_SchContainerNb) & "', '" _
                & QuoteParam(DateFormat(txt_LoadPlanStartTime)) & "', '" _
                & QuoteParam(DateFormat(txt_LoadPlanEndTime)) & "', '" _
                & QuoteParam(DateFormat(txt_ArrivalTime)) & "', '" _
                & QuoteParam(txt_ActContainerNb) & "', '" _
                & QuoteParam(DateFormat(txt_LoadStartTime)) & "', '" _
                & QuoteParam(DateFormat(txt_LoadEndTime)) & "', '" _
                & QuoteParam(txt_LoadBy) & "', '" _
                & QuoteParam(txt_SealNb) & "'"
        End If
        If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
            li_Status = SQLRowCount(ll_Statement, ll_lngrows)
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            If ll_lngrows = 0 Then
                SendMessage 2, "Another user change the record", gut_LangLogin.Code
            Else
                Upd_Table = OK
                C_main.Grid.RemoveItem C_main.Grid.Row
                ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_DeliveryDate & Chr(9) & txt_CustName & Chr(9) & txt_ShipAdd & Chr(9) & cbo_ContainerCpy & Chr(9) & txt_CLSShipNb
                C_main.Grid.AddItem ls_Line, C_main.Grid.Row
            End If
        Else
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            SendMessage 3, "Update failed", gut_LangLogin.Code
        End If
    End If
End If
Exit Function

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
End Function

Private Sub Clear_Description()
    txt_DCFromName = ""
    txt_ShipDate = ""
    cbo_ContainerCpy_code.Clear
    cbo_ContainerCpy.Clear
    cbo_Equipement.Clear
    txt_CustName = ""
    txt_ShipAdd = ""
    txt_CLSOrder = ""
    txt_CLSShipNb = ""
    Opt_No.Value = OK
    cbo_Interco_code.Clear
    cbo_Interco.Clear
    txt_COSContact = ""
    txt_DeliveryDate = ""
    txt_Weight = ""
    cbo_UOM.Clear
    txt_RSRequire = ""
    txt_SchContainerNb = ""
    txt_LoadPlanStartTime = ""
    txt_LoadPlanEndTime = ""
    txt_ArrivalTime = ""
    txt_ActContainerNb = ""
    txt_LoadStartTime = ""
    txt_LoadEndTime = ""
    txt_LoadBy = ""
    txt_SealNb = ""
    
    mb_ContLoad = OK
    mb_EqLoad = OK
    mb_UOMLoad = OK
    mb_IntLoad = OK
    mb_OverLoadChange = KO

End Sub

Private Sub Set_Description()
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim li_Count As Integer

On Error GoTo suite

ls_req = "EXEC Dc_Containers_dtl " & gs_TableCode
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        txt_DCFromName = ODBCData(ll_Statement, 1)
        txt_ShipDate = ODBCData(ll_Statement, 2)
        cbo_ContainerCpy_code.AddItem ODBCData(ll_Statement, 3)
        cbo_ContainerCpy.AddItem ODBCData(ll_Statement, 4)
        cbo_Equipement.AddItem ODBCData(ll_Statement, 5)
        txt_CustName = ODBCData(ll_Statement, 6)
        txt_ShipAdd = ODBCData(ll_Statement, 7)
        txt_CLSOrder = ODBCData(ll_Statement, 8)
        txt_CLSShipNb = ODBCData(ll_Statement, 9)
        If ODBCData(ll_Statement, 10) = "Y" Then
            Opt_Yes.Value = OK
        Else
            Opt_No.Value = OK
        End If
        cbo_Interco_code.AddItem ODBCData(ll_Statement, 11)
        cbo_Interco.AddItem ODBCData(ll_Statement, 12)
        txt_COSContact = ODBCData(ll_Statement, 13)
        txt_DeliveryDate = ODBCData(ll_Statement, 14)
        txt_Weight = ODBCData(ll_Statement, 15)
        cbo_UOM.AddItem ODBCData(ll_Statement, 16)
        txt_RSRequire = ODBCData(ll_Statement, 17)
        txt_SchContainerNb = ODBCData(ll_Statement, 18)
        txt_LoadPlanStartTime = ODBCData(ll_Statement, 19)
        txt_LoadPlanEndTime = ODBCData(ll_Statement, 20)
        txt_ArrivalTime = ODBCData(ll_Statement, 21)
        txt_ActContainerNb = ODBCData(ll_Statement, 22)
        txt_LoadStartTime = ODBCData(ll_Statement, 23)
        txt_LoadEndTime = ODBCData(ll_Statement, 24)
        txt_LoadBy = ODBCData(ll_Statement, 25)
        txt_SealNb = ODBCData(ll_Statement, 26)
    End If
End If
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

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

Private Function Dlt_Table() As Boolean

Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

Dlt_Table = KO

On Error GoTo suite

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    ls_req = gs_ParamReqDel & " " _
     & gs_TableCode & ", " _
     & gs_TableCode2
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        If ll_lngrows = 0 Then
            SendMessage 7, "Delete failed : concurrency problem ?", gut_LangLogin.Code
            C_main.FillGrid
        Else
            Dlt_Table = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 6, "Delete failed ", gut_LangLogin.Code
    End If
End If
MouseOff
Exit Function

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
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 Add_Table() As Boolean
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Line As String

On Error GoTo suite

Add_Table = KO

If Control Then
    If ControlOver Then
        ls_req = gs_ParamReqIns & "'" & QuoteParam(txt_DCFromName) & "', '" _
                & QuoteParam(cbo_ContainerCpy_code.List(cbo_ContainerCpy.ListIndex)) & "', '" _
                & QuoteParam(cbo_Equipement) & "', '" _
                & QuoteParam(txt_ShipAdd) & "', '" _
                & QuoteParam(txt_CLSOrder) & "', '" _
                & QuoteParam(txt_CLSShipNb) & "',"
                If Opt_Yes.Value = -1 Then
                    ls_req = ls_req & " 'Y', '" & cbo_Interco_code.List(cbo_Interco.ListIndex) & "', '" _
                            & QuoteParam(cbo_Interco) & "', '"
                Else
                    ls_req = ls_req & " 'N', '', '" _
                            & QuoteParam(txt_CustName) & "', '"
                End If
        ls_req = ls_req & QuoteParam(txt_COSContact) & "', '" _
                & QuoteParam(FormatD(txt_DeliveryDate, "mm/dd/yyyy")) & "', " _
                & txt_Weight & ", '" _
                & QuoteParam(cbo_UOM) & "', '" _
                & QuoteParam(txt_RSRequire) & "', '" _
                & QuoteParam(txt_SchContainerNb) & "', '" _
                & QuoteParam(DateFormat(txt_LoadPlanStartTime)) & "', '" _
                & QuoteParam(DateFormat(txt_LoadPlanEndTime)) & "', '" _
                & QuoteParam(DateFormat(txt_ArrivalTime)) & "', '" _
                & QuoteParam(txt_ActContainerNb) & "', '"
        ls_req = ls_req & QuoteParam(DateFormat(txt_LoadStartTime)) & "', '" _
                & QuoteParam(DateFormat(txt_LoadEndTime)) & "', '" _
                & QuoteParam(txt_LoadBy) & "', '" _
                & QuoteParam(txt_SealNb) & "'"
                
                
        If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
            li_Status = SQLRowCount(ll_Statement, ll_lngrows)
            If ll_lngrows = 0 Then
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                SendMessage 4, "Insert failed", gut_LangLogin.Code
                C_main.FillGrid
            Else
                li_Status = SQLFetch(ll_Statement)
                If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                    ml_d = CLng(ODBCData(ll_Statement, 1))
                End If
                Add_Table = OK
                ls_Line = 0 & Chr(9) & 1 & Chr(9) & txt_DeliveryDate & Chr(9) & txt_CustName & Chr(9) & txt_ShipAdd & Chr(9) & cbo_ContainerCpy & Chr(9) & txt_CLSShipNb
                C_main.Grid.AddItem ls_Line
                C_main.Grid.Row = C_main.Grid.Rows - 1
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            End If
        Else
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                SendMessage 4, "Insert failed", gut_LangLogin.Code
        End If
    End If
End If
Exit Function

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




Private Sub cbo_containerCpy_DropDown()
Dim ls_Text As String

If mb_ContLoad Then
    mb_ContLoad = KO
    If cbo_ContainerCpy.ListIndex <> -1 Then
        ls_Text = cbo_ContainerCpy_code.List(cbo_ContainerCpy.ListIndex)
    Else
        ls_Text = ""
    End If
    cbo_ContainerCpy_code.Clear
    cbo_ContainerCpy.Clear
    FillCbo "Carrier_cbo", cbo_ContainerCpy_code, cbo_ContainerCpy
    If ls_Text <> "" Then
        cbo_ContainerCpy.ListIndex = ComboFindItem(cbo_ContainerCpy_code, ls_Text)
    End If
End If

End Sub



Private Sub Cbo_Equipement_DropDown()
Dim ls_Text As String

If mb_EqLoad Then
    mb_EqLoad = KO
    If cbo_Equipement.ListIndex <> -1 Then
        ls_Text = cbo_Equipement
    Else
        ls_Text = ""
    End If
    cbo_Equipement.Clear
    FillOneCbo "DC_Equipement_cbo", cbo_Equipement
    If ls_Text <> "" Then
        cbo_Equipement.ListIndex = ComboFindItem(cbo_Equipement, ls_Text)
    End If
End If

End Sub


Private Sub cbo_Interco_Change()
mb_OverLoadChange = OK
End Sub

Private Sub cbo_Interco_DropDown()
Dim ls_Text As String

If mb_IntLoad Then
    mb_IntLoad = KO
    If cbo_Interco.ListIndex <> -1 Then
        ls_Text = cbo_Interco_code.List(cbo_Interco.ListIndex)
    Else
        ls_Text = ""
    End If
    cbo_Interco_code.Clear
    cbo_Interco.Clear
    FillCbo "DC_cbo", cbo_Interco_code, cbo_Interco
    If ls_Text <> "" Then
        cbo_Interco.ListIndex = ComboFindItem(cbo_Interco_code, ls_Text)
    End If
End If

End Sub


Private Sub cbo_UOM_DropDown()
Dim ls_Text As String

If mb_UOMLoad Then
    mb_UOMLoad = KO
    If cbo_UOM.ListIndex <> -1 Then
        ls_Text = cbo_UOM
    Else
        ls_Text = ""
    End If
    cbo_UOM.Clear
    FillOneCbo "DC_UOM_cbo", cbo_UOM
    If ls_Text <> "" Then
        cbo_UOM.ListIndex = ComboFindItem(cbo_UOM, ls_Text)
    End If
End If

End Sub


Private Sub Form_Activate()
If gs_Action = "Delete" Then
    spp_save.SetFocus
ElseIf gs_Action = "MoreInfo" Then
    ssp_quit.SetFocus
ElseIf gs_TableName = "DC_Containers" Then
    cbo_ContainerCpy.SetFocus
ElseIf gs_TableName = "DC_Cont_End" Then
    txt_SchContainerNb.SetFocus
End If
End Sub

Private Sub Opt_No_Click()
lbl_ShipInterco.Visible = KO
cbo_Interco.Visible = KO

End Sub

Private Sub Opt_yes_Click()

lbl_ShipInterco.Visible = OK
cbo_Interco.Visible = OK
txt_CustName = ""
txt_ShipAdd = ""

End Sub

Private Sub spp_save_Click()

Dim ld_AddDate As Date

MouseOff
gb_Return = OK
Select Case gs_Action
Case "Add":
    If Add_Table Then
        DCCost1.TransCode = ml_d
        DCCost1.GridSave
        
        cbo_ContainerCpy.ListIndex = -1
        cbo_Equipement.ListIndex = -1
        cbo_UOM.ListIndex = -1
        txt_CustName = ""
        txt_ShipAdd = ""
        Opt_No.Value = True
        txt_Weight = ""
        txt_COSContact = ""
        txt_CLSOrder = ""
        txt_CLSShipNb = ""
        ld_AddDate = StringToDate(right(txt_ShipDate, 10))
        txt_DeliveryDate = DateToString(DateAdd("d", 2, ld_AddDate))
        txt_RSRequire = ""
        txt_SchContainerNb = ""
        txt_LoadPlanStartTime = "0000"
        txt_LoadPlanEndTime = "0000"
        txt_ArrivalTime = "0000"
        txt_ActContainerNb = ""
        txt_LoadStartTime = "0000"
        txt_LoadEndTime = "0000"
        txt_LoadBy = ""
        txt_SealNb = ""
        If gl_NbLineDisplay < 2 Then
            C_main.FillGrid
        End If
        DCCost1.TransCode = 0
        DCCost1.Grid_Init
    End If
Case "Update":
    If Upd_Table Then
        If gs_TableCode = "" Then
            DCCost1.TransCode = 0
        Else
            DCCost1.TransCode = CLng(gs_TableCode)
        End If
        DCCost1.GridSave
        Me.Hide
        Exit Sub
    End If
Case "Delete":
    'DCCost1.dc_ODBC_Connect = prg.ODBC_ConnectString
    If gs_TableCode = "" Then
        DCCost1.TransCode = 0
    Else
        DCCost1.TransCode = CLng(gs_TableCode)
    End If
    DCCost1.GridDelete
          
    If Dlt_Table Then
        Me.Hide
        Exit Sub
    End If
End Select

MouseOn
End Sub



Private Sub SSDeliveryDate_Click()
On Error GoTo suite

MouseOff
gb_Return = KO
gs_Date = txt_DeliveryDate
Dates.show 1
If gb_Return Then
    txt_DeliveryDate = gs_Date
End If
MouseOn
Exit Sub

suite:
StdError
MouseOn
End Sub


Private Sub ssp_quit_Click()
    Me.Hide
End Sub





Private Sub SSShipDate_Click()
On Error GoTo suite

MouseOff
gb_Return = KO
gs_Date = txt_ShipDate
Dates.show 1
If gb_Return Then
    txt_ShipDate = gs_Date
End If
MouseOn
Exit Sub

suite:
StdError
MouseOn

End Sub

Private Sub txt_ArrivalTime_GotFocus()

If Len(txt_ArrivalTime) = 5 And Mid(txt_ArrivalTime, 3, 1) = ":" Then
    txt_ArrivalTime = Left(txt_ArrivalTime, 2) & right(txt_ArrivalTime, 2)
End If

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

End Sub


Private Sub txt_ArrivalTime_LostFocus()

If Len(txt_ArrivalTime) = 5 Then
    txt_ArrivalTime = Left(txt_ArrivalTime, 2) & right(txt_ArrivalTime, 2)
End If

If Not CheckNumericValue(txt_ArrivalTime) Then
    SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
    txt_ArrivalTime.SetFocus
    MouseOn
    Exit Sub
End If

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

MouseOn

End Sub


Private Sub txt_deliverydate_Change()
mb_OverLoadChange = OK

If txt_DeliveryDate = "" Then Exit Sub

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

Private Sub txt_LoadEndTime_GotFocus()
    
If Len(txt_LoadEndTime) = 5 Then
    txt_LoadEndTime = Left(txt_LoadEndTime, 2) & right(txt_LoadEndTime, 2)
End If

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

End Sub


Private Sub txt_LoadEndTime_LostFocus()

If Len(txt_LoadEndTime) = 5 And Mid(txt_LoadEndTime, 3, 1) = ":" Then
    txt_LoadEndTime = Left(txt_LoadEndTime, 2) & right(txt_LoadEndTime, 2)
End If

If Not CheckNumericValue(txt_LoadEndTime) Then
    SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
    txt_LoadEndTime.SetFocus
    MouseOn
    Exit Sub
End If

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

MouseOn

End Sub


Private Sub txt_LoadPlanEndTime_GotFocus()
    
If Len(txt_LoadPlanEndTime) = 5 Then
    txt_LoadPlanEndTime = Left(txt_LoadPlanEndTime, 2) & right(txt_LoadPlanEndTime, 2)
End If

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

End Sub


Private Sub txt_LoadPlanEndTime_LostFocus()

If Len(txt_LoadPlanEndTime) = 5 And Mid(txt_LoadPlanEndTime, 3, 1) = ":" Then
    txt_LoadPlanEndTime = Left(txt_LoadPlanEndTime, 2) & right(txt_LoadPlanEndTime, 2)
End If

If Not CheckNumericValue(txt_LoadPlanEndTime) Then
    SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
    txt_LoadPlanEndTime.SetFocus
    MouseOn
    Exit Sub
End If

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

MouseOn

End Sub


Private Sub txt_LoadPlanStartTime_GotFocus()
    
If Len(txt_LoadPlanStartTime) = 5 Then
    txt_LoadPlanStartTime = Left(txt_LoadPlanStartTime, 2) & right(txt_LoadPlanStartTime, 2)
End If

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

End Sub


Private Sub txt_LoadPlanStartTime_LostFocus()

If Len(txt_LoadPlanStartTime) = 5 And Mid(txt_LoadPlanStartTime, 3, 1) = ":" Then
    txt_LoadPlanStartTime = Left(txt_LoadPlanStartTime, 2) & right(txt_LoadPlanStartTime, 2)
End If

If Not CheckNumericValue(txt_LoadPlanStartTime) Then
    SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
    txt_LoadPlanStartTime.SetFocus
    MouseOn
    Exit Sub
End If

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

MouseOn

End Sub


Private Sub txt_LoadStartTime_GotFocus()

If Len(txt_LoadStartTime) = 5 Then
    txt_LoadStartTime = Left(txt_LoadStartTime, 2) & right(txt_LoadStartTime, 2)
End If

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

End Sub


Private Sub txt_LoadStartTime_LostFocus()

If Len(txt_LoadStartTime) = 5 And Mid(txt_LoadStartTime, 3, 1) = ":" Then
    txt_LoadStartTime = Left(txt_LoadStartTime, 2) & right(txt_LoadStartTime, 2)
End If

If Not CheckNumericValue(txt_LoadStartTime) Then
    SendMessage 8, "Only numeric field is valid !", gut_LangLogin.Code
    txt_LoadStartTime.SetFocus
    MouseOn
    Exit Sub
End If

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

MouseOn

End Sub



Private Function Control() As Boolean

Control = KO

If cbo_ContainerCpy = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        cbo_ContainerCpy.SetFocus
        Exit Function
End If
If cbo_Equipement = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        cbo_Equipement.SetFocus
        Exit Function
End If
If txt_CustName = "" And Opt_Yes = False Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_CustName.SetFocus
        Exit Function
End If
If txt_ShipAdd = "" And Opt_Yes = False Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_ShipAdd.SetFocus
       Exit Function
End If
If txt_CLSOrder = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_CLSOrder.SetFocus
        Exit Function
End If
If txt_DeliveryDate = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_DeliveryDate.SetFocus
        Exit Function
End If
If txt_ShipDate = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_ShipDate.SetFocus
        Exit Function
End If
If DateDiff("d", StringToDate(txt_DeliveryDate), StringToDate(txt_ShipDate)) > 0 Then
        SendMessage 8, "The delivery date must be greater" & Chr(10) & "than the shipping date", gut_LangLogin.Code
        txt_DeliveryDate.SetFocus
        Exit Function
End If
If txt_Weight = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        txt_Weight.SetFocus
        Exit Function
End If
If Not CheckNumericValue(txt_Weight) Then
    SendMessage 8, "Value must be a numeric", gut_LangLogin.Code
    txt_Weight.SetFocus
    Exit Function
End If
If cbo_UOM = "" Then
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        cbo_UOM.SetFocus
        Exit Function
End If

Control = OK

End Function

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

On Error GoTo suite

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, gs_ParamReqCsts) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or _
         li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or _
       li_Status = SQL_SUCCESS_WITH_INFO Then
        ls_Field = ODBCData(ll_Statement, 1)
        ls_Text = Left(ODBCData(ll_Statement, 2), 30)
        Select Case ls_Field
            Case "title": Caption = ls_Text
            Case "titleA": If gs_Action = "Add" Then Caption = Caption & " - " & ls_Text
            Case "titleU": If gs_Action = "Update" Then Caption = Caption & " - " & ls_Text
            Case "titleD": If gs_Action = "Delete" Then Caption = Caption & " - " & ls_Text
            Case "lbl_ShipFromDC": lbl_ShipFromDC = ls_Text
            Case "lbl_ShipDate": lbl_ShipDate = ls_Text
            Case "lbl_ContainerCpy": lbl_ContainerCpy = ls_Text
            Case "lbl_Equipement": lbl_Equipement = ls_Text
            Case "lbl_CustName": lbl_CustName = ls_Text
            Case "lbl_ShipAdd": lbl_ShipAdd = ls_Text
            Case "lbl_Interco": lbl_Interco = ls_Text
            Case "lbl_ShipInterco": lbl_ShipInterco = ls_Text
            Case "lbl_CLSOrderNb": lbl_CLSOrderNb = ls_Text
            Case "lbl_CLSShipNb": lbl_CLSShipNb = ls_Text
            Case "lbl_DeliveryDate": Lbl_DeliveryDate = ls_Text
            Case "lbl_Weight": lbl_Weight = ls_Text
            Case "lbl_UOM": lbl_UOM = ls_Text
            Case "lbl_COSContact": lbl_COSContact = ls_Text
            Case "lbl_RSRequire": lbl_RSRequire = ls_Text
            Case "Fr_Schedule": Fr_Schedule.Caption = ls_Text
            Case "lbl_SchContainerNb": lbl_SchContainerNb = 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_ActContainerNb": lbl_ActContainerNb = 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_SealNb": lbl_SealNb = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError

End Sub

' 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 "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"
    
    If Not mo_Db.IsConnected Then
        Call ReconnectSafe
    End If

    spp_save.Picture = LoadResPicture(RES_OK, 1)
    ssp_quit.Picture = LoadResPicture(RES_QUIT, 1)
    SSShipDate.Picture = LoadResPicture(RES_DOWN2, vbResIcon)
    SSDeliveryDate.Picture = LoadResPicture(RES_DOWN2, vbResIcon)

    DCCost1.dc_user = ms_loginName
    Set DCCost1.ArmDb = mo_Db
    Call DCCost1.SetReconnectParams(ms_reconnectServer, ms_reconnectDB, ms_reconnectUser, ms_reconnectPassword, ms_reconnectApp)
    DCCost1.Lang = ms_Language_Code
    DCCost1.U_Code = ml_U_Code
    Call DCCost1.Load_A_Com

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

Public Sub InitControl()
On Error GoTo errhandler
    mb_eventRunning = True
    
    Dim lsa_PLs() As String
    lsa_PLs = Split(Get_A_Config("DC_PL_STYLE"), SEP)
    
    Dim ll_i As Long
    mb_PL_STYLE_ENABLED = False
    For ll_i = LBound(lsa_PLs) To UBound(lsa_PLs)
        If lsa_PLs(ll_i) = ms_DC_Code Then
            mb_PL_STYLE_ENABLED = True
            Exit For
        End If
    Next
    
    ms_UrlWebService = Get_A_Config("DC_WEBSERVICE_ORDER_DATA")
    
    Call Clear_Description
    
cbo_ContainerCpy.Enabled = OK
cbo_Equipement.Enabled = OK
cbo_UOM.Enabled = OK
cbo_Interco.Enabled = OK
txt_CustName.Locked = KO
txt_ShipAdd.Locked = KO
txt_CLSOrder.Locked = KO
txt_CLSShipNb.Locked = KO
txt_DeliveryDate.Locked = OK
txt_Weight.Locked = KO
Opt_Yes.Enabled = OK
Opt_No.Enabled = OK
txt_COSContact.Locked = KO
SSDeliveryDate.Enabled = OK
SSShipDate.Enabled = OK
txt_RSRequire.Locked = KO
Fr_Schedule.Enabled = OK
Fr_Actual.Enabled = OK
spp_save.Visible = OK

    
If gs_Action <> "Add" Then
    Set_Description
    cbo_ContainerCpy.ListIndex = 0
    cbo_Equipement.ListIndex = 0
    cbo_UOM.ListIndex = 0
    If Opt_No.Value = 0 Then
        lbl_Interco.Visible = OK
        cbo_Interco.Visible = OK
        cbo_Interco.ListIndex = 0
    End If
    If gs_TableName = "DC_Cont_End" Then
        cbo_ContainerCpy.Enabled = KO
        cbo_Equipement.Enabled = KO
        cbo_UOM.Enabled = KO
        cbo_Interco.Enabled = KO
        txt_CustName.Locked = OK
        txt_ShipAdd.Locked = OK
        txt_CLSOrder.Locked = OK
        txt_CLSShipNb.Locked = OK
        txt_DeliveryDate.Locked = OK
        txt_Weight.Locked = OK
        Opt_Yes.Enabled = KO
        Opt_No.Enabled = KO
        txt_COSContact.Locked = OK
        SSDeliveryDate.Enabled = KO
        SSShipDate.Enabled = KO
        txt_RSRequire.Locked = OK
    End If
    If gs_Action = "Delete" Or gs_Action = "MoreInfo" Then
        Set_Description
        cbo_ContainerCpy.Enabled = KO
        cbo_Equipement.Enabled = KO
        cbo_UOM.Enabled = KO
        cbo_Interco.Enabled = KO
        txt_CustName.Locked = OK
        txt_ShipAdd.Locked = OK
        txt_CLSOrder.Locked = OK
        txt_CLSShipNb.Locked = OK
        txt_DeliveryDate.Locked = OK
        txt_Weight.Locked = OK
        Opt_Yes.Enabled = KO
        Opt_No.Enabled = KO
        txt_COSContact.Locked = OK
        SSDeliveryDate.Enabled = KO
        SSShipDate.Enabled = KO
        txt_RSRequire.Locked = OK
        Fr_Schedule.Enabled = KO
        Fr_Actual.Enabled = KO
        If gs_Action = "MoreInfo" Then
            spp_save.Visible = KO
        End If
    End If
Else
    FillCbo "Carrier_cbo", cbo_ContainerCpy_code, cbo_ContainerCpy
    FillOneCbo "DC_Equipement_cbo", cbo_Equipement
    FillOneCbo "DC_UOM_cbo", cbo_UOM
    FillCbo "DC_cbo", cbo_Interco_code, cbo_Interco
    SSShipDate.Visible = KO
    cbo_Interco.Visible = KO
    lbl_ShipInterco.Visible = KO
    txt_CustName = ""
    txt_DCFromName = DC_Choice.cbo_ShipDC
    txt_ShipDate = DC_Choice.txt_ShipDate
    AddDay
    txt_LoadPlanStartTime = "0000"
    txt_LoadPlanEndTime = "0000"
    txt_LoadStartTime = "0000"
    txt_LoadEndTime = "0000"
    txt_ArrivalTime = "0000"
    mb_ContLoad = KO
    mb_EqLoad = KO
    mb_UOMLoad = KO
    mb_IntLoad = KO
End If

    
    If gs_TableCode = "" Or gs_Action = "Add" Then
        DCCost1.TransCode = 0
        DCCost1.Enabled = True
    Else
        DCCost1.TransCode = CLng(ml_d)
        DCCost1.Enabled = (gs_Action = "Update")
    End If

    Call DCCost1.Grid_Init
    
    mb_eventRunning = False

    Exit Sub
errhandler:
    mb_eventRunning = False
    Call ErrorHandler("InitControl")
End Sub

Public Sub Unload_A_Com()
    
On Error GoTo errhandler
    mb_Initialized = False
    
    Dim lo_control As Object

    For Each lo_control In Controls
      Select Case UCase(TypeName(lo_control))
      Case "ARMCOMBOBOX"
        Call lo_control.Unload_A_Com
      Case "ARMPICKER"
        Call lo_control.Unload_A_Com
      Case "TOOLBARCONTROL"
        Call lo_control.Unload_A_Com
      Case "ARMGRID"
        Call lo_control.Unload_A_Com
      Case "ARMTREEVIEW"
        Call lo_control.Unload_A_Com
      Case "ARMCHECKVIEW"
        Call lo_control.Unload_A_Com
      Case "TOOLBR"
        Call lo_control.Unload_A_Com
      End Select
    Next
    
    Call DCCost1.Unload_A_Com
    
    Set mo_Sys = Nothing
    
    Set mo_scriptObj = Nothing
    
    Exit Sub
    
errhandler:
    
    Call ErrorHandler("UnLoad_A_Com")
    
End Sub


Private Function ReconnectSafe() As Boolean
On Error GoTo errhandler

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

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

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


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

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

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

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

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


Private Function 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 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

