БЛАНКСШАБЛОНОМ [07.11.2005] "Общие процедуры и функции";
-- Редакция ЗАО "Агентство 'Русспромоценка'"
2-- Константы
var Sep       :String="~";
2-- Переменные
var TempDAT[] :Date;    -- для переноса нескольких дат между бланками
var TempLOG[] :Logical; -- для переноса нескольких переменных логического типа между бланками
var TempINT[] :Integer; -- для переноса нескольких целых чисел между бланками
var TempNUM[] :Numeric; -- для переноса нескольких чисел между бланками
var TempSTR[] :String;    -- для переноса нескольких строк между бланками
var TempREC[] :Record;    -- для переноса нескольких ссылок между бланками
--
var ИмяБланка :String;
var текРеестр :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 :Integer;
 RO=OpenWorkArea(Card, Field);
 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 UnqNumF(Card:String; Field:String; Curr:Record) :Integer;
-- По упорядоченному числовому порядковому полю ищет незанятый (уникальный) номер
-- При исчерпании списка уникальный номер - max + 1
var RO, Num, Ind, S :Integer;
 RO=OpenWorkArea(Card, Field, "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;
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(РАБ.УПП.LIB.TempNUM);
 if len>0:
   compare=""; OK=False; sum=0; k=0;
   ShowProgress(len, "Подождите, идет суммирование данных...");
   Try
     for i=1..len do
       ProgressPos(i);
       if compare<>РАБ.УПП.LIB.TempSTR[i]: OK=False; fi; -- одинаковых нет
       if OK=False: -- если не одинаковый, то запоминаем...
     compare=РАБ.УПП.LIB.TempSTR[i];
         sum=РАБ.УПП.LIB.TempNUM[i];
     k=k+1;
     РАБ.УПП.LIB.TempSTR[k]=compare;
     РАБ.УПП.LIB.TempNUM[k]=sum;
     OK=True; --... следующий элемент (до проверки) считаем одинаковым
       else
     РАБ.УПП.LIB.TempNUM[k]=РАБ.УПП.LIB.TempNUM[k]+РАБ.УПП.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(РАБ.УПП.LIB.TempSTR, i); 
     DeleteFromArray(РАБ.УПП.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(РАБ.УПП.LIB.TempNUM);
 if len>0:
   compare=""; OK=False; sum=0; k=0;
   for i=1..len do
     if compare<>РАБ.УПП.LIB.TempSTR[i]: OK=False; fi; -- одинаковых нет
     if OK=False: -- если не одинаковый, то запоминаем...
       compare=РАБ.УПП.LIB.TempSTR[i];
       sum=РАБ.УПП.LIB.TempNUM[i];
       k=k+1;
       РАБ.УПП.LIB.TempSTR[k]=compare;
       РАБ.УПП.LIB.TempNUM[k]=sum;
       OK=True; --... следующий элемент (до проверки) считаем одинаковым
     else
       РАБ.УПП.LIB.TempNUM[k]=РАБ.УПП.LIB.TempNUM[k]+РАБ.УПП.LIB.TempNUM[i]; -- если одинаковый - суммируем
     fi;
   od;
   k=k+1; len=i-1;
   if k<=len:  -- удаляем лишнее
     i=len;
     while i>=k do
       DeleteFromArray(РАБ.УПП.LIB.TempSTR, i);
       DeleteFromArray(РАБ.УПП.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(РАБ.УПП.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<>РАБ.УПП.LIB.TempREC[i]: OK=False; fi; -- одинаковых нет
       if OK=False: -- если не одинаковый, то запоминаем...
     compare=РАБ.УПП.LIB.TempREC[i];
         sum=РАБ.УПП.LIB.TempNUM[i];
     k=k+1;
     РАБ.УПП.LIB.TempREC[k]=compare;
     РАБ.УПП.LIB.TempNUM[k]=sum;
     OK=True; --... следующий элемент (до проверки) считаем одинаковым
       else
     РАБ.УПП.LIB.TempNUM[k]=РАБ.УПП.LIB.TempNUM[k]+РАБ.УПП.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(РАБ.УПП.LIB.TempREC, i);
     DeleteFromArray(РАБ.УПП.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, num :Integer;
var Фильтр :String;
 Фильтр=Field+"="+Str(iVal);
 RO=OpenWorkArea(Card, Field, "1=0");
 Try
   SetFilter(RO, Фильтр);
   num=Records(RO);
   if num>1 : ^True;
   |  num=1 : if REC<>GetRecordKey(RO, 1): ^True; fi;
   else ^False;
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^False;
end;

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

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

Func ДубликатЗап(REC:Record; rVal:Record; Card:String; Field:String): Logical;
-- ДЛЯ ЗНАЧЕНИЯ ТИПА ЗАПИСЬ rVal: оперделяется дубликат записи в таблице с именем Card по уникальному полю Field = значению rVal;
var RO, num :Integer;
var Фильтр :String;
 Фильтр=Field+"="+RecordToString(rVal);
 RO=OpenWorkArea(Card, Field, "1=0");
 Try
   SetFilter(RO, Фильтр);
   num=Records(RO);
   if num>1 : ^True;
   |  num=1 : if REC<>GetRecordKey(RO, 1): ^True; fi;
   else ^False;
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^False;
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 СуммаАмортизацииКарт(БалансСтоим:Numeric; ДатаОС:Date; ДатаРас:Date; Норма:Numeric; Всего:Logical; Точ:Integer) :Numeric;
-- БалансСтоим -- Начальная балансовая стоимость ОС
-- ДатаОС      -- Дата принятия ОС к учету
-- ДатаРас     -- Дата расчета амортизации (день - любой, месяц - для какого делается расчет)
-- Срок        -- Срок полезного использования ОС
-- Всего       -- Если TRUE - вычисляется весь износ на дату
-- Точ           -- Точность вычислений
var OSdate, WKdate :Date;
var колМесСрока, колМесАморт, timeR :Integer;
var Срок, СумАмортМес, СумАмортВсе, V, RES :Numeric;
 OSdate=RoundMonthUp(ДатаОС);
 WKdate=Dat(1, Mon(ДатаРас), Year(ДатаРас));
 Срок=if(Норма=0, 0, 100/Норма);
 колМесСрока=Int(RoundUp(Срок*12, 0));
 if (WKdate>OSdate) : колМесАморт=Int(ИнтервалМеждуДатами(OSdate, WKdate, 2, False, False))+1;
 |  (WKdate=OSdate) : колМесАморт=1;
 |  (WKdate<OSdate) : колМесАморт=0;
 fi;
 if колМесАморт<>0 :
   if колМесСрока<>0 :
     СумАмортМес=Round(БалансСтоим/колМесСрока, Точ); -- амортизация за месяц
     СумАмортВсе=Round(СумАмортМес*колМесАморт, Точ); -- накопительная амортизация
     timeR=колМесСрока-колМесАморт;
     if timeR>0 : -- начисляем амортизацию
       if Всего : 
     RES=СумАмортВсе;
       else
     RES=СумАмортМес;
       fi;
     |    timeR=0 : -- последний месяц начисления амортизации
       V=БалансСтоим-СумАмортВсе;
       if Всего : 
     if V>=0 : RES=СумАмортВсе; else RES=БалансСтоим; fi;
       else
     if V>=0 : RES=СумАмортМес; else RES=СумАмортМес+V; fi;
       fi;
     |    timeR<0 : -- все уже самортизировалось
       if Всего : RES=БалансСтоим; else RES=0; fi;
     fi;
   else
    RES=0; -- амортизация (норма=0) не начисляется
   fi;
 else
   RES=0; -- время еще не настало
 fi;
 ^RES;
end;

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

-- ПиФ УПП

Func ТочностьЕдИзмПродукта(REC :Record) :Integer;
var t :Integer;
 if REC<>NIL: t=GetCardFieldI("РПО_РЕЕСТР", REC, "ТОЧ_ЕИ"); t=if(t>0,if(t>4,4,t),0); fi; ^t;
end;

Func вГраммы(REC :Record) :Numeric; -- ед.изм. выраженная в граммах (если задано)
 if REC<>NIL: ^GetCardFieldN("РПО_ЕДИЗМ", REC, "ГРАММ"); fi;
end;

Func КоэффициентПересчета(REC :Record) :Numeric; -- пересчет к базовой единице
var k :Numeric;
 if REC<>NIL: k=GetCardFieldN("РПО_ЕДИЗМ", REC, "КФ_БАЗЫ"); k=if(k>0, k, 1); fi; ^k;
end;

Func КПграмм(REC :Record) :Numeric; -- пересчет к базовой единице, выраженной в граммах
var k, v, out :Numeric;
 if REC<>NIL: k=КоэффициентПересчета(REC); v=вГраммы(REC); if v>0: out=k/v; else out=k; fi; fi; ^out;
end;

Func РольПродукта(ind:Integer) :String; -- возщвращает роль продукта
var Out :String;
 if ind=1 : Out="Продукт";
 |  ind=2 : Out="Полуфабрикат";
 |  ind=3 : Out="Блюдо";
 |  ind=4 : Out="Продукт как блюдо";
 |  ind=5 : Out="Компонент";
 else Out="";
 fi;
 ^Out;
end;

Func УмолчаниеКонст :Record;
var RO, num :Integer;
var REC :Record;
 REC=NIL;
 RO=OpenWorkArea("РПО_КОНСТ", "");
 Try
   if Records(RO)=0:
     BeginChanging(RO, False);
     Try
       num=InsertRecord(RO);
       num=PutFieldI(RO, num, "КОД", 1);
       num=PutFieldL(RO, num, "ЗАЩИТА", True);
       num=PutFieldS(RO, num, "КОММЕНТ", "Параметры по умолчанию");
       num=PutFieldL(RO, num, "АКТИВНЫ", True);
       num=PutFieldI(RO, num, "ПАР_СТЛВИД", 5);
       num=PutFieldI(RO, num, "ПАР_ТОЧУМ", 2);
       num=PutFieldN(RO, num, "ПАР_БРУТТО", 100);
       num=PutFieldI(RO, num, "ПАР_ПР_ЛИМ", 30);
       num=PutFieldN(RO, num, "ПАР_ПРНАД", 20);
       num=PutFieldN(RO, num, "ПАР_ПРНАЦ", 20);
       num=PutFieldL(RO, num, "ПАР_СВОДОТЧ", False);
       num=PutFieldL(RO, num, "ПАР_ГРУПКАТ", True);
       num=PutFieldL(RO, num, "ПАР_РАЗВПФ", False);
       num=PutFieldS(RO, num, "ПАР_ИМЯОРГ", 'Наша организация');
       num=PutFieldS(RO, num, "ПАР_ДОЛЖРУК", 'Должность');
       num=PutFieldS(RO, num, "ПАР_ФИОРУК", 'Ф. И. О.');
       num=PutFieldS(RO, num, "ПАР_ФИОЗАВСТОЛ", 'Ф. И. О.');
       num=PutFieldS(RO, num, "ПАР_ФИОБУХКАЛК", 'Ф. И. О.');
       EndChanging(RO);
       REC=GetRecordKey(RO, num);
     Except
       CancelChanging(RO);
       Raise;
     end;
   fi;
 Finally
   CloseWorkArea(RO);
 end;
 ^REC;
end;

Func КлючЗаписиАктивныхНастроек :Record;
var RO, num, nn, i :Integer;
var RR :Record;
 RR=NIL;
 RO=OpenWorkArea("РПО_КОНСТ", "", "АКТИВНЫ=True");
 Try 
   num=Records(RO);
   if num=1:
     RR=GetRecordKey(RO, 1);
   |  num=0:
     Message("Нет записи настроек подсистемы!^MБудет создана запись с настройками по умолчанию!", mtInformation);
     RR=УмолчаниеКонст;
   |  num>1:
     Message("Ошибка!^MАктивна должна быть одна запись настроек подсистемы!^MБудет активирована первая запись.", mtError);
     BeginChanging(RO, False);
     Try
       for i=2 .. num do nn=PutFieldL(RO, i, "АКТИВНЫ", False); od;
       EndChanging(RO);
     Except
       CancelChanging(RO); Raise;
     end;
     RR=GetRecordKey(RO, 1);
   fi; 
 Finally 
   CloseWorkArea(RO);
 end;
 ^RR;
end;

-- Добавление от 22.05.2006

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;
 УСЛсч="("+УСЛсч+")";
 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 УСЛан="*": ^True; 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 NextNum(Card:String; Field:String; Curr:Record) :Integer;
--var RO, num, res :Integer;
--res=0;
-- RO=OpenWorkArea(Card, Field, "Ukey<>"+RecordToString(Curr));
-- Try
--   num=Records(RO);
--   res=if(num>0, GetFieldI(RO, num, Field), 0)+1;
-- Finally
--   CloseWorkArea(RO);
-- end;
-- ^res;
--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(CardNum:String; FieldNum:String; Filter:String) :Integer;
var RO, num, res :Integer;
var SQLWork :Logical;
var Zero, SQL: LongString;
 res=0; SQLWork=False;
 if GetCardDBType(CardNum)="MS SQL" and SQLQueryEnabled: SQLWork=CardFilterToSql(CardNum, "t.", Filter, SQL); fi;
 if SQLWork:
   Zero="";
   SQL="select max(t.["+FieldNum+"]) as result from "+GetRealCardFileName(CardNum)+" t with (nolock)"+ if(Filter="", Zero, " where " + SQL);--+" order by t.["+FieldNum+"] desc";
   RO=OpenWorkAreaSql("", SQL, CardNum);
   Try
     res=(GetFieldI(RO, 1, "result")+1);
   Finally
     CloseWorkArea(RO);
   end;
 else
   RO=OpenWorkArea(CardNum, FieldNum, Filter);
   Try
     num=Records(RO);
     res=if(num>0, GetFieldI(RO, num, FieldNum), 0)+1;
   Finally
     CloseWorkArea(RO);
   end;
 fi;
 ^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 ПризнакКонстанта(МаскаДляВыбора:String) :String;
var nn :Integer;
var mask, tmp: String;
 nn=0;
 Try for Sign mask=МаскаДляВыбора do tmp=mask; nn=nn+1; if nn=2: Break; fi; od; Except end;
 if nn=1: ^tmp;  -- признак=константа
 |  nn=0: ^" ";  -- признаков нет вообще
 |  True: ^"" ;  -- признаков больше одного
 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;

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