**************************************************************************************************** * PROGRAM OVERVIEW **************************************************************************************************** * * PROGRAM: table_creator.sas * * Created (mm/dd/yyyy): 12/19/2014 * Last modified: 03/27/2018 * Version: 3.10 * *-------------------------------------------------------------------------------------------------- * PURPOSE: * Create table 1 and PS distribution histograms using output from covariate adjustments module * * Program inputs: * * Program outputs: * * PARAMETERS: * -comp = Comparison number * -look = Looking period number * -psvar = Model variable (PREDEFINEDPS HDPSPREDEFINED HDPSONLY) * -pstype = Type of model (PREDEFINED, HDPS and PREDEFINED, HDPS ONLY) * -matchvar = Variable containing matched ids * -caliper = Caliper value * * Programming Notes: * The Initial Developer of the Original Code is the * Division of Pharmacoepidemiology and Pharmacoeconomics, * Department of Medicine, Brigham and Women's Hospital and * Harvard Medical School * * Module Leads: Joshua J Gagne, Shirley V Wang, Sebastian Schneeweiss * Programmer: Shirley V Wang (modified by Shawn Hallinan) * Uses Pharmacoepidemiology Toolbox macros, created by Jeremy Rassen * * *-------------------------------------------------------------------------------------------------- * CONTACT INFO: * Mini-Sentinel Coordinating Center * info@mini-sentinel.org * *-------------------------------------------------------------------------------------------------- * CHANGE LOG: * * Version Date Initials Comment (reference external documentation when available) * ------- -------- -------- --------------------------------------------------------------- * 1.2 02/06/15 SL(EM) changed name of the sas file from tables_creator.sas * adapted code for the "always match" * matched distribution plots only executed on patient where time=&look. * * 2.0 DM adapted macro to COVARIATEADJUSTMENT new design * * 2.1 DM merged 1.2 and 2.0 versions together because they were developed * concurrently * * 3.0 11/09/15 EM Removed third party dependency to Excel. Now outputted in a SAS * dateset. * * 3.1 12/21/15 EM New weighted standardized differences calculations * * 3.2 01/15/16 VC Add covariate enhancements to table * * 3.3 06/10/16 EM Updated Mahalanobis Distance to reflect model variables * * 3.4 12/09/16 AP Updated Dummies variable format for Mahalanobis Distance Calculation * * 3.5 2/10/17 AP Added .pdf output and consolidated histograms to 1 sheet * * 3.6 2/27/17 AP Modified histograms to: remove density plot and rescale y axis to percent * * 3.7 3/5/17 AP Added race, hispanic, year in Table 1 * Added race and hispanic to Mahalanobis Distance calculation Remove PS distribution and replaced with dataset defining bins * * 3.8 10/17/17 AP Recoded A/U sex values (QRP-453) * * 3.9 03/13/18 RR Adding conditional for PS vs. MFM matching (QRP-322) * * 3.10 03/13/18 RR Restrict PS distribution to PS score estimated in current look (QRP-556) * ***************************************************************************************************; /************************************************************** CREATE TABLES & PROPENSITY DISTRIBUTION FIGURES ***************************************************************/ %macro matchtables(comp=, look=, psvar=, pstype=, matchvar=, caliper=, input_file=); options mprint mlogic; proc printto log="&MSOC.&RUNID._table1_&comp._&look..log" new; run; %PUT =====> MACRO CALLED: table_creator v3.10 => matchtables; /****************************************************** GET START TIME ******************************************************/ data _NULL_; temp=DATETIME(); call symput('START',temp); call symput('STARTDATE',put(datepart(temp),date9.)); call symput('STARTTIME',put(timepart(temp),time4.)); run; /******************************************************** Directories to include in progam ********************************************************/ /** Specify name of input and output datasets for table creation **/ /** Set the location of the output rtf file in the specified directory **/ %if %sysfunc(exist(dplocal.&RUNID._matched_&comp._&LOOK)) = 0 %then %do; %put error: Input dataset does not exist; %abort; %end; %if %sysfunc(exist(dplocal.&RUNID._matched_&comp._&LOOK)) = 1 %then %do; %let input = &RUNID._matched_&comp._&LOOK; %end; /* Skip matched tables if there are no matches */ /* from any of sequential monitoring periods */ %let skip = ; PROC SQL NOPRINT ; create table exposure_time as select count(distinct studyclass) as c from dplocal.&input group by time; select max(c) into :numexposure from exposure_time; QUIT; %if &numexposure <2 %then %let skip = 1; * Set the list of dichotomous and continous variables; %if &ITT = 0 %then %let a_type = ASTREATED; %if &ITT = 1 %then %let a_type = ITT; %let covar = ; %let combcovar = ; %let util =; %let agecat =; PROC CONTENTS DATA = DPLOCAL.&INPUT OUT=VAR_NAMES(KEEP = NAME) NOPRINT; RUN; DATA var_names; SET var_names; u_name = UPCASE(name); * Age_cat=TRANSLATE(Age_cat,"_","-"); RUN; PROC SQL NOPRINT ; select name into :covar separated by ' ' from var_names where index(u_name, "COVAR") = 1 and index(name, "TIME") = 0 and index(u_name, "COVARNUM") = 0; select name into :combcovar separated by ' ' from var_names where index(u_name, "COMBCOVAR") = 1 and index(name, "TIME") = 0 and index(u_name, "COMBCOVARNUM") = 0; select name into :util separated by ' ' from var_names where index(u_name, "NUM") = 1; select distinct(compress("AGE"||compress(TRANSLATE(upcase(Age_cat),"_","-"), "<-+"))) into :agecat separated by ' ' from dplocal.&input where covarnum in(0,.); /*Restrict to "Overall" analysis to avoid duplicate entries*/ select distinct(compress(cat("YEAR_",year))) into :yearcat separated by ' ' from dplocal.&input where covarnum in(0,.); /*Restrict to "Overall" analysis to avoid duplicate entries*/ QUIT; %put &covar; %put &combcovar; %put &util; %put &agecat; %put &yearcat; %global dvarlst; %global cvarlst; %global race_vars; %let race_vars= ; %global hispanic_vars; %let hispanic_vars = ; %if "&race" ne "" %then %do; %let race_vars = race_unknown AmericanIndian Asian Black PacificIslander White; %end; %if "&hispanic" ne "" %then %do; %let hispanic_vars = hispanic_unknown hispanic_yes hispanic_no; %end; %let dvarlst = EVENT_&a_type &agecat female male &yearcat sex_other &race_vars &hispanic_vars &covar &combcovar ; %let cvarlst = FOLLOWUPTIME_&a_type AGE COMORBIDSCORE &util; %macro resultsout(data_input = , tabledvars = ,tablecvars = ); *create empty matched_tables table; data msoc.&RUNID._matched_tables_&comp._&Look. _row0; format comp_order group1 group2 table MetVar vartype $30. exp_mean exp_std exp_S2 comp_mean comp_std comp_S2 ad sd exp_w exp_w2 comp_w comp_w2 best.; call missing(of _all_); if _N_<1 then output msoc.&RUNID._matched_tables_&comp._&Look.; comp_order=strip("&COMP."); group1=strip("&grp1."); group2=strip("&grp2."); output _row0; run; proc sql noprint ; select count(distinct(compress("AGE"||compress(TRANSLATE(upcase(Age_cat),"_","-"), "<-+"))) ) into :totagecat from dplocal.&input where age_cat is not missing; select distinct(compress("AGE"||compress(TRANSLATE(upcase(Age_cat),"_","-"), "<-+"))) into :age1-:age%eval(&totagecat) from dplocal.&input where age_cat is not missing; select count(distinct(year)) into :totyearcat from dplocal.&input where year is not missing; select distinct(year) into :year1-:year1%eval(&totyearcat) from dplocal.&input where year is not missing; quit; %put &totagecat; %put &age1; %put &totyearcat; %put &year1; %macro w(); data datain2(rename=age_cat2=age_cat); set &data_input; where covarnum in(0,.); *Restrict to "Overall" analysis to avoid duplicate entries; *create indicators; NPAT = 1; FEMALE = (SEX = 'F'); MALE = (SEX = 'M'); SEX_OTHER = (SEX = 'O'); %if "&race_vars" ne "" %then %do; race_unknown = (RACE='0'); AmericanIndian = (RACE='1'); Asian = (RACE='2'); Black = (RACE='3'); PacificIslander = (RACE='4'); White = (RACE='5'); %end; %if "&hispanic_vars" ne "" %then %do; hispanic_unknown = (HISPANIC = 'U'); hispanic_yes = (HISPANIC = 'Y'); hispanic_no = (HISPANIC = 'N'); %end; format Age_Cat2 $12.;* AGEXXXX_XXXX; Age_Cat2="AGE"||Strip(compress(TRANSLATE(upcase(Age_cat),"_","-"), "<-+")); %do i = 1 %to %eval(&totagecat); %scan(&agecat,%eval(&i)) =(Age_Cat2 = "&&Age&i"); %end; %do a = 1 %to %eval(&totyearcat); %scan(&yearcat,%eval(&a)) = (year = "&&year&a"); %end; PRI_TX = (UPCASE(StudyClass) = %UPCASE("&grp1")); PRI_REF = (UPCASE(StudyClass) = %UPCASE("&grp2")); %if &skip = %str() %then %do; MATCHED = (&matchvar. ne ''); %end; %if &skip = 1 %then %do; MATCHED = 0; &psvar. = .; %end; *settings weights to 1 (Unmatched or 1:1); w=1; w2=1; label PRI_TX = "&grp1" PRI_REF = "&grp2"; keep Patid pri_tx pri_ref npat &tabledvars &tablecvars age_cat2 sex MATCHED &psvar. &matchvar. time w w2 YEAR time race hispanic exposure &hd_VarsSelected.; run; %mend; %w(); /* Get NPAT for each group */ proc sql noprint; select count(*) into :NPAT1 from datain2 where PRI_TX = 1; select count(*) into :NPAT2 from datain2 where PRI_REF = 1; quit; %put &NPAT1.; %put &NPAT2.; %macro filltables(table = , dsname = ,dichvars = , contvars = , percentDec = , subgroup = ); %local snpat1 snpat2; %let snpat1 = 0; %let snpat2 = 0; %put &subgroup.; *restrict to subgroup; %if &subgroup ne %str() %then %do; data &subgroup; set &dsname; where &subgroup = 1; run; %let dsin = &subgroup; %put Subgroup Table &subgroup; %put dsin &dsin.; %end; %else %do; data Unmatched; set &dsname; run; %let dsin = Unmatched; %put Unmatched Dataset Table; %end; /* Continue if there are >0 observations in the subgroup */ %let dsid=%sysfunc(open(&dsin)); %let numobs=%sysfunc(attrn(&dsid,nlobs)); %let rc=%sysfunc(close(&dsid)); %put &numobs.; %if &numobs>0 %then %do; proc sql noprint; select count(*) into :snpat1 from &dsin where PRI_TX = 1; select count(*) into :snpat2 from &dsin where PRI_REF = 1; quit; %put Number in group 1 is &npat1; %put Number in group 2 is &npat2; %put Number in subgroup 1 is &snpat1; %put Number in subgroup 2 is &snpat2; %if &SNPAT1 eq 0 %then %do; %let percnpat1 = %sysfunc(putn(0,best.)); %end; %if &SNPAT1 ne 0 %then %do; %let percnpat1 = %sysfunc(putn(%sysevalf(&snpat1 /&npat1),best.)); %end; %if &SNPAT2 eq 0 %then %do; %let percnpat2 = %sysfunc(putn(0,best.)); %end; %if &SNPAT2 ne 0 %then %do; %let percnpat2 = %sysfunc(putn(%sysevalf(&snpat2 /&npat2),best.)); %end; *overall N (never weighted); data _row; set _row0; table=strip("&table."); MetVar="TOTAL"; vartype=""; exp_mean = input("&snpat1.",best.); exp_std = input("&percnpat1.",best.); comp_mean = input("&snpat2.",best.); comp_std = input("&percnpat2.",best.); run; proc append data=_row base=msoc.&RUNID._matched_tables_&comp._&Look. force; run; %put &table.; %if "&table." = "Matched" %then %do; *Calculate matchvar weight denominators; proc means data= &dsin. noprint nway; var NPAT; class PRI_TX &matchvar.; output out=Weights(drop=_:) sum=w; run; *Put back in &dsin.; proc sql noprint undo_policy=none; create table &dsin. as select a.*, (1/b.w) as w, (1/b.w)*(1/b.w) as w2 from &dsin.(drop=w w2) as a left join Weights(where=(w>0 and &matchvar. ne '')) as b on a.PRI_TX = b.PRI_TX and a.&matchvar. = b.&matchvar. order PRI_TX; quit; proc datasets library=work nolist nowarn; delete Weights; quit; %end; %let ndichvars = %sysfunc(countw(&tabledvars.," ")); %let ncontvars = %sysfunc(countw(&tablecvars.," ")); %macro wrapper; data &dsin.; set &dsin.; if w = . then w=1; *weighted variables; %do tmp_d = 1 %to &ndichvars;%scan(&tabledvars,&tmp_d)_w=%scan(&tabledvars,&tmp_d)*w;%end; %do tmp_c = 1 %to &ncontvars;%scan(&tablecvars,&tmp_c)_w=%scan(&tablecvars,&tmp_c)*w;%end; run; %mend; %wrapper; %put &tabledvars.; %put &tablecvars.; %macro wrapper; *This is dependant on the matched status; proc sql noprint undo_policy=none; create table &dsin. as select a.* ,sum(w) as SumW ,sum(w2) as SumW2 %do tmp_d = 1 %to &ndichvars;,sum(%scan(&tabledvars,&tmp_d)) as Sum%scan(&tabledvars,&tmp_d) %end; /* SUM_x for dich*/ %do tmp_d = 1 %to &ndichvars;,sum(%scan(&tabledvars,&tmp_d)_w) as Sum%scan(&tabledvars,&tmp_d)_w %end; /* SUM_xw for dich*/ %do tmp_c = 1 %to &ncontvars;,sum(%scan(&tablecvars,&tmp_c)) as Sum%scan(&tablecvars,&tmp_c) %end; /* SUM_x for cont*/ %do tmp_c = 1 %to &ncontvars;,sum(%scan(&tablecvars,&tmp_c)_w) as Sum%scan(&tablecvars,&tmp_c)_w %end; /* SUM_xw for cont*/ from &dsin. as a group by PRI_TX; quit; %mend; %wrapper; %let totdich = %sysfunc(countw(&dichvars," ")); /*%let dsin= datain2; %let dvar= EVENT_ASTREATED;*/ %do tmp_j = 1 %to &totdich; %let dvar = %scan(&dichvars,&tmp_j); data _dvar; set &dsin.; *fixed; mean=Sum&dvar._w/SumW; if SumW**2 ne SumW2 ne 0 then S2sqLeftPart=SumW/(SumW**2-SumW2); *Variable; S2sqRightPart=w*(&dvar.-mean)**2; keep Patid &dvar. &dvar._w sum&dvar._w SumW SumW2 PRI_TX PRI_REF mean w w2 S2sq:; run; proc sql noprint undo_policy=none; create table _dvar as select PRI_REF, max(a.sum&dvar._w) as N, max(a.mean) as mean, max(a.S2sqLeftPart) as S2sqLeftPart, max(a.SumW) as SumW, max(a.SumW2) as SumW2, sum(a.S2sqRightPart) as S2sqRightPart from _dvar as a group by PRI_REF order by PRI_REF; quit; data _row; set _dvar end=eof; if _N_=1 then set _row0; if not eof then do; *PRI_REF=0; exp_mean=N; exp_std=mean; *p (to be outputted); exp_w=SumW; exp_w2=SumW2; if "&table." = "Unmatched" or ("&table." = "Matched" and &ratio. = 1) then do; exp_S2=mean*(1-mean); put "using p(1-p) for the variance for reference group"; end; else do; exp_S2=S2sqLeftPart*S2sqRightPart; end; end; else do; comp_mean=N; comp_std=mean; *p (to be outputted); comp_w=SumW; comp_w2=SumW2; if "&table." = "Unmatched" or ("&table." = "Matched" and &ratio. = 1) then do; comp_S2=mean*(1-mean); put "using p(1-p) for the variance for reference group"; end; else do; comp_S2=S2sqLeftPart*S2sqRightPart; end; *absolute difference; ad=exp_std-comp_std; *Standardized difference; if sum(exp_S2,comp_S2)>0 then sd=(exp_std-comp_std)/sqrt((exp_S2+comp_S2)/2); table=strip("&table."); MetVar=upcase("&dvar."); vartype="dichotomous"; output; end; retain exp_mean exp_std exp_S2 exp_w exp_w2; keep comp_order group1 group2 table MetVar vartype exp_mean exp_std exp_S2 comp_mean comp_std comp_S2 ad sd exp_w exp_w2 comp_w comp_w2; run; proc append data=_row base=msoc.&RUNID._matched_tables_&comp._&Look. force; run; %end; %let totrow = %sysfunc(countw(&contvars," ")); %do numrvar = 1 %to &totrow; %let cvar = %scan(&contvars, &numrvar); data _cvar; set &dsin.; *fixed; mean=Sum&cvar._w/SumW; if SumW**2 ne SumW2 ne 0 then S2sqLeftPart=SumW/(SumW**2-SumW2); *Variable; S2sqRightPart=w*(&cvar.-mean)**2; keep Patid &cvar. &cvar._w SumW SumW2 PRI_TX PRI_REF mean w w2 S2sq:; run; proc sql noprint undo_policy=none; create table _cvar as select PRI_REF, max(a.mean) as mean, max(a.S2sqLeftPart) as S2sqLeftPart, max(a.SumW) as SumW, max(a.SumW2) as SumW2, sum(a.S2sqRightPart) as S2sqRightPart from _cvar as a group by PRI_REF order by PRI_REF; quit; data _row; set _cvar end=eof; if _N_=1 then set _row0; if not eof then do; exp_mean=mean; exp_std=S2sqLeftPart*S2sqRightPart; exp_w=SumW; exp_w2=SumW2; end; else do; comp_mean=mean; comp_std=S2sqLeftPart*S2sqRightPart; comp_w=SumW; comp_w2=SumW2; *absolute difference; ad=exp_mean-comp_mean; *Standardized difference; if sum(exp_std,comp_std)>0 then sd=(exp_mean-comp_mean)/sqrt((exp_std+comp_std)/2); exp_S2=exp_std; comp_S2=comp_std; if exp_std>0 then exp_std=sqrt(exp_std); if comp_std>0 then comp_std=sqrt(comp_std); table=strip("&table."); MetVar=upcase("&cvar."); vartype="continuous"; output; end; retain exp_mean exp_std exp_w exp_w2; keep comp_order group1 group2 table MetVar vartype exp_mean exp_std exp_S2 comp_mean comp_std comp_S2 ad sd exp_w exp_w2 comp_w comp_w2; run; proc append data=_row base=msoc.&RUNID._matched_tables_&comp._&Look. force; run; %end; /* Initialize the dist macro variables to - in case something has gone wrong */ /* in the distance dataset then the distance will show up as - in the output */ /* tables */ %let dist = -; /* Use the candisc procedure to get Mahalanobis distance for the Predefined */ /* Covariates */ ods listing close; %let dsid=%sysfunc(open(&dsin,in)); %let nobs=%sysfunc(attrn(&dsid,nobs)); %if &dsid > 0 %then %do; %let rc=%sysfunc(close(&dsid)); proc sql noprint ; select count(distinct PRI_TX) into :numexp from &dsin; quit; %put &numexp; %end; %if &nobs > 0 and &numexp>1 /*and (%length(&noclassvars.) or %length(&classvars.))*/ %then %do; /* CHANGE DEMOGRAPHIC DATA FROM TEXT TO NUMERIC GET NUMBER */ /* OF PREDEFINED COVARIATE CONDITIONS AND COVARIATE RX */ PROC SQL NOPRINT ; create table age as select /*distinct age_cat*/ distinct(compress("AGE"||compress(TRANSLATE(upcase(Age_cat),"_","-"), "<-+"))) as age length=12 from ( (select distinct age_cat from DPLocal.&input. WHERE age is not missing) union (select distinct StratumName as age_cat from DPLocal.&input. where covarnum=1001) ); create table SEX as select distinct sex from ( (select distinct sex from DPLocal.&input. where sex is not missing) union (select distinct StratumName as sex from DPLocal.&input. where covarnum=1000) ); %if "&race_vars" ne "" %then %do; create table RACE as select distinct race from ( (select distinct race from DPLocal.&input. where race is not missing) union (select distinct StratumName as race from DPLocal.&input. where covarnum=1012) ); %end; %if "&hispanic_vars" ne "" %then %do; create table HISPANIC as select distinct hispanic from ( (select distinct hispanic from DPLocal.&input. where hispanic is not missing) union (select distinct StratumName as hispanic from DPLocal.&input. where covarnum=1013) ); %end; create table year as select distinct year from ( (select distinct(/*"YEAR"||*/strip(put(year,best.))) as year length=12 from DPLocal.&input. where year is not missing) union (select distinct StratumName as year from DPLocal.&input. where covarnum=1002) ); PROC SQL NOPRINT ; create table time as select distinct time from ( (select distinct(strip(put(time,best.))) as time length=12 from DPLocal.&input. where time is not missing) union (select distinct StratumName as time from DPLocal.&input. where covarnum=1003) ); QUIT; %macro number(var = ); DATA &var; set &var; num&var = _n_; keep &var num&var; RUN; PROC MEANS DATA = &var noprint; VAR num&var; OUTPUT OUT = temp N = N; RUN; %global num&var; DATA TEMP; SET TEMP; CALL SYMPUTX("num&var", put(N,best.)); RUN; %mend; %number(var = age); %number(var = sex); %number(var = year); %number(var = time); %if "&race_vars" ne "" %then %do; %number(var = race); %end; %else %do; %let numrace = 0; %end; %if "&hispanic_vars" ne "" %then %do; %number(var = hispanic); %end; %else %do; %let numhispanic =0; %end; %put &numage &numsex &numyear &numtime &numrace &numhispanic; data &dsin; set &dsin; yearc=strip(put(year,best.)); timec=strip(put(time,best.)); run; PROC SQL NOPRINT; CREATE TABLE numericdemo as SELECT D.*, numage, numsex, numyear, numtime %if "&race_vars" ne "" %then %do;, numrace %end; %if "&hispanic_vars" ne "" %then %do;, numhispanic %end; FROM &dsin as D INNER JOIN AGE AS A ON D.AGE_CAT = A.AGE INNER JOIN SEX AS S ON D.SEX = S.SEX INNER JOIN YEAR AS S ON D.YEARc = S.YEAR INNER JOIN time AS S ON D.timec = S.time %if "&race_vars" ne "" %then %do; INNER JOIN race AS S ON D.race = S.race %end; %if "&hispanic_vars" ne "" %then %do; INNER JOIN hispanic AS S ON D.hispanic = S.hispanic %end; ; QUIT ; DATA DEMO; SET numericdemo; ARRAY A(&numage) AGE1-AGE%eval(&numage); ARRAY S(&numsex) SEX1-SEX%eval(&numsex); ARRAY Y(&numyear) YEAR1-YEAR%eval(&numyear); ARRAY T(&numtime) TIME1-TIME%eval(&numtime); %if "&race_vars" ne "" %then %do; ARRAY R(&numrace) RACE1-RACE%eval(&numrace); %end; %if "&hispanic_vars" ne "" %then %do; ARRAY H(&numhispanic) HISPANIC1-HISPANIC%eval(&numhispanic); %end; DO i = 1 to &numage; A(i) = 0; IF numage = i THEN A(i) = 1; END; DO i = 1 to &numsex; S(i) = 0; IF numsex = i THEN S(i) = 1; END; DO i = 1 to &numyear; Y(i) = 0; IF numyear = i THEN Y(i) = 1; END; DO i = 1 to &numtime; T(i) = 0; IF numtime = i THEN T(i) = 1; END; %if "&race_vars" ne "" %then %do; DO i = 1 to &numrace; R(i) = 0; IF numrace = i THEN R(i) = 1; END; %end; %if "&hispanic_vars" ne "" %then %do; DO i = 1 to &numhispanic; H(i) = 0; IF numhispanic = i THEN H(i) = 1; END; %end; RUN; *convert selected categorial in dummies; %let UseYear=0; %let Useage=0; %let Usesex=0; %let Usetime=0; %let Userace=0; %let Usehispanic=0; %let dummies=; proc contents data=&INPUT_FILE. out=comparison_contents noprint; run; proc sql noprint; select LENGTH into: class_length from comparison_contents where upcase(name) = "CLASS"; quit; %put &class_length; data _null_; format dummies $&class_length..; dummies=upcase("&classvars."); if index(upcase("&classvars."),'YEAR') then do; call symputx("UseYear",1); dummies=TRANWRD(dummies, "YEAR", ""); end; if index(upcase("&classvars."),'AGE') then do; call symputx("Useage",1); dummies=TRANWRD(dummies, "AGE", ""); end; if index(upcase("&classvars."),'SEX') then do; call symputx("Usesex",1); dummies=TRANWRD(dummies, "SEX", ""); end; if index(upcase("&classvars."),'TIME') then do; call symputx("Usetime",1); dummies=TRANWRD(dummies, "TIME", ""); end; if index(upcase("&classvars."),'RACE') then do; call symputx("Userace",1); dummies=TRANWRD(dummies, "RACE", ""); end; if index(upcase("&classvars."),'HISPANIC') then do; call symputx("Usehispanic",1); dummies=TRANWRD(dummies, "HISPANIC", ""); end; call symputx("dummies",dummies); run; %put &UseYear. &Useage. &Usesex. &Usetime. &Userace. &Usehispanic. &dummies.; %if (%UPCASE("&ANALYSIS.") eq "PS") %then %do ; proc candisc data = demo out = mhal2 distance; class PRI_TX; var %if %eval(&Useage.=1) %then %do; AGE1-AGE%eval(&totagecat.) %end; %if %eval(&Usesex.=1) %then %do; SEX1-SEX%eval(&numsex.) %end; %if %eval(&UseYear.=1) %then %do; year1-year%eval(&numyear.) %end; %if %eval(&UseTime.=1) %then %do; time1-time%eval(&numtime.) %end; %if %eval(&Userace.=1) %then %do; race1-race%eval(&numrace.) %end; %if %eval(&Usehispanic.=1) %then %do; hispanic1-hispanic%eval(&numhispanic.) %end; &dummies. &noclassvars. &hd_VarsSelected.; ods output Dist = distance; run; /* In case of running on systems where the output dataset "distance" */ /* has variable names that do not have leading "_" */ proc transpose data = distance (drop = FromPRI_TX) out = t; run; proc sql noprint ; select col1 format best. into :dist from t where monotonic() = 2; quit; %put &dist; proc datasets nolist; delete distance mhal t; run; data _row; set _row0; table=strip("&table."); MetVar=upcase("Mahalanobis"); vartype="continuous"; exp_mean =&dist.; run; proc append data=_row base=msoc.&RUNID._matched_tables_&comp._&Look. force; run; %END; *FOR PS analysis; %end; *nobs numexp; ods listing; /* End of Mahalanobis distance code */ %end; * if there were >0 obs and numexp>1 in the subgroup; %if &numobs=0 & "&table." = "Matched" %then %do; *When no matched, still create empty; data _forSquare; set msoc.&RUNID._matched_tables_&comp._&Look.; call missing(exp_mean, exp_std, exp_S2, comp_mean, comp_std, comp_S2, ad, sd, exp_w, exp_w2, comp_w, comp_w2); table = "Matched"; run; data msoc.&RUNID._matched_tables_&comp._&Look.; set msoc.&RUNID._matched_tables_&comp._&Look. _forSquare; run; %end; %mend; %filltables(table = Unmatched, dsname = datain2, subgroup=, dichvars = &tabledvars, contvars = &tablecvars, percentDec = 1); %filltables(table = Matched, dsname = datain2, subgroup = MATCHED, dichvars = &tabledvars, contvars = &tablecvars, percentDec = 1); /* Get statistics */ %if %sysfunc(exist(dplocal.&RUNID._estimates_&comp._&look.)) %then %do; data stats; set dplocal.&RUNID._estimates_&comp._&look.; where strip(PSTYPE)=strip("&pstype."); run; %let cstat = PS Model did not converge; proc sql noprint; select c_stat format best. into :cstat from stats where score_model_converged = 1; quit; %put &cstat; PROC SQL NOPRINT ; select score_model_converged into :c1 from dplocal.&RUNID._estimates_&comp._&look. where strip(PSTYPE)=strip("&pstype."); QUIT; %put &c1; %macro output_ps_distribution(data=, type=); %let start = -.0125; %let end = 0.0125; %let interval = 0.025; data bins; set &data.(where=(time=&look.)); %do bin = 1 %to 41; if &start. < &psvar. <= &end. then ps_cat = &bin.; %let start = &start. + &interval.; %let end = &end. + &interval.; %end; patient = 1; run; proc means data=bins noprint nway; var patient; class ps_cat exposure; output out=sum_bins_&type.(drop=_:) sum=; run; /*Square ps_cat*/ data squared_pscat; %do bin = 1 %to 41; ps_cat = &bin.; exposure = 0; output; exposure = 1; output; %end; run; proc sql noprint undo_policy=none; create table sum_bins_&type. as select x.patient ,y.exposure ,y.ps_cat from sum_bins_&type. as x right join squared_pscat as y on x.ps_cat = y.ps_cat and x.exposure = y.exposure; quit; %mend; %output_ps_distribution(data=datain2, type=AllPts); %if &ratio.=1 %then %do; %output_ps_distribution(data=MATCHED, type=Matched); %end; data msoc.&runid._psdistribution_&comp._&look.(drop=exposure); length group $40. type $20.; set sum_bins_allpts (in=a) %if &ratio.=1 %then %do; sum_bins_matched (in=b) %end; ; comp_order = &comp.; if exposure = 0 then group = "&Grp2."; if exposure = 1 then group = "&Grp1."; if patient = . then patient = 0; rename patient = npts; if a then do; type = "AllPts"; end; %if &ratio.=1 %then %do; if b then do; type = "Matched"; end; %end; run; %end; %mend; %resultsout(data_input = dplocal.&input , tabledvars = &dvarlst. , tablecvars = &cvarlst.); /** Get Total Run Time **/ data _NULL_; temp=DATETIME(); seconds=temp-&start.; hours=int(seconds/3600); minutes=int((seconds-hours*3600)/60); seconds2=int((seconds-hours*3600-minutes*60)); call symput('STOP',temp); call symput('hours',put(hours,4.0)); call symput('minutes',put(minutes,2.0)); call symput('seconds',put(seconds2,2.0)); run; %global tabletime; %let tabletime = &hours. h &minutes. m &seconds. s; %put &tabletime; DATA TEMP; length TABLETIME $150.; DO i = 1 to 1; MONITORINGPERIOD = put(&LOOK, 2.); COMPARISON = PUT(&comp., 2.) ; TABLETIME = "&TABLETIME"; OUTPUT; DROP i; END; RUN; %if (%UPCASE("&ANALYSIS.") eq "PS") %then %do ; DATA MSOC.&RUNID._TIMING; RETAIN MONITORINGPERIOD COMPARISON ADJUSTMENTRUNTIME HDPSRUNTIME MATCHRUNTIME; MERGE MSOC.&RUNID._TIMING TEMP; BY MONITORINGPERIOD COMPARISON ; RUN; %end; /** CLEAN UP **/ proc datasets library=work nolist kill; quit; run; proc datasets library = msoc; delete excel_table_def table_cells table_col_def table_def table_footnotes table_row_def; run; %put NOTE: ********END OF MACRO: table_creator v3.10 => matchtables ********; proc printto log=log print=print;run; %mend;