Упорядочить список по другому принципу: сначала следуют элементы с четными табельными номерами в порядке возрастания, за

type 
  PElement = ^TypeElement;
  TypeElement = record
    Nom: integer;
    Fam: string;
    Next: PElement;
  end;
 
var
  first, p, p1, a, pred: PElement;
  s: integer;
  f: string;
  
  
procedure NewList();
begin
  if first = nil then begin writeln('Список пуст'); exit; end;
  p := first;
  while (p^.Nom mod 2 <> 0) do
  begin
    writeln(p^.Nom, ' ', p^.Fam);
    p := p^.Next;
  end;
  writeln;
end;
 
//_____________________________________________________________
//                      ВЫВЕСТИ СПИСОК НА ЭКРАН
//_____________________________________________________________
procedure PrintList();
begin
  if first = nil then begin writeln('Список пуст'); exit; end;
  p := first;
  while p <> nil do
  begin
    writeln(p^.Nom, ' ', p^.Fam);
    p := p^.Next;
  end;
  writeln;
end;
  
 
//_____________________________________________________________
//                       ПОИСК ЭЛЕМЕНТА
//_____________________________________________________________
procedure search(x: string);//Поиск
begin
  if first = nil then begin writeln('Список пуст'); exit; end;
  p := first;
  while (p^.Next <> nil) and (x <> p^.Fam) do p := p^.Next;
  if(x <> p^.Fam) then writeln('Элемент не найден')
  else writeln('Элемент: ', p^.Nom, ' ', p^.Fam);
end;
 
//_____________________________________________________________
//                   ДОБАВЛЕНИЕ НОВОГО ЭЛЕМЕНТА СПИСКА
//_____________________________________________________________
procedure input(x: string);
begin
  if first = nil then begin
    new(a);
    a^.Nom := s;
    a^.Fam := x;
    a^.Next := nil;
    first := a;
  end else begin
    p := first;
    pred := p;
    p := first;
    while (p <> nil) and (x > p^.Fam) do
    begin
      pred := p;
      p := p^.Next;
    end;
    s := s + 1;
    new(a);
    a^.Nom := s;
    a^.Fam := x;
    a^.Next := p;
    if pred = p then first := a
    else pred^.Next := a;
  end;
end;
//_____________________________________________________________
// ПОИСК ЭЛЕМЕНТА В СПИСКЕ ПО НОМЕРУ (НУЖЕН ДЛЯ ДРУГОЙ ПРОЦЕДУРЫ)
//_____________________________________________________________
procedure searchID(x: integer);
begin
  if first = nil then begin writeln('Список пуст'); exit; end;
  p := first;
  while (p^.Next <> nil) and (x <> p^.Nom) do p := p^.Next;
  if(x <> p^.Nom) then writeln('Поиск не дал результатов')
  else writeln(p^.Nom, ' ', p^.Fam);
end;
 
//_____________________________________________________________
//              ПОИСК ЭЛЕМЕНТА С НАИБОЛЬШИМ НОМЕРОМ
//_____________________________________________________________
procedure poiskmax();
var
  max: integer;
begin
  if first = nil then begin writeln('Список пуст'); exit; end;
  p := first;
  while p <> nil do
  begin
   if p^.Nom > max then 
     max := p^.Nom;
   p := p^.next;   
  end;
  searchID(max);
end;
 
//_____________________________________________________________
//                        ОЧИСТКА СПИСКА
//_____________________________________________________________
procedure ochistka();
begin
  dispose(first);
  writeln('Список очищен');
  writeln;
end;
 
 
 
//_____________________________________________________________
//              УДАЛЕНИЕ КОНКРЕТНОГО ЭЛЕМЕНТА
//_____________________________________________________________
procedure delete(x: string);
begin
  if first = nil then begin writeln('Список пуст'); exit; end;
  p := first;
  while (p^.Next <> nil) and (x <> p^.Fam) do
  begin
    pred := p; p := p^.Next;
  end;
  if(x <> p^.Fam) then writeln('Элемент не найден')
  else begin
    writeln('Элемент: ', p^.Nom, ' ', p^.Fam, ' успешно удален');
    if(p <> first) then pred^.Next := p^.Next else first := p^.Next;
    dispose(p);
  end;
end;
 
//_____________________________________________________________
//                       ПЕРЕЗАПУСК ПРОГРАММЫ
//_____________________________________________________________
procedure enter;
var
e: char;
begin
  writeln;
  write('Нажмите Enter для продолжения...'); 
  read(e); 
  //clrscr;
end;
 
//_____________________________________________________________
//                       МЕНЮ
//_____________________________________________________________
procedure Menu;
var
  MI, a: integer;
 
begin 
  writeln('[1]. Показать список');
  writeln('[2]. Добавить элемент в список');
  writeln('[3]. Поиск в списке');
  writeln('[4]. Удалить элемент из списка');
  writeln;
  writeln('Индивидуальные задания:');
    
  writeln('[5]. Задание 1 (21) : .');
 
 
  writeln;
  writeln('[6]. Выход из программы.');
      
  writeln();
  write('Введите номер действия: ');
  readln(MI);
  writeln();
  case MI of
    1: begin 
       PrintList(); 
       enter; 
       Menu; 
       end;
    2: begin 
       writeln('Введите имя: '); 
       readln(f); 
       input(f); 
       writeln('Имя добавлено'); 
       enter; 
       Menu; 
       end;
    3: begin writeln('Введите имя для поиска: '); 
    readln(f); 
    search(f); 
    enter; 
    Menu; 
    end;
    4: begin writeln('Введите имя для удаления: '); 
    readln(f); 
    Delete(f); 
    enter; 
    Menu; 
    end;
    5: begin poiskmax(); 
    enter; 
    Menu; 
    end;
    6: exit;
  end;
end;
 
begin
  s := 1;
  input('Один');
  input('Тор');
  input('Бальдр');
  input('Тюр');
  input('Фрейя');   
  Menu;
end.