IBM Mainframe Forum

<!DOCTYPE DM SYSTEM>

<VARCLASS NAME=SUBSYSC  TYPE='CHAR 04'>
<VARCLASS NAME=SQLIDC   TYPE='CHAR 08'>
<VARCLASS NAME=LOCNIDC  TYPE='CHAR 08'>
<VARCLASS NAME=CREATORC TYPE='CHAR 08'>
<VARCLASS NAME=TNAMEC   TYPE='CHAR 24'>
<VARCLASS NAME=DBASEC   TYPE='CHAR 08'>
<VARCLASS NAME=TSPACEC  TYPE='CHAR 08'>
<VARCLASS NAME=DISPMODC TYPE='CHAR 01'>
<VARCLASS NAME=UROPTNC  TYPE='CHAR 03'>
<VARCLASS NAME=MAXROWSC TYPE='CHAR 05'>
<VARCLASS NAME=OWTBLC   TYPE='CHAR 33'>
<VARCLASS NAME=SELECTNC TYPE='CHAR 03'>
<VARCLASS NAME=COLNAMEC TYPE='CHAR 18'>
<VARCLASS NAME=DATATYPC TYPE='CHAR 17'>
<VARCLASS NAME=ORDERBYC TYPE='CHAR 02'>
<VARCLASS NAME=ASCDESCC TYPE='CHAR 01'>
<VARCLASS NAME=WHERECDC TYPE='CHAR 25'>

<VARLIST>
   <VARDCL NAME=SUBSYS   VARCLASS=SUBSYSC>
   <VARDCL NAME=SQLID    VARCLASS=SQLIDC>
   <VARDCL NAME=LOCNID   VARCLASS=LOCNIDC>
   <VARDCL NAME=CREATOR  VARCLASS=CREATORC>
   <VARDCL NAME=TNAME    VARCLASS=TNAMEC>
   <VARDCL NAME=DBASE    VARCLASS=DBASEC>
   <VARDCL NAME=TSPACE   VARCLASS=TSPACEC>
   <VARDCL NAME=DISPMODE VARCLASS=DISPMODC>
   <VARDCL NAME=UROPTN   VARCLASS=UROPTNC>
   <VARDCL NAME=MAXROWS  VARCLASS=MAXROWSC>
   <VARDCL NAME=OWTBL    VARCLASS=OWTBLC>
   <VARDCL NAME=SELECTN  VARCLASS=SELECTNC>
   <VARDCL NAME=COLNAME  VARCLASS=COLNAMEC>
   <VARDCL NAME=DATATYPE VARCLASS=DATATYPC>
   <VARDCL NAME=ORDERBY  VARCLASS=ORDERBYC>
   <VARDCL NAME=ASCDESC  VARCLASS=ASCDESCC>
   <VARDCL NAME=WHERECDN VARCLASS=WHERECDC>
</VARLIST>

<CMDTBL APPLID=P110>
   <CMD NAME=EXIT>EXIT
      <CMDACT ACTION=PASSTHRU>
</CMDTBL>

<KEYL NAME=K110>
   <KEYI KEY=F3 CMD=EXIT>EXIT
</KEYL>

<PANEL NAME=PAN110 KEYLIST=K110>
DB2 Editor ----------- Browse Selection Screen ---------------
<CMDAREA> Command
<AREA WIDTH=76>
   <REGION>
      <DTAFLD DATAVAR=OWTBL ENTWIDTH=33 PMTWIDTH=40>
      Type SQL to view/Edit the SQL Source for
      <DTAFLD DATAVAR=MAXROWS ENTWIDTH=05 PMTWIDTH=22>
      Max Rows to Select ==> <DTAFLDD>(* = All Rows)
   </REGION>

   <DIVIDER GUTTER=1 TYPE=SOLID>

   <REGION>
      <LSTFLD SCROLLVAR=SCRAMT>
         <LSTCOL DATAVAR=SELECTN  COLWIDTH=03>Sel
         <LSTCOL DATAVAR=COLNAME  USAGE=OUT COLWIDTH=18>COLUMN NAME
         <LSTCOL DATAVAR=DATATYPE USAGE=OUT COLWIDTH=17>DATATYPE
         <LSTCOL DATAVAR=ORDERBY  COLWIDTH=02>ORDER
         <LSTCOL DATAVAR=ASCDESC  COLWIDTH=01>(A/D)
         <LSTCOL DATAVAR=WHERECDN COLWIDTH=15>WHERE
      </LSTFLD>
   </REGION>
</AREA>
</PANEL>

/* REXX - Db2 Editor                                         */
/*                                                           */
/* Author : Quasar Chunawala quasar.chunawalla@gmail.com     */
/*                                                           */
/* REXX PROGRAM - ED110                                      */
/* PANELS       - PAN110                                     */
/*                                                           */
/* VERSION 1.0                                               */
/* A Data Editor for Db2 on the zOS.                         */
/*     (c) Copyright Quasar Chunawala, 2012                  */

MAIN:

   CALL RESTORE_USER_PROFILE

   DO UNTIL ZCMD = 'X'

      CALL PRE_FETCH_TABLE_SCHEMA

      CALL DISPLAY_BROWSE_SELECTION_PANEL

      IF DISPLAY_RC > 0 THEN DO
         LEAVE
      END

   END

   /* EVALUATE THE MENU OPTION ENTERED BY THE USER */

   IF ZCMD = 'X' | ZCMD = 'EXIT' THEN DO
      RETURN
   END

   EXIT

DISPLAY_BROWSE_SELECTION_PANEL:

   /* INITIALISE PANEL VARIABLES */

   OWTBL = CREATOR || '.' || TNAME

   ADDRESS ISPEXEC
   "TBTOP SCHEMATB"

   ADDRESS ISPEXEC
   "TBDISPL SCHEMATB PANEL(PAN110)"

   DISPLAY_RC = RC

   RETURN

BROWSE_PANEL:

   CALL ED100

   RETURN

RESTORE_USER_PROFILE:
   ADDRESS ISPEXEC
   "TBSTATS USERPROF STATUS1(S1) STATUS2(S2)"

   IF S1 = 1 & S2 = 1 THEN DO
      ADDRESS ISPEXEC
      "TBOPEN USERPROF WRITE"

      IF RC > 0 THEN DO
         SAY 'ERROR OPENING THE USER-PROFILE'
         SAY 'EXITING APPLICATION...'
         EXIT
      END

      ADDRESS ISPEXEC
      "TBTOP USERPROF"

      USERID = SYSVAR(SYSUID)

      ADDRESS ISPEXEC
      "TBGET USERPROF"

      IF RC > 0 THEN DO
         SAY 'ERROR RETRIEVING THE USER-PROFILE'
         SAY 'EXITING APPLICATION...'

         ADDRESS ISPEXEC
         "TBCLOSE USERPROF"
         EXIT
      END

      ADDRESS ISPEXEC
      "TBCLOSE USERPROF"

   END
   ELSE DO
      SAY 'ERROR ON THE STATUS CHECK OF USER-PROFILE TABLE'
      SAY 'EXITING APPLICATION...'
      EXIT
   END

   RETURN

EXECUTE_SQL:

   CALL CONNECT_DB2

   ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"
   SAY 'DECLARE SQLCODE : ' SQLCODE
   ADDRESS DSNREXX "EXECSQL PREPARE S1 INTO :SQLDA",
                   "FROM :SQLSTMT"
   SAY 'PREPARE SQLCODE ' SQLCODE
   ADDRESS DSNREXX "EXECSQL OPEN C1"
   SAY 'OPEN SQLCODE : ' SQLCODE

   /* ------------- MAIN PROCESSING LOGIC --------------------*/
   CALL CREATE_TEMP_ISPF_TABLE "SCHEMATB",,
                               "COLNAME",,
                               "SELOPTN DATATYPE ORDERBY ASCDESC WHERECDN"

   DO WHILE SQLCODE <> 100
      ADDRESS DSNREXX "EXECSQL FETCH C1",
                      "USING DESCRIPTOR :SQLDA"

      COLNAME  = SQLDA.1.SQLDATA
      SELOPTN  = ''
      DATATYPE = SQLDA.2.SQLDATA
      ORDERBY  = '  '
      ASCDESC  = ' '
      WHERECDN = ''

   /* SAY 'ADDING ROW -> ' SQLDA.1.SQLDATA                    */

      IF SQLCODE = 0 THEN DO
         CALL ADD_ROW_TO_TABLE "SCHEMATB"
      END

   END

   /* ------------- PROCESSING LOGICE ENDS HERE --------------*/

   ADDRESS DSNREXX "EXECSQL CLOSE C1"

   CALL CLOSE_DB2

   RETURN

CREATE_TEMP_ISPF_TABLE:
   PARSE ARG ISPF_TBL_NAME,KEYLIST,NAMELIST

   ADDRESS ISPEXEC
   "TBCREATE "ISPF_TBL_NAME" KEYS("KEYLIST") NAMES("NAMELIST")",
   "REPLACE"

   IF RC > 4 THEN DO
      SAY 'ERROR CREATING THE TEMPORARY TABLE ' ISPF_TBL_NAME
      SAY 'RETURN CODE : ' RC
      SAY 'EXITING APPLICATION...'
      EXIT
   END

   RETURN

OPEN_ISPF_TABLE:
   PARSE ARG ISPF_TBL_NAME

   ADDRESS ISPEXEC
   "TBSTATS "ISPF_TBL_NAME" STATUS1(S1) STATUS2(S2)"

   IF S1 = 1 & S2 = 1 THEN DO
      ADDRESS ISPEXEC
      "TBOPEN "ISPF_TBL_NAME" WRITE"

      IF RC > 0 THEN DO
         SAY 'ERROR OPENING THE ' ISPF_TBL_NAME
         SAY 'EXITING APPLICATION...'
         EXIT
      END
   END

   ADDRESS ISPEXEC
   "TBTOP "ISPF_TBL_NAME""

   RETURN

CLOSE_ISPF_TABLE:
   PARSE ARG ISPF_TBL_NAME

   ADDRESS ISPEXEC
   "TBCLOSE "ISPF_TBL_NAME""

   IF RC > 0 THEN DO
         SAY 'ERROR CLOSING THE ' ISPF_TBL_NAME
         SAY 'EXITING APPLICATION...'
         EXIT
   END

   RETURN

ADD_ROW_TO_TABLE:

   PARSE ARG ISPF_TBL_NAME

   ADDRESS ISPEXEC
   "TBADD "ISPF_TBL_NAME""

   IF RC > 0 THEN DO
      SAY 'ERROR ADDING ROWS TO THE ' ISPF_TBL_NAME ', RC = ' RC
      SAY 'EXITING APPLICATION...'
      EXIT
   END

   RETURN

CONNECT_DB2:
   S_RC = RXSUBCOM("ADD","DSNREXX","DSNREXX")
   ADDRESS DSNREXX "CONNECT" SUBSYS
   RETURN

CLOSE_DB2:
   ADDRESS DSNREXX "DISCONNECT"
   RETURN

PRE_FETCH_TABLE_SCHEMA:
   SQLSTMT = "SELECT NAME,COLTYPE,LENGTH,SCALE",
             "FROM SYSIBM.SYSCOLUMNS",
             "WHERE TBNAME='"TNAME"'",
             "AND TBCREATOR = '"CREATOR"'"

   CALL EXECUTE_SQL

   RETURN