uses
  SysUtils,Windows;

const n = 20;

type
  TForm = (Spec, Bak, Mag);
  TOsn = (Budjet, Dogovor);
  TSubj = record
    name: string[20];
    Mark: 2..5;
  end;
  TSession = array [1..5] of TSubj;
  TStudent = record
    Surname: string[20];
    Course: 1..6;
    Form: TForm;
    Osn: TOsn;
    Session: TSession;
  end;
  TMas = array [1..n] of TStudent;
//-----------------------------------------------
procedure ReadStudent (var f: textfile; var S: TStudent); //считывание информации об одном студенте
var buf: string;
    i: integer;
begin
    readln (f, S.Surname);
    readln (f, buf);
    if pos ('Курс ',buf) = 1 then
      delete (buf, 1, 5);
    S.Course := StrToInt(Trim(buf));
    readln (f);
    readln (f, buf);
    if buf = 'Специалист' then S.Form := Spec else
    if buf = 'Бакалавр' then S.Form := Bak else
    if buf = 'Магистр' then S.Form := Mag;
    readln (f);
    readln (f, buf);
    if buf = 'Госбюджет' then S.Osn := Budjet else
    if buf = 'Договор' then S.Osn := Dogovor;
    readln (f);
    for i := 1 to 5 do
    begin
      readln (f, buf);
      S.Session[i].name := copy (buf, 1, length(buf) - 2);
      S.Session[i].Mark := StrToInt (buf[length(buf)]);
    end;
    readln (f);
end;
//-----------------------------------------------
procedure ReadAll (var f: textfile; var a: TMas); //считывание информации обо всех студентах
var i: integer;
begin
for i := 1 to n do
  ReadStudent (f, a[i]);
end;
//-----------------------------------------------
procedure Swap (var a,b: TStudent); //"пузырьковый" обмен
var t: TStudent;
begin
  t := a;
  a := b;
  b := t;
end;
//-----------------------------------------------
function CountAverage (const S: TStudent): real;
var i: integer;
begin
  result := 0;
  for i := 1 to 5 do
    result := result + S.Session[i].Mark;
  result := result / 5;
end;

//-----------------------------------------------
procedure BubbleSort(var A: TMas; n: integer);//удорядочение массива по среднему баллу
var i,j: integer;
begin
  for i := 1 to n - 1 do
    for j := 1 to n - i  do
      if CountAverage(A[j]) > CountAverage(A[j+1]) then swap(A[j], A[j + 1]);
end;
//-----------------------------------------------
procedure PrintStudent (const S: TStudent; var f:textfile);
var i: integer;
begin
with S do
  begin
    writeln (f,Surname);
    writeln (f,'Курс ',Course);
    writeln (f,'Форма обучения:');
    case Form of
      Spec: writeln (f,'Специалист');
      Bak: writeln (f,'Бакалавр');
      Mag: writeln (f,'Магистр');
    end;
    writeln (f,'Основа обучения:');
    case Osn of
      Budjet: writeln (f,'Госбюджет');
      Dogovor: writeln (f,'Договор');
    end;
    writeln (f,'Сессия: ');
    for i := 1 to 5 do
      writeln (f,Session[i].name,' ',Session[i].Mark);
    writeln(f);
  end;
end;
//-----------------------------------------------
function NoDebts (const S: TStudent): boolean;//если студент не двоешник
var i: integer;
begin
  result := true;
  for i := 1 to 5 do
    if S.Session[i].Mark = 2 then result := false;
    NoDebts:=result;
end;
//-----------------------------------------------
procedure Transfer (var a: TMas; var Count: integer); //перевод студентов, не имеющих задолжностей на следующий курс
var i: integer;
begin
i := 1;
while i <= Count do
  begin
    if NoDebts (a[i]) then
        with a[i] do
          if ((Course = 4) and (Form = Bak)) or
             ((Course = 5) and (Form = Spec)) or
             ((Course = 6) and (Form = Mag)) then
             begin
             a[i] := a[Count];
             dec (Count);
             dec (i);
             end
          else inc (Course);
    inc (i);
  end;
end;
//-----------------------------------------------
procedure PrintAll (const a: TMas; Count: integer; var f:textfile); //печать информации о переведенных студентах
var i: integer;
begin
  for i := 1 to Count do
    PrintStudent (a[i],f);
end;
//-----------------------------------------------

var a: TMas;
    f: textfile;
    filename: string;
    f1: file of TStudent;
    count: integer;
Begin
  SetConsoleCP (1251);
  SetConsoleOutputCP (1251);
  writeln ('Введите имя файла:');
  readln (filename);
  if fileexists (filename) then
  begin
    assignfile (f,filename);
    reset (f);
    ReadAll (f, a);
    closefile (f);
    Count := n;
    BubbleSort (a, Count);
    Transfer (a, Count);
    assignfile(f,'output.txt');
    rewrite(f);
    PrintAll (a, Count, f);
    closefile(f);
    writeln('Перевод завершен!');
    end
      else
        writeln ('Файла с таким именем не существует!');
  readln
End.