         PROC 1 DSN PR() TO() US() PW()
         /*************************************************************/
         /*                                                           */
         /*  CLIST:    PUTDOC Version 5.21                            */
         /*                                                           */
         /*  VERSION:  5.21 04/24/08 - See $CB for details            */
         /*            5.2  11/06/07 - See $CA for details            */
         /*            5.11 05/14/07 - See $C9 $C91 $C92 for details  */
         /*            5    04/05/07 - 13-char PMR naming convention  */
         /*            4    09/25/06 - Testcase server directory      */
         /*                            names update; large files      */
         /*                            split handling.                */
         /*            3    09/05/03 - EMEA Repository.               */
         /*            2    04/23/02 - Data Encryption.               */
         /*            1    11/28/00 - INITIAL VERSION.               */
         /*                                                           */
         /*  FUNCTION: Send a file to the testcase server             */
         /*                                                           */
         /*  TOTAL LINE COUNT: 5680                                   */
         /*                                                           */
         /*  SUPPORTED TYPES:  Binary                                 */
         /*                    Tersed     (will terse if needed)      */
         /*                    Text       (may translate to Ascii)    */
         /*                    TSO XMIT   (will convert - file format */
         /*                                only, transmit is FTP)     */
         /*                                                           */
         /*  PARAMETERS:                                              */
         /*                                                           */
         /*  DSN  -  required  -  input data set name                 */
         /*  PR() -  optional  -  pmr number                          */
         /*  TO() -  optional  -  remote host nickname                */
         /*                                                           */
         /*  Non-testcase destinations may also use:                  */
         /*                                                           */
         /*  PW() -  optional  -  password for remote userid          */
         /*  US() -  optional  -  userid on remote host               */
         /*                                                           */
         /*  See HELP text for more information.                      */
         /*                                                           */
         /*  FEATURES:  Will terse or convert to TSO XMIT Format      */
         /*             any seq file.  Will split very large files    */
         /*             (tersed only) into parts.  Installation-      */
         /*             dependent variables can be set at the end     */
         /*             in the CUSTOM section.                        */
         /*                                                           */
         /*             Will encrypt tersed data before transmit      */
         /*             using a generated key, a user-supplied key,   */
         /*             or a combination.  Encryption software        */
         /*             location and instructions are below.      @B1A*/
         /*                                                           */
         /*             Designed to be run from the 3.4 panel in      */
         /*             ISPF, but does not require ISPF services      */
         /*             to be run.                                    */
         /*                                                           */
         /*             PUTDOC supports sequential and partitioned    */
         /*             MVS data sets, as well as hfs data sets by    */
         /*             copying them to an MVS data set.  The file    */
         /*             may be tersed (with TRSMAIN), in TSO XMIT     */
         /*             output format, or split into parts prior      */
         /*             to the invocation of PUTDOC.                  */
         /*                                                           */
         /*             PUTDOC also provides support for PDSE         */
         /*             libraries.  Members that are generated by the */
         /*             binder may not be sent in a group.  They must */
         /*             be sent individually because they cannot be   */
         /*             copied to a PDS to enable other options.  @C2A*/
         /*                                                           */
         /*             Multiple input parts must be named with a last*/
         /*             qualifier of PnOFm.  Up to nine (9) parts     */
         /*             may be processed.  PUTDOC reunites them       */
         /*             into one output data set (and optionally      */
         /*             splits them again after tersing the output).  */
         /*             There must be sufficient disk space on the    */
         /*             system to hold the united parts or a tersed   */
         /*             copy.                                         */
         /*                                                           */
         /*             PUTDOC's primary purpose is to send files     */
         /*             to the testcase server at IBM.  It can        */
         /*             be used to transmit to other locations but    */
         /*             results may vary.  PUTDOC _does_ attempt to   */
         /*             send the correct information to an MVS host.  */
         /*             It also supports the international EMEA       */
         /*             repository - see the HELP text.               */
         /*                                                           */
         /*                                                           */
         /*  Copyright IBM Corporation 2001.  All Rights Reserved     */
         /*                                                           */
         /*  This sftware is provided AS IS.                         */
         /*                                                           */
         /*  Permission to use, copy and modify this software for any */
         /*  purpose and without fee is hereby granted, provided that */
         /*  the above copyright notice appear in all copies and that */
         /*  the name of IBM not be used in advertising or publicity  */
         /*  pertaining to distribution of the software without       */
         /*  specific written permission.                             */
         /*                                                           */
         /*  IBM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS         */
         /*  SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF            */
         /*  MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL IBM      */
         /*  BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL     */
         /*  DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING              */
         /*  FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN         */
         /*  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS         */
         /*  ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE     */
         /*  OR PERFORMANCE OF THIS SOFTWARE.                         */
         /*                                                           */
         /*                                                           */
         /*  ACTIVITY:                                                */
         /*                                                           */
         /* Flag Reason  Date   Org   Description                     */
         /* ---- ------- ------ ---   ------------------------------- */
         /* $  = Deploy  020211 BHR : Remove all ^ symbols            */
         /* $AL= Deploy  020318 BHR : Chg #${ to @ for testcase       */
         /*                           Delete keystroke on pmr entry   */
         /*                           Remove testing flags            */
         /* $  = Deploy  020320 BHR : Remove CLRSCRN from HELP        */
         /* $  = Deploy  020325 BHR : Add alternate testcase name     */
         /* $AM= Deploy  020417 BHR : Correct HFS copy DSATTR         */
         /* $B1= V2      020423 BHR : Add encryption                  */
         /*                           Keep log if append fails        */
         /*                           Better handling of long names   */
         /*                           Limit core for DB2 to 28 chars  */
         /*                           Refine terse calculations       */
         /*                           Align JCL stream (not flagged)  */
         /* $B2= V2      020515 BHR : Clarify non-mvs host            */
         /* $B3= V2      020524 BHR : Enhance logging                 */
         /* $B4= V2      020531 BHR : Prevent double delete work d/s  */
         /* $B5= V2      020607 BHR : Allow prompt for TCUSER, TCPASS */
         /*                           and TCMORE                      */
         /* $B6= V2      020611 BHR : Substitution in JCL '/*' cards  */
         /* $B7= V2      020729 BHR : Add 2 signon lines (MOREn)      */
         /* $B8= V2      020806 BHR : Handle negative remainder       */
         /* $  = V2      020814 BHR : Correct help text               */
         /* $B9= V2      020914 BHR : Upper case MVS directory        */
         /* $  = V2      020918 BHR : Add header comment about %      */
         /* $  = V2      020924 BHR : Change encryption URL           */
         /* $BA= V2      021213 BHR : Split tersed files evenly       */
         /*                           Change XMIT file name           */
         /*                           Use SPACK for 4G+ raw data sets */
         /* $BB= V2      030320 BHR : Customize FTP timeout value     */
         /* $C1= V3      030905 BHR : Support EMEA repository         */
         /*                           Validate member with wildcards  */
         /*                           Improve presentation            */
         /*                           Release space from copy PDS     */
         /*                           Log correct size of copy PDS    */
         /* $C2= V3      031014 BHR : Support PDSE                    */
         /* $C3= V3      040604 AJN : Remove this symbol ^ since it   */
         /*                           does not make the round-trip    */
         /*                           through some ASCII hosts.       */
         /* $C4= V4      092506 AJN : The SET &&BLKS statement needs  */
         /*                           to come after the adjustment of */
         /*                           &SYSUSED based on &SYSUNITS.    */
         /*                           Matters a lot when deciding how */
         /*                           to apportion the output when    */
         /*                           splitting large files. (BHR)    */
         /* $C5= V4      092506 AJN : Testcase directory name changes */
         /*                           (mid-Sept thru mid-Oct 2006),   */
         /*                           e.g. from s390/toibm/vtam to    */
         /*                           toibm/mvs                       */
         /* $C6= V4      022307 AJN : The /[fromibm|toibm]/db2 dir    */
         /*                           has been replaced with          */
         /*                           /[fromibm|toibm]/im             */
         /* $C7= V4      032107 AJN : VTAM using the EMEA repository  */
         /* $C8= V5      040507 AJN : 13-PMR naming convention        */
         /* $C9= V5.1    042507 AJN : The option for a subdirectory   */
         /*                           removed (per Bill Spencer)      */
         /* $C91=V5.1    050707 AJN : Remove original DSName in the   */
         /*                           file name placed on the server, */
         /*                           using the new 13-PMR naming     */
         /*                           convention. Also Tnn no longer  */
         /*                           includes in the file name (per  */
         /*                           Bill Spencer).                  */
         /* $C92=V5.11   051407 AJN : Remove the name string for data */
         /*                           on EMEA repository; the naming  */
         /*                           conversion corrected.           */
         /* $C93=V5.12   100407 WES : Set 40 char check for           */
         /*                           intermediate dsn length for     */
         /*                           ecurep.                         */
         /* $C94=V5.13   103107 WES : Change default of               */
         /*                           testcase.software.ibm.com to    */
         /*                           testcase.boulder.ibm.com        */
         /* $CA= V5.2    110707 MJF : Revise MVS name to always be a  */
         /*                           Valid MVS DS name - no all num  */
         /*                           Qualifiers - toolreq 7115       */
         /* $CB= V5.21   042408 MJF : Split Free FI(LOGIN,LGOUT) to 2 */
         /*                           statements In case first fails  */
         /*************************************************************/
         /* Note: Using a CLRSCRN or similar function can interfere   */
         /*       with proper operation of the CLIST under ISPF when  */
         /*       the CLIST is invoked using extended implicit        */
         /*       notation (%PUTDOC).  Simply put, invoke PUTDOC      */
         /*       without using % for best results.                   */
         /*************************************************************/
         /*  Look on this server for usage tips and updates to PUTDOC:*/
         /*     http://techsupport.services.ibm.com/server/           */
         /*               nav/zSeries/putdoc/putdoc.html              */
         /*************************************************************/
         /* Look on this server for encryption sofware:               */
         /* http://www-5.ibm.com/de/support/ecurep/mvs_encryption.html*/
         /*************************************************************/
         CONTROL  NOLIST END(ENDO) NOFLUSH ASIS
         SET &SYSOUTTRAP = 9999
         SET &PMR = &STR(&PR)
         SET &USERID = &STR(&US)
         SET &PASSWD = &STR(&PW)
         SET &DEST = &STR(&TO)
         SET &RP = )
         SET &LP = &SUBSTR(3:3,&NRSTR(DD(DD))                  /* @BAA*/
         GOTO CUSTOM
         /*************************************************************/
         /* Set up disposition constants.                             */
         /*************************************************************/
CUSTOMD: SET &MIGTXT0 = &STR(No Change)
         SET &MIGTXT1 = &STR(Migrate to Level 1 (unless PDS))
         SET &MIGTXT2 = &STR(Migrate to Level 2 (unless PDS))
         SET &MIGTXT99 = &STR(Delete)
         SET &MIGTXTO = &&MIGTXT&MIGORIG
         SET &MIGTXTW = &&MIGTXT&MIGWORK
         IF &MIGTXTO = &STR() THEN +
           SET &MIGTXTO = &STR(>>> disposition unknown <<<)
         IF &MIGTXTW = &STR() THEN +
           SET &MIGTXTW = &STR(>>> disposition unknown <<<)
         /*************************************************************/
         /* Check for any problems in the customization section.      */
         /*************************************************************/
         IF &STR(&OWNERID) = &STR() THEN +
           SET &OWNERID = &STR(&SYSUID)
         /*************************************************************/
         /* Allow some things to be dropped without complaining.      */
         /* If something is wrong, send a warning.                    */
         /*************************************************************/
         IF &STR(&WKUNIT) = &STR() THEN +
           SET &WKUNIT = &STR(SYSDA)
         IF &DATATYPE(&MAXVOLS) = &STR(NUM) THEN DO
           IF &MAXVOLS < 1 OR &MAXVOLS > 59 THEN DO
             SEND '>> PUTDOC <<  MAXVOLS(&MAXVOLS) is out of range' +
               USER(&OWNERID) LOGON
             SET &MAXVOLS = 10
           ENDO
         ENDO
         ELSE DO
           IF &STR(&MAXVOLS) NE &STR() THEN +
             SEND '>> PUTDOC <<  MAXVOLS(&STR(&MAXVOLS)) is invalid' +
               USER(&OWNERID) LOGON
           SET &MAXVOLS = 10
         ENDO
         IF &DATATYPE(&MAXCYLS) = &STR(NUM) THEN DO
           IF &MAXCYLS < 1 OR &MAXCYLS > 3000 THEN DO
             SEND '>> PUTDOC <<  MAXCYLS(&MAXCYLS) is out of range' +
               USER(&OWNERID) LOGON
             SET &MAXCYLS = 900
           ENDO
           SET &MAXVOLTH1 = (&MAXCYLS * 2) / 3                 /* @BAA*/
           SET &MAXVOLTH2 = &MAXCYLS / 2                       /* @BAA*/
         ENDO
         ELSE DO
           IF &STR(&MAXCYLS) NE &STR() THEN +
             SEND '>> PUTDOC <<  MAXCYLS(&STR(&MAXCYLS)) is invalid' +
               USER(&OWNERID) LOGON
           SET &MAXCYLS = 900
         ENDO
         IF &SPLTSIZE > &MAX2G THEN DO
           SEND '>> PUTDOC <<  SPLTSIZE is larger than &MAX2G' +
             USER(&OWNERID) LOGON
           SET &SPLTSIZE = &MAX2G
         ENDO
         SET &MAXKBYT = 810 * &MAXCYLS * &MAXVOLS
         IF &MAXKBYT < &SPLTSIZE THEN DO
           SEND '>> PUTDOC <<  SPLTSIZE(&SPLTSIZE) is larger than ' +
                MAXVOLS x MAXCYLS x 810 Kb ' +
             USER(&OWNERID) LOGON
           SEND '>> PUTDOC <<  MAXVOLS(&MAXVOLS) x MAXCYLS(&MAXCYLS) +
                x 810 = &MAXKBYT' +
             USER(&OWNERID) LOGON
           SET &SPLTSIZE = &MAXKBYT
         ENDO
         IF &STR(&OUTHLQ) = &STR() THEN DO
           SET &OUTHLQ = &STR(&SYSUID)
         ENDO
         IF &DATATYPE(&BUFNO) = &STR(NUM) THEN DO
           IF &BUFNO < 1 OR &BUFNO > 200 THEN DO
             SEND '>> PUTDOC <<  BUFNO(&BUFNO) is out of range' +
               USER(&OWNERID) LOGON
             SET &BUFNO = 10
           ENDO
         ENDO
         ELSE DO
           IF &STR(&BUFNO) NE &STR() THEN +
             SEND '>> PUTDOC <<  BUFNO(&STR(&BUFNO)) is invalid' +
               USER(&OWNERID) LOGON
           SET &BUFNO = 10
         ENDO
         /*************************************************************/
         /* Display HELP output.                                      */
         /*************************************************************/
         IF &STR(&DSN) = &STR(HELP) THEN DO
           WRITE *******************************************************
           WRITE *                                                     *
           WRITE * FUNCTION: Send a file to the testcase server        *
           WRITE *                                                     *
           WRITE * PUTDOC Parameters:                                  *
           WRITE *                                                     *
           WRITE *     1 required positional parameter:                *
           WRITE *                                                     *
           WRITE *         input data set name                         *
           WRITE *                                                     *
           WRITE *         Fully qualified, with or without quotes.    *
           WRITE *         The high level qualifier is removed to      *
           WRITE *         generate the base of the name of the        *
           WRITE *         file created on the testcase server.        *
           WRITE *                                                     *
           WRITE *         Please see "Support for multi-part data     *
           WRITE *         sets" for information on handling large     *
           WRITE *         and/or fragmented files.                    *
           WRITE *                                                     *
           WRITE *         HELP may be entered in place of this        *
           WRITE *         parameter to generate this display.         *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Other parameters:                               *
           WRITE *                                                     *
           WRITE *     ==> pmr number (or other identifying string)    *
           WRITE *                                                     *
           WRITE *         The pmr number or other identifying         *
           WRITE *         string may be specified at invocation       *
           WRITE *         using the PR() parameter.  Otherwise        *
           WRITE *         the CLIST will prompt for it.  Anything     *
           WRITE *         specified at invocation is converted to     *
           WRITE *         lowercase.                                  *
           WRITE *                                                     *
           WRITE *         ex: PR(ppppp.bbb.ccc)                       *
           WRITE *                                                     *
           WRITE *         The passed pmr number can be any length but *
           WRITE *         is generally 13 Chars in the above format:  *
           WRITE *                                                     *
           WRITE *           ppppp is the 5-char PMR number, eg: 34143 *
           WRITE *           bbb   is the 3-char branch, eg: 055       *
           WRITE *           ccc   is the 3-char country code, eg: 724 *
           WRITE *                                                     *
           WRITE *         This is used to name the target sub         *
           WRITE *         directory on the testcase server or to      *
           WRITE *         insert in the filename on testcase.  If the *
           WRITE *         host is testcase, a pmr number is required. *
           WRITE *                                                     *
           WRITE *         Established nicknames may include a         *
           WRITE *         sub directory vs insert designation - if    *
           WRITE *         not, the CLIST will prompt for it.          *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     ==> destination                                 *
           WRITE *                                                     *
           WRITE *         The destination is the target path on       *
           WRITE *         the testcase server or another fully        *
           WRITE *         specified host/pathname.  It may be         *
           WRITE *         specified at invocation using one of the    *
           WRITE *         defined nicknames or the CLIST will         *
           WRITE *         prompt for it.                              *
           WRITE *                                                     *
           WRITE *           ex: TO(cics)  (on command line)           *
           WRITE *                                                     *
           WRITE *         TO() accepts only a nickname.  The prompt   *
           WRITE *         allows the user to select from a list or    *
           WRITE *         enter an alternative destination.           *
           WRITE *                                                     *
           WRITE *         If no destination is specified either at    *
           WRITE *         invocation or at the prompt, no files will  *
           WRITE *         be sent.  This is useful if you wish only   *
           WRITE *         to create the intermediate MVS files for    *
           WRITE *         TERSE and XMIT.                             *
           WRITE *                                                     *
           WRITE *         An alternative fully-qualified destination  *
           WRITE *         host/pathname may be entered.  If the       *
           WRITE *         destination begins with '/', it is treated  *
           WRITE *         as a path on the testcase server.  Paths    *
           WRITE *         on testcase are displayed that way.         *
           WRITE *                                                     *
           WRITE *         If the target path requires a slash (as in  *
           WRITE *         an hfs directory on an MVS host), enter     *
           WRITE *         the slash after the 'host/' :               *
           WRITE *                                                     *
           WRITE *           ex: my.host.name//u/userxx                *
           WRITE *                                                     *
           WRITE *         or enter only the host and wait for the     *
           WRITE *         CLIST to prompt for the target directory.   *
           WRITE *         If you designate (via prompt) the remote    *
           WRITE *         host as MVS, you may press enter at the     *
           WRITE *         prompt to accept 'userid' as the directory. *
           WRITE *                                                     *
           WRITE *                                                     *
           WRITE *  #  Nickname  Host/Path                             *
           WRITE *  =  ========  =========                             *
           DO &P = 1 TO &NICKMAX
             SET &NICK = &&NICK&P
             SET &NICKLC = &SYSLC(&NICK)
             IF &STR(&NICKLC) NE &STR(dummy) AND +
                &STR(&NICK) NE &STR() THEN DO
               SET &LN = &LENGTH(&STR(&NICK))
               SET &NICK = &STR(&NICK+
                 &SUBSTR(1:9-&LENGTH(&STR(&NICK)),&STR(         )))
               SET &PATH = &&PATH&P
               SET &HOST = &&HOST&P
               IF &STR(&HOST) = &STR(TESTCASE) THEN SET &HOST = &STR()
               SET &LN = &LENGTH(&STR(&HOST/&PATH)
               IF &LN < 37 THEN +
                 SET &FILL = &SUBSTR(1:37-&LN,+
                 &STR(                                      ))
               ELSE +
                 SET &FILL = &STR()
               IF &LENGTH(&STR(&P)) < 2 THEN +
                 SET &P = &STR( &P)
               WRITE * &P  &NICK  &HOST/&PATH.&FILL*
             ENDO
           ENDO
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     ==> userid and password                         *
           WRITE *                                                     *
           WRITE *         Userid and password may be specified in     *
           WRITE *         the following ways:                         *
           WRITE *                                                     *
           WRITE *           invocation -- the US() and PW() keywords  *
           WRITE *                         may be used at invocation   *
           WRITE *                         if the destination is not   *
           WRITE *                         testcase (the values are    *
           WRITE *                         always in uppercase).       *
           WRITE *                                                     *
           WRITE *           predefined -- userid and password may     *
           WRITE *                         be coded for each host      *
           WRITE *                         in the CUSTOM section or in *
           WRITE *                         a PUTDOC profile data set   *
           WRITE *                                                     *
           WRITE *           prompt     -- the CLIST will prompt for   *
           WRITE *                         userid and password if      *
           WRITE *                         not set at invocation or    *
           WRITE *                         predefined.                 *
           WRITE *                                                     *
           WRITE *         A userid and password are required for      *
           WRITE *         access to all remote systems, including     *
           WRITE *         the testcase server.  In the case of the    *
           WRITE *         testcase server, the userid is 'anonymous'  *
           WRITE *         and the password is an email address.       *
           WRITE *                                                     *
           WRITE *         To force an override of a predefined        *
           WRITE *         userid/password connected to a non-testcase *
           WRITE *         destination nickname, at least US(userid)   *
           WRITE *         must be specified on the command line.      *
           WRITE *                                                     *
           WRITE *         The userid specified must have write access *
           WRITE *         to the target directory.                    *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     ==> type of transfer                            *
           WRITE *                                                     *
           WRITE *         The CLIST will attempt to determine the     *
           WRITE *         type of file being transferred and may      *
           WRITE *         recommend a type to use.  The user is       *
           WRITE *         asked to confirm the choice.                *
           WRITE *                                                     *
           WRITE *                                                     *
           WRITE *         Binary file - see TRS and XMT for TRSMAIN   *
           WRITE *                       tersed and TSO XMIT files     *
           WRITE *                                                     *
           WRITE *               > Use for binary data that cannot     *
           WRITE *                 be translated to ASCII and that     *
           WRITE *                 does not need to be terse or XMIT   *
           WRITE *                                                     *
           WRITE *                                                     *
           WRITE *         Text file - displayable data                *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *         Terse file - file is tersed or needs to be  *
           WRITE *               tersed - the CLIST will determine     *
           WRITE *               which and verify before transmitting  *
           WRITE *                                                     *
           WRITE *               > Use for all large files             *
           WRITE *               > Use for files with variable records *
           WRITE *               > If the tersed file is too large     *
           WRITE *                 to transmit, it will be split into  *
           WRITE *                 parts before transmission.          *
           WRITE *               > Tersed files may be encrypted       *
           WRITE *                                                     *
           WRITE *                                                     *
           WRITE *         TSO XMIT - file is a TSO XMIT output file   *
           WRITE *               or needs conversion to one - PUTDOC   *
           WRITE *               will verify which before transfer     *
           WRITE *                                                     *
           WRITE *               > Use for files with variable records *
           WRITE *               > TSO XMIT is only the file format,   *
           WRITE *                 it is not the mode of transmission. *
           WRITE *                 All files are transmitted using FTP.*
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Encrypting the output file:                     *
           WRITE *                                                     *
           WRITE *     Data set encryption, using the C/C++ encrypt()  *
           WRITE *     facility, is available for all sequential files,*
           WRITE *     including individual PDS members.  The file     *
           WRITE *     must be tersed or selected to be tersed using   *
           WRITE *     TRSMAIN before encryption can be done.          *
           WRITE *                                                     *
           WRITE *     If PUTDOC is configured to perform encryption,  *
           WRITE *     any data set that is already tersed, or is      *
           WRITE *     selected to be tersed, or is a tersed fragment, *
           WRITE *     is eligible to be encrypted.  The tool will     *
           WRITE *     ask whether the file should be encrypted.       *
           WRITE *                                                     *
           WRITE *     You will be prompted for 0 to 8 positions of    *
           WRITE *     the encryption key.  Some or all of your input  *
           WRITE *     (if any) is folded into the key fields with     *
           WRITE *     the generated fields.  If you enter 8 valid     *
           WRITE *     characters, that key will be used.  Any EBCDIC  *
           WRITE *     character is accepted except for single or      *
           WRITE *     double quotes, forward or backward slashes,     *
           WRITE *     and ampersand (' " / \ &STR(&&)).+
                 &STR(                      *)
           WRITE *                                                     *
           WRITE *     The final key used to encrypt the file will     *
           WRITE *     print in the PUTDOC log.  It is placed there    *
           WRITE *     for reference because the actual key contents   *
           WRITE *     cannot be reliably predicted.  The key also     *
           WRITE *     prints in the job output.  Ensure that both     *
           WRITE *     the log file and the job output are secured.    *
           WRITE *                                                     *
           WRITE *     Report the key contents to the support team     *
           WRITE *     who is handling your request so that they are   *
           WRITE *     able to decipher the data.  For security        *
           WRITE *     reasons, please do not place the encryption     *
           WRITE *     key on the Testcase server.  The best method    *
           WRITE *     of delivering the key contents is by telephone  *
           WRITE *     or by placing an update in the problem record.  *
           WRITE *                                                     *
           WRITE *     The encryption process creates an additional    *
           WRITE *     work data set on the local host.  Its           *
           WRITE *     disposition will be the same as that designated *
           WRITE *     for all work data sets.                         *
           WRITE *                                                     *
           WRITE *     To enable encryption, the programs found on     *
           WRITE *     the following server must be installed:         *
           WRITE *                                                     *
           WRITE *     ftp://ftp.emea.ibm.com/fromibm/s390/mvs/tools/  *
           WRITE *     ftp://ftp.emea.ibm.com/fromibm/mvs/tools/  @C5M *
           WRITE *                                                     *
           WRITE *     Update the ENCPROGM and, if needed, the         *
           WRITE *     ENCSTEPL parameters in the CUSTOM section to    *
           WRITE *     indicate the name and location of the load      *
           WRITE *     module to use.  PUTDOC will not attempt         *
           WRITE *     encryption until ENCPROGM is set to either      *
           WRITE *     FTPENCR or FTPENCRD.                            *
           WRITE *                                                     *
           WRITE *     The run-time of the batch job when encryption   *
           WRITE *     is in use is about double that of processing    *
           WRITE *     the same file without encryption.               *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *

           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Support for hfs files:                          *
           WRITE *                                                     *
           WRITE *     Files in the hfs (Hierarchical File System)     *
           WRITE *     on an OS/390 platform may be sent with PUTDOC.  *
           WRITE *     To do so, specify a preexisting but empty MVS   *
           WRITE *     data set name, or a non-existent MVS data set   *
           WRITE *     name or PDS member as the source for PUTDOC.    *
           WRITE *                                                     *
           WRITE *     You will be given the option of a BINARY or     *
           WRITE *     TEXT copy (via OGET) to the MVS file.  If the   *
           WRITE *     file did not exist, OGET will create it and     *
           WRITE *     determine its attributes.  Otherwise, the       *
           WRITE *     attributes used will be those of the existing   *
           WRITE *     output MVS data set or PDS.                     *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Support for partitioned data sets:              *
           WRITE *                                                     *
           WRITE *     A partitioned data set and optional member(s)   *
           WRITE *     may be used as input to PUTDOC. Valid forms:    *
           WRITE *                                                     *
           WRITE *     'my.pds'                'my.pds(member)'        *
           WRITE *     'my.pds(*)'             'my.pds(mem*)'          *
           WRITE *                                                     *
           WRITE *     If form 'my.pds' is used (as when PUTDOC is     *
           WRITE *     invoked from the 3.4 panel in ISPF) the CLIST   *
           WRITE *     will prompt for the specification of member.    *
           WRITE *                                                     *
           WRITE *     If multiple (or all) members of a PDS are       *
           WRITE *     specified and the destination is Testcase, the  *
           WRITE *     TERSE option is not available.                  *
           WRITE *                                                     *
           WRITE *     If multiple (but not all) members of a PDS      *
           WRITE *     are specified with a type of XMIT, the matching *
           WRITE *     members are first copied to a work PDS and then *
           WRITE *     that PDS is converted to TSO TRANSMIT format.   *
           WRITE *     Note that TSO TRANSMIT is only the file format, *
           WRITE *     not the transmission mode.  All files are       *
           WRITE *     transmitted using FTP.                          *
           WRITE *                                                     *
/* @C2A*/  WRITE *     PDSE libraries are supported but members that   *
/* @C2A*/  WRITE *     were generated by the binder may not be sent in *
/* @C2A*/  WRITE *     a group.  Binder-generated members cannot be    *
/* @C2A*/  WRITE *     copied to the intermediate PDS for TSO TRANSMIT *
/* @C2A*/  WRITE *     format and a PDSE cannot be tersed.  Binder     *
/* @C2A*/  WRITE *     member names must be entered individually.      *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Support for multi-part data sets:               *
           WRITE *                                                     *
           WRITE *     Files that are very large can be tersed and     *
           WRITE *     then split into parts by PUTDOC.  That happens  *
           WRITE *     automatically based on your SPLTSIZE setting    *
           WRITE *     in the CUSTOM section.  The output files are    *
           WRITE *     placed on the target system with a suffix of    *
           WRITE *     PnOFm to indicate they are file fragments.      *
           WRITE *                                                     *
           WRITE *     If an untersed INPUT data set is fragmented,    *
           WRITE *     or tersed fragments must be re-sent,            *
           WRITE *     PUTDOC will automatically process them with     *
           WRITE *     some restrictions:                              *
           WRITE *                                                     *
           WRITE *     Fragmented untersed INPUT data set:             *
           WRITE *                                                     *
           WRITE *     > All of the parts must be named identically    *
           WRITE *       except for their last-level qualifier, which  *
           WRITE *       must be in the form PnOFm (n starts at 1).    *
           WRITE *                                                     *
           WRITE *     > Do NOT terse the individual parts of the      *
           WRITE *       data set.  PUTDOC will take care of that.     *
           WRITE *                                                     *
           WRITE *     > A maximum of nine (9) parts is allowed. All   *
           WRITE *       files within the range (m) must be found.     *
           WRITE *                                                     *
           WRITE *     > The data set attributes of all the data sets  *
           WRITE *       must be identical.                            *
           WRITE *                                                     *
           WRITE *     > If PUTDOC is issued against any member of a   *
           WRITE *       group of fragments of an untersed INPUT       *
           WRITE *       data set, the entire group of data sets       *
           WRITE *       is processed and sent.                        *
           WRITE *                                                     *
           WRITE *     > If the aggregate input file is of sufficient  *
           WRITE *       size, the tersed copy will be split into      *
           WRITE *       TERSED FRAGMENTS (see below) before sending.  *
           WRITE *       These fragments will have different names     *
           WRITE *       from the input fragments.                     *
           WRITE *                                                     *
           WRITE *     > If the aggregate input is not large enough to *
           WRITE *       force a terse and split, you may choose to    *
           WRITE *       send it using the TSO TRANSMIT format.  The   *
           WRITE *       file is transmitted using FTP, but is first   *
           WRITE *       converted to TSO TRANSMIT output format.      *
           WRITE *                                                     *
           WRITE *                                                     *
           WRITE *     TERSED FRAGMENTS:                               *
           WRITE *                                                     *
           WRITE *     > If the fragments are already tersed, the      *
           WRITE *       file ** must ** have been tersed before it    *
           WRITE *       was split.  If you have an untersed file      *
           WRITE *       in fragments, let PUTDOC terse and send it -  *
           WRITE *       DO NOT terse the fragments first.             *
           WRITE *                                                     *
           WRITE *     > PUTDOC produces tersed fragments when it      *
           WRITE *       splits a file (see SPLTSIZE).  If any of      *
           WRITE *       the fragments fails to be transmitted, it     *
           WRITE *       can be re-sent this way.                      *
           WRITE *                                                     *
           WRITE *     > A maximum of nine (9) parts is allowed.       *
           WRITE *                                                     *
           WRITE *     > Data sets must contain TRSMAIN output.        *
           WRITE *                                                     *
           WRITE *     > Issue PUTDOC for each TERSED FRAGMENT you     *
           WRITE *       wish to send.  The order of submission is     *
           WRITE *       not significant - they will be reassembled    *
           WRITE *       using their PnOFm qualifier.                  *
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *     International EMEA Repository:                  *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *     The EMEA repository is an HFS host that is      *
/* @C1A*/  WRITE *     used by international customers.  It is *not*   *
/* @C1A*/  WRITE *     commonly used by domestic customers and should  *
/* @C1A*/  WRITE *     not be used unless you have been instructed to  *
/* @C1A*/  WRITE *     place documentation there.                      *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  The CLIST will prompt for a userid and     *
/* @C1A*/  WRITE *          password or they may be specified on the   *
/* @C1A*/  WRITE *          command line using US() and PW().  They    *
/* @C1A*/  WRITE *          may also be included in a user's PROFILE   *
/* @C1A*/  WRITE *          data set or hardcoded in the nickname for  *
/* @C1A*/  WRITE *          EMEA (not recommended).                    *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  Branch Office (General Services #) and     *
/* @C1A*/  WRITE *          Country code are hardcoded in the CUSTOM   *
/* @C1A*/  WRITE *          section of the CLIST (see EMB and EMC      *
/* @C1A*/  WRITE *          parameters).  These may be overridden via  *
/* @C1A*/  WRITE *          a user's PROFILE data set.                 *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  The EMEA hostname is kept in the EMHOSTN   *
/* @C1A*/  WRITE *          parameter in the CUSTOM section.           *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  The default EMEA directory (toibm/mvs) is  *
/* @C1A*/  WRITE *          kept in the PATH parameter of the EMEA     *
/* @C1A*/  WRITE *          nickname.                                  *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  The EMEA nickname (a sample is provided)   *
/* @C1A*/  WRITE *          can be moved in the list.  This is the     *
/* @C1A*/  WRITE *          original sample:                           *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/ WRITE *             SET NICK8 = &&STR(EMEA)                  *
/* @C1A*/  WRITE *             SET HOST8 = &&STR(&EMHOSTN)      *
/* @C1A*/ WRITE *             SET MVSF8 = &&STR(N)                     *
/* @C1A*/ WRITE *             SET USER8 = &&STR(anonymous)             *
/* @C1A*/ WRITE *             SET PASS8 = &&STR()                      *
/* @C1A*/ WRITE *             SET MORE8 = &&STR(NONE)                  *
/* @C1A*/ WRITE *             SET MOR28 = &&STR(NONE)                  *
/* @C1A*/ WRITE *             SET MOR38 = &&STR(NONE)                  *
/* @C1A*/ WRITE *             SET PATH8 = &&STR(toibm/mvs)             *
/* @C1A*/ WRITE *             SET PMRD8 = &&STR(I)                     *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  Only tersed (or tersed and encrypted)      *
/* @C1A*/  WRITE *          data types are accepted.                   *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  The EMEA repository (unlike Testcase) will *
/* @C1A*/  WRITE *          accept a tersed PDS, but the user must     *
/* @C1A*/  WRITE *          inform the EMEA support representative     *
/* @C1A*/  WRITE *          that the transmitted data set contains     *
/* @C1A*/  WRITE *          a PDS.                                     *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *     Naming conventions:                             *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  Default PATH is toibm/mvs                  *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  Data sets are named                        *
/* @C1A*/  WRITE *            nnnnn.bbb.ccc.**(.PDS).type(.PnOFm)      *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *          Where:                                     *
/* @C1A*/  WRITE *            nnnnn is the 5-digit pmr number          *
/* @C1A*/  WRITE *            bbb is the Branch or General Services #  *
/* @C1A*/  WRITE *            ccc is the Country code                  *
/* @C1A*/  WRITE *            ** is your choice                        *
/* @C1A*/  WRITE *            PDS indicates a tersed PDS               *
/* @C1A*/  WRITE *            type is one of the following:            *
/* @C1A*/  WRITE *               TRS   - tersed file                   *
/* @C1A*/  WRITE *               CRY   - non-DES encrypted             *
/* @C1A*/  WRITE *               CRY64 - 64-bit DES encrypted          *
/* @C1A*/  WRITE *            PnOFm is optional and is used for        *
/* @C1A*/  WRITE *               tersed fragments                      *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  The CLIST will prompt for a data set name  *
/* @C1A*/  WRITE *          string.  Normally 20 positions are         *
/* @C1A*/  WRITE *          available but tersed fragments and a       *
/* @C1A*/  WRITE *          tersed PDS will reduce the available space.*
/* @C1A*/  WRITE *          Examples:                                  *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *            ONTOP.GSbbb.Pnnnnn.Cccc.**.TRS           *
/* @C1A*/  WRITE *            ONTOP.GSbbb.Pnnnnn.Cccc.**.CRY.P1OF5     *
/* @C1A*/  WRITE *            ONTOP.GSbbb.Pnnnnn.Cccc.**.PDS.TRS       *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *       o  Also, a single member from a PDS can be    *
/* @C1A*/  WRITE *          tersed and sent.  In that case, then       *
/* @C1A*/  WRITE *          member name will be included in the output *
/* @C1A*/  WRITE *          file name thus:                            *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *            ONTOP.GSbbb.Pnnnnn.Cccc.**.member.TRS    *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE *          The delimiters on either side of the       *
/* @C1A*/  WRITE *          string (** above) are added automatically, *
/* @C1A*/  WRITE *          are not included in the number of          *
/* @C1A*/  WRITE *          available bytes, and should *not* be       *
/* @C1A*/  WRITE *          duplicated in input from the user.         *
/* @C1A*/  WRITE *          Delimiters between supplied qualifiers are *
/* @C1A*/  WRITE *          allowed (and required).                    *
/* @C1A*/  WRITE *                                                     *
/* @C1A*/  WRITE * --------------------------------------------------- *
/* @C1A*/  WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Disposition of source and work data sets:       *
           WRITE *                                                     *
           WRITE *     The MIGORIG and MIGWORK values in the CUSTOM    *
           WRITE *     section control the final disposition of the    *
           WRITE *     original file and any work data sets.           *
           WRITE *                                                     *
           WRITE *     The CLIST will inform you of these settings     *
           WRITE *     before the job is submitted, and you may        *
           WRITE *     elect to change as part of the job submission   *
           WRITE *     process.                                        *
           WRITE *                                                     *
           WRITE *     MIGORIG is currently set to                     *
           WRITE *      >>   &MIGTXTO   <<
           WRITE *     MIGWORK is currently set to                     *
           WRITE *      >>   &MIGTXTW   <<
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Profile data set:                               *
           WRITE *                                                     *
           WRITE *     If users wish to create a profile data set with *
           WRITE *     customized settings for their invocations of    *
           WRITE *     PUTDOC, they may.  The syntax rules governing   *
           WRITE *     the profile data set, the data set name format, *
           WRITE *     and the variables that can be changed are       *
           WRITE *     described in the CUSTOM section of the CLIST.   *
           WRITE *     Please see your system administrator for more   *
           WRITE *     information about setting up a profile data set.*
           WRITE *                                                     *
           WRITE * --------------------------------------------------- *
           WRITE * --------------------------------------------------- *
           WRITE *                                                     *
           WRITE *     Abnormal termination support:                   *
           WRITE *                                                     *
           WRITE *     In case of abnormal termination of the PUTDOC   *
           WRITE *     job, all the input and work data sets are kept  *
           WRITE *     on level 1, and the following data sets may     *
           WRITE *     aid in restart:                                 *
           WRITE *                                                     *
           WRITE *     1)   '&OUTHLQ..Tnn.Ppmr.typ.PUTDOC.JCL'         *
           WRITE *     2)   '&OUTHLQ..Tnn.Ppmr.typ.PUTDOC.FTPMKD'      *
           WRITE *     3)   '&OUTHLQ..Tnn.Ppmr.typ.PUTDOC.FTPBAT'      *
           WRITE *                                                     *
           WRITE *     Where:                                          *
           WRITE *                                                     *
           WRITE *     1)    -  Contains the JCL for the submitted job *
           WRITE *     2)    -  Contains input to the mkdir FTP step   *
           WRITE *     3)    -  Contains input to the main FTP step    *
           WRITE *                                                     *
           WRITE *     Tnn   -  time qualifier - all work and output   *
           WRITE *              files use this as second qualifier     *
           WRITE *              (except for a target PDS on the        *
           WRITE *               remote host)                          *
           WRITE *     pmr   -  pmr number (if any)                    *
           WRITE *     typ   -  TXT, BIN, TRS, XMT, ECR, ECD           *
           WRITE *                                                     *
           WRITE *     Note that all output data sets are cataloged    *
           WRITE *     and kept upon abnormal termination.  You may    *
           WRITE *     need to delete some data sets before restart.   *
           WRITE *                                                     *
           WRITE *******************************************************
           GOTO GETOUT
         ENDO
         IF &STR(&TCSRVR) = &STR() OR +
            &STR(&TCHOSTN) = &STR() THEN DO                    /* @B5C*/
           SEND '>> PUTDOC <<  TESTCASE parameters not configured' +
             USER(&OWNERID) LOGON
           WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE >>>  Parameters for accessing testcase not configured
           WRITE >>>  Please configure TCSRVR and TCHOSTN
           WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT
         ENDO
         SET &DELMLN = &STR(************************************)+
                       &STR(*****************************)
         SET &LFP = &SUBSTR(2:2,&STR(4())
         SET &RTP = )
         /*************************************************************/
         /* Remove any quotes, member name, and the HLQ from          */
         /* the input data set name. Collect last qualifier.          */
         /*************************************************************/
         /* Quotes                                                    */
         SET &L = &LENGTH(&STR(&DSN))
         IF &SUBSTR(1:1,&STR(&DSN)) = &STR(') THEN DO
           SET &L = &L-2
           SET &DSN = &SUBSTR(2:&L+1,&STR(&DSN))
         ENDO
         /* Member Name                                               */
         SET &WC = 0   /* Wildcard in member name of PDS              */
         SET &MEMBER = &STR() /* Member name, name with * or '*'      */
         SET &IP = &SYSINDEX(&STR(&LFP),&STR(&DSN))
         IF &IP > 0 THEN DO
           /* We have a member name                                   */
           SET &L = &LENGTH(&STR(&DSN))
           SET &LM = (&L-&IP) - 1 /* Length of member name w/o ()     */
           IF &LM > 0 THEN DO
             SET &MEMBER = &SUBSTR(&IP+1:&L-1,&STR(&DSN))
             SET &IA = &SYSINDEX(&STR(*),&STR(&MEMBER))
             IF &SUBSTR(&LM:&LM,&STR(&MEMBER)) = &STR(*) THEN DO
               IF &STR(&MEMBER) = &STR(*) THEN +
                 SET &WC = 1   /* All members                         */
               ELSE IF &IA < &LM THEN DO                       /* @C1A*/
/* @C1A*/        WRITE   >>> Member name format is invalid
                 GOTO GETOUT                                   /* @C1A*/
               ENDO                                            /* @C1A*/
               ELSE +
                 SET &WC = 2   /* Partial name specified              */
             ENDO
           ENDO
           ELSE DO                                             /* @C1A*/
/* @C1A*/    WRITE   >>> Member name format is invalid
             GOTO GETOUT                                       /* @C1A*/
           ENDO                                                /* @C1A*/
           SET &DSN = &SUBSTR(1:&IP-1,&STR(&DSN))
         ENDO
         /* HLQ                                                       */
         SET &L = &LENGTH(&STR(&DSN))
         DO &I = 1 TO &L
           IF &SUBSTR(&I:&I,&STR(&DSN)) = &STR(.) THEN DO
             SET &TCDSN = &SUBSTR(&I+1:&L,&STR(&DSN))
             SET &I = &L + 1
           ENDO
         ENDO
         /* Last Qualifier                                            */
         /* &LQUAL is the last level qualifier                        */
         /* &LQUAP is the position of LQUAL                           */
         SET &L = &LENGTH(&STR(&TCDSN))
         DO &I = &L TO 1 BY -1
           IF &SUBSTR(&I:&I,&STR(&TCDSN)) = &STR(.) THEN DO
             SET &LQUAL = &SUBSTR(&I+1:&L,&STR(&TCDSN))
             SET &LQUALP = &I
             SET &I = 0
           ENDO
         ENDO
         /*********************************************/
         /* PARTI - number of input data sets         */
         /* TFRG  - tersed fragment?                  */
         /*********************************************/
         SET &TFRG = 0         /* Default not tersed fragment         */
         SET &PARTI = 1        /* Default number of parts             */
         IF &LENGTH(&STR(&LQUAL)) = 5 THEN DO
           SET &P2 = &SUBSTR(2:2,&STR(&LQUAL))
           SET &PARTQ = &SUBSTR(5:5,&STR(&LQUAL))
           IF &SUBSTR(1:1,&STR(&LQUAL)) = &STR(P) AND +
              &SUBSTR(3:4,&STR(&LQUAL)) = &STR(OF) AND +
              &DATATYPE(&P2) = &STR(NUM) AND +
              &DATATYPE(&PARTQ) = &STR(NUM) THEN DO
             LISTDSI '&DSN' RECALL
             IF &SYSLRECL = 1024 AND +
                &SYSRECFM = &STR(FB) THEN +
               SET &TFRG = 1   /* looks like tersed fragment          */
             ELSE +
               SET &PARTI = &PARTQ
           ENDO         /* Looks like a fragment                      */
         ENDO
         IF &TFRG = 1 THEN DO
           &CLRSCRN
           WRITE &DELMLN
           WRITE * File - &DSN
           WRITE *
           WRITE * This file appears to be a fragment of a larger
           WRITE * file that was tersed (TRSMAIN) and then split.
           WRITE *
           WRITE * At the prompt,
           WRITE *   Respond 'Y' if the file contains TRSMAIN output
           WRITE *   Respond 'N' if the file is not tersed
           WRITE *   Respond 'QUIT' to stop
           WRITE *
           WRITE &DELMLN
TFRG1:     WRITE
           WRITENR   Does this file contain tersed (TRSMAIN) output? +
                     (Y or N) ==>
           SET &SYSASIS = &STR(OFF)
           READ &ANS
           SET &SYSASIS = &STR(ON)
           IF &STR(&ANS) = &STR(QUIT) THEN +
             GOTO GETOUT
           ELSE IF &STR(&ANS) = &STR(Y) THEN +
             SET &PARTI = 1         /* send one at a time             */
           ELSE IF &STR(&ANS) = &STR(N) THEN DO
             SET &TFRG = -1         /* do not treat as tersed frg     */
             SET &PARTI = &PARTQ
           ENDO
           ELSE DO
             WRITE   >>> Response not understood
             GOTO TFRG1
           ENDO
         ENDO
         IF &PARTI > 1 THEN DO
           SET &L = &LENGTH(&STR(&TCDSN))
           SET &TCDSN = &SUBSTR(1:&L-6,&STR(&TCDSN))
           SET &L = &LENGTH(&STR(&DSN))
           SET &PARTN = &SUBSTR(1:&L-6,&STR(&DSN))
         ENDO
         SET &TQUAL = &STR(tqq)  /* Placeholder until we get TQUAL    */
         /*************************************************************/
         /* In case the destination is DB2, save a shortened copy     */
         /* of the name for testcase.                                 */
         /*************************************************************/
         IF &LENGTH(&TCDSN) > 28 THEN DO                       /* @B1A*/
           SET &DBDSN = &SUBSTR(1:28,&STR(&TCDSN))             /* @B1A*/
           IF &SUBSTR(28:28,&STR(&DBDSN)) = &STR(.) THEN +
             SET &DBDSN = &SUBSTR(1:27,&STR(&DBDSN))           /* @B1A*/
           SET &DBDSN  = &STR(&TQUAL..&STR(&DBDSN))            /* @B1A*/
         ENDO                                                  /* @B1A*/
         ELSE +
           SET &DBDSN  = &STR(&TQUAL..&STR(&TCDSN))            /* @B1A*/
         SET &TCDSN  = &STR(&TQUAL..&STR(&TCDSN))
         SET &MVSDSN = &STR(&OUTHLQ..&STR(&TCDSN))
         SET &TRSDSN = &STR()                                  /* @B1A*/
         SET &ENCDSN = &STR()                                  /* @B1A*/
         /*************************************************************/
         /* Initialize (document)                                     */
         /*************************************************************/
         SET &BATALLO = 0  /* Batch file is allocated                 */
         SET &BATOPEN = 0  /* Batch file is open (1) or closed (0)    */
         SET &CDSNALL = 0  /* MVSCDSN data set is allocated           */
         SET &DLM = &STR(/) /* Delimiter for output filename          */
         SET &NUMCH = &STR(0123456789)                         /* @B1A*/
         SET &MVSCH = &STR(ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$)
         SET &LCCH  = &STR(abcdefghijklmnopqrstuvwxyz)         /* @B1A*/
         SET &GDMVS = &STR(&MVSCH.&NUMCH)                      /* @CA */
         SET &EBCCH = &STR(&MVSCH.&NUMCH.&LCCH.)+
                      &STR(›.<(+|!$*);-º,%_>?`:#@={})          /* @C3A*/
                   /* &STR(›.<(+|!$*);^-º,%_>?`:#@={})         -- @B1A*/
         SET &EBCDV = &LENGTH(&STR(&EBCCH))                    /* @B1A*/
         SET &HFSFIL = &STR() /* HFS pathname to copy                 */
         SET &JCLOPEN = 0  /* JCL file is open (1) or closed (0)      */
         SET &JCLALLO = 0  /* JCL file is allocated                   */
         SET &KBYTES = 0    /* KBytes input (used for splits)         */
         SET &MKDALLO = 0  /* MKD bat file is allocated               */
         SET &MKDOPEN = 0  /* MKD bat file is open(1), closed(0)      */
         SET &NEWDCB = 0  /* 1=output mvs data set has new DCB        */
         SET &ORGFILE = &STR()  /* Original file needs migrating      */
         SET &OTRKS  = 0    /* Tracks of original file                */
         SET &P5    = 1    /* Number of input parts                   */
         SET &PARTO = 0    /* Number of output tersed parts           */
         SET &REMOTMVS = -1 /* Is remote host MVS (-1 unknown)        */
         SET &TCPMR = &STR() /* pmr number to insert in o/p filename  */
         SET &TRSPLIT = 0  /* Split is needed of tersed file          */
         /*************************************************************/
         /* Since TRS and XMT can mean both that the file exists      */
         /* in that state or that it needs conversion, these          */
         /* flags keep track of the state of the file.                */
         /*                                                           */
         /*   Value     Meaning                                       */
         /*     0       File is not in correct state                  */
         /*     1       File is already in correct state              */
         /*************************************************************/
         SET &TRSFLAG = 0
         SET &XMTFLAG = 0
         SET &FTPSTP = 0
         /*************************************************************/
         /* Check for multiple part input.                            */
         /*************************************************************/
         IF &PARTI > 1 THEN DO &PI = 1 TO &PARTI
           SET &DSN&PI = &STR(&PARTN..P&PI.OF&PARTI.)
           SET &DSNC = &&DSN&PI
           LISTC ENTRY('&DSNC')
           IF &LASTCC NE 0 THEN DO
             WRITE
             WRITE >>> &DSNC does not exist
             WRITE >>> All members of the data set can't be found
             WRITENR ***
             READ &ANS
             GOTO GETOUT
           ENDO
         ENDO
PATH1:   IF &STR(&DEST) = &STR() THEN DO
           &CLRSCRN
           WRITE &DELMLN
           IF &PARTI > 1 THEN DO
             SET &DSNC = &STR(&DSN1)                           /* @ALC*/
             WRITE * PUTDOC Version 5.2
             WRITE *
             WRITE * File : &STR(&DSNC) - Destination
             SET &DSNC = &&DSN&PARTI
             SET &DSNC = &STR(&DSNC)                           /* @ALC*/
             WRITE *        ... thru ...
             WRITE *        &STR(&DSNC)
           ENDO
           ELSE +
               WRITE * PUTDOC Version 5.2
               WRITE *
               WRITE * File : &STR(&DSN) - Destination
           WRITE *
           WRITE *  #  Nickname  Host/Path
           WRITE *  =  ========  =========
         ENDO
         DO &P = 1 TO &NICKMAX
           SET &NICK = &&NICK&P
           SET &NICKLC = &SYSLC(&STR(&NICK))
           IF &STR(&DEST) NE &STR() THEN DO
             SET &DESTLC = &SYSLC(&DEST)
             IF &STR(&DESTLC) = &STR(&NICKLC) THEN +
               SET &SELNO = &P
           ENDO
           ELSE DO  /* No DEST specified                              */
             IF &STR(&NICKLC) NE &STR(dummy) AND +
                &STR(&NICK) NE &STR() THEN DO
               SET &LN = &LENGTH(&STR(&NICK))
               SET &NICK = &STR(&NICK+
                 &SUBSTR(1:9-&LENGTH(&STR(&NICK)),&STR(        )))
               SET &PATH = &&PATH&P
               SET &HOST = &&HOST&P
               IF &STR(&HOST) = &STR(TESTCASE) THEN +
                 SET &HOST = &STR()
               IF &LENGTH(&STR(&P)) < 2 THEN +
                 SET &P = &STR( &P)
               WRITE * &P  &NICK  &HOST/&PATH
             ENDO  /* Got one to display                              */
           ENDO /* no DEST                                            */
         ENDO /* Scan nicknames                                       */
         IF &STR(&DEST) = &STR() THEN DO
           WRITE &DELMLN
           WRITE   Enter selection #, other destination, or press +
                   enter to skip sending.
           WRITENR   ==>
           READ &SELNO
         ENDO
         ELSE IF &SELNO = &STR() THEN SET &SELNO = 99
         IF &STR(&SELNO) = &STR(QUIT) OR +
            &STR(&SELNO) = &STR(quit) THEN GOTO GETOUT
         IF &STR(&SELNO) = &STR() THEN DO
           WRITE   *********************************************
           WRITE   *** No destination will be used.  The FTP ***
           WRITE   *** transfer step will not be built.      ***
           WRITE   *********************************************
           SET &PMR = &STR()
           SET &SUBDIR = &STR()
           SET &PATH = &STR()
           SET &DEST1 = &STR()
           SET &DEST2 = &STR()
           WRITENR ***
           READ &ANS
           GOTO CKDISPS
         ENDO
         SET &TCH = 0  /* 0,1 means host is not/is testcase           */
         SET &NKU = 0  /* 0,1 means nickname was not/was used         */
         IF &DATATYPE(&STR(&SELNO)) = &STR(NUM) THEN DO
           SET &NICK = &&NICK&SELNO
           SET &NICK = &SYSLC(&NICK)
           IF &SELNO > 0 AND &SELNO <= &NICKMAX AND +
             &STR(&NICK) NE &STR(dummy) THEN DO
             SET &DEST1 = &&HOST&SELNO
             SET &DEST2 = &&PATH&SELNO
             SET &ISMVS = &&MVSF&SELNO
             SET &PMRD  = &&PMRD&SELNO
             IF &STR(&USERID) = &STR() THEN DO
               SET &USERID = &&USER&SELNO
               SET &PASSWD = &&PASS&SELNO
             ENDO
             SET &MOREL = &&MORE&SELNO
             SET &MOR2L = &&MOR2&SELNO                         /* @B7A*/
             SET &MOR3L = &&MOR3&SELNO                         /* @B7A*/
             SET &NKU = 1
             IF &STR(&DEST1) = &STR(&EMHOSTN) THEN +
               SET &DEST1 = &STR(EMEA)                         /* @C1A*/
           ENDO
           ELSE IF &STR(&DEST) = &STR() THEN DO
             /*********************************************************/
             /* This is a fat finger.                                 */
             /*********************************************************/
             WRITE   >>> &SELNO is not a valid response - try again
             WRITENR ***
             READ &ANS
             GOTO PATH1
           ENDO
           ELSE DO
             /*********************************************************/
             /* Input destination is bad.                             */
             /*********************************************************/
             WRITE   >>> &DEST is not a valid nickname - try again
             WRITENR ***
             READ &ANS
             SET &DEST = &STR()  /* Dump it                           */
             GOTO PATH1
           ENDO
         ENDO  /* They chose from the list                            */
         ELSE DO
           SET &SL = &LENGTH(&STR(&SELNO))
           SET &HL = &SYSINDEX(&STR(/),&STR(&SELNO))
           IF &HL = 1 THEN DO
             SET &DEST1 = &STR(TESTCASE)
             SET &DEST2 = &SUBSTR(2:&SL,&STR(&SELNO))
           ENDO
           ELSE DO
             IF &HL > 0 THEN DO
               SET &DEST1 = &SUBSTR(1:&HL-1,&STR(&SELNO))
               SET &DEST2 = &SUBSTR(&HL+1:&SL,&STR(&SELNO))
             ENDO
             ELSE DO
               SET &DEST1 = &STR(&SELNO)
               SET &DEST2 = &STR()
             ENDO  /* we only got a host                              */
             IF &STR(&DEST1) = &STR(&TCHOSTN) THEN +
               SET &DEST1 = &STR(TESTCASE)
             ELSE IF &STR(&DEST1) = &STR(&EMHOSTN) THEN +
               SET &DEST1 = &STR(EMEA)                         /* @C1A*/
             ELSE DO /* Check for the testcase keyword                */
               SET &TUC = &SYSCAPS(&STR(&DEST1))
               IF &STR(&TUC) = &STR(TESTCASE) THEN +
                 SET &DEST1 = &STR(TESTCASE)
             ENDO
           ENDO  /* not (apparently) the testcase server              */
         ENDO  /* answer not numeric                                  */
         /*************************************************************/
         /* Set up for the transfer.  Check to see if more            */
         /* directory information is needed and see if we             */
         /* know whether or not this is testcase or MVS.              */
         /*************************************************************/
         SET &FTPSTP = 1
         SET &PATH = &STR(&DEST2)
      /* IF &STR(&PATH) = &STR(s390/toibm) THEN SET &MORDIR = 1 */
/* @C5M */ IF &STR(&PATH) = &STR(toibm) THEN SET &MORDIR = 1
         ELSE SET &MORDIR = 0
      /* IF &STR(&PATH) = &STR(s390/toibm/db2) THEN SET &DB2 = 1 */
/* @C5M    IF &STR(&PATH) = &STR(toibm/db2) THEN SET &DB2 = 1 */
/* @C6M */ IF &STR(&PATH) = &STR(toibm/im) THEN SET &DB2 = 1
         ELSE SET &DB2 = 0
         IF &STR(&DEST1) = &STR(TESTCASE) THEN DO
           SET &TCH = 1
           SET &REMOTMVS = 0
         ENDO
         ELSE DO
           IF &SYSCAPS(&ISMVS) = &STR(Y) THEN DO
             SET &REMOTMVS = 1
             SET &DLM = &STR(.)
           ENDO
           ELSE IF &SYSCAPS(&ISMVS) = &STR(N) THEN +
             SET &REMOTMVS = 0
         ENDO
         /*************************************************************/
         /* See if more information is needed.                        */
         /*************************************************************/
         IF &TCH = 0 AND &REMOTMVS = -1 THEN DO   /* Still unknown    */
MVSHOST:   WRITE
           /***********************************************************/
           /* WBNVM                                                   */
           /***********************************************************/
           WRITE ******************************************************
 /* @B2A*/ WRITE * If the target destination is the HFS, respond 'N'
 /* @B2C*/ WRITE * Is this destination (&DEST1)
 /* @B2C*/ WRITENR * an MVS host? (Y or N) ==>
           SET &SYSASIS = &STR(OFF)
           READ &ANS
           SET &SYSASIS = &STR(ON)
           IF &ANS = &SR(QUIT) THEN GOTO GETOUT
           ELSE IF &ANS = &STR(Y) THEN DO
             SET &REMOTMVS = 1
             SET &DLM = &STR(.)
           ENDO
           ELSE IF &ANS NE &STR(N) THEN DO
             WRITE
             WRITE   >>> Response not understood
             GOTO MVSHOST
           ENDO
           ELSE +
             SET &REMOTMVS = 0
         ENDO   /* Not testcase                                       */
         /*************************************************************/
         /* Check to see if the destination is TESTCASE.              */
         /*************************************************************/
         IF &STR(&DEST1) = &STR(TESTCASE) THEN DO
           SET &GOHOST = &STR(&TCSRVR)
           SET &USERID = &STR(&TCUSER)
           SET &PASSWD = &STR(&TCPASS)
           SET &MOREL = &STR(&TCMORE)
           SET &MOR2L = &STR(&TCMORE2)                         /* @B7A*/
           SET &MOR3L = &STR(&TCMORE3)                         /* @B7A*/
           SET &MYCASE = &NRSTR(&&SYSLC)
         ENDO
         ELSE IF &STR(&DEST1) = &STR(EMEA) THEN DO             /* @C1A*/
           SET &GOHOST = &STR(&EMHOSTN)                        /* @C1A*/
           SET &MOREL = &STR(NONE)                             /* @C1A*/
           SET &MOR2L = &STR(NONE)                             /* @C1A*/
           SET &MOR3L = &STR(NONE)                             /* @C1A*/
           SET &MYCASE = &NRSTR(&&STR)                         /* @C1A*/
         ENDO                                                  /* @C1A*/
         ELSE DO                                               /* @B5C*/
           SET &GOHOST = &STR(&DEST1)
           IF &REMOTMVS = 1 THEN +
             SET &MYCASE = &NRSTR(&&SYSCAPS)
           ELSE +
             SET &MYCASE = &NRSTR(&&STR)
         ENDO                                                  /* @B5A*/
         /*  Allow destination to be testcase                     @B5D*/
         SET &HDR = 0
         IF &STR(&USERID) = &STR() THEN DO
           &CLRSCRN
           WRITE &DELMLN
           WRITE *  Enter the signon information for &DEST1
           WRITE *
/* @C1C*/  WRITE *  Input is free format (blanks must be in quotes)
           SET &HDR = 1
           WRITE &DELMLN
           WRITE
           IF &STR(&DEST1) = &STR(TESTCASE) THEN +
/* @B7A*/    WRITENR   &TCUSERP
           ELSE +
             WRITENR   Enter the first signon line (userid) ==>
           READ &USERID
         ENDO
         IF &STR(&PASSWD) = &STR() THEN DO
           IF &HDR = 0 THEN DO
             &CLRSCRN                                        /* @B5A*/
             WRITE &DELMLN
             WRITE *  Enter the signon information for &DEST1
             WRITE *
             SET &HDR = 1
             WRITE &DELMLN
           ENDO
           WRITE
           IF (&STR(&DEST1) = &STR(TESTCASE) OR +
               &STR(&DEST1) = &STR(&EMHOSTN) OR +
               &STR(&DEST1) = &STR(EMEA)) AND +
              &USERID = &STR(anonymous) THEN +
/* @C1C*/    WRITENR   Enter your email id (will display) ==>
           ELSE DO                                             /* @B7C*/
             IF &STR(&DEST1) = &STR(TESTCASE) THEN +
/* @B7A*/      WRITENR   &TCPASSP
             ELSE +
               WRITENR   Enter the second signon line (password) +
                       - will display ==>
           ENDO                                                /* @B7A*/
           READ &PASSWD
         ENDO
         IF &MOREL = &STR(NONE) THEN +
           SET &MOREL = &STR()
         ELSE IF &STR(&MOREL) = &STR() THEN DO                 /* @B7C*/
           WRITE
           IF &STR(&DEST1) = &STR(TESTCASE) THEN +
/* @B7A*/    WRITENR   &TCMOREP
           ELSE +
             WRITENR   Enter the third signon line or press +
                       enter for none ==>
           READ &MOREL
           SET &HDR = 1                                        /* @B7A*/
         ENDO
         IF &MOR2L = &STR(NONE) THEN +
           SET &MOR2L = &STR()                                 /* @B7A*/
         ELSE IF &STR(&MOR2L) = &STR() THEN DO                 /* @B7A*/
/* @B7A*/  WRITE
           IF &STR(&DEST1) = &STR(TESTCASE) THEN +
/* @B7A*/    WRITENR   &TCMOR2P
           ELSE +
/* @B7A*/    WRITENR   Enter the fourth signon line or press +
                       enter for none ==>
           READ &MOR2L                                         /* @B7A*/
           SET &HDR = 1                                        /* @B7A*/
         ENDO                                                  /* @B7A*/
         IF &MOR3L = &STR(NONE) THEN +
           SET &MOR3L = &STR()                                 /* @B7A*/
         ELSE IF &STR(&MOR3L) = &STR() THEN DO                 /* @B7A*/
/* @B7A*/  WRITE
           IF &STR(&DEST1) = &STR(TESTCASE) THEN +
/* @B7A*/    WRITENR   &TCMOR3P
           ELSE +
/* @B7A*/    WRITENR   Enter the fifth signon line or press +
                       enter for none ==>
           READ &MOR3L                                         /* @B7A*/
           SET &HDR = 1                                        /* @B7A*/
         ENDO                                                  /* @B7A*/
         /*************************************************************/
         /* Prompt for problem number and path                    @C1C*/
         /*************************************************************/
         WRITE
         &CLRSCRN
         WRITE &DELMLN
/*@C1A*/ IF &STR(&DEST1) = &STR(EMEA) THEN +
           WRITE * PUTDOC - send a file to the EMEA repository
/*@C1C*/ ELSE +
           WRITE * PUTDOC - send a file to &DEST1
         WRITE *   Enter 'QUIT' at any following prompt to terminate
         WRITE &DELMLN
         IF &PARTI > 1 THEN DO
           SET &DSNC = &STR(&DSN1)                             /* @ALC*/
           WRITE * File : &STR(&DSNC)
           SET &DSNC = &&DSN&PARTI
           SET &DSNC = &STR(&DSNC)                             /* @ALC*/
           WRITE *        ... thru ...
           WRITE *        &STR(&DSNC)
         ENDO
         ELSE +
             WRITE * File : &STR(&DSN)
      /* IF &STR(&PATH) = &STR() THEN DO                       ** @C1M*/
         IF &STR(&PATH) = &STR(NONE) THEN SET &PATH = &STR()   /* @C4M*/
/* @C4M*/ ELSE IF &STR(&PATH) = &STR() THEN DO
/* @C1M*/  WRITE &DELMLN
/* @C1M*/  WRITE *
           IF &REMOTMVS = 1 THEN DO                            /* @C1M*/
/* @C1M*/    WRITE *
  /* @B9C*/  WRITE *  The destination directory is '&SYSCAPS(&USERID.)'.
/* @C1M*/    WRITENR *  Press enter to accept or enter new ==>
             READ &PATH                                        /* @C1M*/
             IF &STR(&PATH) = &STR() THEN +
               SET &PATH = &STR(&USERID)                       /* @C1M*/
           ENDO  /* remote host is mvs                            @C1M*/
           ELSE DO                                             /* @C1M*/
/* @C1M*/    WRITE *
/* @C1M*/    WRITENR *  Enter the destination directory ==>
             READ &PATH                                        /* @C1M*/
           ENDO  /* remote host is not mvs                        @C1M*/
         ENDO  /* No path specified                               @C1M*/
         ELSE DO  /* We have a path                               @C1M*/
           /***********************************************************/
           /* Ask them to confirm the path if :                       */
           /*                                                         */
           /*   ) They used a nickname  - and -                       */
           /*   ) The target is not the testcase server               */
           /*                                                         */
           /* It might seem like a good idea to allow the             */
           /* user to confirm a typed-in path, but they               */
           /* actually get that opportunity (to abort) later          */
           /* on.                                                     */
           /***********************************************************/
           IF &NKU = 1 AND &TCH = 0 THEN DO                    /* @C1M*/
/* @C1C*/    WRITE *
             IF &REMOTMVS = 1 THEN DO                          /* @C1C*/
/* @C1C*/      WRITE *  The destination directory is &SYSCAPS(&PATH.)
             ENDO                                              /* @C1M*/
/* @C1C*/    ELSE  +
               WRITE *  The destination directory is &PATH.
/* @C1M*/    WRITENR *  Press enter to accept or enter new ==>
             READ &ANS                                         /* @C1M*/
             IF &STR(&ANS) NE &STR() THEN +
               SET &PATH = &STR(&ANS)                          /* @C1M*/
           ENDO  /* They might need to change a path              @C1M*/
         ENDO  /* Path was specified                              @C1M*/
         /*************************************************************/
         /* Make sure the pathname looks like we want it to.          */
         /*************************************************************/
         IF &STR(&PATH) = &STR() THEN DO                       /* @C1M*/
           SET &CDPATH = &STR()                                /* @C1M*/
           GOTO SUBD                                           /* @C1M*/
         ENDO                                                  /* @C1M*/
         IF &SUBSTR(1:1,&STR(&PATH)) = &STR(')) THEN DO        /* @C1M*/
           SET &L = &LENGTH(&STR(&PATH))                       /* @C1M*/
           IF &SUBSTR(&L:&L,&STR(&PATH)) NE &STR(') THEN DO    /* @C1M*/
             SET &PATH = &STR(&PATH)&STR(')                    /* @C1M*/
             SET &L = &L + 1                                   /* @C1M*/
           ENDO                                                /* @C1M*/
           SET &CDPATH = &STR(&PATH)                           /* @C1M*/
           SET &PATH = &SUBSTR(2:&L-2,&STR(&PATH))             /* @C1M*/
         ENDO                                                  /* @C1M*/
         ELSE IF &REMOTMVS = 1 THEN +
           SET &CDPATH = &STR('&PATH')                         /* @C1M*/
         ELSE +
           SET &CDPATH = &STR(&PATH)                           /* @C1M*/
         IF &SUBSTR(1:1,&STR(&PATH)) = &STR(/) THEN +
           SET &DLM = &STR(/)  /* change it back to go to hfs     @C1M*/
SUBD:    SET &GOTSLSH = &SYSINDEX(&STR(/),&STR(&PMR))
         IF &GOTSLSH > 0 THEN DO
           WRITE * ***************************************************
           WRITE * A slash (/) is not accepted in PR().  Remove the
           WRITE * slash and retry.  The CLIST will prompt for needed
           WRITE * sub directory information.
           WRITE * ***************************************************
           GOTO GETOUT
         ENDO
/* @C8A begins here */
           IF &STR(&PMR) = &STR() THEN DO
           &CLRSCRN
DB2AGN:    WRITE
           WRITE &DELMLN
           IF &DB2 = 1 THEN +
             WRITE *  Enter the PMR number in the convention
           ELSE +
             WRITE *  Enter the PMR number in the convention
           IF &TCH = 0 THEN +
             WRITE *
             WRITE *  ppppp.bbb.ccc where:
             WRITE *
             WRITE *      ppppp is the 5-char PMR number, eg: 34143
             WRITE *        bbb is the 3-char branch, eg: 055
             WRITE *        ccc is the 3-char country code, eg: 724
             WRITE *
             WRITE *  Country codes are documented at url:
             WRITE *  http://www.ibm.com/de/support/ecurep/country.html
             WRITE *
             WRITE *    - or - press enter to bypass.
             WRITE *
           WRITE &DELMLN
           WRITE
           WRITENR  Enter the PMR number as ppppp.bbb.ccc ==>
           READ &PMR

           IF &STR(&PMR) = &STR(QUIT) OR +
              &STR(&PMR) = &STR(quit) THEN GOTO GETOUT
/*         /* IF &LENGTH(&STR(&PMR)) NE 5 AND +
/*            (&DEST1 = &STR(EMEA) OR &DB2 = 1) THEN DO */     /* @C1C*/
           IF &LENGTH(&STR(&PMR)) NE 13 THEN DO
/*         /* WRITE >>> PMR number must be exactly 5 digits */
             WRITE
             WRITE >>> PMR number must be exactly 13 digits in
             WRITE >>> the convention: ppppp.ccc.bbb
             WRITE >>>
             WRITE >>> Please use the period command between the
             WRITE >>> 5-char PMR and the 3-char country code, and
             WRITE >>> between the 3-char country code and the 3-char
             WRITE >>> branch code.
             WRITE
             GOTO DB2AGN
           ENDO
           ELSE IF &DB2 = 1 THEN +
/* @C91      SET &PMR = &STR(PM&PMR) */
             SET &PMR = &STR(&PMR)
           WRITE

             SET &SHD = &STR()   /* @C9M */
             &CLRSCRN
SHDAGN:      WRITE
             WRITE &DELMLN
             WRITE *
             WRITE * Enter short description up to 40 characters:
             WRITE *
             WRITE *  xxxxxxyyyyyyzzzzz
             WRITE *
             WRITE * The file name is the target of an FTP put command
             WRITE * The only restrictions on the file name (short
             WRITE * description) are no national characters, no
             WRITE * quotes, no spaces and no slashes.
             WRITE *
             WRITE &DELMLN
             WRITE
             WRITENR  Enter the short description ==>
             READ &SHD
             SET &SHD = &STR(.&SHD)
             IF &LENGTH(&STR(&SHD)) GT 41 THEN DO
               WRITE
               WRITE >>> Short desc must be less than 40 chars
               WRITE
               GOTO SHDAGN
             ENDO
/* @CA*/     IF &LENGTH(&STR(&SHD)) GT 1 THEN +
/* @CA*/         SET &PMR = &STR(&PMR&SHD)

/* MJF     WRITE PMR SO FAR IS &PMR */
/* @C8A ends */
         ENDO
         ELSE DO             /* Pause to introduce ourselves      @B1A*/
           WRITE &DELMLN
           WRITENR ***
           READ &ANS                                           /* @B1M*/
         ENDO                                                  /* @B1A*/
         IF &MORDIR = 1 THEN DO
           WRITE &DELMLN
        /* WRITE *  A group directory under s390/toibm is needed. */
/* @C5M */ WRITE *  A group directory under /toibm is needed.
           WRITE &DELMLN
           WRITE
        /* WRITENR   Enter the s390/toibm group directory ==> */
/* @C5M */ WRITENR   Enter the toibm group directory ==>
           READ &GDIR
           SET &GDIR = &SYSLC(&GDIR)
           SET &PATH = &STR(&PATH./&GDIR)
           SET &CDPATH = &STR(&PATH.)
         ENDO
         /*************************************************************/
         /*  If we are headed for testcase, insist on a PMR           */
         /*  number and determine if it should be the subd.           */
         /*************************************************************/
/*@C8A   IF &TCH = 1 OR &STR(&DEST1) = &STR(EMEA) THEN DO */   /* @C1A*/
/*@C8A     IF &STR(&PMR) = &STR() THEN DO */
/*@C8A       WRITE */
/*@C1C*/  /* WRITE >>> A PMR number is required for &DEST1 @C8A */
/*@C8A       WRITENR *** */
/*@C8A       READ &ANS */
/*@C8A       GOTO SUBD */
/*@C8A     ENDO */
/*@C8A   ENDO */
         /*************************************************************/
         /*  If DB2 is the destination, insert the possibly shortened */
         /*  version of the file name into TCDSN.                 @B1A*/
         /*************************************************************/
      /* IF &STR(&PATH) = &STR(s390/toibm/db2) THEN + */
/* @C5M    IF &STR(&PATH) = &STR(toibm/db2) THEN + */
/* @C6M */ IF &STR(&PATH) = &STR(toibm/im) THEN +
           SET &TCDSN = &DBDSN                                 /* @B1A*/
         IF &PMRD NE &STR() THEN DO
           SET &ANS = &PMRD
/*         IF &ANS = &STR(I) OR &ANS = &STR(S) THEN + */
/*           GOTO BYPROMPT */
         ENDO
/*       IF &REMOTMVS = 0 AND &PMR NE &STR() THEN DO              @B2C*/
         IF &REMOTMVS = X AND &PMR NE &STR() THEN DO   /* X=bogus @C9A*/
PRMPT0:    WRITE
           WRITE &DELMLN
           WRITE * Is the PMR number '&PMR' to be used as a subdirectory
           WRITE * name or inserted into the output filename?
           WRITE &DELMLN
           WRITE
           WRITENR   Enter S (for subdirectory) or I (for insert) ==>
           SET &SYSASIS = &STR(OFF)
           READ &ANS
           SET &SYSASIS = &STR(ON)
           IF &STR(&ANS) = &ST(QUIT) THEN GOTO GETOUT
BYPROMPT:  IF &STR(&ANS) = &STR(I) THEN DO
             SET &SUBDIR = &STR()
             SET &TCPMR = &STR(&PMR)
           ENDO
           ELSE IF &STR(&ANS) = &STR(S) THEN DO
             SET &SUBDIR = &STR(&PMR)
             SET &TCPMR = &STR()
           ENDO
           ELSE DO
             WRITE
             WRITE   >>> Response not understood
             WRITENR ***
             READ &ANS
             &CLRSCRN
             GOTO PRMPT0
           ENDO
         ENDO
         ELSE IF &STR(&PMR) NE &STR() THEN DO    /* MVS with pmr#    */
           SET &SUBDIR = &STR()
           SET &TCPMR = &STR(&PMR)
         ENDO
/* MJF   WRITE TCPMR SO FAR IS &TCPMR  */
         /*************************************************************/
         /*  Set the delimiting slash if needed.                      */
         /*************************************************************/
         IF &STR(&SUBDIR) NE &STR() THEN +
           SET &DSL = &STR(/)
         ELSE +
           SET &DSL = &STR()

         /*************************************************************/
         /*  Clip the PMR number to use in MVS data sets.             */
         /*  MVS Datasets cannot have all numeric qualifiers          */
         /*  - Locate the pos of the first DOT(.) in the PMR Number   */
         /*  - Extract the chars to the left of the dot               */
         /*    (the 5 character PMR number).                          */
         /*  - Prepend with a 'P' to from the MVS name                */
         /*  - If no dot is found then take the entire PMR number     */
         /*  - In both cases - limit the pmr number to 5 chars        */
         /*************************************************************/
/* @CA*/ /* SET &MVSPMR = &SYSCAPS(&STR(&PMR))                        */
/* @CA*/ /* IF &MVSPMR = &STR() THEN +                                */
/* @CA*/ /*   SET &MVSPMR = &STR(NONE)                                */
/* @CA*/ /* ELSE DO                                                   */
/* @CA*/ /*  SET &FST = &SUBSTR(1:1,&STR(&MVSPMR))                    */
/* @CA*/ /*  SET &DTYP = &SYSINDEX(&FST,&STR(&MVSCH))                 */
/* @CA*/ /*  SET &L = &LENGTH(&STR(&MVSPMR))                          */
/* @CA*/ /*  IF &DTYP = 0 OR &L > 8 THEN DO                           */
/* @CA*/ /*    IF &L > 7 THEN +                                       */
/* @CA*/ /*      SET &MVSPMR = &SUBSTR(&L-6:&L,&MVSPMR)               */
/* @CA*/ /*    SET &MVSPMR = &STR(P&MVSPMR)                           */
/* @CA*/ /*  ENDO                                                     */
/* @CA*/ /* ENDO                                                      */


/* @CA*/ SET &DOT = &SYSINDEX(&STR(.),&PMR)
/* @CA*/ IF &DOT < 2 THEN +
/* @CA*/   SET &DOT = &LENGTH(&STR(&PMR))
/* @CA*/ ELSE +
/* @CA*/   SET &DOT = &DOT -1
/* @CA*/ IF &DOT > 5 THEN +
/* @CA*/   SET &DOT = 5

/* @CA*/ SET &MVSPMR = &SUBSTR(1:&DOT,&PMR)
/* @CA*/ SET &MVSPMR = &SYSCAPS(&STR(&MVSPMR))
/* @CA*/ SET &L = &LENGTH(&STR(&MVSPMR))
/* @CA*/ SET &Z = &STR(Z)

/* @CA*/ DO &MX = 1 TO &L
/* @CA*/   SET &NCHAR = &SUBSTR(&MX:&MX,&STR(&MVSPMR))
/* @CA*/   IF 0 = &SYSINDEX(&NCHAR,&STR(&GDMVS)) THEN DO
/* @CA*/     IF &MX=1 THEN +
/* @CA*/       SET &TBEG = &STR()
/* @CA*/     ELSE +
/* @CA*/       SET &TBEG = &STR(&SUBSTR(1:&MX-1,&STR(&MVSPMR)))
/* @CA*/     IF &MX+1 > &L THEN +
/* @CA*/       SET &TEND = &STR()
/* @CA*/     ELSE +
/* @CA*/       SET &TEND = &STR(&SUBSTR(&MX+1:&L,&STR(&MVSPMR))
/* @CA*/     SET &MVSPMR = &STR(&TBEG&Z&TEND)
/* @CA*/   ENDO
/* @CA*/ ENDO
/* @CA*/ SET &MVSPMR = &STR(P&MVSPMR)
/* @CA*/ /* WRITE &DOT &L &MVSPMR &PMR                                */

         /*************************************************************/
         /* Check the disposition settings                            */
         /*************************************************************/
         GOTO CKDISPS  /* By default, we only check them first        */
CNFMMIG: SET &WHICH = 1
PRMPT1:  WRITE
         &CLRSCRN
         WRITE &DELMLN
         WRITE * Final disposition of data sets
         WRITE *
         IF &WHICH = 1 THEN +
           WRITE *   0 - No change  (forced for PDS)
         ELSE +
           WRITE *   0 - &MIGTXT0
         WRITE *   1 - &MIGTXT1
         WRITE *   2 - &MIGTXT2
         WRITE *  99 - &MIGTXT99 (work data sets only)
         WRITE *
WHCHONE: WRITE &DELMLN
         IF &WHICH = 1 THEN DO
           IF &PARTI > 1 THEN DO &PI = 1 TO &PARTI
             SET &DSNC = &&DSN&PI
             WRITE * &DSNC = &MIGTXTO
           ENDO
           ELSE +
             WRITE * &DSN = &MIGTXTO
         ENDO
         ELSE +
           WRITE * Work data sets = &MIGTXTW
         WRITE &DELMLN
         WRITE
         IF &WHICH = 1 THEN +
           WRITENR   Press enter to confirm, or enter 0,1,2 ==>
         ELSE +
           WRITENR   Press enter to confirm, or enter 0,1,2,99 ==>
         READ &ANS
         IF &ANS = &STR(QUIT) OR +
            &ANS = &STR(quit) THEN GOTO GETOUT
         IF &ANS NE &STR() THEN DO
           IF (&WHICH = 2 AND &ANS = 99) OR +
              &ANS = 0 OR &ANS = 1 OR &ANS = 2 THEN DO
             IF &WHICH = 1 THEN +
               SET &MIGORIG = &ANS
             ELSE +
               SET &MIGWORK = &ANS
           ENDO
           ELSE DO
             WRITE
             WRITE   >>> Response not understood, please try again
             WRITENR ***
             READ &ANS
             GOTO PRMPT1
           ENDO
         ENDO
         IF &WHICH = 1 THEN DO
           SET &WHICH = 2
           WRITE
           GOTO WHCHONE
         ENDO
CKDISPS: IF (&STR(&MIGORIG) NE &STR(0) AND +
             &STR(&MIGORIG) NE &STR(1) AND +
             &STR(&MIGORIG) NE &STR(2)) OR +
            (&STR(&MIGWORK) NE &STR(0) AND +
             &STR(&MIGWORK) NE &STR(1) AND +
             &STR(&MIGWORK) NE &STR(2) AND +
             &STR(&MIGWORK) NE &STR(99)) THEN DO
           WRITE
           WRITE   >>> At least one disposition setting is unknown.
           WRITE   >>> Please make corrections at the prompt.
           WRITENR ***
           READ &ANS
           GOTO CNFMMIG
         ENDO  /* Initial settings can be bad                         */
         /*************************************************************/
         /* Take a first pass at the data sets characteristics        */
         /* and see if we can divine the type.                        */
         /*************************************************************/
         /*************************************************************/
         /* Check the size and attributes of the file                 */
         /*************************************************************/
         DO &NUMP = 1 TO &PARTI             /* Process each part      */
         IF &PARTI > 1 THEN DO
           SET &DSNC = &&DSN&NUMP
           SET &DSNC = &STR(&DSNC)                             /* @ALC*/
         ENDO
         ELSE +
           SET &DSNC = &STR(&DSN)                              /* @ALC*/
         SET &ATTRET = &STR(ATTRBK)                            /* @C1A*/
DSATTR:  CONTROL MSG
         SET &ISTH = &SYSDSN('&DSNC')
         IF &ISTH = &STR(OK) THEN DO
           SET &EXIST = 1
           LISTDSI '&DSNC' RECALL
           SET &DSIRC = &LASTCC
           IF (&DSIRC = 4 AND &EVAL(&SYSREASON) NE 19) OR +
               &DSIRC > 4 THEN DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> Return Code=&DSIRC Reason Code=&SYSREASON from
           WRITE   >>> LISTDSI. Please correct and try again.
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
           /***********************************************************/
           /* Make sure all component parts are compatible.           */
           /***********************************************************/
           SET &DSORG = &SUBSTR(1:2,&STR(&SYSDSORG))
           IF &NUMP = 1 THEN DO
             SET &FLRECL = &SYSLRECL
             SET &FRECFM = &SYSRECFM
             SET &FDSORG = &SYSDSORG
           ENDO
           ELSE DO
             SET &TLRECL = &SYSLRECL
             SET &TRECFM = &SYSRECFM
             SET &TDSORG = &SYSDSORG
             IF &TLRECL NE &FLRECL OR +
                &STR(&TDSORG) NE &STR(&FDSORG) OR +
                &STR(&TRECFM) NE &STR(&FRECFM) THEN DO
               &CLRSCRN
               WRITE
               WRITE >>> &DSNC
               WRITE >>> Lrecl &TLRECL Recfm &TRECFM Dsorg &TDSORG
               WRITE >>>   ... attributes do not match ...
               WRITE >>> &DSN1
               WRITE >>> Lrecl &FLRECL Recfm &FRECFM Dsorg &FDSORG
               WRITE >>>
               WRITE >>> Please correct and retry
               WRITENR ***
               READ &ANS
               GOTO GETOUT
             ENDO
           ENDO
           /***********************************************************/
           /* Compute the number of kilobytes per track.  Then        */
           /* compute the number of tracks.  Finally, compute         */
           /* kbytes used on this volume.                             */
           /***********************************************************/
           IF &STR(&SYSBLKSTRK) = &STR(N/A) THEN DO       /* PDSE @C2A*/
             IF &SYSUNIT = &STR(3380) THEN +
               SET &SYSBLKSTRK = 47476 / &SYSBLKSIZE           /* @C2A*/
             ELSE +
               SET &SYSBLKSTRK = 56664 / &SYSBLKSIZE           /* @C2A*/
             SET &SYSUSED = &SYSALLOC                          /* @C2A*/
           ENDO                                                /* @C2A*/
           SET &KBPTRK = (&SYSBLKSTRK * &SYSBLKSIZE) / 1024
           SET &RMPTRK = (&SYSBLKSTRK * &SYSBLKSIZE) // 1024
           IF &SYSUNITS = &STR(CYLINDER) THEN +
             SET &OTRKS = &SYSUSED * &SYSTRKSCYL
           ELSE IF &SYSUNITS = &STR(TRACK) THEN +
             SET &OTRKS = &SYSUSED
           ELSE IF &SYSUNITS = &STR(BLOCK) THEN DO
             SET &OTRKS = &SYSUSED / &SYSBLKSTRK
             SET &REM = &SYSUSED // &SYSBLKSTRK
             IF &REM > 0 THEN +
               SET &OTRKS = &OTRKS + 1
           ENDO
           SET &KBYTES = &KBYTES + (&OTRKS * &KBPTRK) +
                          + ((&OTRKS * &RMPTRK) / 1024)
           IF &STR(&DSORG) = &STR(PO) AND &STR(&MEMBER) NE &STR() +
             AND &WC = 0 THEN DO
             SET &ISTH = &SYSDSN('&DSN.(&MEMBER)')
             IF &ISTH NE &STR(OK) THEN DO
               SET &EXIST = 0
               SET &KBYTES = 0
             ENDO
           ENDO
           ELSE IF &STR(&DSORG) NE &STR(PO) AND +
                   &STR(&DSORG) NE &STR(PS) THEN DO
             WRITE
             WRITE >>> &DSNC
             WRITE >>>   ... is not sequential or partitioned ...
             WRITE >>>
             WRITE >>> Please correct and retry
             WRITENR ***
             READ &ANS
             GOTO GETOUT
           ENDO
         ENDO
         ELSE IF &ISTH = &STR(MEMBER NOT FOUND) OR +
                 &ISTH = &STR(DATASET NOT FOUND) THEN +
           SET &EXIST = 0
         ELSE DO
           WRITE
           WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE >>>  Error trying to access
           WRITE >>>  &DSN
           WRITE >>>  Reason: &ISTH
           WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT
         ENDO
         IF &DSIRC = 4 AND &EVAL(&SYSREASON) = 19 THEN DO /* multvol  */
           SET &NVOLS = 0
           LISTC ENTRY('&DSN') VOLUME
           DO &I = 1 TO &SYSOUTLINE
             SET &SLINE = &&SYSOUTLINE&I
             IF &LENGTH(&STR(&SLINE)) > 11 THEN DO
               SET &TXT = &SUBSTR(1:12,&STR(&SLINE))
               IF &STR(&TXT) = &STR(     VOLUMES) THEN DO
                 DO &J = &I+2 TO &SYSOUTLINE /* Skip first volume     */
                   SET &SLINE = &&SYSOUTLINE&J
                   SET &VOLSER = &SUBSTR(26:31,&STR(&SLINE))
                   IF &STR(&VOLSER) NE &STR(-----*) THEN DO
                     SET &NVOLS = &NVOLS + 1
                     SET &VOL&NVOLS = &STR(&VOLSER)
                   ENDO
                   ELSE +
                     SET &J = 99999
                 ENDO  /* Scan volume list                            */
                 SET &I = 99999
               ENDO  /* Get the volser info                           */
             ENDO /* Line long enough to test                         */
           ENDO  /* Scan listc output                                 */
           DO &I = 1 TO &NVOLS
             SET &VOLSER = &&VOL&I
             LISTDSI '&DSN' VOLUME(&VOLSER)
             SET &DSIRC = &LASTCC
             IF (&DSIRC = 4 AND &EVAL(&SYSREASON) NE 19) OR +
                 &DSIRC > 4 THEN DO
              WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
         WRITE   >>> Return Code=&HOLDCC Reason Code=&SYSREASON from
              WRITE   >>> LISTDSI(&VOLSER). Correct and try again.
              WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
               GOTO GETOUT
             ENDO
             /*********************************************************/
             /* Compute bytes used as for the first volume.           */
             /* Recalculate the total kbytes.                         */
             /*********************************************************/
             IF &STR(&SYSBLKSTRK) = &STR(N/A) THEN DO     /* PDSE @C2A*/
               IF &SYSUNIT = &STR(3380) THEN +
                 SET &SYSBLKSTRK = 47476 / &SYSBLKSIZE         /* @C2A*/
               ELSE +
                 SET &SYSBLKSTRK = 56664 / &SYSBLKSIZE         /* @C2A*/
               SET &SYSUSED = &SYSALLOC                        /* @C2A*/
             ENDO                                              /* @C2A*/
             SET &KBPTRK = (&SYSBLKSTRK * &SYSBLKSIZE) / 1024
             SET &RMPTRK = (&SYSBLKSTRK * &SYSBLKSIZE) // 1024
             SET &MOTRKS = 0      /* Tracks on subsequent vols        */
             IF &SYSUNITS = &STR(CYLINDER) THEN +
               SET &MOTRKS = (&SYSUSED * &SYSTRKSCYL)
             ELSE IF &SYSUNITS = &STR(TRACK) THEN +
               SET &MOTRKS = &SYSUSED
             ELSE IF &SYSUNITS = &STR(BLOCK) THEN +
               SET &MOTRKS = (&SYSUSED / &SYSBLKSTRK)
             SET &KBYTES =  &KBYTES + (&MOTRKS * &KBPTRK) +
                          + ((&MOTRKS * &RMPTRK) / 1024)
             SET &OTRKS = &OTRKS + &MOTRKS  /* Capture all trks       */
           ENDO  /* Get space info from remaining volumes             */
         ENDO /* Multivolume processing                               */
         ENDO                               /* Process each part      */
         GOTO &ATTRET                                          /* @C1A*/
ATTRBK:  CONTROL MSG
         IF &KBYTES = 0 THEN DO  /* File is empty or not there        */
           IF &PARTI > 1 THEN DO
             WRITE
             WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             WRITE >>> At least one member of a multi-part data set
             WRITE >>> must contain data.  Please correct and retry.
             WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
           IF &STR(&HFSFIL) NE &STR() THEN DO
             WRITE
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> The copied file was empty.  Please correct
           WRITE   >>> and try again.
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
           &CLRSCRN
           WRITE &DELMLN
           IF &STR(&MEMBER) NE &STR() THEN +
             WRITE * &DSN.(&MEMBER)
           ELSE +
             WRITE * &DSN
           IF &EXIST = 1 THEN +
             WRITE *   appears to be empty
           ELSE +
             WRITE *   does not exist
           WRITE *
           IF &EXIST = 1 THEN DO
             WRITE *   You may Send it as is
             WRITE *     __ or __
           ENDO
           WRITE *   You may Create it by copying an HFS file to it
           WRITE *     __ or __
           WRITE *   You may Quit
           WRITE *
           WRITE *  (Any copy will be done during your TSO session
           WRITE *   prior to submitting the batch job to send
           WRITE *   this file.)
           WRITE &DELMLN
EMPT:      WRITE
           IF &EXIST = 1 THEN +
           WRITENR   Do you wish to Send, Create, or Quit (S,C,Q) ==>
           ELSE  +
             WRITENR   Do you wish to Create or Quit (C,Q) ==>
           SET &SYSASIS = &STR(OFF)
           READ &ANS
           SET &SYSASIS = &STR(ON)
           IF &ANS = &STR(Q) THEN GOTO GETOUT
           ELSE IF &ANS = &STR(QUIT) THEN GOTO GETOUT
           ELSE IF &ANS = &STR(C) THEN DO
             WRITE
             WRITE   Use single quotes if the name contains blanks.
             WRITE   Enter exact HFS pathname for source data set.
             WRITENR   ==>
             READ &HFSFIL
           ENDO
           ELSE IF &ANS NE &STR(S) OR &EXIST = 0 THEN DO
             WRITE   >>> Response not understood
             GOTO  EMPT
           ENDO
           IF &STR(&HFSFIL) NE &STR() THEN DO
             IF &STR(&MEMBER) NE &STR() THEN +
               SET &ODSN = &STR(&DSN(&MEMBER))
             ELSE +
               SET &ODSN = &STR(&DSN)
             &CLRSCRN
             WRITE &DELMLN
             WRITE *   Enter T for Text copy
             WRITE *         B for Binary copy
             WRITE *
             WRITE *   of  '&HFSFIL'
             WRITE *
             WRITE *   to  '&ODSN'
             WRITE *
             WRITE *   or Q to quit
             WRITE &DELMLN
HFSCPY:      WRITE
             WRITENR   Enter type of copy (T,B) or Q to quit ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(Q) THEN GOTO GETOUT
             ELSE IF &ANS = &STR(QUIT) THEN GOTO GETOUT
             ELSE IF &ANS = &STR(T) OR &ANS = &STR(B) THEN DO
               IF &STR(&MEMBER) NE &STR() THEN +
                 SET &ODSN = &STR(&DSN(&MEMBER))
               ELSE +
                 SET &ODSN = &STR(&DSN)
               IF &ANS = &STR(T) THEN +
                 SET &HTYP = &STR(TEXT)
               ELSE +
                 SET &HTYP = &STR(BINARY)
               CONTROL NOMSG
               OGET '&HFSFIL' +
                    '&ODSN' +
                     &HTYP
               SET &HOLDCC = &LASTCC
               CONTROL MSG
               IF &HOLDCC = 0 THEN DO
                 WRITE
                 WRITE &DELMLN
                 WRITE * Copy was successful
                 WRITE &DELMLN
                 WRITENR ***
                 READ &ANS
                 FREE DA('&DSN')
                 SET &NUMP = &NUMP - 1                         /* @AMA*/
                 GOTO DSATTR
               ENDO /* OGET succeeded                                 */
               ELSE DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> The copy failed with return code &HOLDCC.
           WRITE   >>> Please correct and try again.
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                 GOTO GETOUT
               ENDO  /* OGET failed                                   */
             ENDO  /* text or binary copy requested                   */
             ELSE DO
               WRITE   >>> Response not understood
               GOTO  HFSCPY
             ENDO  /* response not valid                              */
           ENDO
         ENDO
         /*************************************************************/
         /* Handle PDS pre-processing                                 */
         /*************************************************************/
         IF &DSORG = &STR(PO) THEN DO
           IF &PARTI > 1 THEN DO
             WRITE
             WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             WRITE >>> Partitioned data sets may not be used as
             WRITE >>> multi-part input.  Please correct and retry.
             WRITE >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
           &CLRSCRN
           IF &STR(&MEMBER) NE &STR() THEN DO
             /* We have a member name                                 */
             IF &WC > 0 THEN DO
               SET &NOTETXT = &STR((&MEMBER))
             ENDO  /* Wildcard                                        */
             ELSE DO  /* really is a member                           */
               SET &KBYTES = &KBYTES / 5                       /* @B1C*/
               SET &TCDSN = &STR(&TCDSN..&MEMBER)
               SET &MVSDSN = &STR(&OUTHLQ..&TCDSN)
               SET &PDSN = &STR(&DSN)                          /* @B1A*/
               SET &DSN = &STR(&DSN.(&MEMBER))
             ENDO /* real member                                      */
           ENDO  /* Member name was supplied                          */
           ELSE DO
             /*********************************************************/
             /* WBNDIR                                                */
             /*********************************************************/
PDSAGN:      WRITE &DELMLN
             WRITE * &STR(&DSN)
/* @C2A*/    IF &STR(&SYSDSSMS) = &STR(PROGRAM_LIBRARY) THEN DO
/* @C2A*/       WRITE *   is a PDSE containing binder-generated members
/* @C2A*/       WRITE *
/* @C2A*/       WRITE * Enter member name to transmit
/* @C2A*/    ENDO
/* @C2A*/    ELSE DO
               WRITE *   is a partitioned data set
               WRITE *
               WRITE * Enter member name to transmit
               WRITE *   __ or __
               WRITE * Enter 'name*' to send a group of members
               WRITE *   __ or __
               WRITE * Enter '*' to send all members
/* @C2A*/    ENDO
             WRITE *   __ or __
             WRITE * Press enter to quit
             WRITE &DELMLN
             WRITE
             WRITE
/* @C2A*/    IF &STR(&SYSDSSMS) = &STR(PROGRAM_LIBRARY) THEN DO
/* @C2A*/      WRITE   Note: Binder members must be sent individually
/* @C2A*/      WRITE
/* @C2A*/      WRITENR   Enter member name or press enter to quit ==>
/* @C2A*/    ENDO
/* @C2C*/    ELSE +
              WRITENR   Enter *, name, name*, or press enter to quit ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             SET &LA = &LENGTH(&STR(&ANS))
             SET &IA = &SYSINDEX(&STR(*),&STR(&ANS))
             IF &STR(&ANS) = &STR() THEN +
               GOTO GETOUT
             ELSE IF &SUBSTR(&LA:&LA,&STR(&ANS)) = &STR(*) THEN DO
/* @C2A*/      IF &STR(&SYSDSSMS) = &STR(PROGRAM_LIBRARY) THEN DO
/* @C2A*/        WRITE
/* @C2A*/        WRITE   >>> Binder members must be sent individually
/* @C2A*/        WRITENR ***
                 READ &ANS                                     /* @C2A*/
                 &CLRSCRN                                      /* @C2A*/
                 GOTO PDSAGN                                   /* @C2A*/
               ENDO
               SET &MEMBER = &STR(&ANS)
               SET &NOTETXT = &STR((&MEMBER))
               IF &STR(&MEMBER) = &STR(*) THEN +
                 SET &WC = 1
               ELSE IF &IA < &LA OR THEN DO                    /* @C1A*/
/* @C2A*/        WRITE
/* @C1A*/        WRITE   >>> Input is invalid format
/* @C1A*/        WRITENR ***
                 READ &ANS                                     /* @C1A*/
                 &CLRSCRN                                      /* @C1A*/
                 GOTO PDSAGN                                   /* @C1A*/
               ENDO                                            /* @C1A*/
               ELSE +
                 SET &WC = 2
             ENDO
             ELSE DO
               SET &MEMBER = &STR(&ANS)
               GOTO DSATTR  /* Need to do it over to allow hfs copy   */
             ENDO  /* Member name was given                           */
           ENDO /* PDS did not have a member name supplied with it    */
         ENDO  /* Data set is a PDS                                   */
         /*************************************************************/
         /* Take a guess at its form                                  */
         /*************************************************************/
         IF &SYSLRECL = 1024 AND &SYSRECFM = &STR(FB) THEN +
           SET &TYPE = &STR(TRS)
         ELSE IF &SYSLRECL = 80 AND &SYSRECFM = &STR(FB) AND +
            &SYSBLKSIZE = 3120 THEN +
           SET &TYPE = &STR(XMT)
         ELSE IF &SUBSTR(1:1,&SYSRECFM) NE &STR(F) THEN +
           SET &TYPE = &STR(VB)
         ELSE +
           SET &TYPE = &STR(FB)
         IF &TFRG = 1 THEN DO
           SET &TRSFLAG = 1
           GOTO GOTTYPE
         ENDO
GETTYPE: WRITE
         &CLRSCRN
         SET &TYPTXT1 = &STR(Binary          )
         SET &TYPTXT2 = &STR(Send as Tersed  )
         SET &TYPTXT3 = &STR(Text            )
         SET &TYPTXT4 = &STR(Send as TSO XMIT)
         WRITE &DELMLN
         IF &PARTI > 1 THEN DO
           SET &DSNC = &STR(&DSN1)                             /* @ALC*/
           WRITE * File : &STR(&DSNC)
           SET &DSNC = &&DSN&PARTI
           SET &DSNC = &STR(&DSNC)                             /* @ALC*/
           WRITE *        ... thru ...
           WRITE *        &STR(&DSNC)
         ENDO
         ELSE +
             WRITE * File : &STR(&DSN) &NOTETXT
         WRITE *
         WRITE * Lrecl: &SYSLRECL  Blksize: &SYSBLKSIZE  +
                 Recfm: &SYSRECFM
         WRITE * Size : &KBYTES Kbytes
         /* Too large overrides all other considerations              */
         SET &MAX2G =  1953125  /* Maximum size to send               */
         IF &SPLTSIZE > &MAX2G THEN DO
           SEND '>> PUTDOC <<  SPLTSIZE is larger than &MAX2G' +
             USER(&OWNERID) LOGON
           SET &SPLTSIZE = &MAX2G
         ENDO
         IF &KBYTES > &SPLTSIZE AND &STR(&MEMBER) = &STR() THEN DO
           /* Don't ask about fragments we know about */
           IF &TYPE = &STR(TRS) AND &TFRG = 0 THEN DO
             WRITE *
             WRITE * This file possibly contains TRSMAIN output.
             WRITE *
             WRITE * Respond Y to confirm that the file is tersed
             WRITE *      or N to indicate it is not tersed.
             WRITE &DELMLN
PRMPT2:      WRITE
             WRITENR   Does this file contain TRSMAIN output? +
                       (Y or N) ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(QUIT) THEN GOTO GETOUT
             IF &ANS = &STR(Y) THEN DO
               SET &TRSFLAG = 1  /* File already tersed               */
               SET &TRSPLIT = 1  /* File needs to be split          */
               SET &PARTO = &KBYTES / &SPLTSIZE
               SET &REM = &KBYTES // &SPLTSIZE
               IF &REM > 500 THEN +
                 SET &PARTO = &PARTO + 1                       /* @B1C*/
               IF &PARTO > 9 THEN DO
                 SET &PARTO = 9
                 SEND '>> PUTDOC <<  SPLTSIZE(&SPLTSIZE) is too small+
                   ' USER(&OWNERID) LOGON
               ENDO
               IF &PARTO = 1 THEN +
                 SET &PARTO = 2                                /* @B1A*/
               WRITE
               WRITE &DELMLN
               WRITE * The file will be split into &PARTO parts due to
             WRITE * its size.  The parts will be suffixed PnOF&PARTO..
               WRITE &DELMLN
               WRITENR ***
               READ &ANS
             ENDO
             ELSE IF &ANS NE &STR(N) THEN DO
               WRITE   >>> Response not understood
               GOTO PRMPT2
             ENDO
           ENDO  /* We think it might be tersed                       */
           IF &TRSFLAG = 0 THEN DO  /* File is not tersed             */
             SET &TYPE = &STR(TRS)
             WRITE &DELMLN
             WRITE * The file will be tersed and then transmitted.
             /*********************************************************/
             /* Estimate the amount of untersed bytes that will       */
             /* translate into a tersed file that needs to be         */
             /* split.  Multiply SPLTSIZE by 5 as a good guess.       */
             /*********************************************************/
             SET &SPLTUNT = &SPLTSIZE * 5                      /* @B1C*/
             IF &KBYTES > &SPLTUNT THEN DO
               SET &TRSPLIT = 1  /* File needs to be split            */
               SET &PARTO = &KBYTES / &SPLTUNT
               SET &REM = &KBYTES // &SPLTUNT
               IF &REM > 500 THEN +
                 SET &PARTO = &PARTO + 1                       /* @B1C*/
               IF &PARTO > 9 THEN DO
                 SET &PARTO = 9
                 SEND '>> PUTDOC <<  SPLTSIZE(&SPLTSIZE) is too small+
                   ' USER(&OWNERID) LOGON
               ENDO
               ELSE IF &PARTO = 1 THEN +
                 SET &PARTO = 2                                /* @B1C*/
               WRITE
               WRITE &DELMLN
               WRITE * The file will be split into &PARTO parts due to
             WRITE * its size.  The parts will be suffixed PnOF&PARTO..
               WRITE &DELMLN
               WRITENR ***
               READ &ANS
             ENDO
             ELSE DO
               WRITE &DELMLN
               WRITENR ***
               READ &ANS
             ENDO  /* File does not need to be split                  */
           ENDO  /* File is not tersed                                */
           GOTO GOTTYPE
         ENDO  /* File is too large                                   */
         IF &TYPE = &STR(TRS) AND &STR(&MEMBER) = &STR() AND +
            &TFRG = 0 THEN DO
           WRITE * This file possibly contains TRSMAIN output.
           WRITE *
           WRITE * Respond Y to confirm that the file is tersed
           WRITE *      or N to indicate it is not tersed
           WRITE &DELMLN
PRMPT3:    WRITE
           WRITENR   Does this file contain TRSMAIN output? +
                     (Y or N) ==>
           SET &SYSASIS = &STR(OFF)
           READ &ANS
           SET &SYSASIS = &STR(ON)
           IF &ANS = &STR(QUIT) THEN GOTO GETOUT
           IF &ANS = &STR(N) THEN +
             SET &TYPE = &STR(FB)
           ELSE IF &ANS = &STR(Y) THEN DO
             SET &TRSFLAG = 1 /* We know it is tersed                 */
             GOTO GOTTYPE
           ENDO  /* File confirmed as tersed                          */
           ELSE DO
             WRITE   >>> Response not understood
             GOTO PRMPT3
           ENDO
           &CLRSCRN
         ENDO  /* We think it may be tersed                           */
         ELSE DO
           IF &TYPE = &STR(XMT) AND &STR(&MEMBER) = &STR() THEN DO
             WRITE * This file may contain output from TSO TRANSMIT.
             WRITE *
             WRITE * Respond Y to confirm that the file is TSO XMIT
             WRITE *      or N to indicate it is not TSO XMIT.
             WRITE &DELMLN
PRMPT4:      WRITE
             WRITENR   Does this file contain TSO XMIT output? +
                     (Y or N) ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(QUIT) THEN GOTO GETOUT
             IF &ANS = &STR(N) THEN +
               SET &TYPE = &STR(FB)
             ELSE IF &ANS = &STR(Y) THEN DO
               IF &STR(&DEST1) = &STR(EMEA) THEN DO            /* @C1A*/
/* @C1A*/  WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
/* @C1A*/  WRITE   >>> File is in XMIT format and EMEA does not support
/* @C1A*/  WRITE   >>> XMIT format data.
/* @C1A*/  WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                 GOTO GETOUT                                   /* @C1A*/
               ENDO                                            /* @C1A*/
               SET &XMTFLAG = 1 /* We know it is TSO XMIT   */
               IF &FTPSTP = 0 THEN DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> File is already in XMIT format and no work
           WRITE   >>> data sets need to be created.  No destination
           WRITE   >>> was specified, so there is no work to do.
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                 GOTO GETOUT
               ENDO
               GOTO GOTTYPE
             ENDO
             ELSE DO
               WRITE   >>> Response not understood
               GOTO PRMPT4
             ENDO
             &CLRSCRN
           ENDO  /* We think it may be XMIT                           */
         ENDO /* File is not tersed
         WRITE &DELMLN
         WRITE * Please select a valid type for this file:
         SET &D1 = &STR( -)
         SET &D2 = &STR( -)
         SET &D3 = &STR( -)
         SET &D4 = &STR( -)
         SET &W1 = &STR( 1 )
         SET &W2 = &STR( 2 )
         SET &W3 = &STR( 3 )
         SET &W4 = &STR( 4 )
         SET &WARN = &STR()
         IF &FTPSTP = 0 THEN DO  /* Must need an output file          */
           SET &WARN = &STR(       *** Requires a destination ***)
           SET &W1 = &STR(   )
           SET &W3 = &STR(   )
           SET &D1 = &STR(  )
           SET &D3 = &STR(  )
         ENDO
         ELSE IF &TYPE = &STR(VB) AND &REMOTMVS = 0 THEN DO
           SET &WARN = &STR(       ***  Not supported for VB  ***)
           SET &W1 = &STR(   )
           SET &W3 = &STR(   )
           SET &D1 = &STR(  )
           SET &D3 = &STR(  )
         ENDO
         ELSE IF &PARTI > 1 THEN DO
           SET &WARN = &STR(       ***  No multi-part support ***)
           SET &W1 = &STR(   )
           SET &W3 = &STR(   )
           SET &D1 = &STR(  )
           SET &D3 = &STR(  )
         ENDO
         SET &XMTWRN = &STR((File format only, xfer mode is FTP))
         IF &WC > 0 THEN DO
           IF &STR(&DEST1) EQ &STR(TESTCASE) THEN DO           /* @C2C*/
             SET &PLSTRS = &STR(       ***  Not supported for PDS ***)
             SET &W2 = &STR(   )
             SET &D2 = &STR(  )
           ENDO                                                /* @C1A*/
/* @C1A*/  ELSE +
          SET &PLSTRS = &STR(       ***  Notify support of PDS ***)
         ENDO
         ELSE DO
           IF &DB2 = 1 THEN +
             SET &PLSTRS = &STR(       ***  DB2 requires terse    ***)
           ELSE IF &KBYTES > 50000 THEN +
             SET &PLSTRS = &STR(       ***  Best for large files  ***)
           ELSE +
             SET &PLSTRS = &STR()
         ENDO
         IF &STR(&DEST1) = &STR(EMEA) THEN DO                  /* @C1A*/
           SET &W1 = &STR(   )                                 /* @C1A*/
           SET &W3 = &STR(   )                                 /* @C1A*/
           SET &W4 = &STR(   )                                 /* @C1A*/
/* @C1A*/  SET &XMTWRN = &STR(       ***  Disabled for EMEA     ***)
/* @C1A*/  SET &WARN   = &STR(       ***  Disabled for EMEA     ***)
         ENDO                                                  /* @C1A*/
         SET &OK1 = &W1
         SET &OK2 = &W2
         SET &OK3 = &W3
         SET &OK4 = &W4
         WRITE * &W1 &D1  &TYPTXT1  &WARN
         WRITE * &W2 &D2  &TYPTXT2  &PLSTRS
         WRITE * &W3 &D3  &TYPTXT3  &WARN
         WRITE * &W4 &D4  &TYPTXT4  &XMTWRN
         WRITE &DELMLN
         WRITE
         WRITENR   Enter Selection Number for Type ==>
         SET &SYSASIS = &STR(OFF)
         READ &ANS
         SET &SYSASIS = &STR(ON)
         IF &ANS = &STR(QUIT) THEN GOTO GETOUT
         IF &ANS NE &STR(1) AND +
            &ANS NE &STR(2) AND +
            &ANS NE &STR(3) AND +
            &ANS NE &STR(4) THEN DO
           WRITE   >>> Type &ANS is invalid - please try again
           WRITENR ***
           READ &ANS
           GOTO GETTYPE
         ENDO
         IF &FTPSTP = 0 THEN DO  /* Local files only                  */
           IF &ANS = &STR(1) OR &ANS = &STR(3) THEN DO
             SET &TXT = &&TYPTXT&ANS
             WRITE   >>> Type &TXT is not supported if no destination
             WRITE   >>> is specified - no work data sets are created.
             WRITENR ***
             READ &ANS
             GOTO GETTYPE
           ENDO
           ELSE IF (&ANS = 4 AND &XMTFLAG = 1) OR +
                   (&ANS = 2 AND &TRSFLAG = 1 AND &TRSPLIT = 0) +
           THEN DO
             SET &TXT = &&TYPTXT&ANS
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> File is already in &TXT format and no work
           WRITE   >>> data sets need to be created.  No destination
           WRITE   >>> was specified, so there is no work to do.
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
         ENDO
         SET &STAT = &&OK&ANS
         IF &STAT NE &ANS THEN DO
           SET &TXT = &&TYPTXT&ANS
           WRITE   >>> Type &TXT is unsupported for this file
           WRITENR ***
           READ &ANS
           GOTO GETTYPE
         ENDO
         IF &ANS = &STR(1) THEN +
           SET &TYPE = &STR(BIN)
         ELSE IF &ANS = &STR(2) THEN DO                       /* @C1C*/
           SET &TYPE = &STR(TRS)
           IF &STR(&DEST1) = &STR(EMEA) AND &WC > 0 THEN DO   /* @C1A*/
/* @C1A*/    WRITE   *** Please inform EMEA support +
                     this is a tersed PDS ***
           ENDO                                               /* @C1A*/
         ENDO                                                 /* @C1A*/
         ELSE IF &ANS = &STR(3) THEN +
           SET &TYPE = &STR(TXT)
         ELSE +
           SET &TYPE = &STR(XMT)
         IF &ANS NE &STR(2) AND +
            &KBYTES > 50000 THEN DO
WHAT:        WRITE
             WRITE   &DSN is &KBYTES kbytes
             WRITENR   Enter 1 to terse, 2 to accept type &TYPE ==>
             READ &ANS
             IF &ANS = &STR(1) THEN SET &TYPE = &STR(TRS)
             ELSE IF &ANS = &STR(2) THEN /* Nothing */
             ELSE GOTO WHAT
         ENDO
         /*************************************************************/
         /* We have a type - trim the MVS data set name to hold   @B1A*/
         /* the type if necessary.                                @B1A*/
         /*************************************************************/
/* @C93D IF &STR(&DEST1) NE &STR(EMEA) THEN DO                 -- @C1A*/
GOTTYPE:   SET &L = &LENGTH(&STR(&MVSDSN))                     /* @C1C*/
           IF &L > 40 THEN DO                                  /* @B1A*/
             SET &MVSDSN = &SUBSTR(1:40,&MVSDSN)               /* @B1A*/
             IF &SUBSTR(40:40,&MVSDSN) = &STR(.) THEN +
             SET &MVSDSN = &SUBSTR(1:39,&MVSDSN)               /* @B1A*/
           ENDO                                                /* @B1A*/
/* @C93D ENDO                                                  -- @C1A*/
         /*************************************************************/
         /* Check on encryption                                   @B1A*/
         /*************************************************************/
         IF &TYPE = &STR(TRS) AND +
           (&ENCPROGM = &STR(FTPENCRD) OR +
            &ENCPROGM = &STR(FTPENCR)) THEN DO
/* @B1A*/  WRITE
/* @B1A*/  WRITE   ** Please confirm with support personnel in the **
/* @B1A*/  WRITE   ** target area that encryption may be used.     **
/* @B1A*/  WRITE
/* @B1A*/ WRITENR   Would you also like the file encrypted? (Y or N) ==>
           SET &SYSASIS = &STR(OFF)                            /* @B1A*/
           READ &ANS                                           /* @B1A*/
           SET &SYSASIS = &STR(ON)                             /* @B1A*/
           IF &STR(&ANS) = &STR(Y) THEN +
             SET &TYPE = &STR(ECR)                             /* @B1A*/
           ELSE IF &STR(&ANS) NE &STR(N) THEN DO               /* @B1A*/
/* @B1A*/    WRITE   >>> Response not understood. Please try again.
             GOTO GOTTYPE                                      /* @B1A*/
           ENDO                                                /* @B1A*/
         ENDO       /* See if TRS should become ECR               @B1A*/
         /*************************************************************/
         /* Prompt for encryption key.                            @B1A*/
         /*************************************************************/
         IF &TYPE = &STR(ECR) THEN DO                          /* @B1A*/
           IF &DEST1 = &STR(EMEA) THEN DO                      /* @C1A*/
             IF &ENCPROGM = &STR(FTPENCRD) THEN +
               SET &TYPESUF = &STR(.CRY64)                     /* @C1A*/
             ELSE +
               SET &TYPESUF = &STR(.CRY)                       /* @C1A*/
           ENDO
           ELSE DO                                             /* @C1A*/
             IF &ENCPROGM = &STR(FTPENCRD) THEN +
               SET &TYPESUF = &STR(.ECD)                       /* @B1A*/
             ELSE +
               SET &TYPESUF = &STR(.ECR)                       /* @B1A*/
           ENDO                                                /* @C1A*/
           &CLRSCRN                                            /* @B1A*/
/* @B1A*/  WRITE &DELMLN
/* @B1A*/  WRITE *
/* @B1A*/  WRITE *          Enter Encryption Key
/* @B1A*/  WRITE *
/* @B1A*/  WRITE * The encryption key may contain any combination of
/* @B1A*/  WRITE * valid EBCDIC characters, symbols, or numbers, except
/* @B1A*/  WRITE * for quotes, slashes, or ampersand (' " \ / +
                   &STR(&&)).
/* @B1A*/  WRITE * Enter 0 to 8 positions at the prompt and the rest
/* @B1A*/  WRITE * of the key will be generated.  The full key will be
/* @B1A*/  WRITE * recorded in the log data set for your reference.
/* @B1A*/  WRITE *
/* @B1A*/  WRITE &DELMLN
/* @B1A*/  WRITENR   Enter encryption key data ==>
           READ &EKEY                                          /* @B1A*/
           SET &ANS = &SYSCAPS(&NRSTR(&EKEY))                  /* @B1A*/
           IF &NRSTR(&ANS) = &STR(QUIT) THEN GOTO GETOUT       /* @B1A*/
           SET &LK = &LENGTH(&NRSTR(&EKEY))                    /* @B1A*/
           SET &EKEYO = &STR()                                 /* @B1A*/
           SET &NDISC = 0                                      /* @B1A*/
           DO &IK = 1 TO &LK                                   /* @B1A*/
             SET &KCHR = &SUBSTR(&IK:&IK,&NRSTR(&EKEY))        /* @B1A*/
             IF &SYSINDEX(&NRSTR(&KCHR),+
                          &NRSTR(&EBCCH)) > 0 THEN +
               SET &EKEYO = &STR(&EKEYO.&KCHR)                 /* @B1A*/
             ELSE +
               SET &NDISC = &NDISC + 1                         /* @B1A*/
           ENDO                                                /* @B1A*/
           SET &EKEY = &STR(&EKEYO)                            /* @B1A*/
           SET &LENK = &LENGTH(&STR(&EKEY))                    /* @B1A*/
           IF &LENK > 8 THEN DO                                /* @B1A*/
             SET &EKEY = &SUBSTR(1:8,&EKEY)                    /* @B1A*/
             SET &NDISC = &NDISC + (&LENK - 8)                 /* @B1A*/
             SET &LENK = 8                                     /* @B1A*/
           ENDO                                                /* @B1A*/
           IF &NDISC = 1 THEN DO                               /* @B1A*/
 /* @B1A*/   WRITE
 /* @B1A*/   WRITE >>> 1 character entered was discarded
 /* @B1A*/   WRITENR ***
             READ &ANS                                         /* @B1A*/
           ENDO                                                /* @B1A*/
           ELSE IF &NDISC > 0 THEN DO                          /* @B1A*/
 /* @B1A*/   WRITE
 /* @B1A*/   WRITE >>> &NDISC characters entered were discarded
 /* @B1A*/   WRITENR ***
             READ &ANS                                         /* @B1A*/
           ENDO                                                /* @B1A*/
         ENDO                                                  /* @B1A*/
         ELSE IF &TYPE = &STR(&LQUAL) THEN +
           SET &TYPESUF = &STR()                               /* @B1C*/
         ELSE +
           SET &TYPESUF = &STR(.&TYPE)
         IF &TYPE = &STR(TRS) AND +
            &FTPSTP = 0 AND &TRSFLAG = 1 THEN DO               /* @B1C*/
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> File is already in TERSED format and no work
           WRITE   >>> data sets need to be created.  No destination
           WRITE   >>> was specified, so there is no work to do.
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT                                         /* @B1M*/
         ENDO                                                  /* @B1M*/
         /*************************************************************/
         /* If the destination is testcase, replace any '#' or '$' or */
         /* '{' in the data set name with '@'.                    @ALA*/
         /*************************************************************/
         SET &L = &LENGTH(&STR(&TCDSN))                        /* @ALA*/
         IF &TCH = 1 THEN SET &POS = 0                         /* @ALA*/
         ELSE SET &POS = &L + 1                                /* @ALA*/
         DO WHILE (&POS < &L)                                  /* @ALA*/
           SET &POS = &POS + 1                                 /* @ALA*/
           SET &SCHR = &SUBSTR(&POS:&POS,&STR(&TCDSN))         /* @ALA*/
           IF &STR(&SCHR) = &STR(#) OR +
              &STR(&SCHR) = &STR($) OR +
              &STR(&SCHR) = &STR({) THEN DO                    /* @ALA*/
             IF &POS > 1 THEN +
               SET &FP = &SUBSTR(1:&POS-1,&STR(&TCDSN))        /* @ALA*/
             ELSE +
               SET &FP = &STR()                                /* @ALA*/
             IF &POS < &L THEN +
               SET &LPT = &SUBSTR(&POS+1:&L,&STR(&TCDSN))      /* @BAC*/
             ELSE +
               SET &LPT = &STR()                               /* @BAC*/
             SET &TCDSN = &STR(&FP.@&LPT)                      /* @BAC*/
           ENDO                                                /* @ALA*/
         ENDO                                                  /* @ALA*/
         /*************************************************************/
         /* If a target directory without a sub directory was chosen, */
         /* and an mput of pds members is going to happen, switch     */
         /* to sub directory mode instead of insert mode.             */
         /*************************************************************/
         IF &WC > 0 AND &SUBDIR = &STR() AND &TYPE NE &STR(XMT) AND +
            &STR(&DEST1) NE &STR(EMEA) THEN DO                 /* @C1A*/
           SET &SUBDIR = &STR(&PMR)
           SET &TCPMR = &STR()
           SET &DSL = &STR(/)
         ENDO
/* @C1C*/IF &WC > 0 AND &TYPE NE &STR(XMT) AND &TYPE NE &STR(TRS) THEN +
           SET &TCDSN = &STR(<member name>)
         ELSE DO
           /***********************************************************/
           /* Insert the original rectype and lrecl for all files     */
           /* that are not tersed fragments or already tersed (for    */
           /* those files we don't have the info). Append the type    */
           /* to the recfm and lrecl - all are used in retrieval.     */
           /***********************************************************/
           IF &TRSPLIT > 1 THEN +
             SET &TCDSN = &STR(&TCDSN..<PnOFm>)
           ELSE IF &TFRG = 1 THEN
           ELSE IF &TYPE = &STR(BIN) OR &TYPE = &STR(TXT) AND +
             REMOTMVS = 0 THEN DO
/* @C91A     SET &TCDSN = &STR(&TCDSN..F&SYSLRECL.&TYPESUF) */
/* @C91A */  SET &TCDSN = &STR(F&SYSLRECL.&TYPESUF)
           ENDO
           ELSE IF &TRSFLAG = 0 AND &XMTFLAG = 0 THEN DO
             SET &VF = &SUBSTR(1:1,&SYSRECFM)
/* @C91A     SET &TCDSN = &STR(&TCDSN..&VF.&SYSLRECL.&TYPESUF) */
/* @C91A */  SET &TCDSN = &STR(&VF.&SYSLRECL.&TYPESUF)
/* AJN       WRITE HEY1 &TCDSN */
           ENDO
           ELSE +
             SET &TCDSN = &STR(&TCDSN.&TYPESUF)
         ENDO
         /*************************************************************/
         /*  For organizations that use the pmr number in the         */
         /*  filename instead of sub directories, insert the          */
         /*  specified pmr number at the front of the name.           */
         /*  If the target system is MVS, use MVSPMR instead.  If     */
         /*  all members of a PDS are sent separately, only the       */
         /*  member name is sent.                                     */
         /*************************************************************/
         IF &WC = 0 THEN DO          /* Not sending PDS members       */
           IF &REMOTMVS = 0 THEN DO  /* Not sending to MVS            */
             IF &STR(&TCPMR) NE &STR() THEN +
               SET &TCDSN = &STR(&TCPMR..&TCDSN.)
           ENDO                      /* Not sending to MVS            */
           ELSE DO                   /* Sending to MVS                */
             IF &STR(&MVSPMR) NE &STR() THEN +
               SET &TCDSN = &STR(&MVSPMR..&TCDSN.)
             SET &L = &LENGTH(&STR(&PATH..&TCDSN)
             IF &L > 44 THEN DO
               SET &L2 = &LENGTH(&STR(&PATH..))
               SET &L = 44 - &L2
               SET &TCDSN = &SUBSTR(1:&L,&TCDSN)
             ENDO  /* name too long                                   */
           ENDO    /* sending to MVS                                  */
         ENDO      /* not sending members of a PDS                    */
         SET &TRSDSN = &STR(&MVSDSN..TRS)                      /* @B1A*/
         SET &ENCDSN = &STR(&MVSDSN.&TYPESUF)                  /* @B1A*/
         IF &TYPE NE &STR(XMT) OR &WC < 2 THEN +
           SET &MVSDSN = &STR(&MVSDSN.&TYPESUF)
         IF &TYPE = &STR(ECR) AND &TRSFLAG = 0 THEN DO         /* @B1A*/
           SET &L = &LENGTH(&STR(&TRSDSN))                     /* @B1A*/
           IF &L > 44 THEN DO                                  /* @B1A*/
             SET &TRSDSN = &SUBSTR(1:44,&TRSDSN)               /* @B1A*/
             IF &SUBSTR(44:44,&TRSDSN) = &STR(.) THEN +
               SET &TRSDSN = &SUBSTR(1:43,&STR(&TRSDSN))       /* @B1A*/
           ENDO  /* Tersed copy for encryption name too long      @B1A*/
         ENDO    /* Type is terse/encrypt and needs tersing       @B1A*/
         /*************************************************************/
         /*  &EMDSN  - root for output data set(s) on EMEA            */
         /*************************************************************/
         SET &EMDSN = &STR()                                   /* @C1A*/
         IF &STR(&DEST1) = &STR(EMEA) THEN DO                  /* @C1A*/
           SET &EMROOT = &STR(&PMR..&EMB..&EMC)                /* @C1A*/
           /***********************************************************/
           /*  For some reason EMEA will use only 40 positions of dsn */
           /***********************************************************/
           SET &L = 16   /* Available for the ultimate MVS name   @C1A*/
           IF &TRSPLIT = 1 THEN +
             SET &L = &L - 6                                   /* @C1A*/
           IF &WC > 0 THEN DO                                  /* @C1A*/
             SET &L = &L - 4                                   /* @C1A*/
             SET &TYPESUF = &STR(.PDS&TYPESUF)                 /* @C1A*/
           ENDO                                                /* @C1A*/
           IF &STR(&MEMBER) NE &STR() AND &WC = 0 THEN DO      /* @C1A*/
             SET &L = &L - &EVAL(&LENGTH(&STR(&MEMBER)) + 1)   /* @C1A*/
             SET &TYPESUF = &STR(.&MEMBER.&TYPESUF)            /* @C1A*/
           ENDO
/*--------------*/
/* @C92A begins */
/*--------------*/
/* ENTSUFF:   IF &TYPE = &STR(ECR) THEN + */
/*         WRITE   &DSN */
/*        WRITE   Enter name string for this data set on EMEA repository */
/*         SET &DOTS = &SUBSTR(1:&L,&STR(.....................) -*@C1A*/
/*         IF &L > 9 THEN SET &SPC = &STR( ) */
/*         ELSE SET &SPC = &STR() */
/* @C1A*-  WRITE                                        &SPC.&DOTS */
/* @C1A*-  WRITENR   Max &L positions, 8 per qualifier ==> */
/*         SET &SYSASIS = &STR(OFF)                            -* @C1A*/
/*         READ &NAMSTR                                        -* @C1A*/
/*         SET &SYSASIS = &STR(ON)                             -* @C1A*/
/*         IF &STR(&NAMSTR) = &STR(QUIT) THEN GOTO GETOUT      -* @C1A*/
/*         IF &LENGTH(&STR(&NAMSTR)) > &L THEN GOTO ENTSUFF    -* @C1A*/
/*         IF &LENGTH(&STR(&NAMSTR)) < 1 THEN GOTO ENTSUFF     -* @C1A*/
/*         IF &DATATYPE(&SUBSTR(1:1,&STR(&NAMSTR))) NE &STR(CHAR) AND + */
/*            &SUBSTR(1:1,&STR(&NAMSTR)) NE &STR(#) AND + */
/*            &SUBSTR(1:1,&STR(&NAMSTR)) NE &STR(@) AND + */
/*            &SUBSTR(1:1,&STR(&NAMSTR)) NE &STR($) THEN DO */
/*           WRITE First position must be alpha or national char */
/*           GOTO ENTSUFF */
/*         ENDO */
/*         SET &EMDSN = &SYSCAPS(&STR(&EMROOT..&NAMSTR))       -* @C1A*/
/*--------------*/
/* @C92A ends   */
/*--------------*/
         ENDO                                                  /* @C1A*/
         /*************************************************************/
         /*  Set up to display the settings for confirmation.         */
         /*************************************************************/
         IF &FTPSTP = 0 THEN DO  /* Local files only                  */
           IF &MIGWORK = 99 THEN DO
             WRITE *** Work data set disp is DELETE.  No destination
             WRITE *** was given, so MIGORIG(&MIGORIG) will be used.
             WRITENR ***
             READ &ANS
             SET &MIGWORK = &MIGORIG
           ENDO
           SET &BINTXT = &STR()
         ENDO
         ELSE +
           SET &BINTXT = &STR(, send binary)
         IF &STR(&MEMBER) NE &STR() THEN +
           SET &ORGTXT = &MIGTXT0
         ELSE +
           SET &ORGTXT = &&MIGTXT&MIGORIG
         SET &WRKTXT = &&MIGTXT&MIGWORK
         &CLRSCRN
         WRITE &DELMLN
         WRITE * Input Data Set (&ORGTXT):
         IF &PARTI > 1 THEN DO
           SET &DSNC = &STR(&DSN1)                             /* @ALC*/
           WRITE *  &STR(&DSNC) &NOTETXT
           SET &DSNC = &&DSN&PARTI
           SET &DSNC = &STR(&DSNC)                             /* @ALC*/
           WRITE *  ... thru ...
           WRITE *  &STR(&DSNC)
         ENDO
         ELSE +
           WRITE *  &STR(&DSN) &NOTETXT
         WRITE *
         /*************************************************************/
         /* The TQUAL value is Tnn where nn are the two digits of the */
         /* seconds of the current time.  TQUAL is used to minimize   */
         /* collisions with existing MVS data set names as well as    */
         /* testcase files.  Try several times to make it unique.     */
         /*************************************************************/
         SET &TRIES = 0
         SET &TQUAL = &STR(T)&SUBSTR(7:8,&SYSTIME)
         IF &TYPESUF = &STR() THEN +
           SET &OTYP = &STR(.&TYPE)                            /* @B1A*/
         ELSE +
           SET &OTYP = &TYPESUF                                /* @B1A*/
RQ:      IF &MVSPMR NE &STR() THEN +
           SET &PDMLQS = &STR(&TQUAL..&MVSPMR.&OTYP..PUTDOC)   /* @B1A*/
         ELSE +
           SET &PDMLQS = &STR(&TQUAL.&OTYP..PUTDOC)            /* @B1A*/
         LISTC EN('&OUTHLQ..&PDMLQS..FTPBAT')
         IF &LASTCC = 0 THEN DO
           IF &TRIES < 5 THEN DO
             SET &TRIES = &TRIES + 1
             SET &TQUAL = &STR(T)&SUBSTR(7:8,&SYSTIME)
             GOTO RQ
           ENDO
           ELSE DO
             WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             WRITE   >>> Unable to create unique batch file
             WRITE   >>> Look for files named
             WRITE   >>>  '&OUTHLQ..*.&MVSPMR..&TYPE..PUTDOC.FTPBAT'
             WRITE   >>> and delete them if possible.
             WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
         ENDO
         /*************************************************************/
         /* At this point, we must look all the data set              */
         /* 'roots' and replace .tqq. with TQUAL.                     */
         /*************************************************************/
         /*************************************************************/
         /*  &TCDSN - root for data sets on remote host               */
         /*************************************************************/
         SET &L = &LENGTH(&STR(&TCDSN))
         IF &L > 0 THEN DO
           SET &ITQ = &SYSINDEX(&STR(tqq.),&STR(&TCDSN))
           IF &ITQ > 1 THEN +
             SET &TCDSN = &SUBSTR(1:&ITQ-1,&STR(&TCDSN))+
                            &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&TCDSN))
           ELSE IF &ITQ = 1 THEN +
             SET &TCDSN = &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&TCDSN))
         ENDO
         /*************************************************************/
         /*  &MVSDSN - root for output data set(s) on this host       */
         /*************************************************************/
         SET &L = &LENGTH(&STR(&MVSDSN))
         IF &L > 0 THEN DO
           SET &ITQ = &SYSINDEX(&STR(tqq.),&STR(&MVSDSN))
           IF &ITQ > 1 THEN +
             SET &MVSDSN = &SUBSTR(1:&ITQ-1,&STR(&MVSDSN))+
                            &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&MVSDSN))
           ELSE IF &ITQ = 1 THEN +
             SET &MVSDSN = &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&MVSDSN))
         ENDO
         /*************************************************************/
         /*  &TRSDSN - intermediate tersed copy for encryption        */
         /*************************************************************/
         SET &L = &LENGTH(&STR(&TRSDSN))                       /* @B1A*/
         IF &L > 0 THEN DO                                     /* @B1A*/
           SET &ITQ = &SYSINDEX(&STR(tqq.),&STR(&TRSDSN))      /* @B1A*/
           IF &ITQ > 1 THEN +
             SET &TRSDSN = &SUBSTR(1:&ITQ-1,&STR(&TRSDSN))+
                   &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&TRSDSN))     /* @B1A*/
           ELSE IF &ITQ = 1 THEN SET &TRSDSN = +
                   &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&TRSDSN))     /* @B1A*/
         ENDO                                                  /* @B1A*/
         /*************************************************************/
         /*  &ENCDSN - output from encryption                         */
         /*************************************************************/
         SET &L = &LENGTH(&STR(&ENCDSN))                       /* @B1A*/
         IF &L > 0 THEN DO                                     /* @B1A*/
           SET &ITQ = &SYSINDEX(&STR(tqq.),&STR(&ENCDSN))      /* @B1A*/
           IF &ITQ > 1 THEN +
             SET &ENCDSN = &SUBSTR(1:&ITQ-1,&STR(&ENCDSN))+
                   &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&ENCDSN))     /* @B1A*/
           ELSE IF &ITQ = 1 THEN SET &ENCDSN = +
                   &TQUAL.&SUBSTR(&ITQ+3:&L,&STR(&ENCDSN))     /* @B1A*/
         ENDO                                                  /* @B1A*/
         /*************************************************************/
         /* Generate the encryption key if the user did not enter 8   */
         /* valid positions.  Use part or all of what they did enter. */
         /* These values are not truly "random" but they do produce   */
         /* enough variation in the key for our purposes.             */
         /*************************************************************/
         IF &TYPE = &STR(ECR) AND &LENK < 8 THEN DO            /* @B1A*/
           SET &KX  = &SUBSTR(7:7,&SYSTIME)                    /* @B1A*/
           SET &KX  = 10 - &KX                                 /* @B1A*/
           SET &K1  = &SUBSTR(8:8,&SYSTIME)&KX                 /* @B1A*/
           SET &K1A = &STR(&SYSCPU)                            /* @B1A*/
           SET &L   = &LENGTH(&STR(&K1A))                      /* @B1A*/
           SET &K1A = &SUBSTR(&L-1:&L,&K1A)                    /* @B1A*/
           SET &K1  = ((&K1 * &K1A) // &EBCDV) + 1             /* @B1A*/
           SET &K2  = &STR(&SYSCPU)                            /* @B1A*/
           SET &L   = &LENGTH(&STR(&K2))                       /* @B1A*/
           SET &DOT = &L - 2                                   /* @B1A*/
           SET &K2A = &SUBSTR(1:&DOT-1,&STR(&K2))              /* @B1A*/
           SET &K2  = &SUBSTR(&DOT+1:&L,&STR(&K2))             /* @B1A*/
           SET &K2A = &K2A + 1                                 /* @B1A*/
           SET &K2  = &K2 + 1                                  /* @B1A*/
           SET &K2  = &K2 * &K2A                               /* @B1A*/
           SET &K2  = ((&SYSSRV + &K2) // &EBCDV) + 1          /* @B1A*/
           SET &KX  = &SUBSTR(8:8,&SYSTIME)                    /* @B1A*/
           SET &K3  = (&SYSSRV / &OTRKS) + &KX                 /* @B1A*/
           SET &K3  = ((&K3 * &K1) // &EBCDV) + 1              /* @B1A*/
           SET &K4  = &SUBSTR(4:6,&SYSJDATE)                   /* @B1A*/
           SET &K4  = 1000 - &K4                               /* @B1A*/
           SET &KX  = &SUBSTR(7:7,&SYSTIME)                    /* @B1A*/
           SET &KX  = &SUBSTR(8:8,&SYSTIME)&KX                 /* @B1A*/
           SET &KX  = (&SYSSRV / (&KX + 5))                    /* @B1A*/
           SET &K4  = ((&K4 * &KX) // &EBCDV) + 1              /* @B1A*/
           SET &KX  = &SUBSTR(8:8,&SYSTIME)                    /* @B1A*/
           SET &KX  = 10 - &KX                                 /* @B1A*/
           SET &KX  = &KX * &KX * &KX                          /* @B1A*/
           SET &K5  = (((&SYSSRV / &KX) + 1) // &EBCDV) + 1    /* @B1A*/
           SET &K6  = +
              &SUBSTR(7:8,&SYSTIME)&SUBSTR(4:5,&SYSTIME)+
              &SUBSTR(1:2,&SYSTIME)                            /* @B1A*/
           SET &K6  = &K6 + 1                                  /* @B1A*/
           SET &KX  = &STR(&SYSSRV)                            /* @B1A*/
           SET &L   = &LENGTH(&KX)                             /* @B1A*/
           SET &KX  = &SUBSTR(&L-1:&L,&KX)                     /* @B1A*/
           SET &K6  = ((&K6 * &KX) // &EBCDV) + 1              /* @B1A*/
           SET &K7  = (&SYSSRV + &SYSPRIMARY) + 7              /* @B1A*/
           SET &K7  = (&K7 // &EBCDV) + 1                      /* @B1A*/
           SET &CPU = &STR(&SYSCPU)                            /* @B1A*/
           SET &L   = &LENGTH(&CPU)                            /* @B1A*/
           SET &L   = &L / 2                                   /* @B1A*/
           SET &K8  = &SUBSTR(&L:&L,&CPU)                      /* @B1A*/
           IF  &STR(&K8) = &STR(.) THEN DO                     /* @B1A*/
             SET &L = &L + 1                                   /* @B1A*/
             SET &K8  = &SUBSTR(&L:&L,&CPU)                    /* @B1A*/
           ENDO                                                /* @B1A*/
           SET &K8A = &SUBSTR(2:3,&SYSSRV)                     /* @B1A*/
           SET &K8  = &K8A - &K8
           IF  &K8 < 0 THEN +
             SET &K8 = &K8 + 999                               /* @B1A*/
           SET &KX  = +
              &SUBSTR(8:8,&SYSTIME)&SUBSTR(5:5,&SYSTIME)       /* @B1A*/
           SET &K8  = (((&K8 + 1) * (&KX + 1)) // &EBCDV) + 1  /* @B1A*/
           /***********************************************************/
           /* Select "random" insertion points for the user-supplied  */
           /* key and our portion.  If they supplied the entire key,  */
           /* we won't be here.                                       */
           /***********************************************************/
           IF &STR(&EKEY) NE &STR() THEN +
             SET &IPOS = (((&K1 + &K5) * 3) // 8) + 1          /* @B1A*/
           ELSE +
             SET &IPOS = 0                                     /* @B1A*/
           SET &SPOS = (((&K2 + &K6) * 6) // 8) + 1            /* @B1A*/
           SET &SADJ = &SPOS                                   /* @B1A*/
           SET &EKEYO = &STR()                                 /* @B1A*/
           DO &IK = 1 TO 8                                     /* @B1A*/
             IF &IPOS = &IK THEN DO       /* Insert user portion  @B1A*/
               SET &EKEYO = &STR(&EKEYO.&EKEY)                 /* @B1A*/
               SET &INC = &LENGTH(&STR(&EKEY)) - 1             /* @B1A*/
               SET &IK = &IK + &INC                            /* @B1A*/
               SET &SADJ = &SADJ + &INC                        /* @B1A*/
             ENDO                                              /* @B1A*/
             ELSE DO                                           /* @B1A*/
               SET &ICHR = &STR(&&K&SADJ)  /* Index value         @B1A*/
               SET &ICHR = &ICHR                               /* @B1A*/
               SET &ECHR = &SUBSTR(&ICHR:&ICHR,&NRSTR(&EBCCH)) /* @B1A*/
               SET &EKEYO = &STR(&EKEYO.&ECHR)                 /* @B1A*/
               SET &SADJ = &SADJ + 1                           /* @B1A*/
             ENDO                                              /* @B1A*/
             IF &SADJ > 8 THEN +
               SET &SADJ = &SADJ - 8                           /* @B1A*/
           ENDO                                                /* @B1A*/
           SET &LENK = &LENGTH(&STR(&EKEYO))                   /* @B1A*/
           IF &LENK > 8 THEN DO                                /* @B1A*/
             IF &SPOS > 1 THEN DO                              /* @B1A*/
               SET &KP1 = &SUBSTR(&SPOS:&LENK,&STR(&EKEYO))    /* @B1A*/
               SET &KP2 = &SUBSTR(1:&SPOS-1,&STR(&EKEYO))      /* @B1A*/
               SET &EKEY = &SUBSTR(1:8,&STR(&KP1.&KP2))        /* @B1A*/
             ENDO                                              /* @B1A*/
             ELSE +
               SET &EKEY = &SUBSTR(1:8,&STR(&EKEYO))           /* @B1A*/
           ENDO                                                /* @B1A*/
           ELSE +
             SET &EKEY = &STR(&EKEYO)                          /* @B1A*/
         ENDO                                                  /* @B1A*/
         /*************************************************************/
         /* List the output files for a split tersed file.            */
         /* Trim the base name if it's too long for the suffix.       */
         /*************************************************************/
         IF &TRSPLIT = 1 THEN DO
           SET &L = &LENGTH(&STR(&MVSDSN))
           /***********************************************************/
           /* Encrypted parts need to maintain their type designation.*/
           /***********************************************************/
           IF &TYPE = &STR(ECR) AND &L > 38 THEN DO            /* @B1A*/
             SET &ETYP = &SUBSTR(&L-2:&L,&MVSDSN)              /* @B1A*/
             SET &MVSDSN = &SUBSTR(1:34,&MVSDSN)               /* @B1A*/
             IF &SUBSTR(34:34,&MVSDSN) = &STR(.) THEN +
               SET &MVSDSN = &MVSDSN.&ETYP                     /* @B1A*/
             ELSE +
               SET &MVSDSN = &MVSDSN..&ETYP                    /* @B1A*/
             SET &L = &LENGTH(&STR(&MVSDSN))                   /* @B1A*/
           ENDO  /* save some ECR or ECD                          @B1A*/
           ELSE IF &TYPE NE &STR(ECR) AND &L > 38 THEN DO      /* @B1C*/
             SET &MVSDSN = &SUBSTR(1:&L-4,&STR(&MVSDSN)) /* Lose TRS  */
             SET &L = &LENGTH(&STR(&MVSDSN))
           ENDO /* Too long - dump TRS                                */
           IF &L > 38 THEN DO    /* still too long */
             SET &MVSDSN = &SUBSTR(1:38,&STR(&MVSDSN)) /*just trim it */
             IF &SUBSTR(38:38,&STR(&MVSDSN)) = &STR(.) THEN +
               SET &MVSDSN = &SUBSTR(1:37,&STR(&MVSDSN))
           ENDO  /* Still too long                                  */
           WRITE * Intermediate files to be created (&WRKTXT):
 /* @B1A*/ IF &TYPE = &STR(ECR) THEN +
             WRITE * &ENCDSN
           WRITE * &MVSDSN..P1OF&PARTO::P&PARTO.OF&PARTO
           WRITE *
           IF &FTPSTP = 1 THEN DO
             WRITE * Output files:
/* @C1C*/    IF &STR(&EMDSN) = &STR() THEN +
               SET &ODSN = &MYCASE(&STR(+
                 &PATH.&DSL.&STR(&SUBDIR.)&DLM.&TCDSN..P1OF&PARTO))
             ELSE DO                                           /* @C1A*/
               SET &ODSN = &STR(&EMDSN.&TYPESUF..P1OF&PARTO)   /* @C1A*/
               SET &TCDSN = &STR(&EMDSN.&TYPESUF)              /* @C1A*/
             ENDO                                              /* @C1A*/
             SET &THRU = &MYCASE(&STR(P&PARTO.OF&PARTO))
             WRITE * &ODSN::&THRU
             WRITE *
           ENDO
           WRITE * Note   : Intermediate files are deleted and +
                            replaced
           WRITE *          if they exist.
         ENDO
         /*************************************************************/
         /* For TSO XMIT with a partial name specified, create        */
         /* two work file names - one for the copy of matching        */
         /* members, and the other is the TSO XMIT output.            */
         /*************************************************************/
         ELSE IF &TYPE = &STR(XMT) AND &XMTFLAG = 0 AND &WC = 2 +
          THEN DO
           SET &L = &LENGTH(&STR(&MVSDSN))
           SET &MVSDSN = &SUBSTR(1:&L-4,&STR(&MVSDSN))
           IF &SUBSTR(&L-4:&L-4,&STR(&MVSDSN)) = &STR(.) THEN +
             SET &MVSDSN = &SUBSTR(1:&L-5,&STR(&MVSDSN))
           SET &MVSCDSN = &STR(&MVSDSN..CPY)
           SET &MVSXDSN = &STR(&MVSDSN..XMT)
           WRITE * Intermediate files to be created (&WRKTXT):
           WRITE *  &MVSCDSN.
           WRITE *  &MVSXDSN.
           WRITE *
           IF &FTPSTP = 1 THEN DO
             WRITE * Output file :
             SET &ODSN = +
                 &MYCASE(&STR(&PATH.&DSL.&STR(&SUBDIR.)&DLM.&TCDSN))
             WRITE *  &ODSN
             WRITE *
             WRITE * Userid on remote system: &USERID
             WRITE *
           ENDO
           WRITE * Note   : Intermediate files are deleted and +
                            replaced
           WRITE *          if they exist.
         ENDO
         /*************************************************************/
         /* List the output file for XMT or TRS or ECR.  Make it      */
         /* unique if necessary.                                      */
         /*************************************************************/
         ELSE IF (&TYPE = &STR(XMT) AND &XMTFLAG = 0) +
              OR (&TYPE = &STR(TRS) AND &TRSFLAG = 0) +
              OR  &TYPE = &STR(ECR) THEN DO                    /* @B1C*/
           IF &STR(&DSN) = &STR(&MVSDSN) THEN DO
             DO &I = &L TO 1 BY -1
               IF &SUBSTR(&I:&I,&STR(&MVSDSN)) = &STR(.) THEN DO
                 SET &LEN = &L-&I
                 SET &X = &EVAL(&SUBSTR(7:8,&SYSTIME) + 1)     /* @B1A*/
                 SET &X = (&X / 3) + 1                         /* @B1A*/
                 SET &IPOS = &LENGTH(&STR(&MVSCH)) - &LEN      /* @B1A*/
                 SET &IPOS = &IPOS - &X                        /* @B1A*/
                 SET &LQ = &SUBSTR(&IPOS:&LEN,&STR(&MVSCH))    /* @B1C*/
                 SET &MVSDSN = &SUBSTR(1:&I,&STR(&MVSDSN))&LQ
                 SET &I = 0                                    /* @B1A*/
               ENDO
             ENDO
           ENDO /* Dropped the only unique part - replace last        */
/* @B1A*/  WRITE * Intermediate file(s) to be created (&WRKTXT):
           IF &TYPE = &STR(ECR) THEN DO                        /* @B1A*/
             WRITE *  &ENCDSN.
             WRITE *  &TRSDSN
           ENDO                                                /* @B1A*/
           ELSE +
             WRITE *  &MVSDSN.
           WRITE *
           IF &FTPSTP = 1 THEN DO
             WRITE * Output file :
/* @C1C*/    IF &STR(&EMDSN) = &STR() THEN +
               SET &ODSN = +
                  &MYCASE(&STR(&PATH.&DSL.&STR(&SUBDIR.)&DLM.&TCDSN))
             ELSE DO                                           /* @C1A*/
               SET &EMDSN = &STR(&EMDSN.&TYPESUF)              /* @C1A*/
               SET &TCDSN = &STR(&EMDSN)                       /* @C1A*/
               SET &ODSN = &STR(&EMDSN)                        /* @C1A*/
             ENDO                                              /* @C1A*/
             WRITE *  &ODSN
             WRITE *
           ENDO
           WRITE * Note   : Intermediate files are deleted and +
                            replaced
           WRITE *          if they exist.
         ENDO
         ELSE DO
           WRITE * Output file :
/* @C1C*/  IF &STR(&EMDSN) = &STR() THEN +
             SET &ODSN = +
                 &MYCASE(&STR(&PATH.&DSL.&STR(&SUBDIR.)&DLM.&TCDSN))
           ELSE DO                                             /* @C1A*/
             SET &EMDSN = &STR(&EMDSN.&TYPESUF)                /* @C1A*/
             SET &TCDSN = &STR(&EMDSN)                         /* @C1A*/
             SET &ODSN = &STR(&EMDSN)                          /* @C1A*/
           ENDO                                                /* @C1A*/
           WRITE *  &ODSN
         ENDO
         WRITE *
         IF &TYPE = &STR(TXT) AND &REMOTMVS = 0 THEN +
           WRITE * Type   : TXT - Text file, translate to ASCII
         ELSE IF &TYPE = &STR(TXT) THEN +
           WRITE * Type   : TXT - Text file
         ELSE IF &TYPE = &STR(BIN) THEN +
           WRITE * Type   : BIN - Binary file, no translation
         ELSE IF &TYPE = &STR(XMT) AND &XMTFLAG = 0 THEN DO
           IF &WC = 2 THEN +
            WRITE * Type   : XMT - Copy members, perform TSO XMIT&BINTXT
           ELSE +
             WRITE * Type   : XMT - Perform TSO XMIT&BINTXT
         ENDO
         ELSE IF &TYPE = &STR(XMT) AND &XMTFLAG = 1 THEN +
           WRITE * Type   : XMT - TSO XMIT file&BINTXT
         ELSE IF &TYPE = &STR(TRS) AND &TRSFLAG = 0 THEN DO
           IF &TRSPLIT = 0 THEN +
             WRITE * Type   : TRS - Perform terse&BINTXT
           ELSE DO
             WRITE * Type   : TRS - Large file, terse, split+
                                    &BINTXT
           ENDO
         ENDO
         ELSE IF &TYPE = &STR(TRS) AND &TRSFLAG = 1 THEN DO
           IF &TRSPLIT = 0 THEN +
             WRITE * Type   : TRS - Tersed file&BINTXT
           ELSE DO
             WRITE * Type   : TRS - Large tersed file, split&BINTXT
           ENDO
         ENDO
         ELSE IF &TYPE = &STR(ECR) AND &TRSFLAG = 0 THEN DO    /* @B1A*/
           IF &TRSPLIT = 0 THEN +
             WRITE * Type   : ECR - Perform terse, encrypt&BINTXT
           ELSE DO                                             /* @B1A*/
             WRITE * Type   : TRS - Large file, terse, encrypt, split+
                                    &BINTXT
           ENDO                                                /* @B1A*/
 /* @B1A*/ WRITE * Key    : &STR('&EKEY') (Will be logged)
         ENDO                                                  /* @B1A*/
         ELSE IF &TYPE = &STR(ECR) AND &TRSFLAG = 1 THEN DO    /* @B1A*/
           IF &TRSPLIT = 0 THEN +
             WRITE * Type   : TRS - Tersed file, encrypt&BINTXT
           ELSE DO                                             /* @B1A*/
             WRITE * Type   : TRS - Large tersed file, encrypt, +
                     split&BINTXT
           ENDO                                                /* @B1A*/
 /* @B1A*/ WRITE * Key    : &STR('&EKEY') (Will be logged)
         ENDO                                                  /* @B1A*/
         ELSE DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> Unexpected TYPE=&TYPE TRSFLAG=&TRSFLAG +
                    XMTFLAG=&XMTFLAG combination
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT
         ENDO
PRMPT4A: WRITE &DELMLN
         WRITE   Submit the job                         = or =
         WRITE   Change the disposition of data sets    = or =
         IF &REMOTMVS = 1 AND +
           (&TYPE = &STR(BIN) OR &TYPE = &STR(TXT)) THEN DO
           WRITE   .......the DCB of the output file      = or =
         ENDO
         WRITENR   Quit?                     (Enter S,C,or Q) ==>
         SET &SYSASIS = &STR(OFF)
         READ &ANS
         SET &SYSASIS = &STR(ON)
         IF &STR(&ANS) = &STR(S) THEN GOTO DELWORK
         ELSE IF &STR(&ANS) = &STR(Q) THEN GOTO GETOUT
         ELSE IF &STR(&ANS) = &STR(QUIT) THEN GOTO GETOUT
         ELSE IF &STR(&ANS) NE &STR(C) THEN DO
           WRITE   >>> Response not understood
           GOTO PRMPT4A
         ENDO
         /*************************************************************/
         /* Allow override of DCB for target MVS TXT and BIN          */
         /*************************************************************/
         IF &REMOTMVS = 0 OR +
           (&TYPE NE &STR(BIN) AND &TYPE NE &STR(TXT)) THEN DO
           &CLRSCRN                                            /* @B1A*/
           WRITE
           WRITE &DELMLN
           WRITE *         Override data set disposition
           WRITE *  Press enter at any prompt to keep data unchanged
           WRITE *
           WRITE *  DCB override not allowed - must be Text or Binary
           WRITE *  on a target MVS system
           WRITE &DELMLN
           WRITENR ***
           READ &ANS
           GOTO CNFMM5
         ENDO
         WRITE
         WRITE &DELMLN
         WRITE *      Override data set disposition or DCB
         WRITE *  Press enter at any prompt to keep data unchanged
         WRITE &DELMLN
         WRITENR ***
         READ &ANS
         SET &NEWRECFM = &SYSRECFM
         SET &NEWBLKSIZE = &SYSBLKSIZE
         SET &NEWLRECL = &SYSLRECL
OVRDCB:  WRITE
         &CLRSCRN
         WRITE &DELMLN
         WRITE * Override DCB for &ODSN
         WRITE *
         WRITE * Current LRECL     &NEWLRECL
         WRITE * Current BLKSIZE   &NEWBLKSIZE
         WRITE * Current RECFM     &NEWRECFM
         WRITE &DELMLN
         WRITE
         WRITENR Enter new LRECL or press enter to bypass change ==>
         SET &SYSASIS = &STR(OFF)
         READ &DCBANS
         SET &SYSASIS = &STR(ON)
         IF &DCBANS NE &STR() THEN DO
           IF &DCBANS = &STR(QUIT) THEN GOTO GETOUT
           SET &NEWLRECL = &DCBANS
           SET &NEWDCB = 1
         ENDO
         WRITENR Enter new BLKSIZE or press enter to bypass change ==>
         SET &SYSASIS = &STR(OFF)
         READ &DCBANS
         SET &SYSASIS = &STR(ON)
         IF &DCBANS NE &STR() THEN DO
           IF &DCBANS = &STR(QUIT) THEN GOTO GETOUT
           SET &NEWBLKSIZE = &DCBANS
           SET &NEWDCB = 1
         ENDO
         WRITENR Enter new RECFM (as in VB) or press enter to bypass +
           change ==>
         SET &SYSASIS = &STR(OFF)
         READ &DCBANS
         SET &SYSASIS = &STR(ON)
         IF &DCBANS NE &STR() THEN DO
           IF &DCBANS = &STR(QUIT) THEN GOTO GETOUT
           SET &NEWRECFM = &DCBANS
           SET &NEWDCB = 1
         ENDO
         IF &DATATYPE(&STR(&NEWLRECL)) NE &STR(NUM) OR +
            &DATATYPE(&STR(&NEWBLKSIZE)) NE &STR(NUM) OR +
            &DATATYPE(&STR(&NEWRECFM)) NE &STR(CHAR) THEN DO
           WRITE >>> LRECL    &NEWLRECL
           WRITE >>> BLKSIZE  &NEWBLKSIZE
           WRITE >>> RECFM    &NEWRECFM
           WRITE >>> Something is invalid format
           WRITENR ***
           READ &ANS
           GOTO OVRDCB
         ENDO
         SET &RECFML = &LENGTH(&NEWRECFM)
         IF &RECFML < 1 OR &RECFML > 4 THEN DO
           WRITE >>> Invalid RECFM  &NEWRECFM
           WRITENR ***
           READ &ANS
           GOTO OVRDCB
         ENDO
         SET &RECFM1 = &SUBSTR(1:1,&NEWRECFM)
         IF &RECFM1 NE &STR(D) AND +
            &RECFM1 NE &STR(F) AND +
            &RECFM1 NE &STR(U) AND +
            &RECFM1 NE &STR(V) THEN DO
           WRITE >>> Invalid RECFM  &NEWRECFM
           WRITENR ***
           READ &ANS
           GOTO OVRDCB
         ENDO
         IF &RECFML > 1 THEN DO
           SET &RECFM2 = &SUBSTR(2:2,&STR(&NEWRECFM))
           IF &RECFM2 NE &STR(A) AND +
              &RECFM2 NE &STR(B) AND +
              &RECFM2 NE &STR(M) AND +
              &RECFM2 NE &STR(S) AND +
              &RECFM2 NE &STR(T) THEN DO
             WRITE >>> Invalid RECFM  &NEWRECFM
             WRITENR ***
             READ &ANS                                         /* @AGA*/
             GOTO OVRDCB
           ENDO
           IF &RECFML > 2 THEN DO
             SET &RECFM3 = &SUBSTR(3:3,&STR(&NEWRECFM))
             IF &RECFM3 NE &STR(A) AND +
                &RECFM3 NE &STR(B) AND +
                &RECFM3 NE &STR(M) AND +
                &RECFM3 NE &STR(S) AND +
                &RECFM3 NE &STR(T) THEN DO
               WRITE >>> Invalid RECFM  &NEWRECFM
               WRITENR ***
               READ &ANS
               GOTO OVRDCB
             ENDO
             IF &RECFML > 3 THEN DO
               SET &RECFM4 = &SUBSTR(4:4,&STR(&NEWRECFM))
               IF &RECFM4 NE &STR(A) AND +
                  &RECFM4 NE &STR(M) AND +
                  &RECFM4 NE &STR(S) AND +
                  &RECFM4 NE &STR(T) THEN DO
                 WRITE >>> Invalid RECFM  &NEWRECFM
                 WRITENR ***
                 READ &ANS
                 GOTO OVRDCB
               ENDO
             ENDO
           ENDO
         ENDO
         IF &RECFM1 = &STR(F) THEN DO
           SET &DIVR = &NEWBLKSIZE // &NEWLRECL
           IF &DIVR NE 0 THEN DO
    WRITE >>> BLKSIZE &NEWBLKSIZE is not a multiple of LRECL &NEWLRECL
             WRITENR ***
             GOTO OVRDCB
           ENDO
         ENDO
         /*************************************************************/
         /* Ask to confirm migration settings                         */
         /*************************************************************/
CNFMM5:  SET &WHICH = 1
PRMPT5:  WRITE
         &CLRSCRN
         WRITE &DELMLN
         WRITE * Final disposition of data sets
         WRITE *
         IF &WHICH = 1 THEN +
           WRITE *   0 - No change  (forced for PDS)
         ELSE +
           WRITE *   0 - &MIGTXT0
         WRITE *   1 - &MIGTXT1
         WRITE *   2 - &MIGTXT2
         WRITE *  99 - &MIGTXT99 (work data sets only)
         WRITE *
WHCHON5: WRITE &DELMLN
         IF &WHICH = 1 THEN +
           WRITE * &DSN = &MIGTXTO
         ELSE +
           WRITE * Work data sets = &MIGTXTW
         WRITE &DELMLN
         WRITE
         IF &WHICH = 1 THEN +
           WRITENR   Press enter to confirm, or enter 0,1,2 ==>
         ELSE +
           WRITENR   Press enter to confirm, or enter 0,1,2,99 ==>
         READ &ANS
         IF &ANS = &STR(QUIT) OR +
            &ANS = &STR(quit) THEN GOTO GETOUT
         IF &ANS NE &STR() THEN DO
           IF (&WHICH = 2 AND &ANS = 99) OR +
              &ANS = 0 OR &ANS = 1 OR &ANS = 2 THEN DO
             IF &WHICH = 1 THEN +
               SET &MIGORIG = &ANS
             ELSE +
               SET &MIGWORK = &ANS
           ENDO
           ELSE DO
             WRITE
             WRITE   >>> Response not understood, please try again
             WRITENR ***
             READ &ANS
             GOTO PRMPT5
           ENDO
         ENDO
         IF &WHICH = 1 THEN DO
           SET &WHICH = 2
           WRITE
           GOTO WHCHON5
         ENDO
CKDISP5: IF (&STR(&MIGORIG) NE &STR(0) AND +
             &STR(&MIGORIG) NE &STR(1) AND +
             &STR(&MIGORIG) NE &STR(2)) OR +
            (&STR(&MIGWORK) NE &STR(0) AND +
             &STR(&MIGWORK) NE &STR(1) AND +
             &STR(&MIGWORK) NE &STR(2) AND +
             &STR(&MIGWORK) NE &STR(99)) THEN DO
           WRITE
           WRITE   >>> At least one disposition setting is unknown.
           WRITE   >>> Please make corrections at the prompt.
           WRITENR ***
           READ &ANS
           GOTO CNFMM5
         ENDO  /* Initial settings can be bad                         */
         /*************************************************************/
         /* Look for and delete existing split output files.          */
         /*************************************************************/
DELWORK: WRITE
         &CLRSCRN
         IF &TRSPLIT = 1 THEN DO
           SET &EXIST = 0
           DO &I = 1 TO &PARTO
             LISTC ENTRY('&MVSDSN..P&I.OF&PARTO')
             IF &LASTCC = 0 THEN DO
               WRITE &DELMLN
               WRITE * '&MVSDSN..P&I.OF&PARTO' exists
               SET &EXIST = &EXIST + 1
             ENDO
           ENDO
           IF &EXIST > 0 THEN DO
             WRITE *
             WRITE * Enter Y to confirm deletion(s)
             WRITE *    or N to quit
             WRITE &DELMLN
PRMPT6:      WRITE
             IF &EXIST > 1 THEN +
               WRITENR   Is it OK to delete these files? (Y or N) ==>
             ELSE +
               WRITENR   Is it OK to delete this file? (Y or N) ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(N) THEN GOTO GETOUT
             IF &ANS NE &STR(Y) THEN DO
               WRITE   >>> Response not understood
               GOTO PRMPT6
             ENDO
             DO &I = 1 TO &PARTO
               DELETE '&MVSDSN..P&I.OF&PARTO' PURGE
             ENDO
             WRITE
           ENDO
         ENDO /* Look for existing Split data sets                    */
         /*************************************************************/
         /* Look for and delete existing TRS output file              */
         /*************************************************************/
         IF &TYPE = &STR(TRS) AND &TRSFLAG = 0 THEN DO
           LISTC ENTRY('&MVSDSN.')
           IF &LASTCC = 0 THEN DO
             WRITE &DELMLN
             WRITE * '&MVSDSN.' exists
             WRITE *
             WRITE * Enter Y to confirm deletion
             WRITE *    or N to quit
             WRITE &DELMLN
PRMPT7:      WRITE
             WRITENR  Is it OK to delete this file? (Y or N) ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(N) THEN GOTO GETOUT
             IF &ANS NE &STR(Y) THEN DO
               WRITE   >>> Response not understood
               GOTO PRMPT7
             ENDO
             DELETE '&MVSDSN.' PURGE
           ENDO
         ENDO /* Tersed output file                                   */
         /*************************************************************/
         /* Look for and delete existing XMT work files               */
         /* for partial member list.  Create the copy PDS.            */
         /*************************************************************/
         IF &TYPE = &STR(XMT) AND &XMTFLAG = 0 AND &WC = 2 THEN DO
           SET &EXIST = 0
           LISTC ENTRY('&MVSCDSN')
           IF &LASTCC = 0 THEN DO
             WRITE &DELMLN
             WRITE * '&MVSCDSN' exists
             SET &EXIST = &EXIST + 1
           ENDO
           LISTC ENTRY('&MVSXDSN')
           IF &LASTCC = 0 THEN DO
             WRITE &DELMLN
             WRITE * '&MVSXDSN' exists
             SET &EXIST = &EXIST + 1
           ENDO
           IF &EXIST > 0 THEN DO
             WRITE &DELMLN
             WRITE *
             WRITE * Enter Y to confirm deletion
             WRITE *    or N to quit
             WRITE &DELMLN
PRMPT8:      WRITE
             IF &EXIST > 1 THEN +
               WRITENR   Is it OK to delete these files? (Y or N) ==>
             ELSE +
               WRITENR   Is it OK to delete this file? (Y or N) ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(N) THEN GOTO GETOUT
             IF &ANS NE &STR(Y) THEN DO
               WRITE   >>> Response not understood
               GOTO PRMPT8
             ENDO
             DELETE '&MVSCDSN.' PURGE
             DELETE '&MVSXDSN.' PURGE
           ENDO
           ALLOC DA('&MVSCDSN') NEW CATALOG +
             LIKE('&DSN') UNIT(&WKUNIT) RELEASE                /* @C1C*/
           SET &CDSNALL = 1  /* Data set is allocated                 */
           SET &L = &LENGTH(&STR(&MEMBER)) - 1
           SET &MATCH = &SUBSTR(1:&L,&STR(&MEMBER))
           SET &NUMM = 0 /* Number of name matches                    */
           LISTDS '&DSN' MEMBERS
           DO &I = &SYSOUTLINE TO 1 BY -1
             SET &SLINE = &&SYSOUTLINE&I
             SET &LS = &LENGTH(&STR(&SLINE))
             SET &MEMNAME = &SUBSTR(3:&LS,&STR(&SLINE))
             IF &STR(&MEMNAME) = &STR(MEMBERS--) THEN +
               SET &I = 0
             ELSE IF &LENGTH(&STR(&MEMNAME)) >= &L THEN DO
               SET &MEMMTCH = &SUBSTR(1:&L,&MEMNAME)
               IF &MEMMTCH = &STR(&MATCH) THEN DO
                 REPRO INDATASET('&DSN.(&MEMNAME)') +
                       ODS('&MVSCDSN.(&MEMNAME)')
                 SET &NUMM = &NUMM + 1
               ENDO
               ELSE IF &MEMMTCH < &MATCH THEN +
                 SET &I = 0
             ENDO  /* Member name is long enough to match             */
           ENDO  /* Scan member names (backwards)                     */
           FREE DA('&MVSCDSN')
           IF &NUMM = 0 THEN DO
             WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             WRITE   >>> No members matched '&MEMBER' in data set
             WRITE   >>> &DSN.
             WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
           ELSE DO
             WRITE   ************************************************
             WRITE   *  &NUMM matching members found in
             WRITE   *  &DSN..
             WRITE   ************************************************
             /*********************************************************/
             /* Log the actual size of the copy PDS by calling        */
             /* DSATTR (ensure we return here).  The sizes logged for */
             /* members sent as individual files (not in a copy PDS)  */
             /* and data sets that are tersed in the batch job are    */
             /* not the actual size because it is impractical to      */
             /* report their actual size.  Member names sent using    */
             /* wildcards via mput as individual files are not logged */
             /* individually for the same reason.                     */
             /*********************************************************/
             SET &ATTRET = &STR(COPYBK)                        /* @C1A*/
             SET &DSNC = &STR(&MVSCDSN)                        /* @C1A*/
             GOTO DSATTR                                       /* @C1A*/
COPYBK:      WRITENR ***
             READ &ANS
           ENDO
         ENDO /* TSO XMIT with partial member name                    */
         /*************************************************************/
         /* Look for and delete existing XMT output file              */
         /*************************************************************/
         ELSE IF &TYPE = &STR(XMT) AND &XMTFLAG = 0 THEN DO
           LISTC ENTRY('&MVSDSN.')
           IF &LASTCC = 0 THEN DO
             WRITE &DELMLN
             WRITE * '&MVSDSN.' exists
             WRITE *
             WRITE * Enter Y to confirm deletion
             WRITE *    or N to quit
             WRITE &DELMLN
PRMPT9:      WRITE
             WRITENR   Is it OK to delete this file? (Y or N) ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &ANS = &STR(N) THEN GOTO GETOUT
             IF &ANS NE &STR(Y) THEN DO
               WRITE   >>> Response not understood
               GOTO PRMPT9
             ENDO
             DELETE '&MVSDSN.' PURGE
           ENDO
         ENDO /* Tersed output file                                   */
         IF &FTPSTP = 0 THEN +
           GOTO BLDJCL  /* Bypass the FTP step altogether             */
         /*************************************************************/
         /* If a sub directory is being used, create a separate FTP   */
         /* step to create it.  Do not set an error condition if the  */
         /* MKDIR fails.  This is the simplest way of handling        */
         /* multiple files to the same directory.  Note that the      */
         /* SUBDIR field is always nulls if the remote host is MVS.   */
         /*************************************************************/
         IF &STR(&SUBDIR) NE &STR() THEN DO
           DELETE '&OUTHLQ..&PDMLQS..FTPMKD' PURGE
           ALLOC DA('&OUTHLQ..&PDMLQS..FTPMKD') +
             FI(MKDFILE) +
             UNIT(&WKUNIT) TRACKS SPACE(1 1) NEW CATALOG REUSE +
             LRECL(128) RECFM(F B) BLKSIZE(6144)
           SET &MKDALLO = 1 /* Data set is allocated                  */
           OPENFILE MKDFILE OUTPUT
           SET &MKDOPEN = 1
           SET &MKDFILE = &STR(&GOHOST +
             &LFP.timeout 720)
           PUTFILE MKDFILE
           SET &MKDFILE = &STR(&USERID)
           PUTFILE MKDFILE
           SET &MKDFILE = &STR(&PASSWD)
           PUTFILE MKDFILE
           IF &STR(&MOREL) NE &STR() THEN DO
             SET &MKDFILE = &STR(&MOREL)
             PUTFILE MKDFILE
           ENDO
           IF &STR(&MOR2L) NE &STR() THEN DO                   /* @B7A*/
             SET &MKDFILE = &STR(&MOR2L)                       /* @B7A*/
             PUTFILE MKDFILE                                   /* @B7A*/
           ENDO                                                /* @B7A*/
           IF &STR(&MOR3L) NE &STR() THEN DO                   /* @B7A*/
             SET &MKDFILE = &STR(&MOR3L)                       /* @B7A*/
             PUTFILE MKDFILE                                   /* @B7A*/
           ENDO                                                /* @B7A*/
           SET &MKDFILE = &STR(cd &CDPATH.)
           PUTFILE MKDFILE
           SET &MKDFILE = &STR(mkdir &SUBDIR.)
           PUTFILE MKDFILE
           SET &MKDFILE = &STR(quit)
           PUTFILE MKDFILE
           CLOSFILE MKDFILE  /* FTP input is built                    */
           SET &MKDOPEN = 0
         ENDO
         /*************************************************************/
         /* Allocate the FTP Transfer batch file                      */
         /*************************************************************/
         DELETE '&OUTHLQ..&PDMLQS..FTPBAT' PURGE
         ALLOC DA('&OUTHLQ..&PDMLQS..FTPBAT') +
           FI(BATFILE) +
           UNIT(&WKUNIT) TRACKS SPACE(1 1) NEW CATALOG REUSE +
           LRECL(128) RECFM(F B) BLKSIZE(6144)
         SET &BATALLO = 1 /* Data set is allocated                    */
         OPENFILE BATFILE OUTPUT
         SET &BATOPEN = 1
         SET &BATFILE = &STR(&GOHOST +
           &LFP.timeout &TCTIMEOUT exit=12)                    /* @BBC*/
         PUTFILE BATFILE
         SET &BATFILE = &STR(&USERID)
         PUTFILE BATFILE
         SET &BATFILE = &STR(&PASSWD)
         PUTFILE BATFILE
         IF &STR(&MOREL) NE &STR() THEN DO
           SET &BATFILE = &STR(&MOREL)
           PUTFILE BATFILE
         ENDO
         IF &STR(&MOR2L) NE &STR() THEN DO                     /* @B7A*/
           SET &BATFILE = &STR(&MOR2L)                         /* @B7A*/
           PUTFILE BATFILE                                     /* @B7A*/
         ENDO                                                  /* @B7A*/
         IF &STR(&MOR3L) NE &STR() THEN DO                     /* @B7A*/
           SET &BATFILE = &STR(&MOR3L)                         /* @B7A*/
           PUTFILE BATFILE                                     /* @B7A*/
         ENDO                                                  /* @B7A*/
         SET &BATFILE = &STR(cd &CDPATH.)
         PUTFILE BATFILE
         IF &STR(&SUBDIR) NE &STR() THEN DO
           SET &BATFILE = &STR(cd &SUBDIR.)
           PUTFILE BATFILE
         ENDO
         IF &REMOTMVS = 0 THEN DO
           SET &BATFILE = &STR(SENDSITE)
           PUTFILE BATFILE
         ENDO
         /*************************************************************/
         /* Allocate the JCL file                                     */
         /*************************************************************/
BLDJCL:  DELETE '&OUTHLQ..&PDMLQS..JCL' PURGE
         ALLOC DA('&OUTHLQ..&PDMLQS..JCL') +
           FI(JCLFILE) +
           UNIT(&WKUNIT) TRACKS SPACE(1 1) NEW CATALOG REUSE +
           LRECL(80) RECFM(F B) BLKSIZE(9040)
         SET &JCLALLO = 1 /* Data set is allocated                    */
         OPENFILE JCLFILE OUTPUT
         SET &JCLOPEN = 1
         SET &STARLN = &STR(//************************************)+
                       &STR(*******************************)
         /*************************************************************/
         /* See if JOB cards are in a file.                           */
         /*************************************************************/
         SET &SUBS = 0  /* Have we done this before                   */
         SET &JCFILE = &STR()
         IF &STR(&JOBCDSN) NE &STR() THEN DO
           /* Read the JOB cards from a file                          */
           IF &SUBSTR(1:1,&STR(&JOBCDSN)) = &STR(/) THEN DO
             SET &JCFILE = &STR(&TQUAL..PUTDOC.JOB.CARDS)
             DELETE &JCFILE PURGE
             ALLOC DA(&JCFILE) FI(JOBCARDS) +
               REUSE NEW CATALOG SPACE(1 0) TRACKS UNIT(&WKUNIT) +
               RECFM(F B) LRECL(80) DSORG(PS) BLKSIZE(9040)
             OGET '&JOBCDSN' +
                   &JCFILE +
                   TEXT
           ENDO
           ELSE +
             ALLOC DA('&JOBCDSN') FI(JOBCARDS) SHR REUSE
           SET &HOLDCC = &LASTCC
           IF &HOLDCC NE 0 THEN DO
             SET &SUBS = 1
             &CLRSCRN
             WRITE &DELMLN
             WRITE >>>  Unable to access &JOBC1
             WRITE >>>  The JOB card file will not be used
             WRITE &DELMLN
           ENDO
           ELSE DO
             OPENFILE JOBCARDS INPUT
             ERROR DO
               SET &JOBCARDS = &STR()
               RETURN
             ENDO
             GETFILE JOBCARDS
             SET &JOBC1 = &STR(&JOBCARDS)
             IF &STR(&JOBCARDS) NE &STR() THEN DO
               GETFILE JOBCARDS
               SET &JOBC2 = &STR(&JOBCARDS)
               IF &STR(&JOBCARDS) NE &STR() THEN DO
                 GETFILE JOBCARDS
                 SET &JOBC3 = &STR(&JOBCARDS)
               ENDO
             ENDO
             CLOSFILE JOBCARDS
             FREE FI(JOBCARDS)
           ENDO  /* File exists                                       */
         ENDO /* Get JOB cards from a file                            */
         IF &STR(&JCFILE) NE &STR() THEN +
           DELETE &JCFILE PURGE
         /*************************************************************/
         /* Look for any substitutions that must be made.             */
         /*************************************************************/
         SET &L1 = &LENGTH(&STR(&JOBC1))
         SET &L2 = &LENGTH(&STR(&JOBC2))
         SET &L3 = &LENGTH(&STR(&JOBC3))
         IF &STR(&JOBC2) NE &STR() THEN DO                     /* @B6A*/
           IF &SUBSTR(1:1,&STR(&JOBC2)) = &STR(/) AND +
              &SUBSTR(2:2,&STR(&JOBC2)) = &STR(*) THEN DO      /* @B6A*/
             SET &PART = &SUBSTR(3:&L2,&STR(&JOBC2))           /* @B6A*/
             SET &PART = &STR(&PART)                           /* @B6A*/
             SET &JOBC2 = &STR(/)&STR(*)&STR(&PART)            /* @B6A*/
           ENDO                                                /* @B6A*/
         ENDO                                                  /* @B6A*/
         IF &STR(&JOBC3) NE &STR() THEN DO                     /* @B6A*/
           IF &SUBSTR(1:1,&STR(&JOBC3)) = &STR(/) AND +
              &SUBSTR(2:2,&STR(&JOBC3)) = &STR(*) THEN DO      /* @B6A*/
             SET &PART = &SUBSTR(3:&L3,&STR(&JOBC3))           /* @B6A*/
             SET &PART = &STR(&PART)                           /* @B6A*/
             SET &JOBC3 = &STR(/)&STR(*)&STR(&PART)            /* @B6A*/
           ENDO                                                /* @B6A*/
         ENDO                                                  /* @B6A*/
         DO &I = 1 TO 3   /* Cycle through the JOB cards              */
           SET &L = &&L&I
           SET &JOBC = &&JOBC&I
           SET &IP = &SYSINDEX(&STR(??),&STR(&JOBC))
           IF &IP > 0 THEN DO WHILE (&IP > 0)
             SET &FPART = &SUBSTR(1:&IP-1,&STR(&JOBC))
             IF &EVAL(&IP+2) <= &L THEN +
               SET &LPART = &SUBSTR(&IP+2:&L,&STR(&JOBC))
             ELSE +
               SET &LPART = &STR()
             IF &SUBS = 0 THEN DO
               SET &SUBS = 1
               &CLRSCRN
               WRITE &DELMLN
               WRITE ** Insert data into JOB cards
             ENDO
DOOVER:      WRITE &DELMLN
             WRITE * Substitution(s) required in this JOB card
             WRITE *
             WRITE &FPART.<>&LPART
             WRITE *
             WRITE &DELMLN
             WRITENR Enter text to insert at <> ==>
             SET &SYSASIS = &STR(OFF)
             READ &ANS
             SET &SYSASIS = &STR(ON)
             IF &STR(&ANS) = &STR() THEN DO
               WRITE >>> A response is required
               GOTO DOOVER
             ENDO
             IF &STR(&ANS) = &STR(QUIT) THEN GOTO GETOUT
             SET &JOBC = &STR(&FPART.&ANS.&LPART)
             SET &L = &LENGTH(&STR(&JOBC))
             SET &IP = &SYSINDEX(&STR(??),&STR(&JOBC))
           ENDO
           ELSE IF &L > 0 THEN DO  /* No substitution at all          */
             IF &SUBS = 0 THEN DO
               SET &SUBS = 1
               &CLRSCRN
               WRITE &DELMLN
               WRITE ** Insert data into JOB cards
             ENDO
             WRITE &DELMLN
             WRITE * No Substitutions in this JOB card
             WRITE *
             WRITE &JOBC
             WRITE *
             WRITE &DELMLN
           ENDO
           SET &JOBC&I = &STR(&JOBC)
         ENDO
         SET &L1 = &LENGTH(&STR(&JOBC1))
         SET &L2 = &LENGTH(&STR(&JOBC2))
         SET &L3 = &LENGTH(&STR(&JOBC3))
         DO &I = 1 TO 3
           SET &LX = &&L&I
           SET &JOBC = &&JOBC&I
           DO &J = &LX TO 1 BY -1
             IF &SUBSTR(&J:&J,&JOBC) = &STR( ) THEN +
               SET &LX = &LX - 1
             ELSE +
               SET &J = -1
           ENDO
           IF &LX > 0 THEN +
             SET &JOBC&I = &SUBSTR(1:&LX,&STR(&JOBC))
           SET &L&I = &LX
         ENDO
         IF &L1 > 72 THEN DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> JOB Card 1 is too long
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT
         ENDO
         IF &L2 > 72 THEN DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> JOB Card 2 is too long
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT
         ENDO
         IF &L3 > 72 THEN DO
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           WRITE   >>> JOB Card 3 is too long
           WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
           GOTO GETOUT
         ENDO
         IF &L2 > 2 THEN IF +
            &SUBSTR(1:3,&STR(&JOBC2)) = &STR(// ) THEN DO
           IF &SUBSTR(&L1:&L1,&STR(&JOBC1)) NE &STR(,) THEN DO
             SET &JOBC1 = &STR(&JOBC1,)
             SET &L1 = &L1 + 1
           ENDO
           IF &L1 > 72 THEN DO
             WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             WRITE   >>> JOB Card 1 needed a comma and is now too long
             WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
             GOTO GETOUT
           ENDO
           IF &L3 > 2 THEN IF +
              &SUBSTR(1:3,&STR(&JOBC3)) = &STR(// ) THEN DO
             IF &SUBSTR(&L2:&L2,&STR(&JOBC2)) NE &STR(,) THEN DO
               SET &JOBC2 = &STR(&JOBC2,)
               SET &L2 = &L2 + 1
             ENDO
             IF &L2 > 72 THEN DO
               WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
               WRITE   >>> JOB Card 2 needed a comma and is now too long
               WRITE   >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
               GOTO GETOUT
             ENDO
           ENDO
         ENDO
         SET &JCLFILE = &STR(&JOBC1)
         PUTFILE JCLFILE
         IF &STR(&JOBC2) NE &STR() THEN DO
           SET &JCLFILE = &STR(&JOBC2)
           PUTFILE JCLFILE
         ENDO
         IF &STR(&JOBC3) NE &STR() THEN DO
           SET &JCLFILE = &STR(&JOBC3)
           PUTFILE JCLFILE
         ENDO
         SET &JCLFILE = &STR(&STARLN)
         PUTFILE JCLFILE
         SET &JCLFILE = &STR(//* SEND FILES TO TESTCASE SERVER)
         PUTFILE JCLFILE
         SET &JCLFILE = &STR(&STARLN)
         PUTFILE JCLFILE
         SET &SN = 0
         IF &PARTI > 1 THEN DO
           SET &INPF = &DSN1
           SET &DSN  = &DSN1
         ENDO
         ELSE +
           SET &INPF = &STR(&DSN)
         /*************************************************************/
         /* Handle TRS (file must be tersed) requests and ECR         */
         /* (file must be encrypted) requests (ECR implies TRS)       */
         /*************************************************************/
         IF (&TYPE = &STR(TRS) AND &TRSFLAG = 0) OR +
             &TYPE = &STR(ECR) THEN DO                         /* @B1C*/
           /***********************************************************/
           /* Build the pack step if the file is not already tersed   */
           /***********************************************************/
           IF &TRSFLAG = 0 THEN DO                             /* @B1A*/
             /*********************************************************/
             /* Shrink KBYTES for projected tersed size.          @BAC*/
             /*********************************************************/
             SET &KBYTES = &KBYTES / 5                         /* @BAM*/
             SET &JCLFILE = &STR(&STARLN)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//* PACK )&DSN
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(&STARLN)
             PUTFILE JCLFILE
             SET &SN = &SN + 1
             SET &JCLFILE = &STR(//PACKSTP  EXEC PGM=TRSMAIN,)
             IF &KBYTES > 780000 THEN +
               SET &JCLFILE = &STR(&JCLFILE.PARM=&SPACK)       /* @BAA*/
             ELSE +
               SET &JCLFILE = &STR(&JCLFILE.PARM=PACK)
             PUTFILE JCLFILE
             IF &STR(&TRSSTEPL) NE &STR() THEN DO
               SET &SYSASIS = &STR(OFF)
               SET &TRSSTEPL = &TRSSTEPL  /* uppercase, drop blanks   */
               SET &SYSASIS = &STR(ON)
               SET &JCLFILE = &STR(//STEPLIB  DD DSN=&TRSSTEPL,)
               PUTFILE JCLFILE
               SET &JCLFILE = &STR(//         DISP=SHR)
               PUTFILE JCLFILE
             ENDO
             SET &JCLFILE = &STR(//SYSPRINT DD SYSOUT=*)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//INFILE   DD DSN=&DSN.,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DISP=SHR,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DCB=(BUFNO=&BUFNO))
             PUTFILE JCLFILE
             DO &PI = 2 TO &PARTI
               SET &DSNC = &&DSN&PI
               SET &JCLFILE = &STR(//       DD DSN=&DSNC.,)
               PUTFILE JCLFILE
               SET &JCLFILE = &STR(//       DISP=SHR,)
               PUTFILE JCLFILE
               SET &JCLFILE = &STR(//       DCB=(BUFNO=&BUFNO))
               PUTFILE JCLFILE
             ENDO
             SET &DCBS = &STR(LRECL=1024,BLKSIZE=27648,+
                 RECFM=FB,BUFNO=&BUFNO)
             /*********************************************************/
             /* Adjust the output space value since the file          */
             /* is going to shrink.  If we are splitting the          */
             /* file, that step depends heavily on our                */
             /* guessing well here.                                   */
             /*********************************************************/
             SET &OTRKS = &OTRKS / 5                           /* @B1C*/
             IF &OTRKS > 90 THEN DO
               SET &SP1 = &OTRKS / &SYSTRKSCYL /* May not match, but..*/
               SET &SP2 = (&SP1 / 2) + 1
               SET &SP = &STR(CYL)
               SET &SPACE = &STR(CYLINDERS)
               IF &SP1 > &MAXCYLS THEN DO
                 SET &REMAIN = &SP1 - &MAXCYLS                 /* @BAC*/
                 SET &SP1 = &MAXCYLS
                 SET &SP2 = &SP2 + &REMAIN
                 IF &SP2 > &MAXCYLS THEN +
                   SET &SP2 = &MAXCYLS
               ENDO
               IF &SP1 = &MAXCYLS THEN +
                 SET &VCT = &MAXVOLS                           /* @BAC*/
               ELSE IF &SP1 > &MAXVOLTH1 THEN +
                 SET &VCT = (&MAXVOLS / 2) + 1                 /* @BAC*/
               ELSE IF &SP1 > &MAXVOLTH2 THEN +
                 SET &VCT = (&MAXVOLS / 3) + 1                 /* @BAC*/
               ELSE +
                 SET &VCT = 1
             ENDO
             ELSE DO
               SET &SP = &STR(TRK)
               SET &SPACE = &STR(TRACKS)
               SET &SP1 = &OTRKS
               SET &SP2 = (&OTRKS / 2) + 1
               SET &VCT = 1
             ENDO
             SET &JCLFILE = &STR(//OUTFILE  DD  DISP=(NEW,CATLG,CATLG),)
             PUTFILE JCLFILE
             IF &TYPE = &STR(ECR) THEN +
               SET &JCLFILE = &STR(//         DSN=&TRSDSN.,)   /* @B1A*/
             ELSE +
               SET &JCLFILE = &STR(//         DSN=&MVSDSN.,)   /* @B1C*/
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DCB=(&DCBS),)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         VOL=(,,,&VCT),)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         UNIT=&WKUNIT,)     /* @B1C*/
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         SPACE=)            /* @B1C*/
             SET &JCLFILE = &STR(&JCLFILE.(&SP,(&SP1,&SP2),RLSE))
             PUTFILE JCLFILE
           ENDO          /* File needs to be tersed               @B1A*/
           /***********************************************************/
           /* Encrypt files if requested - use OUTFILE from terse     */
           /* step or input data set name as appropriate.             */
           /***********************************************************/
           IF &TYPE = &STR(ECR) THEN DO                        /* @B1A*/
             SET &JCLFILE = &STR(&STARLN)                      /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             IF &TRSFLAG = 0 THEN +
               SET &TFILE = &TRSDSN    /* Use our tersed copy     @B1A*/
             ELSE +
               SET &TFILE = &DSN       /* Use tersed input file   @B1A*/
             SET &JCLFILE = &STR(//* Encrypt )&TFILE           /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(&STARLN)                      /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &SN = &SN + 1                                 /* @B1A*/
             SET &JCLFILE = &STR(//ENCSTP   EXEC PGM=&ENCPROGM,)/*@B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         PARM='&EKEY')      /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             IF &STR(&ENCSTEPL) NE &STR() THEN DO              /* @B1A*/
               SET &SYSASIS = &STR(OFF)                        /* @B1A*/
               SET &ENCSTEPL = &ENCSTEPL                       /* @B1A*/
               SET &SYSASIS = &STR(ON)                         /* @B1A*/
               SET &JCLFILE = &STR(//STEPLIB DD DSN=&ENCSTEPL,)
               PUTFILE JCLFILE                                 /* @B1A*/
               SET &JCLFILE = &STR(//       DISP=SHR)
               PUTFILE JCLFILE                                 /* @B1A*/
             ENDO                                              /* @B1A*/
             SET &JCLFILE = &STR(//SYSPRINT DD SYSOUT=*)       /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//SYSOUT   DD SYSOUT=*)       /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//FIN      DD DSN=&TFILE,)    /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         DISP=SHR,)         /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         DCB=(BUFNO=&BUFNO)) /*@B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             DO &PI = 2 TO &PARTI    /* Combine tersed fragments  @B1A*/
               SET &DSNC = &&DSN&PI                            /* @B1A*/
               SET &JCLFILE = &STR(//         DD DSN=&DSNC.,)  /* @B1A*/
               PUTFILE JCLFILE                                 /* @B1A*/
               SET &JCLFILE = &STR(//         DISP=SHR,)       /* @B1A*/
               PUTFILE JCLFILE                                 /* @B1A*/
               SET &JCLFILE = &STR(//         DCB=(BUFNO=&BUFNO))
               PUTFILE JCLFILE                                 /* @B1A*/
             ENDO                                              /* @B1A*/
             SET &PARTI = 1                /* No longer in parts  @B1A*/
             /*********************************************************/
             /* Use the computations we made if we tersed the file    */
             /* for the output encrypted copy.  If we didn't terse    */
             /* the file (TRSFLAG is 1) we need to do them.           */
             /*********************************************************/
             IF &OTRKS > 90 AND &TRSFLAG = 1 THEN DO           /* @B1A*/
               SET &SP1 = &OTRKS / &SYSTRKSCYL                 /* @B1A*/
               SET &SP2 = (&SP1 / 2) + 1                       /* @B1A*/
               SET &SP = &STR(CYL)                             /* @B1A*/
               SET &SPACE = &STR(CYLINDERS)                    /* @B1A*/
               IF &SP1 > &MAXCYLS THEN DO
                 SET &REMAIN = &SP1 - &MAXCYLS                 /* @BAC*/
                 SET &SP1 = &MAXCYLS
                 SET &SP2 = &SP2 + &REMAIN
                 IF &SP2 > &MAXCYLS THEN +
                   SET &SP2 = &MAXCYLS
               ENDO
               IF &SP1 = &MAXCYLS THEN +
                 SET &VCT = &MAXVOLS                           /* @BAC*/
               ELSE IF &SP1 > &MAXVOLTH1 THEN +
                 SET &VCT = (&MAXVOLS / 2) + 1                 /* @BAC*/
               ELSE IF &SP1 > &MAXVOLTH2 THEN +
                 SET &VCT = (&MAXVOLS / 3) + 1                 /* @BAC*/
               ELSE +
                 SET &VCT = 1
             ENDO
             ELSE IF &TRSFLAG = 1 THEN DO                      /* @B1A*/
               SET &SP = &STR(TRK)                             /* @B1A*/
               SET &SPACE = &STR(TRACKS)                       /* @B1A*/
               SET &SP1 = &OTRKS                               /* @B1A*/
               SET &SP2 = (&OTRKS / 2) + 1                     /* @B1A*/
               SET &VCT = 1                                    /* @B1A*/
             ENDO                                              /* @B1A*/
             SET &JCLFILE = &STR(//FOUT     DD DISP=(NEW,CATLG,CATLG),)
             PUTFILE JCLFILE                                   /* @B1A*/
             IF &TYPE = &STR(ECR) THEN +
               SET &JCLFILE = &STR(//         DSN=&ENCDSN.,)   /* @B1A*/
             ELSE +
               SET &JCLFILE = &STR(//         DSN=&MVSDSN.,)   /* @B1C*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         VOL=(,,,&VCT),)    /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         UNIT=&WKUNIT,)     /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         DCB=(&TFILE,
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         BUFNO=&BUFNO&RP.,) /* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
             SET &JCLFILE = &STR(//         SPACE=)            /* @B1A*/
           SET &JCLFILE = &STR(&JCLFILE.(&SP,(&SP1,&SP2),RLSE))/* @B1A*/
             PUTFILE JCLFILE                                   /* @B1A*/
           ENDO /* File needs to be encrypted                  /* @B1A*/
           /***********************************************************/
           /* After building the step, put the appropriate commands   */
           /* in the file for the FTP step and set up for the         */
           /* migrate step. Hold off if TRSPLIT is on.                */
           /***********************************************************/
           IF &TRSPLIT = 0 THEN DO
             IF &MIGORIG > 0 AND &STR(&MEMBER) = &STR() THEN +
               SET &ORGFILE = &STR(&DSN)
             IF &MIGWORK > 0 THEN DO                           /* @B1A*/
               SET &WRKFIL1 = &STR(&MVSDSN)
               IF &STR(&MVSDSN) NE &STR(&TRSDSN) THEN +
                 SET &WRKFIL2 = &STR(&TRSDSN)  /* might be null   @B4C*/
             ENDO                                              /* @B1A*/
             IF &FTPSTP = 1 THEN DO
               IF &REMOTMVS = 1 THEN DO
                 SET &BATFILE = &STR(SITE &SPACE PRI=&SP1 SEC=&SP2)
                 PUTFILE BATFILE
               ENDO
               SET &BATFILE = &STR(binary)
               PUTFILE BATFILE
               IF &TYPE = &STR(ECR) THEN +
                 SET &BATFILE = &STR(put '&ENCDSN' + )
               ELSE +
                 SET &BATFILE = &STR(put '&MVSDSN' + )
               PUTFILE BATFILE
               SET &BATFILE = &MYCASE(&STR(  &TCDSN))
               SET &BATFILE = &EVAL(&BATFILE)
               PUTFILE BATFILE
             ENDO
           ENDO  /* No split in our future                            */
           ELSE DO                                             /* @B1C*/
             IF &TYPE = &STR(ECR) THEN +
               SET &INPF = &STR(&ENCDSN)                       /* @B1A*/
             ELSE +
               SET &INPF = &STR(&MVSDSN)
           ENDO   /* File needs to be split - set input file      @B1A*/
         ENDO /* File needing to be tersed                            */
         /*************************************************************/
         /* Handle XMT (file must be converted to TSO XMIT)           */
         /*************************************************************/
         ELSE IF &TYPE = &STR(XMT) AND &XMTFLAG = 0 THEN DO
           IF &WC = 2 THEN DO
             SET &IDSN = &MVSCDSN
             SET &XDSN = &MVSXDSN
           ENDO  /* Use the copy as input                             */
           ELSE DO
             SET &IDSN = &DSN
             SET &XDSN = &MVSDSN
           ENDO  /* Use regular files                                 */
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &TSTR = &STR( XMIT &IDSN TO FILE )
           SET &JCLFILE = &STR(//* )&TSTR
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &SN = &SN + 1
           SET &JCLFILE = &STR(//XMITSTP  EXEC PGM=IKJEFT01,)
           SET &JCLFILE = &STR(&JCLFILE.DYNAMNBR=20)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//SYSTSPRT DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//SYSOUT   DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//SYSPRINT DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &DCBS = &STR(LRECL=80,BLKSIZE=3120,+
               RECFM=FB,BUFNO=&BUFNO)
           IF &OTRKS > 90 THEN DO
             SET &SP1 = &OTRKS / &SYSTRKSCYL /* May not match, but..  */
             SET &SP2 = (&SP1 / 2) + 1
             SET &SP = &STR(CYL)
             SET &SPACE = &STR(CYLINDERS)
             IF &SP1 > &MAXCYLS THEN DO
               SET &REMAIN = &SP1 - &MAXCYLS                   /* @BAC*/
               SET &SP1 = &MAXCYLS
               SET &SP2 = &SP2 + &REMAIN
               IF &SP2 > &MAXCYLS THEN +
                 SET &SP2 = &MAXCYLS
             ENDO
             IF &SP1 = &MAXCYLS THEN +
               SET &VCT = &MAXVOLS                             /* @BAC*/
             ELSE IF &SP1 > &MAXVOLTH1 THEN +
               SET &VCT = (&MAXVOLS / 2) + 1                   /* @BAC*/
             ELSE IF &SP1 > &MAXVOLTH2 THEN +
               SET &VCT = (&MAXVOLS / 3) + 1                   /* @BAC*/
             ELSE +
               SET &VCT = 1
           ENDO
           ELSE DO
             SET &SP = &STR(TRK)
             SET &SPACE = &STR(TRACKS)
             SET &SP1 = &OTRKS
             SET &SP2 = (&OTRKS / 2) + 1
             SET &VCT = 1
           ENDO
           SET &JCLFILE = &STR(//XMITOT   DD DISP=(NEW,CATLG,CATLG),)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DSN=&XDSN.,)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DCB=(&DCBS),)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         VOL=(,,,&VCT),)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         UNIT=)
           SET &JCLFILE = &STR(&JCLFILE.&WKUNIT,SPACE=)
           SET &JCLFILE = &STR(&JCLFILE.(&SP,(&SP1,&SP2),RLSE))
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//XMITIN   DD DSN=&IDSN,)       /* @B1C*/
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DISP=SHR,)           /* @B1A*/
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DCB=(BUFNO=&BUFNO))
           PUTFILE JCLFILE
           DO &PI = 2 TO &PARTI
             SET &DSNC = &&DSN&PI
             SET &JCLFILE = &STR(//       DD DSN=&DSNC.,)      /* @B1C*/
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//       DISP=SHR,)           /* @B1A*/
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//       DCB=(BUFNO=&BUFNO))
             PUTFILE JCLFILE
           ENDO
           SET &JCLFILE = &STR(//SYSTSIN  DD    *)
           PUTFILE JCLFILE
           /***********************************************************/
           /* Use a dummy node and id for the xmit step.              */
           /***********************************************************/
           SET &JCLFILE = &STR( XMIT XNODE.XID +)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR( DATASET('&IDSN') +)            /* @BAC*/
           PUTFILE JCLFILE
           SET &JCLFILE = &STR( OUTFILE(XMITOT) +)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR( SYSOUT(*) +)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR( NONOTIFY NOEPILOG NOLOG)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(/*)
           PUTFILE JCLFILE
           /***********************************************************/
           /* After building the step, put the appropriate commands   */
           /* in the file for the FTP step and set up for the         */
           /* migrate step.                                           */
           /***********************************************************/
           IF &MIGORIG > 0 AND &STR(&MEMBER) = &STR() THEN +
             SET &ORGFILE = &STR(&DSN)
           IF &MIGWORK > 0 THEN DO
             SET &WRKFIL1 = &STR(&XDSN)
             IF &WC = 2 THEN +
               SET &WRKFIL2 = &STR(&MVSCDSN)
           ENDO
           IF &FTPSTP = 1 THEN DO
             IF &REMOTMVS = 1 THEN DO
               SET &BATFILE = &STR(SITE &SPACE PRI=&SP1 SEC=&SP2)
               PUTFILE BATFILE
             ENDO
             SET &BATFILE = &STR(binary)
             PUTFILE BATFILE
             SET &BATFILE = &STR(put '&XDSN' + )
             PUTFILE BATFILE
             SET &BATFILE = &MYCASE(&STR(  &TCDSN))
             SET &BATFILE = &EVAL(&BATFILE)
             PUTFILE BATFILE
           ENDO
         ENDO
         /*************************************************************/
         /* Handle TXT and BIN transfers, including files             */
         /* that were already tersed (no SPLITS, though), in          */
         /* TSO TRANSMIT format, or a PDS where multiple              */
         /* members were requested. Don't migrate a PDS.              */
         /*************************************************************/
         ELSE IF &TRSPLIT = 0 THEN DO
           IF &FTPSTP = 1 THEN DO
             IF &REMOTMVS = 1 THEN DO
               IF &OTRKS > 90 THEN DO
                 SET &SP1 = &OTRKS / &SYSTRKSCYL
                 SET &SP2 = (&SP1 / 2) + 1
                 SET &SP = &STR(CYL)
                 SET &SPACE = &STR(CYLINDERS)
                 IF &SP1 > &MAXCYLS THEN DO
                   SET &REMAIN = &SP1 - &MAXCYLS               /* @BAC*/
                   SET &SP1 = &MAXCYLS
                   SET &SP2 = &SP2 + &REMAIN
                   IF &SP2 > &MAXCYLS THEN +
                     SET &SP2 = &MAXCYLS
                 ENDO
                 IF &SP1 = &MAXCYLS THEN +
                   SET &VCT = &MAXVOLS                         /* @BAA*/
                 ELSE IF &SP1 > &MAXVOLTH1 THEN +
                   SET &VCT = (&MAXVOLS / 2) + 1               /* @BAA*/
                 ELSE IF &SP1 > &MAXVOLTH2 THEN +
                   SET &VCT = (&MAXVOLS / 3) + 1               /* @BAA*/
                 ELSE +
                   SET &VCT = 1                                /* @BAA*/
               ENDO
               ELSE DO
                 SET &SP = &STR(TRK)
                 SET &SPACE = &STR(TRACKS)
                 SET &SP1 = &OTRKS
                 SET &SP2 = (&OTRKS / 2) + 1
               ENDO
               SET &BATFILE = &STR(SITE &SPACE PRI=&SP1 SEC=&SP2)
               PUTFILE BATFILE
               IF &NEWDCB = 1 THEN DO
                 SET &BATFILE = &STR(SENDSITE)
                 PUTFILE BATFILE
                 SET &BATFILE = &STR(SITE lrecl=&NEWLRECL +
                                          blksize=&NEWBLKSIZE +
                                          recfm=&NEWRECFM)
                 PUTFILE BATFILE
               ENDO
             ENDO
             IF &TYPE = &STR(TXT) THEN DO
/* @C1C*/      IF &REMOTMVS < 1 THEN +
                 SET &BATFILE = &STR(ascii)
/* @C1A*/      ELSE +
                 SET &BATFILE = &STR(ebcdic)
               PUTFILE BATFILE
             ENDO
             ELSE DO
               SET &BATFILE = &STR(binary)
               PUTFILE BATFILE
             ENDO
             IF &WC > 0 THEN DO
               SET &BATFILE = &STR(lcd '&DSN' )
               PUTFILE BATFILE
               SET &BATFILE = &STR(mput &MEMBER )
               PUTFILE BATFILE
             ENDO
             ELSE DO
               IF &PARTI > 1 THEN DO   /* File was tersed and split */
                 SET &L = &LENGTH(&STR(&TCDSN))
                 SET &TCDSN = &SUBSTR(1:&L-8,&TCDSN)
                 DO &PI = 1 TO &PARTI
                   SET &DSNC = &&DSN&PI
                   SET &DSNC = &STR(&DSNC)                     /* @ALC*/
                   SET &BATFILE = &STR(put '&DSNC' + )
                   PUTFILE BATFILE
                   SET &OPDSN = &STR(&TCDSN..P&PI.OF&PARTI.)
                   SET &BATFILE = &MYCASE(&STR(  &OPDSN))
                   SET &BATFILE = &EVAL(&BATFILE)
                   PUTFILE BATFILE
                 ENDO
               ENDO
               ELSE DO
                 SET &BATFILE = &STR(put '&DSN' + )
                 PUTFILE BATFILE
                 SET &BATFILE = &MYCASE(&STR(  &TCDSN))
                 SET &BATFILE = &EVAL(&BATFILE)
                 PUTFILE BATFILE
               ENDO
             ENDO
           ENDO
           IF &STR(&MEMBER) = &STR() AND +
              &MIGORIG > 0 THEN +
             SET &ORGFILE = &STR(&DSN)
         ENDO
         /*************************************************************/
         /* Configure the space parameters like a TRS file            */
         /* so that the split function won't be confused.             */
         /*************************************************************/
         ELSE DO  /* File is going to be split                        */
           SET &SP1 = &OTRKS / &SYSTRKSCYL /* May not match, but..    */
           SET &SP2 = (&SP1 / 2) + 1
           SET &SP = &STR(CYL)
           SET &SPACE = &STR(CYLINDERS)
           SET &VCT = &MAXVOLS
         ENDO
         /*************************************************************/
         /* Handle any file, tersed by us or arrived tersed,          */
         /* that now needs to be split into parts.                    */
         /*************************************************************/
         IF &TRSPLIT = 1 THEN DO                               /* @BAA*/
           SET &JCLFILE = &STR(&STARLN)                        /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
/* @BAA*/  SET &JCLFILE = &STR(//* BUILD IDCAMS INPUT FOR )&INPF.
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(&STARLN)                        /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &SN = &SN + 1                                   /* @BAA*/
           /***********************************************************/
           /* Build the CLIST to create the input to IDCAMS           */
           /***********************************************************/
           SET &QCLIST = &STR(&SYSUID..&PDMLQS..CLIST)         /* @BAA*/
           ALLOC DA('&QCLIST') FI(QC) +
                 REUSE NEW CATALOG SPACE(1 1) TRACKS UNIT(&WKUNIT) +
                 RECFM(F B) LRECL(80) DSORG(PS) BLKSIZE(9040)  /* @BAA*/
           OPENFILE QC OUTPUT                                  /* @BAA*/
           SET &QC = &STR( PROC 1 RECS  )                      /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( CONTROL LIST CONLIST SYMLIST END(ENDO) )
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &&RECS = 0 THEN DO )             /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( LISTDSI '&INPF')                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&DSIRC = &&LASTCC )            /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &LP.&&DSIRC = 4 AND + )          /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR(     &&EVAL(&&SYSREASON) NE 19&RP. OR + )
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR(     &&DSIRC > 4 THEN DO )           /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( EXIT CODE(&&DSIRC)  )               /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* exit on failure */ )      /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( IF &&SYSUNITS NE &&STR(TRACK) THEN + ) /* @CM4 */
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&SYSUSED = &&SYSUSED * &&SYSTRKSCYL) /* @CM4 */
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&BLKS = &&SYSUSED * &&SYSBLKSTRK ) /* @C4M */
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&RECS = &&SYSBLKSIZE / 1024 )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&KBYTES = &&RECS * &&BLKS )    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&RECS = (&&KBYTES / &PARTO.) + 1)
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &&DSIRC = 4 AND + )              /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR(  &&EVAL(&&SYSREASON) = 19 THEN DO ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&SYSOUTTRAP=300              ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( LISTC ENTRY('&INPF') VOLUME       ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&NVOLS = 0                   ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( DO IV = 1 TO &&SYSOUTLINE         ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&SLINE = &&&&SYSOUTLINE&&IV )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( IF &&LENGTH(&&STR(&&SLINE)) > 11 THEN DO )
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&TXT = &&SUBSTR(1:12,&&STR(&&SLINE)) )
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/ SET &QC = &STR( IF &&STR(&&TXT) = &&STR(     VOLUMES) THEN DO)
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( DO SV = &&IV+2 TO &&SYSOUTLINE )    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&SLINE = &&&&SYSOUTLINE&&SV )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&VOLSER = &&SUBSTR(26:31,&STR(&&SLINE)))
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( IF &&STR(&&VOLSER) NE &&STR(-----*) THEN DO )
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&NVOLS = &&NVOLS + 1 )         /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&VOL&&NVOLS = &&STR(&&VOLSER)) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* Collect Volser */       ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ELSE +                          )   /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&SV = 99999                 )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* Scan volume list */   )   /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IV = 99999                )   /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* Get the volser info */  )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* line long enough */     )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* scan LISTC output */   )   /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( DO IL = 1 TO &&NVOLS           )    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&VOLSER = &&&&VOL&&IL     )    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( LISTDSI '&INPF' VOLUME(&&VOLSER) )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&DSIRC = &&LASTCC )            /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &LP.&&DSIRC = 4 AND + )          /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( &&EVAL(&&SYSREASON) NE 19&RP. OR + )/* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( &&DSIRC > 4 THEN DO )               /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( EXIT CODE(&&DSIRC)  )               /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* exit on failure */ )      /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &&SYSUNITS NE &&STR(TRACK) THEN +)/*@BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&SYSUSED = &&SYSUSED * &&SYSTRKSCYL)
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&BLKS = &&SYSUSED * &&SYSBLKSTRK )
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&RECS2 = &&SYSBLKSIZE / 1024 ) /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&KBYTES2 = &&RECS2 * &&BLKS )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
/* @BAA*/  SET &QC = &STR( SET &&RECS2 = (&&KBYTES2 / &PARTO.) + 1)
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&RECS = &&RECS + &&RECS2  )    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* list each volume */       /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* GET MULTIVOLUME DATA  */ )/* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO   /* MUST CALCULATE RECS */ )  /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( OPENFILE IDCINP OUTPUT )            /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( DO I = 1 TO &PARTO          )       /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IDCINP = +
                     &&STR( REPRO IFILE(INPFIL) + ) )          /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( PUTFILE IDCINP )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IDCINP = +
                     &&STR(      OFILE(OUTFIL&&I.) + ) )       /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( PUTFILE IDCINP )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &&I = 1 THEN DO )                /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IDCINP = +
                     &&STR(      COUNT(&&RECS) REUSE  ) )      /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( PUTFILE IDCINP )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* First fragment */ )        /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ELSE DO        )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( IF &&I < &PARTO THEN DO )           /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IDCINP = +
                     &&STR(      COUNT(&&RECS) REUSE + ) )     /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( PUTFILE IDCINP )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* Middle Fragment */  )      /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ELSE DO        )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IDCINP = +
                     &&STR(      REUSE  +))                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( PUTFILE IDCINP )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO    /* Last Fragment */  )      /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( SET &&IDCINP = +
                     &&STR(      SKIP(&&EVAL(&&RECS*(&&I-1))) )/* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( PUTFILE IDCINP )                    /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* Not First Fragment */  )   /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( ENDO  /* Do all Fragments */  )     /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           SET &QC = &STR( CLOSFILE IDCINP )                   /* @BAA*/
           PUTFILE QC                                          /* @BAA*/
           CLOSFILE QC                                         /* @BAA*/
           FREE FI(QC)                                         /* @BAA*/
           /***********************************************************/
           /* Now build the JCL step to run the CLIST             @BAA*/
           /***********************************************************/
           SET &JCLFILE = &STR(//BLDIDCIN  EXEC PGM=IKJEFT01,) /* @BAA*/
           SET &JCLFILE = &STR(&JCLFILE.DYNAMNBR=20,COND=(0,LT))/*@BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(//SYSTSPRT DD SYSOUT=*)         /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(//SYSOUT   DD SYSOUT=*)         /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(//IDCINP DD DSN=&&IDCINP, )     /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(//  DISP=(NEW,PASS), )          /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(// DCB=(LRECL=80,BLKSIZE=9040,RECFM=FB),)
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(// SPACE=(TRK,(1,1)),UNIT=&WKUNIT )
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(//SYSTSIN  DD    *)             /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR( EX '&QCLIST' +        )        /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           IF &TRSFLAG = 0 THEN +
             SET &JCLFILE = &STR( '0')                         /* @BAA*/
           ELSE DO                                             /* @BAA*/
             SET &PKBYTES = &KBYTES / &PARTO                   /* @BAA*/
             SET &JCLFILE = &STR( '&PKBYTES')                  /* @BAA*/
           ENDO                                                /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           SET &JCLFILE = &STR(/*)                             /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
           /***********************************************************/
           /* Build the split step                                    */
           /***********************************************************/
           SET &DCBS = &STR(LRECL=1024,BLKSIZE=27648,+
               RECFM=FB,BUFNO=&BUFNO)
           SET &SP1 = (&OTRKS / &PARTO) + 1                    /* @BAC*/
           IF &SP1 > &MAXCYLS THEN +
             SET &SP1 = &MAXCYLS                               /* @BAA*/
           SET &SP2 = ((&SP1 * 3) / 4) + 1                     /* @BAC*/
           SET &VCT = (&VCT / (&PARTO / 2) ) + 1               /* @BAC*/
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//* SPLIT )&INPF.
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &SN = &SN + 1
/* @BAC*/  SET &JCLFILE = &STR(//SPLTSTP  EXEC PGM=IDCAMS,COND=(0,LT) )
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//SYSPRINT DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//INPFIL   DD  DISP=SHR,)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DSN=&INPF.,)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DCB=(BUFNO=&BUFNO))
           PUTFILE JCLFILE
           DO &I = 1 TO &PARTO  /* Build output dd statements         */
             SET &JCLFILE = &STR(//OUTFIL&I  DD +
                                 DISP=(NEW,CATLG,CATLG),)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DSN=&MVSDSN..P&I.OF&PARTO,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DCB=(&DCBS),)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         FREE=CLOSE,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         VOL=(,,,&VCT),)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         UNIT=)
             SET &JCLFILE = &STR(&JCLFILE.&WKUNIT,SPACE=)
             SET &JCLFILE = &STR(&JCLFILE.(&SP,(&SP1,&SP2),RLSE))
             PUTFILE JCLFILE
           ENDO
           SET &JCLFILE = &STR(//SYSIN    DD    DSN=&&IDCINP,) /* @BAC*/
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DISP=(OLD,DELETE) )  /* @BAA*/
           PUTFILE JCLFILE
           /***********************************************************/
           /* After building the step, put the appropriate commands   */
           /* in the file for the FTP step and set up for the         */
           /* migrate step.                                           */
           /***********************************************************/
           IF &FTPSTP = 1 THEN DO
             IF &REMOTMVS = 1 THEN DO
               SET &BATFILE = &STR(SITE &SPACE PRI=&SP1 SEC=&SP2)
               PUTFILE BATFILE
             ENDO
             SET &BATFILE = &STR(binary)
             PUTFILE BATFILE
           ENDO
           IF &MIGORIG > 0 AND &STR(&MEMBER) = &STR() THEN +
             SET &ORGFILE = &STR(&DSN)
           DO &I = 1 TO &PARTO
             IF &FTPSTP = 1 THEN DO
               SET &BATFILE = &STR(put '&MVSDSN..P&I.OF&PARTO' + )
               PUTFILE BATFILE
               SET &BATFILE = &MYCASE(&STR(    &TCDSN..P&I.OF&PARTO ))
               SET &BATFILE = &EVAL(&BATFILE)
               PUTFILE BATFILE
             ENDO
             IF &MIGWORK > 0 THEN DO                           /* @B1C*/
               SET &J = &I + 2      /* 1 and 2 may be utilized    @B1A*/
               SET &WRKFIL&J = &STR(&MVSDSN..P&I.OF&PARTO)
             ENDO                                              /* @B1A*/
           ENDO
         ENDO /* File needing to be split                             */
         IF &FTPSTP = 0 THEN GOTO MIGSTP
         /*************************************************************/
         /* If a mkdir is needed, build a step to create it           */
         /*************************************************************/
         IF &STR(&SUBDIR) NE &STR() THEN DO
           SET &SN = &SN + 1
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//* FTP - Create sub directory )
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//MKDSTP   EXEC PGM=FTP,COND=(0,LT))
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//INPUT    DD DSN=+
                  &OUTHLQ..&PDMLQS..FTPMKD,)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DISP=(OLD,KEEP,KEEP))
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//OUTPUT   DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//SYSIN    DD DUMMY)
           PUTFILE JCLFILE
           IF &STR(&FTPDATA) NE &STR() THEN DO
             SET &JCLFILE = &STR(//SYSFTPD  DD DSN=&FTPDATA,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DISP=SHR)
             PUTFILE JCLFILE
           ENDO
           IF &STR(&TCPDATA) NE &STR() THEN DO
             SET &JCLFILE = &STR(//SYSTCPD  DD DSN=&TCPDATA,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DISP=SHR)
             PUTFILE JCLFILE
           ENDO
         ENDO
         /*************************************************************/
         /* FTP input is built - add the FTP step                     */
         /*************************************************************/
         IF &FTPSTP = 1 THEN DO
           SET &SN = &SN + 1
           SET &BATFILE = &STR(quit)
           PUTFILE BATFILE
           CLOSFILE BATFILE  /* FTP input is built                    */
           SET &BATOPEN = 0
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//* FTP - Send to testcase)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//FTPSTP   EXEC PGM=FTP,COND=(0,LT))
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//INPUT    DD DSN=+
                 &OUTHLQ..&PDMLQS..FTPBAT,)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//         DISP=(OLD,KEEP,KEEP))
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//OUTPUT   DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//SYSIN    DD DUMMY)
           PUTFILE JCLFILE
           IF &STR(&FTPDATA) NE &STR() THEN DO
             SET &JCLFILE = &STR(//SYSFTPD  DD DSN=&FTPDATA,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DISP=SHR)
             PUTFILE JCLFILE
           ENDO
           IF &STR(&TCPDATA) NE &STR() THEN DO
             SET &JCLFILE = &STR(//SYSTCPD  DD DSN=&TCPDATA,)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//         DISP=SHR)
             PUTFILE JCLFILE
           ENDO
         ENDO
         /*************************************************************/
         /* Add a migrate step if requested.                          */
         /*************************************************************/
MIGSTP:  IF &SYSHSM NE &STR() AND +
            ((&STR(&ORGFILE) NE &STR() AND &MIGORIG > 0) OR +
             (&STR(&WRKFIL1) NE &STR() AND (&MIGWORK = 1 OR +
              &MIGWORK = 2))) THEN DO
           SET &SN = &SN + 1
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//* BACK UP AND MIGRATE)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//HSMSTP   EXEC PGM=IKJEFT01,)
           SET &JCLFILE = &NRSTR(&JCLFILE.DYNAMNBR=20,)
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//         COND=(0,LT))
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//SYSTSPRT DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//SYSTSIN  DD  *)
           PUTFILE JCLFILE
           SET &IFILE = &ORGFILE
           SET &MIGRATE = &MIGORIG
           SET &I = 0
           DO WHILE (&I < 4)
             IF &MIGRATE = 1 THEN +
               SET &MIGRATE = &STR()
             ELSE +
               SET &MIGRATE = &STR(ML2)
             IF &STR(&IFILE) NE &STR() THEN DO
               SET &JCLFILE = &STR( HBACKDS '&IFILE' WAIT)
               PUTFILE JCLFILE
               SET &JCLFILE = &STR( HMIGRATE '&IFILE' &MIGRATE NOWAIT)
               PUTFILE JCLFILE
             ENDO
             SET &I = &I + 1
             SET &IFILE  = &&WRKFIL&I
             SET &MIGRATE = &MIGWORK
           ENDO
           SET &JCLFILE = &NRSTR(/*)
           PUTFILE JCLFILE
         ENDO
         /*************************************************************/
         /* Delete the work data sets if requested.                   */
         /*************************************************************/
         IF &MIGWORK = 99 AND +
            &STR(&WRKFIL1) NE &STR() THEN DO
           SET &SN = &SN + 1
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(//* DELETE WORK DATA SETS)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR(&STARLN)
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//DELWKSTP EXEC PGM=IDCAMS,)
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(// COND=(0,LT))
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//SYSPRINT DD SYSOUT=*)
           PUTFILE JCLFILE
           SET &JCLFILE = &NRSTR(//SYSIN    DD  *)
           PUTFILE JCLFILE
           DO &I = 1 TO 3
             SET &IFILE  = &&WRKFIL&I
             IF &STR(&IFILE) NE &STR() THEN DO
               SET &JCLFILE = &STR( DELETE '&IFILE' PURGE)
               PUTFILE JCLFILE
             ENDO
           ENDO
           SET &JCLFILE = &NRSTR(/*)
           PUTFILE JCLFILE
         ENDO
         /*************************************************************/
         /* Append to the LOG if everything went OK.                  */
         /*************************************************************/
         IF &FTPSTP = 1 THEN DO /* Actually sent something            */
           SET &ULOG = &STR(&SYSUID..&PDMLQS..LOG)
           DELETE '&ULOG' PURGE
           ALLOC DA('&ULOG') FI(LOGOUT) MOD +
                 RECFM(F B) LRECL(80) BLKSIZE(9040) CYLINDERS +
                 REUSE SPACE(1 1) UNIT(&WKUNIT)
           IF &LASTCC = 0 THEN DO
             ERROR OFF  /* Don't take any guff here                   */
             ERROR DO
               RETURN
             ENDO
             OPENFILE LOGOUT OUTPUT
             SET &LOGOUT = &STR(&SYSDATE &SYSTIME - &SYSUID at &SYSNODE)
             PUTFILE LOGOUT
             IF &WC > 0 THEN +
               SET &LOGOUT = &STR(    - sent &DSN.(&MEMBER))
             ELSE +
               SET &LOGOUT = &STR(    - sent &DSN)
             PUTFILE LOGOUT
             SET &LOGOUT = &STR(    - attr dsorg=&SYSDSORG,)   /* @B3A*/
             SET &LOGOUT = &STR(&LOGOUT.lrecl=&SYSLRECL,)      /* @B3A*/
             SET &LOGOUT = &STR(&LOGOUT.blksize=&SYSBLKSIZE,)  /* @B3A*/
             SET &LOGOUT = &STR(&LOGOUT.recfm=&SYSRECFM,)      /* @B3A*/
             IF &SYSUNITS = &STR(CYLINDER) THEN +
               SET &SZ = &STR(&SYSUSED. cyl)
             ELSE IF &SYSUNITS = &STR(TRACK) THEN +
               SET &SZ = &STR(&SYSUSED. trk)
             ELSE IF &SYSUNITS = &STR(BLOCK) THEN +
               SET &SZ = &STR(&SYSUSED. blk)
             ELSE +
               SET &SZ = &STR(&SYSUSED. ???)
             SET &LOGOUT = &STR(&LOGOUT.size=&SZ)              /* @B3A*/
             PUTFILE LOGOUT                                    /* @B3A*/
             IF &TRSPLIT = 1 THEN +
                 SET &LOGOUT = +
                 &MYCASE&STR((&TCDSN..P1OF&PARTO::+
                              P&PARTO.OF&PARTO ))              /* @B3C*/
             ELSE +
               SET &LOGOUT = &MYCASE(&STR(&ODSN))              /* @C1C*/
             SET &LOGOUT = &EVAL(&LOGOUT)
             SET &LOGOUT = &STR(    - as   &LOGOUT)
             PUTFILE LOGOUT
             SET &LOGOUT = &STR(    - to   +
               &GOHOST/&PATH.&DSL.&STR(&SUBDIR.))
             PUTFILE LOGOUT
             IF &TYPE = &STR(ECR) THEN DO                      /* @B1A*/
               SET &LOGOUT = +
                  &STR(    - encr &ENCPROGM key '&EKEY')       /* @B1A*/
               PUTFILE LOGOUT                                  /* @B1A*/
             ENDO                                              /* @B1A*/
             CLOSFILE LOGOUT
             FREE FI(LOGOUT)
             SET &SN = &SN + 1
             SET &JCLFILE = &STR(&STARLN)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//* LOG FILE TRANSFER)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(&STARLN)
             PUTFILE JCLFILE
             SET &JCLFILE = &NRSTR(//LOGSTP   EXEC PGM=IKJEFT01,)
             PUTFILE JCLFILE
             SET &JCLFILE = &NRSTR(//         COND=(0,LT),DYNAMNBR=20)
             PUTFILE JCLFILE
             SET &JCLFILE = &NRSTR(//SYSPRINT DD SYSOUT=*)
             PUTFILE JCLFILE
             SET &JCLFILE = &NRSTR(//SYSTSPRT DD SYSOUT=*)
             PUTFILE JCLFILE
             SET &JCLFILE = &NRSTR(//LOGIN    DD DSN=&ULOG.,)
             PUTFILE JCLFILE
             SET &JCLFILE = &NRSTR(//         DISP=(OLD,KEEP)) /* @B1C*/
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(//SYSTSIN  DD  *)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(  ALLOC DA('&OLOG') FI(LOGOUT) +)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(        MOD CATALOG REUSE      +)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(        UNIT(&WKUNIT) LRECL(80) +)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(        BLKSIZE(9040) RECFM(F B) +)
             PUTFILE JCLFILE
             SET &JCLFILE = &STR(        CYLINDERS SPACE(5 1)  )
             PUTFILE JCLFILE
             SET &JCLFILE = &STR( REPRO INFILE(LOGIN) +
                                  OUTFILE(LOGOUT))
             PUTFILE JCLFILE
         /*  SET &JCLFILE = &STR( FREE FI(LOGIN,LOGOUT )         @CBD */
             SET &JCLFILE = &STR( FREE FI(LOGIN) )            /* @CBA */
             PUTFILE JCLFILE
             SET &JCLFILE = &STR( FREE FI(LOGOUT) )           /* @CBA */
             PUTFILE JCLFILE                                  /* @CBA */
             SET &JCLFILE = &NRSTR(/*)
             PUTFILE JCLFILE
           ENDO  /* Allocate of the LOG file worked                   */
         ENDO /* An FTP Step was generated                            */
         /*************************************************************/
         /* Delete the PUTDOC data sets if everything went OK.        */
         /*************************************************************/
         SET &SN = &SN + 1
         SET &JCLFILE = &STR(&STARLN)
         PUTFILE JCLFILE
         SET &JCLFILE = &STR(//* DELETE PUTDOC DATA SETS)
         PUTFILE JCLFILE
         SET &JCLFILE = &STR(&STARLN)
         PUTFILE JCLFILE
         SET &JCLFILE = &NRSTR(//DELPDSTP EXEC PGM=IDCAMS,)
         PUTFILE JCLFILE
         SET &JCLFILE = &NRSTR(//         COND=(0,LT))
         PUTFILE JCLFILE
         SET &JCLFILE = &NRSTR(//SYSPRINT DD SYSOUT=*)
         PUTFILE JCLFILE
         SET &JCLFILE = &NRSTR(//SYSIN    DD  *)
         PUTFILE JCLFILE
         SET &IFILE = +
           &STR('&OUTHLQ..&PDMLQS..JCL')
         SET &JCLFILE = &STR( DELETE &IFILE PURGE)
         PUTFILE JCLFILE
         IF &FTPSTP = 1 THEN DO
           SET &IFILE = +
             &STR('&OUTHLQ..&PDMLQS..FTPBAT')
           SET &JCLFILE = &STR( DELETE &IFILE PURGE)
           PUTFILE JCLFILE
           SET &JCLFILE = &STR( DELETE '&ULOG' PURGE)          /* @B1A*/
           PUTFILE JCLFILE                                     /* @B1A*/
         ENDO
         IF &STR(&SUBDIR) NE &STR() THEN DO
           SET &IFILE = +
             &STR('&OUTHLQ..&PDMLQS..FTPMKD')
           SET &JCLFILE = &STR( DELETE &IFILE PURGE)
           PUTFILE JCLFILE
         ENDO
         IF &QCLIST NE &STR() THEN DO                          /* @BAA*/
           SET &JCLFILE = &STR( DELETE '&QCLIST' PURGE)        /* @BAA*/
           PUTFILE JCLFILE                                     /* @BAA*/
         ENDO                                                  /* @BAA*/
         SET &JCLFILE = &NRSTR(/*)
         PUTFILE JCLFILE
         /*************************************************************/
         /* Close up shop and submit the job.                         */
         /*************************************************************/
         SET &JCLFILE = &NRSTR(//)
         PUTFILE JCLFILE
         CLOSFILE JCLFILE
         SET &JCLOPEN = 0
         SET &SYSOUTTRAP = 0
         WRITE
         IF &SN = 1 THEN +
           WRITE  Job has &SN step
         ELSE +
           WRITE  Job has &SN steps
         WRITE
         SUBMIT '&OUTHLQ..&PDMLQS..JCL'
GETOUT:  ERROR OFF
         WRITE
         IF &BATOPEN = 1 THEN +
           CLOSFILE BATFILE
         IF &JCLOPEN = 1 THEN +
           CLOSFILE JCLFILE
         IF &MKDOPEN = 1 THEN +
           CLOSFILE MKDFILE
         IF &SUBDIR NE &STR() THEN +
           FREE FI(MKDFILE)
         IF &FTPSTP = 1 THEN +
           FREE FI(BATFILE)
         IF &SYSOUTTRAP NE 0 THEN DO /* This is an abort              */
           /***********************************************************/
           /* We particularly need to know if the CLIST               */
           /* allocated these data sets, since we may be              */
           /* terminating rather than overwrite one - we              */
           /* only want to clean them up if they are ours.            */
           /***********************************************************/
           IF &CDSNALL = 1 THEN +
             DELETE '&MVSCDSN' PURGE
           IF &MKDALLO = 1 THEN +
             DELETE '&OUTHLQ..&PDMLQS..FTPMKD' PURGE
           IF &BATALLO = 1 THEN +
             DELETE '&OUTHLQ..&PDMLQS..FTPBAT' PURGE
           IF &JCLALLO = 1 THEN +
             DELETE '&OUTHLQ..&PDMLQS..JCL' PURGE
         ENDO
         FREE FI(JCLFILE)
         EXIT QUIT
         /*************************************************************/
         /* This is the end of processing                             */
         /*************************************************************/
         /*************************************************************/
         /* The CUSTOM section must be preceded by the line           */
         /* 'CUSTOM: ERROR OFF'.  It must terminate with the          */
         /* GOTO CUSTOMD line.  All variables are modifiable.         */
         /* Bear in mind that syntax rules for CLISTs apply - to      */
         /* be safe, all character strings are enclosed in &STR().    */
         /*************************************************************/
         /*             *** Please note ***                           */
         /*     For many of the values here, a blank &STR( ) is       */
         /*     not the same as a null &STR().  Don't use &STR( )     */
         /*     unless you mean to specify a value of blanks.         */
         /*************************************************************/
CUSTOM:  ERROR OFF
         /*************************************************************/
         /* Please note the following rules concerning case:          */
         /*   > Variable names (NICK1, TCPASS - anything to the       */
         /*     left the of equal sign in a SET statement) remain     */
         /*     in all uppercase - the CLIST will convert them        */
         /*     though in case of a typo.                             */
         /*   > Special keywords such as nicknames (CICS, MVS),       */
         /*     hostname TESTCASE, and DUMMY for an unused nickname   */
         /*     are case-insensitive.                                 */
         /*   > The TRSSTEPL, JOBCx, WKUNIT, and the like are not     */
         /*     case-sensitive because they must be uppercase.        */
         /*   > The FTPDATA and JOBCDSN are case-sensitive to         */
         /*     allow hfs files to be used.                           */
         /*   > Path names, hostnames, userids, passwords, etc.       */
         /*     are all case-sensitive.                               */
         /*************************************************************/
         /*************************************************************/
         /* EMEA Repository Support - hostname and codes              */
         /*************************************************************/
         /* Hostname, branch office (general services #) and country  */
         /* for the EMEA repository.                                  */
         /*************************************************************/
         SET EMHOSTN = &STR(ftp.emea.ibm.com)                  /* @C1A*/
         SET EMB     = &STR(000)  /* Branch (General Services #)  @C1A*/
         SET EMC     = &STR(000)  /* Country code                 @C1A*/
         /*************************************************************/
         /* EMEA Repository Support - Tersed PDS (always enabled)     */
         /*  Note: PUTDOC does not supported tersing a PDS for        */
         /*        the Testcase repository.  It *does* support        */
         /*        tersing a PDS for EMEA.  Please ensure you have    */
         /*        informed the support personnel that the file       */
         /*        is a tersed PDS. No customization is required.     */
         /*************************************************************/
         /* This is the hostname for TESTCASE.  Do not change         */
         /* this unless the hostname for TESTCASE changes.  If you    */
         /* have problems connecting, try the alternate hostname      */
         /* SET TCHOSTN = &STR(testcase.boulder.ibm.com)              */
         /*************************************************************/
         SET TCHOSTN = &STR(testcase.boulder.ibm.com)         /* @C93C*/
         /*************************************************************/
         /* This is the timeout value in seconds for the transfer to  */
         /* Testcase.  It is not used in the separate MKDIR step.     */
         /* Valid values are 0 and 15 to 86400, default here is 720.  */
         /*************************************************************/
         SET TCTIMEOUT = 720                                   /* @BBA*/
         /*************************************************************/
         /* For destinations that use the special name TESTCASE       */
         /* for the testcase server, the following variables are      */
         /* used for the signon.  Any USER or PASS or MORn            */
         /* settings for a nickname that uses TESTCASE are ignored.   */
         /* All values may use symbolic substitution.                 */
         /*                                                           */
         /* These are the keywords in the order they are used:        */
         /*   1 - TCSRVR  (hostname for FTP)                          */
         /*   2 - TCUSER                                              */
         /*   3 - TCPASS                                              */
         /*   4 - TCMORE                                              */
         /*   4 - TCMORE2                                         @B7A*/
         /*   4 - TCMORE3                                         @B7A*/
         /*                                                           */
         /*************************************************************/
         /* TCSRVR is the actual server name that you will connect    */
         /* to - often a proxy server.  TCUSER, TCPASS, and TCMOREn   */
         /* may contain any string - TCMORE and TCMOREn are ignored   */
         /* if nulls except as noted below with prompts.          @B7C*/
         /*************************************************************/
         /* TCSRVR and TCHOSTN must have values for the CLIST to run. */
         /* TCUSER, TCPASS, TCMORE, and TCMOREn may be blank and will */
         /* be prompted for.  They may be specified in the PROFILE    */
         /* data set but _not_ via US() and PW() at invocation.   @B7C*/
         /*************************************************************/
         /* Note: If you choose to be prompted for TCUSER and/or      */
         /* TCPASS and wish to avoid the prompt for TCMORE or TCMOREn */
         /* then set either or both of them to NONE here:             */
         /*      ex:  SET TCMORE = &STR(NONE)                     @B7C*/
         /*************************************************************/
         /* All destinations support five signon lines (USER, PASS,   */
         /* and the three MORE lines).  For the TESTCASE destination, */
         /* you may customize the prompts used for each string.  The  */
         /* prompt string variables and default values:               */
         /*                                                           */
         /*  TCUSERP = &STR(Enter the first signon line (userid) ==>) */
         /*  TCPASSP = &STR(Enter the second signon line (password) + */
         /*            - will display ==>)                            */
         /*  TCMOREP = &STR(Enter the third signon line or press +    */
         /*                 enter for none ==>)                       */
         /*  TCMOR2P = &STR(Enter the fourth signon line or press +   */
         /*                 enter for none ==>)                       */
         /*  TCMOR3P = &STR(Enter the fifth signon line or press +    */
         /*                 enter for none ==>)                   @B7A*/
         /*************************************************************/
         SET TCSRVR = &STR(&TCHOSTN)
         SET TCUSER = &STR(anonymous)
         SET TCUSERP = &STR(Enter the first signon line (userid) ==>)
         SET TCPASS = &STR()
         SET TCPASSP = &STR(Enter the second signon line (password) +
                       - will display ==>)
         SET TCMORE = &STR()
         SET TCMOREP = &STR(Enter the third signon line or press +
                            enter for none ==>)                /* @B7A*/
         SET TCMORE2 = &STR()
         SET TCMOR2P = &STR(Enter the fourth signon line or press +
                            enter for none ==>)                /* @B7A*/
         SET TCMORE3 = &STR()
         SET TCMOR3P = &STR(Enter the fifth signon line or press +
                            enter for none ==>)                /* @B7A*/
         /*************************************************************/
         /* Nicknames can be 1-8 characters.                          */
         /* If the specified destination is not a member of the       */
         /* selection list, it is read as a fully-specified path.     */
         /*  > Symbolic substitution of any value is allowed          */
         /*  > Nicknames are used in order to ease remembering        */
         /*    which path to use and reduce errors.  At the           */
         /*    prompt for destination, they are not used except       */
         /*    for display.  They are used in the TO() parameter.     */
         /*  > Slots for 15 nicknames are provided.  This ensures     */
         /*    readability.  If more are added, the NICKMAX value     */
         /*    below must be adjusted.  It can also be adjusted       */
         /*    downward to ignore slots.  Otherwise, to be ignored,   */
         /*    the nickname must be 'DUMMY' (any case).               */
         /*  > If PATH, USER, or PASS are not specified the CLIST     */
         /*    will prompt.  If included below, USER and PASS can be  */
         /*    overridden on the command line (non-TESTCASE           */
         /*    desinations only), PATH as described below. MORE/MORn  */
         /*    are optional and ignored if nulls.  Variables are      */
         /*    used in the order they are listed.                 @B7C*/
         /*  > PMRDx is a flag that indicates whether the PMR number  */
         /*    is to be a name insert (I) or sub directory (S).       */
         /*  > MVSF is a flag that indicates whether this is an       */
         /*    MVS host.  Values are 'Y', 'N' and nulls.  The         */
         /*    CLIST will prompt if no value is given and the host    */
         /*    is not TESTCASE.                                       */
         /*************************************************************/
         /*                                                           */
         /*    SET NICKx = &STR(not case-sensitive)                   */
         /*    SET HOSTx = &STR(case-sensitive unless TESTCASE)       */
         /*    SET MVSFx = &STR(y or n, not case-sensitive)           */
         /*    SET USERx = &STR(case-sensitive)                       */
         /*    SET PASSx = &STR(case-sensitive)                       */
         /*    SET MOREx = &STR(case-sensitive)                       */
         /*    SET MOR2x = &STR(case-sensitive)                   @B7A*/
         /*    SET MOR3x = &STR(case-sensitive)                   @B7A*/
         /*    SET PATHx = &STR(case-sensitive)                       */
         /*    SET PMRDx = &STR(I or S, not case-sensitive)           */
         /*                                                           */
         /*************************************************************/
         /*    This is an example of an MVS destination where the     */
         /*    target path is the hfs:                                */
         /*                                                           */
         /*    SET NICKx = &STR(MVSHOST)                              */
         /*    SET HOSTx = &STR(my.other.mvs.host)                    */
         /*    SET MVSFx = &STR(y)                                    */
         /*    SET USERx = &STR(myuserid) or &STR()                   */
         /*    SET PASSx = &STR(mypasswd) or &STR()                   */
         /*    SET MOREx = &STR()                                     */
         /*    SET MOR2x = &STR()                                 @B7A*/
         /*    SET MOR3x = &STR()                                 @B7A*/
         /*    SET PATHx = &STR('/u/myuserid')  (**)                  */
         /*    SET PMRDx = &STR(I)                                    */
         /*                                                           */
         /*    (**) A PATH specification can be overridden at run-    */
         /*         time for a non-testcase host (the CLIST will      */
         /*         prompt).  PATH entries for testcase nicknames     */
         /*         cannot be changed at run-time.                    */
         /*************************************************************/
         /* USER, PASS, MORE, MORn, and MVSF are ignored for          */
         /* nicknames that specify HOST = TESTCASE.               @B7C*/
         /*************************************************************/
         SET NICKMAX = 15  /* If more are added, incr this value      */
         /*************************************************************/
         /* Nickname #1                                               */
         /*************************************************************/
         SET NICK1 = &STR(TCPIP)
         SET HOST1 = &STR(TESTCASE)  /* @C8M */
         SET HOST1 = &STR(&EMHOSTN)  /* @C8M */
         SET MVSF1 = &STR(N)         /* @C8M */
         SET USER1 = &STR(anonymous) /* @C8M */
         SET PASS1 = &STR()          /* @C8M */
         SET MORE1 = &STR(NONE)  /* @C8M */
         SET MOR21 = &STR(NONE)  /* @C8M */
         SET MOR31 = &STR(NONE)  /* @C8M */
         SET PATH1 = &STR(toibm/mvs) /* @C5M */
      /* SET PMRD1 = &STR(S)    @C8M */
         SET PMRD1 = &STR(I) /* @C8M */
         /*************************************************************/
         /* Nickname #2                                               */
         /*************************************************************/
         SET NICK2 = &STR(MVS)
         SET HOST2 = &STR(TESTCASE)
      /* SET PATH2 = &STR(mvs/toibm) */
         SET PATH2 = &STR(toibm/mvs) /* @C5M */
         SET PMRD2 = &STR(I)
         /*************************************************************/
         /* Nickname #3                                               */
         /*************************************************************/
         SET NICK3 = &STR(VTAM)
         SET HOST3 = &STR(&PRXYSRV)  /* @C7M */
         SET HOST3 = &STR(&EMHOSTN)  /* @C8M */
      /* SET HOST3 = &STR(TESTCASE)     @C7M */
      /* SET PATH3 = &STR(s390/toibm/vtam) */
         SET MVSF3 = &STR(N)     /* @C7M */
      /* SET USER3 = &STR(anonymous@&EMHOSTN) */ /* @C7M */
         SET USER3 = &STR(anonymous)     /* @C8M */
         SET PASS3 = &STR()              /* @C8M */
         SET MORE3 = &STR(NONE)  /* @C7M */
         SET MOR23 = &STR(NONE)  /* @C7M */
         SET MOR33 = &STR(NONE)  /* @C7M */
         SET PATH3 = &STR(toibm/mvs) /* @C5M */
      /* SET PMRD3 = &STR(S)    @C7M */
         SET PMRD3 = &STR(I) /* @C7M */
         /*************************************************************/
         /* Nickname #4                                               */
         /*************************************************************/
         SET NICK4 = &STR(CICS)
         SET HOST4 = &STR(&EMHOSTN)  /* @C8M */
      /* SET HOST4 = &STR(TESTCASE)     @C8M */
      /* SET PATH4 = &STR(ns/toibm) */
         SET MVSF4 = &STR(N)     /* @C8M */
         SET USER4 = &STR(anonymous)  /* @C8M */
         SET PASS4 = &STR()      /* @C8M */
         SET MORE4 = &STR(NONE)  /* @C8M */
         SET MOR24 = &STR(NONE)  /* @C8M */
         SET MOR34 = &STR(NONE)  /* @C8M */
         SET PATH4 = &STR(toibm/mvs) /* @C5M */
         SET PMRD4 = &STR(I)
         /*************************************************************/
         /* Nickname #5                                               */
         /*************************************************************/
         SET NICK5 = &STR(DB2)
         SET HOST5 = &STR(TESTCASE)
      /* SET PATH5 = &STR(s390/toibm/db2) */
      /* SET PATH5 = &STR(toibm/db2)    @C5M */
         SET PATH5 = &STR(toibm/im) /* @C6M */
         SET PMRD5 = &STR(I)
         /*************************************************************/
         /* Nickname #6                                               */
         /*************************************************************/
         SET NICK6 = &STR(NETVIEW)
      /* SET HOST6 = &STR(TESTCASE)     @C8M */
         SET HOST6 = &STR(&EMHOSTN)  /* @C8M */
      /* SET PATH6 = &STR(s390/toibm/netview) */
         SET MVSF6 = &STR(N)     /* @C8M */
         SET USER6 = &STR(anonymous)  /* @C8M */
         SET PASS6 = &STR()      /* @C8M */
         SET MORE6 = &STR(NONE)  /* @C8M */
         SET MOR26 = &STR(NONE)  /* @C8M */
         SET MOR36 = &STR(NONE)  /* @C8M */
         SET PATH6 = &STR(toibm/tivoli) /* @C5M */
         SET PATH6 = &STR(toibm/mvs) /* @C5M */
         SET PMRD6 = &STR(I)
         /*************************************************************/
         /* Nickname #7                                               */
         /*************************************************************/
         SET NICK7 = &STR(S390WEBS)
      /* SET HOST7 = &STR(TESTCASE)     @C8M */
         SET HOST7 = &STR(&EMHOSTN)  /* @C8M */
      /* SET PATH7 = &STR(s390/toibm/websphere) */
         SET MVSF7 = &STR(N)     /* @C8M */
         SET USER7 = &STR(anonymous)  /* @C8M */
         SET PASS7 = &STR()      /* @C8M */
         SET MORE7 = &STR(NONE)  /* @C8M */
         SET MOR27 = &STR(NONE)  /* @C8M */
         SET MOR37 = &STR(NONE)  /* @C8M */
         SET PATH7 = &STR(toibm/tivoli) /* @C5M */
         SET PATH7 = &STR(toibm/mvs) /* @C5M */
      /* SET PMRD7 = &STR(S)    @C8M */
         SET PMRD7 = &STR(I) /* @C8M */
         /*************************************************************/
         /* Nickname #8                                               */
         /*************************************************************/
         SET NICK8 = &STR(EMEA)                                /* @C1C*/
         SET HOST8 = &STR(&EMHOSTN)                            /* @C1C*/
         SET MVSF8 = &STR(N)                                   /* @C1C*/
         SET USER8 = &STR(anonymous)                           /* @C1C*/
         SET PASS8 = &STR()                                    /* @C1C*/
         SET MORE8 = &STR(NONE)                                /* @C1C*/
         SET MOR28 = &STR(NONE)                                /* @C1C*/
         SET MOR38 = &STR(NONE)                                /* @C1C*/
         SET PATH8 = &STR(toibm/mvs)                           /* @C1C*/
         SET PMRD8 = &STR(I)                                   /* @C1C*/
         /*************************************************************/
         /* Nickname #9  - example with proxy                         */
         /*************************************************************/
         SET NICK9 = &STR(DUMMY)
         SET HOST9 = &STR(proxy-server)
         SET MVSF9 = &STR()
         SET USER9 = &STR(anonymous@my.host.name)
         SET PASS9 = &STR(mypass)
         SET MORE9 = &STR()
         SET MOR29 = &STR()                                    /* @B7A*/
         SET MOR39 = &STR()                                    /* @B7A*/
         SET PATH9 = &STR(tmp)
         SET PMRD9 = &STR()
         /*************************************************************/
         /* Nickname #10                                              */
         /*************************************************************/
         SET NICK10 = &STR(DUMMY)
         SET HOST10 = &STR(EMEA)
         SET PATH10 = &STR(toibm/ftp.emea.ibm.com)
         SET PMRD10 = &STR(S)
         /*************************************************************/
         /* Nickname #11 - Used for other destinations under s390     */
         /*************************************************************/
         SET NICK11 = &STR(S/390)
         SET HOST11 = &STR(TESTCASE)
      /* SET PATH11 = &STR(s390/toibm) */
         SET PATH11 = &STR(toibm/mvs) /* @C5M */
         SET PMRD11 = &STR()
         /*************************************************************/
         /* Nickname #12                                              */
         /*************************************************************/
         SET NICK12 = &STR(DUMMY)
         SET HOST12 = &STR()
         SET MVSF12 = &STR()
         SET USER12 = &STR()
         SET PASS12 = &STR()
         SET MORE12 = &STR()
         SET MOR212 = &STR()                                   /* @B7A*/
         SET MOR312 = &STR()                                   /* @B7A*/
         SET PATH12 = &STR()
         SET PMRD12 = &STR()
         /*************************************************************/
         /* Nickname #13                                              */
         /*************************************************************/
         SET NICK13 = &STR(DUMMY)
         SET HOST13 = &STR()
         SET MVSF13 = &STR()
         SET USER13 = &STR()
         SET PASS13 = &STR()
         SET MORE13 = &STR()
         SET MOR213 = &STR()                                   /* @B7A*/
         SET MOR313 = &STR()                                   /* @B7A*/
         SET PATH13 = &STR()
         SET PMRD13 = &STR()
         /*************************************************************/
         /* Nickname #14                                              */
         /*************************************************************/
         SET NICK14 = &STR(DUMMY)
         SET HOST14 = &STR()
         SET MVSF14 = &STR()
         SET USER14 = &STR()
         SET PASS14 = &STR()
         SET MORE14 = &STR()
         SET MOR214 = &STR()                                   /* @B7A*/
         SET MOR314 = &STR()                                   /* @B7A*/
         SET PATH14 = &STR()
         SET PMRD14 = &STR()
         /*************************************************************/
         /* Nickname #15                                              */
         /*************************************************************/
         SET NICK15 = &STR(DUMMY)
         SET HOST15 = &STR()
         SET MVSF15 = &STR()
         SET USER15 = &STR()
         SET PASS15 = &STR()
         SET MORE15 = &STR()
         SET MOR215 = &STR()                                   /* @B7A*/
         SET MOR315 = &STR()                                   /* @B7A*/
         SET PATH15 = &STR()
         SET PMRD15 = &STR()
         /*************************************************************/
         /* Turn case-sensitivity off for the MVS parms.              */
         /*************************************************************/
         SET &SYSASIS = &STR(OFF)  /* DO NOT DELETE OR MOVE           */
         /*************************************************************/
         /* OWNERID is the USERID of the owner of this tool.          */
         /* Messages can be sent to this userid when problems         */
         /* arise in parameter values or processing.  OLOG is         */
         /* the common LOG data set name.  Users must have ALTER      */
         /* (or CREATE) authority to this data set name.              */
         /*************************************************************/
         SET OWNERID = &STR(&SYSUID)
         SET OLOG = &STR(&OWNERID..PUTDOC.LOG)
         /*************************************************************/
         /* WKUNIT is the unit name for allocating new data sets.     */
         /* MAXVOLS is the maximum number of volumes a data set       */
         /* can span (1 to 59, default 10).                           */
         /* MAXCYLS is the maximum number of cylinders a data set     */
         /* may have in each extent (1 to 3000, default 900).         */
         /*************************************************************/
         SET WKUNIT = &STR(SYSDA)  /* For intermediate MVS files      */
         SET MAXVOLS = 10   /* Max # of volumes for large d/s         */
         SET MAXCYLS  = 900  /* Max # of cylinders in each ext        */
         /*************************************************************/
         /* TRSSTEPL is the STEPLIB data set for TRSMAIN.             */
         /* BUFNO is the number of buffers to use when reading from   */
         /*   and writing to data sets.                               */
         /*************************************************************/
         SET TRSSTEPL = &STR()                   /* TRSMAIN STEPLIB   */
         SET BUFNO  = 10                         /* data buffers      */
         /*************************************************************/
         /* ENCSTEPL is the (optional) STEPLIB for the encryption     */
         /*   programs.                                               */
         /*                                                           */
         /* ENCPROGM is the load module to execute for encryption.    */
         /* The choices are:                                          */
         /*   &STR(FTPENCR)  - Encryption module without DES          */
         /*   &STR(FTPENCRD) - Encryption module with 64-bit DES      */
         /*   anything else  - Disables encryption                    */
         /*                                                           */
         /* The load modules are available on this server:            */
         /*   ftp://ftp.emea.ibm.com/fromibm/s390/mvs/tools/      @B1A*/
         /*   ftp://ftp.emea.ibm.com/fromibm/mvs/tools/           @C5M*/
         /*************************************************************/
         SET ENCSTEPL = &STR()              /* Encryption steplib @B1A*/
         SET ENCPROGM = &STR()              /* Encryption module  @B1A*/
         /*************************************************************/
         /* The CLRSCRN variable contains the name of the function    */
         /* (if any) used to clear the screen for readability.  You   */
         /* may enter another command or invocation to clear the      */
         /* screen or perform any other function - just be aware      */
         /* it will be executed at every point that a screen clear    */
         /* would have been done.  Use a null string for none.        */
         /* Note: CLIST commands (such as WRITE) are not valid here.  */
         /*  Examples:                                                */
         /*   SET CLRSCRN = &STR(CLRSCRN)                  default    */
         /*   SET CLRSCRN = &STR(CLR3270)                             */
         /*   SET CLRSCRN = &STR(EX 'MY.CLIST(MYFUNC)')               */
         /*   SET CLRSCRN = &STR()                         none       */
         /*************************************************************/
         /* Note: Using a CLRSCRN or similar function can interfere   */
         /*       with proper operation of the CLIST under ISPF when  */
         /*       the CLIST is invoked using extended implicit        */
         /*       notation (%PUTDOC).  Simply put, invoke PUTDOC      */
         /*       without using % for best results.                   */
         /*************************************************************/
         SET CLRSCRN = &STR(CLRSCRN)     /* Screen clear function  A8A*/
         /*************************************************************/
         /* OUTHLQ is the HLQ of output data sets. All output data    */
         /* sets (MVS intermediate files and testcase files) get      */
         /* a (usually) unique qualifier called &TQUAL.  This         */
         /* allows an aborted run to be rerun without having to       */
         /* delete the testcase file, overwriting of which may        */
         /* not be permitted.  See above for more about &TQUAL.       */
         /*************************************************************/
         SET OUTHLQ = &STR(&SYSUID.)  /* Default HLQ for MVS d/s      */
         /*************************************************************/
         /* SPLTSIZE is the size (in Kbytes) at which a data set      */
         /* is eligible to be split.  If a data set is larger         */
         /* than this size (and is already tersed) it will be         */
         /* split into parts before transmission.  If the data        */
         /* set has not yet been tersed, the CLIST will force         */
         /* it to be tersed and that data set will be split into      */
         /* parts if it is projected to still be too large.           */
         /* Default value is 1500000, which is about 1.5G.  Whatever  */
         /* is coded here, a maximum of 9 parts is allowed.           */
         /*                                                           */
         /* SPACK controls whether extensive packing will be used in  */
         /* tersing very large (over 4G raw) data sets.  SPACK saves  */
         /* DASD but increases CPU cost significantly.            @BAA*/
         /*    SET SPACK = &STR(PACK)  -  Use regular terse algorithm */
         /*************************************************************/
         SET SPLTSIZE = 1500000   /* Maximum kbytes before split      */
/*@BAA*/ SET SPACK = &STR(SPACK)  /* Use super pack for huge data sets*/
         /*************************************************************/
         /* To DISABLE the split function, increase the &MAX2G value  */
         /* below (default is 1953125) to 195312500 (Kbytes, which    */
         /* equals 200G) and set SPLTSIZE to the same value.  No      */
         /* splits will occur as no tersed file will exceed this size.*/
         /*************************************************************/
         SET &MAX2G =  1953125  /* Maximum size to send           @C1M*/
         /*************************************************************/
         /* The batch functions used by the process require a         */
         /* JOB card.  Please make any changes below.  JOBC2 and      */
         /* JOBC3 can be set to &STR() if they are not needed.        */
         /*                                                           */
         /* The JOB card settings may be placed into a data set.      */
         /* Put the fully-qualified data set name without quotes      */
         /* (symbolic substitution may be used if desired) in the     */
         /* JOBCDSN variable.  JOBCDSN WILL OVERRIDE THE JOBCx        */
         /* SETTINGS.  If the data set is not found, the              */
         /* JOBCx settings will be used.                              */
         /*                                                           */
         /*    ex: SET JOBCDSN = &STR(&SYSUID..job.card.dsn)          */
         /*                                                           */
         /*    Note:  If the JOBCDSN is filled in to allow the        */
         /*           users to take advantage of this feature, a      */
         /*           warning message will be issued for each         */
         /*           invocation when the resolved data set name is   */
         /*           not found.  This will not cause the CLIST       */
         /*           to fail but the message can be avoided by       */
         /*           allocating the data set (empty is OK).
         /*                                                           */
         /* Restrictions:                                             */
         /*    A maximum of 3 JOB cards is allowed, regardless of     */
         /*       whether defined here or in a file                   */
         /*    The source data set can be MVS                         */
         /*       PS, FB, LRECL=80                                    */
         /*    or hfs                                                 */
         /*       filename must begin with '/' and not have '/'       */
         /*       in the second position                              */
         /*                                                           */
         /* Dynamic substitution can be requested for any part        */
         /* of the JOB card by specifying '??' where you want         */
         /* the data.  Any number of characters can be substituted    */
         /* in this way, so be careful about the length of the        */
         /* line that will be generated.  The CLIST does not edit     */
         /* the input - the user is simply prompted for a value       */
         /* to insert at that point.  This technique can be used      */
         /* in JOB cards defined in the CLIST or in a file.           */
         /*                                                           */
         /* Restrictions:                                             */
         /*    No commas, quotes, parentheses or blanks may be        */
         /*       included in the string to be inserted.              */
         /*    "optional" substitutions are not allowed - the         */
         /*       CLIST will insist upon a response from the user.    */
         /*    All JOB cards must begin with // (CLIST will not       */
         /*       verify this) but commas are inserted to continue    */
         /*       to the next card if needed.                         */
         /*    If you do not want one of the job cards used, you      */
         /*       must set it to nulls - &STR()                       */
         /*                                                           */
         /* Note: JOBC2 and JOBC3 may be used to hold other types     */
         /*       of JCL statements.  The CLIST will recognize they   */
         /*       are not part of the JOB card and insert them        */
         /*       appropriately after the JOB card.                   */
         /*       ex: /*ROUTE PRINT nodename.??                       */
         /*           /*ROUTE PRINT nodename.&SYSUID.                 */
         /*************************************************************/
         SET JOBC1 = &STR(+
//&SYSUID.?? JOB (11111),&SYSUID.,MSGLEVEL=(1,1),MSGCLASS=??,)
         SET JOBC2 = &STR(+
//  USER=&SYSUID.,NOTIFY=&SYSUID.,TIME=1440,REGION=8M)
         SET JOBC3 = &STR()
         /*************************************************************/
         /* Turn case-sensitivity back on for the MVS parms that      */
         /* take hfs filenames.                                       */
         /*************************************************************/
         SET &SYSASIS = &STR(ON)  /* DO NOT DELETE OR MOVE            */
         /*************************************************************/
         /* If specified, JOBCDSN will override the JOBCx settings.   */
         /*************************************************************/
 SET JOBCDSN = &STR()
         /*************************************************************/
         /* FTPDATA contains the fully-qualified name of the          */
         /* FTPDATA file you want the FTP steps to use.  If none      */
         /* is specified, none will be included in the job steps.     */
         /*************************************************************/
         /* *** Please note *** If your connection with the testcase  */
         /* server is experiencing connection reset errors, it may    */
         /* be due to the keepalive function.  To disable this        */
         /* function, include the following statement:                */
         /*      FTPKEEPALIVE  86400                                  */
         /* in your default FTP.DATA data set or in the data set      */
         /* you designate here using the FTPDATA parameter.           */
         /*************************************************************/
 SET FTPDATA = &STR()                               /* DDNAME SYSFTPD */
 SET TCPDATA = &STR()                               /* DDNAME SYSTCPD */
         /*************************************************************/
         /* At the completion of the transfer, PUTDOC can back up     */
         /* and migrate the original data set and any intermediate    */
         /* work data sets that were created.  Settings here can      */
         /* be overridden via response to a prompt.                   */
         /*                                                           */
         /*   MIGORIG - controls disposition of the original file     */
         /*             Note: A PDS is never migrated.                */
         /*   MIGWORK - controls disposition of work files            */
         /*             (filenames with TRS, XMT, etc)                */
         /*                                                           */
         /*   Set MIGORIG/MIGWORK to 0 for no migration to occur      */
         /*   Set MIGORIG/MIGWORK to 1 to migrate to level 1          */
         /*   Set MIGORIG/MIGWORK to 2 to migrate to level 2          */
         /*   Set MIGWORK to 99 to delete work data sets              */
         /*************************************************************/
         SET MIGORIG = 0                    /* original data set      */
         SET MIGWORK = 99                   /* work data sets         */
         /*************************************************************/
         /*   Individual PUTDOC profile data set:                     */
         /*      - optional, not processed if the file does not exist */
         /*      - typically used by an installation with shared      */
         /*        access to a CLIST library but different sets of    */
         /*        processing requirements                            */
         /*      - is not required for different JOB cards only - see */
         /*        above for substitution within JOB cards as well    */
         /*        as the ability to read an individual JOB card file.*/
         /*************************************************************/
         /*   After all customization has been done, the user's       */
         /*   PUTDOC profile data set is read if it exists.  The name */
         /*   defaults to '&SYSUID..PUTDOC.PROFILE' but can be        */
         /*   changed below.   The data must be of the form:          */
         /*                                                           */
         /*     <CLIST variable name>  <value>    <comment>           */
         /*                                                           */
         /*   ex:  TCHOST   &STR(my.proxy-server.name)                */
         /*        TCPASS   &STR(mypasswd)    my password             */
         /*        HOST2    &STR(&TCHOST)     host for nick2          */
         /*                                                           */
         /*   Only assignments are allowed - enclose strings in       */
         /*   &STR().  Do not use the '=' assignment operator or      */
         /*   the verb ' SET ' in the profile data set.               */
         /*   Recommended data set attributes:                        */
         /*       FB                                                  */
         /*       LRECL=80                                            */
         /*       Caps OFF                                            */
         /*   The CLIST automatically stops at column 72 to ignore    */
         /*   any line numbers that may be in the file.               */
         /*                                                           */
         /*   Embedded comments are allowed, but they must follow the */
         /*   value parm by at least 4 blanks or be the only data     */
         /*   on the line.  Use /* as the comment delimiter for a     */
         /*   comment that occupies the entire line.  Comments on     */
         /*   the data lines need only be separated from the value    */
         /*   parm by at least 4 blanks.                              */
         /*                                                           */
         /*   Blanks embedded in a parameter value are allowed, but   */
         /*   a maximum of 3 consecutive blanks is permitted.  A 4th  */
         /*   blank is treated as the end of the input on the line -  */
         /*   otherwise the line will be searched thru column 72.     */
         /*                                                           */
         /*   Values in the profile data set will override previous   */
         /*   settings.  Known variables in this CLIST may be used    */
         /*   in symbolic substitution within the profile data set.   */
         /*                                                           */
         /*   Command line variables TO(), PR(), US(), and PW()       */
         /*   cannot be reset from the PROFILE data set.  You must    */
         /*   use the following variables instead:                    */
         /*                                                           */
         /*     For    PR()  use   PMR                                */
         /*     For    US()  use   USERID  (does not set TCUSER)      */
         /*     For    PW()  use   PASSWD  (does not set TCPASS)      */
         /*     For    TO()  use   DEST                               */
         /*************************************************************/
         SET &PROFDS = &STR(&SYSUID..PUTDOC.PROFILE)
         SET &ISTH = &SYSDSN('&PROFDS')
         IF &ISTH = &STR(OK) THEN DO
           ERROR DO
             SET &HOLDCC = &LASTCC
             IF &HOLDCC = 400 THEN DO
               SET &EOF = 1
               RETURN
             ENDO
             ERROR OFF
             CLOSFILE PUTPROF
             FREE FI(PUTPROF)
             GOTO GETOUT
           ENDO
           SET EOF = 0
           ALLOC DA('&PROFDS') FI(PUTPROF) SHR REUSE
           OPENFILE PUTPROF INPUT
           GETFILE PUTPROF
           DO WHILE(&EOF = 0)
             SET &L = &LENGTH(&STR(&PUTPROF))
             SET PRM1 = 0
             SET EPRM1 = 0
             SET PRM2  = 0
             SET EPRM2 = 0
             SET &COM = &NRSTR(/*)
             IF &L > 72 THEN SET &L = 72
             DO &I = 1 TO &L
               IF &I < 72 AND &PRM1 = 0 THEN DO
                 IF &SUBSTR(&I:&I+1,&STR(&PUTPROF)) = &STR(&COM) +
                   THEN GOTO SKIPIT
               ENDO
               IF &SUBSTR(&I:&I,&STR(&PUTPROF)) NE &STR( ) THEN DO
                 IF &EPRM2 > 0 THEN +
                   SET &EPRM2 = 0   /* Keep going, embedded blank     */
                 ELSE IF &PRM1 = 0 THEN +
                   SET &PRM1 = &I
                 ELSE IF &EPRM1 > 0 AND &PRM2 = 0 THEN +
                   SET &PRM2 = &I
               ENDO  /* non-blank found                               */
               ELSE DO  /* blank found                                */
                 IF &PRM1 > 0 THEN DO  /* First parm located          */
                   IF &PRM2 > 0 THEN +
                     IF &EPRM2 = 0 THEN +
                       SET &EPRM2 = &I-1   /* End of 2nd parm?        */
                     ELSE DO
                       IF &EVAL(&I - &EPRM2) > 2 THEN +
                         SET &I = 72
                     ENDO
                   ELSE +
                     IF &EPRM1 = 0 THEN +
                       SET &EPRM1 = &I-1  /* End of 1st parm          */
                 ENDO
               ENDO
             ENDO  /* Scan line                                       */
             IF &PRM1 = 0 THEN GOTO SKIPIT
             IF &EPRM2 = 0 THEN SET &EPRM2 = 72  /* filled line       */
             SET &FPM = &SUBSTR(&PRM1:&EPRM1,&STR(&PUTPROF))   /* @BAC*/
             SET &SPM = &SUBSTR(&PRM2:&EPRM2,&STR(&PUTPROF))   /* @BAC*/
             SET &&FPM = &SPM
SKIPIT:      GETFILE PUTPROF
           ENDO  /* Do while not EOF                                  */
           ERROR OFF
           CLOSFILE PUTPROF
           FREE FI(PUTPROF)
         ENDO  /* Profile data set found                              */
         /*************************************************************/
         /* Do not delete the following line : GOTO CUSTOMD           */
         /* It must be the last line in the file.                     */
         /*************************************************************/
         GOTO CUSTOMD
