Удалить из списка первый отрицательный элемент, если такой есть

uses
  crt;
 
const
  n = 5;
 
type
  uk = ^trec;
  trec = record
    x: integer;
    Radr, Ladr: uk
  end;
 
var
  firstL1, firstL2, first1L, first2L, first1L1, first2L1, first1L2, first2L2, p1, p2: uk;
  ft: text;
 
procedure SOZD_SPIS(var f1, f2: uk);
var
  i: integer;
begin
  f1 := nil;
  f2 := nil;
  for i := 1 to n do
  begin
    new(p1);
    read(p1^.x);
    p1^.Radr := nil;
    p1^.Ladr := nil;
    if f1 = nil then f1 := p1
    else begin
      p2^.Radr := p1;
      p1^.Ladr := p2 end;
    p2 := p1;
  end;
  f2 := p2;
  writeln;
end;
 
procedure VIV_SPIS(var first: uk; t: string);
begin
  writeln(t);
  p1 := first;
  while p1 <> nil do
  begin
    write(p1^.x:4);
    p1 := p1^.Radr
  end;
  readkey;
end;
 
procedure UDAL(var first: uk);
var
  priz: boolean;
begin
  p1 := first;
  p2 := p1;
  priz := true;
  while (p1 <> nil) and priz do
    if (p1^.x < 0) then begin
      priz := false; p2 := p1;
      p1 := p1^.Radr
    end
    else if p1 = first then 
    begin
      first := p1^.Radr;
      dispose(p1);
      p1 := first
    end
    else 
    begin
      p2^.Radr := p1^.Radr;
      dispose(p1);
      p1 := p2^.Radr
    end;
end;
 
begin
  SOZD_SPIS(FirstL1, FirstL2);
  VIV_SPIS(firstL1, 'список');
  UDAL(FirstL1);
  writeln;
  VIV_SPIS(p1, 'список без отрицательного ');
end.

uses
  crt;
 
type
  uk = ^trec;
  trec = record
    x: integer;
    adr: uk
  end;
 
var p1,p2,first,b, a, L, LL:uk;
    ft:text;
     procedure SOZD_SPIS;
     begin
     reset(ft);
     first:=nil;
     while not eof(ft) do begin
                          new(p1);
                          read(ft,p1^.x);
                          if first=nil then first:=p1
                          else p2^.adr:=p1;
                          p2:=p1;
                           end;
    p2^.adr:=nil;
    close(ft);
    end;
    
    procedure VIVOD_SPIS(ft:uk);
    begin
    p1:=ft;
    while p1<>nil do begin
                     write(p1^.x:5);
                     p1:=p1^.adr;
                     end;
    end;
    
procedure UDAL(var first: uk);
var
  priz: boolean;
begin
  p1 := first;
  
  priz := true;
  while (p1 <> nil) and priz do begin
    if (p1^.x < 0) then begin
      if p1=first then begin first:=p1^.adr; priz:=false end;
    
      priz := false; p2 := p1;end;
      p1:=p1^.adr  
      end;
p1:=first;
while p1^.adr <> p2 do p1:=p1^.adr;
p1^.adr:=p2^.adr
end;    
 
begin
assign (ft, '1.txt');
  SOZD_SPIS;
  writeln('исходный');
  VIVOD_SPIS(first);
  UDAL(first);
  writeln;
  writeln('после удаления отрицательного ');
  VIVOD_SPIS(first);
  writeln;
  dobav;
  end.