Список ( всё готово, одна загвоздка есть! )

Program  spisok;
uses crt;
Type
zapdin=^zap;
zap=record
ukaz: zapdin;
info:integer;
end;
 
Var
zapr: zapdin;
zapg: zapdin;
n: integer;
zapis: zapdin;
 
 
procedure sortbubble(var zap1: zapdin);
 
Var
zapt: zapdin;
zapt1: zapdin;
n: integer;
 
Begin
zapt:= zap1;
  while zapt^.ukaz <> nil do
   begin
    zapt1:= zapt^.ukaz;
            while zapt1 <> nil do
             begin
                   If zapt^.info < zapt1^.info then
                       begin
                        n:= zapt^.info;
                        zapt^.info:= zapt1^.info;
                        zapt1^.info:= n;
                        end;
                   zapt1:= zapt1^.ukaz;
             end;
            zapt:= zapt^.ukaz;
   end;
end;  
 
 
Procedure Ochered ( var zap1:zapdin);
var
n:integer;
zapP,zapT:zapDin;
c:char;
Begin
     writeln ('Будем ли создавать очередь? y/n ');
     read(c);
     if c='y' then
     begin
     if c='n' then
        zap1:=nil
                 else
                     begin
                     new(zapT);
                     zap1:=ZapT;
                                repeat
                                writeln ('Введите числа: ');
                                read(n);
                                ZapP:=ZapT;
                                new(ZapT);
                                zapP^.ukaz:=ZapT;
                                ZapP^.info:=n;
                                writeln('Продолжить? y/n');
                                read(c);
                                until c='n';
                     zapP^.ukaz:=nil;
                 Dispose(ZapT);
                      end;
end;         
 
end;
 
 
Procedure print(zap1:zapdin);
var zapt:zapdin;
begin
     if zap1=nil then
     writeln('Список пуст')
     else
         begin
              zapt:=zap1;
              while zapt <>nil do
                    begin
                    write(zapt^.info:7); 
                    zapt:=zapt^.ukaz;
                    end;
                    writeln;
         end;
end; 
 
procedure srarifm(var zap1:zapdin);
 
Var
zapt: zapdin;
zapt1: zapdin;
n,i: integer;
sum:real;
kol:integer;
sr:real;
curr,pred:zapdin;
 
Begin
sum:=0;
n:=1;
zapt:= zap1;
zapt1:= zapt^.ukaz;
sum:=zapt^.info;
  while zapt^.ukaz <> nil do
   begin
    zapt1:= zapt^.ukaz;
            while zapt1 <> nil do
             begin
 
 
                   zapt1:= zapt1^.ukaz;
             end;
 
            zapt:= zapt^.ukaz;
      begin
                        sum:=sum+zapt^.info;
                        n:=n+1;
                        end;
   end;
   sum:=sum/n;
   write('Среднее арифметическое чисел: ',sum);
   
 
             begin
                   curr:=zap1;
                   pred:=zap1;
                   while curr <> nil do
                         If curr^.info > sum then
                            if curr=zap1 then
                                    begin
                                      curr:=curr^.ukaz;
                                      dispose(zap1);
                                      zap1:=curr;
                                      pred:=curr;
                                    end
                                        else
                                        begin
                                        pred^.ukaz:=curr^.ukaz;
                                        dispose(curr);
                                        curr:=pred^.ukaz;
                                        end
                                         else
                              begin
                                   pred:=curr;
                                   curr:=curr^.ukaz;
                              end;
 
               end;
            end;
 
 
 
 
 
 
 
Begin
 
 
 ochered (zapis);
 print (zapis);
 srarifm (zapis);
 print (zapis);
 sortbubble  (zapis);
 print (zapis);
 writeln;
 writeln;
 
 
end.