/* REXX ***************************************************************/
/* -------------------------------------------------------------------*/
/* Name:       SAVE                                                   */
/* Short       Double a dataset (PO / PS)                             */
/* Type:       REXX-Exec                                              */
/* Author:     Norbert Haas                                           */
/* Syntax:     SAVE (used in 3.4 in front of a DSN)                   */
/* Parameter:  none                                                   */
/* Remark:     Based on an idea of Dirk Melzig                        */
/*                                                                    */
/* Version Author        Date       Why                               */
/* ------- ------------- ---------- --------------------------------- */
/* V05.01  N.Haas        18.06.2003 english version                   */
/* V05.00  N.Haas        xx.01.2003 ...                               */
/* V04.00  N.Haas        xx.08.2001 ...                               */
/* V03.00  N.Haas        xx.05.2000 ...                               */
/* V02.00  N.Haas        xx.03.2000 ...                               */
/* V01.00  N.Haas        xx.11.1999 Creation                          */
/**********************************************************************/

/* Init --------------------------------------------------------------*/
TRUE = 1
FALSE = 0

PARSE UPPER ARG dsn_alt

/* Parm OK ? ---------------------------------------------------------*/
IF dsn_alt = '' THEN DO
   rc = DispMsg('Wrong use',,
                'This tool must be used in the datasetlist from',
                'PDF 3.4 or a DSN must be given as a parameter.',,
                TRUE)
   EXIT
END

/* Datasetname with or without >'< ? ---------------------------------*/
dsn_alt = STRIP(dsn_alt,"B","'")
dsn_neu = dsn_alt || '.SAVE'

"ISPEXEC ADDPOP"
adsn = dsn_alt

Display:
ndsn = dsn_neu
"ISPEXEC DISPLAY PANEL(SAVEP)"
IF rc = 8 THEN DO
   rc = DispMsg('Canceld by user',,
                'This action has been canceld by the user.',,
                FALSE)
   EXIT
END
dsn_neu = ndsn

IF LENGTH(dsn_neu) > 44 THEN DO
   rc = DispMsg('Error (length)',,
                'The new DSN will be to long (> 44 Char). Please',
                'take a different name for the dataset' dsn_neu'.',,
                TRUE)
   SIGNAL Display
END

"ISPEXEC REMPOP"
dsn_alt = "'"dsn_alt"'"
dsn_neu = "'"dsn_neu"'"

/* New DSN exists ? --------------------------------------------------*/
IF SYSDSN(dsn_neu) = 'OK' THEN DO
   rc = DispMsg('Error (already existing)',,
                'The new DSN' dsn_neu 'already exists.',,
                TRUE)
   EXIT
END

/* Create new dsn ----------------------------------------------------*/
"ALLOC NEW DATASET("dsn_neu") LIKE("dsn_alt") MGMTCLAS(TESTSTD)",
           "STORCLAS(STANDARD)"
alloc_rc = rc
IF alloc_rc > 0 THEN DO
   SAY 'ALLOC, RC =' rc
END

/* Copy (PO / PS) ----------------------------------------------------*/
dummy = LISTDSI(dsn_alt)
IF datopt = 1 THEN DO /* Create and copy */
   IF sysdsorg = 'PO' THEN DO
      member = ''
      "ISPEXEC LMINIT DATAID(dataid1) DATASET("dsn_alt") ENQ(SHR)"
      "ISPEXEC LMINIT DATAID(dataid2) DATASET("dsn_neu") ENQ(SHRW)"

      "ISPEXEC LMOPEN DATAID("dataid1") OPTION(INPUT)"

      "ISPEXEC LMMLIST DATAID("dataid1") OPTION(LIST) MEMBER(member)"

      DO WHILE rc = 0
         "ISPEXEC LMCOPY FROMID("dataid1") FROMMEM("member")",
                        "TODATAID("dataid2") TOMEM("member")",
                        "REPLACE"
         lmcopy_rc = rc
         IF lmcopy_rc > 0 THEN DO
            SAY 'LMCOPY, RC =' rc
         END
         "ISPEXEC LMMLIST DATAID("dataid1") OPTION(LIST) MEMBER(member)"
      END

      "ISPEXEC LMCLOSE DATAID("dataid1")"

      "ISPEXEC LMFREE DATAID("dataid2")"
      "ISPEXEC LMFREE DATAID("dataid1")"
   END
   ELSE DO
      IF sysdsorg = 'PS' THEN DO
         "ALLOC DD(SYSUT1)   DSN("dsn_alt") SHR REUSE"
         "ALLOC DD(SYSUT2)   DSN("dsn_neu") OLD REUSE"
         "ALLOC DD(SYSIN)    DUMMY REUSE"
         "ALLOC DD(SYSPRINT) DUMMY REUSE"

         "ISPEXEC SELECT PGM(IEBGENER)"
         iebgener_rc = rc
         IF iebgener_rc > 0 THEN DO
            SAY 'IEBGENER, RC =' rc
         END

         "FREE DD(SYSPRINT)"
         "FREE DD(SYSIN)"
         "FREE DD(SYSUT2)"
         "FREE DD(SYSUT1)"
      END
      ELSE DO
         rc = DispMsg('Wrong DSORG',,
                 'The DSORG of DSN' dsn_alt 'is not PO or PS.',
                 'SAVE only supports PO and PS datasets.',,
                      TRUE)
         CALL Delete_Again dsn_neu
         EXIT
      END
   END
END
ELSE DO
   IF datopt = 2 THEN DO /* Create and copy lines */
      IF vonzeil1 = "" | biszeil1 = "" THEN DO
         rc = DispMsg('Wrong Input',,
                      'If option 2 selected, "from line"',
                      'and "to line" must be filled out.',,
                      TRUE)
         CALL Delete_Again dsn_neu
         EXIT
      END
      ELSE DO
         IF sysdsorg = 'PS' THEN DO
            /* 1 */
            anzahl_zeilen = biszeil1 - vonzeil1 + 1
            "ALLOC DD(di) DSN("dsn_alt") SHR REUSE"
            "EXECIO" anzahl_zeilen "DISKR di" vonzeil1 "(FINIS STEM line.)"
            execio_rc = rc
            "FREE DD(di)"
            IF execio_rc /= 0 THEN DO
               rc = DispMsg('To less memory',,
                            'Unsufficioned memory to read the selected',
                            'lines.',,
                            TRUE)
               CALL Delete_Again dsn_neu
               EXIT
            END
            "ALLOC DD(do) DSN("dsn_neu") SHR REUSE"
            "EXECIO" anzahl_zeilen "DISKW do (FINIS STEM line.)"
            "FREE DD(do)"
            /* 2 */
            IF vonzeil2 /= "" & biszeil2 /= "" THEN DO
               anzahl_zeilen = biszeil2 - vonzeil2 + 1
               "ALLOC DD(di) DSN("dsn_alt") SHR REUSE"
               "EXECIO" anzahl_zeilen "DISKR di" vonzeil2 "(FINIS STEM line.)"
               execio_rc = rc
               "FREE DD(di)"
               IF execio_rc /= 0 THEN DO
                  rc = DispMsg('To less memory',,
                               'Unsufficioned memory to read the selected',
                               'lines.',,
                               TRUE)
                  CALL Delete_Again dsn_neu
                  EXIT
               END
               "ALLOC DD(do) DSN("dsn_neu") MOD REUSE"
               "EXECIO" anzahl_zeilen "DISKW do (FINIS STEM line.)"
               "FREE DD(do)"
            END
            /* 3 */
            IF vonzeil3 /= "" & biszeil3 /= "" THEN DO
               anzahl_zeilen = biszeil3 - vonzeil3 + 1
               "ALLOC DD(di) DSN("dsn_alt") SHR REUSE"
               "EXECIO" anzahl_zeilen "DISKR di" vonzeil3 "(FINIS STEM line.)"
               execio_rc = rc
               "FREE DD(di)"
               IF execio_rc /= 0 THEN DO
                  rc = DispMsg('To less memory',,
                               'Unsufficioned memory to read the selected',
                               'lines.',,
                               TRUE)
                  CALL Delete_Again dsn_neu
                  EXIT
               END
               "ALLOC DD(do) DSN("dsn_neu") MOD REUSE"
               "EXECIO" anzahl_zeilen "DISKW do (FINIS STEM line.)"
               "FREE DD(do)"
            END
         END
         ELSE DO
            rc = DispMsg('Wrong DSORG',,
                        'If option 2 selected, the DSORG must be PS.',,
                         TRUE)
            CALL Delete_Again dsn_neu
            EXIT
         END
      END
   END
END

/* ... uns Tschuess --------------------------------------------------*/
"FREE DATASET("dsn_neu")"
EXIT

/* ================================================================== */

Delete_Again: PROCEDURE
   PARSE ARG dsn_del
   dummy = MSG('OFF')
   "DELETE" dsn_del
   dummy = MSG('ON')
RETURN