VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX"
Begin VB.UserControl DSW 
   ClientHeight    =   13080
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   16245
   ScaleHeight     =   13080
   ScaleWidth      =   16245
   Begin DSWMGR.DC_Sample_lst uc_DC_Sample_lst 
      Height          =   3285
      Left            =   3795
      TabIndex        =   56
      Top             =   1890
      Width           =   9840
      _ExtentX        =   17357
      _ExtentY        =   5794
   End
   Begin VB.Frame frm_sample 
      Caption         =   "Frame1"
      Height          =   5190
      Left            =   4125
      TabIndex        =   53
      Top             =   1155
      Width           =   9675
      Begin DSWMGR.CapSample uc_sample 
         Height          =   4740
         Left            =   285
         TabIndex        =   54
         Top             =   300
         Width           =   8955
         _ExtentX        =   15796
         _ExtentY        =   8361
      End
   End
   Begin VB.Frame fr_main 
      ForeColor       =   &H80000008&
      Height          =   10475
      Left            =   30
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   16200
      Begin VB.Frame fr_detail 
         Height          =   4215
         Left            =   3375
         TabIndex        =   12
         Top             =   6180
         Width           =   12735
         Begin DSWMGR.ArmGrid grd_DetailLine 
            Height          =   2850
            Left            =   7410
            TabIndex        =   66
            Top             =   180
            Width           =   5250
            _ExtentX        =   9260
            _ExtentY        =   5027
         End
         Begin DSWMGR.ArmCombobox cbo_actionType 
            Height          =   345
            Left            =   1800
            TabIndex        =   63
            Top             =   510
            Width           =   1800
            _ExtentX        =   3175
            _ExtentY        =   609
         End
         Begin VB.CommandButton btn_delSample 
            Caption         =   "Remove sample"
            Height          =   300
            Left            =   7410
            TabIndex        =   62
            Tag             =   "DSW58"
            Top             =   3090
            Width           =   1665
         End
         Begin VB.CommandButton btn_addSample 
            Caption         =   "Add sample"
            Height          =   300
            Left            =   9435
            TabIndex        =   61
            Tag             =   "DSW59"
            Top             =   3090
            Width           =   1440
         End
         Begin VB.CheckBox chk_DSW 
            Alignment       =   1  'Right Justify
            Caption         =   "For D.S.W."
            Height          =   255
            Left            =   11010
            TabIndex        =   60
            Tag             =   "DSW60"
            Top             =   3090
            Visible         =   0   'False
            Width           =   1590
         End
         Begin DSWMGR.A_SrchTxt srch_contact 
            Height          =   345
            Left            =   1800
            TabIndex        =   58
            Tag             =   "CNT_name"
            Top             =   885
            Width           =   3225
            _ExtentX        =   5689
            _ExtentY        =   609
         End
         Begin DSWMGR.A_SrchTxt srch_Customer 
            Height          =   345
            Left            =   1800
            TabIndex        =   57
            Tag             =   "CCU_Desc"
            Top             =   1230
            Width           =   3225
            _ExtentX        =   5689
            _ExtentY        =   609
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   5
            Left            =   4620
            Locked          =   -1  'True
            TabIndex        =   14
            Tag             =   "CT_Code"
            Top             =   2700
            Visible         =   0   'False
            Width           =   180
         End
         Begin VB.CommandButton cmd_Update_QTY 
            Caption         =   "Update qty sent from requested"
            Height          =   300
            Left            =   7410
            TabIndex        =   55
            Tag             =   "DSW57"
            Top             =   3090
            Visible         =   0   'False
            Width           =   3465
         End
         Begin VB.CheckBox Sa_Flag 
            Caption         =   "SA"
            Enabled         =   0   'False
            Height          =   255
            Left            =   6600
            TabIndex        =   52
            Tag             =   "DSW15"
            Top             =   480
            Width           =   735
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   13
            Left            =   5880
            Locked          =   -1  'True
            TabIndex        =   50
            Tag             =   "CCU_fax"
            Top             =   2520
            Width           =   1410
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   12
            Left            =   5880
            Locked          =   -1  'True
            TabIndex        =   48
            Tag             =   "CCU_tel"
            Top             =   2160
            Width           =   1410
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   11
            Left            =   3480
            Locked          =   -1  'True
            TabIndex        =   46
            Tag             =   "CT_Desc"
            Top             =   2700
            Width           =   1530
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   10
            Left            =   720
            Locked          =   -1  'True
            TabIndex        =   44
            Top             =   2700
            Width           =   1530
         End
         Begin VB.TextBox dt_bck 
            Height          =   375
            Left            =   120
            TabIndex        =   43
            Top             =   3240
            Visible         =   0   'False
            Width           =   495
         End
         Begin MSComctlLib.ImageCombo cb_status 
            Height          =   330
            Left            =   8160
            TabIndex        =   42
            Top             =   3480
            Visible         =   0   'False
            Width           =   2895
            _ExtentX        =   5106
            _ExtentY        =   582
            _Version        =   393216
            ForeColor       =   -2147483640
            BackColor       =   16777152
            Locked          =   -1  'True
         End
         Begin VB.PictureBox tb_upd 
            Appearance      =   0  'Flat
            AutoRedraw      =   -1  'True
            AutoSize        =   -1  'True
            BackColor       =   &H80000005&
            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          =   615
            Left            =   11160
            ScaleHeight     =   585
            ScaleWidth      =   1380
            TabIndex        =   38
            Top             =   3480
            Visible         =   0   'False
            Width           =   1410
            Begin VB.PictureBox quit_upd 
               Appearance      =   0  'Flat
               BackColor       =   &H00FFFFFF&
               BorderStyle     =   0  'None
               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          =   495
               Left            =   720
               Picture         =   "DSW.ctx":0000
               ScaleHeight     =   495
               ScaleWidth      =   615
               TabIndex        =   40
               Top             =   60
               Width           =   615
            End
            Begin VB.PictureBox valid_upd 
               Appearance      =   0  'Flat
               BackColor       =   &H00FFFFFF&
               BorderStyle     =   0  'None
               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          =   495
               Left            =   120
               Picture         =   "DSW.ctx":030A
               ScaleHeight     =   495
               ScaleWidth      =   615
               TabIndex        =   39
               Top             =   60
               Width           =   615
            End
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   18
            Left            =   1800
            Locked          =   -1  'True
            TabIndex        =   37
            Tag             =   "SR_Name"
            Top             =   180
            Width           =   1800
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   17
            Left            =   5280
            Locked          =   -1  'True
            TabIndex        =   35
            Tag             =   "Z_creator"
            Top             =   1680
            Width           =   1800
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   16
            Left            =   5295
            Locked          =   -1  'True
            TabIndex        =   33
            Tag             =   "Z_creation"
            Top             =   1065
            Width           =   1800
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   3
            Left            =   4680
            Locked          =   -1  'True
            TabIndex        =   30
            Tag             =   "ACT_raisedBy"
            Top             =   480
            Width           =   1800
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   1
            Left            =   4680
            Locked          =   -1  'True
            TabIndex        =   27
            Tag             =   "ACT_dueDate"
            Top             =   180
            Width           =   1800
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   0
            Left            =   9225
            Locked          =   -1  'True
            TabIndex        =   25
            Tag             =   "AC_code"
            Top             =   3825
            Width           =   1800
         End
         Begin VB.TextBox dt 
            Height          =   1095
            Index           =   19
            Left            =   960
            Locked          =   -1  'True
            MaxLength       =   2000
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   22
            Tag             =   "ACT_comment"
            Top             =   3000
            Width           =   6375
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   8
            Left            =   3480
            Locked          =   -1  'True
            TabIndex        =   21
            Tag             =   "CCU_Town"
            Top             =   2340
            Width           =   1530
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   9
            Left            =   1800
            Locked          =   -1  'True
            TabIndex        =   19
            Tag             =   "CCU_zip"
            Top             =   2340
            Width           =   975
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   7
            Left            =   1800
            Locked          =   -1  'True
            TabIndex        =   17
            Tag             =   "CCU_Addr2"
            Top             =   1950
            Width           =   3215
         End
         Begin VB.TextBox dt 
            Alignment       =   1  'Right Justify
            Height          =   315
            Index           =   6
            Left            =   1800
            Locked          =   -1  'True
            TabIndex        =   16
            Tag             =   "CCU_Addr1"
            Top             =   1620
            Width           =   3215
         End
         Begin VB.Label dl 
            Caption         =   "Sub addr."
            Height          =   255
            Index           =   7
            Left            =   120
            TabIndex        =   65
            Tag             =   "DSW07"
            Top             =   2010
            Width           =   1575
         End
         Begin VB.Label dl 
            Caption         =   "Fax"
            Height          =   255
            Index           =   13
            Left            =   5040
            TabIndex        =   51
            Tag             =   "DSW13"
            Top             =   2640
            Width           =   615
         End
         Begin VB.Label dl 
            Caption         =   "Phone"
            Height          =   255
            Index           =   12
            Left            =   5040
            TabIndex        =   49
            Tag             =   "DSW12"
            Top             =   2280
            Width           =   615
         End
         Begin VB.Label dl 
            Caption         =   "Country"
            Height          =   255
            Index           =   11
            Left            =   2400
            TabIndex        =   47
            Tag             =   "DSW11"
            Top             =   2760
            Width           =   975
         End
         Begin VB.Label dl 
            Caption         =   "County"
            Height          =   255
            Index           =   10
            Left            =   120
            TabIndex        =   45
            Tag             =   "DSW10"
            Top             =   2760
            Width           =   615
         End
         Begin VB.Label l_upd 
            Caption         =   "Status"
            Height          =   240
            Left            =   7470
            TabIndex        =   41
            Tag             =   "DSW14"
            Top             =   3495
            Visible         =   0   'False
            Width           =   615
         End
         Begin VB.Label dl 
            Caption         =   "Customer Rep"
            Height          =   315
            Index           =   18
            Left            =   120
            TabIndex        =   36
            Tag             =   "DSW18"
            Top             =   180
            Width           =   1695
         End
         Begin VB.Label dl 
            Caption         =   "Creator"
            Height          =   315
            Index           =   17
            Left            =   5280
            TabIndex        =   34
            Tag             =   "DSW17"
            Top             =   1440
            Width           =   1695
         End
         Begin VB.Label dl 
            Caption         =   "Creation Date"
            Height          =   270
            Index           =   16
            Left            =   5280
            TabIndex        =   32
            Tag             =   "DSW16"
            Top             =   840
            Width           =   1815
         End
         Begin VB.Label dl 
            Caption         =   "Contact"
            Height          =   255
            Index           =   4
            Left            =   120
            TabIndex        =   31
            Tag             =   "DSW04"
            Top             =   930
            Width           =   1575
         End
         Begin VB.Label dl 
            Caption         =   "Raised By"
            Height          =   375
            Index           =   3
            Left            =   3720
            TabIndex        =   29
            Tag             =   "DSW03"
            Top             =   525
            Width           =   855
         End
         Begin VB.Label dl 
            Caption         =   "Action Type"
            Height          =   360
            Index           =   2
            Left            =   120
            TabIndex        =   28
            Tag             =   "DSW02"
            Top             =   525
            Width           =   1695
         End
         Begin VB.Label dl 
            Caption         =   "Due Date"
            Height          =   375
            Index           =   1
            Left            =   3720
            TabIndex        =   26
            Tag             =   "DSW01"
            Top             =   180
            Width           =   975
         End
         Begin VB.Label dl 
            Caption         =   "Action Reference"
            Height          =   225
            Index           =   0
            Left            =   7470
            TabIndex        =   24
            Tag             =   "DSW00"
            Top             =   3885
            Width           =   1695
         End
         Begin VB.Label dl 
            Caption         =   "Comment"
            Height          =   255
            Index           =   19
            Left            =   120
            TabIndex        =   23
            Tag             =   "DSW19"
            Top             =   3000
            Width           =   1575
         End
         Begin VB.Label dl 
            Caption         =   "Town"
            Height          =   255
            Index           =   8
            Left            =   2880
            TabIndex        =   20
            Tag             =   "DSW08"
            Top             =   2400
            Width           =   975
         End
         Begin VB.Label dl 
            Caption         =   "Post Code"
            Height          =   255
            Index           =   9
            Left            =   120
            TabIndex        =   18
            Tag             =   "DSW09"
            Top             =   2400
            Width           =   1575
         End
         Begin VB.Label dl 
            Caption         =   "Address"
            Height          =   255
            Index           =   6
            Left            =   120
            TabIndex        =   15
            Tag             =   "DSW06"
            Top             =   1680
            Width           =   1575
         End
         Begin VB.Label dl 
            Caption         =   "Company"
            Height          =   255
            Index           =   5
            Left            =   120
            TabIndex        =   13
            Tag             =   "DSW05"
            Top             =   1320
            Width           =   1575
         End
      End
      Begin VB.PictureBox tbl 
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         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          =   615
         Left            =   3375
         ScaleHeight     =   585
         ScaleWidth      =   12690
         TabIndex        =   8
         Top             =   195
         Width           =   12720
         Begin VB.PictureBox excel_export 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   4000
            Picture         =   "DSW.ctx":0614
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   68
            Top             =   60
            Width           =   615
         End
         Begin VB.PictureBox print_detail 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   3225
            Picture         =   "DSW.ctx":091E
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   67
            Top             =   60
            Width           =   615
         End
         Begin VB.PictureBox del 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   2445
            Picture         =   "DSW.ctx":0C28
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   64
            Top             =   60
            Width           =   615
         End
         Begin VB.PictureBox add 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   1630
            Picture         =   "DSW.ctx":0F32
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   59
            Top             =   60
            Width           =   615
         End
         Begin VB.PictureBox quit 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   12000
            Picture         =   "DSW.ctx":123C
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   11
            Top             =   60
            Width           =   615
         End
         Begin VB.PictureBox upd 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   840
            Picture         =   "DSW.ctx":1546
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   10
            Top             =   60
            Width           =   615
         End
         Begin VB.PictureBox grd_detail_refresh 
            Appearance      =   0  'Flat
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            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          =   495
            Left            =   120
            Picture         =   "DSW.ctx":1850
            ScaleHeight     =   495
            ScaleWidth      =   615
            TabIndex        =   9
            Top             =   60
            Width           =   615
         End
      End
      Begin VB.Frame fr_tw 
         Height          =   10295
         Left            =   120
         TabIndex        =   2
         Top             =   120
         Width           =   3195
         Begin VB.PictureBox tb 
            Appearance      =   0  'Flat
            AutoRedraw      =   -1  'True
            AutoSize        =   -1  'True
            BackColor       =   &H80000005&
            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          =   615
            Left            =   120
            ScaleHeight     =   585
            ScaleWidth      =   2925
            TabIndex        =   6
            Top             =   120
            Width           =   2955
            Begin VB.PictureBox tw_refresh 
               Appearance      =   0  'Flat
               BackColor       =   &H00FFFFFF&
               BorderStyle     =   0  'None
               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          =   495
               Left            =   120
               Picture         =   "DSW.ctx":1B5A
               ScaleHeight     =   495
               ScaleWidth      =   615
               TabIndex        =   7
               Top             =   60
               Width           =   615
            End
         End
         Begin MSComctlLib.TabStrip tw_tab 
            Height          =   375
            Left            =   120
            TabIndex        =   3
            Top             =   9855
            Width           =   2955
            _ExtentX        =   5212
            _ExtentY        =   661
            MultiRow        =   -1  'True
            Placement       =   1
            TabMinWidth     =   706
            _Version        =   393216
            BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
               NumTabs         =   3
               BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
                  Caption         =   "All"
                  Object.Tag             =   "DSW20"
                  ImageVarType    =   2
               EndProperty
               BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
                  Caption         =   "Oustanding"
                  Object.Tag             =   "DSW21"
                  ImageVarType    =   2
               EndProperty
               BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
                  Caption         =   "Complete"
                  Object.Tag             =   "DSW22"
                  ImageVarType    =   2
               EndProperty
            EndProperty
         End
         Begin DSWMGR.ArmTreeView tw 
            Height          =   9150
            Left            =   120
            TabIndex        =   4
            Top             =   720
            Width           =   2970
            _ExtentX        =   5239
            _ExtentY        =   16140
         End
      End
      Begin DSWMGR.ArmGrid grd_detail 
         Height          =   5400
         Left            =   3375
         TabIndex        =   5
         Top             =   795
         Width           =   12750
         _ExtentX        =   22490
         _ExtentY        =   9525
      End
   End
   Begin MSComctlLib.TabStrip Main_tab 
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   10425
      Width           =   16185
      _ExtentX        =   28549
      _ExtentY        =   661
      Placement       =   1
      TabMinWidth     =   6175
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   4
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Direct to Customers"
            Key             =   "K_1"
            Object.Tag             =   "DSW23"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Bulk Shipment to Munster"
            Key             =   "K_2"
            Object.Tag             =   "DSW24"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Samples management"
            Key             =   "K_3"
            Object.Tag             =   "DSW32"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Samples shipment"
            Key             =   "K_4"
            Object.Tag             =   "DSW49"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "DSW"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" _
                                        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "Kernel32" Alias "GetTempFileNameA" _
                        (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFilename As String) As Long

Const C_GRD_ITEM_ID As Long = 0
Const C_GRD_GROUP_COL As Long = 1
Const C_GRD_DESC_COL As Long = 2
Const C_GRD_QTY_COL As Long = 3
Const C_GRD_HF_COL As Long = 4
Const C_GRD_EdgeDetailDesc_COL As Long = 5
Const C_GRD_Comment_COL As Long = 6
Const C_GRD_QTY_SENT_COL As Long = 7
Const C_GRD_QTY_STOCK_COL As Long = 8
Const C_GRD_MTNC As Long = 9


Private Enum ActionStatus
    AS_COMPLETE = "1"
    AS_OUTSTANDING = "2"
End Enum

Private Enum MoveDirection
    D_Left = 1
    D_Right = 2
    D_up = 3
    D_Down = 4
End Enum

Private mb_AllowAdd As Boolean
Private mb_AllowDel As Boolean
Private mb_AllowUpd As Boolean
Private mb_AllowPrint As Boolean

Private mo_Db As Object
Private ml_cstsCurs As Long  'Armdb cursor
Dim dsw_name As String
Dim dsw_u_code As Long
Public Event quit()
Dim ic As Long
Dim ls_req As String
Dim charset_list As String
Dim Mode As String
Dim label_language As String
Dim count_completion As Long
Dim Logged_user As String
Dim Logged_pwd As String
Dim ms_armstrongUser As String
Dim ml_armstrongUserCode As Long
Dim Use_DSW As Boolean
Private Const GRID_COMMENT_SIZE As Long = 1000  ' must be synchronized with memo length constant in sp selecting into grid
Private Const CH_C = "'"
Private Const CH_LDELIMIT = "®©"
Private mi_CapMouseNumber As Integer
Private ma_CapMouseNumber() As Integer
Private ms_ATG_Desc As String                   ' detail data
Private go_Trace As Object

Public Property Set DB(ByRef ao_db As ARMSYSCOMLib.ArmDb)

    On Error GoTo Db_er
    
    Set mo_Db = ao_db
    
    Exit Property
  
Db_er:
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in property DB", True, True

End Property

Public Function Load_A_COM()
On Error GoTo Load_A_COM_er
    Load_A_COM = False
    Dim j As Long
    count_completion = 0

    Call Load_Language
    
    charset_list = Get_A_Config("CHARSET")
    If Use_DSW Then
        A_MsgBox "Samples Program Version DSW started by " & Logged_user & " Version: " & App.Major & "." & App.Minor & "." & App.Revision, False, False
        ' detect the user for pontalier
        Dim lsa_keys() As String
        lsa_keys = Split(Get_A_Config("EXT_SMP_USERS"), SEP, , vbTextCompare)
        
        Dim ll_i As Long
        For ll_i = LBound(lsa_keys) To UBound(lsa_keys)
            Dim lsa_vals() As String
            lsa_vals = Split(lsa_keys(ll_i), SEP1, , vbTextCompare)
            
            If UCase(lsa_vals(0)) = UCase(Logged_user) Then
                dsw_name = Get_A_Config(lsa_vals(1))
                Exit For
            End If
        Next
        
        If dsw_name = "" Then dsw_name = Get_A_Config("DSWCODE")        ' munster config by default
    Else
        A_MsgBox "Samples Program started at Armstrong by " & Logged_user & " Version: " & App.Major & "." & App.Minor & "." & App.Revision, False, False
        dsw_name = Logged_user
    End If

    Dim ll_Curs As Long
    ls_req = "select GSU.U_CODE from Gen_Systems_Users GSU where GSU.U_Login_name='" & dsw_name & "'"
    ll_Curs = OpenSQLSafe(mo_Db, ls_req)
    dsw_u_code = mo_Db.GetFields(ll_Curs, "U_CODE")
    Call mo_Db.Close(ll_Curs)
    ll_Curs = 0
    
    Call Permission
    
    cb_status.ComboItems.Clear
    ls_req = "select as_code, as_desc from cap_actionstatus where language_code='" & label_language & "'"
    ll_Curs = OpenSQLSafe(mo_Db, ls_req)
    
    j = 1
    While Not mo_Db.EOF(ll_Curs)
        Call cb_status.ComboItems.add(j, SEP & mo_Db.GetFields(ll_Curs, "as_code"), mo_Db.GetFields(ll_Curs, "as_desc"))
        Call mo_Db.Next(ll_Curs)
        j = j + 1
    Wend
    Call mo_Db.Close(ll_Curs)
    ll_Curs = 0

    tw.Load_A_COM
    tw.Language = label_language
    Set tw.ArmDb = mo_Db
    tw.Levels = 2
'    tw.StartDemandLevel = 0
    tw.UseImages = True
    tw.Images = Array(1, 1)
    tw.SelectedImages = Array(2, 2)
    tw.RemoveNodeDuplicity = True


    Set srch_Customer.ArmDb = mo_Db
    srch_Customer.Language = label_language
    
    Set srch_contact.ArmDb = mo_Db
    srch_contact.Language = label_language
    
    Set cbo_actionType.ArmDb = mo_Db
    cbo_actionType.Load_A_COM
    cbo_actionType.FirstBlankItem = False
    cbo_actionType.SearchPrefix = " "

    grd_detail.Load_A_COM
    Set grd_detail.ArmDb = mo_Db
    grd_detail.MultiSelect = False
    grd_detail.AllowExcelExport = False
    grd_detail.ExportTitles = False
    grd_detail.AllowSort = False
    grd_detail.FetchAll = False

    Call grd_detail.SetColumns(Array(Join(Array("AC_code", 1650, 1, "AC_code", ""), SEP) _
                                    , Join(Array("ACT_dueDate", 1300, 0, "ACT_dueDate", "", "Date", "dd\/mm\/yyyy", "Center"), SEP) _
                                    , Join(Array("ACT_raisedBy", 1000, 0, "ACT_raisedBy", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CNT_name", 1500, 0, "CNT_name", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CCU_Desc", 1500, 0, "CCU_Desc", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CCU_Addr1", 1500, 0, "CCU_Addr1", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CCU_Addr2", 1500, 0, "CCU_Addr2", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CCU_Town", 1000, 0, "CCU_Town", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CCU_zip", 800, 0, "CCU_zip", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CTY_Desc", 800, 0, "CTY_Desc", "", "String", "", "Left"), SEP) _
                                    , Join(Array("CT_Desc", 800, 0, "CT_Desc", "", "String", "", "Left"), SEP) _
                                    , Join(Array("Z_creator", 1000, 0, "Z_creator", "", "String", "", "Left"), SEP) _
                                    , Join(Array("Z_creation", 1500, 0, "Z_creation", "", "Date", "dd\/mm\/yyyy", "Center"), SEP) _
                                    , Join(Array("SR_Name", 1000, 0, "SR_Name", "", "String", "", "Left"), SEP) _
                                    , Join(Array("ACT_raisedFor", 0, 0, "ACT_raisedFor", "", "String", "", "Left"), SEP) _
                                    , Join(Array("iConcurrency", 0, 0, "iConcurrency", "", "String", "", "Left"), SEP)))

    If Not grd_detail.LoadConstants(ptStatic, Label(25) & SEP & Label(26) & SEP & Label(28) & SEP & Label(29) & SEP & Label(30) & SEP & Label(31) & SEP & Label(32) & SEP & Label(33) & SEP & Label(34) _
    & SEP & Label(35) & SEP & Label(36) _
    & SEP & Label(44) & SEP & Label(45) & SEP & Label(46) & SEP & "" & SEP & "", ctColumns) Then ' task299.3
        MsgBox ("Error loading constants.")
    End If
    grd_detail.Height = 9650
    
    Call grd_DetailLine_init

    fr_detail.Visible = False
    upd.Visible = False
    del.Visible = False
    print_detail.Visible = False
    add.Visible = mb_AllowAdd
    
    fr_main.Top = 0
    fr_main.Left = 0
    fr_main.Height = 10495
    fr_main.Width = 16200
    fr_main.Visible = True

    Call frm_sample.Move(fr_main.Left, fr_main.Top, fr_main.Width, fr_main.Height)
    frm_sample.Visible = False

    Call uc_sample.Move(10, 10, frm_sample.Width - 20, frm_sample.Height - 20)
    Set uc_sample.DB = mo_Db
    uc_sample.Language_Code = label_language
    uc_sample.Ucode = dsw_u_code    ' 313
    uc_sample.Login = dsw_name      '"D.S.W."
    uc_sample.Load_A_COM



    uc_DC_Sample_lst.Visible = False
    Set uc_DC_Sample_lst.ArmDb = mo_Db
    Call uc_DC_Sample_lst.SetReconnectParams(C_SERVER, C_DB, Logged_user, Logged_pwd, "EXT_SMP")
    uc_DC_Sample_lst.Language_Code = label_language
    uc_DC_Sample_lst.U_Code = dsw_u_code
    uc_DC_Sample_lst.LoginName = dsw_name
    
    lsa_keys = Split(Get_A_Config("EXT_SMP_CONFIG"), SEP, , vbTextCompare)
    
    Dim lb_useBulkShipment As Boolean
    lb_useBulkShipment = False
    
    For ll_i = LBound(lsa_keys) To UBound(lsa_keys)
        lsa_vals = Split(lsa_keys(ll_i), SEP1, , vbTextCompare)
        
        If UCase(lsa_vals(0)) = dsw_name Then
            If lsa_vals(1) <> "" Then
                uc_DC_Sample_lst.DC_Code = lsa_vals(1)  '"P510"                     ' pontalier
                uc_DC_Sample_lst.DC_name = lsa_vals(2)  '"DC Pontalier"
                uc_DC_Sample_lst.DC_Carrier = lsa_vals(3)   ' default currier when creating new DC_Transaction (standalone)
            
                uc_DC_Sample_lst.ShippingDay = Date + 1
                Call uc_DC_Sample_lst.GridRequests("EXEC DC_Samples_t_lst '" & lsa_vals(1) & "', $DATE$, '" & label_language & "', $TT_CODE$", _
                                                    "EXEC DC_Samples_t_lst2 $TRANS_Code$,'" & label_language & "'", _
                                                    "EXEC DC_Transaction_lst_sample '" & lsa_vals(1) & "', $TT_CODE$, $DATE$")
                uc_DC_Sample_lst.GridColumns = Array( _
                                             Join(Array("TRANS_Code", 0, 1, "TRANS_Code", "#TRANS_Code"), SEP) _
                                            , Join(Array("TRUCK_ID", 0, 0, "TRUCK_ID", "#TRUCK_ID", "String"), SEP) _
                                            , Join(Array("MasterDetail", 250, 0, "MasterDetail", "", "BITMAP"), SEP), Join(Array("IsMaster", 0, 0, "IsMaster", "", "INT"), SEP), Join(Array("SubCount", 0, 0, "SubCount", "", "INT"), SEP) _
                                            , Join(Array("iConcurrency", 0, 0, "iConcurrency", "#iConcurrency", "INT"), SEP) _
                                            , Join(Array("Load_Planned_Starting_Time", 600, 0, "Load_Planned_Starting_Time", "#Time", "String"), SEP) _
                                            , Join(Array("CUSTN1", 2400, 0, "CUSTN1", "#ShipToPartnerName", "String"), SEP) _
                                            , Join(Array("Delivery_Date", 1000, 0, "Delivery_Date", "#Delivery_Date", "DATE"), SEP) _
                                            , Join(Array("Ship_To_CT_Code", 450, 0, "Ship_To_CT_Code", "#Ship_To_CT_Code"), SEP) _
                                            , Join(Array("Ship_To_Address", 3100, 0, "Ship_To_Address", "#Ship_To_Address"), SEP) _
                                            , Join(Array("Ship_To_Zip_Code", 1000, 0, "Ship_To_Zip_Code", "#Ship_To_Zip_Code"), SEP) _
                                            , Join(Array("Quantity", 800, 0, "Quantity", "#Quantity"), SEP) _
                                            , Join(Array("Shipment_Number", 1100, 0, "Shipment_Number", "#Shipment_Number"), SEP) _
                                            , Join(Array("CARRIER_Code", 0, 0, "CARRIER_Code", "#CARRIER_Code", "String"), SEP) _
                                            , Join(Array("CARRIER_Name", 0, 0, "CARRIER_Name", "#CARRIER_Name"), SEP) _
                                            , Join(Array("Remark", 1500, 0, "Remark", "#R/S Requirements"), SEP) _
                                            , Join(Array("Cost_Comment", 850, 0, "Cost_Comment", "#Comment"), SEP) _
                                            , Join(Array("PrefLanguage", 0, 0, "PrefLanguage", "#PrefLanguage", "String"), SEP) _
                                            , Join(Array("TT_Code", 0, 0, "TT_Code", "#TT_Code", "String"), SEP), Join(Array("TT_Desc", 1500, 0, "TT_Desc", "#Tran. type", "String"), SEP) _
                                            , Join(Array("Master_TRANS_Code", 0, 0, "Master_TRANS_Code", "#Master_TRANS_Code"), SEP), Join(Array("IsSampleCarrier", 0, 0, "IsSampleCarrier", "IsSampleCarrier", "INT"), SEP) _
                                            )
                uc_DC_Sample_lst.ScreenConstantRequest = "EXEC Screen_Csts 'main_DC_Customer', '" & label_language & "'"
                uc_DC_Sample_lst.SecurityRequest = "EXEC Check_Security 'DC_Transaction', '" & dsw_name & "'"
                uc_DC_Sample_lst.TableName = "DC_Sample"
            
                Call uc_DC_Sample_lst.Load_A_COM
                Call uc_DC_Sample_lst.Move(fr_main.Left, fr_main.Top, fr_main.Width, fr_main.Height)
                Call uc_DC_Sample_lst.MoveX(fr_main.Left, fr_main.Top, fr_main.Width, fr_main.Height)
            End If
            
            lb_useBulkShipment = (lsa_vals(4) = "BULK_YES")
            ms_armstrongUser = lsa_vals(5)                  ' define armstrong user to become requestor for new actions
            ml_armstrongUserCode = lsa_vals(6)
            
            Exit For
        End If
    Next
    
    ' apply security
    If Not lb_useBulkShipment Then
        ' bulk shipment
        Call Main_tab.Tabs.Remove(GetTabIndex(Main_tab, "K_2"))
    End If
    If Not uc_DC_Sample_lst.Initialized Then
        ' remove last tab
        Call Main_tab.Tabs.Remove(GetTabIndex(Main_tab, "K_4"))
    End If
    
    upd.Visible = mb_AllowUpd
    add.Visible = mb_AllowAdd
    del.Visible = mb_AllowDel
    print_detail.Visible = mb_AllowPrint


    Mode = "D" ' By default, we display direct action to customers
    tw_tab.Tabs.Item(2).Selected = True
    Load_A_COM = True
Exit Function
Load_A_COM_er:
    If ll_Curs > 0 Then
        Call mo_Db.Close(ll_Curs)
        ll_Curs = 0
    End If
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function load_A_com", True, True
End Function


Private Function GetTabIndex(ByRef ao_tab As TabStrip, ByVal as_Key As String) As Long
On Error GoTo errhandler
    GetTabIndex = -1
    Dim ll_i As Long
    For ll_i = 1 To ao_tab.Tabs.Count
        If ao_tab.Tabs(ll_i).Key = as_Key Then
            GetTabIndex = ll_i
            Exit For
        End If
    Next
    Exit Function
errhandler:
    Call errorHandler("GetTabIndex")
End Function


Private Function ChangeCharset(ByVal new_country As String) As Boolean
On Error GoTo ChangeCharset_er:
Dim new_charset, pos As Integer
Dim wrk1 As String
ChangeCharset = False
pos = InStr(1, charset_list, "®" & new_country & "®")
If pos > 0 Then
    wrk1 = Left(charset_list, pos - 1)
    new_charset = Mid(wrk1, InStrRev(wrk1, "{") - 3, 3)
Else
    new_charset = 0
End If

Dim lc_Control As Control
    For Each lc_Control In UserControl
        Select Case UCase(TypeName(lc_Control))
        Case "TABSTRIP", "TEXTBOX", "LABEL", "FRAME", "COMMANDBUTTON", _
              "LISTVIEW", "CHECKBOX", "OPTIONBUTTON", _
               "TREEVIEW", "MSHFLEXGRID", "ARMTREEVIEW", "ARMGRID", "IMAGECOMBO", "MSHFLEXGRID"
          lc_Control.Font.Name = "MS Sans Serif"
          lc_Control.Font.Size = 8
          lc_Control.Font.Charset = new_charset
          Case Else
          End Select
    Next
ChangeCharset = True
Exit Function
ChangeCharset_er:
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function ChangeCharSet", True, True
End Function


Private Sub btn_addSample_Click()
On Error GoTo errhandler
    
    If dt(5).Text = "" Then Exit Sub
    
    If cbo_actionType.SelectedItem Is Nothing Then Exit Sub

    Dim lo_frm As Sample_pick
    Set lo_frm = New Sample_pick
    
    Set lo_frm.ArmDb = mo_Db
    lo_frm.Language_Code = label_language
    lo_frm.LoginName = dsw_name
    lo_frm.U_Code = dsw_u_code
    lo_frm.CT_Code = dt(5)
    lo_frm.AT_Code = cbo_actionType.SelectedItem.Key
    
    If chk_DSW.value = vbChecked Then
        lo_frm.SDP_Code = RaisedForStockDepartment(ml_armstrongUserCode)                                   ' todo: from config?
    Else
        lo_frm.SDP_Code = RaisedForStockDepartment(dsw_u_code)
    End If
    
    Call lo_frm.Load_A_COM
    
    Call lo_frm.InitControl
    
    Call lo_frm.Show(vbModal)
    
    If lo_frm.SD_Code <> 0 Then
        ' check if there is item already in the grid
        Dim ll_i As Long
        
        For ll_i = 0 To grd_DetailLine.Rows - 1
            If grd_DetailLine.SearchKey(True, Array(CStr(lo_frm.SD_Code))) Then
                Call MsgBox("This sample exists already.", vbOKOnly)
                GoTo cancelSample
            End If
        Next
        
        ' insert new line
        Call grd_DetailLine.AddLine(Array(lo_frm.SD_Code, lo_frm.SDG_Desc, lo_frm.SD_desc, 1, "H", "", "", 0, lo_frm.SD_Qty, "A"))
        
        grd_DetailLine.DeselectRow
    End If
    
cancelSample:
    Call lo_frm.Unload_A_Com
    
    Set lo_frm = Nothing
    
    Exit Sub
errhandler:
    Call A_MsgBox("Unexpected Error " & Err.Number & " " & Err.Description & " occured in function cmd_Update_QTY_Click", False, True)
End Sub

Private Sub btn_delSample_Click()
On Error GoTo errhandler
    If grd_DetailLine.SelectedCount = 0 Then
        Call SendMessage(2404, "#Please select a row.", label_language, vbOKOnly)
        Exit Sub
    End If
    
    If grd_DetailLine.SelectedLine(0, "MTNC") <> "A" Then Exit Sub      ' only new added can be removed
    
    Call grd_DetailLine.DeleteSelectedLines
    
    Exit Sub
errhandler:
Call A_MsgBox("Unexpected Error " & Err.Number & " " & Err.Description & " occured in function cmd_Update_QTY_Click", False, True)
End Sub

Private Sub cbo_actionType_ComboItemSelected()
On Error GoTo errhandler
    Call grd_DetailLine.ClearGrid
    grd_DetailLine.Requests = ""
    Exit Sub
errhandler:
    Call A_MsgBox("Unexpected Error " & Err.Number & " " & Err.Description & " occured in function cbo_actionType_ComboItemSelected", False, True)
End Sub

Private Sub chk_DSW_Click()
    If chk_DSW.value = vbChecked Then
        ' it is raised for armstrong person -> raised by = logged user group person
'        dt(3).Text = dsw_name
        Call RefreshCKV_StockSample(RaisedForStockDepartment(ml_armstrongUserCode))
    Else
        ' it is raised for logged user group person -> raised by armstrong person
'        dt(3).Text = ms_armstrongUser
        Call RefreshCKV_StockSample(RaisedForStockDepartment(dsw_u_code))
    End If
End Sub

Private Sub cmd_Update_QTY_Click()
On Error GoTo errhandler
    
    Dim ll_Count As Long
    For ll_Count = 0 To grd_DetailLine.Rows - 1
        grd_DetailLine.Row = ll_Count
        
        grd_DetailLine.SelectedLine(0, "ASD_qty_sent") = grd_DetailLine.SelectedLine(0, "ASD_qty")
        If grd_DetailLine.SelectedLine(0, "MTNC") = "" Then grd_DetailLine.SelectedLine(0, "MTNC") = "U"
    Next
    
    Exit Sub
errhandler:
    Call A_MsgBox("Unexpected Error " & Err.Number & " " & Err.Description & " occured in function cmd_Update_QTY_Click", False, True)
End Sub

Private Sub del_Click()
On Error GoTo errhandler
    If grd_detail.SelectedCount = 0 Then Exit Sub
    
    If grd_detail.CurrentKey(0) <> dt(0).Text Then Exit Sub
    
    If tw_tab.SelectedItem Is Nothing Then Exit Sub
    
    ' check if action is still outstanding and if the creator and logged user is the same
    If tw_tab.SelectedItem.Index <> 2 Then Exit Sub
    
    If UCase(grd_detail.CurrentLine("Z_Creator")) <> UCase(Logged_user) Then
        Call MsgBox("To delete the action you have to be creator!", vbInformation)
        Exit Sub
    End If
    
    
    If MsgBox("Do you want to delete selected line?", vbYesNo) = vbNo Then Exit Sub
    
Const CREQ As String = "EXEC Cap_Action_del $AC_CODE$, $CCU_CAPKEY$, $ICONC$"
    Dim ls_req As String
    
    ls_req = Replace(CREQ, "$AC_CODE$", SqlStr(grd_detail.CurrentKey(0), 16), , , vbTextCompare)
    ls_req = Replace(ls_req, "$CCU_CAPKEY$", SqlStr(srch_Customer.Key1, 16), , , vbTextCompare)
    ls_req = Replace(ls_req, "$ICONC$", SQLNum(grd_detail.CurrentLine("iConcurrency")), , , vbTextCompare)
    
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req, 1)
    
    Dim ll_retVal As Long
    ll_retVal = mo_Db.GetFields(ll_Cursor, 0)
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    If ll_retVal < 0 Then
        If ll_retVal = -6 Then
            Call MsgBox("Deletition was not sucessfull! Another user has updated the action. Please refresh the grid and try again.", vbInformation)
        Else
            Call MsgBox("Deletition was not sucessfull! return code:" & ll_retVal, vbInformation)
        End If
    Else
        ' refresh the grid
        grd_detail.Refresh
    End If
    
    Exit Sub
errhandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call A_MsgBox("Unexpected Error " & Err.Number & " " & Err.Description & " occured in function del_Click", False, True)
End Sub

Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property

Private Sub LoadDetail(ByVal as_ac_code As String)
On Error GoTo errhandler
Const CREQ As String = "EXEC Cap_Action_ext_sel $AC_Code$, $LANG$"
Const CREQD As String = "Cap_Action_ext_samples_lst $AC_CODE$, $SDP_CODE$, $LANG$"

    Dim ls_req As String
    
    ls_req = Replace(CREQ, "$AC_Code$", SqlStr(as_ac_code, 16), , , vbTextCompare)
    ls_req = Replace(ls_req, "$LANG$", SqlStr(label_language, 1), , , vbTextCompare)
    
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    Dim lo_ctrl As TextBox
    
    For Each lo_ctrl In dt
        If lo_ctrl.Tag <> "" Then
            lo_ctrl.Text = mo_Db.GetFields(ll_Cursor, lo_ctrl.Tag)
        Else
            lo_ctrl.Text = ""
        End If
    Next
    
    ic = mo_Db.GetFields(ll_Cursor, "iConcurrency")
    
    Call cbo_actionType.Clear
    cbo_actionType.Request = "EXEC cap_actiontype_cbo_SAMPLE " & SqlStr(mo_Db.GetFields(ll_Cursor, "CT_Code")) & ",'" & label_language & "'"
    Call cbo_actionType.AddItem(Array(mo_Db.GetFields(ll_Cursor, "AT_Code"), mo_Db.GetFields(ll_Cursor, "AT_Desc")), True)
    cbo_actionType.Enabled = False
    
    
    srch_Customer.Clear
    srch_Customer.Key1 = mo_Db.GetFields(ll_Cursor, "CCU_CapKey")
    srch_Customer.Text = mo_Db.GetFields(ll_Cursor, "CCU_Desc")
    srch_Customer.CodeProject = mo_Db.GetFields(ll_Cursor, "SP_CapKey")
    srch_Customer.TypeSearch = "Customer"
    srch_Customer.Enabled = False
    
    srch_contact.Clear
    srch_contact.CodeProject = mo_Db.GetFields(ll_Cursor, "SP_CapKey")
    srch_contact.CodeContact = mo_Db.GetFields(ll_Cursor, "CNT_Code")
    srch_contact.CodeCustomer = mo_Db.GetFields(ll_Cursor, "CCU_CapKey")
    srch_contact.TypeSearch = "Contact"
    srch_contact.Key1 = mo_Db.GetFields(ll_Cursor, "CNT_Code")
    srch_contact.Text = mo_Db.GetFields(ll_Cursor, "CNT_name")
    srch_contact.Enabled = False
    
    btn_addSample.Visible = False
    btn_delSample.Visible = False
    
    If mo_Db.GetFields(ll_Cursor, "CCU_saflag") = "" Then Sa_Flag.value = 0 Else Sa_Flag.value = 1

    ms_ATG_Desc = mo_Db.GetFields(ll_Cursor, "ATG_Desc")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    chk_DSW.value = vbUnchecked              ' loading only for logged user

    Call grd_DetailLine.ClearGrid
    
    ls_req = Replace(CREQD, "$AC_Code$", SqlStr(as_ac_code, 16), , , vbTextCompare)
    ls_req = Replace(ls_req, "$LANG$", SqlStr(label_language, 1), , , vbTextCompare)
    ls_req = Replace(ls_req, "$SDP_CODE$", RaisedForStockDepartment(dsw_u_code), , , vbTextCompare)
    
    If Not grd_DetailLine.Load(ls_req, True) Then
        MsgBox ("Error loading detail!!")
    End If
    
    Exit Sub
errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
End Sub



Private Sub grd_detail_Click()
On Error GoTo grd_detail_Click_er
    Call LockScreen(True)
    
    upd.Visible = (tw_tab.SelectedItem.Index = 2) And mb_AllowUpd
    del.Visible = (tw_tab.SelectedItem.Index = 2) And mb_AllowDel
    print_detail.Visible = mb_AllowPrint
    
    If grd_detail.SelectedCount = 0 Then
        upd.Visible = False
        del.Visible = False
        print_detail.Visible = False
        Call LockScreen(False)
        Exit Sub
    End If
    
    Call LoadDetail(grd_detail.SelectedKey(0)(0))
    
    grd_detail.Height = 5400
    fr_detail.Visible = True
    Call LockScreen(False)
Exit Sub
grd_detail_Click_er:
    Call LockScreen(False)
    Screen.MousePointer = 0
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function grd_detail_Click", True, True

End Sub


Private Sub add_init()
On Error GoTo errhandler

    Dim i As Integer
    Dim j As Long
    
    ' init samples list
    Call grd_DetailLine.ClearGrid
    grd_DetailLine.Requests = ""
    
    grd_detail.Visible = False
    
    srch_Customer.Clear
    srch_Customer.Key1 = ""
    srch_Customer.Text = ""
    srch_Customer.CodeProject = ""
    srch_Customer.CodeCustomerRequired = True
    srch_Customer.TypeSearch = "Customer"
    
    srch_contact.Clear
    srch_contact.CodeProject = ""
    srch_contact.CodeContact = ""
    srch_contact.CodeCustomer = ""
    srch_contact.CodeCustomerRequired = True
    srch_contact.TypeSearch = "Contact"
    srch_contact.Key1 = ""
    srch_contact.Text = ""
    
    Call cbo_actionType.Clear
    cbo_actionType.Request = ""
    
    
    Sa_Flag.value = vbUnchecked
    dt(0).Text = ""                                     ' action code AC_Code
    dt(1).Text = Format(Now(), "DD\/MM\/YYYY")          ' action date
'    dt(2).Text = "Sample"                               ' action type
    dt(3).Text = dsw_name                               ' raised by
    dt(5).Text = ""                                     ' CT_Code
    dt(6).Text = ""                                     ' customer addr1
    dt(7).Text = ""                                     ' customer addr2
    dt(8).Text = ""                                     ' customer town
    dt(9).Text = ""                                     ' customer zip
    dt(10).Text = ""                                    ' customer county
    dt(11).Text = ""                                    ' customer country
    dt(12).Text = ""                                    ' customer phone
    dt(13).Text = ""                                    ' customer fax
    dt(16).Text = Format(Now(), "DD\/MM\/YYYY")         ' creation date
    dt(17).Text = UCase(Logged_user)                    ' creator
    dt(18).Text = ""                                    ' customer rep
    dt(19).Text = ""                                    ' comment

    chk_DSW.value = vbUnchecked
    ms_ATG_Desc = "Dispatch"
    
'    grd_DetailLine.Clear
    grd_detail.Height = 5400
    grd_detail.Visible = True
    fr_detail.Visible = True
    Exit Sub
errhandler:
    Screen.MousePointer = 0
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function add_init", True, True

End Sub


Private Sub grd_detail_refresh_Click()
    If tw.SelectedItem Is Nothing Then Exit Sub
    Call tw_NodeClick(tw.Nodes(tw.SelectedItem.Index))
End Sub


Private Sub grd_detail_RowLoaded(ByVal al_row As Long)
On Error GoTo errhandler
Static ll_Color As Long

    If al_row = 0 Then
        ll_Color = &HC0FFC0
    Else
        Debug.Assert (al_row > 0)
    
        If grd_detail.Data(al_row, "AC_Code") <> grd_detail.Data(al_row - 1, "AC_Code") Then
            ll_Color = IIf(ll_Color = &HC0FFC0, &HFFC0FF, &HC0FFC0)
        End If
    End If
    
    grd_detail.LineColor(al_row) = ll_Color
    
    Exit Sub
errhandler:
End Sub

Private Sub grd_DetailLine_Click()
    On Error GoTo Trace_Err
    
    If upd.Enabled Then Exit Sub
    
    If grd_DetailLine.SelectedCount = 0 Then Exit Sub
    
    If RaisedForStockDepartment(dsw_u_code) = 0 Then Exit Sub
    
    If dt(0).Text = "" Then
        ' add mode
        If grd_DetailLine.Col <= C_GRD_DESC_COL Then Exit Sub       ' when clicked on group or sample desc
        
        Select Case grd_DetailLine.Col
            Case C_GRD_QTY_SENT_COL, C_GRD_EdgeDetailDesc_COL
                grd_DetailLine.Col = C_GRD_QTY_COL
            Case C_GRD_QTY_STOCK_COL, C_GRD_ITEM_ID, C_GRD_MTNC
                grd_DetailLine.Col = C_GRD_Comment_COL
        End Select
    Else
        'update mode
        If grd_DetailLine.Col <> C_GRD_Comment_COL Then
            grd_DetailLine.Col = C_GRD_QTY_SENT_COL
        End If
    End If

    If UpdateSampleListItem(grd_DetailLine.Row, grd_DetailLine.Columns(grd_DetailLine.Col).Name) Then
'        Call ckv_Sample_ItemLoaded(ckv_Sample.SelectedItem)
    End If
 
    Exit Sub
Trace_Err:
End Sub

Private Sub print_detail_Click()
On Error GoTo errorHandler
    
    If grd_detail.SelectedCount = 0 Then
        Call SendMessage(2404, "#Please select a row.", label_language, vbOKOnly)
        Exit Sub
    End If

    If grd_detail.CurrentKey(0) <> dt(0).Text Then Exit Sub
    
    If tw_tab.SelectedItem Is Nothing Then Exit Sub
    
    ' check if action is still outstanding and if the creator and logged user is the same
'    If tw_tab.SelectedItem.Index <> 2 Then Exit Sub
    
    If grd_detail.SelectedLine(0, "ACT_raisedFor") <> dsw_name Then
        Call SendMessage(995, "#Action is not raised for logged user.", label_language, vbOKOnly)
        Exit Sub
    End If
    
    
    Call PrintFromTemplate
    
    Exit Sub
errorHandler:
    Call MsgBox("Error:" & Err.Description & vbCrLf & Err.Source)
End Sub

Private Sub excel_export_Click()
On Error GoTo errorHandler
    If tw_tab.SelectedItem Is Nothing Then Exit Sub
    
'    If tw_tab.SelectedItem.Index <> 2 Then
'        Call SendMessage(996, "#Export is not supported for this filters.", label_language, vbOKOnly)
'        Exit Sub
'    End If
    
    If tw.SelectedItem Is Nothing Then
        Call SendMessage(997, "#Please select a node.", label_language, vbOKOnly)
        Exit Sub
    End If
    
    If tw.SelectedItem.Tag.ml_Level = 0 Then
        Call SendMessage(997, "#Please select a node.", label_language, vbOKOnly)
        Exit Sub
    End If
    
    Call Exportexcell
    
    Exit Sub
errorHandler:
    Call MsgBox("Error:" & Err.Description & vbCrLf & Err.Source)
End Sub

Private Sub quit_Click()
On Error GoTo errorHandler
    Call Quit_program
    Exit Sub
errorHandler:
    End
End Sub


Private Sub quit_upd_Click()
    dt(19).BackColor = &H80000005
    dt(19) = dt_bck
    ic = grd_detail.CurrentLine("iConcurrency")
    If dt(0).Text = "" Then
        ' it is action add
        chg_to_add (False)
        Call grd_detail_Click
        Exit Sub
    Else
        chg_to_upd (False)
    End If
End Sub



Private Sub Main_tab_Click()
On Error GoTo Main_tab_Click_er
    Dim current_mode As String
    current_mode = Mode
    Select Case Main_tab.SelectedItem.Key
    Case "K_1":
        Mode = "D"  ' Direct to customers
    Case "K_2"
        Mode = "B"  ' Bulk delivery to DC
    Case "K_3"
        Mode = ""
        fr_main.Visible = False
        uc_DC_Sample_lst.Visible = False
        frm_sample.Visible = True
        Exit Sub
    Case "K_4"
        Mode = ""
        fr_main.Visible = False
        frm_sample.Visible = False
        
Static sb_datainitialized As Boolean
        
        If Not sb_datainitialized Then
            If Not uc_DC_Sample_lst.Initialized Then
                Call MsgBox("You do not have rights to access this application. Please contact your IT support.")
                Call uc_DC_Sample_lst.Unload_A_Com
                Exit Sub
            End If
    
            Call uc_DC_Sample_lst.InitControl
            sb_datainitialized = True
        End If
        
        
        uc_DC_Sample_lst.Visible = True
        Exit Sub
    End Select
    If current_mode <> Mode Then  ' Detect if mode has really changed
        uc_DC_Sample_lst.Visible = False
        frm_sample.Visible = False
        fr_main.Visible = True
        Raz_Detail
        fr_detail.Visible = False
        grd_detail.Height = 9650
        tw_tab_Click
    End If
Exit Sub
Main_tab_Click_er:
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function Main_tab_Click", True, True

End Sub

Private Sub srch_Customer_OnClick()
'    If srch_Customer.CodeCustomer = "" Then
        Dim ls_custIdf As String
        Dim lo_form As FilterDlg
        
        Set lo_form = New FilterDlg
        
        Set lo_form.ArmDb = mo_Db
        lo_form.Language_Code = label_language
        lo_form.U_Code = dsw_u_code
        lo_form.FilterValue = Replace(srch_Customer.CodeCustomer, "%", "", , , vbTextCompare)
        lo_form.SQLCondition = Replace(srch_Customer.CodeCustomer, lo_form.FilterValue, "$val$", , , vbTextCompare)
        
        
        Call lo_form.Load_A_COM
        
        Call lo_form.Show(vbModal)
        
        If Len(lo_form.FilterValue) < 3 Then
            srch_Customer.CodeCustomer = "%%"       ' to indicate quiet exit
            Exit Sub
        End If
        
        ' search in db to get customer key
        srch_Customer.CodeCustomer = Replace(lo_form.SQLCondition, "$val$", lo_form.FilterValue, , , vbTextCompare)
        
        Call Unload(lo_form)
        Set lo_form = Nothing
        
        
'    End If
End Sub

Private Sub srch_Customer_OnDelete()
    srch_Customer.CodeCustomer = ""
    srch_contact.CodeCustomer = ""
    srch_contact.Clear
    Call Clear_CustomerInfo
End Sub

Private Sub srch_Customer_OnValid()
    ' update customer key into contact
    If srch_contact.CodeCustomer <> srch_Customer.Key1 Then
        srch_contact.CodeCustomer = srch_Customer.Key1
        
        Dim ls_oldCT_Code As String
        ls_oldCT_Code = dt(5).Text
        
        Call Load_CustomerInfo(srch_Customer.Key1)
        
        If ls_oldCT_Code <> dt(5).Text Then
            ' clear the list of samples
            Call grd_DetailLine.ClearGrid
            grd_DetailLine.Requests = ""

            Dim ls_oldKey As String
            Dim ls_oldDesc As String
            
            If Not cbo_actionType.SelectedItem Is Nothing Then
                ls_oldKey = cbo_actionType.SelectedItem.Key
                ls_oldDesc = cbo_actionType.SelectedItem.DisplayText
            End If
            
            cbo_actionType.Clear
            cbo_actionType.Request = "EXEC cap_actiontype_cbo_SAMPLE " & "'" & dt(5).Text & "', '" & label_language & "'"
            
            If ls_oldKey <> "" Then
                Call cbo_actionType.AddItem(Array(ls_oldKey, ls_oldDesc), True)
            Else
                ' load the combo and set at_code=7 (Samples)
                Call cbo_actionType.Load
                Call cbo_actionType.SearchItem(7, "AT_Code")
            End If

        End If
        
    End If
    
End Sub


Private Sub tw_tab_Click()
On Error GoTo tw_tab_Click_er
    Dim Request As String
    grd_detail.ClearGrid
    grd_detail.Height = 9650
    Call grd_DetailLine.ClearGrid
    fr_detail.Visible = False
    If Mode = "D" Then
        Request = "CapTv_Action_dsw_direct_Lx"
    Else
        Request = "CapTv_Action_dsw_Bulk_Lx"
    End If

    Select Case tw_tab.SelectedItem.Index
    Case 1:
        upd.Visible = False
        del.Visible = False
        print_detail.Visible = mb_AllowPrint
'        grd_detail.AllowExcelExport = False
        Call tw.Clear
        tw.NodeRequests = Array(Replace(Request, "_Lx", "_L0", , , vbTextCompare) & " 'E',Null,'" & dsw_name & "'", _
                                Replace(Request, "_Lx", "_L1", , , vbTextCompare) & " 'E',Null,$1$,'" & dsw_name & "'")
        Call tw.LoadTree(LoadTypeChildsDemand)
    Case 2:
        Call tw.Clear
'        grd_detail.AllowExcelExport = true
        tw.NodeRequests = Array(Replace(Request, "_Lx", "_L0", , , vbTextCompare) & " 'E',2,'" & dsw_name & "'", _
                                Replace(Request, "_Lx", "_L1", , , vbTextCompare) & " 'E',2,$1$,'" & dsw_name & "'")
        Call tw.LoadTree(LoadTypeChildsDemand)
    Case 3:
        upd.Visible = False
        del.Visible = False
        print_detail.Visible = mb_AllowPrint
'        grd_detail.AllowExcelExport = False
        Call tw.Clear
        tw.NodeRequests = Array(Replace(Request, "_Lx", "_L0", , , vbTextCompare) & " 'E',1,'" & dsw_name & "'", _
                                Replace(Request, "_Lx", "_L1", , , vbTextCompare) & " 'E',1,$1$,'" & dsw_name & "'")
        Call tw.LoadTree(LoadTypeChildsDemand)
    Case 4:
    End Select

    Exit Sub
tw_tab_Click_er:
    Screen.MousePointer = 0
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function tw_tab_Click", True, True
End Sub


Private Sub tw_refresh_Click()
tw_tab_Click
End Sub


Private Sub tw_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo tw_Click_er
    If tw.SelectedItem Is Nothing Then
        upd.Visible = False
        del.Visible = False
        print_detail.Visible = False
        Exit Sub
    End If
    
    If Node.Tag.ml_Level = 0 Then
        print_detail.Visible = False
        Exit Sub
    End If
    Call LockScreen(True)

    Call ChangeCharset(Node.Tag.GetData(0))
    
    Dim i As Long
    Dim ac_status, Request As String
    fr_detail.Visible = False
    upd.Visible = False
    del.Visible = False
    print_detail.Visible = False
    If Mode = "D" Then
        Request = "Cap_Action_ext_direct"
    Else
        Request = "Cap_Action_ext_Bulk"
    End If
    Select Case tw_tab.SelectedItem.Index
        Case 1: ac_status = "Null"
        Case 2: ac_status = "2"
        Case 3: ac_status = "1"
    End Select
    
    Dim prv As String
    grd_detail.Visible = False
    grd_detail.ClearGrid
    
    Call grd_detail.Load(Request & " 'E'," & ac_status & ",'" & Node.Tag.GetData(0) & "','" & dsw_name & "','" & Node.Tag.GetData(1) & "'", (tw_tab.SelectedItem.Index = 2))
    
    prv = ""
    grd_detail.Height = 9650
    grd_detail.Visible = True
    Call LockScreen(False)
    Exit Sub
tw_Click_er:
    Call LockScreen(False)
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function tw_Click", True, True
End Sub

Private Sub grd_DetailLine_init()
On Error GoTo grd_DetailLine_init_er

    grd_DetailLine.Load_A_COM
    grd_DetailLine.MultiSelect = False
    grd_DetailLine.AllowExcelExport = True
    grd_DetailLine.ExportTitles = True
    grd_DetailLine.AllowSort = False
    grd_DetailLine.FreeSelect = True
    Set grd_DetailLine.ArmDb = mo_Db
    grd_DetailLine.FetchAll = True
    grd_DetailLine.Title = "Detail lines"

    Call grd_DetailLine.SetColumns(Array(Join(Array("SD_Code", 0, 1, "SD_Code", "", "String", "", "Left"), SEP) _
                                    , Join(Array("SDG_Desc", 1000, 0, "SDG_Desc", "", "String", "", "Left"), SEP) _
                                    , Join(Array("SD_Desc", 1900, 0, "SD_Desc", "", "String", "", "Left"), SEP) _
                                    , Join(Array("ASD_qty", 500, 0, "ASD_qty", "", "int", "", "Left"), SEP) _
                                    , Join(Array("handorfullflag", 500, 0, "handorfullflag", "", "String", "", "Left"), SEP) _
                                    , Join(Array("PE_Desc", 500, 0, "PE_Desc", "", "String", "", "Left"), SEP) _
                                    , Join(Array("ASD_comment", 2500, 0, "ASD_comment", "", "String", "", "Left"), SEP) _
                                    , Join(Array("ASD_qty_sent", 700, 0, "ASD_qty_sent", "", "INT", "", "Left"), SEP) _
                                    , Join(Array("SD_Qty", 700, 0, "SD_Qty", "", "INT", "", "Left"), SEP) _
                                    , Join(Array("MTNC", 0, 0, "MTNC", "", "STRING", "", "Left"), SEP)))

    If Not grd_DetailLine.LoadConstants(ptStatic, "" & SEP & Label(50) & SEP & Label("DSW40") & SEP & Label(51) & SEP & Label(52) & SEP & Label(53) & SEP & Label(54) & SEP & Label(55) & SEP & Label(56) & SEP & "", ctColumns) Then
        MsgBox ("Error loading constants.")
    End If

Exit Sub
grd_DetailLine_init_er:
    Screen.MousePointer = 0
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function grd_DetailLine_init", True, True
End Sub

Private Sub uc_DC_Sample_lst_quit()
    Quit_program
End Sub

Private Sub uc_sample_quit()
    Quit_program
End Sub

Private Sub upd_Click()
    If grd_detail.SelectedCount = 0 Then
        Call SendMessage(2404, "#Please select a row.", label_language, vbOKOnly)
        Exit Sub
    End If

    If grd_detail.CurrentKey(0) <> dt(0).Text Then Exit Sub
    
    If tw_tab.SelectedItem Is Nothing Then Exit Sub
    
    ' check if action is still outstanding and if the creator and logged user is the same
    If tw_tab.SelectedItem.Index <> 2 Then Exit Sub
    
    If grd_detail.SelectedLine(0, "ACT_raisedFor") <> dsw_name Then
        Call SendMessage(995, "#Action is not raised for logged user.", label_language, vbOKOnly)
        Exit Sub
    End If
    
    dt(19).BackColor = &HFFFFC0
    dt_bck = dt(19)
    Call chg_to_upd(True)
    
    If dt(3).Text = dsw_name Then
        ' you can send it back to DSW if it is a reply
        chk_DSW.Visible = True
    End If
    
End Sub

Private Sub add_Click()
    dt(19).BackColor = &HFFFFC0
    dt_bck = dt(19)
    Call chg_to_add(True)
    Call add_init
End Sub

Private Function chg_to_add(ByVal v As Boolean)
On Error GoTo Chg_to_upd_er
    Dim i As Integer
    Main_tab.Enabled = Not (v)
    grd_detail.Enabled = Not (v)
    fr_tw.Enabled = Not (v)
    tw_tab.Enabled = Not (v)
    tw_refresh.Enabled = Not (v)
    grd_detail_refresh.Enabled = Not (v)
    upd.Enabled = Not (v)
    add.Enabled = Not (v)
    quit.Enabled = Not (v)
    upd.Visible = Not (v) And mb_AllowUpd
    del.Visible = Not (v) And mb_AllowDel
    print_detail.Visible = Not (v) And mb_AllowPrint
    add.Visible = Not (v) And mb_AllowAdd
    l_upd.Visible = v
    cb_status.Visible = v
    tb_upd.Visible = v
    chk_DSW.Visible = v
    cb_status.Enabled = Not v
    
    cmd_Update_QTY.Visible = False
    btn_addSample.Visible = v
    btn_delSample.Visible = v


    srch_contact.Enabled = v
    srch_Customer.Enabled = v
    cbo_actionType.Enabled = v


    dt(19).Locked = Not (v)

    Set cb_status.SelectedItem = Nothing
    If v = False Then
        cb_status.Text = ""
    Else
    
    For i = 1 To cb_status.ComboItems.Count
        Set cb_status.SelectedItem = cb_status.ComboItems.Item(i)
        If cb_status.SelectedItem.Key = SEP & "2" Then Exit For
    Next i
End If

Exit Function
Chg_to_upd_er:
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function Chg_to_add", True, True
End Function



Private Function chg_to_upd(ByVal v As Boolean)
On Error GoTo Chg_to_upd_er
    Dim i As Integer
    
    Main_tab.Enabled = Not (v)
    grd_detail.Enabled = Not (v)
    fr_tw.Enabled = Not (v)
    tw_tab.Enabled = Not (v)
    tw_refresh.Enabled = Not (v)
    grd_detail_refresh.Enabled = Not (v)
    upd.Enabled = Not (v)
    add.Enabled = Not (v)
    quit.Enabled = Not (v)
    upd.Visible = Not (v) And mb_AllowUpd
    del.Visible = Not (v) And mb_AllowDel
    print_detail.Visible = Not (v) And mb_AllowPrint
    add.Visible = Not (v) And mb_AllowAdd
    l_upd.Visible = v
    cb_status.Visible = v
    tb_upd.Visible = v
    dt(19).Locked = Not (v)
    chk_DSW.Visible = False
    
    cmd_Update_QTY.Visible = v
    btn_addSample.Visible = False
    btn_delSample.Visible = False

    srch_contact.Enabled = False
    srch_Customer.Enabled = False
    cbo_actionType.Enabled = False

    If v = False Then
        Set cb_status.SelectedItem = Nothing
        cb_status.Text = ""
    Else
        Set cb_status.SelectedItem = Nothing
        For i = 1 To cb_status.ComboItems.Count
            Set cb_status.SelectedItem = cb_status.ComboItems.Item(i)
            If cb_status.SelectedItem.Key = SEP & "2" Then Exit For
        Next i
    End If

Exit Function
Chg_to_upd_er:
    Screen.MousePointer = 0
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function Chg_to_upd", True, True
End Function



Public Sub Unload_A_Com()
    grd_detail.Unload_A_Com
    tw.Unload_A_Com
    
    If ml_cstsCurs > 0 Then
        Call mo_Db.Close(ml_cstsCurs)
        ml_cstsCurs = 0
    End If
    
End Sub

Private Sub Add_db()
Const REQ_memo_ins = "EXEC Cap_Memo_ins 'E', $Comment_desc$, $Comment$, 'N', 'N', Null, '$AC_CODE$', '', 2, 0, '$MEM_Code$'"
Dim lb_InTran As Boolean
    lb_InTran = False

On Error GoTo errhandler
    If srch_Customer.Key1 = "" Then
        Call ASC_SendMessage(mo_Db, label_language, 266, "#Missing Data in compulsory field.")
        Call srch_Customer.SetFocus
        Exit Sub
    End If
    
    If cbo_actionType.SelectedItem Is Nothing Then
        Call ASC_SendMessage(mo_Db, label_language, 266, "#Missing Data in compulsory field.")
        Call cbo_actionType.SetFocus
        Exit Sub
    End If
    
    ' check if there is some sample
    If grd_DetailLine.Rows = 0 Then
        Call ASC_SendMessage(mo_Db, label_language, 266, "#Missing Data in compulsory field.")
        Call grd_DetailLine.SetFocus
        Exit Sub
    End If
    
    Debug.Assert (ms_ATG_Desc = "Dispatch")     ' AT_Code=7 (Sample)
    
    Dim ls_RaisedFor As String
    ls_RaisedFor = IIf(chk_DSW.value, ms_armstrongUser, dsw_name)                       ' todo: from config? raiser for D.S.W. or myself
    
    Dim ls_ActionCode As String
    ls_ActionCode = mo_Db.SQLNextID("Cap_Action")
    If ls_ActionCode = "" Then Call Err.Raise(666, "", "SQL Error: mo_Db.SQLNextID(""Cap_Action"") return nothing.")
    
    Dim ls_MEM_Code As String
    ls_MEM_Code = mo_Db.SQLNextID("Cap_Memo")
    If ls_MEM_Code = "" Then Call Err.Raise(666, "", "SQL Error: mo_Db.SQLNextID(""Cap_Memo"") return nothing.")

    Dim ls_Request As String
    ls_Request = "Exec Cap_Action_ins "
                
    ls_Request = ls_Request & "  " & SqlStr(srch_Customer.Key1, 16)   '@CCU_CapKey char (16),
    ls_Request = ls_Request & ", " & SqlStr(srch_contact.Key1, 16, True)  '
    ls_Request = ls_Request & ", " & SqlStr("", 16, True) '
    ls_Request = ls_Request & ", " & SQLNum(cbo_actionType.SelectedItem.Key) '@AT_code int ,
    ls_Request = ls_Request & ", " & SQLNum("2") '@AS_code int ,      2 .. Outstanding
    ls_Request = ls_Request & ", " & SQLNum("") '@LT_code int ,       NULL .. LT_Code
    ls_Request = ls_Request & ", " & SqlStr(ls_RaisedFor, 30) '@ACT_raisedFor char (30),
'    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_Comment) '@ACT_comment varchar (255),     ' task 299.3
    ls_Request = ls_Request & ", " & SQLNum("1") '@AR_code int ,     1.. Incomming Call
    ls_Request = ls_Request & ", " & SqlDate(dt(1).Text) '@ACT_dueDate datetime ,
    ls_Request = ls_Request & ", " & SQLNum("") '@ACT_size real ,       NULL
    ls_Request = ls_Request & ", " & SqlStr("M2", 5) '@UM_code char (5),
    ls_Request = ls_Request & ", " & "NULL" 'Correct() '@AC_desc varchar (80),
    ls_Request = ls_Request & ", " & "''" '@Internet CHAR(1),
    ls_Request = ls_Request & ", " & "''" '@Drop CHAR(1),
    ls_Request = ls_Request & ", " & "NULL" '@Drop_date DATETIME,
    ls_Request = ls_Request & ", " & "NULL" '@spare1_varchar VARCHAR(1),
    ls_Request = ls_Request & ", " & "NULL" '@spare2_varchar VARCHAR(1),
    ls_Request = ls_Request & ", " & "NULL" '@spare3_real REAL,
    ls_Request = ls_Request & ", " & "NULL" '@spare4_real REAL
    ls_Request = ls_Request & ", " & "'" & ls_ActionCode & "'"
    
    
    Call ASC_BeginTransaction(mo_Db)
    lb_InTran = True

    ' insert cap_action, Cap_ActionContact
    Call ExecuteSQLSafe(mo_Db, ls_Request)

    ' insert into cap_memo only 'E' language record, memo type=2(spare3_real)
    ls_Request = Replace(REQ_memo_ins, "$Comment_desc$", SqlStr(dt(19).Text, 80))
    ls_Request = Replace(ls_Request, "$Comment$", SqlStr(dt(19).Text))
    ls_Request = Replace(ls_Request, "$AC_CODE$", ls_ActionCode)
    ls_Request = Replace(ls_Request, "$MEM_Code$", ls_MEM_Code)
    
    ' insert memo
    Call ExecuteSQLSafe(mo_Db, ls_Request)
    
    dt(0).Text = ls_ActionCode
    
    'insert samples
    If UCase$(ms_ATG_Desc) = "DISPATCH" Then
        If Not SaveSampleGrid(dt(0).Text, 0) Then
            Call ASC_RollBackTransaction(mo_Db)
            lb_InTran = False
            Call ASC_SendMessage(mo_Db, label_language, 891, "#An error occured during this manipulation, please contact your IT support")
            Exit Sub
        End If
    End If

    Call ASC_CommitTransaction(mo_Db)         ' task 299.3 end
    lb_InTran = False
    
    ' move back to listing
    chg_to_add (False)
    
    If Not chk_DSW.value Then
        If Not tw.SelectedItem Is Nothing Then
            If tw.SelectedItem.Tag.IDValue = dt(5).Text Then
                grd_detail.Refresh
            Else
                tw_tab_Click
            End If
        Else
            tw_tab_Click
        End If
    End If
    Exit Sub
errhandler:
    If lb_InTran Then
        Call ASC_RollBackTransaction(mo_Db)
        lb_InTran = False
    End If
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function Add_db", True, True
End Sub

Private Sub valid_upd_Click()
On Error GoTo valid_upd_Click_er
Dim i As Long

    Call LockScreen(True)

    If dt(0).Text = "" Then
        ' it is action add
        Call Add_db
        Call LockScreen(False)
        Exit Sub
    End If

    Dim ls_RaisedFor As String
    ls_RaisedFor = dsw_name

    Dim ls_samplesReport As String
    ls_samplesReport = ""
    Dim lb_stockCompletition As Boolean
    Dim ll_SPD_Code As Long
    ll_SPD_Code = RaisedForStockDepartment(dsw_u_code)
    lb_stockCompletition = (Mid(cb_status.SelectedItem.Key, 3, 1) = ActionStatus.AS_COMPLETE And (ll_SPD_Code <> 0))
    
    Dim ll_stockCursor As Long
    ll_stockCursor = 0
    ' check if sample is on stock
    If lb_stockCompletition Then
        ll_stockCursor = mo_Db.OpenSQL("EXEC Cap_SampleDoc_Transaction_lst '" & dt(0) & "'")
        If ll_stockCursor = 0 Then
            Call LockScreen(False)
            Call ASC_SendMessage(mo_Db, label_language, 992, "#Failed to execute the transaction list")
            Exit Sub
        End If
        
        
        ' check if action was not completing by another stock department
        While Not mo_Db.EOF(ll_stockCursor)
            If ll_SPD_Code <> mo_Db.GetFields(ll_stockCursor, "SDP_Code") Then
                Call LockScreen(False)
                Call ASC_SendMessage(mo_Db, label_language, 993, "#This action was completed by different Stock department!", "", vbCritical)
                Call mo_Db.Close(ll_stockCursor)
                Exit Sub
            End If
            Call mo_Db.Next(ll_stockCursor)
        Wend
        
        Call mo_Db.First(ll_stockCursor)
    End If
    
    Dim ll_qtyToSent As Long
    Dim ll_Count As Long
    If lb_stockCompletition Then
        For ll_Count = 0 To grd_DetailLine.Rows - 1
            ' if qty requested is not on the stock
            If CLng(grd_DetailLine.Data(ll_Count, "SD_Qty")) < CLng(grd_DetailLine.Data(ll_Count, "ASD_qty")) Then
                ls_samplesReport = ls_samplesReport & vbCrLf & ASC_MsgText(mo_Db, label_language, 975, "#Requested qty is not on the stock.") & " (" & grd_DetailLine.Data(ll_Count, "SD_Desc") & ")"
            End If
            
            If CLng(grd_DetailLine.Data(ll_Count, "ASD_qty_sent")) <> CLng(grd_DetailLine.Data(ll_Count, "ASD_qty")) Then
                ls_samplesReport = ls_samplesReport & vbCrLf & ASC_MsgText(mo_Db, label_language, 976, "#Requested qty is not equal to qty sent.") & " (" & grd_DetailLine.Data(ll_Count, "SD_Desc") & ")"
            End If
            
            ' get the transaction numbers from previouse completition
            ll_qtyToSent = CLng(grd_DetailLine.Data(ll_Count, "ASD_qty_sent"))
            If mo_Db.Find(ll_stockCursor, Array("SD_code"), Array(grd_DetailLine.Data(ll_Count, "SD_Code"))) >= 0 Then
                ll_qtyToSent = ll_qtyToSent + mo_Db.GetFields(ll_stockCursor, "Tran_Qty")
            End If

            ' error mssage when qty sent is not on stock
            If ll_qtyToSent > CLng(grd_DetailLine.Data(ll_Count, "SD_Qty")) Then
                
                Call LockScreen(False)
                Call ASC_SendMessage(mo_Db, label_language, 977, "#Qty to send is more than qty on stock!", grd_DetailLine.Data(ll_Count, "SD_Desc"))
                grd_DetailLine.SetFocus
                Call mo_Db.Close(ll_stockCursor)
                Exit Sub
            ElseIf CLng(grd_DetailLine.Data(ll_Count, "ASD_qty_sent")) = 0 Then
                ls_samplesReport = IIf(ls_samplesReport = "", "", ls_samplesReport & vbCrLf) & ASC_MsgText(mo_Db, label_language, 978, "#Qty to sent is zero.") & " (" & grd_DetailLine.Data(ll_Count, "SD_Desc") & ")"
            End If
        
        Next
    
        If ls_samplesReport <> "" Then
            Dim ll_msgResult As VbMsgBoxResult
            ll_msgResult = ASC_SendMessage(mo_Db, label_language, 979, "#Some warnings detected! Do you want to send action back to requestor?", ls_samplesReport, vbYesNoCancel)
            If ll_msgResult = vbCancel Then
                Call mo_Db.Close(ll_stockCursor)
                Call LockScreen(False)
                Exit Sub
            End If
        
            If ll_msgResult = vbYes Then
                ' add warnings into comment field
                dt(19).Text = dt(19).Text & vbCrLf & ls_samplesReport
            
                ' move back to status outstanding
                Dim ll_i As Long
                For ll_i = 1 To cb_status.ComboItems.Count
                    If Mid(cb_status.ComboItems.Item(ll_i).Key, 3, 1) = ActionStatus.AS_OUTSTANDING Then
                        Set cb_status.SelectedItem = cb_status.ComboItems.Item(ll_i)
                        Exit For
                    End If
                Next ll_i
            
                ' change raisedfor to requestor
                ls_RaisedFor = dt(3).Text
            
                ' change stock completition to false
                lb_stockCompletition = False
                Call mo_Db.Close(ll_stockCursor)
                ll_stockCursor = 0
            End If
        End If
    Else
        ' check if user do want to send action back to DSW manually
        If chk_DSW.value = vbChecked Then
            ls_RaisedFor = ms_armstrongUser
        End If
    End If



    Call ASC_BeginTransaction(mo_Db)        ' task 299.3
    
    ls_req = "update cap_action set z_last_upd= getdate(), z_last_upd_user= '" & dsw_name & "',  as_code=" & Mid(cb_status.SelectedItem.Key, 3, 1) & ", iconcurrency= " & Val(ic) + 1
    
    If dsw_name <> ls_RaisedFor Then
        ls_req = ls_req & ", ACT_raisedFor='" & ls_RaisedFor & "'"
    End If
    
    If Not mo_Db.ExecuteSQL(ls_req & "  where ac_code='" & dt(0) & "' and iconcurrency=" & ic) Then
        Call ASC_RollBackTransaction(mo_Db)     ' task 299.3
        Call LockScreen(False)
        A_MsgBox "Error while updating record with key: " & dt(0) & " " & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage, True, True
        Call mo_Db.Close(ll_stockCursor)
        Exit Sub
    End If
    
    If mo_Db.SQLRowsAffected <> 1 Then
        Call ASC_RollBackTransaction(mo_Db)     ' task 299.3
        Call LockScreen(False)
        MsgBox "Somebody else change the data during you editing it. Please refresh the record and retry"
        Call mo_Db.Close(ll_stockCursor)
        Exit Sub
    End If
    
    ' update memo
    ' task 299.3 begin
    Const REQupd = "EXEC Cap_Memo_Comment_upd '$AC_CODE$', $Comment$, 'N', Null, 2, $uid$"
    Dim ls_Result As String
    
    ' update cap_memo
    Dim ls_Request As String
    Dim lb_Result As Boolean
    
    ls_Request = Replace(REQupd, "$AC_CODE$", dt(0))
    ls_Request = Replace(ls_Request, "$Comment$", FormatSqlStringParameter(dt(19).Text))
    ls_Request = Replace(ls_Request, "$uid$", "'" & UCase(Logged_user) & "'")
    lb_Result = ASC_RecordExec(mo_Db, ls_Request, ls_Result)
    If lb_Result = False Then
        Call ASC_RollBackTransaction(mo_Db)     ' task 299.3
        Call LockScreen(False)
        Call ASC_SendMessage(mo_Db, label_language, 891, "#An error occured during this manipulation, please contact your IT support")
        Call mo_Db.Close(ll_stockCursor)
        Exit Sub
    End If
    
    
    If UCase$(ms_ATG_Desc) = "DISPATCH" Then
        If Not SaveSampleGrid(dt(0).Text, ll_stockCursor) Then
            Call ASC_RollBackTransaction(mo_Db)
            Call LockScreen(False)
            Call ASC_SendMessage(mo_Db, label_language, 891, "#An error occured during this manipulation, please contact your IT support")
            Call mo_Db.Close(ll_stockCursor)
            Exit Sub
        End If
    End If
    
    ' task 299.3 end
    Call ASC_CommitTransaction(mo_Db)         ' task 299.3 end
    
    If ll_stockCursor > 0 Then
        Call mo_Db.Close(ll_stockCursor)
        ll_stockCursor = 0
    End If
    
    If lb_stockCompletition Then
        ' Check if stock quantity is not less than min
        Dim ll_Curs As Long
        ll_Curs = mo_Db.OpenSQL("EXEC Cap_SampleDoc_Department_lst3 '" & dt(0).Text & "','" & label_language & "'")
        
        If mo_Db.RowCount(ll_Curs) > 0 Then
            ' there is something on the stock less than min
            Dim ls_Msg As String
            Dim ls_msgTmpl As String
            ls_msgTmpl = ASC_MsgText(mo_Db, label_language, 982, "#Stock ($STOCKDPT$) quantity ($QTY$) of item $ITEM$ is less than Min ($MIN$).")
            ls_Msg = ""
            While Not mo_Db.EOF(ll_Curs)
                Dim ls_auxmsg As String
                ls_auxmsg = Replace(ls_msgTmpl, "$STOCKDPT$", mo_Db.GetFields(ll_Curs, "SDP_Desc"), , , vbTextCompare)
                ls_auxmsg = Replace(ls_auxmsg, "$QTY$", mo_Db.GetFields(ll_Curs, "SD_Qty"), , , vbTextCompare)
                ls_auxmsg = Replace(ls_auxmsg, "$ITEM$", mo_Db.GetFields(ll_Curs, "SD_Desc"), , , vbTextCompare)
                ls_auxmsg = Replace(ls_auxmsg, "$MIN$", mo_Db.GetFields(ll_Curs, "SD_Min"), , , vbTextCompare)
                ls_Msg = IIf(ls_Msg = "", ls_Msg, ls_Msg & vbCrLf) & ls_auxmsg
                
                Call mo_Db.Next(ll_Curs)
            Wend
            
            Call ASC_SendMessage(mo_Db, label_language, 983, "#Warning!", ls_Msg, vbInformation & vbOKOnly)
            
        End If
        Call mo_Db.Close(ll_Curs)
        ll_Curs = 0
        
    End If
    
    
    ' local updates
    dt(19).BackColor = &H80000005
    dt_bck = ""
    If Mid(cb_status.SelectedItem.Key, 3, 1) = "1" Then
        count_completion = count_completion + 1
        grd_detail.Visible = False
        
        Call grd_detail.DeleteSelectedLines
        
        If grd_detail.Rows = 0 Then
            tw.RemoveNode tw.Nodes(tw.SelectedItem.Index)
            Raz_Detail
            fr_detail.Visible = False
            grd_detail.Height = 9650
            tw_tab_Click
        End If
        grd_detail.Visible = True
    Else
        dt_bck = dt(19)
        grd_detail.CurrentLine("ACT_comment") = Left(dt_bck, GRID_COMMENT_SIZE)        ' task 299.3
        grd_detail.CurrentLine("iConcurrency") = Val(ic) + 1
        
    End If
    chg_to_upd (False)
    grd_detail_Click
    Call LockScreen(False)
    Exit Sub

valid_upd_Click_er:
    Call ASC_RollBackTransaction(mo_Db)     ' task 299.3
    
    If ll_stockCursor > 0 Then
        Call mo_Db.Close(ll_stockCursor)
        ll_stockCursor = 0
    End If
    
    Call LockScreen(False)
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function valid_upd_Click", True, True

End Sub

Private Function SaveSampleGrid(as_ActionCode As String, ByVal al_stockCursor As Long) As Boolean
On Error GoTo Trace_Err
    
Const CREQ_INS As String = "EXEC Cap_ActionSampleDoc_ins $AC_CODE$, $CCU_CAPKEY$, $SD_CODE$, $PE_CODE$, $ASD_QTY$, $HandOrFullFlag$, $ASD_comment$, $ASD_qtySent$"
    SaveSampleGrid = False
        
    ' have to update manually row by row
    Dim ll_Count As Long
    Dim ls_Request As String
    Dim ll_Rows As Long
    
    ll_Rows = grd_DetailLine.Rows
    
    For ll_Count = 0 To ll_Rows - 1
        Select Case grd_DetailLine.Data(ll_Count, "MTNC")
        Case "U"
            ls_Request = "EXEC Cap_ActionSampleDoc_dsw_upd '" & as_ActionCode & "'," & grd_DetailLine.Data(ll_Count, "SD_Code") & "," & SqlStr(grd_DetailLine.Data(ll_Count, "ASD_comment"), 255) & "," & grd_DetailLine.Data(ll_Count, "ASD_qty_sent")
            
            If Not mo_Db.ExecuteSQL(ls_Request) Then
                GoTo Trace_Err
            End If
        Case "A"
            ls_Request = Replace(CREQ_INS, "$AC_CODE$", SqlStr(as_ActionCode, 16), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$CCU_CAPKEY$", SqlStr(srch_Customer.Key1, 16), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$SD_CODE$", grd_DetailLine.Data(ll_Count, "SD_Code"), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$PE_CODE$", "NULL", , , vbTextCompare)        ' C_GRD_EdgeDetailDesc_COL
            ls_Request = Replace(ls_Request, "$ASD_QTY$", SQLNum(grd_DetailLine.Data(ll_Count, "ASD_qty")), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$HandOrFullFlag$", SqlStr(grd_DetailLine.Data(ll_Count, "handorfullflag"), 1), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$ASD_comment$", SqlStr(grd_DetailLine.Data(ll_Count, "ASD_comment"), 255), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$ASD_qtySent$", SQLNum(grd_DetailLine.Data(ll_Count, "ASD_qty_sent")), , , vbTextCompare)
            
            If Not mo_Db.ExecuteSQL(ls_Request) Then
                GoTo Trace_Err
            End If
        End Select
        
        If al_stockCursor <> 0 Then
            ' remove from stock + generate new transaction
            Dim ld_qtyToAdd As Double
            ld_qtyToAdd = -grd_DetailLine.Data(ll_Count, "ASD_qty_sent")
            
            ' chcek in transaction if there was some adding before
            If mo_Db.Find(al_stockCursor, Array("SD_code"), Array(grd_DetailLine.Data(ll_Count, "SD_Code"))) >= 0 Then
                ld_qtyToAdd = ld_qtyToAdd - mo_Db.GetFields(al_stockCursor, "Tran_Qty")
            End If
            
            ' if there is a change then update stock into database + generate new transaction
            If ld_qtyToAdd <> 0 Then
                Dim ll_rep_U_Code As Long
                ll_rep_U_Code = dsw_u_code
                
                Dim ll_SPD_Code As Long
                ll_SPD_Code = RaisedForStockDepartment(dsw_u_code)
                Debug.Assert (ll_SPD_Code <> 0)             ' if we are here we have to know stock departemnt of a raiserFor
                
                mo_Db.ExecuteSQL ("EXEC Cap_SampleDoc_Department_upd2 " & grd_DetailLine.Data(ll_Count, "SD_Code") & "," & ll_SPD_Code & "," & ld_qtyToAdd & ", " & ll_rep_U_Code)
                
                ' add transaction
                mo_Db.ExecuteSQL ("EXEC Cap_SampleDoc_Transaction_ins '" & as_ActionCode & "'," & grd_DetailLine.Data(ll_Count, "SD_Code") & ", " & ll_SPD_Code & "," & ld_qtyToAdd & "," & (grd_DetailLine.Data(ll_Count, "SD_Qty") + ld_qtyToAdd) & "," & ll_rep_U_Code)
                
                ' update local data
                grd_DetailLine.Data(ll_Count, "SD_Qty") = grd_DetailLine.Data(ll_Count, "SD_Qty") + ld_qtyToAdd
            End If

        End If
    Next
    SaveSampleGrid = True


Trace_End:
    Exit Function
    
Trace_Err:
End Function

Private Function Raz_Detail()
On Error GoTo raz_detail_er
    Dim ind As Integer
    For ind = 0 To 13
        If ind <> 4 And ind <> 2 Then
            dt(ind) = ""
        End If
    Next ind
    For ind = 16 To 19
        dt(ind) = ""
    Next ind
    Call grd_DetailLine.ClearGrid
    grd_DetailLine.Requests = ""
Exit Function
raz_detail_er:
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function Raz_Detail", True, True

End Function

Private Function Label(ByVal av_Col As Variant) As String
On Error GoTo errhandler
    Debug.Assert (ml_cstsCurs <> 0)
    
    Label = ""
    
    If av_Col = "" Then Exit Function
    
    If IsNumeric(av_Col) Then
        Label = mo_Db.GetFieldsAt(ml_cstsCurs, av_Col, "local_text")
    Else
        If mo_Db.Find(ml_cstsCurs, "field_name", av_Col) >= 0 Then
            Label = mo_Db.GetFields(ml_cstsCurs, "local_text")
        End If
    End If
    
    Exit Function
errhandler:
End Function

Private Sub LoadCaption(ByRef ao_label As Object)
On Error GoTo errhandler
    Dim ls_caption As String
    
    ls_caption = Label(ao_label.Tag)
    
    If ls_caption <> "" Then
        ao_label.Caption = ls_caption
    End If
    
    Exit Sub
errhandler:
End Sub


Private Function Load_Language() As Boolean
On Error GoTo load_language_er
    Load_Language = False
    ls_req = "screen_csts 'DSW','" & label_language & "'"
    ml_cstsCurs = OpenSQLSafe(mo_Db, ls_req)
    
    Dim lo_ctrl As Object
    
    For Each lo_ctrl In dl
        Call LoadCaption(lo_ctrl)
    Next
    
    Call LoadCaption(l_upd)
    Call LoadCaption(Sa_Flag)
    
    For Each lo_ctrl In tw_tab.Tabs
        Call LoadCaption(lo_ctrl)
    Next

    For Each lo_ctrl In Main_tab.Tabs
        Call LoadCaption(lo_ctrl)
    Next

    Call LoadCaption(cmd_Update_QTY)
    Call LoadCaption(btn_delSample)
    Call LoadCaption(btn_addSample)
    Call LoadCaption(chk_DSW)
    
    Load_Language = True

    Exit Function
load_language_er:
    Screen.MousePointer = 0
    A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function load_language", True, True
End Function

Public Property Let Language(ByVal choosen_language As String)
label_language = choosen_language
End Property

Public Property Let Use_by_DSW(ByVal dsw As String)
Use_DSW = dsw
End Property

Public Property Let user_info(ByVal theuser As String)
    Logged_user = theuser
End Property

Public Property Let user_pwd(ByVal thepassword As String)
    Logged_pwd = thepassword
End Property

Public Property Get user_info() As String
    user_info = Logged_user
End Property

Public Property Get DSW_NANME() As String
    DSW_NANME = dsw_name
End Property

Private Sub Quit_program()
On Error GoTo quit_program_er
    A_MsgBox "Samples Program Log out, User was" & dsw_name & " " & count_completion & " action(s) completed", False, False
    Dim try As Integer
    try = 0
    tw.Unload_A_Com
    grd_detail.Unload_A_Com
    uc_sample.Unload_A_Com
    If uc_DC_Sample_lst.Initialized Then
        Call uc_DC_Sample_lst.Unload_A_Com
    End If
    RaiseEvent quit
Exit Sub
quit_program_er:
    try = try + 1
    If try < 2 Then RaiseEvent quit Else End
End Sub

Private Function Get_A_Config(ByVal TheKey As String) As String
On Error GoTo Get_A_Config_er
Get_A_Config = ""
    Dim curs As Long
ls_req = "select cfg_value from A_config where cfg_Key ='" & UCase(TheKey) & "'"
curs = mo_Db.OpenSQL(ls_req)
    If curs = 0 Then
    A_MsgBox "Error executing " & ls_req & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage, True, True
    
    Else
        If mo_Db.RowCount(curs) <> 1 Then
        mo_Db.Close (curs)
        A_MsgBox "Executing " & ls_req & " returned " & mo_Db.RowCount(curs) & " record(s) while one was expected", True, True
        
        Else
        Get_A_Config = mo_Db.GetFields(curs, 0)
        mo_Db.Close (curs)
        End If
    End If
Exit Function
Get_A_Config_er:
Screen.MousePointer = 0
A_MsgBox "Unexpected Error " & Err.Number & " " & Err.Description & " occured in function Get_A_Config", True, True
End Function

Private Function A_MsgBox(ByVal msg As String, ByVal will_quit As Boolean, ByVal will_display As Boolean)
Dim current_mp As Integer
current_mp = Screen.MousePointer
Screen.MousePointer = 0
    If Not mo_Db.ExecuteSQL("insert into zlog (log_date,log_txt,nb_record,application) values(getdate(),'" & msg & "',1,'DSW Samples')") Then
        If UCase(Left(msg, 2)) <> UCase("Samples Program Log out, User was") Then  'in case user disconnected, not worse displaying an error msg just becasue we cannot log this warning
            MsgBox "Error while inserting error into log. Please write down this message and contact IT. " & " Msg to log was: " & msg & " Current error is " & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage

            If will_quit Then
                End
            End If

        End If
        Quit_program
    End If
    If will_display Then
        If UCase(Left(msg, 2)) <> UCase("Samples Program Log out, User was") Then  'in case user disconnected, not worse displaying an error msg just becasue we cannot log this warning
            MsgBox "Following error occured: " & msg
        End If
    End If
    
    If will_quit Then Quit_program
    
    Screen.MousePointer = current_mp
End Function

' task 299.3 begin
Private Function GetCommentText(ByVal as_ac_code As String) As String
    Dim ll_Cursor As Long
    GetCommentText = ""
    ll_Cursor = mo_Db.OpenSQL("SELECT MEM_text FROM Cap_Memo WHERE spare1_varchar = '" & as_ac_code & "' AND spare3_real=2 AND Language_code='E'")
    If ll_Cursor > 0 Then
        If Not mo_Db.EOF(ll_Cursor) Then
            GetCommentText = mo_Db.GetFields(ll_Cursor, "MEM_text")
        End If
        Call mo_Db.Close(ll_Cursor)
    Else
        A_MsgBox "Error while retrieving memo for action with key: " & as_ac_code & " " & mo_Db.LastErrorCode & "  " & mo_Db.LastErrorMessage, True, True
    End If
End Function
' task 299.3 end

Public Function ASC_BeginTransaction(ByRef ao_Armdb As Object, Optional ByVal as_name As String = "") As Boolean
Dim ll_Cursor As Long
Dim ls_Request As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:ASC_BeginTransaction"
    #End If
    
    ASC_BeginTransaction = False
    
    ls_Request = "BEGIN TRAN " & as_name
    
    'Execute the request
    If Not ao_Armdb.ExecuteSQL(ls_Request) Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError ao_Armdb, "Tools:ASC_BeginTransaction", "ls_Request = " & ls_Request
        GoTo Trace_End
    End If
    
    ASC_BeginTransaction = True
            
Trace_End:
    'ao_ArmDB.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:ASC_BeginTransaction"
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    'ao_ArmDB.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:ASC_BeginTransaction"
    CapMouseOn
End Function

Public Function ASC_CommitTransaction(ByRef ao_Armdb As Object, Optional ByVal as_name As String = "") As Boolean
Dim ll_Cursor As Long
Dim ls_Request As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:ASC_CommitTransaction"
    #End If
    
    ASC_CommitTransaction = False
    
    ls_Request = "COMMIT TRAN " & as_name
    
    'Execute the request
    If Not ao_Armdb.ExecuteSQL(ls_Request) Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError ao_Armdb, "Tools:ASC_CommitTransaction", "ls_Request = " & ls_Request
        GoTo Trace_End
    End If
    
    ASC_CommitTransaction = True
            
Trace_End:
    'ao_ArmDB.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:ASC_CommitTransaction"
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    'ao_ArmDB.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:ASC_CommitTransaction"
    CapMouseOn
End Function

Public Function ASC_RollBackTransaction(ByRef ao_Armdb As Object, Optional ByVal as_name As String = "") As Boolean
Dim ll_Cursor As Long
Dim ls_Request As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:ASC_RollBackTransaction"
    #End If
    
    ASC_RollBackTransaction = False
    
    ls_Request = "ROLLBACK TRAN " & as_name
    
    'Execute the request
    If Not ao_Armdb.ExecuteSQL(ls_Request) Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError ao_Armdb, "Tools:ASC_RollBackTransaction", "ls_Request = " & ls_Request
        GoTo Trace_End
    End If
    
    ASC_RollBackTransaction = True
            
Trace_End:
    'ao_ArmDB.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:ASC_RollBackTransaction"
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    'ao_ArmDB.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:ASC_RollBackTransaction"
    CapMouseOn
End Function

Public Function ASC_RecordExec(ByRef ao_Armdb As Object, ByVal as_Request As String, ByRef as_ResultCode As String, Optional ab_TestResult As Boolean = True) As Boolean
Dim ll_Cursor As Long
Dim ls_Result As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:ASC_RecordExec", "as_Request=" & as_Request
    #End If
    
    ASC_RecordExec = False
    as_ResultCode = ""
    
    'Execute the request
    ll_Cursor = ao_Armdb.OpenSQL(as_Request)
    If ll_Cursor = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError ao_Armdb, "Tools:ASC_RecordExec", "as_Request = " & as_Request
        GoTo Trace_End
    End If
    
    ls_Result = ao_Armdb.GetFields(ll_Cursor, 0)
    If ls_Result = "" Then GoTo Trace_End
    
    as_ResultCode = ls_Result 'Error
    If ab_TestResult Then
        If Not IsNumeric(ls_Result) Then GoTo Trace_End
        If CDbl(ls_Result) < 0 Then GoTo Trace_End
    End If
    
    ASC_RecordExec = True
    
Trace_End:
    ao_Armdb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:ASC_RecordExec", "Result=" & ASC_RecordExec, "as_ResultCode=" & as_ResultCode
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    ao_Armdb.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:ASC_RecordExec"
    CapMouseOn
End Function

' Display an error message
Public Function ASC_SendMessage(ByRef ao_Armdb As Object, ByVal as_LG_Code As String, ByVal ai_MsgCode As Integer, ByVal as_MsgDefault As String, Optional ByVal as_MsgCxt As String = "", Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title As String) As VbMsgBoxResult
Dim ls_Message As String
Dim ll_Mouse As Long
Dim lo_Return As VbMsgBoxResult

    On Error GoTo Trace_Err
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:ASC_SendMessage", "LG_Code=" & as_LG_Code & ", ai_MsgCode=" & ai_MsgCode & ", as_MsgDefault=" & as_MsgDefault & ", as_MsgCxt=" & as_MsgCxt & ", VbMsgBoxStyle=" & "" & ", Title=" & Title
    #End If
    CapMouseOff
    
    If ao_Armdb Is Nothing Then
        ls_Message = as_MsgDefault
    Else
        If ao_Armdb.IsConnected = False Then
            ls_Message = as_MsgDefault
        Else
            ls_Message = ASC_MsgText(ao_Armdb, as_LG_Code, ai_MsgCode, as_MsgDefault)
        End If
    End If
    ls_Message = ls_Message & vbCrLf & Trim(as_MsgCxt)
        
    If Title = "" Then Title = "Capture Online"
    lo_Return = MsgBox(ls_Message, Buttons, Title)
    
    ASC_SendMessage = lo_Return

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:ASC_SendMessage", "Result=" & ASC_SendMessage
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    ASC_SendMessage = vbAbort
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:ASC_SendMessage"
    CapMouseOn
End Function

' Get an error message
Private Function ASC_MsgText(ByRef ao_Armdb As Object, ByVal as_LG_Code As String, ByVal ai_MsgID As Integer, Optional ByVal as_MsgDefault As String = "")
Dim lc_Msg As Long
Dim ls_Msg As String, ls_Request As String

    On Error GoTo Trace_Err
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:ASC_MsgText", "LG_Code=" & as_LG_Code & ", ai_MsgID=" & ai_MsgID & ", as_MsgDefault=" & as_MsgDefault
    #End If
    CapMouseOff
    
    ls_Request = "SELECT Message_Text FROM Error_Message WHERE Language_Code = '" & as_LG_Code & "' AND MsgID = " & ai_MsgID
    lc_Msg = ao_Armdb.OpenSQL(ls_Request)
    If lc_Msg = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError ao_Armdb, "Tools:ASC_MsgText", "Request=" & ls_Request
        GoTo Trace_End
    End If
    
    ls_Msg = ao_Armdb.GetFields(lc_Msg, "MESSAGE_TEXT")
    
Trace_End:
    Call ao_Armdb.Close(lc_Msg)
    ASC_MsgText = IIf(Len(ls_Msg) <> 0, ls_Msg, as_MsgDefault)
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:ASC_MsgText", "Result=" & ASC_MsgText
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    ASC_MsgText = ""
    Call ao_Armdb.Close(lc_Msg)
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:ASC_MsgText"
    CapMouseOn
End Function

Public Sub CapMouseOff(Optional ab_Restore = False)
Dim ll_Size As Long

    On Error GoTo Trace_Err
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:CapMouseOff", "ab_Restore=" & ab_Restore
    #End If

    If ab_Restore = True Then
        ll_Size = UBound(ma_CapMouseNumber)
        mi_CapMouseNumber = ma_CapMouseNumber(ll_Size)
        ReDim Preserve ma_CapMouseNumber(ll_Size - 1)
    Else
        mi_CapMouseNumber = mi_CapMouseNumber + 1
    End If
    Screen.MousePointer = vbHourglass

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:CapMouseOff"
    #End If
    Exit Sub

Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:CapMouseOff"

End Sub

Public Sub CapMouseOn(Optional ab_Saved = False)
Dim ll_Size As Long

    On Error GoTo Trace_Err
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:CapMouseOn", "ab_Saved=" & ab_Saved
    #End If

    If ab_Saved = True Then
        On Error Resume Next
        ll_Size = 0
        ll_Size = UBound(ma_CapMouseNumber)
        ll_Size = ll_Size + 1
        ReDim Preserve ma_CapMouseNumber(ll_Size)
        ma_CapMouseNumber(ll_Size) = mi_CapMouseNumber
        mi_CapMouseNumber = 1
    End If
    
    mi_CapMouseNumber = IIf(mi_CapMouseNumber < 1, 0, mi_CapMouseNumber - 1)
    If mi_CapMouseNumber = 0 Then
        Screen.MousePointer = vbDefault
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:CapMouseOn"
    #End If
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:CapMouseOn"

End Sub

Public Function FormatSqlStringParameter(ByVal as_str As String) As String

    On Error GoTo Trace_Err
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Tools:FormatSqlStringParameter", "as_Str=" & as_str
    #End If
    CapMouseOff
    
    FormatSqlStringParameter = CH_C & Replace(as_str, CH_C, CH_C & CH_C) & CH_C
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Tools:FormatSqlStringParameter", "Result=" & FormatSqlStringParameter
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Tools:FormatSqlStringParameter"
    CapMouseOn
End Function


' STOCK MANAGEMENT EXTENSION

Private Function RaisedForStockDepartment(ByVal al_U_Code As Long) As Long
Static ls_configValue  As String
    
    RaisedForStockDepartment = 0
    
    If dsw_name = "" Then Exit Function
    
    If ls_configValue = "" Then
        ls_configValue = SEP & Get_A_Config("CAP_SAMPLE_STOCKMNGR") & SEP
    End If
    
    Dim ll_Idx As Long
    
    ll_Idx = InStr(1, ls_configValue, SEP & al_U_Code & Left(SEP, 1))
    
    If ll_Idx > 0 Then
        ll_Idx = InStr(ll_Idx + Len(SEP), ls_configValue, Left(SEP, 1))
        RaisedForStockDepartment = CLng(Mid(ls_configValue, ll_Idx + 1, InStr(ll_Idx + 2, ls_configValue, SEP) - ll_Idx - 1))
    End If
End Function

Private Function UpdateSampleListItem(al_row As Long, av_Col As String) As Boolean
On Error GoTo onError:

    UpdateSampleListItem = False
    
    Dim ls_NewValue As String
    
    Dim lb_valid As Boolean
    lb_valid = False
    Do
        ls_NewValue = InputBox(grd_DetailLine.Columns(av_Col).Title, "Edit value", grd_DetailLine.Data(al_row, av_Col))
    
        If ls_NewValue = "" Then Exit Function
    
        ' validate new value
        Select Case av_Col
            Case "ASD_qty", "ASD_qty_sent"
                lb_valid = IsNumeric(ls_NewValue)
            Case "handorfullflag"
                ls_NewValue = UCase(ls_NewValue)
                lb_valid = (ls_NewValue = "H" Or ls_NewValue = "F")
            Case "ASD_comment"
                lb_valid = True
        End Select
        
        If Not lb_valid Then
            Call MsgBox("Invalid input!!" & vbCrLf & "Please enter correct input.", vbInformation)
        End If
    Loop While Not lb_valid
    
    
    If ls_NewValue <> grd_DetailLine.Data(al_row, av_Col) Then
        grd_DetailLine.Data(al_row, av_Col) = ls_NewValue
        If grd_DetailLine.Data(al_row, "MTNC") = "" Then grd_DetailLine.Data(al_row, "MTNC") = "U"
        
        ' if the raised for is selected then check also qty on the stock
        If RaisedForStockDepartment(dsw_u_code) <> 0 Then
            If CLng(grd_DetailLine.Data(al_row, "SD_Qty")) < CLng(grd_DetailLine.Data(al_row, "ASD_qty")) Then
                Call ASC_SendMessage(mo_Db, label_language, 975, "#Requested qty is not on the stock.", "", vbInformation, "")
            End If
        End If
        
        UpdateSampleListItem = True
    End If
    
    Exit Function
onError:
    UpdateSampleListItem = False

End Function
' END T298.WP7



Private Sub Load_CustomerInfo(ByVal as_CCU_Capkey As String)
Dim ls_Request As String
Dim ll_Cursor As Long

    On Error GoTo Trace_Err
    CapMouseOff

    If as_CCU_Capkey <> "" Then
        ls_Request = "exec claim_customer_t_sel3 '" & as_CCU_Capkey & "', '" & label_language & "'"
        ll_Cursor = OpenSQLSafe(mo_Db, ls_Request)
        
'        Txt_name.Text = mo_ArmDb.GetFields(ll_Cursor, "ccu_desc")
        dt(5).Text = mo_Db.GetFields(ll_Cursor, "CT_Code")
        dt(6).Text = mo_Db.GetFields(ll_Cursor, "ccu_addr1")
        dt(7).Text = mo_Db.GetFields(ll_Cursor, "ccu_addr2")
        dt(8).Text = mo_Db.GetFields(ll_Cursor, "ccu_town")
        dt(9).Text = mo_Db.GetFields(ll_Cursor, "ccu_zip")
        dt(10).Text = mo_Db.GetFields(ll_Cursor, "CTY_Desc")
        dt(11).Text = mo_Db.GetFields(ll_Cursor, "CT_desc")
        dt(12).Text = mo_Db.GetFields(ll_Cursor, "ccu_tel")
        Sa_Flag.value = IIf(mo_Db.GetFields(ll_Cursor, "ccu_saflag") = "O", Checked, Unchecked)
        dt(18).Text = mo_Db.GetFields(ll_Cursor, "SR_Name")
    
        Call mo_Db.Close(ll_Cursor)
    
    End If
    
    
    
    
Trace_End:
    Call mo_Db.Close(ll_Cursor)
    CapMouseOn
    Exit Sub
    
Trace_Err:
    Call mo_Db.Close(ll_Cursor)
    CapMouseOn
End Sub


Private Sub Clear_CustomerInfo()
    On Error GoTo Trace_Err

    dt(5).Text = ""
    dt(6).Text = ""
    dt(7).Text = ""
    dt(8).Text = ""
    dt(9).Text = ""
    dt(10) = ""
    dt(11) = ""
    dt(12).Text = ""
    Sa_Flag.value = vbUnchecked
    dt(18).Text = ""
    
    Exit Sub
    
Trace_Err:
End Sub


Private Sub RefreshCKV_StockSample(ByVal al_SDP_Code As Long)
    On Error GoTo Trace_Err
    Const C_REQ As String = "EXEC Cap_SampleDoc_Department_lst2 $SDP_CODE$"
    
    Dim ll_Cursor As Long
    ll_Cursor = mo_Db.OpenSQL(Replace(C_REQ, "$SDP_CODE$", al_SDP_Code, , , vbTextCompare))
    
    Dim ll_i As Long
    For ll_i = 0 To grd_DetailLine.Rows - 1
    
        If mo_Db.Find(ll_Cursor, "SD_Code", grd_DetailLine.Data(ll_i, "SD_Code")) >= 0 Then
            grd_DetailLine.Data(ll_i, "SD_Qty") = mo_Db.GetFields(ll_Cursor, "SD_Qty")
        Else
            grd_DetailLine.Data(ll_i, "SD_Qty") = "0"
        End If
    Next
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Exit Sub
Trace_Err:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Capact:RefreshCKV_StockSample"
End Sub


Private Sub LockScreen(ByVal ab_lock As Boolean)

    Dim ll_errNumber As Long, ls_ErrSrc As String, ls_ErrDesc As String
    ll_errNumber = Err.Number
    ls_ErrSrc = Err.Source
    ls_ErrDesc = Err.Description

On Error GoTo errhandler
    Static ll_Count As Long
    Static ll_Mousepointer As Long
    Static lb_Locked As Boolean
      
      
    ll_Count = ll_Count + IIf(ab_lock, 1, -1)
    Debug.Assert (ll_Count >= 0)
    
    ' First lock
    If Not lb_Locked And ab_lock Then
        ll_Mousepointer = Screen.MousePointer
        Screen.MousePointer = vbHourglass
        LockWindowUpdate UserControl.hwnd
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        UserControl.Refresh ' Repaint immediately
        Screen.MousePointer = ll_Mousepointer
        lb_Locked = False
    End If
    
    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc
    
    Exit Sub
    
errhandler:
End Sub


Private Function TempFile() As String
On Error GoTo errorHandler
    TempFile = ""
    ' return temporary file name or empty string if error
    Dim sDir As String
    Dim sBuff As String
    Dim x As Long
    sBuff = SPACE$(512)
    sDir = SPACE$(512)
    x = GetTempPath(Len(sDir), sDir)
    x = GetTempFileName(sDir, "TMP", 0, sBuff)
    x = InStr(sBuff, vbNullChar)
    
    If x > 0 Then
        TempFile = Left(sBuff, x - 1)
    End If
    
    Exit Function
errorHandler:
End Function

' print cez excell
Private Sub PrintFromTemplate()

On Error GoTo errhandler

    Dim ls_tmpFile As String
    Dim lo_ExcelApp As Object
    Dim lo_ExcelWorkBook As Object
    Dim lo_ExcelSheet As Object
    Dim lb_excellOpened As Boolean
    Dim lc_Cursor As Long
    Dim ls_req As String

    Call LockScreen(True)

    ls_tmpFile = App.Path & "\detail.xlsx"
  
    lb_excellOpened = False
    If Not OpenExcelDocument(ls_tmpFile, lo_ExcelApp, lo_ExcelWorkBook, lb_excellOpened) Then
        Call MsgBox("Not possible to open excell document! (" & ls_tmpFile & ")")
        
        Call LockScreen(False)
        Exit Sub
    End If
    
    lo_ExcelApp.ScreenUpdating = False
    Call lo_ExcelWorkBook.Activate
    Set lo_ExcelSheet = lo_ExcelWorkBook.Worksheets(1)
    Call lo_ExcelSheet.Activate
    
    Dim lo_range As Excel.Range
    Set lo_range = lo_ExcelSheet.UsedRange
    
    Dim ll_Row As Long
    Dim ll_col As Long
    Dim ls_Data As Variant
    
    Dim ll_rowMax As Long
    Dim ll_colMax As Long
    
    ll_rowMax = lo_range.Rows.Count
    ll_colMax = lo_range.Columns.Count
    
    ll_Row = lo_range.Top + 1
    
    Do While ll_Row <> ll_rowMax
        For ll_col = lo_range.Columns.Left + 1 To ll_colMax
            ls_Data = lo_range.Cells(ll_Row, ll_col).Text
            ' find if it is placeholder
            
            If ls_Data Like "[[]*[]]" Then
                ' yes it is placeholder -> try to replace
                Dim lo_ctrl As Control
                
                If ls_Data Like "[[][<>^_]*" Then
                    ' it is a field from line grid repeating to a specified side (left, right, up, down)
                    Dim ll_direction As XlDirection
                    Dim ll_copyOrigin As XlInsertFormatOrigin
                    Dim ll_colsToShift As Long
                    Dim ll_rowsToShift As Long
                    
                    ll_colsToShift = 0
                    ll_rowsToShift = 0
                    
                    If InStr(1, ls_Data, "[<", vbTextCompare) > 0 Then
                        ls_Data = Replace(ls_Data, "[<", "[", , , vbTextCompare)
                        ll_direction = xlToLeft
                        ll_copyOrigin = xlFormatFromLeftOrAbove
                    ElseIf InStr(1, ls_Data, "[>", vbTextCompare) > 0 Then
                        ls_Data = Replace(ls_Data, "[>", "[", , , vbTextCompare)
                        ll_direction = xlToRight
                        ll_copyOrigin = xlFormatFromRightOrBelow
                        ll_colMax = ll_colMax + 1
                    ElseIf InStr(1, ls_Data, "[^", vbTextCompare) > 0 Then
                        ls_Data = Replace(ls_Data, "[^", "[", , , vbTextCompare)
                        ll_direction = xlUp
                        ll_copyOrigin = xlFormatFromLeftOrAbove
                    ElseIf InStr(1, ls_Data, "[_", vbTextCompare) > 0 Then
                        If Len(ls_Data) > 3 Then
                            If Mid(ls_Data, 3, 1) = "x" Then
                                ll_colsToShift = Asc(Mid(ls_Data, 4, 1)) - ll_col - 64
                                
                                ls_Data = Replace(ls_Data, "[_" & Mid(ls_Data, 3, 2), "[", , , vbTextCompare)
                            Else
                                ls_Data = Replace(ls_Data, "[_", "[", , , vbTextCompare)
                            End If
                        Else
                            ls_Data = ""
                        End If
                        ll_direction = xlDown
                        ll_copyOrigin = xlFormatFromRightOrBelow
                        ll_rowMax = ll_rowMax + 1
                    End If
                    
                    Dim ll_i As Long
                    Dim ll_Y As Long
                    
                    Dim ls_dataTemplate As String
                    ls_dataTemplate = ls_Data
                    
                    For ll_i = grd_DetailLine.Rows - 1 To 0 Step -1
                        For ll_Y = 0 To grd_DetailLine.Cols - 1
                            ls_Data = Replace(ls_Data, "[" & grd_DetailLine.Columns(ll_Y).Name & "]", grd_DetailLine.Data(ll_i, ll_Y), , , vbTextCompare)
                        Next
                        
                        ls_Data = Replace(ls_Data, "[]", "", , , vbTextCompare)
                        
                        If ll_i <> 0 And (ll_colsToShift > 0 Or ll_rowsToShift > 0) Then
                            lo_range.Cells(ll_Row, ll_col) = Trim(ls_Data)
                            Call lo_ExcelSheet.Range(lo_ExcelSheet.Cells(ll_Row, ll_col), lo_ExcelSheet.Cells(ll_Row + ll_rowsToShift, ll_col + ll_colsToShift)).Insert(ll_direction, ll_copyOrigin)
                            
                            Dim ll_X  As Long
                            For ll_X = 1 To ll_colsToShift
                                lo_ExcelSheet.Cells(ll_Row, ll_col + ll_X) = lo_ExcelSheet.Cells(ll_Row + 1, ll_col + ll_X)
                            Next
                        Else
                            lo_range.Cells(ll_Row + ll_i, ll_col) = Trim(ls_Data)
                        End If
                        
                        ls_Data = ls_dataTemplate
                    Next
                    
                Else
                    For Each lo_ctrl In dt
                        If lo_ctrl.Tag <> "" Then ls_Data = Replace(ls_Data, "[" & lo_ctrl.Tag & "]", lo_ctrl.Text, , , vbTextCompare)
                    Next
                
                    ls_Data = Replace(ls_Data, "[" & srch_contact.Tag & "]", srch_contact.Text, , , vbTextCompare)
                    ls_Data = Replace(ls_Data, "[" & srch_Customer.Tag & "]", srch_Customer.Text, , , vbTextCompare)
                    ls_Data = Replace(ls_Data, "[CCU_saflag]", IIf(Sa_Flag.value = vbChecked, "X", ""), , , vbTextCompare)
                
                    lo_range.Cells(ll_Row, ll_col) = Trim(ls_Data)
                    
                    ' check if it is merged cell -> count nb of new line characters and set the row heigh
                    If lo_range.Cells(ll_Row, ll_col).MergeArea.Cells.Count >= 2 Then
                        lo_range.Rows(ll_Row).RowHeight = lo_range.Rows(ll_Row).RowHeight * (Len(ls_Data) - Len(Replace(ls_Data, vbLf, "")) + 1)
                        
                    End If
                End If
            End If
        Next
        
        ll_Row = ll_Row + 1
    Loop
    
    lo_ExcelSheet.PrintOut Copies:=1, Collate:=True
    Call lo_ExcelWorkBook.Close(False)
    lo_ExcelApp.ScreenUpdating = True
    lo_ExcelApp.Visible = True
    If lb_excellOpened Then
        ' if we have opened the excell then close it
        Call lo_ExcelApp.quit
    End If
    Set lo_ExcelSheet = Nothing
    Set lo_ExcelWorkBook = Nothing
    Set lo_ExcelApp = Nothing
    
    MsgBox ("Detail was printed!")
  
    Call LockScreen(False)
    Exit Sub
errhandler:
Resume Next
  Set lo_ExcelSheet = Nothing
  Set lo_ExcelWorkBook = Nothing
  Set lo_ExcelApp = Nothing
  Call MsgBox("Print detail failed: " & Err.Number & ",Desc: " & Err.Description & ",Src:" & Err.Source)
  Call LockScreen(False)
End Sub

Private Function OpenExcelDocument(ByVal as_name As String, ByRef ao_ExcelApp As Object, ByRef ao_ExcelBook, ByRef ao_excellOpened As Boolean) As Boolean
On Error GoTo errhandler

    OpenExcelDocument = False
    
    On Error GoTo Err_NotLoaded
    
    Set ao_ExcelApp = Nothing
    Set ao_ExcelBook = Nothing
    
    Set ao_ExcelApp = GetObject(, "Excel.Application")
    
    If ao_ExcelApp Is Nothing Then
        Set ao_ExcelApp = CreateObject("Excel.Application")
        ao_excellOpened = True
    End If
    
    If ao_ExcelApp Is Nothing Then GoTo errhandler
    
    On Error GoTo errhandler
    
    ao_ExcelApp.Application.Visible = False
    If as_name <> "" Then
        Set ao_ExcelBook = ao_ExcelApp.Workbooks.Open(as_name)
    Else
        Set ao_ExcelBook = ao_ExcelApp.Workbooks.add
    End If
    OpenExcelDocument = True
    Exit Function
Err_NotLoaded:
    If Err.Number = 429 Then
        Resume Next
    End If
errhandler:
    Call MsgBox("Error opening Excel: " & Err.Description)
    Set ao_ExcelApp = Nothing
    Set ao_ExcelBook = Nothing
End Function


Private Sub Permission()

Dim ls_Perm As String
Dim ll_Cursor As Long
Dim ls_req As String

On Error GoTo errhandler

    mb_AllowAdd = KO
    mb_AllowDel = KO
    mb_AllowUpd = KO
    mb_AllowPrint = KO

    ls_req = "EXEC Check_Security 'DSW', '" & UCase(Logged_user) & "'"
    
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    Do While Not mo_Db.EOF(ll_Cursor)
        ls_Perm = mo_Db.GetFields(ll_Cursor, "Action")
        
        If ls_Perm = "Update" Then
            mb_AllowUpd = OK
        End If
        If ls_Perm = "Delete" Then
            mb_AllowDel = OK
        End If
        If ls_Perm = "Insert" Then
            mb_AllowAdd = OK
        End If
        If ls_Perm = "Print" Then
            mb_AllowPrint = OK
        End If
        
        Call mo_Db.Next(ll_Cursor)
    Loop
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0

Exit Sub

errhandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
End Sub

Private Sub Exportexcell()

On Error GoTo errhandler

    Dim lo_ExcelApp As Object
    Dim lo_ExcelWorkBook As Object
    Dim lo_ExcelSheet As Object

    Call LockScreen(True)

    If Not OpenExcelDocument("", lo_ExcelApp, lo_ExcelWorkBook, True) Then
        Call MsgBox("Not possible to open excell application!")
        
        Call LockScreen(False)
        Exit Sub
    End If
    
    lo_ExcelApp.ScreenUpdating = False
    Call lo_ExcelWorkBook.Activate
    Set lo_ExcelSheet = lo_ExcelWorkBook.Worksheets(1)
    Call lo_ExcelSheet.Activate
    
    
    ' set columns
    Dim lsa_columns As Variant
    lsa_columns = Array(Label(25), Label(26), Label(27), Label(28), Label(29), Label(30), Label(31), Label(32), Label(33), Label(34) _
                        , Label(35), Label(36), Label(37), Label(38), Label(39) _
                        , Label(40), Label(41), Label(42), Label(43), Label(44), Label(45), Label(46), Label(47), Label(48), "", "", "", "", "", "", "")

    Dim ll_Idx As Long
    For ll_Idx = 0 To UBound(lsa_columns)
        lo_ExcelSheet.Cells(1, ll_Idx + 1) = "'" & lsa_columns(ll_Idx)
    Next

    Dim ll_localID As Long
    ll_localID = GetLCIDFromCodePage(GetCodePageFromLanguage(mo_Db, label_language))

    Dim ll_Cursor As Long
    Dim ls_req As String
    Dim ls_status As String
    If Mode = "D" Then
        ls_req = "Cap_Action_dsw_direct"
    Else
        ls_req = "Cap_Action_dsw_Bulk"
    End If
    Select Case tw_tab.SelectedItem.Index
        Case 1: ls_status = "Null"
        Case 2: ls_status = "2"
        Case 3: ls_status = "1"
    End Select
    
    ls_req = ls_req & " 'E'," & ls_status & ",'" & dsw_name & "','" & tw.NodeInfo(tw.SelectedItem).GetData(1) & "'," & RaisedForStockDepartment(dsw_u_code)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_req)
    
    Dim ll_exportRow As Long
    ll_exportRow = 2
    While Not mo_Db.EOF(ll_Cursor)
        Call ExportRow(ll_Cursor, ll_exportRow, lo_ExcelSheet, ll_localID)
        ll_exportRow = ll_exportRow + 1
        Call mo_Db.Next(ll_Cursor)
    Wend
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    lo_ExcelApp.Application.Visible = True
    If Not (lo_ExcelApp Is Nothing) Then
        lo_ExcelApp.ScreenUpdating = True
        lo_ExcelApp.Cursor = -4143
        Set lo_ExcelSheet = Nothing
        Set lo_ExcelWorkBook = Nothing
        Set lo_ExcelApp = Nothing
    End If
    
    Call LockScreen(False)
    
    MsgBox ("Exported!")
    Exit Sub
errhandler:
    Set lo_ExcelSheet = Nothing
    Set lo_ExcelWorkBook = Nothing
    Set lo_ExcelApp = Nothing
    Call MsgBox("Excel export failed: " & Err.Number & ",Desc: " & Err.Description & ",Src:" & Err.Source)
    Call LockScreen(False)
End Sub

Private Function ExportRow(ByVal al_Cursor As Long, ByVal al_exportRow As Long, ByRef ao_sheet As Object, ByVal al_localID As Long) As Boolean

    Dim ll_col As Long, ll_ColCount As Long
    Dim lv_Data As Variant, lv_Value As Variant

On Error GoTo errorHandler
    
    Dim ll_db As ArmDb
    
    ll_ColCount = mo_Db.FieldCount(al_Cursor)
    ReDim lv_Data(ll_ColCount - 1)
    
    For ll_col = 0 To ll_ColCount - 1
      
      lv_Value = mo_Db.GetFields(al_Cursor, ll_col)
      
      Select Case mo_Db.GetFieldType(al_Cursor, ll_col)
      Case DBTYPE_STR, DBTYPE_BSTR
          If al_localID <> 0 Then
            lv_Data(ll_col) = "'" & StrConv(StrConv(Left(lv_Value, 910), vbFromUnicode, 1033), vbUnicode, al_localID)
          Else
            lv_Data(ll_col) = "'" & Left(lv_Value, 910)
          End If
      Case DBTYPE_DATE
          If lv_Value = 0 Then lv_Value = Empty
          lv_Data(ll_col) = lv_Value
      Case Else
          lv_Data(ll_col) = lv_Value
      End Select
    Next
    ExportRow = ExportArray(lv_Data, al_exportRow, ao_sheet)
    Exit Function
errorHandler:
  ExportRow = False
#If CompDebug Then
  Call mo_Trace.WriteTraceError("ArmExcel:ExportRow")
#End If
End Function

Private Function ExportArray(av_Data As Variant, ByVal al_exportRow As Long, ByRef ao_sheet As Object) As Boolean

On Error GoTo errorHandler
  ao_sheet.Range(ao_sheet.Cells(al_exportRow, 1), _
                 ao_sheet.Cells(al_exportRow, UBound(av_Data) + 1)) = av_Data
  
  ExportArray = True
  Exit Function
errorHandler:
  ExportArray = False
End Function

Public Function GetCodePageFromLanguage(ByRef ao_Armdb As Object, ByVal ALanguage As String) As Long
    Dim ls_Request As String, lCurs As Long
    ls_Request = "SELECT Code_Page FROM Language WHERE Language_Code = '" & ALanguage & "'"
    lCurs = ao_Armdb.OpenSQL(ls_Request)
    Dim lCodePage As Long
    lCodePage = ao_Armdb.GetFields(lCurs, "Code_Page")
    Call ao_Armdb.Close(lCurs)
    GetCodePageFromLanguage = lCodePage
End Function

Private Function GetLCIDFromCodePage(ByVal al_CodePage As Long) As Long

    On Error GoTo Trace_Err

    Select Case al_CodePage
        Case 932 ' Japanese
            GetLCIDFromCodePage = 1041
        Case 936 ' Simplified Chinese
            GetLCIDFromCodePage = 2052
        Case 949 ' Korean
            GetLCIDFromCodePage = 1042
        Case 950 ' Traditional Chinese
            GetLCIDFromCodePage = 1028
        Case 1250 ' Eastern Europe
            GetLCIDFromCodePage = 1045
        Case 1251  ' Russian
            GetLCIDFromCodePage = 1049
        Case 1252  ' Western European Languages
            GetLCIDFromCodePage = 1033
        Case 1253 ' Greek
            GetLCIDFromCodePage = 1032
        Case 1254 ' Turkish
            GetLCIDFromCodePage = 1055
        Case 1255 ' Hebrew
            GetLCIDFromCodePage = 1037
        Case 1256 ' Arabic
            GetLCIDFromCodePage = 1025
        Case 1257 ' Baltic
            GetLCIDFromCodePage = 1061
        Case Else
            GetLCIDFromCodePage = 1033
    End Select
    
    Exit Function
    
Trace_Err:
    Call errorHandler("GetLCIDFromCodePage()")

End Function

