*! version 1.0.0  24 June 1996
program define far5
  version 5.0
  if "`*'"=="" | substr("`1'",1,1)=="," {
    _farpt `*'
    exit
  }

  local varlist "req ex min(2) max(2)"
  local options "LEvel(int $S_level) Eform"
  #delimit ;
  local options "`options' COVars(string) CMd(string) DEad(string)
                 Group(string) RATes * " ;
  #delimit cr
  local in "opt"
  local if "opt"
  local weight "aweight fweight"
  parse "`*'"
  preserve

  if `level'<10 | `level'>99 { local level 95 }
  if "`cmd'"=="" {
    local cmd "cox"
  }
  if "`cmd'"!="cox"&"`cmd'"!="clogit" {
    di in red "`cmd' not allowed"
    exit 198
  }
  if "`cmd'"=="cox" {
    if "`group'"!="" {
      di in red "GROUP not allowed with cox"
      exit 198
    }
    if "`dead'"!="" {
      local cens "dead(`dead')"
    }
    local norr "nohr"
    if "`eform'"~="" {
      local rr "hr"
    }
  }
  if "`cmd'"=="clogit" {
    if "`rates'"!="" {
      di in red "Rates not allowed with clogit"
      exit 198
    }
    if "`group'"=="" {
      di in red "GROUP var required"
      exit 198
    }
    local norr "noor"
    if "`eform'"~="" {
      local rr "or"
    }
    local group "gr(`group')"
  }
  quietly {
    if "`if'`in'"!="" {
      keep `if' `in'
    }
    parse "`varlist'", parse(" ")
    local y "`1'"
    local factor "`2'"
    drop if `y'==.|`factor'==.
    local stb=substr("`factor'",1,5)
    sort `factor'
    tempvar gp
    by `factor':gen byte `gp'=_n==1
    replace `gp'=sum(`gp')
    summ `gp'
    local K=_result(6)
    if `K'<2 {
      di in red "Factor has only one level"
      exit 198
    }
    local vars "`y'"
    local rn "`stb'_1"
    gen byte `stb'_1=`gp'==1
    local i "2"
    while `i'<=`K' {
      local rn "`rn' `stb'_`i'"
      gen byte `stb'_`i'=`gp'==`i'
      local vars "`vars' `stb'_`i'"
      local i=`i'+1
    }
    local vars "`vars' `covars'"

    if "`covars'"!="" {
      parse "`covars'", parse(" ")
      while "`1'"!="" {
        drop if `1'==.
        qui summ `1'
        qui replace `1'=`1'-_result(3)
        mac shift
      }
    }
    tempvar D PT
    if "`rates'"!="" {
      if "`dead'"=="" {
        gen `D'=1
      }
      else {
        gen `D'=`dead'>0 if `dead'!=.
      }
      drop if `D'==.
      replace `D'=sum(`D')
      gen `PT'=sum(`y')
      local CRATE=`D'[_N]/`PT'[_N]
    }

    if `K'<3 {
      noi `cmd' `vars', lev(`level') `cens' `rr' `group' `options'
      exit
    }
    else {
      `cmd' `vars', `cens' `norr' `group' `options'
    }
    local nobs=_result(1)
    tempname b V A0 A1 a A2
    mat `b' = get(_b)
    mat `V' = get(VCE)
    local k=`K'-1
    mat `A0'=J(`k',1,0)
    mat `A1'=J(`k',`k',0)
    local i "1"
    local a00=0
    while `i'<=`k' {
      local j "1"
      local ai0=0
      while `j'<=`k' {
        local ai0=`ai0'+`V'[`i',`j']
        local j=`j'+1
      }
      local ai0=`ai0'-`V'[`i',`i']
      mat `A0'[`i',1]=`ai0'/(`K'-2)
      local a00=`a00'+`ai0'
      local i=`i'+1
    }
    local a00=`a00'/((`K'-1)*(`K'-2))
    local i "1"
    while `i'<=`k' {
      mat `A0'[`i',1]=`a00'-`A0'[`i',1]
      local i=`i'+1
    }
    local i "1"
    while `i'<=`k' {
      local j "1"
      while `j'<=`k' {
        mat `A1'[`i',`j']=`V'[`i',`j']+`A0'[`i',1]+`A0'[`j',1]-`a00'
        local j=`j'+1
      }
      local i=`i'+1
    }
    mat `A1'=`A0',`A1'
    mat `a'=(`a00')
    mat `A0'=`a'\ `A0'
    mat `A0'=`A0''
    mat `A1'=`A0'\ `A1'
    mat `a'[1,1]=0
    mat `b'=`a',`b'
    mat `b'=`b'[.,1..`K']
    if "`rates'"!="" {
      local bbar "0"
      local i "1"
      while `i'<=`K' {
        local bbar=`bbar'+`b'[1,`i']
        local i=`i'+1
      }
      local bbar=`bbar'/`K'-log(`CRATE')
      mat `a'=J(1,`K',`bbar')
      mat `b'=`b'-`a'
    }
    mat colnames `b'=`rn'
    mat rownames `A1'=`rn'
    mat colnames `A1'=`rn'

    mat post `b' `A1', depname(`y') obs(`nobs')

    global S_tit "Cox Regression with floating absolute risk"
    if "`rates'"!="" {
      global S_tit "${S_tit}: Floating standardised rates"
    }
    global S_adjst
    if "`covars'"!="" {
      global S_adjst "Estimates are adjusted for `covars'"
    }
    if "`cmd'"=="clogit" {
      global S_tit "Cond logit Regression with floating absolute risk"
    }
    global S_rates "`rates'"
    global S_cmd "`cmd'"
    global S_E_cmd  "far5"

  }
    _farpt5, level(`level') `eform'

end


program define _farpt5
  version 4.0
  local options "LEvel(int $S_level) EForm"
  parse "`*'"
  if "$S_E_cmd"!="far5" { error 301 }
  if `level'<10 | `level'>99 {
    di in red "level() must be between 10 and 99"
    exit 198
  }

  di _n in gr "$S_tit"
  if "`eform'"~="" {
    if "$S_cmd"=="cox" {
      if "$S_rates"!="" {
        local ef "eform(Rate)"
      }
      else {
        local ef "eform(HRatio)"
      }
    }
    else {
      local ef "eform(ORatio)"
    }
  }
  mat mlout, level(`level') `ef'
  if "$S_adjst"!="" {
    noi dis in gr "$S_adjst"
  }

end