VERSION 5.00
Begin VB.Form frmAnulaTransaccion 
   Caption         =   "Anula Transacción"
   ClientHeight    =   6375
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5610
   Icon            =   "frmAnulaTransaccion.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6375
   ScaleWidth      =   5610
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txttipo 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   840
      TabIndex        =   12
      Top             =   0
      Visible         =   0   'False
      Width           =   675
   End
   Begin VB.TextBox txtsupervisor 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   4245
      MaxLength       =   6
      TabIndex        =   11
      Top             =   5925
      Visible         =   0   'False
      Width           =   1230
   End
   Begin VB.TextBox txtnumero 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   2400
      TabIndex        =   4
      Top             =   330
      Width           =   1770
   End
   Begin VB.TextBox txtserie 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   1665
      TabIndex        =   2
      Top             =   330
      Width           =   675
   End
   Begin VB.CommandButton cmdBuscar 
      Appearance      =   0  'Flat
      Caption         =   "&Buscar"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   555
      Left            =   4380
      Picture         =   "frmAnulaTransaccion.frx":08CA
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   195
      Width           =   735
   End
   Begin VB.CommandButton cmdSalir 
      Cancel          =   -1  'True
      Caption         =   "&Salir"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   2760
      TabIndex        =   10
      Top             =   5760
      Width           =   1185
   End
   Begin VB.CommandButton cmdAnular 
      Caption         =   "&Anular"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   1080
      TabIndex        =   9
      Top             =   5760
      Width           =   1185
   End
   Begin VB.TextBox txtTexto 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4470
      Left            =   165
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   8
      Top             =   1215
      Width           =   5250
   End
   Begin VB.TextBox txtTransaccion 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   3000
      TabIndex        =   7
      Top             =   765
      Visible         =   0   'False
      Width           =   1230
   End
   Begin VB.CheckBox chkAlterno 
      Caption         =   "&O/C, NC , PADE,  PADV"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   195
      TabIndex        =   6
      Top             =   810
      Width           =   2655
   End
   Begin VB.Label txtnumeri 
      Caption         =   "&Número"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   255
      Left            =   2715
      TabIndex        =   3
      Top             =   45
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "&Serie"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   255
      Left            =   1695
      TabIndex        =   1
      Top             =   45
      Width           =   765
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "&Documento:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   210
      TabIndex        =   0
      Top             =   405
      Width           =   1245
   End
End
Attribute VB_Name = "frmAnulaTransaccion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iTipoVenta As Integer '1:Normal 2:Voucher 3:Dolares 4:Transaccion Anulada
Dim nTipoCambio As Double
Dim dFechaOperacion As Date
Dim Producto() As tProducto 'Almacena los datos de cada producto que se va registrando
Dim nProducto As Long 'Cantidad de productos por transaccion
Dim sTarjeta As String 'Tarjeta del Cliente
Dim sUsuario As String 'Usuario que registor transaccion
Dim sTexto0 As String 'Bloques para la impresion
Dim sTexto1 As String 'Bloques para la impresion
Dim sTexto2 As String 'Bloques para la impresion
Dim sTexto3 As String 'Bloques para la impresion

Dim iEfectivo As Double, iVuelto As Double
Dim lstarjeta As String
Dim ldtFecha As Date
Dim lTotal As Double
Dim Busq1 As Boolean
 
Public bAcceso As Boolean

'sw To SQL Server
Dim sIdLocal As String

Private Sub chkAlterno_Click()
If chkAlterno.Value = 1 Then
   txttipo.Text = ""
   txtNumero.Text = ""
   txtSerie.Text = ""
   Busca_operparalela
   Buscar
   'txtTransaccion.Visible = True
Else
   Busca_operacion
   'txtTransaccion.Visible = False
End If
End Sub
Private Sub chkAlterno_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If chkAlterno.Value = 1 Then
       chkAlterno.Value = 0
    Else
       chkAlterno.Value = 1
    End If
End If
End Sub
Private Function ValidarAnulacionOC(ByVal sSerie As String, ByVal sNumero As String) As Boolean
Dim sSQL As String
Dim ADORS As ADODB.Recordset

sSQL = "SELECT  * FROM OperacionParalela WHERE cDocSerie='" & sSerie & "' AND cDocCodigo=" & sNumero & " "

If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

If LeerCampo(ADORS("cOperCodeRela")) <> 0 Then
    Dim nOper As Integer
    nOper = LeerCampo(ADORS("cOperCodeRela"))
    
    sSQL = "SELECT  * FROM OperacionParalela WHERE cOperCode=" & nOper
    
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
    If LeerCampo(ADORS("cDocTipo")) = "14" Then
        ValidarAnulacionOC = False
    Else
        ValidarAnulacionOC = True
    End If
Else
    ValidarAnulacionOC = True
End If

Salir:

  Set ADORS = Nothing
End Function
Private Sub cmdAnular_Click()
  On Error GoTo LineaError
  
  Dim sFecha As String, sTexto As String
  Dim iCodOper As Long
  Dim iSigno As Integer
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim i As Long
  Dim iTransaccion As Long
  Dim p As Integer
  
  If Not IsNumeric(txtTransaccion.Text) Then GoTo Salir
  iTransaccion = CLng(txtTransaccion.Text)
  
  bAcceso = False
  Load frmAutorizarOperacion
  Set frmAutorizarOperacion.frmPadre = Me
  frmAutorizarOperacion.Show vbModal
  If Not bAcceso Then Exit Sub
  'bAcceso = False
 
  If chkAlterno.Value = 0 Then
    sSQL = " SELECT count(*) as TOTAL" & _
           " FROM Operacion" & _
           " WHERE cOperCodeAnula =$" & _
           " AND cOperFlagAbierto = 1"
           
    sSQL = VBsprintf(sSQL, CStr(iTransaccion))

    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
    If LeerCampo(ADORS("Total")) <> 0 Then
      MsgBox "Esta transacción ya ha sido anulada"
      'txtTransaccion.SetFocus
      GoTo Salir
    End If
    ConfiguraImpresora kPAR_IMPRESORA
    p = 1
  Else
    If Left(Trim(txtSerie.Text), 2) = "OC" Then
        If ValidarAnulacionOC(Trim(txtSerie.Text), Trim(txtNumero.Text)) = False Then
            MsgBox "La OC tiene una Liquidacion asociada...No se puede eliminar!", vbInformation + vbOKOnly
            Exit Sub
        End If
    End If
    ConfiguraImpresora kPAR_IMPRESORA_ALTERNA
    p = 2
  End If
  '------------------------
  '-- Registra Anulacion --
  '------------------------
  If iTipoVenta = 3 Then
    If MsgBox("Este es un documento proveniente de una Liquidación " + Chr(13) + "Al Anular el documento se anulara la liquidación " + Chr(13) + "Desea Continuar?", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmación") = vbNo Then
      Exit Sub
    End If
  End If
  
  If chkAlterno.Value = 0 Then
    sSQL = " SELECT MAX(cOperCode) AS maximo FROM Operacion"
  Else
    sSQL = " SELECT MAX(cOperCode) AS maximo FROM OperacionParalela"
  End If
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  If ADORS.RecordCount = 1 Then
    If IsNull(ADORS("maximo")) Then
      iCodOper = 1
    Else
      iCodOper = LeerCampo(ADORS("maximo")) + 1
    End If
  End If

   
     'SE OBTIENE FECHA DEL SISTEMA DE LA BASE DE DATOS DE SQL - version 2.0.5
   
   Dim cnFECHASQL As ADODB.Connection
   Dim sqlFECHASIS As String
   Dim rsFEchaSis As ADODB.Recordset
      
   If oDBAdmin.AbrirBD(cnFECHASQL, psConnectString, False) = True Then
     
     sqlFECHASIS = "select convert(varchar,getdate(),120) as fechasis"
     If oDBAdmin.EjecutarConsulta(cnFECHASQL, sqlFECHASIS, rsFEchaSis) = True Then
         
         If rsFEchaSis!fechasis <> "" Then
             sFecha = rsFEchaSis!fechasis
         End If

     Else
         'no pudo abrir el rs: que consulte al access
         'MsgBox "No se pudo obtener la fecha, hay problemas de conexión de la red con la Base de Datos Principal", vbOKOnly + vbExclamation, "Aviso"
         sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
         'Unload Me
     End If

     Set cnFECHASQL = Nothing

   Else
     'no pudo conectarse al sql: que consulte al access
      'MsgBox "No se pudo obtener la fecha, hay problemas de conexión de la red con la Base de Datos Principal", vbOKOnly + vbExclamation, "Aviso"
      sFecha = Format(Now(), "DD/MM/YYYY hh:mm")
      'Unload Me
   End If
   
   'FIN FECHA DEL SISTEMA DE LA BASE DE DATOS DE SQL
   


  'sFecha = Format(Now(), "DD/MM/YYYY hh:mm")

  Set ADORS = Nothing
  
  iSigno = -1
  
  If chkAlterno.Value = 0 Then
   
    For i = 1 To nProducto
      'sw To SQL Server add >>> IdLocal (con sIdLocal)
      If sIdLocal = "" Then
      sSQL = "INSERT INTO OPERACION (cOperCode, cUserDesc, cAlmaCode, cProdCode, nProdCant, nProdPrecUnit," & _
                                    " dOperFech, cOperTipo, cOperFlagAnula, cOperCodeAnula, cCajaCodi, cTurnoCodi) " + _
             "VALUES" + _
             "($, '$', '$', $, $, '$', '$', $, $, '$', '$', '$')"
      
      sSQL = VBsprintf(sSQL, CStr(iCodOper), psUsuario_Descripcion, Producto(i).Almacen, CStr(Producto(i).Codigo), CStr(Producto(i).Cant * iSigno), _
                             CStr(Producto(i).PUnit), sFecha, CStr(iTipoVenta), "1", CStr(CLng(txtTransaccion.Text)), kPAR_CAJA, kPAR_TURNO)
      Else
      sSQL = "INSERT INTO OPERACION (cOperCode, cUserDesc, cAlmaCode, cProdCode, nProdCant, nProdPrecUnit," & _
                                    " dOperFech, cOperTipo, cOperFlagAnula, cOperCodeAnula, cCajaCodi, cTurnoCodi, IdLocal) " + _
             "VALUES" + _
             "($, '$', '$', $, $, '$', '$', $, $, '$', '$', '$', $)"
      
      sSQL = VBsprintf(sSQL, CStr(iCodOper), psUsuario_Descripcion, Producto(i).Almacen, CStr(Producto(i).Codigo), CStr(Producto(i).Cant * iSigno), _
                             CStr(Producto(i).PUnit), sFecha, CStr(iTipoVenta), "1", CStr(CLng(txtTransaccion.Text)), kPAR_CAJA, kPAR_TURNO, sIdLocal)
      End If
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
      
      sSQL = " UPDATE OPERACION " & _
             " SET cOperFlagAnula = 1 " & _
             " WHERE cOperCode = $"
           
      sSQL = VBsprintf(sSQL, CStr(CLng(txtTransaccion.Text)))
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    Next
  Else
    sSQL = " INSERT INTO OPERACIONPARALELA (cOperCode, cOperTipo, dOperFech, " & _
           " sGlosa, cEstado, cCajaCodi, cTurnoCodi, cUserDesc)" & _
           " VALUES" & _
           " ($, $, '$', '$', '$', '$', '$', '$')"
    sSQL = VBsprintf(sSQL, CStr(iCodOper), CStr(iTipoVenta), sFecha, "ANULACION", CStr(0), _
           kPAR_CAJA, kPAR_TURNO, psUsuario_Descripcion)
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    
    sSQL = " UPDATE OPERACIONPARALELA" & _
           " SET cEstado = '0'," & _
           " cOpercodeAnul = $" & _
           " WHERE cOperCode = $"
           
    sSQL = VBsprintf(sSQL, CStr(iCodOper), CStr(iTransaccion))
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
    
    sSQL = "DELETE FROM Operacion " & _
           "WHERE cOpercode= $ AND cOperFlagAbierto=1 AND cDocTipo in ('10', '14')"
    sSQL = VBsprintf(sSQL, CStr(CStr(iTransaccion)))
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
  End If
  
  Dim sLCodRela As String
  If iTipoVenta = 3 Or iTipoVenta = 20 Then
    If chkAlterno.Value = 0 Then
      sSQL = " SELECT cOperCodeAnula as CodRela" & _
             "  FROM Operacion" & _
             " WHERE cOperCode =$" & _
             "   AND cOperFlagAbierto = 1 "
    Else
      sSQL = " SELECT cOperCodeRela as CodRela" & _
             "   FROM OperacionParalela" & _
             "  WHERE cOperCode =$" & _
             "   AND cOperFlagAbierto = 1 "
    End If
    
    sSQL = VBsprintf(sSQL, CStr(iTransaccion))
    If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
        
    If val("0" & (ADORS!codRela)) <> 0 Then
           
      If Not ADORS.EOF Then sLCodRela = LeerCampo(ADORS!codRela)
            
      sSQL = "UPDATE OperacionParalela SET cEstado= '1', cOperCodeRela=0 " & _
             "WHERE cOperTipo <> 20 AND cOpercodeRela= $ "
      sSQL = VBsprintf(sSQL, sLCodRela)
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
            
      sSQL = "DELETE FROM OperacionParalela " & _
             "WHERE cOpercode= $ AND cOperFlagAbierto=1"
                    
      sSQL = VBsprintf(sSQL, sLCodRela)
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
            
      sSQL = "DELETE FROM Operacion " & _
             "WHERE cOpercode= $ AND cOperFlagAbierto=1"
      sSQL = VBsprintf(sSQL, sLCodRela)
      If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
            
    End If
  End If
  
  sTexto = ""
  sTexto = sTexto + sTexto0 + vbCrLf
  sTexto = sTexto + "             " + Format(CStr(Now()), "DD/MM/YYYY (DDD)") + vbCrLf
  sTexto = sTexto + Right(Space(20) & "TRANSACCION ANULADA", Int(Len("TRANSACCION ANULADA") / 2) + 20) + vbCrLf
  
  sTexto = sTexto + sTexto1 + vbCrLf
   
  sTexto = sTexto + sTexto2 + vbCrLf
 
  sTexto = sTexto + sTexto3
    
  sTexto3 = ""
  sTexto3 = vbCrLf + Right(Space(20) + "TRANSACCION ANULADA", Int(Len("TRANSACCION ANULADA") / 2) + 20) + vbCrLf
  sTexto = sTexto + sTexto3 + vbCrLf
  
  sTexto = sTexto + " " + Left(psUsuario_Descripcion, 10) + " "  'Usuario: 10 + 1
  sTexto = sTexto + Format(CStr(Now()), "hh:mm") + " " 'Hora: 6 + 1
  sTexto = sTexto + vbCrLf + "Supervisor: " + Left(txtsupervisor, 10) + " " + vbCrLf 'supervisor: 10 + 1
  sTexto = sTexto + vbCrLf + "CAJA: " + kPAR_CAJA + "   TURNO: " + kPAR_TURNO
  sTexto = sTexto + vbCrLf & "Correlativo: " & ObtenerCorrelativo(p)
  
  If p = 1 Then
  Select Case KImpresora
    Case 1
      Call CortePapel(sTexto, p, CStr(iCodOper))
    Case 0
      printer.Print sTexto
      printer.Print " "
      printer.Print " "
      printer.EndDoc
    End Select
  Else
    Select Case KImpresoraALT
      Case 1
        Call CortePapel(sTexto, p)
      Case 0
        printer.Print sTexto
        printer.Print " "
        printer.Print " "
        printer.EndDoc
    End Select
  End If
  
  If Trim(lstarjeta) <> "" And Trim(sIdLocal) <> "" Then
    'sw To SQL Server era
    'sw Extorna_puntos lstarjeta, ldtFecha, CDbl(lTotal)
    Extorna_puntos lstarjeta, ldtFecha, CDbl(lTotal), sIdLocal
    lstarjeta = ""
  End If
  
  Dim sTotalPago As String
  Dim cnSQL As ADODB.Connection
  
  If Not oDBAdmin.AbrirBD(cnSQL, psConnectString) Then GoTo Salir
  
  sSQL = "SELECT COUNT(1) TOTAL FROM pagos WHERE FechaAnulacion IS NULL AND cSerieDocPago='" & txtSerie.Text & "' AND CONVERT(INT,NroDocPago)=" & CStr(CLng(Trim(txtNumero.Text))) & ""
  If Not oDBAdmin.EjecutarConsulta(cnSQL, sSQL, ADORS) Then GoTo Salir
  sTotalPago = LeerCampo(ADORS("TOTAL"))
  
  If sTotalPago <> "0" Then
    sSQL = "UPDATE pagos SET FechaAnulacion = getdate() WHERE cSerieDocPago='" & txtSerie.Text & "' AND CONVERT(INT,NroDocPago)=" & CStr(CLng(Trim(txtNumero.Text))) & ""
    If Not oDBAdmin.EjecutarSentencia(cnSQL, sSQL) Then GoTo Salir
  End If
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set ADORS = Nothing
  Me.cmdAnular.Enabled = False
End Sub

Private Sub cmdBuscar_Click()
'If chkAlterno.Value = 1 Then
 '  Buscar
'Else
  BuscarDocumento
'End If
End Sub

Private Sub cmdsalir_Click()
Unload Me
End Sub

Private Sub Form_Load()
  Busq1 = True
  Busca_operacion
  Busq1 = False
End Sub

Private Sub txtnumero_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
  BuscarDocumento
End If
End Sub
Private Sub txtNumero_KeyPress(KeyAscii As Integer)
 On Error GoTo LineaError
  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub
Private Sub txtnumero_LostFocus()
If Trim(txtNumero.Text) <> Empty Then BuscarDocumento
End Sub
Private Sub txtserie_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
   BuscarDocumento
End If
End Sub

Private Sub txtTransaccion_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
  Buscar
End If
End Sub

Private Sub txtTransaccion_KeyPress(KeyAscii As Integer)
  On Error GoTo LineaError
  Call ValidKeyPress(KeyAscii, kVKP_NUMERIC_INTEGER_ONLY)
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
End Sub

Private Sub Buscar()

  On Error GoTo LineaError
 
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim i As Long, j As Long
  Dim iTransaccion As Long
  
  If Not IsNumeric(txtTransaccion.Text) Then GoTo Salir
  iTransaccion = CLng(txtTransaccion.Text)
  
  If chkAlterno.Value = 0 Then
    'Normal
    sSQL = " SELECT count(*) as TOTAL" & _
           " FROM Operacion" & _
           " WHERE cOperCodeAnula =$ " & _
           " AND cOperFlagAbierto = 1 and cdoctipo in ('02', '01')"
  Else
    'Alterno
    sSQL = " SELECT count(*) as TOTAL" & _
           " FROM OperacionParalela" & _
           " WHERE cOperCode =$" & _
           " AND cEstado ='1' AND coperFlagabierto= 1 and cDoctipo in ('10', '11', '12', '13') "
  End If
  
  sSQL = VBsprintf(sSQL, CStr(iTransaccion))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir


  If chkAlterno.Value = 0 Then
    'Normal
    sSQL = " SELECT O.cOperCode, O.cUserDesc, O.nTarjNumb, O.cProdCode, O.cAlmaCode, O.nProdCant, O.nProdPrecUnit," & _
           " O.dOperFech, O.cOperTipo, O.cOperFlagAnula, P.sProdDesc, P.sProdDescCrta, 0 AS nDscto, O.nServicio" & _
           " FROM Operacion AS O INNER JOIN Producto AS P ON O.cProdCode = P.cProdCode " & _
           " WHERE O.cOperCode =$ AND O.cOperFlagAbierto = 1 ORDER BY O.cOperID"
  Else
    'Alterno
    sSQL = " SELECT O.cOperCode, O.cUserDesc, O.nTarjNumb, O.dOperFech, O.cOperTipo," & _
           " O.cOperCodeRela, O.nVueltoSoles, O.nEfectivoSoles, B.cAlmaCode, B.cProdCode, B.nProdCant," & _
           " B.nProdPrecUnit, B.nDscto, B.sProdDescCrta, B.nServicio" & _
           " FROM OperacionParalela AS O LEFT JOIN" & _
           " (SELECT A.cOperCode, A.cProdCode, A.nProdCant, A.nProdPrecUnit, A.nDscto," & _
           " P.sProdDescCrta, A.cAlmaCode, A.nServicio FROM OperacionParalelaProducto as A INNER JOIN Producto AS P" & _
           " ON A.cProdCode = P.cProdCode ) AS B ON O.cOperCode = B.cOperCode" & _
           " WHERE O.cOperCode = $ AND O.cEstado IN ('1') and o.cOperFlagAbierto=1 "
  End If
  
  sSQL = VBsprintf(sSQL, CStr(iTransaccion))

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  If ADORS.RecordCount < 1 Then
    If Not Busq1 Then
      MsgBox "El número de transacción no existe o ya ha sido cerrada."
    End If
    txtTexto.Text = ""
    txtTransaccion.Text = ""
    GoTo Salir
  End If
  
  If chkAlterno.Value = 0 Then
    'Normal
    If LeerCampo(ADORS("cOperFlagAnula")) <> "0" Then
      MsgBox "Esta es una transacción de anulación. No puede ser anulada"
      GoTo Salir
    End If
    If LeerCampo(ADORS("cOperTipo")) <> "1" And LeerCampo(ADORS("cOperTipo")) <> "2" And _
      LeerCampo(ADORS("cOperTipo")) <> "3" Then
      MsgBox "No es una transacción de venta."
      GoTo Salir
    End If
  Else
    'Alterno
    iVuelto = LeerCampo(ADORS("nVueltoSoles"))
    iEfectivo = LeerCampo(ADORS("nEfectivoSoles"))
    
    If LeerCampo(ADORS("cOperTipo")) = 24 Then
      MsgBox "Esta es una transacción de liquidación. No puede ser anulada"
      Me.cmdAnular.Enabled = False
      GoTo Salir
    End If
  End If
  
  nProducto = ADORS.RecordCount
  iTipoVenta = LeerCampo(ADORS("cOperTipo"))
  dFechaOperacion = LeerCampo(ADORS("dOperFech"))
  sTarjeta = LeerCampo(ADORS("nTarjNumb"))
  sUsuario = LeerCampo(ADORS("cUserDesc"))
  
  
  ReDim Producto(nProducto)
  i = 1
  Do While Not ADORS.EOF
    Producto(i).Almacen = LeerCampo(ADORS("cAlmaCode"))
    Producto(i).Codigo = IIf(LeerCampo(ADORS("cProdCode")) = "", 0, LeerCampo(ADORS("cProdCode")))
    Producto(i).nombre = LeerCampo(ADORS("sProdDescCrta"))
    Producto(i).Cant = IIf(LeerCampo(ADORS("nProdCant")) = "", 0, LeerCampo(ADORS("nProdCant")))
    Producto(i).PUnit = IIf(LeerCampo(ADORS("nProdPrecUnit")) = "", 0, LeerCampo(ADORS("nProdPrecUnit")))
    Producto(i).Dscto = IIf(LeerCampo(ADORS("nDscto")) = "", 0, LeerCampo(ADORS("nDscto")))
    Producto(i).Serv = LeerCampo(ADORS("nServicio"))
    ADORS.MoveNext
    i = i + 1
  Loop
  
  Call CapturaTipoCambio
  Call MuestraTransaccion
  
  GoTo Salir
  
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set ADORS = Nothing
End Sub

Sub MuestraTransaccion()
  On Error GoTo LineaError
  
  Dim rsNC As ADODB.Recordset, ADORS As ADODB.Recordset
  Dim iTotal As Double, iSubTotal As Double, iTotItems As Double, iDscto As Double
  Dim iPagoAdelantado As Double, iSubTotalDscto As Double, iTotalDscto As Double, iServicio As Double
  Dim i As Long
  Dim sFecha As String
  Dim sTexto As String
  Dim iSigno As Integer
  Dim iFlagTipo As Integer
  Dim sSQL As String
  Dim iTransaccion As Long
  Dim smoneda As String
  smoneda = ""
  sTexto0 = ""
  sTexto1 = ""
  sTexto2 = ""
  sTexto3 = ""
    
  iTransaccion = Replace(txtTransaccion.Text, ",", "")
    
  Call CabeceraImpresion
  
  For i = 0 To UBound(sCabecera) - 1
    If Not Trim(sCabecera(i)) = "" Then
      sTexto0 = sTexto0 + Right(Space(60) + sCabecera(i), Int(Len(Space(40) + sCabecera(i)) / 2)) + vbCrLf
    End If
  Next
  
  If chkAlterno.Value = 0 Then
    'sw era >>> Select nTarjNumb, dOperFech  FROM Operacion ...
    sSQL = "Select * FROM Operacion WHERE cOperCode= " + Str(iTransaccion)
  Else
    sSQL = "Select nTarjNumb, dOperFech  FROM OperacionParalela WHERE cOperCode= " + Str(iTransaccion)
  End If
 
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  If Not ADORS.EOF Then
    lstarjeta = LeerCampo(ADORS!nTarjNumb)
    ldtFecha = LeerCampo(ADORS!dOperFech)
    
    'sw To SQL Server
    If chkAlterno.Value = 0 Then
      sIdLocal = LeerCampo(ADORS!idLocal)
    End If
  Else
    lstarjeta = ""
  End If
        
  sTexto1 = sTexto1 + "            " + Format(CStr(dFechaOperacion), "DD/MM/YYYY (DDD)") + vbCrLf
    
  'Cabecera segun tipo de venta
  Select Case iTipoVenta
    Case 2 'Voucher
      sTexto = "VOUCHER"
      sTexto = Right("                  " + sTexto, Int(Len(sTexto) / 2) + 20) + vbCrLf
    'Case 3 'Dolares
    '  sTexto = "U$(TC: " + Format(CStr(nTipoCambio), "###,##0.00") + ")"
    '  sTexto = Right("                 " + sTexto, Int(Len(sTexto) / 2) + 20) + vbCrLf
    Case 20 'O/C
      sTexto = "O/C"
      sTexto = Right("                  " + sTexto, Int(Len(sTexto) / 2) + 20)
    Case 21 'O/C
      sTexto = "N/C"
      sTexto = Right("                  " + sTexto, Int(Len(sTexto) / 2) + 20)
    Case 22 'O/C
      sTexto = "PADE"
      sTexto = Right("                  " + sTexto, Int(Len(sTexto) / 2) + 20)
    Case 23 'O/C
      sTexto = "PADV"
      sTexto = Right("                  " + sTexto, Int(Len(sTexto) / 2) + 20)
    Case 24 'O/C
      sTexto = "LIQPAD"
      sTexto = Right("                  " + sTexto, Int(Len(sTexto) / 2) + 20)
  End Select
  sTexto1 = sTexto1 + sTexto + vbCrLf
    
  iSubTotal = 0
  iTotal = 0
  iTotItems = 0
  sTexto = ""
  
  If iTipoVenta = 22 Or iTipoVenta = 23 Or iTipoVenta = 24 Then
    'Detalle de los N/C relacionados
    Dim iOperNC As Long
    Dim nSubtotal As Double
    Dim nItems As Long
    Dim nPrecUnit As Long
    'Dim nItems As Long
    Dim sProdDescCrta As String
    Dim nDscto As Double
    Dim sTeclDesc As String
    
    If iTipoVenta = 24 Then
      iTotal = 0
      iTotItems = 0
      
      sSQL = " SELECT SUM(nMontoSoles) as Adelantado FROM OperacionParalela" & _
             " Where cOperCodeRela = $"
      sSQL = VBsprintf(sSQL, CStr(iTransaccion))
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
      iPagoAdelantado = LeerCampo(ADORS("Adelantado"))
      
      sSQL = " SELECT cOperCode FROM OperacionParalela WHERE cOperCodeRela = " & CStr(iTransaccion) & " AND cEstado <> '0' AND cOperTipo = 21"
      sSQL = sSQL & " UNION SELECT cOperCode FROM OperacionParalela WHERE cEstado <> '0' AND cOperTipo = 21" & _
             " AND cOperCodeRela IN (SELECT cOperCode FROM OperacionParalela WHERE cOperCodeRela = " & CStr(iTransaccion) & _
             " AND cEstado <> '0' AND cOperTipo IN (22, 23)) "
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, rsNC) Then GoTo Salir
      
      Do While Not rsNC.EOF
        sSQL = " SELECT O.cOperCode, O.cProdCode, O.nProdCant, O.nProdPrecUnit, O.nDscto, P.sProdDescCrta," & _
               " O.nProdCant * O.nProdPrecUnit * (100 - O.nDscto) / 100 As TotalMonto," & _
               " c.cTeclCode , c.sTeclDesc FROM OperacionParalelaProducto O INNER JOIN" & _
               " (Producto P LEFT JOIN ConfiguracionTeclado AS C ON P.cProdCode = C.cProdCode)" & _
               " ON O.cProdCode = P.cProdCode AND O.cAlmaCode = P.cAlmaCode" & _
               " Where cOperCode = " + CStr(LeerCampo(rsNC("cOperCode")))
  
        If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
        nSubtotal = 0
        sTexto = sTexto + "---------------------------------------" + vbCrLf
        sTexto = sTexto + "TX" + CStr(LeerCampo(rsNC("cOperCode"))) + vbCrLf
        sTexto = sTexto + "Producto         Cant. Precio  SubTotal" + vbCrLf
       sTexto = sTexto + "---------------------------------------" + vbCrLf
        Do While Not ADORS.EOF
          nItems = LeerCampo(ADORS("nProdCant"))
          nPrecUnit = LeerCampo(ADORS("nProdPrecUnit"))
          sProdDescCrta = LeerCampo(ADORS("sProdDescCrta"))
          nDscto = LeerCampo(ADORS("nDscto"))
          sTeclDesc = IIf(LeerCampo(ADORS("sTeclDesc")) = "", "---", LeerCampo(ADORS("sTeclDesc")))
          
          sTexto = sTexto + Left(sProdDescCrta + Space(18), 18) & _
                    " " + Right(Space(7) & CStr(nItems), 4) & _
                    " " + Right(Space(6) & Format(CStr(nPrecUnit), "###,###,##0.00"), 6) & _
                    " " + Right(Space(7) & Format(LeerCampo(ADORS("TotalMonto")), "###,###,##0.00"), 7) + vbCrLf
          nSubtotal = nSubtotal + LeerCampo(ADORS("TotalMonto"))
          ADORS.MoveNext
        Loop
        sTexto = sTexto + "  AV./ITEM" + Right("                 *" + Format(CStr(nSubtotal), "###,###,##0.00"), 17) + vbCrLf
        
        iTotal = iTotal + nSubtotal
        iTotItems = iTotItems + nItems
        
        rsNC.MoveNext
      Loop
    ElseIf iTipoVenta = 22 Or iTipoVenta = 23 Then
      sSQL = " SELECT nMontoSoles, nMontoDolares, nMoneda FROM OperacionParalela" & _
             " Where cOperCode = $"
      sSQL = VBsprintf(sSQL, CStr(iTransaccion))
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
      smoneda = Trim(Str(ADORS("nMoneda")))
      If smoneda = "2" Then
        iTotal = LeerCampo(ADORS("nMontoDolares"))
      Else
        iTotal = LeerCampo(ADORS("nMontoSoles"))
      End If
    End If
      '----------------------------
          
  Else
        sTexto = sTexto + "Producto         Cant. Precio  SubTotal" + vbCrLf
        sTexto = sTexto + "---------------------------------------" + vbCrLf
    For i = 1 To nProducto
      iSubTotal = Producto(i).Cant * Producto(i).PUnit
       sTexto = sTexto + Left(Producto(i).nombre + Space(18), 18) & _
                     " " + Right(Space(7) & CStr(Producto(i).Cant), 4) & _
                    " " + Right(Space(6) & Format(CStr(Producto(i).PUnit), "###,###,##0.00"), 6) & _
                    " " + Right(Space(7) & Format(CStr(iSubTotal), "###,###,##0.00"), 7) + vbCrLf
      
'      sTexto = sTexto + Right("000" + CStr(Producto(i).Cant), 3) + " "  'Cant de productos: 3 + 1
'      sTexto = sTexto + Left(Producto(i).nombre + "          ", 10) + " " ' Descripcion corta del producto: 10 + 1
'      sTexto = sTexto + Right("          *" + Format(CStr(iSubTotal), "###,##0.00"), 11) + vbCrLf 'SubTotal 1 + 11
      iTotal = iTotal + iSubTotal
      iTotItems = iTotItems + Producto(i).Cant
    
      'Descuentos por O/C
      If iTipoVenta = 20 Then
        iDscto = Producto(i).Dscto
        iSubTotalDscto = Producto(i).Cant * Producto(i).PUnit * (100 - iDscto) / 100
        If Producto(i).Dscto <> 0 Then
          sTexto = sTexto + "   " + " "  'Cant de productos: 3 + 1
          sTexto = sTexto + Left("%Dscto          ", 10) + " " ' Descripcion corta del producto: 10 + 1
          sTexto = sTexto + Right("          *" + Format(CStr(iDscto), "###,##0.00"), 11) + vbCrLf 'SubTotal 1 + 11
        End If
        iTotalDscto = iTotalDscto + iSubTotalDscto
      Else
        iServicio = iServicio + (Producto(i).PUnit * Producto(i).Cant * (IIf(Producto(i).Serv <> "0", val(Producto(i).Serv), 0)) / 100)
      End If
    Next
  End If
  'Añade el % de servicio al total
 ' iTotal = iTotal + iServicio
  
  If iServicio <> 0 Then sTexto = sTexto + "  %SERVICIO" + Right("              *" + Format(CStr(iServicio), "###,###,##0.00"), 15) + vbCrLf
       
  sTexto = sTexto + "---------------------------------------" + vbCrLf
  sTexto1 = sTexto1 + sTexto
  sTexto = ""
  
  '--------------------------------
  'For i = 1 To nProducto
  '  iSubTotal = Producto(i).Cant * Producto(i).PUnit
  '  sTexto = sTexto + Right("000" + CStr(Producto(i).Cant), 3) + " "  'Cant de productos: 3 + 1
  '  sTexto = sTexto + Left(Producto(i).Nombre + "          ", 10) + " " ' Descripcion corta del producto: 10 + 1
  '  sTexto = sTexto + Right("          *" + Format(CStr(iSubTotal), "###,##0.00"), 11) + vbCrLf 'SubTotal 1 + 11
  '  iTotItems = iTotItems + Producto(i).Cant
  'Next
    
  'sTexto = sTexto + "--------------------------"
  'sTexto1 = sTexto1 + sTexto
  
  'sTexto = ""
  
  'Total segun tipo de venta
  Select Case iTipoVenta
    Case 1, 2, 3  'Normal, Voucher
      sTexto = "CASH/TL  " + Right(Space(28) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 29)
       'sTexto = "CASH/TL  " + Right(Space(28) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 29) + vbCrLf
      
      'sTexto = sTexto + "CASH/TL(U$)" + Right(Space(26) & "*" + Format(CStr(iTotal / nTipoCambio), "###,###,##0.00"), 27)
    'Case 3 'Dolares
     
    Case 4 'Anula Productos
      sTexto = "CASH/TL  " + Right(Space(28) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 29)
    Case 20 'O/C
      If iVuelto <> 0 Then
        sTexto = "SUB/TOTL " + Right(Space(28) & "*" + Format(CStr(iTotalDscto), "###,###,##0.00"), 29) + vbCrLf
        sTexto = sTexto + "EFECTIVO " + Right(Space(28) & "*" + Format(CStr(iEfectivo), "###,###,##0.00"), 29) + vbCrLf
        sTexto = sTexto + "VUELTO   " + Right(Space(28) & "*" + Format(CStr(iVuelto), "###,###,##0.00"), 29)
      Else
        sTexto = "CASH/TL  " + Right(Space(28) & "*" + Format(CStr(iTotalDscto), "###,###,##0.00"), 29)
      End If
    Case 21 'N/C
      sTexto = "CASH/TL  " + Right(Space(28) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 29)
    Case 22 'PADE
      sTexto = "CASH/TL  " + IIf(smoneda = "2", "$  ", "S/.") + Right(Space(26) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 26)
    Case 23 'PADV
      sTexto = "CASH/TL  " + IIf(smoneda = "2", "$  ", "S/.") + Right(Space(28) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 29)
    Case 24 'LIQPAD
      sTexto = "SUB/TOTL " + Right(Space(28) & "*" + Format(CStr(iTotal), "###,###,##0.00"), 29) + vbCrLf
      sTexto = sTexto + "PADE/PADV " + Right(Space(27) & "*" + Format(iPagoAdelantado, "###,###,##0.00"), 28) + vbCrLf
      sTexto = sTexto + "TOT-PAGAR " + Right(Space(27) & "*" + Format(iPagoAdelantado - iTotal, "###,###,##0.00"), 28) + vbCrLf
      sTexto = sTexto + "EFECTIVO " + Right(Space(28) & "*" + Format(CStr(iEfectivo), "###,###,##0.00"), 29) + vbCrLf
      sTexto = sTexto + "VUELTO   " + Right(Space(28) & "*" + Format(CStr(iVuelto), "###,###,##0.00"), 29)
  End Select
  smoneda = ""
  sTexto2 = sTexto2 + sTexto
    
  sTexto = "   ITEM  " + Right(Space(28) & "*" + Format(CStr(iTotItems), "###,##0.00"), 29)
    
  sTexto2 = sTexto2 + vbCrLf + sTexto + vbCrLf
    
  sTexto = ""
  
'  If chkAlterno.Value = 1 Then
 '   sTexto = sTexto + Space(10) & Right("000000" + CStr(txtTransaccion.Text), 6) + vbCrLf 'Codigo Transaccion: 6
 ' Else
    sTexto = sTexto + Space(10) & "Documento:" + txtSerie.Text + "-" + Right("0000000" & Trim(txtNumero.Text), 7) + vbCrLf
'  End If
  
'  sTexto = sTexto + Format(CStr(dFechaOperacion), "hh:mm") + " " + vbCrLf 'Hora: 6 + 1
'  sTexto = sTexto + "           " + Left(sUsuario, 10) + " " 'Usuario: 10 + 1
  sTexto3 = sTexto3 + vbCrLf + sTexto
  
  txtTexto.Text = sTexto0 + vbCrLf + sTexto1 + vbCrLf + sTexto2 + vbCrLf + sTexto3
  
'  If iTipoVenta = 3 Then iTipoVenta = 1
 lTotal = CDbl(iTotal)
  
 GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
End Sub

Sub CapturaTipoCambio()
  On Error GoTo LineaError
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  'Captura el tipo de cambio
  sSQL = " SELECT nTipoCambMont FROM Tipo_Cambio" & _
         " WHERE FORMAT(dTipoCambFech, 'yyyy/mm/dd') = '" & Format(CStr(dFechaOperacion), "yyyy/mm/dd") & "'"

  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  If ADORS.RecordCount <> 1 Then
    MsgBox "Para registrar ventas en dólares debe registrar el tipo de cambio"
  Else
    nTipoCambio = LeerCampo(ADORS("nTipoCambMont"))
  End If
  
  Screen.MousePointer = vbDefault
  
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

Salir:
  Set ADORS = Nothing
End Sub

Private Sub txtTransaccion_LostFocus()
  Buscar
End Sub
Public Sub BuscarDocumento()
Dim sSQL As String
Dim ADORS As ADODB.Recordset
Dim xwhere As String
xwhere = " "
If Trim(txtSerie.Text) <> Empty Then
    xwhere = " And cdocSerie like '" & Trim(txtSerie.Text) & "'"
End If
If Trim(txtNumero.Text) <> Empty Then
    xwhere = xwhere & " And cDocCodigo like '" & Trim(txtNumero.Text) & "'"
End If
If chkAlterno.Value = 0 Then
sSQL = "Select distinct cdocTipo, cdocSerie, cDocCodigo, cOpercode " & _
          " from Operacion " & _
          " Where " & _
          " cOperFlagAnula = 0  " & _
          " AND cOperFlagAbierto = 1 " & xwhere
Else
sSQL = "Select distinct cdocTipo, cdocSerie, cDocCodigo, cOpercode " & _
          " from OperacionParalela " & _
          " Where " & _
          " (cOperFlagAbierto = 1 OR cestado='1') " & xwhere
End If
If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
If ADORS.RecordCount > 0 Then
   If ADORS.RecordCount = 1 Then
      txttipo.Text = LeerCampo(ADORS!cdocTipo)
      txtSerie.Text = LeerCampo(ADORS!cDocSerie)
      txtNumero.Text = LeerCampo(ADORS!cDocCodigo)
      txtTransaccion.Text = "0" & (ADORS!cOperCode)
      Buscar
   Else
        
   End If
   Me.cmdAnular.Enabled = True
Else
   MsgBox "No existen coincidencias para el documento"
   txtTexto.Text = ""
   txtTransaccion.Text = ""
   Me.cmdAnular.Enabled = False
End If

Set ADORS = Nothing

Salir:

End Sub

Public Sub Busca_operparalela()
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim llMax As Long
  sSQL = "SELECT max(cOperCode) AS MAX FROM OperacionParalela " & _
         " WHERE " & _
         " (cOperCodeAnul = 0 OR cOperTipo=3 ) " & _
         " AND cEstado = '1' "
      
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  llMax = val("0" & ADORS!max)
      
  sSQL = "Select cOpercode, cdocTipo, cdocserie, cDocCodigo " & _
         " from Operacionparalela " & _
         " Where cOperCode = " & CStr(llMax)
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  
  If ADORS.RecordCount > 0 Then
    txttipo.Text = LeerCampo(ADORS!cdocTipo)
    txtSerie.Text = LeerCampo(ADORS!cDocSerie)
    txtNumero.Text = LeerCampo(ADORS!cDocCodigo)
    txtTransaccion.Text = "0" & (ADORS!cOperCode)
    Buscar
  End If
  Set ADORS = Nothing
  
Salir:
  
End Sub

Public Sub Busca_operacion()
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim llMax As Long

  sSQL = " SELECT MAX(cOpercode) as max " & _
        "  FROM Operacion " & _
        "  WHERE cDocTipo in ('02', '01') "
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
  If ADORS.RecordCount > 0 Then
    llMax = val("0" & ADORS!max)
    If llMax > 0 Then
        sSQL = "SELECT  count(*) as nulo FROM Operacion WHERE cOperFlagAnula= 1 and cOperFlagAbierto=1 AND cOperCodeAnula= " & Str(llMax)
        If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
        If val("0" & ADORS!nulo) = 0 Then
             sSQL = "SELECT cdocTipo, cdocSerie, cDocCodigo, cOpercode " & _
             " FROM Operacion " & _
             " WHERE cOperCode =" & Str(llMax)
             If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
                txttipo.Text = LeerCampo(ADORS!cdocTipo)
                txtSerie.Text = LeerCampo(ADORS!cDocSerie)
                txtNumero.Text = LeerCampo(ADORS!cDocCodigo)
                txtTransaccion.Text = "0" & (ADORS!cOperCode)
                Buscar
        End If
    End If
             
End If
      
'ssql = "SELECT cdocSerie, cDocCodigo, cOpercode " & _
'      " FROM Operacion " & _
'      " WHERE cOperCode = (SELECT MAX(cOpercode) " & _
'      "  FROM Operacion " & _
'      "  WHERE cDocTipo in ('02', '01') " & _
'      "  AND  NOT cOperCode  IN  " & _
'      " (SELECT  cOperCodeAnula FROM Operacion WHERE cOperFlagAnula= 1 and cOperFlagAbierto=1) )"
'If Not oDBAdmin.EjecutarConsulta(ADOCnn, ssql, ADORS) Then GoTo Salir
'If ADORS.RecordCount > 0 Then
'    txtserie.Text = LeerCampo(ADORS!cDocSerie)
'    txtnumero.Text = LeerCampo(ADORS!cDocCodigo)
'    txtTransaccion.Text = "0" & (ADORS!cOpercode)
'    Buscar
'End If
  Set ADORS = Nothing
  
Salir:
  
End Sub

Public Sub Extorna_puntos(tarjeta As String, fecha As Date, Total As Double, ByVal nIdLocal As String)

  Dim sSQL As String
  Dim sSubQry As String
  Dim ADORS As ADODB.Recordset
  Dim Cliente As Long
  Dim nPuntCant As Long
  Dim lReglaImporteMaximo As Long
  Dim lReglaPuntoImporte As Long
  Dim lReglaPuntoCantidad As Long

  '---------------------------------------------------------------------
  If bolExistenProblemasConexionBDCliente = False Then
    ConectarBDCliente     'Abrimos conexion
  End If
  
  If bolExisteConexionBDCliente = True Then
    sSQL = "SELECT * FROM Regla_Punto"
    If Not oDBAdmin.EjecutarConsulta(ADOCnn2, 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
    End If
    lReglaImporteMaximo = LeerCampo(ADORS!nImpoMaxi)
    lReglaPuntoImporte = CLng(LeerCampo(ADORS!nPuntImpo))
    lReglaPuntoCantidad = CLng(LeerCampo(ADORS!nPuntCant))
    'Actualizamos estos parametros en la BD Local
    sSQL = " UPDATE Regla_Punto" & _
           "    SET nImpoMaxi = " & lReglaImporteMaximo & "," & _
           "        nPuntImpo = " & lReglaPuntoImporte & "," & _
           "        nPuntCant = " & lReglaPuntoCantidad
    If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo Salir
               
  Else
    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
    End If
    lReglaImporteMaximo = LeerCampo(ADORS!nImpoMaxi)
    lReglaPuntoImporte = CLng(LeerCampo(ADORS!nPuntImpo))
    lReglaPuntoCantidad = CLng(LeerCampo(ADORS!nPuntCant))
  End If
  nPuntCant = Int(Total / IIf(IsNull(lReglaPuntoImporte) Or lReglaPuntoImporte = 0, 1, lReglaPuntoImporte)) * lReglaPuntoCantidad
  '---------------------------------------------------------------------------

  'sw To SQL Server add >>> AND IdLocal
  sSQL = " SELECT cClieCode FROM Tarjeta WHERE nTarjNumb='" + tarjeta + "' " & _
         " AND IdLocal=" & nIdLocal

  If Not oDBAdmin.EjecutarConsulta(ADOCnn2, sSQL, ADORS) Then GoTo Salir
  If Not ADORS.EOF Then
    Cliente = val("0" + (ADORS!cClieCode))
  End If

  'ssql = "Delete * From Acumulacion_Punto where nTarjNumb='" + tarjeta + "' and format(dAcumDate, 'yyyy-mm-dd hh:mm:ss')='" + Format(fecha, "yyyy-mm-dd hh:mm:ss") + "' and nPuntCant=" + CStr(nPuntCant)

  sSQL = "Delete From Acumulacion_Punto where cDocTipo='" + txttipo.Text + "'" + _
         " and cDocSerie='" + txtSerie.Text + "' and cDocCodigo=" + txtNumero.Text
        
  If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo Salir

  '-------------------Actualiza los puntos en el cliente--------------------------
  'sw To SQL Server add >>> AND IdLocal
  sSubQry = " Where cClieCode=" & CStr(Cliente) & " AND IdLocal = " & nIdLocal
  sSQL = " Update Cliente set  nPuntCant= (nPuntCant - " & Str(nPuntCant) & ") " & sSubQry
        
  sSQL = VBsprintf(sSQL, sSubQry)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn2, sSQL) Then GoTo Salir
  Cliente = 0

  Set ADORS = Nothing
  Exit Sub
  
Salir:
  MsgBox "No se logró Extornar los puntos acumulados del cliente Cod:" + CStr(Cliente)
End Sub
