Прошу проверить на неправильность..

[CodeExpert]

Здравствуйте форумчане, сейчас сижу делаю себе лабу в институт, задание такое:
Дана строка символов, содержащая русские слова, разделенные пробелами. Удалить из слов с четной длиной все гласные, а из слов с нечетной длинной – все согласные. Полученные слова вывести на экран в лексикографическом виде.
Вот код, он как бы работает, но есть такие входные данные, при которые он не хочет выдавать правильный ответ, к примеру таким словом является слово "на"
вот код:

program aaa;
uses Crt;
const gla: set of char=['А','а','Е','е','И','и','О','о','У','у','Ы','ы','Э','э',
     'Ю','ю','Я','я'];
      so:set of char=['Б','б','В','в','Г','г','Д','д','Ж','ж','З','з','К','к',
      'Л','л','М','м','Н','н','П','п','Р','р','С','с','Т','т','Ф','ф','Х','х',
      'Ц','ц','Ч','ч','Ш','ш','Щ','щ','Ъ','ъ','Ь','ь'];
var mas:array[1..50] of string;//массив слов
    q:integer;//счетчик слов
    str:string;//строка
    i:integer;//циклический счетчик
    slovo:string; //очередное слово
    n:integer;//счетчик для букв
    max,min:integer;
begin
{ввод строки}
Writeln('Введите строку');
readln(str);
{присвоение начального значения счетчикам}
i:=1;
q:=1;
repeat
if str[i]=char(#32) then
 begin
  slovo:=copy(str,1,i-1);//копируем очередное слово
  mas[q]:=slovo;//заносим его в массив
  inc(q);//повышаем счетчик кол-ва слов
  delete(str,1,i);//удаляем использованное строчное слово
  i:=1; //присваиваем начальное значение
  end;
if i=length(str) then
 begin
  slovo:=copy(str,1,i);//копируем очередное слово
  mas[q]:=slovo;//заносим его в массив
  {присваиваем значение больше длинны строки чтоб
  выйти из цикла}
  i:=length(str)+1;
  end;
inc(i);
until i>length(str);
Writeln('Вид разобранной по словам строки:');
for i:=1 to q do
 begin writeln(mas[i]);end;
{разбираем каждое слово массива на состовляющие}
  n:=1;
for i:=1 to q do
 begin
  slovo:=mas[i];
  if (length(slovo) mod 2=0) then
   begin
    repeat
      if slovo[n] in gla then
       begin
        delete(slovo,n,1);n:=1;
        end;
       n:=n+1;
      until n=length(slovo);
    end;
  if not(length(slovo) mod 2=0) then
   begin
    repeat
      if slovo[n] in so then
       begin
        delete(slovo,n,1);n:=1;
        end;
       inc(n);
      until n>=length(slovo);
    end;
    n:=1;
   mas[i]:=slovo;
  end;
Writeln('Вид разобранной по словам строки:');
for i:=1 to q do
 begin writeln(mas[i]);end;
 readln;
 end.