CREATE PROCEDURE S$_GENBARCODE (
    pflg char( 1 ))
returns (
    barcode varchar( 13 ))
as
declare variable i integer;
declare variable lbar varchar( 13 );
declare variable li integer;
declare variable lsum integer;
begin
  /* Procedure Text */

  if (PFLG='S') then begin

   i=GEN_ID(G_BARSCALE, 1 );
   i=i+ 1 ;
   lbar=cast(i as varchar( 13 ));

  end else begin
   i=gen_id(G_BAR, 1 );
   i=i+ 1 ;
   lbar=cast(i as varchar( 13 ));



   select RES from s$_addchar (:lbar,'0', 10 )
   into :lbar;

   lbar='24'||lbar;

   li=strlen(lbar); i= 1 ; lsum= 0 ;
    while (li<> 0 ) do begin
     if (mod(li, 2 )= 0 ) then
      lsum=lsum+(cast(subst(lbar,i,i) as integer)* 1 );
     else
      lsum=lsum+(cast(subst(lbar,i,i) as integer)* 3 );
     li=li- 1 ;i=i+ 1 ;
    end
    if (mod(lsum, 10 )= 0 ) then
      lbar=lbar||'0';
    else begin
      i= 10 -mod(lsum, 10 );
      lbar=lbar||cast(i as varchar( 1 ));
    end
  end

  barcode=:lbar;

  suspend;
end^

SET TERM ; ^

CREATE PROCEDURE S$BARTOTXT (
    pbar varchar( 14 ))
returns (
    bartxt varchar( 25 ))
as
declare variable ls varchar( 1 );
declare variable li integer;
declare variable lupcode varchar( 7 );
begin
  /* Procedure Text */
  li= 1 ;bartxt='';
  while (li<=strlen(:pbar)) do begin
   ls=subst(:pbar,li,li);
   if ((ls='0') and (li= 1 )) then begin
       lupcode='AAAAAA';
       bartxt='0';
   end
   if ((ls='1') and (li= 1 )) then lupcode='AABABB';
   if ((ls='2') and (li= 1 )) then begin
       lupcode='AABBAB';
        bartxt='%';
   end
   if ((ls='3') and (li= 1 )) then lupcode='AABBBA';
   if ((ls='4') and (li= 1 )) then lupcode='ABAABB';
   if ((ls='5') and (li= 1 )) then lupcode='ABBAAB';
   if ((ls='6') and (li= 1 )) then lupcode='ABBBAA';
   if ((ls='7') and (li= 1 )) then lupcode='ABABAB';
   if ((ls='8') and (li= 1 )) then lupcode='ABABBA';
   if ((ls='9') and (li= 1 )) then lupcode='ABBABA';


   if (li= 2 ) then begin
     bartxt=:bartxt||'!';
   end
   if (li= 8 ) then begin
     bartxt=:bartxt||'-';
   end

   if ((li> 1 ) and (li<= 7 )) then begin
    if ((ls='0') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'0';
    if ((ls='0') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'A';

    if ((ls='1') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'1';
    if ((ls='1') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'B';

    if ((ls='2') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'2';
    if ((ls='2') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'C';

    if ((ls='3') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'3';
    if ((ls='3') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'D';

    if ((ls='4') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'4';
    if ((ls='4') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'E';

    if ((ls='5') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'5';
    if ((ls='5') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'F';

    if ((ls='6') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'6';
    if ((ls='6') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'G';

    if ((ls='7') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'7';
    if ((ls='7') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'H';

    if ((ls='8') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'8';
    if ((ls='8') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'I';

    if ((ls='9') and (subst(lupcode,li- 1 ,li- 1 )='A')) then
      bartxt=:bartxt||'9';
    if ((ls='9') and (subst(lupcode,li- 1 ,li- 1 )='B')) then
      bartxt=:bartxt||'J';
   end

   if ((li> 7 ) and (ls='0')) then begin
    bartxt=:bartxt||'a';
   end
   if ((li> 7 ) and (ls='1')) then begin
    bartxt=:bartxt||'b';
   end
   if ((li> 7 ) and (ls='2')) then begin
    bartxt=:bartxt||'c';
   end
   if ((li> 7 ) and (ls='3')) then begin
    bartxt=:bartxt||'d';
   end
   if ((li> 7 ) and (ls='4')) then begin
    bartxt=:bartxt||'e';
   end
   if ((li> 7 ) and (ls='5')) then begin
    bartxt=:bartxt||'f';
   end
   if ((li> 7 ) and (ls='6')) then begin
    bartxt=:bartxt||'g';
   end
   if ((li> 7 ) and (ls='7')) then begin
    bartxt=:bartxt||'h';
   end
   if ((li> 7 ) and (ls='8')) then begin
    bartxt=:bartxt||'i';
   end
   if ((li> 7 ) and (ls='9')) then begin
    bartxt=:bartxt||'j';
   end
   if(li= 13 ) then
    bartxt=:bartxt||'!';

   li=li+ 1 ;
  end
  suspend;
end^

SET TERM ; ^

DESCRIBE PROCEDURE S$BARTOTXT
'Ïðåîáðàçîâàíèå öûôð øòðèõêîäà â ïîñëåäîâàòåëüíîñòü ñèìâîëîâ';