Удаление возвращенных маркированных товаров из банкетных заказов

Чтобы удалять из ранее сохраненного заказа позиции с конкретной маркой (например, в заведении проходит банкет, для которого в заказ было добавлено 120 бутылок воды с указанием марки. После окончания банкета заказчик вернул невостребованные 50 бутылок воды. Для повторной реализации товаров из заказа должны быть удалены бутылки с конкретными возвращенными марками):

  1. Сделайте неактивным предустановленный mcr-алгоритм Маркированная продукция (GS1) блюдо
  2. Добавьте новый mcr-алгоритм и там разместите скрипт
  3. В блоке Set parameters укажите код категории с маркированными товарами и код причины удаления блюда.
Function MCR1003052(DeviceSignal: Integer; DeviceIdent: Integer; var Parameter: String): Boolean;
var
  parsedData: TStringList;
  FNC1, GS: char;
  AI01, AI21: string;
  Prmt: string;
  i: Integer;
  currPos: Integer;
  s: string;
  AI: Integer;
  partlen: Integer;
  GSSymbolExists: Boolean;
  Props: TVisitOrderInfo;
////////////////////////////////////////////////////////////////////////////////
  it, CurItem: TCheckItem;
  Categ: TClassificatorGroup;
  CatCode, j, k, m, CntModif: integer;
  CheckView: TCheckView;
  voidCode: String;
  d: TDish;  
begin
  Result := False;
  if (Length(Parameter) = 0) then
    Exit;

  GSSymbolExists := False;
  FNC1 := #232;
  GS := #29;
  Prmt := Parameter;
  if (Prmt[1] = FNC1) or (Prmt[1] = GS) then begin
    Delete(Prmt, 1, 1);
    GSSymbolExists := True;
  end;  

  parsedData := TStringList.Create;
  try
    // Разбираем QR-код, заносим секции в parsedData
    currPos := 1;
    while currPos < Length(Prmt) do begin
      s := Copy(Prmt, currPos, 2);
      if Length(s) <> 2 then Break;
      AI := StrToIntDef(s, -1);
      if AI = -1 then Exit;
      //полный список AI фиксированной длины:
      // "Table 2-3 Element strings with pre-defined length using Application Identifiers (GS1 General Specifications Figure 5.10.1-2)."
      if AI = 00 then 
        partLen := 20
      else if (AI >= 01) and (AI <= 03) then 
        partLen := 16
      else if AI = 04 then 
        partLen := 18
      else if (AI >= 11) and (AI <= 19) then
        partLen := 8
      else if AI = 20 then
        partLen := 4
      else if (AI >= 31) and (AI <= 36) then 
        partLen := 10
      else if AI = 41 then
        partLen := 16
      else partLen := 0;
      if partLen > 0 then begin
        //AI фиксированной длины
        if currPos + partLen > Length(Prmt)+1 then Exit;
        s := Copy(Prmt, currPos, partLen);
        //данные не должны содержать GS или FNC1
        if Pos(GS, s) > 0 then Exit;
        if Pos(FNC1, s) > 0 then Exit;
      end else begin
        //AI переменной длины
        s := copy(Prmt, currPos, 1000);
        //ищем первый GS или FNC1
        partLen := Pos(GS, s);
        if partLen > 0 then begin
          s := copy(s, 1, partLen-1);
          GSSymbolExists := True;
        end;
        partLen := Pos(FNC1, s);
        if partLen > 0 then begin
          s := copy(s, 1, partLen-1);
          GSSymbolExists := True;
        end;
      end;

      //добавляем найденный кусок
      parsedData.Add(s);       
      currPos := currPos + Length(s);

      //удаляем разделительный GS или FNC1. После AI фиксированной длины разделитель тоже допустим по GS1
      s := Copy(Prmt, currPos, 1);
      if (s = FNC1) or (s = GS) then begin
        currPos := currPos + 1;         
        GSSymbolExists := True;
      end;
    end;
    
    // Проверяем, что в ParsedData есть нужные данные
    AI01 := '';
    AI21 := '';
    for i := 0 to parsedData.Count - 1 do begin
      if copy(parsedData.Strings[i], 1, 2) = '01' then
        AI01 := copy(parsedData.Strings[i], 3, 1000);
      if copy(parsedData.Strings[i], 1, 2) = '21' then
        AI21 := copy(parsedData.Strings[i], 3, 1000);
    end;
  finally
    parsedData.Free;
  end;

  if (AI01 = '') or (AI21 = '') then Exit;

  for i := 1 to Length(AI01) do
    if (AI01[i] < '0') or (AI01[i] > '9') then Exit;

  if not GSSymbolExists then begin
    Result := False;
    Exit;
  end; 
  Result := True;
  //////////////////////////////////////////////////////////////////////////////
//**************Set parameters********************************  
  CatCode:=16391; // код категории с маркированными товарами *  
  voidCode:= '2';  //код причины удаления блюда              *
//************************************************************    
  Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', catcode));
  CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
  if CheckView = Nil then Exit;
  if not RKCheck.Valid then Exit;
  CntModif := 0;
  for k := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
    begin
      it := RKCheck.CurrentOrder.Sessions.Lines[k];
      if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then
      if Categ.IsChild(TDish(it).RefItem) then 
      begin
        for j := 0 to TDish(it).Modifiers.Count - 1 do      
        begin
          if (TModiItem(TDish(it).Modifiers.Items[j]).OpenName = Parameter) and (TDish(it).Quantity > 0) then
          begin
            CntModif := CntModif + 1;
            d := TDish(it);
            //dbg.dbgprint('!!==!!' + ' Марка ' + Parameter);
            Break;
          end;
        end;
      end;
    end;
   //dbg.dbgprint('!!==!!' + ' CntModif ' + IntToStr(CntModif));
   if CntModif > 0 then
   begin
      m:= gui.MessageDlgEx('Позиция с такой маркой уже добавлена в заказ.', mtInformation, mbYes+mbNo, 'Удалить;Оставить');
      if m=ID_Yes then
       begin
        CheckView.GotoItem(TDish(d));
        RKCheck.CreateCheckItem(rkrefOrderVoids, voidCode, FloatToStr(d.Quantity));
        //RKCheck.DeleteCheckItem(d);
        Result := False;
      end;
      if m=ID_No then
       Result := True;
  end;         
  Parameter := Copy(AI01, 2, 13);
end;

DELPHI

Теперь, если открыть ранее сохранённый заказ и отсканировать в него позиции с уже имеющимся в заказе кодом datamatrix, система проинформирует о том, что такая позиция уже присутствует в заказе, и предложит ее удалить.

Запрет печати пречека, если в заказе присутствует маркированная продукция без марки

Чтобы запретить печать пречек по заказу, в котором есть хотя бы одна позиция маркированного товара с не отсканированной маркой:

  1. Разместите скрипт, приведенный ниже, на форму редактирования обычного заказа.
  2. В параметрах скрипта укажите код категории маркированных товаров(по умолчанию он 16391).
procedure DesignFormOnOperation(Sender: TBasePanel; Operation, Param: integer; var res: integer);
var
it:Tcheckitem;
i, j, mCnt, CatCode:integer;
Categ: TClassificatorGroup;
kikoz:boolean;
CheckView: TCheckView;
begin
  ShowOrderInfo('hide');
  //**************Set parameters********************************  
  CatCode:=16391; // код категории с маркированными товарами *
//************************************************************  
  
  if  operation=461  then
  begin      
  kikoz:=false;
  Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', catcode));
  CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
  if CheckView = Nil then Exit;  
  for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
    begin
      it := RKCheck.CurrentOrder.Sessions.Lines[i];
      if SYS.ObjectInheritsFrom(it, 'TDish') then
      if (Categ.IsChild(TDish(it).RefItem))  then
      if TDish(it).quantity>0 then
      begin
        if TDish(it).Modifiers.Count > 0 then
        begin   

          for j := 0 to TDish(it).Modifiers.Count - 1 do      
            begin      
              if TDish(it).Modifiers.Items[j].Code=2012 then mCnt:=mCnt+1;         
            end;
         if mCnt=0  then kikoz:=true;
         mCnt:=0;
         end;
         if TDish(it).Modifiers.Count = 0 then kikoz:=true;
        end;
    end; 
    if kikoz then 
    begin
    gui.showmessage('Нельзя распечатать пречек, т.к. в заказе есть маркированная продукция без марок!') ;
    res:=1;
    end;     
  
  end;  
end;
DELPHI

Ограничение количества продажи блюд из определенной категории

В одном чеке может быть не больше 128 маркированных товаров.
При необходимости ограничить продажу количества блюд определенной категории воспользуйтесь скриптом.


procedure CheckViewOnBeforeCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject; var AAllow: boolean; var AMessage: string);
var
 it : TCheckItem;
 Categ : TClassificatorGroup;
 i, dishCount, categCode : integer;
begin
  dishCount := 0;
  categCode := 10; //Здесь указать код категории
  Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', categCode)); 
  for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do 
   begin
    it := RKCheck.CurrentOrder.Sessions.Lines[i];
    if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then
     if Categ.IsChild(it.RefItem) then
      dishCount:=dishCount + 1;
   end;
   if AEditType = etInsert then
    if SYS.ObjectInheritsFrom(AObjectAft, 'TDish') then
     if (dishCount >= 128) and (Categ.IsChild(TDish(AObjectAft).RefItem)) then
       begin
        AAllow:=false;
        AMessage := 'В этом заказе содержится максимальное количество маркированных товаров: 128. Добавление маркированных товаров в этот заказ невозможно';
       end; 
end;

procedure CheckViewOnAfterCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject);
var
 it : TCheckItem;
 Categ : TClassificatorGroup;
 i, dishCount, categCode : integer;
begin
  dishCount := 0;
  categCode := 10; //Здесь указать код категории
  Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', categCode)); 
  for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do 
   begin
    it := RKCheck.CurrentOrder.Sessions.Lines[i];
    if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then
     if Categ.IsChild(it.RefItem) then
      dishCount:=dishCount + 1;
   end;
   if AEditType = etInsert then
    if SYS.ObjectInheritsFrom(AObjectAft, 'TDish') then
     if (dishCount = 128) and (Categ.IsChild(TDish(AObjectAft).RefItem)) then
      gui.showmessage('В этом заказе уже содержится максимальное количество маркированных товаров: 128. Добавление маркированных товаров в этот заказ невозможно');
end;
DELPHI


Запасной вариант скрипта, который обрабатывает кнопку количество.

function GetQuantity(qnt,s:double; cat:integer): boolean;
var
i:integer;
Categ: TClassificatorGroup;
it : TCheckItem;
kolvo:double;
begin
Categ   := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', cat));
for i     := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
  begin    
    it:= RKCheck.CurrentOrder.Sessions.Lines[i];
    if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then 
      if Categ.IsChild(it.RefItem) then kolvo:=kolvo+TDish(it).Quantity;
      
  end;
if kolvo+qnt>s then result:=true else result:=false;
end;

procedure CheckViewOnBeforeCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject; var AAllow: boolean; var AMessage: string);
var
numcateg:integer;
Categ: TClassificatorGroup;
maxQNT:double;
begin
//*********Parameters***************
numcateg:=16391; // код категории маркированных товаров
maxQNT:=128; // максимальное количество блюд

//**********************************
Categ   := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', numcateg));
if (AEditType = etInsert) or (AEditType = etChange) then
  begin
    if SYS.ObjectInheritsFrom(TObject(AObjectBef), 'TDish') then 
    if (Categ.IsChild(TDish(AObjectBef).RefItem)) then 
      Begin
        if getQuantity(1, maxQNT, numcateg) then
          begin
            AAllow:=False;
            gui.showmessage('В заказе не может быть больше ' + floattostr(maxQNT)+' маркированных товаров!' );
          end;
      end;
  end;
end;
 
procedure DesignFormOnOperation(Sender: TBasePanel; Operation, Param: integer; var res: integer);
var
ed: TObject;
curitem : TCheckItem;
numcateg:integer;
maxQNT:double;
Categ: TClassificatorGroup;
begin
//*********Parameters***************
numcateg:=16391; // код категории маркированных товаров
maxQNT:=128; // максимальное количество блюд

//**********************************

if operation=rkoEditAmount then 
  begin
    Categ   := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', numcateg));
    CurItem := RKCheck.CurrentCheckItem;
    ed := TObject(gui.FindComponentByName('Editor'));
    if SYS.ObjectInheritsFrom(curitem, 'TDish') then 
      if (Categ.IsChild(curitem.RefItem)) then
        if SYS.ObjectInheritsFrom(TObject(ed), 'TNumEditor') then 
          if getQuantity(strtofloat(TNumEditor(ed).Text)-TDish(curitem).quantity, maxQNT, numcateg) then
            begin
              res:=1;
              gui.showmessage('В заказе не может быть больше ' + floattostr(maxQNT)+' маркированных товаров!' );
            end;                 
  end;  
end;
DELPHI