Список . Процедура удаления .

[Rexar]

Прошу подкорректировать написанную процедуру удаления элемента списка по номеру . Удаляет любой элемент кроме 1 и 2 .

base - адрес начала списка

procedure del(var base:pp);
var tmp,tmp1,tmp2:pp;
n,i:integer;
begin
writeln('Input number : ');
read(n);
tmp := base;
for i:=1 to (n-1) do tmp := tmp^.adr;
tmp1 := tmp^.adr;
tmp:=tmp^.adr;
tmp:=tmp^.adr;
tmp2 := tmp^.adr;
dispose(tmp);
tmp1^.adr := tmp2;
end;

[Хыиуду]

Тип pp опишите.

[Rexar]

Тип pp опишите.

type pp=^elem;
elem=record
inf1:byte;
inf2:word;
inf3:string[3];
adr:pp;
end;
var ptb,pte,pt:pp;
i:integer;

+ список циклический

Добавлю ещё как создаю :

function make: pp;
begin
randomize;
new(pt);
ptb := pt;
pt^.inf1 := random(10);
pt^.inf2 := random(10);
pt^.inf3 := chr(random(25))+chr(random(25))+chr(random(25));
pt^.adr := ptb;
for i := 2 to 12 do
begin
new(pt^.adr);
pt := pt^.adr;
pt^.inf1 := random(10);
pt^.inf2 := random(10);
pt^.inf3 := chr(random(90)+32)+chr(random(90)+32)+chr(random(90)+32);
pt^.adr := ptb;
pte := pt;
end;
make := ptb;
end;
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Удаление первого я организовал :

procedure del1(var base:pp);
var tmp,ptb1:pp;
begin
ptb1:=base;
tmp:=base^.adr;
dispose(base);
ptb:=tmp;
while tmp^.adr<>ptb1 do
tmp:=tmp^.adr;
tmp^.adr:=ptb;

end;

procedure del(var base:pp);
var tmp,tmp1,tmp2:pp;
n,i:integer;
begin
writeln('Input number : ');
read(n);
tmp := base;
if n=1 then del1(ptb) else
begin
for i:=1 to (n-3) do tmp := tmp^.adr;
tmp1 := tmp^.adr;
tmp:=tmp^.adr;
tmp:=tmp^.adr;
tmp2 := tmp^.adr;
dispose(tmp);
tmp1^.adr := tmp2;
if n=1 then
tmp1:=base;
end;end;

Подскажите почему 2 не удаляется ?