Final AED I UTN (medrano)

{-------------------------------------------------------------------------}
{ AUTOR: D'ACHARY Vladimiro Gaston                                        }
{ FECHA: 27/12/2013                                                       }
{ TEMA : Final Algoritmos y estructura de datos I de la UTN.              }
{        Realizacion de un programa para resolver un problema dentro del  }
{        area de las ART. Basicamente el problema consiste en la emision  }
{        de dos listados, uno que muestre las empresas aseguradas y el    }
{        centaje de reajuste de acuerdo a la cantidad de accidentes regis-}
{        trados con el siguiente formato:                                 }
{        RazSoc     porcent                                               }
{        _ _ _ _     _ _ _                                                }
{        El otro listado que se pide tiene que contener el total de los   }
{        de los trabajadores accidentados de la empresa con mayor porcent }
{        de reajuste.                                                     }
{        leg        dias                                                  }
{        _ _ _ _    _ _ _                                                 }
{        para la realizacion de programa se cuenta con dos archivos:      }
{        el archivo EMPRESAS.DAT, que contiene el listado de las empresas }
{        aseguradas (como maximo pueden ser 100) con el formato:          }
{        idEmp   rSoc  tAseg                                              }
{        tambien se cuenta con el archivo accidentes ACCIDENTES.DAT       }
{        en el que estan registrados todos los accidentes de los trabaja  }
{        dores de las empresas:  idEmp  leg  dias                         }
{        el archivo trabajadores esta ordenado, el de empresas no         }

program final_art_2007(input,output);

{$APPTYPE CONSOLE}

uses crt;

const
  MAX = 100;

type

  REmpresa = record
    idEmp:string[4];
    rSoc :string[15];
    tAseg:integer;
  end;

  FEmpresa = file of REmpresa;

  RAccidente = record
    idEmp:string[4];
    leg  :integer;
    dias :integer;
  end;

  FAccidente = file of RAccidente;

  PNodo= ^Nodo;
  Nodo = record
    leg :integer;
    dias:integer;
    sig:PNodo;
  end;

  RArr = record
    idEmp:string[4];
    rSoc :string[15];
    tAseg:integer;
    tAcc :integer;
    total:integer;
    lst:PNodo;
  end;

  TArr = array [1..MAX] of RArr;


function buscar(elArray:TArr
               ;target:string):byte;
var
  pos,i:byte;
  salir:boolean;
begin
  i:=1;
  pos:=0;
  salir:=false;

  while ( i<=MAX ) and ( salir=false ) do begin
    if ( elArray[i].idEmp=target ) then begin
      pos:=i;
      salir:=true
    end;

    i:=i+1;
  end;
  buscar:=pos;
end;


function buscarMaximo(elArray:TArr):byte;
var
  i,max,posMax:byte;
begin
  max:=elArray[1].tAcc;
  posMax:=1;
  for i:=1 to MAX do begin
    if ( elArray[i].tAcc>max ) then begin
      max:=elArray[i].tAcc;
      posMax:=i;
    end;
  end;
  buscarMaximo:=posMax;
end;

procedure crearArchivoEmp(var archEmp:FEmpresa
                         ;reg:REmpresa);

  procedure ingresoEmp(var reg:REmpresa);
  begin
    write('empresa: ');
    readLn(reg.idEmp);
    write('razon social: ');
    readLn(reg.rSoc);
    write('trabajadores asegurados: ');
    readLn(reg.tAseg);
    writeLn('--------------------------------');
  end;

begin
  assign(archEmp,'EMPRESAS.DAT');
  reWrite(archEmp);

  ingresoEmp(reg);

  while (reg.idEmp <> 'fin' ) do begin

    write(archEmp,reg);
    ingresoEmp(reg);

  end;

  close(archEmp);
end;

procedure crearArchivoAcc(var archAcc:FAccidente
                         ;reg:RAccidente);

  procedure ingresoAcc(var reg:RAccidente);
  begin
    write('empresa: ');
    readLn(reg.idEmp);
    write('legajo: ');
    readLn(reg.leg);
    write('dias de licencia: ');
    readLn(reg.dias);
    writeLn('--------------------------------');
  end;

begin
  assign(archAcc,'ACCIDENTES.DAT');
  reWrite(archAcc);

  ingresoAcc(reg);

  while reg.idEmp<>'fin' do begin
    write(archAcc,reg);
    ingresoAcc(reg);
  end;

  close(archAcc);
end;

procedure inicializarArr(var elArray:TArr);
var
  i:byte;
begin
  for i:=1 to MAX do begin
    elArray[i].idEmp:='';
    elArray[i].rSoc :='';
    elArray[i].tAseg:=0;
    elArray[i].tAcc :=0;
    elArray[i].total:=0;
    elArray[i].lst  :=NIL
  end;
end;

procedure subirArchivoEmp(var elArray:TArr);
var
  i:byte;
  archEmp:FEmpresa;
  regEmp :REmpresa;
begin
  i:=1;
  assign(archEmp,'EMPRESAS.DAT');
  reset(archEmp);

  while ( not eof(archEmp) ) do begin
    read(archEmp,regEmp);
    elArray[i].idEmp:=regEmp.idEmp;
    elArray[i].rSoc :=regEmp.rSoc;
    elArray[i].tAseg:=regEmp.tAseg;
    i:=i+1
  end;

  close(archEmp);
end;

function buscarNodo(lst:PNodo
                   ;reg:RAccidente):PNodo;
var
  aux:PNodo;
begin
  aux:=lst;

  while ( aux<>NIL ) and ( aux^.leg<>reg.leg ) do begin
    aux:=aux^.sig
  end;

  buscarNodo:=aux;
end;

procedure agregarNodo(var lst:PNodo
                     ;reg:RAccidente);
var
  aux,nuevo:PNodo;
begin
  new(nuevo);
  nuevo^.leg :=reg.leg;
  nuevo^.dias:=reg.dias;
  nuevo^.sig :=NIL;

  if ( lst=NIL ) then begin
    lst:=nuevo;
  end else begin
    aux:=lst;
    while ( aux^.sig<>NIL ) do begin
      aux:=aux^.sig;
    end;
    aux^.sig:=nuevo;
  end;
end;

procedure proceso(var elArray:TArr
                 ;reg:RAccidente);
var
  pos:byte;
  aux:PNodo;
begin
  pos:=buscar(elArray,reg.idEmp);
  elArray[pos].tAcc :=( elArray[pos].tAcc )+1;
  elArray[pos].total:=( elArray[pos].total )+reg.dias;

  aux:=buscarNodo(elArray[pos].lst,reg);
  if ( aux=NIL ) then begin
    agregarNodo(elArray[pos].lst,reg);
  end else begin
    aux^.dias:=aux^.dias+reg.dias;
  end;
end;

procedure mostrarArray(elArray:TArr);
var
  i:byte;
begin
  writeLn('id      R.Soc        As      Ac   Total');
  writeLn('----------------------------------------');
  for i:=1 to MAX do begin
    if ( elArray[i].idEmp<>'' ) then begin
      write(elArray[i].idEmp,'  ',elArray[i].rSoc,'     ');
      writeLn(elArray[i].tAseg,'    ',elArray[i].tAcc ,'    ',elArray[i].total);
      writeLn('----------------------------------------');
    end;
  end;
end;

procedure mostrarListadoReajustes(elArray:TArr);
var
  i:byte;
begin
  writeLn('Los reajustes son los siguientes: ');
  writeLn('----------------------------------');
  for i:=1 to MAX do begin
    if ( elArray[i].idEmp<>'' ) then begin
      writeLn(elArray[i].rSoc,'  ','%',elArray[i].tAcc);
    end;
  end;
end;

procedure mostrarListadoMaximo(elArray:TArr);
var
  pos:byte;
  aux:PNodo;
begin
  pos:=buscarMaximo(elArray);

  writeLn('emprsa de mayor re-Ajuste: ');
  writeLn('id. Empresa: ',elArray[pos].idEmp);
  writeLn('razon social: ',elArray[pos].rSoc);
  writeLn('listado de accidentes registrados :');
  writeLn('------------------------------------');

  aux:=elArray[pos].lst;
  while ( aux<>NIL ) do begin
    writeLn('legajo: ',aux^.leg,' ','dias de lic: ',aux^.dias);
    writeLn('------------------------------');
    aux:=aux^.sig;
  end;
end;

var
  regEmp :REmpresa;
  regAcc :RAccidente;

  archEmp:FEmpresa;
  archAcc:FAccidente;

  elArray:TArr;
  regArr :RArr;
begin

  // inicializo el array
  inicializarArr(elArray);

  // subo el archivo empresas (maestro) al array
  subirArchivoEmp(elArray);

  // abro el archivo accidentes (novedades)
  assign(archAcc,'ACCIDENTES.DAT');
  reset(archAcc);

  // recorro el archivo de modo secuencial y proceso registro por registro
  // hasta llegar al final del archivo accidentes (novedades)
  while ( not eof(archAcc) ) do begin

    // leo el registro
    read(archAcc,regAcc);

    // proceso el registro
    proceso(elArray,regAcc);

  end;

  // muestra el primer listado
  mostrarListadoReajustes(elArray);
  readKey();
  clrScr;

  // muestra el segundo listado
  mostrarListadoMaximo(elArray);

  // cierro el archivo ACCIDENTES.DAT (novedades)
  close(archAcc);
  readKey()
end.