 /* REXX */
 /*********************************************************************/
 /* Licensed Material - Property of IBM                               */
 /* 5639-B92 , 5648-A25 , 5688-197 , 5639-D65 , 5688-235              */
 /* (C) Copyright IBM Corp., 1997, 1998                               */
 /* All rights reserved.                                              */
 /* US Government Users Restricted Rights - Use, duplication or       */
 /* disclosure restricted by GSA ADP Schedule Contract with IBM Corp. */
 /*********************************************************************/
 trace off;
 signal on novalue;
 parse source opsys rest;
 parse upper arg input_name rest;
 if input_name = '' then
   do;
   say 'Input name missing';
   exit 16;
   end;
 'IGYFLIBS';
 igyfvals_rc = rc;
 if igyfvals_rc <> 0 then
   do;
   say 'ERROR IGYFLIBS return code =' igyflibs_rc;
   exit igyfvals_rc;
   end;
 modlib = '';
 do while queued() > 0;
   pull usertype uservalue rest;
   select;
     when usertype = 'COBOL' then
       modlib = uservalue;
     otherwise
       nop;
     end;
   end;
 if modlib = '' then
   do;
   say 'ERROR IGYFLIBS is invalid';
   exit 16;
   end;
 output_name = "'"userid()".IWZ.@@TEMP@@.CNTL'";
 call alloc_input;
 call alloc_output;
 blanks = '                                        ';
 blanks = blanks||blanks;
 wasjob = 'no';
 wasnot = 'no';
 call read_input;
 if infile.0 = 0 then
   do;
   say 'Input file is empty';
   exit 16;
   end;
 do ii = 1 to infile.0;
   record71 = substr(infile.ii,1,71);
   if substr(record71,1,2) = '//' & substr(record71,3,1) <> '*' then
     do;
     parse var record71 '//' jobname job rest;
     if job = 'JOB' then
       do;
       jobnameo = jobname;
       recrest = substr(infile.ii,72);
       theuser = userid();
       lentest = length(theuser) + 1;
       /* change the job name unless it already consists of the */
       /* userid plus one character */
       if substr(jobname,1,length(theuser)) <> theuser |,
         length(jobname) <> lentest then
         do;
         tm = time();
         tmm = substr(tm,4,2);
         tms = substr(tm,7,2);
         tm = (((tmm * 60) + tms) // 36) + 1;
         tm = substr('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789',tm,1);
         jobname = userid()||tm;
         rest2 = strip(rest,'L');
         testrec = '//'jobname 'JOB' rest;
         testrec = strip(testrec,'T');
         if length(testrec) <= 71 then
           record71 = testrec;
         else
           do;
           say 'Cannot alter job name' jobnameo,
             ', job not submitted';
           'FREE FILE(IGYFSUBI,IGYFSUBO)';
           exit 16;
           end;
         record71 = substr(record71||blanks,1,71);
         infile.ii = record71||recrest;
         leave;
         end;
       end;
     end;
   end;
 'execio * diskw' output_dd '(STEM infile. FINIS';
 execio_rc = rc;
 if execio_rc <> 0 then
   call execio_err;
 'FREE FILE(IGYFSUBI,IGYFSUBO)';
 'SUBMIT' output_name;
 submit_rc = rc;
 exit submit_rc;
 /* */
 alloc_input:
 xx = outtrap('tsoout.');
 do ii = 1 to 54;
   if ii > 53 then
     call errexit;
   'ALLOCATE FILE(IGYFSUBI) OLD REUSE DA('input_name')';
     allocate_rc = rc;
     if allocate_rc = 0 then
       leave;
   "CALL '"modlib"(IGYFWAIT)'";
   igyfwait_rc = rc;
   if igyfwait_rc <> 0 then
     do;
     say 'Module IGYFWAIT cannot be accessed';
     call errexit;
     end;
   end;
 input_dd = 'IGYFSUBI';
 xx = outtrap('OFF');
 return;
 /* */
 alloc_output:
 if sysdsn(output_name) = 'OK' then
   do;
   'ALLOCATE FILE(IGYFSUBO) OLD REUSE DA('output_name')';
   allocate_rc = rc;
   if allocate_rc <> 0 then
     do;
     say 'Allocate for output file failed , RC ='allocate_rc;
     exit allocate_rc;
     end;
   end;
 else
   do;
   'ALLOCATE FILE(IGYFSUBO) NEW REUSE DA('output_name')',
     ' TRACKS SPACE(2 2) RECFM(F B) LRECL(80) BLKSIZE(6160)';
   allocate_rc = rc;
   if allocate_rc <> 0 then
     do;
     say 'Allocate for output file failed , RC ='allocate_rc;
     exit allocate_rc;
     end;
   end;
 output_dd = 'IGYFSUBO';
 return;
 /* */
 read_input:
 'execio * diskr' input_dd '(STEM infile. FINIS';
 execio_rc = rc;
 if execio_rc <> 0 then
   call execio_err;
 return;
 /* */
 execio_err:
 say 'EXECIO error, RC =' execio_rc;
 exit execio_rc;
 /* */
 errexit:
 xx = outtrap('OFF');
 if tsoout.0 > 0 then
   say 'MVS messages follow';
 else
   say 'No MVS messages available';
 if tsoout.0 > 0 then
   do;
   do ii = 1 to tsoout.0;
     say strip(tsoout.ii,'T');
     end;
   end;
 exit 16;
