Напечатать в алфавитном порядке все глухие согласные буквы, которые не входят только в одно слово

k:=0;
for i:=1 to a do 
if (pos(f[i],y)=0) and((length(y)-1) mod 2<>0) then begin write (f[i],' ');k:=k+1;
end;
if k=0 then write('букв удовлетворяющих условию нет');
end.

for e :='а'to 'я' do begin  for i:=1 to a do 
if (pos(f[i],y)=0) and((length(y)-1) mod 2<>0) and (f[i]=e) then begin write (f[i],' ');k:=k+1;
end;if k=0 then write('букв удовлетворяющих условию нет');
end

program qqq;
var st,q:string;
a:array [1..100] of string;
gl,zn,m:set of char;
x,z:char;
i,i1,k,v:integer;
Begin
read(st);
gl:=['к','п','с','т','ф','х','ц','ч','ш','щ'];
zn:=[',','.',' '];
m:=[];
q:='';
for i1:=1 to length(st)do
if st[i1] in zn then
   begin
   q:=q+'.';
   for i:=1 to length(q) do
   if q[i] in zn then
      begin
      gl:=gl*m;
      m:=[];         {не входят только в одно слово нечетной длинны}
      q:='';
      end
   else
       if q[i] in gl then
       include(m,q[i])
   end
else
q:=q+st[i1];
   if length(q) mod 2 =1 then
      begin
      k:=k+1;
      a[k]:=q;
      end;
   for x:='а' to 'я' do
   if x in gl then
   begin
   z:=x;
   for i:=1 to k do
   if pos(x,a[i])<>0 then v:=v+1;
   if v<>k-1 then exclude(gl,x);
   end;
if gl=[] then
write('net bukov')
else
for x:='а' to 'я' do
if x in gl then
writeln(x);
end.