****************************************************************************************************
*                                           PROGRAM OVERVIEW
****************************************************************************************************
*
* PROGRAM: ms_switching.sas  
* Created (mm/dd/yyyy): 05/15/2018
*
*--------------------------------------------------------------------------------------------------
* PURPOSE: Calculate switching episodes for Type 6 analysis                                     
*   
*  Program inputs:  
*   -infolder.&treatmentpathways
*   -infolder.&inclusioncodes
*   -dplocal.&runid._mstr
*   -msoc.&runid_t6_productsdates
*                                       
*  Program outputs:    
*   -dplocal.&runid._T6_switchepisodes
*   -msoc.&runid._T6_switchattrition 
*   -msoc.&runid._T6_switchepisdurstats
*   -msoc.&runid._T6_switchplota
*   -msoc.&runid._T6_switchplotb 
*
*  PARAMETERS:                                                                       
*            
*  Programming Notes:                                                                                
*                                                                           
*
*--------------------------------------------------------------------------------------------------
* CONTACT INFO: 
*  Sentinel Coordinating Center
*  info@sentinelsystem.org
*
***************************************************************************************************;

%macro ms_switching();

    %put =====> MACRO CALLED: ms_switching; 

    *Determine which tables and strata to output;
    data _t6levels_switchepisdur
         _t6levels_switchplota
         _t6levels_switchplotb;
        set userstrata;
        
        *SwitchEpisDur;
        if lowcase(tableID) = "t6switchepisdur" then do;
            *defensive - add episodelength if not specified since that is an automatic strata;
            if index(lowcase(levelvars), 'episodelength') = 0 then do;
                levelvars = catx(' ',levelvars, "episodelength");
            end;
            output _t6levels_switchepisdur;
        end;

        *Plots a and b;
        if lowcase(tableID) = "t6plota" then output _t6levels_switchplota;
        if lowcase(tableID) = "t6plotb" then output _t6levels_switchplotb;
    run;

    %let t6switchepisdurstrat1=;
    %let t6plotastrat1=;
    %let t6plotbstrat1=;

    proc sql noprint;
        select distinct lowcase(levelvars) into: t6switchepisdurstrat1 separated by ' '
        from _t6levels_switchepisdur;
        select distinct lowcase(levelvars) into: t6plotastrat1 separated by ' '
        from _t6levels_switchplota;
        select distinct lowcase(levelvars) into: t6plotbstrat1 separated by ' '
        from _t6levels_switchplotb;
    quit;
    %nonrep(invar = t6switchepisdurstrat1, outvar = t6switchepisdurstrat);
    %nonrep(invar = t6plotastrat1, outvar = t6plotastrat);
    %nonrep(invar = t6plotbstrat1, outvar = t6plotbstrat);

    /***********************/
    /* Calculate Switching */
    /***********************/

    /*Read in treatmentpathways and loop through analysisgrp*/

    %ISDATA(dataset=infolder.&treatmentpathways.);
    %IF %EVAL(&NOBS.>=1) %THEN %DO;
    proc sql noprint;
        select distinct analysisgrp into: analysisgrp_list separated by ' '
        from infolder.&treatmentpathways.;
    quit;

    %let n_analysisgrp = %sysfunc(countw(&analysisgrp_list.));

    %do n = 1 %to %eval(&n_analysisgrp.);

        %ms_starttimer(timestart=switchruntime);

        %let analysisgrp = %scan(&analysisgrp_list., &n.);
        %put Now looping on analysisgrp = &analysisgrp.;

        data switch&n.;
            set infolder.&treatmentpathways.;
            where analysisgrp = "&analysisgrp.";
        run;

            /*Defensive warnings*/
            proc sql noprint;
                select count(distinct switchcohortincldate),
                       count(distinct switchdateuse),
                       max(switchevalstep)
                    into: count_switchcohortincldate, :count_switchdateuse, :max_switchevalstep
                from switch&n.;
            quit;
            %if %eval(&count_switchcohortincldate. > 1) %then %do;
                %put WARNING: (Sentinel) More than one row per unique analysisgrp contains a non-null SWITCHCOHORTINCLDATE value. Revise TREATMENTPATHWAYS file;
            %end;
            %if %eval(&count_switchdateuse. > 1) %then %do;
                %put WARNING: (Sentinel) More than one row per unique analysisgrp contains a non-null SWITCHDATEUSE value. Revise TREATMENTPATHWAYS file;
            %end;

        %do i = 0 %to %eval(&max_switchevalstep.);
            /* Assign macro parameters*/
            data _null_;
                set infolder.&treatmentpathways.;
                where analysisgrp = "&analysisgrp." and switchevalstep = &i.;

                call symputx("switchgroup&i.", group);
                call symputx("switchcohortdef&i.", switchcohortdef);
                call symputx("gaptol&i.", gaptol);
                call symputx("overlaptol&i.", overlaptol);
                call symputx("overlaptype&i.", upcase(overlaptype));
                call symputx("switchcohortincldate&i.", upcase(switchcohortincldate));
                call symputx("switchdateuse&i.", switchdateuse);
                call symputx("switchgapincl&i.", upcase(switchgapincl));
            run;

            /*  Select all GROUP episodes for each SWITCHEVALSTEP. */
            /*  Note: All SWITCHEVALSTEP=0 episode will be considered as start of switch pattern, episodes that are a switch-back will be removed later */
            proc sort data=dplocal.&runid._mstr(rename=indexdt=indexdt&i. 
                                                rename=episodeenddt=EpisodeEndDtSwitch&i. 
                                                rename=enr_end=enr_end&i. 
                                                rename=enr_start=enr_start&i.
                                                rename=cens_elig=cens_elig&i.
                                                rename=cens_dth=cens_dth&i.
                                                rename=cens_dpend=cens_dpend&i.
                                                rename=cens_qryend=cens_qryend&i.
                                                rename=cens_episend=cens_episend&i.
                                                rename=EpisodeEndDt_Censor=censor_switch&i.Dt
                                                rename=sex=sex&i.
                                                rename=agegroup=agegroup&i.
                                                rename=agegroupnum=agegroupnum&i.
												rename=age=age&i.
												rename=IndexLookEndDt=IndexLookEndDt&i.
                              					rename=IndexLook=IndexLook&i.
                                                rename=race=race&i.
                                                rename=hispanic=hispanic&i.
                                                rename=zip3=zip3&i.
                                                rename=state=state&i.
                                                rename=hhs_reg=hhs_reg&i.
                                                rename=cb_reg=cb_reg&i.
                                                rename=zip_uncertain=zip_uncertain&i.
                                                rename=incexl=incexl&i.)
                out=step&i._index(keep=patid indexdt&i. EpisodeEndDtSwitch&i. enr_end&i. enr_start&i. cens: race&i. hispanic&i.
                                    sex&i. agegroup&i. agegroupnum&i. age&i. IndexLookEndDt&i. IndexLook&i. zip3&i. state&i. hhs_reg&i. cb_reg&i. zip_uncertain&i. incexl&i.); 
                by patid indexdt&i.; 
                where group = "&&switchgroup&i.";
            run;
        %end;

        /*Create switching episodes*/
        %macro identifyswitch(step=);
            %let priorstep = %eval(&step.-1);

            **Use point= datastep option to select 1st SWITCHEVALSTEP 1 episode after SWITCHEVALSTEP 0 index date;
            data start_stop; 
                set step&step._index;
                by patid indexdt&step.; 
                retain start;
                if first.patid then start =_n_;
                if last.patid then stop = _n_;
                if last.patid;
                keep patid start stop;
            run;

            data _selectedindex(where=(indexdt&priorstep. ne .)); 
                length indexdt&priorstep. EpisodeEndDtSwitch&priorstep. switch&step.indexdt switch&step.episodeenddt 4;

                merge step&priorstep._index 
                      start_stop; 
                by patid; 

                if (start ne .) and (stop ne .) then do recordid = start to stop;
                    set step&step._index point = recordid;

                    if switch&step.indexdt = . and indexdt&step. >= indexdt&priorstep. then do;
                        switch&step.indexdt = indexdt&step.;
                        switch&step.episodeenddt = EpisodeEndDtSwitch&step.;
                        switch&step.agegroup = agegroup&step.;
                        switch&step.agegroupnum = agegroupnum&step.;
                        switch&step.age = age&step.;
                    end;
                end;
                format indexdt: date9.;
                drop start stop recordid indexdt&step. EpisodeEndDtSwitch&step. agegroup&step. agegroupnum&step. age&step.;
            run;

        /*Determine if a switch occured*/
            data switchstep&step.;
                set _selectedindex;

                /*No switch occurs if:
                    1. Switch&step.indexdt is missing (no step 1 episodes after step 0 index date) then switch_reason&priorstep. = No switch OR
                    2. Switch&step.indexdt is > GAPTOL from EpisodeEndDtSwitch&priorstep.*/

                if (switch&step.indexdt = .) OR 
                        (switch&step.indexdt - EpisodeEndDtSwitch&priorstep. -1 > %eval(&&gaptol&step.)) then do;
                    switch&step. = "N";
                end;
                else do;
    
                    /*Switch occurs if:
                        1. overlap <= OVERLAPTOL OR
                        2. Switch&step.indexdt <= GAPTOL from EpisodeEndDtSwitch&priorstep. */

                    overlap = EpisodeEndDtSwitch&priorstep. - Switch&step.IndexDt + 1;
                    Percentoverlap = 100*(overlap/(EpisodeEndDtSwitch&priorstep.-IndexDt&priorstep. + 1));

                    %if "&&overlaptype&step." = "PERCENT" %then %do;
                        if Percentoverlap <= %eval(&&overlaptol&step.) then do;
                            switch&step. = "Y";
                        end;
                        else if Percentoverlap > %eval(&&overlaptol&step.) then do;
                            switch&step. = "N";
                        end;
                        else do;
                    %end;
                    %if "&&overlaptype&step." = "DAYS" %then %do;
                        if overlap <= %eval(&&overlaptol&step.) then do;
                            switch&step. = "Y";
                        end;
                        else if overlap > %eval(&&overlaptol&step.) then do;
                            switch&step. = "N";
                        end;
                        else do;
                    %end;

                    if Switch&step.indexdt > EpisodeEndDtSwitch&priorstep. AND (Switch&step.IndexDt-EpisodeEndDtSwitch&priorstep. -1) <= %eval(&&gaptol&step.) then do;
                        switch&step. = "Y";
                    end;
                    end;
                end;

                /*Convert switches to non-switches if there is an enrollment gap in the gaptol*/
                if switch&step. = "Y" then do;
                    if enr_start&step. > EpisodeEndDtSwitch&priorstep. then switch&step. = "N";
                end;

                if switch&step. ne "Y" then call missing(switch&step.indexdt,switch&step.EpisodeEndDt, 
                    cens_elig&step., cens_elig&step., cens_dth&step., cens_dpend&step., cens_qryend&step., cens_episend&step., censor_switch&step.Dt);

                /* Reclassify initial switch enddate to day prior to switch and keep original enddate for duration metrics  */
                /* Reclassification is to prevent inclusion of episodes that prior to SWITCHCOHORTINCLDATE + GAPTOL date    */
                    format OrigEpisodeEndSwitch&priorstep.Dt date9.;
                    length OrigEpisodeEndSwitch&priorstep.Dt 4;
                    OrigEpisodeEndSwitch&priorstep.Dt = EpisodeEndDtSwitch&priorstep.;
                    if switch&step. = "Y" then EpisodeEndDtSwitch&priorstep. = switch&step.indexdt-1;
            run;
        %mend;
        %identifyswitch(step=1);

        %if %eval(&max_switchevalstep. = 2) %then %do;
            /*Evalute SWITCHEVALSTEP = 2 only for individuals who switched*/
            proc sort data=switchstep1(rename=switch1indexdt=indexdt1 rename=switch1episodeenddt=EpisodeEndDtSwitch1
                                       rename=switch1agegroup=agegroup1 rename=switch1agegroupnum=agegroupnum1
                                       rename=switch1age=age1)
                out=step1_index(keep=patid indexdt1 EpisodeEndDtSwitch1 enr_end1 enr_start1 agegroup1 agegroupnum1 age1); 
                by patid indexdt1; 
                where switch1 = 'Y';
            run;
        
            %identifyswitch(step=2);

            /*Merge SWITCHEVALSTEP 1 and SWITCHEVALSTEP 2*/
            proc sql noprint;
                create table analysisgrp&n. as
                select one.patid
				,   one.indexdt0 as indexdt format=date9. length=4
                ,   one.indexdt0				
                ,   one.EpisodeEndDtSwitch0 format=date9.
                ,   one.incexl0
                ,   one.enr_end0
                ,   one.enr_start0
                ,   one.OrigEpisodeEndSwitch0Dt format=date9.
                ,   one.switch1indexdt format=date9.
                ,   one.switch1episodeenddt format=date9.
                ,   one.switch1
                ,   one.cens_elig0
                ,   one.cens_elig1
                ,   one.cens_dth0
                ,   one.cens_dth1
                ,   one.cens_dpend0
                ,   one.cens_dpend1
                ,   one.cens_qryend0
                ,   one.cens_qryend1
                ,   one.cens_episend0
                ,   one.cens_episend1
                ,   one.censor_switch0Dt
                ,   one.censor_switch1Dt
                ,   two.switch2indexdt format=date9.
                ,   two.switch2episodeenddt format=date9.
                ,   two.switch2
                ,   one.sex0 as sex
                ,   one.agegroup0 as agegroup
                ,   one.agegroupnum0 as agegroupnum
				,   one.age0 as age
                ,   one.switch1agegroup
                ,   one.switch1agegroupnum 
                ,   one.switch1age
                ,   two.switch2agegroup
                ,   two.switch2agegroupnum 
                ,   two.switch2age
				,   one.IndexLookEndDt0 as IndexLookEndDt format=date9. length=4
				,   one.IndexLook0 as IndexLook
                ,   one.race0 as race
                ,   one.hispanic0 as hispanic
                ,   one.zip30 as zip3
                ,   one.state0 as state
                ,   one.hhs_reg0 as hhs_reg
                ,   one.cb_reg0 as cb_reg
                ,   one.zip_uncertain0 as zip_uncertain
                from switchstep1 as one
                left join switchstep2 as two 
                on one.switch1indexdt = two.indexdt1 and one.patid=two.patid;
            quit;

            /*Remove switchback episodes as initial swithers*/
            %if "&switchgroup0." = "&switchgroup2." %then %do;
                proc sort data=analysisgrp&n.(keep=patid switch2indexdt) out=switchback;
                by patid switch2indexdt;
                where switch2indexdt ne .;
                run;

                proc sort data=analysisgrp&n.; 
                    by patid indexdt0;
                run;

                data analysisgrp&n.;
                    merge analysisgrp&n. (in=a)
                        switchback(rename=switch2indexdt=indexdt0 in=b);
                        by patid indexdt0;
                        if a and b then delete;
                run;
            %end;
        %end;
        %else %if %eval(&max_switchevalstep. = 1) %then %do;
            proc sql noprint;
                create table analysisgrp&n. as
                select one.patid
				,   one.indexdt0 as indexdt format=date9. length=4
                ,   one.indexdt0				
                ,   one.EpisodeEndDtSwitch0 format=date9.
                ,   one.incexl0
                ,   one.enr_end0
                ,   one.enr_start0
                ,   one.OrigEpisodeEndSwitch0Dt format=date9.
                ,   one.switch1indexdt format=date9.
                ,   one.switch1episodeenddt format=date9.
                ,   one.switch1
                ,   one.cens_elig0
                ,   one.cens_elig1
                ,   one.cens_dth0
                ,   one.cens_dth1
                ,   one.cens_dpend0
                ,   one.cens_dpend1
                ,   one.cens_qryend0
                ,   one.cens_qryend1
                ,   one.cens_episend0
                ,   one.cens_episend1
                ,   one.censor_switch0Dt
                ,   one.censor_switch1Dt
                ,   one.sex0 as sex
                ,   one.agegroup0 as agegroup
                ,   one.agegroupnum0 as agegroupnum
				,   one.age0 as age
                ,   one.switch1agegroup
                ,   one.switch1agegroupnum 
                ,   one.switch1age
				,   one.IndexLookEndDt0 as IndexLookEndDt format=date9. length=4
				,   one.IndexLook0 as IndexLook
                ,   one.race0 as race
                ,   one.hispanic0 as hispanic
                ,   one.zip30 as zip3
                ,   one.state0 as state
                ,   one.hhs_reg0 as hhs_reg
                ,   one.cb_reg0 as cb_reg
                ,   one.zip_uncertain0 as zip_uncertain
                from switchstep1 as one;
            quit;
        %end;
            
        data analysisgrp&n.;
            set analysisgrp&n.;
            /*Calculte EndDate for Switch Episode*/
            format switchpatternenddt date9.;
            length switchpatternenddt 4;
            switchpatternenddt = max(EpisodeEndDtSwitch0, switch1episodeenddt %if %eval(&max_switchevalstep. = 2) %then %do;, switch2episodeenddt %end; );
        run;

        /*Apply GAPTOL between switching episodes*/
        proc sort data=analysisgrp&n.;
            by patid indexdt0 switchpatternenddt;
        run;

        /*modified version of %ms_findgap()*/
        data analysisgrp&n.;
            set analysisgrp&n.;
            by patid;
            DaysUntreated=indexdt0-lag(switchpatternenddt);
            gap=DaysUntreated > max(&gaptol0.,0);
            if &gaptol0.=. then gap=0;  *If gaptol=., then only first date is valid;
            if first.patid then gap=1;  *first one always counts as being a potential index date;
            if gap or (&gaptol0.=0);  * if gaptol =0 then all claims are deemed potential indedate wrt own self;
            drop gap daysuntreated;
        run;

        %let INCDATEGROUP&n. = ;
        %let SWITCHCOHORTINCLDATE&n. = ;
        %let SWITCHDATEUSE&n. = ;
        %let gaptol&n. = ;
        %let switchenrdays&n. = ;
        %let switchreqdaysaftind&n. = ;
        %let group0 = ;
        %let keepinclexc = N;

        /*Exclude switching episodes*/
            /* Apply SWITCHCOHORTINCLDATE, SWITCHDATEUSE, SWITCHENRDAYS, switchreqdaysaftind, and KEEPINCLEXC */
                ** Check to see if parameters have been specified;
                data _null_;
                    set infolder.&treatmentpathways.;
                    where analysisgrp = "&analysisgrp." and switchcohortincldate is not missing;
                        call symputx("INCDATEGROUP&n.", group);
                        call symputx("SWITCHCOHORTINCLDATE&n.", upcase(SWITCHCOHORTINCLDATE));
                        call symputx("SWITCHDATEUSE&n.", SWITCHDATEUSE);
                        call symputx("gaptol&n.", gaptol);
                run;
                data _null_;
                    set infolder.&treatmentpathways.;
                    where analysisgrp = "&analysisgrp." and switchevalstep = 0;
                        call symputx("switchenrdays&n.", upcase(switchenrdays));
                        call symputx("switchreqdaysaftind&n.", upcase(switchreqdaysaftind));
                        call symputx("group0", group);
                        call symputx("keepinclexc", upcase(keepinclexc));
                run;

                %put &&INCDATEGROUP&n. &&SWITCHCOHORTINCLDATE&n. &&SWITCHDATEUSE&n. &&gaptol&n. &&switchenrdays&n. &&switchreqdaysaftind&n.;

                %if "&&SWITCHCOHORTINCLDATE&n." ne "" %then %do; /*if no SWITCHCOHORTINCLDATE, then do not apply inclusion criteria*/
                    /*get date and evaluate whether SWITCHCOHORTINCLDATE + Gaptol occurs on or before EpisodeEndDtSwitch0*/
                    proc sql noprint undo_policy=none;  
                    create table analysisgrp&n. as
                        select x.*,
                        y.&&SWITCHCOHORTINCLDATE&n ,
                        case when 
                            x.EpisodeEndDtSwitch0 + &&gaptol&n. >= y.&&SWITCHCOHORTINCLDATE&n then 0
                            else 1
                            end as excl_switchdate
                        from analysisgrp&n. as x,
                        msoc.&runid._t6_productsdates(where=(group="&&INCDATEGROUP&n.")) as y;
                    quit;
                %end;
                %else %do;
                    data analysisgrp&n.;
                        set analysisgrp&n.;
                        retain excl_switchdate 0;
                    run;
                %end;

                *Evaluated enrollment and prior exclusion requirements;
                data analysisgrp&n.;
                    set analysisgrp&n.;
					length MinEnrolMet1 MinEnrolMet2 MinEnrolNotMet PriorExclusionNotMet 3;

                    * Initialize to prevent issues in switch_attrition;
                    MinEnrolMet1=0; 
                    MinEnrolMet2=0; 
                    MinEnrolNotMet=0;
                    PriorExclusionNotMet = 0;

                    if enr_start0 <= indexdt0-max(0,&&switchenrdays&n.) then MinEnrolMet1=1;
                    if min(enr_end0, &censordate.) >= indexdt0+max(0,&&switchreqdaysaftind&n.) then MinEnrolMet2=1;
                    if MinEnrolMet1 ne 1 | MinEnrolMet2 ne 1 then MinEnrolNotMet = 1;

                    if "&keepinclexc." = "Y" then do;
                        if incexl0= 0 then PriorExclusionNotMet = 1;
                    end;
                    drop incexl0;
                run;

            /* Apply INCLUSIONCODES TO SWITCH EPISODE
    		   Assign default value for macro variable that identifies if there are valid inclusion/exclusion criteria */
			   %let excl_incl = N; 
			   
                data switchinclusioncodes;
                    set &cohortcodes.;
                    where indexcriteria in('INC','EXC') and group = "&analysisgrp.";
                run;
				
                %isdata(dataset=switchinclusioncodes);
                %IF %EVAL(&NOBS.>=1) %THEN %DO;
                %let excl_incl = Y; 

                    data _it&inclusioncodes.;
                    set &inclusioncodes.;
                    where group = "&analysisgrp.";
                    run;

                    *Processing steps for Inclusion/Exclusion codes;
                    data _diag 
                           _others;
                        set switchinclusioncodes;
                        if CodeCat in("DX") then output _diag;
                        else output _others;
                    run;

                    %ISDATA(dataset=_diag);
                    %IF %EVAL(&NOBS.>=1) %THEN %DO;
                        %MS_ProcessWildcards(InFile=_diag, 
                                             CodeVar=code, 
                                             OutFile=_diag);
                    %END;

                    *Create Switch Pattern-specific parameter files. These processing steps are the same as in ms_cidanum, however
                        group=analysisgrp are only switchinclusion codes, which were not processed in ms_cidanum;
                    data _ITGroupParamNDC(keep= codecat codetype code dateonly codesupply stockgroup
                                               &InclExclVars. codepop indexdate indexcriteria)
                         _ITGroupParamMeds(keep= codecat codetype code dateonly codesupply 
                                                CareSettingPrincipal &InclExclVars. codepop indexdate indexcriteria)
                         _ITGroupParamLabs(keep= codecat codetype code dateonly codesupply group RawLabResult RawLabDateType
                                                CareSettingprincipal &InclExclVars. codepop indexdate indexcriteria
                                           rename=(CareSettingprincipal=RawCaresetting group=RawGroup));
                       set _diag
                           _others;
                       if Condinclusion=. then Condinclusion=1;
                       if CodeCat="RX"          then output _ITGroupParamNDC;
                       else if CodeCat in("DX","PX") then output _ITGroupParamMeds;
                       else if CodeCat in("LB")      then output _ITGroupParamLabs;
                    run;

                    *Break out CaresettingPrincipal into Caresetting and Principal;
                    %ms_caresettingprincipal(InFile=_ITGroupParamMeds, 
                                             Var=CareSettingPrincipal, 
                                             OutFile=_ITGroupParamMeds);


                    *Extract analysisgrp-specific records;
                    %ms_loopmeds(datafile=worktemp.meds,
                                 lookfile=_ITGroupParamMeds, 
                                 multiplecodecat = Y,
                                 outfile=_ITMeds);

                    %ms_extractdrugs(datafile=worktemp.drugs,
                                     lookfile=_ITGroupParamNDC, 
                                     lookvar=code , 
                                     mindate=,
                                     outfile=_ITDrugs);

                    *Need to define Supply End Date to make sure days of supply are constrained within enrollment;
                    data _ITDrugs;
                    set _ITDrugs;
                    format RxSupEndDt date9.;
                    if not missing(codesupply) then RxSup = CodeSupply;
                    RxSupEndDt=Rxdate+RxSup-1;
                    run;

                    %if &CHKCOMBREC = 1 %then %do;
                    %ms_extractdrugs(datafile=worktemp.drugsComb,
                                     lookfile=_ITGroupParamNDC, 
                                     lookvar=code , 
                                     mindate=,
                                     outfile=_ITDrugsComb);


                    *Need to define Supply End Date to make sure days of supply are constrained within enrollment;
                    data _ITDrugsComb;
                    set _ITDrugsComb;
                    format RxSupEndDt date9.;
                    if not missing(codesupply) then RxSup = CodeSupply;
                    RxSupEndDt=Rxdate+RxSup-1;
                    run;
                    %end;

                    %ms_extractlabs(datafile=worktemp.labextract,
                                    lookfile=_ITGroupParamLabs, 
                                    mindate=,
                                    outfile=_ITlabs (drop=RawGroup));   

                     *Make sure all claims overlap enrollment span and only 
                     keep eligible exposures (overlaping Enr_Start Enr_End);

                     *Create file that is deduplicated on patid/enrollment dates;

                     *Get all the enrollment spans;
                     data _null_;
                        set cohortfile_for_enr;
                         if cohortgrp="&group0." then do;
                            call symputx('ENRNUM',enrollmentnum);     
                        end;
                     run;

                    proc sql noprint;
                        create table worktemp.group0 as
                        select a.patid, a.Enr_Start, a.Enr_End
                        from worktemp.enr_&enrnum. a
                        where patid in (select distinct patid from analysisgrp&n.);
                    quit;

                     %ms_shaveoutside(reffile=worktemp.group0,
                                       refstart=Enr_Start,
                                       refend=Enr_End,
                                       KeepPartBf=N,
                                       ToShaveFile=_ITDrugs,
                                       ToShaveStart=RxDate,
                                       ToShaveEnd=RxSupEndDt,
                                       shaverx=Y,
                                       outfile=_ITDrugs);
                       
                    %ISDATA(dataset=_ITDrugsComb);
                    %IF %EVAL(&NOBS.>=1) %THEN %DO;
                    %ms_shaveoutside(reffile=worktemp.group0,
                                     refstart=Enr_Start,
                                     refend=Enr_End,
                                     KeepPartBf=N,
                                     ToShaveFile=_ITDrugsComb,
                                     ToShaveStart=RxDate,
                                     ToShaveEnd=RxSupEndDt,
                                     shaverx=Y,
                                     outfile=_ITDrugsComb(drop=Enr_Start0 Enr_end0));
                    %END;

                    %ms_shaveoutside(reffile=worktemp.group0,
                                     refstart=Enr_Start,
                                     refend=Enr_End,
                                     KeepPartBf=N,
                                     ToShaveFile=_ITMeds,
                                     ToShaveStart=ADate,
                                     ToShaveEnd=ADate,
                                     shaverx=N,
                                     outfile=_ITMeds);


                    %isdata(dataset=_ITLabs);
                    %if %eval(&NOBS.>=1) %then %do;                              
                    %ms_shaveoutside(reffile=worktemp.group0,
                                     refstart=Enr_Start,
                                     refend=Enr_End,
                                     KeepPartBf=N,
                                     ToShaveFile=_ITLabs,
                                     ToShaveStart=ADate,
                                     ToShaveEnd=ADate,
                                     shaverx=N,
                                     outfile=_ITLabs (drop=RawLabResult RawLabDateType));
                    %end; 

                    *Apply Stockpiling;

                    %let unique_stock_params=0;
                    %ISDATA(dataset=STOCKPILE_NONCOVAR);    
                    %IF %EVAL(&NOBS.>0) %THEN %DO;
                    /* store maximum number of combination of stockpiling parameters */
                    proc sql noprint;
                        select max(stocknumber)
                        into :unique_stock_params
                        from STOCKPILE_NONCOVAR
                        where group="&analysisgrp";
                    quit;
                    %END;

                    %if &unique_stock_params <= 1 %then %do;

                    %if &unique_stock_params <= 0 %then %do;
                    %let SAMEDAY=aa;
                    %let SUPRANGE=0<-HIGH;
                    %let AMTRANGE=0<-HIGH;
                    %let PERCENTDAYS=;
                    %end;

                    %else %do;
                        data _null_;
                            set STOCKPILE_NONCOVAR;
                                where group="&ANALYSISGRP";
                                call symputx("SAMEDAY",strip(SameDay));
                                call symputx("SUPRANGE",strip(SupRange));
                                call symputx("AMTRANGE",strip(AmtRange));
                                call symputx("PERCENTDAYS",put(PercentDays,best.));
                        run;
                    %end; /* =1 */

                    %MS_STOCKPILING(INFILE=_ITDrugs,            
                                    CLMDATE=RxDate,                                 
                                    CLMSUP=RxSup,                                   
                                    CLMAMT=RxAmt,                                   
                                    PROCFLAG=,                                      
                                    PERCENTDAYS=&PERCENTDAYS.,                                  
                                    GROUPING= StockGroup indexcriteria &InclExclVars.,                        
                                    SAMEDAY=&SAMEDAY.,                                  
                                    SUPRANGE=&SUPRANGE.,                                    
                                    AMTRANGE=&AMTRANGE.,
                                    ID=CODECAT,                                             
                                    OUTFILE=_ITDrugs,       
                                    OUTFILEEXCL=_ITDrugsExcl
                                    );

                    %end; /* unique_stock_params <=1 */

                    %if &unique_stock_params > 1 %then %do;
                        %do z = 1 %to &unique_stock_params;

                        data STOCKPILE_NONCOVAR_&z;
                        set STOCKPILE_NONCOVAR;
                        where group="&analysisgrp." and stocknumber=&z;
                        call symputx("SAMEDAY",strip(SameDay));
                        call symputx("SUPRANGE",strip(SupRange));
                        call symputx("AMTRANGE",strip(AmtRange));
                        call symputx("PERCENTDAYS",put(PercentDays,best.));
                        run;

                        /* Only process dataset if there are subsetted observations */
                        %ISDATA(dataset=STOCKPILE_NONCOVAR_&z);
                        %if %eval(&NOBS>0) %then %do;
                        %let stock_list=;
                        proc sql noprint;
                          select distinct quote(strip(stockgroup))
                          into :stock_list separated by ' ' 
                          from STOCKPILE_NONCOVAR_&z;
                        quit;

                        %MS_STOCKPILING(INFILE=_ITDrugs(where=(stockgroup in (&stock_list))),            
                                    CLMDATE=RxDate,                                 
                                    CLMSUP=RxSup,                                   
                                    CLMAMT=RxAmt,                                   
                                    PROCFLAG=,                                      
                                    PERCENTDAYS=&PERCENTDAYS.,                                  
                                    GROUPING= StockGroup indexcriteria &InclExclVars.,                        
                                    SAMEDAY=&SAMEDAY.,                                  
                                    SUPRANGE=&SUPRANGE.,                                    
                                    AMTRANGE=&AMTRANGE.,
                                    ID=CODECAT,                                             
                                    OUTFILE=_ITDrugs_&z,       
                                    OUTFILEEXCL=_ITDrugsExcl_&z
                                    );

                        %end; /* %isdata(STOCKPILINGFILE._&z) */

                        %end; /* z */

                        /* Stack all datasets together */
                        data _ITDrugs;
                          set _ITDrugs_:;
                        run;

                        data _ITDrugsExcl;
                          set _ITDrugsExcl_:;
                        run;

                        /* Delete temporary datasets */
                        proc datasets nowarn noprint lib=work;
                        delete _ITDrugs_: _ITDrugsExcl_: stockpile_noncovar_:;
                        quit;

                    %end; /* unique_stock_params > 1 */

                    %if &CHKCOMBREC = 1 %then %do;
                    data _ITDrugs;
                        set  _ITDrugs
                             _ITDrugsComb(in=a);
                            *ExpireDt does not exist in _ITDrugsComb;
                            if a then ExpireDt=Rxdate+RxSup-1;  
                    run;
                    %end;

                    *Need to reshave because Stockpiling may have pushed claims outside enrollment period;
                    %ISDATA(dataset=_ITDrugs);
                    %IF %EVAL(&NOBS.>=1) %THEN %DO;
                        %ms_shaveoutside(reffile=worktemp.group0,
                                         refstart=Enr_Start,
                                         refend=Enr_End,
                                         KeepPartBf=N,
                                         ToShaveFile=_ITDrugs,
                                         ToShaveStart=RxDate,
                                         ToShaveEnd=ExpireDt,
                                         shaverx=Y,
                                         outfile=_ITDrugs);
                    %END;

                    proc datasets library=work nowarn nolist;
                    delete _ITGroupParam: _diag _others _shaverefile;
                    quit;

                    proc datasets library=worktemp nowarn nolist;
                    delete group0;
                    quit;

                    data _InclExcl;
                        set _ITDrugs(in=a rename=RxDate=ADate)
                            _ITMeds(in=b)
                            _ITLabs(in=c);

                            if b or c then do;
                                if not missing(codesupply) then RxSup = CodeSupply;
                                else RxSup = 1;
                                Expiredt=Adate+RxSup-1;
                                RXAmt=1;
                                NumDispensing = 1;
                            end;
                      run;

                    /*--------------------------------------------------------------*/
                    /* Apply Exclusion/Inclusion Criteria (POV3)                    */
                    /*--------------------------------------------------------------*/
						
                        *Initialize list with all potential index dates;
                        data _pov3;
                        set analysisgrp&n.;
						length MustKickOutHard MustKickOutElig 3.;
                        retain MustKickOutHard MustKickoutElig 0;
                        keep PatId indexdt0 Enr_Start0 Enr_end0 MustKickOut:;
                        run;

                        *Determine how many conditions and max lookback;
                        %let MAXCOND=;
                        %let MinimumCondFrom = .;
                        proc sql noprint;
                            select max(cond), 
                                   min(CondFrom),
                                   max(minrxdays)
                                   into :maxcond trimmed,
                                        :MinimumCondFrom trimmed,
                                        :evalminrxdays trimmed
                            from _it&inclusioncodes.;
							
							select distinct b.condlevel
                                          , a.indexcriteria
                                 into:condlvl1 - :condlvl&maxcond.
                                   ,:criteria1 - :criteria&maxcond.
                            from _it&inclusioncodes. as a
							inner join infolder.&INCLUSIONCODES. as b
		                    on a.condlevel = upcase(b.condlevel)
		                    and upcase(a.group) = upcase(b.group);
                        quit;

                        %put &MAXCOND.;

                        *Uniqueness of _InclExcl;
                        Proc Sort nodupkey data=_InclExcl out=_InclExcl;
                        by Patid Adate Expiredt CondInclusion cond subcond SubCondInclusion CondFrom CondTo codedays dateonly;
                        run;

                        *Get all in INCL/EXCL period claims (both incl and Excl) 
                         relative to each potential index dates;
                        proc sql noprint;
                        create table _pov3Claims as
                        select distinct index.Patid,
                                        index.indexdt0,
                                        inc.adate as incdate,
                                        Inc.cond,
                                        Inc.Subcond                                  
                                        %if %eval(&evalminrxdays.>1) %then %do;
                                        /*extract start and end date within CONDFROM-CONDTO window*/
                                        , max(inc.adate, index.indexdt0+CondFrom) as minrxadate length=4
                                        , min(inc.expiredt, index.indexdt0+CondTo) as minrxexpiredt length=4
                                        %end;
                        from analysisgrp&n. as index,
                             _InclExcl as Inc
                        where index.Patid = Inc.Patid and
                        ( ( inc.dateonly='N' and %MS_PeriodsOverlap(period1=COALESCE(index.indexdt0+CondFrom,-999999) COALESCE(index.indexdt0+CondTo,999999),                                             
                            period2=Inc.ADate Inc.Expiredt)) |
	   			            (inc.dateonly='Y' and %MS_PeriodsOverlap(period1=COALESCE(index.indexdt0+CondFrom,-999999) COALESCE(index.indexdt0+CondTo,999999),                                             
                             period2=Inc.ADate)) )
                        order by index.Patid, 
                                 index.indexdt0
                                %if %eval(&evalminrxdays.>1) %then %do;
                                , minrxadate
                                , minrxexpiredt
                                %end;
                                ;
                        quit;

                        %DO COND=1 %TO &MAXCOND.;

                            *Determine how many levels of subconditions needed;
                           *Determine whether this COND is an exclusion or inclusion;
                            %let MAXSUBCOND=0;
                            %let inclusion = .;
                            proc sql noprint;
                                select max(subcond), max(CondInclusion)
                                into :maxsubcond trimmed, :inclusion trimmed
                                from _it&inclusioncodes.(where=(cond=&COND.));
                            quit;

                            %put &MAXSUBCOND. &INCLUSION.;

                            *Set data for this cond;
                            data _pov3_&cond.;
                            set _pov3(keep=Patid indexdt0 ENR_START0 ENR_END0);
    							length ExclCond&COND. 3.;
                            ExclCond&COND.=0;
                            run;

                            %DO SUBCOND=1 %TO &MAXSUBCOND.;

                                %let subinclusion=0;
                                %let minrxdays =1;
                                *Determine if SUBCOND is an exclusion or inclusion;
                                proc sql noprint;
                                    select max(SubCondInclusion), 
                                           min(CondFrom), 
                                           max(codedays),
                                           max(minrxdays),
                                           count(distinct stockgroup)
                                    into: SUBCONDINCLUSION, :CONDFROM, :CODEDAYS, :minrxdays, :countstockgroup
                                    from _it&inclusioncodes.(where=(cond=&COND. and subcond=&SUBCOND.)); 
                                quit;
                                %put &SUBCONDINCLUSION. &CondFrom. &codedays.;

                                *Only keep if minrxdays is satisfied (days in window >=minrxdays;
                                %if %eval(&minrxdays>1) %then %do;
                                    /*Determine number of stockgroups - if >1 then need to consolidate potential overlapping dispensings.
                                    If 1, then there are no overlapping dispensings after stockpiling*/
                                    %if %eval(&countstockgroup.>1) %then %do;
                        			data _pov3_rxclaims(drop=LRunOutDt gap cond subcond);
                        				set _POV3Claims(where=(cond=&COND. and subcond=&SUBCOND.));
                        				by patid indexdt0;
                                        length LRunOutDt 4;
                        				if first.indexdt0 then do;
                        					LRunOutDt=minrxexpiredt;
                        					gap=.;
                        					episode=1;
                        				end;
                        				else do;
                        					gap = minrxadate - LRunOutDt - 1;
                        					if gap > 0 then do;
                        					episode=episode+1;
                        					LRunOutDt = minrxexpiredt;
                        				end;
                        					else LRunOutDt = max(minrxexpiredt,LRunOutDt);
                        				end;
                        				retain episode LRunOutDt;
                        			run;

                        			proc means noprint data=_pov3_rxclaims nway missing;
                        				var minrxadate minrxexpiredt;
                        				class patid indexdt0 episode;
                        				output out=_pov3_rxclaims_dedup(drop=_:) min(minrxadate)=
                        													     max(minrxexpiredt)= / keeplen;
                        			run;
                                    %end;

                                    *Only keep claims on _pov3claims if minrxdays satisfied (total days in window >= minrxdays);
                                    proc sql noprint;
                                        create table _pov3claims_mod as
                                        select distinct x.Patid,
                                                        x.indexdt0,
                                                        x.incdate
                                        from _POV3Claims(where=(cond=&COND. and subcond=&SUBCOND.)) as x
                                        inner join (select patid, 
                                                           indexdt0,
                                                           sum(minrxexpiredt - minrxadate + 1) as sumrxdays  /*Total days in window*/
                                                    from
                                                     %if %eval(&countstockgroup.>1) %then %do; _pov3_rxclaims_dedup %end;
                                                     %else %do; _POV3Claims(where=(cond=&COND. and subcond=&SUBCOND.)) %end;
                                                    group by patid, indexdt0
                                                    having sumrxdays>=&minrxdays.
                                                    ) as y
                                       on x.patid = y.patid and x.indexdt0 = y.indexdt0;
                                    quit;

                                    %let codedaysdataset = _pov3claims_mod;
                                %end;
                                %else %do;
                                    %if %eval(&evalminrxdays.>1) %then %do;
                                    /*dedup dataset - needed because _pov3claims may contain duplicate ADATE codes - saving 
                                      MinRxDay variables kept same day codes with different expiredt values*/
                                        proc sort data=_POV3Claims(where=(cond=&COND. and subcond=&SUBCOND.)) nodupkey out=_pov3claims_mod(keep=patid Indexdt0 incdate);
                                            by patid Indexdt0 incdate;
                                        run;
                                        %let codedaysdataset = _pov3claims_mod;
                                    %end;
                                    %else %do;
                                        %let codedaysdataset = _POV3Claims(where=(cond=&COND. and subcond=&SUBCOND.)) ;
                                    %end;
                                %end;

                                *Only keep if codedays satisfied (number of indexdt0 >= codedays);
                                proc means data=&codedaysdataset. noprint nway missing;
                                    class patid Indexdt0 / missing;
                                    output out=_pov3Incl_tmp(drop=_: where=(freq>=&codedays.)) n=freq;
                                run;

                                proc sort nodupkey data=_pov3Incl_tmp out=_pov3Incl_tmp(keep=PatId Indexdt0);
                                    by PatId Indexdt0;  *Here Indexdt0 is of the analysisgrp, not the INCL;
                                run;

                                *Square;                        
                                data _pov3_&cond.;
									length SubCond_&COND._&SUBCOND. 3.;
                                    merge _pov3_&cond.(in=a)
                                      _pov3Incl_tmp(in=b);
                                    by PatId Indexdt0;

                                    if a and b then SubCond_&COND._&SUBCOND.=1;
                                    else SubCond_&COND._&SUBCOND.=0;

                                    if &SUBCONDINCLUSION.=1 then do;
                                        if a and b then SubCond_&COND._&SUBCOND.=1;
                                        else SubCond_&COND._&SUBCOND.=0;
                                    end;
                                    *If the subcondition is met but it is a subexclusion, then means that condition not satisfied;
                                    else do;
                                        if a and b then SubCond_&COND._&SUBCOND.=0;
                                        else SubCond_&COND._&SUBCOND.=1;
                                    end;
                                run;

                                proc datasets nowarn noprint lib=work;
                                    delete _pov3claims_mod _pov3_rxclaims:;
                                quit;
                            %END; *loop subcond;
                            
                            *If all subconditions are satisfied, then condition is satisfied (at this point);
                            data _pov3_&cond.;
                            set _pov3_&cond.;
    							length Cond&cond. MustKickOutHard_&cond. InclCond&COND. 3.;
                            Cond&cond.=sum(of SubCond_&COND._1-SubCond_&COND._&MAXSUBCOND.)=&MAXSUBCOND.;

                                *Manage if an exclusion - if you have one hard exclusion ;
                                if &INCLUSION.=0 then do;
                                  *if the patient had cond&cond.=1 then can never be included;
                                  if Cond&cond.=1 then MustKickOutHard_&cond.=1;
                                  else MustKickOutHard_&cond.=0;
                                  *flip the dummy;
                                  Cond&cond.=Cond&cond.=0;
                                end;

                                *Create a dummy to remember if this condition was an inclusion or and exlusion;
                                InclCond&COND.=&INCLUSION.;
                            run;

                            *Put all together;
                            data _pov3;
                                merge _pov3(in=a)
                                      _pov3_&cond.(in=b keep=PatId Indexdt0 Cond: SubCond: Excl: InclCond: MustKickOut:);
                                by PatId Indexdt0;
                                if MustKickOutHard_&cond.=1 then MustKickOutHard=1;
                                if a;
                            run;
                        %END;*loop cond;

                        *Clean up;
                        data _pov3;                                                         
                        set _pov3;
						  length AnyCond MustKickOutElig 3;
                          array _cond(*) 3 Cond1-cond&maxcond.;
                          array _InclCond(*) 3 InclCond1-InclCond&maxcond.;
                          array incl_flag(*) 3 incl_flag1-incl_flag&maxcond.;
						  
                            *at least one inclusion criterion;
                            %if &maxcond. >1 %then %do;
                                inclusion=max(of InclCond1-InclCond&maxcond.);
                            %end;
                            %else %do;
                                inclusion=InclCond1;
                            %end;

                            *initialize AnyCond;
                            if inclusion ne 1 then AnyCond=1;
                            else do;
                              AnyCond=0;
                              *Find those with at least on inclusion met;
                              do i=1 to &maxcond.;
                                if _cond(i)=1 and _InclCond(i)=1 then do;
				                   AnyCond=1;
				                   incl_flag(i)=1;
				                end;
        	                  end;	
                            end;
                     
                            *Because user may have specified a longer lookback compared to the original cohort ENRDAYS,
                             need to consider if enough pre-index enrollment in this case;
                             MustKickOutElig=0;
                             if not(Enr_Start0 <= Indexdt0 + COALESCE(&MinimumCondFrom.,0)) then do;
                                MustKickOutElig=1;
                            end;

                            *kick out any index not meeting the elig criteria for at least one exclusion
                             or that has at least one hard exclusion (claim);
                            if MustKickOutElig or MustKickOuthard then AnyCond=0;
                            drop inclusion i;
                      run;

                        data analysisgrp&n.;
                            merge analysisgrp&n. (in=a)
                            _pov3 (in=b keep=patid indexdt0 MustKickOutHard: incl_flag: MustKickoutElig Anycond);
                            by patid indexdt0;
                            if a and b;
                        run;
                %end; /*_ITINCLUSIONCODES*/
                %else %do;
                    data analysisgrp&n.;
                        set analysisgrp&n.;
                        length MustKickOutHard MustKickoutElig Anycond 3.;
                        retain MustKickoutElig MustKickOutHard 0 Anycond 1;
                    run;
                %end;
          
            /* Apply other criteria, then apply SWITCHCOHORTDEF */
                %if "&switchcohortdef0" = "01" %then %do; /*Only keep the 1st switching episode*/
                    proc sort data=analysisgrp&n. out=_temp_analysisgrp&n.;
                        by patid indexdt0;
                        where max(excl_switchdate, mustkickouthard, mustkickoutelig, MinEnrolNotMet, PriorExclusionNotMet)=0 and anycond = 1;
                    run;

                    data _temp_analysisgrp&n.;
                        set _temp_analysisgrp&n.;
                        by patid indexdt0;
                        length MetCohortdef 3;
                        if first.patid then MetCohortdef = 1;
                            else MetCohortdef = 0;
                    run;

                    /*merge back for attrition*/
                    data analysisgrp&n.;
                        length all 3;
                        retain all 1;
                        merge analysisgrp&n.
                            _temp_analysisgrp&n.(keep=patid indexdt0 MetCohortdef);
                        by patid indexdt0;
                    run;
                %end;
                %else %do;
                    data analysisgrp&n.;
                        set analysisgrp&n.;
                        length all MetCohortdef 3;
                        retain all MetCohortdef 1;
                    run;
                %end;

        /*************************/
        /* T6_SWITCHATTRITION    */ 
        /*************************/ 

        *Reset cumulative;
            proc datasets library=work nowarn nolist;
                delete _attrition;
            quit;

            %let level=1;

            %ms_attrition_compute(file=analysisgrp&n.,ToExcl=all=0,analysisgrp=&analysisgrp.);
            %ms_attrition_compute(file=analysisgrp&n.,ToExcl=excl_switchdate=1,analysisgrp=&analysisgrp.);
            %ms_attrition_compute(file=analysisgrp&n.,ToExcl=MinEnrolNotMet=1,analysisgrp=&analysisgrp.);
            %ms_attrition_compute(file=analysisgrp&n.,ToExcl=PriorExclusionNotMet=1,analysisgrp=&analysisgrp.);
            %ms_attrition_compute(file=analysisgrp&n.,ToExcl=MustKickOutElig=1,analysisgrp=&analysisgrp.);
			
            %IF &excl_incl. = Y %THEN %DO;
		  	  /* Save analysisgrp&n. file to deterime number of exclusions per condition */
               data _analysisgrp&n._cond;
                set analysisgrp&n.;
               run;
			   
			   %ms_attrition_compute(file=analysisgrp&n.,ToExcl=MustKickOutHard=1 or AnyCond=0,analysisgrp=&analysisgrp.);
			
               data _excluded;
			     merge _analysisgrp&n._cond (in = step5)
			           analysisgrp&n. (in = step6);
				 by patid indexdt indexdt0;
			     if step5 and not step6 then output;
			   run;
			
			   %do cond = 1 %to &maxcond.; /*loop through each condition*/
                  proc sql noprint;
                    select count(*) into: numtoexcl
                     from _excluded
	    			 %if %str("&&criteria&cond..") = %str("INC") %then %do;
	    			   where incl_flag&cond. ne 1;
	    			 %end;
	    			 %else %do;
                       where MustKickOutHard_&cond. = 1;
	    			 %end;
                  quit;
	    
                  data _attrition_cond;
                    format level $7. num comma10. analysisgrp $40. descr $500.;
                    %if %eval(&cond.>1) %then %do;
                      set _attrition_cond end=eof;
                      output;
                      if eof then do;
	    			%end;
                        level       = "6.&cond.";
                        num         = .;
                        analysisgrp = "&analysisgrp.";
                        excluded    = &numtoexcl.;  
                        %if %str("&&criteria&cond..") = %str("INC") %then %do;
                          descr = "Information: Episodes excluded for lacking &&condlvl&cond..";
                        %end;
                        %else %do;
                          descr = "Information: Episodes excluded for &&condlvl&cond..";
                        %end;
                        output;
	    			%if %eval(&cond.>1) %then %do;
                       end;
	    			%end;
                  run;
                    
              %end;*end of condition;
            %end;
			%else %do;
			  %ms_attrition_compute(file=analysisgrp&n.,ToExcl=MustKickOutHard=1 or AnyCond=0,analysisgrp=&analysisgrp.);
			%end;
            
            %ms_attrition_compute(file=analysisgrp&n.,ToExcl=MetCohortdef=0,analysisgrp=&analysisgrp.);
			
                data _Attrition;
                    format descr $500. Excluded comma10.;
                    retain level descr num Excluded;
                    set _Attrition;

                    format ;
                    LastRemain=lag(num);
					Excluded=LastRemain-num;

                    if level="1" then descr="Initial Switch Episode Count";
                    if level="2" then descr="Exclusion - Episodes must satisfy switch cohort entry criteria (SWITCHCOHORTINCLDATE and SWITCHDATEUSE)";
                    if level="3" then descr="Exclusion - Episodes must satisfy the switch enrollment requirement";
                    if level="4" then descr="Exclusion - Episodes must satisfy the type 6 utilization exclusion/inclusion requirements";
                    if level="5" then descr="Exclusion - Episodes must satisfy the Exclusion enrollment requirement";
                    if level="6" then descr="Exclusion - Episodes must satisfy the exclusion and inclusion conditions";
                    if level="7" then descr="Exclusion - Episodes must meet SWITCHCOHORTDEF requirement";

                    rename num=remaining;
                    drop LastRemain;
                run;
				
				/* If inclusion/exclusion dataset exists then add attrition_cond dataset to _attrition table */		
				%IF &excl_incl. = Y %THEN %DO;
				  data _Attrition;
                     set _Attrition					  
					   _attrition_cond (keep = analysisgrp level descr excluded);
				  run;
				  
				  proc sort data = _Attrition;
				    by analysisgrp level;
				  run;	
				%end;
					
            proc datasets nowarn noprint;
                delete step: start_stop ;
            quit;

        /*--------------------------------------*/
        /*---- Compute Metrics -----------------*/
        /*--------------------------------------*/

        data analysisgrp&n.;
            length analysisgrp $40 year month 3 time_to_first_switch time_to_second_switch episodelength 4;
                set analysisgrp&n.(where=(max(excl_switchdate, mustkickouthard, mustkickoutelig, MinEnrolNotMet)=0
                                          and anycond = 1 and MetCohortdef=1) drop=all);
                retain analysisgrp "&analysisgrp.";
                /*compute time to 1st switch*/
                if switch1 = 'Y' then do;
                    %if %eval(&&SWITCHDATEUSE&n. = 2) %then %do; /*Time FROM SWITCHCOHORTINCLDATE*/ 
                        time_to_first_switch = switch1indexdt - &&SWITCHCOHORTINCLDATE&n.;
                    %end;
                    %else %do;
                        time_to_first_switch = switch1indexdt - indexdt0;
                    %end;
                        /*Compute time to 2nd switch (if applicable)*/
                        %if %eval(&max_switchevalstep. = 2) %then %do;
                            if switch2 = 'Y' then do; 
                                time_to_second_switch = switch2indexdt - switch1indexdt;
                            end;
                            else do;
                                time_to_second_switch = censor_switch1Dt - switch1indexdt;
                            end;
                        %end;
                        %else %do;
                            time_to_second_switch = .;
                        %end;
                end; 
                else do;
                    %if %eval(&&SWITCHDATEUSE&n. = 2) %then %do;
                    time_to_first_switch = censor_switch0Dt - &&SWITCHCOHORTINCLDATE&n.;
                    %end;
                    %else %do;
                    time_to_first_switch = censor_switch0Dt - indexdt0;
                    %end;
                    time_to_second_switch = .; /*No second switch if there is no 1st switch*/
                end;

                /*Compute switch pattern duration*/
                %if "&switchgapincl0." = "Y" %then %do; /*include gaps*/
                    episodelength = switchpatternenddt - indexdt0 + 1;
                %end;
                %else %do; /*do not include gaps*/
                    
                    /*Gap between SwitchEval step 1 and 0*/
                    gap0 = switch1indexdt - Origepisodeendswitch0dt - 1; /*minus 1 b/c a 1 day gap means EpisodeEndDt and SwitchIndexDt separated by 2 days*/

                    /*Gap between SwitchEval step 2 and 1*/
                    %if %eval(&max_switchevalstep. = 2) %then %do;
                        gap1 = switch2indexdt - switch1episodeenddt - 1;
                    %end;
                    %else %do;
                        gap1 = .;
                    %end;
                    episodelength = (switchpatternenddt - indexdt0 + 1) - (max(gap0,0)) - (max(gap1,0));

                    drop gap1 gap0;
                %end;

            year=year(indexdt0);
			month=month(indexdt0);

            /*Reclassify censoring if a switch*/
            %do a = 1 %to &max_switchevalstep.;
			    length cens_switch%eval(&a.-1) 3;
                if switch&a. = "Y" then do;
                    cens_dth%eval(&a.-1) = 0; 
                    cens_qryend%eval(&a.-1) = 0;
                    cens_dpend%eval(&a.-1) = 0;
                    cens_elig%eval(&a.-1) = 0;
                    cens_episend%eval(&a.-1) = 0;
                    cens_switch%eval(&a.-1) = 1;
                end;
                else do;
                    cens_switch%eval(&a.-1) = 0;
                end;
            %end;

            /* If switch 2 isn't requested, create dummy variables for cidacov processing */
            %if &max_switchevalstep ^= 2 %then %do;
            length switch2 $1 
                   cens_switch1 3 
                   switch2indexdt switch2episodeenddt 4 
                   switch2agegroup $9 
                   switch2age switch2agegroupnum 8;
                switch2='';
                switch2indexdt=.;
                switch2episodeenddt=.;
                switch2agegroup='';
                switch2agegroupnum=.;
                switch2age=.;
                cens_switch1 = 0;
            %end;

			keep analysisgrp PatId indexdt year month switch1 time_to_first_switch time_to_second_switch episodelength 
				 indexdt0 EpisodeEndDtSwitch0 enr_end0 enr_start0 switch1indexdt switch1episodeenddt cens_elig0	cens_elig1 
				 cens_dth0 cens_dth1 cens_dpend0 cens_dpend1 cens_qryend0 cens_qryend1 cens_episend0 cens_episend1 cens_switch0
				 censor_switch0Dt censor_switch1Dt switchpatternenddt sex agegroup switch1agegroup switch1agegroupnum switch1age
				 agegroupnum age race hispanic zip3 state hhs_reg cb_reg zip_uncertain IndexLookEndDt IndexLook excl_switchdate MetCohortdef
				 switch2 switch2indexdt switch2episodeenddt switch2agegroup switch2agegroupnum switch2age cens_switch1 ;								 		
        run;

        *Save to dplocal/msoc;
        %if %eval(&n. = 1) %then %do;
            data dplocal.&runid._t6_switchepisodes;
                set analysisgrp&n.;
            run;

            /*Output attrition table to MSOC folder*/
            data MSOC.&runid._t6_switchattrition;
                retain analysisgrp level descr remaining Excluded;
                set _Attrition;
            run;
        %end;
        %else %do;
            data dplocal.&runid._t6_switchepisodes;
                set dplocal.&runid._t6_switchepisodes
                    analysisgrp&n.;
            run;

            proc append base=MSOC.&runid._t6_switchattrition 
                        data=_Attrition force;
            run;
        %end;

        /*--------------------------------------*/
        /*---- Output switching tables ---------*/
        /*--------------------------------------*/

        data _null_;
            set infolder.&cohortfile.;
            where cohortgrp = "&switchgroup0";
            if missing(agestrat) then do;
                call symputx("agestrat","00-01 02-04 05-09 10-14 15-18 19-21 22-44 45-64 65-74 75+");
            end;
            else do;
                call symputx("agestrat",agestrat);
            end;    
        run;

        proc sql noprint;
            create table _switchers&n. as 
            select mstr.*
            from analysisgrp&n. as mstr;
        quit;   

        /******************************************************/
        /*  T6_SWITCHPLOTA and T6_SWITCHPLOTB (if applicable) */
        /******************************************************/
        %macro createTTS(class=,level=);

            *One record per patient for the class stratification;
            proc sql noprint;
                create table _tts_strat as
                select analysisgrp, %if %length(&class) > 0 %then %do; &class, %end; 
                                    sum(EndEnrollmentPatCount) as EndEnrollmentPatCount, 
                                    sum(DeathPatCount) as DeathPatCount, 
                                    sum(EndAvailDataPatCount) as EndAvailDataPatCount, 
                                    sum(EndQueryPatCount) as EndQueryPatCount, 
                                    sum(ProductDiscontinuationPatCount) as ProductDiscontinuationPatCount, 
                                    sum(SwitchedPatCount) as SwitchedPatCount,
                                    sum(EndEnrollmentCount) as EndEnrollmentCount, 
                                    sum(DeathCount) as DeathCount, 
                                    sum(EndAvailDataCount) as EndAvailDataCount, 
                                    sum(EndQueryCount) as EndQueryCount, 
                                    sum(ProductDiscontinuationCount) as ProductDiscontinuationCount, 
                                    sum(SwitchedCount) as SwitchedCount, 
                                    sum(Npts) as Npts, 
                                    sum(Episodes) as Episodes
                       from(select analysisgrp, %if %length(&class) > 0 %then %do; &class, %end;
                                        max(cens_elig&num.) as EndEnrollmentPatCount,           
                                        max(cens_dth&num.) as DeathPatCount,  
                                        max(cens_dpend&num.) as EndAvailDataPatCount,          
                                        max(cens_qryend&num.) as EndQueryPatCount, 
                                        max(cens_episend&num.) as ProductDiscontinuationPatCount,                 
                                        max(cens_switch&num.) as SwitchedPatCount, 
                                        max(patient) as Npts,
                                        sum(cens_elig&num.) as EndEnrollmentCount,           
                                        sum(cens_dth&num.) as DeathCount,  
                                        sum(cens_dpend&num.) as EndAvailDataCount,           
                                        sum(cens_qryend&num.) as EndQueryCount, 
                                        sum(cens_episend&num.) as ProductDiscontinuationCount,    
                                        sum(cens_switch&num.) as SwitchedCount,
                                        sum(patient) as Episodes
                                        from _switchers_tts
                                        group by analysisgrp, PatId %if %length(&class) > 0 %then %do; ,&class. %end;)
                       group by analysisgrp %if %length(&class) > 0 %then %do; ,&class. %end;;
            quit;

            %if %eval(&s.=1) %then %do;
                data _TTS;
                    set _tts_strat;
                    format level $3.;
                    retain Level "&level.";
                run;
            %end;
            %else %do;
                data _TTS;
                    set _TTS
                        _tts_strat(in=a);
                    if a then Level="&level.";
                run;
            %end;
        %mend;

        %macro time_to_switch_plot(num=, var=, plot=);

            %isdata(dataset=_t6levels_switchplot&plot.);    
            %if %eval(&nobs.>0) %then %do;

                /*Square time_to_switch to all values*/
                proc sql noprint;
                    create table _TTS_squared as
                    select distinct &var. length=4
                    from _switchers&n.
                    where &var. is not missing;
                quit;

                %isdata(dataset=_TTS_squared)
                %if %eval(&nobs.=0) %then %do;
                    %put WARNING: (Sentinel) No qualifying switch episodes for &analysisgrp.;
                %end;

                %isdata(dataset=_t6levels_switchplot&plot.);    
                %do s = 1 %to %eval(&nobs.);
                    data _null_;
                        set _t6levels_switchplot&plot.;
                        if _n_ = &s. then do;
                            call symputx('levelid', levelid);
                            call symputx('levelvars', levelvars);
                        end;
                    run;

                    *Square stratifications vars;
                    %ms_squaredtableshell(squarevars =&levelvars.,
                                          analysisvars=EndEnrollmentCount DeathCount EndAvailDataCount EndQueryCount EndProductDiscontinuationCount 
                                                       switchedcount SwitchedPatCount EndQueryPatCount EndEnrollmentPatCount EndAvailDataPatCount 
                                                       ProductDiscontinuationPatCount deathpatcount Npts Episodes,
                                          groups="&analysisgrp",
                                          analysis = Y);                    
                    
                    proc sort data=_mastersquare nodup;
                        by _all_;
                    run;

                    data _switchers_tts (rename=&var.=ttswitch);
                        set _switchers&n.(in=a where=(&var. is not missing))
                            _mastersquare(in=b);
						length patient cens_elig&num. cens_dth&num. cens_dpend&num. cens_qryend&num. cens_episend&num. cens_switch&num. 3;
                        if a then do;
                            patient=1;
                        end;
                        else do;
                            patient=0;
                            cens_elig&num. = 0;
                            cens_dth&num. = 0;
                            cens_dpend&num. = 0;
                            cens_qryend&num. = 0;
                            cens_episend&num. = 0;
                            cens_switch&num. = 0;
                        end;
                    run;

                    /* Add commas to levelvar list */
                    %if %length(&levelvars) > 0 %then %let levelvars_comma = %bquote(%sysfunc(tranwrd(&levelvars,%str( ),%str(,))));
                    %else %let levelvars_comma = ;
                

                    *Summarize;
                    %createTTS(class=&levelvars_comma., level=&levelid.);

                    proc datasets nowarn noprint lib=work;
                        delete _tts_strat _switchers_tts _mastersquare;
                    quit;
                %end;

                /*Save to MSOC*/
                %if %eval(&n.=1) %then %do;
                    /*Save to MSOC*/
                    data msoc.&runid._t6_switchplot&plot.; 
                        retain analysisgrp level &&t6plot&plot.strat 
                        EndEnrollmentPatCount DeathPatCount EndAvailDataPatCount EndQueryPatCount ProductDiscontinuationPatCount SwitchedPatCount
                        EndEnrollmentCount DeathCount EndAvailDataCount EndQueryCount ProductDiscontinuationCount SwitchedCount Npts Episodes;
                        set _TTS;
                    run;
                %end;
                %else %do;
                    proc append base=msoc.&runid._t6_switchplot&plot.
                        data=_TTS(keep=analysisgrp level &&t6plot&plot.strat 
                        EndEnrollmentPatCount DeathPatCount EndAvailDataPatCount EndQueryPatCount ProductDiscontinuationPatCount SwitchedPatCount
                        EndEnrollmentCount DeathCount EndAvailDataCount EndQueryCount ProductDiscontinuationCount SwitchedCount Npts Episodes) force;
                    run;
                %end;

                proc datasets nowarn noprint lib=work;
                    delete _tts;
                quit;
            %end;
        %mend;

        %time_to_switch_plot(num=0, var=time_to_first_switch, plot=a);

        proc sql noprint;
            select max(switchevalstep) into: max_switchevalstep
            from infolder.&treatmentpathways
            where analysisgrp = "&analysisgrp";
        quit;
        %put &max_switchevalstep.;
        %if %eval(&max_switchevalstep. = 2) %then %do;
        %time_to_switch_plot(num=1, var=time_to_second_switch, plot=b);
        %end;

        /*************************/
        /* T6_SWITCHEPISDURSTATS */ 
        /*************************/ 
        
        /*Square episodelength to all values*/
        proc sql noprint;
            create table _length_squared as
            select distinct episodelength
            from _switchers&n.;
        quit;
        
        %macro createduration(class=,level=);
            proc means data=_switchers_duration&n. nway noprint missing;
                var patient;
                class analysisgrp &class.;
                output out=_num0(drop=_:) sum(patient)=Count;        
            run;

            %if %eval(&s.) = 1 %then %do;
                data _Duration;
                    set _num0;
                    format level $3.;
                    retain Level "&level.";
                run;
            %end;
            %else %do;
                data _Duration;
                    set _Duration
                        _num0(in=a);
                    if a then Level="&level.";
                 run;
            %end;
        %mend;


        %isdata(dataset=_t6levels_switchepisdur);    
        %if %eval(&nobs.>0) %then %do;
        %do s = 1 %to %eval(&nobs.);
            data _null_;
                set _t6levels_switchepisdur;
                if _n_ = &s. then do;
                    call symputx('levelid', levelid);
                    call symputx('levelvars', levelvars);
                end;
            run;

            *Square stratifications vars;
            %ms_squaredtableshell(squarevars =&levelvars.,
                                  analysisvars=,
                                  groups="&analysisgrp",
                                  analysis = Y);
        
            proc sort data=_mastersquare nodup;
                by _all_;
            run;

            data _switchers_duration&n.;
                set _switchers&n.(in=a)
                    _mastersquare(in=b);
				length patient 3;
                if a then do;
                    patient=1;
                end;
                else do;
                    patient=0;
                end;
            run;

            %createduration(class=&levelvars. ,level=&levelid.);

            proc datasets nowarn noprint lib=work;
                delete _num: _switchers_duration _mastersquare;
            quit;
        %end;

        /*Save to MSOC*/
        %if %eval(&n.=1) %then %do;
            data msoc.&runid._t6_switchepisdurstats; 
                retain analysisgrp level &t6switchepisdurstrat. episodelength count;
                set _Duration;
            run;
        %end;
        %else %do;
            proc append base=msoc.&runid._t6_switchepisdurstats
                        data=_Duration(keep=analysisgrp level &t6switchepisdurstrat. episodelength count) force;
            run;
        %end;
        %end;

        proc datasets nowarn noprint;
            delete _switch: switchinclusioncodes _it&inclusioncodes.;
        quit;
            
        /*output runtime*/
        %ms_stoptimer(timestart=switchruntime);
        %ms_outputruntimes(timevar=switchruntime, step=%str(Switching Module), group=&analysisgrp., monitoringperiod=);

    %end; /*Loop through analysisgrp*/
    %end;

    proc datasets nowarn noprint;
        delete switch: ;
    quit;

%put NOTE: ********END OF MACRO: ms_switching ********;

%mend ms_switching;