Create an iSeries screen on the fly

This code snippet creates the iSeries screen on the fly.

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

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

0245.00      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

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

This was first published in April 2005

Dig deeper on Imaging on iSeries

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close