[an error occurred while processing this directive]
Listing TELEFON.PAS 
 Program phone; 
 const ni='phone.in'; 
 no='phone.out'; 
 pmax=100; 
 nmax=50000; 
 cmax=10000; 
 lmax=30; 
 
 type sir=array [1..cmax] of char; 
 psir=^sir; 
 mat=array [1..lmax] of psir; 
 vector=array [1..nmax] of byte; 
 pvector=^vector; 
 
 var f:Text; 
 a:mat; 
 lng:pvector; 
 ok:array [0..9,'a'..'z'] 
of 
Longint; 
 nr,use,cuse,stl,stc: 
 array [1..pmax] of Longint; 
 v,used,jump:array [0..pmax] 
of 
Longint; 
 numar,vali:string; 
 n,l,c,i,j,k,h,p,cate,aux,sl,sc: 
 Longint; 
 er:Integer; 
 ch:Char; 
 test:Boolean; 
 
 procedure load; 
 begin 
 Assign(f,ni); 
 Reset(f); 
 Readln(f,numar); 
 Readln(f,n); 
 New(lng); 
 l:=1; 
 c:=0; 
 New(a[1]); 
 for i:=1 to n 
do 
 begin
 readln(f,vali); 
 lng^[i]:=Length(vali); 
 for j:=1 to Length(vali) 
do 
 begin
 c:=c+1; 
 if c>cmax 
then 
 begin
 l:=l+1; 
 c:=1; 
 New(a[l]) 
 end; 
 a[l]^[c]:=vali[j] 
 end 
 end; 
 Close(f) 
 end; 
 
 procedure init_ok; 
 begin 
 for i:=0 to 9 do 
 for ch:='a' to 'z' do 
 ok[i,ch]:=0; 
 ok[1,'i']:=1; ok[1,'j']:=1; 
 ok[2,'a']:=1; ok[2,'b']:=1; 
 ok[2,'c']:=1; ok[3,'d']:=1; 
 ok[3,'e']:=1; ok[3,'f']:=1; 
 ok[4,'g']:=1; ok[4,'h']:=1; 
 ok[5,'k']:=1; ok[5,'l']:=1; 
 ok[6,'m']:=1; ok[6,'n']:=1; 
 ok[7,'p']:=1; ok[7,'r']:=1; 
 ok[7,'s']:=1; ok[8,'t']:=1; 
 ok[8,'u']:=1; ok[8,'v']:=1; 
 ok[9,'w']:=1; ok[9,'x']:=1; 
 ok[9,'y']:=1; ok[0,'o']:=1; 
 ok[0,'q']:=1; ok[0,'z']:=1 
 end; 
 
 procedure init; 
 begin 
 p:=Length(numar); 
 for i:=1 to p do 
 Val(numar[i],nr[i],er); 
 v[0]:=0; 
 for i:=1 to p do 
 v[i]:=Maxint 
 end; 
 
 procedure work; 
 begin 
 for i:=0 to p-1 do 
 if v[i]<>maxint 
then 
 begin
 l:=1; c:=0; 
 for j:=1 to n 
do 
 begin
 sl:=l; 
 sc:=c; 
 if i+lng^[j]<=p then 
 if v[i]+1<v[i+lng^[j]] 
then 
 begin
 test:=true; 
 for k:=1 to lng^[j] 
do 
 begin
 c:=c+1; 
 if c>cmax 
then 
 begin
 l:=l+1; 
 c:=1; 
 end; 
 if ok[nr[i+k], 
 a[l]^[c]]=0 
then 
 begin
 test:=false; 
 k:=lng^[j] 
 end; 
 end; 
 if test 
then 
 begin
 v[i+lng^[j]]:=v[i]+1; 
 used[i+lng^[j]]:=j; 
 jump[i+lng^[j]]:=i 
 end 
 end; 
 l:=sl; c:=sc+lng^[j]; 
 if c>cmax 
then 
 begin
 l:=l+1; 
 c:=c-cmax 
 end 
 end 
 end 
 end; 
 
 procedure imposibil; 
 begin 
 if v[p]=maxint 
then 
 begin
 Assign(f,no); Rewrite(f); 
 Writeln(f,'No solution.'); 
 Close(f); Halt 
 end 
 end; 
 
 procedure reconst; 
 begin 
 i:=p; cate:=0; 
 while i>0 
do 
 begin
 cate:=cate+1; 
 use[cate]:=used[i]; 
 i:=jump[i]; 
 end; 
 for i:=1 to cate do 
 cuse[i]:=use[i]; 
 for i:=1 to cate-1 do 
 for j:=i+1 to cate do 
 if cuse[i]>cuse[j] 
then 
 begin
 aux:=cuse[i]; 
 cuse[i]:=cuse[j]; 
 cuse[j]:=aux 
 end; 
 l:=1; 
 c:=0; 
 k:=1; 
 for i:=1 to n do 
 if k>cate then i:=n 
 
else 
 begin
 if i=cuse[k] 
then 
 begin
 stl[k]:=l; 
 stc[k]:=c; 
 k:=k+1 
 end; 
 c:=c+lng^[i]; 
 if c>cmax 
then 
 begin
 l:=l+1; 
 c:=c-cmax 
 end 
 end; 
 for i:=1 to cate do 
 if cuse[i]=cuse[i-1] 
then 
 begin
 stl[i]:=stl[i-1]; 
 stc[i]:=stc[i-1] 
 end 
 end; 
 
 procedure scrie; 
 begin 
 Assign(f,no); Rewrite(f); 
 for i:=cate downto 1 
do 
 begin
 for j:=1 to cate do 
 if use[i]=cuse[j] then k:=j; 
 l:=stl[k]; 
 c:=stc[k]; 
 for h:=1 to lng^[use[i]] 
do 
 begin
 c:=c+1; 
 if c>cmax 
then 
 begin
 l:=l+1; 
 c:=1 
 end; 
 Write(f,a[l]^[c]) 
 end; 
 Write(f,' ') 
 end; 
 Writeln(f); 
 Close(f) 
 end; 
 Begin  
 load; 
 init_ok; 
 init; 
 work; 
 imposibil; 
 reconst; 
 scrie 
 End. 

[cuprins]