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

Const glsogl =['п', 'ф', 'к', 'т', 'ш', 'с', 'м', 'н', 'х', 'ч', 'ц', 'щ'];
      razdel =[' ', ',', '.'];
 
Var I : Integer;
    K : Boolean;
    S : String;
    T : String;
    C : Char;
    M : Array ['а'..'я'] of Boolean;
 
Procedure Control(W:String; ChetNechet:Boolean);
Begin
     //WriteLn (ChetNechet:6, ' ', W);
 
     For C := 'а' To 'я' Do
     Begin
          If (ChetNechet and (pos(C,W) <> 0)) Then M[C] := true;
          If ((not ChetNechet) and (pos(C,W) = 0)) Then M[C] := False;
     End;
End;
 
Begin
     ClrScr;
     WriteLn ('Enter string:');
     ReadLn (S);
     If Length(S) = 0
     Then
         Begin
              S := 'Вывести на печать в алфавитном порядке глухие согласные';
              WriteLn(S);
         End
     Else
         If S[Length(S)] <> '.' Then S := S + '.';
 
     For C := 'а' To 'я' Do
     Begin
           M[C] := True;
     End;
 
     I := 1;
     K := False;
     T := '';
     While S[I]<> '.' Do
     Begin
          If (S[I] in razdel)
          Then
              Begin
                   If Length(T) <> 0 Then
                   Begin
                        Control(T, K);
                        T := '';
                        K := not K;
                   End;
              End
          Else T:=T+S[I];
          Inc(I);
     End;
     Control(T, K);
 
      For C := 'а' To 'я' Do
          If (C in glsogl) and M[C]
             Then WriteLn(C, ' ', M[C], ' ');
      WriteLn;
 
     ReadLn;
End.

uses crt;
const
gl=['к','п','с','т','ф','х','ц','ч','ш','щ','К','П','С','Т','Ф','Х','Ц','Ч','Ш','Щ'];{глухие согласные}
bk:string='КкПпСсТтФфХхЦцЧчШшЩщ';
type mnoz=set of char;
var  s,s1:string;
     m:array[1..100] of mnoz;{массив множеств}
     mn_ob,mn,mn1:mnoz;
     n,i,j:byte;
begin
clrscr;
repeat
writeln('Введите текст на русском языке, между словами пробелы:');
readln(s);
if pos(' ',s)=0 then
writeln('В предложении только одно слово. Повторите ввод.');
until pos(' ',s)>0;
s:=s+' ';{}
mn_ob:=[];
for i:=1 to length(s) do
if s[i] in gl then mn_ob:=mn_ob+[s[i]];
n:=0;
while pos(' ',s)>0 do{создаем массив множеств}
 begin
  s1:=copy(s,1,pos(' ',s)-1);{копируем очередное слово}
  n:=n+1;{считаем}
  m[n]:=[];{создаем множество}
  for j:=1 to length(s1) do
  if s1[j] in gl then m[n]:=m[n]+[s1[j]];{из его букв по условию}
  delete(s,1,pos(' ',s));{удаляем это слово}
 end;
mn1:=[];{множество цифр, не входящих только в одно число}
for i:=1 to n do{для каждого множества }
 begin
  mn:=[];
  for j:=1 to n do
  if j<>i then mn:=mn+m[j];{делаем множество из букв, котoрые входят в другие числа}
  mn1:=mn1+(m[i]-mn);{вычитаем из даннго множества общее множество
                      и остаток записываем в новое}
 end;
if mn1=[] then writeln('Цифр, которые не входят только в одно число, нет!')
else
 begin
  writeln('Цифры, которые не входят только в одно число:');
  for i:=1 to length(bk) do{идем по алфавиту,
  если буква есть в общем множестве и ее нет в котором по разу, выводим}
  if (bk[i] in mn_ob)and not (bk[i] in mn1) then write(bk[i],' ');
 end;
readln
end.

  (*Заменить:*)
  (*if (bk[i] in mn_ob) and not (bk[i] in mn1) then write(bk[i],' ');*)
  if (bk[i] in mn_ob) and (bk[i] in mn1) then write(bk[i],' ');