VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSComCt2.ocx"
Begin VB.Form frmAcumulacion 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Acumulación"
   ClientHeight    =   8280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10785
   Icon            =   "frmAcumulacion.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   8280
   ScaleWidth      =   10785
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdAjustar 
      Caption         =   "Realizar A&juste"
      Height          =   375
      Index           =   1
      Left            =   1560
      TabIndex        =   29
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdAjustar 
      Caption         =   "Realizar A&juste"
      Height          =   375
      Index           =   0
      Left            =   1560
      TabIndex        =   13
      Top             =   5130
      Width           =   1335
   End
   Begin VB.CommandButton cmdCliente 
      Caption         =   "&Ver Cliente"
      Height          =   375
      Left            =   7800
      TabIndex        =   16
      Top             =   7800
      Width           =   1335
   End
   Begin VB.Frame fraFoto 
      Height          =   2535
      Left            =   7680
      TabIndex        =   26
      Top             =   360
      Width           =   2895
      Begin VB.Image imgFoto 
         Height          =   2145
         Left            =   120
         Stretch         =   -1  'True
         Top             =   240
         Width           =   2640
      End
   End
   Begin VB.CommandButton cmdSalir 
      Caption         =   "&Salir"
      Height          =   375
      Left            =   9240
      TabIndex        =   17
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdExtornar 
      Caption         =   "Ext&ornar"
      Height          =   375
      Index           =   1
      Left            =   120
      TabIndex        =   15
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdExtornar 
      Caption         =   "E&xtornar"
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   12
      Top             =   5130
      Width           =   1335
   End
   Begin VB.Frame fraAcumulacion 
      Height          =   855
      Index           =   2
      Left            =   120
      TabIndex        =   22
      Top             =   2040
      Width           =   7335
      Begin VB.CommandButton cmdBuscar 
         Caption         =   "B&uscar"
         Default         =   -1  'True
         Height          =   375
         Left            =   5520
         TabIndex        =   10
         Top             =   320
         Width           =   1335
      End
      Begin MSComCtl2.DTPicker dtpFInicio 
         Height          =   315
         Left            =   1560
         TabIndex        =   7
         Top             =   360
         Width           =   1215
         _ExtentX        =   2143
         _ExtentY        =   556
         _Version        =   393216
         CalendarForeColor=   -2147483640
         CalendarTitleBackColor=   -2147483645
         CalendarTitleForeColor=   -2147483629
         CalendarTrailingForeColor=   -2147483645
         CustomFormat    =   "dd/MM/yyyy"
         Format          =   23658499
         CurrentDate     =   37042
      End
      Begin MSComCtl2.DTPicker dtpFFin 
         Height          =   315
         Left            =   3960
         TabIndex        =   9
         Top             =   360
         Width           =   1215
         _ExtentX        =   2143
         _ExtentY        =   556
         _Version        =   393216
         CalendarForeColor=   -2147483640
         CalendarTitleBackColor=   -2147483645
         CalendarTitleForeColor=   -2147483629
         CalendarTrailingForeColor=   -2147483645
         CustomFormat    =   "dd/MM/yyyy"
         Format          =   23658499
         CurrentDate     =   37042
      End
      Begin VB.Label lblLabels 
         Caption         =   "Al"
         Height          =   375
         Index           =   4
         Left            =   3120
         TabIndex        =   8
         Top             =   360
         Width           =   495
      End
      Begin VB.Label lblLabels 
         Caption         =   "Del"
         Height          =   375
         Index           =   3
         Left            =   720
         TabIndex        =   6
         Top             =   360
         Width           =   495
      End
   End
   Begin VB.Frame fraAcumulacion 
      Caption         =   "Tickets"
      Height          =   735
      Index           =   1
      Left            =   120
      TabIndex        =   20
      Top             =   1200
      Width           =   7335
      Begin VB.TextBox txtTicket 
         Height          =   315
         Left            =   1560
         TabIndex        =   4
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton cmdGrabar 
         Caption         =   "Gra&bar"
         Height          =   375
         Index           =   1
         Left            =   3000
         TabIndex        =   5
         Top             =   240
         Width           =   1335
      End
      Begin VB.Label lblLabels 
         Caption         =   "Tickets:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   8
         Left            =   4560
         TabIndex        =   28
         Top             =   240
         Width           =   855
      End
      Begin VB.Label lblTickets 
         Alignment       =   1  'Right Justify
         Caption         =   "Tickets"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   5640
         TabIndex        =   25
         Top             =   240
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "&Tickets"
         Height          =   375
         Index           =   1
         Left            =   600
         TabIndex        =   3
         Top             =   240
         Width           =   855
      End
   End
   Begin VB.Frame fraAcumulacion 
      Caption         =   "Puntos"
      Height          =   735
      Index           =   0
      Left            =   120
      TabIndex        =   19
      Top             =   360
      Width           =   7335
      Begin VB.CommandButton cmdGrabar 
         Caption         =   "&Grabar"
         Height          =   375
         Index           =   0
         Left            =   3000
         TabIndex        =   2
         Top             =   240
         Width           =   1335
      End
      Begin VB.TextBox txtImporte 
         Height          =   315
         Left            =   1560
         TabIndex        =   1
         Top             =   240
         Width           =   1215
      End
      Begin VB.Label lblLabels 
         Caption         =   "Puntos:"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   7
         Left            =   4560
         TabIndex        =   27
         Top             =   240
         Width           =   855
      End
      Begin VB.Label lblPuntos 
         Alignment       =   1  'Right Justify
         Caption         =   "Puntos"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   5520
         TabIndex        =   24
         Top             =   240
         Width           =   1455
      End
      Begin VB.Label lblLabels 
         Caption         =   "&Importe"
         Height          =   375
         Index           =   0
         Left            =   600
         TabIndex        =   0
         Top             =   240
         Width           =   855
      End
   End
   Begin MSComctlLib.ListView lvwPunto 
      Height          =   1935
      Left            =   120
      TabIndex        =   11
      Top             =   3160
      Width           =   10455
      _ExtentX        =   18441
      _ExtentY        =   3413
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   393217
      Icons           =   "imlAcumulacion"
      SmallIcons      =   "imlAcumulacion"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComctlLib.ImageList imlAcumulacion 
      Left            =   -120
      Top             =   240
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmAcumulacion.frx":0442
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmAcumulacion.frx":0894
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmAcumulacion.frx":0CE6
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvwTicket 
      Height          =   1935
      Left            =   120
      TabIndex        =   14
      Top             =   5830
      Width           =   10455
      _ExtentX        =   18441
      _ExtentY        =   3413
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   393217
      Icons           =   "imlAcumulacion"
      SmallIcons      =   "imlAcumulacion"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Label lblLabels 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Tickets"
      Height          =   255
      Index           =   6
      Left            =   120
      TabIndex        =   23
      Top             =   5590
      Width           =   10455
   End
   Begin VB.Label lblLabels 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Puntos"
      Height          =   255
      Index           =   5
      Left            =   120
      TabIndex        =   21
      Top             =   2920
      Width           =   10455
   End
   Begin VB.Label lblCliente 
      Alignment       =   2  'Center
      Caption         =   "Cliente"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   18
      Top             =   120
      Width           =   10575
   End
End
Attribute VB_Name = "frmAcumulacion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim sCliente As String
Dim sTarjeta As String
Dim sCodigo As String

Dim lReglaPuntoImporte As Long
Dim lReglaPuntoCantidad As Long

Dim lPunto As Long

Public dFInicio As Date
Public dFFin As Date

Private Sub Form_Activate()

  On Error GoTo LineaError
  
  'Form Actual
  psForm = kFORM_ACUMULACION
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub Form_Load()

  'Carga el formulario
  
  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  Call ConfigurarColumnas
  Call InicializarForm
  
  Screen.MousePointer = vbDefault
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault
  
End Sub

Private Sub ConfigurarColumnas()

  'Configura las columnas de la lista lvwpunto
  
  On Error GoTo LineaError

  Dim aColumnTitle() As String
  Dim aColumnWidth() As Single
  Dim aColumnAlign() As Integer
  
  ReDim aColumnTitle(7) As String
  ReDim aColumnWidth(7) As Single
  ReDim aColumnAlign(7) As Integer

  aColumnTitle(0) = "Fecha Acum."
  aColumnTitle(1) = "Tarjeta"
  aColumnTitle(2) = "Importe"
  aColumnTitle(3) = "Puntos"
  aColumnTitle(4) = "Usuario"
  aColumnTitle(5) = "Fecha Extorno"
  aColumnTitle(6) = "Usuario Extorno"
  
  aColumnWidth(0) = 0.14
  aColumnWidth(1) = 0.12
  aColumnWidth(2) = 0.12
  aColumnWidth(3) = 0.12
  aColumnWidth(4) = 0.14
  aColumnWidth(5) = 0.14
  aColumnWidth(6) = 0.14
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnLeft
  aColumnAlign(2) = lvwColumnRight
  aColumnAlign(3) = lvwColumnRight
  aColumnAlign(4) = lvwColumnLeft
  aColumnAlign(5) = lvwColumnLeft
  aColumnAlign(6) = lvwColumnLeft
    
  Call oListAdmin.InicializarLista(lvwPunto, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  ReDim aColumnTitle(6) As String
  ReDim aColumnWidth(6) As Single
  ReDim aColumnAlign(6) As Integer

  aColumnTitle(0) = "Fecha Acum."
  aColumnTitle(1) = "Tarjeta"
  aColumnTitle(2) = "Tickets"
  aColumnTitle(3) = "Usuario"
  aColumnTitle(4) = "Fecha Extorno"
  aColumnTitle(5) = "Usuario Extorno"
  
  aColumnWidth(0) = 0.16
  aColumnWidth(1) = 0.12
  aColumnWidth(2) = 0.14
  aColumnWidth(3) = 0.16
  aColumnWidth(4) = 0.16
  aColumnWidth(5) = 0.16
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnLeft
  aColumnAlign(2) = lvwColumnRight
  aColumnAlign(3) = lvwColumnLeft
  aColumnAlign(4) = lvwColumnLeft
  aColumnAlign(5) = lvwColumnLeft
    
  Call oListAdmin.InicializarLista(lvwTicket, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub InicializarForm()

  'Inicializa el Form
  
  On Error GoTo LineaError
  
  dtpFInicio.Value = Date - 15
  dtpFFin.Value = Date
  
  TraerDataCliente
  
  Call cmdBuscar_Click
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub TraerDataCliente()

  'Traer Data del Cliente seleccionado
  
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim sRutaFoto As String
  Dim iPos As Integer
  
  sCliente = Mid(frmPrincipal.lvwCliente.SelectedItem.Key, 2)
  
  sSQL = "SELECT * FROM Cliente WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, sCliente)
  
  If oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then

    If Not ADORS.EOF Then
    
      sTarjeta = frmPrincipal.lvwCliente.SelectedItem.SubItems(2)
    
      lblCliente.Caption = LeerCampo(ADORS!sClieApel) + " " + LeerCampo(ADORS!sClieName) + " - Tarjeta Activa: " + sTarjeta
      lblPuntos.Caption = Format(LeerCampo(ADORS!nPuntCant), "##,##0")
      lblTickets.Caption = Format(LeerCampo(ADORS!nTickCant), "##,##0")

      sRutaFoto = LeerCampo(ADORS!sClieRout)

      If sRutaFoto <> "" Then

        If Dir(sRutaFoto) = "" Then

          iPos = InStrRev(sRutaFoto, "\")

          If iPos > 0 Then
            sRutaFoto = App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + kDIR_FOTOS + Mid(sRutaFoto, iPos + 1)
          End If

        End If

        If Dir(sRutaFoto) <> "" Then
          imgFoto.Picture = LoadPicture(sRutaFoto)
        End If

      End If
               
    End If

  End If
  
  Set ADORS = Nothing

  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Public Sub LlenarListaAcumulacionPunto()

  'Llena la lista Punto

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim itemX As ListItem

  sSQL = "SELECT * " + _
         "FROM Acumulacion_Punto " + _
         "WHERE cClieCode = $ AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') >= '$' AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') <= '$' " + _
         "Order by dAcumDate DESC"
  sSQL = VBsprintf(sSQL, sCliente, _
         Format(dtpFInicio.Value, "yyyy/mm/dd"), _
         Format(dtpFFin.Value, "yyyy/mm/dd"))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

  Do While Not ADORS.EOF

    Set itemX = lvwPunto.ListItems.Add(, "k" + LeerCampo(ADORS!cAcumCode), Format(LeerCampo(ADORS!dAcumDate), "dd/mm/yyyy hh:mm"))
    itemX.SubItems(1) = LeerCampo(ADORS!nTarjNumb)
    itemX.SubItems(2) = LeerCampo(ADORS!nAcumImpo)
    itemX.SubItems(3) = LeerCampo(ADORS!nPuntCant)
    itemX.SubItems(4) = LeerCampo(ADORS!sUserDesc)

    If LeerCampo(ADORS!dExtoDate) = "" Then
      
      If LeerCampo(ADORS!cAjusFlag) <> CStr(kSI) Then
        
        itemX.Icon = 1
        itemX.SmallIcon = 1
        
      Else
      
        itemX.Icon = 3
        itemX.SmallIcon = 3
      
      End If
      
    Else
      itemX.SubItems(5) = Format(LeerCampo(ADORS!dExtoDate), "dd/mm/yyyy hh:mm")
      itemX.SubItems(6) = LeerCampo(ADORS!sUseEDesc)
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If

    ADORS.MoveNext

  Loop

  lblLabels(5).Caption = "Puntos   -   Del " + Format(dtpFInicio.Value, "dd/mm/yyyy") + " Al " + Format(dtpFFin.Value, "dd/mm/yyyy")
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Public Sub LlenarListaAcumulacionTicket()

  'Llena la lista Ticket

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim itemX As ListItem

  sSQL = "SELECT * " + _
         "FROM Acumulacion_Ticket " + _
         "WHERE cClieCode = $ AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') >= '$' AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') <= '$' " + _
         "Order by dAcumDate DESC"
  sSQL = VBsprintf(sSQL, sCliente, _
         Format(dtpFInicio.Value, "yyyy/mm/dd"), _
         Format(dtpFFin.Value, "yyyy/mm/dd"))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

  Do While Not ADORS.EOF

    Set itemX = lvwTicket.ListItems.Add(, "k" + LeerCampo(ADORS!cAcumCode), Format(LeerCampo(ADORS!dAcumDate), "dd/mm/yyyy hh:mm"))
    itemX.SubItems(1) = LeerCampo(ADORS!nTarjNumb)
    itemX.SubItems(2) = LeerCampo(ADORS!nTickCant)
    itemX.SubItems(3) = LeerCampo(ADORS!sUserDesc)

    If LeerCampo(ADORS!dExtoDate) = "" Then
      
      If LeerCampo(ADORS!cAjusFlag) <> CStr(kSI) Then
        
        itemX.Icon = 1
        itemX.SmallIcon = 1
        
      Else
      
        itemX.Icon = 3
        itemX.SmallIcon = 3
      
      End If
      
    Else
      itemX.SubItems(4) = Format(LeerCampo(ADORS!dExtoDate), "dd/mm/yyyy hh:mm")
      itemX.SubItems(5) = LeerCampo(ADORS!sUseEDesc)
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If

    ADORS.MoveNext

  Loop

  lblLabels(6).Caption = "Tickets   -   Del " + Format(dtpFInicio.Value, "dd/mm/yyyy") + " Al " + Format(dtpFFin.Value, "dd/mm/yyyy")
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Public Sub ManejarControles()

  'Maneja el uso de los controles

  On Error GoTo LineaError

  Call DeshabilitarControl(cmdExtornar(kPUNTO), False)
  Call DeshabilitarControl(cmdAjustar(kPUNTO), False)
  Call DeshabilitarControl(cmdExtornar(kTICKET), False)
  Call DeshabilitarControl(cmdAjustar(kTICKET), False)
  
  If piPerfil_Codigo = kPERFIL_ADMINISTRADOR Or piPerfil_Codigo = kPERFIL_SUPERVISOR Then

    If lvwPunto.ListItems.Count > 0 Then
      lvwPunto.SelectedItem.EnsureVisible
      Call HabilitarControl(cmdExtornar(kPUNTO), False)
      Call HabilitarControl(cmdAjustar(kPUNTO), False)
    End If
    
    If lvwTicket.ListItems.Count > 0 Then
      lvwTicket.SelectedItem.EnsureVisible
      Call HabilitarControl(cmdExtornar(kTICKET), False)
      Call HabilitarControl(cmdAjustar(kTICKET), False)
    End If

  End If

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPunto_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordenar Según la columna seleccionada

  On Error GoTo LineaError

  If ColumnHeader.Index = 1 Or ColumnHeader.Index = 6 Then

    Call APISort(lvwPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_DATE)

  ElseIf ColumnHeader.Index = 3 Or ColumnHeader.Index = 4 Then

    Call APISort(lvwPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_VALUE)

  Else

    Call APISort(lvwPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_DEFAULT)

  End If

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwTicket_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordenar Según la columna seleccionada

  On Error GoTo LineaError

  If ColumnHeader.Index = 1 Or ColumnHeader.Index = 5 Then

    Call APISort(lvwTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_DATE)

  ElseIf ColumnHeader.Index = 3 Then

    Call APISort(lvwTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_VALUE)

  Else

    Call APISort(lvwTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_DEFAULT)

  End If

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Public Sub cmdBuscar_Click()

  'Buscar Acumulacion según rango de fecha

  On Error GoTo LineaError

  lblLabels(5).Caption = "Puntos"
  lblLabels(6).Caption = "Tickets"
  
  lvwPunto.ListItems.Clear
  lvwTicket.ListItems.Clear

  LlenarListaAcumulacionPunto
  LlenarListaAcumulacionTicket
  
  dFInicio = dtpFInicio.Value
  dFFin = dtpFFin.Value
  
  ManejarControles

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtImporte_KeyPress(KeyAscii As Integer)

  'Valida q se ingrese solo valores numéricos (enteros)

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtImporte_LostFocus()

  'Formatea el texto
  
  On Error GoTo LineaError
  
  txtImporte.Text = Format(txtImporte.Text, "##,##0")
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub txtTicket_KeyPress(KeyAscii As Integer)

  'Valida q se ingrese solo valores numéricos (enteros)

  On Error GoTo LineaError

  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub txtTicket_LostFocus()

  'Formatea el texto
  
  On Error GoTo LineaError
  
  txtTicket.Text = Format(txtTicket.Text, "##,##0")
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdGrabar_Click(Index As Integer)

  'Inserta Acumulación

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Screen.MousePointer = vbHourglass
  
  If Not ValidarData(Index) Then GoTo Salir
  If Not ActualizarTabla(Index) Then GoTo Salir
  ActualizarLista (Index)
  ManejarControles
  
  GoTo Salir

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Screen.MousePointer = vbDefault
  
End Sub

Private Function ValidarData(iIndex As Integer) As Boolean

  'Valida que la información ingresada sea correcta y completa
  
  On Error GoTo LineaError
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  ValidarData = False
  
  If iIndex = kPUNTO Then
  
    If Trim(txtImporte.Text) = "" Then
      MsgBox "Ingresar Importe", vbOKOnly + vbInformation
      txtImporte.SetFocus
      GoTo Salir
    End If
    
    sSQL = "SELECT * FROM Regla_Punto"
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    If ADORS.EOF Then
    
      MsgBox "Reglas en relación a los puntos no han sido establecidos", vbOKOnly + vbInformation
      GoTo Salir
      
    Else
    
      If LeerCampo(ADORS!nImpoMaxi) <> "0" And LeerCampo(ADORS!nImpoMaxi) <> "" Then
      
        If CLng(txtImporte.Text) > CLng(LeerCampo(ADORS!nImpoMaxi)) Then
          MsgBox "Importe ingresado mayor al máximo permitido (" + Format(LeerCampo(ADORS!nImpoMaxi), "##,##0") + " Nuevo Soles)", vbOKOnly + vbInformation
          txtImporte.SetFocus
          GoTo Salir
        End If
      
      End If
      
      lReglaPuntoImporte = CLng(LeerCampo(ADORS!nPuntImpo))
      lReglaPuntoCantidad = CLng(LeerCampo(ADORS!nPuntCant))
      
    End If
    
  End If
  
  If iIndex = kTICKET Then
  
    If Trim(txtTicket.Text) = "" Then
      MsgBox "Ingresar Tickets", vbOKOnly + vbInformation
      txtTicket.SetFocus
      GoTo Salir
    End If
    
    sSQL = "SELECT * FROM Regla_Ticket"
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    If ADORS.EOF Then
    
      MsgBox "Reglas en relación a los tickets no han sido establecidos", vbOKOnly + vbInformation
      GoTo Salir
      
    Else
    
      If LeerCampo(ADORS!nTickMaxi) <> "0" And LeerCampo(ADORS!nTickMaxi) <> "" Then
      
        If CLng(txtTicket.Text) > CLng(LeerCampo(ADORS!nTickMaxi)) Then
          MsgBox "Cantidad de Tickets ingresado mayor al máximo permitido (" + Format(LeerCampo(ADORS!nTickMaxi), "##,##0") + ")", vbOKOnly + vbInformation
          txtTicket.SetFocus
          GoTo Salir
        End If
      
      End If
      
    End If
    
  End If
  
  ValidarData = True
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Function

Private Function ActualizarTabla(iIndex As Integer) As Boolean

  'Inserta el registro de Acumulacion_Punto/Acumulacion_Ticket

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim bConnFlag As Boolean

  ActualizarTabla = False

  sSQL = "SELECT MAX(cAcumCode) AS Codigo FROM $ " + _
         "WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, IIf(iIndex = kPUNTO, "Acumulacion_Punto", "Acumulacion_Ticket"), sCliente)
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError1

  sCodigo = "1"

  If Not ADORS.EOF Then

    If LeerCampo(ADORS!Codigo) <> "" Then
      sCodigo = CStr(ADORS!Codigo + 1)
    End If

  End If

  Set ADORS = Nothing
  
  ADOCnn.BeginTrans
  bConnFlag = True

  If iIndex = kPUNTO Then
  
    lPunto = Int(CLng(txtImporte.Text) / lReglaPuntoImporte) * lReglaPuntoCantidad

    sSQL = "INSERT INTO Acumulacion_Punto (cClieCode, cAcumCode, nTarjNumb, " + _
           "nAcumImpo, nPuntCant, sUserDesc, dAcumDate) " + _
           "VALUES($, $, '$', $, $, '$', '$')"
    sSQL = VBsprintf(sSQL, sCliente, sCodigo, sTarjeta, _
           Format(txtImporte.Text, "####0"), Format(lPunto, "####0"), _
           ReemplazarComilla(psUsuario_Descripcion), Format(Now, "yyyy/mm/dd hh:mm"))

    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

    sSQL = "UPDATE Cliente SET nPuntCant = nPuntCant + $, " + _
           "dUltTDate = '$', cTranCode = $ " + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, Format(lPunto, "####0"), _
           Format(Date, "yyyy/mm/dd"), _
           kTRAN_ACUMULA_PUNTOS, _
           sCliente)
           
  Else
  
    sSQL = "INSERT INTO Acumulacion_Ticket (cClieCode, cAcumCode, nTarjNumb, " + _
           "nTickCant, sUserDesc, dAcumDate) " + _
           "VALUES($, $, '$', $, '$', '$')"
    sSQL = VBsprintf(sSQL, sCliente, sCodigo, sTarjeta, _
           Format(txtTicket.Text, "####0"), _
           ReemplazarComilla(psUsuario_Descripcion), Format(Now, "yyyy/mm/dd hh:mm"))

    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

    sSQL = "UPDATE Cliente SET nTickCant = nTickCant + $, " + _
           "dUltTdate = '$', cTranCode = $ " + _
           "WHERE cClieCode = $"
    sSQL = VBsprintf(sSQL, Format(txtTicket.Text, "####0"), _
           Format(Date, "yyyy/mm/dd"), _
           kTRAN_ACUMULA_TICKETS, _
           sCliente)
  
  End If

  If oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then
    ADOCnn.CommitTrans
    bConnFlag = False
    ActualizarTabla = True
  Else
    GoTo LineaError1
  End If

  Exit Function

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

LineaError1:
  Set ADORS = Nothing
  If bConnFlag Then ADOCnn.RollbackTrans
  
End Function

Private Sub ActualizarLista(iIndex As Integer)

  'Actualiza las listas

  On Error GoTo LineaError
  
  Dim itemX As ListItem
  
  If iIndex = kPUNTO Then
  
    lblPuntos.Caption = Format(CLng(lblPuntos.Caption) + lPunto, "##,##0")
    frmPrincipal.lvwCliente.SelectedItem.SubItems(4) = lblPuntos.Caption
    
    If Date >= dFInicio And Date <= dFFin Then
  
      Set itemX = lvwPunto.ListItems.Add(, "k" + sCodigo, Format(Now, "dd/mm/yyyy hh:mm"))
      itemX.SubItems(1) = sTarjeta
      itemX.SubItems(2) = Format(txtImporte.Text, "##,##0")
      itemX.SubItems(3) = Format(lPunto, "##,##0")
      itemX.SubItems(4) = psUsuario_Descripcion
    
      itemX.Icon = 1
      itemX.SmallIcon = 1
    
      itemX.Selected = True
      
    Else
    
      dtpFInicio.Value = Date - 15
      dtpFFin.Value = Date
      
      Call cmdBuscar_Click
      
    End If
    
    txtImporte.Text = ""
    
  Else
  
    lblTickets.Caption = Format(CLng(lblTickets.Caption) + CLng(txtTicket.Text), "##,##0")
    frmPrincipal.lvwCliente.SelectedItem.SubItems(5) = lblTickets.Caption
    
    If Date >= dFInicio And Date <= dFFin Then
  
      Set itemX = lvwTicket.ListItems.Add(, "k" + sCodigo, Format(Now, "dd/mm/yyyy hh:mm"))
      itemX.SubItems(1) = sTarjeta
      itemX.SubItems(2) = Format(txtTicket.Text, "##,##0")
      itemX.SubItems(3) = psUsuario_Descripcion
    
      itemX.Icon = 1
      itemX.SmallIcon = 1
    
      itemX.Selected = True
      
    Else
    
      dtpFInicio.Value = Date - 15
      dtpFFin.Value = Date
      
      Call cmdBuscar_Click
      
    End If
    
    txtTicket.Text = ""
    
  End If
         
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdExtornar_Click(Index As Integer)

  'Extornar

  On Error GoTo LineaError
  
  If Index = kPUNTO Then
    ExtornarPunto
  Else
    ExtornarTicket
  End If
  
  Screen.MousePointer = vbDefault

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

End Sub

Private Sub ExtornarPunto()

  'Extornar Acumulacion de Puntos

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim itemX As ListItem
  Dim bConnFlag As Boolean

  Dim lCantidad As Long

  Screen.MousePointer = vbHourglass

  If lvwPunto.SelectedItem.SmallIcon = 2 Then
    MsgBox "Transacción ya ha sido extornada", vbOKOnly + vbInformation
    Exit Sub
  ElseIf lvwPunto.SelectedItem.SmallIcon = 3 Then
    MsgBox "Los ajustes no pueden ser extornados", vbOKOnly + vbInformation
    Exit Sub
  End If
  
  lCantidad = CLng(lvwPunto.SelectedItem.SubItems(3))

  If CLng(lblPuntos.Caption) < lCantidad Then
    MsgBox "No se puede ejecutar el proceso. Puntos acumulados actualmente menor a la cantidad a extornar.", vbOKOnly + vbInformation
    Exit Sub
  End If

  If MsgBox("Se extornará transacción seleccionada (Fecha: " + lvwPunto.SelectedItem.Text + " - Cantidad: " + lvwPunto.SelectedItem.SubItems(3) + "). Confirma Acción?", _
  vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

  ADOCnn.BeginTrans
  bConnFlag = True

  sSQL = "UPDATE Acumulacion_Punto SET dExtoDate = '$', sUseEDesc = '$' " + _
         "WHERE cClieCode = $ AND cAcumCode = $"
  sSQL = VBsprintf(sSQL, Format(Now, "yyyy/mm/dd hh:mm"), ReemplazarComilla(psUsuario_Descripcion), sCliente, _
         Mid(lvwPunto.SelectedItem.Key, 2))

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  sSQL = "UPDATE Cliente SET nPuntCant = nPuntCant - $ " + _
         "WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, Format(lvwPunto.SelectedItem.SubItems(3), "####0"), _
         sCliente)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  ADOCnn.CommitTrans
  bConnFlag = False

  Set itemX = lvwPunto.SelectedItem

  itemX.SubItems(5) = Format(Now, "dd/mm/yyyy hh:mm")
  itemX.SubItems(6) = psUsuario_Descripcion
  itemX.Icon = 2
  itemX.SmallIcon = 2
  
  lblPuntos.Caption = Format(CLng(lblPuntos.Caption) - lCantidad, "##,##0")
  frmPrincipal.lvwCliente.SelectedItem.SubItems(4) = lblPuntos.Caption

  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

LineaError1:
  If bConnFlag Then ADOCnn.RollbackTrans

End Sub

Private Sub ExtornarTicket()

  'Extornar Acumulacion de Tickets

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim itemX As ListItem
  Dim bConnFlag As Boolean

  Dim lCantidad As Long

  Screen.MousePointer = vbHourglass

  If lvwTicket.SelectedItem.SmallIcon = 2 Then
    MsgBox "Transacción ya ha sido extornada", vbOKOnly + vbInformation
    Exit Sub
  ElseIf lvwTicket.SelectedItem.SmallIcon = 3 Then
    MsgBox "Los ajustes no pueden ser extornados", vbOKOnly + vbInformation
    Exit Sub
  End If
  
  lCantidad = CLng(lvwTicket.SelectedItem.SubItems(2))

  If CLng(lblTickets.Caption) < lCantidad Then
    MsgBox "No se puede ejecutar el proceso. Tickets acumulados actualmente menor a la cantidad a extornar.", vbOKOnly + vbInformation
    Exit Sub
  End If

  If MsgBox("Se extornará transacción seleccionada (Fecha: " + lvwTicket.SelectedItem.Text + " - Cantidad: " + lvwTicket.SelectedItem.SubItems(2) + "). Confirma Acción?", _
  vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

  ADOCnn.BeginTrans
  bConnFlag = True

  sSQL = "UPDATE Acumulacion_Ticket SET dExtoDate = '$', sUseEDesc = '$' " + _
         "WHERE cClieCode = $ AND cAcumCode = $"
  sSQL = VBsprintf(sSQL, Format(Now, "yyyy/mm/dd hh:mm"), ReemplazarComilla(psUsuario_Descripcion), sCliente, _
         Mid(lvwTicket.SelectedItem.Key, 2))

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  sSQL = "UPDATE Cliente SET nTickCant = nTickCant - $ " + _
         "WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, Format(lvwTicket.SelectedItem.SubItems(2), "####0"), _
         sCliente)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  ADOCnn.CommitTrans
  bConnFlag = False

  Set itemX = lvwTicket.SelectedItem

  itemX.SubItems(4) = Format(Now, "dd/mm/yyyy hh:mm")
  itemX.SubItems(5) = psUsuario_Descripcion
  itemX.Icon = 2
  itemX.SmallIcon = 2
  
  lblTickets.Caption = Format(CLng(lblTickets.Caption) - lCantidad, "##,##0")
  frmPrincipal.lvwCliente.SelectedItem.SubItems(5) = lblTickets.Caption

  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

LineaError1:
  If bConnFlag Then ADOCnn.RollbackTrans

End Sub

Private Sub cmdAjustar_Click(Index As Integer)

  'Invoca al form Ajuste

  On Error GoTo LineaError
  
  psLista = Index
  frmAjuste.Show vbModal
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdCliente_Click()

  'Invoca al formulario Usuario
  
  On Error GoTo LineaError
  
  frmCliente.iEditar = kCMD_VER
  frmCliente.Show vbModal
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub cmdSalir_Click()

  'Descargar Form

  On Error GoTo LineaError
  
  Unload Me

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub
