*! version 1.0 dgc/mh Nov 1996  STB-40 ssa10
program define stlexis
   version 5.0
   di
   di in gr "Lexis: expansion of survival time data by time bands"
   st_is
   local varlist "opt ex" 
   local options "BReaks(string) GENerate(string) ORigin(string)"
   local options "`options' SCale(string) Label Invert"
   parse "`*'"
   local stid : char _dta[st_id]
   if "`stid'"=="" {
      di in re "st data must have an id variable declared"
      exit
   }
   if "`breaks'"=="" {
      di in re "You must specify break points"
      exit
   }
   st_show
   di
   local timout : char _dta[st_t]
   local timin : char _dta[st_t0]
   local ttype : type `timout'
   if "`origin'"!="" {
      di in gr "          origin:  " in ye "`origin'"
      if "`invert'"!="" {
         di in gr _col(20) "(value, on break-scale, when t=0 on st-scale)"
      }
      capture confirm var `origin'
      if _rc==0 {
         if "`origin'"=="`timin'" | "`origin'"=="`timout'" {
            di in bl "Warning: time origin is one of the st variables"
            di in bl _col(3) "- these might have been changed if you have " /*
               */ "used stlexis earlier"
         }
         local vor "`origin'"
      }
      else {
         capture confirm number `origin'
         if _rc!=0 {
            di in re "illegal origin option"
            exit
         }
      }
   }
   else {
      local origin = 0
   }
   if "`scale'"!="" {
      di in gr "         scaling:  " in ye "`scale'"
      local ttype "double"
      if "`invert'"!="" {
         di in gr _col(20) "(units on break-scale per unit on st-scale)"
      }
      capture confirm var `scale'
      if _rc==0 {
         local vsc "`scale'"
      }
      else {
         capture confirm number `scale'
         if _rc!=0 {
            di in re "illegal scale option"
            exit
         }
      }
   }
   else {
      local scale = 1
   }
   parse "`generate'", parse(" ")
   if "`2'"!="" {
      local gen "`2'"
      local gtype "`1'"
   }
   else {
      local gen "`1'"
      local gtype "`float'"
   }
   if "`gen'"=="" {
      local gen "_band"
      di in gr "By default, time" _continue
   }
   else {
      di in gr "Time" _continue
   }
   di in gr " band will be coded in the variable: " in ye "`gen'"
   confirm new var `gen'
   local fail : char _dta[st_d]
   local stid : char _dta[st_id]
   local stwv : char _dta[st_wv]
   if "`fail'"=="" {
      local fail "_fail"
      di in gr "Failure indicator created: " in ye "`fail'"
      confirm new var `fail'
      gen byte `fail'=1
   }
   if "`timin'"=="" {
      local timin "_t_in"
      di in gr "Entry time variable created: " in ye "`timin'"
      confirm new var `timin'
      gen `ttype' `timin' = 0
   }
   else {
      qui drop if `timin'==.
   }

   tempvar id n tmin tmax na nb ta tb band

   quietly {

      * check syntax of breaks list

      parse "`breaks'", parse(",[]")
      local cutp "`1'"
      local min = `1'
      while "`1'"!="" {
         if "`2'"=="," {
            if `3'<=`cutp' {
               noi di in red "Break points must be in ascending order"
               exit
            }
            else {
               mac shift
               mac shift
               local cutp "`1'"
            }
         }
         else if "`2'"=="[" {
            if "`4'"!="]" {
               noi di in red "Syntax error in breaks list"
               exit
            }
            else {
               if "`5'"=="" {
                  noi di in red "No upper bound to #[#]# break expression"
               }
               if `5'<=`1' {
                  noi di in red "Break points must be in ascending order"
                  exit
               }
               mac shift
               mac shift
               local cutw "`1'"
               mac shift
               mac shift 
               while `cutp'<`1' { local cutp = `cutp'+`cutw'}
               if `cutp'>`1' { local cutp "`1'" }
            }
         }
         else if "`2'"=="" {
            mac shift
         }
         else {
            noi di in red "Syntax error in breaks list"
            exit
         }
      }
      local max "`cutp'"
 
      * Reduce dataset by removing unnecessary variables and cases

      keep `timin' `timout' `vor' `vsc' `fail' `stid' `stwv' `varlist'
      drop if `fail'==. | `timout'==.
      if "`vor'"!="" {
         drop if `origin'==.
      }
      if "`vsc'"!="" {
         drop if `scale'==.
      }
	 
      * adjust records which fall outside the breaks

      if "`invert'"=="" {
         gen `ttype' `tmin' = `min'*`scale' + (`origin')
         gen `ttype' `tmax' = `max'*`scale' + (`origin')
      }
      else {
         gen `ttype' `tmin' = cond(`scale'!=0, (`min'-(`origin'))/`scale', /*
            */ cond(`origin'<=`min', `timout', `timin')) 
         gen `ttype' `tmax' = cond(`scale'!=0, (`max'-(`origin'))/`scale', /*
            */ cond(`origin'>=`max', `timin', `timout'))
      }
      count if `timin'>=`tmax'
      if _result(1)>0 {
         noi di in ye _result(1) in bl _col(6) /*
            */ "records start after `max' - dropped"
         drop if `timin'>=`tmax'
      }
      count if `timout'<=`tmin'
      if _result(1)>0 {
         noi di in ye _result(1) in bl _col(6) /*
            */ "records finish before `min'  - dropped"
         drop if `timout'<=`tmin'
      }
      count if `timout'>`tmax'
      if _result(1)>0 {
         noi di in ye _result(1) in bl _col(6) /* 
            */ "records end after `max' - right censored"
         replace `fail' = 0 if `timout'>`tmax'
         replace `timout'= `tmax' if `timout'>`tmax'
      }
      count if `timin'<`tmin'
      if _result(1)>0 {
         noi di in ye _result(1) in bl _col(6) /*
            */ "records start before `min' - left truncated"
         replace `timin' = `tmin' if `timin'<`tmin'
      }
      drop `tmin' `tmax'

      * calculates number of bands each subject spans

      gen  int `na'=0
      gen  int `nb'=0

      parse "`breaks'", parse(",[]")
      while "`1'"!="" {
         if ("`2'"=="," | "`2'"=="[") {
            local cutp "`1'"
            mac shift
            mac shift
         }
         else if "`2'"=="]" {
            local cutp = `cutp' + `1'
            if `cutp'>=`3' {
               local cutp "`3'"
               mac shift
               mac shift
               mac shift
               if "`1'"!="" {mac shift}
            }
         }
         else if "`2'"=="" {
            local cutp "`1'"
            mac shift
         }
         if "`invert'"=="" {
            replace `na'=`na'+1 if `timin' >= (`cutp'*`scale' + (`origin'))
            replace `nb'=`nb'+1 if `timout' > (`cutp'*`scale' + (`origin'))
         }
         else {
            replace `na'=`na'+1 if (`timin'*`scale' + (`origin')) >= `cutp' 
            replace `nb'=`nb'+1 if (`timout'*`scale' + (`origin')) > `cutp'
         }
      }
      gen int `n'=`nb'-`na'+1

      * if necessary, expand records

      count if `n'> 1
      if _result(1) ==0 {
         noi di in bl "No extra records were created"
         exit
      }
      gen long `id' = _n
      replace `n' = cond(`n'>0, `n' - 1, 0)
      summ `n'
      noi di in ye _result(1)*_result(3)  in bl _col(6) /*
         */ "extra records are being created"
      replace `n' = `n' + 1
      * expands records and generates band number
      expand `n'
      sort `id'
      by `id': gen int `band' = `na' + _n - 2
      drop `na' `nb'

      * update timin, timout, fail and generate()

      gen `gtype' `gen' = .
      gen `ttype' `ta' = .
      gen `ttype' `tb' = .
      parse "`breaks'", parse(",[]")
      local i=0
      while "`1'"!="" {
         if ("`2'"=="," | "`2'"=="[") {
            local cutp "`1'"
            mac shift
            mac shift
         }
         else if "`2'"=="]" {
            local cutp = `cutp' + `1'
            if `cutp'>=`3' {
               local cutp "`3'"
               mac shift
               mac shift
               mac shift
               if "`1'"!="" {
                  mac shift
               }
            }
         }
         else if "`2'"=="" {
            local cutp "`1'"
            mac shift
         }
         if "`label'"=="" {
            replace `gen' = `cutp' if `band'==`i'
         }
         else {
            cap label drop `gen'
            replace `gen' = `i' if `band'==`i'
            if `i'>0 {
               local code = `i' - 1
               la def `gen' `code' "`lastcut'-`cutp'", a
            }
            local lastcut "`cutp'"
         }
         if "`invert'"=="" {
            replace `ta'=`cutp'*`scale' + (`origin') if `band'==`i'
            replace `tb'=`cutp'*`scale' + (`origin') if `band'==(`i'-1)
         }
         else {
            replace `ta'= cond(`scale'!=0, (`cutp'-(`origin'))/`scale', /*
               */ `timin') if `band' == `i'
            replace `tb'= cond(`scale'!=0, (`cutp'-(`origin'))/`scale', /*
               */ `timout') if `band' == (`i'-1)
         }
         local i=`i'+1
      }

      by `id': replace `ta'=`timin' if _n==1
      by `id': replace `tb'=`timout' if _n==_N
      replace `timin'=`ta'
      replace `timout'=`tb'
      count if `timin'==`timout'
      if _result(1)>0 {
         noi di in bl _result(1) in bl _col(6) /*
            */ "records with zero follow-up time dropped"
      }
      drop if `timin'==`timout'
      by `id': replace `fail'=0 if _n!=_N
      if "`label'"!="" {
         la val `gen' `gen'
      }
   }
   end