IBMi (AS400) fans only ‘ Rpg Free: Create a Window to display a very long program message




#IBMiSample





I'm tired of one-line messages. Too short. The average user needs clear and comprehensive messages.
Then I need a large enough window to display a clear and complete message.

Why not use a SUBFILE?
A SUBFILE program can handle a list of many lines, a clear and complete message is just a list of many text lines!

Here's how I did it

I need a table that contains the messages.
                         
--                                                 
--  RUNSQLSTM SRCFILE(VDOTEST1/QSOURCE) SRCMBR(W03AM00F)
--                                                 
CREATE TABLE VDOTEST1/W03AM00F (                   
W3FANN CHARACTER(1) NOT NULL WITH DEFAULT,         
W3TPMS CHARACTER(6) NOT NULL WITH DEFAULT,         
W3COD0 NUMERIC(4, 0) NOT NULL WITH DEFAULT,        
W3RIG0 NUMERIC(2, 0) NOT NULL WITH DEFAULT,        
W3TXT0 CHARACTER(078) NOT NULL WITH DEFAULT        
)                                                  
RCDFMT W03AM                                       
;                                                  


Let's populate the table:

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)
values ('INFO',0001,01,'Program message 0001 row 01')         

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)
values ('INFO',0001,02,'Program message 0001 row 02') 

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)
values ('INFO',0001,03,'Program message 0001 row 03')         

...
...
... we suppose the text is very long...

INSERT INTO VDOTEST1/W03AM00F (W3TPMS, W3COD0, W3RIG0, W3TXT0)
values ('INFO',0001,21,'Program message 0001 row 21')

Now let's build the window.

Here is the Display file:

W03A00FM.DSPF

                                            DSPSIZ(*DS4)                        
                                            CHGINPDFT(CS UL HI)                 
                                            INDARA                              
                                            CA03(03 'F3=Exit')                  
                                            REF(W03AM00F)                       
      *-------------------------------------------------------------------------
                R SFL1                      SFL                                 
      *-------------------------------------------------------------------------
                  S1TXT0    R   78      1  1REFFLD(W3TXT0) DSPATR(HI)           
      *-------------------------------------------------------------------------
                R FMT01                     SFLCTL(SFL1)                        
      *-------------------------------------------------------------------------
                                            SFLPAG(0010)                        
                                            SFLSIZ(&NBRRECS)                    
                                            OVERLAY                             
       N50                                  SFLDSP  SFLDSPCTL                   
        50                                  SFLCLR                              
        91                                  SFLEND(*MORE)                       
                                            WINDOW(6 5 12 78)                   
                                            WDWTITLE((*TEXT 'Program message')) 
                                            WDWTITLE((*TEXT 'Press F3 to
                                            continue') *BOTTOM)         
                  SF1NUM         4S 0H                                  
                  NBRRECS        5S 0P                                  


Here is the SQLRPGLE source:


W03A00.SQLRPGLE

      **FREE                                                       
       ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no);
                                                                   
       dcl-f W03A00FM workstn indds(Dspf) sfile(SFL1 : SF1NUM);    
                                                                   
       dcl-c MaxSFLrec 0100 ;                                      
                                                                   
       dcl-s ReLoadSFL  ind          inz(*on)    ;                 
                                                                   
       dcl-ds Dspf qualified ;                                     
         Exit            ind pos(03) inz(*off)   ;                 
         SflClr          ind pos(50) inz(*off)   ;                 
         SflEnd          ind pos(91) inz(*off)   ;                 
       end-ds ;                                                    
                                                                   
       dcl-ds RecordDs;                                            
         W3COD0 zoned(004);                                        
         W3RIG0 zoned(002);                                        
         W3TXT0  char(078);                                        
       end-ds;                                                                
                                                                              
       dcl-pi W03A00 ;                                                        
         pW3COD0 like(W3COD0);                                                
       end-pi ;                                                               
                                                                              
       // Both "exec sql" is not executed but needed at compile time.         
       // It must be placed just after the last "dcl" declaration.            
       // LANGIDSHR defines the sort sequence as a "shared-weight sort table",
       // upper/lower insensitive, special characters are treated             
       // "{" as "A"                                                          
       // "]" as "E" and so on.                                               
       exec sql set option Commit = *None;                                    
       exec sql set option SRTSEQ = *LANGIDSHR;                               
       // preapre the data recordset                                          
       exec sql declare C1 cursor for                                         
         select                                                               
           W3COD0,                                                            
           W3RIG0,                                                            
           W3TXT0                                                             
         from W03AM00F                                                        
         where      W3COD0 = :pW3COD0                                         
         order by   W3COD0, W3RIG0                                            
         for read only;                                                       
       //*********************************************************************
       // Start working...                                                    
       //*********************************************************************
       pW3COD0 = pW3COD0;                                                     
       ReLoadSFL = *on;                                                       
       dow Dspf.Exit = *off;                                                  
         if ReLoadSFL;                                                        
           LoadSFL();                                                         
         endif;                                                               
         exfmt FMT01;                                                         
         select;                                                              
         when Dspf.Exit;              // F3=Exit                              
           leave;                                                             
      // call a program or a subroutine                                       
         other; // Read user options                                          
         endsl;                                                               
       enddo;                                                                 
       exec sql close C1;                                                     
       *inlr = *on;                                                           
       //*********************************************************************
       dcl-proc LoadSFL; // Load subfile                                      
       //*********************************************************************
         ReLoadSFL = *off;                                                    
         // Clear subfile                                                     
         Dspf.SflClr = *on;                                                   
         write FMT01;                                                         
         Dspf.SflClr = *off;                                                  
         // Load SFL                                                          
         SF1NUM = *zero;                                                      
         exec sql close C1;                                                   
         exec sql open C1;                                                    
         // Read recordset                                                    
         dow Sqlcode = 0 and SF1NUM < MaxSFLrec;                              
           exec sql fetch C1 into :RecordDS;                                  
           if sqlcode = 0;                                                    
             S1TXT0 = W3TXT0;                                                 
             SF1NUM += 1;                     
             write SFL1;                      
           else;                              
             Dspf.SflEnd = *on; // SFLEND *END
           endif;                             
         enddo;                               
                                              
         NBRRECS = SF1NUM;                    
                                              
         if NBRRECS = 0;                      
           clear SFL1;                        
           SF1NUM += 1;                       
           write SFL1;                        
         endif;                               
                                              
       end-proc;



Now I call the program to display all the Message 1 rows:

CALL PGM(w03a00) PARM('0001')                              













That's it!


I appreciate all the comments made on this blog.

Comments

Popular posts from this blog

IBMi (AS400) fans only ‘ Memories (IBM Coding Forms)

IBM i (AS400) fans only ' How to read a TXT file in the IFS with SQL