This is the full source code for the subfile sort program that appeared in the May 2004 issue of the iSeries EXTRA newsletter. The source for the display file and the Product file used in the example follow the RPG source.
For a zip file containing all the sources, click here.
|
|
DDS for the Display and Product Files
H Option(*SrcStmt: *NoDebugIO)
H DftActGrp(*No) BndDir('QC2LE')
FProduct IF E DISK
// This program demonstrates a number of V5R2 features,
// including the use of a result field DS on I/O operations.
// It also demonstrates the use of the qsort API to sequence
// subfile data
FDspProdSf CF E WORKSTN SFile(ProdSfl: RRN)
// Prototype for qsort - which should be in a /COPY member
D SortDS Pr ExtProc('qsort')
D DataToSort Like(SubfileData)
D Elements 10U 0 Value
D Size 10U 0 Value
D SortFunct * ProcPtr Value
// Constants used by qsort sequencing routines
D High C 1
D Low C -1
D Equal C 0
// Prototypes for the two seqencing routines used in the program
D ProductSort Pr 10I 0
D Element1 LikeRec(ProdSfl: *Output)
D Element2 LikeRec(ProdSfl: *Output)
D DescrSort Pr 10I 0
D Element1 LikeRec(ProdSfl: *Output)
D Element2 LikeRec(ProdSfl: *Output)
// Prototypes for the various subprocedures used
D LoadArray Pr 10I 0
D DisplaySubfile Pr
D ClearSubfile Pr
D LoadSubfile Pr
D RecordCount 10I 0
// This is the DS that will hold the subfile "array"
// For demonstration purposes it is hard coded as 99 elements
// In practice we would probably use dynamic memory (%Alloc)
// or a User Space to hold the array
D SubfileData DS Qualified
D SubfileRec LikeRec(ProdSfl: *Output) Dim(99)
D Count S 10I 0 Inz(0)
D RRN S 10I 0 Inz(0)
// Procedure pointers used as an alternative to duplicating the call
// to qsort
D SortRoutine S * ProcPtr
D SortProduct S * ProcPtr Inz(%PAddr(ProductSort))
D SortDescr S * ProcPtr Inz(%PAddr(DescrSort))
// Named constants to map numbered indicators in display file
D Exit C 3
D SortPrCode C 5
D SortDesc C 6
D SflDspCtl C 90
D SflClear C 91
D SflDsp C 92
/FREE
Count = LoadArray(); // Load all data for subfile
DOU *In(Exit);
LoadSubfile(Count);
DisplaySubfile();
SELECT; // Determine sort option
WHEN *In(SortPrCode);
SortRoutine = SortProduct;
WHEN *In(SortDesc);
SortRoutine = SortDescr;
OTHER; // Default to Product sort
SortRoutine = SortProduct;
ENDSL;
// Call the sort routine
SortDS(SubFileData:
Count:
%Size(SubfileData.SubfileRec):
SortRoutine);
ClearSubfile();
ENDDO;
*INLR = *On;
/END-FREE
// LoadArray subprocedure reads all records to be added to the subfile
// (everything in this example) and loads them into the array. It
// returns a count of the number of records loaded.
// It is left as an exercise for the reader to adapt the technique to
// a page-at-a-time approach.
P LoadArray B
D PI 10I 0
D n S 10I 0
/FREE
// Read all records and fill array of subfile records
DOU %EOF(Product);
READ ProductR;
IF Not %Eof(Product);
n +=1;
SubfileData.SubfileRec(n).ProdCD = ProdCd;
SubfileData.SubfileRec(n).ProdDS = ProdDs;
SubfileData.SubfileRec(n).CatCod = CatCod;
SubfileData.SubfileRec(n).StOH = StOH;
SubfileData.SubfileRec(n).SellPr = SellPr;
ENDIF;
ENDDO;
RETURN n;
/END-FREE
P LoadArray E
// DisplaySubfile does just what you would expect it to do!
P DisplaySubfile B
D PI
/Free
*IN(SflClear) = *Off;
*IN(SflDspCtl) = *On;
*IN(SflDsp) = *On;
Write Keys;
ExFmt ProdSflCtl;
Return;
/end-free
P DisplaySubfile E
// LoadSubfile - simply loops through the array (in whatever sequence it
// happens to be in now) and writes the subfile records. Note the
// use of the array element as the result field on the Write operation.
// This allows all fields to be output simultaneously.
P LoadSubfile B
D PI
D RecordCount 10I 0
D i S 10I 0
/FREE
FOR RRN = 1 to RecordCount;
WRITE ProdSfl SubfileData.SubfileRec(RRN);
ENDFOR;
/END-FREE
P LoadSubfile E
// ClearSubfile - hmmmm - wonder what that one does!
P ClearSubfile B
D PI
/FREE
*IN(SflClear) = *On;
*IN(SflDspCtl) = *Off;
*IN(SflDsp) = *Off;
Write ProdSflCtl;
Return;
/END-FREE
P ClearSubfile E
// Sort into Product code sequence.
// Note the use of LikeRec to decribe the parameters.
P ProductSort B
D PI 10I 0
D Element1 LikeRec(ProdSfl: *Output)
D Element2 LikeRec(ProdSfl: *Output)
/FREE
SELECT;
WHEN Element1.ProdCd > Element2.ProdCd;
RETURN High;
WHEN Element1.ProdCd < Element2.ProdCd;
RETURN Low;
OTHER;
RETURN Equal;
ENDSL;
/END-FREE
P ProductSort E
// Sort into Product Description sequence
// Note that this is identical to ProductSort except for
// the field name referenced in the comparisons,
P DescrSort B
D PI 10I 0
D Element1 LikeRec(ProdSfl: *Output)
D Element2 LikeRec(ProdSfl: *Output)
/FREE
SELECT;
WHEN Element1.ProdDs > Element2.ProdDs;
RETURN High;
WHEN Element1.ProdDs < Element2.ProdDs;
RETURN Low;
OTHER;
RETURN Equal;
ENDSL;
/END-FREE
P DescrSort E
Product File
A R PRODUCTR
A PRODCD 7 COLHDG('Product Code')
A PRODDS 30 COLHDG('Description')
A CATCOD 2 COLHDG('Category Code')
A STOH 7P 0 COLHDG('Stock on Hand')
A LNDCST 9P 2 COLHDG('Landed Cost')
A SELLPR 9P 2 COLHDG('Selling/Unit Price')
A DTLCHG 6P 0 COLHDG('Date Last Changed')
A DTLORD 6P 0 COLHDG('Date Last Ordered')
Display File
A DSPSIZ(24 80 *DS3)
A REF(PARIS/PRODUCT PRODUCTR)
A CA03(03)
A CA05(05)
A CA06(06)
A R PRODSFL
A SFL
A PRODCD R O 5 5
A PRODDS R O 5 15
A CATCOD R O 5 48
A STOH R O 5 53
A SELLPR R O 5 63
A R PRODSFLCTL
A SFLCTL(PRODSFL)
A 90 SFLDSPCTL
A 92 SFLDSP
A 91 SFLCLR
A SFLPAG(16)
A SFLSIZ(32)
A OVERLAY
A 1 29'Product Subfile Display'
A 3 5' Code'
A 3 24'Description'
A 3 47'Cat'
A 3 54'Stock'
A 3 65'Price'
A R KEYS
A OVERLAY
A 23 5'F3=Exit'
A 23 14'F5=Sort by Prod Code'
A 23 36'F6=Sort by Description'
Want more
information?
Got a question or comment about the site?
Please feel free to Contact
Us at any time.}