2011-11-14 17:40:41 +00:00
unit uBizFacturasProveedorServer;
interface
uses
uDAInterfaces, uDADelta, uDABusinessProcessor,
schFacturasProveedorServer_Intf;
const
BIZ_SERVER_FACTURAS_PROVEEDOR = 'Server.FacturasProveedor' ;
type
TBizFacturasProveedorServer = class( TFacturasProveedorBusinessProcessorRules)
FReferenciaAutomatica : Boolean ;
function DarReferencia : String ;
function IncrementarReferencia : Boolean ;
protected
procedure Insert_Asiento_Factura( aChange: TDADeltaChange) ; virtual ;
procedure Update_Asiento_Factura( aChange: TDADeltaChange) ; virtual ;
procedure Delete_Asiento_Factura( aChange: TDADeltaChange) ; virtual ;
2022-03-12 10:40:36 +00:00
procedure LiberarAlbaranDeFactura( aChange: TDADeltaChange) ;
2011-11-14 17:40:41 +00:00
procedure BeforeProcessDelta( Sender: TDABusinessProcessor; const aDelta: IDADelta) ; override ;
procedure AfterProcessChange( Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean ;
var CanRemoveFromDelta: Boolean ) ; override ;
end ;
implementation
uses
Variants, uDAClasses, uReferenciasUtils, uBusinessUtils, uROClasses, uDataModuleServer,
schFacturasProveedorClient_Intf, FactuGES_Intf, uROServer, SysUtils;
const
REF_FACTURAS_PROVEEDOR = 'REF_FACTURAS_PROVEEDOR' ;
REF_ABONOS_PROVEEDOR = 'REF_ABONOS_PROVEEDOR' ;
CTE_TIPO_ABONO = 'A' ;
CTE_TIPO_FACTURA = 'F' ;
{ TBizFacturasProveedorServer }
procedure TBizFacturasProveedorServer. AfterProcessChange( Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean ;
var CanRemoveFromDelta: Boolean ) ;
begin
inherited ;
case aChange. ChangeType of
ctInsert: begin
Insert_Asiento_Factura( aChange) ;
end ;
ctUpdate: begin
Update_Asiento_Factura( aChange) ;
end ;
ctDelete: begin
Delete_Asiento_Factura( aChange) ;
2022-03-12 10:40:36 +00:00
LiberarAlbaranDeFactura( aChange) ;
2011-11-14 17:40:41 +00:00
end ;
end ;
// No hay que quitar los deltas para que los datos del contacto se
// mantengan por si alguna tabla detalle lo necesita
// (por ejemplo, DireccionesContacto)
CanRemoveFromDelta : = False ;
case aChange. ChangeType of
ctInsert, ctUpdate: begin
if FReferenciaAutomatica then
begin
IncrementarReferencia;
FReferenciaAutomatica : = False ;
end ;
end ;
end ;
end ;
procedure TBizFacturasProveedorServer. BeforeProcessDelta( Sender: TDABusinessProcessor; const aDelta: IDADelta) ;
begin
FReferenciaAutomatica : = False ;
case Sender. CurrentChange. ChangeType of
ctInsert, ctUpdate: begin
//Si la referencia no ha sido asignada le asignamos una nosotros
if REFERENCIAIsNull or ( Length( REFERENCIA) = 0 ) then
begin
FReferenciaAutomatica : = True ;
REFERENCIA : = DarReferencia;
end ;
end ;
end ;
end ;
function TBizFacturasProveedorServer. DarReferencia: String ;
var
AReferenciasService : IsrvReferencias;
Intf : IInterface;
AClientID : TGUID;
ATipo : String ;
begin
//No se hace distinci<63> n en la referencia entre facturas y abonos
// if TIPO = CTE_TIPO_FACTURA then
ATipo : = REF_FACTURAS_PROVEEDOR;
// else
// ATipo := REF_ABONOS_PROVEEDOR;
CreateGUID( AClientID) ;
GetClassFactory( 'srvReferencias' ) . CreateInstance( AClientID, Intf) ;
AReferenciasService : = Intf as IsrvReferencias;
Result : = AReferenciasService. DarNuevaReferencia( ATipo, ID_EMPRESA, ID_TIENDA)
end ;
procedure TBizFacturasProveedorServer. Delete_Asiento_Factura( aChange: TDADeltaChange) ;
var
ASchema : TDASchema;
ACurrentConn : IDAConnection;
ACommand : IDASQLCommand;
begin
ASchema : = BusinessProcessor. Schema;
ACurrentConn : = GetBusinessProcessorConnection( BusinessProcessor) ;
//Eliminamos los recibos de la factura
ACommand : = ASchema. NewCommand( ACurrentConn, 'Delete_RecibosFactura' ) ;
try
with ACommand do
begin
ParamByName( 'ID_FACTURA' ) . Value : = aChange. OldValueByName[ fld_FacturasProveedorID] ;
Execute;
end ;
finally
ACommand : = NIL ;
end ;
//Eliminamos los asientos contables de la factura
ACommand : = ASchema. NewCommand( ACurrentConn, 'Delete_AsientoFactura' ) ;
try
with ACommand do
begin
ParamByName( 'IdFactura' ) . Value : = aChange. OldValueByName[ fld_FacturasProveedorID] ;
ParamByName( 'Tipo' ) . Value : = 'p' ;
Execute;
end ;
finally
ACommand : = NIL ;
end ;
end ;
function TBizFacturasProveedorServer. IncrementarReferencia: Boolean ;
var
AReferenciasService : IsrvReferencias;
Intf : IInterface;
AClientID : TGUID;
ATipo : String ;
begin
// if TIPO = CTE_TIPO_FACTURA then
ATipo : = REF_FACTURAS_PROVEEDOR;
// else
// ATipo := REF_ABONOS_PROVEEDOR;
CreateGUID( AClientID) ;
GetClassFactory( 'srvReferencias' ) . CreateInstance( AClientID, Intf) ;
AReferenciasService : = Intf as IsrvReferencias;
Result : = AReferenciasService. IncrementarValorReferencia( ATipo, Self. REFERENCIA, ID_EMPRESA, ID_TIENDA)
end ;
procedure TBizFacturasProveedorServer. Insert_Asiento_Factura( aChange: TDADeltaChange) ;
var
ASchema : TDASchema;
ACurrentConn : IDAConnection;
ACommand : IDASQLCommand;
begin
ASchema : = BusinessProcessor. Schema;
ACurrentConn : = GetBusinessProcessorConnection( BusinessProcessor) ;
ACommand : = ASchema. NewCommand( ACurrentConn, 'Insert_AsientoFactura' ) ;
try
with ACommand do
begin
ParamByName( 'IdFactura' ) . Value : = aChange. NewValueByName[ fld_FacturasProveedorID] ;
ParamByName( 'IdSubCuentaCompra' ) . Value : = aChange. NewValueByName[ fld_FacturasProveedorID_SUBCUENTA] ;
Execute;
end ;
finally
ACommand : = NIL ;
end ;
end ;
2022-03-12 10:40:36 +00:00
procedure TBizFacturasProveedorServer. LiberarAlbaranDeFactura( aChange: TDADeltaChange) ;
var
ASchema : TDASchema;
ACurrentConn : IDAConnection;
ACommand : IDASQLCommand;
begin
ASchema : = BusinessProcessor. Schema;
ACurrentConn : = GetBusinessProcessorConnection( BusinessProcessor) ;
//En el caso de borrar una factura se comprueban los albaranes de proveedor asociados para liberarlos para que puedan asociar a otras futuras facturas.
ACommand : = ASchema. NewCommand( ACurrentConn, 'LiberarAlbaranesDeFactura' ) ;
try
with ACommand do
begin
ParamByName( 'ID_FACTURA' ) . Value : = aChange. OldValueByName[ fld_FacturasProveedorID] ;
Execute;
end ;
finally
ACommand : = NIL ;
end ;
end ;
2011-11-14 17:40:41 +00:00
procedure TBizFacturasProveedorServer. Update_Asiento_Factura( aChange: TDADeltaChange) ;
var
ASchema : TDASchema;
ACurrentConn : IDAConnection;
ACommand : IDASQLCommand;
begin
ASchema : = BusinessProcessor. Schema;
ACurrentConn : = GetBusinessProcessorConnection( BusinessProcessor) ;
ACommand : = ASchema. NewCommand( ACurrentConn, 'Insert_AsientoFactura' ) ;
try
with ACommand do
begin
ParamByName( 'IdFactura' ) . Value : = aChange. NewValueByName[ fld_FacturasProveedorID] ;
ParamByName( 'IdSubCuentaCompra' ) . Value : = aChange. NewValueByName[ fld_FacturasProveedorID_SUBCUENTA] ;
Execute;
end ;
finally
ACommand : = NIL ;
end ;
end ;
initialization
RegisterBusinessProcessorRules( BIZ_SERVER_FACTURAS_PROVEEDOR, TBizFacturasProveedorServer) ;
end .