Tutorialspoint

Rexx Programming Examples

Rexx Working with Arguments

/* Main program */ 
say add(5,6) 
exit 
add: 
PARSE ARG a,b 

return a + b
say arg() 

Rexx Defining a Function

/* Main program */ 
say add(5,6)
exit 
add: 
PARSE ARG a,b 
return a + b
c = add(5,6)
say
say c

Rexx Defining a Function

/* Main program */ 
say add(5,6) 
add: 
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

/*
add(list.1.1,list.1.2)
add:
parse arg result
say result
exit
*/

EXPND project

/*REXX*/
/* expnd */
/*ISPEXEC "VIEW DATAID("DATID") MEMBER("MEMBR") MACRO(WHATEVER)"  */
ADDRESS ISREDIT " MACRO"
/* ADDRESS ISREDIT " MACRO (Z) PROCESS"              */
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
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 READJCLDATA
     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
    CALL READCPYBKLIB
    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
             ADDRESS TSO "DELETE " PVARFILE
          END
       IF SYSDSN(PLIB) = 'OK' THEN
          DO
             ADDRESS TSO "DELETE " PLIB
          END
       IF SYSDSN(LLIB) = 'OK' THEN
          DO
             ADDRESS TSO "DELETE " LLIB
          END
       IF SYSDSN(JNAME) = 'OK' THEN
          DO
             ADDRESS TSO "DELETE " JNAME
          END
       IF SYSDSN(SETVARFILE) = 'OK' THEN
          DO
             ADDRESS TSO "DELETE " SETVARFILE
          END
/*     IF SYSDSN(JINCMEM) = 'OK' THEN
          DO
             ADDRESS TSO "DELETE " JINCMEM
          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'
           ADDRESS ISPEXEC " VIEW DATASET("PARMSTACK.O")"
/*         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
            ADDRESS ISPEXEC " VIEW DATASET('"L2"')"
            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
        SAY 'PROC NAME NOT FOUND, ERROR CODE 1001'
        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
                         ADDRESS ISPEXEC " VIEW DATASET("DSN")"
                         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
                         ADDRESS ISPEXEC " VIEW DATASET("DSN")"
                         LEAVE
                       END
                     END

               END
               LEAVE
            END

      END
    END
 IF SRCLIB_FOUND = 'FALSE' THEN
    DO
      SAY ' COBOL PROGRAM NOT FOUND IN ANY SRC LIB PRESENT'
    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")"    */
          ADDRESS ISPEXEC " VIEW   DATASET("DSN")"
          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
  ADDRESS ISPEXEC " VIEW DATASET('"V2"')"
  IF RC <> 0  THEN
     DO
       SAY 'NOT FOUND' SYSDSN(V2) V2
     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")"    */
          ADDRESS ISPEXEC " VIEW   DATASET("DSN")"
          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:
  ADDRESS TSO "DELETE " PVARFILE
  ADDRESS TSO "DELETE " SETVARFILE
  ADDRESS TSO "DELETE " JNAME
  ADDRESS TSO "DELETE " PLIB
  ADDRESS TSO "DELETE " LLIB
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
READJCLDATA:
  "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
          CALL GETLOADLIB(CLINE Y)
          CLINE = INCCLINE
          JOBLIB_FLAG = 'FALSE'
          STEPLIB_FLAG = 'FALSE'
          LOOP_EXIT_FLAG = 'FALSE'
          ITERATE
        END
     IF POS(' INCLUDE ',LNE) > 0 THEN
        DO
          CALL READINCMEMDATA
          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
GETLOADLIB:
  PARSE ARG CLINE EXIT_FLAG
  LOOP_EXIT_FLAG = 'FALSE'
  LOADLIB_FOUND_FLAG = 'FALSE'
  PROC_LOADLIB_VALD = 'NOT-INIT'
  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) &,
        (LOADLIB_FOUND_FLAG <> 'TRUE'))                   THEN
        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
          LOADLIB_FOUND_FLAG = 'TRUE'
          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
     IF LOADLIB_FOUND_FLAG = 'TRUE' THEN
        DO
          IF SUBSTR(LNE,3,1) <> ' ' THEN
             DO
                LOADLIB_FOUND_FLAG = 'FALSE'
                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
                    CALL READINCMEMDATA
                    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
READCPYBKLIB:
  "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'
         ADDRESS ISPEXEC " VIEW DATASET("DSN")"
         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
READINCMEMDATA:
  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

1 2 3 4 5 6 7 ... 11 Next
Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.