Убрать пересорт — различия между версиями
Материал из wiki.standart-n.ru
Agk (обсуждение | вклад) (Новая страница: «==Общие сведения== ТМС (подпрограмма) позволяет при возникновении пересорта, например, пр…») |
Agk (обсуждение | вклад) |
||
Строка 58: | Строка 58: | ||
end. | end. | ||
</nowiki> | </nowiki> | ||
+ | |||
+ | ==Теги== | ||
+ | Пересортица, пересорт, убрать пересорт |
Версия 17:25, 26 мая 2015
Содержание
Общие сведения
ТМС (подпрограмма) позволяет при возникновении пересорта, например, при открытии накладной на редактирование, по которой уже были продажи, создать автоматически документ корректировки пересорта для взаимного объединения этих позиций. Поиск производится по наименованию, цене, серии.
Установка
Менеджер - Сервис - Подпрограммы - Общие - правой кнопкой мышки - Создать новую группу - Убрать пересорт. Код процедуры взять из раздела ниже.
Текст подпрограммы
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.
Теги
Пересортица, пересорт, убрать пересорт