text:
/*=====================================================================
Program Name            : CreateTableOrView.sas
Purpose                 : Create either a table (SAS data set) or view
                          from either specified parameters, metadata
                          data set, or shell data sets.
SAS Version             : SAS 9.2
Input Data              : Specified in macro parameter
Output Data             : SAS / SQL data set or SAS / SQL view

Macros Called           : parmv, seplist

Originally Written by   : Scott Bass
Date                    : 07JUL2011
Program Version #       : 1.0

=======================================================================

Scott Bass (sas_l_739@yahoo.com.au)

This code is licensed under the Unlicense license.
For more information, please refer to http://unlicense.org/UNLICENSE.

This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

=======================================================================

Modification History    : Original version

=====================================================================*/

/*---------------------------------------------------------------------
Usage:

options mprint msglevel=i;

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,type=table
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,lang=sas
   ,type=table
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,type=view
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,lang=sas
   ,type=view
)

Creates SAS data set work.shoes and SAS data step view work.v_shoes
   from sashelp.shoes, keeping all variables.
Macro default is to create SAS data sets.

=======================================================================

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,lang=sql
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,lang=sql
   ,type=table
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,lang=sql
   ,type=view
)

Creates SQL data set work.shoes and SQL view work.v_shoes
   from sashelp.shoes, keeping all variables.

=======================================================================

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=table
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=table
)

Creates SAS data set and SQL data set work.shoes from sashelp.shoes
   keeping specified variables.

=======================================================================

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=view
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=view
)

Creates SAS data step view and SQL view work.v_shoes from sashelp.shoes
   keeping specified variables.

=======================================================================

* this will fail, indexes do not support the descending option ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=table
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary -Sales
   ,index=Y
)

* this will work, implemented as proc sort rather than an index ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=table
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary -Sales
   ,index=N
)

* this will work, no descending option present ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=table
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary Product
   ,index=Y
)

Creates SAS data set work.shoes from sashelp.shoes
   keeping specified variables.
Data is filtered by specified where clause.
Data is either indexed or sorted by specified by variables.
Data step views cannot be indexed, but they can be sorted after the
   view is created.
SAS data sets can be indexed or sorted.
SQL views can be sorted (order by).
SQL data sets can either be indexed or sorted (order by).

Use a leading minus sign (-) to specify descending order.  The correct
syntax will be derived based on whether the lang is SAS or SQL.

=======================================================================

* this will fail, indexes are not supported with views ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=view
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary Product
   ,index=Y
)

* this will work, implemented as proc sort rather than an index ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=view
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary -Sales
   ,index=N
)

Creates SAS data step view work.v_shoes and SAS data set work.shoes
   from sashelp.shoes, keeping specified variables.
Data is filtered by specified where clause.

Use a leading minus sign (-) to specify descending order.  The correct
syntax will be derived based on whether the lang is SAS or SQL.

=======================================================================

* this will fail, indexes do not support the descending option ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=table
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary -Sales
   ,index=Y
)

* this will work, implemented as output data set index ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=table
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary Sales
   ,index=Y
)

* this will work, implemented as SQL order by clause ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=table
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary -Sales
   ,index=N
)

Creates SQL data set set work.shoes from sashelp.shoes,
   keeping specified variables.
Data is filtered by specified where clause.

Use a leading minus sign (-) to specify descending order.  The correct
syntax will be derived based on whether the lang is SAS or SQL.

=======================================================================

* this will fail, indexes are not supported with views ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=view
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary Sales
   ,index=Y
)

* this will work, implemented as SQL order by clause ;
%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=view
   ,where=Region in ("United States", "Canada")
   ,by=Region Subsidiary -Sales
   ,index=N
)

Creates SQL view work.v_shoes from sashelp.shoes,
   keeping specified variables.
Data is filtered by specified where clause.

Use a leading minus sign (-) to specify descending order.  The correct
syntax will be derived based on whether the lang is SAS or SQL.

=======================================================================

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,drop=Stores Inventory Returns
   ,rename=Sales=TotalSales Region=Country
   ,lang=sas
   ,type=view
   ,where=Region in ("United States", "Canada")
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,drop=Stores Inventory Returns
   ,rename=Sales=TotalSales Region=Country
   ,lang=sql
   ,type=table
   ,where=Region in ("United States", "Canada")
)

Creates SAS data step view work.v_shoes and SQL data set work.shoes
   from sashelp.shoes, dropping and renaming specified variables.
Data is filtered by specified where clause.

=======================================================================

* create sample columns metadata data set ;
proc sql;
   create table meta_columns as
      select * from dictionary.columns
      where libname="SASHELP" and memname="SHOES"
   ;
quit;

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes (label="My Shoes Test SAS Data Set")
   ,meta_columns=meta_columns
   ,meta_columns_cond=upcase(Name) not in ("STORES","INVENTORY")
   ,lang=sas
   ,type=table
   ,where=Region contains ("America")
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes (label="My Shoes Test SQL View")
   ,meta_columns=meta_columns
   ,meta_columns_cond=upcase(Name) not in ("STORES","INVENTORY")
   ,lang=sql
   ,type=view
   ,where=Region contains ("America")
)

Creates SAS data set work.shoes and SQL vew work.v_shoes
   from sashelp.shoes, using columns in specified metadata data set.
Only the columns in the specified metadata data set are kept.
Data is filtered by specified where clause.

=======================================================================

* create sample shell data set ;
data shell (label="My SAS Shell Data Set");
   set sashelp.shoes;
   drop Stores Inventory Returns;
   stop;
run;

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes (label="My Shoes Test Data Set")
   ,shell=shell
   ,lang=sas
   ,type=table
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,shell=shell
   ,lang=sas
   ,type=view
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,shell=shell
   ,drop=stores
   ,rename=Product=Stuff Sales=TotalSales
   ,lang=sql
   ,type=table
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,shell=shell
   ,drop=stores inventory returns
   ,rename=Product=Stuff Sales=TotalSales
   ,lang=sql
   ,type=view
   ,by=product
   ,index=N
)

Creates data set work.shoes and view work.v_shoes
   from sashelp.shoes, using attributes in the specified shell data set (could also be a view).
If shell data set contains a data set label then that label is applied to the output data set/view.
If the output data set/view has a label specified then that value has precedence over the shell data set label.

=======================================================================

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sas
   ,type=table
   ,file=%sysfunc(pathname(work))/generatedCreateTableOrView.sas
)

%CreateTableOrView(
   data=sashelp.class
   ,out=work.v_class
   ,lang=sas
   ,type=table
   ,file=%sysfunc(pathname(work))/generatedCreateTableOrView.sas
   ,append=Y
)

%CreateTableOrView(
   data=sashelp.shoes
   ,out=work.v_shoes
   ,keep=Region Subsidiary Product Stores Sales
   ,lang=sql
   ,type=view
   ,file=_temp_
   ,run=Y
)

Generates code to creates SAS data set work.shoes and SQL view work.v_shoes
   from sashelp.shoes, keeping specified variables.
For the SAS data set, the code is written to <path to work library>/generatedCreateTableOrView.sas,
   but not executed.  It also uses the APPEND parameter to append to the output file.
For the SQL view, the code is written to a temporary file (default), and the code is executed.

In either scenario, the DMS command "fslist _code_" can be used to interactively debug the generated code.

-----------------------------------------------------------------------
Notes:

Note that the use cases above cover most, but not all, of the usage
scenarios.  See the macro code (esp. the parameter list) for all
usage scenarios.

The main purpose of this macro is to build SAS data sets/view or SQL
data sets/views using metadata from a metadata data set or shell data set
to enable metadata-driven programming.  Otherwise, it is easy enough
to "hard code" static data step or SQL code.

This code is not meant to generate any complex joins.  Its only
purpose is as a utility macro to generate a SAS data set/view or SQL
data set/view from a single input data set/view.  However, it could be
used as a utility macro within another macro for more complex
processing.

---------------------------------------------------------------------*/

%macro CreateTableOrView
/*---------------------------------------------------------------------
Create either a table (SAS data set) or view from either specified
parameters, metadata data set, or shell data sets.
---------------------------------------------------------------------*/
(
DATA=          /* Input data set/view (REQ).                         */
,OUT=          /* Output data set/view (REQ).                        */
,KEEP=         /* Keep specified variables? (Opt).                   */
               /* If specified, only the specified variables are     */
               /* kept in the output data set/view.                  */
               /* If blank, then all variables are kept.             */
,DROP=         /* Drop specified variables? (Opt).                   */
               /* If specified, those variables are dropped from the */
               /* output data set/view.  If both DROP and KEEP are   */
               /* specified then DROP has precedence and KEEP is     */
               /* ignored.                                           */
,BY=           /* Sort output data set/view? (Opt).                  */
               /* If specified, the output data set/view is sorted   */
               /* by the specified variables.  BY is invalid if the  */
               /* output is a data step view.                        */
,INDEX=Y       /* How should the output data set be sorted? (Opt).   */
               /* This is a required parameter if BY is specified.   */
               /* If INDEX=YES, an index is used to logically sort   */
               /* the output data set.  If INDEX=NO, PROC sort is    */
               /* used to physically sort the output data set.       */
               /* INDEX is ignored if the output type is a view.     */
               /* Default value is YES.  Valid values are:           */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
,WHERE=        /* Filter observations from input data set/view?(Opt).*/
               /* If specified, the observations are filtered by the */
               /* where condition.                                   */
               /* Do not specify the "where" keyword.                */
,RENAME=       /* Rename output variables? (Opt).                    */
               /* Specify as oldvar1=newvar1 oldvar2=newvar2 ...     */
,META_COLUMNS= /* Metadata columns data set (Opt).                   */
               /* If specified, the attributes as specified in the   */
               /* metadata will be used for the output variables.    */
               /* The metadata should be specified with the same     */
               /* structure as PROC CONTENTS output, as well as any  */
               /* optional filtering variables.                      */
,META_COLUMNS_COND=
               /* Filter metadata columns data set? (Opt).           */
               /* If specified, the metadata columns data set will   */
               /* be filtered and only those returned columns will   */
               /* be in the output data set/view.                    */
,SHELL=        /* Shell data set (Opt).                              */
               /* If specified, the output data set/view will have   */
               /* the same structure as in the shell data set.       */
,LANG=SAS      /* Output language type (REQ).                        */
               /* Valid values are SAS (SAS data set/data step view) */
               /* or SQL (SQL data set/view).                        */
,TYPE=TABLE    /* Output type (REQ).                                 */
               /* Valid values are TABLE or VIEW.                    */
,FILE=         /* Output file for generated code (Opt).              */
               /* If blank, the code is executed via normal macro    */
               /* processing.  If non-blank, the generated code is   */
               /* written to the specified file.  If FILE=_TEMP_,    */
               /* the code is written to a temporary file.           */
               /* This only makes sense if RUN=Y.                    */
               /* A temporary file, pre-allocated fileref, or SAS    */
               /* catalog entry are all supported.                   */
,APPEND=N      /* Append to output file? (Opt).                      */
               /* If NO, the output file will be overwritten.        */
               /* If YES, the output file will be appended.          */
               /* If YES, the output file parameter must not be      */
               /* blank.                                             */
               /* Default value is NO.  Valid values are:            */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
,RUN=N         /* Run generate code? (Opt).                          */
               /* If NO, the code is written to the output file but  */
               /* not executed.  If YES, the code is %included and   */
               /* thus executed.                                     */
               /* This parameter is ignored unless GENERATE=YES.     */
               /* Default value is NO.  Valid values are:            */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
,PRE_PROCESS=  /* Pre-processing code (Opt).                         */
               /* If specified, this code is executed immediately    */
               /* after the DATA or PROC SQL statement.              */
,POST_PROCESS= /* Post-processing code (Opt).                        */
               /* If specified, this code is executed immediately    */
               /* before the RUN or QUIT statement.                  */
);

%local macro parmerr;
%let macro = &sysmacroname;

%* check input parameters ;
%parmv(DATA,               _req=1,_words=1,_case=N)   /* _words=1 allows ds options */
%parmv(OUT,                _req=1,_words=1,_case=N)   /* _words=1 allows ds options */
%parmv(KEEP,               _req=0,_words=1,_case=N)
%parmv(DROP,               _req=0,_words=1,_case=N)
%parmv(BY,                 _req=0,_words=1,_case=N)
%parmv(INDEX,              _req=0,_words=1,_case=U,_val=0 1)
%parmv(WHERE,              _req=0,_words=1,_case=N)
%parmv(RENAME,             _req=0,_words=1,_case=N)
%parmv(META_COLUMNS,       _req=0,_words=1,_case=N)
%parmv(META_COLUMNS_COND,  _req=0,_words=1,_case=N)
%parmv(SHELL,              _req=0,_words=0,_case=N)
%parmv(LANG,               _req=1,_words=0,_case=U,_val=SAS SQL)
%parmv(TYPE,               _req=1,_words=0,_case=U,_val=TABLE VIEW)
%parmv(FILE,               _req=0,_words=1,_case=N)
%parmv(APPEND,             _req=0,_words=0,_case=U,_val=0 1)
%parmv(RUN,                _req=0,_words=0,_case=U,_val=0 1)
%parmv(PRE_PROCESS,        _req=0,_words=1,_case=N)
%parmv(POST_PROCESS,       _req=0,_words=1,_case=N)

%if (&parmerr) %then %goto quit;

%* parse any data set options out of the data and out parameters ;
%local data_options out_options;
%let rx=%sysfunc(prxparse(/^(.*?)\((.*)\)/));
%if (%sysfunc(prxmatch(&rx,%superq(data)))) %then %do;
   %let data_options=%sysfunc(prxposn(&rx,2,%superq(data)));
   %let data        =%sysfunc(prxposn(&rx,1,%superq(data)));
%end;
%if (%sysfunc(prxmatch(&rx,%superq(out)))) %then %do;
   %let out_options=%sysfunc(prxposn(&rx,2,%superq(out)));
   %let out        =%sysfunc(prxposn(&rx,1,%superq(out)));
%end;
%syscall prxfree(rx);

%* additional error checking ;

%* check if the source data set exists ;
%if (not (%sysfunc(exist(&data,data)) or %sysfunc(exist(&data,view)))) %then %do;
   %parmv(_msg=&data data set or view does not exist)
   %goto quit;
%end;

%* descending option is not allowed for indexes ;
%if (&index and %index(&by,%str(-))) %then %do;
   %parmv(_msg=The descending option is not supported for indexes)
   %goto quit;
%end;

%* indexes are not supported for views ;
%* (INDEX parameter is ignored unless BY is specified) ;
%if (%superq(by) ne ) %then %do;
      %if (&index and &type eq VIEW) %then %do;
         %parmv(_msg=Indexes are not supported for views)
         %goto quit;
   %end;
%end;

%* was a label specified on the out parameter? ;
%* if so, give it precedence over any label in the shell data set ;
%* otherwise, if a shell data set was specified, get the label from the shell data set ;
%local dslabel;
%let rx=%sysfunc(prxparse(/label\s*=\s*[%"%'](.*?)[%'%"]/i));
%if (%sysfunc(prxmatch(&rx,&out_options))) %then %do;
   %* do nothing, label is part of the options ;
%end;
%else %do;
   %if (&shell ne ) %then %do;
      %let dslabel=%data_attr(&shell,label);
   %end;
%end;
%syscall prxfree(rx);

%* format the label for later processing ;
%if (&dslabel ne ) %then %let dslabel=%sysfunc(quote(&dslabel));

%* get the libname and memname of the data and out parameters ;
%local data_libname data_memname out_libname out_memname temp;
%let data_libname=%scan(&data,1,.);
%let data_memname=%scan(&data,2,.);
%if (&data_memname eq ) %then %do;
   %let data_memname=&data_libname;
   %let temp=%sysfunc(getoption(user));
   %let data_libname=%sysfunc(ifc(&temp ne ,&temp,work));
%end;
%let out_libname=%scan(&out,1,.);
%let out_memname=%scan(&out,2,.);
%if (&out_memname eq ) %then %do;
   %let out_memname=&out_libname;
   %let temp=%sysfunc(getoption(user));
   %let out_libname=%sysfunc(ifc(&temp ne ,&temp,work));
%end;

%* get the libname and memname of the shell dataset if it was specified ;
%local shell_libname shell_memname;
%if (&shell ne ) %then %do;
   %let shell_libname=%scan(&shell,1,.);
   %let shell_memname=%scan(&shell,2,.);
   %if (&shell_memname eq ) %then %do;
      %let shell_memname=&shell_libname;
      %let temp=%sysfunc(getoption(user));
      %let shell_libname=%sysfunc(ifc(&temp ne ,&temp,work));
   %end;
%end;

%* build the index clause ;
%* we have already tested for the descending option with an index, ;
%* so &by will be ok for use in the index_stmt ;
%local index_stmt out_saved;
%if (%quote(&by) ne ) %then %do;
   %if (&index) %then %do;
      %if (%count_words(&by) eq 1) %then
         %let index_stmt=index=(&by);
      %else
         %let index_stmt=index=(_sort_=(&by));
   %end;
   %else
   %if (&lang eq SAS) %then %do;
      %* create a temporary data set or view ;
      %let out_saved=&out;
      %let out=_meta_temp_;
   %end;
%end;

%* dump macro variables to the log for debugging ;
%dump_mvars(
   data     data_libname   data_memname   data_options
   out      out_libname    out_memname    out_options
   shell    shell_libname  shell_memname
   dslabel
   keep
   drop
   rename
   where
   by
   index    index_stmt
   file     run
)

%*---------------------------------------------------------------------
START OF SAS CODE GENERATION
--------------------------------------------------------------------- ;

%* start with a clean slate ;
proc datasets lib=work nowarn nolist memtype=(data view);
   delete _meta_:;
quit;

%* parse the output file parameter to determine the output file type ;
%local _fileref _out_type _out_fileref;
%if (%superq(file) ne ) %then %do;
   %* was a physical file or a fileref specified? ;
   %if (%sysfunc(findc(%superq(file),%str(:./\%'%")))) or
       (%length(%superq(file)) gt 8) %then
      %let _fileref=0;
   %else
      %let _fileref=1;

   %* what type of file was specified? ;
   %if (not &_fileref) %then %do;
      %if (%scan(%upcase(%superq(file)),-1,.) eq SOURCE) %then %do;
         %let _out_type=catalog;
         %let _out_fileref=_code_;
      %end;
      %else
      %if (%scan(%upcase(%superq(file)),-1,.) eq SAS) %then %do;
         %let _out_type=file;
         %let _out_fileref=_code_;
      %end;
   %end;
   %else %do;
      %let _out_type=fileref;
      %let _out_fileref=%superq(file);
   %end;

   %* if the output fileref is _TEMP_, allocate a temporary fileref ;
   %* otherwise if the output type is a fileref, check if it is allocated ;
   %* otherwise allocate the file ;
   %if (&_out_type eq fileref) %then %do;
      %if (%upcase(&_out_fileref) eq _TEMP_) %then %do;
         %let _out_fileref=_code_;
         filename &_out_fileref temp %if (&append) %then mod;;
      %end;
      %else %do;
         %* is the fileref allocated? ;
         %if (%sysfunc(fileref(&_out_fileref)) gt 0) %then %do;
            %parmv(_msg=&_out_fileref fileref is not allocated)
         %end;
      %end;
   %end;
   %else
   %if (&_out_type eq file) %then %do;
      filename &_out_fileref "&file" %if (&append) %then mod;;
   %end;
   %else
   %if (&_out_type eq catalog) %then %do;
      filename &_out_fileref catalog "&file" %if (&append) %then mod;;
   %end;
%end;

%* if either a shell or metadata dataset was specified, build a keep statement ;
%* if both were specified, merge the data, giving precedence to shell dataset variable order ;
%* if either a shell or metadata dataset was specified, also check the source dataset for expected variables ;
%* and print warnings to the log if any expected variables are missing ;

%* if the lang is SQL, build metadata from the source dataset, since we want to explicitly ;
%* specify each select line (rather than select *) ;
%let vars=name type length varnum label format informat;
%let vars_sql=%seplist(&vars);

%if ( (%superq(meta_columns)%superq(shell) ne ) or (&lang eq SQL) ) %then %do;
   %* unconditionally create source dataset metadata ;
   %* used to check if source data contains all expected variables ;
   %* as specified in the shell or metadata dataset ;
   proc sql;
      create table _meta_source_ (index=(_uname_)) as
         select
             monotonic()+2000 as _order_
            ,upcase(name) as _uname_
            ,&vars_sql
         from
            dictionary.columns
         where
            libname="%upcase(&data_libname)" and memname="%upcase(&data_memname)"
         order by
            varnum
      ;
   quit;

   %if (&shell ne ) %then %do;
      proc sql;
         create table _meta_shell_ (index=(_uname_)) as
            select
                monotonic() as _order_
               ,upcase(name) as _uname_
               ,&vars_sql
            from
               dictionary.columns
            where
               libname="%upcase(&shell_libname)" and memname="%upcase(&shell_memname)"
            order by
               varnum
         ;
      quit;
   %end;

   %if (&meta_columns ne ) %then %do;
      proc sql;
         create table _meta_columns_ (index=(_uname_)) as
            select
               monotonic()+1000 as _order_
               ,upcase(name) as _uname_
               ,*
            from &meta_columns
            %if (%superq(meta_columns_cond) ne ) %then %do;
            where &meta_columns_cond
            %end;
         ;
      quit;
   %end;

   %* if rename parameter was specified, parse rename parameter to create rename metadata dataset ;
   %* to merge in with metadata.  this allows the rename parameter to override shell or metadata specifications ;
   %if (&rename ne ) %then %do;
      data _meta_rename_ (index=(_uname_));
         length _uname_ name rename $32 word $70 buffer $32767;
         buffer="&rename";

         %* remove any embedded spaces surrounding the equals sign ;
         rx=prxparse("s/\s*=\s*/=/");
         buffer=prxchange(rx,-1,buffer);

         i=1;
         word=scan(buffer,i," ");
         do while (word ne "");
            name=scan(word,1,"=");
            rename=scan(word,2,"=");
            _uname_=upcase(name);
            output;
            i+1;
            word=scan(buffer,i," ");
         end;
         keep _uname_ name rename;
      run;
   %end;

   data _meta_columns_ (index=(_order_));
      length _order_ 8 _uname_ name rename $32 type $4 length 8 format informat $49 label $256;
      length _order_so _order_sh _order_md in_source in_shell in_columns in_rename 8;
      call missing(of _all_);
      merge
         %if %sysfunc(exist(_meta_source_))  %then _meta_source_  (in=in_source  rename=(_order_=_order_so));
         %if %sysfunc(exist(_meta_shell_))   %then _meta_shell_   (in=in_shell   rename=(_order_=_order_sh));
         %if %sysfunc(exist(_meta_columns_)) %then _meta_columns_ (in=in_columns rename=(_order_=_order_md));
         %if %sysfunc(exist(_meta_rename_))  %then _meta_rename_  (in=in_rename);
      ;
      by _uname_;
      _order_=coalesce(_order_sh,_order_md,_order_so);

      %* if drop or keep were specified, drop or keep that metadata ;
      %* if both were specified, drop has precedence ;
      %if (&drop ne )                        %then %do; if _uname_ in (%upcase(%seplist(&drop,nest=QQ))) then delete; %end;
      %if (&keep ne )                        %then %do; if _uname_ in (%upcase(%seplist(&keep,nest=QQ))); %end;

      %* check if variables were specified in shell, metadata, or rename, but are not in source ;
      in_meta=max(0,in_shell,in_columns,in_rename);

      if (in_meta and not in_source) then do;
         putlog "WAR" "NING: " _uname_ "variable is not in &data data set.  Check log for further WAR" "NINGS or ERR" "ORS.";
      end;

      %* only keep those variables specified in the metadata ;
      if in_meta;

      drop _order_so _order_sh _order_md in_source in_shell in_columns in_rename;
   run;
   data _meta_columns_;
      set _meta_columns_ end=eof;
      by _order_;

      %* build keep and rename statements from metadata, overriding KEEP and/or RENAME parameters ;
      length buffer buffer2 $32767;
      retain buffer buffer2;
      buffer=catx(" ",buffer,name);
      if ^missing(rename) then buffer2=catx(" ",buffer2,catx("=",name,rename));
      if (eof) then call symputx("keep",buffer,"F");
      if (eof) then call symputx("rename",buffer2,"F");
      drop buffer buffer2;
   run;
%end;

%*---------------------------------------------------------------------
CREATE UTILITY MACROS
--------------------------------------------------------------------- ;

%* Utility macro to parse the BY parameter, ;
%* implementing correct descending syntax for both SAS and SQL ;
%macro parse_by(by=, lang=);
   %local temp;
   %let lang=%upcase(&lang);
   %let i=1;
   %let word=%scan(&by,&i,%str( ));
   %do %while (%quote(&word) ne );
      %if (%qsubstr(&word,1,1) eq %str(-)) %then %do;
         %if (&lang eq SAS) %then %do;
            %let word=descending %substr(&word,2);
         %end;
         %else %do;
            %let word=%substr(&word,2) desc;
         %end;
      %end;
      %if (&lang eq SAS) %then %do;
         %let temp=&temp &word;
      %end;
      %else %do;
         %if (&i gt 1) %then %let temp=&temp,;
         %let temp=&temp &word;
      %end;
      %let i=%eval(&i+1);
      %let word=%scan(&by,&i,%str( ));
   %end;
&temp
%mend;

%* if generating output code, get length of longest variables for cleaner code generation ;
%local max_name max_length max_format max_informat max_rename;
%if (%superq(file) ne ) %then %do;
   %if (%sysfunc(exist(_meta_columns_))) %then %do;
      proc sql noprint;
         select
             max(lengthn(name))
            ,case
                when missing(length) then 0
                else max(lengthn(put(length,8.-L)))
             end
            ,max(lengthn(format))
            ,max(lengthn(informat))
            into :max_name, :max_length, :max_format, :max_informat
         from
            _meta_columns_
         ;
         %if (%varexist(_meta_columns_,rename)) %then %do;
         select
            max(lengthn(rename))
            into :max_rename
         from
            _meta_columns_
         ;
         %end;
      quit;

      %* remove leading spaces ;
      %let max_name=&max_name;
      %let max_length=&max_length;
      %let max_format=&max_format;
      %let max_informat=&max_informat;
      %let max_rename=&max_rename;
   %end;
%end;

%macro SASMacro(
DATA=
,OUT=
,KEEP=
,DROP=
,BY=
,INDEX=
,WHERE=
,RENAME=
,META_COLUMNS=
,META_COLUMNS_COND=
,SHELL=
,TYPE=
,PRE_PROCESS=
,POST_PROCESS=
);

%local name rename type length label format informat;

%* parse by variable to build descending option ;
%let by=%parse_by(by=&by,lang=&lang);

%* create SAS data set / view ;
data &out
   %if (%superq(dslabel)%superq(index_stmt)%superq(out_options) ne ) %then %do; (   %end;
   %if (%superq(dslabel)            ne )              %then %do; label=&dslabel     %end;
   %if (%superq(index_stmt)         ne )              %then %do; &index_stmt        %end;
   %if (%superq(out_options)        ne )              %then %do; &out_options       %end;
   %if (%superq(dslabel)%superq(index_stmt)%superq(out_options) ne ) %then %do; )   %end;

   %if (&type eq VIEW)                                %then %do; / view=&out        %end;
   ;

   %if (%superq(pre_process)        ne )              %then %do; &pre_process;      %end;

   %* if shell data set or metadata data set was specified then create attrib statements ;
   %if (%sysfunc(exist(_meta_columns_))) %then %do;
      %let dsid=%sysfunc(open(_meta_columns_,i));
      %syscall set(dsid);
      %if (%superq(length) eq 0 or %superq(length) eq .) %then %let length=;
      %do %while (%sysfunc(fetch(&dsid)) eq 0);
         %if (%superq(label)        ne ) %then %let label=%sysfunc(quote(&label));
         attrib
            &name
            %if (&length            ne )              %then %if (&type eq char) %then %let length=$&length;
            %if (&length            ne )              %then %do; length=&length     %end;
            %if (&format            ne )              %then %do; format=&format     %end;
            %if (&informat          ne )              %then %do; informat=&informat %end;
            %if (&label             ne )              %then %do; label=&label       %end;
         ;
      %end;
      %let dsid=%sysfunc(close(&dsid));
   %end;

   set &data
   %if (%superq(data_options)       ne )              %then %do; (&data_options)    %end;
   ;

   %if (%superq(where)              ne )              %then %do; where &where;      %end;
   %if (%superq(rename)             ne )              %then %do; rename &rename;    %end;
   %if (%superq(keep)               ne )              %then %do; keep &keep;        %end;
   %if (%superq(drop)               ne )              %then %do; drop &drop;        %end;

   %if (%superq(post_process)       ne )              %then %do; &post_process;     %end;
run;

%* if by was specified and index=N then sort the output data set ;
%if (%superq(by) ne ) %then %do;
   %if (&index_stmt eq ) %then %do;
      proc sort data=&out out=&out_saved;
         by &by;
      run;
   %end;
%end;

%mend;

%macro SASCode(
DATA=
,OUT=
,KEEP=
,DROP=
,BY=
,INDEX=
,WHERE=
,RENAME=
,META_COLUMNS=
,META_COLUMNS_COND=
,SHELL=
,TYPE=
,PRE_PROCESS=
,POST_PROCESS=
,FILE=
,RUN=
);

%* parse by variable to build descending option ;
%let by=%parse_by(by=&by,lang=&lang);

%* account for leading $ for character variables ;
%let max_length=%eval(&max_length+1);

%* generate SAS code ;
data _null_;
   length buffer $32767;
   call missing(buffer);

   * create column pointers for generated code fragments ;
   c_spacing   = 2;
   c_name      = 7;
   c_length    = c_name       + (&max_name     gt 0) * (                       &max_name     + c_spacing);
   c_format    = c_length     + (&max_length   gt 0) * (lengthn("length=")   + &max_length   + c_spacing);
   c_informat  = c_format     + (&max_format   gt 0) * (lengthn("format=")   + &max_format   + c_spacing);
   c_label     = c_informat   + (&max_informat gt 0) * (lengthn("informat=") + &max_informat + c_spacing);

   %macro dsvar;
      %local temp;
      %let temp=%unquote(&&&word);
      %if (%superq(temp) eq ) %then %do;
         &word = "";
      %end;
      %else %do;
         &word = %sysfunc(quote(%superq(temp)));
      %end;
   %mend;
   %loop(
      data data_options out out_options out_saved dslabel
      where keep drop rename
      by index_stmt
      pre_process post_process
      ,mname=dsvar
   )

   file &_out_fileref col=c;

   link start;
   link pre_process;
   link attrib;
   link set;
   link where;
   link post_process;
   link keep;
   link drop;
   link rename;
   link run;
   link sort;

   stop;

start:
   c=1;                                                        put @c "data " out @;
   if (^missing(cats(dslabel,index_stmt,out_options)))   then  put "(" @;
   if (^missing(dslabel))                                then  put "label=" dslabel @;
   if (^missing(index_stmt))                             then  put index_stmt @;
   if (^missing(out_options))                            then  put out_options @;
   c=c-1;
   if (^missing(cats(dslabel,index_stmt,out_options)))   then  put @c ") " @;
   if ("&type" eq "VIEW")                                then  put "/ view=" out @;
   put +(-1) ";";
return;

attrib:
   %if (%sysfunc(exist(_meta_columns_))) %then %do;
      c=4;                                                     put @c "attrib";
      eof=0;
      do until (eof);
         call missing(buffer);
         set _meta_columns_ (drop=rename) end=eof;
         c=c_name;                                             put @c name $%eval(&max_name+2).-L @;
         if (^missing(length))                           then  buffer=ifc(type eq "char",cats("$",length),cats(length));
         c=c_length;   if (^missing(buffer))             then  put @c "length=" buffer $%sysfunc(max(1,&max_length)).-R @;
         c=c_format;   if (^missing(format))             then  put @c "format=" format $%eval(&max_format+2).-L @;
         c=c_informat; if (^missing(informat))           then  put @c "informat=" informat $%eval(&max_informat+2).-L @;
         c=c_label;    if (^missing(label))              then  do;
            buffer=quote(trim(label));
                                                               put @c "label=" buffer @;
         end;
         put;
      end;
      c=4;                                                     put @c ";";
   %end;
return;

set:
   c=4;                                                        put @c "set " data @;
   if (^missing(data_options))                           then  put "(" data_options +(-1) ")" @;
   c=c-1;                                                      put @c ";";
return;

where:
   c=4; if (^missing(where))                            then  put @c "where " where +(-1) ";";
return;

keep:
   %splitvar(keep, 70, split=~, hanging_indent=0)
   c=4; if (^missing(keep))                             then  put @c "keep";
   i=1;
   buffer=scan(keep,i,"~");
   do while (buffer ne "");
      c=7;
      put @c buffer;
      i+1;
      buffer=scan(keep,i,"~");
   end;
   c=4;                                                       put @c ";";
return;

drop:
   c=4; if (^missing(drop))                             then  put @c "drop " drop +(-1) ";";
return;

rename:
   %splitvar(rename, 70, split=~, hanging_indent=0)
   c=4; if (^missing(rename))                           then  put @c "rename";
   i=1;
   buffer=scan(rename,i,"~");
   do while (buffer ne "");
      c=7;
      put @c buffer;
      i+1;
      buffer=scan(rename,i,"~");
   end;
   c=4;                                                       put @c ";";
return;

run:
   c=1;                                                        put @c "run;" /;
return;

%* if by was specified and index=N then sort the output data set ;
sort:
   if (^missing(by) and missing(index_stmt))             then do;
   c=1;                                                        put @c "proc sort data=" out "out=" out_saved @;
   if (^missing(cats(dslabel,out_options)))              then  put "(" @;
   if (^missing(dslabel))                                then  put "label=" dslabel @;
   if (^missing(out_options))                            then  put out_options @;
   c=c-1;
   if (^missing(cats(dslabel,out_options)))              then  put @c ") " @;
   c=c-1;                                                      put @c ";";
   c=4;                                                        put @c "by " by +(-1) ";";
   c=1;                                                        put @c "run;" /;
   end;
return;

pre_process:
   c=4; if (^missing(pre_process))                       then  put @c pre_process +(-1) ";";
return;

post_process:
   c=4; if (^missing(post_process))                      then  put @c post_process +(-1) ";";
return;

run;

%if (&run) %then %do;
   %let options=%sysfunc(getoption(mprint,keyword));
   options nomprint;
   %include &_out_fileref / source source2;
   options &options;
%end;

%mend;

%macro SQLMacro(
DATA=
,OUT=
,KEEP=
,DROP=
,BY=
,INDEX=
,WHERE=
,RENAME=
,META_COLUMNS=
,META_COLUMNS_COND=
,SHELL=
,TYPE=
,PRE_PROCESS=
,POST_PROCESS=
);

%* parse by variable to build descending option ;
%let by=%parse_by(by=&by,lang=&lang);

%* generate SQL code ;
proc sql;
   create %sysfunc(ifc(&type eq VIEW,view,table)) &out

   %if (%superq(dslabel)%superq(index_stmt)%superq(out_options) ne ) %then %do; (   %end;
   %if (%superq(dslabel)            ne )              %then %do; label=&dslabel     %end;
   %if (%superq(index_stmt)         ne )              %then %do; &index_stmt        %end;
   %if (%superq(out_options)        ne )              %then %do; &out_options       %end;
   %if (%superq(dslabel)%superq(index_stmt)%superq(out_options) ne ) %then %do; )   %end;

   as
      select

      %if (%sysfunc(exist(_meta_columns_))) %then %do;
         %let i=0;
         %let dsid=%sysfunc(open(_meta_columns_,i));
         %syscall set(dsid);
         %if (%superq(length) eq 0 or %superq(length) eq .) %then %let length=;
         %do %while (%sysfunc(fetch(&dsid)) eq 0);
            %if (%superq(label)     ne ) %then %let label=%sysfunc(quote(&label));
            %if (&i ne 0)                             %then %do; ,                  %end;
            &name
            %if (%superq(rename)    ne )              %then %do; as &rename         %end;
            %if (%superq(length)    ne )              %then %do; length=&length     %end;
            %if (%superq(format)    ne )              %then %do; format=&format     %end;
            %if (%superq(informat)  ne )              %then %do; informat=&informat %end;
            %if (%superq(label)     ne )              %then %do; label=&label       %end;
            %let i=1;
         %end;
         %let dsid=%sysfunc(close(&dsid));
      %end;

      from &data
      %if (%superq(data_options)    ne )              %then %do; (&data_options)    %end;

      %if (%superq(where)           ne )              %then %do; where &where       %end;
      %if ((%superq(by) ne ) and (&index_stmt eq ))   %then %do; order by &by       %end;
      ;
   quit;
run;

%mend;

%macro SQLCode(
DATA=
,OUT=
,KEEP=
,DROP=
,BY=
,INDEX=
,WHERE=
,RENAME=
,META_COLUMNS=
,META_COLUMNS_COND=
,SHELL=
,TYPE=
,PRE_PROCESS=
,POST_PROCESS=
,FILE=
,RUN=
);

%* parse by variable to build descending option ;
%let by=%parse_by(by=&by,lang=&lang);

%* generate SQL code ;
data _null_;
   length buffer $32767;
   call missing(buffer);

   * create column pointers for generated code fragments ;
   c_spacing   = 2;
   c_name      = 10;
   c_rename    = c_name + 1   + (&max_name     gt 0) * (&max_name + c_spacing);
   c_length    = c_rename     + (&max_rename   gt 0) * (lengthn(" as")       + &max_rename   + c_spacing);
   c_format    = c_length     + (&max_length   gt 0) * (lengthn("length=")   + &max_length   + c_spacing);
   c_informat  = c_format     + (&max_format   gt 0) * (lengthn("format=")   + &max_format   + c_spacing);
   c_label     = c_informat   + (&max_informat gt 0) * (lengthn("informat=") + &max_informat + c_spacing);

   %macro dsvar;
      %local temp;
      %let temp=%unquote(&&&word);
      %if (%superq(temp) eq ) %then %do;
         &word = "";
      %end;
      %else %do;
         &word = %sysfunc(quote(%superq(temp)));
      %end;
   %mend;
   %loop(
      data data_options out out_options out_saved dslabel
      where keep drop
      by index_stmt
      pre_process post_process
      ,mname=dsvar
   )

   file &_out_fileref col=c;

   link start;
   link pre_process;
   link create;
   link select;
   link post_process;
   link from;
   link where;
   link by;
   link quit;

   stop;

start:
   c=1;                                                        put @c "proc sql;";
return;

create:
   c=4;                                                        put @c "create " @;
   buffer=ifc("&type" eq "VIEW","view","table");
   buffer=catx(" ",buffer,out);
                                                               put buffer @;
   if (^missing(cats(dslabel,index_stmt,out_options)))   then  put "(" @;
   if (^missing(dslabel))                                then  put "label=" dslabel @;
   if (^missing(index_stmt))                             then  put index_stmt @;
   if (^missing(out_options))                            then  put out_options @;
   c=c-1;
   if (^missing(cats(dslabel,index_stmt,out_options)))   then  put @c ") " @;

   put "as";
return;

select:
   c=7;                                                        put @c "select";
   i=0;
   do until (eof1);
      call missing(buffer);
      c=c_name+(i=0);                                          put @c @;
      if (i ne 0)                                        then  put "," @;
      set _meta_columns_ end=eof1;
                                                               put name $%eval(&max_name+1).-L @;
      c=c_rename; if (^missing(rename))                  then  put @c "as " rename $%eval(&max_rename+1).-L @;
      c=c_length; if (^missing(length))                  then  put @c "length=" length %sysfunc(max(1,&max_length)).-R @;
      c=c_format; if (^missing(format))                  then  put @c "format=" format $%eval(&max_format+1).-L @;
      c=c_informat; if (^missing(informat))              then  put @c "informat=" informat $%eval(&max_informat+1).-L @;
      if (^missing(label))                               then  do;
         buffer=quote(trim(label));
         c=c_label;                                            put @c "label=" buffer @;
      end;
      put;
      i=1;
   end;
return;

from:
   c=7;                                                        put @c "from";
   c=10;                                                       put @c data @;
   if (^missing(data_options))                           then  put "(" data_options +(-1) ")" @;
   put;
return;

where:
   if (^missing(where))                                  then do;
      c=7;                                                     put @c "where";
      c=10;                                                    put @c where;
   end;
return;

by:
   if (^missing(by))                                     then do;
      c=7;                                                     put @c "order by";
      c=10;                                                    put @c by;
   end;
return;

quit:
   c=4;                                                        put @c ";";
   c=1;                                                        put @c "quit;" /;
return;

pre_process:
   c=4; if (^missing(pre_process))                       then  put @c pre_process;
return;

post_process:
   c=7; if (^missing(post_process))                      then  put @c post_process;
return;

run;

%if (&run) %then %do;
   %let options=%sysfunc(getoption(mprint,keyword));
   options nomprint;
   %include &_out_fileref / source source2;
   options &options;
%end;

%mend;

%* now generate and/or execute the desired code ;
%if (&lang eq SAS and %superq(file) eq ) %then %do;
   %SASMacro(
      DATA=&data
      ,OUT=&out
      ,KEEP=&keep
      ,DROP=&drop
      ,BY=&by
      ,INDEX=&index
      ,WHERE=&where
      ,RENAME=&rename
      ,META_COLUMNS=&meta_columns
      ,META_COLUMNS_COND=&meta_columns_cond
      ,SHELL=&shell
      ,TYPE=&type
      ,PRE_PROCESS=&pre_process
      ,POST_PROCESS=&post_process
   )
%end;
%else
%if (&lang eq SAS and %superq(file) ne ) %then %do;
   %SASCode(
      DATA=&data
      ,OUT=&out
      ,KEEP=&keep
      ,DROP=&drop
      ,BY=&by
      ,INDEX=&index
      ,WHERE=&where
      ,RENAME=&rename
      ,META_COLUMNS=&meta_columns
      ,META_COLUMNS_COND=&meta_columns_cond
      ,SHELL=&shell
      ,TYPE=&type
      ,PRE_PROCESS=&pre_process
      ,POST_PROCESS=&post_process
      ,FILE=&file
      ,RUN=&run
   )
%end;
%else
%if (&lang eq SQL and %superq(file) eq ) %then %do;
   %SQLMacro(
      DATA=&data
      ,OUT=&out
      ,KEEP=&keep
      ,DROP=&drop
      ,BY=&by
      ,INDEX=&index
      ,WHERE=&where
      ,RENAME=&rename
      ,META_COLUMNS=&meta_columns
      ,META_COLUMNS_COND=&meta_columns_cond
      ,SHELL=&shell
      ,TYPE=&type
      ,PRE_PROCESS=&pre_process
      ,POST_PROCESS=&post_process
   )
%end;
%else
%if (&lang eq SQL and %superq(file) ne ) %then %do;
   %SQLCode(
      DATA=&data
      ,OUT=&out
      ,KEEP=&keep
      ,DROP=&drop
      ,BY=&by
      ,INDEX=&index
      ,WHERE=&where
      ,RENAME=&rename
      ,META_COLUMNS=&meta_columns
      ,META_COLUMNS_COND=&meta_columns_cond
      ,SHELL=&shell
      ,TYPE=&type
      ,PRE_PROCESS=&pre_process
      ,POST_PROCESS=&post_process
      ,FILE=&file
      ,RUN=&run
   )
%end;

%quit:
%if (%sysfunc(fileref(_code_)) le 0) %then %do;
   /* filename _code_ clear; */
%end;

%mend;

/******* END OF FILE *******/


text:
/*=====================================================================
Program Name            : sendmail.sas
Purpose                 : Macro to send an email using a metadata dataset
SAS Version             : SAS 9.1.3
Input Data              : Dataset containing email text
Output Data             : Email sent to desired recipients

Macros Called           : parmv, seplist

Originally Written by   : Scott Bass
Date                    : 12MAR2008
Program Version #       : 1.0

=======================================================================

Scott Bass (sas_l_739@yahoo.com.au)

This code is licensed under the Unlicense license.
For more information, please refer to http://unlicense.org/UNLICENSE.

This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

=======================================================================

Modification History    :

Programmer              : Scott Bass
Date                    : 22NOV2013
Change/reason           : Changed to make email dataset optional in
                          order to send "subject only" emails.
Program Version #       : 1.1

=====================================================================*/

/*---------------------------------------------------------------------
Usage:

* specify message only, other options are macro parameters ;
data mail;
   length parm $15 line $1000;
   infile datalines dsd dlm="|" truncover;
   input parm line;
   datalines;
| Dear Support
|
| Job foo failed.
| See bar for details.
| Test of &sysprocessid..
;
run;

%sendmail(
  to=&sysuserid
  ,subject=%str(This is the subject as of &sysdate and &systime)
)

=======================================================================

* specify all parameters in the metadata dataset ;
%let job=My Job;
data mail;
   length parm $15 line $1000;
   infile datalines dsd dlm="|" truncover;
   input parm line;
   datalines;
TO       | jack@sas.com^jill@sas.com
CC       | Joe User <joe@sas.com>
CC       | Jane User <jane@sas.com>
FROM     | Real Name <real.name@sas.com>
SUBJECT  | Job &job failed at %sysfunc(date(),date7.) %sysfunc(time(),time5.)
ATTACH   | "%sysfunc(pathname(fileref_to_error_log))"
         | Dear Support
         |
         | Job foo failed.
         | See bar for details.
         | Date &sysdate Time &systime..
;
run;

%sendmail;

=======================================================================

* send a "subject only" email without any email message ;
%sendmail(
  metadata=_null_
  ,to=&sysuserid
  ,subject=%str(This is the subject as of &sysdate and &systime)
)

-----------------------------------------------------------------------
Notes:

The end user is responsible for specifying correct parameters for the
macro.  Little error checking is done.

See http://support.sas.com/onlinedoc/913/getDoc/en/lrdict.hlp/a002058232.htm
for documentation on parameter syntax.

To send a "subject only" email with no email message, specify
METADATA=_null_ for the metadata dataset parameter.

Parameters can be specified as macro parameters, or included in the
metadata dataset.  If included in the metadata dataset, the names
must match the macro variables in the macro parameters.  The names are
case insensitive.  If both macro parameter and metadata parameters are
specified, the metadata parameters take precedence.

To, Cc, and Bcc parameters should be separated with a caret (^), since
they can contain spaces.  Do not add any syntax (eg. quotation marks),
the macro will take care of this.

To, Cc, Bcc, and Attach can be specified all on one line, or on separate lines.
If on separate lines, they will be concatenated into the appropriate
addressee or attachment list.

For the remaining parameters, if specified multiple times, the last
parameter specified will be used.

At a minimum, the text of the email must be included in the metadata
dataset.  The parm variable should be missing for the text of the email.
Make sure the line variable is long enough to contain *resolved* macro
variable references without data truncation.

Macro variable references in the metadata dataset are resolved at macro
run time.
---------------------------------------------------------------------*/

%macro sendmail
/*---------------------------------------------------------------------
Macro to send an email using a metadata dataset
---------------------------------------------------------------------*/
(METADATA=mail /* Metadata dataset (REQ).                            */
,TO=           /* To addressee (Opt).                                */
,CC=           /* Cc addressee (Opt).                                */
,BCC=          /* Bcc addressee (Opt).                               */
,FROM=
               /* From addressee (Opt).                              */
,REPLYTO=      /* Reply-to addressee (Opt).                          */
,SUBJECT=      /* Subject (Opt).                                     */
,ATTACH=       /* Attachment (Opt).                                  */
,CONTENT_TYPE= /* Content type (Opt).                                */
,ENCODING=     /* Encoding (Opt).                                    */
);

%local macro parmerr metadata_exists;

%* check input parameters ;
%let macro = &sysmacroname;
%parmv(METADATA,     _req=1,_words=0,_case=U)

%if (&parmerr) %then %goto quit;

%let metadata_exists=%sysfunc(exist(&metadata));

%* create macro variables from the metadata dataset, ;
%* overwriting any parameters passed in as macro parameters ;
%let options=%sysfunc(getoption(serror));
%if (&metadata_exists) %then %do;
  options noserror;
  data _null_;
     set &metadata end=eof;
     where parm is not missing;
     length to cc bcc attach $10000;  /* adjust length as desired, but make long enough for resolved values */
     retain to cc bcc attach;
     select(upcase(parm));
        when("TO")     to       = catx("^",to,       line);
        when("CC")     cc       = catx("^",cc,       line);
        when("BCC")    bcc      = catx("^",bcc,      line);
        when("ATTACH") attach   = catx("^",attach,   line);
        when("FROM","REPLYTO","SUBJECT","CONTENT_TYPE","ENCODING")
           call symputx(parm,line);
        otherwise do;
           put "ERR" "OR: " parm "is an invalid parameter.";
           call symputx("parmerr",1);
           stop;
        end;
     end;
     if eof then do;
        if length(to)     then call symputx("TO",     to);
        if length(cc)     then call symputx("CC",     cc);
        if length(bcc)    then call symputx("BCC",    bcc);
        if length(attach) then call symputx("ATTACH", attach);
     end;
  run;
%end;

%if (&parmerr) %then %goto quit;

%* error checking ;
%parmv(TO,           _req=1,_words=1,_case=N)

%if (&parmerr) %then %goto quit;

%* issue filename statement ;
filename email email
   %let temp = %seplist(&to,nest=QQ,indlm=^,dlm=%str( ));
   to=(&temp)

%if (%superq(cc) ne ) %then %do;
   %let temp = %seplist(&cc,nest=QQ,indlm=^,dlm=%str( ));
   cc=(&temp)
%end;

%if (%superq(bcc) ne ) %then %do;
   %let temp = %seplist(&bcc,nest=QQ,indlm=^,dlm=%str( ));
   bcc=(&temp)
%end;

%if (%superq(subject) ne ) %then %do;
   subject="&subject"
%end;

%if (%superq(from) ne ) %then %do;
   from="&from"
%end;

%if (%superq(replyto) ne ) %then %do;
   replyto="&replyto"
%end;

%if (%superq(attach) ne ) %then %do;
   %let temp = %seplist(&attach,nest=QQ,indlm=^,dlm=%str( ));
   attach=(&temp)
%end;

%if (%superq(content_type) ne ) %then %do;
   content_type="&content_type"
%end;

%if (%superq(encoding) ne ) %then %do;
   encoding="&encoding"
%end;
;

%* now send the email ;
data _null_;
   file email;
/*   file print; */  /* for debugging */
   %if (&metadata_exists) %then %do;
   set &metadata;
   where parm is missing;
   line = resolve(line);
   put line;
   %end;
run;

filename email clear;
options &options;

%quit:
%mend;

/******* END OF FILE *******/

repo_name: scottbass/SAS

repo_language: SAS

mime_type: text/plain


text:
/*=====================================================================
Program Name            : queryActiveDirectory.sas
Purpose                 : Execute an LDAP query against Active Directory
SAS Version             : SAS 9.2
Input Data              : Active Directory
Output Data             : WORK.LDAP data step view of Active Directory

Macros Called           : parmv

Originally Written by   : Scott Bass
Date                    : 06JUL2012
Program Version #       : 1.0

=======================================================================

Scott Bass (sas_l_739@yahoo.com.au)

This code is licensed under the Unlicense license.
For more information, please refer to http://unlicense.org/UNLICENSE.

This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

=======================================================================

Modification History    :

Programmer              : Scott Bass
Date                    : 30JUN2013
Change/reason           : Changed the base DN to the default base DN
                          configured in Active Directory.
                          This change is due to changes by IT to the
                          OU structure for user objects.
Program Version #       : 1.1

Programmer              : Scott Bass
Date                    : 06JUL2016
Change/reason           : Changed the base DN to the default base DN
                          configured in Active Directory for Medibank.
Program Version #       : 1.2

=====================================================================*/

/*---------------------------------------------------------------------
Usage:

* return all user information for the current user (&sysuserid) ;
* specify debug= parameter for informational or full debugging ;
* Note:  Because it creates a data step view, you will not see ;
* anything in the log until you execute the proc print ;

* makes debgging info in log easier to read ;
options ls=max;

* makes proc print output easier to read ;
options ps=max nocenter;

%queryActiveDirectory;
%queryActiveDirectory(debug=I)
%queryActiveDirectory(debug=F)

proc print;
  where length(value) < 60;
run;

=======================================================================

* return all user information for a particular user ;
%queryActiveDirectory(
  filter=(&(samaccountname=rbowden)(objectclass=user))
  ,debug=I
);

proc print;
  var name value;
  format value $100.;
run;

=======================================================================

* return full name, first name, last name, and email address for a particular user ;
%queryActiveDirectory(
  filter=(samaccountname=rbowden)
  ,attrs=cn givenName sn mail
  ,debug=F
);

proc print;
run;

=======================================================================

* return full name of all users in the Sydney branch of the Active Directory tree ;
* whose first names begin with "S" ;
%queryActiveDirectory(
  base=%str(OU=Sydney,OU=BUPAUsers,DC=internal,DC=bupa,DC=com,DC=au)
  ,filter=(givenName=S*)
  ,attrs=cn
);

proc print;
  var value;
run;

=======================================================================

* return full name of all users in the Melbourne branch of the Active Directory tree ;
* whose first or last names contain "will" ;
* (queries are case-insensitive by default) ;
%queryActiveDirectory(
  base=%str(OU=Melbourne,OU=BUPAUsers,DC=internal,DC=bupa,DC=com,DC=au)
  ,filter=(|(givenName=*will*)(sn=*will*))
  ,attrs=cn
);

proc print;
  var value;
run;

=======================================================================

* return all user objects (may take a long time to run) ;
* in fact, it fails due ldap server sizelimit exceeded ;
%queryActiveDirectory(
  filter=(objectclass=user)
);

proc print data=&syslast (obs=50);
run;

=======================================================================

* return ALL objects (will definitely take a long time to run) ;
* in fact, it fails due ldap server sizelimit exceeded ;
%queryActiveDirectory(
  filter=(objectclass=*)
);

proc print data=&syslast (obs=50);
run;

=======================================================================

* example of post processing the data in SAS ;
* return all users with Rob Ashmore as their manager ;
%queryActiveDirectory(
  base=%str(OU=Sydney,OU=BUPAUsers,DC=internal,DC=bupa,DC=com,DC=au)
  ,filter=(manager=CN=Rob Ashmore,OU=Sydney,OU=BUPAUsers,DC=internal,DC=bupa,DC=com,DC=au)
  ,attrs=givenName sn streetAddress l st postalCode mail telephoneNumber mobile title
);

* create macro variables ;
data _null_;
  set ldap;
  by entryname notsorted;
  if first.entryname then ctr+1;
  if name="l" then name="city";
  call symputx(cats(name,ctr),strip(value),"G");
run;

%put &givenname1 &sn1 &mail1 &mobile1; * etc, etc. ;
%put &givenname2 &sn2 &mail2 &mobile2;
%put &givenname3 &sn3 &mail3 &mobile3;

* or, transpose the data instead ;
* note: this would give undesired results if the LDAP attribute name ;
* is not a valid SAS variable name ;
proc transpose data=ldap out=transposed (rename=(l=city) drop=_name_);
  by entryname notsorted;
  id name;
  var value;
run;

* if you know the attribute is a multi-valued attribute, ;
* you would probably want to return the data as a delimited list ;
%queryActiveDirectory(
  base=%str(OU=Sydney,OU=BUPAUsers,DC=internal,DC=bupa,DC=com,DC=au)
  ,filter=(cn=Scott Bass)
);
proc sql noprint;
  select
    value into :email_proxies separated by "^"
  from
    ldap
  where
    lowcase(name) = "%lowcase(proxyaddresses)"
  ;
  select
    value into :email_lists separated by "^"
  from
    ldap
  where
    lowcase(name) = "%lowcase(memberof)"
  ;
quit;
%put &email_proxies;
%put &email_lists;

-----------------------------------------------------------------------
Notes:

LDAP, and thus Active Directory, is an object-oriented database with a
tree structure.  Since this structure cannot be mimicked in SAS, the
output data step view is a "flattened" view of Active Directory.

As with SQL pass through against an RDBMS, you will get MUCH better
performance if you make Active Directory do the filtering, rather than
returning "everything" and then filtering in SAS.

You can use the LDP command ("C:\Program Files (x86)\Support Tools\ldp.exe")
to view the structure of Active Directory.  For a primer on this
command and LDAP query syntax, see
http://technet.microsoft.com/en-us/library/aa996205(v=exchg.65).aspx#DoingASearchUsingADUC

Certain LDAP searches will execute quicker than others, for example
searching on sAMAccountName (network login) vs. mail (email address).
For best results, set the Base DN as low in the directory tree as
possible to get the desired results, analogous to searching a Windows
directory structure as low as possible.  Again, the LDP command is your
friend here.

IT has created a service account with a non-expiring password for
programmatic querying of Active Directory.  The details of the service
account are below.  The password must be sent in the clear (not
encoded in any way).

The most common query would be for user information, which has an
objectclass hierarchy of objectclass=organizationalPerson at the lowest level.

The default parameters of this macro are purposely restrictive in
order to return the attributes of the currently logged on user.

I envision that this generic macro would be the "engine" for a wrapper
macro, such as returning the email address for a given user.

This code is based on
http://support.sas.com/rnd/itech/doc9/dev_guide/ldap/ldapintf/ldap_search.html.

---------------------------------------------------------------------*/

%macro queryActiveDirectory
/*---------------------------------------------------------------------
Execute an LDAP query against Active Directory
---------------------------------------------------------------------*/
(SERVER=MPLINF001.medibank.local
               /* Server address of Active Directory (REQ).          */
,PORT=389
               /* Server port of Active Directory (REQ).             */
,BASE=%str(DC=medibank,DC=local)
               /* Base DN (Distinguished Name) from which to start   */
               /* the LDAP search (REQ).                             */
               /* The default Base DN used by Active Directory is    */
               /* DC=medibank,DC=local                               */
               /* which is analogous to the root directory in a      */
               /* file system or Windows drive.                      */
,BINDDN=%str(CN=&LDAPName,OU=Staff,OU=Medibank PHI,OU=MPL Staff,DC=medibank,DC=local)
               /* Bind DN used to connect to Active Directory (REQ). */
               /* Our Active Directory is not configured for         */
               /* anonymous binds, so a valid Bind DN and password   */
               /* is required.  You will not usually need to change  */
               /* this value.  However, if you want to connect as    */
               /* yourself, it would be something like:              */
               /* CN=Scott Bass,OU=BUPAUsers,DC=internal, DC=bupa,...*/
               /* and your current LAN password (clear text).        */
,PW=&LDAPPassword
               /* Bind DN password (REQ).  As above, you will not    */
               /* usually need to change this value.                 */
,FILTER=(&(samaccountname=&sysuserid)(objectclass=organizationalPerson))
               /* LDAP query filter (REQ).                           */
               /* This will retrieve the user object of the current  */
               /* user for LAN accounts ONLY (i.e. not PRODUSR)      */
,ATTRS=
               /* Requested LDAP attributes to return (Opt).         */
               /* A blank value will return all attributes for the   */
               /* retrieve object.  Specify attributes as a spaced   */
               /* delimited list, eg. cn givenName sn mail.          */
,DEBUG=
               /* Echo debugging information in the SAS log? (Opt).  */
               /* Valid values are:                                  */
               /*    Blank = no debugging                            */
               /*    I     = connection information only             */
               /*    F     = full debugging (on a large query this   */
               /*          =    can fill the SAS DMS log)            */
);

%local macro parmerr;
%let macro = &sysmacroname;

%* check input parameters ;
%parmv(SERVER,       _req=1,_words=0,_case=N)
%parmv(PORT,         _req=1,_words=0,_case=N)
%parmv(BASE,         _req=1,_words=1,_case=N)
%parmv(BINDDN,       _req=1,_words=1,_case=N)
%parmv(PW,           _req=1,_words=0,_case=N)
%parmv(FILTER,       _req=1,_words=1,_case=N)
%parmv(ATTRS,        _req=0,_words=1,_case=N)
%parmv(DEBUG,        _req=0,_words=0,_case=U,_val=I F)

%if (&parmerr) %then %goto quit;

%global qad_rc;
%let qad_rc=-1;  %* queryActiveDirectory was called, but work.ldap data step view not referenced yet ;

data work.ldap / view=work.ldap;
  length entryName msg $200 name $50 value $4096;

  %* initialize custom return code (syscc is not suitable) ;
  call symputx("qad_rc",0,"G");

  %* initialize variables ;
  rc=0;
  handle=0;
  shandle=0;
  numEntries=0;
  debug="&debug";

  %* open connection to LDAP server ;
  call ldaps_open(handle, "&server", &port, "&base", "&bindDN", "&PW", rc);

  if (rc ne 0) then do;
    msg = sysmsg();
    putlog msg;
    putlog "Server:  &server";
    putlog "Port:    &port";
    putlog "Bind DN: &bindDN";
    putlog "Bind PW: ********";

    %* display message and cleanup resources ;
    link noconnection;
  end;
  else do;
    if (debug ne "") then do;
      putlog "LDAPS_OPEN call successful.";
    end;
  end;

  %* search the LDAP directory ;
  call ldaps_search(handle, shandle, "&filter", "&attrs", numEntries, rc);
  if (rc ne 0 or numEntries eq 0) then do;
    msg = sysmsg();
    putlog msg;
    putlog "Base DN: &base";
    putlog "Filter:  &filter";
    putlog "Attrs:   &attrs";

    %* display message and cleanup resources ;
    link noentries;
  end;
  else do;
    if (debug ne "") then do;
      putlog "LDAPS_SEARCH call successful.";
      putlog "Num entries returned is " numEntries;
    end;
  end;

  do eIndex = 1 to numEntries;
    numAttrs=0;
    entryname="";

    %* retrieve each entry name and number of attributes ;
    call ldaps_entry(shandle, eIndex, entryname, numAttrs, rc);
    if (rc ne 0 or numAttrs eq 0) then do;
      msg = sysmsg();
      putlog msg;

      %* display message and cleanup resources ;
      link noattrs;
    end;
    else do;
      if (debug ne "") then do;
        putlog "LDAPS_ENTRY call successful.";
        putlog "Num attributes returned is " numAttrs;
      end;
    end;

    do aIndex = 1 to numAttrs;
      numValues=0;
      name="";

      %* for each attribute, retrieve name and number of values ;
      call ldaps_attrName(shandle, eIndex, aIndex, name, numValues, rc);
      if (rc ne 0) then do;
        msg = sysmsg();
        putlog msg;
        link novalues;
      end;

      do vIndex = 1 to numValues;
        %* for each attribute, retrieve the values (may be more than one) ;
        call ldaps_attrValue(shandle, eIndex, aIndex, vIndex, value, rc);
        if (rc ne 0) then do;
           msg = sysmsg();
           putlog msg;
           link novalues;
        end;
        else do;
          if (debug="F") then do;
            putlog name= @60 value=;
          end;
          output;
        end;
      end;
    end;
  end;

  cleanup:
    link free;
    link close;
  return;

  free:
    if (shandle=0) then return;

    %* free search resources ;
    call ldaps_free(shandle, rc);
    if (rc ne 0) then do;
      msg = sysmsg();
      putlog msg;
    end;
    else do;
      if (debug ne "") then do;
        putlog "LDAPS_FREE call successful.";
      end;
    end;
  return;

  close:
    if (handle=0) then stop;

    %* close connection to LDAP server ;
    call ldaps_close(handle, rc);
    if (rc ne 0) then do;
       msg = sysmsg();
       putlog msg;
    end;
    else do;
      if (debug ne "") then do;
        putlog "LDAPS_CLOSE call successful.";
      end;
    end;

    %* all calls to close result in a stop ;
    stop;
  return;

  noconnection:
    putlog "Unable to contact the LDAP server.  Check your connection settings.";
    call symputx("qad_rc",3891);
    link cleanup;
  return;

  noentries:
    putlog "No entries found.  Check your Base DN or search filter.";
    call symputx("qad_rc",3892);
    link cleanup;
  return;

  noattrs:
    putlog "No attributes found.  Check your attributes setting.";
    call symputx("qad_rc",3893);
    link cleanup;
  return;

  novalues:
    putlog "Error retrieving values.";
    call symputx("qad_rc",3894);
    link cleanup;
  return;

  keep entryName name value;
run;

%quit:
%mend;

/******* END OF FILE *******/


text:
/*=====================================================================
Program Name            : delete_file.sas
Purpose                 : Deletes an external file, either by physical
                          filename or by pre-allocated fileref.
SAS Version             : SAS 9.3
Input Data              : N/A
Output Data             : N/A

Macros Called           : parmv

Originally Written by   : Scott Bass
Date                    : 30NOV2016
Program Version #       : 1.0

=======================================================================

Scott Bass (sas_l_739@yahoo.com.au)

This code is licensed under the Unlicense license.
For more information, please refer to http://unlicense.org/UNLICENSE.

This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

=======================================================================

Modification History    : Original version

=====================================================================*/

/*---------------------------------------------------------------------
Usage:

First create a dummy external file accessible to your SAS server
session.  This means if you are using EG the file path must be from the
perspective of the server, not your local machine.  If in doubt, try
using a full UNC path, i.e. \\machine\folder\@@@.txt.

%let file=\\machine\folder\@@@.txt;  %* change to suit your environment ;

%delete_file(&file)

Deletes the file \\machine\folder\@@@.txt by its physical name.

=======================================================================

filename foo "&file";
%delete_file(foo)
filename foo;

Deletes the file \\machine\folder\@@@.txt by its fileref.
Note that the fileref must be allocated and deallocated outside the
macro.  The macro does not deallocate the fileref, even though the
underlying file has been deleted.

=======================================================================

%put %delete_file(&file,rc=Y);

* or ;
%let myrc=%delete_file(&file,rc=Y);
%put &=myrc;

Returns an optional return code to the macro processor code stream.
0=file was successfully deleted, not 0=file was not deleted.

=======================================================================

%delete_file(C:\doesnotexist.txt)
%delete_file(C:\Does\Not\Exist\doesnotexist.txt)
%put %delete_file(C:\Does\Not\Exist\doesnotexist.txt,rc=Y);
%let myrc=%delete_file(C:\Does\Not\Exist\doesnotexist.txt,rc=Y);
%put &=myrc;

%delete_file(XXX)
%delete_file(XXX,rc=Y);
%let myrc=%delete_file(XXX,rc=Y);
%put &=myrc;

Error checking:
Should not generate any messages:
   Even if the directory path and filename does not exist.
   Even if the fileref has not been allocated.

-----------------------------------------------------------------------
Notes:

By default, this macro is "pure macro" code so does not submit any code
to the SAS compiler.  If you then needed to confirm the deletion of the
file, you would have to manually code this outside the macro.

By default this macro (purposely) does not return a return code.
If you want a return code set, specify rc=Y, and call the macro in the
context of an rvalue, i.e. on the right side of an assignment
statement or boolean condition.

The return code is the return code from the FEXIST function, rather
than the return code from the call to FDELETE.  This is a "safer"
approach to checking that the file has actually been deleted.

I've purposely made this macro rather "quiet" by not printing messages
if the file does not exist, if the fileref is not allocated, etc.,
unlike the del or rm commands in Windows or Unix.

The logic trigger to determine whether the FILE parameter is a physical
path or a fileref is the presence of a slash (/ or \) in the parameter.

---------------------------------------------------------------------*/

%macro delete_file
/*---------------------------------------------------------------------
Deletes an external file, either by physical filename or by
pre-allocated fileref.
---------------------------------------------------------------------*/
(FILE          /* Physical file path or pre-allocated fileref (REQ). */
,RC=NO         /* Confirm the deletion of the file by passing a      */
               /* return code value? (Opt).                          */
               /* Default value is NO.  Valid values are:            */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
);

%local macro parmerr dummy _rc_ _return_code_;
%let macro = &sysmacroname;

%* check input parameters ;
%parmv(FILE,         _req=1,_words=1,_case=N)  /* words=1 allows spaces in file path */
%parmv(RC,           _req=0,_words=0,_case=U,_val=0 1)

%if (&parmerr) %then %goto quit;

%* is it a physical file? assume yes if it contains a slash ;
%if (%sysfunc(indexc(&file,\/))) %then %do;
   %* allocate a fileref ;
   %* (what genius in SAS R&D dreamed up this syntax???) ;
   %let dummy=________;  %* use a fileref unlikely to be used by the end user ;
   %let _rc_=%sysfunc(filename(dummy,&file));

   %* any errors? ;
   %if (&_rc_ ne 0) %then %put %sysfunc(sysmsg());

   %* if the file exists, delete it ;
   %if (%sysfunc(fexist(&dummy))) %then %do;
      %let _rc_=%sysfunc(fdelete(&dummy));

      %* any errors? ;
      %if (&_rc_ ne 0) %then %put %sysfunc(sysmsg());
   %end;

   %* was a return code requested? ;
   %if (&rc) %then %do;
      %let _return_code_=%sysfunc(fexist(&dummy));
   %end;

   %* deallocate the fileref ;
   %let _rc_=%sysfunc(filename(dummy));

   %* any errors? ;
   %if (&_rc_ ne 0) %then %put %sysfunc(sysmsg());
%end;
%else %do;
   %* already a fileref so no need to allocate it ;

   %* if the file exists, delete it ;
   %if (%sysfunc(fexist(&file))) %then %do;
      %let _rc_=%sysfunc(fdelete(&file));

      %* any errors? ;
      %if (&_rc_ ne 0) %then %put %sysfunc(sysmsg());
   %end;

   %* was a return code requested? ;
   %if (&rc) %then %do;
      %let _return_code_=%sysfunc(fexist(&file));
   %end;
   %* since the end user pre-allocated the fileref, ;
   %* leave it to him/her to deallocate the fileref ;
%end;

%* was a return code requested? ;
%if (&rc) %then %do;
&_return_code_
%end;

%quit:

%mend;

/******* END OF FILE *******/


text:
/*=====================================================================
Program Name            : export_dlm.sas
Purpose                 : Replacement macro for PROC EXPORT for
                          exporting a SAS dataset to a delimited file.
SAS Version             : SAS 9.4
Input Data              : SAS dataset
Output Data             : Delimited flat file

Macros Called           : parmv

Originally Written by   : Scott Bass
Date                    : 04SEP2019
Program Version #       : 1.0

=======================================================================

Scott Bass (sas_l_739@yahoo.com.au)

This code is licensed under the Unlicense license.
For more information, please refer to http://unlicense.org/UNLICENSE.

This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

=======================================================================

Modification History    : Original version

=====================================================================*/

/*---------------------------------------------------------------------
Usage:

%let path=C:\Temp;  %* edit to suit your requirements ;

%export_dlm(
   data=sashelp.class
   ,path="&path"
)

Creates C:\Temp\class.csv as a CSV file

Default output is a CSV (comma separated values) file.
Default filename is <SAS dataset name>.csv
if only a directory path is specified.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.csv"
   ,dbms=csv
);

Creates C:\Temp\file.csv as a CSV file
   (explicitly specified output file name).
Aborts if C:\Temp\file.csv already exists.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.csv"
   ,replace=Y
);

Creates C:\Temp\file.csv as a CSV file,
replacing C:\Temp\file.csv if it already exists.

=======================================================================

%export_dlm(
   data=sashelp.shoes
   ,path="&path\"
   ,replace=Y
   ,label=Y
)

Creates C:\Temp\shoes.csv as a CSV file,
replacing C:\Temp\shoes.csv if it already exists,
using the column labels for the header row.

=======================================================================

%export_dlm(
   data=sashelp.cars
   ,path="&path\"
   ,replace=Y
   ,label=Y
   ,header=N
)

Creates C:\Temp\cars.csv as a CSV file,
replacing C:\Temp\cars.csv if it already exists,
without creating a header row.

The LABEL parameter is ignored if HEADER=N.

=======================================================================

data work.vwStocks / view=work.vwStocks;
   * reorder columns, moving volume to the end ;
   format Stock Date Open High Low Volume;
   set sashelp.stocks;
   * drop Close and AdjClose ;
   drop Close AdjClose;
   * use a different format for the Date column ;
   format Date e8601da.;
   * add labels ;
   label
      Open="Opening Price"
      High="Highest Price"
      Low="Lowest Price"
      Volume="Total Daily Volume"
   ;
run;

%export_dlm(
   data=work.vwStocks
   ,path="&path\stocks.csv"
   ,replace=Y
   ,label=Y
   ,header=Y
)

Creates C:\Temp\stocks.csv as a CSV file,
replacing C:\Temp\stocks.csv if it already exists,
using the column labels for the header row.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.tdf"
   ,dbms=tab
   ,replace=Y
);

Creates C:\Temp\file.tdf as a tab-delimited file,
replacing C:\Temp\file.tdf if it already exists.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.txt"
   ,dbms=dlm
   ,replace=Y
);

Creates C:\Temp\file.txt as a space delimited file,
   (probably not what you want)
replacing C:\Temp\file.txt if it already exists.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.txt"
   ,dbms=dlm
   ,replace=Y
   ,delimiter=|
);

Creates C:\Temp\file.txt as a pipe delimited file,
replacing C:\Temp\file.txt if it already exists.

You can use any sequence of characters (including hexadecimal constants)
as the field delimiter.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.txt"
   ,dbms=dlm
   ,replace=Y
   ,delimiter='A7'x
);

data _null_;
   infile "&path\file.txt";
   input;
   putlog _infile_;
run;

Creates C:\Temp\file.txt as a hex character delimited file,
replacing C:\Temp\file.txt if it already exists.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.txt"
   ,dbms=dlm
   ,replace=Y
   ,dlm=|
);

dlm can be used as an alias for delimiter.

=======================================================================

* test single level dataset name ;
data cars;
   set sashelp.cars;
run;

%export_dlm(
   data=cars (where=(make =: 'Mercedes' and type='Sports'))
   ,path="&path\MercedesBenzSportsCars.csv"
   ,replace=Y
);

Creates C:\Temp\MercedesBenzSportsCars.csv as a CSV file,
replacing C:\Temp\MercedesBenzSportsCars.csv if it already exists,
containing Mercedes-Benz sports cars.

=======================================================================

filename temp temp;

%export_dlm(
   data=sashelp.class
   ,path=temp
   ,dbms=dlm
   ,delimiter=|
);

data _null_;
   infile temp;
   input;
   putlog _infile_;
run;

Writes sashelp.class to the fileref temp as a pipe delimited file.

Use an unquoted path to specify a fileref.

=======================================================================

%export_dlm(
   data=sashelp.class
   ,path="&path\file.txt"
   ,dbms=dlm
   ,delimiter=|
   ,replace=Y
   ,header=Y
   ,lrecl=999999
);

Increases the output logical record length from the default of 32767.
Use if your combined output linesize overflows 32767 characters.

=======================================================================

Error checking:

%export_dlm(
   data=sashelp.DoesNotExist
   ,path="&path"
   ,replace=Y
);

Fails, SAS dataset sashelp.DoesNotExist does not exist.

%export_dlm(
   data=sashelp.class
   ,path="Z:\"
   ,replace=Y
);

Fails, drive letter Z: does not exist.

%export_dlm(
   data=sashelp.class
   ,path="C:\DoesNotExist"
   ,replace=Y
);

Fails, output directory does not exist.
The macro does not trap for this edge case error,
although the code fails as it should.

%export_dlm(
   data=sashelp.class
   ,path="C:\DoesNotExist\file.csv"
   ,replace=Y
);

Fails, output directory (part of file path) does not exist.

%export_dlm(
   data=sashelp.class
   ,path=FOO
   ,replace=Y
);

Fails, FOO fileref is not already allocated.

-----------------------------------------------------------------------
Notes:

One of the main reasons for this macro is that PROC EXPORT puts
unwanted double-quotes around the header field names when the LABEL
option is used.

PROC EXPORT also has issues with long formats
(truncates the long format names)

This macro also allows specifying an output logical record length.

Physical output paths MUST be single or double quoted.
This is to indicate that it is a physical path and not a fileref.

If you specify a non-existent directory only, this macro does not
trap for that error, although the code will fail when it attempts
to create a file in the non-existent path.

For example:

%export_dlm(
   data=sashelp.class
   ,path="C:\DoesNotExist"
   ,replace=Y
);

If you specify a non-existent directory as part of the file path,
this macro will trap for that error.

For example:

%export_dlm(
   data=sashelp.class
   ,path="C:\DoesNotExist\file.csv"
   ,replace=Y
);

Note the different error messages from the two different invocations.

This code is based on (i.e. virtually copied from):
https://communities.sas.com/t5/ODS-and-Base-Reporting/How-to-use-labels-in-proc-export-or-create-tab-dlm-file-using/m-p/76789#M8698

---------------------------------------------------------------------*/

%macro export_dlm
/*---------------------------------------------------------------------
Replacement macro for PROC EXPORT for
exporting a SAS dataset to a delimited file.
---------------------------------------------------------------------*/
(DATA=         /* Dataset to export (REQ).                           */
               /* Data set options, such as a where clause, may be   */
               /* specified.                                         */
,PATH=         /* Output directory or file path (REQ).               */
               /* Either a properly quoted physical file             */
               /* (single or double quotes), or an already allocated */
               /* fileref may be specified.                          */
,DBMS=CSV      /* Output file type (REQ).                            */
               /* CSV, TAB, or DLM may be specified.                 */
               /* Default value is CSV.                              */
               /* Ignored if DELIMITER is specified.                 */
,DELIMITER=    /* Output field delimiter (Opt).                      */
               /* If specified, the DBMS parameter is ignored.       */
               /* If not specified:                                  */
               /*    If DBMS=CSV, DELIMITER=,                        */
               /*    If DBMS=TAB, DELIMITER="09"x (tab)              */
               /*    If DBMS=DLM, DELIMITER=" " (space)              */
,DLM=          /* Output field delimiter (Opt).                      */
               /* DLM is an alias for DELIMITER.                     */
               /* If both are specified then DELIMITER is used.      */
,REPLACE=N     /* Replace output file? (Opt).                        */
               /* Default value is NO.  Valid values are:            */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
,LABEL=N       /* Use data set labels instead of names? (Opt).       */
               /* Default value is NO.  Valid values are:            */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
               /* If the data set variable does not have a label     */
               /* then the variable name is used.                    */
,HEADER=Y      /* Output a header row? (Opt).                        */
               /* Default value is YES.  Valid values are:           */
               /* 0 1 OFF N NO F FALSE and ON Y YES T TRUE           */
               /* OFF N NO F FALSE and ON Y YES T TRUE               */
               /* (case insensitive) are acceptable aliases for      */
               /* 0 and 1 respectively.                              */
               /* If the data set variable does not have a label     */
               /* then the variable name is used.                    */
,LRECL=32767   /* Logical record length for output file (Opt).       */
               /* Default value is 32767 (32K)                       */
);

%global syscc;
%local macro parmerr;
%local _rc _temp _pos _type _exist _fileref _is_dir _dir _lib _ds _dlm;
%let macro = &sysmacroname;

%* check input parameters ;
%parmv(DATA,         _req=1,_words=1,_case=N)  /* words=1 allows multiple datasets */
%parmv(PATH,         _req=1,_words=1,_case=N)
%parmv(DBMS,         _req=1,_words=0,_case=U,_val=CSV TAB DLM)
%parmv(DELIMITER,    _req=0,_words=0,_case=N)
%parmv(DLM,          _req=0,_words=0,_case=N)
%parmv(REPLACE,      _req=0,_words=0,_case=U,_val=0 1)
%parmv(LABEL,        _req=0,_words=0,_case=U,_val=0 1)
%parmv(HEADER,       _req=0,_words=0,_case=U,_val=0 1)
%parmv(LRECL,        _req=0,_words=0,_case=U,_val=POSITIVE)

%if (&parmerr) %then %return;

%* additional error checking ;

%* parse off any dataset options ;
%let _temp=%superq(data);
%let _pos=%sysfunc(findc(%superq(_temp),%str(%()));
%if (&_pos) %then %do;
   %let _temp=%substr(%superq(_temp),1,&_pos-1);
%end;

%* does the SAS dataset exist? ;
%if not (%sysfunc(exist(%superq(_temp),DATA)) or %sysfunc(exist(%superq(_temp),VIEW))) %then %do;
   %let syscc=8;
   %parmv(_msg=SAS dataset %superq(_temp) does not exist)
   %return;
%end;

%* If the path is a quoted physical name, check: ;
%*    1) Is it a directory?
%*    2) If not:
%*       A) Does the directory path for the file exist? (error);
%*       B) Does the file itself exist (not an error), ;
%*          but we need to know to propery process the REPLACE option. ;

%* initialize as not exists ;
%let _exist=0;

%* quoted physical file ;
%if (%sysfunc(findc(%superq(path),%str(%"%')))) %then %do;
   %let _type=FILE;
   %* remove quotes to derive output file path ;
   %let path=%sysfunc(compress(%superq(path),%str(%'%")));
%end;
%* fileref ;
%else %do;
   %let _type=FILEREF;
%end;

%if (&_type eq FILE) %then %do;
   %* create temporary fileref ;
   %let _fileref=;
   %let _rc=%sysfunc(filename(_fileref,"%superq(path)"));

   %* is the file a directory? ;
   %let _is_dir=%sysfunc(dopen(&_fileref));
   %let _msg=%sysfunc(sysmsg());
   %let _rc=%sysfunc(dclose(&_is_dir));
   %let _rc=%sysfunc(filename(_fileref));
   %*put &=_is_dir &=_msg;  %* for debugging, comment out in production ;

   %* if not a directory, assume it is a file and get the directory path ;
   %if (not &_is_dir) %then %do;
      %let _pos=%sysfunc(findc(%superq(path),\,-9999));
      %*put &=_pos;  %* for debugging, comment out in production ;
      %if (&_pos) %then %do;
         %let _dir=%substr(%superq(path),1,&_pos);
         %*put &=_dir;  %* for debugging, comment out in production ;

         %* does the directory exist? ;
         %let _fileref=;
         %let _rc=%sysfunc(filename(_fileref,"%superq(_dir)"));
         %let _is_dir=%sysfunc(dopen(&_fileref));
         %let _msg=%sysfunc(sysmsg());
         %let _rc=%sysfunc(dclose(&_is_dir));
         %let _rc=%sysfunc(filename(_fileref));
         %*put &=_is_dir &=_msg;  %* for debugging, comment out in production ;

         %if (not &_is_dir) %then %do;
            %let syscc=8;
            %parmv(_msg=The directory %superq(_dir) does not exist.  No output created)
            %return;
         %end;

         %* does the file exist? (which is not an error) ;
         %let _fileref=;
         %let _rc=%sysfunc(filename(_fileref,"%superq(path)"));
         %let _exist=%sysfunc(fexist(&_fileref));
         %let _msg=%sysfunc(sysmsg());
         %let _rc=%sysfunc(filename(_fileref));
         %*put &=_exist &=_msg;  %* for debugging, comment out in production ;
      %end;
   %end;

   %* it is a directory, so derive the output file name ;
   %else %do;
      %let _lib=%scan(%superq(_temp),1,.);
      %let _ds =%scan(%superq(_temp),2,.);
      %if (%superq(_ds) eq ) %then %let _ds=&_lib;
      %let path=%superq(path)\%superq(_ds);  %* this works whether the input path has a trailing \ or not ;
      %if (&dbms=CSV) %then
         %let path=%superq(path).csv;
      %else
      %if (&dbms=TAB) %then
         %let path=%superq(path).tdf;
      %else
      %if (&dbms=DLM) %then
         %let path=%superq(path).txt;

      %* does the file exist? (which is not an error) ;
      %let _fileref=;
      %let _rc=%sysfunc(filename(_fileref,"%superq(path)"));
      %let _exist=%sysfunc(fexist(&_fileref));
      %let _msg=%sysfunc(sysmsg());
      %let _rc=%sysfunc(filename(_fileref));
      %*put &=_exist &=_msg;  %* for debugging, comment out in production ;
   %end;
%end;

%* already allocated fileref ;
%else
%if (&_type eq FILEREF) %then %do;
   %* is the fileref allocated? ;
   %if (%sysfunc(fileref(%superq(path))) gt 0) %then %do;
      %let syscc=8;
      %parmv(_msg=The %superq(path) fileref is not allocated. No output created)
      %return;
   %end;
   %let _exist=%sysfunc(fexist(%superq(path)));
   %*put &=_exist;  %* for debugging, comment out in production ;
%end;

%* file exists but replace was not specified ;
%if (&_exist and not &replace) %then %do;
   %if (&_type eq FILE) %then %do;
      %let msg=%str(WAR)NING: "%superq(path)" already exists.;
      %let msg=&msg Specify REPLACE to overwrite.;
      %let msg=&msg No output created.;
   %end;
   %else
   %if (&_type eq FILEREF) %then %do;
      %let msg=%str(WAR)NING: "%sysfunc(pathname(%superq(path)))" already exists.;
      %let msg=&msg Specify REPLACE to overwrite.;
      %let msg=&msg No output created.;
   %end;
   %put &msg;  %* do not comment out this line ;
   %let syscc=4;
   %return;
%end;

%* add back the quotes to indicate that it is a physical filename ;
%if (&_type eq FILE) %then %do;
   %let path="%superq(path)";
%end;

%* if DELIMITER or DLM was specified then explicitly set the delimiter ;
%* and ignore the DBMS setting ;
%if (%superq(DELIMITER)%superq(DLM) ne ) %then %do;
   %let _dlm = %superq(DELIMITER);
   %if (%superq(_dlm) eq ) %then %let _dlm = %superq(DLM);

   %* if the delimiter is not a hex character then ensure it is properly quoted, ;
   %* otherwise assume that a hex character is properly quoted ;
   %let _rx=%sysfunc(prxparse(/['|"][0-9a-f]+["|']x/i));
   %if not (%sysfunc(prxmatch(&_rx,%superq(_dlm)))) %then %do;
      %let _dlm = %sysfunc(compress(&_dlm,%str(%"%')));
      %let _dlm = "&_dlm";
   %end;
   %syscall prxfree(_rx);
%end;
%else %do;
   %if (&DBMS eq CSV) %then %let _dlm = %str(",");
   %else
   %if (&DBMS eq TAB) %then %let _dlm = %str("09"x);
   %else
   %if (&DBMS eq DLM) %then %let _dlm = %str(" ");
%end;
%let _dlm=%unquote(&_dlm);

data _null_;
   file &path dsd dlm=&_dlm lrecl=&lrecl;
   set &data;
   %if (&header) %then %do;
   if _n_ eq 1 then link header;
   %end;
   put (_all_)(:);
return;

%if (&header) %then %do;
header:
   length _LABEL_ $128 _NAME_ $32;
   if _n_ eq 1 then do;
      do while(1);
      call vnext(_name_);
      if _name_ eq '_LABEL_' then leave;
      _label_ = ifc(&label,vlabelx(_name_),_name_);
      put _label_ @;
   end;
   put;
   end;
return;
%end;

run;

%mend;

/******* END OF FILE *******/