Hist. Пенсионный фонд РФ перенумерация данных

Источник: pastebin.com
/* Classic Rexx  */
 
/* Перенумератор пачек с ИС, версия следующая (наверное вторая) ;)         */
/* По совету друзей, уменьшен размер и упрощён алгоритм. По просьбе        */
/* пользователей добавлена фича записи реального количества ИС в заголовок */
 
call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
call SysLoadFuncs
 
InDir= '.\IN\*.*'
OutDir='.\OUT\*.*'
 
call SysFileTree InDir, 'File' , 'BO'
 DO j=1 TO File.0
  Say 'Обрабатывается файл: 'File.j
  Fi=Right(file.j,12)
   DO
    ISI='.\in\'||Fi
    ISO=Fi||'.tmp'
    ISO2='.\out\'||Fi
 
    fc=Stream(ISI,'C',Open Read)
    fc=Stream(ISO,'C',Open Write)
 
   /* ----- Заголовок оставляем как есть ----- */
 
     DO 4
      Str=LineIn(ISI)
      fc=LineOut(ISO,Str)
     END
 
   /* ----- Основной цикл - перенумерация ----- */
 
    i=1
     DO while Lines(ISI)
      Str=LineIn(ISI)
      len=Length(i)
      tar=Substr(Str,8,len)
       IF compare(tar,i) > 0 THEN
        DO
         Str=DelStr(Str,8,len)
         fc=Insert(i,Str,7)
         fc=LineOut(ISO,fc)
        END
       ELSE fc=LineOut(ISO,Str)
       i=i+1
     END
 
    fc=Stream(ISI,'C',Close)
    fc=Stream(ISO,'C',Close)
 
   /* ----- Вывов в правильный файл ----- */
 
    fc=Stream(ISO,'C',Open Read)
    fc=Stream(ISO2,'C' Open Write)
 
   /* ----- Заголовок оставляем как есть (почти) ----- */
 
     DO 3
      Str=LineIn(ISO)
      fc=LineOut(ISO2,Str)
     END
 
   /* ----- Корректное количество ИС в пачке (та самая фича)  ----- */
 
      i=i-1
      Str=LineIn(ISO)
      Str=DelStr(Str,15)
      Str=Str||i
      fc=LineOut(ISO2,Str)
 
   /* ----- Обрезание хвостов ----- */
 
    i=1
     DO while Lines(ISO)
      Str=LineIn(ISO)
      pos=Length(i)+8
      tar=Substr(Str,pos,1)
       IF compare(tar,',') > 0 THEN
        DO
         Str=DelStr(Str,pos,1)
         fc=LineOut(ISO2,Str)
        END
       ELSE fc=LineOut(ISO2,Str)
       i=i+1
     END
 
    fc=Stream(ISO2,'C',Close)
    fc=Stream(ISO,'C',Close)
 
    '@Del ' ISO '> Nul'
   END
 END j