*! version 1.0.0  10/17/93              STB-19: sqv9
program define dprobit
	version 3.1
	parse "`*'", parse(" ,")
	local options "Level(int $S_level) CLassic AT(string)"
	if "`1'"!="" & "`1'"!="," {
		local varlist "req ex min(2)"
		local weight "aweight fweight"
		local if "opt"
		local in "opt"
		local options "`options' *"
		parse "`*'"

		if "`at'"!="xbar" & "`at'"!="pbar" & "`at'"!="" {
			confirm number `at'
			if `at'<0 | `at'>1 {
				di in red "at() invalid"
			}
		}

		tempname t		/* used for various things 	*/
		tempname b x 		/* coefs and sample means	*/
		tempvar touse		/* sample marker 		*/
		tempvar tosumm		/* lhs var mapped to 0/1 	*/
		tempvar preds		/* predictions, sample selec	*/

		mark `touse' [`weight'`exp'] `if' `in'
		markout `touse' `varlist'

		probit `varlist' [`weight'`exp'] if `touse', nocoef `options'
		if _result(1)==0 | _result(1)==. {
			exit 2000
		}

					/* check constant exists	*/
		capture scalar `t'=_b[_cons]
		if _rc {
			di in red "may not drop constant"
			exit 399
		} 

					/* check if drops from sample	*/
		quietly predict float `preds' if `touse'
		capture assert `preds'~=. if `touse'
		if _rc { 		
			quietly replace `touse'=0 if `preds'==.
			parse "`varlist'", parse(" ")
			local varlist "`1'"
			mac shift 
			while "`1'"!="" { 
				capture scalar `t'=_b[`1']
				if _rc==0 { 
					local varlist "`varlist' `1'"
				}
				mac shift
			}
		}

				/* obtain Xb evaluation at means, f(Xb) */
		parse "`varlist'", parse(" ")
		quietly gen byte `tosumm'=`1'!=0 if `touse'
		quietly summ `tosumm' [`weight'`exp'] if `touse'
		scalar S_E_pbar = _result(3)
		scalar S_E_ybar = invnorm(_result(3))
		matrix `b' = get(_b) 
		matrix `x' = get(mns)
		matrix `b' = `b' * `x''
		scalar S_E_xbar = `b'[1,1]
		matrix drop `x' `b'

				/* mark the dummies 			*/
		mac shift
		while "`1'"!="" {
			capture assert `1'==0 | `1'==1 if `touse'
			if _rc {
				global S_E_dum "$S_E_dum 0"
			}
			else	global S_E_dum "$S_E_dum 1"
			mac shift
		}
				
				/* save other info			*/
		global S_E_vl "`varlist'"
		global S_E_if "`if'"
		global S_E_in "`in'"
		global S_E_wgt "`weight'"
		global S_E_exp "`exp'"
		global S_E_ll=_result(2)
		global S_E_nobs=_result(1)
		global S_E_mdf=_result(3)
		global S_E_cmd "dprobit"
	}
	else	parse "`*'"

				/* begin replay logic		*/
	if "$S_E_cmd" != "dprobit" { error 301 } 
	if `level'<10 | `level'>99 {
		local level 95
	}

	probit, nocoef
	di _n in gr "Probit Estimates" _col(57) "Number of obs =" /*
		*/ in ye %7.0f _result(1)
	di in gr _col(57) "chi2(" in ye _result(3) in gr ")" _col(71) /*
		*/ "=" in ye %7.2f _result(6)
	di in gr _col(57) "Prob > chi2   =" in ye /*
		*/ %7.4f chiprob(_result(3),_result(6))
	di in gr "Log Likelihood = " in ye %10.0g _result(2) /*
		*/ _col(57) in gr "Pseudo R2" _col(71) "=" /*
		*/ in ye %7.4f _result(7)

	parse "$S_E_vl", parse(" ")
	local skip = 8-length("`1'")

	di _n in gr _dup(78) "-" _n /*
		*/ _skip(`skip') "`1' |" _col(17) "dF/dX" _col(25) /*
		*/ "Std. Err." _col(41) "z" _col(47) "P>|z|" /*
		*/ _col(59) "[`level'% Conf. Interval]" _n /*
		*/ _dup(9) "-" "+" _dup(68) "-"

	local lhs "`1'"
	mac shift
	tempname b z s Z M y0 y1 ll ul ybar fp
	if "`at'"=="xbar" | "`at'"=="" {
		scalar `ybar' = scalar(S_E_xbar)
	}
	else if "`at'"=="pbar" {
		scalar `ybar' = scalar(S_E_ybar)
	}
	else {
		confirm number `at'
		if `at'<0 | `at'>1 {
			di in red "at() invalid"
			exit 198
		}
		local userat "true"
		scalar `ybar' = invnorm(`at') 
	}
	scalar `fp' = 1/sqrt(2*_pi)*exp(-(`ybar'^2)/2)
	matrix `M' = get(mns)			/* matrix of means	*/
	scalar `Z' = invnorm(1-(1-`level'/100)/2)
	local i 1
	while "``i''"!="" {
		scalar `z'=_b[``i'']/_se[``i'']
		scalar `y0' = `ybar'-`M'[1,`i']*_b[``i'']
		local isdum : word `i' of $S_E_dum
		if `isdum' & "`classic'"=="" {
			local anydum "true"
			local star "*"
			scalar `y1' = `y0' + _b[``i'']
			scalar `b' = normprob(`y1') - normprob(`y0')
			scalar `s' = `b'/`z'
			scalar `ll' = /*
			*/normprob(`y0'+_b[``i'']-`Z'*_se[``i''])-normprob(`y0')
			scalar `ul' = /*
			*/normprob(`y0'+_b[``i'']+`Z'*_se[``i''])-normprob(`y0')
		}
		else {
			scalar `b'=_b[``i'']*`fp'
			scalar `s'=_se[``i'']*`fp'
			scalar `ll' = `b'-`Z'*`s'
			scalar `ul' = `b'+`Z'*`s'
			local star " "
		}
		local skip=8-length("``i''")
		di in gr _skip(`skip') "``i''`star'|  " in ye /*
			*/ %9.0g `b' "  " /*
			*/ %9.0g `s' "  " /*
			*/ %9.3f `z' "  " /*
			*/ %6.3f 2*normprob(-abs(`z')) "      " /* 
			*/ %9.0g `ll' "   " /*
			*/ %9.0g `ul'
		local i=`i'+1
	}
	local ttl "<-- dF/dX evaluated here"
	if "`userat'"!="true" {
		if "`at'"=="xbar" | "`at'"=="" { 
			local ttlmean "`ttl'"
		}
		else 	local ttlsamp "`ttl'"
	}
	di in gr _dup(9) "-" "+" _dup(68) "-" _n /*
		*/ "  obs. P |  " in ye %9.0g scalar(S_E_pbar) /*
		*/ in gr _col(55) "`ttlsamp'"
	di in gr " pred. P |  " in ye %9.0g normprob(scalar(S_E_xbar)) /*
		*/ in gr "  (at means of indep. vars.)" _col(55) "`ttlmean'"
	if "`userat'"=="true" { 
		di in gr "       P |  " in ye %9.0g `at' /* 
		*/ in gr _col(55) "`ttl'"
	}
	di in gr _dup(78) "-"
	if "`anydum'"=="true" {
		di in gr /*
		*/ "(*) " _quote "dF/dX" _quote /*
		*/ " is for discrete change of dummy variable from 0 to 1"
	}
end