Production Ready Macros for SAS Application Developers
https://github.com/sasjs/core
mp_ds2cards.sas
Go to the documentation of this file.
1 /**
2  @file
3  @brief Create a CARDS file from a SAS dataset.
4  @details Uses dataset attributes to convert all data into datalines.
5  Running the generated file will rebuild the original dataset.
6  usage:
7 
8  %mp_ds2cards(base_ds=sashelp.class
9  , cards_file= "C:\temp\class.sas"
10  , maxobs=5)
11 
12  stuff to add
13  - labelling the dataset
14  - explicity setting a unix LF
15  - constraints / indexes etc
16 
17  @param base_ds= Should be two level - eg work.blah. This is the table that
18  is converted to a cards file.
19  @param tgt_ds= Table that the generated cards file would create. Optional -
20  if omitted, will be same as BASE_DS.
21  @param cards_file= Location in which to write the (.sas) cards file
22  @param maxobs= to limit output to the first <code>maxobs</code> observations
23  @param showlog= whether to show generated cards file in the SAS log (YES/NO)
24  @param outencoding= provide encoding value for file statement (eg utf-8)
25 
26 
27  @version 9.2
28  @author Allan Bowe
29 **/
30 
31 %macro mp_ds2cards(base_ds=, tgt_ds=
32  ,cards_file="%sysfunc(pathname(work))/cardgen.sas"
33  ,maxobs=max
34  ,random_sample=NO
35  ,showlog=YES
36  ,outencoding=
37 )/*/STORE SOURCE*/;
38 %local i setds nvars;
39 
40 %if not %sysfunc(exist(&base_ds)) %then %do;
41  %put WARNING: &base_ds does not exist;
42  %return;
43 %end;
44 
45 %if %index(&base_ds,.)=0 %then %let base_ds=WORK.&base_ds;
46 %if (&tgt_ds = ) %then %let tgt_ds=&base_ds;
47 %if %index(&tgt_ds,.)=0 %then %let tgt_ds=WORK.%scan(&base_ds,2,.);
48 %if ("&outencoding" ne "") %then %let outencoding=encoding="&outencoding";
49 
50 /* get varcount */
51 %let nvars=0;
52 proc sql noprint;
53 select count(*) into: nvars from dictionary.columns
54  where libname="%scan(%upcase(&base_ds),1)"
55  and memname="%scan(%upcase(&base_ds),2)";
56 %if &nvars=0 %then %do;
57  %put WARNING: Dataset &base_ds has no variables! It will not be converted.;
58  %return;
59 %end;
60 
61 /* get indexes */
62 proc sort data=sashelp.vindex
63  (where=(upcase(libname)="%scan(%upcase(&base_ds),1)"
64  and upcase(memname)="%scan(%upcase(&base_ds),2)"))
65  out=_data_;
66  by indxname indxpos;
67 run;
68 
69 %local indexes;
70 data _null_;
71  set &syslast end=last;
72  if _n_=1 then call symputx('indexes','(index=(','l');
73  by indxname indxpos;
74  length vars $32767 nom uni $8;
75  retain vars;
76  if first.indxname then do;
77  idxcnt+1;
78  nom='';
79  uni='';
80  vars=name;
81  end;
82  else vars=catx(' ',vars,name);
83  if last.indxname then do;
84  if nomiss='yes' then nom='/nomiss';
85  if unique='yes' then uni='/unique';
86  call symputx('indexes'
87  ,catx(' ',symget('indexes'),indxname,'=(',vars,')',nom,uni)
88  ,'l');
89  end;
90  if last then call symputx('indexes',cats(symget('indexes'),'))'),'l');
91 run;
92 
93 
94 data;run;
95 %let setds=&syslast;
96 proc sql
97 %if %datatyp(&maxobs)=NUMERIC %then %do;
98  outobs=&maxobs;
99 %end;
100  ;
101  create table &setds as select * from &base_ds
102 %if &random_sample=YES %then %do;
103  order by ranuni(42)
104 %end;
105  ;
106 reset outobs=max;
107 create table datalines1 as
108  select name,type,length,varnum,format,label from dictionary.columns
109  where libname="%upcase(%scan(&base_ds,1))"
110  and memname="%upcase(%scan(&base_ds,2))";
111 
112 /**
113  Due to long decimals cannot use best. format
114  So - use bestd. format and then use character functions to strip trailing
115  zeros, if NOT an integer!!
116  resolved code = ifc(int(VARIABLE)=VARIABLE
117  ,put(VARIABLE,best32.)
118  ,substrn(put(VARIABLE,bestd32.),1
119  ,findc(put(VARIABLE,bestd32.),'0','TBK')));
120 **/
121 
122 data datalines_2;
123  format dataline $32000.;
124  set datalines1 (where=(upcase(name) not in
125  ('PROCESSED_DTTM','VALID_FROM_DTTM','VALID_TO_DTTM')));
126  if type='num' then dataline=
127  cats('ifc(int(',name,')=',name,'
128  ,put(',name,',best32.-l)
129  ,substrn(put(',name,',bestd32.-l),1
130  ,findc(put(',name,',bestd32.-l),"0","TBK")))');
131  else dataline=name;
132 run;
133 
134 proc sql noprint;
135 select dataline into: datalines separated by ',' from datalines_2;
136 
137 %local
138  process_dttm_flg
139  valid_from_dttm_flg
140  valid_to_dttm_flg
141 ;
142 %let process_dttm_flg = N;
143 %let valid_from_dttm_flg = N;
144 %let valid_to_dttm_flg = N;
145 data _null_;
146  set datalines1 ;
147 /* build attrib statement */
148  if type='char' then type2='$';
149  if strip(format) ne '' then format2=cats('format=',format);
150  if strip(label) ne '' then label2=cats('label=',quote(trim(label)));
151  str1=catx(' ',(put(name,$33.)||'length=')
152  ,put(cats(type2,length),$7.)||format2,label2);
153 
154 
155 /* Build input statement */
156  if type='char' then type3=':$char.';
157  str2=put(name,$33.)||type3;
158 
159 
160  if(upcase(name) = "PROCESSED_DTTM") then
161  call symputx("process_dttm_flg", "Y", "L");
162  if(upcase(name) = "VALID_FROM_DTTM") then
163  call symputx("valid_from_dttm_flg", "Y", "L");
164  if(upcase(name) = "VALID_TO_DTTM") then
165  call symputx("valid_to_dttm_flg", "Y", "L");
166 
167 
168  call symputx(cats("attrib_stmt_", put(_N_, 8.)), str1, "L");
169  call symputx(cats("input_stmt_", put(_N_, 8.))
170  , ifc(upcase(name) not in
171  ('PROCESSED_DTTM','VALID_FROM_DTTM','VALID_TO_DTTM'), str2, ""), "L");
172 run;
173 
174 data _null_;
175  file &cards_file. &outencoding lrecl=32767 termstr=nl;
176  length __attrib $32767;
177  if _n_=1 then do;
178  put '/*******************************************************************';
179  put " Datalines for %upcase(%scan(&base_ds,2)) dataset ";
180  put " Generated by %nrstr(%%)mp_ds2cards()";
181  put " Available on github.com/sasjs/core";
182  put '********************************************************************/';
183  put "data &tgt_ds &indexes;";
184  put "attrib ";
185  %do i = 1 %to &nvars;
186  __attrib=symget("attrib_stmt_&i");
187  put __attrib;
188  %end;
189  put ";";
190 
191  %if &process_dttm_flg. eq Y %then %do;
192  put 'retain PROCESSED_DTTM %sysfunc(datetime());';
193  %end;
194  %if &valid_from_dttm_flg. eq Y %then %do;
195  put 'retain VALID_FROM_DTTM &low_date;';
196  %end;
197  %if &valid_to_dttm_flg. eq Y %then %do;
198  put 'retain VALID_TO_DTTM &high_date;';
199  %end;
200  if __nobs=0 then do;
201  put 'call missing(of _all_);/* avoid uninitialised notes */';
202  put 'stop;';
203  put 'run;';
204  end;
205  else do;
206  put "infile cards dsd delimiter=',';";
207  put "input ";
208  %do i = 1 %to &nvars.;
209  %if(%length(&&input_stmt_&i..)) %then
210  put " &&input_stmt_&i..";
211  ;
212  %end;
213  put ";";
214  put "datalines4;";
215  end;
216  end;
217  set &setds end=__lastobs nobs=__nobs;
218 /* remove all formats for write purposes - some have long underlying decimals */
219  format _numeric_ best30.29;
220  length __dataline $32767;
221  __dataline=catq('cqtmb',&datalines);
222  put __dataline;
223  if __lastobs then do;
224  put ';;;;';
225  put 'run;';
226  stop;
227  end;
228 run;
229 proc sql;
230  drop table &setds;
231 quit;
232 
233 %if &showlog=YES %then %do;
234  data _null_;
235  infile &cards_file lrecl=32767;
236  input;
237  put _infile_;
238  run;
239 %end;
240 
241 %put NOTE: CARDS FILE SAVED IN:;
242 %put NOTE-;%put NOTE-;
243 %put NOTE- %sysfunc(dequote(&cards_file.));
244 %put NOTE-;%put NOTE-;
245 %mend;