 /* 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 upper arg dsname nocopy tempmult numrec . '((' .;
 parse upper arg . '((' options;
 temphlq = userid();
 if words(options) > 0 then
   do;
   do oo = 1 to words(options);
     theopt = word(options,oo);
     parse var theopt theoptnm '=' theoptval;
     select;
       when theoptnm = 'TEMPHLQ' then
         temphlq = theoptval;
       otherwise
         nop;
       end;
     end;
   end;
 tempds = nocopy;
 if nocopy = 'NC' then
   nocopy = 'NOCOPY';
 if tempds = 'TD' then
   tempds = 'TEMPDS';
 if tempds = 'TDR' then
   tempds = 'TEMPDSR';
 if tempmult = '' then
   tempmult = 1;
 fromtr = '!|'||'bd'x;
 dsname = translate(dsname,"'''",fromtr);
 xx = outtrap('tsoout.');
 'LISTDS' dsname;
 xx = outtrap('OFF');
 if tsoout.0 < 5 then
   do;
   say 'ERROR ? ? ? ? ? ? ? *';
   exit 16;
   end;
 if pos('--RECFM-LRECL-BLKSIZE-DSORG',tsoout.2) = 0 then
   do;
   say 'ERROR ? ? ? ? ? ? ? *';
   exit 16;
   end;
 parse upper var tsoout.3 recfm lrecl blksize dsorg rest;
 seqnum = '?';
 alias = '?';
 badhex = '?';
 data = '?';
 memexist = 'YES';
 tempdsn = '*';
 hextrin = xrange('00'X,'FF'X);
 hextrout = '';
 hextrout = hextrout||'00000000000000000000000000000000'X;
 hextrout = hextrout||'00000000000000000000000000000000'X;
 hextrout = hextrout||'00000000000000000000000000000000'X;
 hextrout = hextrout||'00000000000000000000000000000000'X;
 hextrout = hextrout||'40000000000000000000004B4C4D4E4F'X;
 hextrout = hextrout||'500000000000000000005A5B5C5D5E00'X;
 hextrout = hextrout||'60610000000000000000006B6C6D6E6F'X;
 hextrout = hextrout||'000000000000000000007A7B7C7D7E7F'X;
 hextrout = hextrout||'00818283848586878889000000000000'X;
 hextrout = hextrout||'00919293949596979899000000000000'X;
 hextrout = hextrout||'0000A2A3A4A5A6A7A8A9000000000000'X;
 hextrout = hextrout||'00000000000000000000000000000000'X;
 hextrout = hextrout||'C0C1C2C3C4C5C6C7C8C9000000000000'X;
 hextrout = hextrout||'D0D1D2D3D4D5D6D7D8D9000000000000'X;
 hextrout = hextrout||'E000E2E3E4E5E6E7E8E9000000000000'X;
 hextrout = hextrout||'F0F1F2F3F4F5F6F7F8F9000000000000'X;
 if tsoout.0 > 5 then
   do;
   if pos('--MEMBER---TTR----ALIAS-TTRN-CNT-DATA',tsoout.6) > 0 then
     do;
     if tsoout.0 > 6 then
       parse upper var tsoout.7 memname ttr alias ttrn cnt data;
     end;
   end;
 parse var dsname dsn1 '(' member ')' dsn2;
 if (dsorg = 'PS' & member = '') | (dsorg = 'PO' & member <> '') then
   do;
   badhex = 'NO';
   if sysdsn(dsname) = 'OK' & tempds <> 'TEMPDSR' then
     do;
     input_dd = 'IGYFINFO';
     'ALLOCATE FILE(IGYFINFO) SHR REUSE DA('dsname')';
     allocate_rc = rc;
     if allocate_rc = 0 then
       do;
       if (dsorg= 'PS' | dsorg = 'PO') & substr(recfm,1,1) = 'F' &,
         lrecl <= 256 then
         do; /* this code is fast path for fixed len, lrecl <= 256 */
         'IGYFLIBS';
         igyfvals_rc = rc;
         if igyfvals_rc <> 0 then
           exit igyfvals_rc;
         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 ? ? ? ? ? ? ? *';
           exit 16;
           end;
         "CALL '"modlib"(IGYFINF)'";
         igyfinf_rc = rc;
         if igyfinf_rc < 100 then
           do;
           say 'ERROR ? ? ? ? ? ? ? *';
           exit 16;
           end;
         igyfinf_rc = igyfinf_rc - 100;
         numrec = igyfinf_rc % 256;
         igyfinf_rc = igyfinf_rc // 256;
         if igyfinf_rc >= 16 then
           do;
           badhex = 'YES';
           igyfinf_rc = igyfinf_rc - 16;
           end;
         if igyfinf_rc = 0 then
           seqnum = 'YES'
         else
           seqnum = 'NO';
         end;
       else
         do; /* code below can handle all cases */
         'execio * diskr' input_dd '(STEM read_stem. FINIS';
         execio_rc = rc;
         if execio_rc = 0 then
           do;
           numrec = read_stem.0;
           if read_stem.0 > 0 then
             do;
             prevseq = 0 - 1;
             if (dsorg= 'PS' | dsorg = 'PO') &,
              substr(recfm,1,1) = 'F' & lrecl = 80 then
                seqnum = 'YES';
             do ii = 1 to read_stem.0;
               testhex =,
                 translate(read_stem.ii,hextrout,hextrin);
               if pos('00'x,testhex) > 0 then
                 badhex = 'YES';
               if (dsorg= 'PS' | dsorg = 'PO') &,
                 substr(recfm,1,1) = 'F' & lrecl = 80 then
                 do;
                 testseq = substr(read_stem.ii,73,8);
                 testseq2 =,
                   translate(testseq,'9999999999','0123456789');
                 if testseq2 <> '99999999' then
                   do;
                   seqnum = 'NO';
                   leave;
                   end;
                 testseq = testseq + 0;
                 if testseq <= prevseq then
                   do;
                   seqnum = 'NO';
                   leave;
                   end;
                 prevseq = testseq;
                 end;
               end;
             end;
           end;
         end;
       'FREE FILE(IGYFINFO)';
       end;
     end;
   else
     do;
     memexist = 'NO';
     if tempds <> 'TEMPDSR' then
       numrec = 0;
     end;
   end;
 parse var dsname dsn1 '(' member ')' dsn2;
 if dsorg = 'PO' & member <> '' then
   do;
   if sysdsn(dsname) = 'OK' then
     do;
     parse var dsname dsn1 '(' member ')' dsn2;
     dsname2 = dsn1||dsn2;
     xx = outtrap('tsoout.');
     'LISTDS' dsname2 'MEMBERS';
     xx = outtrap('OFF');
     if tsoout.0 < 6 then
       do;
       say 'ERROR ? ? ? ? ? ? ? *';
       exit 16;
       end;
     if strip(tsoout.6,'B') <> '--MEMBERS--' then
       do;
       say 'ERROR ? ? ? ? ? ? ? *';
       exit 16;
       end;
     if tsoout.0 > 6 then
       do;
       do ii = 7 to tsoout.0;
         if substr(tsoout.ii,1,8) <> '        ' then
           do;
           if pos('THE FOLLOWING ALIAS NAMES',tsoout.ii) > 0 then
             leave;
           parse var tsoout.ii memname aliasname;
           if memname = member then
             do;
             aliasname = strip(aliasname,'L');
             if substr(aliasname,1,6) = 'ALIAS(' then
               do;
               alias = 'BASE';
               leave;
               end;
             end;
           end;
         end;
       end;
     end;
   end;
 if seqnum = 'YES' then
   do;
   data = strip(data,'B');
   if data <> '?' & length(data) > 0 then
     seqnum = 'ISPF';
   end;
 if badhex = 'YES' & nocopy <> 'NOCOPY' then
   do;
   call copyds;
   badhex = output_name;
   end;
 if (tempds = 'TEMPDS' | tempds = 'TEMPDSR') & badhex = 'NO' then
   do;
   recfmtmp = substr(recfm,1,1);
   if lrecl > 80 then
     do;
     blksizetmp = 20 * lrecl;
     blocktmp = 500;
     blockcur = (numrec % 20) + 1;
     blockfact = 20;
     end;
   else
     do;
     blksizetmp = 50 * lrecl;
     blocktmp = 200;
     blockcur = (numrec % 50) + 1;
     blockfact = 50;
     end;
   if recfmtmp = 'V' then
     blksizetmp = blksizetmp + 4;
   blocktmp = blocktmp * tempmult;
   blocktmp = blocktmp + blockcur;
   maxrec = blocktmp * blockfact;
/* blocktmp2 = blocktmp % 2; */
   blocktmp2 = 0;
   if tempds = 'TEMPDS' then
     do;
     tmpout = time();
     tmpout = substr(tmpout,1,2)||substr(tmpout,4,2)||,
       substr(tmpout,7,2);
     tmpout = 'D'tmpout;
     if pos('.',temphlq) > 0 then
       tempdsn2 = "'"temphlq".@@TPSV@@."tmpout"'";
     else
       tempdsn2 = "'"temphlq".IWZ.@@TPSV@@."tmpout"'";
     end;
   else
     tempdsn2 = dsname;
   junk = outtrap('tsoout.');
   'DELETE' tempdsn2;
   junk = outtrap('OFF');
   'ALLOCATE FILE(IGYFTEMP) NEW REUSE DA('tempdsn2')',
     ' RECFM('recfmtmp 'B) LRECL('lrecl') BLKSIZE('blksizetmp')',
     ' SPACE('blocktmp blocktmp2') BLOCK('blksizetmp')';
   allocate_rc = rc;
   if allocate_rc <> 0 then
     do;
     say 'Allocate for temp save file failed , RC ='allocate_rc;
     exit allocate_rc;
     end;
   push 'x';
   'execio 1 diskw IGYFTEMP (OPEN FINIS';
   execio_rc = rc;
   if execio_rc <> 0 then
     do;
     say 'Cannot use temp save file';
     exit execio_rc;
     end;
   'FREE FILE(IGYFTEMP)';
   tempdsn = tempdsn2;
   tempdsn = tempdsn'/'maxrec;
   end;
 say 'OK' recfm lrecl dsorg seqnum alias badhex memexist tempdsn;
 exit 0;
 /* */
 copyds:
 input_name = dsname;
 tmpout = time();
 tmpout = substr(tmpout,1,2)||substr(tmpout,4,2)||substr(tmpout,7,2);
 tmpout = 'D'tmpout;
 parse var dsname dsn1 '(' member ')' dsn2;
 if member = '' then
   do;
   if pos('.',temphlq) > 0 then
     output_name = "'"temphlq".@@TEMP@@."tmpout"'";
   else
     output_name = "'"temphlq".IWZ.@@TEMP@@."tmpout"'";
   end;
 else
   do;
   if pos('.',temphlq) > 0 then
     output_name = "'"temphlq".@@TEMP@@."tmpout"("member")'";
   else
     output_name = "'"temphlq".IWZ.@@TEMP@@."tmpout"("member")'";
   end;
 call alloc_input;
 call alloc_output;
 blanks = '                                        ';
 blanks = blanks||blanks;
 wasjob = 'no';
 line = 0;
 do forever;
   call read_input;
   if read_rc = 0 then
     do;
     record = translate(record,hextrout,hextrin);
     out_rec = record;
     call write_output;
     end;
   else
     do;
     call finis_input;
     call finis_output;
     call free_input;
     call free_output;
     return;
     end;
   end;
 /* */
 alloc_input:
 'ALLOCATE FILE(IGYFEDI) SHR REUSE DA('input_name')';
   allocate_rc = rc;
   if allocate_rc <> 0 then
     do;
     say 'Allocate for input file failed , RC ='allocate_rc;
     exit allocate_rc;
     end;
   input_dd = 'IGYFEDI';
 return;
 /* */
 alloc_output:
 junk = outtrap('tsoout.');
 'DELETE' output_name;
 junk = outtrap('OFF');
 'ALLOCATE FILE(IGYFEDO) NEW REUSE DA('output_name')',
   ' LIKE('input_name')';
 allocate_rc = rc;
 if allocate_rc <> 0 then
   do;
   say 'Allocate for output file failed , RC ='allocate_rc;
   exit allocate_rc;
   end;
 output_dd = 'IGYFEDO';
 return;
 /* */
 read_input:
 'MAKEBUF';
 call read_input_inner;
 'DROPBUF';
 buf_rc = rc;
 if buf_rc <> 0 then
   call buferr;
 return;
 /* */
 read_input_inner:
 line = line + 1;
 'execio 1 diskr' input_dd line '(LIFO';
 execio_rc = rc;
 if execio_rc = 0 then
   do;
   if queued() > 0 then
     do;
     parse pull record;
     read_rc = 0;
     return;
     end;
   end;
 read_rc = 4;
 return;
 /* */
 write_output:
 push out_rec;
 'execio 1 diskw' output_dd '(';
 execio_rc = rc;
 if execio_rc <> 0 then
   call execio_err;
 return;
 /* */
 finis_input:
 'execio 0 diskr' input_dd '(FINIS';
 execio_rc = rc;
 if execio_rc <> 0 then
   call execio_err;
 return;
 /* */
 finis_output:
 'execio 0 diskw' output_dd '(FINIS';
 execio_rc = rc;
 if execio_rc <> 0 then
   call execio_err;
 return;
 /* */
 free_input:
 'FREE FILE(IGYFEDI)';
 return;
 /* */
 free_output:
 'FREE FILE(IGYFEDO)';
 return;
 /* */
 buferr:
 say 'Internal error, MAKEBUF or DROPBUF failed , RC =' buf_rc;
 exit buf_rc;
 /* */
 execio_err:
 say 'EXECIO error, RC =' execio_rc;
 exit execio_rc;
