Преобразовать список в очередь

uses
  crt;
 
type
  PElement = ^TypeElement;
  TypeElement = record
    Name: string;
    Id: integer;
    Next: PElement;
  end;
 
var
  head, pcur, pnew, ppred: PElement;
  ID, DopCount: integer;
 
 
procedure Insert(Stroka: string);
begin
  New(pnew);
  pnew^.name := Stroka;
  ID := ID + 1;
  pnew^.Id := ID;
  
  if head = nil
  then begin
    pnew^.Next := nil;
    head := pnew;
  end
  else begin
    ppred := nil;
    pcur := head;
    while (Stroka > pcur^.name) and (pcur^.next <> nil) do 
    begin
      ppred := pcur;
      pcur := pcur^.next;
    end;
    
    if (pcur^.next = nil) and (Stroka > pcur^.name)
    then begin
      ppred := pcur;
      pnew^.next := nil;
    end
    else pnew^.next := pcur;
    
    if ppred = nil
      then head := pnew
    else ppred^.next := pnew;
  end;
end;
 
 
procedure Print;
begin
  pCur := Head;
  while pCur <> nil do
  begin
    writeln(pCur^.Id, ' ', pCur^.Name);
    pCur := pCur^.Next;
  end;
end;
 
 
procedure Find(stroka: string);
var
  el: integer;
begin
  el := 0;
  pcur := head;
  DopCount := 0;
  
  while pcur <> nil do 
  begin
    if pcur^.name = stroka
    then begin
      el := pcur^.ID;
      writeln(el);
      DopCount := DopCount + 1;
    end;
    pcur := pcur^.next;
  end;
  if el = 0
    then writeln('Элемент не существует!');
end;
 
procedure Delete(NameDel: string);
 
begin
  ppred := nil;
  pcur := head;
  
  while (pcur^.next <> nil) and (pcur^.name <> NameDel) do
  begin
    ppred := pcur;
    pcur := pcur^.next;
  end;
  
  
  if (pcur^.name = NameDel)
  then begin
    if (pCur^.next = nil)
    then begin
      if pCur = head
        then head := pcur^.next
      else ppred^.next := nil;
      Writeln('Элемент ', pcur^.Name, ' № ', pcur^.Id, ' удалён!');
      Dispose(pcur);
    end
    else begin
      if pcur = head
        then head := pcur^.next
      else ppred^.next := pcur^.next;
      Writeln('Элемент ', pcur^.Name, ' № ', pcur^.Id, ' удалён!');
      Dispose(pcur);
    end;
  end
  else Writeln('Нет такого элемента!');
end;
 
procedure DopFind;
var
  stroka: string;
  IdDel: integer;
 
begin
  while (stroka <> 'Четных элементов нет!') do 
  begin
    pcur := head;
    ppred := head;
    pcur := pcur^.next;
    IdDel := -1;
    while (pcur <> nil) and (IdDel <> 0) do 
    begin
      
      if ppred^.name = pcur^.name
      then begin
        stroka := pcur^.name;
        writeln(stroka, ':');
        
        ppred := pcur;
        pcur := pcur^.next;
        
        Find(stroka);
        
        while DopCount > 1 do 
        begin
          writeln('Какой номер удалить? 0 - ничего не удалять, вернуться в главное меню');
          readln(IdDel);
          
          if IdDel = 0
          then begin
            DopCount := 1;
            stroka := 'Четных элементов нет!';
            break;
          end
          else begin
            ppred := nil;
            pcur := head;
            
            while (pcur^.next <> nil) and (pcur^.ID <> IdDel) do
            begin
              ppred := pcur;
              pcur := pcur^.next;
            end;
            
            if (pcur^.Id = IdDel)
            then begin
              if (pCur^.next = nil)
              then begin
                if pCur = head
                  then head := pcur^.next
                else ppred^.next := nil;
                Writeln('Элемент ', pcur^.Name, ' № ', pcur^.Id, ' удалён!');
                Dispose(pcur);
              end
              
              else begin
                if pcur = head
                  
                  then head := pcur^.next
                else ppred^.next := pcur^.next;
                
                Writeln('Элемент ', pcur^.Name, ' № ', pcur^.Id, ' удалён!');
                Dispose(pcur);
              end;
            end;
            DopCount := DopCount - 1;
          end;
        end;
      end
      else begin
        ppred := pcur;
        pcur := pcur^.next;
        stroka := 'Одинаковых элементов нет!';
      end;
    end;
    if (IdDel <> 0) and (stroka = 'Одинаковых элементов нет!') then writeln(stroka);
  end;
end;
 
procedure Control;
var
  stroka: string;
  comanda: integer;
 
begin
  Insert('Anikin');
  Insert('Fedorov');
  Insert('Litvinov');
  Insert('Nikonov');
  Insert('Vetrov');
  comanda := 0;
  
  while comanda <> 6 do 
  begin
    writeln('Выберите нужное действие:');
    writeln('-------------------------');
    writeln('1) Просмотреть список');
    writeln('2) Добавить элемент');
    writeln('3) Удалить элемент');
    writeln('4) Поиск по списку');
    writeln('5) Поиск одинаковых элементов');
    writeln('6) Выход');
    readln(comanda);
    clrscr;
    
    case comanda of
      1: Print;
      2:
        begin
          Writeln('Введите добавляемый элемент:');
          Readln(stroka);
          Insert(stroka);
        end;
      3:
        begin
          writeln('Введите фамилию:');
          readln(stroka);
          Delete(stroka);
        end;
      
      4:
        begin
          writeln('Введите фамилию:');
          readln(stroka);
          find(stroka);
        end;
      5: opFind;
    end;
    
  end;
end;
 
begin
  clrscr;
  Head := nil;
  ID := 5000;
  Control;
end.