/**********************************************************************/


   /*--------------------------------------------------------------+
   |                                                               |
   | NAME:    LISTFILE SASMACRO                                    |
   | PURPOSE: To create a data set containing a list of files      |
   | USAGE:   LISTFILE <filename> <filetype> <filemode>, <dataset> |
   |                                                               |
   |      all parameters have defaults:                            |
   |      filename = *                                             |
   |      filetype = *                                             |
   |      filemode = A                                             |
   |      dataset = LISTFILE                                       |
   |                                                               |
   |      the resulting data set contains three variables:         |
   |      FN   type: character   length: 8                         |
   |      FT   type: character   length: 8                         |
   |      FM   type: character   length: 2                         |
   |                                                               |
   +--------------------------------------------------------------*/


/**********************************************************************/


parse arg fn ft fm xtra ',' dataset .
if xtra ^= '' then do
   '++SASLOG ERROR: Invalid file specification'
   exit 24
   end


/**********************************************************************/


if fm = '' then fm = 'A'
if ft = '' then ft = '*'
if fn = '' then fn = '*'
if dataset = '' then dataset = 'LISTFILE'


/**********************************************************************/


typing = cmsflag('cmstype')
address command
'MAKEBUF'
'SET CMSTYPE HT'
'LISTFILE' fn ft fm '(STACK'


/**********************************************************************/


ret = rc
if typing then
   'SET CMSTYPE RT'
address


/**********************************************************************/


if ret ^= 0 then do
    '++SASLOG ERROR: Return code' ret 'from CMS LISTFILE'
    address command 'DROPBUF'
    exit ret
    end


/**********************************************************************/


'DATA' dataset ';'
'LENGTH FN FT $8 FM $2;'
do i = 1 to queued()
   pull fn ft fm .
   'FN = "' || fn || '";'
   'FT = "' || ft || '";'
   'FM = "' || fm || '";'
   'OUTPUT;'
end


/**********************************************************************/


address command 'DROPBUF'
'RUN;'


/**********************************************************************/


length fn ft selfile $ 8 fm $ 2 ;


/**********************************************************************/


INIT:
control label;


/**********************************************************************/


submit continue;
   listfile * output a, work.outlist ;
   run;
endsubmit;


/**********************************************************************/


if exist('work.outlist') then dsid=open('work.outlist');


/**********************************************************************/


rc=filename('rept3','freq output a').


/**********************************************************************/


if dsid then do;
   call set(dsid);
   numobs=attrn(dsid,'nobs');
   do i=numobs to 1 by -1;
      rc=fetchobs(dsid,i);
      rc=filename('rept'||i,fn||' '||ft||' '||fm);
   end;
   rc=close(dsid);
end;
else do;
   _msg_='A listing of files available could not be accessed.';
end;


/**********************************************************************/


reportid=makelist();


/**********************************************************************/


cursor ask;
return;


/**********************************************************************/


ASK:
rc=clearlist(reportid);
refresh;
call wregion(1,1,15,79,'cmdline');
call execcmd("setwname 'Reports Available'");
selfile=filelist('^ rlink','Select the desired report file',"N");
   if selfile ne _blank_ then do;
      rc=fillist('fileref',selfile,reportid);
      call setrow(0,0,'','y');
   end;
ask=_blank_;
return;


/**********************************************************************/


GETROW:
if _currow_ gt listlen(reportid) then call endtable();
else  do;
   row=getitemc(reportid,_currow_);
   if substr(row,1,1)='1' then substr(row,1,1)=' ';
end;
return;


/**********************************************************************/


PUTROW:  return;

MAIN:    return;


/**********************************************************************/


term:
if reportid then rc=dellist(reportid,'y');
return;


/**********************************************************************/