Program COMMA(x1:string)[MENU];        { written by Luis Bermello Crespo }
                                       {            DICT-MES, Cuba       }
var fst1  : array [1..200] of string;  {            April, 1993          }
    line1 : array [1..200] of string;
    fstname1, impname1 : string;
    maxfst1, n1, pos1, fldn1, fldn0 : real;
    s0, s1, s2, tag1, sep1 : string;

{--------------------------------------------}
Function UPPER(s:string):string;
var us:string;
begin
us:=s;  uc(us);  upper:=us;
end;
{--------------------------------------------}
Function TRIM(s:string):string;
var z1 : string;
begin
z1:=s;
if z1<>'' then begin
 while (size(z1)>1) and (substr(z1,size(z1),1)=' ') do z1:=substr(z1,1,size(z1)-
   1);
 while (size(z1)>1) and (substr(z1,1,1)=' ') do z1:=substr(z1,2,255);
end;
if z1=' ' then z1:='';
trim:=z1;
end;
{--------------------------------------------}
Procedure TextoMsg(r1:real;z1:string);
{ 0 espera inkey, 1 intermitente }
var n1,n2:real; s2:string;
begin
z1:=' '|z1|' ';
clearbox(4,1,1,80,-2);
n2:=size(z1)+2;  n1:=(80-n2)/2;
cursor(4,n1+1); write(z1);
chattr(1,4,n1+1,size(z1));
if r1=0 then s2:=inkey
end;
{--------------------------------------------}
Function Integer(n0:real):real;
var n1:real;
begin
n1:=val(encint(n0,1));
Integer:=n1;
end;
{--------------------------------------------}
Function FindTag(z0:string;l0:real):string;
{ z0 texto de la cadena, l0 valor maximo del arreglo }
var min1,max1,m1:real; sw1:string;
begin
min1:=1;
max1:=l0;
m1:=integer((max1+min1)/2);
sw1:='';
while (min1<=max1) and (sw1='') do begin
 if substr(fst1[m1],1,4)=z0 then sw1:=substr(fst1[m1],5,100)
 else begin
  if substr(fst1[m1],1,4)>z0 then max1:=m1-1 else min1:=m1+1;
 end;
 m1:=integer((max1+min1)/2);
end;
sw1:=trim(sw1);
FindTag:=sw1;
end;
{--------------------------------------------}
Procedure SortFst;
var i1,j1,sw1:real; s1:=string;
begin
i1:=1;
sw1:=1;
while (i1<maxfst1-1) and (sw1<>0) do begin
 sw1:=0;
 j1:=1;
 while j1<maxfst1-i1 do begin
  if fst1[j1]>fst1[j1+1] then begin
   s1:=fst1[j1];
   fst1[j1]:=fst1[j1+1];
   fst1[j1+1]:=s1;
   sw1:=1;
  end;
  j1:=j1+1;
 end;
 i1:=i1+1;
end;
end;
{--------------------------------------------}
Procedure FstImpNm;
var s1,s2:string; n1,n2:real;
begin
fstname1:='';  impname1:='';  maxfst1:=0;
clear;      cursor(1,1);
write(msgtext(295)|' ');
readln(fstname1);
fstname1:=trim(upper(fstname1));
if fstname1<>'' then begin
 if filexist(path('dbn',10)|fstname1|'.FST')<>0 then begin
  TextoMsg(0,fstname1|'.FST --> '|msgtext(316));
  fstname1:='';
 end;
end;
if fstname1<>'' then begin
 cursor(2,1);
 write(msgtext(214)|' ');
 readln(impname1);
 impname1:=trim(impname1);
 if impname1='' then fstname1:=''
 else begin
  cursor(3,1);    s1:='';
  write(msgtext(126)|' ');
  readln(s1);
  if s1<>'' then impname1:=s1|impname1;
  if filexist(impname1)<>0 then begin
   TextoMsg(0,impname1|' --> '|msgtext(316));
   fstname1:='';
   impname1:='';
  end;
 end;
end;
if fstname1<>'' then begin
 if position('Ss',lang,1)=0 then s1:='PLEASE, WAIT' else s1:='ESPERE UNOS SEGUND
   OS';
 TextoMsg(1,s1);
 for n1:=1 to 200 do fst1[n1]:='';
 assign('inp',path('dbn',10)|fstname1|'.FST');
 while (maxfst1<201) and not (eof(inp)) do begin
  readln(inp,s1);
  maxfst1:=maxfst1+1;
  n1:=position(s1,' ',1);
  fst1[maxfst1]:=encint(val(substr(s1,1,n1-1)),4);
  s1:=substr(s1,n1+1,5000);
  n1:=position(s1,' ',1);
  s1:=substr(s1,n1+1,5000);
  s2:='';
  while position('1234567890',substr(s1,1,1),1)=0 do s1:=substr(s1,2,5000);
  while position('1234567890',substr(s1,1,1),1)>0 do begin
   s2:=s2|substr(s1,1,1);
   s1:=substr(s1,2,5000);
  end;
  n2:=val(s2);
  if n2>200 then maxfst1:=n2
  else begin
   fst1[maxfst1]:=encint(val(s2),4)|fst1[maxfst1];
   n1:=position(s1,'|',1);
   if n1<>0 then begin
    s1:=substr(s1,n1+1,5000);
    n1:=position(s1,'|',1);
    if n1<>0 then fst1[maxfst1]:=fst1[maxfst1]|' '|substr(s1,1,n1-1);
   end;
  end;
 end;
 if maxfst1<201 then SortFst
 else TextoMsg(0,'ERROR: Coma-Tag '|encint(maxfst1,1)|' > 200');
 assign('inp','');
end;
end;
{--------------------------------------------}

{============================================}
BEGIN
FstImpNm;
if (fstname1<>'') and (maxfst1<201) then begin
 assign('inp',impname1);
 chattr(-2,4,2,78);
 clearbox(4,1,1,80,-2);
 cursor(5,1);
 while not eof(inp) do begin
  readln(inp,s0);
  if size(s0)>0 then begin
   for fldn0:=1 to 200 do line1[fldn0]:='';
   fldn1:=0;
   repeat
    fldn1:=fldn1+1;
    if substr(s0,1,1)='"' then s1:='"' else s1:='';
    n1:=size(s1)+1;
    pos1:=position(s0,s1|',',1);
    if pos1=0 then begin
     if n1=1 then line1[fldn1]:=s0 else line1[fldn1]:=substr(s0,2,size(s0)-2);
    end else begin
     if pos1>1 then line1[fldn1]:=substr(s0,n1,pos1-n1);
     s0:=substr(s0,pos1+n1,5000);
    end;
   until pos1=0;
   n1:=newrec;
   for fldn0:=1 to fldn1 do begin
    s0:=line1[fldn0];
    if size(s0)<255 then s0:=trim(s0);
    if s0<>'' then begin
     sep1:='';
     tag1:=FindTag(encint(fldn0,4),fldn1);
     if size(tag1)>0 then begin
      tag1:=trim(tag1);
      n1:=position(tag1,' ',1);
      if n1>0 then begin
       sep1:=trim(substr(tag1,n1+1,5000));
       tag1:=trim(substr(tag1,1,n1-1));
      end;
      if sep1='' then n1:=fldadd(val(tag1),nfields+1,s0)
      else repeat
       pos1:=position(s0,sep1,1);
       if pos1=0 then s2:=s0
       else begin
        s2:=trim(substr(s0,1,pos1-1));
        s0:=trim(substr(s0,pos1+size(sep1),5000));
       end;
       n1:=fldadd(val(tag1),nfields+1,s2);
      until pos1=0;
     end;
    end;
   end;
   update;
   writeln('MFN ',maxmfn-1:1,' ',msgtext(434));
  end;   {if s0<>'' }
 end;
 assign('inp','');
 write(chr(7));  write(chr(7));  writeln(chr(7));
 write(msgtext(120)|' ',maxmfn:1,' ---> ');
 s0:=inkey;
end;
x1:=' ';
END.