My program gets "WA". I can't find what's wrong with it. Please help
me. Thank you!

program u1085;

var
  link :array[1..100,1..100] of boolean;
  pp,ppa   :integer;
  dist :array[1..100] of integer;
  n,k,v,u:integer;
  st   :array[1..100] of integer;
  money:array[1..100] of integer;
  okay :boolean;
  sum,summ  :longint;
  q    :array[1..100] of integer;


procedure init;

var
  m,u,l,v,w,bb  :integer;
  te  :array[1..100] of integer;


begin
{  assign(input,'u1085.in');
  reset(input);}
  readln(n,m);
  fillchar(link,sizeof(link),false);
  for u:=1 to m do begin
    read(l);
    for v:=1 to l do read(te[v]);
    readln;
    for v:=1 to l-1 do
      for w:=v+1 to l do begin
        link[te[v],te[w]]:=true;
        link[te[w],te[v]]:=true;
    end;
  end;
  readln(k);
  u:=1;
  while u<=k do begin
    readln(money[u],st[u],bb);
    if bb=1 then dec(k) else inc(u);
  end;
{  close(input);}
end;


procedure workpath;

var
  u,v,i,j  :integer;

begin
  fillchar(dist,sizeof(dist),$FF);
  fillchar(q,sizeof(q),0);
  i:=1; j:=1; q[1]:=pp; dist[pp]:=0;
  repeat
    for u:=1 to n do if (link[q[i],u]) and (dist[u]=-1) then begin
      dist[u]:=dist[q[i]]+1;
      inc(j);
      q[j]:=u;
    end;
    inc(i);
  until i>j;
end;



begin
  init;
  summ:=maxlongint;
  for pp:=1 to n do begin
    workpath;
    okay:=true;
    for u:=1 to k do begin
      if dist[st[u]]=-1 then begin
        okay:=false;
        break;
      end;
      if dist[st[u]]*4>money[u] then begin
        okay:=false;
        break;
      end;
    end;
    if okay then begin
      sum:=0;
      for u:=1 to k do sum:=sum+dist[st[u]]*4;
      if sum<summ then begin summ:=sum; ppa:=pp; end;
    end;
  end;
  if summ=maxlongint then writeln(0) else writeln(ppa,' ',summ);
end.