БЛАНКСШАБЛОНОМ "Общие процедуры и функции НФА";
-- Редакция ЗАО "Агентство 'Русспромоценка'"
2-- Константы
var Sep       :String="~";
2-- Переменные
var ИмяБланка :String;
var TempDAT[] :Date;    -- для переноса нескольких дат между бланками
var TempLOG[] :Logical; -- для переноса нескольких переменных логического типа между бланками
var TempINT[] :Integer; -- для переноса нескольких целых чисел между бланками
var TempNUM[] :Numeric; -- для переноса нескольких чисел между бланками
var TempSTR[] :String;  -- для переноса нескольких строк между бланками
var TempREC[] :Record;  -- для переноса нескольких ссылок между бланками

2-- Общие процедуры и функции
Func Mod(X:Integer; Y:Integer) :Integer; -- возвращает остаток от деления (X - делимое; Y - делитель)
 ^Int(X-Y*Int(Trunc(X/Y)));
end;

Func LenM(X:Numeric) :Integer; -- вычисляем количество цифр после запятой
var i :Integer;
 while (X-Trunc(X, i))<>0 do i=i+1; od;
 ^i;
end;

Func Степень(X:Numeric; Степ:Numeric) :Numeric; -- возводит число Х в степень Степ
 ^Exp(Степ*Log(X));
end;

Func RoundUp(Чис:Numeric; Точ:Integer) :Numeric; -- округлить "вверх" число Чис с точностью Точ
var A :Numeric;
 A=Trunc(Чис, Точ);
 if (Чис-A)>0 : A=A+Степень(10,-Точ); fi;
 ^A;
end;

Func RoundMonthUp(ДатаРасчета:Date) :Date; -- округлить месяц "вверх"
var MMMM, YYYY :Integer;
var dd :Date;
 MMMM=Mon(ДатаРасчета); YYYY=Year(ДатаРасчета);
 dd=if(MMMM<12, Dat(1, MMMM+1, YYYY), Dat(1, 1, YYYY+1));
 ^dd;
end;

Func UnqNum(Card:String; Field:String) :Integer;
-- По упорядоченному числовому порядковому полю ищет незанятый (уникальный) номер
-- При исчерпании списка уникальный номер - max + 1
var RO, Num, Ind, S, CurrentVal :Integer;
 RO=OpenWorkArea(Card, Field ,Field+">0");
 Try
   Num=Records(RO);
   for Ind=1..Num do
    CurrentVal = GetFieldI(RO, Ind, Field);
    if CurrentVal-S=1: S=S+1 ; -- След больше на 1
     | CurrentVal-S<1: S=S   ; -- Пара одинаковых (для целых=0)
     | CurrentVal-S>=2: Break; -- нашли разрыв
    fi;
   od;
 Finally
   CloseWorkArea(RO);
 end;
 Ind=S+1;
 ^Ind;
end;

Func UnqNumF(Card:String; Field:String; Curr:Record) :Integer; -- ошибается при наличии нецелочисленных и повторяющихся значениях
-- По упорядоченному числовому порядковому полю ищет незанятый (уникальный) номер
-- При исчерпании списка уникальный номер - max + 1
var RO, Num, Ind, S :Integer;
 RO=OpenWorkArea(Card, Field, Field+">0 and Ukey<>"+RecordToString(Curr));
 Try
   Num=Records(RO);
   if Num>0:
     for Ind=1..Num do
       S=GetFieldI(RO, Ind, Field);
       if Ind<>S: Break; fi;
     od;
   else
     Ind=1;
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^Ind; -- od; делает +1 к счетчику (Ind)
end;

Func Объединить(Value1:String; Value2:String; Separator:String) :String;
var Ret :String;
 if Value1<>"" and Value2<>"": Ret=Value1+Separator+Value2;
 |  Value1= "" and Value2<>"": Ret=Value2;
 |  Value1<>"" and Value2="" : Ret=Value1;
 |  True: Ret="";
 fi;
 ^Ret;
end;

Func ИмяФайлаБланка :String; -- возвращает корректное имя активного бланка в отличии от функции GetActiveBlankName
var path, tmp :String;
var len :Integer;
 path=Up(BlankFileName(""));
 len=Length(path);
 tmp=Substr(path, len-3, len);
 if tmp=".BLN": path=SubStr(path, 1, len-4); fi;
 ^ExtractWord(WordsCount(path, "\"), path, "\");
end;

Func Цвет(r:Integer; g:Integer; b:Integer) :Integer; -- цвет по стандарту ТБ 6.9
 ^(256*256*b+256*g+r);
end;

Func ЗаписейФильтра(Card:String; Field:String; Filtr:String) :Integer; 
-- количество записей в рабочей области с фильтром
var RO, num :Integer;
 num=0;
 RO=OpenWorkArea(Card, Field, Filtr);
 Try num=Records(RO); Finally CloseWorkArea(RO); end;
 ^num;
end;

Func ПризнакИспользуется(Voc:String; Card:String; REC:Record) :Logical;
-- Voc: маска справочника
-- Card: картотека аналитического признака
-- REC: ссылка на запись аналитического признака
var nn, i :Integer;
var tmp :String;
 RefreshAna;
 nn=RecSignsCount(Card, REC);
 if nn>0:
   for i=1..nn do
     tmp=RecSign(Card, REC, i);
     if Match(tmp, Voc): if SignUsed(tmp): ^True; fi; fi;
   od;
 fi;
 ^False;
end;

Proc СумируемОдинаковые;
var i, k, len :Integer;
var sum :Numeric;
var compare :String; -- то, с чем сравниваем
var OK :Logical;
 len=LengthOfArray(РАБ.НФА.FUNC_LIB.TempNUM);
 if len>0:
   compare=""; OK=False; sum=0; k=0;
   ShowProgress(len, "Подождите, идет суммирование данных...");
   Try
     for i=1..len do
       ProgressPos(i);
       if compare<>РАБ.НФА.FUNC_LIB.TempSTR[i]: OK=False; fi; -- одинаковых нет
       if OK=False: -- если не одинаковый, то запоминаем...
         compare=РАБ.НФА.FUNC_LIB.TempSTR[i];
             sum=РАБ.НФА.FUNC_LIB.TempNUM[i];
         k=k+1;
         РАБ.НФА.FUNC_LIB.TempSTR[k]=compare;
         РАБ.НФА.FUNC_LIB.TempNUM[k]=sum;
         OK=True; --... следующий элемент (до проверки) считаем одинаковым
       else
         РАБ.НФА.FUNC_LIB.TempNUM[k]=РАБ.НФА.FUNC_LIB.TempNUM[k]+РАБ.НФА.FUNC_LIB.TempNUM[i]; -- если одинаковый - суммируем
       fi;
     od;
   Finally
     CloseProgress;
   end;
   k=k+1; len=i-1;
   if k<=len:  -- удаляем лишнее
     ShowProgress(len-k, "Подождите, идет упорядочивание данных...");
     Try
       i=len;
       while i>=k do 
         ProgressPos(len-i+1);
         DeleteFromArray(РАБ.НФА.FUNC_LIB.TempSTR, i); 
         DeleteFromArray(РАБ.НФА.FUNC_LIB.TempNUM, i); 
         i=i-1;
       od;
     Finally
       CloseProgress;
     end;
   fi;
 fi;
end;

Proc СумируемОдинаковыеБезГрадусника;
var i, k, len :Integer;
var sum :Numeric;
var compare :String; -- то, с чем сравниваем
var OK :Logical;
 len=LengthOfArray(РАБ.НФА.FUNC_LIB.TempNUM);
 if len>0:
   compare=""; OK=False; sum=0; k=0;
   for i=1..len do
     if compare<>РАБ.НФА.FUNC_LIB.TempSTR[i]: OK=False; fi; -- одинаковых нет
     if OK=False: -- если не одинаковый, то запоминаем...
       compare=РАБ.НФА.FUNC_LIB.TempSTR[i];
           sum=РАБ.НФА.FUNC_LIB.TempNUM[i];
       k=k+1;
       РАБ.НФА.FUNC_LIB.TempSTR[k]=compare;
       РАБ.НФА.FUNC_LIB.TempNUM[k]=sum;
       OK=True; --... следующий элемент (до проверки) считаем одинаковым
     else
       РАБ.НФА.FUNC_LIB.TempNUM[k]=РАБ.НФА.FUNC_LIB.TempNUM[k]+РАБ.НФА.FUNC_LIB.TempNUM[i]; -- если одинаковый - суммируем
     fi;
   od;
   k=k+1; len=i-1;
   if k<=len:  -- удаляем лишнее
     i=len;
     while i>=k do
       DeleteFromArray(РАБ.НФА.FUNC_LIB.TempSTR, i);
       DeleteFromArray(РАБ.НФА.FUNC_LIB.TempNUM, i);
       i=i-1;
     od;
   fi;
 fi;
end;

Proc СумируемОдинаковыеREC;
var i, k, len :Integer;
var sum :Numeric;
var compare :Record; -- то, с чем сравниваем
var OK :Logical;
 len=LengthOfArray(РАБ.НФА.FUNC_LIB.TempREC);
 if len>0:
   compare=NIL; OK=False; sum=0; k=0;
   ShowProgress(len, "Подождите, идет суммирование данных...");
   Try
     for i=1..len do
       ProgressPos(i);
       if compare<>РАБ.НФА.FUNC_LIB.TempREC[i]: OK=False; fi; -- одинаковых нет
       if OK=False: -- если не одинаковый, то запоминаем...
         compare=РАБ.НФА.FUNC_LIB.TempREC[i];
             sum=РАБ.НФА.FUNC_LIB.TempNUM[i];
         k=k+1;
         РАБ.НФА.FUNC_LIB.TempREC[k]=compare;
         РАБ.НФА.FUNC_LIB.TempNUM[k]=sum;
         OK=True; --... следующий элемент (до проверки) считаем одинаковым
       else
         РАБ.НФА.FUNC_LIB.TempNUM[k]=РАБ.НФА.FUNC_LIB.TempNUM[k]+РАБ.НФА.FUNC_LIB.TempNUM[i]; -- если одинаковый - суммируем
       fi;
     od;
   Finally
     CloseProgress;
   end;
   k=k+1; len=i-1;
   if k<=len:  -- удаляем лишнее
     ShowProgress(len-k, "Подождите, идет упорядочивание данных...");
     Try
       i=len;
       while i>=k do 
         ProgressPos(len-i+1);
         DeleteFromArray(РАБ.НФА.FUNC_LIB.TempREC, i);
         DeleteFromArray(РАБ.НФА.FUNC_LIB.TempNUM, i);
         i=i-1;
       od;
     Finally
       CloseProgress;
     end;
   fi;
 fi;
end;

Func Left(Stroka:String; len:Integer) :String;
 if (Stroka="") or (len<0): ^(Stroka); fi; ^Substr(Stroka, 1, len);
end;

Func Right(Stroka:String; len:Integer) :String;
 if (Stroka="") or (len<0): ^(Stroka); fi; ^Substr(Stroka, Length(Stroka)-len+1, len);
end;

Func FormatChisloOrMoney(Chislo:Numeric; Separ:String; Money:Logical) :String;
var np, i :Integer;
var temp, man, Out :String;
 temp=Str(Chislo,2); np=Pos(".", temp);
 if np<>0: man=Substr(temp, np+1, 2); temp=Substr(temp, 1, np-1); else man=""; fi;
 i=Length(temp); Out=""; np=3;
 while i > np do
   Out=Separ + Substr(temp, i-(np-1), np) + Out;
   temp=Substr(temp, 1, i-np);
   i=i-np;
 od;
 if Money:
   if man<>"": Out=temp+Out+" руб."+" "+man+" коп."; else Out=temp+Out+" руб."; fi;
 else
   if man<>"": Out=temp+Out+"."+man; else Out = temp + Out; fi;
 fi;
 ^Out;
end;

Func FormatChislo(Chislo:Numeric; Separ:String; PosleZ:Integer) :String;
var k, n, i, kZn :Integer;
var temp, man, Out :String;
 k=0;
 while (Chislo-Trunc(Chislo, k))<>0 do k=k+1; od;
 if PosleZ>=k: temp=Str(Chislo, k); kZn=PosleZ-k; else temp=Str(Chislo, PosleZ); kZn=PosleZ; fi;
 n=Pos(".", temp);
 if n<>0:
   if PosleZ>=k: man=Substr(temp, n+1, k)+RepStr("0",kZn); else man=Substr(temp, n+1, k); fi;
   temp=Substr(temp, 1, n-1);
 else
   man=RepStr("0",PosleZ);
 fi;
 i=Length(temp); Out=""; n=3;
 while i>n do
   Out=Separ + Substr(temp, i-(n-1), n) + Out;
   temp=Substr(temp, 1, i-n);
   i=i-n;
 od;
 if man<>"": Out=temp+Out+"."+man; else Out=temp+Out; fi;
 ^Out;
end;

Func ДубликатЦел(REC:Record; iVal:Integer; Card:String; Field:String): Logical;
-- ДЛЯ ЦЕЛОГО ЗНАЧЕНИЯ iVal: оперделяется дубликат записи в таблице с именем Card по уникальному полю Field = значению iVal;
var RO  :Integer;
var Фильтр :String;
var Res :Logical;
 Фильтр=Field+"="+Str(iVal)+" and UKEY<>"+RecordToString(REC);
 RO=OpenWorkArea(Card, Field, Фильтр);
 Res=Records(RO)>0;
 CloseWorkArea(RO);
 ^Res;
end;

Func ДубликатВещ(REC:Record; nVal:Numeric; Card:String; Field:String): Logical;
-- ДЛЯ ВЕЩЕСТВЕННОГО ЗНАЧЕНИЯ nVal: оперделяется дубликат записи в таблице с именем Card по уникальному полю Field = значению nVal;
var RO  :Integer;
var Фильтр :String;
var Res :Logical;
 Фильтр=Field+"="+Str(nVal, LenM(nVal))+" and UKEY<>"+RecordToString(REC);
 RO=OpenWorkArea(Card, Field, Фильтр);
 Res=Records(RO)>0;
 CloseWorkArea(RO);
 ^Res;
end;

Func ДубликатСтр(REC:Record; sVal:String; Card:String; Field:String): Logical;
-- ДЛЯ СТРОКОВОГО ЗНАЧЕНИЯ sVal: оперделяется дубликат записи в таблице с именем Card по уникальному полю Field = значению sVal;
var RO  :Integer;
var Фильтр :String;
var Res :Logical;
 Фильтр=Field+"='"+sVal+"'"+" and UKEY<>"+RecordToString(REC);
 RO=OpenWorkArea(Card, Field, Фильтр);
 Res=Records(RO)>0;
 CloseWorkArea(RO);
 ^Res;
end;

Func ДубликатЗап(REC:Record; rVal:Record; Card:String; Field:String): Logical;
-- ДЛЯ ЗНАЧЕНИЯ ТИПА ЗАПИСЬ rVal: оперделяется дубликат записи в таблице с именем Card по уникальному полю Field = значению rVal;
var RO  :Integer;
var Фильтр :String;
var Res :Logical;
 Фильтр=Field+"="+RecordToString(rVal)+" and UKEY<>"+RecordToString(REC);
 RO=OpenWorkArea(Card, Field, Фильтр);
 Res=Records(RO)>0;
 CloseWorkArea(RO);
 ^Res;
end;

Func ДнейМесяца(Days:Date) :Integer;
var ВИС :Logical;
var Month, Ost :Integer;
 ВИС=False;
 Month=Mon(Days);
 if Month=1 : ^31;
 |  Month=2 : Ost=Mod(Year(Days), 4);
              if Ost=0: ВИС=True; fi;
              if ВИС=True: ^29; else ^28; fi;
 |  Month=3 : ^31;
 |  Month=4 : ^30;
 |  Month=5 : ^31;
 |  Month=6 : ^30;
 |  Month=7 : ^31;
 |  Month=8 : ^31;
 |  Month=9 : ^30;
 |  Month=10: ^31;
 |  Month=11: ^30;
 |  Month=12: ^31;
 fi;
end;

Func JulianDays(ГД:Date) :Integer;
-- Вычисляем дни по Юлианскому календарю (без учета полудня [JD=JD+0.5 или вместо 1720994 - 1720994,5])
-- ГД - дата по григорианскому календарю
var КГ, КМ, КД :Integer; -- календарный григорианский год, месяц, день
var JD, ММ, ГГ, IA, IB, IS, GDAT :Integer;
 КГ=Year(ГД); КМ=Mon(ГД); КД=Day(ГД);
 if КМ>2 : ГГ=КГ; ММ=КМ+1; else ГГ=КГ-1; ММ=КМ+13; fi;
 if ГГ=0 : IS=1; else IS=Int(Trunc(ГГ/Abs(ГГ))); ГГ=Abs(ГГ); fi;
 GDAT=ГГ*10000+ММ*100+КД;
 if IS>0 :
   IB=0;
   if GDAT>=15821115 :
     IA=Int(Trunc(ГГ/100))*IS;
     IB=2-IA+Int(Trunc(Abs(IA)/4))*IS;
   fi;
   JD=1720994+КД+Int(Trunc(365.25*ГГ))+Int(Trunc(30.6001*ММ))+IB;
 else
   JD=1720994+КД-Int(Trunc(365.25*ГГ+0.75))+Int(Trunc(30.6001*ММ));
 fi;
 ^JD;
end;

Func НаписаниеИнтервала(Тип:String; strTrans:String) :String;
var val, nn, len :Integer;
 len=Length(strTrans);
 if len<2: val=0; else val=Int(SubStr(strTrans, len-1, 1)); fi;
 nn=Int(SubStr(strTrans, len, 1));
 if Тип="гг": if nn=1 and val<>1: ^"год";   | (nn=2 or nn=3 or nn=4) and val<>1: ^"года";   else ^"лет";     fi;
 |  Тип="мм": if nn=1 and val<>1: ^"месяц"; | (nn=2 or nn=3 or nn=4) and val<>1: ^"месяца"; else ^"месяцев"; fi;
 |  Тип="дд": if nn=1 and val<>1: ^"день";  | (nn=2 or nn=3 or nn=4) and val<>1: ^"дня";    else ^"дней";    fi;
 fi;
 ^"";
end;

Func ИнтервалМеждуДатами(Day1:Date; Day2:Date; ТипИнт:Integer; noAuto:Logical; Прописью:Logical) :String;
--ТипИнт: == 1 - 'День'; 2 - 'Месяц'; 3 - 'Год'; 4 - 'Год + Месяц'; 5 - 'Год + Месяц + День'
var strRes, tmp, out, msg :String;
var JDн, JDк, JDв :Integer;
var Г1, Г2, М1, М2, Д1, Д2, откл :Integer;
var РГ, РМ, РД :Integer;
var DayВ :Date;
var a ,b ,c :Integer;
 strRes="";
 if Day1<=1.1.100 : msg='Не задана дата начала периода!';    if noAuto: Message(msg, mtWarning); fi; ^msg; fi;
 if Day2<=1.1.100 : msg='Не задана дата окончания периода!'; if noAuto: Message(msg, mtWarning); fi; ^msg; fi;
 if Day1>Day2     : msg='Дата начала "'+DateToString(Day1)+'" периода позже даты окончания периода "'+DateToString(Day2)+'".'+Chr(13)+'Необходимо скорректировать даты!';
                    if noAuto: Message(msg, mtWarning); fi; ^msg; fi;
 JDн=JulianDays(Day1); JDк=JulianDays(Day2);
 if ТипИнт=1                                     :
   strRes=Str(JDк-JDн);
 |  ТипИнт=2 or ТипИнт=3 or ТипИнт=4 or ТипИнт=5 :
   Г1=Year(Day1); М1=Mon(Day1); Д1=Day(Day1); a=ДнейМесяца(Day1);
   Г2=Year(Day2); М2=Mon(Day2); Д2=Day(Day2); b=ДнейМесяца(Day2);
   if Д1>b: c=b; else c=Д1; fi;
   DayВ=Dat(c, Mon(Day2), Year(Day2));
   JDв=JulianDays(DayВ);
   c=JDк-JDв;
   if c>=0:
     откл=0;
     РД=c;
   else
     откл=1;
     c=ДнейМесяца(AddMon(Day2,-1));
     РД=c-Д1+Д2;
   fi;
   if (М2-М1-откл)<0 :
     РГ=Г2-Г1-1; РМ=12-(Abs(М2-М1)+откл);
   else
     РГ=Г2-Г1; РМ=М2-М1-откл;
   fi;
   if ТипИнт=2 : strRes=Str(12*РГ+РМ); fi;
   if ТипИнт=3 : strRes=Str(РГ); fi;
   if ТипИнт=4 : strRes=Str(РГ)+", "+Str(РМ); fi;
   if ТипИнт=5 : strRes=Str(РГ)+", "+Str(РМ)+", "+Str(РД); fi;
 fi;
 if Прописью:
   out="";
   if ТипИнт=1: out=StrRes+" "+НаписаниеИнтервала("дд", strRes);
   |  ТипИнт=2: out=StrRes+" "+НаписаниеИнтервала("мм", strRes);
   |  ТипИнт=3: out=StrRes+" "+НаписаниеИнтервала("гг", strRes);
   |  ТипИнт=4: tmp=ExtractWord(1, strRes, ", ");
                out=tmp+" "+НаписаниеИнтервала("гг", tmp);
                tmp=ExtractWord(2, strRes, ", ");
                out=out+", "+tmp+" "+НаписаниеИнтервала("мм", tmp);
   |  ТипИнт=5:
                tmp=ExtractWord(1, strRes, ", ");
                out=tmp+" "+НаписаниеИнтервала("гг", tmp);
                tmp=ExtractWord(2, strRes, ", ");
                out=out+", "+tmp+" "+НаписаниеИнтервала("мм", tmp);
                tmp=ExtractWord(3, strRes, ", ");
                out=out+", "+tmp+" "+НаписаниеИнтервала("дд", tmp);
   fi;
   strRes=out;
 fi;
 ^strRes;
end;

Func ВзятьКонечнуюДатуИнтервала(Интервал:String; НДАТ:Date) :Date;
var КДАТ :Date;
var num, i, p, yy, mm, dd, y1, m1, d1  :Integer;
var tmp :String;
 КДАТ=1.1.100;
 if НДАТ=1.1.100 or Интервал="": ^КДАТ; fi;
 yy=0; mm=0; dd=0;
 num=WordsCount(Интервал, ",");
 for i=1 to num do 
   tmp=Up(ExtractWord(i, Интервал, ","));
   p=0;
   if Pos("ДЕНЬ",    tmp)>0: p=Pos("ДЕНЬ",    tmp); dd=Int(SubStr(tmp, 1, p-2));
   |  Pos("ДНЯ",     tmp)>0: p=Pos("ДНЯ",     tmp); dd=Int(SubStr(tmp, 1, p-2));
   |  Pos("ДНЕЙ",    tmp)>0: p=Pos("ДНЕЙ",    tmp); dd=Int(SubStr(tmp, 1, p-2));
   |  Pos("МЕСЯЦ",   tmp)>0: p=Pos("МЕСЯЦ",   tmp); mm=Int(SubStr(tmp, 1, p-2));
   |  Pos("МЕСЯЦА",  tmp)>0: p=Pos("МЕСЯЦА",  tmp); mm=Int(SubStr(tmp, 1, p-2));
   |  Pos("МЕСЯЦЕВ", tmp)>0: p=Pos("МЕСЯЦЕВ", tmp); mm=Int(SubStr(tmp, 1, p-2));
   |  Pos("ГОД",     tmp)>0: p=Pos("ГОД",     tmp); yy=Int(SubStr(tmp, 1, p-2));
   |  Pos("ГОДА",    tmp)>0: p=Pos("ГОДА",    tmp); yy=Int(SubStr(tmp, 1, p-2));
   |  Pos("ЛЕТ",     tmp)>0: p=Pos("ЛЕТ",     tmp); yy=Int(SubStr(tmp, 1, p-2));
   fi;
 od;
 y1=Year(НДАТ); m1=Mon(НДАТ); d1=Day(НДАТ);
 КДАТ=AddMon(Dat(d1, m1, y1+yy), mm)+dd;
 ^КДАТ;
end;

Func ПроверитьСимвол (St :String) :Logical;
 if St>="0" and St<="9": ^True;
   |St>="A" and St<="Z": ^True;
   |St>="a" and St<="z": ^True;
   |St>="А" and St<="Я": ^True;
   |St>="а" and St<="я": ^True;
   |St ="."  or St="_" : ^True;
 fi;
 ^False;
end;

Proc ПроверитьПризнак(Ana:String);
var i, len :Integer;
var Char, msg :String;
var Flag :Logical;
 len=Length(Ana);
 if len=0: 
   Message("Для аналитического признака задана пустая строка или пробел!", mtError); 
   Exit; 
 fi;
 ClearVariable(РАБ.НФА.FUNC_LIB.TempSTR);
 Flag=False;
 for i=1 to len do
   Char=SubStr(Ana, i, 1);
   if Char="." and Flag: Message("Ошибка!^MДве или более точек подряд в написании аналитического признака!", mtError); Exit; fi;
   if Char=".": Flag=True; else Flag=False; fi;
   if ПроверитьСимвол(Char)=False: -- запрещенный символ
     if Char=" ": Char="пробел";
     |  Char=",": Char="запятая";
     |  Char='"': Char="двойная ковычка";
     |  Char="'": Char="одинарная ковычка";
     fi;
     if SearchInArray(РАБ.НФА.FUNC_LIB.TempSTR, Char, True)<0: InsertInArraySort(РАБ.НФА.FUNC_LIB.TempSTR, Char); fi;
   fi;
 od;
 i=Pos(".", Ana);
 if i=1 or i=len: 
   Message("Аналитический признак не может начинаться или заканчиваться точкой!", mtError); 
   Exit; 
 fi;
 len=LengthOfArray(РАБ.НФА.FUNC_LIB.TempSTR);
 if len>0:
   msg="При формировании аналитического признака"+Chr(13)+"недопустимо использовать следующие символы:"+Chr(13)+Chr(13);
   for i=1 to len do msg=msg+"'"+РАБ.НФА.FUNC_LIB.TempSTR[i]+"'"+Chr(13); od;
   Message(msg, mtError);
 fi;
 ClearVariable(РАБ.НФА.FUNC_LIB.TempSTR);
end;

Func FormatInvAna(NFA:String; INV:String; Type:Integer; Zero:String; Raz:String) :String;
-- NFA - код аналитического признака;
-- INV - код аналитического признака;
-- Type - тип форматирования - 0:Учетный + Инвентарный; 1:Учетный; 2:Инвентарный; 3:Инвентарный + Учетный
-- Zero - строка для вывода если пусто
var txt, tmp :String;
var nn :Integer;
 if INV="" or INV=" ": ^""; fi;
 tmp=GetAnaGlossary(INV);
 if tmp="": ^""; fi;
 nn=Length(tmp)+2; -- 1-точка + 1-начало нужной подстроки (инвентарный номер)
 tmp=Name_A("ИНВВЕД."+NFA+"."+INV); -- ведомственный инв. номер
 txt=if(Raz<>Chr(13), " ", "");
 if Type=0: ^(if(Raz<>Chr(13), "[", "")+SubStr(INV, nn, 255)+if(Raz<>Chr(13), "]", "")+txt+Raz+txt+if(tmp=" ": "инв. карточка не создана" | tmp="": Zero, tmp));
 |  Type=1: ^SubStr(INV, nn, 255);
 |  Type=2: ^(if(tmp=" ": "инв. карточка не создана" | tmp="": Zero, tmp));
 |  Type=3: ^(if(tmp=" ": "инв. карточка не создана" | tmp="": Zero, tmp)+txt+Raz+txt+if(Raz<>Chr(13), "[", "")+SubStr(INV, nn, 255)+if(Raz<>Chr(13), "]", ""));
 else ^"";
 fi;
end;

Func ВыборВидаТаблицыИНВ(State:Integer) :Integer;
var nn :Integer;
 ClearVariable(РАБ.УПП.LIB.TempSTR);
 TempSTR[1]="Учетный + Инвентарный";
 TempSTR[2]="Учетный";
 TempSTR[3]="Инвентарный";
 TempSTR[4]="Инвентарный + Учетный";
 nn=Alternate("Выберите способ отображения инвентарного номера", TempSTR, -1, State+1, 12);
 ClearVariable(РАБ.УПП.LIB.TempSTR);
 if nn=0: ^State; fi;
 ^(nn-1);
end;

Func FormatAna(Ana:String; Type:Integer; Zero:String; Raz:String) :String;
-- Ana - код аналитического признака;
-- Type - тип форматирования - 0:код + наименование; 1:только код; 2:только наименование; 3: наименование + код
-- Zero - строка для вывода если пусто
var tmp :String;
var nn :Integer;
 if Ana="": ^""; fi;
 tmp=GetAnaGlossary(Ana);
 if tmp="": ^""; fi;
 nn=Length(tmp)+2; -- 1-точка + 1-начало нужной подстроки
 tmp=Name_A(Ana);
 if Type=0: ^("["+SubStr(Ana, nn, 255)+"] "+Raz+" "+if(tmp<>"" and tmp<>" ", tmp, Zero));
 |  Type=1: ^SubStr(Ana, nn, 255);
 |  Type=2: ^(if(tmp<>"" and tmp<>" ", tmp, Zero));
 |  Type=3: ^(if(tmp<>"" and tmp<>" ", tmp, Zero)+" "+Raz+" ["+SubStr(Ana, nn, 255)+"]");
 else ^"";
 fi;
end;

Func FormatAcc(ФКР:String; ИФД:Integer; Acc:String; Type:Integer; Zero:String; Raz:String; mode:String) :String;
-- Acc - счет + субсчет СЧ5;
-- Type - тип форматирования - 0:код + наименование; 1:только код; 2:только наименование; 3: наименование + код
-- Zero - строка для вывода если пусто
-- mode - "СЧ5" - счет вида ???.??; "СЧ8" - счет вида ???.??.???
var tmp, сч :String;
 if ФКР="" or ИФД<1 or Acc="": ^""; fi;
 if mode="СЧ5": сч=ФКР+"."+Str(ИФД)+"."+Acc+".";
 |  mode="СЧ8": сч=ФКР+"."+Str(ИФД)+"."+Acc;
 fi;
 tmp=Name_S(сч);
 if Type=0: ^("["+Acc+"] "+Raz+" "+if(tmp<>"" and tmp<>" ", tmp, Zero));
 |  Type=1: ^Acc;
 |  Type=2: ^(if(tmp<>"" and tmp<>" ", tmp, Zero));
 |  Type=3: ^(if(tmp<>"" and tmp<>" ", tmp, Zero)+" "+Raz+" ["+Acc+"]");
 else ^"";
 fi;
end;

Func FormatAccFull(Acc:String; Type:Integer; Zero:String; Raz:String) :String;
-- Acc - счет СЧ26;
-- Type - тип форматирования - 0:код + наименование; 1:только код; 2:только наименование; 3: наименование + код
-- Zero - строка для вывода если пусто
var tmp :String;
 tmp=Name_S(Acc);
 if Type=0: ^("["+Acc+"] "+Raz+" "+if(tmp<>"" and tmp<>" ", tmp, Zero));
 |  Type=1: ^Acc;
 |  Type=2: ^(if(tmp<>"" and tmp<>" ", tmp, Zero));
 |  Type=3: ^(if(tmp<>"" and tmp<>" ", tmp, Zero)+" "+Raz+" ["+Acc+"]");
 else ^"";
 fi;
end;

Func ВзятьПериодПоДате(dd:Date; mode:String) :String;
--mode: гг - год, кв - квартал, мм - месяц
--mode пусто => с максимальной точностью!
var k :Integer;
var tmp :String;
 tmp="";
 tmp="ПЕРИОД."+Str(Year(dd));
 if mode='гг': ^tmp; fi;
 k=Mon(dd);
 if k<4  : tmp=tmp+'.1';
 |  k<7  : tmp=tmp+'.2';
 |  k<10 : tmp=tmp+'.3';
 |  k<13 : tmp=tmp+'.4';
 fi;
 if mode='кв': ^tmp; fi;
 if k<10: tmp=tmp+'.0'+Str(k);
 | True : tmp=tmp+'.' +Str(k);
 fi;
 if mode='мм': ^tmp; fi;
 ^tmp;
end;

Func DeleteWord(sStr:String; numStr:Integer; Raz:String) :String;
var out, tmp :String;
var k, len :Integer;
 out="";
 k=WordsCount(sStr, Raz);
 if k<numStr: ^sStr; fi;
 tmp=ExtractWord(numStr, sStr, Raz);
 len=Length(tmp);
 k=Pos(Up(tmp), Up(sStr));
 if numStr<>1: k=k-1; len=len+1; fi;
 out=Delete(sStr, k, len);
 ^out;
end;

Func ВыбратьВалюту(OldV:String) :String;
var Curr :String;
var i, nn :Integer;
 i=0; nn=0; ClearVariable(РАБ.НФА.FUNC_LIB.TempSTR);
 for Currencies Curr="*" do  i=i+1; РАБ.НФА.FUNC_LIB.TempSTR[i]=Up(Curr); od;
 nn=Alternate("Валюта документа:", РАБ.НФА.FUNC_LIB.TempSTR, -1, 1, 12);
 if nn=0: ^OldV; fi;
 ^РАБ.НФА.FUNC_LIB.TempSTR[nn];
end;

Func СуммаВалютыПрописью(Сумма:Numeric; Валюта:String) :String; -- Возвращает сумму прописью в зависимости от валюты
var result :String;
 if Сумма=0: ^""; fi;
 if Валюта=''   : result=СЛО(Сумма);
 |  Валюта='РУБ': result=СЛО(Сумма);
 |  Валюта='USD': result=СЛО_(Сумма,'ДОЛ');
 |  Валюта='DEM': result=СЛО_(Сумма,'ДЕМ');
 |  Валюта='EUR': result=СЛО_(Сумма,'ЕВР');
 else result=СЛО_(Сумма, Валюта);
 fi;
 ^result;
end; 

Func ОтносительныйПутьSTDВАбсолютный(ПутьОтносит:String; БланкSTD:String) :String;
var ПутьSTD, ПутьБланка, STD, ПутьАбс :String;
var nn, kk, len :Integer;
 ПутьАбс="";
 if БланкSTD="": БланкSTD="ВЕРСИЯ"; fi;
 if not(BlankExist(БланкSTD)) or ПутьОтносит="": ^""; fi;
 ПутьОтносит=Up(ПутьОтносит);
 ПутьБланка=Up(BlankFileName(БланкSTD));
 ПутьSTD=PlanVar("STD_RPO");
 if ПутьSTD=".." or ПутьSTD=".": ^""; fi;
 STD=Up(ExtractWord(WordsCount(ПутьSTD, "\"), ПутьSTD, "\"));
 nn=Pos(STD, ПутьБланка);
 if nn<1: ^""; fi;
 kk=Pos(STD, ПутьОтносит);
 if kk<1: ^""; fi;
 len=Length(STD);
 ПутьАбс=SubStr(ПутьБланка, 1, nn+len-1)+SubStr(ПутьОтносит, kk+len, Length(ПутьОтносит)-(kk+len)+1);
 ^ПутьАбс;
end;

Func СоздатьФайлОтчетСтрокиПоПризнакам(ИмяФайла:String; Folder:String; ИмяОтчета:String; УслСЧ:String; УслАН:String; БалансСЧ:Logical; ЗаБалансСЧ:Logical; СтрокиПоПризнакам:String) :Logical;
var FlagCreate :Logical;
var F, len, i :Integer;
var qq :Numeric;
 if ExistsFolder(Folder)=False: Message("Папки"+Chr(13)+Folder+Chr(13)+"не существует!", mtError); ^False; fi;
 Try qq=Saldo(УслСЧ+"{"+УслАН+"}",1.1.100); Except Raise; ^False; end;
 Try qq=Saldo("{"+СтрокиПоПризнакам+".*}",1.1.100); Except Raise; ^False; end;
 ИмяФайла=ИмяФайла+".lst";
 Try
   FlagCreate=False;
   F=TextFileCreate(Folder+"\"+ИмяФайла);
   FlagCreate=True;
   ClearVariable(РАБ.НФА.FUNC_LIB.TempSTR);
   РАБ.НФА.FUNC_LIB.TempSTR[1] ="[ReportList]";
   РАБ.НФА.FUNC_LIB.TempSTR[2] =Up(ИмяОтчета)+"=";
   РАБ.НФА.FUNC_LIB.TempSTR[3] ="";
   РАБ.НФА.FUNC_LIB.TempSTR[4] ="["+Up(ИмяОтчета)+"]";
   РАБ.НФА.FUNC_LIB.TempSTR[5] ="startD=01.01.1990";
   РАБ.НФА.FUNC_LIB.TempSTR[6] ="endD=01.01.2090";
   РАБ.НФА.FUNC_LIB.TempSTR[7] ="accStr="+УслСЧ;
   РАБ.НФА.FUNC_LIB.TempSTR[8] ="anaStr="+УслАН;
   РАБ.НФА.FUNC_LIB.TempSTR[9] ="outForm=0";
   РАБ.НФА.FUNC_LIB.TempSTR[10]="TabSplRang=0";
   РАБ.НФА.FUNC_LIB.TempSTR[11]="TabDateSplit=2";
   РАБ.НФА.FUNC_LIB.TempSTR[12]="TabDateStep=1";
   РАБ.НФА.FUNC_LIB.TempSTR[13]="ColSplRang=0";
   РАБ.НФА.FUNC_LIB.TempSTR[14]="ColDateSplit=0";
   РАБ.НФА.FUNC_LIB.TempSTR[15]="ColDateStep=1";
   РАБ.НФА.FUNC_LIB.TempSTR[16]="StrSplRang=4";
   РАБ.НФА.FUNC_LIB.TempSTR[17]="StrDateSplit=0";
   РАБ.НФА.FUNC_LIB.TempSTR[18]="StrDateStep=1";
   РАБ.НФА.FUNC_LIB.TempSTR[19]="Turn=2";
   РАБ.НФА.FUNC_LIB.TempSTR[20]="NotTurn=0";
   РАБ.НФА.FUNC_LIB.TempSTR[21]="CreTurn=0";
   РАБ.НФА.FUNC_LIB.TempSTR[22]="DebTurn=0";
   РАБ.НФА.FUNC_LIB.TempSTR[23]="Saldo=1";
   РАБ.НФА.FUNC_LIB.TempSTR[24]="InpSaldo=1";
   РАБ.НФА.FUNC_LIB.TempSTR[25]="IsCreFirst=0";
   РАБ.НФА.FUNC_LIB.TempSTR[26]="OutLevel=2";
   РАБ.НФА.FUNC_LIB.TempSTR[27]="Strip=0";
   РАБ.НФА.FUNC_LIB.TempSTR[28]="NulSalTurn=0";
   РАБ.НФА.FUNC_LIB.TempSTR[29]="OldPeriod=1";
   РАБ.НФА.FUNC_LIB.TempSTR[30]="Balans="+if(БалансСЧ, "1", "0");
   РАБ.НФА.FUNC_LIB.TempSTR[31]="ZaBalans="+if(ЗаБалансСЧ, "1", "0");
   РАБ.НФА.FUNC_LIB.TempSTR[32]="Comment=1";
   РАБ.НФА.FUNC_LIB.TempSTR[33]="FullComment=0";
   РАБ.НФА.FUNC_LIB.TempSTR[34]="Counter=0";
   РАБ.НФА.FUNC_LIB.TempSTR[35]="ColResult=1";
   РАБ.НФА.FUNC_LIB.TempSTR[36]="StrResult=1";
   РАБ.НФА.FUNC_LIB.TempSTR[37]="NatKolUni=0";
   РАБ.НФА.FUNC_LIB.TempSTR[38]="NatSumUni=1";
   РАБ.НФА.FUNC_LIB.TempSTR[39]="NatVirUni=0";
   РАБ.НФА.FUNC_LIB.TempSTR[40]="NatValUni=0";
   РАБ.НФА.FUNC_LIB.TempSTR[41]="FileRepName=0";
   РАБ.НФА.FUNC_LIB.TempSTR[42]="SizeUniArr=0";
   РАБ.НФА.FUNC_LIB.TempSTR[43]="StrNameOut=2";
   РАБ.НФА.FUNC_LIB.TempSTR[44]="ConjTables=0";
   РАБ.НФА.FUNC_LIB.TempSTR[45]="UseStu=0";
   РАБ.НФА.FUNC_LIB.TempSTR[46]="AnaShow=0";
   РАБ.НФА.FUNC_LIB.TempSTR[47]="ToJur=0";
   РАБ.НФА.FUNC_LIB.TempSTR[48]="RightBar=0";
   РАБ.НФА.FUNC_LIB.TempSTR[49]="HiPage=0";
   РАБ.НФА.FUNC_LIB.TempSTR[50]="IsSvodn=0";
   РАБ.НФА.FUNC_LIB.TempSTR[51]="UseAna=0";
   РАБ.НФА.FUNC_LIB.TempSTR[52]="SvodnByDay=1";
   РАБ.НФА.FUNC_LIB.TempSTR[53]="SortTab=1";
   РАБ.НФА.FUNC_LIB.TempSTR[54]="SortCol=1";
   РАБ.НФА.FUNC_LIB.TempSTR[55]="SortStr=1";
   РАБ.НФА.FUNC_LIB.TempSTR[56]="ColOther=0";
   РАБ.НФА.FUNC_LIB.TempSTR[57]="ShowPeriod=1";
   РАБ.НФА.FUNC_LIB.TempSTR[58]="ShowPB=0";
   РАБ.НФА.FUNC_LIB.TempSTR[59]="ShowCond=1";
   РАБ.НФА.FUNC_LIB.TempSTR[60]="ShowDate=1";
   РАБ.НФА.FUNC_LIB.TempSTR[61]="AltHeaders=0";
   РАБ.НФА.FUNC_LIB.TempSTR[62]="ColHeaders0=Остаток на";
   РАБ.НФА.FUNC_LIB.TempSTR[63]="ColHeaders1=дебет";
   РАБ.НФА.FUNC_LIB.TempSTR[64]="ColHeaders2=кредит";
   РАБ.НФА.FUNC_LIB.TempSTR[65]="ColHeaders3=Оборот";
   РАБ.НФА.FUNC_LIB.TempSTR[66]="ColHeaders4=по дебету";
   РАБ.НФА.FUNC_LIB.TempSTR[67]="ColHeaders5=Оборот";
   РАБ.НФА.FUNC_LIB.TempSTR[68]="ColHeaders6=по кредиту";
   РАБ.НФА.FUNC_LIB.TempSTR[69]="ColHeaders7=Счет";
   РАБ.НФА.FUNC_LIB.TempSTR[70]="ColHeaders8=ИТОГО";
   РАБ.НФА.FUNC_LIB.TempSTR[71]="ColHeaders9=Валюта";
   РАБ.НФА.FUNC_LIB.TempSTR[72]="ColHeaders10=Непомеченные признаком -";
   РАБ.НФА.FUNC_LIB.TempSTR[73]="ColHeaders11=Обороты за период с";
   РАБ.НФА.FUNC_LIB.TempSTR[74]="ColHeaders12=Период";
   РАБ.НФА.FUNC_LIB.TempSTR[75]="ColHeaders13=Обороты";
   РАБ.НФА.FUNC_LIB.TempSTR[76]="ColHeaders14=ВСЕГО";
   РАБ.НФА.FUNC_LIB.TempSTR[77]="ColHeaders15=Другие";
   РАБ.НФА.FUNC_LIB.TempSTR[78]="ColHeaders16=Наименование";
   РАБ.НФА.FUNC_LIB.TempSTR[79]="ColHeaders17=Кол.";
   РАБ.НФА.FUNC_LIB.TempSTR[80]="ColHeaders18=Ит.";
   РАБ.НФА.FUNC_LIB.TempSTR[81]="ColHeaders19=подтаблицы";
   РАБ.НФА.FUNC_LIB.TempSTR[82]="ColHeaders20=План бухгалтерии:";
   РАБ.НФА.FUNC_LIB.TempSTR[83]="ColHeaders21=Условие отбора";
   РАБ.НФА.FUNC_LIB.TempSTR[84]="ColHeaders22=пров";
   РАБ.НФА.FUNC_LIB.TempSTR[85]="ColHeaders23=Корр.";
   РАБ.НФА.FUNC_LIB.TempSTR[86]="ColHeaders24=за";
   РАБ.НФА.FUNC_LIB.TempSTR[87]="ColHeaders25=с";
   РАБ.НФА.FUNC_LIB.TempSTR[88]="ColHeaders26=по";
   РАБ.НФА.FUNC_LIB.TempSTR[89]="ColHeaders27=включительно";
   РАБ.НФА.FUNC_LIB.TempSTR[90]="ColHeaders28=вкл.";
   РАБ.НФА.FUNC_LIB.TempSTR[91]="NaimWidth=50";
   РАБ.НФА.FUNC_LIB.TempSTR[92]="IsMovAnaName=0";
   РАБ.НФА.FUNC_LIB.TempSTR[93]="FixedDateFormat=0";
   РАБ.НФА.FUNC_LIB.TempSTR[94]="UseOldDelim=1";
   РАБ.НФА.FUNC_LIB.TempSTR[95]="IsReverse=0";
   РАБ.НФА.FUNC_LIB.TempSTR[96]="StrAnaGroup="+СтрокиПоПризнакам;
   len=LengthOfArray(РАБ.НФА.FUNC_LIB.TempSTR);
   if len=0: ^False; fi;
   for i=1 to len do TextFileWriteLn(F, РАБ.НФА.FUNC_LIB.TempSTR[i]); od;
 Except
   if FlagCreate=True:
     TextFileClose(F);
     Message("Ошибка записи в файл '"+Folder+ИмяФайла+"'");
     ^False;
   else
     Message("Ошибка создания файла '"+Folder+ИмяФайла+"'");
     ^False;
   fi;
 end;
 TextFileClose(F);
 ^True;
end;

Func ДатаПроводки(УСЛсч:String; УСЛан:String; ДатаРасчета:Date; Последняя:Logical) :Date;
var x :Integer;
var ANA :String;
var Res :Numeric;
var ddv :Date;
 ddv=1.1.100; ANA=УСЛсч+"{"+УСЛан+"}";
 Try Res=Saldo(ANA, 1.1.100); Except Raise; ^ddv; end;
 if Последняя:
   for Transaction x=ANA, 1.1.100, ДатаРасчета, Reverse do ddv=TransDate(x); if ddv<>1.1.100: Break; fi; od;
 else
   for Transaction x=ANA, 1.1.100, ДатаРасчета          do ddv=TransDate(x); if ddv<>1.1.100: Break; fi; od;
 fi;
 ^ddv;
end;

Func СчетСоотвМаске(СЧ:String; УСЛсч:String) :Logical;
-- СЧ должно являтся полным значением, а не маской!
var Acc :String;
 if УСЛсч="": ^False; fi;
 if Name_S(СЧ)=" ": ^False; fi;
if WordsCount(УСЛсч, '~|&/+-()') = 1: ^Match(СЧ, ExtractWord(1,УСЛсч,'~|&/+-()')); fi;
 if Length(СЧ)+Length(УСЛсч)+4<255:УСЛсч=СЧ+'&('+УСЛсч+')';fi;
 for Account Acc=УСЛсч, Sort do if СЧ=Acc: ^True; fi; od;
 ^False;
end;

Func ПризнакСоотвМаске(Призн:String; УСЛан:String) :Logical;
-- Призн должно являтся полным значением, а не маской!
var Ana :String;
 if УСЛан="": ^False; fi;
 if Name_A(Призн)=" ": ^False; fi;
 if WordsCount(УСЛан, '~|&/+-()') = 1: ^Match(Призн, ExtractWord(1,УСЛан,'~|&/+-()')); fi;
 if Length(Призн)+Length(УСЛан)+4<255:УСЛан=Призн+'&('+УСЛан+')';fi;
 for Sign Ana=УСЛан, Sort do if Призн=Ana: ^True; fi; od;
 ^False;
end;

Func ПризнакИзСтрокиАналитикиПроводки(x:Integer; VOC:String; ДебПров:Logical) :String;
-- x - номер проводки
var p :Integer;
var sep, ANA :String;
 sep=""; ANA="";
 p=TransNumSign(x, sep+VOC+".");
 if p>0: ANA=TransSignName(x, p); ^ANA; fi;
 if ДебПров: sep="+"; else sep="-"; fi;
 p=TransNumSign(x, sep+VOC+".");
 if p>0: ANA=TransSignName(x, p); ^(SubStr(ANA, 2, 255)); fi;
 ^ANA;
end;

Func ПоследнийПризнакВПроводкахИзСправочника(УСЛсч:String; УСЛан:String; ddн:Date; ddк:Date; VOC:String) :String;
var x, p :Integer;
var ANA, tmp :String;
var Res :Numeric;
 ANA=УСЛсч+"{"+УСЛан+"&"+VOC+".*}"; tmp="";
 Try Res=Saldo(ANA, 1.1.100); Except Raise; ^""; end;
 for Transaction x=ANA, ddн, ddк, Reverse do
   p=TransNumSign(x,  ""+VOC+".");
   if p>0: tmp=TransSignName(x, p); ^tmp; fi;
   p=TransNumSign(x, "+"+VOC+".");
   if p>0: tmp=TransSignName(x, p); ^SubStr(tmp, 2, 255); fi;
   p=TransNumSign(x, "-"+VOC+".");
   if p>0: tmp=TransSignName(x, p); ^SubStr(tmp, 2, 255); fi;
 od;
 ^tmp;
end;

Func NextNumNotCurr(CardNum:String; FieldNum:String; Curr:Record) :Integer;
var RO, num, res :Integer;
 res=0;
 RO=OpenWorkArea(CardNum, FieldNum, "Ukey<>"+RecordToString(Curr));
 Try
   num=Records(RO);
   res=if(num>0, GetFieldI(RO, num, FieldNum), 0)+1;
 Finally
   CloseWorkArea(RO);
 end;
 ^res;
end;

Func NextNumInF(CardNum:String; FieldNum:String; Filter:String) :Integer;
var RO, num, res, rs,MaxLen,j:Integer;
var f0,f1,fin :s;
var breakok:l;

 if WordsCount(FieldNum,',')=1:
       if SQLQueryEnabled:
         j=Раб.SQL.GetNomCRD(CardNum);
         if Раб.SQL.CardDBType[j]="MS SQL" and Раб.SQL.ServFilter[j]='':
            breakok=false;
            if Filter<>'':
               breakok=not CardFilterToSql(CardNum, "", Filter, fin);
            fi;
            if not breakok:
              ^max(0,Раб.sql.GetAgrFieldI(CardNum,Раб.SQL.SQLcrdlist[j],FieldNum,fin,'max',false))+1;
            fi;
         fi;
       fi;
      RO=OpenWorkArea(CardNum, FieldNum, Filter);
      try
        rs=Records(RO);
        if rs>0:res=max(0,GetFieldI(RO,rs,FieldNum));fi;
      Finally
        CloseWorkArea(RO);
      end;
  | true:
    FieldNum=ExtractWord(2,FieldNum,',');
    j=Раб.SQL.GetNomCRD(CardNum);
    if Раб.SQL.CardDBType[j]="MS SQL" and SQLQueryEnabled:
       f0='(не СООТВ('+FieldNum+',"*[^0-9. ]*"))'; -- волшебный фильтр для целых положительных чисел
       j=Раб.SQL.GetNomCRD(CardNum);
       breakok=false;
       if Filter<>'':
          breakok=not CardFilterToSql(CardNum, "", Filter, fin);
        | true:fin='';
       fi;
       if Раб.SQL.ServFilter[j]='' and not breakok:--нет доп фильтра на сервере и доп фильтр можно использовать в SQL
            if fin<>'':fin='('+fin+') and ';fi;
            fin=fin+'IsNumeric('+FieldNum+')=1';
            fin=fin+" and "+FieldNum+" not LIKE '%[^0-9. ]%'";
            FieldNum='cast(cast('+FieldNum+' as dec(11,0)) as integer)';
--          FieldNum='cast(cast('+FieldNum+' as numeric) as integer)';
            ^max(0,Раб.sql.GetAgrFieldI(CardNum,Раб.SQL.SQLcrdlist[j],FieldNum,fin,'max',false))+1;
       fi;

       if fin<>'':
          fin=' and ('+fin+')';
       fi;
       RO=OpenWorkAreaSql("", "select distinct Len("+FieldNum+") result,Len("+FieldNum+")-Len(Ltrim("+FieldNum+")) result1 from "+GetRealCardFileName(CardNum)+" with (nolock) where "+FieldNum+" not LIKE '%[^0-9. ]%' and Len("+FieldNum+")>0"+fin, CardNum);
       ClearVariable(Раб.НФА.func_lib.TempINT);
       ClearVariable(Раб.НФА.func_lib.TempNUM);
       Try
         MaxLen=GetAsArraySQL(RO,'Раб.НФА.func_lib','TempINT=result|TempNUM=result1');
       Finally
         CloseWorkArea(RO);
       end;
       RO=OpenWorkArea(CardNum, FieldNum,'1=0');
       try
         for j=1..MaxLen do
           f1=' and Length('+FieldNum+')='+str(TempINT[j])+' and СООТВ('+FieldNum+',"'+повтор(' ',int(TempNUM[j]))+'[0-9.]*")';
           SetFilter(RO,f0+f1);
           rs=Records(RO);
           if rs>0:res=max(res,int(GetFieldS(RO,rs,FieldNum)));fi;
         od;
       Finally
         CloseWorkArea(RO);
       end;
       ClearVariable(Раб.НФА.func_lib.TempINT);
       ClearVariable(Раб.НФА.func_lib.TempNUM);

     | true:-- ручной перебор
         f1='int('+FieldNum+')>';
         if Filter<>'': f1='('+Filter+') и '+f1; fi;
         RO=OpenWorkArea(CardNum, FieldNum,f1+'0');
         try
           rs=records(ro);
           while rs>0 do
             res=max(res,int(GetFieldS(RO,rs,FieldNum)));-- берем максимальное (последнее в отсортированой области)
             SetFilter(RO,f1+str(res));-- ищем все, что больше обновленного максимального
             rs=records(ro);
           od;
         Finally
           CloseWorkArea(RO);
         end;
    fi;
 fi;
 ^res+1;
end;

Func NextNum(CardNum:String; FieldNum:String) :Integer;
var RO, num, res :Integer;
 res=0;
 if GetCardDBType(CardNum)="MS SQL" and SQLQueryEnabled:
   RO=OpenWorkAreaSql("", "select max("+FieldNum+") as result from "+GetRealCardFileName(CardNum)+" with (nolock)", CardNum);
   Try
     res=(GetFieldI(RO, 1, "result")+1);
   Finally
     CloseWorkArea(RO);
   end;
 else
   RO=OpenWorkArea(CardNum, FieldNum);
   Try
     num=Records(RO);
     res=if(num>0, GetFieldI(RO, num, FieldNum), 0)+1;
   Finally
     CloseWorkArea(RO);
   end;
 fi;
 ^res;
end;

Func NextNumInF_Old(CardNum:String; FieldNum:String; Filter:String) :Integer;
var RO, num, res :Integer;
var resN    :Numeric;
var SQLWork :Logical;
var FieldNum0 :String;
var Zero, SQL: LongString;
-- FieldNum - может быть два поля, первое - целое, второе - строковое
 FieldNum0=FieldNum;
 res=0; SQLWork=False;
 if GetCardDBType(CardNum)="MS SQL" and SQLQueryEnabled: SQLWork=CardFilterToSql(CardNum, "", Filter, SQL); fi;
 if SQLWork:
   Zero="";
   if WordsCount(FieldNum,',')=2:
      FieldNum=ExtractWord(2,FieldNum,',');
      if sql<>'':sql='('+sql+') and ';fi;
      sql=sql+'IsNumeric('+FieldNum+')=1';
      FieldNum='cast(cast('+FieldNum+' as dec(11,0)) as integer)';
   fi;
--   ^Раб.sql.GetAgrFieldI(crd,crdsql,FieldNum,SQL,'max',false);
   SQL="select max("+FieldNum+") as result from "+GetRealCardFileName(CardNum)+"  with (nolock)"+ if(Filter="", Zero, " where " + SQL);--+" order by t.["+FieldNum+"] desc";
   try
     RO=OpenWorkAreaSql("", SQL, CardNum);
     Try
       resN=GetFieldN(RO, 1, "result");
       if resN>2147483646:res=2147483647;
        | true:res=int(resN)+1;
       fi;
       CloseWorkArea(RO);
     except
       SQLWork = False; --SQL жестоко сфейлил, пошли нативно...
       CloseWorkArea(RO);
     end;
   except
     SQLWork = False; --SQL жестоко сфейлил, пошли нативно...
   end;
 fi;
 if not SQLWork:
   if WordsCount(FieldNum0,',')=2:
      --не СООТВ(БУМНОМЕР,"*[^0-9.-]*") и СООТВ(БУМНОМЕР,"[0-9-]*") и ((СООТВ(БУМНОМЕР,"*[0-9].[0-9]*") и не СООТВ(БУМНОМЕР,"*.*.*")) или не СООТВ(БУМНОМЕР,"*.*"))
      FieldNum0=ExtractWord(1,FieldNum0,',');
   fi;
   RO=OpenWorkArea(CardNum, FieldNum0, Filter);
   Try
     num=Records(RO);
     res=if(num>0, GetFieldI(RO, num, FieldNum0), 0)+1;
   Finally
     CloseWorkArea(RO);
   end;
 fi;
 ^max(1,res);
end;

Func NextNumToDate(CardNum:String; FieldNum:String; FieldDat:String; ToDate:Date) :Integer; -- Определения следущего номера с учетом перехода между годами и учетом заданной даты
var CurrYear:Integer;
var Фильтр :String;
 if ToDate<>1.1.100: CurrYear=Year(ToDate); else CurrYear=Year(ToDay); fi;
 Фильтр="("+FieldDat+">="+DateToString(Dat(1, 1, CurrYear))+") and ("+FieldDat+"<"+DateToString(Dat(1, 1, CurrYear+1))+")";
 ^NextNumInF(CardNum, FieldNum, Фильтр);
end;

Func NextNumToDateInF(CardNum:String; FieldNum:String; FieldDat:String; Filter:String; ToDate:Date) :Integer; -- Определения следущего номера с учетом перехода между годами, с учетом фильтра и заданной даты
var CurrYear:Integer;
var Фильтр :String;
 if ToDate<>1.1.100: CurrYear=Year(ToDate); else CurrYear=Year(ToDay); fi;
 Фильтр="("+Filter+") and ("+FieldDat+">="+DateToString(Dat(1, 1, CurrYear))+") and ("+FieldDat+"<"+DateToString(Dat(1, 1, CurrYear+1))+")";
 ^NextNumInF(CardNum, FieldNum, Фильтр);
end;

Func фЕстьТакоеПоле_в_Картотеке(aWorkCRD:String; aFieldName:String; aFieldType:Integer) :Logical;
var num :Integer;
 ClearVariable(РАБ.НФА.FUNC_LIB.TempSTR);
 num=GetCardFileFields(aWorkCRD, РАБ.НФА.FUNC_LIB.TempSTR, aFieldType);
 if num>1:
   SortArray(РАБ.НФА.FUNC_LIB.TempSTR);
   ^(if(SearchInArray(РАБ.НФА.FUNC_LIB.TempSTR, Up(aFieldName), True, 1)>0, True, False));
 |  num=1:
   ^(if(РАБ.НФА.FUNC_LIB.TempSTR[1]=Up(aFieldName), True, False));
 else ^False;
 fi;
end;

Func Документ_Сформирован_из_ОперацийДНФА(refWRKCRD:String; refДНФАID:Integer; refRECCRD:Integer) :Logical;
var RECID_REF :Integer;
var CRDwork :String;
var REC :Record;

 RECID_REF=0;
 REC=NIL;
 if refWRKCRD<>"" and refWRKCRD<>"РПО_ОПЕРАЦИИДНФА":
   CRDwork   = refWRKCRD;
   RECID_REF = refRECCRD;
   if RECID_REF=0 and refДНФАID<>0: RECID_REF=refДНФАID; fi; -- на всякий случай
 else
   CRDwork   = "РПО_ОПЕРАЦИИДНФА";
   RECID_REF = refДНФАID;
   if RECID_REF=0 and refRECCRD<>0: RECID_REF=refRECCRD; fi;
 fi;
 if RECID_REF<>0:
   REC = IntegerToRecord(Abs(RECID_REF));
   if REC<>NIL and CRDwork<>"": ^RecordExists(CRDwork, REC); fi;
 fi;
 ^False;
end;

Proc Перейти_к_ОперацинномуДокументу(refWRKCRD:String; refBLNCRD:String; refДНФАID:Integer; refRECCRD:Integer; refCURBLN:String);
var CRD_АвтоДОК, bln_АвтоДОК :String;
var Work :Logical;
var REC :Record;

 Work = False;
 REC = NIL;
 if refWRKCRD<>"" and refRECCRD<>0: CRD_АвтоДОК = refWRKCRD         ; bln_АвтоДОК = refBLNCRD;              REC=IntegerToRecord(Abs(refRECCRD));
 | True:                            CRD_АвтоДОК = "РПО_ОПЕРАЦИИДНФА"; bln_АвтоДОК = "НФА.ЖУР.ОПЕРАЦИИДНФА"; REC=IntegerToRecord(Abs(refДНФАID));
 fi;
 if REC<>NIL and CRD_АвтоДОК<>"" and bln_АвтоДОК<>"": Work = RecordExists(CRD_АвтоДОК, REC); fi;
 if not Work: Message("Не найден операционный документ из которого сформирован текущий документ!", mtWarning); Exit; fi;
 OpenBlank(bln_АвтоДОК, False, REC);
 if ModalMode: Close(refCURBLN); fi;
end;

-- *** === ***

Proc Очистить;
 ClearVariable(TempDAT); ClearVariable(TempLOG); ClearVariable(TempINT);
 ClearVariable(TempNUM); ClearVariable(TempSTR); ClearVariable(TempREC);
 ClearVariable(ИмяБланка);
end;

2-- События шаблона
Proc Template_OnOpen(Create:Logical); -- при открытии шаблона
 Очистить;
end;

Proc Template_OnClose(Destroy:Logical); -- при закрытии шаблона
 Очистить;
end;

КОНЕЦ -- конец бланка


