/*--------------------------------------------------------------
  *
  *      NAME:  truncate_zero.sas
  *     TITLE:  Removes all observations from a data set, 
  *             preserving indexes and non-referential
  *             and non-primary key integrity constraints.
  *     INPUT:  see below
  *    OUTPUT:  truncate_zero.log
  *
  *  SPEC.REQ:  see below
  *--------------------------------------------------------------*/

  *--------------------------------------------------------------* 
  * This SAS Macro removes all observations from a data set,
  * preserving indexes and non-referential and non-primary key
  * integrity constraints.  The SAS Macro fails with an expected 
  * ERROR when run on data sets with the following attributes:
  *
  *   1. Audit trail
  *   2. Generations
  *   3. Primary key integrity constraint
  *   4. Referential integrity constraint
  *
  * Definition of macro arguments:
  *   lib=  SAS libref containing the data set 
  *   dset= data set name
  *
  *--------------------------------------------------------------*;

 %macro truncate_zero(lib, dset); 
 
  /* create flag variables for indexes, Integrity Constraints, Referential 
     Integrity Constraints, Generations, and Audit Trails  */   
  %local index_here ic_here ref_ic_here gens_here audit_here;
  
  /* initialize flag variables to missing */
  %let index_here=;
  %let ic_here=; 
  %let ref_ic_here=;
  %let gens_here=;
  %let audit_here=;
 
 
          /* Use Proc Contents information to populate the flag variables */
          ods output attributes=atr1(keep=cvalue1 label1 
                                    where=(label1 in ('Audit', 'Max Generations')))
          
                     attributes=atr2(keep=cvalue2 label2 
                                    where=(label2 in ('Indexes', 'Integrity Constraints')));
          ods listing close;
          proc contents data=&lib..&dset;run;
          ods listing;
 
 
          data atr1(rename=(label1=attribute cvalue1=value));
          set atr1;
          run;
          
          data atr2(rename=(label2=attribute cvalue2=value));
          set atr2;
          run;
          
          /* force the length of the Value column to be as wide as possible to avoid */
          /* an insignificant WARNING RE:  differing lengths of the column in data   */
          /* sets atr1 and atr2 (this WARNING is new for SAS 9.2)                    */            
          data atr;
          length value $256.;  
          set atr2 atr1;
          run;
 
 
          data _null_;
          set atr;         
          if upcase(attribute)='AUDIT' then do;
             call symput("audit_here", "y");
          end;
          
          if index(upcase(attribute), 'GENERATION') gt 0 then do;
             call symput("gens_here", "y");
          end;
          
          if upcase(attribute)='INDEXES' then do;
             if put(value, 8.) gt 0 then do;
                call symput("index_here", "y");
             end;
          end;
          
          if upcase(attribute)='INTEGRITY CONSTRAINTS' then do;
             call symput("ic_here", "y");                      
          end;         
          run;
 
          /* If the data set has an Integrity Constraint, use */
          /* Proc Contents information to determine the type  */
          /* of the constraint.                               */
          %if &ic_here=y %then %do;
     
            ods output integrityConstraints=ics(keep=type);
            ods listing close;
            proc contents data=&lib..&dset;run;
            ods listing;
            
            data _null_;
            set ics;
            if upcase(type) in ("FOREIGN KEY", "PRIMARY KEY") then do;
               call symput("ref_ic_here", "y");                                   
            end;
            run;        
          %end;
     
     /* If the data set has no audit trail, generations, nor referential or */
     /* primary key integrity constraint, create a truncated copy of the    */
     /* original data set.  Any indexes or non-referential/non-primary key  */
     /* integrity constraints are copied to the truncated data set.         */
     %if &audit_here=  and &gens_here=  and &ref_ic_here=  %then %do;
     
        options notes msglevel=i;
        proc append base=&lib..&dset.zero data=&lib..&dset(obs=0);run;
        options nonotes msglevel=n;
 
 
        /* use the flag variables to determine whether or not Indexes */
        /* or non-referential/non-primary key Integrity Constraints   */
        /* exist on the original data set.  If so, delete the Indexes */
        /* and non-referential/non-primary key Integrity Constraints. */
 
        %if &index_here=y %then %do;
            %if &ic_here=y %then %do;
                proc datasets lib=&lib nolist;
                     modify &dset;
                        ic delete _all_;
                     run;
                quit;
            %end;
            
            %else %if &ic_here=  %then %do;
                proc datasets lib=&lib nolist;
                     modify &dset;
                        index delete _all_;
                     run;
                quit;              
            %end;
        %end;
        
        /* delete the original data set */
        proc datasets lib=&lib nolist;delete &dset;run;quit;
 
        
        /* rename the truncated copy of the original data set to the */
        /* name of the original data set.                            */
         proc datasets lib=&lib nolist;
              change &dset.zero = &dset;
              run;
          quit;
               
     %end;
 
     /* If the data set has an Audit trail, generation or referential or */
     /* primary key Integrity constraint, do not create a truncated copy */
     /* and output an ERROR message.                                     */ 
     %else %if &audit_here=y or &gens_here=y or &ref_ic_here=y %then %do;
         
         %put ERROR: Truncation is not allowed when the data set has generations, primary key or referential integrity constraints or an audit trail.;
   
     %end;
     
     /* Delete the WORK library data sets which were created by the macro.  */    
     proc datasets lib=work nolist;
          delete atr atr1 atr2;
          run;
     quit;
     
 %mend truncate_zero;