*
;
 /*-------------------------------------------------------------------*/
 /*  Program:  DataDoc  SAS                                           */
 /*  Author:   George A. Theall                                       */
 /*  Project:  n/a                                                    */
 /*  Purpose:  Documents SAS datasets.                                */
 /*  Notes:    This is a macro. Include this file in your program -   */
 /*                 "%include DataDoc.SAS /nosource2 ;" - and invoke  */
 /*                 the macro DataDoc().                              */
 /*            Arguments to the macro are as follows:                 */
 /*                 1st - name of dataset to document;                */
 /*                 2nd - name of format library;                     */
 /*                 3rd - sort order of output ('P' => position of    */
 /*                       variables in dataset).                      */
 /*            Set the linesize ("options ls=") to at least 121 or    */
 /*                 BAD THINGS may happen to your output!             */
 /*            The macro is (I hope) platform-independent. It's been  */
 /*                 tested under SAS PC v6.04 and MVS SAS v6.07.      */ 
 /*            The datasets WORK._DDOC* serve as scratch.             */
 /*            The platform-independent character combination "?/"    */
 /*                 is used in place of the vertical bar for the      */
 /*                 concatenation operator. NB: There is apparently   */
 /*                 a bug in SAS PC v6.04 that affects resolution of  */
 /*                 "?/" combinations in IF ... THEN expressions;     */
 /*                 one solution is to use them within a DO block.    */
 /*  Updated:  09-Oct-92, GAT                                         */
 /*                 - initial version.                                */
 /*-------------------------------------------------------------------*/


 /*------------------------------------------------------*/
 /*  Set DEBUG to a non-zero value to help squash bugs.  */
 /*------------------------------------------------------*/
%let Debug = 1 ;


 /*-------------------------------------------------*/
 /*  DS holds the name of the dataset to document;  */
 /*  FMTLIB names the library where formats are;    */
 /*  ORDER specifies sort order ('P' for position   */
 /*       in data vector; else alphabetically.      */
 /*-------------------------------------------------*/
%macro DataDoc(DS, FmtLib, Order) ;
     %***************************************************** ;
     %*  Initialize various options and macro variables.  * ;
     %***************************************************** ;
     options charcode ;
     %if (%eval(&sysver > 6.04)) %then
          %let mlogic = mlogic ;
     %else
          %let mlogic = mtrace ;
     %* For tracing macro execution. ;
     %if (&Debug) %then %do ;
          options mprint symbolgen &mlogic ;
     %end ;
     %else %do ;
          options nomprint nosymbolgen no&mlogic ;
     %end ;
     %* Default dataset and format library names. ;
     %if (&DS = '') %then 
          %let DS = WORK._LAST_ ;
     %if (&FmtLib = '') %then 
          %let FmtLib = WORK ;
     %* Sort order for final report. ;
     %if (&Order = 'P' or &Order = 'p') %then
          %let SortVar = nPos ;
     %else 
          %let SortVar = Name ;
 
     %************************************** ;
     %*  Create dataset with format info.  * ;
     %************************************** ;
     %let nFmtObs = 0 ;
     proc format lib = &FmtLib cntlout = _DDOCF ;

     data _DDOCF ;
          set _DDOCF end=eof ;

          if (eof) then call symput('nFmtObs', left(put(_n_, best.))) ;

          if (Start = End) then 
               FmtRange = compress(Start) ;
          else 
               FmtRange = compress(Start ?/?/ '-' ?/?/ End) ;
          FmtLabel = Label ;

          keep FmtName FmtRange FmtLabel ;

     %if (&Debug) %then %do ;
          proc print data = _DDOCF ;
     %end ;

     %*********************************************** ;
     %*  Use SAS to determine contents of dataset.  * ;
     %*********************************************** ;
     proc contents data = &DS out = _DDOCD memtype = data noprint ;

     data _DDOCN ;
          set _DDOCD (keep = MemName) ;
          by MemName ;

          if (first.MemName) then
               nVars = 0 ;
          nVars + 1 ;
          if (last.MemName) then
               output ;

     %if (&Debug) %then %do ;
          proc print data = _DDOCD ;
          proc print data = _DDOCN ;
     %end ;

     %************************************* ;
     %*  Merge contents and format info.  * ;
     %************************************* ;
     data _DDOCD ;
          length Informat Format $ 28 
               FmtLabel $ 16 
               FmtRange $ 12 ;
          merge _DDOCD _DDOCN ;
          by MemName ;

          if (InformL > 0) then do ;
               Informat = compress(Informat ?/?/ 
                    put(InFormL, best.) ?/?/ '.' ?/?/ 
                    put(InFormD, best.)) ;
          end ;

          FmtLabel = '' ;
          FmtRange = '' ;
          if (FormatL > 0) then do ;
               Format = compress(Format ?/?/ 
                    put(FormatL, best.) ?/?/ '.' ?/?/ 
                    put(FormatD, best.)) ;
               output ;
          end ;
          else if (Format = '') then do ;
               output ;
          end ;
          else do indx = 1 to &nFmtObs ;
               set _DDOCF point=indx ;
               if (Format = FmtName) then output ;
          end ;

          keep LibName MemName MemLabel nObs nVars 
               Name Type Length Label nPos Informat Format FmtLabel FmtRange ;

     proc sort data = _DDOCD ;
          by MemName &SortVar ;
     %if (&Debug) %then %do ;
          proc print data = _DDOCD ;
     %end ;

     proc format ;
          value VarFmt
               1 = 'Num '
               2 = 'Char' ;

     data _null_ ;
          set _DDOCD ;
          by MemName &SortVar ;

          array Cols (*) Col1 - Col8 (1 11 53 59 64 74 92 106) ;

          file PRINT header=PutHdr ;
          if (first.MemName and _n_ > 1) then put _page_ ;

          if (first.&SortVar) then 
               put @Col1 Name $char8.        @Col2 Label $40.
                    @Col3 Type VarFmt.       @Col4 Length 3.
                    @Col5 Informat $8.       @Col6 Format $16.
                    @Col7 FmtRange $12.      @Col8 FmtLabel $16. ;
          else 
               put                           @Col6 Format $16.
                    @Col7 FmtRange $12.      @Col8 FmtLabel $16. ;
          return ;

          PutHdr:
               /* New member. */
               if (first.MemName) then do ;
                    put // 
                         @Col2 'Library:     '    +2 LibName
                         @Col6 'Variables:   '    +2 +3 nVars comma5.
                         / 
                         @Col2 'Member name: '    +2 MemName
                         @Col6 'Observations:'    +2 nObs comma8.
                         / 
                         @Col2 'Member label:'    +2 MemLabel ;
               end ;

          put //
               @Col1 8*'='         @Col2 40*'='        @Col3 4*'='
               @Col4 3*'='         @Col5 8*'='         @Col6 16*'='
               @Col7 12*'='        @Col8 16*'='
               /
               @Col1 'Variable'    @Col2 'Label'       @Col3 'Type'
               @Col4 'Len'         @Col5 'Informat'    @Col6 'Format'
               @Col7 'Format Range'                    @Col8 'Format Label'
               /
               @Col1 8*'='         @Col2 40*'='        @Col3 4*'='
               @Col4 3*'='         @Col5 8*'='         @Col6 16*'='
               @Col7 12*'='        @Col8 16*'=' ;
          return ;
%mend DataDoc ;
*
;