%************************** xmain ******************************; %* generate %macro statement for main macro and call to xinit enabling use of &_test_ for labeling test output; %* arg name of main macro with parenthesized argument list, i.e. a %macro statement without the keyword '%macro' and without a semicolon; /* usage: %unquote(%xinit(MYMACRO(arg1=,arg2=,...))) */ %macro xmain(arg); %local name; %let name=%qscan(&arg,1); %global _test_; %if %bquote(&_test_)^= %then %do; %nrstr(%%)macro &arg / parmbuff; %nrstr(%%)local xpbuff; %* kludge macro bug--cannot pass syspbuff as argument to a macro; %nrstr(%%)let xpbuff=%nrbquote(&)syspbuff; %nrstr(%%)xinit(&name,%nrstr(%%)nrbquote(%nrbquote(&)xpbuff)) %end; %else %do; %nrstr(%%)macro &arg; %nrstr(%%)xinit(&name) %end; %nrstr(%%)if %nrbquote(&)_xdebug_ %nrstr(%%)then %nrstr(%%)put %qupcase(&name): xmacro initialized; %mend xmain; %************************** xinit ******************************; %* initialize global variables for x macros; %* main name of main macro, which must use the /PARMBUFF option; %* pbuff (optional) local variable that has been assigned the value of &syspbuff; /* usage: %xinit(MYMACRO) or: %local pbuff; %let pbuff=&syspbuff; %xinit(MYMACRO,%nrbquote(&pbuff)) */ %macro xinit(main,pbuff); ; run; options nospool; * prevent spool file from using up all disk space; %global _main_; %* name of main macro; %let _main_=%qupcase(&main); %global _digits_; %let _digits_=0123456789; %global _uplets_; %let _uplets_=ABCDEFGHIJKLMNOPQRSTUVWXYZ; %global _lolets_; %let _lolets_=abcdefghijklmnopqrstuvwxyz; %global _alpha_; %* includes underscore; %let _alpha_=_&_uplets_&_lolets_; %global _alpnum_; %let _alpnum_=&_alpha_&_digits_; %global _sq_; %let _sq_=%str(%'); %global _dq_; %let _dq_=%str(%"); %global _xrc_; %* return code for xmacros; %let _xrc_=OK; %global _check_; %* check main macro arguments?; %if %bquote(&_check_)= %then %let _check_=2; %else %if %verify(&_check_,&_digits_) %then %do; %put ERROR: Invalid value of _CHECK_=&_check_!; %let _check_=0; %end; %global _xdebug_; %* debugging flag for xmacros; %if %bquote(&_xdebug_)= %then %let _xdebug_=0; %else %if &_check_>1 %then %if %verify(&_xdebug_,&_digits_) %then %do; %put ERROR: Invalid value of _XDEBUG_=&_xdebug_!; %let _xdebug_=0; %end; %global _debug_; %* debugging flag for non-x macros; %if %bquote(&_debug_)= %then %let _debug_=0; %else %if &_check_>1 %then %if %verify(&_debug_,&_digits_) %then %do; %put ERROR: Invalid value of _DEBUG_=&_debug_!; %let _debug_=0; %end; %global _putall_; %* print all obs in DATA steps in non-x macros; %if %bquote(&_putall_)= %then %let _putall_=0; %else %if &_check_>1 %then %if %verify(&_putall_,&_digits_) %then %do; %put ERROR: Invalid value of _PUTALL_=&_putall_!; %let _putall_=0; %end; %global _echo_; %* option to echo arguments of main macro; %if %bquote(&_echo_)= %then %let _echo_=0; %else %if &_check_>1 %then %if %verify(&_echo_,&_digits_) %then %do; %put ERROR: Invalid value of _ECHO_=&_echo_!; %let _echo_=1; %end; %if &_debug_ %then %if ^&_echo_ %then %let _echo_=1; %if &_echo_ %then %put Arguments to the &_main_ macro:; %global _notes_; %* option to print notes from all steps; %if %bquote(&_notes_)= %then %let _notes_=0; %else %if &_check_>1 %then %if %verify(&_notes_,&_digits_) %then %do; %put ERROR: Invalid value of _NOTES_=&_notes_!; %let _notes_=1; %end; %xnotes(0); %global _test_; %* make specified title line echo macro invocation; %if %bquote(&_test_)^= %then %do; %if &_check_>1 %then %if %verify(&_test_,&_digits_) %then %do; %put ERROR: Invalid value of _TEST_=&_test_!; %let _test_=1; %end; %let pbuff=%qcmpres(&pbuff); title&_test_ "&_main_&pbuff"; %end; %global _xsysver; %let _xsysver=%xrepstr(&sysver,.,); %global _xlast; %* save _LAST_ so it can be reset by xterm; %let _xlast=&syslast; %global _arglist; %* list of arguments generated by xchk... macros; %let _arglist=; %xxbug(XINIT, _main_ _notes_ _echo_ _check_ _putall_ _debug_ _xdebug_ _test_ _xlast _xrc_) %mend xinit; %macro xquiet; options nomprint nomlogic nomacrogen nosymbolgen; %global _notes_ _echo_ _putall_ _debug_ _xdebug_ _check_; %let _notes_=0; %let _echo_=0; %let _putall_=0; %let _debug_=0; %let _xdebug_=0; %let _check_=2; run; %mend xquiet; %macro xnoisy; %* generates vast amount of output; options notes mprint mlogic macrogen symbolgen; %global _notes_ _echo_ _putall_ _debug_ _xdebug_ _check_; %let _notes_=1; %let _echo_=2; %let _putall_=1; %let _debug_=1; %let _xdebug_=1; %let _check_=2; run; %mend xnoisy; %************************** xterm ******************************; %* print termination message and set options notes and _last_ as appropriate; %macro xterm; run; %xxbug(XTERM,_main_ _xrc_ _xlast) %xnotes(1); %let _xrc_=%bquote(&_xrc_); %if &_xrc_=%str(0) %then %do; %put NOTE: The &_main_ macro terminated due to an empty data set.; %end; %else %if &_xrc_^=OK %then %do; options _last_=&_xlast; %put NOTE: The &_main_ macro terminated due to error(s).; %end; %else %do; %put NOTE: The &_main_ macro terminated, perhaps normally.; %end; %mend xterm; %************************** xerrset ******************************; %* set error return code and print message; %macro xerrset(msg); %let _xrc_=%qcmpres(&msg); %put ERROR: &_xrc_..; %mend; %************************** xerrmisc ******************************; %* miscellaneous error message; %macro xerrmisc(arg); %let _xrc_=%qcmpres(Unknown error &arg while running the &_main_ macro); %put ERROR: &_xrc_..; %mend; %************************** xnotes ******************************; %* turn notes on or off; %* on 1 to turn notes on 0 to turn notes off; %macro xnotes(on); %if &_notes_=0 %then %do; options %if &on %then notes; %else nonotes; ; %end; %mend xnotes; %************************** indexc **********************; %* Return the position of the first character in &str that is also in &chars; %macro indexc(str,chars); %local i s; %if %length(&chars) %then %do; %do i=1 %to %length(&str); %if %index(&chars,%qsubstr(&str,&i,1)) %then %goto exit; %end; %end; %let i=0; %exit: &i %mend indexc; %************************** xverify **********************; %* Return the position of the first character in &str that is not also in &chars. Accepts zero-length arguments; %macro xverify(str,chars); %local i s; %if %length(&chars) %then %do; %do i=1 %to %length(&str); %if ^%index(&chars,%qsubstr(&str,&i,1)) %then %goto exit; %end; %end; %else %do; %do i=1 %to %length(&str); %if %qsubstr(&str,&i,1)^= %then %goto exit; %end; %end; %let i=0; %exit: &i %mend xverify; %************************** xeq **********************; %* Safe, slow, case-insensitive character comparison of two strings. Returns 1 if the two arguments are the same except for case and trailing blanks. Otherwise returns 0; %macro xeq(str1,str2); %local i j; %let str1=%qtrim(&str1); %let i=%length(&str1); %let str2=%qtrim(&str2); %let j=%length(&str2); %if &i^=&j %then %do; 0 %goto exit; %end; %do i=1 %to &j; %let c1=%qsubstr(&str1,&i,1); %let c2=%qsubstr(&str2,&i,1); %if &c1^=&c2 %then %if %qupcase(&c1)^=%qupcase(&c2) %then %do; 0 %goto exit; %end; %end; 1 %exit: %mend xeq; %************************** xchkerr **********************; %* Print error message about invalid argument; %* _arg name of argument that is invalid; %macro xchkerr(_arg); %put ERROR: "%upcase(&_arg)=%bquote(&&&_arg)" is invalid. &_xrc_..; %mend xchkerr; %************************** xchkech **********************; %* Echo argument, quote it, check for excessively large integers; %* _arg name of argument; %macro xchkech(_arg); %if &_echo_ %then %do; %put %str( )%upcase(&_arg)=&&&_arg; %let _arglist=&_arglist &_arg; %end; %let &_arg=%superq(&_arg); %if &_check_>1 %then %do; %local __i __l __str __tok; %let __i=%indexc(&&&_arg,123456789); %if &__i %then %do; %let __str=&&&_arg; %do %while(&__i); %let __str=%qsubstr(&__str,&__i); %let __l=%verify(&__str,&_digits_); %if &__l=0 %then %let __l=%eval(%length(&__str)+1); %let __tok=%xsubstr(&__str,1,&__l-1); %let __str=%xsubstr(&__str,&__l); %xxbug(xchkech int:, __l __tok) %if &__l<11 %then %let __l=0; %else %if &__l=11 %then %do; data _null_; if &__tok<=2147483647 then call symput("__l","0"); run; %end; %if &__l %then %do; %let _xrc_=%qcmpres(The macro language cannot process integers greater than 2147483647); %xchkerr(&_arg); %let &_arg=; %let __i=0; %end; %else %let __i=%indexc(&__str,123456789); %end; %end; %end; %mend xchkech; %************************** xchkdef **********************; %* If argument value is blank, set it to default value. No other checking is done; %* _arg name of argument to check; %* def (optional) default value; %macro xchkdef(_arg,def); %* set default for &_arg; %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %xxbug(XCHKDEF,&_arg) %mend xchkdef; %************************** xchkeq **********************; %* Issue error message if an argument value contains =. Delete stuff following the =; %* _arg name of argument to check; %* def (optional) default value; %* noecho nonblank value means argument has already been echoed; %macro xchkeq(_arg,def,noecho); %* check _arg for equals sign; %if &noecho= %then %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %if %index(%bquote(&&&_arg),=) %then %do; %let _xrc_=%qcmpres(The value of argument %qupcase(&_arg)= may not contain another "="); %xchkerr(&_arg); %put WARNING: Possible missing comma in macro invocation.; %let &_arg=%qscan(%bquote(&&&_arg),1,%str(= )); %end; %xxbug(XCHKEQ,&_arg) %mend xchkeq; %************************** xchkone **********************; %* Issue error message if an argument value has more than one token or contains an =. Delete extraneous tokens from argument value; %* _arg name of argument to check; %* def (optional) default value; %* noecho nonblank value means argument has already been echoed; %macro xchkone(_arg,def,noecho); %* check _arg for more than one token; %if &noecho= %then %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %if %qscan(%bquote(&&&_arg),2,%str( ))^= %then %do; %let _xrc_=%qcmpres(Only one value for the argument %qupcase(&_arg)= is allowed); %xchkerr(&_arg); %put WARNING: Possible missing comma in macro invocation.; %let &_arg=%qscan(%bquote(&&&_arg),1,%str( )); %end; %xchkeq(&_arg,,y) %end; %xxbug(XCHKONE,&_arg) %mend xchkone; %************************** xchkuint **********************; %* Issue error message if an argument value is not a single unsigned integer. Delete extraneous tokens from argument value and return default value if the argument value is blank or invalid; %* _arg name of argument to check; %* def (optional) default value; %macro xchkuint(_arg,def); %* check whether _arg is an unsigned integer; %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %xchkone(&_arg,,y) %if %verify(%bquote(&&&_arg),&_digits_) %then %do; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be an unsigned integer with no decimal point); %xchkerr(&_arg) %if %bquote(&def)= %then %let &_arg=0; %else %let &_arg=&def; %end; %end; %xxbug(XCHKUINT,&_arg) %mend xchkuint; %************************** xchkint **********************; %* Issue error message if an argument value is not a single integer within a specified range. Delete extraneous tokens from argument value and return a value within the permissible range or a specified default value if the argument value is blank or not an integer; %* _arg name of argument to check; %* def (optional) default value; %* lb (optional) lower bound for value of the argument; %* ub (optional) upper bound for value of the argument; %macro xchkint(_arg,def,lb,ub); %* check whether _arg is an integer; %xchkech(&_arg); %local __ok __tmp __iv; %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %xchkone(&_arg,,y) %let __tmp=%qleft(&&&_arg); %if %xsubstr(&__tmp,1,1)=%str(-) %then %let __iv=2; %else %let __iv=1; %let __ok=0; %if %verify(%xsubstr(&__tmp,&__iv),&_digits_) %then %do; %if %bquote(&def)^= %then %let __tmp=&def; %else %if %bquote(&lb)^= %then %let __tmp=&lb; %else %if %bquote(&ub)^= %then %let __tmp=&ub; %else %let __tmp=0; %end; %else %if %bquote(&lb)^= & &__tmp<&lb %then %let __tmp=&lb; %else %if %bquote(&ub)^= & &__tmp>&ub %then %let __tmp=&ub; %else %let __ok=1; %if ^&__ok %then %do; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be an integer with no decimal point); %if %bquote(&lb)^= %then %let _xrc_=%qcmpres(&_xrc_ greater than or equal to &lb); %if %bquote(&ub)^= & %bquote(&ub)^= %then %let _xrc_=%qcmpres(&_xrc_ and); %if %bquote(&ub)^= %then %let _xrc_=%qcmpres(&_xrc_ less than or equal to &ub); %xchkerr(&_arg) %let &_arg=&__tmp; %end; %end; %xxbug(XCHKINT,&_arg) %mend xchkint; %************************** xchknum **********************; %* Issue error message if an argument value is not a single numeric constant satisfying a condition specified as a DATA step expression. Delete extraneous tokens from argument value and return a default value if the condition is not true; %* _arg name of argument to check; %* def (optional) default value; %* cond (optional) condition written as a DATA step expression using the name of the argument (without an &); %macro xchknum(_arg,def,cond,noecho); %* check whether _arg is a numeric constant; %if &noecho= %then %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %xchkone(&_arg,,y) %local __ok; %let __ok=1; %if %datatyp(%bquote(&&&_arg))=CHAR %then %let __ok=0; %else %if %nrbquote(&cond)^= %then %do; data _null_; &_arg=input(symget("&_arg"),12.); __ok=%unquote(&cond); call symput("__ok",trim(left(put(__ok,best12.)))); run; %end; %if ^&__ok %then %do; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be a numeric constant); %if %bquote(&cond)^= %then %let _xrc_=%qcmpres(&_xrc_ such that &cond); %xchkerr(&_arg) %let &_arg=&def; %end; %end; %xxbug(XCHKNUM,&_arg) %mend xchknum; %************************** xchkmiss **********************; %* Issue error message if an argument value is not a missing value or single numeric constant satisfying a condition specified as a DATA step expression. Delete extraneous tokens from argument value and return a default value if the condition is not true; %* _arg name of argument to check; %* def (optional) default value; %* cond (optional) condition written as a DATA step expression using the name of the argument (without an &); %macro xchkmiss(_arg,def,cond); %* check whether _arg is a missing value or numeric constant; %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %xchkone(&_arg,,y) %local __tmp __c1 __c2 __nonmis; %let __tmp=%qleft(&&&_arg); %let __nonmis=1; %if %length(&__tmp)<=2 %then %do; %let __c1=%xsubstr(&__tmp,1,1); %if &__c1=%str(.) %then %do; %let __c2=%xsubstr(&__tmp,2,1); %if &__c2= %then %let __nonmis=0; %else %if %index(&_alpnum_,&__c2) %then %let __nonmis=0; %end; %end; %if &__nonmis %then %xchknum(&_arg,&def,&cond,y); %end; %xxbug(XCHKMISS,&_arg) %mend xchkmiss; %************************** xchkname **********************; %* Issue error message if an argument value is not a SAS name; %* _arg name of argument to check; %* def (optional) default value; %macro xchkname(_arg,def); %* check whether _arg is a name; %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %xchkone(&_arg,,y) %if ^%xname(%bquote(&&&_arg)) %then %do; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be a SAS name); %xchkerr(&_arg) %let &_arg=&def; %end; %end; %xxbug(XCHKNAME,&_arg) %mend xchkname; %************************** xchkdsn **********************; %* Issue error message if an argument value is not a SAS data set name. Uppercases argument value; %* _arg name of argument to check; %* def default value; %macro xchkdsn(_arg,def,noecho); %* check whether _arg is a data set name; %if &noecho= %then %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %do; %let &_arg=%qupcase(&&&_arg); %if &_check_ %then %do; %local __ind __tmp __err __lib; %let __lib=&&&_arg; %let __tmp=&__lib; %let __ind=%index(&__tmp,%str(%()); %if &__ind %then %let __tmp=%xsubstr(&__tmp,1,&__ind-1); %let &_arg=&__tmp; %xxbug(xchkdsn1:, __lib __tmp &_arg) %xchkeq(&_arg,,y) %if &&&_arg^=&__tmp %then %let __tmp=&&&_arg; %let &_arg=&__lib; %let __err=0; %let __ind=%index(&__tmp,.); %xxbug(xchkdsn2:, __tmp __ind) %if &__ind %then %do; %if &__ind=1 %then %let __err=1; %else %if ^%xname(%xsubstr(&__tmp,1,&__ind-1)) %then %let __err=1; %else %if ^%xname(%xsubstr(&__tmp,&__ind+1)) %then %let __err=1; %else %if &_check_>1 %then %do; %let __lib=%unquote(%substr(&__tmp,1,&__ind-1)); %xxbug(xchkdsn3:, __lib) data &__lib.._TEMP_; stop; run; %if &syserr>4 %then %let __err=1; %else %do; proc datasets nolist nowarn library=&__lib; delete _TEMP_ / memtype=data; quit; %end; %end; %end; %else %if ^%xname(&__tmp) %then %let __err=1; %if &__err %then %do; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be a SAS data set name); %xchkerr(&_arg); %let &_arg=_NULL_; %end; %end; %end; %xxbug(XCHKDSN,&_arg) %mend xchkdsn; %************************** xchkdata **********************; %* Issue error message if an argument value is not an existing SAS data set. Uppercases argument value; %* _arg name of argument to check. Set to blank if invalid; %* def (optional) default value, usually _LAST_; %macro xchkdata(_arg,def); %* check whether _arg is a valid input data set; %xchkech(&_arg); %xchkdsn(&_arg,&def,y) %if &_xrc_^=OK %then %goto exit; %if %bquote(&&&_arg)=_LAST_ %then %do; %if &_xlast=_NULL_ %then %do; %let _xrc_=%bquote(No input data set); %xchkerr(&_arg); %goto exit; %end; %let &_arg=&_xlast; %end; %if &_check_>1 %then %if %bquote(&&&_arg)^= %then %do; data _null_; set %unquote(&&&_arg); stop; run; %if &syserr>4 %then %do; %let _xrc_=%qcmpres(The data set &&&_arg does not exist or cannot be opened for input); %xchkerr(&_arg); %let &_arg=; %goto exit; %end; %end; %exit: %xxbug(XCHKDATA,&_arg) %mend xchkdata; %************************** xchkkey **********************; %* Issue error message if an argument value is not in a list of key words/values. Uppercases everything; %* _arg name of argument to check; %* def (optional) default value; %* keys list of valid key words/values. each key may optionally be followed by a colon and a return value. If the argument value fails to match a prefix of a key in the list, an error message is issued. Otherwise, if the matched key has a colon, the return value is returned, otherwise the complete key is returned; %* delim (optional) delimiters in keys. if omitted defaults to blanks; %macro xchkkey(_arg,def,keys,delim); %* check whether _arg is a name; %xchkech(&_arg) %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %do; %let &_arg=%qupcase(&&&_arg); %if &_check_ %then %do; %xchkone(&_arg,,y) %if %nrbquote(&delim)= %then %let delim=%str( ); %local __arg __j __k __l __token __sub; %let __arg=&&&_arg; %let __l=%length(&__arg); %do __j=1 %to 9999; %let __token=%qscan(&keys,&__j,&delim); %if &__token= %then %let __j=9999; %else %do; %let __token=%qupcase(&__token); %let __k=%index(&__token,:); %if &__k %then %do; %let __sub=%xsubstr(&__token,&__k+1); %let __token=%xsubstr(&__token,1,&__k-1); %if &__arg=%xsubstr(&__token,1,&__l) %then %do; %let &_arg=&__sub; %goto exit; %end; %end; %else %if &__arg=%xsubstr(&__token,1,&__l) %then %do; %let &_arg=&__token; %goto exit; %end; %end; %end; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be one of the following: &keys); %xchkerr(&_arg) %let &_arg=&def; %end; %end; %exit: %xxbug(XCHKKEY,&_arg) %mend xchkkey; %************************** xchklist **********************; %* Issue error message if an argument value does not contain a list of values of designated types with the number of values in a designated range; %* _arg name of argument to check; %* def (optional) default value; %* types (optional) permitted types: I=integer, N=SAS name, Q=quoted string, any special character represents itself. the default is %str(N:-), which is suitable for variable lists; %* nmin (optional) minimum number of values. default 0; %* nmax (optional) maximum number of values. default 999999; %macro xchklist(_arg,def,types,nmin,nmax); %xchkech(&_arg); %if %bquote(&&&_arg)= %then %let &_arg=&def; %else %if &_check_ %then %do; %xchkeq(&_arg,,y) %if &types= %then %let types=%str(N:-); %else %let types=%qupcase(&types); %if %bquote(&nmin)= %then %let nmin=0; %if %bquote(&nmax)= %then %let nmax=999999; %local __n __typ __tok __str; %let __str=&&&_arg; %do __n=1 %to &nmax; %let __typ=%xscan(__tok,__str); %if &__typ=B %then %do; %if &__n<=&nmin %then %goto error; %goto break; %end; %if &__typ=S %then %do; %if %index(&types,&__tok)=0 %then %goto error; %end; %else %if %index(&types,&__typ)=0 %then %goto error; %end; %break: %if &__str^= %then %goto error; %end; %goto exit; %error: %local __str __n; %let __str=; %if %index(&types,N) %then %let __str=&__str or SAS names; %if %index(&types,Q) %then %let __str=&__str or quoted strings; %if %index(&types,I) %then %let __str=&__str or integers; %if %bquote(&__str)^= %then %let __str=%substr(&__str,4); %let __n=; %if &nmin=&nmax %then %let __n=&nmin; %else %if &nmax>=999999 %then %let __n=&nmin or more; %else %let __n=from &nmin to &nmax; %let _xrc_=%qcmpres(The value of the argument %qupcase(&_arg)= must be a list of &__n &__str); %xchkerr(&_arg) %let &_arg=&def; %exit: %xxbug(XCHKLIST,&_arg) %mend xchklist; %************************** xchkend **********************; %* call after xchk... has been called for all arguments to the main macro and defaults have been set for all arguments; %* data (optional) data set to check for no observations. Sets global variable _xnobs if this argument is specified; %macro xchkend(xdata); %if &_echo_>=2 %then %xput(Arguments to the &_main_ macro with defaults:, &_arglist,%str( )); %if &_check_>1 %then %do; %global _xnobs; %let _xnobs=-1; %if %bquote(&xdata)^= %then %do; %xnobs(_xnobs,&xdata) %if &_xnobs=0 %then %do; %if &_xrc_=OK %then %let _xrc_=0; %put NOTE: No observations in data set &xdata..; %end; %end; %if &_xnobs<0 %then %let _xnobs=0; %end; %mend xchkend; %************************** xchkvar **********************; %* dummy data step to check for errors in variable lists. Does not echo anything; %* data input data set that is supposed to have all the variables; %* by (optional) BY list. Must have been processed by xbylist; %* varlists (optional) other variable lists. you may concatenate several lists; %macro xchkvar(data,by,varlists); %if &_check_ %then %if %bquote(&data)^= %then %do; data _null_; set %unquote(&data); %if %bquote(&by)^= %then %do; by &_bydata; %end; retain %unquote(&varlists); stop; run; %if &syserr>4 %then %do; %xerrset(Probably invalid data set %qupcase(&data) or variable list); %end; %end; %mend xchkvar; %************************** xname **********************; %* return 1 if argument is a SAS name, 0 otherwise; %macro xname(arg); %local ok len; %let ok=1; %let arg=%qupcase(%qtrim(&arg)); %let len=%length(&arg); %if &len=0 | &len>32 %then %let ok=0; %else %if %index(&_digits_,%qsubstr(&arg,1,1)) %then %let ok=0; %else %if %verify(&arg,&_alpnum_) %then %let ok=0; %xxbug(XNAME, arg len ok) &ok %mend xname; %************************** xscan *****************************; %* remove the first token from a string, return the token and remainder of the string. Token type: B blank (nothing left) I unsigned integer N name Q quoted string S special does not recognize floating point or quoted strings yet. ; %macro xscan(_tok,_str); %local __j __l __char; %if %bquote(&&&_str)= %then %do; B %let &_tok=; %end; %else %do; %* skip blanks; %let __j=%verify(&&&_str,%str( )); %if &__j %then %let &_str=%xsubstr(&&&_str,&__j); %let __char=%xsubstr(&&&_str,1,1); %if %index(&_digits_,&__char) %then %do; I %let __j=%verify(&&&_str,&_digits_); %end; %else %if %index(&_alpha_,&__char) %then %do; N %let __j=%verify(&&&_str,&_alpnum_); %end; %else %if &__char=&_sq_ | &__char=&_dq_ %then %do; Q %let __l=%length(&&&_str); %do __j=2 %to &__l; %if %qsubstr(&&&_str,&__j,1)=&__char %then %do; %if &__j=&__l %then %goto matchq; %if %qsubstr(&&&_str,&__j+1,1)^=&__char %then %goto matchq; %let __j=%eval(&__j+1); %end; %end; %let &_str=&_str&__char; %* append missing quote; %matchq: %let __j=%eval(&__j+1); %goto done; %end; %else %do; S %let __j=2; %end; %done: %if &__j=0 %then %let __j=%eval(%length(&&&_str)+1); %let &_tok=%xsubstr(&&&_str,1,&__j-1); %let &_str=%xsubstr(&&&_str,&__j); %end; %if &_xdebug_ %then %put XSCAN: &_tok=&&&_tok! &_str=&&&_str!; %mend xscan; %************************** xput ******************************; %* print values of a list of macro variables to the log; %* msg (optional) message of whatever sort to print; %* list (optional) list of names of macro variables to print; %* prefix (optional) prefix to print before each item in list; %* suffix (optional) suffix to print after each item in list; %macro xput(__msg,__list,__prefix,__suffix); %if %bquote(&__msg)^= %then %put &__msg; %local __j __token; %let __j=1; %let __token=%scan(&__list,&__j,%str( )); %do %while(%bquote(&__token)^=); %* token must be unquoted in the %put statement; %put &__prefix%upcase(&__token)=&&&__token.&__suffix; %let __j=%eval(&__j+1); %let __token=%scan(&__list,&__j,%str( )); %end; %if &__j>2 %then %put ; %mend xput; %************************** xbug ******************************; %* print values of a list of macro variables if debugging is on; %* msg (optional) message of whatever sort to print; %* list (optional) list of names of macro variables to print; %macro xbug(__msg,__list); %if &_debug_ %then %xput(&__msg,&__list,debug:%str( ),!); %mend xbug; %macro xbugdo(stmts); %if &_debug_ %then %do; &stmts %end; %mend xbugdo; %macro xxbug(__msg,__list); %if &_xdebug_ %then %xput(&__msg,&__list,xdebug:%str( ),!); %mend xxbug; %************************** xecho ******************************; %macro xecho(__level,__name,__list); %if &_echo_>=&__level %then %xput(Arguments to the %upcase(&__name) macro:,&__list,%str( )); %mend xecho; %************************** xdo_by *****************************; %* define DO and END statements for looping over BY groups and observations in a DATA step; %macro xdo_by; _end=0; do until(_end); _nby+1; %mend; %macro xend_by; end; %mend; %macro xdo_obs(data); %* expects macro variables from xbylist; %if %bquote(&by)^= %then %do; last.&_bylast=0; do until(last.&_bylast); set %unquote(&data) end=_end; by &_bydata; %end; %else %do; _end=0; do until(_end); set %unquote(&data) end=_end; %end; %mend; %macro xend_obs; end; %mend; %************************** xlag *********************************; %* xlag is a replacement for LAGn that allows for varying lags. xlagi declares arrays. xlagr empties the queue. xlag adds a value to the queue and returns a lagged value. The xlagfq... versions allow a frequency variable. maxlag maximum lag that will be asked for ret returned lagged value (variable name) val current value to be added to the lag queue lag size of lag: from 0 to &maxlag ; %macro xlagi(maxlag); drop _tmplag; array _lag _lag1-_lag&maxlag; retain _lag1-_lag&maxlag . _curlag 0; %mend xlagi; %macro xlagr(maxlag); _curlag=0; do _tmplag=1 to &maxlag; _lag[_tmplag]=.; end; %if &_xdebug_ %then %do; put 'xlagr ' _curlag=; put 'xlagr ' _lag[*]=; %end; %mend xlagr; %macro xlag(ret,val,lag,maxlag); %if &_xdebug_ %then %do; put 'xlag ' _curlag= &val= &lag=; %end; _curlag+1; if _curlag>&maxlag then _curlag=1; if &lag=0 then &ret=&val; else do; _tmplag=_curlag-&lag; if _tmplag<=0 then _tmplag+&maxlag; &ret=_lag[_tmplag]; end; _lag[_curlag]=&val; %if &_xdebug_ %then %do; put 'xlag ' _curlag= &ret=; put 'xlag ' _lag[*]=; %end; %mend xlag; %macro xlagfqi(maxlag); drop _tmplag; array _lag _lag1-_lag&maxlag; array _lfq _lfq1-_lfq&maxlag; retain _lag1-_lag&maxlag . _lfq1-_lfq&maxlag 0 _outlag _inlag _totlag 0; %mend xlagfqi; %macro xlagfqr(maxlag); _outlag=1; _inlag=0; _totlag=0; %if &_xdebug_ %then %do; put 'xlagfqr ' _outlag= _inlag= _totlag=; %end; %mend xlagfqr; %macro xlagfq(ret,val,fq,lag,maxlag); %if &_xdebug_ %then %do; put 'xlagfq ' _outlag= _inlag= _totlag= &val= &fq= &lag=; %end; _inlag+1; if _inlag>&maxlag then _inlag=1; _totlag+&fq; _tmplag=_totlag-_lfq[_outlag]; do while(_tmplag>=&lag+1); _outlag+1; if _outlag>&maxlag then _outlag=1; _totlag=_tmplag; if _outlag=_inlag then leave; _tmplag=_tmplag-_lfq[_outlag]; end; if _totlag<&lag+1 then &ret=.; else if _outlag=_inlag then &ret=&val; else &ret=_lag[_outlag]; _lag[_inlag]=&val; _lfq[_inlag]=&fq; %if &_xdebug_ %then %do; put 'xlagfq ' _outlag= _inlag= _totlag= &ret=; put 'xlagfq ' _lag[*]=; put 'xlagfq ' _lfq[*]=; if ^(_totlag>=&lag+1) then put 'xlagfq fail 1'; if ^(&lag+1>_totlag-_lfq[_outlag]) then put 'xlagfq fail 2'; %end; %mend xlagfq; %************************** xmerge *******************************; %* xmerge acts like a MERGE statement with a BY statement even if there are no BY variables; %macro xmerge(data1,data2); %if %bquote(&by)^= %then %do; merge %unquote(&data1) %unquote(&data2); by &_bydata; %end; %else %do; if _end1 & _end2 then stop; if ^_end1 then set %unquote(&data1) end=_end1; if ^_end2 then set %unquote(&data2) end=_end2; %end; %mend xmerge; %************************** xsubstr ******************************; %* substr that accepts nonpositive lengths and other non-nice input; %macro xsubstr(str,pos,len); %local r; %let r=%eval(%length(&str)-%eval(&pos)+1); %if &len= %then %let len=&r; %else %if &len>&r %then %let len=&r; %if &len<=0 %then; %else %qsubstr(&str,&pos,&len); %mend xsubstr; %************************** xbylist ******************************; %* take a BY list for a PROC step and make a BY list for a DATA step, make a list with only the variable names, find last BY variable, and construct BY line. Abbreviated variable lists may not produce correct BY groups if formats combine several unformatted values into one formatted value, hence there is a warning for abbreviated lists. input: &by BY list for a PROC step, usually an argument to the main macro global variables returned: _bydata BY list for a DATA step _byvars list of variable names only _bylast last BY variable _byline BY line ; %macro xbylist; %global _bydata _byvars _bylast _byline; %local n token; %let _byline=; %let _bydata=; %let _byvars=; %let _bylast=; %let n=1; %let token=%qupcase(%qscan(&by,&n,%str( ))); %do %while(&token^=); %if %index(&token,-) %then %put WARNING: Abbreviated BY list &token.; %if &token=DESCENDING | &token=NOTSORTED %then %do; %let _bydata=&_bydata &token; %end; %else %do; %let token=%unquote(&token); %let _byline=&_byline &token=; %let _bydata=&_bydata GROUPFORMAT &token; %let _byvars=&_byvars &token; %let _bylast=&token; %end; %let n=%eval(&n+1); %let token=%qupcase(%scan(&by,&n,%str( ))); %end; %xxbug(XBYLIST, by _bydata _byvars _bylast _byline) %mend xbylist; %************************** xvfreq ******************************; %* process FREQ variable, define FREQ statement &fqstmt; %macro xvfreq(data); %global fqstmt fqopt; %if %bquote(&freq)^= & %bquote(&data)^= %then %do; %xvlist(data=&data,_list=freq,_name=freq,_count=nfreq, valid=01) %if &nfreq>1 %then %do; %let _xrc_=There may be at most one FREQ= variable; %xchkerr(freq); %let freq=&freq1; %end; %let fqstmt=freq &freq %str(;); %let fqopt=1; %end; %else %do; %let fqstmt=; %let fqopt=0; %end; %xxbug(XVFREQ, fqopt fqstmt); %mend xvfreq; %************************** xvweight ****************************; %* process WEIGHT variable, define WEIGHT statement &wtstmt; %macro xvweight(data); %global wtstmt wtopt; %if %bquote(&weight)^= & %bquote(&data)^= %then %do; %xvlist(data=&data,_list=weight,_name=weight,_count=nwght, valid=01) %if &nwght>1 %then %do; %let _xrc_=There may be at most one WEIGHT= variable; %xchkerr(weight); %let weight=&weight1; %end; %let wtstmt=weight &weight %str(;); %let wtopt=1; %end; %else %do; %let wtstmt=; %let wtopt=0; %end; %xxbug(XVWEIGHT, wtopt wtstmt); %mend xvweight; %************************** xvlist ******************************; %* process a variable list, allowing abbreviated lists, and return information about each variable and/or the entire list. * Create a data set named according to the value of the _name argument prefixed by an underscore that contains information about the variables from PROC CONTENTS. * Optionally create macros containing: name type (1=numeric 2=char) format (optionally specify default format and length) for each variable. * Optionally remove variables from the list that have been specified in one or more other variable lists. * Optionally return the number of variables. * Optionally return the list type (0=empty 1=numeric 2=char 3=mixed) and/or validate the list type and issue an error for an invalid list type. * Optionally replace abbreviated variable lists by an expanded list containing each individual variable name. * BY lists are allowed if the list name _list=by. ; %macro xvlist(data=,_list=,_name=,_type=,_fmt=,dnf=BEST,dnl=8,dcf=CHAR, _count=,_ltype=,valid=,remove=,replace=0,format=); %if &_xdebug_ %then %do; %put xvlist: data=&data!; %* data set name; %put xvlist: _list=&_list!; %* name of variable list. The list is updated if replace=1 is specified; %put xvlist: list value=&&&_list!; %put xvlist: _name=&_name!; %* prefix for returned macro vars with numerical suffixes for individual variable names. if blank, no macro vars for names are returned. %put xvlist: _type=&_type!; %* prefix for returned macro vars with numerical suffixes for individual variable types. if blank, no macro vars for types are returned; %put xvlist: _fmt=&_fmt!; %* prefix for returned macro vars with numerical suffixes for individual variable formats. if blank, no macro vars for formats are returned; %put xvlist: dnf=&dnf!; %* default numeric format; %put xvlist: dnl=&dnl!; %* default numeric format length; %put xvlist: dcf=&dcf!; %* default character format; %* to detect variables for which no format has been specified, use: dnf=,dnl=0,dcf= and check for a format of 0.; %put xvlist: _count=&_count!; %* returned: number of variables. if blank, no count is returned; %put xvlist: _ltype=&_ltype!; %* returned: list type: 0=empty list 1=all numeric 2=all character 3=mixed if blank, no list type is returned; %put xvlist: valid=&valid!; %* string of digits 0-3 specifying valid list types (_ltype). If the list type is not in this list, an error is issued. If blank, no validation is done, but some proc steps may issue warnings if the variable list is empty. Hence, valid= should always be used for a list that is allowed to be empty, such as a BY list, for which use valid=0123; %put xvlist: remove=&remove!; %* list of _names of other variable lists to be removed from this list. These _name values must have been processed in previous calls to xvlist. the _name values should be separated by blanks. This argument may be blank if no variables need to be removed; %put xvlist: replace=&replace!; %* if replace=1, the value of _list is replaced by an expanded list containing individual variable names instead of abbreviated lists. For example, X1-X3 is replaced by X1 X2 X3. However, if you use this with a BY list, the DESCENDING and NOTSORTED keywords will be lost; %put xvlist: format=&format!; %* format list to be used in a FORMAT statement. If blank, then no FORMAT statement is used; %put ; %end; %global &_count &_ltype; %local __count __j __token; %************ see if empty list is ok; %if %bquote(&&&_list)= %then %if %index(&valid,0) %then %do; %if &_count^= %then %let &_count=0; %goto exit; %end; %************ if the _list is to be replaced, _name must be a valid prefix; %if &replace %then %if %bquote(&_name)= %then %let _name=_; %************ if valid= is specified, have to get list type; %if %bquote(&valid)^= %then %if &_ltype= %then %let _ltype=_xtype; ************ make a small data set so summary wont take a lot of time --cant use obs= data set option on the real data set ******; %if %bquote(&data)= %then %goto exit; data _XTMP0; set %unquote(&data); %if %bquote(&format)^= %then %do; format %unquote(&format); %end; stop; run; %if &syserr>4 %then %goto fail; ************ use summary to reorder the variables; proc summary data=_XTMP0(firstobs=1 obs=1); output out=_XTMP1(drop=_TYPE_ _FREQ_); %if %qupcase(&_list)=BY %then %do; by %unquote(&&&_list); %end; %else %do; id %unquote(&&&_list); %end; run; %if &syserr>4 %then %do; %put ERROR: "%upcase(&_list)=&&&_list" is probably invalid.; %goto fail; %end; ************ make data set with variable names; proc contents data=_XTMP1(firstobs=1) %if &_fmt^= & &_xsysver>=608 %then fmtlen; noprint out=_&_name; run; %if &syserr>4 %then %goto fail; %if &_xdebug_>=2 %then %do; proc print data=_&_name(firstobs=1 obs=2000000000); run; %end; ************ remove variables from other lists; %if &remove^= %then %do; %let __j=1; %let __token=%scan(&remove,&__j); %do %while(&__token^=); proc sql; delete from _&_name(firstobs=1 obs=2000000000) where name in (select name from _&__token(firstobs=1 obs=2000000000)); run; %if &syserr>4 %then %goto fail; %let __j=%eval(&__j+1); %let __token=%scan(&remove,&__j); %end; %end; ************ order by position in data set, not alphabetically; %xnobs(_xvntmp,_&_name(firstobs=1 obs=2000000000)) %if &_xvntmp %then %do; %* avoid spurious warning from SORT; proc sort force data=_&_name(firstobs=1 obs=2000000000); by npos; run; %if &syserr>4 %then %goto fail; %end; ************ find out how many variables and what types; %let __count=0; %if &_ltype^= %then %let &_ltype=0; data _null_; %if &_ltype^= %then %do; retain ltype 0; %end; set _&_name(firstobs=1 obs=2000000000) nobs=count end=end; if _n_=1 then do; %if &_xdebug_ %then %do; put 'xvlist: count=' count; %end; call symput("__count",trim(left(put(count,5.)))); %if &_ltype^= %then %do; ltype=type; %end; end; %if &_ltype^= %then %do; else if ltype^=type then ltype=3; if end then call symput("&_ltype",left(put(ltype,5.))); %end; %else %do; stop; %end; run; %if &syserr>4 %then %goto fail; %if &_xdebug_ %then %do; %put xvlist: count=&__count!; %if &_ltype^= %then %put xvlist: ltype=&&&_ltype; %end; %************ validate list type; %if %bquote(&valid)^= %then %if %index(&valid,&&&_ltype)=0 %then %do; %let _xrc_=The %qupcase(&_list)= variable list must; %if &&&_ltype=0 %then %let _xrc_=%qcmpres(&_xrc_ contain at least one variable); %else %if %verify(&valid,02)=0 %then %let _xrc_=%qcmpres(&_xrc_ contain only character variables); %else %if %verify(&valid,01)=0 %then %let _xrc_=%qcmpres(&_xrc_ contain only numeric variables); %else %if %verify(&valid,012)=0 %then %let _xrc_=%qcmpres(&_xrc_ not contain both numeric and character variables); %else %let _xrc_=%qcmpres(&_xrc_ ???); %put ERROR: &_xrc_..; %goto finish; %end; %if &_count^= %then %let &_count=&__count; ************ make macro variables global before defining them; %if &_name^= %then %do __j=1 %to &__count; %global &_name&__j; %end; %if &_type^= %then %do __j=1 %to &__count; %global &_type&__j; %end; %if &_fmt^= %then %do __j=1 %to &__count; %global &_fmt&__j; %end; ************ assign variable names and formats to macro variables; %if &_name^= | &_type ^= | &_fmt^= %then %do; data _null_; set _&_name(firstobs=1 obs=2000000000); %if &_name^= %then %do; call symput("&_name"||left(put(_n_,5.)),trim(name)); %end; %if &_type^= %then %do; call symput("&_type"||left(put(_n_,5.)),put(type,1.)); %end; %if &_fmt^= %then %do; length fmt $20; if format=' ' then do; if type=1 then do; if formatl=0 then format="&dnf"; end; else format="&dcf"; end; if formatl=0 then if format^=' ' then do; if type=1 then formatl=&dnl; else formatl=length; end; fmt=trim(format)|| trim(left(put(formatl,3.)))||'.'; if type=1 then fmt=trim(fmt)||trim(left(put(formatd,3.))); call symput("&_fmt"||left(put(_n_,5.)),trim(fmt)); %end; run; %if &syserr>4 %then %goto fail; %end; %************ replace _list with expanded list; %if &replace %then %do; %let &_list=%xconcat(&_name,&__count); %if &_xdebug_ %then %do; %put xvlist: replaced list=&&&_list; %end; %end; %goto finish; %fail: %xerrset(Processing %qupcase(&_list) variable list failed) %finish: %xdelete(_XTMP0 _XTMP1); %exit: %mend xvlist; %************************** xdelete *****************************; %* delete work data sets; %* list list of data sets to delete; %macro xdelete(list); %if %bquote(&list)^= %then %do; %if &_xdebug_ %then %put XDELETE: &list; proc datasets nolist nowarn; delete %unquote(&list) / memtype=data; quit; %end; %mend xdelete; %************************** xfloat *****************************; %* evaluate an expression in floating point arithmetic in a DATA step; %* _result name of macro variable to assign result to; %* express expression; %* format (optional) format for converting the floating point result; %macro xfloat(_result,express,format); %if %bquote(&format)= %then %let format=best12.; %let &_result=.; data _null_; result=%unquote(&express); call symput("&_result",trim(left(put(result,&format)))); run; %if &syserr>4 %then %xerrset(DATA step to compute floating point expression &express failed); %else %if &_xdebug_ %then %put XFLOAT: &_result<-(&express)=&&&_result; %mend xfloat; %************************** xnobs *****************************; %* find number of observations in a data set; %* _xn name of macro variable to assign number of observations; %* data data set; %macro xnobs(_xn,data); %if &_xdebug_ %then %put XNOBS: _xn=&_xn data=&data; %global &_xn; %let &_xn=0; data _null_; if 0 then set %unquote(&data) nobs=_xn; call symput("&_xn",trim(left(put(_xn,12.)))); stop; run; %if &syserr>4 %then %xerrset(DATA step to find number of observations in data set %qupcase(&data) failed); %else %if &_xdebug_ %then %put XNOBS: &_xn=&&&_xn; %mend xnobs; %************************** xnvar *****************************; %* find number of variables in an array; %* _xn name of macro variable to assign number of variables; %* data data set; %* list list of variables in array; %macro xnvar(_xn,data,list); %global &_xn; %let &_xn=0; data _null_; if 0 then set %unquote(&data); array _xnvar [*] %unquote(&list); call symput("&_xn",trim(left(put(dim(_xnvar),12.)))); stop; run; %if &syserr>4 %then %xerrset(DATA step to find number of variables in an array in data set %qupcase(&data) failed); %else %if &_xdebug_ %then %put XNVAR: &_xn=&&&_xn; %mend xnvar; %************************** xdsinfo *****************************; %* return libname, memname, type, label; %* data data set; %macro xdsinfo(data); %global _xdslib _xdsmem _xdstype _xdslab; %if %bquote(&data)= %then %goto exit; %let _xdstype=?; proc contents data=%unquote(&data) out=_TEMP_ noprint; run; %if &syserr>4 %then %goto error; data _null_; set _TEMP_(firstobs=1 obs=1); call symput("_xdslib",trim(libname)); call symput("_xdsmem",trim(memname)); call symput("_xdstype",trim(typemem)); call symput("_xdslab",trim(memlabel)); stop; run; %if &syserr>4 %then %goto error; %xxbug(XDSINFO,data _xdslib _xdsmem _xdstype _xdslab) %goto exit; %error: %xerrset(Failure getting information for data set %qupcase(&data)); %exit: %xdelete(_TEMP_) %mend xdsinfo; %****** replace all occurrences of a substr with another string ******; %macro xrepstr(source,replace,with); %local result pos len prev; %let result=; %let len=%length(&replace); %let pos=%index(&source,&replace); %do %while(&pos); %let prev=%xsubstr(&source,1,&pos-1); %let result=&result&prev&with; %let source=%xsubstr(&source,&pos+&len); %let pos=%index(&source,&replace); %end; %let result=&result&source; &result %mend xrepstr; %****** replace all occurrences of a token with another string ******; %macro xreptok(source,replace,with); %local result tok; %let replace=%qtrim(%qleft(&replace)); %let result=%xsubstr(&source,1,%xverify(&source,)-1); %do %while(%xscan(tok,source)^=B); %if &tok=&replace %then %let result=&result&with; %else %let result=&result&tok; %let result=&result%xsubstr(&source,1,%xverify(&source,)-1); %end; &result %mend xreptok; %****** returns concatenation of &n macro variables named &_name.1 to &&_name&n with intervening blanks. This is a trivial thing to do, but if you do it the obvious way with a %LET statement in a loop, performance is terrible; %macro xconcat(_cat,n); %local __i; %do __i=1 %to &n; &&&_cat&__i %end; %mend xconcat; %****** set global variable to indicate that xmacro has been processed; %global _xmacro_; %let _xmacro_=610; /*********************** End Utility Macros *************************/