VERSION 5.00
Begin VB.Form BaseItemYear_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   4080
   ClientLeft      =   870
   ClientTop       =   1530
   ClientWidth     =   3810
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4080
   ScaleWidth      =   3810
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txt_SAP 
      ForeColor       =   &H00000000&
      Height          =   288
      Left            =   1644
      Locked          =   -1  'True
      MaxLength       =   40
      TabIndex        =   8
      Top             =   840
      Width           =   1680
   End
   Begin VB.PictureBox pic_Sel_Std 
      AutoSize        =   -1  'True
      Height          =   480
      Left            =   1644
      ScaleHeight     =   420
      ScaleWidth      =   420
      TabIndex        =   7
      Top             =   2292
      Width           =   480
   End
   Begin VB.PictureBox pic_UnSel_Std 
      AutoSize        =   -1  'True
      Height          =   480
      Left            =   1656
      ScaleHeight     =   420
      ScaleWidth      =   420
      TabIndex        =   6
      Top             =   2892
      Width           =   480
   End
   Begin VB.ListBox lst_Yeara 
      ForeColor       =   &H00000000&
      Height          =   1620
      ItemData        =   "BI_YEAR.frx":0000
      Left            =   324
      List            =   "BI_YEAR.frx":000A
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   2016
      Width           =   1116
   End
   Begin VB.ListBox lst_IA_Std 
      ForeColor       =   &H00000000&
      Height          =   1620
      ItemData        =   "BI_YEAR.frx":0013
      Left            =   2328
      List            =   "BI_YEAR.frx":0015
      Sorted          =   -1  'True
      TabIndex        =   4
      Top             =   2004
      Width           =   1032
   End
   Begin VB.PictureBox ssp_Icons 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ClipControls    =   0   'False
      ForeColor       =   &H80000008&
      Height          =   665
      Left            =   0
      ScaleHeight     =   630
      ScaleWidth      =   3780
      TabIndex        =   0
      Top             =   0
      Width           =   3810
      Begin VB.PictureBox pic_quit 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "BI_YEAR.frx":0017
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   1200
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   1
         Top             =   60
         Width           =   480
      End
      Begin VB.PictureBox pic_Save 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "BI_YEAR.frx":0321
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   60
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   3
         Top             =   60
         Width           =   480
      End
      Begin VB.PictureBox pic_UnDo 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   480
         Left            =   600
         ScaleHeight     =   480
         ScaleWidth      =   480
         TabIndex        =   2
         Top             =   60
         Width           =   480
      End
   End
   Begin VB.Label lbl_Sap 
      Caption         =   "SAP code : "
      Height          =   210
      Left            =   360
      TabIndex        =   12
      Top             =   900
      Width           =   1125
   End
   Begin VB.Label lbl_Avail 
      Caption         =   "Available year"
      Height          =   204
      Index           =   0
      Left            =   324
      TabIndex        =   11
      Top             =   1704
      Width           =   1176
   End
   Begin VB.Label lbl_Sel 
      Caption         =   "Selected year"
      Height          =   204
      Index           =   0
      Left            =   2316
      TabIndex        =   10
      Top             =   1704
      Width           =   1032
   End
   Begin VB.Label lbl_Std 
      Alignment       =   2  'Center
      Caption         =   "Standard"
      Height          =   228
      Left            =   636
      TabIndex        =   9
      Top             =   1440
      Width           =   2340
   End
End
Attribute VB_Name = "BaseItemYear_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mi_concurrency As Integer
Dim ms_Std As String
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 suite

pic_save.Visible = KO
pic_UnDo.Visible = KO
pic_Sel_Std.Visible = KO
pic_UnSel_Std.Visible = KO
lbl_Avail(0).Visible = KO
lbl_Sel(0).Visible = KO
lst_Yeara.Visible = KO
li_Big = 0
ls_req = "EXEC Check_Security 'Item_Activity', '" _
            & 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_Sel_Std.Visible = OK
            pic_UnSel_Std.Visible = OK
            lbl_Avail(0).Visible = OK
            lbl_Sel(0).Visible = OK
            lst_Yeara.Visible = OK
            li_Big = 1
        End If
    End If
Loop
If li_Big = 0 Then
    lst_IA_Std.Left = 700
    lbl_Std.Left = 40
    Width = 5720
End If
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

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

On Error GoTo suite

MouseOff

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

pic_save.Picture = LoadResPicture(RES_OK, 1)
pic_quit.Picture = LoadResPicture(RES_QUIT, 1)
pic_UnDo.Picture = LoadResPicture(RES_CANCEL, 1)
pic_Sel_Std.Picture = LoadResPicture(RES_RIGHT, 1)
pic_UnSel_Std.Picture = LoadResPicture(RES_LEFT, 1)
Permission
BaseItem_detail.lst_On_What.Visible = KO
FillCsts
txt_SAP = gs_SAPCode
FillYear
FillList
MouseOn
Exit Sub

suite:
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 suite
   
ls_req = "EXEC Screen_Csts 'Year_Act', " & 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.Caption = ls_Text
        Case "lbl_std": lbl_Std.Caption = ls_Text
        Case "lbl_sel": lbl_Sel(0).Caption = ls_Text
        Case "lbl_avail": lbl_Avail(0).Caption = ls_Text
        Case "form": BaseItemYear_mtnc.Caption = 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

Private Sub pic_Save_Click()

Dim j As Integer

On Error GoTo suite

MouseOff
If BeginTran(gl_Environment, gl_Database) Then
    If YearDel Then
        For j = 0 To lst_IA_Std.ListCount - 1
            ms_Std = lst_IA_Std.List(j)
            If Not YearIns Then
                RollbackTran gl_Environment, gl_Database
                MouseOn
                Exit Sub
            End If
        Next j
        CommitTran gl_Environment, gl_Database
        Unload Me
    Else
        RollbackTran gl_Environment, gl_Database
    End If
End If
MouseOn
Exit Sub

suite:
StdError
End Sub

Private Sub pic_quit_Click()

MouseOff
Unload Me
MouseOn

End Sub
Private Function YearIns() As Boolean

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

YearIns = KO

On Error GoTo suite

ls_req = "EXEC Item_Activity_ins '" _
        & gs_SAPCode & "','" _
        & ms_Std & "'"
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    YearIns = OK
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 4, "Insert failed", gut_LangLogin.Code
End If
Exit Function

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

Dim ls_req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim i As Integer
Dim ls_Str1 As String

On Error GoTo suite

ls_req = "EXEC Item_Activity_lst '" & 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
mi_concurrency = 0
lst_IA_Std.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)
        mi_concurrency = ODBCData(ll_Statement, 2)
        If ls_Str1 > "0000" Then
            lst_IA_Std.AddItem ls_Str1
            DelYear ls_Str1
        End If
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Sub

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

Dim i As Integer
Dim y As Integer
Dim li_Year As Integer

On Error GoTo suite

i = 0
y = 1990
li_Year = Year(Date)
lst_Yeara.Clear
For i = 0 To 20
    lst_Yeara.AddItem y
    If li_Year = y Then
        lst_Yeara.ListIndex = i
    End If
    y = y + 1
Next i
Exit Sub

suite:
StdError
End Sub
Private Function YearDel() As Boolean

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

YearDel = KO

On Error GoTo suite

ls_req = "EXEC Item_Activity_del '" _
        & gs_SAPCode & "', " _
        & mi_concurrency
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_req) Then
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    YearDel = OK
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 7, "Delete failed : concurrency problem ?", gut_LangLogin.Code
End If
Exit Function

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

MouseOff
If lst_Yeara.ListIndex = -1 Then Exit Sub
lst_IA_Std.AddItem lst_Yeara.Text
lst_Yeara.RemoveItem lst_Yeara.ListIndex
MouseOn

End Sub
Private Sub pic_UnDo_Click()

MouseOff
FillYear
FillList
MouseOn

End Sub
Private Sub pic_UnSel_std_Click()

MouseOff
If lst_IA_Std.ListIndex = -1 Then Exit Sub
lst_Yeara.AddItem lst_IA_Std.Text
lst_IA_Std.RemoveItem lst_IA_Std.ListIndex
MouseOn

End Sub
Private Sub DelYear(ls_Str1 As String)

Dim j As Integer

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

End Sub


