program Buhg_calc;
uses crt;
const
     Hd: array[1..9] of string = ('sto'     , 'dvesti'  , 'trista', 'chetiresta',
                    'pyatsot' , 'shestsot', 'semsot', 'vosemsot',
                    'devyatsot');

     Dc: array[1..10] of string = ('odin' , 'dva', 'tri'  , 'chetire', 'pyat',
                    'shest', 'sem', 'vosem', 'devyat'  , 'desyat');

     th: array[1..10] of string = ('odna' , 'dve', 'tri'  , 'chetire', 'pyat',
                    'shest', 'sem', 'vosem', 'devyat'  , 'desyat');
var
     c: longint;
     res: string;
     tis: boolean;
     rkey: char;

Function Chislo(c: word; tis: boolean): string;
var r, sub: string;
     cdc,n: byte;
     flag: boolean;
begin
flag := false;
r := '';
if c = 0 then
     begin
     chislo := '';
     exit;
     end;

if ((c div 100) > 0) then r := r + hd[c div 100] + ' ';
cdc := c mod 100;

if (cdc <= 10) then
    begin
    if tis then r := r + th[cdc] + ' ' else
    r := r + dc[cdc] + ' ';
    end;

if (cdc > 10) and (cdc < 20) then
    begin
    n := cdc mod 10;
    sub := dc[n];
    if (sub[length(sub)] = 'e') then delete(sub, length(sub), 1);
    if (sub[length(sub)] = 'a') then sub[length(sub)] := 'e';
    r := r + sub + 'nadcat ';
    end;

if cdc >= 20 then
    begin
    if cdc div 10 <= 3 then
       begin
       r := r + dc[cdc div 10] + 'dcat ';
       flag := true;
       end;
    if cdc div 10 = 4 then
       begin
       r := r + 'sorok ';
       flag := true;
       end;
    if cdc div 10 = 9 then
       begin
       r := r + 'devyanosto ';
       flag := true;
       end;

    if flag = false then
       r := r + dc[cdc div 10] + 'desyat ';
    if tis then r := r + th[cdc mod 10] + ' ' else
       r := r + Dc[cdc mod 10] + ' ';
    end;

if tis then
     begin
     if r[length(r) - 1] = 'a' then r := r + 'tysyacha ' else
     if (r[length(r) - 1] = 'e') or
        (r[length(r) - 1] = 'i') then r := r + 'tysyachi ' else
     r := r + 'tysyach ';

     end;
Chislo := r;
end;

begin
clrscr;
repeat
res := '';

writeln(#10#13, 'Vvedite chislo');
{$I-}
readln(c);
{$I+}
if c = 0 then writeln('Nolik');
while (IOResult <> 0) or (c < 0) or (c > 999999) do
     begin
     writeln('Vvedite pravilno chislo: ');
     {$I-}
     readln(c);
     {$I+}
     end;

tis := c div 1000 > 0;
if c div 1000 > 0 then res := chislo(c div 1000, tis);
res := res + chislo(c mod 1000, false);

writeln(res);

writeln('Press [d] to continue...');
rkey := readkey;
until (rkey = 'd') or (rkey ='D');
end.

{A perevodom zanimaites' sami, ya lublu transliteration!!!}