Убрать пересорт — различия между версиями

Материал из wiki.standart-n.ru
Перейти к: навигация, поиск
(Текст подпрограммы)
(Текст подпрограммы)
 
Строка 16: Строка 16:
 
  trn:=CREATEIBTRANSACTION;     
 
  trn:=CREATEIBTRANSACTION;     
 
  STARTIBTRANSACTION(trn,1);
 
  STARTIBTRANSACTION(trn,1);
try
+
try  
// m_manager.logit('select doc_id  from PR_NEWDOC(18,(select USER_ID from SESSIONS where id ='+floattostr(m_session_id)+' ),0,(select max(vnum)+1 from docs where doc_type=18),current_date,'+floattostr(m_session_id)+')');
+
  query:=ExecIBQuery(trn,'select doc_id  from PR_NEWDOC(18,(select USER_ID from SESSIONS where id ='+floattostr(m_session_id)+' ),0,(select max(vnum)+1 from docs where doc_type=18),current_date,'+floattostr(m_session_id)+')',1);  
  query:=ExecIBQuery(trn,'select doc_id  from PR_NEWDOC(18,(select USER_ID from SESSIONS where id ='+floattostr(m_session_id)+' ),0,(select max(vnum)+1 from docs where doc_type=18),current_date,'+floattostr(m_session_id)+')',1);
+
 
  if not IBQUERY_EOF(query) then
 
  if not IBQUERY_EOF(query) then
 
  begin
 
  begin
Строка 27: Строка 26:
 
  while not IBQUERY_EOF(query) do
 
  while not IBQUERY_EOF(query) do
 
  begin
 
  begin
//  m_manager.logit('Select first 1 part_id,quant,price,price*quant as summa,sname,price_o,seria from warebase where quant>=((-1)*('+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+')) and trim(sname)=trim('''+IBQuery_FieldByName_s(query, 'sname')+''');');
+
  query2:=ExecIBQuery(trn,'Select first 1 part_id,quant,price,price*quant,seria as summa,sname,price_o from warebase where part_id not in (select part_id from doc_detail_active where doc_id='+new_id_doc+') and realquant>=((-1)*('+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+')) and trim(sname)=trim('''+IBQuery_FieldByName_s(query, 'sname')+''') and price='+Stringreplace(IBQuery_FieldByName_s(query, 'price'),',','.',1)+' and abs(price_o-'+Stringreplace(IBQuery_FieldByName_s(query, 'price_o'),',','.',1)+') <= 0.01 ;',1);
  query2:=ExecIBQuery(trn,'Select first 1 part_id,quant,price,price*quant as summa,sname,price_o,seria from warebase where quant>=((-1)*('+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+')) and trim(sname)=trim('''+IBQuery_FieldByName_s(query, 'sname')+''');',1);
+
 
   if not IBQUERY_EOF(query2) then
 
   if not IBQUERY_EOF(query2) then
 
   begin
 
   begin
//     showmessage(IBQuery_FieldByName_s(query2, 'part_id'));
+
    //showmessage(IBQuery_FieldByName_s(query2, 'part_id'));
 
     query3:=ExecIBQuery(trn,'select id,msg from PR_RASHODPART('+new_id_doc+','+IBQuery_FieldByName_s(query, 'part_id')+','+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+','+Stringreplace(IBQuery_FieldByName_s(query, 'summa'),',','.',1)+','''',1,0,null,0);',1);  
 
     query3:=ExecIBQuery(trn,'select id,msg from PR_RASHODPART('+new_id_doc+','+IBQuery_FieldByName_s(query, 'part_id')+','+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+','+Stringreplace(IBQuery_FieldByName_s(query, 'summa'),',','.',1)+','''',1,0,null,0);',1);  
 
     query3:=ExecIBQuery(trn,'select id,msg from PR_RASHODPART('+new_id_doc+','+IBQuery_FieldByName_s(query2, 'part_id')+',(-1)*'+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+',(-1)*'+Stringreplace(IBQuery_FieldByName_s(query, 'summa'),',','.',1)+','''',1,0,null,0);',1);       
 
     query3:=ExecIBQuery(trn,'select id,msg from PR_RASHODPART('+new_id_doc+','+IBQuery_FieldByName_s(query2, 'part_id')+',(-1)*'+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+',(-1)*'+Stringreplace(IBQuery_FieldByName_s(query, 'summa'),',','.',1)+','''',1,0,null,0);',1);       
Строка 48: Строка 46:
 
  end
 
  end
 
  else
 
  else
begin
+
   showmessage('Ничего не нашли');  
  query:=ExecIBQuery(trn,'delete from docs where id='+new_id_doc,1);
+
   showmessage('Ничего не нашли');
+
end 
+
 
except
 
except
 
  showmessage('Ошибка');  
 
  showmessage('Ошибка');  

Текущая версия на 12:51, 8 июля 2016

Общие сведения

ТМС (подпрограмма) позволяет при возникновении пересорта, например, при открытии накладной на редактирование, по которой уже были продажи, создать автоматически документ корректировки пересорта для взаимного объединения этих позиций. Поиск производится по наименованию, цене, серии.

Установка

Менеджер - Сервис - Подпрограммы - Общие - правой кнопкой мышки - Создать новую группу - Убрать пересорт. Код процедуры взять из раздела ниже.

Текст подпрограммы

program GroupProgram;
var  trn, query, query1, query2, query3: cardinal; 
     new_date_doc,new_id_doc,new_part_id,part_str: string;
     fl: integer;
begin
 part_str:='';  
 trn:=CREATEIBTRANSACTION;    
 STARTIBTRANSACTION(trn,1);
try 
 query:=ExecIBQuery(trn,'select doc_id  from PR_NEWDOC(18,(select USER_ID from SESSIONS where id ='+floattostr(m_session_id)+' ),0,(select max(vnum)+1 from docs where doc_type=18),current_date,'+floattostr(m_session_id)+')',1); 
 if not IBQUERY_EOF(query) then
 begin
  new_id_doc:=IBQuery_FieldByName_s(query, 'doc_id');  
 end;
 
 query:=ExecIBQuery(trn,'Select part_id,quant,price,price*quant as summa,sname,price_o,seria from warebase where quant<0 and price_o >=0 and price > 0',1);
 while not IBQUERY_EOF(query) do
 begin
   query2:=ExecIBQuery(trn,'Select first 1 part_id,quant,price,price*quant,seria as summa,sname,price_o from warebase where part_id not in (select part_id from doc_detail_active where doc_id='+new_id_doc+') and realquant>=((-1)*('+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+')) and trim(sname)=trim('''+IBQuery_FieldByName_s(query, 'sname')+''') and price='+Stringreplace(IBQuery_FieldByName_s(query, 'price'),',','.',1)+' and abs(price_o-'+Stringreplace(IBQuery_FieldByName_s(query, 'price_o'),',','.',1)+') <= 0.01 ;',1);
   if not IBQUERY_EOF(query2) then
   begin
     //showmessage(IBQuery_FieldByName_s(query2, 'part_id'));
     query3:=ExecIBQuery(trn,'select id,msg from PR_RASHODPART('+new_id_doc+','+IBQuery_FieldByName_s(query, 'part_id')+','+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+','+Stringreplace(IBQuery_FieldByName_s(query, 'summa'),',','.',1)+','''',1,0,null,0);',1); 
     query3:=ExecIBQuery(trn,'select id,msg from PR_RASHODPART('+new_id_doc+','+IBQuery_FieldByName_s(query2, 'part_id')+',(-1)*'+Stringreplace(IBQuery_FieldByName_s(query, 'quant'),',','.',1)+',(-1)*'+Stringreplace(IBQuery_FieldByName_s(query, 'summa'),',','.',1)+','''',1,0,null,0);',1);      
   end;
   IBQUERY_NEXT(query); 
 end  
 query:=ExecIBQuery(trn,'select *  from doc_detail_active where doc_id='+new_id_doc,1);
 if not IBQUERY_EOF(query) then
 begin
   //query:=ExecIBQuery(trn,'execute procedure PR_DOC_COMMIT('+new_id_doc+','+inttostr(m_session_id)+')',1);
   
   query:=ExecIBQuery(trn,'select caption from docs where id='+new_id_doc,1);
   showmessage('Создан новый документ : '+trim(IBQuery_FieldByName_s(query, 'caption')));
  // m_docarchive.show;      
   EndIBTransaction(trn,1); 
 end
 else
  showmessage('Ничего не нашли'); 
except
 showmessage('Ошибка'); 
 EndIBTransaction(trn,0);
end;    

 FREEIBQUERY(query);        
 FREEIBTRANSACTION(trn);
 m_manager.INITACTIVEDOCS;
end.
 

Теги

Пересортица, пересорт, убрать пересорт