%macro NLEstimate(version, instore=, inest=, incovb=, 
                  f=, fdata=, label=, score=, outscore=NLEst, 
                  df=, alpha=);
   %local notesopt; %let notesopt = %sysfunc(getoption(notes));
   %let time = %sysfunc(datetime());
   %let _version=1.3;
   %if &version ne %then %put NOTE: NLEstimate macro Version &_version;
   %let status=ok;
   %let PInit =;
   %let nrecdiv = 300;
   %let Expnt=;
   %let Expnt1=;
   %if %upcase(&version) ne DEBUG %then %do;
     options nonotes;
     ods exclude all;
   %end;

   /* 
   /  Check for newer version. 
   /------------------------------------------------------------------*/
   %if %sysevalf(&sysver >= 8.2) %then %do;
    %let _notfound=0;
    filename _ver url 'http://ftp.sas.com/techsup/download/stat/versions.dat' termstr=crlf;
    data _null_;
      infile _ver end=_eof;
      input name:$15. ver;
      if upcase(name)="&sysmacroname" then do;
         call symput("_newver",ver); stop;
      end;
      if _eof then call symput("_notfound",1);
      run;
    %if &syserr ne 0 or &_notfound=1 %then
      %put &sysmacroname: Unable to check for newer version;
    %else %if %sysevalf(&_newver > &_version) %then %do;
      %put &sysmacroname: A newer version of the &sysmacroname macro is available.;
      %put %str(           ) You can get the newer version at this location:;
      %put %str(           ) http://support.sas.com/kb/;
    %end;
   %end;

   /*
   /  Input checking.
   /------------------------------------------------------------------*/
   %if (&instore= and &inest= and &incovb=) or
       (&instore ne and (&inest ne or &incovb ne)) %then %do;
     %put ERROR: Either INSTORE= or both INEST= and INCOVB= must be specified.;
     %let status=input_err;
     %goto exit;
   %end;
   %if (&inest ne and &incovb=) or (&inest= and &incovb ne) %then %do;
     %put ERROR: Both INEST= and INCOVB= must be specified.;
     %let status=input_err;
     %goto exit;
   %end;
   %if %index(&f,%str(%"))>0 or %index(&label,%str(%"))>0 %then %do;
     %put ERROR: Do not use double quotes (%str(%")) in F= or LABEL=. Use single quotes (%str(%')).;
     %let status=input_err;
     %goto exit;
   %end;
   %if %upcase(&version) ne SHOWNAMES and &fdata= and %quote(&f)= %then %do;
     %put ERROR: Either or both of FDATA= and F= must be specified.;
     %let status=input_err;
     %goto exit;
   %end;
   %if %upcase(&version) ne SHOWNAMES and &df= %then %do;
     %put &sysmacroname: When DF= is omitted 1 degree of freedom is assumed.;
   %end;
   %if &inest ne %then %do;
     %if %sysfunc(exist(&inest)) ne 1 %then %do;
       %put ERROR: INEST= data set not found.;
       %let status=input_err;
       %goto exit;
     %end;
     %else %do;
       %let dsid=%sysfunc(open(&inest));
       %if &dsid %then %do;
         %if %sysfunc(varnum(&dsid,estimate))=0 %then %do;
           %put ERROR: Required variable, ESTIMATE, not found.;
           %let status=input_err;
         %end;
         %let rc=%sysfunc(close(&dsid));
         %if &status=input_err %then %goto exit;
       %end;
       %else %do;
         %put ERROR: Could not open INEST= data set.;
         %goto exit;
       %end;
     %end;
   %end;
   %if &incovb ne and %sysfunc(exist(&incovb)) ne 1 %then %do;
     %put ERROR: INCOVB= data set not found.;
     %let status=input_err;
     %goto exit;
   %end;
   %if &score ne and %sysfunc(exist(&score)) ne 1 %then %do;
     %put ERROR: SCORE= data set not found.;
     %let status=input_err;
     %goto exit;
   %end;
   %if &score ne and &fdata ne %then %do;
     %put ERROR: When SCORE= is specified FDATA= is not allowed. Specify F=.;
     %let status=input_err;
     %goto exit;
   %end;
   %if &score ne and %quote(&f)= %then %do;
     %put ERROR: When SCORE= is specified F= must also be specified.;
     %let status=input_err;
     %goto exit;
   %end;
   %if &instore ne and %sysfunc(exist(&instore,ITEMSTOR)) ne 1 %then %do;
     %put ERROR: INSTORE= item store not found.;
     %let status=input_err;
     %goto exit;
   %end;
   %if &fdata ne %then %do;
     %if %sysfunc(exist(&fdata)) ne 1 %then %do;
       %put ERROR: FDATA= data set not found.;
       %let status=input_err;
       %goto exit;
     %end;
     %else %do;
       %let dsid=%sysfunc(open(&fdata));
       %if &dsid %then %do;
         %if %sysfunc(varnum(&dsid,label))=0 %then %do;
           %put ERROR: Required variable, LABEL, not found.;
           %let status=input_err;
         %end;
         %if %sysfunc(varnum(&dsid,f))=0 %then %do;
           %put ERROR: Required variable, F, not found.;
           %let status=input_err;
         %end;
         %let rc=%sysfunc(close(&dsid));
         %if &status=input_err %then %goto exit;
       %end;
       %else %do;
         %put ERROR: Could not open FDATA= data set.;
         %goto exit;
       %end;
     %end;
   %end;

   /*
   /  Put parameter estimates and covariance matrics into data sets.
   /------------------------------------------------------------------*/
   %if &instore ne %then %do;
     proc plm restore=&instore;
        show parameters covariance;
        ods output ParameterEstimates=_Parm
                   Cov               =_Cov;
     run;
     %if &syserr %then %do;
       %let status=plm_err;
       %goto exit;
     %end;
     data _cov; set _cov; 
        keep Col:;
     run;
   %end;
   %else %do;
     data _Parm; set &inest; run;
     data _Cov; set &incovb; run;
   %end;
   
   data _Parm; 
      set _Parm nobs=nobs; 
      call symput("dim",cats(nobs));
      Row=cats("p",_N_);
   run;

   /*
   /  Display parameter names for use in f= or fdata=.
   /------------------------------------------------------------------*/
   %if &score= %then %do;
     data _names; set _Parm;
        Name=cats("B_",Row);
     run;
     ods select all;
     proc print data=_names;
        id Name;
        var Estimate;
     run;
     %if %upcase(&version)=SHOWNAMES %then %goto exit;
   %end;

   /*
   /  Create input data and list of variables in it.
   /------------------------------------------------------------------*/
   proc transpose data=_Parm(rename=(Row=_NAME_)) out=_tParm(drop=_NAME_);
      format Estimate best16.;
      var Estimate;
   run;
   proc transpose data=_tParm out=_ttParm;
   run;

   /* 
   /  Build list of Parameter names and values for NLMIXED.
   /------------------------------------------------------------------*/
   data _null_; set _ttParm;
      call symput("PInit",cats(symget("PInit"))||' '||'B_'||cats(_NAME_)||' '||cats(COL1));
   run;

   /* 
   /  Prepare covariance matrix.
   /------------------------------------------------------------------*/
   data _null_;
     set _cov nobs=nobs;
     array cols (*) _numeric_;
     if _n_=1 then 
     if nobs ne &dim or nobs ne dim(cols) then do;
       put "ERROR: Covariance matrix improper or incompatible with parameter vector.";
       call symput("status","bad_cov");
     end;
   run;
   %if &status=bad_cov %then %goto exit;
   proc transpose data=_cov out=_tcov(keep=Col:); 
      var _numeric_;
   run;

   /* 
   /  Invert covariance matrix.
   /------------------------------------------------------------------*/
   data _addI;
     array idmx{&dim} I1-I&dim;
     set _tcov;
     do _j=1 to &dim;
        if _j=_N_ then idmx[_j]=1;
        else idmx[_j]=0;
     end;
     drop _j;
   run;
   proc reg data=_addI outest=_CovInv(keep=Col:) noprint;
     model I1-I&dim = Col: / noint;
   run;quit;
   
   /* 
   /  Gather covariance values.
   /------------------------------------------------------------------*/
   data _likepieces;
     set _CovInv;
     array c(&dim) Col1-Col&dim;
     do j=1 to _n_;
       covlow=c(j);
       lhs=cats("p",_n_);
       rhs=cats("p",j);
       if j = _n_ then factor = 1;
       else factor = 2;
       keep covlow lhs rhs factor;
       output;
      end;
   run;

   %if %upcase(&version)=DEBUG %then %do;
      proc print data = _likepieces;
      run;
   %end;

   data _likepieces;
      set _likepieces end = last;
   
      if _N_ = 1 then call symputx('midx',1);
      else do;
         if mod(_N_-1, &nrecdiv) = 0 then do;
            call symputx('midx', symgetN('midx')+1);
            end;
         end;
      
      if(_N_ = 1 and last = 1) then do;
         call symput('Expnt'||cats(symgetN('midx')), 
                     cats(symget('Expnt'||cats(symgetN('midx'))))||
                     cats(factor)||'*'||'('||trim(translate(lhs,"_","*"))||'-B_'||trim(translate(lhs,"_","*"))||')'
                     ||'*'||cats(covlow)||'*'||
                     '('||trim(translate(rhs,"_","*"))||'-B_'||trim(translate(rhs,"_","*"))||')');
         end;
      else do;
         if (mod(_N_-1, &nrecdiv) = 0) then do;
            call symput('Expnt'||cats(symgetN('midx')),
                        cats(factor)||'*'||'('||trim(translate(lhs,"_","*"))||'-B_'||trim(translate(lhs,"_","*"))||')'
                        ||'*'||cats(covlow)||'*'||
                        '('||trim(translate(rhs,"_","*"))||'-B_'||trim(translate(rhs,"_","*"))||')'||'+');         
            end;
         
         else if (mod(_N_, &nrecdiv) = 0) then do;
            call symput('Expnt'||cats(symgetN('midx')), 
                        cats(symget('Expnt'||cats(symgetN('midx'))))||
                        cats(factor)||'*'||'('||trim(translate(lhs,"_","*"))||'-B_'||trim(translate(lhs,"_","*"))||')'
                        ||'*'||cats(covlow)||'*'||
                        '('||trim(translate(rhs,"_","*"))||'-B_'||trim(translate(rhs,"_","*"))||')');
            end;
         else if last then do;
            call symput('Expnt'||cats(symgetN('midx')), 
                        cats(symget('Expnt'||cats(symgetN('midx'))))||
                        cats(factor)||'*'||'('||trim(translate(lhs,"_","*"))||'-B_'||trim(translate(lhs,"_","*"))||')'
                        ||'*'||cats(covlow)||'*'||
                        '('||trim(translate(rhs,"_","*"))||'-B_'||trim(translate(rhs,"_","*"))||')');
            end;   
         else do;
            call symput('Expnt'||cats(symgetN('midx')), 
                        cats(symget('Expnt'||cats(symgetN('midx'))))||
                        cats(factor)||'*'||'('||trim(translate(lhs,"_","*"))||'-B_'||trim(translate(lhs,"_","*"))||')'
                        ||'*'||cats(covlow)||'*'||
                        '('||trim(translate(rhs,"_","*"))||'-B_'||trim(translate(rhs,"_","*"))||')'||'+');
            end;
         end;
      run;

   /* 
   /  Use NLMIXED to compute estimate(s).
   /------------------------------------------------------------------*/
   %macro sum;
     %do i = 1 %to &midx-1;
        &&Expnt&i +
     %end;
     &&Expnt&midx;
   %mend;                  

   %if &fdata ne %then %do;
     data _null_; 
        set &fdata end=last nobs=nobs;
        if index(label,'"')>0 or index(f,'"')>0 then 
           call symput("status","quotes");
        call symput(cats("l",_n_),trim(label));
        call symput(cats("f",_n_),trim(f));
        if last then call symput("nf",nobs);
        run;
     %if &status=quotes %then %do;
     %put ERROR: Do not use double quotes (%str(%")) in the F or LABEL variable. Use single quotes (%str(%')).;
        %goto exit;
     %end;
   %end;
   
   %if &score ne %then %do;
     data _tParm;
       set _tParm &score(in=inscore);
       _inscore=0;
       if inscore then _inscore=1;
   %end;

   %if (^%length(&label)) %then %let label = &f;
   %if ( %length(&df)   ) %then %let df = df = &df;

   proc nlmixed data = _tParm;
    %if %upcase(&version) ne DEBUG and &score= %then 
      ods select AdditionalEstimates;
    ;
      parms &PInit;
      _e =  %sum;
      _l = -0.5*_e;
      %if &score ne %then if _inscore=0 then;
      _dummy = 1;  
      model _dummy ~ general(_l);
    %if %quote(&f) ne %then %do;
      %if &score ne %then %do;
        %if %quote(&f) ne %then %do;
          predict &f out=&outscore(where=(_inscore=1)) &df
            %if &alpha ne %then alpha=α
          ;
        %end;
      %end;
      %else %do;
        estimate "&label" &f &df
          %if &alpha ne %then alpha=α
        ;
      %end;
    %end;
    
    %if &fdata ne %then %do i=1 %to &nf;
      estimate "&&l&i" &&f&i &df
        %if &alpha ne %then alpha=α
      ;    
    %end;

    run;
   %if &syserr=3000 %then %do;
      %put ERROR: PROC NLMIXED in SAS/STAT is required.;
      %goto exit;
   %end;

   %if &score ne %then %do;
      data &outscore;
        set &outscore nobs=nobs;
        call symput("nobs",cats(nobs));
        drop _inscore;
        run;
      options notes;
      %put NOTE: The data set %upcase(&outscore) has &nobs observations.;
      %if %upcase(&version) ne DEBUG %then options nonotes;;
   %end;
    

%exit:
   /* 
   /  Delete temporary data sets; turn output and notes back on.
   /------------------------------------------------------------------*/
   %if %upcase(&version) ne DEBUG %then %do;
     %if &status=ok %then %do;
       proc datasets nolist; 
         delete _Parm _names _Cov  
         %if %upcase(&version) ne SHOWNAMES %then
                _tParm _ttParm _tcov _addI _CovInv _likepieces;
         ;
         run; quit;
     %end;
     %else %if &status=bad_cov %then %do;
       proc datasets nolist; 
         delete _Parm _names _Cov _tParm _ttParm;
         run; quit;
     %end;
     %else %if &status=quotes %then %do;
       proc datasets nolist; 
         delete _Parm _names _Cov _tParm _ttParm _tcov _addI _CovInv _likepieces;
         run; quit;
     %end;
   %end;
   %else %do;
     %put status = &status;
     %put midx   = &midx;
     %put Expnt1 = &Expnt1;   
     %put PInit  = &PInit;
     %put dim    = &dim;
   %end;   

   ods select all;
   options &notesopt;
   %let time = %sysfunc(round(%sysevalf(%sysfunc(datetime()) - &time), 0.01));
   %put NOTE: The NLEstimate macro used &time seconds.;
%mend;