options ps=120 ls=160 nodate pageno=1;
dm log "clear;" continue; dm out "clear;" continue;
ods html close;
ods listing;

%let outdir=C:\Documents\when to censor - composite events; 
libname out "C:\Documents\when to censor - composite events"; 

%let reps=1000;
%let n=1000; 
%let Mmean=6; 

*create data - generate visit structure and then data underlying it on a daily level that is only seen at visits;
%let maxfu=120; 
*reset datasets holding results; 
proc datasets library=work nolist; 
	delete biases countlost: capt: cens: km: meas: prev: risk: one two; 
	quit;

data one; 
	call streaminit(477); 
	do sim=1 to &reps.; 
		do id=1 to &n.; 
			m=0; *m is number of months/units of time;
			lastm=0; *keep track of time between visits;
			do while (m<=&maxfu.);
				nextm=min(m+max(1,min(rand('poisson',&Mmean.),11)),&maxfu.); *next visit is average of Mmean months after current visit - bound at 1,11 to ensure no LTFU in complete data; 
				if m>=&maxfu. then leave; *stop generating data after max 10 years of follow-up;
				output;
				lastm=m; *lag variables; 
				m=nextm;
			end; 
		end;
	end; 
	run;
/*proc means data=one min mean median max; var minterval; run;*/

*data set ONE contained visits, now generate data values that underlie those visits; 
********************************************************************************************************************************************************;
* SET UP MACROS;
*simplify code to calculate a probability and generate a bernoulli random variable;
%macro bern(var);
	rand('bernoulli',1/(1+exp(-(&var.))));
%mend bern;
********************************************************************************************************************************************************;
******** j=1 MEASURED, j=2 CAPTURED; 
%macro newtruth(risk,j);
data two; 
	set one; 
	by sim id m; 
	retain tmpy tmpj y j out; 
	if first.id then do; /*define baseline variables:*/
		tmpy=rand('uniform',0,120)*rand('bernoulli',&risk./100); 
		tmpj=1+rand('bernoulli',&j./100); 
		y=0; /*y is the outcome*/
		j=0; 
	end;
	*assign time-varying conditions; 
	if m<tmpy<=nextm and not last.id then do; 
		y=1; j=tmpj; if j=1 then out=nextm; if j=2 then out=ceil(tmpy); 
	end; 
	if m<tmpy<=nextm and     last.id then do; 
		if tmpj=1 then do; y=0; j=0; out=nextm; end; /*measured event wont be observed, do nothing*/ 
		else do; y=1; j=tmpj; out=ceil(tmpy); end;
	end; 
	if last.id then do;
		if tmpy=0 then out=nextm; 
		output; 
	end;
	drop tmpy tmpj m lastm nextm; 
	run;
proc phreg data=two noprint;
	model out*y(0)=;
	baseline out=totkm survival=s; 
	run;
data truthtot (drop=s); set totkm end=eof; if eof; r=1-s; run;
proc phreg data=two noprint;
	model out*j(0)= / eventcode=1;
	baseline out=meas cif=r; 
	run;
data truthmeas; set meas end=eof; if eof; run;
proc phreg data=two noprint;
	model out*j(0)= / eventcode=2; 
	baseline out=capt cif=r; 
	run;
data truthcapt; set capt end=eof; if eof; run;
%mend newtruth;

title;

********************************************************************************************************************************************************************************;
*compare with truth; 
*there are 4 variations - 2x2 table with measured v captured event, and censor at definition v last encounter; 
%macro biascalc(event,scen);
*keep risk estimate at end of administrative follow-up; 
data risk; 
	set km&event._&scen. (rename=(r=r_est));
	if _n_=1 then set truth&event.; 
	simbias=r_est-r; 
	run; 
proc means data=risk noprint nway; 
	var simbias r_est;
	output out=risk_ests (drop=_type_ _freq_) mean=avg_bias avg_r
		median=med_bias med_r
		q1=q1_bias q1_r
		q3=q3_bias q3_r;
	run; 
*merge estimated R, RD, RR with truth and calculate bias; 
data risk_bias; 
	set risk_ests;
	if _n_=1 then set truth&event.; 
	length mediqr_bias $ 30; 
	r_bias=round((avg_r-r)*100,0.0001); 
	r_pctbias=round((avg_r-r)/r*100,0.1); 
	avg_r=round(avg_r*100,0.001); 
	mediqr_bias=strip(put(round(med_bias*100,0.1),10.1))||" ("||strip(put(round(q1_bias*100,0.1),10.1))||", "||strip(put(round(q3_bias*100,0.1),10.1))||")"; 
	drop r out; 
	run;
*estimate prevalence of LTFU for specific simulation;
proc means data=countlost noprint;
	var percent; 
	output out=prevltfu (drop=_type_ _freq_) mean=totpctdrop;
	run;
*save off summary values; 
data bias; 	
	set risk_bias; 
	length censstrategy eventtype $ 6; 
	if _n_=1 then set prevltfu; 
	totrisk=put("&totrisk.",10.5); 
	riskj1=put("&riskj1.",10.5);
	riskj2=put("&riskj2.",10.5); 
	eventtype="&event."; 
	censstrategy="&scen."; 
	run;
proc append base=biases data=bias; run;
%mend biascalc; 


%macro censorsetup(event); 	
%global title2 scen; 
%do simtmp=1 %to &reps. %by 10; 
	data cens1; set cens1tot; where &simtmp.<=sim<&simtmp.+10; run;
	*get last encounter from death data set - which includes last encounter prior to event. if it is AFTER ltfu date, patient is censored; 
	proc sql;
		*last encounter is last encounter prior to "censtmp" random variable;
		create table tmp as 
		select cens1.sim, cens1.id, max(one.m) as lastseen
		from cens1 left join one on (cens1.sim=one.sim and cens1.id=one.id and one.m<=cens1.censtmp)
		group by cens1.sim, cens1.id; 
		quit;
	************************ CENSOR AT DEFINITION ************************;
	data cens_flat; 
		merge cens1 (rename=(y=ytrue j=jtrue)) tmp; *cens1 has one observation per person and t is the end of follow-up in truth;
		by sim id; 
		defmet=lastseen+12; *this is when they meet the censoring definition;
		if defmet>=120 or lastseen>=out then do; *if they do not meet definition of LTFU ever, they are admin censored; 
			outcens=out; y=ytrue; j=jtrue; drop=0; 
		end;
		else if defmet<out then do; *if they meet the def of LTFU before their event they are censored at definition;
			outcens=defmet; y=0; j=0; drop=1; 
		end; 
		else if lastseen<out<=defmet then do; 
			if jtrue=1 then do; outcens=defmet; y=0; j=0; drop=1; end;*measured events will not be captured and persons will be treated as censored;
			if jtrue=2 then do; outcens=out; y=ytrue; j=jtrue; drop=0; end;
		end;
		run;

	title2 "censor at definition"; 
	%let title2=censor at definition; 
	%global scen;
	%let scen=def; *scen indexes analytic approaches; 
	*output KM curves; 
	%if "&event."="tot" %then %do;
	proc phreg data=cens_flat noprint; 
		model outcens*y(0)=;
		baseline out=km survival=s / method=emp;
		by sim;  
		run;
	data km; set km; by sim; if last.sim; r=1-s; drop s; run;
	proc append base=kmtot_&scen. data=km; run;
	%end;
	%else %if "&event."="meas" %then %do; 
	proc phreg data=cens_flat noprint; 
		model outcens*j(0)=  / eventcode=1;
		baseline out=km cif=r / method=emp;
		by sim;  
		run;
	data km; set km; by sim; if last.sim; run;
	proc append base=kmmeas_&scen. data=km; run;
	%end; 
	%else %if "&event."="capt" %then %do;
	proc phreg data=cens_flat noprint; 
		model outcens*j(0)=  / eventcode=2;
		baseline out=km cif=r / method=emp;
		by sim;  
		run;
	data km; set km; by sim; if last.sim; run;
	proc append base=kmcapt_&scen. data=km; run;
	%end;

	************************ CENSOR LAST VISIT ************************; 
	*actually impose censoring under alternate censoring scenario - censor last time they were seen as long as they meet definition of LTFU; 
	data cens_flat (where=(outcens>0)); *if first visit is last visit, person contributes no person-time to analysis...; 
		merge cens1 (rename=(y=ytrue j=jtrue)) tmp;
		by sim id; 
		defmet=lastseen+12; *this is when they meet the LTFU definition;
		if defmet>=120 or lastseen>=out then do; *if administratively censored or had the event before their last visit, person is not LTFU; 
			outcens=out; y=ytrue; j=jtrue; drop=0; 
		end;
		else if defmet<out then do; *if they meet the LTFU definition, set end of follow-up to date last seen and any outcomes for persons who are LTFU are not observed; 
			outcens=lastseen; y=0; j=0; drop=1; 
		end; 
		else if lastseen<out<=defmet then do; 
			if jtrue=1 then do; outcens=lastseen; y=0; j=0; drop=1; end;*measured events will not be captured and persons will be treated as censored;
			if jtrue=2 then do; outcens=out; y=ytrue; j=jtrue; drop=0; end;*captured events will preclude person from meeting LTFU definition and will be included; 
		end;
		run;

	title2 "censor last visit"; 
	%let title2=censor last visit; 
	%let scen=last; 
	*output KM curves; 
	%if "&event."="tot" %then %do;
	proc phreg data=cens_flat noprint; 
		model outcens*y(0)=;
		baseline out=km survival=s / method=emp;
		by sim;  
		run;
	data km; set km; by sim; if last.sim; r=1-s; drop s; run;
	proc append base=kmtot_&scen. data=km; run;
	%end;
	%else %if "&event."="meas" %then %do;
	proc phreg data=cens_flat noprint; 
		model outcens*j(0)= / eventcode=1;
		baseline out=km cif=r / method=emp;
		by sim;  
		run;
	data km; set km; by sim; if last.sim; run;
	proc append base=kmmeas_&scen. data=km; run;
	%end;
	%else %if "&event."="capt" %then %do;
	proc phreg data=cens_flat noprint; 
		model outcens*j(0)= / eventcode=2;
		baseline out=km cif=r / method=emp;
		by sim;  
		run;
	data km; set km; by sim; if last.sim; run;
	proc append base=kmcapt_&scen. data=km; run;
	%end;
	
	************************ CENSOR SEPARATELY ************************;
	%if "&event."="tot" %then %do;
		data cens_flat; 
			merge cens1 (rename=(y=ytrue j=jtrue)) tmp; *cens1 has one observation per person and t is the end of follow-up in truth;
			by sim id; 
			defmet=lastseen+12; *this is when they meet the censoring definition;
			if defmet>=120 or lastseen>=out then do; *if they do not meet definition of LTFU ever, they are admin censored; 
				outcensdef=out; outcenslast=out; y=ytrue; j=jtrue; drop=0; 
			end;
			else if defmet<out then do; *if they meet the def of LTFU before their event they are censored at definition;
				outcensdef=defmet; outcenslast=lastseen; y=0; j=0; drop=1; 
			end; 
			else if lastseen<out<=defmet then do; 
				if jtrue=1 then do; outcensdef=defmet; outcenslast=lastseen; y=0; j=0; drop=1; end;*measured events will not be captured and persons will be treated as censored;
				if jtrue=2 then do; outcensdef=out; outcenslast=out; y=ytrue; j=jtrue; drop=0; end;
			end;
			run;

		title2 "censor separately"; 
		%let title2=censor separately; 
		%global scen;
		%let scen=new; *scen indexes analytic approaches; 
		*output KM curves, censoring competing events, separately for each event...trying to estimate cause-specific hazards;
		proc phreg data=cens_flat noprint;
			model outcenslast*j(0,2)=; *censor when last seen for measured event;
			baseline out=km1 survival=s1 / method=emp;
			by sim; 
			run;
		proc phreg data=cens_flat noprint;
			model outcensdef*j(0,1)=; *censor at definition for captured event;
			baseline out=km2 survival=s2 / method=emp;
			by sim; 
			run;
		*sum cumulative hazards for each event to get total cumulative hazard; 
		data km; 
			merge km1 (rename=(outcenslast=outcens)) km2 (rename=(outcensdef=outcens));
			by sim outcens;
			retain ch1 ch2;
			if outcens=0 then do; ch1=0; ch2=0; end;
			if s1>. then ch1=-log(s1); 
			if s2>. then ch2=-log(s2);
			ch=ch1+ch2; 
			s=exp(-ch);
			r=1-s; 
			if last.sim then output; 
			keep sim outcens r; 
			run;
		proc append base=kmtot_&scen. data=km; run;
	%end;

	************************ keep track of prevalence of LTFU ************************; 
	proc sql; 
		create table countlost_tmp as
		select sim, sum(drop)/count(*) as percent 
		from cens_flat
		group by sim; 
		quit;
	proc append base=countlost data=countlost_tmp; run;

%end;
%biascalc(&event.,def); 
%biascalc(&event.,last); 
%biascalc(&event.,new); 

*reset datasets holding results; 
proc datasets library=work nolist; 
	delete km&event._def km&event._last; 
	quit;
%if "&event."="tot" %then %do;
proc datasets library=work nolist;
	delete km&event._new;
	quit;
%end;
%mend censorsetup; 


********************************************************************************************************************************************************************************;
*** 1: CENSORING IS RANDOM; 
********************************************************************************************************************************************************************************;
*event j1 (MEASURED EVENT) has higher cause-specific hazard than j2 (CAPTURED EVENT);
*inputs to newtruth macro are 1: OR for period exposure-> J1, 2: OR for period exposure -> J2, 3: baseline period risk for J1, 4: baseline period risk for J2;

%let pctdrop=40;
%let constrisk=40;
%macro wrapper;
%global riskj1 riskj2 totrisk;
data _null_; 
	maxpct=(100-&constrisk.)/100; 
	call symput("maxpct",strip(put(round(maxpct*100,5),3.)));
	run;
%put maxpct=&maxpct.; 

%do pctcapt=5 %to &maxpct %by 5; 
/*hold risk of measured event constant and vary risk of captured event as a competing risk*/
data _null_; 
	pct=&pctcapt./100; 	
	constrisk=&constrisk./100;
	riskj1=constrisk; 
	riskj2=constrisk*(pct/(1-pct)); 
	call symput("riskj1",strip(put(riskj1*100,3.))); 
	call symput("riskj2",strip(put(riskj2*100,3.))); 
	call symput("totrisk",strip(put((riskj1+riskj2)*100,3.))); 
	run;
%put "measured event " pctcapt=&pctcapt. constrisk=&constrisk. riskj1=&riskj1. riskj2=&riskj2. totrisk=&totrisk.;
%newtruth(&totrisk.,&pctcapt.);
*add date last seen; 
data cens1tot; 
	set two; 
	by sim; 
	tmpdrop=rand('bernoulli',&pctdrop./100);
	censtmp=rand('uniform',0,120)*tmpdrop+120*(1-tmpdrop);
	run;
* censorsetup macro should implement censoring, then apply the two censoring schemes - censor at definition and censor at last seen;
%censorsetup(meas);
%end; 

/*hold risk of captured event constant and vary risk of measured event as a competing risk*/
%do pctmeas=5 %to &maxpct %by 5; 
data _null_; 
	pct=&pctmeas./100; 	
	constrisk=&constrisk./100;
	riskj1=constrisk*(pct/(1-pct)); 
	riskj2=constrisk; 
	call symput("riskj1",strip(put(riskj1*100,3.))); 
	call symput("riskj2",strip(put(riskj2*100,3.))); 
	call symput("totrisk",strip(put((riskj1+riskj2)*100,3.))); 
	call symput("pctcapt",strip(put(100-&pctmeas.,3.)));
	run;
%put "captured event " pctmeas=&pctmeas. pctcapt=&pctcapt. constrisk=&constrisk. riskj1=&riskj1. riskj2=&riskj2. totrisk=&totrisk.;
%newtruth(&totrisk.,&pctcapt.);
*add date last seen; 
data cens1tot; 
	set two; 
	by sim; 
	tmpdrop=rand('bernoulli',&pctdrop./100);
	censtmp=rand('uniform',0,120)*tmpdrop+120*(1-tmpdrop);
	run;
* censorsetup macro should implement censoring, then apply the two censoring schemes - censor at definition and censor at last seen;
%censorsetup(capt);
%end; 

%do pctcapt=5 %to 95 %by 5; 
data _null_;
	call symput("riskj1",strip(put(&constrisk.*(100-&pctcapt.)/100,3.)));
	call symput("riskj2",strip(put(&constrisk.*&pctcapt./100,3.)));
	call symput("totrisk",strip(put(&constrisk.,3.)));
	run;
/*hold total risk constant and vary proportion of risk that is captured*/
%put "total risk " pctcapt=&pctcapt. constrisk=&constrisk. riskj1=&riskj1. riskj2=&riskj2. totrisk=&totrisk.;
%newtruth(&constrisk.,&pctcapt.); 
*add date last seen; 
data cens1tot; 
	set two; 
	by sim; 
	tmpdrop=rand('bernoulli',&pctdrop./100);
	censtmp=rand('uniform',0,120)*tmpdrop+120*(1-tmpdrop);
	run;
%censorsetup(tot); 
%end;
%mend wrapper;

options nosource nonotes;
%wrapper;
options source notes; 

proc sort data=biases; by eventtype censstrategy; run;

data anno; 
	retain xsys '1' ysys '2' color 'black' line 1 size 30; 
	function='move'; x=0; y=0; output;
	function='draw'; x=100; y=0; output;
	run;
%macro graph(j);
data graph_tot; 
	if "&j"="total" then set biases (where=(eventtype="tot"));
	if "&j"="measured" then set biases (where=(eventtype="meas")); 
	if "&j"="captured" then set biases (where=(eventtype="capt")); 
	if censstrategy="def" then do; linelabel="At LTFU definition"; group=1; end;
	else if censstrategy="last" then do; linelabel="At last visit"; group=2; end;
	else if censstrategy="new" then do; linelabel="Hybrid"; group=3; end;
	xaxis_pctcapt=round(riskj2/totrisk,0.01); 
	med_bias=med_bias*100;
	q1_bias=q1_bias*100;
	q3_bias=q3_bias*100; 
	run;
proc sort data=graph_tot; by group xaxis_pctcapt; run;
proc sql noprint;
	select floor(min(r_bias)) into: lo from graph_tot;
	select ceil(max(r_bias)) into: hi from graph_tot; 
	quit;
title;
goptions reset=all device=zgif ftext="Albany AMT" htext=12pt gsfname=grafout gsfmode=replace xmax=4 ymax=4 xpixels=4000 ypixels=4000; 
axis1 label=(angle=90 "bias") w=8 major=(w=8 h=18) minor=none offset=(0,0) order=(-2 to 2 by 1) origin=(22,17) pct;
axis2 label=("pct capt") w=8 major=(w=8 h=7) minor=none offset=(0,0) order=(0 to 1 by 0.2) value=(angle=45 rotate=0);
symbol1 c=grayd0 v=none i=sm25 w=16 l=1 mode=include;
symbol2 c=grayd0 v=none i=sm25 w=16 l=22 mode=include;
symbol3 c=gray70 v=none i=sm25 w=16 l=1 mode=include;
filename grafout "&outdir.\risk40_ltfu20_&j..png";
proc gplot data=graph_tot; 
	plot med_bias*xaxis_pctcapt=group / noframe nolegend annotate=anno haxis=axis2 vaxis=axis1;* legend=legend1; 
	run; 
	quit;
%mend graph;
%graph(total);
%graph(measured);
%graph(captured);


/*proc export data=biases outfile="&outdir.\const risk 40 ltfu 40_20aug18.csv" dbms=csv replace;*/
/*	run;*/

proc import file="&outdir.\const risk 40 ltfu 20_20aug18.csv" dbms=csv out=r40l20 replace;
	run; 
proc import file="&outdir.\const risk 40 ltfu 40_20aug18.csv" dbms=csv out=r40l40 replace;
	run; 
proc import file="&outdir.\const risk 15 ltfu 20_20aug18.csv" dbms=csv out=r15l20 replace;
	run; 
proc import file="&outdir.\const risk 15 ltfu 40_20aug18.csv" dbms=csv out=r15l40 replace;
	run; 

proc sort data=r15l20; by riskj2; run;
data totbias; 
	set r40l20 (in=a)
	    r40l40 (in=b)
	    r15l20 (in=c)
	    r15l40 (in=d);
	where eventtype="tot";
	if a or c then ltfu=20;
	else ltfu=40; 
	retain avg_bias_def med_bias_def;
	if censstrategy="def" then do;
		avg_bias_def=avg_bias;
		med_bias_def=med_bias;
	end;
	if censstrategy="last" then do;
		avg_bias_last=avg_bias;
		med_bias_last=med_bias;
		if abs(med_bias_last)<abs(med_bias_def) then med_best="last"; else med_best="def"; 
		if abs(avg_bias_last)<abs(avg_bias_def) then avg_best="last"; else avg_best="def";
		pct_meas=round(riskj1/totrisk*100,0.1); 
		output;
	end;
	keep avg_bias_def med_bias_def avg_bias_last med_bias_last avg_best med_best totrisk pct_meas ltfu; 
	run;
data totbias;
	set totbias;
	lagmedbest=lag(med_best); 
	if lagmedbest="last" and med_best="def"; 
	run;