Sort Utility

• Sort Utility is used in most applications in JCL's.  
• It is frequently used for three basic functions .Sorting, Merging and Copying.

 

SAMPLE JCL FOR SORT

//STEPNAME   EXEC PGM=SORT
//SYSOUT         DD SYSOUT=*
//SORTIN          DD DSN=MY.SORTIN
//SORTOUT      DD DSN=MY.SORTOUT
//SORTOFxx    DD DSN=MY.SORTOFXX
//SORTXSUM  DD DSN=MY.SORTXSUM
//SYSIN              DD *
   sort statements                                       
/*

• SORTIN         Input dataset
• SORTOUT     Output dataset
• SORTOFxx    Multiple output files
• SORTXSUM  Output dataset for eliminated records
• SYSOUT        Output message

Rexx
-----
1. Retrieve data from CA7 
   ----------------------
//STEP02   EXEC PGM=CAL2X2WB,PARM='*AUTO*,CA71'
//STEPLIB  DD DSN=SYS1.CA7.LOADLIB,DISP=SHR
//SYSPRINT DD DSN=T01.SP02.OUTPUT.ABEND,
//            SPACE=(CYL,(15,5)),
//            DISP=(NEW,CATLG,DELETE)
//SYSDUMP  DD SYSOUT=Z
//SYSIN    DD DSN=T01.SYSPLEX.PARM.ABD,DISP=SHR


sysin la namba ca7 la ena command tharamo atha kuduthu data pick pannikanum

2. CHANGE
   ------
/************************************REXX*******************************
****/
CHANGE:
T_STR1=ARG(1)
T_STR2=ARG(2)
T_STR3=ARG(3)
NUM=0
ARRAY=
FOUND_FLAG=0
VAR2=LENGTH(T_STR1)
VAR3=LENGTH(T_STR2)
I=1
DO FOREVER
VAR1=POS(T_STR1,T_STR2)
IF VAR1 =0 THEN
 DO
  CALL PROCESS
  IF FOUND_FLAG=1 THEN
       DO
      RETURN FINAL_STR
       END
    ELSE
     DO
      RETURN T_STR2
     END
   EXIT
  END
  IF VAR1 \= 0 THEN
    DO
     FOUND_FLAG=1
     VAR4=SUBSTR(T_STR2,1,VAR1-1)
     VAR5=SUBSTR(T_STR2,VAR1+VAR2)
     VAR6=VAR4||T_STR3
     T_STR2=VAR5
     NUM=NUM+1
    ARRAY.I=VAR6
               I=I+1
           END
         END
         PROCESS:
          SIZE=I
          ARRAY.SIZE=VAR5
          FINAL_STR=ARRAY.1
          DO I=2 TO SIZE
            FINAL_STR=FINAL_STR||ARRAY.I
          END
         RETURN FINAL_STR

3. CNT
   ---
~
 /*                     REXX PROGRAM                             */
 /*--------------------------------------------------------------*/
 /*  THIS PROGRAM WILL COUNT THE NUMBER OF BYTES PRESENT IN      */
 /*  A RANGE OF INPUT ( BOUNDED BY THE LINE COMMAND 'C' OR 'CC').*/
 /*  THE OUTPUT WILL BE DISPLAYED ON THE UPPER RIGHT SIDE OF THE */
 /*  SCREEN.                                                     */
 /*--------------------------------------------------------------*/
 /* TRACE I*/
 SUM   = 0
 VALUE1 = 0
 VALUE2 = 0
 OCC_1_LVL   = 99
 OCC_1_TIMES = 1
 OCC_2_LVL   = 99
 OCC_2_TIMES = 1
 OCC_3_LVL   = 99
 OCC_3_TIMES = 1
 OCC_4_LVL   = 99
 OCC_4_TIMES = 1
 OCC_5_LVL   = 99
  OCC_5_TIMES = 1
  ADDRESS ISREDIT
     'ISREDIT MACRO NOPROCESS'
  ADDRESS ISPEXEC
     'ISPEXEC CONTROL ERRORS RETURN'
  ADDRESS ISREDIT
     'ISREDIT PROCESS RANGE C CC'
  SELECT
    WHEN RC = 4 THEN
      DO
        ZEDSMSG = 'ENTER C OR CC'
        ZEDLMSG = 'ENTER A C OR CC ON LINE'
        ADDRESS ISPEXEC
         'ISPEXEC SETMSG MSG(ISRZ001)'
          EXIT 12
      END
    WHEN RC > 4 THEN
          EXIT RC
    OTHERWISE NOP
      END
         /* GET FIRST AND LAST LINE OF THE INPUT */
      ADDRESS ISREDIT
        'ISREDIT (FIRST) = LINENUM .ZFRANGE'
        'ISREDIT (LAST)  = LINENUM .ZLRANGE'
      PREV_REC = ''
  DO LPTR = FIRST TO LAST
     ADDRESS ISREDIT
     'ISREDIT (REC) = LINE' LPTR
    /*   LINE IS COMMENTED OUT  */
    IF SUBSTR(REC,7,1) = '*' THEN
       DO
           ITERATE
       END
     /* OMIT LINE 1-7 AND 73-80 */
     REC = SUBSTR(REC,8,65)
     WORD_CNT = WORDS(REC)
     IF WORD_CNT = 0 THEN
        ITERATE
     /*  THIS CHECKS IF LAST CHAR IN THE RECORD IS A PERIOD */
     IF SUBSTR(WORD(REC,WORD_CNT),WORDLENGTH(REC,WORD_CNT),1) = '.' THEN
        DO
           PREV_REC = PREV_REC || ' ' || REC
           PIC_POS = WORDPOS(' PIC ',REC)
           IF  PIC_POS = 0 THEN
             /*   GET POSITION OF 'PICTURE'  */
               PIC_POS = WORDPOS(' PICTURE ',REC)
           PIC_VALUE_WORD = WORD(REC,PIC_POS + 1)

           LEVEL = WORD(REC,1)
       /*  SAY REC ' REC'
           SAY LEVEL ' LEVEL'
           SAY REDEFINES_LEVEL ' REDEFINES_LEVEL'
           SAY REDEFINES_ACTIVE ' REDEFINES_ACTIVE'
           PULL AA */
           IF REDEFINES_ACTIVE = 'YES' THEN
           DO
              IF LEVEL > REDEFINES_LEVEL THEN
                 ITERATE
              ELSE
              DO
                 REDEFINES_ACTIVE = 'NO'
                 REDEFINES_LEVEL =
              END
           END
           IF INDEX(REC,' REDEFINE ')  > 0,
           |  INDEX(REC,' REDEFINES ') > 0 THEN
           DO
              REDEFINES_ACTIVE = 'YES'
              REDEFINES_LEVEL = LEVEL
              ITERATE
           END
           IF INDEX(PIC_VALUE_WORD,'88') > 0 THEN
              ITERATE
           IF INDEX(REC,' PIC ') > 0 THEN
              CALL PIC_VALUE
           VALUE2=VALUE2+VALUE1
      /*   SAY VALUE2 ' VALUE2 '
           SAY VALUE1 ' VALUE1 ' */
           ITERATE
        END
     ELSE
       DO
          REC = PREV_REC || ' ' || REC
          PREV_REC = ''
       END
    /*   GET LEVEL NUMBER               */
    LEVEL = WORD(REC,1)
    IF LEVEL = 88 THEN
       ITERATE
    CALL CLEAN_UP_OCCURS_ARRAY     /*  INITIALIZE OCCURS ARRAY IF   */
                                   /*  POSSIBLE DUE TO NEW LEVEL NO */
    /*   CHECK IF PART OF A REDEFINES   */
    IF REDEFINES_ACTIVE = 'YES' THEN
       DO
          IF LEVEL > REDEFINES_LEVEL THEN
             ITERATE
          ELSE
             REDEFINES_ACTIVE = 'NO'
       END
    /*   LINE IS A REDEFINES LINE */
    IF INDEX(REC,' REDEFINE ')  > 0,
    |  INDEX(REC,' REDEFINES ') > 0 THEN
       DO
          REDEFINES_ACTIVE = 'YES'
          REDEFINES_LEVEL = LEVEL
          ITERATE
       END
    /*   LINE IS AN OCCURS LINE */
    IF INDEX(REC,' OCCURS ') > 0,
    |  INDEX(REC,' OCCUR ')  > 0 THEN
       CALL SAVE_OCCURS_IN_ARRAY      /* INITIALIZE OCCURS ARRAY IF   */
                                      /* POSSIBLE DUE TO NEW LEVEL NO */
    /*   GET POSITION OF 'PIC'  */
    PIC_POS = WORDPOS(' PIC ',REC)
    IF  PIC_POS = 0 THEN
        /*   GET POSITION OF 'PICTURE'  */
        PIC_POS = WORDPOS(' PICTURE ',REC)
    IF PIC_POS = 0 THEN
       DO
          VALUE1 = 0
       END
    ELSE
       DO
          /*   GET VALUE AFTER 'PIC'  */
          PIC_VALUE_WORD = WORD(REC,PIC_POS + 1)
          VALUE1 = 0
          CALL PIC_VALUE
       END
 /* SAY '#1' LEVEL OCC_1_LVL OCC_1_TIMES  */
 /* SAY '#2' LEVEL OCC_2_LVL OCC_2_TIMES  */
 /* SAY '#3' LEVEL OCC_3_LVL OCC_3_TIMES  */
 /* SAY '#4' LEVEL OCC_4_LVL OCC_4_TIMES  */
 /* SAY '#5' LEVEL OCC_5_LVL OCC_5_TIMES  */
     IF LEVEL > OCC_1_LVL,
      | (   LEVEL = OCC_1_LVL,
          & LPTR  = OCC_1_LINE ) THEN
        VALUE1 = VALUE1 * OCC_1_TIMES
     IF LEVEL > OCC_2_LVL,
      | (   LEVEL = OCC_2_LVL,
          & LPTR  = OCC_2_LINE ) THEN
        VALUE1 = VALUE1 * OCC_2_TIMES
     IF LEVEL > OCC_3_LVL,
      | (   LEVEL = OCC_3_LVL,
          & LPTR  = OCC_3_LINE ) THEN
        VALUE1 = VALUE1 * OCC_3_TIMES
     IF LEVEL > OCC_4_LVL,
      | (   LEVEL = OCC_4_LVL,
          & LPTR  = OCC_4_LINE ) THEN
       VALUE1 = VALUE1 * OCC_4_TIMES
    IF LEVEL > OCC_5_LVL,
     | (   LEVEL = OCC_5_LVL,
         & LPTR  = OCC_5_LINE ) THEN
       VALUE1 = VALUE1 * OCC_5_TIMES
    SUM = SUM + VALUE1
/*  SAY SUM ' SUM AT LAST'
    SAY VALUE1 ' VALUE 1 AT LAST'
    PULL AA */
 END
 /*SAY SUM ' SUM B4'
 SAY VALUE2 ' VALUE2 A4' */
    SUM = SUM + VALUE2
 /* SAY SUM ' SUM FINAL'
    SAY VALUE2 ' VALUE2 FINAL' */
 ZEDSMSG = SUM || ' BYTE(S)'
 ZEDLMSG = 'TOTAL NUMBER OF BYTE(S) IS' SUM
 ADDRESS ISPEXEC
    'ISPEXEC SETMSG MSG(ISRZ001)'
 EXIT
 /*************************/
 /*    END OF PROGRAM     */
 /*************************/
 /*************************/
 /*  ROUTINE TO COUNT THE */
 /*  PICTURE IN A LINE    */
 /*************************/
 PIC_VALUE:
  /*  SAY PIC_VALUE_WORD ' PIC_VALUE_WORD' */
    LOOK_FOR_CLOSE_PAREN = 'NO'
    VALUE1 = 0
    VALUE_IN_PAREN = 0
    DO W1 = 1 TO LENGTH(PIC_VALUE_WORD)
      /*  SAY    SUBSTR(PIC_VALUE_WORD,W1,1)  ' SUBSTR'
          PULL AA */
       SELECT
         WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = ' ' THEN
         DO
      /*    SAY ' IN SPACE PARA' */
            ITERATE
         END
         WHEN LOOK_FOR_CLOSE_PAREN = 'YES' THEN
            DO
         /*    SAY LOOK_FOR_CLOSE_PAREN ' LOOK_FOR_CLOSE_PAREN' */
               IF SUBSTR(PIC_VALUE_WORD,W1,1) = ')' THEN
                  ITERATE
               ELSE
                  DO
                     LOOK_FOR_CLOSE_PAREN = 'NO'
                     ITERATE
                   END
             END
          WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = 'S' THEN
                DO
                  ITERATE
                END
          WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = 'V' THEN
                DO
                  ITERATE
                END
          WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = '(' THEN
             DO
      /*       SAY ' VALUE1 IN ( PARA B4' VALUE1 */
               VALUE1 = VALUE1 - 1
               OPEN_PAREN_FOUND = 'YES'
               ITERATE
             END
          WHEN OPEN_PAREN_FOUND = 'YES' THEN
             DO
               RPAREN_POS = INDEX(PIC_VALUE_WORD,')',W1)
              VALUE_IN_PAREN = SUBSTR(PIC_VALUE_WORD,W1,RPAREN_POS - W1)
               VALUE1 = VALUE1 + VALUE_IN_PAREN
          /*   SAY ' VALUE1 A4 ' VALUE1
               SAY ' VALUE_IN_PAREN ' VALUE_IN_PAREN */
           /*  PULL AA */
               OPEN_PAREN_FOUND = 'NO'
               LOOK_FOR_CLOSE_PAREN = 'YES'
               ITERATE
             END
         WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = '.' THEN
            DO
      /*      SAY W1 ' W1'
              SAY PIC_VALUE_WORD ' PIC_VALUE_WORD'
              PULL AA */
               IF W1 = LENGTH(PIC_VALUE_WORD) THEN
                  DO
                     ITERATE
                  END
               ELSE
                 VALUE1 = VALUE1 + 1
            END
       OTHERWISE
       DO
         VALUE1 = VALUE1 + 1
     /*  SAY ' VALUE1 IN OTHERWISE ' VALUE1 */
       END
       END
    END
    /* SAY 'VALUE = ' || VALUE */
    IF SUBSTR(PIC_VALUE_WORD,1,1) = 'S',
     | SUBSTR(PIC_VALUE_WORD,1,1) = 'V',
     | SUBSTR(PIC_VALUE_WORD,1,1) = '9' THEN
       DO
          SELECT
             WHEN INDEX(REC,' COMP ')   > 0,        /* COMP OR COMP-4 */
              |   INDEX(REC,' COMP.')   > 0,
              |   INDEX(REC,' COMP-4 ') > 0,
              |   INDEX(REC,' COMP-4.') > 0 THEN
                DO
                   SELECT
                      WHEN VALUE1 <= 4 THEN
                         VALUE1 = 2
                      WHEN VALUE1 <= 9 THEN
                         VALUE1 = 4
                      OTHERWISE
                         VALUE1 = 8
                   END
                END
             WHEN INDEX(REC,' COMP-3 ') > 0,        /* COMP-3 */
              |   INDEX(REC,' COMP-3.') > 0 THEN
                VALUE1 = (VALUE1 % 2) + 1
             WHEN INDEX(REC,' COMP-1 ') > 0,        /* COMP-1 */
              |   INDEX(REC,' COMP-1.') > 0 THEN
                VALUE1 = 4
             WHEN INDEX(REC,' COMP-2 ') > 0,        /* COMP-2 */
              |   INDEX(REC,' COMP-2.') > 0 THEN
                VALUE1 = 8
             OTHERWISE NOP
          END
       END
  /*   SAY VALUE1 ' VALUE1 IN PIC ROUTINE' */
 RETURN
 /*   END OF PIC_VALUE ROUTINE     */
 /*************************/
  /*  ROUTINE TO CLEAN UP  */
  /*  THE OCCURS ARRAY     */
  /*************************/
  CLEAN_UP_OCCURS_ARRAY:
     IF LEVEL <= OCC_1_LVL THEN
        DO
           OCC_1_LVL   = 99
           OCC_1_TIMES =  1
           OCC_1_LINE  =  0
        END
     IF LEVEL <= OCC_2_LVL THEN
        DO
           OCC_2_LVL   = 99
           OCC_2_TIMES =  1
           OCC_2_LINE  =  0
        END
     IF LEVEL <= OCC_3_LVL THEN
        DO
           OCC_3_LVL   = 99
           OCC_3_TIMES =  1
           OCC_3_LINE  =  0
        END
     IF LEVEL <= OCC_4_LVL THEN
        DO
           OCC_4_LVL   = 99
           OCC_4_TIMES =  1
           OCC_4_LINE  =  0
        END
     IF LEVEL <= OCC_5_LVL THEN
        DO
          OCC_5_LVL   = 99
          OCC_5_TIMES =  1
          OCC_5_LINE  =  0
       END
 RETURN
 /*   END OF CLEAN_UP_OCCURS_ARRAY ROUTINE     */
 /*************************/
 /*  ROUTINE TO SAVE IN   */
 /*  OCCURS ARRAY         */
 /*************************/
 SAVE_OCCURS_IN_ARRAY:
     OCCURS_WORD_POS = WORDPOS(' OCCURS ',REC)
     IF OCCURS_WORD_POS = 0 THEN
        OCCURS_WORD_POS = WORDPOS(' OCCUR ',REC)
     TIMES = WORD(REC,OCCURS_WORD_POS + 1)
     DO
        SELECT
           WHEN OCC_1_LVL = 99 THEN
              DO
                 OCC_1_LVL   = LEVEL
                 OCC_1_TIMES = TIMES
                 OCC_1_LINE  = LPTR
              END
           WHEN OCC_2_LVL = 99 THEN
              DO
                OCC_2_LVL   = LEVEL
                OCC_2_TIMES = TIMES
                OCC_2_LINE  = LPTR
             END
          WHEN OCC_3_LVL = 99 THEN
             DO
                OCC_3_LVL   = LEVEL
                OCC_3_TIMES = TIMES
                OCC_3_LINE  = LPTR
             END
          WHEN OCC_4_LVL = 99 THEN
             DO
                OCC_4_LVL   = LEVEL
                OCC_4_TIMES = TIMES
                OCC_4_LINE  = LPTR
             END
          WHEN OCC_5_LVL = 99 THEN
             DO
                OCC_5_LVL   = LEVEL
                OCC_5_TIMES = TIMES
                OCC_5_LINE  = LPTR
             END
          OTHERWISE
             SAY 'ERROR ===> ARRAY EXCEEDED (MORE THAN 5)'
       END
    END
 RETURN
 /*   END OF SAVE_OCCURS_IN_ARRAY ROUTINE     */

4. COPY A CERTAIN MEMBERS FROM A PDS TO ANOTHER PDS
   ------------------------------------------------
/****REXX**/
/****COPY A CERTAIN MEMBERS FROM A PDS TO ANOTHER PDS ***/
INP='N01.LK.SNE.GDIS.PROGRAM.CUT'
INP1='NANNA1.SQL.FINAL.OUTPUT'
OUTJOB='N01.LK.GDIS.FREEZE.PGMS.INP2'
ADDRESS TSO
X=OUTTRAP("RESJOB.")
"LISTDS ('"||INP||"') MEMBERS"
X=OUTTRAP("OFF")
ADDRESS TSO
"ALLOC FI(DD3) DS('"INP1"') SHR"
"EXECIO * DISKR DD3(FINIS STEM INP2."
"FREE FI(DD3)"

/******************DECLARATIONS******************/
Z=1
DO K=1 TO INP2.0
   INP2.K=STRIP(INP2.K)
   SAY INP2.K
   DO J=7 TO RESJOB.0
     RESJOB.J=STRIP(RESJOB.J)
     IF RESJOB.J=INP2.K THEN
     DO
        INPUT=INP||'('RESJOB.J')'
        INP1.=
        INP3.=
        ADDRESS TSO
        "ALLOC FI(DD4) DS('"INPUT"') SHR"
        "EXECIO * DISKR DD4(FINIS STEM INP1."
        "FREE FI(DD4)"
        DO L=1 TO INP1.0
           INP3.L=INP1.L
        END
        OUTPUT=OUTJOB||'('RESJOB.J')'
        ADDRESS TSO
        "ALLOC FI(DD5) DS('"OUTPUT"') SHR"
        "EXECIO * DISKW DD5(FINIS STEM INP3."
        "FREE FI(DD5)"
     END
   END
END
EXIT

5. CREATE A DATASET
   ----------------
/*REXX*/
OUTPUT='NANNA1.SNE.DIT2'
IF SYSDSN("'"OUTPUT"'") = 'OK' THEN
   NOP
ELSE
DO
   ADDRESS TSO
   "ALLOCATE DATASET('"OUTPUT"') CATALOG LRECL (80) EXPDT(2017/364)
    VOLUME(PRJ002)             BLKSIZE(27920) MGMTCLAS(STANDARD)
  STORCLAS(STANDARD) RECFM(F B) DSORG(PS) CYLINDER SPACE(50 50) DIR(0)"
  "FREE DA('"OUTPUT"')"
END
EXIT

6. DELETE A SET OF FILES
   ---------------------
/*****REXX************/
INPUT='NANNA1.OUT12'
"ALLOC FI(DD2) DS('"INPUT"') SHR"
"EXECIO * DISKR DD2(FINIS STEM INP."
"FREE FI(DD2)"
DO I = 1 TO INP.0
    INP.I=STRIP(INP.I)
    INP.I="'" || INP.I || "'"
    SAY INP.I
    DELETE INP.I
END

7. FILEAID JCL
   -----------
//NANNA1AA JOB (ACCOUNT),CLASS=A,MSGLEVEL=(1,1),MSGCLASS=R,             
//         NOTIFY=NANNA1
//FASTEP   EXEC PGM=FILEAID,REGION=8M
//STEPLIB  DD  DISP=SHR,DSN=SYS2.FILEAID.V940.CXFALOAD
//         DD  DISP=SHR,DSN=SYS2.FILEAID.V940.SXFALOAD
//SYSPRINT DD  SYSOUT=*
//SYSLIST  DD  SYSOUT=*
//DD01     DD  DSN=N01.LIBR.LIBCCF.DST,DISP=SHR
//DD01O    DD  DSN=NANNA1.GFMV.PGM,
//             DISP=OLD
//SYSIN    DD  *
$$DD01 COPY PADCHAR=X'00',CEM=YES,RLM=YES,
  MEMBER=(DCC81,DCEDI01)
/*

8. GET MEMBER NAME FROM A PDS
   --------------------------
/*************REXX****************/
INP='N01.LK.UPC.OTHERS'
OUTPUT='NANNA1.OUT'
ADDRESS TSO
X=OUTTRAP("RES.")
"LISTDS ('"||INP||"') MEMBERS"
X=OUTTRAP("OFF")
/**************DECLARATIONS**************/
Z=1

DO I = 7 TO RES.0
   RES.I=STRIP(RES.I)
   OUTPUT.Z=RES.I
   Z=Z+1
END
   ADDRESS TSO
   "ALLOC FI(DD4) DS('"OUTPUT"') SHR"
   "EXECIO * DISKW DD4(FINIS STEM OUTPUT."
   "FREE FI(DD4)"
EXIT

9. CHECK NEW DATASETS FROM A SET OF JCLS
   -------------------------------------
/*************REXX****************/
JCLRC = 0
DO WHILE JCLRC < 8
   MSGSTAT=MSG('ON')
   MSGI = "TOOL TO CHECK NEW DATASETS FROM A SET OF JCLS"
   ADDRESS ISPEXEC "SETMSG MSG(ISRZ001 )"
ADDRESS ISPEXEC
 "LIBDEF ISPPLIB DATASET ID('NANNA1.REXX')"
ADDRESS ISPEXEC
 "DISPLAY PANEL(TABPANL)"

 JCLRC = RC
 MSGSTAT=MSG('OFF')

INP = INPI
INP = TRANSLATE(INP)
INP = STRIP(INP)
OUTPUT = OUTI
OUTPUT = TRANSLATE(OUTPUT)
OUTPUT = STRIP(OUTPUT)
  IF JCLRC = 8 THEN
  DO
   INPI = " "
   OUTI = " "
  END
  IF RESP = "PF03" THEN
  DO
     EXIT(0)
  END
ADDRESS TSO
X=OUTTRAP("RES.")
"LISTDS ('"||INP||"') MEMBERS"
X=OUTTRAP("OFF")
/**************DECLARATIONS**************/
DL ='DSN='
DL1=','
Z=1
COUNT=0
INLINE_FLAG=0
SECOND_INLINE=0
THIRD_INLINE=0

DO I = 7 TO RES.0
   RES.I=STRIP(RES.I)
   INPUT=INP||'('RES.I')'
   INP.=
   ADDRESS TSO
   "ALLOC FI(DD2) DS('"INPUT"') SHR"
   "EXECIO * DISKR DD2(FINIS STEM INP."
   "FREE FI(DD2)"
   SAY INP.0
   OUTPUT.Z=RES.I
   Z=Z+1
   DO X= 1 TO INP.0
      IF INDEX(INP.X,'NEW') > 0 & INDEX(INP.X,'DISP') > 0 &,
         SUBSTR(INP.X,3,1) \= '*' THEN
      DO
          IF INDEX(INP.X,'DSN') > 0 THEN
          DO
             PARSE VAR INP.X FIRST (DL) FILE (DL1)
             IF INDEX(FILE,'&&') = 0 THEN
             DO
               OUTPUT.Z=RIGHT(FILE,60,' ')
               Z=Z+1
             COUNT=COUNT+1
             END
             INLINE_FLAG = 1
          END
          G=X-1
          IF INDEX(INP.G,'DSN') > 0 & INLINE_FLAG = 0 THEN
          DO
             PARSE VAR INP.G FIRST (DL) FILE (DL1)
             IF INDEX(FILE,'&&') = 0 THEN
             DO
               OUTPUT.Z=RIGHT(FILE,60,' ')
               Z=Z+1
               COUNT=COUNT+1
             END
             G=0
          END
          INLINE_FLAG = 0
      END
      IF INDEX(INP.X,'(,CATLG,DELETE)') > 0 &,
         INDEX(INP.X,'DISP') > 0 &,
         SUBSTR(INP.X,3,1) \= '*' THEN
      DO
          IF INDEX(INP.X,'DSN') > 0 THEN
          DO
             PARSE VAR INP.X FIRST (DL) FILE (DL1)
             IF INDEX(FILE,'&&') = 0 THEN
             DO
               OUTPUT.Z=RIGHT(FILE,60,' ')
               Z=Z+1
               COUNT=COUNT+1
             END
             SECOND_INLINE = 1
          END
          G=X-1
          IF INDEX(INP.G,'DSN') > 0 & SECOND_INLINE = 0 THEN
          DO
             PARSE VAR INP.G FIRST (DL) FILE (DL1)
             IF INDEX(FILE,'&&') = 0 THEN
             DO
               OUTPUT.Z=RIGHT(FILE,60,' ')
               Z=Z+1
               COUNT=COUNT+1
             END
             G=0
          END
          SECOND_INLINE = 0
      END
      IF INDEX(INP.X,'(MOD,CATLG') > 0 &,
         INDEX(INP.X,'DISP') > 0 &,
         SUBSTR(INP.X,3,1) \= '*' THEN
      DO
          IF INDEX(INP.X,'DSN') > 0 THEN
          DO
             PARSE VAR INP.X FIRST (DL) FILE (DL1)
             IF INDEX(FILE,'&&') = 0 THEN
             DO
               OUTPUT.Z=RIGHT(FILE,60,' ')
               Z=Z+1
               COUNT=COUNT+1
             END
             THIRD_INLINE = 1
          END
          G=X-1
          IF INDEX(INP.G,'DSN') > 0 & THIRD_INLINE = 0 THEN
          DO
             PARSE VAR INP.G FIRST (DL) FILE (DL1)
             IF INDEX(FILE,'&&') = 0 THEN
             DO
               OUTPUT.Z=RIGHT(FILE,60,' ')
               Z=Z+1
               COUNT=COUNT+1
             END
             G=0
          END
          THIRD_INLINE = 0
      END

   END
   OUTPUT.Z=RIGHT(COUNT,70,' ')
   Z=Z+1
   OUTPUT.Z='---------------------------------------------------------'
   Z=Z+1
   COUNT=0
END
IF SYSDSN("'"OUTPUT"'") = 'OK' THEN
   NOP
ELSE
DO
   ADDRESS TSO
   "ALLOCATE DATASET('"OUTPUT"') CATALOG LRECL (80)
    BLKSIZE(27920)  RECFM(F B) DSORG(PS) TRACKS SPACE(50 50) DIR(0)"
  "FREE DA('"OUTPUT"')"
END
ADDRESS TSO
   "ALLOC FI(DD4) DS('"OUTPUT"') SHR"
   "EXECIO * DISKW DD4(FINIS STEM OUTPUT."
   "FREE FI(DD4)"
    MSGSTAT=MSG(ON)
    MSGY='NEW DATASETS ARE LISTED IN OUTPUT REPORT SUCCESSFULLY'
    MSGO=' CHECK YOUR OUTPUT IN  ' || OUTPUT
    ADDRESS ISPEXEC "SETMSG MSG(ISRZ001 )"
    INPI=" "
    OUTI=" "
END
EXIT

10. CONNECT REXX TO DB2 TABLES
    --------------------------
/**rexx**/
ADDRESS TSO "SUBCOM DSNREXX"
say rc
IF RC = 0 THEN
DO
    S_RC=RXSUBCOM('ADD','DSNREXX','DSNREXX')
    SAY 'DB2 CONNECTED'
END
ADDRESS DSNREXX "CONNECT DSNT"
CALL RXSUBCOM 'ADD','SQL','RXTASQL'
X=DB2SET('PS','O')
SAY RC' A4 OPN'
QUERY1 = "SELECT JOB_NAME FROM  DEVGEN.JOB WHERE JOB_NAME="@@ABC123";"
SAY QUERY1
ADDRESS SQL QUERY1
SAY RC' A4 QRY'
X=DB2SET('PS','C')
SAY SQLCA.SQLROWS
 ADDRESS DSNREXX "DISCONNECT"
 S_RC=RXSUBCOM('DELETE','DSNREXX','DSNREXX')
EXIT

11. COMMENT CERTAIN LINES IN COBOL
    ------------------------------
/**REXX**/
"ISREDIT MACRO (N) NOPROCESS"
 ISREDIT "(MX)=LINENUM .ZLAST "
 SAY MX 'MX '
 SAY N  'N  '
 IF LENGTH(N)=0 THEN N=7
 ISREDIT "PROCESS RANGE CO"
 ISREDIT "(L)=LINENUM .ZFRANGE "
 ISREDIT "(MX)=LINENUM .ZLRANGE "
 ISREDIT "LABEL "L"=.THIS "
 ISREDIT "LABEL "MX"=.THAT "
 ISREDIT "C "N" ' ' '*' ALL .THIS .THAT"
 EXIT

12. REXXJCL
    -------
//TESTJOB  JOB DST,CLASS=A,MSGCLASS=9,MSGLEVEL=(1,1),
//         NOTIFY=&SYSUID
//STEP1 EXEC PGM=IKJEFT01
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*
//SYSTSIN DD *
 EXEC 'N01.LN.REXX.TOOL(COMPCHK)'
/*

13. GET COBOL TIMESTAMP FROM LINKLIB
    --------------------------------
//TIMEJCL  JOB (DVBP),MASSCLON,CLASS=B,MSGCLASS=A,
//         NOTIFY=&SYSUID,MSGLEVEL=(1,1)
//*********************************************************************
//* DELETE OUTPUT DATASETS GENERATED IN THE NEXT STEP
//*********************************************************************
//STEP00 EXEC PGM=IEFBR14
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//DD2      DD DSN=S3S2.PGMVALID,DISP=(MOD,DELETE,DELETE),
//         SPACE=(TRK,0)
//DD3      DD DSN=S3S2.INSTALL.STATUS,DISP=(MOD,DELETE,DELETE),
//         SPACE=(TRK,0)
/*
//STEP000   EXEC PGM=IEBGENER,REGION=0M
//SYSPRINT DD SYSOUT=*
//SYSUT1   DD DATA,DLM='灿'
//*********************************************************************
//ACTIVEOB JOB (DGBP,$$CLPREP),FIN,
//             CLASS=C,MSGCLASS=R,
//             MSGLEVEL=(1,1),
//             NOTIFY=&SYSUID
/*JOBPARM  C=0,L=1,T=5
/*ROUTE    PRINT SP03
/*ROUTE    XEQ SP02
//*
//*********************************************************************
//STEP01 EXEC PGM=IEFBR14
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//DD1      DD DSN=S2S3.TIMESTMP.OUT,DISP=(MOD,DELETE,DELETE),
//         SPACE=(TRK,0)
/*
//*********************************************************************
//* TO GET THE COMPILE TIMESTAMP FOR LIST OF LOAD MODULES IN THE
//* REMEDIATED LOAD LIBRARIES
//*********************************************************************
//FNDTSTP1 EXEC PGM=AMBLIST
//SYSPRINT DD   DSN=S2S3.TIMESTMP.OUT,
//         SPACE=(TRK,(30,20),RLSE),DISP=(,CATLG,DELETE),
//         DCB=(RECFM=FB,LRECL=80)
//SYSOUT   DD   SYSOUT=*
//STEPLIB  DD   DSN=SYS1.LINKLIB,DISP=SHR
//MYLOAD   DD   DSN=WM.BR.LINKLIB,DISP=SHR
//SYSIN    DD   DSN=S3S2.TIMESTMP.BATCH,DISP=SHR
//*
//FNDTSTP2 EXEC PGM=AMBLIST
//SYSPRINT DD   DSN=S2S3.TIMESTMP.OUT,
//         SPACE=(TRK,(30,20),RLSE),DISP=(MOD,CATLG,DELETE),
//         DCB=(RECFM=FB,LRECL=80)
//SYSOUT   DD   SYSOUT=*
//STEPLIB  DD   DSN=SYS1.LINKLIB,DISP=SHR
//MYLOAD   DD   DSN=WM.BR.CICSLINK,DISP=SHR
//SYSIN    DD   DSN=S3S2.TIMESTMP.CICS,DISP=SHR
//*
//**********************************************************
//*STEP002 - TRIGGERS SP03JOB WHICH WILL RUN IN SP03
//**********************************************************
//STEP002   EXEC PGM=IEBGENER,REGION=0M
//SYSPRINT DD SYSOUT=*
//SYSUT1   DD DATA,DLM='止'
//*********************************************************************
//SP03JOB  JOB (DGBP,$$CLPREP),FIN,
//             CLASS=C,MSGCLASS=R,
//             MSGLEVEL=(1,1),
//             NOTIFY=&SYSUID
//*********************************************************************
/*JOBPARM  C=0,L=1,T=5
/*ROUTE    PRINT SP03
/*ROUTE    XEQ SP03
//*
//*********************************************************************
//* CHECKS FOR PGM COMPILE DATE AND CURRENT DATE
//*********************************************************************
//STEP02 EXEC PGM=IKJEFT01
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//SYSTSPRT DD SYSOUT=*
//SYSTSIN DD *
 EXEC 'N01.LN.REXX.TOOL.SUIN(DATEINTL)'
/*
止
//SYSIN     DD DUMMY
//SYSUT2    DD SYSOUT=(A,INTRDR),
//             DCB=(RECFM=F,LRECL=80,BLKSIZE=80)
灿
//SYSIN     DD DUMMY
//SYSUT2    DD SYSOUT=(A,INTRDR),
//             DCB=(RECFM=F,LRECL=80,BLKSIZE=80)


14. PANEL SAMPLE
    ------------
)ATTR
@ TYPE(TEXT) COLOR(RED) INTENS(HIGH)
$ TYPE(TEXT) COLOR(WHITE) INTENS(HIGH)
! TYPE(TEXT) COLOR(YELLOW) INTENS(HIGH)
% TYPE(TEXT) COLOR(GREEN) INTENS(HIGH)
_ TYPE(INPUT) INTENS(HIGH) COLOR(WHITE) PAD('_')
/ TYPE(OUTPUT) INTENS(HIGH)  COLOR(YELLOW)
)BODY
%COMMAND ===>_ZCMD
$
$ *****************************************
$ *** "PROGRAM INSTALL VALIDATION"      ***
$ *****************************************
$
% ENTER YOUR OPTION _Z+
@  1. US MARKETS
@  2. INTERNATIONAL MARKETS
$  ------------------------------------------------------------------
$  -NOTE:
$  -ENTER A NUMBER 1 OR 2 TO USE THE SPECIFIED TOOL
$  ------------------------------------------------------------------
! /MSGY
)INIT
ZVARS='(OPT)'
)REINIT
 REFRESH(*)
)PROC
VER(&OPT,NB)
VER(&OPT,RANGE,1,2)
&RESP = .PFKEY
)END

15. SUPERC
    ------
/*******************REXX*******************/
/********* USING NEXCLUDE , OEXCLUDE COLS IN SUPERC JCL**********/
QUEUE 'SUPERC'
  ADDRESS TSO EX "'NANNA1.SNE.TOOLS.SIMPLE(STATLOG)'"
  ADDRESS TSO
 PDSN = USERID()".SUPERC.JCL"
 IF SYSDSN("'"PDSN"'") \= "OK" THEN
 DO
  "ALLOC F(DD1) DS('"PDSN"') NEW TRACKS SPACE(10,10) DIR(10) REUSE",
  "DSORG(PO) RECFM(F,B) LRECL(80) blksize(8000)"
  "FREE FILE(DD1)"
 END
 PDSN1=USERID()".SUPERC.MAILPAM"
 IF SYSDSN("'"PDSN1"'") \= "OK" THEN
 DO
  "ALLOC F(DD1) DS('"PDSN1"') NEW TRACKS SPACE(1,14) REUSE",
  "DSORG(PS) RECFM(F,B,A) LRECL(203)"
  "FREE FILE(DD1)"
 END
  ELEMENT="N01.LN.SNE.REXX.TOOLS(PARMSKL)"
 /* ELEMENT=USERID()."SUPERC.TOOL(PARMSKL)" */
 "ALLOC F(DD1) SHR DS('"ELEMENT"')"
 "EXECIO * DISKR DD1(FINIS STEM IN."
 "FREE F(DD1)"
 ELEMENT=USERID()."SUPERC.MAILPAM"
 "ALLOC F(DD1) SHR DS('"ELEMENT"')"
 "EXECIO * DISKW DD1(FINIS STEM IN."
 "FREE F(DD1)"
ADDRESS ISPEXEC
   "ISPEXEC EDIT DATASET('"ELEMENT"') MACRO(UCHANGE)"
   "ISREDIT CANCEL"
/* DISPLAYING THE PANEL*/
CALL PANEL_THROW
EXIT
PANEL_THROW:
   "DISPLAY PANEL(SUPCPNL)"
    IF RESP = "PF03" THEN
    DO
      SAY ' YOU HAVE PRESSED EXIT'
      EXIT(0)
    END
    ELSE DO
      NAME1 = FILE1
      NAME2 = FILE2
      COLRANGE = COLS
      COLRANGE = STRIP(COLRANGE)
      POSNUM = POS(' ',COLRANGE)
    IF POSNUM \= 0 THEN
      DO
    /*  INPUT IS HAVING MORE THAN ONE RANGE */
       LOC1 = POSNUM - 1
       LOC2 = POSNUM + 1
       PART1 = SUBSTR(COLRANGE,1,LOC1)
       PART2 = SUBSTR(COLRANGE,LOC2)
       PARSE VAR PART1 COL1 ":" COL2
       PARSE VAR PART2 COL3 ":" COL4
      CALL SUPERC
      CALL EMAIL
      RETURN
      EXIT
      END
    ELSE IF COLS \= "" THEN
      DO
       /* INPUT IS HAVING ONE RANGE*/
         PARSE VAR COLRANGE COL1 ":" COL2
   /*    COL3 = 0
         COL4 = 0 */
         CALL SUPERC
         CALL EMAIL
         RETURN
         EXIT
      END
     ELSE
       /* INPUT IS NOT HAVING RANGE*/
      DO
       COL1 = 0
       COL2 = 0
       COL3 = 0
       COL4 = 0
      CALL SUPERC
      CALL EMAIL
      RETURN
      EXIT
      END
    END
SUPERC:
/* CODE TO EXECUTE SUPERC ON USER INPUT FILES */
ADDRESS ISPEXEC
SAY 'EXECUTING SUPERC'
USER = USERID()
/*SKLDSN = USER".SUPERC.TOOL"*/
SKLDSN = "N01.LN.SNE.REXX.TOOLS"
JCLDSN = USER".SUPERC.JCL"
"LIBDEF ISPSLIB DATASET ID('"SKLDSN"')"
"LIBDEF ISPFILE DATASET ID('"JCLDSN"')"
JOBLINE1  = '//'USER'H  JOB (DCBP),DST,MSGLEVEL=(1,1),'
JOBLINE2  = '//             CLASS=9,MSGCLASS=A,NOTIFY=&SYSUID'
NEWDSN   = NAME1
OLDDSN   = NAME2
OUTDSN  = USER".SUPERC.OUTPUT"
 "FTOPEN"
 "FTINCL SUPCSKL"
NEWJOB = "SUPCJCL"
"FTCLOSE NAME("NEWJOB")"
TEMPDSN = JCLDSN || "("NEWJOB")"
X =  OUTTRAP('JOB.')
ADDRESS TSO "SUBMIT '"TEMPDSN"'"
X = OUTTRAP("OFF")
ADDRESS SYSCALL
 "SLEEP" 10
 CALL SYSCALLS 'OFF'
   RETURN
 /* SENDING SUPERC OUTPUT IN EMAIL WITH ATTACHMENT*/
EMAIL :
ADDRESS ISPEXEC
SAY" EXECUTING  EMAIL"
USER = USERID()
/*SKLDSN = USER".SUPERC.TOOL"*/
SKLDSN = "N01.LN.SNE.REXX.TOOLS"
JCLDSN = USER".SUPERC.JCL"
"LIBDEF ISPSLIB DATASET ID('"SKLDSN"')"
"LIBDEF ISPFILE DATASET ID('"JCLDSN"')"
JOBLINE1  = '//'USER'H  JOB (DCBP),DST,MSGLEVEL=(1,1),'
JOBLINE2  = '//             CLASS=9,MSGCLASS=A,NOTIFY=&SYSUID'
INDSN = USER".SUPERC.MAILPAM"
OUTDSN  = USER".SUPERC.OUTPUT"
 "FTOPEN"
 "FTINCL MAILSKL"
NEWJOB = "MAILJCL"
"FTCLOSE NAME("NEWJOB")"
TEMPDSN = JCLDSN || "("NEWJOB")"
X =  OUTTRAP('JOB.')
ADDRESS TSO "SUBMIT '"TEMPDSN"'"
X = OUTTRAP("OFF")
ADDRESS SYSCALL
 "SLEEP" 2
 CALL SYSCALLS 'OFF'
 SAY 'CHECK OUTPUT IN MAILBOX'
   RETURN

16. OBSOLETE JCL
    ------------
/*REXX*/
QUEUE 'OBSJCL'
ADDRESS TSO EX "'N01.LN.SNE.REXX.TOOLS(STATLOG)'"
ADDRESS ISPEXEC
 "LIBDEF ISPPLIB DATASET ID('N01.LN.SNE.REXX.TOOLS')"
ADDRESS ISPEXEC
 "DISPLAY PANEL(OBJOBPNL)"

INP = INPI
INP = TRANSLATE(INP)
INP = STRIP(INP)

IF RESP = "PF03" THEN
DO
   EXIT(0)
END
ADDRESS TSO
X=OUTTRAP("PGM.")
"LISTDS ('"||INP||"') MEMBERS"
X=OUTTRAP("OFF")
   DO I = 7 TO PGM.0
      PGM.I=STRIP(PGM.I)
      TEMP =STRIP(PGM.I)
      INPUT=INP||'('PGM.I')'
      INP.=
       ADDRESS ISPEXEC "EDIT DATASET ('"INPUT"') " ||,
       " MACRO(OBSOLJOB) PARM(TEMP)"
   END
   SAY 'OBSOLETE JCLS GENERATED SUCCESSFULLY'
 EXIT

17. OBSOLETE JCL - 2
    ----------------
/* REXX */
ADDRESS ISREDIT "MACRO (JOBNAME)"
ADDRESS ISREDIT
"DELETE" .ZF .ZL
OUTPUT1 = '//'JOBNAME'  JOB (MOBP),OBSOLETE,'
ADDRESS ISREDIT "LINE_AFTER  0 = (OUTPUT1)"
OUTPUT2 = '//           CLASS=R,MSGCLASS=8,SCHENV=BATCH,'
ADDRESS ISREDIT "LINE_AFTER  1 = (OUTPUT2)"
OUTPUT3 = '//           MSGLEVEL=(1,1)'
ADDRESS ISREDIT "LINE_AFTER  2 = (OUTPUT3)"
OUTPUT4 = '//JOBLIB   DD DSN=WM.SP.LINKLIB,DISP=SHR'
ADDRESS ISREDIT "LINE_AFTER  3 = (OUTPUT4)"
OUTPUT5 = ,
     '//$AVRS    OUTPUT CLASS=8,DEFAULT=YES,DEST=$GO,JESDS=ALL'
ADDRESS ISREDIT "LINE_AFTER  4 = (OUTPUT5)"
/*ADDRESS ISREDIT
F FIRST NX '" JOB "'" */
/*IF RC = 0 THEN DO */
/*END */
TDATE = DATE("S")
YEAR  = SUBSTR(TDATE,3,2)
MM    = SUBSTR(TDATE,5,2)
DD    = SUBSTR(TDATE,7,2)
XDATE = MM'/'DD'/'YEAR
USER = USERID()
JLN1  = "//******************************************************"
ADDRESS ISREDIT "LINE_AFTER  5 = (JLN1)"
JLN2  = "//* JOB "JOBNAME "WAS MADE OBSOLETE "XDATE" - " USER
ADDRESS ISREDIT "LINE_AFTER  6 = (JLN2)"
JLN3  = "//******************************************************"
ADDRESS ISREDIT "LINE_AFTER  7 = (JLN3)"
JLN4  = "//*STEP01   TELLOP"
ADDRESS ISREDIT "LINE_AFTER  8 = (JLN4)"
JLN5  = "//*-----------------------------------------------------"
ADDRESS ISREDIT "LINE_AFTER  9 = (JLN5)"
JLN6  = "//STEP01   EXEC PGM=TELLOP "
ADDRESS ISREDIT "LINE_AFTER  10 = (JLN6)"
JLN7  = "//"
ADDRESS ISREDIT "LINE_AFTER  11 = (JLN7)"
ADDRESS ISREDIT
"SAVE"
"END"
EXIT

18. REXX CODE FOR INVOKING PANELS
    -----------------------------
FTPRC = 0
DO WHILE FTPRC < 8
   MSGSTAT=MSG('ON')
   MSGI = "TOOL TO CHECK FTP PARMS FROM A SET OF JCLS"
   ADDRESS ISPEXEC "SETMSG MSG(ISRZ001 )"
ADDRESS ISPEXEC
 "LIBDEF ISPPLIB DATASET ID('N01.LN.REXX.TOOL')"
ADDRESS ISPEXEC
 "DISPLAY PANEL(TABPANL)"
FTPRC = RC
   MSGSTAT=MSG('OFF')
   INP = INPI
   INP = TRANSLATE(INP)
   INP = STRIP(INP)
   OUTJOB = OUTI
   OUTJOB = TRANSLATE(OUTJOB)
   OUTJOB = STRIP(OUTJOB)
     IF FTPRC = 8 THEN
     DO
      INPI = " "
      OUTI = " "
     END
   IF RESP = "PF03" THEN
   DO
     EXIT(0)
   END
/*INP='KGANESA.SNE.HO.JCL'
OUTJOB='NANNA1.JCLOUT'*/
ADDRESS TSO
X=OUTTRAP("RESJOB.")
"LISTDS ('"||INP||"') MEMBERS"
X=OUTTRAP("OFF")
        MSGSTAT=MSG(ON)
        MSGY='FTP PARMS LISTED IN OUTPUT REPORT SUCCESSFULLY'
        MSGO=' CHECK YOUR OUTPUT IN  ' || OUTJOB
        ADDRESS ISPEXEC "SETMSG MSG(ISRZ001 )"
        INPI=" "
        OUTI=" "
END
EXIT