It is all about IBM i: How to create a Subfile program without using any native I/O operations.

How to create a single page Subfile just using embedded SQL.

Every RPGer knows about subfiles. So, in this post I am not going to describe you “what is a subfile” or “what are the three types of subfiles”.

One day a friend asked me “is it hard to create a single page subfile just using SQL and also with a search option?” He was though managing ‘Page up’ and ‘Page down’ would be difficult when using SQL. But it’s not. I have done it easily using a scrollable cursor.

There are two main differences in my single page subfile program than many other single page subfiles on the internet. Those differences are,

There are no any native I/O operations, It’s just SQL.
There are no any numeric indicators.

Here I’m using simple search with one search criteria. But if we want to use more complex search criteria, then we might have to use dynamic SQL instead of Static SQL.

If anyone wants to re-use this program with a different file and a selection, then he/she has minimum changes to be done (Just change SQL selection and “dsp_fields” data structure). Following are the codes. Even you can download them from here.

Physical file

A R RCUSTOMER

A CUSCODE 10 0 COLHDG('Customer Code')

A CUSNAME 30 COLHDG('Customer Name')

A CUSBDAY 8 0 COLHDG('Customer B''day')

A CUSIDNM 12 COLHDG('Customer ID Number')

A CUSCON1 10 0 COLHDG('Custmr contact Num1')

A CUSCON2 10 0 COLHDG('Custmr contact Num2')

A CUSADD1 30 COLHDG('Customer Address 1')

A CUSADD2 30 COLHDG('Customer Address 2')

A CUSADD3 30 COLHDG('Customer Address 3')

A K CUSCODE

Display File

A DSPSIZ(24 80 *DS3)

A PRINT

A INDARA

A ERRSFL

A HELP

A CA01

A CA02

A CA03

A CA04

A CA05

A CA06

A CA07

A CA08

A CA09

A CA10

A CA11

A CA12

A CA13

A CA14

A CA15

A CA16

A CA17

A CA18

A CA19

A CA20

A CA21

A CA22

A CA23

A CA24

A PAGEUP

A PAGEDOWN

A R SFL01 SFL

A $CUSCODE 10S 0O 8 6

A $CUSNAME 30A O 8 18

A $CUSBDAY 8Y 0O 8 50EDTWRD(' / / ')

A $CUSCON1 10Y 0O 8 62EDTWRD('0 - ')

A R SFLCTL SFLCTL(SFL01)

A SFLSIZ(0010)

A SFLPAG(0010)

A OVERLAY

A 41 SFLDSP

A 42 SFLDSPCTL

A 40 SFLCLR

A 45 SFLEND(*MORE)

A 1 2USER

A 1 72DATE

A EDTCDE(Y)

A 2 72TIME

A 1 32'TEST SUBFILE PROGRAM'

A 6 8'Customer'

A COLOR(WHT)

A 7 12'Code'

A COLOR(WHT)

A 6 18'Customer'

A COLOR(WHT)

A 7 18'Name'

A COLOR(WHT)

A 6 52'Customer'

A COLOR(WHT)

A 7 52'Birthday'

A COLOR(WHT)

A 6 65'Customer'

A COLOR(WHT)

A 7 62'Contact Num'

A COLOR(WHT)

A @CUSCODE 10Y 0B 5 6EDTCDE(4)

A R BOTTOM

A OVERLAY

A 22 2'F3=Exit F5=Refresh'

A COLOR(BLU)

A 21 2' -

A -

A '

A DSPATR(UL)

A COLOR(BLU)

A @ERRDSP 75 O 24 2COLOR(WHT)

Program

//------------------------------------------------------------

// Copyright (C) Poorna Sanjeewa, http://www.rpglk.com/

// This is a single page(non elastic) subfile written

// using sql(Without using any native I/O) and free form RPG.

//------------------------------------------------------------

// Control Specification

//------------------------------------------------------------

ctl-opt dftactgrp(*no) optimize(*none);

//------------------------------------------------------------

// File Specification

//------------------------------------------------------------

dcl-f TSTSFLFM workstn sfile(SFL01:rrn) infDs(infdata)

indDs(indicatiors);

//------------------------------------------------------------

// Variable Specification

//------------------------------------------------------------

dcl-s rrn zoned(5:0);

// Function Key definition...

dcl-c key_Exit const(x'33');

dcl-c key_enter Const(x'F1');

dcl-c key_pageUp Const(x'F4');

dcl-c key_pageDn Const(x'F5');

dcl-c key_refresh Const(x'35');

//------------------------------------------------------------

// Date Structures

//------------------------------------------------------------

// File information data structure...

dcl-ds infdata;

key_pressed char(1) pos(369);

end-ds;

// indicator information data structure...

dcl-ds indicatiors;

sfl_Clear ind pos(40);

sfl_Dsply ind pos(41);

sfl_DsCon ind pos(42);

sfl_End ind pos(45);

end-ds;

// Display fields data structure...

dcl-ds dsp_fields;

$CUSCODE zoned(10:0);

$CUSNAME char(30);

$CUSBDAY zoned(8:0);

$CUSCON1 zoned(10:0);

end-ds;

//------------------------------------------------------------

// Begining of the main Program...

//------------------------------------------------------------

exec sql set option commit = *none, closqlcsr = *endmod;

key_pressed = key_enter;

dow key_Exit <> key_pressed;

if key_pressed = key_enter;

clear_sfl();

build_csr();

fetch_Fst_pgDnEn();

build_sfl();

dsply_sfl();

elseif key_pressed = key_refresh;

@CUSCODE = 0;

clear_sfl();

build_csr();

fetch_Fst_pgDnEn();

build_sfl();

dsply_sfl();

elseif key_pressed = key_pageUp;

process_pageUp();

dsply_sfl();

elseif key_pressed = key_pageDn;

process_pageDn();

dsply_sfl();

else;

dsply_sfl();

endif;

enddo;

*inlr = '1';

//------------------------------------------------------------

// Clear Subfile procedure...

//------------------------------------------------------------

dcl-proc clear_sfl;

sfl_Clear = *on;

write SFLCTL;

sfl_Clear = *off;

end-proc;

//------------------------------------------------------------

// Build Subfile procedure...

//------------------------------------------------------------

dcl-proc build_sfl;

dow sqlcode >= 0 and sqlcode < 100;

rrn += 1;

write SFL01;

if rrn = 10;

leave;

endif;

exec sql fetch next from c1 into :dsp_fields;

enddo;

// Check whether the last record or not...

exec sql fetch next from c1 into :dsp_fields;

if sqlcode = 100 ;

rrn += 1;

sfl_End = *on;

else;

// If not the last record set the cursor to previous position.

exec sql fetch prior from c1 into :dsp_fields;

endif;

end-proc;

//------------------------------------------------------------

// Display Subfile procedure...

//------------------------------------------------------------

dcl-proc dsply_sfl;

write bottom;

sfl_Dsply = *on;

sfl_DsCon = *on;

exfmt SFLCTL;

@ERRDSP = ' ';

end-proc;

//------------------------------------------------------------

// Declare cursor procedure...

//------------------------------------------------------------

dcl-proc build_csr;

exec sql close c1;

exec sql declare c1 scroll cursor for

select CUSCODE, CUSNAME, CUSBDAY, CUSCON1

from poorna.CSTMR_TBL

where CUSCODE >= :@CUSCODE

order by CUSCODE

FOR READ ONLY;

exec sql open c1;

end-proc;

//------------------------------------------------------------

// Fetch first reocrd for 'page down' and 'enter' keys

//------------------------------------------------------------

dcl-proc fetch_Fst_pgDnEn;

sfl_End = *off;

rrn = 0 ;

exec sql fetch next from c1 into :dsp_fields;

end-proc;

//------------------------------------------------------------

// Fetch first reocrd for 'page up' Key

//------------------------------------------------------------

dcl-proc fetch_Fst_pgUp;

dcl-pi *n char(1) end-pi;

if rrn <> 0;

rrn += 9 ;

else;

rrn = 11;

endif;

// Make the 'rrn' negative, to point the cursor to 'rrn' number of

// rows before the last fetch

rrn *= -1;

// Set the cursor location...

exec sql fetch relative :rrn from c1 into :dsp_fields;

// If the cursor already in the top the list

if sqlcode = 100;

rrn = 0 ;

exec sql fetch first from c1 into :dsp_fields;

// Point the cursor to 9 Rows after the last fetch.

exec sql fetch relative +9 from c1 into :dsp_fields;

@ERRDSP = 'You have reached the top of the list.';

return '1';

endif;

sfl_End = *off;

rrn = 0 ;

return ' ';

end-proc;

//------------------------------------------------------------

// Page down procedure...

//------------------------------------------------------------

dcl-proc process_pageDn;

if sfl_End = *on;

@ERRDSP = 'You have reached the bottom of the list.';

return;

endif;

clear_sfl();

fetch_Fst_pgDnEn();

build_sfl();

end-proc;

//------------------------------------------------------------

// Page up procedure...

//------------------------------------------------------------

dcl-proc process_pageUp;

// Buid the subfile only if the first record successfully fetched

if fetch_Fst_pgUp() = ' ';

clear_sfl();

build_sfl();

endif;

end-proc;

//------------------------------------------------------------

References:

20 comments:

UnknownNovember 30, 2016 at 5:33 AM
Nice to see an SQL based example.

Any reason though why you did not use LikeRec to define the dsp_fields DS rather than define it manually.
AnonymousDecember 1, 2016 at 9:22 AM
1. Why are you not using a multiple row Fetch to load the subfile, rather than Fetching one row at a time?

2. Why do people still write "page at a time" subfiles? When you use the multiple row fetch it is almost at fast to have a "load all".

As you have already mention articles by rpgpgm.com I think a link to one more would help explain what I mean.
http://www.rpgpgm.com/2016/11/creating-program-to-show-jobs-in.html
UnknownDecember 3, 2016 at 9:32 PM
Nice example Poorna. It gave me ideas .. thanks
https://ca.linkedin.com/in/jeanclaudedurce
AnonymousDecember 4, 2016 at 2:23 AM
I agree with you Jon..it's really a case of when to use load all vs page at once when it comes to business applications. However it is good to know the page at once technique when it is needed. I have seen business application written with "surely the page size will not go over the limit" mind set but get bitten by it over the years when the data set has grown. May be the reasons are case of not archiving old data etc but it happens sometimes and when it does you have to revert back to page at once approach.
Regards,
Lal
UnknownDecember 4, 2016 at 11:34 PM
One technique that I have used in the past (and is even easier with the size increases of V6) is to use a "load all" approach - but to store the subfile record images in memory. Makes it trivial to add sorting capability to the subfile and doesn't suffer from the "where did that record go?" phenomena that can confuse the heck out of end-users when SQL queries are re-done to achieve a different sequence.
VivoPavaroloDecember 5, 2016 at 12:46 PM
I'm a little confused on what you are discussing about... I think this is not the "classic" page-at-a-time sfl, as the program is managing both page dwn AND page ups requests. Nice example Poorna!
Poorna SanjeewaDecember 6, 2016 at 8:25 PM
Thank you very much for your ideas and comments. There are things that I can do to improve performance of this subfile. I have got some other tips in the Linkedin groups(link1,link2) as well. The 'load all' method is easy. I wanted to try the hard way. That's why I wrote this 'page at a time' subfile.

Your comments are so informative and there are so many things to learn. That's what I want to see in this tech blog. Thanks guys!
Harish JDecember 8, 2016 at 10:42 PM
Very Much Helpful. Thanks for Posting this :)
AVROHOMNJanuary 15, 2017 at 2:37 PM
What's the point? Is it easier to code? more readble? more structured? more object oriented?
UnknownJanuary 15, 2017 at 10:19 PM
Perhaps because a subfile represents a set of data and that is where SQL shines.

But surely it was intended as a demonstration of how SQL can be used in subfile operations. It needs no more "point" than that.
AnonymousMarch 4, 2018 at 7:10 PM
Just a quick msg, tried your program with an empty customerfile. Gave a CPF error "cursor c1 not open".
Otherwise a very interesting program, I copied it for my reference.
AnonymousOctober 22, 2018 at 8:30 PM
Poorna...Beautiful program. Thank you for coming up with this elegant way to work with subfiles. The only comment that I have is that the code does not handle an empty subfile. Easy fix though. Very nice style. Congrats.
micDecember 9, 2020 at 12:09 PM
Hello.
This is a very good example.
If you have this program with add and update?
Thanks, Mic
NibiMarch 12, 2021 at 3:57 PM
Hi.. This code is really helpful.. Thanks!

It is all about IBM i

Pages

Sunday, November 27, 2016

How to create a Subfile program without using any native I/O operations.

20 comments: