{ exchange #3036
  оптимизация запросов зачислений.

    для зачислений, по доработкам exchange #2425 по каждой зачисляемой
  записи выполнялись запросы. для ускорения можно выполнить один групповой
  запрос, что и реализовано.
    суть доработки:

  1) по списку эд для зачислений выполняется группировака id по бюджетам.
     в результате формируется список объектов TStringList. по каждому
     объекту хранится список id для одного бюджета.
     это дает то, что при зачислении вместо каждого запроса на каждую запись
     будет только один запрос, и проверка, подходит ли эд по #2425
     будет выполняться поиском ID в списоке строк.

  1) exchange #2425 возвращает:
    =true если: есть в БД Приложении к выписке кредитовом (статус=выгружен)
     "Счет" блока "Получатель" равен одному из счетов, указанных в настройке
      "Бухгалтерия/Настройка счетов/Счета ФО/Счета бюджета"
      с типом "Счет для учета операций БУ/АУ", а "Счет" блока "Плательщик"
      равен "Единому счету бюджета" карточки бюджета и в
      "Основании" 24 класса указано слово "подкреплен" без учета регистра,
      без пробелов в середине.
    =FALSE - в любом другом случае.}
{------------------------------------------------------------------------------}
const
  cnSQL_In_Count = 3;

var
  // список ид. бюджетов
  vMBEnrolmentBudget: TStringList;

  // все строки синхронизированы со списком vMBEnrolmentBudget.
  // для каждого пункта:
  //   строка - подстрока запроса в SQL
  //   объект - TStringList список ID эд для одного бюджета.
  vMBEnrolmentID: TStringList;

  vMBEnrolmentID_ED24: TStringList;
  vMBEnrolmentID_ED203: TStringList;

  // exchange #3053
  vCfg_KES_HBC: string;


{------------------------------------------------------------------------------}
{~DoSearch_ED203_by_ED24
  если есть ассоциация эд24 (aID24) - эд203, то возвращаем ид. документа 203го
  связанного с ЭД 24м (aID24)}
function DoSearch_ED203_by_ED24( aID24: string): string;
var
  xIndex: integer;
begin
    try
      xIndex := vMBEnrolmentID_ED24.IndexOf( aID24);
      if (xIndex = -1)
        then Result := ''
        else Result := vMBEnrolmentID_ED203.Strings[ xIndex];
      except
        ExceptionProc( 'DoSearch_ED203_by_ED24');
    end;
end;
{------------------------------------------------------------------------------}
{~DoClearEnrolments
  сброс переменных для зачислений. }
procedure DoClearEnrolments;
var
  i: integer;
  xSL: TStringList;
begin
    try
      // чистим XML
      vXML_Doc.LoadXml( '');//
      // чистим список бюджетов
      vMBEnrolmentBudget.Clear;
      // чистим ассоциативный список ЭД 24х и 203х
      vMBEnrolmentID_ED24.Clear;
      vMBEnrolmentID_ED203.Clear;
      // чистим список ссылок на зачисляемые ЭД
      for i := 0 to vMBEnrolmentID.Count - 1 do begin
        xSL := TStringList( vMBEnrolmentID.Objects( i));
        xSL.Free;
      end;//for//
      vMBEnrolmentID.Clear;
      except
        ExceptionProc( 'DoClearEnrolments');
    end;
end;
{------------------------------------------------------------------------------}
{~DoMakeListEnrolments
  сформировать списки для оптимизации зачислений}
procedure DoMakeListEnrolments;
var
  i,j,n: integer;
  xIndex: integer;
  xSL: TStringList;
  xSL_BudgetID: string;
  xBudgetID: string;
  xID: string;
  s: string;
  xSQL: string;
  xXml_Doc: Variant;
  xXml: Variant;
  xXml_Node: Variant;
begin
    try
      DoClearEnrolments;

      // формируем группировку по бюджету
      xSL_BudgetID := '';
      cdsList.First;
      while NOT cdsList.EOF do begin
        xID := cdsList.FieldByName('ID').AsString;
        if (DBGrid.Bookmark.IndexOf( xID) <> -1) then begin
          xBudgetID := cdsList.FieldByName('BUDGET_ID').AsString;
          if (xBudgetID <> xSL_BudgetID) then begin
            // ищем бюджет в списке для зачисления
            xIndex := vMBEnrolmentID.IndexOf( xBudgetID);
            if (xIndex = -1) then begin
              // создаем новое описание бюджета
              xSL_BudgetID := xBudgetID;
              xSL := TStringList.Create;
              // добавление бюджета в список
              vMBEnrolmentBudget.Add( xBudgetID);
              // добавление строки запроса и списка ид. эд для бюджета
              vMBEnrolmentID.AddObject( '', xSL);
            end else begin
              xSL_BudgetID := xBudgetID;
              xSL := TStringList( vMBEnrolmentID.Objects( xIndex));
            end;
          end;
          xSL.Add( xID);
        end;
        cdsList.Next;
      end;//while//

      // формируем подзапросы по списку ID эд по каждому бюджету
      for i := 0 to vMBEnrolmentID.Count - 1 do begin
        xSL := TStringList( vMBEnrolmentID.Objects( i));
        xSQL := '';
        s := '';
        n := 0;
        for j := 0 to xSL.Count - 1 do begin
          if (LENGTH( s) > 0)
            then s := s + ',';
          s := s + '?';//xSL.Strings[ j];
          INC( n);
          if (n > cnSQL_In_Count) then begin
            if (LENGTH( xSQL) > 0)
              then xSQL := xSQL + ' OR ';
            xSQL := xSQL + 'P.ID in (' + s + ')';//'(' + s + ')';
            n := 0;
            s := '';
          end;
        end;//for//
        if (n > 0) then begin
          if (LENGTH( xSQL) > 0)
            then xSQL := xSQL + ' OR ';
          xSQL := xSQL + 'P.ID in (' + s + ')';//'(' + s + ')';
        end;
        vMBEnrolmentID.Strings[ i] :=
                                      '(P.BUDGET_ID=? and (' + xSQL + '))';
      end;//for//

      // если список эд 24х пустой, то не ищем эд 203е
      if (vMBEnrolmentID.Count <= 0) then EXIT;

      { exchange #2425
        список Приложений к выписке кредитовом (статус=выгружен)
       "Счет" блока "Получатель" равен одному из счетов, указанных в настройке
        "Бухгалтерия/Настройка счетов/Счета ФО/Счета бюджета"
        с типом "Счет для учета операций БУ/АУ", а "Счет" блока "Плательщик"
        равен "Единому счету бюджета" карточки бюджета и в
        "Основании" 24 класса указано слово "подкреплен" без учета регистра,
        без пробелов в середине.
        exchange #3036
        здесь все охватываем одним запросом.
        формируем строку выборки:
          ( (budget=? and (id in (...)...))
            or (budget=? and (id in (...)...))
            or (...) )
        а заодно и добавляем значения параметров к запросу Query.}
      xSQL := '';
      for i := 0 to vMBEnrolmentID.Count - 1 do begin
        xSL := TStringList( vMBEnrolmentID.Objects( i));
        // ид.бюджета
        Query.AddStr( vMBEnrolmentBudget.Strings[ i]);
        // список ид.эд для этого бюджета
        for j := 0 to xSL.Count - 1
          do Query.AddStr( xSL.Strings[ j]);
        // подзапрос
        if (LENGTH( xSQL) > 0)
          then xSQL := xSQL + ' OR ';
        xSQL := xSQL + '(' + vMBEnrolmentID.Strings[ i] + ')';
      end;

      // запрашиваем список ид.
      xXml_Doc := vXML_Doc;//CreateOleObject('Microsoft.XmlDom');
      xXml_Doc.LoadXML(
            Query.Run(  ' select P.ID from PAYORDER P '
                       +' left join BUDGET B on B.ID = P.BUDGET_ID '
                       +' where (' + xSQL + ') and '
                       +' P.REC_ACC_ID in (select BO.ORGACCOUNT_ID '
                       +' from BUDGETORGACCOUNT BO '
                       +' where BO.BUDGETORGACCOUNTTYPE_ID = 1)'
                       +' and P.dispstatus_id=9'
                       +' and P.PAY_ACC_ID = B.COMMON_ACC_ID'
                       +' and lower(P.DESCRIPTION) like '#39'%подкреплен%'#39));
      xXml := xXml_Doc.documentElement.childNodes;

      xSQL := '';
      xSL := TStringList.Create;
      try
        for i := 0 to xXml.Length - 1
          do xSL.Add( xXml.Item[ i].getAttribute('ID'));

      {Exch2425_SearchDoc203
  искать "Распоряжение на подкрепление" следующим образом:
  на статусе "Списано со счета", имеющее порожденное Платежное поручение (13 класс)
  на статусе "Обработка завершена", номер которого в последних разрядах включает
  все цифры номера, указанного в Номере Приложения к выписке кредитового,
  по порядку (вхождение справа, пример соотвтествия номера - номер ПП 711083,
  в Номере Приложения к выписке кредитового - номер 83 - аналогия поиска
  Exchange, #2385),"Дата списания" Распоряжения на подкрепление должна быть
  равна "Дате по банку" Приложения к выписке, "Сумма подкрепления/перечисления"
  равна "Сумме выписки" Приложения, "Направление платежа"="возврат из бюджета"
  возвращает:
    =true - найден единственный такой документ.
            в этом случае aID - идентификатор этого документа.
    =false - документ не найден или найдено несколько ЭД. в этом случае
            значение в параметре aID роли не играет.
     exchange #3036
     запрашиваем все эд одним запросом.
     результат - список пар: эд 24й и эд203}
        // формируем параметрический подзапрос по списку ID типа:
        // ((pkvk.ID in (?,?,...)) or (pkvk.ID in (...))
        s := '';
        n := 0;
        for j := 0 to xSL.Count - 1 do begin
          // ид.эд 24го
          Query.AddStr( xSL.Strings[ j]);
          // список ид.
          if (LENGTH( s) > 0)
            then s := s + ',';
          s := s + '?';
          INC( n);
          if (n > cnSQL_In_Count) then begin
            if (LENGTH( xSQL) > 0)
              then xSQL := xSQL + ' OR ';
            xSQL := xSQL + 'pkvk.ID in (' + s + ')';
            n := 0;
            s := '';
          end;
        end;//for//
        if (n > 0) then begin
          if (LENGTH( xSQL) > 0)
            then xSQL := xSQL + ' OR ';
          xSQL := xSQL + 'pkvk.ID in (' + s + ')';
        end;
        finally
          xSL.Free;
      end;
      // на всякий случай проверяем - были проблемы !
      if (LENGTH( xSQL) <= 0) then EXIT;


      // запрос и формируем результат ассоциации: эд24 - эд203
      xXml_Doc.LoadXML(
          Query.Run(
 ' select o.id ID203, pkvk.ID ID24'
+' from reststransferorder o'
+' join document d on d.id= o.document_id'
+' join document dpp on dpp.parent_id= d.id and dpp.documentclass_id=13'
+' and dpp.dispstatus_id=10'
+' join payorder po on po.document_id=dpp.id'
+' join payorder pkvk on ' + xSQL
+' where d.dispstatus_id=87'
+' and o.debit_date=pkvk.CARRY_DATE'
+' and o.AMOUNT=pkvk.ABS_AMOUNT'
+' and o.DIRECTION=1'
+' and trim(po.doc_number) like '#39'%'#39' || trim(pkvk.doc_number)'));
      xXml := xXml_Doc.documentElement.childNodes;
      for i := 0 to xXml.Length - 1 do begin
        xXml_Node := xXml.Item[ i];
        vMBEnrolmentID_ED24.Add( xXml_Node.GetAttribute( 'ID24'));
        vMBEnrolmentID_ED203.Add( xXml_Node.GetAttribute( 'ID203'));
      end;//for//
      except
        ExceptionProc( 'DoMakeListEnrolments');
    end;
end;

{------------------------------------------------------------------------------}
{~InitializeEnrolment
  инициализация модуля зачислений}
procedure InitializeEnrolment;
begin
    try
      vMBEnrolmentBudget    := TStringList.Create;
      vMBEnrolmentID        := TStringList.Create;
      vMBEnrolmentID_ED24   := TStringList.Create;
      vMBEnrolmentID_ED203  := TStringList.Create;
      except
        ExceptionProc( 'InitializeEnrolment');
    end;
end;
{------------------------------------------------------------------------------}
{~FinalizeEnrolment
  завершение модуля зачислений}
procedure FinalizeEnrolment;
begin
    try
      // при завершении, если сбой был еще до инициализации списков
      // то чистка списков не выполняется. чистка выполняется, если все
      // нужные объекты созданы.
      if (vMBEnrolmentID <> NIL) then
        if (vMBEnrolmentBudget <> NIL)
          then DoClearEnrolments;

      if (vMBEnrolmentID <> NIL)
        then vMBEnrolmentID.Free;

      if (vMBEnrolmentBudget <> NIL)
        then vMBEnrolmentBudget.Free;

      if (vMBEnrolmentID_ED24 <> NIL)
        then vMBEnrolmentID_ED24.Free;

      if (vMBEnrolmentID_ED203 <> NIL)
        then vMBEnrolmentID_ED203.Free;
      except
        ExceptionProc( 'FinalizeEnrolment');
    end;
end;
{------------------------------------------------------------------------------}
begin
end.
