Убрать пересорт - История изменений

Agk: /* Текст подпрограммы */

2016-07-08T07:51:55Z

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

Agk: /* Текст подпрограммы */

2016-05-04T07:08:24Z

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

Agk в 12:25, 26 мая 2015

2015-05-26T12:25:06Z

Agk: Новая страница: «==Общие сведения== ТМС (подпрограмма) позволяет при возникновении пересорта, например, пр…»

2015-05-26T12:24:14Z

Новая страница: «==Общие сведения== ТМС (подпрограмма) позволяет при возникновении пересорта, например, пр…»

Новая страница

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

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

==Текст подпрограммы==
<nowiki>
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,-2,0,'''',null,'+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
// m_manager.logit('Select first 1 part_id,quant,price,price*quant,seria as summa,sname,price_o from warebase where quant>=((-1)*('+IBQuery_FieldByName_s(query, 'quant')+')) 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 and trim(seria)=trim('''+IBQuery_FieldByName_s(query, 'seria')+''');');
query2:=ExecIBQuery(trn,'Select first 1 part_id,quant,price,price*quant,seria as summa,sname,price_o from warebase where quant>=((-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 and trim(seria)=trim('''+IBQuery_FieldByName_s(query, 'seria')+''');',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.
</nowiki>

← Предыдущая		Версия 12:25, 26 мая 2015
Строка 58:		Строка 58:
	end.		end.
	</nowiki>		</nowiki>
		+
		+	==Теги==
		+	Пересортица, пересорт, убрать пересорт

@@ Строка 16: / Строка 16: @@
   trn:=CREATEIBTRANSACTION;
   STARTIBTRANSACTION(trn,1);
 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
   begin
@@ Строка 27: / Строка 26: @@
   while not IBQUERY_EOF(query) do
   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
     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(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
   else
- begin
+   showmessage('Ничего не нашли');
-  query:=ExecIBQuery(trn,'delete from docs where id='+new_id_doc,1);
    showmessage('Ничего не нашли');
- end
 except
   showmessage('Ошибка');