RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

Create an iSeries screen on the fly Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   

This code snippet creates the iSeries screen on the fly. For example, during run time when you call this program, it uses the IBM supplied Dynamic Screen API's. This is just the starting point for everyone to develop on DSMs.

 
  
0001.00
 
0002.00      FEMPPF     IF   E           K DISK
0003.00 
0004.00       * Function Keys
0005.00      D F_HELP          C                   X'31'       F1 - KEY                                    
0006.00      D F_EXIT          C                   X'33'       F3 - KEY                                    
0007.00
0008.00       * Program Constants
0009.00      D TEMP            C                   X'20'
0010.00      D TEMP1           C                   X'00'
0011.00      D C_HEAD          C                   CONST('EMPLOYEE DETAILS')                                                        
0012.00
0013.00       * Work Variables
0014.00      D HEADTEXT        S            128A
0015.00      D WSTEXT          S            128A
0016.00      D WSEMPNO         S                   LIKE(EMPNO)
0017.00      D WSEMPNAM        S                   LIKE(EMPNAM)
0018.00      D WSEMPSEX        S                   LIKE(EMPSEX)
0019.00      D WSEMPAGE        S                   LIKE(EMPAGE)
0020.00      D WSEMPADDR1      S                   LIKE(EMPADDR1)
0021.00      D WSEMPADDR2      S                   LIKE(EMPADDR2)
0022.00      D WSEMPSTATE      S                   LIKE(EMPSTATE)
0023.00      D WSEMPADDR       S             55A
0024.00      D TEXTLENGTH      S              9B 0 INZ(32)
0025.00      D ROW             S              9B 0 INZ
0026.00      D COLUMN          S              9B 0 INZ
0027.00      D ROWCNT          S              9  0 INZ(6)
0028.00      D COL3            S              9  0 INZ(3)
0029.00      D COL7            S              9  0 INZ(7)
0030.00      D COL16           S              9  0 INZ(16)
0031.00      D COL26           S              9  0 INZ(26)
0032.00      D COL32           S              9  0 INZ(32)
0033.00      D COL35           S              9  0 INZ(35)
0034.00      D COL70           S              9  0 INZ(70)
0035.00      D ERROR           S              8    INZ(x'0000000000000000')  
0036.00      D AID             S              1
0037.00      D LINES           S              9B 0 inz(1)
0038.00      D WF1             S              1
0039.00      D SCREEN          S              9B 0
0040.00
0041.00       * API to clear the screen
0042.00      D CLRSCREEN       PR             9B 0 EXTPROC('QsnClrScr')
0043.00      D  MODE                          1A   OPTIONS(*NOPASS)
                                                   CONST               MODE                          
0044.00      D  CMDBUFHNDLE                   9B 0 OPTIONS(*NOPASS)
                                                   CONST               COMMAND BUFFER HANDLE         
0045.00      D  LOWLVLENV                     9B 0 OPTIONS(*NOPASS)
                                                   CONST               LOW LEVEL ENVIRONMENT         
0046.00      D  ERRCDE                        8A   OPTIONS(*NOPASS)    ERROR CODE                    
0047.00
0048.00       * API to write data to the screen
0049.00      D WRTDATA         PR             9B 0 EXTPROC('QsnWrtDta')
0050.00      D  DATA                        128                        DATA TO BE WRITTEN            
0051.00      D  DATALEN                       9B 0                     LENGTH OF THE DATA            
0052.00      D  FEILDID                       9B 0 OPTIONS(*NOPASS)
                                                   CONST               FIELD ID                      
0053.00      D  ROW                           9B 0 OPTIONS(*NOPASS)
                                                   CONST               ROW                           
0054.00      D  COLUMN                        9B 0 OPTIONS(*NOPASS)
                                                   CONST               COLUMN                        
0055.00      D  STRMATR                       1A   OPTIONS(*NOPASS)
                                                   CONST               STARTING MONOCHROME ATTRIBUTE 
0056.00      D  ENDMATR                       1A   OPTIONS(*NOPASS)
                                                   CONST               ENDING MONOCHROME ATTRIBUTE   
0057.00      D  STRCOLATR                     1A   OPTIONS(*NOPASS)
                                                   CONST               STARTING COLOR ATTRIBUTE      
0058.00      D  ENDCOLATR                     1A   OPTIONS(*NOPASS)
                                                   CONST               ENDING COLOR ATTRIBUTE        
0059.00      D  CMDBUFHNDLE                   9B 0 OPTIONS(*NOPASS)
                                                   CONST               COMMAND BUFFER HANDLE
0060.00      D  LOWLVLENV                     9B 0 OPTIONS(*NOPASS)
                                                   CONST               LOW LEVEL ENVIRONMENT  
0061.00      D  ERRCDE                        8A   OPTIONS(*NOPASS)    ERROR CODE             
0062.00
0063.00      D GetAID          PR             1A   EXTPROC('QsnGetAID')
0064.00      D  AID                           1A   OPTIONS(*NOPASS)
0065.00      D  ENV                           9B 0 OPTIONS(*NOPASS)
                                                                        CONST               LOW LEVEL ENVIRONMENT  
0066.00      D  ERRCDE                        8A   OPTIONS(*NOPASS)     ERROR CODE             
0067.00
0068.00      D RollUp          PR             9B 0 EXTPROC('QsnRollUp')
0069.00      D  LINES                         9B 0
                                                   CONST                                      
0070.00      D  TOP                           9B 0
                                                   CONST                                      
0071.00      D  BOTTOM                        9B 0
                                                   CONST                                      
0072.00      D  CMDBUFHNDLE                   9B 0 OPTIONS(*NOPASS)
                                                   CONST               COMMAND BUFFER HANDLE  
0073.00      D  LOWLVLENV                     9B 0 OPTIONS(*NOPASS)
                                                   CONST               LOW LEVEL ENVIRONMENT  
0074.00      D  ERRCDE                        8    OPTIONS(*NOPASS)    ERROR CODE             
0075.00
0076.00
********************************************************************
0077.00
0078.00       *Clear Screen Subroutine
0079.00      C                   EXSR      CLRSCR
0080.00       *Subroutine to write the Screen Headings
0081.00      C                   EXSR      HEADSR
0082.00       *Subroutine to write the Screen Footer
0083.00      C                   EXSR      FOOTSR
0084.00       *Subroutine to write the Data
0085.00      C                   EXSR      WRTDTASR
0086.00
0087.00      C                   EVAL      *INLR = *ON
0088.00      C                   RETURN
0089.00
0090.00
********************************************************************  
0091.00       * Clear Screen Subroutine
0092.00      C     CLRSCR        BEGSR
0093.00
0094.00       * Call the CLRSCR procedure to clear the screen initially
0095.00       * The values passed are
0096.00       * Mode = 4, Set the screen to 27 * 132 mode
0097.00       * Command Buffer Handle = 0, Screen is cleared immediatly
0098.00       * Low Level Environment = 0, Default low level environment is used    
0099.00       * Error Code - To store the return error code
0100.00      C                   EVAL      SCREEN = CLRSCREEN('4' : 0 : 0 : ERROR)      
0101.00
0102.00      C     CLRSCRE       ENDSR
0103.00
0104.00
********************************************************************
0105.00
0106.00
********************************************************************
0107.00       * Subroutine to write the Headings
0108.00      C     HEADSR        BEGSR
0109.00       *Write the Screen Heading for the first time
0110.00      C                   EVAL      HEADTEXT = C_HEAD
0111.00      C                   EVAL      ROW = 2
0112.00      C                   EVAL      COLUMN = 25
0113.00      C                   EXSR      WRTHEADSR
0114.00
0115.00      C                   EVAL      HEADTEXT = '================'
0116.00      C                   EVAL      ROW = 3
0117.00      C                   EVAL      COLUMN = 25
0118.00      C                   EXSR      WRTHEADSR
0119.00
0120.00       *Write the Column Heading                               
0121.00      C                   EVAL      HEADTEXT = 'EMP NAME'      
0122.00      C                   EVAL      ROW = 4                    
0123.00      C                   EVAL      COLUMN = 3                 
0124.00      C                   EXSR      WRTHEADSR                  
0125.00                                                               
0126.00      C                   EVAL      HEADTEXT = '==========='   
0127.00      C                   EVAL      ROW = 5                    
0128.00      C                   EVAL      COLUMN = 3                 
0129.00      C                   EXSR      WRTHEADSR                  
0130.00                                                               
0131.00      C                   EVAL      HEADTEXT = 'EMP SEX'       
0132.00      C                   EVAL      ROW = 4                    
0133.00      C                   EVAL      COLUMN = 16                
0134.00      C                   EXSR      WRTHEADSR                  
0135.00                                                               
0136.00      C                   EVAL      HEADTEXT = '==========='   
0137.00      C                   EVAL      ROW = 5                    
0138.00      C                   EVAL      COLUMN = 16                
0139.00      C                   EXSR      WRTHEADSR                  
0140.00
0141.00      C                   EVAL      HEADTEXT = 'EMP ADDRESS'
0142.00      C                   EVAL      ROW = 4 
0143.00      C                   EVAL      COLUMN = 32
0144.00      C                   EXSR      WRTHEADSR
0145.00
0146.00      C                   EVAL      HEADTEXT = '==========='
0147.00      C                   EVAL      ROW = 5
0148.00      C                   EVAL      COLUMN = 32
0149.00      C                   EXSR      WRTHEADSR
0150.00
0151.00      C                   EVAL      HEADTEXT = 'EMP STATE'
0152.00      C                   EVAL      ROW = 4
0153.00      C                   EVAL      COLUMN = 70
0154.00      C                   EXSR      WRTHEADSR
0155.00
0156.00      C                   EVAL      HEADTEXT = '========='
0157.00      C                   EVAL      ROW = 5
0158.00      C                   EVAL      COLUMN = 70
0159.00      C                   EXSR      WRTHEADSR
0160.00
0161.00      C     HEADSRE       ENDSR
0162.00
0163.00
********************************************************************
0164.00
0165.00
********************************************************************
0166.00       * Subroutine to write the Screen Footer
0167.00      C     FOOTSR        BEGSR
0168.00      C                   EVAL      HEADTEXT = 'F1-Help'
0169.00      C                   EVAL      ROW = 25
0170.00      C                   EVAL      COLUMN = 5
0171.00      C                   EVAL      SCREEN = WRTDATA(HEADTEXT:TEXTLENGTH:0:ROW:  
0172.00      C                                      COLUMN:TEMP:TEMP:TEMP:TEMP:0:0:ERROR)        
0173.00
0174.00      C                   EVAL      HEADTEXT = 'F3-Exit'
0175.00      C                   EVAL      ROW = 25
0176.00      C                   EVAL      COLUMN = 17
0177.00      C                   EVAL      SCREEN = WRTDATA(HEADTEXT:TEXTLENGTH:0:ROW:  
0178.00      C                                      COLUMN:TEMP:TEMP:TEMP:TEMP:0:0:ERROR)        
0179.00
0180.00      C                   EVAL      HEADTEXT = 'F6-Add'
0181.00      C                   EVAL      ROW = 25
0182.00      C                   EVAL      COLUMN = 31
0183.00      C                   EVAL      SCREEN = WRTDATA(HEADTEXT:TEXTLENGTH:0:ROW:  
0184.00      C                                      COLUMN:TEMP:TEMP:TEMP:TEMP:0:0:ERROR)        
0185.00
0186.00      C     FOOTSRE       ENDSR
0187.00
0188.00
********************************************************************
0189.00
0190.00
********************************************************************
0191.00       * Subroutine to write the Data
0192.00      C     WRTDTASR      BEGSR
0193.00
0194.00      C                   READ      EMPR                  90    
0195.00      C                   DOW       *IN90 = *OFF
0196.00
0197.00      C                   EVAL      WSTEXT = EMPNAM
0198.00      C                   EVAL      TEXTLENGTH = %LEN(EMPNAM)
0199.00      C                   EVAL      ROW = ROWCNT
0200.00      C                   EVAL      COLUMN = COL3
0201.00      C                   EXSR      DATASR
020.00
0203.00      C                   EVAL      WSTEXT = EMPSEX
0204.00      C                   EVAL      TEXTLENGTH = %LEN(EMPSEX)
0205.00      C                   EVAL      ROW = ROWCNT
0206.00      C                   EVAL      COLUMN = COL16
0207.00      C                   EXSR      DATASR
0208.00
0209.00      C                   EVAL      WSEMPADDR1 = EMPADDR1
0210.00      C                   EVAL      WSEMPADDR2 = EMPADDR2
0211.00      C                   EVAL      WSEMPADDR = WSEMPADDR1 + WSEMPADDR2    
0212.00      C                   EVAL      WSTEXT = WSEMPADDR
0213.00      C                   EVAL      TEXTLENGTH = %LEN(WSEMPADDR)
0214.00      C                   EVAL      ROW = ROWCNT
0215.00      C                   EVAL      COLUMN = COL32
0216.00      C                   EXSR      DATASR
0217.00
0218.00      C                   EVAL      WSTEXT = EMPSTATE
0219.00      C                   EVAL      TEXTLENGTH = %LEN(EMPSTATE)
0220.00      C                   EVAL      ROW = ROWCNT
0221.00      C                   EVAL      COLUMN = COL70
0222.00      C                   EXSR      DATASR
0223.00
0224.00      C                   READ      EMPR              90       


0225.00      C                   EVAL      ROWCNT = ROWCNT + 1
0226.00      C                   ENDDO
0227.00      C*                  EVAL      SCREEN = ROLLUP(LINES:1:24:0:0:ERROR)           
0228.00
0229.00      C                   EVAL      WF1 = GETAID (AID : 0 : ERROR)                  
0230.00      C                   IF        AID = F_EXIT
0231.00      C                   EVAL      *INLR = *ON
0232.00      C                   ENDIF
0233.00
0234.00      C     WRTDTASRE     ENDSR
0235.00
0236.00
********************************************************************
0237.00       * Subroutine to write the Data
0238.00      C     DATASR        BEGSR
0239.00
0240.00      C                   EVAL      SCREEN = WRTDATA(WSTEXT:TEXTLENGTH:0:ROW:    
0241.00      C                                      COLUMN:TEMP:TEMP:TEMP:TEMP:0:0:ERROR)        
0242.00
0243.00       *Clear the work variables
0244.00      C                   MOVE      *ZEROS        TEXTLENGTH
024500       C                   MOVE      *ZEROS        WSEMPNO
0246.00      C                   MOVE      *BLANKS       WSTEXT
0247.00      C                   MOVE      *BLANKS       WSEMPADDR1
0248.00      C                   MOVE      *BLANKS       WSEMPADDR2
0249.00      C                   MOVE      *BLANKS       WSEMPADDR
0250.00      C                   MOVE      *BLANKS       WSEMPSTATE
0251.00      C                   MOVE      *BLANKS       WSEMPNAM
0252.00      C                   MOVE      *BLANKS       WSEMPSEX
0253.00
0254.00      C     DATASRE       ENDSR
025.00
0256.00
*******************************************************************
0257.00
********************************************************************
0258.00       * Subroutine to write the Headers
0259.00      C     WRTHEADSR     BEGSR
0260.00
0261.00      C                   EVAL      SCREEN = WRTDATA(HEADTEXT:TEXTLENGTH:0:ROW:            
0262.00      C                                      COLUMN:TEMP:TEMP:TEMP:TEMP:0:0:ERROR)                  
0263.00      C                   EVAL      HEADTEXT = *BLANKS
0264.00
0265.00      C     WRTHEADSRE    ENDSR
0266.00
        ****************** End of data
***********************************************************
        
  EMPPF - Physical File
 
0001.00      A                                      UNIQUE
0002.00      A          R EMPR                            
0003.00      A            EMPNO          5P 0             
0004.00      A            EMPNAM        20A               
0005.00      A            EMPSEX         1A               
0006.00      A            EMPAGE         3P 0             
0007.00      A            EMPADDR1      25A               
0008.00      A            EMPADDR2      25A               
0009.00      A            EMPSTATE      10A               
0010.00      A          K EMPNO                                   
  
 
<Previous   Next>