## Rexx Working with Arguments

```/* Main program */
exit
PARSE ARG a,b

return a + b
say arg() ```

## Rexx Defining a Function

```/* Main program */
exit
PARSE ARG a,b
return a + b
say
say c```

## Rexx Defining a Function

```/* Main program */
PARSE ARG a,b
return a + b
exit ```

## Rexxy

```/* Main program */
O = "TTYA.MRPYM.SAMPLE.NEW"
P = 0
K = 0
K1 = 1
Z = 1
D = 1
J = LENGTH(O)
DO I = 1 TO J
K = POS('.',O,K1)
IF K = 0 THEN DO
B.D = J
A = SUBSTR(O,Z,J+1-Z)
SAY A
SAY B.D
LEAVE
END
IF K > 0 THEN DO
B.D = K
K1 = K+1
A = SUBSTR(O,Z,K-Z)
Z=K1
SAY A
SAY B.D
END
END```

## Execute REXX Online

```/* Main program */
list.1 = 10
list.1.1 = 11
list.1.2 = 12

say list.1
say list.1.1
say list.1.2

/*
parse arg result
say result
exit
*/
```

## EXPND project

```/*REXX*/
/* expnd */
/*ISPEXEC "VIEW DATAID("DATID") MEMBER("MEMBR") MACRO(WHATEVER)"  */
/* ADDRESS ISREDIT " MACRO (Z) PROCESS"              */
X = V
"ISREDIT (LNE) = LINE .ZCSR"
"ISREDIT (LNENUM) = LINENUM .ZCSR"
"ISREDIT (R1 C1) = CURSOR"
LODLIBSTACK.0 = 0
PVARSTACK.0 = 0
PARMSTACK.0 = 0
PARM_STACK_CNT = 0
CALL RUNTYPESELECT
CALL VERIFYRUN
IF FIRST_RUN_FLAG = 'TRUE' THEN
DO
CALL GETSETVAR
CALL GETJCLLIB
CALL GETPROCSETVAR
CALL GETINCLUDEMEM
CALL PROCLIBCHECK
CALL WRITETOFILE
"ISREDIT (LNE) = LINE" LNENUM
IF PARM_TYPE = 'TRUE' THEN
DO
CALL PARMOPENPARA
END
IF PROC_TYPE = 'TRUE' THEN
DO
CALL PROCOPENPARA
END

IF COBOL_TYPE = 'TRUE' THEN
DO
CALL COBOPENPARA
END

IF FILE_TYPE = 'TRUE' THEN
DO
CALL FILEOPENPARA
END

IF INC_MEM_TYPE = 'TRUE' THEN
DO
CALL OPENINCMEMPARA
END
CALL TERMPARA
END
ELSE
DO
CALL GETPROCVARS
CALL GETPROCSETVAR
CALL FINALPROCVARSET
CALL GETINCLUDEMEM
"ISREDIT (LNE) = LINE" LNENUM

IF PROC_TYPE = 'TRUE' THEN
DO
"ALLOC FILE(PFILE) DATASET("PVARFILE") SHR REUSE"
"EXECIO" PVARSTACK.0 "DISKW PFILE ( STEM PVARSTACK. FINIS"
"FREE FI(PFILE)"
CALL PROCOPENPARA
END

IF COBOL_TYPE = 'TRUE' THEN
DO
CALL COBOPENPARA
END

IF INC_MEM_TYPE = 'TRUE' THEN
DO
CALL OPENINCMEMPARA
END

IF FILE_TYPE = 'TRUE' THEN
DO
CALL FILEOPENPARA
END

END
EXIT
VERIFYRUN:
"ISREDIT (RCHK) = LINE" 1
IF COPYBOOK_TYPE = 'TRUE' THEN
DO
RETURN
END
FIRST_RUN_FLAG = 'FALSE'
PVARFILE = "'TTYA."]]USERID()]]".PVAR.FILE'"
SETVARFILE = "'TTYA."]]USERID()]]".SETVAR.FILE'"
JNAME = "'TTYA."]]USERID()]]".JNAME.FILE'"
PLIB = "'TTYA."]]USERID()]]".PLIB.FILE'"
LLIB = "'TTYA."]]USERID()]]".LLIB.FILE'"
/*  JINCMEM = "'TTYA.SUNNY.JINC.FILE'"          */
PARSE VAR RCHK '//' JOBNAME ' JOB ' J1
JOBSTACK.1 = JOBNAME
JOBSTACK.0 = 1
IF POS(' JOB ',RCHK) > 0 THEN
DO
FIRST_RUN_FLAG = 'TRUE'
IF SYSDSN(PVARFILE) = 'OK' THEN
DO
END
IF SYSDSN(PLIB) = 'OK' THEN
DO
END
IF SYSDSN(LLIB) = 'OK' THEN
DO
END
IF SYSDSN(JNAME) = 'OK' THEN
DO
END
IF SYSDSN(SETVARFILE) = 'OK' THEN
DO
END
/*     IF SYSDSN(JINCMEM) = 'OK' THEN
DO
END      */
"ALLOCATE DATASET("PVARFILE") NEW SPACE(5,1) DSORG(PS)",
"LRECL(80) BLKSIZE(800) RECFM(F B)"
"ALLOCATE DATASET("SETVARFILE") NEW SPACE(5,1) DSORG(PS)",
"LRECL(80) BLKSIZE(800) RECFM(F B)"
"ALLOCATE DATASET("JNAME") NEW SPACE(5,1) DSORG(PS)",
"LRECL(80) BLKSIZE(800) RECFM(F B)"
"ALLOCATE DATASET("PLIB") NEW SPACE(5,1) DSORG(PS)",
"LRECL(80) BLKSIZE(800) RECFM(F B)"
"ALLOCATE DATASET("LLIB") NEW SPACE(5,1) DSORG(PS)",
"LRECL(80) BLKSIZE(800) RECFM(F B)"
/*   "ALLOCATE DATASET("JINCMEM") NEW SPACE(5,1) DSORG(PS)",
"LRECL(80) BLKSIZE(800)"   */
END
ELSE
DO
IF (POS('PROC',RCHK) > 0) THEN
DO
IF SYSDSN(PVARFILE) <> 'OK' THEN
DO
SAY 'YOU CANNOT VIEW FILES DIRECTLY FROM PROC'
EXIT
END
IF SYSDSN(SETVARFILE) <> 'OK' THEN
DO
SAY 'YOU CANNOT VIEW FILES DIRECTLY FROM PROC'
EXIT
END
END
END
RETURN
PARMOPENPARA:
ERR_FLAG = 'TRUE'

DO O = 1 TO PARMSTACK.0
CALL SYMCHKNPROC(PARMSTACK.O)
PARMSTACK.O = DATA
PARMSTACK.O = "'"]] PARMSTACK.O ]]"'"
IF SYSDSN(PARMSTACK.O) = 'OK' THEN
DO
ERR_FLAG = 'FALSE'
/*         RETURN            */
END
END
IF ERR_FLAG = 'TRUE' THEN
DO
SAY 'PARM CANNOT BE EXPANDED :' LNE
EXIT
END
RETURN
GETSETVAR:
LOOP_EXIT_FLAG = 'FALSE'
CLINE = 0 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */
I=0
DO UNTIL LOOP_EXIT_FLAG='TRUE'
CLINE = CLINE +1
"ISREDIT (LNE) = LINE" CLINE
IF (POS('EXEC',LNE) > 0 ) THEN
DO
LOOP_EXIT_FLAG='TRUE'
END

IF SUBSTR(LNE,3,1) = '*' THEN
DO
ITERATE
END

IF POS(' SET ',LNE) > 0 THEN
DO
CALL GETSETVARPROC(LNE)
END
END
RETURN
GETSETVARPROC:
PARSE ARG LNE
PARSE VAR LNE V0 ' SET ' V1 ',' V2
QUOTE_PROC_COMPLETE = 'FALSE'
IF POS("'",V1) > 0 THEN
DO
PARSE VAR LNE V0 ' SET ' V2
DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE'
CALL QUOTEPARMPROC(V2 VARSTACK)
V2 = PVAR2
END
END
IF LOOP_EXIT_FLAG = 'TRUE' THEN
DO
LEAVE
END

IF QUOTE_PROC_COMPLETE = 'FALSE' THEN
DO
I=I+1
VARSTACK.I = STRIP(V1)
VARSTACK.0 = I
END
MORE_SET_VAR_FLAG = 'TRUE'
DO UNTIL MORE_SET_VAR_FLAG = 'FALSE'
IF POS(',',V2) > 0  THEN
DO
LNE = V2
PARSE VAR LNE V1 ',' V2
QUOTE_PROC_COMPLETE = 'FALSE'
IF POS("'",V1) > 0 THEN
DO
DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE'
CALL QUOTEPARMPROC(LNE VARSTACK)
LNE = PVAR2
V2 = PVAR2
END
END
IF LOOP_EXIT_FLAG = 'TRUE' THEN
DO
MORE_SET_VAR_FLAG = 'FALSE'
LEAVE
END
IF QUOTE_PROC_COMPLETE = 'TRUE' THEN
DO
ITERATE
END
I=I+1
CALL VARSTACKINS(I V1)
END
ELSE
DO
IF POS('=',V2) > 0 THEN
DO
LNE = V2
PARSE VAR LNE V1 V2
I=I+1
CALL VARSTACKINS(I V1)
END
MORE_SET_VAR_FLAG = 'FALSE'
END
END
RETURN
GETJCLLIB:
/* THIS PROCEDURE IS TO GET ALL OF THE JCLLIB PRESENT IN THE JCL

*/
LOOP_EXIT_FLAG = 'FALSE'
CLINE = 1
I = 1
JCLLIB_END_FLAG = ' '
DO UNTIL LOOP_EXIT_FLAG = 'TRUE'
CLINE = CLINE + 1
"ISREDIT (LNE) = LINE" CLINE
IF (POS('JCLLIB',LNE) > 0) THEN
DO
JCLLIB_END_FLAG = 'FALSE'
END
IF JCLLIB_END_FLAG = 'FALSE' THEN
DO
IF (POS(')',LNE) > 0) THEN
DO
JCLLIB_END_FLAG = 'TRUE'
LOOP_EXIT_FLAG = 'TRUE'
END
IF(POS('JCLLIB',LNE) > 0) THEN
DO
IF (POS('ORDER=(',LNE) > 0) THEN
DO
IF (POS(')',LNE) > POS('(',LNE)) THEN
DO
PARSE VAR LNE J1 'ORDER=(' J2 ')'
JCLLIB_END_FLAG = 'TRUE'
LOOP_EXIT_FLAG = 'TRUE'
END
ELSE
DO
PARSE VAR LNE J1 'ORDER=(' J2 ',' J3
END
END
ELSE
DO
PARSE VAR LNE J1 'ORDER=' J2 ',' J3
JCLLIB_END_FLAG = 'TRUE'
LOOP_EXIT_FLAG = 'TRUE'
END
CALL JCLLIBSTACKINS(I J2)
I=I+1
IF (STRIP(J3) != '') THEN
DO
PARSE VAR J3 J2 ',' J4
CALL JCLLIBSTACKINS(I J2)
I=I+1
END
END
ELSE
DO
PARSE VAR LNE  '//' J2 ',' J3
IF JCLLIB_END_FLAG = 'TRUE' THEN
DO
IF (POS(',',LNE) > 0) THEN
DO
PARSE VAR LNE '//' J2 ',' J3
CALL JCLLIBSTACKINS(I J2)
I=I+1
PARSE VAR J3 J2 ')'
CALL JCLLIBSTACKINS(I J2)
I=I+1
LEAVE
END
PARSE VAR LNE '//' J2 ')' J3
CALL JCLLIBSTACKINS(I J2)
I=I+1
LEAVE
END
CALL JCLLIBSTACKINS(I J2)
I=I+1
IF (STRIP(J3) != '') THEN
DO
PARSE VAR J3 J2 ',' J4
CALL JCLLIBSTACKINS(I J2)
I=I+1
END
END
END
END
RETURN
PROCLIBCHECK:
"ISREDIT (LNE) = LINE" LNENUM
IF ((POS('EXEC',LNE) = 0) & (POS('DD',LNE) = 0)) THEN
DO
IF (POS('ORDER=',LNE) > 0) THEN
DO
IF (POS('ORDER=(',LNE) > 0) THEN
DO
PARSE VAR LNE L1 'ORDER=(' L2 ',' L3
END
ELSE
DO
PARSE VAR LNE L1 'ORDER=' L2 ',' L3
END
IF POS(')',L2) > 0 THEN
DO
PARSE VAR L2 F ')'
L2 = F
END
CALL SYMCHKNPROC(L2)
L2 = DATA
EXIT
END
END
RETURN
COBOPENPARA:
CSTNAME = '' /* VARIABLE TO HOLD STEP NAME OF COBOL PGM */
CPRNAME = '' /* VARIABLE TO HOLD PROC NAME OF COBOL PGM */
SLIB = "'TTYA.DBCRD.SRCLIB.FILE'"

"ALLOC FILE(SFILE) DATASET("SLIB") SHR REUSE"
"EXECIO * DISKR SFILE   ( STEM SLIBSTACK. FINIS "
"FREE FI(SFILE)"
IF SLIBSTACK.0 <> 0 THEN
DO
DO I = 1 TO SLIBSTACK.0
SLIBSTACK.I = STRIP(SLIBSTACK.I)
END
END
IF POS('PGM=',LNE) > 0 THEN
DO
PARSE VAR LNE '//' CSTNAME 'EXEC ' J  'PGM=' PGMNAME ',' REST
END
IF POS('PROG(',LNE) > 0 THEN
DO
PARSE VAR LNE FIRST 'PROG(' PGMNAME ')' REST
LNUM = LNENUM - 1
"ISREDIT (LNE) = LINE" LNUM
IF POS('PGM=',LNE) > 0 THEN
DO
PARSE VAR LNE '//' CSTNAME 'EXEC ' J
END
ELSE
DO
LNUM = LNUM - 1
"ISREDIT (LNE) = LINE" LNUM
IF POS('PGM=',LNE) > 0 THEN
DO
PARSE VAR LNE '//' CSTNAME 'EXEC ' J
END
ELSE
DO
LNUM = LNUM - 1
"ISREDIT (LNE) = LINE" LNUM
IF POS('PGM=',LNE) > 0 THEN
DO
PARSE VAR LNE '//' CSTNAME 'EXEC ' J
END
END
END
END
LNUM = LNENUM
LOOP_EXIT_FLAG = 'FALSE'
DO UNTIL LOOP_EXIT_FLAG = 'TRUE'
LNUM = LNUM - 1
IF LNUM = 0 THEN
DO
LEAVE
END
"ISREDIT (LNE) = LINE" LNUM
IF SUBSTR(LNE,3,1) = '*' THEN
DO
ITERATE
END
IF POS(' PROC ',LNE) > 0 THEN
DO
PARSE VAR LNE '//' CPRNAME 'PROC'
CPRNAME = STRIP(CPRNAME)
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END
END
CALL SYMCHKNPROC(PGMNAME)
PGMNAME = DATA
SRCLIB_FOUND = 'FALSE'
IF LODLIBSTACK.0 = 0 THEN
DO
SAY ' NO LOADLIB FOUND. CHECK JCL OR CONTACT DEVELOPER'
END
DO I = 1 TO LODLIBSTACK.0
/* THIS IS TO SEARCH FOR LOAD IN STEPLIBS PRESENT
*/
PARSE VAR LODLIBSTACK.I IND ',' LPNME ','LSNME ',' LODLIB
LODLIB = STRIP(LODLIB)
PGMNAME = STRIP(PGMNAME)
IF ((CPRNAME = LPNME) & (CSTNAME = LSNME)) THEN
DO
DSN = "'" ]] LODLIB ]] '(' ]] PGMNAME ]] ')' ]] "'"
IF SYSDSN(DSN) = 'OK' THEN
DO
SRCLIB_FOUND = 'FALSE'
DO J = 1 TO SLIBSTACK.0
PARSE VAR SLIBSTACK.J SLODLIB ',' SSRCLIB ','
SLODLIB = STRIP(SLODLIB)
SSRCLIB = STRIP(SSRCLIB)
IF (SLODLIB = LODLIB) THEN
DO
SRCLIB_FOUND = 'TRUE'
DSN = "'"]]SSRCLIB]]'(']]PGMNAME]]')']]"'"
IF SYSDSN(DSN) = 'OK' THEN
DO
LEAVE
END
ELSE
DO
/* TO HANDLE WHAT TO DO IF LOAD IS NOT AVAILABLE IN STEPLIB
*/
SRCLIB_FOUND = 'FALSE'
END
END

END
IF SRCLIB_FOUND = 'TRUE' THEN
DO
LEAVE
END
END
END
END
IF SRCLIB_FOUND = 'FALSE' THEN
DO
/* THIS PARA IS TO SERACH FOR LOAD IN JOBLIB   */

DO I = 1 TO LODLIBSTACK.0
PARSE VAR LODLIBSTACK.I IND ',' LPNME ','LSNME ',' LODLIB
IF (IND = 'S') THEN
DO
ITERATE
END
LODLIB = STRIP(LODLIB)
DSN = "'" ]] LODLIB ]] '(' ]] PGMNAME ]] ')' ]] "'"
IF SYSDSN(DSN) = 'OK' THEN
DO
SRCLIB_FOUND = 'FALSE'
DO J = 1 TO SLIBSTACK.0
PARSE VAR SLIBSTACK.J SLODLIB ',' SSRCLIB ','
SLODLIB = STRIP(SLODLIB)
SSRCLIB = STRIP(SSRCLIB)
IF (SLODLIB = LODLIB) THEN
DO
SRCLIB_FOUND = 'TRUE'
DSN = "'"]]SSRCLIB]]'(']]PGMNAME]]')']]"'"
IF SYSDSN(DSN) = 'OK' THEN
DO
LEAVE
END
END

END
LEAVE
END

END
END
IF SRCLIB_FOUND = 'FALSE' THEN
DO
END
RETURN
PROCOPENPARA:
IF (POS('PROC=',LNE) > 0) THEN
DO
PARSE VAR LNE P1 'PROC=' P2 ',' P3
END
ELSE
DO
PARSE VAR LNE P1 'EXEC' P2 ',' P3
END
CALL SYMCHKNPROC(P2)
P2 = DATA
DO I = 1 TO JCLLIBSTACK.0
DSN = "'" ]] JCLLIBSTACK.I ]] '(' ]] STRIP(P2) ]] ')' ]] "'"
IF SYSDSN(DSN) = 'OK' THEN
DO
/* ADDRESS  ISPEXEC "VIEW DATASET("JCLLIBSTACK.I") MEMBER("P2")"    */
LEAVE
END
IF I = JCLLIBSTACK.0 THEN
DO
SAY 'PROC NOT AVAILABLE IN ANY OF THE LIBRARY'
EXIT
END
END
RETURN
FILEOPENPARA:
IF POS('DSN=',LNE) = 0 THEN
DO
SAY ' NOT A VALID DSN TO OPEN'
EXIT
END
PARSE VAR LNE V1 'DSN=' V2 ',' V3
CALL SYMCHKNPROC(V2)
V2 = DATA
SELECT
WHEN POS('(+1)',V2) > 0 THEN
DO
PARSE VAR V2 V1 '+1' V3
V2 = V1 ]] '0' ]] V3
END
WHEN POS('(+2)',V2) > 0 THEN
DO
PARSE VAR V2 V1 '+2' V3
V2 = V1 ]] '0' ]] V3
END
WHEN POS('(+3)',V2) > 0 THEN
DO
PARSE VAR V2 V1 '+3' V3
V2 = V1 ]] '0' ]] V3
END
OTHERWISE
DO
END
END
IF RC <> 0  THEN
DO
END
RETURN
OPENINCMEMPARA:
PARSE VAR LNE M1 'MEMBER=' INCMEM
CALL SYMCHKNPROC(INCMEM)
INCMEM = DATA
DO I = 1 TO JCLLIBSTACK.0
DSN = "'" ]] JCLLIBSTACK.I ]] '(' ]] STRIP(V2) ]] ')' ]] "'"
IF SYSDSN(DSN) = 'OK' THEN
DO
/* ADDRESS  ISPEXEC "VIEW DATASET("JCLLIBSTACK.I") MEMBER("P2")"    */
LEAVE
END
END
RETURN
GETPROCSETVAR:
/* THIS IS TO GET ALL OF THE PARAMETER SET FOR A PARTICULAR PROC
*/
LOOP_EXIT_FLAG = 'FALSE'
CLINE = 1 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */
I=PVARSTACK.0
DO UNTIL LOOP_EXIT_FLAG='TRUE'
CLINE = CLINE +1
"ISREDIT (LNE) = LINE" CLINE
IF RC <> 0 THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END
IF SUBSTR(LNE,3,1) = '*' THEN
DO
ITERATE
END
IF POS(' EXEC ',LNE) > 0 THEN
DO
PROC_FOUND_FLAG='TRUE'
IF POS('PGM=',LNE) > 0 THEN
DO
PROC_FOUND_FLAG = 'FALSE'
ITERATE
END
ELSE
DO
PARSE VAR LNE PVAR1 ',' PVAR2
IF POS('PROC=',LNE) > 0 THEN
DO
PARSE VAR LNE PNAME1 'PROC=' PNAME ',' PNAME2
END
ELSE
DO
PARSE VAR LNE PNAME1 ' EXEC ' PNAME ',' PNAME2
END
CALL GETMPROCSETVAR
ITERATE
END
END
IF PROC_FOUND_FLAG = 'TRUE' THEN
DO
IF (SUBSTR(LNE,3,1) = ' ') THEN
DO
PARSE VAR LNE PVAR1 PVAR2
CALL GETMPROCSETVAR
END
ELSE
DO
PROC_FOUND_FLAG= 'FALSE'
END
END
END
RETURN
GETMPROCSETVAR:
MORE_PROC_VAR_FLAG = 'TRUE'
DO UNTIL MORE_PROC_VAR_FLAG = 'FALSE'
QUOTE_PROC_COMPLETE = 'FALSE'
IF POS(',',PVAR2) > 0 THEN
DO
LNE = PVAR2
PARSE VAR PVAR2 PVAR1 ',' PVAR3       /*FROM HERE */
IF POS("'",PVAR1) > 0 THEN
DO
DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE'
CALL QUOTEPARMPROC(PVAR2 PVARSTACK)
IF QUOTE_PROC_COMPLETE = 'TRUE' THEN
DO
MORE_PROC_VAR_FLAG = 'FALSE'
END
END
END
ELSE
DO
PARSE VAR LNE PVAR1 ',' PVAR2
I = I + 1
CALL PVARSTACKINS(I PNAME PVAR1)
END
/*        PVARSTACK.I = STRIP(PNAME)]]',']]STRIP(PVAR1)
PVARSTACK.0=I
*/      END
ELSE
DO
MORE_PROC_VAR_FLAG = 'FALSE'
IF POS('=',PVAR2) > 0 THEN
DO
LNE = PVAR2
PARSE VAR LNE PVAR1     PVAR2
I = I + 1
CALL PVARSTACKINS(I PNAME PVAR1)
/*             PVARSTACK.I = STRIP(PNAME)]]',']]STRIP(PVAR1)
PVARSTACK.0=I
*/           END
END
END
RETURN
RETURN
TERMPARA:
RETURN
WRITETOFILE:
"ALLOC FILE(PFILE) DATASET("PVARFILE") SHR REUSE"
"EXECIO" PVARSTACK.0 "DISKW PFILE   ( STEM PVARSTACK. FINIS"
"FREE FI(PFILE)"

"ALLOC FILE(SFILE) DATASET("SETVARFILE") SHR REUSE"
"EXECIO" VARSTACK.0 "DISKW SFILE   ( STEM VARSTACK. FINIS "
"FREE FI(SFILE)"

"ALLOC FILE(JFILE) DATASET("JNAME") SHR REUSE"
"EXECIO" JOBSTACK.0 "DISKW JFILE   (STEM JOBSTACK. FINIS "
"FREE FI(JFILE)"

"ALLOC FILE(PFILE) DATASET("PLIB") SHR REUSE"
"EXECIO" JCLLIBSTACK.0 "DISKW PFILE   (STEM JCLLIBSTACK. FINIS "
"FREE FI(PFILE)"

"ALLOC FILE(LFILE) DATASET("LLIB") SHR REUSE"
"EXECIO" LODLIBSTACK.0 "DISKW LFILE   (STEM LODLIBSTACK. FINIS "
"FREE FI(LFILE)"
RETURN
"ALLOC FILE(PFILE) DATASET("PVARFILE") SHR REUSE"
"EXECIO * DISKR PFILE   ( STEM PVARSTACK. FINIS "
"FREE FI(PFILE)"
IF PVARSTACK.0 <> 0 THEN
DO
DO I = 1 TO PVARSTACK.0
PVARSTACK.I = STRIP(PVARSTACK.I)
END
END

"ALLOC FILE(SFILE) DATASET("SETVARFILE") SHR REUSE"
"EXECIO * DISKR SFILE   ( STEM VARSTACK. FINIS "
"FREE FI(SFILE)"
IF VARSTACK.0 <> 0 THEN
DO
DO I = 1 TO VARSTACK.0
VARSTACK.I = STRIP(VARSTACK.I)
END
END

"ALLOC FILE(PFILE) DATASET("PLIB") SHR REUSE"
"EXECIO * DISKR PFILE   ( STEM JCLLIBSTACK. FINIS "
"FREE FI(PFILE)"
IF JCLLIBSTACK.0 <> 0 THEN
DO
DO I = 1 TO JCLLIBSTACK.0
JCLLIBSTACK.I = STRIP(JCLLIBSTACK.I)
END
END

"ALLOC FILE(LFILE) DATASET("LLIB") SHR REUSE"
"EXECIO * DISKR LFILE   ( STEM LODLIBSTACK. FINIS "
"FREE FI(LFILE)"
IF LODLIBSTACK.0 <> 0 THEN
DO
DO I = 1 TO LODLIBSTACK.0
LODLIBSTACK.I = STRIP(LODLIBSTACK.I)
END
END

"ALLOC FILE(JFILE) DATASET("JNAME") SHR REUSE"
"EXECIO * DISKR JFILE   ( STEM JOBSTACK. FINIS "
"FREE FI(JFILE)"
IF JOBSTACK.0 <> 0 THEN
DO
DO I = 1 TO JOBSTACK.0
JOBSTACK.I = STRIP(JOBSTACK.I)
END
END
RETURN
GETPROCVARS:
PVARFILE = "'TTYA."]]USERID()]]".PVAR.FILE'"
SETVARFILE = "'TTYA."]]USERID()]]".SETVAR.FILE'"
JNAME = "'TTYA."]]USERID()]]".JNAME.FILE'"
PLIB = "'TTYA."]]USERID()]]".PLIB.FILE'"
PROCPVARSTACK.0=0
"ISREDIT (PDATA) = LINE" 1
IF (POS('PROC',PDATA) > 0) THEN
DO
PARSE VAR PDATA '//' PNAME ' PROC ' REST
PNAME_GLOBAL = PNAME
LOOP_EXIT_FLAG = 'FALSE'
CLINE = 0 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */
I=0
DO UNTIL LOOP_EXIT_FLAG='TRUE'
CLINE = CLINE +1
"ISREDIT (LNE) = LINE" CLINE
IF SUBSTR(LNE,3,1) = '*' THEN
DO
ITERATE
END
IF ((POS(' PROC ',LNE) = 0) & (SUBSTR(LNE,3,1) <> ' ')) THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END
IF POS(' PROC ',LNE) > 0 THEN
DO
PARSE VAR LNE L1 ' PROC ' PVAR2
END
ELSE
DO
PARSE VAR LNE '//' PVAR2
END
PVAR2 = STRIP(PVAR2)
IF PVAR2 = '' THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END
QUOTE_PROC_COMPLETE = 'FALSE'
IF POS(',',PVAR2) > 0 THEN
DO
/*             PARSE VAR PVAR2 PVAR1 ',' PVAR2    */
PARSE VAR PVAR2 PVAR1 ',' PVAR3       /*FROM HERE */
IF POS("'",PVAR1) > 0 THEN
DO
DO UNTIL QUOTE_PROC_COMPLETE = 'TRUE'
CALL QUOTEPARMPROC(PVAR2 PROCPVARSTACK)
END
/*                  PARSE VAR PVAR2 PVAR1 "='" PVAR3 "'" PVAR4
PVAR1 = PVAR1 ]] "='" ]] PVAR3 ]]"'"
I = I + 1
PROCPVARSTACK.I = STRIP(PVAR1)
PROCPVARSTACK.0 = I
PVAR4 = STRIP(PVAR4)
IF PVAR4 = '' THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
LEAVE
END
ELSE
DO
PARSE VAR PVAR4 ',' PVAR2
END         */
END    /* TILL HERE */
IF QUOTE_PROC_COMPLETE = 'TRUE' THEN
DO
ITERATE
END
IF LOOP_EXIT_FLAG = 'TRUE' THEN
DO
LEAVE
END
PARSE VAR PVAR2 PVAR1 ',' PVAR2       /*FROM HERE */
MORE_PROC_VAR = 'TRUE'
I = I + 1
PROCPVARSTACK.I = STRIP(PVAR1)
PROCPVARSTACK.0 = I
MORE_FLAG = 'FALSE'
DO UNTIL MORE_FLAG = 'TRUE'
PVAR2=STRIP(PVAR2)
IF PVAR2 = '' THEN
DO
MORE_FLAG = 'TRUE'
ITERATE
END
ELSE IF POS('*',PVAR2) > 0 THEN
DO
MORE_FLAG = 'TRUE'
ITERATE
END
ELSE
DO
IF POS('=',PVAR2) > 0 THEN
DO
I = I + 1
PROCPVARSTACK.I = STRIP(PVAR2)
PROCPVARSTACK.0 = I
END
IF POS(',',PVAR2) > 0 THEN
DO
PARSE VAR PVAR2 P1 ',' P2
PAVR2 = P2
END
ELSE
DO
MORE_FLAG = 'TRUE'
END
END
END
END
ELSE
DO
I = I + 1
PROCPVARSTACK.I = PVAR2
PROCPVARSTACK.0 = I
LOOP_EXIT_FLAG = 'TRUE'
END
END
END
ELSE
DO
SAY 'NOT A VALID PROC FOR FURTHER PROCESSING'
CALL TERMPARA
EXIT
END
/*
/********************DELETE FROM HERE         ********************/
DO A = 1 TO PVARSTACK.0
OVERRIDE_FOUND = 'FALSE'
PARSE VAR PVARSTACK.A PRC ','VARSTK_NAME '=' VARSTK_VAL
IF PRC <> CUR_PROC_NAME THEN
DO
ITERATE
END
DO B = 1 TO PROCPVARSTACK.0
PARSE VAR PROCPVARSTACK.B VAR_NAME '=' VAR_VAL
IF VAR_NAME = VARSTK_NAME THEN
DO
OVERRIDE_FOUND = 'TRUE'
PROCPVARSTACK.B = VAR_NAME ]] '=' ]] VARSTK_VAL
B = PROCPVARSTACK.0
END
END
IF OVERRIDE_FOUND = 'FALSE' THEN
DO
B = PROCPVARSTACK.0
B = B + 1
PROCPVARSTACK.B =  VARSTK_NAME ]] '=' ]] VARSTK_VAL
PROCPVARSTACK.0 = B
END
END
/********************DELETE FROM HERE         ********************/
*/
RETURN
FINALPROCVARSET:
/* THIS PARA WILL OVERRIDE THE PARAMETERS FOR VARIABLES COMING FROM JCL
*/
PNAME = PNAME_GLOBAL
DO I = 1 TO PVARSTACK.0
PARSE VAR PVARSTACK.I PROCNAME ',' JVAR '=' JVAL ' '
IF PNAME <> PROCNAME THEN
DO
ITERATE
END
JCL_PARM_FOUND = 'FALSE'
DO J = 1 TO PROCPVARSTACK.0
PARSE VAR PROCPVARSTACK.J PVAR '=' PVAL ' '
IF (PVAR = JVAR) THEN
DO
PVAL = JVAL
PROCPVARSTACK.J = PVAR ]] '=' ]] JVAL
JCL_PARM_FOUND = 'TRUE'
END
END
IF JCL_PARM_FOUND = 'FALSE' THEN
DO
J = PROCPVARSTACK.0
J = J + 1
PROCPVARSTACK.J = JVAR ]] '=' ]] JVAL
PROCPVARSTACK.0 = J
END
END
K = VARSTACK.0
DO I = 1 TO PROCPVARSTACK.0
K = K + 1
VARSTACK.K = PROCPVARSTACK.I
VARSTACK.0 = K
END
RETURN
GETINCLUDEMEM:
LOOP_EXIT_FLAG = 'FALSE'
CLINE = 1 /*THIS IS TO HOLD CURRENT LINE FOR VARIABLE DATA */
I=0
JINCSTACK.0 = 0
DO UNTIL LOOP_EXIT_FLAG='TRUE'
CLINE = CLINE +1
"ISREDIT (LNE) = LINE" CLINE
IF RC <> 0 THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END
IF SUBSTR(LNE,3,1) = '*' THEN
DO
ITERATE
END
IF FIRST_RUN_FLAG = 'TRUE' THEN
DO
IF (POS('EXEC',LNE) > 0) THEN
DO
IF (POS('PGM=',LNE) > 0) THEN
DO
ITERATE
END
IF (POS('PROC=',LNE) > 0 ) THEN
DO
PARSE VAR LNE P1 'PROC=' P2 ',' P3
END
ELSE
DO
PARSE VAR LNE P1 'EXEC' P2 ','
END
JPROCNAME = STRIP(P2)
END
END
ELSE
DO
JPROCNAME = PNAME
IF POS('EXEC',LNE) > 0 THEN
DO
PARSE VAR LNE '//'STEPNAME 'EXEC' REST
STEPNAME = STRIP(STEPNAME)
END
END
IF ((POS('STEPLIB',LNE) > 0) ] (POS('JOBLIB',LNE)>0)) THEN
DO
/* INSERT HERE THE CODE FOR INCLUDE MEMBER IN A STEPLIB */
INCCLINE = CLINE
CLINE = INCCLINE
JOBLIB_FLAG = 'FALSE'
STEPLIB_FLAG = 'FALSE'
LOOP_EXIT_FLAG = 'FALSE'
ITERATE
END
IF POS(' INCLUDE ',LNE) > 0 THEN
DO
IF JINCTSTACK.0 = 0 THEN
DO
ITERATE
END
I = 0
K = VARSTACK.0
DO I = 1 TO JINCTSTACK.0
IF (SUBSTR(JINCTSTACK.I,3,1) = '*') THEN
DO
ITERATE
END
/*           IF (SUBSTR(JINCTSTACK.I,3,1) <> ' ') THEN
DO
STEP_LIB_FLAG = 'FALSE'
JOB_LIB_FLAG = 'FALSE'
END     */
IF POS(' SET ',JINCTSTACK.I) > 0 THEN
DO
CALL GETSETVARPROC(JINCTSTACK.I)
ITERATE
END
/*           PARSE VAR JINCTSTACK.I 'DSN=' DSNAME ','
CALL SYMCHKNPROC(DSNAME)
DSNAME = DATA
DSN_CHECK = "'" ]] DSNAME ]] "'"
IF SYSDSN(DSN_CHECK) = 'OK' THEN
DO
IF STEP_LIB_FLAG = 'TRUE' THEN
DO
DSNAME_T = 'S,' ]] JPROCNAME ]] ','
DSNAME_T = DSNAME_T ]] STEPNAME ]] ',' ]] DSNAME
END
ELSE
DO
DSNAME_T = 'J,,,' ]] DSNAME
END
END
ELSE
DO
ITERATE
END
O = LODLIBSTACK.0
O = O + 1
LODLIBSTACK.O = DSNAME_T
LODLIBSTACK.0 = O        */
/* REDUDANDT CODE */
IF (((SUBSTR(JINCTSTACK.I,3,7) = 'STEPLIB') ],
(SUBSTR(JINCTSTACK.I,3,6) = 'JOBLIB')) &,
((STEP_LIB_FLAG = 'FALSE') &,
(JOB_LIB_FLAG = 'FALSE'))) THEN
DO
PARSE VAR JINCTSTACK.I 'DSN=' DSNAME ','
CALL SYMCHKNPROC(DSNAME)
DSNAME = DATA
DSN_CHECK = "'" ]] DSNAME ]] "'"
IF SUBSTR(JINCTSTACK.I,3,7) = 'STEPLIB' THEN
DO
STEP_LIB_FLAG = 'TRUE'
JOB_LIB_FLAG = 'FALSE'
END
ELSE
DO
STEP_LIB_FLAG = 'FALSE'
JOB_LIB_FLAG = 'TRUE'
END
IF SYSDSN(DSN_CHECK) = 'OK' THEN
DO
O = LODLIBSTACK.0
O = O + 1
IF STEP_LIB_FLAG = 'TRUE' THEN
DO
DSNAME_T = 'S,' ]] JPROCNAME ]] ','
DSNAME_T = DSNAME_T ]] STEPNAME ]] ','
LODLIBSTACK.O = DSNAME_T ]] DSNAME
END
ELSE
DO
DSNAME = 'J,,,' ]] DSNAME
LODLIBSTACK.O = DSNAME
END
LODLIBSTACK.0 = O
END
ELSE
DO
ITERATE
END
END /*REDUDANT CODE */

END        /*  */
END
END
RETURN
PARSE ARG CLINE EXIT_FLAG
LOOP_EXIT_FLAG = 'FALSE'
I = LODLIBSTACK.0
DO UNTIL LOOP_EXIT_FLAG='TRUE'
"ISREDIT (LNE) = LINE" CLINE
CLINE = CLINE +1
IF RC <> 0 THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END
IF (SUBSTR(LNE,3,1) = '*') THEN
DO
ITERATE
END
/*   IF (SUBSTR(LNE,3,1) <> '*' & SUBSTR(LNE,3,1) <> ' ') THEN
DO
LOOP_EXIT_FLAG='TRUE'
ITERATE
END                */
IF (POS('EXEC',LNE) > 0) THEN
DO
JOBLIB_FLAG = 'FALSE'
STEPLIB_FLAG = 'FALSE'
IF (POS('PGM=',LNE) > 0) THEN
DO
ITERATE
END
IF (POS('PROC=',LNE) > 0 ) THEN
DO
PARSE VAR LNE P1 'PROC=' P2 ',' P3
END
ELSE
DO
PARSE VAR LNE P1 'EXEC' P2 ','
END
JPROCNAME = STRIP(P2)
END
IF ((POS('JOBLIB',LNE) > 0 ] POS('STEPLIB',LNE) > 0) &,
DO
IF FIRST_RUN_FLAG = 'TRUE' THEN
DO
IF (POS('STEPLIB',LNE) > 0) THEN
DO
STEPLIB_FLAG = 'TRUE'
JOBLIB_FLAG = 'FALSE'
PARSE VAR LNE '//' S 'DD' REST
PARSE VAR S STEPNAME '.' STEPLIB
END
ELSE
DO
JOBLIB_FLAG = 'TRUE'
STEPLIB_FLAG = 'FALSE'
END
END
ELSE
DO
STEPLIB_FOUND = 'TRUE'
DO Y = 1 TO LODLIBSTACK.0
PARSE VAR LODLIBSTACK.Y IND ',' LPNME ','LSNME ',' R
IF ((JPROCNAME = LPNME) & (LSNME = STEPNAME)) THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
LEAVE
END
END
END
IF LOOP_EXIT_FLAG = 'TRUE' THEN
DO
ITERATE
END
PARSE VAR LNE L1 'DSN=' L2 ',' L3
I = LODLIBSTACK.0
I = I + 1
CALL SYMCHKNPROC(L2)
L2 = DATA
IF JOBLIB_FLAG = 'TRUE' THEN
DO
V = 'J' ]] ',,,' ]] STRIP(L2)
END
ELSE
DO
V = 'S' ]] ',' ]] JPROCNAME ]] ',' ]] STEPNAME
V = V ]] ',' ]] STRIP(L2)
END
LODLIBSTACK.I = V
LODLIBSTACK.0 = I
ITERATE
END
DO
IF SUBSTR(LNE,3,1) <> ' ' THEN
DO
IF EXIT_FLAG = 'Y' THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
LEAVE
END
END
IF (SUBSTR(LNE,3,1) = ' ') THEN
DO
IF POS(' INCLUDE ',LNE) > 0 THEN
DO
IF JINCTSTACK.0 = 0 THEN
DO
ITERATE
END
CNTR = 0
VARSTACK_COUNT = VARSTACK.0
DO CNTR = 1 TO JINCTSTACK.0
IF (SUBSTR(JINCTSTACK.CNTR,3,1) = '*') THEN
DO
ITERATE
END
PARSE VAR JINCTSTACK.CNTR 'DSN=' DSNAME ','
CALL SYMCHKNPROC(DSNAME)
DSNAME = DATA
DSN_CHECK = "'" ]] DSNAME ]] "'"
IF SYSDSN(DSN_CHECK) = 'OK' THEN
DO
IF STEP_LIB_FLAG = 'TRUE' THEN
DO
DSNAME_T = 'S,' ]] JPROCNAME ]] ','
DSNAME_T = DSNAME_T ]] STEPNAME ]] ','
DSNAME_T = DSNAME_T ]] DSNAME
END
ELSE
DO
DSNAME_T = 'J,,,' ]] DSNAME
END
END
ELSE
DO
ITERATE
END
O = LODLIBSTACK.0
O = O + 1
LODLIBSTACK.O = DSNAME_T
LODLIBSTACK.0 = O
END
/*                  IF CNTR = JINCTSTACK.0 THEN
DO
LOOP_EXIT_FLAG = 'TRUE'
ITERATE
END     */
END
ELSE
DO
PARSE VAR LNE L1 'DSN=' L2 ',' L3
IF STRIP(L2) = ''     THEN
DO
ITERATE
END
I = LODLIBSTACK.0
I = I + 1
CALL SYMCHKNPROC(L2)
L2 = DATA
IF JOBLIB_FLAG = 'TRUE' THEN
DO
V = 'J' ]] ',,,' ]] STRIP(L2)
END
ELSE
DO
V = 'S' ]] ',' ]] JPROCNAME ]] ',' ]] STEPNAME
V = V ]] ',' ]] STRIP(L2)
END
LODLIBSTACK.I = V
LODLIBSTACK.0 = I
END
END
END
END
RETURN
STEMSEARCH:
PARSE ARG INPUT STKNAME ',' VALUE
RETURN
RUNTYPESELECT:
JCLLIB_TYPE   = 'FALSE'
FILE_TYPE     = 'FALSE'
COBOL_TYPE    = 'FALSE'
COBOL_PGM_TYPE= 'FALSE'
PROC_TYPE     = 'FALSE'
INC_MEM_TYPE  = 'FALSE'
COPYBOOK_TYPE = 'FALSE'
PARM_TYPE     = 'FALSE'
IF POS('DD',LNE) > 0 THEN
DO
FILE_TYPE       = 'TRUE'
END
IF POS(' CALL ',LNE) > 0 THEN
DO
COBOL_PGM_TYPE  = 'TRUE'
END
IF POS('EXEC',LNE) > 0 THEN
DO
IF POS('PGM=',LNE) > 0 THEN
DO
COBOL_TYPE = 'TRUE'
END
ELSE
DO
PROC_TYPE  = 'TRUE'
PARSE VAR LNE ',' TMP
PARSE VAR TMP '=' PARM_DATA ' '
IF POS(',',PARM_DATA) > 0 THEN
DO
EXIT_FLAG = 'FALSE'
DO UNTIL EXIT_FLAG = 'TRUE'
PARSE VAR PARM_DATA PARM_DATA_T ',' P_DATA_T
PARM_DATA = PARM_DATA_T
PARM_STACK_CNT = PARMSTACK.0
PARM_STACK_CNT = PARM_STACK_CNT + 1
PARMSTACK.PARM_STACK_CNT = PARM_DATA
PARMSTACK.0 = PARM_STACK_CNT
IF STRIP(P_DATA_T) = '' THEN
DO
EXIT_FLAG = 'TRUE'
END
ELSE
DO
PARSE VAR P_DATA_T '=' PARM_DATA
P_DATA_T = ''
END
END
PARSE VAR PARM_DATA PARM_DATA_T ','
PARM_DATA = PARM_DATA_T

END
END
END
IF POS('JCLLIB',LNE) > 0 THEN
DO
JCLLIB_TYPE     = 'TRUE'
END
IF ((POS('MEMBER',LNE)> 0) & (SUBSTR(LNE,3,1) <> '*')) THEN
DO
INC_MEM_TYPE    = 'TRUE'
END
IF POS('PROG(',LNE) > 0 THEN
DO
COBOL_TYPE      = 'TRUE'
END
IF ((POS(' COPY ',LNE) > 0 ) ] (POS(' INCLUDE ',LNE)> 0)) THEN
DO
IF POS('MEMBER=',LNE) = 0 THEN
DO
COPYBOOK_TYPE   = 'TRUE'
END
END
IF PROC_TYPE      = 'FALSE' &  ,
INC_MEM_TYPE   = 'FALSE' &  ,
JCLLIB_TYPE    = 'FALSE' &  ,
COPYBOOK_TYPE  = 'FALSE' &  ,
COBOL_TYPE     = 'FALSE' &  ,
COBOL_PGM_TYPE = 'FALSE' &  ,
FILE_TYPE      = 'FALSE'    THEN
DO
IF POS('=',LNE) > 0 THEN
DO
PARM_TYPE = 'TRUE'
PARSE VAR LNE '=' PARM_DATA ' '
IF POS(',',PARM_DATA) > 0 THEN
DO
EXIT_FLAG = 'FALSE'
DO UNTIL EXIT_FLAG = 'TRUE'
PARSE VAR PARM_DATA PARM_DATA_T ',' P_DATA_T
PARM_DATA = PARM_DATA_T
PARM_STACK_CNT = PARMSTACK.0
PARM_STACK_CNT = PARM_STACK_CNT + 1
PARMSTACK.PARM_STACK_CNT = PARM_DATA
PARMSTACK.0 = PARM_STACK_CNT
IF STRIP(P_DATA_T) = '' THEN
DO
EXIT_FLAG = 'TRUE'
END
ELSE
DO
PARSE VAR P_DATA_T '=' PARM_DATA
P_DATA_T = ''
END
END
END
PARM_STACK_CNT = PARMSTACK.0
PARM_STACK_CNT = PARM_STACK_CNT + 1
PARMSTACK.PARM_STACK_CNT = PARM_DATA
PARMSTACK.0 = PARM_STACK_CNT
END
ELSE
DO
SAY ' WRONG TYPE CHOOSEN, PROGRAM TERMINATING'
EXIT
END
END
RETURN
VARSTACKINS:
PARSE ARG ITR VAL
VARSTACK.ITR = STRIP(VAL)
VARSTACK.0   = ITR
RETURN
PVARSTACKINS:
PARSE ARG ITR PROC_NAME VAR_NAME
PVARSTACK.ITR = STRIP(PROC_NAME)]]',']]STRIP(VAR_NAME)
PVARSTACK.0=ITR
RETURN
PROCPVARSTACKINS:
PARSE ARG ITR VAL
PROCPVARSTACK.ITR = STRIP(VAL)
PROCPVARSTACK.0   = ITR
RETURN
JCLLIBSTACKINS:
PARSE ARG ITR VAL
CALL SYMCHKNPROC(VAL)
VAL = DATA
JCLLIBSTACK.ITR = STRIP(VAL)
JCLLIBSTACK.0   = ITR
RETURN
"ISREDIT (LNE) = LINE" LNENUM
IF POS(' COPY ',LNE) > 0 THEN
DO
PARSE VAR LNE ' COPY ' CPYNAME_T '.'
PARSE VAR CPYNAME_T CPYNAME ' '
END
IF POS(' INCLUDE ',LNE) > 0 THEN
DO
PARSE VAR LNE ' INCLUDE ' CPYNAME_T '.'
PARSE VAR CPYNAME_T CPYNAME ' '
END
CPYNAME = STRIP(CPYNAME)
SLIB = "'TTYA.DBCRD.SRCLIB.FILE'"

"ALLOC FILE(SFILE) DATASET("SLIB") SHR REUSE"
"EXECIO * DISKR SFILE   ( STEM SLIBSTACK. FINIS "
"FREE FI(SFILE)"
IF RC <> 0 THEN
DO
SAY ' SRCLIB FILE IS NOT PRESENT PLEASE CHECK DOCUMENTATION'
EXIT
END
IF SLIBSTACK.0 <> 0 THEN
DO
COPYBOOK_FOUND = 'FALSE'
DO I = 1 TO SLIBSTACK.0
SLIBSTACK.I = STRIP(SLIBSTACK.I)
PARSE VAR SLIBSTACK.I A ',' B ',' CPYLIB
CPYLIB = STRIP(CPYLIB)
DSN = "'"]]CPYLIB]]'(']]CPYNAME]]')']]"'"
IF SYSDSN(DSN) = 'OK' THEN
DO
COPYBOOK_FOUND = 'TRUE'
EXIT
END
END
IF COPYBOOK_FOUND = 'FALSE' THEN
DO
SAY 'COPYBOOK COULDNOT BE FOUND IN THE LIB. CHECK DOCUMENT'
EXIT
END
END
RETURN
QUOTEPARMPROC:
PARSE ARG PVAR2 STACK
PARSE VAR PVAR2 PVAR1 "='" PVAR3 "'" PVAR4
PVAR1 = PVAR1 ]] "='" ]] PVAR3 ]]"'"
I = I + 1
IF STACK = 'VARSTACK' THEN
DO
CALL VARSTACKINS(I STRIP(PVAR1))
END
IF STACK = 'PROCPVARSTACK' THEN
DO
CALL PROCPVARSTACKINS(I STRIP(PVAR1))
END
PVAR4 = STRIP(PVAR4)
IF PVAR4 = "," THEN
DO
QUOTE_PROC_COMPLETE = 'TRUE'
END
IF PVAR4 = '' THEN
DO
QUOTE_PROC_COMPLETE = 'TRUE'
LOOP_EXIT_FLAG = 'TRUE'
END
ELSE
DO
PARSE VAR PVAR4 ',' PVAR2
PARSE VAR PVAR2 PVAR1 ',' PVAR3
IF POS("'",PVAR1) = 0 THEN
DO
QUOTE_PROC_COMPLETE = 'TRUE'

END
END
RETURN
PARSE VAR LNE INC1 'MEMBER=' INCMEM
I2 = STRIP(INCMEM)
CALL SYMCHKNPROC(I2)
I2 = DATA
JINCTSTACK.0 = 0
DO I = 1 TO JCLLIBSTACK.0
JCLLIBSTACK.I = STRIP(JCLLIBSTACK.I)
DSN = "'" ]] JCLLIBSTACK.I ]] '(' ]] STRIP(I2) ]] ')' ]] "'"
IF SYSDSN(DSN) = 'OK' THEN
DO
"ALLOC FILE(JINC) DATASET("DSN") SHR REUSE"
"EXECIO * DISKR JINC ( STEM JINCTSTACK. FINIS "
"FREE FI(JINC)"
LEAVE
END
END
DO I = 1 TO JINCTSTACK.0
JINCTSTACK.I = STRIP(JINCTSTACK.I)
END
RETURN
SYMCHKNPROC:
PARSE ARG DATA
V2 = STRIP(DATA)
CALL STRSYMCHECK
IF SYM_FLAG = 'TRUE' THEN
DO
CALL STRSYMPROCESS
END
DATA = V2
RETURN
STRSYMCHECK:
SYM_FLAG = 'FALSE'
IF POS('&',V2) > 0 THEN
DO
SYM_FLAG = 'TRUE'
END
RETURN
STRSYMPROCESS:
/* THIS PARAGRAPH IS TO CONVERT ALL SYMBOLIC PARAMETERS PRESENT IN
A FILE NAME OR ON A PROC NAME
*/
SYMPOS = POS('&',V2)
DO UNTIL SYMPOS = 0
PARSE VAR V2 V0 '&' V1 '.' V3
/***************DELETE FROM HERE ***************/
IF POS('&',V1) > 0 THEN
DO
PARSE VAR V1 T1 '&' T2
V3 = '&']]T2 ]] V3
V1 = T1
END
/***************TILL        HERE ***************/
IF POS('(',V1) > 0 THEN
DO
PARSE VAR V1 V1_T '(' V3
V1 = V1_T
V3 = '(' ]] V3
END
VARLEN = LENGTH(V1)
Y = 0
DO Y = 1 TO VARSTACK.0
PARSE VAR VARSTACK.Y VAR1 '=' VAL1
IF VAR1 == V1 THEN
DO
V1 = STRIP(VAL1)
IF POS("'",V1) > 0 THEN
DO
PARSE VAR V1 "'" V1_TEMP "'"
V1 = V1_TEMP
END
V2 = V0 ]] V1 ]] V3
IF (POS('&',V2) > 0 ) THEN
DO
SYMPOS = POS('&',V2)
PARSE VAR V2 V0 '&' V1 '.' V3
IF POS('&',V1) > 0 THEN
DO
PARSE VAR V1 T1 '&' T2
V3 = '&']]T2 ]] V3
V1 = T1
END
IF POS('(',V1) > 0 THEN
DO
PARSE VAR V2 V0 '&' V1 '(' V3
V3 = '(' ]] STRIP(V3)
END
IF STRIP(V3) = '' THEN
DO
IF POS(')',V1) > 0 THEN
DO
PARSE VAR V2 V0 '&' V1 ')' V3
V3 = ')'
END
IF POS(',',V1) > 0 THEN
DO
PARSE VAR V2 V0 '&' V1 ',' V3
V3 = ','
END
END
Y=1
END
ELSE
DO
LEAVE
END
END
IF ((VARSTACK.0 = Y) & (SYMPOS <> 0)) THEN
DO
SYMPOS = 0
SAY ' UNKNOWS SYMBOLIC PARAMTER FOUND, EXITTING :' V2
EXIT
END
END
SYMPOS = POS('&',V2)
END
RETURN
```

## hugolinoneto@gmail.com

```/* Main program */

A=3
B=3
C=3

IF B < (A + C) & A < (B + C) & C < (A + B) THEN
DO
IF (A = B ) & (B = C) THEN
SAY ' TRIANGULO EQUILATERO '
ELSE
IF (A = B) | (B = C) | (A = C) THEN
SAY ' TRIANGULO ISOSCELES '
ELSE
SAY ' TRIANGULO ESCALENO '
END
ELSE
SAY ' NAO FORMA TRIANGULO '                        ```

## Hola Mundo

```/* Programa "Hola Mundo", codificado en Rexx*/
say "Hola mundo, mi nombre es Sergio Plata"
```

## Rexx String Compare Test

```/* Main program */
X = 0e10
Y = 0e30
SAY 'DOES' X '=' Y '?'
IF (X = Y) THEN
SAY 'TRUE'
ELSE
SAY 'FALSE'
SAY ''
SAY 'DOES' X '==' Y '?'
IF (X == Y) THEN
SAY 'TRUE'
ELSE
SAY 'FALSE'
EXIT 0```

## gggg

```/* Main program */
x=1.19
y=0.80
a=x//y
say a
return
```