/*------------------------------------------------------------*
 * NAME:       %MAKETBL                                       *
 * PURPOSE:    %MAKETBL is a SAS macro that generates a       *
 *             translation table for use in the SORTSEQ=      *
 *             option of PROC SORT.                           *
 * AUTHORS:    Arjen Raateland - FEA, Helsinki, Finland       *
 *             Biff Beers      - SAS Institute, Cary,         *
 *                               North Carolina, USA          *
 * USAGE:      %maketbl(charlist, tblename) ;                 *
 * PARAMETERS:                                                *
 * - CHARLIST: a list of characters in the desired sorting    *
 *             order. SAS Macro quoting rules apply. For      *
 *             example, if the characters ("), ('), or (,)    *
 *             are to be listed, they must be enclosed in     *
 *             the macro function %BQUOTE. No more than 200   *
 *             characters can be listed.                      *
 * - TBLENAME: the name of the translation table to be        *
 *             generated.                                     *
 * NOTES:                                                     *
 *           - This macro can be used independently of the    *
 *             underlying character set. However, the         *
 *             underlying character set is assumed to be a    *
 *             single-byte character set.                     *
 *           - Characters that are listed in CHARLIST should  *
 *             appear in the list only once, but not every    *
 *             character in the underlying character set must *
 *             be listed.                                     *
 *           - Characters that are NOT listed in CHARLIST and *
 *             that occur in the underlying character set     *
 *             before all the characters that are listed      *
 *             remain before those characters in the          *
 *             resulting sorting sequence.                    *
 *           - Other characters not listed in CHARLIST appear *
 *             after all the listed characters in the         *
 *             resulting sorting sequence.                    *
 *------------------------------------------------------------*/
%macro maketbl(charlist, tblename);

  /*----------------------------------------------------------*
   * For each character listed in CHARLIST, this DATA step    *
   * records the position of the character in the underlying  *
   * character set and the desired sorting weight of the      *
   * character based on its relative position in the list.    *
   *----------------------------------------------------------*/

  data listed(keep=pos weight);
    charlist="&charlist";
    len=length(charlist);
    minpos=256;
    do i=1 to len;
      char=substr(charlist,i,1);
      pos=rank(char);
      if pos<minpos then minpos=pos;
      weight=(i-1);
      output;
    end;
    call symput('maxwght', put(weight+minpos,3.));
    call symput('firstpos', put(minpos,3.));
  run;

  /*----------------------------------------------------------*
   * This DATA step adjusts the sorting weight of each        *
   * character processed in the last DATA step so that it is  *
   * relative to all characters in the underlying character   *
   * set and not just the characters listed in CHARLIST.      *
   *----------------------------------------------------------*/

  data listed;
    set listed;
    weight+&firstpos;
  run;

  /*----------------------------------------------------------*
   * This PROC SORT step reorders the information gathered in *
   * the previous DATA steps by increasing character set      *
   * position. It is currently ordered by increasing sorting  *
   * weight. This reordering is necessary because the         *
   * following DATA step "visits" each character position,    *
   * from 0 to 255, and assigns to it the proper sorting      *
   * weight.                                                  *
   *----------------------------------------------------------*/

  proc sort data=listed;
    by pos;
  run;

  /*----------------------------------------------------------*
   * This DATA step records the character set position and    *
   * sorting weight for each character in the underlying      *
   * character set that is NOT listed in CHARLIST. It also    *
   * intermixes this information in the proper order with the *
   * character set positions and sorting weights recorded in  *
   * the previous DATA steps. This DATA step is broken into   *
   * labeled sections, and the first section controls the     *
   * execution of the other sections.                         *
   *----------------------------------------------------------*/

  data newtable (keep=pos weight);
    set listed end=eof;
    retain i 0 ww &maxwght;
    if (i<&firstpos) then link before;
    if (i<pos) then link between;
    output;
    i=i+1;
    if eof then link after;
  return;

  /*----------------------------------------------------------*
   * This section records the character set positions and     *
   * sorting weights of characters that occur in the          *
   * underlying character setbefore any of the characters     *
   * listed in CHARLIST.                                      *
   *----------------------------------------------------------*/

  before:
    holdp=pos;
    holdw=weight;
    do j=i to &firstpos - 1 by 1;
      pos=j;
      weight=pos;
      output;
    end;
    pos=holdp;
    weight=holdw;
    i=j;
  return;

  /*----------------------------------------------------------*
   * This section records the character set positions and     *
   * sorting weights of characters that occur in the          *
   * underlying character set in between two of the           *
   * characters listed in CHARLIST.                           *
   *----------------------------------------------------------*/

  between:
    holdp=pos;
    holdw=weight;
    do j=i to holdp - 1 by 1;
      ww=ww+1;
      pos=j;
      weight=ww;
      output;
    end;
    pos=holdp;
    weight=holdw;
    i=j;
  return;

  /*----------------------------------------------------------*
   * This section records the character set positions and     *
   * sorting weights of characters that occur in the          *
   * underlying character set after all of the characters     *
   * listed in CHARLIST.                                      *
   *----------------------------------------------------------*/

  after:
    do j=i to 255 by 1;
      ww=ww+1;
      pos=j;
      weight=ww;
      output;
    end;
  return;

  run;

  /*----------------------------------------------------------*
   * This DATA step uses each character set position and      *
   * sorting weight recorded in the previous DATA step to     *
   * generate MACRO variables that can be used in REPLACE     *
   * statements in the PROC TRANTAB step below.               *
   *----------------------------------------------------------*/

  data _null_ ;
    set newtable;
    strn=left(put(pos, 3.));
    call symput("pos"||strn, put(pos, 3.));
    call symput("wgt"||strn, put(weight, 3.));
  run;

  /*----------------------------------------------------------*
   * This final PROC TRANTAB step uses the MACRO variables    *
   * created in the previous DATA step to generate REPLACE    *
   * statements. The resulting translation table can be used  *
   * in the SORTSEQ= option of PROC SORT. An inverse table is *
   * also created which is important if the table is to be    *
   * used with a host sort.                                   *                                                 *
   *----------------------------------------------------------*/

  proc trantab table=&tblename;
    %do i = 0 %to 255;
      replace &&pos&i &&wgt&i;
    %end;

    inverse;
    save both;
  run;
  quit;

%mend maketbl;

/*------------------------------------------------------------*
 * END OF MACRO MAKETBL                                       *
 *------------------------------------------------------------*/