*! version 2.0  dgc/mh Sep 1997   STB-41 ssa10.1

program define sttocc
   version 5.0
   st_is
   local varlist "opt ex"
   local options "GENerate(string)  FCodes(string) Match(string)"
   local options "`options' Number(integer 1) SCale(real 1) ORigin(string)"
   parse "`*'"
   parse "`generate'", parse(" ")
   local d "`1'" 
   if "`d'"=="" {
      local d "_case"
   }
   local setid "`2'"
   if "`setid'"=="" {
      local setid "_set"
   }
   local ctime "`3'"
   if "`ctime'"=="" {
       local ctime "_time"
   }
   confirm new var `d' `setid' `ctime'
   if "`4'" != "" {
      di in re "only 3 variables are generated"
      exit
   }
   if "`match'" != "" {
      confirm var `match'
   }
   if "`origin'" != "" {
      confirm var `origin'
   }
   st_show
   if "`fcodes'"!="" {
      di
      di in gr "   failure codes:  " in ye "`fcodes'"
   }
   if "`origin'"!="" {
      di in gr "     time origin:  " in ye "`origin'"
   }
   if "`match'"!="" {
      di in gr "    matching for:  " in ye "`match'"
   }

   local f : char _dta[st_d]
   local t : char _dta[st_t]
   local t0 : char _dta[st_t0]
   local wv : char _dta[st_wv]
   local ttype : type `t'
   local ftype : type `f'

   * trim down to the dataset to be saved

   keep `varlist' `f' `t' `t0' `wv' `match'

   tempvar idd sel include timein timeout new tied
   tempname nc obs tmpobs incr jitter

   * generate d, timein and timeout variables

   if "`fcodes'"=="" {
      gen byte `d' = (`f'!=0)
   }
   else {
      gen `ftype' `d' = `f'
      qui recode `d' `fcodes'=1 *=0
      qui recast byte `d'
   }
   gen `ttype' `timeout' = `t'
   if "`t0'"!="" {
      gen `ttype' `timein' = `t0'
   }
   else {
      gen `ttype' `timein' = 0
   }
   if "`origin'"!="" {
      qui replace `timeout' = `timeout' - `origin'
      qui replace `timein' = `timein' - `origin'
   }


   qui {

      * checks on ties in timeout 
      * place censorings after failures and randomly jitter failures

      summ `timeout'
      local jitter = sqrt(_result(4))*0.0001

      sort `timeout'
      by `timeout': gen int `tied' = (`d'!=0 & _N!=1)
      by `timeout': replace `tied' = sum(`tied')
      by `timeout': replace `tied' = 0 if _n<_N
      count if `tied'>0
      local nties = _result(1)
      if `nties'>0 {
         noi di
         noi di in bl "There were `nties' tied times involving failure(s)"
         noi di in bl _col(3) "- failures assumed to precede censorings,"
         noi di in bl _col(3) "- tied failure times split at random"
         by `timeout': replace `timeout'=`timeout' + /*
            */ cond(`d'==0, 3*`jitter', invnorm(uniform())*`jitter') /*
            */ if _N != 1
      }

      * sorts with cases first, in order of timeout

      replace `d' = 1-`d'
      sort `d' `timeout'
      replace `d' = 1-`d'

      *counts number of cases

      count if `d'==1
      scalar `nc'=_result(1)
      noi di
      noi di in gr "There are " in ye `nc' in gr " cases"

      * sets initial values

      gen int `idd'=_n
      gen int `setid'=.
      scalar `obs'=_N
      scalar `tmpobs'=_N 
      gen byte `include'=.
      if `scale'==1 {
         gen `ttype' `ctime'=.
      }
      else {
         gen double `ctime'=.
      }
      
      * sample each set in turn

      noi di in gr "Sampling " in ye "`number'" in gr /*
         */ " controls for each case: "
      local case = 1
      while `case'<=`nc' {
         noi di  "." _continue
         local ftime = `timeout'[`case']
         replace `include'= (_n != `case')
         parse "`match'", parse(" ")
         while "`1'" != "" {
            * sets include=1 for all records which pass the matching criteria 
            * except the current case
            replace `include' =  `include' & (`1' == `1'[`case'])
            mac shift
         }
         replace `include'=`include'& `timein'<`ftime' & `timeout'>`ftime' & /*
            */ `idd'!=.

         * selects random sample from all records with include = 1

         rsamp `idd' if `include', gen(`sel') n(`number')
        
         * counts how many controls are selected

         count if `sel'==1
         scalar `incr'=_result(1) + 1

         * expands selected controls and current case        

         expand 2 if `idd'==`idd'[`case'] | `sel'==1
         replace `setid'=`case' if _n>`tmpobs'
         replace `ctime'=`timeout'[`case']/`scale' if _n>`tmpobs'

         replace `d'=0 if `d'==1 & _n> `tmpobs' & `idd' != `idd'[`case']
         replace `idd'=. if _n>`obs'

         local case = `case'+1
         scalar `tmpobs' = `tmpobs' + `incr'
         drop `sel'
      }
      drop if _n<=`obs'
   }
   di
   sort `setid' `d'
   end

*! version 1.0 
cap program drop rsamp
program define rsamp
version 3.1
local varlist "req ex min(1) max(1)"
local if "opt"
local in "opt"

local options "GENerate(string) Number(integer 1)"
parse "`*'"
parse "`varlist'", parse(" ")
local id `1'
tempvar u include
confirm new var `generate'


qui {
gen `generate'=0
count `if' `in'
if _result(1)<`number' {
noi di in bl " Warning: sample requested greater than population"
replace `generate' = 1 `if' `in'
exit }
qui gen `u'=uniform() `if' `in'
sort `u'
qui replace `generate'=1 in 1/`number'
sort `id'
}
end