TS-405A

Convert DBF files to SAS Datasets for Windows 6.xx

/*****************************************************
Author    : Michael C. Harris

            Amgen, Therapeutic Products Division
Published : SUGI 18 Proceedings page 915


This code has been modified to correctly
run under SAS 6.08 for Windows and OS/2.
This code is sample code and is NOT supported
by SAS Institute.
*****************************************************/


/* replace "test.dbf" with your dBase file name make sure */
/* you use double qoutes                                  */


%let fname="d:\608\test.dbf";


/* replace "test" with dataset name you desire created */


%let dsname="test";
filename dbfile &fname;
filename pinc 'pinc.sas';
options source2;


data _null_;
  infile dbfile recfm=n;
  length varname $ 8 hedfmt infmt $ 9 droplist $ 200;
  input @1 has_memo ib1.
  @2 dbyear ib1.
  @3 dbmon ib1.
  @4 dbday ib1.
  @5 numrecs ib4.
  @9 headlen ib2.
  @11 reclen ib2. ;


  if has_memo ne 3 then do;
    put 'WARNING: The input file has a memo file associated with it!';
    put 'WARNING: Data will be lost!';
    end;


  put dbyear= dbmon= dbday= numrecs= headlen= reclen=;
  numflds=round(((headlen-34)/32),1);
  put numflds=;
  pos=33;


  file pinc;
  if headlen le 200 then do;
    hdfmt='$char' || left(put(headlen,3.)) || '.;';
    put 'data ' &dsname '(drop=header del);';
    put 'infile "'&fname '"  recfm=n end=end;';
    put 'input header 'hdfmt;
    end;


  else do;
    put 'data '&dsname ';';
    put 'length del $ 1;';
    put 'infile "' &fname '" recfm=n end=end;';
    put 'input';
    hedfmt='$char' || '200.';
    numsects=int(headlen/200)+1;
    lenlast=headlen-((numsects-1)*200);
    droplist='del';


    do pcs=1 to numsects-1;
      hedname='h'||left(put(pcs,1.));
      droplist=trim(droplist)||' '||hedname;
      put hedname hedfmt;
      end;



    hedfmt='$char'||left(put(lenlast,3.))||'.';
    hedname='h'||left(put(numsects,2.));
    droplist=trim(droplist)||' '||hedname;
    put hedname hedfmt';';
    end;


  put 'do until(end);';
  put '  input';
  put '  del $char1.';
  nul=put(0,ib1.);


  do flds=1 to numflds;
    input @pos fld_name $8. +3 fld_type $1. +4
    fld_len ib1. fld_dec ib1.;
    varname=scan(fld_name,1,nul);


    if (fld_type='C' | fld_type='L' | fld_type='D') then
    infmt='$char'||trim(left(put(fld_len,3.)))||'.';


    else if fld_type='N' then
    infmt=trim(put(fld_len,3.))||'.'||left(put(fld_dec,2.));


    else if fld_type='M' then do;
      infmt=trim(put(fld_len,3.))||'.'||left(put(fld_dec,2.));
      droplist=trim(droplist)||' '||varname;
      end;


    put '  'varname infmt;
    pos+32;
    end;


  put '  ;';
  put '  output;'/'end;';
  if length(droplist) gt 8 then put 'drop ' droplist ';';
  put 'run;';
  stop;
run;


  %include 'pinc.sas';