type
  TNumb=string[10];
  TPhone=^Phone;
  Phone=record
    n:tNumb;
    r,l:TPhone;
    end;
var
  head,temp:TPhone;
  a:string;
begin
  head:=nil;
  repeat
    a:='';
    new(temp);
    repeat
      write(a,'Enter Phone Number:');
      readln(temp^.n);
      a:='Error length:';
    until length(temp^.n) in[0,3,7];
    if length(temp^.n)>0 then
      begin
        temp^.r:=head;
        temp^.l:=nil;
        if head<>nil then
          head^.l:=temp;
        head:=temp;
      end;
   until length(temp^.n)=0;
   dispose(temp);
   temp:=head;
   if head<>nil then
     begin
       {show original data}
       writeln('All Phone: ');
       while temp<>nil do
         begin
           writeln(temp^.n);
           temp:=temp^.r;
         end;
       {main target}
       temp:=head;
       while temp<>nil do
         begin
           if length(temp^.n)=3 then
             begin
               if temp<>head then
                 begin
                   temp^.r^.l:=temp^.l;
                   temp^.l^.r:=temp^.r;
                 end
                 else
                 head:=head^.r;
               dispose(temp);
               temp:=head;
             end
             else temp:=temp^.r;
         end;
       {show result}
       temp:=head;
       writeln('Phone with out emergency: ');
       while temp<>nil do
         begin
           writeln(temp^.n);
           temp:=temp^.r;
         end;
       {memory free}
       temp:=head;
       while head<>nil do
         begin
           temp:=head;
           head:=head^.r;
           dispose(temp);
         end;
     end;
   end.