SAS Raking macro closes all programs

[lydiawawa]

Hi, I'm running the following macro by David Izrael. For some reason, the macro closes SAS whenever it completes running. Therefore wipes away all datasets under work library after I restart SAS.

Raking Macro:

%MACRO RAKING
(inds=,			/* input data set */
outds=,			/*output data set */
inwt=, 			/*weight to be raked */
freqlist=,		/*list of data sets with marginal */
				/*freqs or marginal control totals*/
				/*they must contain name of raking*/
				/* variable and either variable */
				/* PERCENT or MRGTOTAL, e.g. direct*/
				/* counts of marginal control totals;*/
				/* by default it is assigned names of*/
				/* raking variables */
outwt=, 		/* resulting raked weight */
byvar=, 		/* variable BY which user might want */
				/* to set up raking. */
				/* By default, raking is done */
				/* over the whole input data set */
varlist=,		/* list of variables to be raked on */
numvar=,		/* number of raking variables */
cntotal=,		/* general control total; it is */
				/* required if freqlist data sets */
				/* contains PERCENT; */
				/* if byvar not empty, cntotal */
				/* must be present for each byvar */
trmprec=1, 		/* tolerance,default is 1 */
numiter=50);	/*number of iterations,default is 50*/

%macro reqpar (param); 			/** checking on required **/
%if (&&&param eq ) %then %do; 	/** parameters **/
%put **** Program terminated: Macro parameter
%upcase(&PARAM) missing ****;
endsas;
%end;
%mend;

%reqpar(inds) %reqpar(outds) %reqpar (inwt)
%reqpar(outwt) %reqpar(varlist)
%reqpar(numvar) %reqpar(trmprec) %reqpar(numiter)
%let varlist=%upcase(&varlist);
%let byvar=%upcase(&byvar);
%let ls=%sysfunc(getoption(ls,keyword));
%let ps=%sysfunc(getoption(ps,keyword));

/* checking on number of raking variables */
%if (%scan(&varlist,&numvar) eq ) or
(%scan(&varlist,%eval(&numvar+1)) ne )
%then %do;
%put **** Program terminated: Number of variables in the
VARLIST ****;
%put **** does not match NUMVAR ****;
endsas;
%end;

data __i0;
set &inds;
weight=&inwt;
run;
%do i=1 %to &numiter; 				/* loop on iteration */
%let sumterm = 0; 					/* cumulative termin flags*/
%do j=1 %to &numvar;				/* loop on raking variable */
%let varrake= %scan(&varlist,&j);
%if (&freqlist ne ) %then
%let dsfreq=%scan(&freqlist,&j);
%else
%let dsfreq=&varrake;

proc sort data=__i0;
by &varrake;
run;

proc summary nway data=__i0 ;	/* calculate adjusted weighted total */
class &varrake;
var weight;
output out=__i1(drop=_type_ _freq_) sum=sum&j;
run;

data __i0; 						/* merge with marginal data set */
merge __i0(in=_1) __i1 &dsfreq(in=_2);
by &varrake;
%if &i=1 %then %do;
if (_1 and ^_2) or (_2 and ^_1) then do;
call symput('match','1');stop;end; else
call symput('match','2');
if mrgtotal ne . then call symput('mrg','1'); else call
symput('mrg','2');
if percent ne . then call symput ('pct','1'); else call
symput('pct','2');
%end;
run;
%if &i=1 %then %do;
%if &match=1 %then %do;
%put
**** Program terminated: levels of variable &varrake do not match ****;
%put
****in sample and marginal totals data sets ****;
endsas;
%end;
%if &pct = 1 and (&cntotal eq ) %then %do;
%put ** Program terminated: PERCENT is not missing and CNTOTAL is missing **;
%put ** for raking variable &varrake **;
endsas;
%end;
%else
%if &pct=2 and &mrg=2 %then %do;
%put **** Program terminated: Both PERCENT and MRGTOTAL are missing ****;
endsas;
%end;
%end;

data __i0;
set __i0;
%if (&cntotal ne ) %then %do;
if mrgtotal ne . then				/*case of marginal totals*/
cntmarg=mrgtotal;
else
if percent ne . then				/*case of marginal freqs*/
cntmarg=&cntotal.*percent/100;
%end;
%else %do;

if mrgtotal ne . then				/*case of marginal totals*/
cntmarg=mrgtotal;
%end;
weight=weight*cntmarg/sum&j;		/*actual raking*/
drop percent mrgtotal;
run;

data __i2(keep=&varrake sum&j cntmarg differ);
set __i0;
by &varrake;
if first.&varrake;
differ=cntmarg-sum&j;
run;
proc print label data=__i2;			/*print diagnostics*/
%if (&byvar ne) %then %do;
title3 "Raking &byvar - &s by &varrake, iteration - &i";
%end; %else %do;
title3 "Raking by &varrake, iteration - &i";
%end;
sum sum&j cntmarg;
label sum&j ='Calculated margin'
differ='Difference'
cntmarg='Margin Control Total';
run;

data __i2;
set __i2 end=eof;
retain comm 0;							/* termination test */
if abs( differ)>&trmprec then comm=1;
if eof and comm=1 then
call symput("term&j",'2'); 				/* continue with iterations*/
else
if eof then
call symput("term&j",'1'); 				/* convergence achieved */
run;
%let sumterm=%eval(&sumterm+&&term&j);
%end;

data __i0;
set __i0;
drop sum1-sum&numvar;
%if (&byvar ne ) %then
%put &byvar=&s iteration=&i numvar=&numvar
sumterm=&sumterm;
%else
%put numvar=&numvar sumterm=&sumterm;
%if &sumterm=&numvar or &i=&numiter %then %do;
/** termination criterion met **/
%if (&byvar ne ) %then
%put **** Terminated &byvar &s at &i-th iteration;
%else
%put *** Task terminated at &i-th iteration ****;
title3 ' ';

data _null_; 					/* write diagostics to listing */
set __i0;
if _n_=1;
file print &ps &ls;
put ' ';
%if &sumterm=&numvar %then %do; /* convergence achieved */
%if (&byvar ne ) %then %do;
put "**** Program for &byvar &s terminated at iteration &i because all calculated margins";
%end; %else %do;
put "**** Program terminated at iteration &i because all calculated margins";
%end;
put "differ from Marginal Control Totals by less than &trmprec ";
run;
%end;
%else %do; ** no convergence ;
%if (&byvar ne ) %then %do;
put "**** Program for &byvar &s terminated at iteration &i";
%end; %else %do;
put "**** Program terminated at iteration &i ";
%end;
put "**** No convergence achieved";
%end;

data &outds(drop=cntmarg); *** write output;
set __i0; *** data set;
rename weight=&outwt;
%let i=&numiter;
%end;
%end;

proc datasets library=work nolist mt=data;
delete __i0 __i1 __i2; ** purge work data;
run;
quit;
%mend;

My setup:

%raking
             (inds=rake2,
              outds=rake3,
              inwt=NR_Adj_Wght,
              freqlist=
                tar_1a
                tar_2a
                tar_3a
                tar_4a
                tar_5a
                tar_6a
                tar_7a
                tar_8a,
              outwt=rk_wt,
              byvar=,
              varlist=
                tar_1
                tar_2
                tar_3
                tar_4
                tar_5
                tar_6
                tar_7
                tar_8,
              numvar=8,
              cntotal=,
              trmprec=1.5,
              numiter=100);

Does anyone know how to stop SAS from closing?

Thanks!

[ChrisNZ · Accepted solution]

This macro calls endsas when it encounters specific conditions.

Use proc printto to redirect the log to see what the condition triggers that statement.

Or replace endsas with %return;

[monicatburrell]

Hi I know its been awhile since this but I've been trying to run Izrael's raking macro and not had it work. Do you have any tips? 

[ChrisNZ]

Did you look at the log?

[monicatburrell]

I ended up emailing David Izrael and he pointed me in the right direction!
I was able to get the code to work

[ChrisNZ]

Maybe put the answer here in case others have the same issue?

[monicatburrell]

Ah good point. The issue was that I was using the antiquated IHB taking macro referenced in his first paper, but they don’t maintain it anymore.

The newest macro can be found out at the link below with a lot of helpful information.

The only other structural issue I was having was not including a level for missing data in my control total datasets. So there are missing values in the raw survey data for the variables being adjusted, it’s necessary to include those. Otherwise, my favorite tip I found was making the most important
control variable the last variable in the iteration because as the last variable adjusted, there is exact agreement with the control totals.

https://www.abtassociates.com/raking-survey-data-aka-sample-balancing

[ChrisNZ]

Adding the code from https://www.abtassociates.com/sites/default/files/files/Insights/Tools/rake_and_trim_G4_V5.sas in case it disappears.

Spoiler

/*** Thias version converged on HCP fall 2016 data after changing low trim to min and high trimm to max ****/

%MACRO RAKE_AND_TRIM_G4_V5


             (inds=,                  /*     input data set            */
              outds=,                 /*    output data set            */
              inwt=,                  /*  weight being adjusted        */
                                      /* if there is no weight 1 is assigned */ 

              outwt=,                 /*     resulting weight          */ 
              varlist=,               /* list of raking variables      */
              numvar=,                /* number of raking variables    */
              cntotal=,               /*       control total           */
              trmprec=1,              /* termination criteria,1 default*/
              trmpct=,               /* termination based on marginal PCT */
                                     /* if indicated, macro termination based on this */

              VARDIFFTLR =,          /* list of variables with convergence criteria different from trmpct */
              DIFFTLR   =,           /* values of the different tolerances */       

                 
              numiter=50,            /* number of iterations, default - 50*/
              prdiag = N,            /* print detailed diagnostics     */
              NameRTF = RATRIMM,     /* name of rtf output              */   
                 

              TRIMWeight = YES,     /** Trim weight or Not: Yes or No **/  

              Method = OR, 

              GL_switch = YES,       /***   for OR method ***/
              GH_switch = YES,       /***   for OR method ***/ 
              IL_switch = YES,       /***   for OR method ***/
              IH_switch = YES,       /***   for OR method ***/ 
              GL_AND_IL_switch= ,    /***   for AND method ***/ 
              GH_AND_IH_switch=,     /***   for AND method ***/
 

        /*** next four parameters are for trimmimng weight by  Individual and global cap value method - IGCV ***/
     
              IHC      = 5,            /* weight will be decreased to individual weight times A */                  
              ILC      = 0.2,           /* weight will be increased to individual weight times B */   
              GHC      = 11.0,          /* weight will be decreased to mean weight times C  */
              GLC      = 0.091,         /* weight will be increased to mean weight times D  */   
              INOC   = 15,             /* iteration from which to check on signs of non-convergence */


);


 options  /*frmdlim='-'*/  nodate nonumber /*nocenter*/;

 ods _all_ close;


 *---------------------------------------------------------------------------*;
 title 'RAKING WITH TRIMMING WEIGHT BY INDIVIDUAL AND GLOBAL CAP VALUE METHOD';

 ODS PATH  TEMPLAT(update)  SASHELP.TMPLMST(READ);
 proc template;
  define style mynewstyle/store=TEMPLAT;
  parent=styles.RTF;
         style Table from output /
             Background=_UNDEF_
             rules = ALL
         cellpadding = 2pt
         cellspacing = 0.15pt
         borderwidth = 0.45pt;

  style batch from batch /
  font_face='Times Roman'
  font_size=9pt
  cellpadding=0
  bordercolor=white
  ;

  style Header from Header /
             Background=_undef_;
  style Rowheader from Rowheader /
             Background=_undef_;
  replace fonts /
      'TitleFont2' = ("Times Roman",10pt,Bold Italic)
      'TitleFont' = ("Times Roman",9pt,Bold Italic)
      'StrongFont' = ("Times Roman",8pt,Bold)
      'EmphasisFont' = ("Times Roman",8pt,Italic)
      'FixedEmphasisFont' = ("Courier",7pt,Italic)
      'FixedStrongFont' = ("Courier",7pt,Bold)
      'FixedHeadingFont' = ("Courier",7pt,Bold)
      'BatchFixedFont' = ("Times Roman, Courier",9pt)
      'FixedFont' = ("Courier",7pt)
      'headingEmphasisFont' = ("Times Roman",10pt,Bold Italic)
      'headingFont' = ("Times Roman",9pt)
      'docFont' = ("Times Roman",9pt);
  End;
  run; 


 *-----------------------*;
 %IF &TRMPCT NE %THEN %DO;

    proc format;
     value traffic low - <- &trmpct = 'CXCCCCCC'
                   &trmpct < - high = 'CXCCCCCC'
                            other   = 'CXFFFFFF';
     ;
    run;

 %END;  %****** IF &TRMPCT NE %THEN %DO;

 %ELSE %DO;

    proc format;
     value traffic low - <- &trmprec = 'CXCCCCCC'
                   &trmprec < - high = 'CXCCCCCC'
                             other   = 'CXFFFFFF';
     ;

 %END;  %****** ELSE %DO;
 *-----------------------*;


 *-----------------------*;
 %IF &PRDIAG = Y %THEN %DO;

    ods rtf  file="&namertf..rtf"  style=mynewstyle bodytitle startpage=never;

 %END; 

 %ELSE %DO;

    ods rtf  file="&namertf..rtf"  style=mynewstyle bodytitle startpage=never;

 %END; %****** IF &PRDIAG = Y %THEN %DO;
 *-----------------------*;



 *------------------*;
 ods escapechar='^';

 %let nb = %str(^S={font_weight=bold});
 %let nb0 = %str(^S={});



 *------------------------------------------------*;
 *  checking on existence of required parameters  *;
 * MACRO REQPAR (PARAM);
 *------------------------------------------------*;

 %MACRO REQPAR (PARAM);

   %if (%bquote(&&&param) eq ) %then %do;
       %put **** Program terminated: Macro parameter %upcase(&PARAM) missing ****;
       endsas;
   %end;

 %MEND; %****** MACRO REQPAR (PARAM);
 *---------------------------------*;


 %REQPAR (inds);
 %REQPAR (outds);
  *****%reqpar (inwt);
 %REQPAR (outwt);
 %REQPAR (varlist);
 %REQPAR (numvar);
 %REQPAR (trmprec);
 %REQPAR (numiter);



 *-------------------------------------------*;
 *  checking on number of raking variables   *;
 *-------------------------------------------*;

 %if  (%upcase(%scan(&varlist,&numvar)) eq ) or
      (%upcase(%scan(&varlist,%eval(&numvar+1))) ne )  %then %do;

       %put **** Program terminated: Number of variables in the VARLIST ****;
       %put **** does not match NUMVAR ****;
       endsas;

 %end;  %****** if  (%upcase(%scan(&varlist,&numvar)) eq ) or;



/*** create array of tolerances ***/

%if &VARDIFFTLR =  %then %do;

    %do _Y = 1 %to &NUMVAR;

     %let TLRDIFF&_Y = &TRMPCT;  


%put &&TLRDIFF&_Y ; 

    %end;

                         %end;  

%else %do;   /*** if there are some variables with different tolerances ***/



    %do _Y = 1 %to &NUMVAR;

     %let _zvar = %upcase(%scan(&varlist,&_y, %str ( )));  
 
        
  %* count the number of variables with diff tolerance to process ;
 
        %LET _numflds = 1;
 
        %DO %WHILE(%LENGTH(%SCAN(&VARDIFFTLR,&_numflds)));
            %LET _numflds = %EVAL(&_numflds + 1);
         %END;
 
        %LET _numflds = %EVAL(&_numflds - 1); 

  
   
/*
VARDIFFTLR
DIFFTLR   
*/
              %let _Flag_DT = 0;

    %do _Z = 1 %to  &_numflds;  

      %let _dvar = %upcase(%scan(&VARDIFFTLR,&_z, %str ( )));   

         %if &_zvar = &_dvar    %then %do;   %* the variable is in the list of different tolerances;  

                      %let TLRDIFF&_Y = %scan(&DIFFTLR,&_z, %str ( )); %let _Flag_DT = 1;  
                                      %end;
          

    %end;   %* end of list of the variables with different tolerances ;

     %if &_Flag_DT = 0 %then %let TLRDIFF&_Y = &TRMPCT;


    %end;  %* end of list of raking variable list;



       %end; /*** if there are some variables with different tolerances END ***/  

%do _Y = 1 %to &NUMVAR;

%put &&TLRDIFF&_Y; 


%end;

 data __I0;
  set &INDS;

  %if (&inwt ne ) %then %do;
      weight=&inwt;
  %end;
  %else %do;
      weight=1;
  %end;



 *------------------------------------------------------------------------------------*;
 *** Calculation of _INPUTWT adjusting input raking weight for general control total  *;
 *------------------------------------------------------------------------------------*;
                                            
                 %let _ds1=%scan(&varlist,1);       /* first margin just to calculate total  */



 proc summary data = &_DS1 noprint nway;*** claritas weight;
  var mrgtotal;
  output out = _POPULATION(drop=_:) 
         sum = population;
  run;


 proc summary data =__I0 noprint nway; *** claritas weight;
  var weight;
  output out = _SUMWEIGHT (drop=_:) 
         sum = sumweight;
  run;


 data __I0(drop=population sumweight);
  set __I0;
  if _n_ = 1 then set _POPULATION;
  if _n_ = 1 then set _SUMWEIGHT;

  weight = weight*population/sumweight; *** Input raking weights is adjusted to population total;

  %upcase(&inwt._ATPT) = weight;

  large_tr=0;  ** flags for person trimmed **;
  small_tr=0;
             GH_Trimmed=0;
             GL_Trimmed=0;
             IH_Trimmed=0;
             IL_Trimmed=0;



  run; 



 *-------------------------------------------------------------------*;
 *** Calculation and putting in IHCV, ILCV, GHCV, and GLCV outline ***;
 *-------------------------------------------------------------------*;

 proc summary data = __I0 noprint nway;
  var %upcase(&inwt._ATPT);
  output  out = _CD(drop=_:) 
         mean = mean_inpwt;
  run;


 data __I0 (drop=mean_inpwt);
  set __I0;
  if _n_ = 1 then set _CD;

  IHCV = %upcase(&inwt._ATPT)*&IHC; 
  ILCV = %upcase(&inwt._ATPT)*&ILC;

  GHCV = mean_inpwt*&GHC;
  GLCV = mean_inpwt*&GLC;

  run;



 *-----------------------------------*;
 *** new insertion written by Mike ***;
 *-----------------------------------*;

 proc sql noprint;
  select count(*) into: _I01 from __I0;
  select count(*) into: _I13 from __I0 where IHCV < GLCV;
  select count(*) into: _I15 from __I0 where ILCV > GHCV;
  quit;


 proc univariate noprint data=__i0;
  var %upcase(&inwt._ATPT);
  output out = _STATWT1
        Mean = _I03 
         Min = _I04 
         Max = _I05 
         std = STD;
  run;


 data _STATWT2;
  set __I0(keep = IHCV ILCV GHCV GLCV);
  if _n_=1;
  run;


 data _STATWT1;
  set _STATWT1;
  _I06= std/_I03; *** CV ***;
  run;


 data _STATWT;
  merge _STATWT1 
        _STATWT2;

  _pole1 = trim(left(put(_I03, 9.2))); 

  _pole2 = trim(left(put( _I04, 9.2)));

  _pole3 = trim(left(put(_I05, 9.2)));

  _pole4 = trim(left(put(_I06, 5.2)));

  _pole5 = trim(left(put(GLCV, 9.2)));

  _pole6 = trim(left(put(GHCV, 9.2)));

  run;


 data _NULL_ ;
  set _STATWT end=eof;
  file print ls=150;

  put "Sample size of completed interviews: &nb.%left(&_I01)&nb0";
  put "Raking input weight adjusted to population total: &nb.%upcase(&inwt._ATPT)&nb0";
  put "Mean value of raking input weight adjusted to population total: " "&nb" _pole1 "&nb0";
  put "Minimum value of raking input weight: " "&nb" _pole2 "&nb0";
  put "Maximum value of raking input weight: " "&nb" _pole3    "&nb0";
  put "Coefficient of variation of raking input weight: " "&nb" _pole4 "&nb0";

  put ' '; 
  put "Trim weight?: " "&nb" "&Trimweight" "&nb0";  


%if %upcase(&TRIMweight) = YES %then %do;

  %if %upcase("&METHOD") = "OR" %then %do; _Pole13 = 'OR '; %end; %else %do; _Pole13 = 'AND'; %end;    

  put "Trimming method: " "&nb" _pole13 "&nb0"; 



%if %upcase("&METHOD") = "OR" %then %do;

put "GL switch: &nb.&GL_switch.&nb0";
put "GH switch: &nb.&GH_switch.&nb0";
put "IL switch: &nb.&IL_switch.&nb0";
put "IH switch: &nb.&IH_switch.&nb0";


%end; %else

%if %upcase("&METHOD") = "AND" %then %do;

put "GL and IL switch: &nb.&GL_and_IL_switch.&nb0";
put "GH and IH switch: &nb.&GH_and_IH_switch.&nb0";


%end;

  put "Global low weight cap value (GLCV): " "&nb" _pole5 "&nb0";

  put "Global low weight cap value factor: Mean input weight times &nb.%left(&GLC)&nb0" ;

  put "Global high weight cap value (GHCV): " "&nb" _pole6 "&nb0";

  put "Global high weight cap value factor: Mean input weight times &nb.%left(&GHC)&nb0" ;

  put "Individual low weight cap value (ILCV) factor: Respondent's weight times &nb.%left(&ILC)&nb0" ;

  put "Individual high weight cap value (IHCV) factor: Respondent's weight times &nb.%left(&IHC)&nb0" ;

  put "Number of respondents who have an individual high weight cap value less than the global low weight cap value"; 

  put "(GLCV used in weight trimming): &nb.%left(&_I13)&nb0";

  put "Number of respondents who have an individual low weight cap value greater than the global high weight cap value" ;

  put "(GHCV used in weight trimming): &nb.%left(&_I15)&nb0";
  put " ";

  put "General tolerance (percentage points): &nb.%left(&trmpct)&nb0"; 
  put "Raking variable with different tolerance: &nb.%left(&VARDIFFTLR)&nb0";  
  put "Respective different tolerances:" "              " "&nb.%left(&DIFFTLR)&nb0";  



/*
trmpct=0.1, 
VARDIFFTLR = setting_rake  age_rake      occupation_rake ,
 DIFFTLR   =    0.01          0.7             0.001,   




*/







%end;


  run;


 title ' ';


 ***ods listing;


%*T*****; 


 *---------------------------------------*;
 * B. MACRO INIT_TABLE;
 *---------------------------------------*;
 %MACRO INIT_TABLE;

%global _trmpct;

  *-------------------------------------*;
  * C. *;
  *-------------------------------------*;
  %DO _IT=1 %TO &NUMVAR;



     %let mvar = %scan(&varlist,&_it, %str ( ));  

/*
     %let _trmpct = &&TLRDIFF&_IT; 

%put RAKING VARIABLE: &mvar &_trmpct;
*/



/*****  here is the place to insert tolerances*****/



     proc freq data = __I0;
      tables &mvar/noprint out = __OUT1(keep=&mvar count percent rename=(count=wcount percent=wpercent));
      weight %upcase(&inwt._ATPT);
      run;


     proc freq data = &MVAR;
      tables &MVAR/noprint out = __OUT2(keep=&mvar count percent rename=(count=tcount percent=tpercent));
      weight mrgtotal;
      run;


     data __OUT;
      retain &mvar wcount tcount difference1 wpercent tpercent difference2; 
      merge __OUT1 
            __OUT2;
      by &mvar;

      difference1 = wcount - tcount;
      difference2 = wpercent - tpercent;
 
      format wcount difference1 11.2 tcount 9.0 tpercent wpercent difference2 7.3;

      label 

           wcount       ='Input Weight Sum of Weights'
           tcount        ='Target Total'
           difference1   ='Sum of Weights Difference'
       
           wpercent      ='% of Input Weights'
           tpercent       ='Target % of Weights'
           difference2     = 'Difference in %';   
      ; 
      run;


     proc print label noobs data = __OUT;                      

      %if &_it = 1 %then %do;
          title2;
          title3 "Weighted Distribution Prior To Raking. Iteration 0";
      %end;
      %else %do;
          title2;
          title3;
      %end;

      var &mvar / Style = [just = left cellwidth=2.5 in ]; 

      var
         wcount
         tcount       
         difference1 
       
         wpercent    
         tpercent    
         difference2 ;


  %END;  %****** DO _IT=1 %TO &NUMVAR;
  *-------------------------------------*;
  * end C.  *;
  *-------------------------------------*;


 %MEND; %****** MACRO INIT_TABLE;
 *---------------------------------------*;
 * mend B. MEND MACRO INIT_TABLE;
 *---------------------------------------*;


 *---------------------------------------*;
 * CALL INIT_TABLE *;
 *---------------------------------------*;
 %INIT_TABLE;


%*T*****; 

 *--------------------------------------------------------------------------*;
 * D. *;
 *--------------------------------------------------------------------------*;
 %DO I=1 %TO &NUMITER;                 /*  LOOP ON ITERATION      */
   
     %let sumterm = 0;                  /* set cumulative sum of   */ 
                                        /* termination flags       */
                                    
                                        /* checking on number of   */
                                        /* raking variables        */
   

     *----------------------------------------------------------------*;
     * E. *;
     *----------------------------------------------------------------*;
     %DO J=1 %TO &NUMVAR;               /* LOOP ON RAKING VARIABLE */


         %let varrake=  %upcase(%scan(&varlist,&j)); /* retrieve raking variable*/
                                                     /* from list               */ 
                 %let dsfreq=&varrake;       /* if list of ds with marg  */
                                             /* freq is empty then their */
                                             /* name are same as names   */            
                                             /* of raking variables      */

         proc sort data = __I0;
          by &varrake;
          run;


         proc summary nway data = __I0 ;       /* calc adjusted marginal total -sum&j */
          class &varrake;
          var weight;
          output out = __I1(drop=_type_ _freq_) 
                 sum = sum&j;
          run;


         data __I0;
          merge __I0(in=_1) 
                __I1 &dsfreq(in=_2);      /* merge with ds with marginal proportions*/
          by &varrake;

          %IF &I=1 %THEN %DO;  /* all checking are done in 1st iteration only*/

              if (_1 and ^_2) or (_2 and ^_1) then do;
                 call symput('match','1');
                 stop;
              end; 
              else call symput('match','2');

              if mrgtotal ne . then call symput ('mrg','1');
              else call symput('mrg','2');

              if percent  ne . then call symput ('pct','1');
              else call symput('pct','2');

         %END;  %****** IF &I=1 %THEN %DO;  

         run;


%*T*****; 

         %*--------------------------------------------------------------------------*;
         %* F. *;
         %*--------------------------------------------------------------------------*;
         %IF &I=1 %THEN %DO;            /* all checking are done on first iteration */


             %*--------------------------*;
             %* G. *;
             %*--------------------------*;
             %IF &MATCH=1 %THEN %DO;

                %put 
                  **** Program terminated: levels of variable &varrake do not match ****;
                %put
                  **** in sample and marginal totals data sets ****;

                endsas;

             %END; %****** IF &MATCH=1 %THEN %DO;
             %*--------------------------*;
             %* end G. *;
             %*--------------------------*;

%*T*****; 

             %*---------------------------------------*;
             %IF &PCT = 1 AND (&CNTOTAL EQ ) %THEN %DO;

                %put 
                  **** Program terminated: PERCENT is not missing and CNTOTAL is missing ****;
                %put
                  **** for raking variable &varrake ****;

                endsas;

             %END; %****** IF &PCT = 1 AND (&CNTOTAL EQ ) %THEN %DO;


             %*-----------------------------------*;
             %ELSE %IF &PCT=2 AND &MRG=2 %THEN %DO;

                %put 
                  **** Program terminated: Both PERCENT and MRGTOTAL are missing ****;

                endsas;

             %END; %****** ELSE %IF &PCT=2 AND &MRG=2 %THEN %DO;



         %END; %****** IF &I=1 %THEN %DO; 
         %*--------------------------------------------------------------------------*;
         %* all checking are done on first iteration *;       
         %*--------------------------------------------------------------------------*;


%*T*****; 

         data __I0;
          set __I0;

          %IF (&CNTOTAL NE ) %THEN %DO;

              if mrgtotal ne . then                   /*  case of marginal totals*/     
                 cntmarg=mrgtotal;

              else if percent ne . then               /*  case of marginal freqs */
                 cntmarg=&cntotal.*percent/100;

          %END; %****** IF (&CNTOTAL NE ) %THEN %DO;

          %ELSE %DO;

              if mrgtotal ne . then                   /*  case of marginal totals*/     
                 cntmarg=mrgtotal;

          %END; %****** ELSE %DO;

          weight=weight*cntmarg/sum&j;     /* actual raking, weight adjustment */ 

          _cycle_trimm = 0; /* before trimming to indicate later if the person was trimmed during 50 cycles */

          drop percent mrgtotal;

          run;

      %if %upcase(&TRIMWEight) = YES %THEN %DO; 

          %*------------------------------------------------------*;
          %*** new truncated stuff descrfibed in Mike s outline ***;
          %*------------------------------------------------------*;

          proc summary data = __I0 nway noprint;
           class &varrake;
           var weight;
           output out = __WTCNT(drop=_type_ _freq_)   
                  sum = __wtcnt;
           run; 

%*T*****; 

         %*----------------------------------------------*;
         %* H. *;
         %*** From here cycle should start on trimming ***;
         %*----------------------------------------------*;



         %DO CYCLE=1 %TO 50;   /* 50 CYCLES AS OUTLINED BY MIKE */

            data __I0;
             set __i0;

          
          
  

             _max_trimm=0 ; 
             _min_trimm=0; /* for printed diagnostics on trimming */
             _spec_max=0;   
             _spec_min=0;

             weight_before = weight;

    %if %upcase(&GH_switch) = YES and %upcase(&IL_switch) = YES and %upcase(&GL_switch) = YES and %upcase(&IH_switch) = YES  %then %do;  
          
             if round(weight,.001) > round(GHCV,.001) and 
                round(weight,.001) < round(ILCV,.001) and 
                _cycle_trimm=0   then do; 

                weight = GHCV; 
                GH_Trimmed=1;              

                _spec_max=1;  
                _max_trimm=1; 
                large_tr=1; 
                _cycle_trimm=1; 

sec=1;
             end; 

             else if round(weight,.001) < round(GLCV,.001) and 
                     round(weight,.001) > round(IHCV,.001) and 
                     _cycle_trimm=0 then do; 

                  weight = GLCV;
                  GL_Trimmed=1;                  

  
                  _spec_min=1;  
                  _min_trimm=1; 
                  small_tr=1;  
                  _cycle_trimm=1; 

sec=2;
             end; 
%end;

%else %if %upcase(&GH_switch) = YES and %upcase(&IL_switch) = YES %then %do;

        if round(weight,.001) > round(GHCV,.001) and 
                round(weight,.001) < round(ILCV,.001) and 
                _cycle_trimm=0   then do; 

                weight = GHCV;
                GH_Trimmed=1;  

                _spec_max=1;  
                _max_trimm=1; 
                large_tr=1; 
                _cycle_trimm=1; 

sec=3;
             end; 

%end;

%else %if %upcase(&GL_switch) = YES and %upcase(&IH_switch) = YES  %then %do; 


if round(weight,.001) < round(GLCV,.001) and 
                     round(weight,.001) > round(IHCV,.001) and 
                     _cycle_trimm=0 then do; 

                  weight = GLCV;  
                  GL_Trimmed=1;
                  _spec_min=1;  
                  _min_trimm=1; 
                  small_tr=1;  
                  _cycle_trimm=1; 

sec=4;
             end; 
%end;


          %IF %upcase("&METHOD") = "OR" %THEN %DO;


%if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch) = YES and  %upcase(&IH_switch) = YES %then %do;



                   if round(weight, .001) > round(min(IHCV,GHCV),.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=min(IHCV,GHCV);
                          if IHCV<GHCV then IH_Trimmed=1; else GH_Trimmed=1;                      


 
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=5;

                     end; 

                     else if round(weight,.001) < round(max(ILCV,GLCV),.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=max(ILCV,GLCV); 
                          if ILCV>GLCV then IL_Trimmed=1; else GL_Trimmed=1;

                           small_tr=1;  
                          _cycle_trimm=1; 
sec=6;

                     end; 

%end;




%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = YES %then %do;



                     if round(weight, .001) > round(IHCV, .001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=IHCV; 
                          IH_Trimmed=1;

                          large_tr=1; 
                          _cycle_trimm=1;  
sec=7;

                     end; 

%end;



%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = NO %then %do;



                     if round(weight,.001) < round(ILCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=ILCV; 
                          IL_Trimmed=1;

                          small_tr=1;  
                          _cycle_trimm=1; 
sec=8;

                     end; 

%end;


%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = YES %then %do; 



                     if round(weight, .001) > round(IHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=IHCV; 
                          IH_Trimmed=1;
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=9;

                     end; 

                     else if round(weight,.001) < round(ILCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=ILCV; 
                          IL_Trimmed=1;
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=10;

                     end; 


%end;



%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = NO %then %do; 



                     if round(weight, .001) > round(GHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=GHCV; 
                          GH_Trimmed=1;
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=11;

                     end; 

%end;


%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = YES %then %do; 


                     if round(weight, .001) > round(min(IHCV,GHCV),.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=min(IHCV,GHCV);
                          if IHCV< GHCV then IH_Trimmed=1; else GH_Trimmed=1;    

 
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=12;

                     end; 

%end;





%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = NO %then %do; 


                     if round(weight, .001) > round(GHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=GHCV;
                          GH_Trimmed=1; 
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=13;

                     end; 

                     else if round(weight,.001) < round(ILCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=ILCV; 
                          IL_Trimmed=1;
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=14;

                     end; 

%end;




%else %if %upcase(&GL_switch) = NO and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = YES %then %do; 

                     if round(weight, .001) > round(min(IHCV,GHCV),.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=min(IHCV,GHCV);
                          if IHCV<GHCV then IH_trimmed=1; else GH_trimmed=1;    


 
                          large_tr=1; 
                          _cycle_trimm=1;  

sec=15;

                     end; 

                     else if round(weight,.001) < round(ILCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=ILCV; 
                          IL_trimmed=1;
                           small_tr=1;  
                          _cycle_trimm=1; 
sec=16;

                     end; 

%end;




%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = NO %then %do; 



                     if round(weight,.001) < round(GLCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=GLCV;
                          GL_trimmed=1; 
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=17;

                     end; 

%end;



%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = YES %then %do; 


                     if round(weight, .001) > round(IHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=IHCV;
                          IH_trimmed=1;  
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=18;

                     end; 

                     else if round(weight,.001) < round(GLCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=GLCV; 
                          GL_trimmed=1; 
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=19;

                     end; 
%end;


%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = NO %then %do; 


                     if round(weight,.001) < round(max(ILCV,GLCV),.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=max(ILCV,GLCV);
                          if ILCV>GLCV then IL_trimmed=1; else GL_trimmed=1; 

 
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=20;

                     end; 
%end;





%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =NO and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = YES %then %do; 


                     if round(weight, .001) > round(IHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=IHCV; 
                          IH_trimmed=1; 
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=21;

                     end; 

                     else if round(weight,.001) < round(max(ILCV,GLCV),.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=max(ILCV,GLCV);
                          if ILCV>GLCV then IL_trimmed=1; else GL_trimmed=1;

 
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=22;

                     end; 

%end;



%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = NO %then %do; 



                     if round(weight, .001) > round(GHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=GHCV;

                          GH_trimmed=1; 
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=23;

                     end; 

                     else if round(weight,.001) < round(GLCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=GLCV; 
                          GL_trimmed=1;
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=24;

                     end; 

%end;




%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= NO and  %upcase(&IH_switch) = YES %then %do; 



                     if round(weight, .001) > round(min(IHCV,GHCV),.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=min(IHCV,GHCV);
                          if IHCV<GHCV then IH_trimmed=1; else GH_trimmed=1; 


 
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=25;

                     end; 

                     else if round(weight,.001) < round(GLCV,.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=GLCV;
                          GL_trimmed=1; 
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=26;

                     end; 

%end;



%else %if %upcase(&GL_switch) = YES and  %upcase(&GH_switch) =YES and  %upcase(&IL_switch)= YES and  %upcase(&IH_switch) = NO %then %do; 



                     if round(weight, .001) > round(GHCV,.001) and 
                     _cycle_trimm=0 then do; 

                          _max_trimm=1; 
                          weight=GHCV; 
                          GH_trimmed=1;
                          large_tr=1; 
                          _cycle_trimm=1;  
sec=27;

                     end; 

                     else if round(weight,.001) < round(max(ILCV,GLCV),.001) and 
                     _cycle_trimm =0 then do; 

                          _min_trimm=1; 
                          weight=max(ILCV,GLCV);
                          if ILCV>GLCV then IL_trimmed=1; else GL_trimmed=1;
 
                          small_tr=1;  
                          _cycle_trimm=1; 
sec=28;

                     end; 

%end;



          %END; 



%ELSE %IF %upcase("&METHOD") = "AND" %THEN %DO;


             %*----------------------------------------*;
             %* USE THESE AND CONDITIONS INSTEAD       *;
             %*----------------------------------------*;



%if %upcase(&GL_and_IL_switch) = YES and  %upcase(&GH_and_IH_switch) =YES %then %do; 


           

              if ( round(weight, .001) > round(IHCV,.001) ) and 
                     ( round(weight, .001) > round(GHCV,.001) ) and 
                      _cycle_trimm=0 then do; 

                      _max_trimm=1; 
                      weight=max(IHCV,GHCV);
                      if IHCV<GHCV then IH_trimmed=1; else GH_trimmed=1;
 
                      large_tr=1; 
                      _cycle_trimm=1;  
sec=29;
      
       end; 


             else if ( round(weight,.001) < round(ILCV,.001) ) and 
                     ( round(weight,.001) < round(GLCV,.001) ) and 
                     _cycle_trimm =0 then do; 

                     _min_trimm=1; 
                     weight=min(ILCV,GLCV); *** change per Mike; 
                     if ILCV>GLCV then IL_trimmed=1; else GL_trimmed=1; 


                     small_tr=1;  
                    _cycle_trimm=1; 
sec=30;

             end; 

%end; 

%else %if %upcase(&GL_and_IL_switch) = YES and  %upcase(&GH_and_IH_switch) =NO %then %do;


if ( round(weight,.001) < round(ILCV,.001) ) and 
                     ( round(weight,.001) < round(GLCV,.001) ) and 
                     _cycle_trimm =0 then do; 

                     _min_trimm=1; 
                     weight=min(ILCV,GLCV);
                     if ILCV>GLCV then IL_trimmed=1; else GL_trimmed=1;

 
                     small_tr=1;  
                    _cycle_trimm=1; 
sec=31;

             end; 


%end;

%else %if %upcase(&GL_and_IL_switch) = NO and  %upcase(&GH_and_IH_switch) =YES %then %do;


              if ( round(weight, .001) > round(IHCV,.001) ) and 
                     ( round(weight, .001) > round(GHCV,.001) ) and 
                      _cycle_trimm=0 then do; 

                      _max_trimm=1; 
                      weight=max(IHCV,GHCV);
                      if IHCV<GHCV then IH_trimmed=1; else GH_trimmed=1;

 
                      large_tr=1; 
                      _cycle_trimm=1;  
sec=32;
   
          end; 



%end;
               %END;


             weight_after_trimming=weight;

             _diff_trimm = weight - weight_before;

             run;




            proc sql noprint;
             select sum(_max_trimm) into: _max_trimm
             from __I0;
             select sum(_min_trimm) into: _min_trimm
             from __I0;
             quit;

            %put CYCLE: &CYCLE LARGE WEIGHTS TRIMMED: &_max_trimm SMALL WEIGHTS TRIMMED: &_min_trimm; 

%*T*****; 

            %*--------------------------*;
            %*** Total Sum of weights ***;
            %*--------------------------*;

            proc summary nway noprint data = &DSFREQ;
             var mrgtotal;
             output out = _TOT_WTS1 
                    sum =_tot_wgts;
             run; 


            %*--------------------------*;
            %*** Low weight Increased ***;
            %*--------------------------*;

            proc summary nway noprint data = __I0;
             var weight_before;
             output out = _TOT_WTS2 
                    sum = low_tot_wgts_before 
                      N = _low_N;
             where _min_trimm=1; 
             run; 


            proc summary nway noprint data = __I0;
             var weight;
             output out = _TOT_WTS3 
                    sum = low_tot_wgts_after;
             where _min_trimm=1; 
             run; 


            proc summary nway noprint data = __I0;
             var _diff_trimm;
             output out = _TOT_WTS31
                    sum = spec_low_tot_wgts_after;
             where _min_trimm=1 and _spec_min=1; 
             run; 


            %*---------------------------*;
            %*** High Weight Decreased ***;
            %*---------------------------*;

            proc summary nway noprint data = __I0;
             var weight_before;
             output out = _TOT_WTS4 
                    sum = high_tot_wgts_before 
                      N = _high_N;
             where _max_trimm=1; 
             run; 


            proc summary nway noprint data = __I0;
             var weight;
             output out = _TOT_WTS5 
                    sum = high_tot_wgts_after;
             where _max_trimm=1; 
             run; 


            proc summary nway noprint data = __I0;
             var _diff_trimm;
             output out = _TOT_WTS51 
                    sum = spec_high_tot_wgts_after;
             where _max_trimm=1 and _spec_max=1; 
             run; 


            data _TRUNC (keep= cycle 
                               Tot_resp 
                               _tot_wgts 
                               _low_N 
                               low_tot_wgts_before 
                               low_tot_wgts_after
                               _high_N 
                               high_tot_wgts_before 
                               high_tot_wgts_after 
                               spec_low_tot_wgts_after   
                               spec_high_tot_wgts_after); 

             merge 
                  _TOT_WTS1 
                  _TOT_WTS2 
                  _TOT_WTS3 
                  _TOT_WTS31  
                  _TOT_WTS4 
                  _TOT_WTS5 
                  _TOT_WTS51
             ;

             Cycle= &cycle; 
             Tot_Resp = &_I01;  

             if _low_N = . then _low_N=0; 

             if low_tot_wgts_before = . then low_tot_wgts_before=0; 

             if low_tot_wgts_after = . then low_tot_wgts_after=0; 

             if _high_N=. then _high_N=0;  

             if high_tot_wgts_before = . then high_tot_wgts_before = 0; 

             if high_tot_wgts_after = . then high_tot_wgts_after = 0; 

             if spec_low_tot_wgts_after = . then spec_low_tot_wgts_after=0; 

             if spec_high_tot_wgts_after = . then spec_high_tot_wgts_after=0; 

             run;


            proc append base = __BASE 
                        data = _TRUNC;
             run;


            %*----------------------------*;
            %*** sum of weights trimmed ***;
            %*----------------------------*;

            proc summary data = __I0 nway noprint;
             where (_min_trimm=1 or _max_trimm=1);  
             class &varrake;
             var weight;
             output out = __SUMTR(drop=_type_ _freq_) 
                    sum = __SUMTR;
             run; 


            %*--------------------------------*;
            %*** sum of weights not trimmed ***;
            %*--------------------------------*;

            proc summary data = __I0 nway noprint;
             where _min_trimm=0 and _max_trimm=0;  
             class &varrake;
             var weight;
             output out = __SUMNTR(drop=_type_ _freq_) 
                    sum = __SUMNTR;
             run; 


            %*-----------------------------------------*;
            %*** adjust controltotal for not trimmed ***;
            %*-----------------------------------------*;

            data __NOTTR;
             merge __WTCNT 
                   __SUMTR;
             by &varrake;

             __wtntr = __wtcnt - __sumtr; 

             if __wtntr=. then __wtntr=__wtcnt;
             run;


            data __I0( drop = __sumtr __wtcnt __wtntr __sumntr  _max_trimm _min_trimm )
                 T;
             merge __I0  
                   __NOTTR 
                   __SUMNTR;
             by &varrake;

             if _max_trimm=0 and _min_trimm=0 then weight = weight*__wtntr/__sumntr;

             run;


            %if &_max_trimm=0 and &_min_trimm = 0 %then %let cycle=50;



         %END;














         %****** DO CYCLE=1 %TO 50;   
         %*-------------------------------------------------------------*;
         %* 50 CYCLES AS OUTLINED BY MIKE *;
         %* end H. *;
         %*-------------------------------------------------------------*;


%*T*****; 

         proc sql noprint;
          select sum(_max_trimm) into: _max_trimm
          from T;
          select sum(_min_trimm) into: _min_trimm
          from T;
          quit;

         %put CYCLE: &CYCLE LARGE WEIGHTS TRIMMED: &_max_trimm SMALL WEIGHTS TRIMMED: &_min_trimm; 


%END;   /****            END OF TRIMMING CYCLE             ****/



/*
proc print data=T;

var large_tr small_tr gh_trimmed gl_trimmed ih_trimmed il_trimmed;
run;
endsas; 
*/








         data __I2 (keep=&varrake sum&j cntmarg differ);
          retain &varrake sum&j cntmarg differ;
          set __I0;
          by &varrake;

          if first.&varrake;
          differ=sum&j - cntmarg;
          Iteration=&i;

          run;


         /*** create % for printing ****/

         proc summary data = __I2 nway noprint;
          var sum&j cntmarg;
          output out = __OUTS(drop=_: ) 
                 sum = sumsum summarg;
          run;


         data __I2(drop=sumsum summarg) 
              __STAT(keep=_diffpct);
          set __i2;

          if _n_ =1 then set __OUTS;

          %if (&trmpct ne ) %then %do;

              _pctsum=100*sum&j/sumsum;
              _pctmrg=100*cntmarg/summarg;

          %end; %****** if (&trmpct ne ) %then %do;

          %else %do;

              _pctsum=100*sum&j/sumsum;
              _pctmrg=100*cntmarg/summarg;

          %end; %****** else %do;

          _diffpct=_pctsum-_pctmrg;

          run;


         *** file for final statistics ***;

         data __STAT;
          set __STAT;

          Iteration=&i;

          _pct_diff = abs(_diffpct);
          drop _diffpct;

          run;


         proc append base = __ENDSTAT 
                     data = __STAT;
         run;


%*T*****; 

         %*-------------------------------*;
         %* I. *;
         %*-------------------------------*;
         %IF %UPCASE(&PRDIAG)=Y %THEN %DO;

            proc print label noobs data = __I2;                      

             title3 "Raking  by &varrake, iteration - &i ";

             var &varrake / Style = [just = left cellwidth=2.5 in ]; 

             var
                sum&j  
                cntmarg
                differ  
                _pctsum 
                _pctmrg 
                _diffpct
             ;

             sum sum&j cntmarg _pctsum _pctmrg;

             label

                  sum&j    = 'Current Sum of Weights'
                  differ   = 'Sum of Weights Difference'
                  cntmarg  = 'Target Total'
                  _pctsum  = 'Current % of Weights'
                  _pctmrg  = 'Target % of Weights'
                  _diffpct = 'Difference in %'
             ;   

             format _pctsum _pctmrg _diffpct 6.3;

             run;

%If %upcase(&TRIMWeight) = YES %THEN %DO; 
            proc report data=__base center split='|' missing  headline headskip;
             col  Cycle Tot_resp _tot_wgts 
                 ("Low Weights Increased"  _low_N   low_tot_wgts_before  low_tot_wgts_after spec_low_tot_wgts_after)
                 ("High Weights Decreased" _high_N high_tot_wgts_before high_tot_wgts_after spec_high_tot_wgts_after)
             ;

             define cycle       / display  width=5 'Cycle';
             define Tot_resp    / display  'Total|Respon-|dents';
             define _tot_wgts   / display  'Total|Sum of|Weights' format= 11.2;
             define _low_N      / display  'Number of|Respon-|dents';
             define low_tot_wgts_before     / display format= 11.2 'Sum of |Weights|Before|Trimming';
             define low_tot_wgts_after      / display format= 11.2 'Sum of |Weights|After|Trimming';
             define spec_low_tot_wgts_after / display format= 11.2 'Total|Weight|Increase|for|Cases with|IHCV<GLCV';

             define _high_N                  / display  'Number of|Respon-|dents';
             define high_tot_wgts_before     / display format =11.2 'Sum of |Weights|Before|Trimming';
             define high_tot_wgts_after      / display format= 11.2 'Sum of |Weights|After|Trimming';
             define spec_high_tot_wgts_after / display format= 11.2 'Total|Weight|Decrease|for|Cases with|ILCV > GHCV';

             title2 ;
             title3 ;

             run;

%END:

            proc datasets library = WORK nolist;
             delete __BASE;
             run;    


         %END;  %****** IF %UPCASE(&PRDIAG)=Y %THEN %DO;
         %*---------------------------------------*;
         %** END OF PRINTING DIAGNOSTICS **;
         %* end I. *;
         %*---------------------------------------*;


     %END;   %****** DO J=1 %TO &NUMVAR;    
             %* LOOP ON RAKING VARIABLE *;
             
     %*----------------------------------------------------------------*;
     %*** END OF THE CURRENT RAKING VARIABLE ***;
     %****** DO _IT=1 %TO &NUMVAR;
     %* end E. *;
     %*----------------------------------------------------------------*;



%*T*****; 

     data __I0;
      set __I0;
      drop 
          %do m=1 %to &numvar;  
              sum&m 
          %end;;    /* drop all sums for next iteration */
      run;



     %*--------------------------*;
     %*** Data for final stats ***;
     %*--------------------------*;

     proc summary data=__i0 nway noprint;
      var weight;
      output out = __STATFIN 
            mean = _finmean 
             std = _finstd;
      run;


     data __STATFIN;
      set __STATFIN;

      ITERATION = &I;
      cv = _finstd/_finmean;

      run; 


     proc append base = __FINSTAT 
                 data = __STATFIN;
      run;


     %*------------------------------------------*;
     %**** New termination criterion checking ****;
     %*------------------------------------------*;

     proc datasets library = WORK nolist;
      delete  __ENDITER 
              __STAT ;
      run;    


%*T*****; 


     %*---------------------------------------------------*;
     %* J. *;
     %*** all freqs calculated and compared with TRMPCT ***;
     %* MACRO TERMIT (MVAR);
     %*---------------------------------------------------*;

     %MACRO TERMIT (MVAR);


      %*---------------------------------------------------*;
      %* K. *;
      %*---------------------------------------------------*;
      %DO _IT=1 %TO &NUMVAR;

          %let mvar = %scan(&varlist,&_it, %str ( ));  

          proc freq data = __I0;
           tables &mvar/noprint out = __OUT1 (keep=&mvar count percent 
                                            rename=(count=wcount percent=wpercent)
                                              );
           weight weight;
           run;


          proc freq data=&mvar;
           tables &mvar/noprint out = __OUT2 (keep=&mvar count percent 
                                            rename=(count=tcount percent=tpercent)
                                             );
           weight mrgtotal;
           run;


          data __OUT(keep= Rake_var iteration differpct differval);
           merge __OUT1 
                 __OUT2;
           by &mvar;
           length rake_var $50;

           rake_var = "&mvar";
           differpct = abs(wpercent - tpercent);
           differval = abs(wcount - tcount);

           iteration = &i;

           run;


          proc append base = __ENDITER 
                      data = __OUT;
           run;


/*
proc print data=__enditer;
run;
*/


      %END; %****** DO _IT=1 %TO &NUMVAR;
      %*---------------------------------------------------*;
      %* end K. *;
      %*---------------------------------------------------*;


     %MEND;
     %*---------------------------------------------------*;
     %* mend J. *;
     %****** MEND MACRO TERMIT (MVAR);
     %*---------------------------------------------------*;


     %*----------------------------*;
     %* CALL MACRO TERMIT;
     %*----------------------------*;
     %TERMIT;



  %DO _IT=1 %TO &NUMVAR;

     %let mvar = %scan(&varlist,&_it, %str ( ));  

     %let _trmpct = &&TLRDIFF&_IT; 


%put RAKING VARIABLE: &mvar &_trmpct;



data __tolerances;
           length rake_var $50;
rake_var = "&mvar";


%if &trmpct ne %then %do;
_trmpct = &_trmpct;

%end;

   %else %do;

_trmpct = input(put("&_trmpct.",12.4),best12.);

%end;

output; 
run;

          proc append base = __rakevartol 
                      data = __tolerances;
          run;





%END;

proc sort data = __ENDITER out=__ENDITER2;
by rake_var;


proc sort data = __rakevartol nodupkey;
by rake_var;



data __ENDITER2;
merge __ENDITER2 __rakevartol;  
by rake_var;
run;

/*
proc print data=__enditer2;
run;
*/





     proc sql noprint;
      select count(*) into: __over
      from __ENDITER2

      %if &trmpct ne  %then %do;
          where differpct > _trmpct;
      %end; %****** if &trmpct ne  %then %do;

      %else %do;
          where differval > &trmprec;
      %end;  %****** else %do;

      quit; 


     proc append base = _ALL_ENDITER 
                 data = __ENDITER;
      run;



%******* 11.05.2013 *******;

         proc sql noprint;
          create table __MAXDIFF_X as
          select Iteration, 
          max(abs(differval)) as _max_diff_val, 
          max(abs(differpct)) as _max_diff
          from _ALL_ENDITER
          group by Iteration;
          quit; 

     proc sort data = __MAXDIFF_X;
       by descending Iteration;
       run;

     data __MAXDIFF_LAST2;
      set __MAXDIFF_X;
      if _N_ <= 2;
      run;

     %******* proc print;
     %*******  title5 "Table x1.a. __MAXDIFF_LAST2 ";
     %*******  run;

     proc sort data = __MAXDIFF_LAST2;
      by  Iteration;
      run;

    
     data FLAG_INC_DIFF__MAX_DIFF_VAL;
      set __MAXDIFF_LAST2 end = eof;

        prev__max_diff_val = lag(_max_diff_val);

        if prev__max_diff_val = . then prev__max_diff_val = 0;

        cur__max_diff_val = _max_diff_val;

        diff__max_diff_val =  cur__max_diff_val - prev__max_diff_val;

      if eof then do;

         if iteration = 1 then do;

            flag_inc_diff__max_diff_val = 0;

         end;

         else do;
     
                 if diff__max_diff_val > 0 then flag_inc_diff__max_diff_val = 1;
            else                                flag_inc_diff__max_diff_val = 0;

         end;

        output;

      end;

      run;

     %******* proc print;
     %*******  title5 "Table x1.b. __MAXDIFF_LAST2 ";
     %*******  run;
      
      %******* where FLAG_INC_DIFF__MAX_DIFF_VAL = 1;

     proc sql noprint;
      select flag_inc_diff__max_diff_val into: _FLAG_INC_DIFF__MAX_DIFF_VAL
      from FLAG_INC_DIFF__MAX_DIFF_VAL;
      quit;
 
      %put **** X1. _FLAG_INC_DIFF__MAX_DIFF_VAL : &_FLAG_INC_DIFF__MAX_DIFF_VAL Iteration = &i ****;
    

%*T*****; 

     *----------------------------*;
     * L.  MACRO INIT_TABLEP;
     *----------------------------*;
     %MACRO INIT_TABLEP;

      *------------------------------------------*;
      * M. *;
      *------------------------------------------*;
      %DO _IT=1 %TO &NUMVAR;

         %let mvar = %scan(&varlist,&_it, %str ( ));  

         proc freq data = __I0;
          tables &mvar/noprint out = __OUT1 (keep=&mvar count percent 
                                           rename=(count=wcount percent=wpercent)
                                             );
          weight weight;
          run;


         proc freq data=&mvar;
          tables &mvar/noprint out = __OUT2 (keep=&mvar count percent 
                                           rename=(count=tcount percent=tpercent)
                                             );
          weight mrgtotal;
          run;


         data __OUT;

          retain &mvar wcount tcount difference1 wpercent tpercent difference2; 

          merge __OUT1 
                __OUT2;

          by &mvar;

          difference1 = wcount - tcount;
          difference2 = wpercent - tpercent;
 
          format wcount difference1 11.2 tcount 9.0 tpercent wpercent difference2 7.3;

          label 
                 wcount        = 'Output Weight Sum of Weights'
                 tcount        = 'Target Total'
                 difference1   = 'Sum of Weights Difference'
       
                 wpercent      = '% of Output Weights'
                 tpercent      = 'Target % of Weights'
                 difference2   = 'Difference in %';   
          ; 

          run;


         proc print label noobs data=__out;                      

          %if &_it = 1 %then %do;
             title2;
             title3 "Weighted Distribution After Iteration &i";
          %end;

          %else %do;
             title2;
             title3;
          %end;

          var &mvar / Style = [just = left cellwidth=2.5 in ]; 

          var
             wcount
             tcount       
             difference1 
       
             wpercent    
             tpercent;    

          var difference2/Style =[BACKGROUND = traffic.];  

          run;


      %END; %****** DO _IT=1 %TO &NUMVAR;
      *---------------------------------------------------*;
      * end M. *;
      *------------------------------------------*;


     %MEND; 
     *----------------------------*;
     * mend L. *;
     * MEND MACRO INIT_TABLEP;
     *----------------------------*;


     %if %upcase(&prdiag) = Y %then
         %INIT_TABLEP;


%*T*****; 

     %*--------------------------------------------------------------------*;
     %*** preparation to terminate early if some conditions are not met ***;
     %*--------------------------------------------------------------------*;

     %*------------------------------*;
     %* N. *;
     %*------------------------------*;
     %IF &I>=&INOC %THEN %DO;

        proc sql noprint;
         create table _locmaxdiff as
         select Iteration, max(abs(differpct)) as _max_diff
         from _ALL_ENDITER
         group by Iteration;
         quit; 


        proc sort data = _LOCMAXDIFF;
         by descending iteration;
         run;


        data _LOCMAXDIFF;
         set _LOCMAXDIFF; 
         by descending iteration;

         if _n_<=5;   /*** 5 consequitive records ***/

         run;


        data _LOCMAXDIFF;
         set _LOCMAXDIFF end=last;

         if not last then
            set _locmaxdiff (firstobs=2 rename=(_max_diff=_max_diff2));

         else _max_diff2=.;

         _diff = _max_diff2 - _max_diff;

         if _diff ne .;

         run;


        proc sql noprint;
         select count(_diff) into: _sumdiff
         from _LOCMAXDIFF
         where abs(_diff)<0.00001
         ;
         quit;


        proc sql noprint;
         select count(_diff) into: _cntdiff
         from _LOCMAXDIFF
         where _diff<0;
         quit;


        %put _SUMDIFF= &_sumdiff _CNTDIFF = &_cntdiff;


        %if &_cntdiff >0  or  &_sumdiff=4   %then  %do;

           %let Exit_i = &i;

           %put Exiting at Iteration: &i;

           %let i=&numiter; /*** exiting iteration loop ***/

        %end; %****** if &_cntdiff >0  or  &_sumdiff=4   %then  %do;


     %END;   %****** IF &I>=&INOC %THEN %DO;
     %*------------------------------------------------*;
     %* end N. *;
     %*------------------------------------------------*;



     %PUT __OVER = &__over Iteration = &i ; 


%*T*****; 

     *------------------------------------------------------------------------------*;
     * O. *;
     *------------------------------------------------------------------------------*;
     %IF &__OVER = 0 OR &I=&NUMITER /*OR &_FLAG_INC_DIFF__MAX_DIFF_VAL = 1*/ %THEN %DO;                 /*  TERMINATION TEST */ 

         title3 ' ';

   %If %upcase(&TRIMWeight) = YES %then %do;

         /** Compute number of persons were trimmed or raised **/

         proc sql noprint;
          select sum(large_tr) into: large_tr
          from __I0;
          select sum(small_tr) into: small_tr
          from __I0;
          quit;


         proc sql noprint;
          select sum(GH_trimmed) into: GH_trimmed
          from __I0;
          select sum(GL_trimmed) into: GL_trimmed
          from __I0;
          select sum(IH_trimmed) into: IH_trimmed
          from __I0;
          select sum(IL_trimmed) into: IL_trimmed
          from __I0;

          quit;

%put &large_tr &small_tr
&GH_trimmed
          
&GL_trimmed

&IH_trimmed
          
&IL_trimmed

;

/*
proc print data = __I0;
where large_tr =1 or small_tr=1;
var large_tr small_tr sec    

GH_trimmed
          
GL_trimmed
          
IH_trimmed
          
IL_trimmed


;



;
endsas;
*/



    %END;



         data _NULL_;                          /* diagnostic for listing */
          set __I0;

          if _n_=1;

          file print ls=150 ps=59;
		
          put ' ';

          %if &__over=0 %then %do;             /* convergence achieved */      

              %if &trmpct ne %then %do;

                  put "&nb.**** Program terminated at iteration &i because raking converged ****&nb0 ";

              %end; %****** if &trmpct ne %then %do;

              %else %do;

                  put "&nb.**** Program terminated at iteration &i because all weighted margins differ from targets by less than &trmprec ****&nb0 ";

              %end; %****** else %do;

          %end;  %****** if &__over=0 %then %do;             /* convergence achieved */      


        /*  %else %if &_FLAG_INC_DIFF__MAX_DIFF_VAL = 1 %then %do;                   

              %let converged=1;

              put "&nb.**** Program terminated at iteration &I due to smallest Maximum Absolute Value of Difference in Sum of Weights ****&nb0";

          %end; */ %****** if &__over=0 %then %do;            

          %else %do;                                  /* no convergence */                  

              %let converged=1;

              put "&nb.**** Program terminated at iteration &i. No convergence achieved.  ****&nb0";

              run;

          %end;  %****** else %do;     %* no convergence *;


%*T*****; 


         %*----------------------------*;
         %* P. MACRO INIT_TABLEF;
         %*----------------------------*;
         %MACRO INIT_TABLEF;


           %*--------------------------*;
           %* Q. *;
           %*--------------------------*;
           %DO _IT=1 %TO &NUMVAR;

               %let mvar = %scan(&varlist,&_it, %str ( ));  

               proc freq data = __I0;
                tables &mvar/noprint out = __OUT1 (keep=&mvar count percent 
                                                 rename=(count=wcount percent=wpercent)
                                                   );
                weight weight;
                run;


               proc freq data=&mvar;
                tables &mvar/noprint out = __OUT2 (keep=&mvar count percent 
                                                 rename=(count=tcount percent=tpercent)
                                                   );
                weight mrgtotal;
                run;


               data __OUT;

                retain &mvar wcount tcount difference1 wpercent tpercent difference2; 

                merge __OUT1 
                      __OUT2;

                by &mvar;

                difference1 = wcount - tcount;
                difference2 = wpercent - tpercent;

%******* 11.05.2013 *******;
               difference3 = round( (difference1 / tcount * 100),.001 );

                  
                format wcount difference1 11.2 tcount 9.0 tpercent wpercent difference2 7.3
                       difference3 7.3;

                label 

                       wcount        = 'Output Weight Sum of Weights'
                       tcount        = 'Target Total'
                       difference1   = 'Sum of Weights Difference'
       
                       wpercent      = '% of Output Weights'
                       tpercent      = 'Target % of Weights'
                       difference2   = 'Difference in %'

                       difference3   = 'Marginal Category Difference in %'
                ;   

                run;


               proc print label noobs data=__out;                      

                %if &_it = 1 %then %do;

                    title2;
                    title3 "Weighted Distribution After Raking";

                %end; %****** if &_it = 1 %then %do;

                %else %do;

                    title2;
                    title3;

                %end; %****** else %do;

                var &mvar / Style = [just = left cellwidth=2.5 in ]; 

                var
                    wcount
                    tcount       
                    difference1 
       
                    wpercent    
                    tpercent    
                    difference2 

                    difference3
                ;

           %END; %****** DO _IT=1 %TO &NUMVAR;
           %*--------------------------------*;
           %* end  Q. *;
           %*--------------------------------*;


         %MEND;  %****** MACRO INIT_TABLEF;
         %*----------------------------*;
         %* mend P. *;
         %* MEND MACRO INIT_TABLEF;
         %*----------------------------*;


         %*----------------------------*;
         %* CALL INIT_TABLEF;
         %*----------------------------*;
         %INIT_TABLEF;


%*T*****; 

         proc sql noprint;
          create table __MAXDIFF as
          select Iteration, 
          max(abs(differval)) as _max_diff_val, 
          max(abs(differpct)) as _max_diff
          from _ALL_ENDITER
          group by Iteration;
          quit; 
/*
proc print data = _ALL_ENDITER;
run;
*/




         data __MAXDIFF;
          merge __MAXDIFF 
                __FINSTAT(keep=iteration cv)
          ;
          by iteration;

          format _max_diff 8.4 ; 

          run;


         proc print label noobs;
          title1;
          title2;
          title3;
          var Iteration / Style = [just = center]; 

          var _max_diff_val / Style = [just = center cellwidth=1.5 in ];
          var _max_diff / Style = [just = center cellwidth=1.5 in ]; 

          var cv / Style = [just = center cellwidth=1.5 in ]; 

          label _max_diff = 'Maximum Absolute Value of Difference in %'
                _max_diff_val = 'Maximum Absolute Value of Difference in Sum of Weights' 

                cv = 'Coefficient of Variation of Weights at the Completion of the Iteration'
                iteration = 'Iteration Number'
          ;

          run;


         data _NULL_;                                    /* diagnostic for listing */
          set __I0;

          if _n_=1;

          file print ls=150 ps=59;

        %If %upcase(&TRIMWeight) = YES %then %do;

          put ' ';
          put "Number of Respondents Who Had Their Weights Decreased by the Trimming: &nb.%left(&large_tr).&nb0";  
          put "Number of Respondents Who Had Their Weights Increased by the Trimming: &nb.%left(&small_tr).&nb0";
          put ' ';           
          put ' ';  
          put "Number of Respondents Who Had Their Weights Decreased to Global High Cap Value (GHCV) : &nb.%left(&GH_trimmed).&nb0";  
          put "Number of Respondents Who Had Their Weights Increased to Global Low Cap Value (GLCV) : &nb.%left(&GL_trimmed).&nb0"; 
          put "Number of Respondents Who Had Their Weights Decreased to Individual High Cap Value (IHCV) : &nb.%left(&IH_trimmed).&nb0";  
          put "Number of Respondents Who Had Their Weights Increased to Individual Low Cap Value (ILCV) : &nb.%left(&IL_trimmed).&nb0"; 




       %end;
          put ' ';
          put "Raking output weight: &nb.&outwt.&nb0"; 

          run;


         data &OUTDS(drop=cntmarg) ;                /*   create output data set */
          set __I0;
          rename weight=&outwt;
          run;


         %let i=&numiter; /*   for exiting i loop in case of early termination */


     %END;   /**** End of  %if __over=0 or &i=&numiter %then %do;   ***/
     %*------------------------------------------------------------------------------*;
     %* end O. *;
     %****** IF &__OVER = 0 OR &I=&NUMITER %THEN %DO;     
     %*  TERMINATION TEST *;
     %*------------------------------------------------------------------------------*;



 %END;  /*** END OF ITERAIONS ***/
 %*-------------------------------------------------------*;
 %* end D.                                                *;
 %****** ??? DO _IT=1 %TO &NUMVAR                         *;
 %****** DO I=1 %TO &NUMITER;  *  LOOP ON ITERATION       *;
 %*-------------------------------------------------------*;


%*T*****; 

 proc univariate noprint data = &OUTDS;
  var %upcase(&inwt._ATPT);
  output  out = _STATWT1 
         Mean = mean 
          Min = min 
          Max = max 
          std = std;
  run;


 proc univariate noprint data = &OUTDS;
  var &outwt;
  output out = _STATWT2 
        Mean = mean 
         Min = min 
         Max = max 
         std = std;
  run;


 data _STATWT;
  retain Weight Mean Min Max CV;
  set _statwt1(in=_1) _statwt2(in=_2);

  if _1 then Weight = "%upcase(&inwt._ATPT)                         ";
  if _2 then Weight = "&outwt                                       ";

  CV=std/Mean;

  format Mean Min Max  10.2   CV 6.3; 

  run;

   
 proc print noobs;
  title1;
  title2;
  title3; 

  ****var Weight Mean Min Max CV;

  var Weight / Style = [just = center cellwidth=2 in ]; 

  var Mean / Style = [just = right cellwidth=0.6 in ]; 
  var Min / Style = [just = right cellwidth=0.6 in ]; 

  var Max / Style = [just = right cellwidth=0.6 in ]; 

  var cv / Style = [just = right cellwidth=0.6 in ]; 

  run; 


 ods rtf close;

               /*    cleaning work data sets   */

 proc datasets library = WORK nolist;
  delete _base 
         __i0 
         __i1 
         __i2 
         __i22 
         __outs 
         _all_enditer 
         __endstat 
         __enditer 
         __enditer2

__rakevartol
__tolerances
          
__stat 
         __finstat 
         __statfin 
         __maxdiff 
         _statwt1 
         _statwt2 
         _statwt;
  run;    




%MEND;