Разработать программу для автоматической подготовки и печати списков

program xd;
uses crt;
var
f_in,fotl,zar,ost:Text;
FIO: string; 
procedure INFO(key: Integer; pred: String);
label 1,2,3,4,5,6,7,8;
begin
writeln('Исходный файл содержит ошибку (ошибки).');
case key of
1: writeln('Неверно указана Ф.И.О. '+fio+'. Первая буква не является заглавной. Остальные буквы — в нижнем регистре.');
2: writeln('Неверно указана Ф.И.О. '+fio+'. Должны присутствовать только буквы русского алфавита, отсутствовать пробелы и длина не должна превышать 50 символов');
3: writeln('Неверно указано количество предметов в ведомости '+fio+'. Данная величина должна быть числом в диапазоне от 1 до 5000.' );
4: writeln('Неверно указано Наименование предмета '+pred+' в ведомости '+fio+'. Первая буква не является заглавной.');
5: writeln('Неверно указано Наименование предмета '+pred+' в ведомости '+fio+'. Должны присутствовать только буквы русского алфавита и пробелы, длина не должна превышать 60 символов.');
6: writeln('Неверно указана Оценка по предмету '+pred+' в ведомости '+fio+'. Зачету соответствует символ «z» или «Z» без кавычек и пробелов, экзамену — цифра «3″, «4″ или «5″ также указанная без кавычек и пробелов.');
7: writeln('Внимание! Возможна следующая ошибка. Общее количество предметов в ведомости '+fio+' не соответствует указанному.');
8: writeln('Неверно указано Приглашение для '+fio+'. При наличии приглашения следует без кавычек и пробелов указать символ латинского алфавита «Y» или «y», при отсутствии — «N» или «n».');
end;
writeln('Отредактируйте ИСХОДНЫЙ файл и перезапустите программу.');
writeln;
readln;
close(f_in);
close(fotl);
close(zaR);
close(ost);
halt;
end;
procedure open;
var
name: String;
begin
try 
assign(f_in,'C:\Users\Ирина\Desktop\Практика\n.txt');
reset(f_in);
except
end;
writeln('Применить к ВЫХОДНЫМ файлам имена по умолчанию (Y/N)?');
readln(name);
if (pos('Y',name)>0) or (pos('y',name)>0) then
try
assign(fotl,'otl.txt'); rewrite(fotl);
assign(zaR,'zar.txt'); rewrite(zaR);
assign(ost,'fost.txt'); rewrite(ost);
except
writeln('Один из файлов отсутствует');
halt;
end
else BEGIN
writeln('Введите имя файла ОТЛИЧНИКОВ');
readln(name);
try
assign(fotl,name); rewrite(fotl);
except
writeln('Файл отсутствует');
halt;
end;
writeln('Введите имя файла с ПРИГЛАШЕНИЯМИ');
readln(name);
try
assign(zaR,name); rewrite(zaR);
except
writeln('Файл отсутствует');
halt;
end;
writeln('Введите имя файла с ОСТАЛЬНИМИ выпускниками');
readln(name);
try
assign(ost,name); rewrite(ost);
except
writeln('Файл отсутствует');
halt;
end;
END;
end;
procedure C_FIO;{ КОНТРОЛЬ ВВОДА ДАННЫХ ФИО }
var
i:Integer;
label 1,2,3,4,5,6,7,8;
begin
2: writeln('Неверно указана Ф.И.О. '+fio+'. Должны присутствовать только буквы русского алфавита, отсутствовать пробелы и длина не должна превышать 50 символов');
if Length(fio)>50 then goto 2;
if Pos(' ',fio)>1 then goto 2;
for i:=1 to length(fio) do
begin
if not ( (UpCase(fio[i])>='А') and (UpCase(fio[i])<='Я') ) then goto 2;
end;
1: writeln('Неверно указана Ф.И.О. '+fio+'. Первая буква не является заглавной. Остальные буквы — в нижнем регистре.');
if not ((fio[1]>='А') and (fio[1]<='Я')) then goto 1;
for i:=2 to Length(fio) do
if fio[i]<='Я' then goto 1;
end;
procedure C_Total (s: String; var i: Integer);{кол-во предметов в ведомости}
var code: Integer;
label 1,2,3,4,5,6,7,8;
begin
try
Val(s,i,code);
3: writeln('Неверно указано количество предметов в ведомости '+fio+'. Данная величина должна быть числом в диапазоне от 1 до 5000.' );
if (code=0) and ((i<1) or (i>5000)) then goto 3;
except
end;
end;
procedure C_Predmet(s: String);{название предмета}
var
i:Integer;
label 1,2,3,4,5,6,7,8;
begin
if Length(s)>60 then INFO(5,s);
for i:=1 to length(s) do
begin
4: writeln('Неверно указано Наименование предмета '+pred+' в ведомости '+fio+'. Первая буква не является заглавной.');
if not (s[i]=' ') then
if not ((UpCase(s[i])>='А') and (UpCase(s[i])<='Я') ) then goto 4;
if not ((s[1]>='А') and (s[1]<='Я')) then goto 4;
end;
end;
{оценка}
procedure C_Number(s,s_oc: String; var key: Integer); {предмет,оценка, число}
var code: Integer;
begin
if (Pos('z',s_oc)>0) or (Pos('Z',s_oc)>0) then
if length(s_oc)=1
then begin key:=0; exit; end {для зачета key=0}
else INFO(6,s);
try
Val(s_oc,key,code);
if (code=0) and ((key<3) or (key>5)) then INFO(6,s);
except
INFO(6,s);
end;
end;
procedure C_YN(s:String);{приглашение + количество предметов по факту}
label 1,2,3,4,5,6,7,8;
begin
7: writeln('Возможна следующая ошибка. Общее количество предметов в ведомости '+fio+' не соответствует указанному.');
8: writeln('Неверно указано Приглашение для '+fio+'. При наличии приглашения следует без кавычек и пробелов указать символ латинского алфавита «Y» или «y», при отсутствии — «N» или «n».');
if ((Pos('Y',s)>0) or (Pos('y',s)>0)) or ((Pos('N',s)>0) or (Pos('n',s)>0)) then
if length(s)=1
then exit
else goto 8
else {не нашли латискую букву} goto 7;
end;
procedure Sort;{ ЧТЕНИЕ ДАННЫХ И ФОРМИРОВАНИЕ СПИСКОВ }
var
kol, c4, c5 , oc: Integer;
s,s_oc: String;
err, otl:Boolean; {учащийся отличник}
begin
{структура файла исходны данных:фамилия,имя,отчество,кол-во предметов,название_предмета,оценка,наличие_приглашения,следующий студент}
writeln;
while not eof(f_in) do
begin
readln(f_in,fio);
C_FIO;
s:=fio;
readln(f_in,fio);
C_FIO;
s:=s+' '+fio;
readln(f_in,fio);
C_FIO;
s:=s+' '+fio;
fio:=s; {теперь ФИО это ФИО}
readln(f_in,s); {read number with control error}
C_Total(s,kol);
otl:=True;
c4:=0;
c5:=0;
err:=False; {у отличника есть и зачеты и экзамены}
while kol>0 do
begin
readln(f_in,s); {predmet}
C_Predmet(s);
readln(f_in,s_oc); {ocenka}
C_Number(s,s_oc,oc);
if otl=False then {если не отличник то анализ оценок не производим — смотрим файл дальше}
begin
dec(kol);
Continue;
end;
if oc=3 then otl:=False
else if oc=4 then inc(c4)
else if oc=5 then inc(c5);
dec(kol);
end; {while kol}
readln(f_in,s); {read Y/N}
C_YN(s);
if (otl=True) and( (c4=0) and (c5=0)) then begin otl:=False ; err:=True; end; {нет ОЦЕНОК только ЗАЧЕТЫ}
if (otl=TRUE) and (c4*100/(c4+c5)>25) then otl:=False; {сброс флага если очень много 4}
if err=False then begin
if otl{ добавление в списки }
then writeln(fotl,fio){//если отличник, записываем в файл отличников}
else writeln(ost,fio);
if s = 'Y' then {//если есть приглашение — то в файл приглашенных за рубеж}
writeln(zaR,fio);
end; {// if err}
end;{//while eof(f1)}
writeln('Выходные данные успешно записаны.');
writeln('Press any key for exit');
readln;
close(f_in);
close(fotl);
close(zaR);
close(ost);
end;
BEGIN
cls;
open;
sort;
END.