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.
To clear subfile, we can use 'QsnClrScr' API.
To write data to the display file we can use 'QsnWrtDta' API.
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
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment