
/*THIS PROGRAM CALCULATES F-SCORE ACCORDING TO DECHOW ET AL.(2011 CAR)*/
/*THIS PROGRAM ALSO COLLECTS ADDITIONAL CONTROL VARIABLES ACCORDING TO BERGER & LEE (2022 JAR)*/
/*FSCORE: FY1985-FY2017*/
data a0a; set index (keep=gvkey year fybegdt fyenddt); where 1985<=year<=2017; run;
proc sql;
  create table a0 as select
    a.*, b.fybegdt as lagfybegdt, b.fyenddt as lagfyenddt
  from a0a a left join index b
  on a.gvkey=b.gvkey and
  	 a.year-1=b.year; quit;
proc sort data=a0 nodupkey; by gvkey year; run;

rsubmit;
proc upload data=a0 out=a0; run;
/*OBTAIN COMPUSTAT VARIABLES*/
proc sql;
  create table a1a as select
    a.*, b.act, b.che, b.lct, b.dlc, 
	b.at, b.ivao, b.lt, b.dltt, 
	b.ivst, b.pstk,
	b.rect, b.invt, b.ppent, b.sale, b.ib, b.sstk, b.dltis
  from a0 a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a1a nodupkey; by gvkey year; run;
proc sql;
  create table a1b as select
    a.*, b.act as actlag, b.che as chelag, b.lct as lctlag, b.dlc as dlclag, 
	b.at as atlag, b.ivao as ivaolag, b.lt as ltlag, b.dltt as dlttlag, 
	b.ivst as ivstlag, b.pstk as pstklag,
	b.rect as rectlag, b.invt as invtlag, b.sale as salelag, b.ib as iblag
  from a1a a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year-1=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a1b nodupkey; by gvkey year; run;
proc sql;
  create table a1 as select
    a.*, b.rect as rectlag2, b.at as atlag2
  from a1b a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year-2=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a1 nodupkey; by gvkey year; run;
/*COMPUTE F-SCORE VARIABLES*/
data a2 (keep=gvkey year rsst_acc ch_rec ch_inv soft_assets ch_cs ch_roa issue); set a1;
avgat=(at+atlag)/2;
avgatlag=(atlag+atlag2)/2;
wco=(act-che)-(lct-dlc);
wcolag=(actlag-chelag)-(lctlag-dlclag);
nco=(at-act-ivao)-(lt-lct-dltt);
ncolag=(atlag-actlag-ivaolag)-(ltlag-lctlag-dlttlag);
fin=(ivst+ivao)-(dltt+dlc+pstk);
finlag=(ivstlag+ivaolag)-(dlttlag+dlclag+pstklag);
rsst_acc=((wco-wcolag)+(nco-ncolag)+(fin-finlag))/avgat;
ch_rec=(rect-rectlag)/avgat;
ch_inv=(invt-invtlag)/avgat;
soft_assets=(at-ppent-che)/at;
cashsale=sale-(rect-rectlag);
cashsalelag=salelag-(rectlag-rectlag2);
ch_cs=(cashsale-cashsalelag)/cashsalelag;
ch_roa=(ib/avgat)-(iblag/avgatlag);
issue=0; if sstk>0 and sstk~=. or dltis>0 and dltis~=. then issue=1; run;
/*DELETE OBSERVATIONS WITHOUT THE PREREQUISITE VARIABLES FOR MODEL 1*/
data a2; set a2;
if rsst_acc=. or ch_rec=. or ch_inv=. or soft_assets=. or ch_cs=. or ch_roa=. or issue=. then delete; run;
/*WINSORIZE MACRO********************************************************************************/
%macro Winsorize_Truncate(dsetin = , 
                          dsetout = , 
                          byvar = none, 
                          vars = , 
                          type = W, 
                          pctl = 1 99);
    %if &dsetout = %then %let dsetout = &dsetin;    
    %let varL=;
    %let varH=;
    %let xn=1;
    %do %until (%scan(&vars,&xn)= );
        %let token = %scan(&vars,&xn);
        %let varL = &varL &token.L;
        %let varH = &varH &token.H;
        %let xn = %EVAL(&xn + 1);
    %end;
    %let xn = %eval(&xn-1);
    data xtemp;
        set &dsetin;
    %let dropvar = ;
    %if &byvar = none %then %do;
        data xtemp;
            set xtemp;
            xbyvar = 1;
        %let byvar = xbyvar;
        %let dropvar = xbyvar;
    %end;
    proc sort data = xtemp;
        by &byvar;
    /*compute percentage cutoff values*/
    proc univariate data = xtemp noprint;
        by &byvar;
        var &vars;
        output out = xtemp_pctl PCTLPTS = &pctl PCTLPRE = &vars PCTLNAME = L H;
    data &dsetout;
        merge xtemp xtemp_pctl; /*merge percentage cutoff values into main dataset*/
        by &byvar;
        array trimvars{&xn} &vars;
        array trimvarl{&xn} &varL;
        array trimvarh{&xn} &varH;
        do xi = 1 to dim(trimvars);
            /*winsorize variables*/
            %if &type = W %then %do;
                if trimvars{xi} ne . then do;
                    if (trimvars{xi} < trimvarl{xi}) then trimvars{xi} = trimvarl{xi};
                    if (trimvars{xi} > trimvarh{xi}) then trimvars{xi} = trimvarh{xi};
                end;
            %end;
            /*truncate variables*/
            %else %do;
                if trimvars{xi} ne . then do;
                    /*insert .T code if value is truncated*/
                    if (trimvars{xi} < trimvarl{xi}) then trimvars{xi} = .T;
                    if (trimvars{xi} > trimvarh{xi}) then trimvars{xi} = .T;
                end;
            %end;
        end;
        drop &varL &varH &dropvar xi;
    /*delete temporary datasets created during macro execution*/
    proc datasets library=work nolist;
        delete xtemp xtemp_pctl; quit; run;
%mend;
%Winsorize_Truncate(dsetin = a2, dsetout = a3,  
	vars = rsst_acc ch_rec ch_inv soft_assets ch_cs ch_roa, 
	type = W, pctl = 1 99); run;
/*CALCULATE FSCORE*/
/*NOTE: THE UNCONDITIONAL PROBABILITY IS BASED ON THE STATISTICS IN DECHOW ET AL TABLE 7 (ROUNDED TO 4 DECIMAL PLACES)*/
data a3; set a3;
FS1=-7.893+0.790*rsst_acc+2.518*ch_rec+1.191*ch_inv+1.979*soft_assets+0.171*ch_cs-0.932*ch_roa+1.029*issue; 
probFS1=exp(FS1)/(1+exp(FS1)); 
Fscore1=probFS1/0.0037; run;
data fscore; set a3;
label	rsst_acc='RSST Accruals'
		ch_rec='Change in receivables'
		ch_inv='Change in inventories'
		soft_assets='Percentage of soft assets'
		ch_cs='Percentage change in cash sales'
		ch_roa='Change in ROA'
		issue='Indicator if the firm issues securities'
		Fscore1='F-Score using Model 1'; run;
proc download data=fscore out=fscore; run;
endrsubmit;

/*COLLECTS ADDITIONAL CONTROL VARIABLES*/
data a0 (keep=gvkey year fyenddt sic2); set index; where 1985<=year<=2017;
sic2=int(sic/100); run;
rsubmit;
proc upload data=a0 out=a0; run;
/*OBTAIN COMPUSTAT VARIABLES*/
proc sql;
  create table a1 as select
    a.*, b.ni, b.sstk, b.prstkc, b.dltis, b.dltr 
  from a0 a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a1 nodupkey; by gvkey year; run;
/*CONSTRUCT VARIABLES*/
data a2; set a1;
loss=0; if ni<0 and ni~=. then loss=1;
stkissue=sstk-prstkc;
debtissue=dltis-dltr;
netfin=0; if stkissue>0 or debtissue>0 then netfin=1; run;
/*VOLATILITY OF SALES*/
proc sql;
  create table a3a as select
    a.gvkey, a.year, b.fyear, b.sale
  from a2 a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year-3<=b.fyear<=a.year-1 and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a3a nodupkey; by gvkey year fyear; run;
proc sql;
  create table a3 as select
    a.*, b.fyear as fyearlag, b.at
  from a3a a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.fyear-1=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a3 nodupkey; by gvkey year fyear; run;
data a3; set a3;
rev=sale/at; run;
proc means data=a3 noprint; by gvkey year;
  output out=a3stats stddev(rev)=stdrev; run;
/*INDUSTRY SALES GROWTH*/
proc sql;
create table a4a as select
    a.gvkey, a.year, a.sic2, b.sale
  from a2 a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a4a nodupkey; by gvkey year; run;
proc sql;
create table a4 as select
    a.*, b.sale as salelag
  from a4a a left join comp.funda b
  on a.gvkey=b.gvkey and
  	 a.year-1=b.fyear and
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D' and b.curcd = 'USD'; quit;
proc sort data=a4 nodupkey; by gvkey year; run;
data a4; set a4;
salegrowth=(sale/salelag)-1;
proc sort data=a4 nodupkey; by sic2 year gvkey; run;
proc means data=a4 noprint; by sic2 year;
  output out=a4stats median(salegrowth)=salegrowth_med; run;
/*MERGE TABLES TOGETHER*/
proc sql;
  create table a5a as select
    a.gvkey, a.year, a.fyenddt, a.sic2, a.loss, a.netfin, b.stdrev
  from a2 a left join a3stats b
  on a.gvkey=b.gvkey and
  	 a.year=b.year; quit;
proc sort data=a5a nodupkey; by gvkey year; run;
proc sql;
  create table a5 as select
    a.*, b.salegrowth_med
  from a5a a left join a4stats b
  on a.sic2=b.sic2 and
  	 a.year=b.year; quit;
proc sort data=a5 nodupkey; by gvkey year; run;
/*OBTAIN BIG5 DATA*/
proc sql;
  create table a6 as select
    a.*, b.AU
  from a5 a left join comp.co_aaudit b
  on a.gvkey=b.gvkey and
  	 a.fyenddt=b.datadate and 
	 b.consol='C' and b.indfmt='INDL' and b.datafmt='STD' and b.popsrc='D'; quit;
proc sort data=a6 nodupkey; by gvkey year; run;
data a6 (drop=fyenddt au); set a6;
/*DEFINE BIG4*/
big4=0;
if au in ("1","2","3","4","5","6","7","8") then big4=1; run;
proc means data=a6; run;
data a6; set a6;
label	loss='Indicator if net income is negative'
		netfin='Indicator if net stock issuance or net debt issuance is positive'
		stdrev='Volatility of sales in the past 3 years'
		salegrowth_med='Industry (SIC2) sales growth (median)'
		big4='Indicator for Big 4 auditors'; run;
proc download data=a6 out=a6; run;
endrsubmit;

/*CREATE FSCORE MEASURES BASED ON BENEISH AND VORST (2022 TAR)*/
data fscore; set fscore;
FS=Fscore1;  
FS1=0; if FS>1.0 then FS1=1; if FS=. then FS1=.;
FS2=0; if FS>1.85 then FS2=1; if FS=. then FS2=.;
FS3=0; if FS>2.45 then FS3=1; if FS=. then FS3=.; run;
proc sql;
  create table a7 as select
    a.*, b.FS, b.FS1, b.FS2, b.FS3
  from a6 a left join fscore b
  on a.gvkey=b.gvkey and
  	 a.year=b.year; quit;
proc sort data=a7 nodupkey; by gvkey year; run;
data fscore; set a7;
label	FS='F-score based on Dechow et al.(2011) Model 1'
		FS1='Indicator if Fscore >1.0'
		FS2='Indicator if Fscore >1.85'
		FS3='Indicator if Fscore >2.45'; run;

PROC EXPORT DATA= WORK.fscore 
            OUTFILE= "C:\JAR Files\fscore.dta" 
            DBMS=STATA REPLACE; run;
RUN;

