VERSION 5.00
Begin VB.Form BaseItemPlant_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Item / Plant Maintenance"
   ClientHeight    =   2655
   ClientLeft      =   1080
   ClientTop       =   1995
   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_UnDo 
      Height          =   615
      Left            =   5820
      Style           =   1  'Graphical
      TabIndex        =   5
      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.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_PlantA 
      ForeColor       =   &H00000000&
      Height          =   1620
      Left            =   2160
      TabIndex        =   1
      Top             =   492
      Width           =   2004
   End
   Begin VB.ListBox lst_PlantS 
      ForeColor       =   &H00000000&
      Height          =   1035
      Left            =   5076
      TabIndex        =   0
      Top             =   492
      Width           =   2000
   End
   Begin VB.Label lbl_screen 
      Caption         =   "BI_Plants"
      Height          =   252
      Left            =   288
      TabIndex        =   11
      Top             =   2256
      Visible         =   0   'False
      Width           =   852
   End
   Begin VB.Label lbl_Sap 
      Caption         =   "lbl_Sap"
      Height          =   204
      Left            =   432
      TabIndex        =   8
      Top             =   180
      Width           =   1128
   End
   Begin VB.Label lbl_PlantA 
      Caption         =   "lbl_planta"
      Height          =   204
      Left            =   2148
      TabIndex        =   7
      Top             =   180
      Width           =   1872
   End
   Begin VB.Label lbl_PlantS 
      Caption         =   "lbl_plants"
      Height          =   204
      Left            =   5088
      TabIndex        =   6
      Top             =   180
      Width           =   1872
   End
End
Attribute VB_Name = "BaseItemPlant_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_Plant 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 = UCase(gs_SAPCode)
    lst_PlantA.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_Plants','" & 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_planta": lbl_PlantA = ls_Text
            Case "lbl_plants": lbl_PlantS = 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_PlantS.ListCount - 1
    For k = 0 To mi_Max
        If ms_Name(k) = lst_PlantS.List(j) And lst_PlantS.List(j) <> "" Then
            ReDim Preserve ms_After(j)
            ms_After(j) = ms_Code(k)
            Exit For
        End If
    Next k
Next j
            
'Delete plants
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 PlantDel(ms_Before(j)) Then
            MouseOn
            Exit Sub
        End If
    End If
Next j

'Add new plants
If lst_PlantS.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 PlantIns(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, ls_Perm As String
Dim ll_Statement As Long, li_Big As Integer
Dim li_Status As Integer

    On Error GoTo Permission_Err
    
    ls_req = "EXEC Check_Security Base_item_Plants, " _
            & prg.LoginName
    pic_Save.Visible = KO
    pic_Undo.Visible = KO
    pic_Selected.Visible = KO
    pic_UnSelected.Visible = KO
    lbl_PlantA.Visible = KO
    lst_PlantA.Visible = KO
    li_Big = 0
    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_PlantA.Visible = OK
                lst_PlantA.Visible = OK
                li_Big = 1
        End If
      End If
    Loop
    If li_Big = 0 Then
        pic_quit.Left = pic_quit.Left - 2900
        lbl_PlantS.Left = lbl_PlantS.Left - 2900
        lst_PlantS.Left = lst_PlantS.Left - 2900
        Width = Width - 2900
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
    
Permission_Err:
    StdError
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
End Sub

Private Function PlantIns(as_Mfgp As String) As Boolean
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer

    PlantIns = KO
    
    On Error GoTo PlantIns_Err
    
    ls_req = "EXEC Base_Item_Plants_ins '" _
            & QuoteParam(txt_SAP) & "', '" _
            & as_Mfgp & "', " _
            & gi_BIConcurrency
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        PlantIns = OK
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 4, "Insert failed", gut_LangLogin.Code
    End If
    Exit Function
    
PlantIns_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Function

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

    On Error GoTo FillCombo_Err
    
    ls_req = "EXEC Base_Item_Plants_cbo '" _
                & QuoteParam(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_PlantS.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_PlantS.AddItem ms_Name(i)
                    DelPlant 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

    On Error GoTo FillArray_Err
    
    ls_req = "EXEC Plants_cbo '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_PlantA.Clear
    ReDim ms_Code(0)
    ReDim ms_Name(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_Code(i)
            ReDim Preserve ms_Name(i)
            ms_Code(i) = ODBCData(ll_Statement, 1)
            ms_Name(i) = ODBCData(ll_Statement, 2)
            lst_PlantA.AddItem ms_Name(i)
            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 PlantDel(as_Mfgp As String) As Boolean
Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer

PlantDel = KO
    
On Error GoTo PlantDel_Err
    
ls_req = "EXEC Base_Item_Plants_del '" & QuoteParam(gs_SAPCode) & "','" & as_Mfgp & "'," & gi_BIConcurrency
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    PlantDel = 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
    
PlantDel_Err:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Function

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

Private Sub pic_UnDo_Click()
    MouseOff
    FillArray
    FillCombo
    MouseOn
End Sub

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

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

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

End Sub
