Товар под заказ

Материал из wiki.standart-n.ru
Перейти к: навигация, поиск

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

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

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

до версии 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;


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 statetements 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_CHECK_ORDER (
    DOC_ID integer)
returns (
    TXT DM_TEXT,
    DOC_ID_LIST DM_BLOBTEXT)
as
declare variable CAPTION DM_TEXT;
declare variable ORDER_DOC_ID integer;
begin
  DOC_ID_LIST = '-3';
  TXT = '';

  if ((select doc_type from docs where id = :DOC_ID) not in (1,2,20)) then exit;

  for select caption || '(' || sagent || ') от ' || cast(cast(d.commitdate as dm_date) as dm_text), id  from vw_docs d where d.doc_type = 19 and d.status = 1 and
    (not exists(select id from docs d2 where d2.doc_type = 3 and d2.parent_id = d.id and d2.doc_type2 is null)) into :caption, :order_doc_id do
  begin
      if (exists(select id from doc_detail_active da where da.doc_id = :doc_id and
                                                          (ware_id in (select ware_id from doc_detail_virtual ddv where ddv.doc_id = :order_doc_id) or
                                                          (bcode_izg in (select bcode_izg from doc_detail_virtual ddv where ddv.doc_id = :order_doc_id))
                                                          ))) then
      begin
           TXT = TXT || 'В приходе имеется товар для "' || caption || '"' || ascii_char(13);
           DOC_ID_LIST = DOC_ID_LIST || ',' || cast(ORDER_DOC_ID as dm_text);
      end
  end
  if (TXT <> '') then suspend;

end^

SET TERM ; ^

/* Following GRANT statements are generated automatically */

GRANT SELECT ON DOCS TO PROCEDURE PR_CHECK_ORDER;
GRANT SELECT ON VW_DOCS TO PROCEDURE PR_CHECK_ORDER;
GRANT SELECT ON DOC_DETAIL_ACTIVE TO PROCEDURE PR_CHECK_ORDER;
GRANT SELECT ON DOC_DETAIL_VIRTUAL TO PROCEDURE PR_CHECK_ORDER;

/* Existing privileges on this procedure */

GRANT EXECUTE ON PROCEDURE PR_CHECK_ORDER 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

ТМС для Кассира -339 "Печать документа заказа"

uses
  Graphics, Controls, Forms, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls, ibquery, DB, ChequeList, FR,
  ScriptRes, Barcode, ZKassa, StrUtils, Windows, Classes,
  IBDatabase;

begin
  DoReport(1000, '', rmView, '');
end;

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

uses
  Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Messages, SysUtils,
  ToolWin, ImgList, dxExEdtr, dxCntner, dxTL, dxDBCtrl, dxDBGrid, StdCtrls,
  unMain,DB, IBQuery, IBDatabase, unDM, DBTables, cfdxUtils, Menus, System,
  Buttons, ExtCtrls, StdCtrls, cfSelectEdit, ADOdb, System,Classes,
  gb_table, Grids, ClipBrd, DBGrids, unFrameCustomDict, need,
  cfWindows, unframeDocArchive, UnMain, cfSelectEdit, unFrameDocArchive;

procedure showOrder(doc_id: string);
var ed: TcfSelectEdit;          
begin
  ed:=frmManagerXP2.DocArchive.FindComponent('edHeader');
  if assigned(ed) then
  begin
    ed.SQLMask:='select * from vw_docs where id in ('+doc_id+')';
    ed.Select;
    frmManagerXP2.ShowDocArchive;
  end;
end;

var
  ActiveDocId: string;
  q: TIBQuery;
  mb_res: integer;

begin
  q := DM.TempQuery(nil);
  try
    ActiveDocId := inttostr(frmManagerxp2.GetActiveDocID);
    q.Active:= False;
    q.SQL.Text := 'select * from PR_CHECK_ORDER( ' + ActiveDocId + ')';
    q.Active := True;

    if (q.eof) Then exit;

    if MessageDlg(q.FieldByName('txt').AsString+chr(13)+'Отобразить данные заказы в журнале документов?', mtConfirmation, mbOKCancel, 0) = mrOk then
          showOrder(q.FieldByName('DOC_ID_LIST').AsString);
    else
          MessageDlg('Отменено пользователем', mtConfirmation, mbOK, 0)


  finally
    q.Free;
  end;

end

дополнить подпрограмму -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);
   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

Настройка аванса

1) провести документ ввода услуг с услугой "Аванс", требования:
 1.1) НДС 18% (обычно);
 1.2) цена по рознице 1 руб.;
 1.3) группа делимость, для копеек;
2) выбрать эту партию из списка, в настройках "Аванс" в разделе ККМ (на всех кассах);