Инструкция по настройке ф-ции "товар под заказ" — различия между версиями
Материал из wiki.standart-n.ru
Agk (обсуждение | вклад) |
Agk (обсуждение | вклад) |
||
Строка 94: | Строка 94: | ||
GRANT EXECUTE ON PROCEDURE PR_GET_ORDER_STATUS TO SYSDBA; | GRANT EXECUTE ON PROCEDURE PR_GET_ORDER_STATUS TO SYSDBA; | ||
+ | |||
+ | SET TERM ^ ; | ||
+ | |||
+ | create or alter procedure PR_ORDER_CASTING ( | ||
+ | DOC_ID integer, | ||
+ | SESSIONS_ID integer) | ||
+ | returns ( | ||
+ | NEW_DOC_ID integer, | ||
+ | COMMENTS DM_TEXT) | ||
+ | as | ||
+ | declare variable WARE_ID DM_UUID_NULL; | ||
+ | declare variable QUANT DM_DOUBLE; | ||
+ | declare variable SNAME DM_TEXT; | ||
+ | declare variable PART_ID integer; | ||
+ | declare variable BCODE_IZG DM_TEXT; | ||
+ | begin | ||
+ | NEW_DOC_ID = null; | ||
+ | |||
+ | for select ware_id, quant, sname, bcode_izg from doc_detail_virtual dd where doc_id = :doc_id into :ware_id, :quant, :sname, :bcode_izg do | ||
+ | begin | ||
+ | select first 1 part_id from warebase w where (w.ware_id = :ware_id or bcode_izg = :bcode_izg) and w.realquant >= :quant order by part_id into :part_id; | ||
+ | if (part_id is not null) then | ||
+ | begin | ||
+ | if (NEW_DOC_ID is null) then select doc_id from pr_newdoc(1001,-2,0,null,null,:SESSIONS_ID) into :NEW_DOC_ID; | ||
+ | select coalesce(MSG, 'OK') || ' - ' || :sname || ' в кол-ве ' || cast(round(:quant,2) as dm_text) from pr_rashodpart(:NEW_DOC_ID,:part_id,:quant,null,null,null,null,1) into :COMMENTS; | ||
+ | end | ||
+ | else | ||
+ | COMMENTS = 'Позиция ' || :sname || ' не найдена на остатке в кол-ве ' || cast(round(:quant,2) as dm_text); | ||
+ | |||
+ | part_id = null; | ||
+ | |||
+ | suspend; | ||
+ | end | ||
+ | end^ | ||
+ | |||
+ | SET TERM ; ^ | ||
+ | |||
+ | /* Following GRANT statements are generated automatically */ | ||
+ | |||
+ | GRANT SELECT ON DOC_DETAIL_VIRTUAL TO PROCEDURE PR_ORDER_CASTING; | ||
+ | GRANT SELECT ON WAREBASE TO PROCEDURE PR_ORDER_CASTING; | ||
+ | GRANT EXECUTE ON PROCEDURE PR_NEWDOC TO PROCEDURE PR_ORDER_CASTING; | ||
+ | GRANT EXECUTE ON PROCEDURE PR_RASHODPART TO PROCEDURE PR_ORDER_CASTING; | ||
+ | |||
+ | /* Existing privileges on this procedure */ | ||
+ | |||
+ | GRANT EXECUTE ON PROCEDURE PR_ORDER_CASTING TO SYSDBA; | ||
</pre> | </pre> | ||
Строка 108: | Строка 155: | ||
(select status from pr_get_order_status(docs.id, docs.doc_type)) | (select status from pr_get_order_status(docs.id, docs.doc_type)) | ||
+ | </pre> | ||
+ | |||
+ | ===В журнале документов вывести поле "Статус заказа"=== | ||
+ | <pre> | ||
+ | В журнале документов вывести поле ORDER_STATUS (статус заказа) | ||
</pre> | </pre> | ||
Строка 169: | Строка 221: | ||
end; | end; | ||
+ | </pre> | ||
+ | |||
+ | ===Добавить новую ТМС в журнал документов "Подобрать остатки для заказа покупателя"== | ||
+ | <pre> | ||
+ | uses | ||
+ | Classes, Graphics, Controls, Forms, Dialogs, undm, | ||
+ | unmain, dxExEdtr, dxTL, | ||
+ | DB, gb_CustomDataSet, dxCntner, dxTL, dxDBCtrl, dxDBGrid, ToolWin, | ||
+ | ComCtrls, UnFrameDocArchive, IBDatabase, IBQuery, | ||
+ | Menus, IBCustomDataSet, IBQuery, ExtCtrls, dateutils, math, Clipbrd, | ||
+ | unFrameMoney,Grids, DBGrids, IBDatabase, IBQuery; | ||
+ | |||
+ | |||
+ | var docs: TdxdbGrid; | ||
+ | doc: TFrameDocArchive; | ||
+ | qwork: TIBQuery; | ||
+ | trnwork: TIBTransaction; | ||
+ | db:TIBDatabase; | ||
+ | doc_id_in, rnum, active_id, COMMENTS, NEW_DOC_ID:string; | ||
+ | doc_type, status, temp: integer; | ||
+ | mb_res: integer; | ||
+ | |||
+ | |||
+ | procedure OrderCasting; | ||
+ | begin | ||
+ | COMMENTS:=''; | ||
+ | trnwork:=TIBTransaction.create(nil); | ||
+ | qwork:=TIBQuery.create(nil); | ||
+ | db:=dm.FindComponent('db'); | ||
+ | trnwork.defaultdatabase:=db; | ||
+ | qwork.database:=db; | ||
+ | qwork.transaction:=trnwork; | ||
+ | |||
+ | try | ||
+ | qWork.SQL.Text:='select NEW_DOC_ID, COMMENTS from PR_ORDER_CASTING('+doc_id_in+','+'(select first 1 id from sessions s where s.user_id = '+IntToStr(frmManagerXP2.GetUserID)+' order by s.startdt desc)'+')'; | ||
+ | // frmManagerXP2.LogIt(qWork.SQL.Text); | ||
+ | qWork.Active:=true; | ||
+ | while not qWork.Eof do | ||
+ | begin | ||
+ | COMMENTS:= COMMENTS + qWork.FieldByName('COMMENTS').AsString + Chr(13); | ||
+ | qWork.Next; | ||
+ | end; | ||
+ | NEW_DOC_ID:=Trim(qWork.FieldByName('NEW_DOC_ID').AsString); | ||
+ | qWork.Transaction.Commit; | ||
+ | if (NEW_DOC_ID <> '') Then frmManagerXP2.InitActiveDocs; | ||
+ | Showmessage(COMMENTS); | ||
+ | except | ||
+ | qWork.Transaction.Rollback; | ||
+ | mb_res:=MessageDlg ('Ошибка подготовки документа',mtError, mbYes ,0); | ||
+ | end | ||
+ | |||
+ | qWork.Free; | ||
+ | trnwork.Free; | ||
+ | |||
+ | end; | ||
+ | |||
+ | begin | ||
+ | docs:=TFrameDocArchive(frmManagerXP2.DocArchive).FindComponent('gbHeader'); | ||
+ | doc_type:=0; | ||
+ | temp:=docs.columnByFieldName('DOC_TYPE').index; | ||
+ | |||
+ | doc_type:=docs.FocusedNode.values[docs.columnByFieldName('DOC_TYPE').index]; | ||
+ | status:=docs.FocusedNode.values[docs.columnByFieldName('STATUS').index]; | ||
+ | doc_id_in:=inttostr(docs.FocusedNode.values[docs.columnByFieldName('ID').index]); | ||
+ | |||
+ | if (doc_type <> 19) Then | ||
+ | begin | ||
+ | mb_res:=MessageDlg ('Доступна только для документа "Заказ покупателя"',mtError, mbOK ,0); | ||
+ | exit; | ||
+ | end | ||
+ | |||
+ | if (status <> 1) Then | ||
+ | begin | ||
+ | mb_res:=MessageDlg ('Доступна только для проведенного документа',mtError, mbOK ,0); | ||
+ | exit; | ||
+ | end | ||
+ | |||
+ | OrderCasting; | ||
+ | |||
+ | end; | ||
+ | |||
</pre> | </pre> |
Версия 19:04, 11 марта 2019
Содержание
Общее
Менеджер
Создать новый тип документа "Подготовка заказа покупателя "
Создать новый тип документа "'Подготовка заказа покупателя " INSERT INTO DOC_TYPES (ID, CAPTION, INSERTDT, BASE_TYPE, STATINI, REPORTS, VTYPE) VALUES (1001, 'Подготовка заказа покупателя (чек для кассы)', '21-SEP-2018 14:14:33.853', 2, NULL, NULL, 2); + скопировать сетку с любого расходного документа;
выполнить скрипт
INSERT INTO WDICTS (ID, PARENT_ID, CAPTION, DESCRIPTION, SOURCE, STATUS, INSERTDT, ORDERBYDEFAULT, ORDERFIELD, FIELDLIST, INI, ICON) VALUES (101, 0, 'Заказы', NULL, 'ORDERS ', 0, '2018-08-21 11:29:43', NULL, NULL, NULL, ';Обязательно должна быть сортировка по уникальному полю, в таблице нужны ключи по этому полу (возр/убыв) [selectsql] select * from vw_docs d1 where status = 1 and doc_type = 19 and not exists(select id from docs d where d.doc_type = 3 and d.parent_id = d1.id and d.doc_type2 is null) order by id [updatesql] [insertsql] [deletesql] [refreshsql] Select * from vw_docs where ID = :ID [cfSelect] selectfieldexpression=SAGENT AllwaysPartial=1 [main] returnfieldname=ID captionfieldname=SAGENT', NULL); COMMIT WORK; SET TERM ^ ; create or alter procedure PR_GET_ORDER_STATUS ( DOC_ID integer, DOC_TYPE integer) returns ( STATUS DM_TEXT) as begin if (doc_type <> 19) then begin STATUS = ''; suspend; exit; end -- с проведенным чеком "исполнен" if (exists(select id from docs d where d.doc_type = 3 and status = 1 and d.parent_id = :doc_id and doc_type2 is null)) Then begin STATUS = 'исполнен'; suspend; exit; end -- с отложенным чеком "готов к выдаче" if (exists(select id from docs d where d.doc_type = 3 and status <> 1 and d.parent_id = :doc_id and doc_type2 is null)) Then begin STATUS = 'готов к выдаче'; suspend; exit; end -- без чека "в работе" if (not exists(select id from docs d where d.doc_type = 3 and d.parent_id = :doc_id and doc_type2 is null)) Then begin STATUS = 'в работе'; suspend; exit; end end^ SET TERM ; ^ /* Following GRANT statements are generated automatically */ GRANT SELECT ON DOCS TO PROCEDURE PR_GET_ORDER_STATUS; /* Existing privileges on this procedure */ GRANT EXECUTE ON PROCEDURE PR_GET_ORDER_STATUS TO SYSDBA; SET TERM ^ ; create or alter procedure PR_ORDER_CASTING ( DOC_ID integer, SESSIONS_ID integer) returns ( NEW_DOC_ID integer, COMMENTS DM_TEXT) as declare variable WARE_ID DM_UUID_NULL; declare variable QUANT DM_DOUBLE; declare variable SNAME DM_TEXT; declare variable PART_ID integer; declare variable BCODE_IZG DM_TEXT; begin NEW_DOC_ID = null; for select ware_id, quant, sname, bcode_izg from doc_detail_virtual dd where doc_id = :doc_id into :ware_id, :quant, :sname, :bcode_izg do begin select first 1 part_id from warebase w where (w.ware_id = :ware_id or bcode_izg = :bcode_izg) and w.realquant >= :quant order by part_id into :part_id; if (part_id is not null) then begin if (NEW_DOC_ID is null) then select doc_id from pr_newdoc(1001,-2,0,null,null,:SESSIONS_ID) into :NEW_DOC_ID; select coalesce(MSG, 'OK') || ' - ' || :sname || ' в кол-ве ' || cast(round(:quant,2) as dm_text) from pr_rashodpart(:NEW_DOC_ID,:part_id,:quant,null,null,null,null,1) into :COMMENTS; end else COMMENTS = 'Позиция ' || :sname || ' не найдена на остатке в кол-ве ' || cast(round(:quant,2) as dm_text); part_id = null; suspend; end end^ SET TERM ; ^ /* Following GRANT statements are generated automatically */ GRANT SELECT ON DOC_DETAIL_VIRTUAL TO PROCEDURE PR_ORDER_CASTING; GRANT SELECT ON WAREBASE TO PROCEDURE PR_ORDER_CASTING; GRANT EXECUTE ON PROCEDURE PR_NEWDOC TO PROCEDURE PR_ORDER_CASTING; GRANT EXECUTE ON PROCEDURE PR_RASHODPART TO PROCEDURE PR_ORDER_CASTING; /* Existing privileges on this procedure */ GRANT EXECUTE ON PROCEDURE PR_ORDER_CASTING TO SYSDBA;
настроить сетку документа "Подготовка заказа покупателя"
добавить поле в VW_DOCS
ORDER_STATUS источник (select status from pr_get_order_status(docs.id, docs.doc_type))
В журнале документов вывести поле "Статус заказа"
В журнале документов вывести поле ORDER_STATUS (статус заказа)
В ТМС проведение активного документа (-205)
if (doc_type = 1001) Then OrderPrepare;
и процедуру
procedure OrderPrepare; var sl: TStringList; s2,t2: String; begin //Проверка, что документ не пустой t:='select count(1) as cnt from doc_detail_active where doc_id='+doc_id; query1:=ExecIBQuery(trn,t,1); if (IBQuery_FieldByName_i(query1, 'cnt') = 0) then begin mb_res:=application.messagebox(PChar('Документ пуст. Проведение отменено'),'',MB_ICONSTOP); program_result.Values['cancel']:='1'; exit; end; sl:=TStringList.Create; s2:='[ORDERS]'#13#10+ 'type=action'#13#10+ 'caption=Заказы'#13#10+ 'mode=wdict=101'#13#10+ 'default='+#13#10; sl.text:=s2; if GetCustomParams(sl,'заполните значения') then s2:=sl.values['ORDERS'] else begin mb_res:=application.messagebox(PChar('Необходимо указать контрагента. Проведение документа отменено'),'',MB_ICONSTOP); program_result.Values['cancel']:='1'; exit; end; mb_res:=application.messagebox(PChar('Подготовить данный товар к выдаче по указанному заказу?'),'',$00000004+$00000020); if mb_res<>6 then begin mb_res:=application.messagebox(PChar('Проведение документа отменено пользователем'),'',MB_ICONSTOP); program_result.Values['cancel']:='1'; exit; end; program_result.Values['cancel']:='1'; t2:='update docs set doc_type = 3, status = 2, parent_id = '+s2+' where id = '+doc_id; query1:=ExecIBQuery(trn,t2,1); EndIBTransaction(trn,1); m_manager.logit(t2); m_manager.INITACTIVEDOCS; mb_res:=application.messagebox(PChar('Выполнено. Заказ переведен в статус "к выдаче (поступил)" и отправлен на кассу'),'Успех',MB_ICONINFORMATION); end;
=Добавить новую ТМС в журнал документов "Подобрать остатки для заказа покупателя"
uses Classes, Graphics, Controls, Forms, Dialogs, undm, unmain, dxExEdtr, dxTL, DB, gb_CustomDataSet, dxCntner, dxTL, dxDBCtrl, dxDBGrid, ToolWin, ComCtrls, UnFrameDocArchive, IBDatabase, IBQuery, Menus, IBCustomDataSet, IBQuery, ExtCtrls, dateutils, math, Clipbrd, unFrameMoney,Grids, DBGrids, IBDatabase, IBQuery; var docs: TdxdbGrid; doc: TFrameDocArchive; qwork: TIBQuery; trnwork: TIBTransaction; db:TIBDatabase; doc_id_in, rnum, active_id, COMMENTS, NEW_DOC_ID:string; doc_type, status, temp: integer; mb_res: integer; procedure OrderCasting; begin COMMENTS:=''; trnwork:=TIBTransaction.create(nil); qwork:=TIBQuery.create(nil); db:=dm.FindComponent('db'); trnwork.defaultdatabase:=db; qwork.database:=db; qwork.transaction:=trnwork; try qWork.SQL.Text:='select NEW_DOC_ID, COMMENTS from PR_ORDER_CASTING('+doc_id_in+','+'(select first 1 id from sessions s where s.user_id = '+IntToStr(frmManagerXP2.GetUserID)+' order by s.startdt desc)'+')'; // frmManagerXP2.LogIt(qWork.SQL.Text); qWork.Active:=true; while not qWork.Eof do begin COMMENTS:= COMMENTS + qWork.FieldByName('COMMENTS').AsString + Chr(13); qWork.Next; end; NEW_DOC_ID:=Trim(qWork.FieldByName('NEW_DOC_ID').AsString); qWork.Transaction.Commit; if (NEW_DOC_ID <> '') Then frmManagerXP2.InitActiveDocs; Showmessage(COMMENTS); except qWork.Transaction.Rollback; mb_res:=MessageDlg ('Ошибка подготовки документа',mtError, mbYes ,0); end qWork.Free; trnwork.Free; end; begin docs:=TFrameDocArchive(frmManagerXP2.DocArchive).FindComponent('gbHeader'); doc_type:=0; temp:=docs.columnByFieldName('DOC_TYPE').index; doc_type:=docs.FocusedNode.values[docs.columnByFieldName('DOC_TYPE').index]; status:=docs.FocusedNode.values[docs.columnByFieldName('STATUS').index]; doc_id_in:=inttostr(docs.FocusedNode.values[docs.columnByFieldName('ID').index]); if (doc_type <> 19) Then begin mb_res:=MessageDlg ('Доступна только для документа "Заказ покупателя"',mtError, mbOK ,0); exit; end if (status <> 1) Then begin mb_res:=MessageDlg ('Доступна только для проведенного документа',mtError, mbOK ,0); exit; end OrderCasting; end;