/* REXX */

record_count = 0

ADDRESS ISPEXEC

SAY 'Enter the dataset name of the sequential equivalent of your PDS:'
PARSE UPPER PULL dsnseq

"LMINIT DATAID(SEQID) DATASET("dsnseq") ENQ(SHR) ORG(DSORG)"
zrc = RC

SELECT
WHEN zrc \= 0
THEN DO
       SAY 'ISPF service LMINIT failed for sequential dataset.',
           ' Return code:' zrc
       EXIT zrc
     END

WHEN dsorg \= 'PS'
THEN DO
       SAY 'Dataset is not sequential.'
       EXIT zrc
     END

OTHERWISE SAY 'ISPF service LMINIT for sequential dataset successful.'
END /* SELECT */

"LMOPEN DATAID("seqid") OPTION(INPUT) LRECL(LRECL) RECFM(RECFM)"
zrc = RC

IF zrc \= 0
THEN DO
       SAY 'ISPF service LMOPEN failed for sequential dataset.',
           ' Return code:' zrc
       SIGNAL Free_Seq
     END
ELSE SAY 'ISPF service LMOPEN for sequential dataset successful.'

recfm = SUBSTR(recfm,1,1) SUBSTR(recfm,2,1) SUBSTR(recfm,3,1),
        SUBSTR(recfm,4,1)
lrecl = STRIP(lrecl,'L',0)

"LMGET DATAID("seqid") MODE(INVAR) DATALOC(DELIMIT)",
                       "DATALEN(LENGTH) MAXLEN("lrecl")"
zrc = RC

SELECT
WHEN zrc > 8
THEN DO
       SAY 'ISPF service LMGET failed for sequential dataset.',
           ' Return code:' zrc'.'
       SIGNAL Close_Seq
     END

WHEN zrc = 8
THEN DO
       SAY 'Empty sequential dataset.'
       SIGNAL Close_Seq
     END

OTHERWISE
     IF LEFT(delimit,2) \= './'
     THEN DO
            SAY 'Invalid sequential dataset.  The dataset must',
                'have been created using REXX exec PDSTOSEQ or',
                'DOSTOSEQ.'
            SIGNAL Close_Seq
          END
END /* SELECT */

/* */

SAY
Say 'Enter the dataset name of the PDS equivalent of your dataset:'
PARSE UPPER PULL dsnpds

SAY
SAY 'Enter the unit name for the PDS equivalent of your dataset:'
PARSE UPPER PULL unit

SAY
SAY 'Enter the volume name for the unit or leave blank:'
PARSE UPPER PULL volume

IF volume \= ''
THEN volume = 'VOLUME('volume')'

SAY
SAY 'Enter TSO ALLOCATE command DCB parameters or leave blank:'
PARSE UPPER PULL dcb

IF dcb = ''
THEN dcb = 'RECFM('recfm') LRECL('lrecl') LIKE('dsnseq')'

ADDRESS TSO "ALLOC F(SEQTOPDS) DA("dsnpds") NEW CATALOG",
            "UNIT("unit")" volume "CYLINDERS SPACE(5 2) DIR(50)",
            "DSORG(PO)" dcb
zrc = RC

IF zrc \= 0
THEN DO
       SAY 'TSO command ALLOCATE failed for PDS dataset.',
           ' Return code:' zrc
       SIGNAL Close_Seq
     END

ADDRESS TSO "FREE F(SEQTOPDS)"
zrc = RC

IF zrc \= 0
THEN DO
       SAY 'TSO command FREE failed for PDS dataset.',
           ' Return code:' zrc
       SAY 'Attempting to continue.'
     END
ELSE SAY 'PDS dataset allocated successfully.'

"LMINIT DATAID(PDSID) DATASET("dsnpds") ENQ(EXCLU)"
zrc = RC

IF zrc \= 0
THEN DO
       SAY 'ISPF service LMINIT failed for PDS dataset.',
           ' Return code:' zrc
       SIGNAL Close_Seq
     END
ELSE SAY 'ISPF service LMINIT for PDS successful.'

"LMOPEN DATAID("pdsid") OPTION(OUTPUT)"
zrc = RC

IF zrc \= 0
THEN DO
       SAY 'ISPF service LMOPEN failed for PDS dataset.',
           ' Return code:' zrc
       SIGNAL Free_Pds
     END
ELSE SAY 'ISPF service LMOPEN for PDS successful.'

/* */

SAY

DO member_loop = 1 UNTIL zrc_lmget = 8
   DO record_loop = 1
      "LMGET DATAID("seqid") MODE(INVAR) DATALOC(RECORD)",
                             "DATALEN(LENGTH) MAXLEN("lrecl")"
      zrc_lmget = RC

      SELECT
      WHEN zrc_lmget > 8
      THEN DO
             SAY 'ISPF service LMGET failed for sequential dataset.',
                 ' Return code:' zrc_lmget'.'
             LEAVE member_loop
           END

      WHEN zrc_lmget = 8      /* End of sequential dataset, */
      THEN LEAVE record_loop  /* Add last member.           */

      OTHERWISE
           DO
             IF LEFT(record,2) = './'  /* End of member. */
             THEN LEAVE record_loop    /* Add member.    */

             "LMPUT DATAID("pdsid") MODE(INVAR) DATALOC(RECORD)",
                                    "DATALEN("length")"
             zrc = RC

             IF zrc \= 0
             THEN DO
                    SAY 'ISPF service LMPUT failed for PDS dataset.'
                        ' Return code:' zrc'.'
                    LEAVE member_loop
                  END
             ELSE record_count = record_count + 1
           END
      END /* SELECT */
   END record_loop

   PARSE VAR delimit,
             './' member zlvers '.' +1 zlmod +2,
                      19 zlcdate +8 28 zlmdate +8 37 zlmtime +5,
                      43 zlcnorc +5 49 zlinorc +5 55 zlmnorc +5,
                      61 zluser .

   "LMMADD  DATAID("pdsid") MEMBER("member") STATS(YES)"

   zrc = RC

   SELECT
   WHEN zrc = 0  /* ok */
   THEN NOP
   WHEN zrc = 4  /* duplicate membername */
   THEN DO
          "SETMSG MSG(MVS00NI) MSGLOC(dsnseq)"
          zrc = 0
        END
   WHEN zrc = 10 /* no file with data id */
   THEN zrc = 0
   WHEN zrc = 12 /* bad stats */
   THEN DO
          "LMMADD  DATAID("pdsid") MEMBER("member") STATS(NO)"
          zrc = RC
        END
   WHEN zrc = 14 /* no records written */
   THEN DO
          "SETMSG MSG(MVS00OI) MSGLOC(dsnpds)"
          zrc = 0
        END
   WHEN zrc = 16 /* variable error */
   THEN DO
          "LMMADD  DATAID("pdsid") MEMBER("member") STATS(NO)"
          zrc = RC
        END
   WHEN zrc = 20 /* severe error */
   THEN NOP
   OTHERWISE
        NOP
   END /* SELECT */

   IF zrc \= 0
   THEN DO
          "SETMSG MSG(MVS00MI) MSGLOC(dsnseq)"
          LEAVE members
        END


   delimit = record
END member_loop

/* */

SAY
SAY member_loop 'members processed.'
SAY record_count 'records written to PDS dataset.'

"LMCLOSE DATAID("pdsid")"

Free_Pds:
"LMFREE DATAID("pdsid")"

Close_Seq:
"LMCLOSE DATAID("seqid")"

Free_Seq:
"LMFREE DATAID("seqid")"

SAY 'All processing complete.'

EXIT 0