Imports System.Data.Objects Imports tsl5.Extensiones Partial Public Class asientos Public Enum TipoAsiento As Integer NORMAL = 0 APERTURA = 1 REGULARIZACION = 2 End Enum Public ReadOnly Property Cuentas As String Get If Me.apuntes.Count > 10 Then Return "** MÁS DE 10 **" Else Dim sCuentas As String = "" For Each ap In Me.apuntes sCuentas &= ap.cuentas.NumeroCuenta & " " Next Return sCuentas.Trim End If End Get End Property Public ReadOnly Property Documentos As String Get Dim sDocumentos As String = "" For Each ap In Me.apuntes.ToList.Where(Function(x) x.NumeroDocumento IsNot Nothing AndAlso x.NumeroDocumento <> "").GroupBy(Function(x) x.NumeroDocumento) sDocumentos &= ap.First.NumeroDocumento & " " Next Return sDocumentos.Trim End Get End Property Public ReadOnly Property Conceptos As String Get Dim sDocumentos As String = "" For Each ap In Me.apuntes.ToList.GroupBy(Function(x) x.Concepto) sDocumentos &= ap.First.Concepto & " " Next Return sDocumentos.Trim End Get End Property Public ReadOnly Property idAsiento_Nulable As Integer? Get If Me.idAsiento = 0 Then Return Nothing Else Return Me.idAsiento End If End Get End Property Public Sub RellenaCuentaTmp() For Each ap In Me.apuntes ap.NumeroCuentaTmp = ap.cuentas.NumeroCuenta ap.DescripcionCuentaTmp = ap.cuentas.Denominacion Next End Sub 'Public Sub EstableceNumeroAsiento(bd As gestionasegasaEntities) ' If Me.NumeroAsiento.HasValue = False Then ' Dim ua = bd.asientos.Where(Function(x) x.Tipo = Me.Tipo And x.Fecha.Year = Me.Fecha.Year).OrderByDescending(Function(x) x.NumeroAsiento).FirstOrDefault ' Dim Nuevo As Integer ' If ua IsNot Nothing Then ' Nuevo = ua.NumeroAsiento.Value + 1 ' Else ' Nuevo = 1 ' End If ' Me.NumeroAsiento = Nuevo ' End If 'End Sub Public Shared Sub GeneraAsientoRecibosContado(bd As gestionasegasaEntities, Recibos As List(Of vf_recibosextendidos), DelegadoError As tsWPF.Comun.ErrorNoControlado) Dim Hoy = tsl5.bbdd.AhoraSqlServer(bd).Date Dim ej = bd.ejercicioscontables.FirstOrDefault(Function(x) x.FechaInicio <= Hoy And x.FechaFin >= Hoy And x.FechaCierre.HasValue = False) If ej Is Nothing Then ej = bdGestionAsegasa.ejercicioscontables.AbreEjercicio(bd, Hoy) Dim idTiporem = bd.enumeraciones.First(Function(x) x.Codigo = "TIPREM.CO").idEnumeracion Dim tipospagos = bd.enumeraciones.Where(Function(x) x.gruposenumeraciones.Grupo = "TIPP").ToList Dim idSituacion = bd.enumeraciones.First(Function(x) x.Codigo = "SITR.PA").idEnumeracion Dim Cont = bd.enumeraciones.First(Function(x) x.Codigo = "CONT.NUMGEN") Dim Conceps = bd.conceptosapuntes.ToList Cont.ValorNumerico1 += 1 Dim remesa As New remesas With remesa .IBAN = "" .FechaCreacion = Now .Fecha = Hoy .idTipo = idTiporem End With bd.remesas.AddObject(remesa) bd.SaveChanges() Dim numgenerados As Integer Dim numerrores As Integer Dim sRecibosConErrores As String = "" Dim lrg As New List(Of vf_recibosextendidos) For Each recibo In Recibos Dim r = bd.recibos.First(Function(x) x.idRecibo = recibo.idRecibo) Try GeneraAsientoReciboContado(bd, r, tipospagos, Conceps, idSituacion, remesa, Cont.ValorNumerico1) lrg.Add(recibo) numgenerados += 1 Catch EX As Exception sRecibosConErrores &= recibo.CodigoRecibo & vbNewLine numerrores += 1 DelegadoError.Invoke("GeneraAsientoRecibosContado", EX) End Try Next Dim sDestinatarios = bd.enumeraciones.First(Function(X) X.Codigo = "CONF.EMAILCONTA").ValorAlfabeticoLargo Dim cta = bd.cuentascorreo.First(Function(x) x.Codigo = "SEG.GENERALES") Dim f() As Byte = Nothing If lrg.Count > 0 Then Dim lr = lrg.Select(Function(x) New With {.CodigoRecibo = x.CodigoRecibo, .NumeroPoliza = x.NumeroPoliza, .NumeroSuplemento = x.NumeroSuplemento, .Tomador = x.Tomador, .BinesAsegurados = x.BienesAsegurados, .Ramo = x.Ramo, .Compañia = x.Compania}).ToList f = tsWPF.Utilidades.Varias.IEnumerableAExcel(lr) End If Dim sCuerpo As String = "" If numgenerados > 0 Then sCuerpo = "Adjunto le remitimos listado de recibos marcados como remesados (Contado)" If numerrores > 0 Then sCuerpo &= vbCrLf & "Los siguientes recibos no pudieron ser marcados como remesados correctamente: " & vbCrLf & sRecibosConErrores End If If numgenerados > 0 Then bdGestionAsegasa.correos.GeneraRegistroCorreoConAdjunto(Nothing, "Se han marcado " & numgenerados.ToString & " Recibos como remesados (Contado)", sCuerpo, cta, f, "Pagos-" & Now.ToString("yyyy-MM-dd") & ".xlsx", "Listado Recibos de con fecha de pago " & Now.ToString("yyyy-MM-dd"), sDestinatarios,, "sevilla@tecnosis.net") Else bdGestionAsegasa.correos.GeneraRegistroCorreo(Nothing, "Los siguientes recibos no pudieron ser marcados como remesados (Contado)", sCuerpo, cta, sDestinatarios,, "sevilla@tecnosis.net") End If End Sub Public Shared Sub GeneraAsientoReciboContado(bd As gestionasegasaEntities, Recibo As recibos, TiposPago As List(Of enumeraciones), Conceptos As List(Of conceptosapuntes), idSituacion As Integer, Remesa As remesas, NumeroGeneracion As Integer, Optional Inverso As Boolean = False) Try Dim Tipp = TiposPago.First(Function(x) x.idEnumeracion = Recibo.idTipoPago).Codigo.Split(".")(1) Dim ent = Recibo.polizassg.EntidadPolizaTomador.entidades Dim na As New asientos bd.asientos.AddObject(na) With na If Inverso Then .Fecha = Today 'Recibo.FechaBaja.Value Else .Fecha = Recibo.FechaPago.Value End If .idEjercicio = ejercicioscontables.ObtieneidEjercicioAbierto(.Fecha) .Tipo = bdGestionAsegasa.asientos.TipoAsiento.NORMAL .FechaIntroduccion = Now If bdGestionAsegasa.Utilidades.dsc.idUsuario > 0 Then .idUsuario = bdGestionAsegasa.Utilidades.dsc.idUsuario End With Dim nap1 As New apuntes With nap1 .asientos = na .Concepto = ent.RazonSocial .NumeroDocumento = Recibo.idRecibo Dim Cta As String Select Case Tipp Case "PE" If ent.CuentaContable.NothingAVacio = "" Then Throw New Exception("La entidad " & ent.RazonSocial & " no tiene asignada una cuenta contable") Cta = ent.CuentaContable .idConcepto = Conceptos.First(Function(x) x.Codigo = "029").idConcepto Case "CO" If Recibo.OficinaAgente.ToUpper = "SEVILLA" Then Cta = "57000000" Else Cta = "57000002" End If If Recibo.TotalRecibo.Value > 0 Then .idConcepto = Conceptos.First(Function(x) x.Codigo = "015").idConcepto Else .idConcepto = Conceptos.First(Function(x) x.Codigo = "029").idConcepto End If 'Case "CGP" ' Cta = "57000000" ' .idConcepto = Conceptos.First(Function(x) x.Codigo = "015").idConcepto ' .Concepto = "GIRO " & ent.RazonSocial Case "CTA" If Recibo.TotalRecibo.Value > 0 Then Cta = "57000001" .idConcepto = Conceptos.First(Function(x) x.Codigo = "016").idConcepto Else Cta = "57200004" .idConcepto = Conceptos.First(Function(x) x.Codigo = "029").idConcepto End If .Concepto = "TRF. " & ent.RazonSocial Case "CTR" Cta = "57200004" .idConcepto = Conceptos.First(Function(x) x.Codigo = "015").idConcepto .Concepto = "TRANS. " & ent.RazonSocial Case "CIN" Cta = "57200004" .idConcepto = Conceptos.First(Function(x) x.Codigo = "015").idConcepto .Concepto = "TPV. " & ent.RazonSocial Case Else Throw New Exception("Tipo de pago " & Tipp & " no soportado") End Select Dim cuenta = bd.cuentas.FirstOrDefault(Function(x) x.NumeroCuenta = Cta And x.idEjercicio = na.idEjercicio) If cuenta Is Nothing Then Dim ctaant = bd.cuentas.Where(Function(x) x.NumeroCuenta = Cta).OrderByDescending(Function(x) x.ejercicioscontables.FechaInicio).FirstOrDefault If ctaant IsNot Nothing Then cuenta = bdGestionAsegasa.cuentas.CreaCuenta(bd, na.idEjercicio, Cta, ctaant.Denominacion, ctaant.Observaciones) End If If cuenta Is Nothing Then Throw New Exception("No existe la cuenta " & Cta & " para el recibo " & Recibo.CodigoRecibo) .cuentas = cuenta If Inverso Then .Haber = Recibo.TotalRecibo.Value .Debe = 0 Else .Haber = 0 .Debe = Recibo.TotalRecibo.Value End If End With na.apuntes.Add(nap1) Dim nap2 As New apuntes With nap2 .asientos = na Dim Cta As String = "4400" & Recibo.polizassg.companias.Codigo .idCuenta = bd.cuentas.First(Function(x) x.NumeroCuenta = Cta And x.idEjercicio = na.idEjercicio).idCuenta If Inverso Then .Haber = 0 .Debe = Math.Round(Recibo.TotalRecibo.Value, 2, MidpointRounding.AwayFromZero) Else .Debe = 0 .Haber = Math.Round(Recibo.TotalRecibo.Value, 2, MidpointRounding.AwayFromZero) End If .Concepto = ent.RazonSocial .idConcepto = Conceptos.First(Function(X) X.Codigo = "005").idConcepto .NumeroDocumento = Recibo.idRecibo End With na.apuntes.Add(nap2) na.Importe = na.apuntes.Sum(Function(x) x.Debe) Recibo.idRemesa = Remesa.idRemesa Recibo.idSituacion = idSituacion bd.SaveChanges() Dim Ahora = tsl5.bbdd.AhoraMysql(bd) 'Dim reglc As New registrosactualizados 'With reglc ' .Tipo = "ASIENTOS" ' .idAplicacion = na.idAsiento ' .MacroAct = "ASICONMYSQL" ' .NumeroGeneracion = NumeroGeneracion ' ' .FechaCreacion = Ahora 'End With 'bd.registrosactualizados.AddObject(reglc) 'bd.SaveChanges() '' Recibo.idAsientoRemesaOContado = na.idAsiento 'Dim reg As New registrosactualizados 'With reg ' .Tipo = "RECIBOS" ' .idAplicacion = Recibo.idRecibo ' .MacroAct = "ASICONMYSQL" ' .NumeroGeneracion = NumeroGeneracion ' ' .FechaCreacion = Ahora 'End With 'bd.registrosactualizados.AddObject(reg) 'bd.SaveChanges() If Tipp = "PE" AndAlso nap1.cuentas.idEmpresaAmortizacion.HasValue Then If Not Inverso Then Dim Amr As New amortizacionrecibos With Amr Dim iUltimoMes As Integer = 0 Dim ud = bd.detallesamortizacionrecibos.Where(Function(x) x.FechaAplicacion.HasValue).OrderByDescending(Function(x) x.FechaAplicacion).FirstOrDefault If ud IsNot Nothing Then iUltimoMes = ud.Mes Dim iMesPago = Recibo.FechaPago.Value.Year * 100 + Recibo.FechaPago.Value.Month If iUltimoMes >= iMesPago Then .FechaInicioAmortizacion = New Date(iUltimoMes \ 100, iUltimoMes Mod 100, 1).AddMonths(1) Else .FechaInicioAmortizacion = Recibo.FechaPago End If .idRecibo = Recibo.idRecibo .PorcentajeAnual = 100 .idEmpresa = nap1.cuentas.idEmpresaAmortizacion .FechaFinAmortizacion = (New Date(.FechaInicioAmortizacion.Year, .FechaInicioAmortizacion.Month, 1)).AddMonths(12) .NumeroCuenta = nap1.cuentas.NumeroCuenta .FechaAlta = Now Dim FechaInicial = New Date(.FechaInicioAmortizacion.Year, .FechaInicioAmortizacion.Month, 1) For i = 0 To 11 Dim amrd As New detallesamortizacionrecibos Amr.detallesamortizacionrecibos.Add(amrd) amrd.Mes = FechaInicial.AddMonths(i).Year * 100 + FechaInicial.AddMonths(i).Month If i < 11 Then amrd.ValorAmortizado = Math.Round(Recibo.TotalRecibo.Value / 12, 2, MidpointRounding.AwayFromZero) amrd.ValorAcumulado = Math.Round(Recibo.TotalRecibo.Value / 12 * (i + 1), 2, MidpointRounding.AwayFromZero) amrd.ValorResidual = Math.Round(Recibo.TotalRecibo.Value - amrd.ValorAcumulado, 2, MidpointRounding.AwayFromZero) Else amrd.ValorAmortizado = Math.Round(Recibo.TotalRecibo.Value - Amr.detallesamortizacionrecibos.Sum(Function(x) x.ValorAmortizado), 2, MidpointRounding.AwayFromZero) amrd.ValorAcumulado = Recibo.TotalRecibo.Value amrd.ValorResidual = 0 End If Next End With bd.amortizacionrecibos.AddObject(Amr) End If bd.SaveChanges() Dim apas = New aplicacionesasientos With apas .idAplicacion = Recibo.idRecibo If Inverso Then .Tipo = Enums.TipoAplicacionAsientoEnum.RECIBO_BAJA_TIPO_PAGO_PE Else .Tipo = Enums.TipoAplicacionAsientoEnum.RECIBO_CONTABILIZACION_PAGO_CONTADO End If .idAsiento = na.idAsiento End With bd.aplicacionesasientos.AddObject(apas) bd.SaveChanges() End If bd.ExecuteStoreCommand("UPDATE registrosactualizados SET FechaCreacion=Now() where FechaCreacion Is null and NumeroGeneracion=" & NumeroGeneracion.ToString & ";") Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Sub Public Shared Function GeneraAsientoReciboPagadoEnCiaYaFacturado(bd As gestionasegasaEntities, Recibo As recibos, idEjercicio As Integer) As asientos Try Dim ent = Recibo.polizassg.EntidadPolizaTomador.entidades Dim na As New asientos bd.asientos.AddObject(na) With na .Fecha = Today .idEjercicio = idEjercicio .Tipo = bdGestionAsegasa.asientos.TipoAsiento.NORMAL .FechaIntroduccion = Now If bdGestionAsegasa.Utilidades.dsc.idUsuario > 0 Then .idUsuario = bdGestionAsegasa.Utilidades.dsc.idUsuario End With Dim nap1 As New apuntes With nap1 .asientos = na .Concepto = "RECIBO PAGADO EN CIA (DESFACTURACION) " & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo Dim Cta As String = "4400" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, idEjercicio) .cuentas = cuenta .Haber = Math.Round(Recibo.TotalRecibo.Value, 2, MidpointRounding.AwayFromZero) .Debe = 0 End With na.apuntes.Add(nap1) Dim nap2 As New apuntes With nap2 .asientos = na Dim Cta As String = "4190" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, idEjercicio) .cuentas = cuenta .Debe = Math.Round(Recibo.TotalRecibo.Value - Recibo.TotalComision.Value, 2, MidpointRounding.AwayFromZero) .Haber = 0 .Concepto = "RECIBO PAGADO EN CIA (DESFACTURACION)" & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo End With na.apuntes.Add(nap2) Dim nap3 As New apuntes With nap3 .asientos = na Dim Cta As String = "7050" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, idEjercicio) .cuentas = cuenta .Debe = Math.Round(Recibo.TotalComision.Value, 2, MidpointRounding.AwayFromZero) .Haber = 0 .Concepto = "RECIBO PAGADO EN CIA (DESFACTURACION)" & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo End With na.apuntes.Add(nap3) Dim nap4 As New apuntes With nap4 .asientos = na .Concepto = "RECIBO PAGADO EN CIA " & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo Dim Cta As String = "4190" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, idEjercicio) .cuentas = cuenta .Haber = 0 .Debe = Math.Round(Recibo.TotalComision.Value, 2, MidpointRounding.AwayFromZero) End With na.apuntes.Add(nap4) Dim nap5 As New apuntes With nap5 .asientos = na Dim Cta As String = "7050" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, idEjercicio) .cuentas = cuenta .Debe = 0 .Haber = Math.Round(Recibo.TotalComision.Value, 2, MidpointRounding.AwayFromZero) .Concepto = "RECIBO PAGADO EN CIA " & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo End With na.apuntes.Add(nap5) na.Importe = na.apuntes.Sum(Function(x) x.Debe) bd.SaveChanges() Dim apas = New aplicacionesasientos With apas .idAplicacion = Recibo.idRecibo .Tipo = Enums.TipoAplicacionAsientoEnum.RECIBO_PAGADO_EN_CIA .idAsiento = na.idAsiento End With bd.aplicacionesasientos.AddObject(apas) bd.SaveChanges() Return na Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Function Public Shared Function GeneraAsientoReciboPagadoEnCia(bd As gestionasegasaEntities, Recibo As recibos) As asientos Try Dim ej = bd.ejercicioscontables.FirstOrDefault(Function(x) x.FechaInicio <= Today And x.FechaFin >= Today And x.FechaCierre.HasValue = False) If ej Is Nothing Then ej = bdGestionAsegasa.ejercicioscontables.AbreEjercicio(bd, Today) Dim ent = Recibo.polizassg.EntidadPolizaTomador.entidades Dim na As New asientos bd.asientos.AddObject(na) With na .Fecha = Today .idEjercicio = ej.idEjercicio .Tipo = bdGestionAsegasa.asientos.TipoAsiento.NORMAL .FechaIntroduccion = Now If bdGestionAsegasa.Utilidades.dsc.idUsuario > 0 Then .idUsuario = bdGestionAsegasa.Utilidades.dsc.idUsuario End With Dim nap1 As New apuntes With nap1 .asientos = na .Concepto = "RECIBO PAGADO EN CIA " & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo Dim Cta As String = "4190" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, ej.idEjercicio) .cuentas = cuenta .Haber = 0 .Debe = Math.Round(Recibo.TotalComision.Value, 2, MidpointRounding.AwayFromZero) End With na.apuntes.Add(nap1) Dim nap2 As New apuntes With nap2 .asientos = na Dim Cta As String = "7050" & Recibo.polizassg.companias.Codigo Dim cuenta = ObtieneCuenta(bd, Cta, ej.idEjercicio) .cuentas = cuenta .Debe = 0 .Haber = Math.Round(Recibo.TotalComision.Value, 2, MidpointRounding.AwayFromZero) .Concepto = "RECIBO PAGADO EN CIA " & ent.RazonSocial .NumeroDocumento = Recibo.idRecibo End With na.apuntes.Add(nap2) na.Importe = Math.Round(na.apuntes.Sum(Function(x) x.Debe), 2, MidpointRounding.AwayFromZero) bd.SaveChanges() Dim apas = New aplicacionesasientos With apas .idAplicacion = Recibo.idRecibo .Tipo = Enums.TipoAplicacionAsientoEnum.RECIBO_PAGADO_EN_CIA .idAsiento = na.idAsiento End With bd.aplicacionesasientos.AddObject(apas) bd.SaveChanges() Return na Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Function Public Sub RefrescaExtensiones() OnPropertyChanged("EjercicioTmp") OnPropertyChanged("idAsiento_Nulable") End Sub Public Shared Function ObtieneCuenta(bd As gestionasegasaEntities, cta As String, idEjercicio As Integer) As cuentas Dim cuenta = bd.cuentas.FirstOrDefault(Function(x) x.NumeroCuenta = cta And x.idEjercicio = idEjercicio) If cuenta Is Nothing Then Dim ctaant = bd.cuentas.Where(Function(x) x.NumeroCuenta = cta).OrderByDescending(Function(x) x.ejercicioscontables.FechaInicio).FirstOrDefault If ctaant IsNot Nothing Then cuenta = bdGestionAsegasa.cuentas.CreaCuenta(bd, idEjercicio, cta, ctaant.Denominacion, ctaant.Observaciones) End If Return cuenta End Function Public Property Punteado As Boolean Get Return FechaPunteo.HasValue End Get Set(value As Boolean) If value Then FechaPunteo = Now Else FechaPunteo = Nothing End If End Set End Property Private _Ejercicio As String Public Property EjercicioTmp As String Get If _Ejercicio = "" AndAlso ejercicioscontables IsNot Nothing Then _Ejercicio = ejercicioscontables.Descripcion End If Return _Ejercicio End Get Set(value As String) _Ejercicio = value OnPropertyChanged("EjercicioTmp") End Set End Property End Class