ОДнонаправленные линейные списки, удалить из файла 1 слова, встречающиеся в файле 2 Опции

[Тёмный Эльф]

Текст программы приведен ниже. Не могу понять, в чем моя ошибка. Вроде бы первая процедура составляет список1 из первого файла, вторая процедура составляет список2 из второго файла, третья процедура собственно проверяет есть ли в списке 1 слова из списка 2 и если есть, удаляет их. А четвёртая процедура выводит изменённый список 1 в выходной файл.
Если кто заметил ошибку, подскажите пожалуйста где она, может я не правильно передаю параметры при заходе в третью процедуру?

Type
next=^elem;
Elem=RECORD
     EL:string;
     Sled:next;
     END;
VAR
head,head2:next;

Procedure p1(var p:next);
var
m:next;
F1:text;
BEGIN
  Assign(f1,'dan.inp');
  Reset(f1);
  Assign(output,'res.out');
  Rewrite(output);
 New(m);
 New(m^.sled);
 p:=m;
 Readln(f1, m^.el);
 m^.sled:=nil;
 while not EOF(f1) do
 begin
 New(m^.sled);
 m:=m^.sled;
 Readln(f1, m^.el);
 m^.sled:=nil;
 End;
 Close(f1);
end;

Procedure p2(var p:next);
var
m:next;
F1:text;
BEGIN
  Assign(f1,'dan1.inp');
  Reset(f1);
 New(m);
 New(m^.sled);
 p:=m;
 Readln(f1, m^.el);
 m^.sled:=nil;
 while not EOF(f1) do
 begin
 New(m^.sled);
 m:=m^.sled;
 Readln(f1, m^.el);
 m^.sled:=nil;
 End;
 Close(f1);
end;

procedure p3(var uk,d2:next);
var pp,df,q:next;
Begin
pp:=uk;
 While pp^.sled<>NIL  do
   BEGIN
   df:=d2;
 While df^.sled<>NIL do
    Begin
     If pp=df then
       Begin
       q:=pp^.sled^.sled;
       Dispose(pp^.sled);
       pp^.sled:=q;
       end;
df:=df^.sled;
end;
pp:=pp^.sled;
end;
END;

procedure p4(var dr:next);
var dt:next;
Begin
writeln('=======REZULTAT=======');
dt:=dr;
 While dt<>NIL do
 Begin
 Writeln(dt^.el);
 dt:=dt^.sled;
 End;
 close(output);
end;

BEGIN
p1(head);
p2(head2);  
p3(head,head2);			
p4(head); 
END.