AbetoDesign_FactuGES2/Source/Modulos/Contratos de cliente/Model/uBizContratosClienteServer.pas

unit uBizContratosClienteServer;

interface

uses
  uDAInterfaces, uDADelta, uDABusinessProcessor,
  schContratosClienteServer_Intf;

const
  BIZ_SERVER_CONTRATOS_CLIENTE = 'Server.ContratosCliente';

type
  TBizContratosClienteServer = class(TContratosClienteBusinessProcessorRules)
  private
    FReferenciaAutomatica : Boolean;
    function DarReferencia : String;
    function IncrementarReferencia : Boolean;
    procedure LiberarPresupuestosDelContrato(aChange: TDADeltaChange);

  protected
    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,
  schContratosClienteClient_Intf, FactuGES_Intf, uROServer, SysUtils;

const
  REF_CONTRATOS_CLIENTE = 'REF_CONTRATOS_CLIENTE';

{ TBizContratosClienteServer }

procedure TBizContratosClienteServer.AfterProcessChange(
  Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean;
  var CanRemoveFromDelta: Boolean);
begin
  inherited;
  { Por defecto, mantenemos los deltas por si alguna tabla hija los necesita }
  CanRemoveFromDelta := False;

  case aChange.ChangeType of
    ctInsert, ctUpdate: begin
                          if FReferenciaAutomatica then
                          begin
                            IncrementarReferencia;
                            FReferenciaAutomatica := False;
                          end;
                        end;
    ctDelete: begin
                LiberarPresupuestosDelContrato(aChange);
              end;
                        
  end;
end;

procedure TBizContratosClienteServer.BeforeProcessDelta(
  Sender: TDABusinessProcessor; const aDelta: IDADelta);
begin
  inherited;

  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 TBizContratosClienteServer.DarReferencia: String;
var
  AReferenciasService : IsrvReferencias;
  Intf : IInterface;
  AClientID : TGUID;
  ACodigoReferencia : String;
begin
  ACodigoReferencia := REF_CONTRATOS_CLIENTE;
  CreateGUID(AClientID);

  GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf);
  AReferenciasService := Intf as IsrvReferencias;
  Result := AReferenciasService.DarNuevaReferencia(ACodigoReferencia, ID_EMPRESA, ID_TIENDA)
end;

function TBizContratosClienteServer.IncrementarReferencia: Boolean;
var
  AReferenciasService : IsrvReferencias;
  Intf : IInterface;
  AClientID : TGUID;
  ACodigoReferencia : String;
begin
  ACodigoReferencia := REF_CONTRATOS_CLIENTE;
  CreateGUID(AClientID);

  GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf);
  AReferenciasService := Intf as IsrvReferencias;
  Result := AReferenciasService.IncrementarValorReferencia(ACodigoReferencia, Self.REFERENCIA, ID_EMPRESA, ID_TIENDA)
end;

procedure TBizContratosClienteServer.LiberarPresupuestosDelContrato(aChange: TDADeltaChange);
var
  ASchema : TDASchema;
  ACurrentConn : IDAConnection;
  ACommand : IDASQLCommand;
begin
  ASchema := BusinessProcessor.Schema;
  ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor);

//En el caso de borrar un contrato se comprueban los presupuestos asociados para liberarlos para generar otro contrato.
  ACommand := ASchema.NewCommand(ACurrentConn, 'LiberarPresupuestosDelContrato');
  try
    with ACommand do
    begin
      ParamByName('ID_CONTRATO').Value := aChange.OldValueByName[fld_ContratosClienteID];
      Execute;
    end;
  finally
    ACommand := NIL;
  end;
end;

initialization
  RegisterBusinessProcessorRules(BIZ_SERVER_CONTRATOS_CLIENTE, TBizContratosClienteServer);

end.