Строки в pascal

[neomax38]

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

Этот код слишком громоздкий и не хватает суммы цифр первого цифрового слова.
Как можно минимизировать? И что дополнить? Подскажите

Program Stroki;
Uses CRT;
Const
  Mn_b:Set of char = ['a'..'z'];
  Mn_b1:Set of char = ['A'..'Z'];
  Mn_cifr:Set of char = ['0'..'9'];
Var
  Mas:array[1..20] of String;
  Stroka,Nov_stroka1,Nov_stroka2,Buf_Str:String;
  i,j,k,Dlina,Kol,Summa,Kol1:Byte;
  Flag1,Flag2:Boolean;
Begin
  ClrScr;
  Write('Введите строку: ');
  Readln(Stroka);
  Writeln;
  j:=1;
  Kol:=1;
  i:=1;
  While i <= Length(Stroka) do
  Begin
    If Stroka[i] <> ' ' then
    Begin
      Mas[j]:=Mas[j]+Stroka[i]
    End
    Else
    If Stroka[i] = ' ' then
    Begin
      Inc(j);
      Inc(Kol)
    End;
    Inc(i)
  End;
  Nov_Stroka1:='';
  I:=1;
  While i <= Kol do
  Begin
    Buf_Str:=Mas[i];
    Dlina:=Length(Buf_str);
    If Dlina <= 7 then
    Begin
      Flag1:=True;
      For j:=1 to Dlina do
      If Not (Buf_Str[j] in Mn_b) or (Buf_str[j] in Mn_b1) then
      Begin
        Flag1:=False;
        Break
      End;
      If Flag1=true then
                    Begin
                      Nov_stroka1:=Nov_stroka1+' '+Buf_str;
                    End;
    End;
    Inc(i);
  End;
  For k:=1 to Length(Nov_stroka1) do
  Begin
    Nov_stroka1[k]:=UpCase(Nov_stroka1[k]);
  End;
  Write('Новая строка: ',Nov_Stroka1);
  Writeln;
  Summa:=0;
  Nov_stroka2:='';
  i:=1;
  Kol1:=0;
  While i <= Kol do
  Begin
    Buf_Str:=Mas[i];
    Flag2:=True;
    For j:=1 to Length(Buf_str) do
    Begin
      If Not (Buf_str[j] In Mn_cifr) then
      Begin
        Flag2:=False;
        Break
      End;
    End;
    If Flag2=True then
    Begin
      Inc(Kol1);
      Break
    End;
    Inc(I)
  End;
  Nov_stroka2:=Buf_Str;
  If Kol1 > 0 then
  Writeln('Первое цифровое слово: ',Nov_Stroka2)
  Else
  Writeln('В строке нет цифрового слова ');
  Readln
End.

есть второй вариант программы но она не работает:

 type
 worda=record s:string;ok:boolean;end;
var s:string; a:array[1..100] of worda;
  e,i,count,k,sum:integer; isdig:boolean;
begin   {$o-}
 s:='Helloololo 13 my 21 world';
 count:=1;
 isdig:=true;     sum:=0;
 i:=1; while (i<=length(s)) do begin
   if s[i]=' ' then begin
    val(a[count].s,k,e);
    if isdig and (e=0) then begin
      for k:=1 to length(a[count].s) do begin
        sum:=sum+ord(a[count].s[k])-ord('0');
      end;
      isdig:=false;
    end;
    inc(count);inc(i);
   end;
   a[count].s:=a[count].s+UpperCase(s[i]);
   a[count].ok:=length(a[count].s)<=7;
   inc(i);
 end;
 for k:=1 to count do begin
  if a[k].ok then  writeln(a[k].s);
 end;
 writeln(sum);
 readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.