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

By -



#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

Post a Comment

Popular posts from this blog

(IBM i fans only) Efficient WRKSPLF with WSF - How to Search string into spooled files, Sort, and Generate PDFs on IBMi

By -
Image
Searching Spooled Files Made Easy: A Unique Solution Managing spooled files efficiently is crucial for users dealing with numerous rows of print data. IBM's WRKSPLF command provides a standard way to interact with spooled files, but it lacks certain features that can significantly enhance user experience. In this article, we'll delve into a powerful functionality that IBM doesn't offer — the ability to search among spooled file lists. Our goal is to highlight the advantages of this capability and introduce a practical solution. The Limitations of Standard WRKSPLF While the WRKSPLF command is a handy tool for working with spooled files, it falls short in certain aspects. One prominent limitation is the inability to search efficiently through the list of spooled file rows. Users often find it challenging to quickly locate specific files based on criteria like creation date, status, or content. Introducing a Unique Solution: WSF (WorkSpooledFiles) To address the limitations of...
Read more

(IBM i fans only) Detecting and Handling Non-Printable Characters in DB2 SQL Using LOCATE() and REPLACE() Functions

By -
Image
When working with DB2 SQL on the IBMi platform, one of the challenges we might encounter is dealing with non-printable characters in our data. These are characters that don't have a direct representation on a standard keyboard and can cause display programs to crash if not handled properly. For this example, we'll be working with the CLANA00F file, which contains customer data. You can find details on how to create this file on my blog post here . Non-printable characters can sneak into our records for various reasons, and to prevent issues, we can run an SQL query that uses the LOCATE() function. This function returns the position of the first occurrence of a substring within a string, allowing us to detect these problematic characters. Suppose we have a customer name with a non-printable character, specifically the EBCDIC '0D' character, which corresponds to the "Carriage Return" (CR) control character in ASCII. To find this character in our records, we can ...
Read more

(IBM i fans only) How to Sniff User Access

By -
Image
If you need to monitor user access on your IBM i system, you can use SQL to query the history log. Note: At the end of this post, you'll find a request directly addressed to you, the readers. Here’s a simple example of how you can do this: SELECT MESSAGE_ID,        MESSAGE_TIMESTAMP,        FROM_USER,        MESSAGE_TEXT     FROM TABLE (             QSYS2.HISTORY_LOG_INFO()         )     WHERE message_id IN ('CPF1164', 'CPF1124')           AND FROM_USER IN ('QSECOFR', 'QSYS', 'QSYSOPR')     ORDER BY MESSAGE_TIMESTAMP In this query: - QSYS2.HISTORY_LOG_INFO(): This function retrieves information from the history log. -  message_id IN ('CPF1164', 'CPF1124') : Filters the results to include only specific message IDs, which indicate sign-on and sign-off events. - FROM_USER in ('QSECOFR', 'QSYS', 'QSYSOPR'): Filters the resu...
Read more