|
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 mailing list archive is Copyright 1997-2025 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.
