/*-------------------<-- Start of Description-->---------------------\
| Output a SAS dataset to R;                                         |
|---------------------<-- End of Description-->----------------------|
|--------------------------------------------------------------------|
|------------<-- Start of Files or Arguments Needed-->---------------|
| Argument:                                                          |
|    data: the data file you want to output to R;                    |
|          default is the syslast;                                   |
|    var: the variable list you want to output;                      |
|    file: the output file path;                                     |
|          default is to create a dat file under R directory;        |
|    header: you want to add a file header to the output file        |
|------------<-- Start of Files or Arguments Needed-->---------------|
|--------------------------------------------------------------------|
|------------------<-- Start of Files Created-->---------------------|
| Example: %outr(data = &syslast, var = pt evtstatus days;           |
| Usage:  outr(data = &syslast, var =,                               |
|         file = C:\Programs\StatSoft\R\rw1060\ud.dat, header = Y);  |
\-------------------<-- End of Files Created-->---------------------*/
%macro outr(data = &syslast, var =, where=, file = C:\Programs\StatSoft\R\rw1060\ud.dat, header = Y);
/*--------------------------------------------\
| Copy Right: Duo Zhou;                       |
| Created: 10-14-2002 9:49pm;                 |
\--------------------------------------------*/
proc format ;
   value na ( default = 15 ) ., .A = 'NA';
   value $na (default = 200) ' ' = 'NA'; run;
%if (%quote(&file) ne) and (not %sysfunc(indexw(%upcase(%trim(%quote(%left(%quote(&file))))), %quote(PRINT))))
   %then %do; %let file=%sysfunc(dequote(%trim(%quote(%left(%quote(&file)))))); %let file="&file"; %end;
%else %let file=print;
%let _vnames_=;
%if (%quote(&var)=) %then %do;
   %let _outrcharvar_=;
   %do _vari_=1 %to %nvars(&data);
      %if (&_vari_=1) %then %let _vnames_="%trim(%left(%varname(&data, &_vari_)))";
      %else %let _vnames_=%trim(%left(&_vnames_)) +1 "%trim(%left(%varname(&data, &_vari_)))";
      %if (%vartype(&data, &_vari_) ne 1) %then %do;
      %let _outrcharvar_=&_outrcharvar_ %varname(&data, &_vari_);
      %end;
   %end; 
   data _null_ ;
      %if (%quote(&_outrcharvar_) ne) %then %do;
         length &_outrcharvar_ $200.;
         format &_outrcharvar_ $200.;
      %end;
      set &data %if (%quote(&where) ne) %then (where=(&where));;
      file &file;
      %if %upcase(%substr(&header.,1,1))=Y %then %do;
      if _n_ eq 1 then put &_vnames_;
      %end;;
      %do _vari_=1 %to %nvars(&data);
         %if (%vartype(&data, &_vari_)=1) %then %do;
            length _char_%trim(%left(%varname(&data, &_vari_))) $200.;
            %if (&_vari_=1) %then %do;
              if missing(%varname(&data, &_vari_)) then do;
                 _char_%trim(%left(%varname(&data, &_vari_)))=trimn(left(put(%varname(&data, &_vari_), na.)));
                 put #_n_ _n_ _char_%trim(%left(%varname(&data, &_vari_))) @@;
              end;
              else put #_n_ _n_ %varname(&data, &_vari_) @@;
            %end;
            %else %do;
              if missing(%varname(&data, &_vari_)) then do;
                 _char_%trim(%left(%varname(&data, &_vari_)))=trimn(left(put(%varname(&data, &_vari_), na.)));
                 put _char_%trim(%left(%varname(&data, &_vari_))) @@;
              end;
              else put %varname(&data, &_vari_) @@;
            %end;
         %end;
         %else %do;
            length %varname(&data, &_vari_) $200.;
            if missing(%varname(&data, &_vari_)) then
               %varname(&data, &_vari_)='"'||'NA'||'"';
            else %varname(&data, &_vari_)='"'||trimn(left(%varname(&data, &_vari_)))||'"';
            %if (&_vari_=1) %then %do;
               put #_n_ _n_ %varname(&data, &_vari_) @@;
            %end;
            %else %do;
               put %varname(&data, &_vari_) @@;
            %end;
         %end;
      %end;
   run;
%end;
%else %do;
   %let _outrcharvar_=;
   %do _vari_=1 %to %words(&var, dlm=%nrstr((), ));
      %let _dummyvar_=%qscan(%quote(&var), &_vari_, %nrstr((), ));
      %if (&_vari_=1) %then %let _vnames_="%trim(%left(&_dummyvar_))";
      %else %let _vnames_=%trim(%left(&_vnames_)) +1 "%trim(%left(&_dummyvar_))";
      %if (%vartype(&data, &_dummyvar_) ne 1) %then %do;
         %let _outrcharvar_=&_outrcharvar_ %trim(%left(&_dummyvar_));
      %end;
   %end;
data _null_ ;
   %if (%quote(&_outrcharvar_) ne) %then %do;
      length &_outrcharvar_ $200.;
      format &_outrcharvar_ $200.;
   %end;
   set &data;
   file &file;
   %if %upcase(%substr(&header.,1,1))=Y %then %do;
   if _n_ eq 1 then put &_vnames_;
   %end;;
   %do _vari_=1 %to %words(%quote(&var), dlm=%nrstr((), ));
      %let _ivar_=%qscan(%quote(&var), &_vari_, %nrstr((), ));
      %if (%vartype(&data, &_ivar_)=1) %then %do;
         length _char_%trim(%left(&_ivar_)) $200.;
         %if (&_vari_=1) %then %do;
         if missing(&_ivar_) then do;
            _char_%trim(%left(&_ivar_))=trimn(left(put(&_ivar_, na.)));
            put #_n_ _n_ _char_%trim(%left(&_ivar_)) @@;
         end;
         else put #_n_ _n_ &_ivar_;
         %end;
         %else %do;
            if missing(&_ivar_) then do;
               _char_%trim(%left(&_ivar_))=trimn(left(put(&_ivar_, na.)));
               put _char_%trim(%left(&_ivar_)) @@;
            end;
            else put &_ivar_ @@;
         %end;
      %end;
      %else %do;
         if missing(&_ivar_) then
            &_ivar_='NA';
         else &_ivar_=trimn(left(%varname(&data, &_vari_)));
         %if (&_vari_=1) %then %do;
            put #_n_ _n_ &_ivar_ @@;
         %end;
         %else %do;
            put &_ivar_ @@;
         %end;
      %end;
   %end;
run;
%end;
%mend outr;