Pages

Sunday, November 27, 2016

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. 

Subfile

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

  1. There are no any native I/O operations, It’s just SQL.
  2. 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:

18 comments:

  1. 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.

    ReplyDelete
    Replies
    1. Jon, thanks for your comment. Because LIKEREC is a QUALIFIED data structure, I can't use it with SQL as "exec sql fetch next from c1 into :dsp_fields". Then I have to mention each qualified field separately after the into statement. Am I wrong? or do you have any solution for that?

      Delete
    2. LIkeRec was a bad choice I guess but you could have externally described it surely. Maybe I'm just out of touch I've written mostly web stuff over the last few years - can't recall the last time I actually wrote a green-screen subfile program.

      Delete
    3. Jon, IBMi + web interfaces are very rare thing in my country (unfortunately) and a thing that I would love to work with. I'm doing my own experiments with JAVA and some other techs. I hope to share some in the future.

      Delete
  2. 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

    ReplyDelete
    Replies
    1. To answer your question/comment re. 2 above.. if you have a large database to display in subfile the RRN restriction if 9999 will bite you. Page at once is the safer and more reliable option for business applications

      Regards,
      Lal

      Delete
    2. I agree about the RRN issues potentially being an issue. But there are too many real world situations where the number of rows will never get that high. Consequently I can't agree with a blanket approach that says to never use load all subfiles. They are so much simpler to handle and more efficient than page at a time. Use the right tool for the job says I.

      Delete
    3. Yeah! I should have used multiple row fetch! Thanks for the link.

      Delete
  3. Nice example Poorna. It gave me ideas .. thanks
    https://ca.linkedin.com/in/jeanclaudedurce

    ReplyDelete
  4. 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

    ReplyDelete
  5. 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.

    ReplyDelete
  6. 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!

    ReplyDelete
  7. 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!

    ReplyDelete
  8. Very Much Helpful. Thanks for Posting this :)

    ReplyDelete
  9. What's the point? Is it easier to code? more readble? more structured? more object oriented?

    ReplyDelete
  10. 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.

    ReplyDelete
  11. 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.

    ReplyDelete
  12. 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.

    ReplyDelete