Найти самый большой проходной балл у студентов

Program xa;
type
 cnuc=record
  f:string[40];
  fak:string[40];
  ocen:real;
  otl:byte;
 end;
 fk=record
  fak:string[40];
  kol:integer;
 end;
var
 abc:array[1..100] of cnuc;
 n,i,m,k,l,j:integer;
 fak:array[1..20] of fk;
 ball,max:real;
 tmp:string[40];
 p:boolean;
begin
 Writeln('BBedute KoLU4ecTBo abuTyPueHToB');
 readln(n);
 Writeln('BBedute DaHHble abuTyPueHToB');
 writeln;
 {BBoD abuTyPueHToB}
 for i:=1 to n do
 begin
  Write('FaMuLu9 ');
  readln(abc[i].f);
  Write('FaKyLbTeT ');
  readln(abc[i].fak);
  Write('Ek3aMuHaL/uOHHblu ball ');
  readln(abc[i].ocen);
  Write('Eclu oTLu4Huk BBedute "1", eclu Het to "0"    ');
  readln(abc[i].otl);
  writeln;
 end;
 {KoHeL/ BBoda}
 Writeln;
 Writeln('BBedute npoxoDHou ball');
 readln(ball);
 
 {BbldeL9em u3 bcex fakyLbTeToB oDuHakoBble}
 fak[1].fak:=abc[1].fak;
 l:=1;
 for i:=2 to n do
 begin
  m:=l;
  p:=true;
  k:=1;
  while (k<=m) and p do
   if abc[i].fak=fak[k].fak then
    p:=false
   else
    inc(k);
   if k>m then
   begin
    inc(l);
    fak[l].fak:=abc[i].fak;
   end;
 end;
 m:=l;   {m-KoLu4ecTBo FaKyLbTeToB}
 l:=0;
 
 {npoBePka ha nocTynuL uLu HeT}
 for i:=1 to n do
 begin
  k:=1;
  p:=true;
  if abc[i].otl=1 then
  begin
   if abc[i].ocen+0.25>=ball then
   begin
    inc(l);
    while (k<=m) and (p) do
     if abc[i].fak=fak[k].fak then
     begin
      inc(fak[k].kol);
      p:=false
     end
     else
      inc(k);
   end
  end
  else
  begin
   if abc[i].ocen>=ball then
   begin
    inc(l);
    while (k<=m) and (p) do
    if abc[i].fak=fak[k].fak then
    begin
     inc(fak[k].kol);
     p:=false
    end
    else
     inc(k)
    end
  end
 end;
 {koHeL/ npoBePKu}
 
 Writeln;
 Writeln('Bcego B YHuBePCuTeT npuH9To ' ,l, ' abuTypueHTa');
 
 {npoBePka ha caMblu boLbLLIou npoxoDHou ball}
 if abc[1].otl=1 then
  max:=abc[1].ocen+0.25
 else
  max:=abc[1].ocen;
 l:=1;
 for i:=2 to n do
  if abc[i].otl=1 then
  begin
   if abc[i].ocen+0.25>max then
   begin
    max:=abc[i].ocen+0.25;
    l:=i;
   end
  end
  else
   if abc[i].ocen>max then
   begin
    max:=abc[i].ocen;
    l:=i;
   end;
 {KoHeL/ npoBePku}
 writeln('CaMblu boLbLLIou npoxoDHou ball y ' ,abc[l].f);
 writeln('FaKyLbTeT   nPuH9To');
 
 {coPtuPoBka faKyLbTeToB}
 k:=m-1;
 p:=true;
 While p=true do
 begin
  p:=false;
  for j:=1 to k do
  begin
   if fak[j].kol<fak[j+1].kol then
   begin
    fak[j].kol:=fak[j].kol-fak[j+1].kol;
    fak[j+1].kol:=fak[j+1].kol+fak[j].kol;
    fak[j].kol:=fak[j+1].kol-fak[j].kol;
    tmp:=fak[j+1].fak;
    fak[j+1].fak:=fak[j].fak;
    fak[j].fak:=tmp;
    l:=j;
    p:=true;
   end;
  end;
  k:=l-1;
 end;
 {koHeL/ copTuPoBKu}
 
 for k:=1 to m do
  Writeln(fak[k].fak, '      ' ,fak[k].kol);
 readln;
end.