/*<pre><b>
/ Program   : fmts2fda.sas
/ Version   : 1.0
/ Author    : Roland Rashleigh-Berry
/ Date      : 31-Jul-2007
/ Purpose   : To create sas code to generate formats as found in your data
/ SubMacros : %quotelst
/ Notes     : The FDA sometimes requests the user-defined formats you are using
/             in your datasets. You can either send them the full format catalog
/             members or use this utility so that the formats can be generated.
/             This will only give you the codes and their formatted values as it
/             occurs in your data. It will NOT give all codes defined to the
/             formats. If you want all possible codes mapped then send them the
/             format catalogs and do not use this utility.
/
/             Note that this utility is weak on numeric formats. These can be
/             very long lists of values. You should just use this to identify
/             what numeric formats are being used and replace the generated code
/             with the original code for the numeric format.
/
/ Usage     : %fmts2fda(mylib1 mylib2)
/ 
/===============================================================================
/ PARAMETERS:
/-------name------- -------------------------description------------------------
/ libname           (pos) Libref of the library where your datasets are stored.
/                   More than one can be specified (separated by spaces).
/ file=fdaformats.sas    Name of the flat file that will hold the formats code
/===============================================================================
/ AMENDMENT HISTORY:
/ init --date-- mod-id ----------------------description------------------------
/ rrb  29Mar07         Put out "macro called" message plus header tidy
/ rrb  31Jul07         Header tidy
/===============================================================================
/ This is public domain software. No guarantee as to suitability or accuracy is
/ given or implied. User uses this code entirely at their own risk.
/=============================================================================*/

%put MACRO CALLED: fmts2fda v1.0;

%macro fmts2fda(libname,file=fdaformats.sas);

%if not %length(&libname) %then %let libname=%sysfunc(getoption(user));
%if not %length(&libname) %then %let libname=work;


*- find all datasets and variables in the library that have -;
*- user-defined formats and output to a dataset -;
proc sql noprint;
  create table _fmts as
  select libname, memname, name, type, format
  from dictionary.columns
  where libname in (%quotelst(%upcase(&libname)))
  and memtype='DATA'
  and compress(format,'F$0123456789.') 
    not in (' ' 'DATE' 'TIME' 'DATETIME' 'CHAR' 'BEST' 'Z');
quit;


%*- warn if no user formats and exit -;
%if not %nobs(_fmts) %then %do;
  %put WARNING: (fmts2fda) No user-defined formats are used in library=&libname;
  data _null_;
    file "&file";
    put "No user-defined formats are used in library=&libname";
  run;
  %goto skip;
%end;


%*- delete base dataset if it already exists -;
%if %sysfunc(exist(_fmtbase)) %then %do;
  proc datasets nolist;
    delete _fmtbase;
  run;
  quit;
%end;


*- for each dataset, sort nodupkey, add the format name and type, -;
*- assign the variable contents to variable "start" and append on -;
*- to the base dataset. -;
data _null_;
  set _fmts;
  call execute('proc sort nodupkey data='||trim(libname)||'.'||trim(memname)||'(keep='||
    trim(name)||') out=_fmtbit;by '||trim(name)||';run;');
  call execute('data _fmtbit;length type $ 4 format start $ 20;retain format "'||
    trim(format)||'" type "'||type||'";set _fmtbit;');
  if type='char' then call execute('start='||trim(name)||';drop '||trim(name)||';run;');
  else call execute('start=trim(left(put('||trim(name)||',best16.)));drop '||trim(name)||';run;');
  call execute('proc append base=_fmtbase data=_fmtbit;run;');
run;


*- get rid of duplicates from the base dataset -;
proc sort nodupkey data=_fmtbase;
  by format type start;
run;


*- write the "proc format" code out to the flat file -;
data _null_;
  length fmt $ 20 label $ 40;
  file "&file" noprint notitles;
  set _fmtbase end=last;
  by format;
  if _n_=1 then put 'proc format;';
  fmt=compress(format,'.');
  if first.format then put @3 'value ' fmt;
  if type='char' then do;
    label=putc(start,format);
    put @5 '"' start +(-1) '"="' label +(-1) '"';
  end;
  else do;
    label=putn(input(start,best16.),format);
    put @5 start +(-1) '="' label +(-1) '"';
  end;
  if last.format then put @3 ';';
  if last then put 'run;';
run;


*- tidy up -;
proc datasets nolist;
  delete _fmts _fmtbase _fmtbit;
run;
quit;



%skip:
%mend;