Программа на тему Записи и процедуры

uses
  crt;
 
const
  nowadays = 2013;
  n = 10;
 
type
  datar = record 
    den: 1..31;
    mes: 1..12;
    god: 1900..nowadays;
  end;
  rabotnic = record 
    fio: string[40]; 
    koldet: 1..10; 
    data: array [1..10] of datar; 
  end;
 
var
  ftext: text;
  ftip: file of rabotnic;
  a, b: rabotnic;     
  NameMax: string;        
  i, k, pMax: Byte;
  p:boolean;
 
procedure SearchFIO;
var
  j: byte; x: string[40];
begin
  j := 0;
  Reset(ftip);
  writeln('vvedite familiyu, imya , otchestvo');
  read(x); 
  while not Eof(ftip) do 
  begin
    read(ftip, b);  
    if (b.fio = x) then begin
      writeln(b); Inc(j); end;
  end;
  if j = 0 then writeln('nichego ne naideno');
end;
 
begin
  assign(ftext, 'record.txt');
  assign(ftip, 'ftip.rec');
  {$I-} reset(ftext); {$I+}
  {if IOResult <> 0 then begin
    writeln(' "record.txt" not found, press ENTER to continue..');
    readln; 
    exit;
  end;}
  pMax := 0;
  rewrite(ftip);
  while not eof(ftext) do 
    with a do 
    begin
      read(ftext, fio, koldet);
      for i := 1 to koldet do 
        read(ftext, data[i].god, data[i].mes, data[i].den);
      readln(ftext);
      write(ftip, a);
      k := 0;
      for i := 1 to koldet do 
        if (nowadays - data[i].god) < 18 then inc(k);
      writeln('Rabochiy ', fio:40, k, ' posobiy(a)');
      if k > pMax then begin
        pMax := k;
        NameMax := fio;
      end;      
    end;
  writeln('Max kol posobij u ', NameMax);  
  ReadKey;
  repeat
  Window(1, 1, 80, 25);
  TextBackground(1);
  ClrScr;  
  p:=false;
  writeln('1=poisk zapisi po fio');
  writeln('2=poisk zapisi po kolichestvu posobiy');
  writeln('3=vivod zapisi');
  writeln('4=udalenie zapisey');
  writeln('5=vivod tipizirovannogo faila');
  writeln('6=postroit diagrammu');
  writeln('7=dobavlenie novoy zapisi v file');
  writeln('9=EXIT');
  case ReadKey of 
    '1': SearchFIO; {
      '2': ;
      '3': ;
      '4': ;
      '5': ;
      '6': ;
      '7': ;}
    '9': p:=true;
  end;
  until p;
  close(ftext);
  close(ftip);
end.