Problem z kolejka priorytetowa

Witam
Mam problem mianowicie musze szybko znalezc bledy w tym programie tak aby dawal dobre wyniki. Niestety moje skromne doswiadczenie w programowaniu mi na to nie pozwala, prosze o pomoc.
Program ma tworzyc dynamiczna kolejke a dodawany element ma byc sortowany w momencie wstawiania tzn. trzeba go wstawic w odpowiednie miejsce. Wydaje mi sie ze problem tkwi w warunku w petli while zawartej w procedurze dodaj lecz nie umiem tego poprawic.

program lista;
uses crt;
type plist=^list;
list= record
next:plist;
wart:integer;
end;
var
head:plist;

procedure dodaj(var head:plist; wart:integer);
var
p,temp:plist;
begin
temp:=head;
new(p);
p^.wart:=wart;
if head<>nil then
begin
while ((head^{.next<>nil)and(head}.wart>wart)and((head^.next).wart<wart)) do
begin

                        head:=head^.next;

                        end;
                  p<sup>.next:=head</sup>.next;
                  head^.next:=p;

               end

        else
           begin
           writeln('weszlo tutaj raz'); delay(1500);
           head:=p;
           head^.next:=nil;
           head^.wart:=wart;


           end;
        head:=temp;
     end;

procedure wypisz(head:plist);
var temp:plist;
begin
while head^.next<>nil do
begin
writeln(head^.wart);
temp:=head;

         head:=head^.next;
         dispose(temp);
      end;
   writeln(head^.wart);

end;
procedure odczytaj(head:plist);
begin
writeln('wartosc wynosi',head^.wart);
end;

procedure menu;
var x,n,i,k:integer;
begin
repeat
begin
repeat
begin
writeln(' MENU');
writeln('1. dodaj do kolejki');
writeln('2. wypisz kolejke');
writeln('3. odczytaj jeden element');
read(x);
end;
until ((x>=0)and(x<=3));
if x=1 then
begin
writeln('ile elementow chcesz dodac');
read(i);
for k:=1 to i do
begin
writeln('podaj wartosc dodawanego el. ');
read(n);
dodaj(head,n);
end;
end;
if x=2 then wypisz(head);
if x=3 then odczytaj(head);
end; until x=0;

end;

begin
clrscr;
new(head);
head^.wart:=23;
head^.next:=nil;

menu;
repeat until keypressed;

end.