БланкСШаблоном "Библиотека предметной области";
-- Описание общих процедур и функций для работы с предметной областью
                                 -- Многие М.М.     01.01.100- 29.05.98
                                 -- Алексеев С.В.   30.05.98 - 17.08.98
                                 -- Егоров М.О.     08.09.98 - 08.09.98 -- Перенес в Раб.Бух.
                                 -- Сущик А.С.      11.05.2004-12.05.2004--Изменена функция Праздники,с учетом,если и 1 и 2выходные дни.
                                 -- Сущик А.С       25.11.2004-30.11.2004--Изменил многие функции
                                 -- работы с календарем связи с изменением законодательства и ввода
                                 -- картотеки характеристики дня
--*********** функции работы с валютами **********************************
  func MaxVal :Integer;
    -- Макс. кол-во валют в структуре учета
  var i :Integer;
  var d :String;
    i = 0;
    для валюты  d="*"  do i = i+1;  od;
    ^i;
  end; -- MaxVal --

  func ValName (i :Integer) :String;
    -- Выдает код i-той валюты в списке валют структуры учета
  var v,d :String;
  var j   :Integer;
    j = 0;
    для валюты  v="*"  do
      d = Lo(v);
      j = j+1;
      if j=i: ^d; fi;
    od;
    ^d;
  end; -- ValName --

  func ValNum (nm :String) :Integer;
    -- Номер валюты в структуре учета по идентификатору
  var v,d,ln :String;
  var i      :Integer;
    ln = Lo(nm);
    i = 0;
    для валюты  v="*"  do
      d = Lo(v);
      if ln = d: ^i+1; fi;
      i = i+1;
    od;
    ^i+1;
  end; -- ValNum --

  func NextVal (v :Integer) :Integer;
    -- Выдает номер следующей валюты в структуре учета циклично
    ^ IF (v=MaxVal: 1, v+1);
  end; -- NextVal --

--*********** функции работы с календарем **********************************
aListDayOfWeek:String='понедельник=1|вторник=2|среда=3|четверг=4|пятница=5|суббота=6|воскресенье=7|';
aListTypeOfDay:String='Рабочий=0='+Str(coBlack)+'|Предпраздничный=1='+Str(coOlive)+'|Суббота=2='+Str(coFuchsia)+'|Воскресенье=4='+Str(coRed)+'|Праздничный=8='+Str(coPurple);
--где Str(coBlack)...-цвета шрифтов в календаре(см.Help-"Константы,цвета клеток")
  Func КалендарьЦветной(Dt:Date):Date;
  --добавил Сущик А.С. 27.04.2005
  --если входная дата(Dt) имеется в картотеке "ХарактеристикиДня",то видим цветной календарь,на
  --базе указанной картотеки;иначе-стандартный.
  --если дата имеется в картотеке,то по правой кнопки мыши можно подправить ее характеристики.
  --Особенно важно для работающих по субботам в случае переноса праздника,для совпадения рабочих и
  -- праздничных дней с внутренним распорядкам.
  Var W,N:I;
  Var VDate:Date;
   N=0;
   If Dt>2.2.1917:
     W=OpenWorkArea("ХарактеристикиДня","ДатаДня","ДатаДня="+DateToString(Dt));
     Try
       N=Records(W);
     Finally
       CloseWorkArea(W);
     End;
     If N>0:
        VDate=CardFileCalendar("ХарактеристикиДня","ДатаДня","ДеньНедели","ТипДня",
        aListDayOfWeek,aListTypeOfDay,Dt);
     | True:
       VDate=Calendar(Dt);
     Fi;
   | True:
     VDate=Calendar;
   Fi;
   ^VDate;
  Cnuf;

  func Месяца (М :Integer) :String;
    -- Название месяца в род. падеже по его номеру
    ^IF(М=1 :"января"  |
       М=2 :"февраля" |
       М=3 :"марта"   |
       М=4 :"апреля"  |
       М=5 :"мая"     |
       М=6 :"июня"    |
       М=7 :"июля"    |
       М=8 :"августа" |
       М=9 :"сентября"|
       М=10:"октября" |
       М=11:"ноября"  |
       М=12:"декабря","");
  end; -- Месяца --

  func Месяц (М :Integer) :String;
    -- Название месяца в имен. падеже по его номеру
    ^IF(М=1 :"ЯНВАРЬ"   |
       М=2 :"ФЕВРАЛЬ"  |
       М=3 :"МАРТ"     |
       М=4 :"АПРЕЛЬ"   |
       М=5 :"МАЙ"      |
       М=6 :"ИЮНЬ"     |
       М=7 :"ИЮЛЬ"     |
       М=8 :"АВГУСТ"   |
       М=9 :"СЕНТЯБРЬ" |
       М=10:"ОКТЯБРЬ"  |
       М=11:"НОЯБРЬ"   |
       М=12:"ДЕКАБРЬ","");
  end; -- Месяц --

  func Месцел (М :String) :Integer;
    -- Возвращает порядковый номер месяца по имени или двуцифровому номеру
    IF СООТВ(М,"*январ*")  или М="01" или М="1":^1;|
      СООТВ(М,"*ФЕВРАЛ*")  или М="02" или М="2":^2;|
      СООТВ(М,"*МАРТ*")    или М="03" или М="3":^3;|
      СООТВ(М,"*АПРЕЛ*")   или М="04" или М="4":^4;|
      СООТВ(М,"*МАЯ*") или  СООТВ(М,"*МАЙ*") или М="05" или М="5":^5;|
      СООТВ(М,"*ИЮН*")     или М="06" или М="6":^6;|
      СООТВ(М,"*ИЮЛ*")     или М="07" или М="7":^7;|
      СООТВ(М,"*АВГУСТ*")  или М="08" или М="8":^8;|
      СООТВ(М,"*СЕНТЯБР*") или М="09" или М="9":^9;|
      СООТВ(М,"*ОКТЯБР*")  или М="10"          :^10;|
      СООТВ(М,"*НОЯБР*")   или М="11"          :^11;|
      СООТВ(М,"*ДЕКАБР*")  или М="12"          :^12;|
      TRUE:   ^МЕС(Сегодня) ;
    FI;
  end; -- Месцел --


  func ПослДн (М :Integer; Г :Integer) :Date;
    If М < 12 :
      ^ДАТ(ДЕНЬ(ДАТ(1,М+1,Г)-1),М,Г);
    | М = 12 :
      ^ДАТ(31,12,Г);
    | True :
      ^1.1.100;
    Fi;
  end; -- ПослДн --


--  func ДеньНедели (М :Date) :Integer;
--  var РазДней,Част :Integer;
--    РазДней=М-01.01.96;
--    Част=ЦЕЛ(ОТБР(РазДней/7));
--    ^ЕСЛИ((РазДней-Част*7+1)>0,(РазДней-Част*7+1),8+(РазДней-Част*7));     --ДеньНедели
--  end; -- ДеньНедели --

--  func ДеньНедели (М :Date) :Integer;
--    -- Возвращает число от 1 (Понедельник) до 7 (Воскресенье).
--  var РазДней,Част :Integer;
--    РазДней=М-01.01.1900;
--    Част=ЦЕЛ(ОТБР(РазДней/7));
--    ^(РазДней-Част*7+1);
--  end; -- ДеньНедели --


  func ДеньНедСло (М :Date) :String;
  var  НДня:Integer;
    НДня=ДеньНедели(М);
    ЕСЛИ   НДня=1 : ^ "понедельник";       |
      НДня=2 : ^ "вторник";           |
      НДня=3 : ^ "среда";             |
      НДня=4 : ^ "четверг";           |
      НДня=5 : ^ "пятница";           |
      НДня=6 : ^ "суббота";            |
      НДня=7 : ^ "воскресенье";
    ИЛСЕ;
  end; -- ДеньНедСло --

  func ПоправкаПраздника (М :Date) :Date;
  var  НДня :Integer;
    НДня=ДеньНедели(М);
    ЕСЛИ   НДня < 6 : ^ М;  |
      НДня = 6 : ^ М+2;|
      НДня = 7 : ^ М+1;
    ИЛСЕ;
  end; -- ПоправкаПраздника --

  func Праздники (Г :Integer; n :Integer) :Date;      -- не изменена,т.к. в др.бланках не используется
    ЕСЛИ n=1  : ^ ПоправкаПраздника(ДАТ( 1, 1,Г)); |
      n=2  : ^ If(ПоправкаПраздника(ДАТ( 2, 1,Г))<>ПоправкаПраздника(ДАТ( 1, 1,Г)),
                  ПоправкаПраздника(ДАТ( 2, 1,Г)),ПоправкаПраздника(ДАТ( 2, 1,Г))+1); |
      n=3  : ^ ПоправкаПраздника(ДАТ( 7, 1,Г)); |
      n=4  : ^ ПоправкаПраздника(ДАТ( 8, 3,Г)); |
      n=5  : ^ ПоправкаПраздника(ДАТ( 1, 5,Г)); |
      n=6  : ^ If(ПоправкаПраздника(ДАТ( 2, 5,Г))<>ПоправкаПраздника(ДАТ( 1, 5,Г)),
                  ПоправкаПраздника(ДАТ( 2, 5,Г)),ПоправкаПраздника(ДАТ( 2, 5,Г))+1); |
      n=7  : ^ ПоправкаПраздника(ДАТ( 9, 5,Г)); |
      n=8  : ^ ПоправкаПраздника(ДАТ(12, 6,Г)); |
      n=9  : ^ ПоправкаПраздника(ДАТ( 7,11,Г)); |
      n=10 : ^ ПоправкаПраздника(ДАТ(12,12,Г));
    ИЛСЕ;
    If Г>=2002: If n=11: ^ПоправкаПраздника(ДАТ(23,2,Г)); Fi; Fi;
  end; -- Праздники --

  func НеПраздник (n :Date) :Logical;  --Изменена Сущик А.С. 25.11.2004
  Var Iter,W,I :Integer;
   If N<1.1.2005:
     For Iter = 1.. 11 Do
       If n = Праздники(ГОД(n),Iter) :
         ^False;
       Fi;
     Od;
    ^True;
   | True:
      W=OpenWorkArea("ХарактеристикиДня","ДатаДня","ДатаДня="+DateToString(N));
      Try
       I=Records(W);
       If I>0:
          Iter=GetFieldI(W,I,"ТипДня");
       Fi;
      Finally
        CloseWorkArea(W);
      End;
      If Iter<>8:
        ^True;
      | True:
        ^False;
      Fi;
   Fi;
  end; -- НеПраздник --

  func Выходной (n :Date) :Logical;  --Изменена Сущик А.С. 25.11.2004
   Var I,Iter,W:I;
    If N<1.1.2005:
      If (ДеньНедели(n)=6) or (ДеньНедели(n)=7) :    --из массива по весу или из массива переносов
        ^True;
      Fi;
      ^False;
    | True:
      W=OpenWorkArea("ХарактеристикиДня","ДатаДня","ДатаДня="+DateToString(N));
      Try
       I=Records(W);
       If I>0:
          Iter=GetFieldI(W,I,"ТипДня");
       Fi;
      Finally
        CloseWorkArea(W);
      End;
      If Iter=2 Or Iter=4:
         ^True;
      Fi;
      ^False;
    Fi;
  end; -- Выходной --

  func ПослРабДн (М :Integer; Г :Integer) :Date;  --Изменена Сущик А.С. 25.11.2004
    Var Rez,DTn :date;
    Var n,W:I;
    Rez = ПослДн (М, Г);
    If Г<2005:
       While Выходной (Rez) or not НеПраздник (Rez) do    --остается
         Rez = Rez - 1;
       od;
    | True:
      Dtn=Dat(1,М,Г);
      W=OpenWorkArea("ХарактеристикиДня","ДатаДня","(ДатаДня>"+DateToString(Dtn)+")And(ДатаДня<="+DateToString(Rez)+")");
      Try
       N=Records(W);
       If GetFieldI(W,N,"ТипДня")>1:
         N=N-1;
         While N>0 Do
           If GetFieldI(W,N,"ТипДня")<2:
              Rez=GetFieldD(W,N,"ДатаДня");
              Break;
           Fi;
         Od;
       Fi;
      Finally
        CloseWorkArea(W);
      End;
    Fi;
    Return Rez;
  end; -- ПослДн --

-- 09.01.2004 Сенков И. В.
-- Новый вариант фун СледРабочийДень
-- Внесены правки с учетом работы рекурсии в 6.9
-- До ввода временной переменной рекурсивный вызов СледРабочийДень(DTmp) в итого всегда возвращал 01.01.100

  СледРабочийДеньTmp: Date;

  func СледРабочийДень (n :Date) :Date;
   Var DTmp:Date;
    DTmp = n + 1;
      If НеПраздник(DTmp) And ДеньНедели(DTmp) < 6 : --и нет в массиве переносов
         СледРабочийДеньTmp = DTmp;
      | True :
         СледРабочийДень(DTmp);
         DTmp = СледРабочийДеньTmp;
      Fi;
     ^DTmp;
   Cnuf;

  func СледРабочийДень2005 (n :Date) :Date; --Создана Сущик А.С. 25.11.2004
   Var DTmp:Date;                       --т.к.нигде не использ. можно ввести новую
   Var W,NN:I;                        -- а в итомрабочемдне в зависимости от года
      DTmp = n + 1;                       -- вызывать одну или другую!
      W=OpenWorkArea("ХарактеристикиДня","ДатаДня","(ДатаДня>="+DateToString(DTmp)+")And(ТипДня<2)");
      Try
       NN=Records(W);
       If NN>0:
      -- If GetFieldI(W,1,"ТипДня")>1:
       --  For I=2..NN Do
       --    If GetFieldI(W,I,"ТипДня")<2:
              DTmp=GetFieldD(W,1,"ДатаДня");
       --       Break;
       --    Fi;
       --  Od;
       Fi;
      Finally
        CloseWorkArea(W);
      End;
     ^DTmp;
  Cnuf; -- СледРабочийДень --

-- Сенков И. В.
-- вариант до правки от 09.01.2004
--  func СледРабочийДень (n :Date) :Date;
--  Var DTmp:Date;
--    DTmp = n + 1;
--    If НеПраздник(DTmp) And ДеньНедели(DTmp) < 6 :
--       ^DTmp;
--    | True :
--       СледРабочийДень(DTmp);
--    Fi;
--  end; -- СледРабочийДень --

  func ИтыйРабочийДень (n: Date; It :Integer) :Date;   --Изменена Сущик А.С. 27.11.2004
   -- Возвращает дату соотв-ую It-му рабочему дню
  Var DTmp:Date;
  Var Iter,W,NN:Integer;
    DTmp = n;
    If N+It<1.1.2005:
       For Iter = 1..It Do
         DTmp = СледРабочийДень(DTmp);
       Od;
    |  N+It<=10.1.2005:
       DTmp=11.1.2005;
    |  True:

     --  For Iter = 1..It Do
     --    DTmp = СледРабочийДень2005(DTmp);
     --  Od;
      W=OpenWorkArea("ХарактеристикиДня","ДатаДня","(ДатаДня>"+DateToString(DTmp)+")And(ТипДня<2)");
      Try
       NN=Records(W);
       If NN>It:NN=It;Fi;
       If NN>0:
          DTmp=GetFieldD(W,NN,"ДатаДня");
       Fi;
      Finally
        CloseWorkArea(W);
      End;

    Fi;
    ^DTmp;
  end; -- ИтыйРабочийДень --

    func ПоправкаКонцаМес (Д:Integer;  М :Integer; Г :Integer) :Date;
    If Д > День(ПослДн (М,Г)) :
      return ПослДн (М,Г);
    | True :
      return ДАТ(Д,М,Г);
    Fi;
  end; -- ПослДн --

  func СледМес(Д:ДАТА):DATE;
    if Мес(Д) < 12:   Return ПоправкаКонцаМес(День(Д), Мес(Д)+1, Год(Д));
    |  Мес(Д) > 11:   Return ПоправкаКонцаМес(День(Д), 1, Год(Д)+1);
    fi;
  end; -- СледМес


  func СледКварт(Д:ДАТА):DATE;
    If Мес(Д) < 10: Return ПоправкаКонцаМес(День(Д), Мес(Д)+3, Год(Д));
    |  Мес(Д) > 9:  Return ПоправкаКонцаМес(День(Д), Мес(Д)-9, Год(Д)+1);
    fi;
  end; -- СледКварт


  func СледГод(Д:ДАТА):DATE;
    Return ПоправкаКонцаМес(День(Д), Мес(Д), Год(Д)+1);
  end; -- СледГод


  func ПредМес(Д:ДАТА):DATE;
    if Мес(Д) > 1:   Return ПоправкаКонцаМес(День(Д), Мес(Д)-1, Год(Д));
    |  Мес(Д) < 2:   Return ПоправкаКонцаМес(День(Д), 12, Год(Д)-1);
    fi;
  end; -- ПредМес


  func ПредКварт(Д:ДАТА):DATE;
    if Мес(Д) < 4:  Return ПоправкаКонцаМес(День(Д), 9+Мес(Д), Год(Д)-1);
    |  Мес(Д) > 3:  Return ПоправкаКонцаМес(День(Д), Мес(Д)-3, Год(Д));
    fi;
  end; -- ПредКварт


  func ПредГод(Д:ДАТА):DATE;
    Return ПоправкаКонцаМес(День(Д), Мес(Д), Год(Д)-1);
  end; -- ПредГод

  Func ПразднДней (Дн :Date; Дк :Date; Г:Integer;Н :Logical) :Integer; ----Создана Сущик А.С. 25.11.2004
  var i,j,День,Праз,Раз :Integer;
  var Д,ДеньПраз                  :Date;
         Раз=Дк-Дн;
         Праз=0;
         ДЛЯ j=1..11 ЦИКЛ    -- Определяем, является ли текущий день праздником
           Д=Дн;
           ДеньПраз=Праздники(Г,j);
           ЕСЛИ  Дн<=ДеньПраз И ДеньПраз<=Дк :
             Д=Дн;
             ДЛЯ i=1..Раз ЦИКЛ
               ЕСЛИ Д=ДеньПраз  :
                 Праз=Праз+1;
                 День=ДеньНедели(Д);  -- определили, каким денем недели является текущая дата
                 ЕСЛИ НЕ Н И Д=ДеньПраз И День=7 : --
                   Праз=Праз+1;
                 ИЛСЕ;
               ИЛСЕ;
               Д=Д+1;
             ЛКИЦ;
           ИЛСЕ;
         ЛКИЦ;
        ^Праз;
  Cnuf;

  Func  ОпределениеВыходных(Дн:Date; Дк :Date; Н :Logical) :Integer; ----Создана Сущик А.С. 25.11.2004
  var i,День,Праз,Раз :Integer;
  var Д                  :Date;
    Раз=Дк-Дн;
    Праз=0;
    Д=Дн;
    ДЛЯ i=1..Раз ЦИКЛ
      День=ДеньНедели(Д);  -- определили, каким денем недели является текущая дата
      ЕСЛИ День=7 : Праз=Праз+1;       -- и не праздник или не праздник и не равен 7,
                                       --но из файла с весом 4(воскр)
      ИЛСЕ;
      ЕСЛИ Н :
        ЕСЛИ День=6 : Праз=Праз+1;-- и не праздник или не праздник и не равен 6,
                                  --но из файла с весом 2(суб)
        ИЛСЕ;
      ИЛСЕ;
    Д=Д+1;
    ЛКИЦ;
   ^Праз;
  Cnuf;

  Func ОпрВыходных_Праздничных(Дн:Date; Дк :Date; Н :Logical) :Integer; ----Создана Сущик А.С. 26.11.2004
  Var W,Праз:I;
  Var Фильтр:S;
     Праз=0;                                                                            --<=
     Фильтр="(ТипДня>"+If(Н,str(1),Str(3))+")And(ДатаДня>="+DateToString(Дн)+")And(ДатаДня<"+DateToString(Дк)+")";
     W=OpenWorkArea("ХарактеристикиДня","ДатаДня",Фильтр);
     Try
       Праз=Records(W);
     Finally
       CloseWorkArea(W);
     End;
    ^Праз;
  Cnuf;

  func РабочихДней (Дн :Date; Дк :Date; Н :Logical) :Integer; ----Изменена Сущик А.С. 26.11.2004
  var Праз,Раз,Г1,Г2 :Integer;
 -- var ДеньПраз                  :Date;
    Раз=Дк-Дн;
    ЕСЛИ Раз>0 :
     Г1=ГОД(Дн);
     Г2=ГОД(Дк);
     Праз=0;
     If Г1>=2005:--Г2 тем более больше!!
        Праз=ОпрВыходных_Праздничных(Дн, Дк, Н);
     | True:
       If Г1=Г2 :
         If Г1<2005:
            Праз=ПразднДней (Дн,Дк,Г1,Н);
            Праз=Праз+ОпределениеВыходных(Дн,Дк,Н);

         | True:
     ------------------
           Праз=ОпрВыходных_Праздничных(Дн, Дк, Н);
         Fi;

       | Г1<>Г2 :
         If Г1<2005:
            Праз=ПразднДней (Дн,Dat(31,12,Г1),Г1,Н);
            Праз=Праз+ОпределениеВыходных(Дн,Dat(31,12,Г1),Н);
         | True:
       -------------------
           Праз=ОпрВыходных_Праздничных(Дн, Dat(31,12,Г1), Н);

         Fi;
         If Г2<2005:
            Праз=Праз+ПразднДней (Dat(1,1,Г2),Дк,Г2,Н);
            Праз=Праз+ОпределениеВыходных(Dat(1,1,Г2),Дк,Н);
         | True:
       -------------------
           Праз=Праз+ОпрВыходных_Праздничных(Dat(1,1,Г2), Дк, Н);

         Fi;
       Fi;
     Fi;--ИЛСЕ;
    ^ Раз-Праз;
    ИЛСЕ;
    ^0;
  end; -- РабочихДней --

  Func КалендарныхДней(Дн :Date; Дк :Date):Integer; --Добавлена Сущик А.С. 12.01.2007
  --Дн дата начала периода                          -- изменена 10.05.2007
  --Дк дата конца периода
   Var W,N:Integer;
   Var Фильтр:S;
     If  Year(Дн)<2007:
       Фильтр="(ТипДня<"+Str(7)+")And(ДатаДня>="+DateToString(Дн)+")And(ДатаДня<="+DateToString(Дк)+")";
     | True:
       Фильтр="(ДатаДня>="+DateToString(Дн)+")And(ДатаДня<="+DateToString(Дк)+")";
     Fi;
     W=OpenWorkArea("ХарактеристикиДня","ДатаДня",Фильтр);
     Try
       N=Records(W);
     Finally
       CloseWorkArea(W);
     End;
   ^N;
  Cnuf;

  func РабочихДнейМес (М :Integer; Г :Integer; Н :Logical) :Integer;    --Изменена Сущик А.С. 26.11.2004
  -- На входе М-номер месяца, Г-номер года, Н-шестидневка
  var Дн,Дк :Date;
  Var Фильтр:S;
  Var РабДн,W:I;
    ЕСЛИ М=12 :
      Дн=ДАТ( 1,12,Г);
      Дк=ДАТ( 1, 1,Г+1);
    ИНАЧЕ
      Дн=ДАТ( 1,М,Г);
      Дк=ДАТ( 1,М+1,Г);
    ИЛСЕ;
    If Г<2005:
    ^   РабочихДней(Дн,Дк,Н);
    | True:
     РабДн=0;
     Фильтр="(ТипДня<"+If(Н,str(2),Str(3))+")And(ДатаДня>="+DateToString(Дн)+")And(ДатаДня<"+DateToString(Дк)+")";
     W=OpenWorkArea("ХарактеристикиДня","ДатаДня",Фильтр);
     Try
       РабДн=Records(W);
     Finally
       CloseWorkArea(W);
     End;
     ^РабДн;
    Fi;
  end; -- РабочихДнейМес --

    --- еще нужно предпразднич.рабочий    и еще все от года либо по старому либо по новому!
  Func ПредпразднДнейМес(М :Integer; Г :Integer) :Integer;
  -- На входе М-номер месяца, Г-номер года
  var Дн,Дк :Date;
  Var Фильтр:S;
  Var РабДн,W:I;
    ЕСЛИ М=12 :
      Дн=ДАТ( 1,12,Г);
      Дк=ДАТ( 1, 1,Г+1);
    ИНАЧЕ
      Дн=ДАТ( 1,М,Г);
      Дк=ДАТ( 1,М+1,Г);
    ИЛСЕ;
      РабДн=0;
      If Г>2004:

        Фильтр="(ТипДня=1)And(ДатаДня>="+DateToString(Дн)+")And(ДатаДня<"+DateToString(Дк)+")";
        W=OpenWorkArea("ХарактеристикиДня","ДатаДня",Фильтр);
        Try
          РабДн=Records(W);
        Finally
          CloseWorkArea(W);
        End;
      Fi;
     ^РабДн;

  Cnuf;

  Func ПредпразднДней(Дн :Date; Дк :Date) :Integer;
  -- На входе Дн-начальная дата, Дк-конечная дата
  -- Функция работает для дат не раннее 1.1.2005г, в противном случае возвращает 0
  Var Фильтр:S;
  Var РабДн,W:I;
      РабДн=0;
      If Дн>=1.1.2005:

        Фильтр="(ТипДня=1)And(ДатаДня>="+DateToString(Дн)+")And(ДатаДня<="+DateToString(Дк)+")";
        W=OpenWorkArea("ХарактеристикиДня","ДатаДня",Фильтр);
        Try
          РабДн=Records(W);
        Finally
          CloseWorkArea(W);
        End;
      Fi;
     ^РабДн;
  Cnuf;

  Proc КоррекцияВыходных(Г:I);   ----Создана Сущик А.С. 25.11.2004
     Var W,n,i,Ii,j,Вес,Вес1:I;
     Var Датн,Датк:Date;
         Датн=Dat(1,1,Г);Датк=Dat(1,1,Г+1);
         W=OpenWorkArea("ХарактеристикиДня","ДатаДня","(ДатаДня>="+DateToString(Датн)+")And(ДатаДня<"+DateToString(ДатК)+")");
         Try
           N=Records(W);
           BeginChanging(w);
           Try
             For i=1..N-1 Do
               Вес=GetFieldI(W,i,"ТипДня");
               If Вес>8:
                  II=PutFieldI(W,i,"ТипДня",8);
                  For J=I+1..N Do
                    Вес1=GetFieldI(W,j,"ТипДня");
                    If Вес1=0:
                      II=PutFieldI(W,j,"ТипДня",Вес-8);
                      Break;
                    Fi;
                  Od;
               Fi;
             Od;
             For i=2..N-1 Do
               Вес=GetFieldI(W,i,"ТипДня");
               If Вес=8:
                  Вес1=GetFieldI(W,I-1,"ТипДня");
                  If Вес1=0:
                    II=PutFieldI(W,I-1,"ТипДня",1);
                  Fi;
               Fi;
             Od;
             If GetFieldI(W,N,"ТипДня")=0:II=PutFieldI(W,N,"ТипДня",1); Fi;
           EndChanging(w);
           Except
             CancelChanging(w);
           Raise;
           End;
         Finally
           CloseWorkArea(W);
         End;

  Corp;

  Proc ЗаполнитьХарактеристикиДней(Ob:S);  ----Создана Сущик А.С. 25.11.2004
     Var Г,W,n,i,ДеньН,Вес,NM,ND:I;
     Var Датн,Датк,Дт:Date;
     Var Fl:L;
     N=Input(Г,"Введите год");
     If N<>кмдВерно:Exit;
     | True:
       If Г<1917 Or Г>2300:
         Message("Год не верный!"); Exit;
       | True:
       ------------------
         Датн=Dat(1,1,Г);Датк=Dat(1,1,Г+1); Fl=True;
         W=OpenWorkArea("ХарактеристикиДня","ДатаДня","(ДатаДня>="+DateToString(Датн)+")And(ДатаДня<"+DateToString(ДатК)+")");
         Try
           N=Records(W);
           BeginChanging(w);
           Try
             If N>0:
                While N>0 Do
                  DeleteRecord(W,N);
                  N=N-1;
                Od;
             Fi;
             Дт=Датн;
             While Дт<Датк Do
               I=InsertRecord(W);
               I=PutFieldD(W,I,"ДатаДня",Дт);
               ДеньН=ДеньНедели(Дт);
               I=PutFieldI(W,I,"ДеньНедели",ДеньН);
               If ДеньН=6:Вес=2;
               |  ДеньН=7:Вес=4;
               | True:    Вес=0; Fi;
               Nm=Mon(Дт); ND=Day(Дт);
               If Г>2004:
                 If (NM=1 And ((ND>=1 And Nd<6) Or Nd=7))Or(NM=2 And ND=23)Or(NM=3 And ND=8)
                    Or(NM=5 And(ND=1 Or ND=9))Or(NM=6 And ND=12)Or(NM=11 And Nd=4): Вес=Вес+8;Fi;
               | True:
                 If (NM=1 And(ND=1 Or Nd=2 Or Nd=7))Or(Г>2001 And NM=2 And Nd=23)Or
                    (NM=3 And ND=8)Or(NM=5 And(ND=1 Or ND=2 Or ND=9))Or(NM=6 And ND=12)
                    Or(NM=11 And ND=7)Or(NM=12 And ND=12):Вес=Вес+8;Fi;
               Fi;
             --сюда старые праздники!
               I=PutFieldI(W,I,"ТипДня",Вес);
               Дт=Дт+1;
             Od;
           EndChanging(w);
           Except
             CancelChanging(w);
             Fl=False;
           Raise;
           End;
         Finally
           CloseWorkArea(W);
         End;
         If Fl:
           КоррекцияВыходных(Г);
         Fi;
       Fi;
     Fi;
  Corp;
--*********** прочие функции *******************************************

  func PtrStr (r :Record; len :Integer) :String;
    -- Указатель на запись в виде строки с ведущими нулями
  var s :String;
    s = RecordToString(r);
    s = SubStr(s, 2, Length(s)-2);
    while (Length(s)<len) do      s = '0'+s;      od;
    ^ s;
  end; -- PtrStr --


  func MainGroup(ww :String) :String2;
    -- Возвращает имя главной группы для признаков,
    -- для справочников возвращает пустую строку
    If Поз(".",ww) > 1 :
         ^Подстр(ww,1,Поз(".",ww)-1);
    | True :
         ^"";
    Fi;
  end; -- MainGroup --

Конец