Немного доработать программу

{Дан список из n целых чисел a1,a2,...,an.
                Вывести на экран элементы списка в указанной последовательности: 
                [U]a1,a3,a2,a4,a5,a7,a6,a8,...,an[/U]}
program prog1305a;
 
uses crt;
 
type PList = ^TList;
     TList = record
       info: integer;
       prev, next: PList //prev(previous)
     end;
 
var
  head, tail: PList;
 
{Процедура создания списка}
procedure MakeList(var head, tail:PList);
var k, i, N: integer;
    p: PList; 
begin
  new(head);
  new(tail);
  head^.next:= tail;
  tail^.prev:= head;
  write('Сколько чисел будите вводить? ');
  read(N);
  for i:= 1 to N do
  begin
    new(p);
    read(k);
    p^.info:= k;
    p^.next:= tail;
    p^.prev:= tail^.prev;
    p^.prev^.next:= p;
    tail^.prev:= p;
  end;
end;
 
{Процедура печатает список на экран}
procedure PrintList(var head, tail:PList);
var p: PList;
begin
  p:= head^.next;
  while (p <> tail) do
  begin
    write(P^.info:7);
    p:= p^.next
  end;
end;
 
{ПРоцедура меняет значения местами}
 
procedure MenyaemMestami(head, tail: PList);
var p, q: PList;
begin
  p:= head^.next^.next;
  q:= p^.next;
  p^.next:= q^.next;
  q^.next^.prev:= p;
  q^.next:= p;
  head^.next^.next:= q;
  q^.prev:= head^.next; 
  p^.prev:= q;
end;
 
Begin
  clrscr;
  MakeList(head, tail);
  clrscr;
  writeln('Исходный список: ');
  PrintList(head, tail);
  writeln();
  MenyaemMestami( head, tail);
  writeln('Отсортированный список: ');
  PrintList(head, tail);
  writeln;
End.