Товар под заказ — различия между версиями

Материал из wiki.standart-n.ru
Перейти к: навигация, поиск
(→‎Установка)
Строка 2: Строка 2:
 
* [[Файл:Инструкция_по_товару_под_заказ_20180904.doc]]
 
* [[Файл:Инструкция_по_товару_под_заказ_20180904.doc]]
  
−
=Установка=
+
=Инструкция по установке=
 +
==Обновить Кассира==
 +
<pre>до версии 2.2.2.9 или выше</pre>
 +
 
 
==Выполнить в базе==
 
==Выполнить в базе==
 
<pre>
 
<pre>
Строка 142: Строка 145:
 
</pre>
 
</pre>
  
 +
 +
==Расчет розничной цены==
 +
<pre>
 +
при добавлении позиции в заказ, Кассир обращается к базе Общего Заказа, по ШК выбирает минимальную цену,
 +
и формирует розничную цену процедурой PR_GET_PRICE_FOR_OZ, передавая в качестве входных параметров ШК и мин. цену из ОЗ
 +
</pre>
 +
<pre>
 +
SET TERM ^ ;
 +
 +
create or alter procedure PR_GET_PRICE_FOR_OZ (
 +
    BARCODE DM_TEXT,
 +
    PRICE_O DM_DOUBLE,
 +
    PRICE_R DM_DOUBLE,
 +
    PRICE_Z DM_DOUBLE)
 +
returns (
 +
    PRICE_OUT DM_DOUBLE)
 +
as
 +
declare variable GNVLS integer;
 +
declare variable NAC DM_DOUBLE;
 +
declare variable PRICE_CALC DM_DOUBLE;
 +
declare variable WARE_ID DM_UUID_NULL;
 +
begin
 +
  --906887 A.K. 20180416
 +
  --907922 A.K. 20180417
 +
 +
/*  if (char_length(:BARCODE) >= 8) then
 +
    select first 1 id from wares where Trim(barcode) containing Trim(:BARCODE) into :WARE_ID;
 +
 +
  select price_out from PR_GET_PRICE_FAP(:ware_id, :PRICE_O, :PRICE_R, :PRICE_Z,0) into :PRICE_OUT;
 +
*/
 +
 +
  if (exists(select barcode from out$gnvls_barcode o where o.barcode = :BARCODE)) Then
 +
  --ЖНВЛС
 +
  begin
 +
      if (PRICE_O > 20000)  then NAC = 5;
 +
      if (PRICE_O <= 20000) then NAC = 7;
 +
      if (PRICE_O <= 2000) then NAC = 10;
 +
      if (PRICE_O <= 1000) then NAC = 13;
 +
      if (PRICE_O <= 500)  then NAC = 15;
 +
      if (PRICE_O <= 300)  then NAC = 18;
 +
      if (PRICE_O <= 100)  then NAC = 20;
 +
      if (PRICE_O <= 50)  then NAC = 40;
 +
  end
 +
  else
 +
  begin
 +
      if (PRICE_O > 20000)  then NAC = 9;
 +
      if (PRICE_O <= 20000) then NAC = 11;
 +
      if (PRICE_O <= 2000) then NAC = 14;
 +
      if (PRICE_O <= 1000) then NAC = 17;
 +
      if (PRICE_O <= 500)  then NAC = 19;
 +
      if (PRICE_O <= 300)  then NAC = 22;
 +
      if (PRICE_O <= 100)  then NAC = 60;
 +
      if (PRICE_O <= 50)  then NAC = 100;
 +
  end
 +
 +
  PRICE_OUT = round((:price_o*(1+:nac/100)),2);
 +
 +
  suspend;
 +
end^
 +
 +
SET TERM ; ^
 +
 +
/* Following GRANT statements are generated automatically */
 +
 +
GRANT SELECT ON OUT$GNVLS_BARCODE TO PROCEDURE PR_GET_PRICE_FOR_OZ;
 +
 +
/* Existing privileges on this procedure */
 +
 +
GRANT EXECUTE ON PROCEDURE PR_GET_PRICE_FOR_OZ TO SYSDBA;
 +
</pre>
 
==поправить VW_DOCS==
 
==поправить VW_DOCS==
 
<pre>
 
<pre>
Строка 156: Строка 229:
 
[[Файл:Договор rep 1000.zip]]
 
[[Файл:Договор rep 1000.zip]]
  
−
==123==
+
==дополнить ТМС -205 "Проведение активного документа" в Менеджере==
 +
<pre>
 +
в основной процедуре
 +
  if (doc_type = 101) 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);
 +
  mb_res:=application.messagebox(PChar('Выполнено. Заказ переведен в статус "к выдаче (поступил)" и отправлен на кассу'),'Успех',MB_ICONINFORMATION);
 +
  m_manager.INITACTIVEDOCS;   
 +
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>
 +
 
 +
==Сетки==
 +
[[Файл:Сетка_заказы.zip]]

Версия 15:24, 3 октября 2018

Инструкция пользователя

Инструкция по установке

Обновить Кассира

до версии 2.2.2.9 или выше

Выполнить в базе

ALTER TABLE DOCS ADD DOC_TYPE2 DM_ID;

INSERT INTO DOC_TYPES (ID, CAPTION, INSERTDT, BASE_TYPE, STATINI, REPORTS, VTYPE)
               VALUES (1001, 'Подготовка заказа покупателя (чек для кассы)', '2018-09-24 14:44:27', 2, '[main]
FixedAgent=-2', NULL, 2);


INSERT INTO REPORTS (ID, PARENT_ID, STATUS, REPORTTYPE, SORTING, CAPTION, PARAMS, WDICT_ID, DATA) VALUES (1000, 0, 0, 3, 1, 'Договор розничной купли-продажи', NULL, NULL, NULL);

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);

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;


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;


Расчет розничной цены

 при добавлении позиции в заказ, Кассир обращается к базе Общего Заказа, по ШК выбирает минимальную цену, 
 и формирует розничную цену процедурой PR_GET_PRICE_FOR_OZ, передавая в качестве входных параметров ШК и мин. цену из ОЗ

SET TERM ^ ;

create or alter procedure PR_GET_PRICE_FOR_OZ (
    BARCODE DM_TEXT,
    PRICE_O DM_DOUBLE,
    PRICE_R DM_DOUBLE,
    PRICE_Z DM_DOUBLE)
returns (
    PRICE_OUT DM_DOUBLE)
as
declare variable GNVLS integer;
declare variable NAC DM_DOUBLE;
declare variable PRICE_CALC DM_DOUBLE;
declare variable WARE_ID DM_UUID_NULL;
begin
   --906887 A.K. 20180416
   --907922 A.K. 20180417

/*   if (char_length(:BARCODE) >= 8) then
     select first 1 id from wares where Trim(barcode) containing Trim(:BARCODE) into :WARE_ID;

   select price_out from PR_GET_PRICE_FAP(:ware_id, :PRICE_O, :PRICE_R, :PRICE_Z,0) into :PRICE_OUT;
*/

  if (exists(select barcode from out$gnvls_barcode o where o.barcode = :BARCODE)) Then
   --ЖНВЛС
   begin
       if (PRICE_O > 20000)  then NAC = 5;
       if (PRICE_O <= 20000) then NAC = 7;
       if (PRICE_O <= 2000) then NAC = 10;
       if (PRICE_O <= 1000) then NAC = 13;
       if (PRICE_O <= 500)  then NAC = 15;
       if (PRICE_O <= 300)  then NAC = 18;
       if (PRICE_O <= 100)  then NAC = 20;
       if (PRICE_O <= 50)   then NAC = 40;
   end
  else
   begin
       if (PRICE_O > 20000)  then NAC = 9;
       if (PRICE_O <= 20000) then NAC = 11;
       if (PRICE_O <= 2000) then NAC = 14;
       if (PRICE_O <= 1000) then NAC = 17;
       if (PRICE_O <= 500)  then NAC = 19;
       if (PRICE_O <= 300)  then NAC = 22;
       if (PRICE_O <= 100)  then NAC = 60;
       if (PRICE_O <= 50)   then NAC = 100;
   end

  PRICE_OUT = round((:price_o*(1+:nac/100)),2);

  suspend;
end^

SET TERM ; ^

/* Following GRANT statements are generated automatically */

GRANT SELECT ON OUT$GNVLS_BARCODE TO PROCEDURE PR_GET_PRICE_FOR_OZ;

/* Existing privileges on this procedure */

GRANT EXECUTE ON PROCEDURE PR_GET_PRICE_FOR_OZ TO SYSDBA;

поправить VW_DOCS

добавить поле 
  ORDER_STATUS
источник
  (select status from pr_get_order_status(docs.id, docs.doc_type))

вывести в сетку

Добавить отчет

для отчета 1000 добавить blob поле Файл:Договор rep 1000.zip

дополнить ТМС -205 "Проведение активного документа" в Менеджере

в основной процедуре 
  if (doc_type = 101) 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);
   mb_res:=application.messagebox(PChar('Выполнено. Заказ переведен в статус "к выдаче (поступил)" и отправлен на кассу'),'Успех',MB_ICONINFORMATION);
   m_manager.INITACTIVEDOCS;     
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;

Сетки

Файл:Сетка заказы.zip

Источник — «http://wiki.standart-n.ru/index.php?title=Товар_под_заказ&oldid=6970»