Удалить из списка все элементы с четными табельными номерами

program LinearList;
uses crt;
//Сам список
type PElement=^TypeElement;
     TypeElement=record
     Name:string[100];
     Id:integer;
     Next:PElement;
end;
var PHead,PCur,PPred,PNew:PElement;
    IdEnd:integer;
    st:string;
    Id:integer;
//добавление в список
procedure Insert(Element:string);
  begin
    New(PNew);
    PNew^.Name:=Element;
    IdEnd:=IdEnd+1;
    PNew^.Id:=IdEnd;   
    if PHead=nil then
      begin        
        PNew^.Next:=nil;
        PHead:=PNew;
      end
    else 
      begin
        PPred:=nil;
        PCur:=PHead;
        while (Element > PCur^.Name) and (PCur^.Next <> nil) do
          begin
            PPred:=PCur;
            PCur:=PCur^.Next;
          end;
        if (PCur^.Next=nil) and (Element > PCur^.Name) then
          begin
            PPred:=PCur;
            PNew^.Next:=nil;
          end
        else 
          PNew^.Next:=PCur;
        if PPred=nil then
          PHead:=PNew
        else 
          PPred^.Next:=PNew;      
      end;
    
  end;
//просмотр списка
procedure Print;
  begin
    PCur:=PHead;
    while PCur <> nil do
      begin
        writeln(PCur^.Id,' ', PCur^.Name);  
        PCur:=PCur^.Next;        
      end;
  end;
//удаление элемента(ов) из списка
procedure Delete;
  var NameDel:string;
  begin
    writeln('Введите фамилию: ');
    readln(NameDel);
    PPred:=nil;
    PCur:=PHead;
    while (PCur^.Next <> nil)and(PCur^.Name <> NameDel) do
      begin
        PPred:=PCur;
        PCur:=Pcur^.Next;
      end;
    if PPred = nil then
      begin
        PHead:=PCur^.Next;
        Dispose(PCur);
      end else
    if (PCur^.Next = nil)and(PCur^.Name = NameDel) then
      begin
        PPred^.Next:=nil;
        Dispose(PCur);
      end else
      begin
        PPred^.Next:=PCur^.Next;
        Dispose(PCur);
      end;     
  end;
 //Поиск
 procedure Find(st:string);
 var  x:integer;     
 begin
   x:=0;
   PCur:=PHead;
   repeat
    if (PCur^.Name=st) then x:=PCur^.Id;
    PCur:=PCur^.Next;
   until  PCur=nil;
  if x<>0 then writeln(x) else writeln('Элемент не существует!');
 end;
//инициализация меню и программы
procedure InitControls;  
  var IdMenu:integer;
      NameIC:string;
  begin
    //поля списка, заданные в лабораторной
    IdEnd:=IdEnd+5000;
    Insert('Аникин');
    Insert('Федоров');
    Insert('Литвинов');
    Insert('Никонов');
    Insert('Ветров');
    IdMenu:=1;
    while IdMenu <> 5 do
      begin
        writeln('Выберите нужное действие:');
        writeln('1) Просмотреть список');
        writeln('2) Добавить');
        writeln('3) Удалить');
        writeln('4) Поиск');
        writeln('5) Quit');
        readln(IdMenu);
        clrscr;
        case IdMenu of
          1:Print;
          2:begin
            writeln('Введите фамилию:');
            readln(NameIC);
            Insert(NameIC);
            end;
          3:Delete;
          4:begin
              writeln('Введите фамилию:');
              readln(st);
              find(st);            
            end;
 
        end;  
      end;    
  end;
begin
InitControls;
end.

//óäàëåíèå ÷åòíûõ ýëåìåíòîâ
procedure DeleteEven;
begin
  PCur:=PHead;
  PPred:=nil;
  
  while( PCur <> nil )do begin
    if ( PCur^.Id mod 2 = 0 ) then begin 
      if( PHead = PCur )then
        PHead:=PCur^.Next;
      
      if ( PPred <> nil ) then
        PPred^.Next:=PCur^.Next;
 
 
      PNext:=PCur^.Next;
      Dispose(PCur);
      PCur:=PNext;
    end
    else begin
      PPred:=PCur;
      PCur:=PCur^.Next;
     end
  end;
end;