Поиск рифмы, строки строки и еще раз строки Опции

[$rvr4vr]

Из заданного словаря выбрать все слова, имеющие рифмы (рифма определяется по принципу, придуманному Незнайкой: два слова рифмуются, если последние слоги у них совпадают, например, “палка – селедка”).
Вот так я сделал. ток мне ее зарубили. сказали чтоб она слоги проверяла, по правилам великого и могучего.

Код

Program Rifma;
uses crt;
Var
y,i,j,k,u,n,s:Byte;
ch:char;
m: array [1..50] of string;
Begin
clrscr;
writeln('Вывод на экран рифмующихся слов');
writeln('Для продолжения ввода слов нажмите Enter');
writeln('Для окончания ввода слов нажмите Esc');
j:=0;
y:=0;
repeat
j:=j+1;
  write(j,'-ое слово  ');
  readln(m[j]);
  ch:=readkey;
until ch=#27;
For i:=1 to j-1 do
   begin
    For u:=i+1 to j do
      begin
       k:=length(m[i]);
       n:=length(m[u]);
       s:=0;
       while m[i][k]=m[u][n] do
         begin
          k:=k-1;
          s:=s+1;
          n:=n-1;
         end;
       If s>=2
        then begin
             writeln(m[i],' - ',m[u]);
             y:=y+1;
             end;
      end;
   end;
If y=0
  then writeln('Слова не рифмуются');
readln;
END.

[$rvr4vr]

На счет шутки о Незнайке....это не прикол это натурально такое задание! и при чем тут ударение?! нам дан принцип этого рекомого Незнайки что слова считаются рифмой когда у нас последнии слоги совподают. остальное нас не волнует! а насчет неоптимальности, просто как то коряво смотрится это повторение два раза одного и тогоже куска,

if (m[i,Length(m[i])-s+1] in ConsDOS) then
           begin
             writeln(m[i],' - ',m[u]);
             y:=y+1;
          end
       end
      else begin
        writeln(m[i],' - ',m[u]);
        y:=y+1;
      end;

вот я и спрашиваю может как то изящнее сделать можно?