Просмотр исходного текста страницы Урезание (свертка базы) на определенную дату

==Добавить ТМС(скрипт) в Менеджер==
'''Сервис - Подпрограммы - Общие - Создать "Урезать(свернуть) базу на определенную дату"''' (тест скрипта ниже)
<pre>
program GroupProgram;
var s: string;
    sl: TStringList;
    trn,query: cardinal;
    trn1,query1: cardinal;
    mb_res:integer;
begin
  sl:=TStringList.Create;
  s:='[CUT_DATE]'#13#10+
  'type=date'#13#10+
  'caption=Дата '#13#10+
  'default=STARTOFMONTH';
  sl.text:=s;
  if GetCustomParams(sl,'заполните значения') then
  begin      
  end
  else
   begin
    showmessage('Действие отменено пользователем');
    exit;
   end; 
  
  mb_res:=application.messagebox(PChar('Внимание! Перед этой операцией рекомендуется сделать РЕЗЕРВНУЮ КОПИЮ базы и НЕ работать с ней. Продолжить?'),'',$00000004+$00000020);
  if mb_res<>6 then 
  begin
    showmessage('Действие отменено пользователем');
    exit;
  end;  
  
  mb_res:=application.messagebox(PChar('Все документы до '+sl.values['CUT_DATE']+' будут удалены. Продолжить?'),'',$00000004+$00000020);
  if mb_res<>6 then 
  begin
    showmessage('Действие отменено пользователем');
    exit;
  end;
  
  mb_res:=application.messagebox(PChar('В зависимости от размера базы чистка займет некоторое время. Продолжить?'),'',$00000004+$00000020);
  if mb_res<>6 then 
  begin
    showmessage('Действие отменено пользователем');
    exit;
  end;
  m_manager.logit('1 из 7 Начало...');    

  trn:=CREATEIBTRANSACTION;    
  STARTIBTRANSACTION(trn,1);  

  trn1:=CREATEIBTRANSACTION;    
  STARTIBTRANSACTION(trn1,1);
                         
  try
   m_manager.logit('2 из 7 Для ускорения отключаем триггеры');  
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_BI_MNN inactive;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AI0 inactive;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AIUD1 inactive;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AU0 inactive;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AD0 inactive;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_AI0 inactive;',1);            
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_AD0 inactive;',1);
   query1:=ExecIBQuery(trn1,'alter trigger PARTS_BU0 inactive;',1);
   EndIBTransaction(trn1,1);
   FREEIBQUERY(query1);        
   FREEIBTRANSACTION(trn1);
    
   trn1:=CREATEIBTRANSACTION;    
   STARTIBTRANSACTION(trn1,1);
   
   m_manager.logit('3 из 7 Чистим базу...');
   query1:=ExecIBQuery(trn1,'execute procedure PR_CUTTER_DOCS('''+sl.values['CUT_DATE']+''');',1);
   EndIBTransaction(trn1,1);   
   FREEIBQUERY(query1);        
   FREEIBTRANSACTION(trn1);
    
   trn1:=CREATEIBTRANSACTION;    
   STARTIBTRANSACTION(trn1,1);
   
   m_manager.logit('4 из 7 Включаем триггеры');
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_BI_MNN active;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AI0 active;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AIUD1 active;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AU0 active;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_ACTIVE_AD0 active;',1);
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_AI0 active;',1);            
   query1:=ExecIBQuery(trn1,'alter trigger DOC_DETAIL_AD0 active;',1);
   query1:=ExecIBQuery(trn1,'alter trigger PARTS_BU0 active;',1);
   EndIBTransaction(trn1,1);   
   FREEIBQUERY(query1);        
   FREEIBTRANSACTION(trn1); 
   trn1:=CREATEIBTRANSACTION;    
   STARTIBTRANSACTION(trn1,1);

   m_manager.logit('5 из 7 Пересобираем остатки');      
   query1:=ExecIBQuery(trn1,'execute procedure DBGPR_MAKEWAREBASEFROMDOCS(0)',1);
   EndIBTransaction(trn1,1);   
   FREEIBQUERY(query1);        
   FREEIBTRANSACTION(trn1);
   trn1:=CREATEIBTRANSACTION;    
   STARTIBTRANSACTION(trn1,1);
   
   m_manager.logit('6 из 7 Очищаем нулевые позиции');      
   query1:=ExecIBQuery(trn1,'execute procedure DBGPR_CLEANWAREBASE',1);
   EndIBTransaction(trn1,1);
   FREEIBQUERY(query1);        
   FREEIBTRANSACTION(trn1);
         
  except
   showmessage('err'); 
   EndIBTransaction(trn,0);
   exit;
  end;    

  m_manager.logit('7 из 7 Операция успешно выполнена!');  
  showmessage('Операция успешно выполнена. Перезапустите программу Менеджер и проверьте остатки!');

end.
</pre>

==Выполнить скрипт==
'''Несуществующие таблицы, поля, триггеры можно из скрипта исключить'''

<pre>
SET TERM ^ ;

create or alter procedure PR_CUTTER_DOCS (
    CUT_DATE DM_DATE)
as
declare variable PART_ID DM_ID;
declare variable SUM_QUANT DM_DOUBLE;
declare variable DOC_ID DM_ID;
declare variable PRICE DM_DOUBLE;
declare variable NAC DM_DOUBLE;
declare variable WARE_ID DM_UUID;
declare variable PRICE_O DM_DOUBLE;
declare variable NDS DM_DOUBLE;
declare variable DEP DM_ID;
declare variable PART_TYPE DM_ID;
declare variable BASE_AGENT_ID DM_ID;
declare variable VERB DM_TEXT1024;
declare variable DOC_ID_DEL DM_ID;
begin

  /* Процедура удаления документов до определенной даты, с сохранением остатков */

  select PR.DOC_ID from PR_NEWDOC(20, 0, 0, 1, :CUT_DATE||' 00:00:00', 0) PR into DOC_ID;
  update docs d set docdate = :CUT_DATE||' 00:00:00', d.commitdate = :CUT_DATE||' 00:00:00' where id = :DOC_ID;

  --Определяем не нулевые партии на указанную дату, всех их оприходуем отдельным документом
  for select sum(QUANT), PART_ID
      from DOC_DETAIL DD
      left join DOCS D on D.ID = DD.DOC_ID
      where D.STATUS = 1 and
            DD.DOC_COMMITDATE < :CUT_DATE
      group by PART_ID
      having abs(sum(QUANT)) > 0
      into SUM_QUANT, :PART_ID
  do
  begin

    select PRICE, NAC, WARE_ID, PRICE_O, NDS, DEP, PART_TYPE, BASE_AGENT_ID from PARTS P
      where P.ID = :PART_ID
    into :PRICE, :NAC, :WARE_ID, :PRICE_O, :NDS, :DEP, :PART_TYPE, :BASE_AGENT_ID;

    insert into DOC_DETAIL_ACTIVE (DOC_ID, PART_ID, QUANT, PRICE, NAC, WARE_ID, PRICE_O, NDS, DEP, PART_TYPE, BASE_AGENT_ID)
    values (:DOC_ID, :PART_ID, :SUM_QUANT, :PRICE, :NAC, :WARE_ID, :PRICE_O, :NDS, :DEP, :PART_TYPE, :BASE_AGENT_ID);

  end

  --Обновляем некоторые поля в документе оприходования
  update DOC_DETAIL_ACTIVE
  set SUM_NDSO = QUANT * PRICE_O * NDS / (100 + NDS),
      SUM_NDSR = QUANT * PRICE * (select NDSR
                                  from DEPS
                                  where ID = DEP) / (100 + (select NDSR
                                                            from DEPS
                                                            where ID = DEP)),
      SUMMA_O = QUANT * PRICE_O,
      SUMMA = QUANT * PRICE,
      NAC = iif((PRICE_O <> 0), (PRICE - PRICE_O) * 100 / PRICE_O, 0)
  where DOC_ID = :DOC_ID;

  --Проводим документ оприходования
  execute procedure pr_doc_commit(:doc_id, 0);

  --Все документы и детализацию до указанной даты удаляем
  for select id from docs where commitdate < :CUT_DATE||' 00:00:00' into DOC_ID_DEL do
  begin
    update parts set doc_id = :doc_id where doc_id = :DOC_ID_DEL;
    delete from DOC_DETAIL_DELETED where doc_id = :DOC_ID_DEL;
    delete from DOC_DETAIL where doc_id = :DOC_ID_DEL;
    delete from DOC_PAYS where doc_id = :DOC_ID_DEL;
    delete from DOC_DETAIL_ACTIVE_MMBSH where doc_id = :DOC_ID_DEL;
    delete from SHIFT_DETAIL_KKM where doc_id = :DOC_ID_DEL;
    delete from DOC_DETAIL_ACTIVE where doc_id = :DOC_ID_DEL;
  end
  delete from docs d where commitdate < :CUT_DATE||' 00:00:00';
  delete from cash_docs cd where cd.commitdate < :CUT_DATE||' 00:00:00';

end^

SET TERM ; ^

/* Following GRANT statetements are generated automatically */

GRANT EXECUTE ON PROCEDURE PR_NEWDOC TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,DELETE,UPDATE ON DOCS TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,DELETE ON DOC_DETAIL TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,UPDATE ON PARTS TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,INSERT,DELETE,UPDATE ON DOC_DETAIL_ACTIVE TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT ON DEPS TO PROCEDURE PR_CUTTER_DOCS;
GRANT EXECUTE ON PROCEDURE PR_DOC_COMMIT TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,DELETE ON DOC_DETAIL_DELETED TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,DELETE ON DOC_PAYS TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,DELETE ON DOC_DETAIL_ACTIVE_MMBSH TO PROCEDURE PR_CUTTER_DOCS;
GRANT SELECT,DELETE ON SHIFT_DETAIL_KKM TO PROCEDURE PR_CUTTER_DOCS;

/* Existing privileges on this procedure */

GRANT EXECUTE ON PROCEDURE PR_CUTTER_DOCS TO SYSDBA;
</pre>

==Выполнить ТМС (скрипт)==
 1. Отключить синхронизацию;
 2. Создать резервную копию; 
 3. Менеджер - зеленая стрелка (выполнить) - "Урезать(сернуть) базу на опреденную дату", ввести дату и запустить на выполнение;
 4. Проверить остатки (например товарным отчетом);
 5. Если все нормально, включить синхронизацию.