VERSION 5.00
Begin VB.Form BaseItemSupplier_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Item / Supplier Maintenance"
   ClientHeight    =   2655
   ClientLeft      =   975
   ClientTop       =   2445
   ClientWidth     =   7410
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2655
   ScaleWidth      =   7410
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton pic_save 
      Default         =   -1  'True
      Height          =   615
      Left            =   5100
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   1830
      Width           =   675
   End
   Begin VB.CommandButton pic_quit 
      Height          =   615
      Left            =   6540
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   1830
      Width           =   675
   End
   Begin VB.CommandButton pic_UnDo 
      Height          =   615
      Left            =   5820
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   1830
      Width           =   675
   End
   Begin VB.TextBox txt_SAP 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   180
      Locked          =   -1  'True
      MaxLength       =   40
      TabIndex        =   4
      Top             =   492
      Width           =   1680
   End
   Begin VB.PictureBox pic_Selected 
      AutoSize        =   -1  'True
      Height          =   480
      Left            =   4380
      ScaleHeight     =   420
      ScaleWidth      =   420
      TabIndex        =   3
      Top             =   516
      Width           =   480
   End
   Begin VB.PictureBox pic_UnSelected 
      AutoSize        =   -1  'True
      Height          =   480
      Left            =   4380
      ScaleHeight     =   420
      ScaleWidth      =   420
      TabIndex        =   2
      Top             =   1080
      Width           =   480
   End
   Begin VB.ListBox lst_SupplA 
      ForeColor       =   &H00000000&
      Height          =   1620
      ItemData        =   "BI_SUPPL.frx":0000
      Left            =   2160
      List            =   "BI_SUPPL.frx":0002
      TabIndex        =   1
      Top             =   492
      Width           =   2004
   End
   Begin VB.ListBox lst_SupplS 
      ForeColor       =   &H00000000&
      Height          =   1035
      ItemData        =   "BI_SUPPL.frx":0004
      Left            =   5070
      List            =   "BI_SUPPL.frx":000B
      TabIndex        =   0
      Top             =   492
      Width           =   2000
   End
   Begin VB.Label lbl_screen 
      Caption         =   "BI_Suppl"
      Height          =   255
      Left            =   285
      TabIndex        =   11
      Top             =   2250
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Label lbl_Sap 
      Caption         =   "lbl_Sap"
      Height          =   210
      Left            =   435
      TabIndex        =   8
      Top             =   180
      Width           =   1125
   End
   Begin VB.Label lbl_Suppla 
      Caption         =   "lbl_Suppla"
      Height          =   210
      Left            =   2160
      TabIndex        =   7
      Top             =   180
      Width           =   1875
   End
   Begin VB.Label lbl_SupplS 
      Caption         =   "lbl_SupplS"
      Height          =   210
      Left            =   5085
      TabIndex        =   6
      Top             =   180
      Width           =   1875
   End
End
Attribute VB_Name = "BaseItemSupplier_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim ms_Name() As String
Dim ms_SP As String
Dim ms_Code() As String
Dim mi_Max As Integer

' The next 2 arrays contain plant before and after update
Dim ms_Before() As String
Dim ms_After() As String

Private Sub Form_Load()

    On Error GoTo Form_Load_Err
    
    MouseOff
    
    If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

    pic_quit.Picture = LoadResPicture(RES_QUIT, 1)
    pic_Save.Picture = LoadResPicture(RES_OK, 1)
    pic_Selected.Picture = LoadResPicture(RES_RIGHT, 1)
    pic_Undo.Picture = LoadResPicture(RES_CANCEL, 1)
    pic_UnSelected.Picture = LoadResPicture(RES_LEFT, 1)
    Permission
    BaseItem_detail.lst_On_What.Visible = KO
    FillCsts
    txt_SAP = gs_SAPCode
    lst_SupplA.ListIndex = -1
    FillArray
    FillCombo
    MouseOn
    Exit Sub
    
Form_Load_Err:
    StdError
End Sub

Private Sub FillCsts()
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_Field As String, ls_Text As String
   
    On Error GoTo FillCsts_Err
       
    ls_Req = "EXEC Screen_Csts 'bi_suppl', '" _
            & gut_LangLogin.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
            ls_Field = ODBCData(ll_Statement, 1)
            ls_Text = ODBCData(ll_Statement, 2)
            Select Case ls_Field
            Case "lbl_sap": lbl_SAP = ls_Text
            Case "lbl_suppla": lbl_Suppla = ls_Text
            Case "lbl_suppls": lbl_SupplS = ls_Text
            Case "title": Caption = ls_Text
            End Select
        End If
    Loop
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
    
FillCsts_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub

Private Sub pic_Save_Click()
Dim j As Integer, k As Integer
Dim ls_Str1 As String, lb_Del As Boolean, lb_Add As Boolean

On Error GoTo Pic_Save_Click_Err
    
MouseOff
    
' fill array after update
ReDim ms_After(0)
For j = 0 To lst_SupplS.ListCount - 1
    For k = 0 To mi_Max
        If ms_Name(k) = lst_SupplS.List(j) And lst_SupplS.List(j) <> "" Then
            ReDim Preserve ms_After(j)
            ms_After(j) = ms_Code(k)
            Exit For
        End If
    Next k
Next j
            
'Delete supplier
For j = 0 To UBound(ms_Before)
    lb_Del = True
    For k = 0 To UBound(ms_After)
        If ms_Before(j) = ms_After(k) Then
            lb_Del = False
            Exit For
        End If
    Next k
    If lb_Del Then
        If Not SupplierDel(ms_Before(j)) Then
            MouseOn
            Exit Sub
        End If
    End If
Next j

'Add new plants
If lst_SupplS.ListCount <> 0 Then
    For j = 0 To UBound(ms_After)
        lb_Add = True
        For k = 0 To UBound(ms_Before)
            If ms_After(j) = ms_Before(k) Then
                lb_Add = False
                Exit For
            End If
        Next k
        If lb_Add Then
            If Not SupplierIns(ms_After(j)) Then
                Exit Sub
            End If
        End If
    Next j
End If

    MouseOn
    Unload Me
    Exit Sub
    
Pic_Save_Click_Err:
    StdError
End Sub

Private Sub pic_quit_Click()
    MouseOff
    Unload Me
    MouseOn
End Sub

Private Sub Permission()
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_Perm As String
Dim li_Big As Integer

    On Error GoTo Permission_Err
    
    pic_Save.Visible = KO
    pic_Undo.Visible = KO
    pic_Selected.Visible = KO
    pic_UnSelected.Visible = KO
    lbl_Suppla.Visible = KO
    lst_SupplA.Visible = KO
    li_Big = 0
    ls_Req = "EXEC Check_Security 'Base_Item_Suppliers', '" _
            & prg.LoginName & "'"
    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_Perm = ODBCData(ll_Statement, 1)
            If ls_Perm = "Update" Then
                pic_Save.Visible = OK
                pic_Undo.Visible = OK
                pic_Selected.Visible = OK
                pic_UnSelected.Visible = OK
                lbl_Suppla.Visible = OK
                lst_SupplA.Visible = OK
                li_Big = 1
            End If
        End If
    Loop
    If li_Big = 0 Then
        pic_quit.Left = pic_quit.Left - 2900
        lbl_SupplS.Left = lbl_SupplS.Left - 2900
        lst_SupplS.Left = lst_SupplS.Left - 2900
        Width = Width - 2900
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
    
Permission_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub

Private Function SupplierIns(as_Supp As String) As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer

SupplierIns = KO

On Error GoTo SupplierIns_Err

ls_Req = "EXEC Base_Item_Suppliers_ins '" & QuoteParam(txt_SAP) & "', '" & as_Supp & "', " & gi_BIConcurrency
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SupplierIns = OK
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 4, "Insert failed", gut_LangLogin.Code
End If
Exit Function
    
SupplierIns_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Function

Private Sub FillCombo()
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_Str1 As String
Dim i As Integer, j As Integer

On Error GoTo FillCombo_Err

ls_Req = "EXEC Base_Item_Suppliers_cbo '" _
        & gs_SAPCode & "','E'"
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If

i = 0
j = 0
ReDim ms_Before(0)
lst_SupplS.Clear

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_Str1 = ODBCData(ll_Statement, 1)
        For i = 0 To mi_Max
            If ms_Code(i) = ls_Str1 Then
               ReDim Preserve ms_Before(j)
               lst_SupplS.AddItem ms_Name(i)
                DelAvail (ms_Name(i))
                ' fill array before update
                ms_Before(j) = ms_Code(i)
                j = j + 1
            End If
        Next i
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub
    
FillCombo_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub

Private Sub FillArray()
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer, i As Integer
Dim ls_Sourcing As String

    On Error GoTo FillArray_Err
    
    Select Case UCase(BaseItem_detail.txt_ArmstrongCode)
    Case "YES": ls_Sourcing = "Purchased"
    Case "J.V": ls_Sourcing = "J.V"
    Case Else:  ls_Sourcing = ""
    End Select
    ls_Req = "EXEC Suppliers_lst2 '" _
            & ls_Sourcing & "','E'"
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
        li_Status = SQL_SUCCESS
    Else
        li_Status = SQL_ERROR
    End If
    i = 0
    lst_SupplA.Clear
    ReDim ms_Name(0)
    ReDim ms_Code(0)
    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 ms_Name(i)
            ReDim Preserve ms_Code(i)
            ms_Name(i) = ODBCData(ll_Statement, 1)
            lst_SupplA.AddItem ms_Name(i)
            ms_Code(i) = ODBCData(ll_Statement, 2)
            i = i + 1
        End If
    Loop
    mi_Max = i - 1
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
    
FillArray_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Sub

Private Function SupplierDel(as_Supp As String) As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer

SupplierDel = KO

On Error GoTo SupplierDel_Err

ls_Req = "EXEC Base_Item_Suppliers_del '" & QuoteParam(gs_SAPCode) & "','" & as_Supp & "'," & gi_BIConcurrency
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SupplierDel = OK
    gi_BIConcurrency = gi_BIConcurrency + 1
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 7, "Delete failed : concurrency problem ?", gut_LangLogin.Code
End If
Exit Function
    
SupplierDel_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Function

Private Sub pic_Selected_Click()
    MouseOff
    If lst_SupplA.ListIndex = -1 Then
       MouseOn
       Exit Sub
    End If
    lst_SupplS.AddItem lst_SupplA.Text
    lst_SupplA.RemoveItem lst_SupplA.ListIndex
    MouseOn
End Sub

Private Sub pic_UnDo_Click()
    MouseOff
    FillArray
    FillCombo
    MouseOn
End Sub

Private Sub pic_UnSelected_Click()
    MouseOff
    If lst_SupplS.ListIndex = -1 Then
       MouseOn
       Exit Sub
    End If
    lst_SupplA.AddItem lst_SupplS.Text
    lst_SupplS.RemoveItem lst_SupplS.ListIndex
    MouseOn
End Sub

Private Sub DelAvail(ls_Str1 As String)
Dim j As Integer

    For j = 0 To lst_SupplA.ListCount - 1
      If ls_Str1 = lst_SupplA.List(j) Then
        lst_SupplA.RemoveItem j
        Exit Sub
      End If
    Next j

End Sub
