× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Here is a very old, very basic program that you can use as an example.
The possible sort fields are selected by the user from a pop-up window.
But you could easily change it to determine the field by curser
positioning.


Embedded SQL & Dynamic Sorting/Positioning Subfiles

 *------------------------------------------------------------------------*
  *
*
  * Program Name:  SBFSQL
*
  *
*
  * Description:   Sample program to use SQL to sort a subfile
*
  *
*
  * To compile:
*
  *    CRTSQLRPGI OBJ(XXX/SBFSQL) SRCFILE(XXX/QRPGLESRC) +
*
  *                SRCMBR(SBFSQL) RDB(*LOCAL) OBJTYPE(*PGM) _
*
  *                DLYPRP(*YES) SQLPKG(*OBJ)
*
  *
*
  * Called by:     XXXXXXXX
*
  *
*
  * Author:        K. Hodge
*

*------------------------------------------------------------------------*
  *
*
  *                       MAINTENANCE LOG
*

*------------------------------------------------------------------------*
  * Start/End
*
*----------   ----   ----------------------------------------------------*
 * 08/23/00    KLH    Program Creation                                    *
 *------------------------------------------------------------------------*
 *
 *---------------------------------------------------------*
 *             F I L E    S P E C I F I C A T I O N        *
 *---------------------------------------------------------*
 *
FSBFSQLD   CF   E             WORKSTN
F                                     SFILE(SFLRCD:RRN)
F                                     infds(info)
 *---------------------------------------------------------*
 *          I N P U T     S P E C I F I C A T I O N        *
 *---------------------------------------------------------*
 /EJECT
 *-------------------------------------------------------------------------
 * Variable Declarations
 *-------------------------------------------------------------------------
*
 *
 * Information data structure to hold attnetion indicator byte.
 *
Dinfo             DS
D cfkey                 369    369
 *
 * Constants for ttention indicator byte
Dexit             C                   const(X'33')
Dprompt           C                   const(X'34')
Dcancel           C                   const(X'3C')
Denter            C                   const(X'F1')
 *
Dorder            S              8    INZ('E2TRANID')
Dposition         S             10
Dselct1           S            500A   INZ('SELECT E2STRNBR, -
D                                          E2FILEID, -
D                                          E2TRANID, -
D                                          E2STRDTE, -
D                                          E2STRTME, -
D                                          E2STATUS, -
 D                                          E2NBRRCD, -
D                                          E2DIRIND -
 D                                          FROM EM0020P -
 D                                          WHERE E2DIRIND = ')
 Dselct2           S            500A   INZ(' ')
  *
 D********************************************************************
 D* Arrays and tables                                                *
 D********************************************************************
 D*
 D*
  /EJECT
 D                 DS
 D  PAGSIZ                 1      5  0 INZ(10)
 D  BCKCNT                 6     10  0 INZ(11)
 D*
 D orderby         C                   CONST(' ORDER BY ')
 D quote           C                   CONST('''')
  *-------------------------------------------------------*
D********************************************************************
D* Arrays and tables                                                *
D********************************************************************
D*
D*
 /EJECT
D                 DS
D  PAGSIZ                 1      5  0 INZ(10)
D  BCKCNT                 6     10  0 INZ(11)
 *-------------------------------------------------------*
 * Transaction ID Data Structure                         *
 *-------------------------------------------------------*
 *-------------------------------------------------------*
 * Display File Information Data Structure               *
 *-------------------------------------------------------*
 /EJECT
 *-------------------------------------------------------*
 *     C A L C U L A T I O N   S P E C I F I C A T I O N *
 *-------------------------------------------------------*
 *
C*
 /EJECT
 *
 *
C/EXEC SQL
C+ CONNECT
C/END-EXEC
 *
C                   EXSR      prep
C                   EXSR      sflbld
C                   dou       (cfkey = exit)
C                   WRITE     CMDKEY
C                   EXFMT     SFLCTL
C                   select
 * prompt to select 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                   endsl
C                   enddo
 *
C                   EXSR      clean
 *
 *
C/EXEC SQL
C+ DISCONNECT CURRENT
C/END-EXEC
C                   eval      *inlr = *on
C                   RETURN
C*
C*
 *****************************************************************
 *  PREPARE SQL CURSOR                                           *
*****************************************************************
C     PREP          BEGSR
C*
 * Prepare the SQL statement for validation, since the program was
 * compiled with DLYPRP (*YES), it will wait until it is used before
 * it prepares the cursor.
C*
 * Simple:
C                   eval      selct2 = %trimr(selct1) + ' ' + order
C                             + ' >= ' + quote + position + quote
C                             + orderby + order
 * more complex:
C                   eval      selct2 = %trimr(selct1) + ' ' + quote
C                             + dirind + quote + ' and ' + order
C                             + ' >= ' + quote + position + quote
C                             + orderby + order
 *
C/EXEC SQL
C+ PREPARE SEL FROM :selct2
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+ Optimize for :Pagsiz Rows
-Or-
C+ Optimize for 10 Rows
C/END-EXEC
C*
C/EXEC SQL
C+ OPEN MYCSR
C/END-EXEC
 *
C*
C                   ENDSR
C*
C*
 *****************************************************************
 *  CLEAN UP B4 EXITING                                          *
 *****************************************************************
C     CLEAN         BEGSR
 *
 * Close the SQL cursor after all processing is complete.
 *
C/EXEC SQL
C+ CLOSE MYCSR
C/END-EXEC
 *
 *
C                   ENDSR
C*
C*
 *****************************************************************
 *  Build the subfile                                            *
 *****************************************************************
C     sflbld        BEGSR
 *
 * Clear the subfile
 *
C                   MOVE      *ON           *IN70
*CLEAR SUBFILE
C                   WRITE     SFLCTL
C                   MOVE      *OFF          *IN70
Set CLEAR *OFF
C                   eval      rrn = 0
* If roll back:
C                   if        *in93 = *on
 * Get the previous rows from the SQL cursor.
 *
C/EXEC SQL
C+ FETCH RELATIVE -20 FROM MYCSR INTO :empiem
C/END-EXEC
C                   endif
 *
 * Process the records in the SQL cursor until the return not = 0
C                   dou       sqlcod <> 0 or rrn = pagsiz
C***                do        pagsiz
 *
 * Get the next row from the SQL cursor.
 *
C/EXEC SQL
C+ FETCH NEXT FROM MYCSR
C+    INTO :e2strnbr, :e2fileid, :e2tranid, :e2strdte, :e2strtme,
C+ :e2endtme, :e2status, :e2nbrrcd
C/END-EXEC
*
C                   if        sqlcod =  0
C                   eval      rrn = rrn + 1
C                   WRITE     SFLRCD
C*                  write     sfl1
C                   endif
C                   enddo
 *
C                   if        rrn =  0
C                   eval      *in70 = *on
C                   MOVE      *OFF          *IN40
C                   else
C                   eval      rrn = 1
C                   MOVE      *ON           *IN40
C                   endif
 *
C                   eval      *in91 = *on
 *
 *
C                   ENDSR
C*
C*
 *****************************************************************
 *  SORT - prompt to select sort criteria                        *
 *****************************************************************
C     sort          BEGSR
 *
 *
C                   exfmt     window1
 *
C                   select
C                   when      tab1 <> *blank
C                   movel(p)  'e2strnbr'    order
C                   clear                   tab1
C                   when      tab2 <> *blank
C                   movel(p)  'e2fileid'    order
C                   clear                   tab2
C                   when      tab3 <> *blank
C                   movel(p)  'e2tranid'    order
C                   clear                   tab3
C                   when      tab4 <> *blank
C                   movel(p)  'e2status'    order
C                   clear                   tab4
C                   endsl
 *
 *
C                   ENDSR
C*
 *****************************************************************
C/EJECT


Thank you,

Karen Hodge
Senior System Analyst
Genesys Health System
1000 Healthpark Blvd, Grand Blanc, Mi 48439
Office 810.606.5180, Fax 810.606.7204
khodge@xxxxxxxxxxx


As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.