/* rexx */
/*-------------------------------------------------------------------*/
/* Exec Name:    SORTCNTL                                            */
/* Date Written: 02/25/1999                                          */
/* Author:       Bruce R. Gillispie - email: gillispi@texasrock.com  */
/* Description:  Generate control cards for Sort                     */
/* Invocation:   Batch Job  - see JCL called: SYTSTK01               */
/*-------------------------------------------------------------------*/
/* Disclaimer:                                                       */
/* The "SORTCNTL" REXX IS NOT in the Public Domain Freeware Software.*/
/* You may use the "SORTCNTL" REXX AT YOUR OWN RISK, it is provided  */ 
/* for your enjoyment and neither the Author or his Employer provides*/ 
/* any warranty for its use.                                         */
/*-------------------------------------------------------------------*/
   
 signal on error                              /* catch all routine   */

 nd = '11';                /* number of days to subtract from today  */

 sdate = date('S',(date('B')-nd),'B');        /* days 03/02/1999 brg */
 
 /* Sort StorageTek report and only select tape in the silo which:    */
 /*      1. are sdate old                                             */
 /*      2. not flagged as scratch volumes                            */
 /*      3. not stored in silo 005 or 007                             */
 /*      4. only want 2500 records                                    */
 /*      5. output records will contain vol=ser and pad rest w/blanks */            

 cntl_recs.1 = " RECORD TYPE=F                         "
 cntl_recs.2 = "  INCLUDE COND=(39,8,CH,LT,C'"sdate"', "
 cntl_recs.3 = "                AND,64,1,CH,NE,C'S',   "
 cntl_recs.4 = "                AND,8,3,CH,NE,C'005',  "
 cntl_recs.5 = "                AND,8,3,CH,NE,C'007')  "
 cntl_recs.6 = "   SORT FIELDS=(39,8,CH,A),STOPAFT=2500"
 cntl_recs.7 = "   OUTREC FIELDS=(17:1,6,24:57X'40')          "

 cntl_recs.0 = "7"                     /* how many sort statements */

 wkname      = "TEST.STK.SORTCNT2"; /* output data set             */
/*              ....5....+....5....+....5....+....5....+....5.... */

call alloc_wrkfile
call write_cntl_recs
call close_work_file
call free_work_file
exit 00
/*                                                                */
/* call display_job                        used for development   */
/* call delete_work_file                   used for development   */

/* \\\\\\\\\\\\\\\\\\\ called routines below ///////////////////// */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Write Sort Control Statement                                      */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
write_cntl_recs:
 do i = 1 to cntl_recs.0
  queue cntl_recs.i
"execio 1 diskw $TMPFLE$";
 end i
return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Close Work file                                                   */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
close_work_file:
"execio 0 diskw $TMPFLE$ (FINIS";
return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Free Work file                                                    */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
free_work_file:
Address 'TSO' 'FREE F($TMPFLE$)'
return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*  Allocate Work file                                               */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
alloc_wrkfile:
  Address 'TSO'
    "ALLOC NEW CAT F($TMPFLE$) DSO(PS) SP(1,1) CYL "||,
    "DA('" || wkname || "') REUSE "||,
    "RECFM(F) BLKSIZE(0) LRECL(80) UNIT(SYSALLDA)";
 retcode = rc;                             /* Save the return code    */
 if retcode <> 0                           /* Did it work ??          */
    then do;                               /*     no, tell them       */
            Say "Allocation failed with rc=" retcode;
            Say "For the Temp Work File";
            exit 888
            return retcode;
            end;

return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Display Job using Library Services                                */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
display_job:
"ISPEXEC LMINIT DATAID(LMID) DDNAME($TMPFLE$)"
"ISPEXEC browse DATAID(&LMID)"
"ISPEXEC LMFREE DATAID(&LMID)"
return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Free and Delete Work file                                         */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
delete_work_file:
Address 'TSO' 'FREE F($TMPFLE$) DELETE'
return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Signal On Error Routine                                           */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
error:
say '----------------------------------------------------------- '
say ' The return code from the command on line' SIGL 'is:' RC
say '----------------------------------------------------------- '
call close_work_file
call delete_work_file
exit 13;
return retcode;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* End of exec...                                                    */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */