- 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
