options symbolgen; %macro WPS2XML(_dsetname, _xmlout,_schemagen, _dtdgen); /****************************************************************************************/ /* Name: WPS2XML.sas Auth: Phil Rack */ /* Date: 5/24/2007 Revd: */ /* */ /* Desc: Takes a WPS dataset and outputs the variables into a standard XML file */ /* with the option to create a dtd. */ /* */ /* Where: _dsetname = the name of the dataset containing the variables to be written. */ /* _xmlout = the name of the XML file that will be created. */ /* _schemagen = YES/NO to create an XSD file. */ /* _dtdgen = YES/NO to create a DTD file. */ /* */ /* Copyright (C) 2007 by MineQuest, LLC. All Rights Reserved. www.minequest.com */ /****************************************************************************************/ %let DefNumFormat = d32.4; %let _dtdgenFlag=OK; *--> error check keywords for generating dtd file; %if (%upcase("&_dtdgen") ne "YES") and (%Upcase("&_dtdgen") ne "NO") %then %do; %let _dtdgenFlag=ERROR; %PUT ERROR: Invalid DTDGEN parameter. &_dtdgen is not a valid Option.; %PUT ERROR: Valid options are, YES or NO.; %end; %if (&_dtdgenFlag = OK) %then %do; Proc contents data=&_dsetname out=_contents_ noprint; run; *--> Get Variable Names; data _null_; set _contents_; call symput('MemName',memname); Run; *--> Put variable names into a macro array and get the var count into a macro variale; data _null_; length nvars 4; retain nvars 0; if (eof eq 1) then do; call symput("nvars",left(put(nvars,4.0))); stop; end; set _contents_ end=eof; if (upcase(name) not in("_OUT_","IDVALUE")) then do; nvars=nvars+1; call symput(trim("_nm"||left(put(nvars,4.0))||" "),left(name)); call symput(trim("_vt"||left(put(nvars,4.0))||" "),left(type)); call symput(trim("_ft"||left(put(nvars,4.0))||" "),left(format)); call symput(trim("_fl"||left(put(nvars,4.0))||" "),left(formatl)); call symput(trim("_fd"||left(put(nvars,4.0))||" "),left(formatd)); end; run; data _null_; set _contents_; length newvar $ 20; nvars+1; Retain nvars; *--> format numerics vars.if there is no format for the numeric variable; *--> assign a default numeric of best32.4; if formatl = 0 and formatd = 0 and type=1 then Newvar=left("&defnumformat"); if (formatl gt 0) and (type=1) and compress(format) not in('DATE','TIME','DATETIME', 'YYMMDD','MMDDYY','DDMMYY') then Newvar=left(Compress(format||formatl||'.'||formatd)); * -- this is it; if (formatl gt 0) and (type=1) and compress(Left(format)) in('DATE','TIME','DATETIME', 'YYMMDD','MMDDYY','DDMMYY') then Newvar=left(Compress(format||formatl||'.')); *--> format Character vars; if formatl = 0 and type=2 then Newvar=left(Compress('Char'||Length||%str('.'))); if formatl gt 0 and type=2 then Newvar=left(compress(format||formatl||%str('.') )); Call Symput(Trim ("_fmt"|| left(put(nvars,4.0)) ||" "),left(Newvar)); Run; DATA _NULL_; FILE &_xmlout ; PUT ''; PUT ''; RUN; DATA _NULL_; SET &_dsetname; LENGTH _outstr_3_ $ 16384; FILE &_xmlout mod; _memname_ = trim("&memname")||'>'; PUT '<' _memname_; %do i=1 %to &nvars; _Outstr_1_ = '<'; _Outstr_2_ = Trim("&&_nm&i") || '>'; *--> do not quote any vars; _Outstr_3_ = Left(Trim(Put(&&_nm&i,&&_fmt&i..))); if &&_vt&i = 1 and ("&&_ft&i" = "DATETIME") then _OutStr_3_ = Left(trim(put(datepart(&&_nm&i),yymmdd10.))) ||' ' || Left(trim(put(TimePart(&&_nm&i),time8.))); _Outstr_4_ = ''; _Outstr_ = Trim(_Outstr_1_) || Trim(_Outstr_2_) || Trim(_Outstr_3_) || Trim(_Outstr_4_) || Trim(_Outstr_5_); put _Outstr_; %end; PUT ''; run; %if %upcase(&_schemagen) = YES %then %do; DATA _NULL_; SchemaNamePos = index(%Upcase(&_xmlout),'.XML'); if SchemaNamePos > 0 then _SchemaName_ = Trim(substr(&_xmlout,1,SchemaNamePos) || 'XSD'); Else _SchemaName_ = Trim(&_xmlout || 'XSD'); call symput('SchemaFileName',_SchemaName_); Run; %let _Schemafn_ = %bquote(%str(&schemaFileName)); data _null_; file "&_schemafn_"; Length StrType $ 20; put ''; %do i=1 %to &nvars; _SchemaStr_ = Trim( Left('"')|| Trim("&&_nm&i") ||Left('"') ); if "&&_vt&i" = 2 then StrType= '"' || 'string' || '"' || '/>'; if "&&_vt&i" = 1 then do; if "&&_fd&i" eq 0 then StrType= '"' || 'decimal' || '"' || '/>'; if "&&_fd&i" gt 0 then StrType= '"' || 'decimal' || '"' || '/>'; End; *--> date format; if ("&&_vt&i" = 1) and (upcase("&&_ft&i") eq "YYMMDD") or (upcase("&&_ft&i") eq "MMDDYY") or (upcase("&&_ft&i") eq "DDMMYY") or (upcase("&&_ft&i") eq "DATE") then StrType = '"' || 'date' || '"' || '/>'; if ("&&_vt&i" = 1) and (upcase("&&_ft&i") = "TIME") then StrType = '"' || 'time' || '"' || '/>'; if ("&&_vt&i" = 1) and (upcase("&&_ft&i") = "DATETIME") then StrType = '"' || 'dateTime' || '"' || '/>'; put ''; Run; %end; %if %Upcase(&_dtdgen) = YES %then %do; DATA _NULL_; file &_xmlout mod; dtdnamepos = index(%Upcase(&_xmlout),'.XML'); if dtdnamepos > 0 then _dtdname_ = Trim(substr(&_xmlout,1,dtdnamepos) || 'DTD'); Else _dtdname_ = Trim(&_xmlout || 'DTD'); call symput('dtdfilename',_dtdName_); Run; %let _dtdfn_ = %bquote(%str(&dtdfilename)); *--> Create DTD; data _NULL_; FILE "&_dtdfn_"; PUT ''; PUT ''; output; RUN; DATA _NULL_; Retain varstrarr; Length varstr $ 200 vstr VarStrArr2 $ 16384; FILE "&_dtdfn_" mod; %Do i=1 %to &nvars -1; vstr = trim(vstr) || trim("&&_nm&i") || ', '; %End; vstr = TRIM(vstr) || TRIM("&&_nm&nvars") || ')>'; tblstr = TRIM(''; VarStrArr2 = ''; PUT VarStr; %End; Run; %end; data _null_; Put "NOTE: MACRO WPS2XML Invoked. "; Put "NOTE: XML File &_xmlout to be written."; %if %upcase(&_dtdgen) = YES %then %Do; Put "NOTE: DTD File Generation Parameter Called. DTD File Name &_dtdfn_"; %end; run; Proc delete data=_contents_; run; /******************************************************************************************/ /* WPS2XML is copyright (c) 2007 by MineQuest, LLC. All Rights Reserved. */ /* MineQuest, LLC, 1939 Queensbridge Dr., Columbus, OH USA. */ /* This Macro Program is proprietary software and is licensed property of MineQuest, LLC. */ /******************************************************************************************/ %end; *--> end error flags; %mend WPS2XML;