pregunta 1 pc4 2015-2

program pregunta1;
type TArrEntero = array [1..61] of Integer;
     TArrStr = array [1..61] of String;

procedure PrepararArchivos(var archIn,archOut:Text);
var nomArchIn,nomArchOut: String;
begin
  writeln('Ingrese el nombre del archivo a ordenar:');
  readln(nomArchIn);
  assign(archIn,nomArchIn);
  writeln('Ingrese el nombre con el que desea guardar el nuevo archivo:');
  readln(nomArchOut);
  assign(archOut,nomArchOut);
end;

procedure LeerDatoPorProfe(var archIn: Text; var auxcodigo,auxdd,auxmm,auxaa,auxhoraIni,auxnhrs,auxcatNum: Integer;
                         var auxnombreProf,auxcategoria: String);
begin
  readln(archIn,auxcodigo);
  readln(archIn,auxnombreProf);
  readln(archIn,auxcategoria);
  readln(archIn,auxdd,auxmm,auxaa);
  readln(archIn,auxhoraIni,auxnhrs);

  case auxcategoria of
    'Principal': auxcatNum:=4;
    'Asociado': auxcatNum:=3;
    'Nombrado': auxcatNum:=2;
    'Contratado': auxcatNum:=1;
  end;
end;

procedure OrdenarArreglos(auxcodigo,auxdd,auxmm,auxaa,auxhoraIni,auxnhrs,auxcatNum: Integer;
                          auxnombreProf,auxcategoria: String;
                          var codigo,dd,mm,aa,horaIni,nhrs,catNum: TArrEntero;
                          var nombreProf,categoria: TArrStr; var cantProf: Integer);
var i,j,k: Integer;

begin
  k:=cantProf;
  while (k>0) and ((catNum[k]<auxcatNum) or ((catNum[k]=auxcatNum) and ((dd[k]+mm[k]*100+aa[k]*10000)>(auxdd+auxmm*100+auxaa*10000)))
        or ((catNum[k]=auxcatNum) and ((dd[k]+mm[k]*100+aa[k]*10000)=(auxdd+auxmm*100+auxaa*10000)) and (nhrs[k]<auxnhrs))) do begin

    codigo[k+1]:=codigo[k];
    dd[k+1]:=dd[k];
    mm[k+1]:=mm[k];
    aa[k+1]:=aa[k];
    horaIni[k+1]:=horaIni[k];
    nhrs[k+1]:=nhrs[k];
    catNum[k+1]:=catNum[k];
    nombreProf[k+1]:=nombreProf[k];
    categoria[k+1]:=categoria[k];

    dec(k)
  end;

  codigo[k+1]:=auxcodigo;
  dd[k+1]:=auxdd;
  mm[k+1]:=auxmm;
  aa[k+1]:=auxaa;
  horaIni[k+1]:=auxhoraIni;
  nhrs[k+1]:=auxnhrs;
  catNum[k+1]:=auxcatNum;
  nombreProf[k+1]:=auxnombreProf;
  categoria[k+1]:=auxcategoria;
  inc(cantProf);
end;

procedure CrearNuevoArchivo(var archOut: Text; var codigo,dd,mm,aa,horaIni,nhrs: TArrEntero;
                            var nombreProf,categoria: TArrStr; var cantProf: Integer);
var i: Integer;
begin
  rewrite(archOut);
  for i:=1 to cantProf do begin
    writeln(archOut,codigo[i]);
    writeln(archOut,nombreProf[i]);
    writeln(archOut,categoria[i]);
    writeln(archOut,dd[i],' ',mm[i],' ',aa[i]);
    writeln(archOut,horaIni[i],' ',nhrs[i]);

  end;
  close(archOut);
end;

procedure ProcesarDatos(var archIn: Text; var codigo,dd,mm,aa,horaIni,nhrs,catNum: TArrEntero;
                        var nombreProf,categoria: TArrStr; var cantProf: Integer);

var auxcod,auxdd,auxmm,auxaa,auxhoraIni,auxnhrs,auxcatNum: Integer;
    auxnombreProf,auxcategoria:String;

begin
  reset(archIn);
  cantProf:=0;
  while not eof(archIn) do begin
    LeerDatoPorProfe(archIn,auxcod,auxdd,auxmm,auxaa,auxhoraIni,auxnhrs,auxcatNum,
                   auxnombreProf,auxcategoria);
    OrdenarArreglos(auxcod,auxdd,auxmm,auxaa,auxhoraIni,auxnhrs,auxcatNum,
                    auxnombreProf,auxcategoria,codigo,dd,mm,aa,horaIni,nhrs,
                    catNum,nombreProf,categoria,cantProf);
  end;
  close(archIn);
end;

var codigo,dd,mm,aa,horaIni,nhrs,catNum: TArrEntero;
    nombreProf,categoria: TArrStr;
    cantProf: Integer;
    archIn,archOut: Text;
begin
  PrepararArchivos(archIn,archOut);
  ProcesarDatos(archIn,codigo,dd,mm,aa,horaIni,nhrs,catNum,nombreProf,categoria,cantProf);
  CrearNuevoArchivo(archOut,codigo,dd,mm,aa,horaIni,nhrs,nombreProf,categoria,cantProf);
end.