Работа с массивом (Pascal)

[imfrozen]

Здравствуйте, помогите пожалуйста на основе имеющегося кода найти кафедру, на которой читается больше всего предметов

Код ввода данных:

program PCK;

uses
  crt;
type
TSubject =record  
 Name:string[20]; {Название предмета}
 CountH:byte; {Количество часов}
 Lector:string[20]; {Преподаватель}
 Cafedra:string[20]; {Кафедра}
 CountE:byte; {Методические пособия – количество в электронном виде}
 CountB:byte; {Методические пособия – количество на бумажном носителе}
 end;

var
  Subjs: array[1..25] of TSubject;
  Subj: TSubject;
  f: file of TSubject;
  myCase: byte;
  n: integer;
  
{-- Процедура ввода данных --}
procedure pEnter;
var
  i: integer;
begin
clrscr;
  assign(f, 'subject.dat');
  rewrite(f);
  repeat
  write('Сколько предметов подрят вы хотите ввести? от 1 до 10: ');
  readln(n);
  until n in [1..10];
  for i := 1 to n do
  begin
   writeln('Введите', ' ', i, ' ', 'предметов');
   with Subj do 
   begin   
    write('|Введите название предмета................|- '); readln(Name);
    write('|Введите количество часов.................|- '); readln(CountH);
    write('|Введите преподавателя....................|- '); readln(Lector);
    write('|Введите название кафедры.................|- '); readln(Cafedra);
    write('|Количество методических пособий в электронном виде........|- '); readln(CountE);
    write('|Количество методических пособий на бумажном носителе......|- '); readln(CountB);
    writeln;
    write(f, Subj); 
  end;
 end;
 close(f);
end;

{-- Процедура чтения данных --}
procedure pRead;
var
  i: integer;
begin
  clrscr;
  assign(f, 'subject.dat');
  reset(f);
  i := 1;
  while not (eof(f)) do 
  begin
    read(f, Subjs[i]);
       writeln(i,Subjs[i].Name:15,' ',Subjs[i].CountH,' ',Subjs[i].Lector:15,' ',Subjs[i].Cafedra:15,'  ',Subjs[i].CountE,' ',Subjs[i].CountB,' ');
    i := i + 1; 
  end;
  close(f);
  n := i - 1;
  writeln(' ');
  writeln('Нажмите Enter для взврата в меню');
  readln;
  clrScr;
end;

begin
repeat
  Writeln('------ Меню ------');
  Writeln('1 : Ввод новых данных');
  Writeln('2 : Чтение данных');
  writeln('3 : Выход');
  readln(myCase);
    case myCase of
      1: pEnter;
      2: pRead;
      3:begin
      writeln('Нажмите Enter для выхода');
      Readln;
      exit;
      end
      else 
        begin
        writeln('Нажмите Enter и повторите ваш ввод');
        Readln; end;
        end
        until (myCase=3);
end.