*! 2.0.0  25Aug97  jw/ics   STB-41 ssa11
*     --  added -preserv- option  
*     --  faster algorithm to split records, inspired by coding of st_rpool
*  1.0.0  10Feb97  (Jeroen Weesie/ICS)

program define stegen
        version 5.0

        st_is

        capture parsoptp
        if _rc != 199 {
                * -parsoptp- is found on the search path
                * code around matching () "bug" to allow expressions in at/from/to
                local cmd "`*'"

              * parse at()
                parsoptp at `cmd'
                local at  "$S_2"        /* at(str) */
                local cmd "$S_3"        /* cmd, with at() removed */

              * parse from()
                parsoptp from `cmd' 
                local from "$S_2"       /* from(str) */
                local cmd  "$S_3"       /* cmd, with from() removed */

              * parse to()
                parsoptp to `cmd'
                local to  "$S_2"        /* to(str) */
                local cmd "$S_3"        /* cmd, with to() removed */

              * parse the rest
                local varlist "new req max(1)"
                local if "opt"
                local in "opt"
                local options "noSHow Censor Preserve"
                parse "`cmd'"
        }
        else {
                di in bl "Install -parsoptp- if you need real expressions in at/from/to"
                * standard high order parsing that does not match on parentheses
                local varlist "new req max(1)"
                local if "opt"
                local in "opt"
                local options "at(str) from(str) to(str) noSHow Censor Preserve"
                parse "`*'"
        }
        
      * scratch

        tempvar att rslt touse tsp vfrom vto
        rename `varlist' `rslt'

      * sample to be modified

        mark `touse' `if' `in'

      * verify arguments at/from/to

        * at()
        if "`at'" == "" {
            di in re "option -at- required"
            exit 100
        }
        capt gen `att' = `at' if `touse'
        if _rc {
            di in re "error in evaluating `at'"
            exit 198
        }

        * att should not be missing
        if "`censor'" == "" {
            capt assert `att' ~= . if `touse'
            if _rc {
                di in re "at() should be non-missing"
                exit 498                
            }
        }
        else {  
            * missing -att- should be interpreted as censoring 
            * and so TVC will be set to "from"-value.
            qui replace `att' = `t' + 1 if `touse' & `att' == .
        }                
        
        capt assert `att' >= 0 if `touse'
        if _rc {
            di in bl "at() takes negative values"
        }                 

        * from()
        if "`from'" == "" {
            di in bl "from() defaults to 0"
            local from 0
        }
        capt gen `vfrom' = `from' if `touse'
        if _rc {
            di in re "error in evaluating `from'"
            exit 198
        }

        * to()
        if "`to'" == "" {
            di in bl "to() defaults to 1"
            local to 1
        }
        qui gen `vto' = `to' if `touse'
        if _rc {
            di in re "error in evaluating `to'"
            exit 198
        }

      * allow restoration
        
        if "`preserv'" ~= "" {
                preserve
                local Done "restore, not"
        }
                                        
     quietly { 
     
      * which obs to split ?        

        local t  : char _dta[st_t]
        local t0 : char _dta[st_t0]
        if "`t0'" == "" { local t0 0 }
      
        gen byte `tsp' = (`att'>`t0') & (`att'<`t') & (`vfrom'~=`vto') & `touse'
        count if `tsp' == 1
        if _result(1) > 0 {
            noi di _n in gr "number of episode splits : " in ye _result(1)
        }
        else {      
            noi di _n in bl "no episode splitting required!"
            st_show `show'      /* no comma ! */
            replace `rslt' = cond(`att'>=`t', `vfrom', `vto') if `touse'
            rename `rslt' `varlist'
            `Done'
            exit
       }                

      * interface to -st- characteristics

        noi st_aux, `show'

        local id : char _dta[st_id]
        local t  : char _dta[st_t]
        local t0 : char _dta[st_t0]
        local d  : char _dta[st_d]

      * perform episode splitting !  

        * code inspired by st_rpool (W. Gould, StataCorp)        
        * trick: -expand- locates new records after original records 
        * it avoids -sort- and -by-

        local N  = _N
        local N1 = _N+1
        expand = `tsp'+1
        
        * adopt t0 and t and died for splitted obs
        replace `t'  = `att' if `tsp' in 1/`N' 
        replace `d'  = 0     if `tsp' in 1/`N' 
        replace `t0' = `att'          in `N1'/l          /* if `tsp' implied */
        
        * set tvc for splitted obs
        replace `rslt' = `vfrom' if `tsp' in 1/`N'
        replace `rslt' = `vto'            in `N1'/l        
        
        * assign tvc for unsplitted obs
        replace `rslt' = cond(`att' >= `t', `vfrom', `vto') if ~`tsp' & `touse' in 1/`N'
        *replace `rslt' = `vfrom' if `att'>=`t' & `touse' in 1/`N'
        *replace `rslt' = `vto'   if `att'<`t0' & `touse' in 1/`N'

        rename `rslt' `varlist'        
        `Done'
    }
end