VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form PF_mtnc 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3825
   ClientLeft      =   1770
   ClientTop       =   2520
   ClientWidth     =   11445
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3825
   ScaleWidth      =   11445
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmd_Add 
      Height          =   495
      Left            =   10200
      Style           =   1  'Graphical
      TabIndex        =   18
      Top             =   480
      Width           =   495
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   615
      Left            =   2760
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   3120
      Width           =   615
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   615
      Left            =   3420
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   3120
      Width           =   615
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   270
      Left            =   3120
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   2640
      Width           =   255
   End
   Begin VB.CommandButton cmd_Del 
      Height          =   495
      Left            =   10680
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   480
      Width           =   495
   End
   Begin VB.TextBox Txt_descr 
      Height          =   285
      Left            =   1920
      MaxLength       =   40
      TabIndex        =   0
      Top             =   240
      Width           =   3135
   End
   Begin VB.ListBox lst_Group 
      Height          =   1815
      ItemData        =   "PFG_mtnc.frx":0000
      Left            =   3720
      List            =   "PFG_mtnc.frx":0007
      TabIndex        =   5
      Top             =   1080
      Width           =   7575
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   288
      Left            =   1920
      Locked          =   -1  'True
      TabIndex        =   7
      Top             =   2640
      Width           =   1212
   End
   Begin VB.CheckBox chk_Int 
      Caption         =   "Check1"
      Height          =   252
      Left            =   1920
      TabIndex        =   6
      Top             =   2280
      Width           =   252
   End
   Begin MSForms.ComboBox cbo_InternetGroup 
      Height          =   315
      Left            =   1920
      TabIndex        =   3
      Top             =   1680
      Width           =   1500
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "2646;556"
      MatchEntry      =   0
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_super 
      Height          =   315
      Left            =   1920
      TabIndex        =   1
      Top             =   720
      Width           =   1500
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "2646;556"
      MatchEntry      =   0
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_UOM 
      Height          =   315
      Left            =   1920
      TabIndex        =   2
      Top             =   1200
      Width           =   1500
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "2646;556"
      MatchEntry      =   0
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin VB.Label lbl_Group 
      Caption         =   "Combination group :"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3720
      TabIndex        =   17
      Top             =   720
      Width           =   5055
   End
   Begin VB.Label lbl_InternetGroup 
      Caption         =   "Internet category :"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   1740
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Label lbl_descr 
      Caption         =   "Description :"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   240
      Width           =   1815
   End
   Begin VB.Label Lbl_super 
      Caption         =   "Super category :"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   720
      Width           =   1815
   End
   Begin VB.Label lbl_Int 
      Caption         =   "Internet flag"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   2280
      Width           =   1455
   End
   Begin VB.Label lbl_Drop 
      Caption         =   "Drop date"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   2640
      Width           =   1455
   End
   Begin VB.Label lbl_UOM 
      Caption         =   "Unit of measure :"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   1200
      Width           =   1815
   End
End
Attribute VB_Name = "PF_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'P592 01/09 begin Products_Edges replaced by a combination (BML,SH,PE,PF)
Dim InfoList() As InfoList
Private Type InfoList
    GWG_Code As Long
    PFG_Code As Long
    BML_Code As String
    SH_Code As String
    PE_Code As String
    PF_Vode As String
    WebDesc As String
    iConcurrency As Integer
End Type
        
'Error management
Private Const C_SCREENNAME As String = "PF_mtnc"

Private mNumber As Long
Private mSource As String
Private mDesc As String

Private Sub Cbo_super_Click()

On Error GoTo ErrHandler
MouseOff

If cbo_super.ListIndex <> -1 And cbo_super.Visible = -1 Then
    If cbo_super.Column(2) = 1 Then
        SendMessage 70, "Inactive data.", gut_LangLogin.Code
    End If
End If

'remplir la combo des products edges
If cbo_super.ListIndex <> -1 And MCombo_GetCode(cbo_super) <> gs_TableCode2 Then
    cbo_UOM.Clear
    cbo_UOM.Tag = UNLOADED
End If

cbo_UOM.Enabled = OK
lbl_UOM.Enabled = OK

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub

Private Sub cbo_UOM_Click()

On Error GoTo ErrHandler
MouseOff

If cbo_UOM.ListIndex <> -1 And cbo_UOM.Visible = -1 Then
    If cbo_UOM.Column(2) = 1 Then
        SendMessage 70, "Inactive data.", gut_LangLogin.Code
    End If
End If

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub

Private Sub cbo_super_DropButtonClick()

On Error GoTo ErrHandler
MouseOff

If cbo_super.Tag = "0" Then
    cbo_super.Clear
    Select Case gs_TableName
        Case "ProductsFamilies_Group"
            MCombo_Fill cbo_super, "EXEC products_families_cbo 'C002','" & gut_LangWork.Code & "'", , OK
        Case "AccProductsFamilies_Group"
            MCombo_Fill cbo_super, "EXEC products_families_cbo 'C004','" & gut_LangWork.Code & "'", , OK
    End Select
    cbo_super.Tag = Loaded
End If

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub

Private Sub cbo_UOM_DropButtonClick()

On Error GoTo ErrHandler
MouseOff

If cbo_UOM.Tag = "0" Then
    cbo_UOM.Clear
    If cbo_super.ListIndex <> -1 Then
        If gs_TableName = "ProductsFamilies_Group" Then
            MCombo_Fill cbo_UOM, "EXEC Products_Edges_cbo5 '" & gut_LangWork.Code & "','C002','" & QuoteParam(MCombo_GetCode(cbo_super)) & "'", , OK
        Else '"AccProductsFamilies_Group"
            MCombo_Fill cbo_UOM, "EXEC Products_Edges_cbo5 '" & gut_LangWork.Code & "','C004','" & QuoteParam(MCombo_GetCode(cbo_super)) & "'", , OK
        End If
    End If
    If MCombo_GetCode(cbo_super) = gs_TableCode2 Then
        MCombo_CodeSelect(cbo_UOM) = gs_TableCode3
    End If
    cbo_UOM.Tag = Loaded
End If

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub

Private Sub cbo_InternetGroup_DropButtonClick()

On Error GoTo ErrHandler
MouseOff

If cbo_InternetGroup.Tag = "0" Then
    cbo_InternetGroup.Clear
    MCombo_AddItemCode cbo_InternetGroup, "", "(None)", False
    MCombo_Fill cbo_InternetGroup, "EXEC DGrid_Group_cbo '" & gut_LangWork.Code & "'", , OK
    MCombo_CodeSelect(cbo_InternetGroup) = gs_TableCode11
    cbo_InternetGroup.Tag = Loaded
End If

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub
'P592 begin
Private Sub cmd_Add_Click()

On Error GoTo ErrHandler
MouseOff

gs_Action = "add"
frm_mtnc_cwpr.show 1

FillLstGroup
MouseOn
Exit Sub

ErrHandler:
    MouseOn
    Select Case mNumber - C_ERRORRAISE
    Case 288
        SendMessage 288, "Impossible to fill existing combinations list.", gut_LangLogin.Code
    Case Else
        StdError
    End Select
End Sub

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

On Error GoTo ErrHandler
MouseOff

If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

'P592 01/09 begin
cmd_Add.Picture = LoadResPicture(RES_ADD, 1)
cmd_Del.Picture = LoadResPicture(RES_DELETE, 1)
'P592 01/09 end

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

mtnc_Categories_cst

cbo_super.Tag = UNLOADED
cbo_UOM.Tag = UNLOADED
cbo_InternetGroup.Tag = UNLOADED

Select Case gs_Action
Case "Add"
    Lbl_super.Enabled = OK
    cbo_super.Enabled = OK
    lbl_UOM.Enabled = KO
    cbo_UOM.Enabled = KO
    Lbl_InternetGroup.Visible = OK
    cbo_InternetGroup.Visible = OK
    Lbl_group.Visible = True
'P592 01/09 begin
    cmd_Del.Visible = KO
    cmd_Add.Visible = False
'P592 01/09 end
    lst_Group.Visible = KO
    MCombo_AddItemCode cbo_super, "", "(None)", False
            MCombo_AddItemCode cbo_InternetGroup, "", "(None)", False
    
Case "Update"
    Txt_descr = gs_TableCode6 'description du lien
    'internet
    If gs_TableCode10 = "X" Then
        chk_Int.Value = 1
    End If
    txt_dropped = gs_TableCode9 'date de drop
    cbo_super.Enabled = OK
    Lbl_super.Enabled = OK
    cbo_UOM.Enabled = OK
    lbl_UOM.Enabled = OK
    Lbl_InternetGroup.Visible = OK
    cbo_InternetGroup.Visible = OK
    MCombo_AddItemCode cbo_super, gs_TableCode2, gs_TableCode7, True
    MCombo_AddItemCode cbo_UOM, gs_TableCode3, gs_TableCode8, True
    MCombo_AddItemCode cbo_InternetGroup, gs_TableCode11, gs_TableCode5, True

'P592 begin
    FillLstGroup
'P592 end

Case "Delete"
    Txt_descr.Enabled = KO
    chk_Int.Enabled = KO
    txt_dropped.Enabled = KO
    SSC_dropped.Visible = KO
    Txt_descr = gs_TableCode6
    MCombo_AddItemCode cbo_super, "", gs_TableCode7, True
    cbo_super.ListIndex = 0
    MCombo_AddItemCode cbo_UOM, "", gs_TableCode8, True
    cbo_UOM.ListIndex = 0
    cbo_super.Enabled = KO
    cbo_UOM.Enabled = KO
    'internet group
    Lbl_InternetGroup.Visible = OK
    cbo_InternetGroup.Visible = OK
    cbo_InternetGroup.Enabled = KO
    MCombo_AddItemCode cbo_InternetGroup, "", gs_TableCode5, True
    
    If gs_TableCode10 = "X" Then
        chk_Int.Value = 1
    End If
    txt_dropped = gs_TableCode9
    
'P592 begin
    FillLstGroup
'P592 end

Case "MoreInfo"
        Txt_descr.Enabled = KO
        chk_Int.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
    Txt_descr = gs_TableCode6
    MCombo_AddItemCode cbo_super, "", gs_TableCode7
        cbo_super.ListIndex = 0
    MCombo_AddItemCode cbo_UOM, "", gs_TableCode8
        cbo_UOM.ListIndex = 0
        cbo_super.Enabled = KO
        cbo_UOM.Enabled = KO
    MCombo_AddItemCode cbo_InternetGroup, "", gs_TableCode5, True
    If gs_TableCode10 = "X" Then
            chk_Int.Value = 1
        End If
    txt_dropped = gs_TableCode9
    
'P592 01/09 begin
    cmd_Del.Enabled = False
    cmd_Add.Enabled = False
    FillLstGroup                                    ' JN 20/2/2014 bugfix to display the content of the list also for view mode
'P592 01/09 end

    cbo_InternetGroup.Enabled = False
    spp_save.Visible = False
End Select

MouseOn
Exit Sub

ErrHandler:
    MouseOn
    Select Case mNumber - C_ERRORRAISE
    Case 288
        SendMessage 288, "Impossible to fill existing combinations list.", gut_LangLogin.Code
    Case Else
        StdError
    End Select
End Sub
'P592 01/09 begin
Private Sub cmd_Del_Click()

On Error GoTo ErrHandler
MouseOff

If lst_Group.ListIndex = -1 Then
    SendMessage 1, "Select a record first, please", gut_LangLogin.Code
Else
    If SendMessage(144, "Do you want to delete linked Products Edges?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
        MouseOff
        If Not DeleteLink(InfoList(lst_Group.ListIndex).GWG_Code, InfoList(lst_Group.ListIndex).iConcurrency) Then
            SendMessage 7, "Delete failed. Try again, please.", gut_LangLogin.Code
        Else
            'Info no more up to date.
            InfoList(lst_Group.ListIndex).GWG_Code = 0
            lst_Group.RemoveItem (lst_Group.ListIndex)
        End If
    End If
End If

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub

Private Sub spp_save_Click()

On Error GoTo ErrHandler
MouseOff

gb_Return = OK
Select Case gs_Action
Case "Add":
    If Add_Table Then
        Txt_descr = ""
        cbo_super.ListIndex = -1
        cbo_UOM.ListIndex = -1
        Txt_descr.SetFocus
        txt_dropped = ""
        chk_Int.Value = 0
        C_main.FillGrid
    End If
    
Case "Update":
    If Upd_Table Then
        Unload Me
        Exit Sub
    End If
    
Case "Delete":
'P592 begin
    If lst_Group.ListCount <> 0 Then
        SendMessage 287, "Delete the associated link(s) before.", gut_LangLogin.Code
    Else
        If SendMessage(140, "Delete Family Group Link ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
            If Dlt_Table Then
                Unload Me
                Exit Sub
            End If
        End If
    End If
'P592 end

End Select

MouseOn
Exit Sub

ErrHandler:
    MouseOn
    Select Case mNumber - C_ERRORRAISE
    Case 2
        SendMessage 2, mDesc, gut_LangLogin.Code
    Case 3
        SendMessage 3, mDesc, gut_LangLogin.Code
    Case 4
        SendMessage 4, mDesc, gut_LangLogin.Code
    Case 6
        SendMessage 6, mDesc, gut_LangLogin.Code
    Case 7
        SendMessage 7, mDesc, gut_LangLogin.Code
    Case Else
        StdError
    End Select
End Sub

Private Sub SSC_dropped_Click()

On Error GoTo ErrHandler
MouseOff

gb_Return = KO
gs_Date = txt_dropped
Dates.show 1
If gb_Return Then
    txt_dropped = gs_Date
End If

MouseOn
Exit Sub

ErrHandler:
    StdError
End Sub

Private Sub ssp_quit_Click()

On Error GoTo ErrHandler

MouseOff
Unload Me

Exit Sub

ErrHandler:
    StdError
End Sub

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
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim ls_DGG_Code As String
Dim ls_InternetGroup As String
            
On Error GoTo ErrHandler

mNumber = C_ERRORRAISE + 2
mSource = C_SCREENNAME & "/Upd_Table:"

If chk_Int.Value = 1 Then ls_IntFlag = "X"
If txt_dropped <> "" Then
    ls_DropFlag = "X"
    ls_DropDate = FormatD(txt_dropped, "mm/dd/yyyy")
End If

Upd_Table = KO

If Control Then
    'verification combo InternetGroup
    If cbo_InternetGroup.ListIndex = -1 Or cbo_InternetGroup.ListIndex = 0 Then
        ls_InternetGroup = "NULL"
    Else
        ls_InternetGroup = QuoteParam(MCombo_GetCode(cbo_InternetGroup))
    End If
    Select Case gs_TableName
        Case "ProductsFamilies_Group"
            ls_req = "EXEC ProductsFamilies_Group_upd '" _
                & gs_TableCode & "', '" _
                & QuoteParam(Txt_descr) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_super)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_UOM)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_InternetGroup)) & "'," _
                & "'C002'," _
                & gs_TableCode4 & ",'" _
                & ls_IntFlag & "','" & ls_DropFlag & "','" & ls_DropDate & "'"
        Case "AccProductsFamilies_Group"
            If gs_TableCode5 = "" Then
                ls_DGG_Code = "NULL"
            Else
                ls_DGG_Code = "'" & QuoteParam(gs_TableCode11) & "'"
            End If
            ls_req = "EXEC ProductsFamilies_Group_upd '" _
                & gs_TableCode & "', '" _
                & QuoteParam(Txt_descr) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_super)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_UOM)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_InternetGroup)) & "'," _
                & "'C004'," _
                & gs_TableCode4 & ",'" _
                & ls_IntFlag & "','" & ls_DropFlag & "','" & ls_DropDate & "'"
    End Select
    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
            mDesc = "Another user change the record. Refresh your screen and try again."
            Err.Raise mNumber, mSource, mDesc
'            C_main.FillGrid
        Else
            Upd_Table = OK
            'verification combo InternetGroup
            If cbo_InternetGroup.ListIndex = -1 Then 'Or cbo_InternetGroup.ListIndex = 0 Then
                ls_InternetGroup = ""
            Else
                ls_InternetGroup = QuoteParam(cbo_InternetGroup.Column(0))
            End If
            ls_Line = gs_TableCode & Chr(9) & _
            MCombo_GetCode(cbo_super) & Chr(9) _
            & QuoteParam(MCombo_GetCode(cbo_UOM)) & Chr(9) _
            & CInt(gs_TableCode4) + 1 & Chr(9) _
            & ls_InternetGroup & Chr(9) _
            & Txt_descr & Chr(9) _
            & gs_TableCode7 & Chr(9) _
            & gs_TableCode8 & Chr(9) _
            & txt_dropped & Chr(9) _
            & ls_IntFlag & Chr(9) _
            & IIf(cbo_InternetGroup.ListIndex = -1, "", MCombo_GetCode(cbo_InternetGroup)) & Chr(9) _
            & gs_TableCode12 'Or cbo_InternetGroup.ListIndex = 0
'P592 begin
            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
            C_main.Grid.RemoveItem C_main.Grid.Row + 1
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        mDesc = "Update failed"
        Err.Raise mNumber + 1, mSource, mDesc
    End If
End If

Exit Function

ErrHandler:
    Select Case Err
    Case 30015
        C_main.FillGrid
    Case Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        Err.Raise mNumber, mSource, mDesc
    End Select
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_Code As String
Dim ls_Line As String
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String

On Error GoTo ErrHandler

Add_Table = KO
mNumber = C_ERRORRAISE + 4
mSource = C_SCREENNAME & "/Add_Table:"

If Control Then
    If chk_Int.Value = 1 Then ls_IntFlag = "X"
    If txt_dropped <> "" Then
        ls_DropFlag = "X"
        ls_DropDate = FormatD(txt_dropped, "mm/dd/yyyy")
    End If
    
    Select Case gs_TableName
        Case "ProductsFamilies_Group"
            ls_req = "EXEC ProductsFamilies_Group_ins '" _
                & QuoteParam(Txt_descr) & "', '" _
                & QuoteParam(MCombo_GetCode(cbo_super)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_UOM)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_InternetGroup)) & "','" _
                & "C002" & "','" _
                & ls_IntFlag & "','" & ls_DropFlag & "','" & ls_DropDate & "'"
        Case "AccProductsFamilies_Group"
            ls_req = "EXEC ProductsFamilies_Group_ins '" _
                & QuoteParam(Txt_descr) & "', '" _
                & QuoteParam(MCombo_GetCode(cbo_super)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_UOM)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_InternetGroup)) & "','" _
                & "C004" & "','" _
                & ls_IntFlag & "','" & ls_DropFlag & "','" & ls_DropDate & "'"
    End Select
    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)
            mDesc = "Insert failed: no record inserted"
            Err.Raise mNumber, mSource, mDesc
'            C_main.FillGrid
        Else
            Add_Table = OK
        ' Find the code
            li_Status = SQLFetch(ll_Statement)
            If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                ls_Code = ODBCData(ll_Statement, 1)
            End If
            ls_Line = ls_Code & Chr(9) & 1 & Chr(9) & Txt_descr & Chr(9) & MCombo_GetCode(cbo_super) & Chr(9) & cbo_super & Chr(9) & MCombo_GetCode(cbo_UOM) & Chr(9) & cbo_UOM & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
            C_main.Grid.AddItem ls_Line
            C_main.Grid.Row = C_main.Grid.Rows - 1
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            Lbl_super.Enabled = OK
            cbo_super.Enabled = OK
            lbl_UOM.Enabled = KO
            cbo_UOM.Enabled = KO
            cbo_UOM.Clear
            Select Case gs_TableName
            Case "ProductsFamilies"
                MCombo_Fill cbo_super, "ProductsFamilies", , OK
            Case "AccProductsFamilies"
                MCombo_Fill cbo_super, "AccProductsFamilies", , OK
            End Select
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        mDesc = "Insert request failed"
        Err.Raise mNumber, mSource, mDesc
    End If
End If
Exit Function

ErrHandler:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Err.Raise mNumber, mSource, mDesc
End Function

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
Dim i As Integer

On Error GoTo ErrHandler

Dlt_Table = KO
mNumber = C_ERRORRAISE + 6
mSource = C_SCREENNAME & "/Dlt_Table:"

ls_req = "EXEC ProductsFamilies_Group_del '" & QuoteParam(gs_TableCode) & "','" & gs_TableCode4 & "'"
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
        mDesc = "Delete failed : concurrency problem ?"
        Err.Raise mNumber + 1, mSource, mDesc
'        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)
    mDesc = "Delete request failed."
    Err.Raise mNumber, mSource, mDesc
End If

Exit Function

ErrHandler:
    Select Case Err
    Case 30015
        C_main.FillGrid
    Case Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        Err.Raise mNumber, mSource, mDesc
    End Select
End Function

Private Sub mtnc_Categories_cst()

Dim ls_req As String
Dim ls_Field As String
Dim ls_Text As String
Dim ll_Statement As Long
Dim li_Status As Integer

On Error GoTo ErrHandler

Select Case gs_TableName
    Case "ProductsFamilies_Group"
        ls_req = "EXEC Screen_Csts m_FamiliesGroup, '" & gut_LangLogin.Code & "'"
    Case "AccProductsFamilies_Group"
        ls_req = "EXEC Screen_Csts m_AFamilyGroup, '" & gut_LangLogin.Code & "'"
End Select
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) 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_descr": lbl_descr.Caption = ls_Text
        Case "lbl_super": Lbl_super = ls_Text
        Case "lbl_uom": lbl_UOM = ls_Text
        Case "lbl_int": lbl_Int = ls_Text
        Case "lbl_drop": lbl_Drop = ls_Text
        Case "lbl_Group": Lbl_group.Caption = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

ErrHandler:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
End Sub

Private Function Control_PFG_Products(as_pf_code As String, as_pe_code) As Boolean
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim li_Count As Integer

On Error GoTo ErrHandler

ls_req = "EXEC Count_DGG_Products '" & as_pf_code & "','" & as_pe_code & "'"

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) 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
        li_Count = ODBCData(ll_Statement, 1)
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)

If li_Count = 0 Then
    Control_PFG_Products = False
Else
    Control_PFG_Products = True
End If

Exit Function

ErrHandler:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
End Function

Private Function Control()

Control = KO
    
If cbo_super.ListIndex = -1 Then
    cbo_super.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If cbo_UOM.ListIndex = -1 Then
    cbo_UOM.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If Txt_descr.Text = "" Then
    Txt_descr.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If Len(Txt_descr) < 4 Then
    Txt_descr.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If Control_PFG_Products(MCombo_GetCode(cbo_super), MCombo_GetCode(cbo_UOM)) = False Then
    cbo_UOM.SetFocus
    SendMessage 145, "No product corresponding", gut_LangLogin.Code
    Exit Function
End If

'P592 begin
If cbo_InternetGroup.ListIndex = -1 Then
    cbo_InternetGroup.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If

Control = OK

End Function

Private Sub FillLstGroup()
Dim i As Integer
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_Idx As Long

On Error GoTo ErrHandler
  
ReDim InfoList(0)
ll_Idx = 0
lst_Group.Clear

mNumber = C_ERRORRAISE + 288
mSource = C_SCREENNAME & "/FillLstGroup:"

ls_req = "EXEC Grid_WebGroup_t_sel " & QuoteParam(gs_TableCode) & ",'" & gut_LangLogin.Code & "'"
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
    mDesc = "Impossible to fill existing combinations list."
    Err.Raise mNumber, mSource, mDesc
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
    
        ReDim Preserve InfoList(ll_Idx)
        
        InfoList(ll_Idx).GWG_Code = ODBCData(ll_Statement, 1)
        InfoList(ll_Idx).PFG_Code = ODBCData(ll_Statement, 2)
        InfoList(ll_Idx).WebDesc = ODBCData(ll_Statement, 3)
        InfoList(ll_Idx).iConcurrency = ODBCData(ll_Statement, 4)
        InfoList(ll_Idx).BML_Code = ODBCData(ll_Statement, 5)
        InfoList(ll_Idx).SH_Code = ODBCData(ll_Statement, 6)
        InfoList(ll_Idx).PE_Code = ODBCData(ll_Statement, 7)
        InfoList(ll_Idx).PF_Vode = ODBCData(ll_Statement, 8)
        
        lst_Group.AddItem InfoList(ll_Idx).WebDesc
        ll_Idx = ll_Idx + 1
        
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)

Exit Sub

ErrHandler:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Err.Raise mNumber, mSource, mDesc
End Sub
'P592 begin
Private Function DeleteLink(ByVal al_Code As Long, ByVal al_Conc As Long) As Boolean

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

On Error GoTo ErrHandler
DeleteLink = False

ls_req = "EXEC Grid_WebGroup_del " & al_Code & "," & al_Conc
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)
        'Delete failed
        Exit Function
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    End If
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Function
End If
    
DeleteLink = True
Exit Function

ErrHandler:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
End Function
'P592 end
