*****************************************************************
      *
      *  To compile:
      *
      *             CRTSQLRPGI PGM(XXX/DSPSTRPRCR) SRCFILE(XXX/QRPGLESRC)
      *
      *
      * COMPILING. In order to compile this program you will need
      *            to use options which allow it to work correctly
      *            between machines. These options are---
      *
      *               COMMIT = *NONE
      *               RDB    = Machine name that you will connect to.
      *               DLYPRP = *YES
      *               SQLPKG = The name & library that you want to
      *                        use for the package. This will put the
      *                        package on the RDB machine that you
      *                        specify.
      *****************************************************************
     FDspStrPrcDcf   e             Workstn
     F                                     SFile(sfl1:rrn1)
     F                                     InfDS(info)
      *
      * Information data structure to hold attention indicator byte.
      *
     Dinfo             ds
     D cfkey                 369    369
      *
      * Constants for attention indicator byte
      *
     D Exit            C                   const(X'33')
     D Prompt          C                   const(X'34')
     D Cancel          C                   const(X'3C')
     D Enter           C                   const(X'F1')
     D PageDown        C                   const(X'F5')

     D SelectOne       S            500A   INZ('SELECT specschema, specname -
     D                                     FROM sysprocs')

     D SelectTwo       S           1000A   INZ(' ')

     D Lastrrn         S                   Like(rrn1)

     D WhereClause     S            200A   INZ(' ')
     D OrderBy         S             50A   INZ(' ')
     D SpecName        S            128A
     D SpecSchema      S            128A
     D Lib             S                   Like(SpecSchema)
     D Proc            S                   Like(SpecName)
     D ProcFilter      C                   Const('SPECNAME')
     D LibFilter       C                   Const('SPECSCHEMA')
     D Quote           C                   Const('''')
     D SubfilePage     C                   Const(16)

     C     *Entry        Plist
     C                   Parm                    Proc
     C                   Parm                    Lib

      * Establish the connection to the remote machine. The -842 return
      * code indicates that the connection is already established. If
      * you want to connect to the local machine, use CONNECT RESET.

     C/EXEC SQL
     C+ CONNECT RESET
     C/END-EXEC

      * Filter data, build and display subfile.

     C                   ExSr      Filter
     C                   ExSr      Clean
     C                   ExSr      Prep
     C                   ExSr      SflBld
     C                   ExSr      PrcSfl
     C                   ExSr      Clean
      *
      *  Disconnect the current connection.
      *
     C/EXEC SQL
     C+   DISCONNECT CURRENT
     C/END-EXEC
      *
     C                   Eval      *InLR = *on
      *
      *****************************************************************
      * Process the Subfile
      *****************************************************************
      *
     C     PrcSfl        BegSr
      *
     C                   DoU       (CFKey = Exit)
      *
     C                   Write     FKey1
     C                   ExFmt     Sf1Ctl
      *
     C                   Select
      *
      * prompt for sorting criteria.
      *
     C                   When      CFKey = Prompt
     C                   ExSr      Sort
     C                   ExSr      Clean
     C                   ExSr      Prep
     C                   ExSr      SflBld
      *
     C                   When      CFKey = Cancel
     C                   Leave
      *
     C                   When      CFKey = PageDown
     C                   ExSr      SflBld
      *
     C                   EndSl
      *
     C                   EndDo
      *
     C                   EndSr
      *
      *****************************************************************
      * Prepare SQL cursor
      *****************************************************************
      *
     C     Prep          BegSr
      *
      * Clear the subfile
      *
     C                   Eval      *In31 = *On
     C                   Write     Sf1Ctl
     C                   Eval      *In31 = *Off
     C                   Eval      *In32 = *Off
     C                   Eval      RRN1 = 0
     C                   Eval      LastRRN = 0
     C                   Eval      *In90 = *Off
      *
      * Prepare the SQL statement for validation, since the program was
      * compiled with DLYPRP (*YES), it will wait until it is used before
      * it prepares th cursor.
      *
     C                   Eval      SelectTwo = %TRIMR(SelectOne) + ' '
     C                                         + %TrimR(WhereClause) + ' '
     C                                         + OrderBy
      *
     C/EXEC SQL
     C+   PREPARE sel FROM :SelectTwo
     C/END-EXEC
      *
      * Declare the SQL cursor to hold the data retrieved from the SELECT
      *
     C/EXEC SQL
     C+ DECLARE MYCSR SCROLL CURSOR FOR SEL
     C/END-EXEC
      *
      * Open the SQL cursor.
      *
     C
     C/EXEC SQL
     C+ OPEN MYCSR
     C/END-EXEC
      *
     C                   EndSr
      *
      *****************************************************************
      * Clean up before exiting
      *****************************************************************
      *
     C     Clean         BegSr
      *
      *  Close the SQL cursor after all processing is complete.
      *
     C/EXEC SQL
     C+   CLOSE mycsr
     C/END-EXEC
      *
     C                   Endsr
      *
      *****************************************************************
      * Build the subfile
      *****************************************************************
      *
     C     SflBld        BegSr
      *
     C                   Eval      RRN1 = LastRRN
      *
      * Process the records in the SQL cursor until the return not = 0
      *
     C                   Do        SubfilePage
      *
      * Get the next row from the SQL cursor.
      *
     C/EXEC SQL
     C+   FETCH NEXT FROM mycsr
     C+      INTO :specschema, :specname
     C/END-EXEC
      *
     C                   If        SqlCod = 0
     C                   Eval      RRN1  = RRN1  + 1
     C                   Eval      Procedure = %TrimR(specname)
     C                   Eval      Library = %TrimR(specschema)
     C                   Write     Sfl1
     C                   Else
     C                   Leave
     C                   EndIf
      *
     C                   EndDo
      *
     C                   If        RRN1 = 0
     C                   Eval      *In32 = *On
     C                   Else
     C                   Eval      LastRRN = RRN1
     C                   EndIf
      *
      * A code of 100 means end of file.
      *
     C                   If        SqlCod = 100
     C                   Eval      *In90 = *On
     C                   EndIf
      *
     C                   EndSr
      *
      *****************************************************************
      * SORT - prompt to select sort criteria
      *****************************************************************
      *
     C     Sort          BegSr
      *
     C                   ExFmt     Window1
      *
     C                   Select
      *
     C                   When      tab1 <> *blank
     C                   Eval      OrderBy = 'ORDER BY SPECNAME'
     C                   Eval      tab1 = *blanks
      *
     C                   When      tab2 <> *blank
     C                   Eval      OrderBy = 'ORDER BY SPECSCHEMA'
     C                   Eval      tab2 = *blanks
      *
     C                   EndSl
      *
     C                   EndSr
      *
      *****************************************************************
      * FILTER - Filter out USER and/Or Date Range
      *****************************************************************
      *
     C     Filter        BegSr

     C                   Clear                   WhereClause

     C                   If        %TrimR(Lib)  <> '*ALL' Or
     C                             %TrimR(Proc) <> '*ALL'

     C                   If        Lib > *Blanks And %TrimR(Lib) <> '*ALL'
     C                   Eval      WhereClause = 'WHERE ' +
     C                                           %TrimR(WhereClause) + ' '
     C                                           + LibFilter
     C                                           + ' = ' + Quote
     C                                           + %TrimR(Lib) + Quote
     C                   EndIf

     C                   If        Proc <> '*ALL' And Lib > *Blanks And
     C                             Lib <> '*ALL'
     C                   Eval      WhereClause = %TrimR(WhereClause)
     C                                           + ' And ' +  ProcFilter
     C                                           + ' = ' + Quote
     C                                           + %TrimR(Proc) + Quote

     C                   ElseIf    (Proc <> '*ALL' And Lib = *Blanks) Or
     C                             (Proc <> '*ALL' And Lib = '*ALL')
     C                   Eval      WhereClause = 'WHERE ' +
     C                                           %TrimR(WhereClause)
     C                                           +  ProcFilter
     C                                           + ' = ' + Quote
     C                                           + %TrimR(Proc) + Quote
     C                   EndIf

     C                   EndIf

     C                   EndSr
      *