Here is my program..

program ural1002;
const
 letters:array['a'..'z']of char=('2','2','2','3','3','3','4','4','1','1','5','5','6','6',
                                '0','7','0','7','7','8','8','8','9','9','9','0');

type
 datetype=record
           tot:longint;
           date:array[1..50000]of string[50];
          end;

var
 i,j,tt,kk:longint;
 dp:array[0..100]of longint;
 route:array[0..100]of string[50];
 words,nums:array[1..50]of datetype;
 s1,s2,s3,k,now:string[50];
 ch:char;

function check(l,r:longint; s:string):boolean;
var
 i,len:longint;
begin
 len:=r-l;
 for i:=1 to nums[len].tot do
  if nums[len].date[i]=s then begin now:=words[len].date[i]; exit(true); end;
 exit(false);
end;

procedure print(x:longint);
begin
 if x=0 then exit;
 print(x-length(route[x]));
 write(route[x],' ');
end;

begin
 readln(k);
 while k<>'-1' do begin
  for i:=0 to 100 do dp[i]:=10000;
  for i:=0 to 100 do route[i]:='';
  for i:=1 to 50 do begin words[i].tot:=0; nums[i].tot:=0; end;
  readln(kk);
  for i:=1 to kk do begin
   readln(s1);
   s2:='';
   for j:=1 to length(s1) do
    s2:=s2+letters[s1[j]];
   inc(words[length(s1)].tot);
   words[length(s1)].date[words[length(s1)].tot]:=s1;
   inc(nums[length(s2)].tot);
   nums[length(s2)].date[nums[length(s2)].tot]:=s2;
  end;
  dp[0]:=0;
  for i:=1 to length(k) do
   for j:=i downto 0 do
    if (dp[j]<>10000)and(check(j,i,copy(k,j+1,i-j))) then
     if dp[j]+1<dp[i] then begin dp[i]:=dp[j]+1; route[i]:=now; end;
  if dp[length(k)]=10000 then writeln('No solution.')
  else begin
    tt:=length(k);
        print(tt);
    writeln;
       end;
  readln(k);
 end;
end.