Ü DATA STRUCTURE
§ Data structure in general means a
structure of different data type.
§ Data structure is specified in
the Input Specification of an RPG 3 Program whereas in RPG 1V we specify it in
'D' specification.
§ Data Structure is used-
1. To break fields into
subfields
2. To Group fields
3. To change the
format of the field
4. To Group
non-contiguous data into contiguous format
5.To
convert data.
Example
1.
Using a data structure to break fields
In the below example we are breaking CURTIMDATE into different subfields CURRYEAR, CURRMONTH & CURRDAY.
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> TIMEDS
FMT * *. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
*************** Beginning of data ****************************************************
0001.00
0002.00 DCURTIMSTP DS
0003.00 DCURTIMDATE 1 8S 0
0004.00 DCURRYEAR 1 4S 0
0005.00 DCURRMONTH 5 6S 0
0006.00 DCURRDAY 7 8S 0
0007.00 DCURRHRS 9 10S 0
0008.00 DCURRMINS 11 12S 0
0009.00 DCURRSECS 13 16S 0
0010.00
0011.00 Dtime_is S z
0012.00 Dtime_isO S 20
0013.00
0014.00 * CALCULATE THE TIME FOR THE CURRENT SYSTEM DATE
0015.00 C EVAL TIME_IS=%TIMESTAMP()
0016.00 C EVAL TIME_ISO=%char(TIME_IS:*iso0)
0017.00 C EVAL CURRYEAR=%dec(%SUBST(TIMe_ISo:1:4):4:0)
0018.00 C EVAL CURRMONTH=%dec(%SUBST(TIMe_ISo:5:2):2:0)
0019.00 C EVAL CURRDAY=%dec(%SUBST(TIMe_ISo:7:2):2:0)
0020.00 C EVAL CURRHRS=%dec(%SUBST(TIMe_ISo:9:2):2:0)
0021.00 C EVAL CURRMINS=%dec(%SUBST(TIMe_ISo:11:2):2:0)
0022.00 C EVAL CURRSECS=%dec(%SUBST(TIMe_ISo:13:4):4:0)
0023.00 C CURTIMSTP DSPLY
0024.00 C CURTIMDATE DSPLY
0025.00 C CURRYEAR DSPLY
0026.00 C CURRMONTH DSPLY
0027.00 C CURRDAY DSPLY
0028.00 C CURRHRS DSPLY
0029.00 C CURRMINS DSPLY
0030.00 C CURRSECS DSPLY
0031.00 C SETON LR
****************** End of data *******************************************************
OUTPUT
2003405802
20
2013
1
21
3
40
5802
(2) Using a data
structure to group fields
In the example below fields YY, FILLER1,
MM, FILLER2, DD have been used to make a
single field OPN.
Columns . . . : 6 100 Browse IROBO1/QRPGLESRC
SEU==> DS_GROUP
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords++++++++++++++++++++Comments+++++++++
*************** Beginning of data ****************************************************
0001.00 DOPN DS
0002.00 DYY 4A
0003.00 DFILLER1 1A INZ('-')
0004.00 DMM 2A
0005.00 DFILLER2 1A INZ('-')
0006.00 DDD 2A
0007.00 C EVAL YY=%CHAR(2012)
0008.00 C EVAL MM=%CHAR(10)
0009.00 C EVAL DD=%CHAR(15)
0010.00 C OPN DSPLY
0011.00 C SETON LR
****************** End of data *******************************************************
OUTPUT
Ü
Types
of data structures in as/400:
I.
program described data structure
II.
EXTERNALLY DESCRIBED DATASTRUCTURE
III.
MULTIPLE OCCURENCE DATASTRUCTURE
IV.
INDICATOR DATA STRUCTURE
V.
DATA AREA DATA STRUCTURE (SPECIFIED IN 'U')
VI.
PROGRAMME STATUS DATASTRUCTURE (SPECIFIED IN 'S')
VII.
FILE INFORMATION DATASTRUCTURE
I.
Externally
described data structure
In
externally described data structure the structure of the data structure is
decided by the external definition used in the program. e.g. In the program
below file CUST has been used as a referenced external definition for the data
structure DS1. Also the data structure has further been modified with the
prefix ‘P’.
Physical file used in the program = CUST
Columns . . . : 1 80 Browse AMIT/QRPGLESRC
SEU==> CUST
FMT PF .....A..........T.Name++++++RLen++TDpB......Functions++++++++++++++++++++++++
*************** Beginning of data ***************************************************
0001.00
0002.00 A R CUSTR
0003.00 A CSNBR 6A
0004.00 A CSNAME 10A
0005.00 A CS#OPN 5P 0
0006.00 A CS$OPN 10P 2
****************** End of data ******************************************************
Columns . . . : 6 80 Edit AMITCC/QRPGLESRC
SEU==> PREFIXDS
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DDS1 E DS EXTNAME(CUST)
0002.00 D PREFIX(P_)
0003.00 C EVAL P_CSNBR='100001'
0004.00 C EVAL P_CSNAME='AMINEM'
0005.00 C EVAL P_CS#OPN=1001
0006.00 C EVAL P_CS$OPN=1000001.11
0007.00 C DS1 DSPLY
0008.00 C SETON LR
****************** End of data *******************************************************
Below
is the compiler source listing of the above program. The data structure used in
the program has got its subfield converted into the structure shown below.
S o u r c e L i s t i n g
DDS1 E DS EXTNAME(CUST)
D PREFIX(P_)
*-----------------------------------------------------------------------------------------*
* Data structure . . . . . . : DS1 *
* Prefix . . . . . . . . . . : P_ : 0 *
* External format . . . . . : CUSTR : AMIT/CUST *
*-----------------------------------------------------------------------------------------*
D P_CSNBR 6A EXTFLD (CSNBR) >>>>>>>>>>>>>>>>>
D P_CSNAME 10A EXTFLD (CSNAME) >>>>>>>>>>>>>>>>>
D P_CS#OPN 5P 0 EXTFLD (CS#OPN) >>>>>>>>>>>>>>>>>
D P_CS$OPN 10P 2 EXTFLD (CS$OPN) >>>>>>>>>>>>>>>>>
C EVAL P_CSNBR='100001'
C EVAL P_CSNAME='AMINEM'
C EVAL P_CS#OPN=1001
C EVAL P_CS$OPN=1000001.11
C DS1 DSPLY
C SETON LR----
* * * * * E N D O F S O U R C E * * * * *
The above program can also be coded like
below to give the same structure to DS1 data structure.
Columns . . . : 6 8 Edit AMITCC/QRPGLESRC
SEU==> PREFIXDS
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DDS1 E DS EXTNAME(CUST)
0002.00 DR_CSNBR E EXTFLD(CSNBR)
0003.00 DS_CSNAME E EXTFLD(CSNAME)
0004.00 DT_CS#OPN E EXTFLD(CS#OPN)
0005.00 DU_CS$OPN E EXTFLD(CS$OPN)
0006.00 C EVAL R_CSNBR='100001'
0007.00 C EVAL S_CSNAME='AMINEM'
0008.00 C EVAL T_CS#OPN=1001
0009.00 C EVAL U_CS$OPN=1000001.11
0010.00 C DS1 DSPLY
0011.00 C T_CS#OPN DSPLY
0012.00 C SETON LR
****************** End of data *******************************************************
OUTPUT
100001
AMINEM
1001
1000001.11
II.
Multiple occurrence data structure
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> MULTDS
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 D DS1 DS OCCURS(10) 130118
0002.00 D FLD01 1 5 130130
0003.00 D FLD02 6 10 130130
0004.00 DX S 2 0 INZ(1) 130118
0005.00 DN S 2 0 INZ(1) 130130
0006.00 130118
0007.00 C X DO 5 130130
0008.00 C X OCCUR DS1 N 130130
0009.00 C EVAL FLD01=%char(X) 130130
0010.00 C EVAL FLD02=%char(X) 130130
0011.00 C EVAL X=X+1 130118
0012.00 C DS1 DSPLY 130118
0013.00 C N DSPLY 130130
0014.00 C ENDDO 130118
0015.00 C SETON LR 130118
****************** End of data *******************************************************
OUTPUT
DSPLY 1 1
DSPLY 1
DSPLY 2 2
DSPLY 2
DSPLY 3 3
DSPLY 3
DSPLY 4 4
DSPLY 4
DSPLY 5 5
DSPLY 5
III.
Data area data structure
If the data structure subfield is based on data area
then that type of data structure is called data area data structure.
We create a data area DTA1. Below is the
entry for the data area DTA1.
Display Data Area
System: PUB1
Data area . . . . . . . : DTA1
Library . . . . . . . : QGPL
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 50
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 ' THIS IS SAMPLE DATA STRUCTUR '
Program
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> DTARPG
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DDADS1 UDS DTAARA('DTA1')
0002.00 DFLD1 1 4
0003.00 DFLD2 6 7
0004.00 DFLD3 9 14
0005.00 DFLD4 16 19
0006.00 DFLD5 21 30
0007.00 C IN DADS1 >>>>>> Data area READ operation
0008.00 C FLD1 DSPLY
0009.00 C FLD2 DSPLY
0010.00 C FLD3 DSPLY
0011.00 C FLD4 DSPLY
0012.00 C FLD5 DSPLY
0013.00 C OUT DADS1 >>>>>> Data area WRITE operation
0014.00 C SETON LR
****************** End of data *******************************************************
OUTPUT
THIS
IS
SAMPLE
DATA
STRUCTURE
***Note:
If there is no name of data area data
structure then that is nothing but local data area(*LDA) data structure.
In this case there is no need DTAARA (*LDA)
keyword also we don’t need to handle input/output operation for the data area.
Columns . . . : 6 80 Browse AMIT/QRPGLESRC
SEU==> DTA_LDA
*************** Beginning of data **************************************************
0002.00 D UDS
0003.00 DFLD001 1 50A
0004.00
0005.01 C FLD001 DSPLY
0007.00 C SETON LR
****************** End of data *****************************************************
OUTPUT
DSPLY 01 - Generic Demonstration Company QPRINT QGPL
Other way to declare Local dataarea
data structure is as below:
Columns . . . : 6 80 Browse AMIT/QRPGLESRC
SEU==> DTA_LDA
*************** Beginning of data ****************************************************
0002.00 D DS1 UDS DTAARA(*LDA)
0003.00 DFLD001 1 50A
0004.00
0005.00 C IN DS1
0005.01 C FLD001 DSPLY
0006.00 C OUT DS1
0007.00 C SETON LR
****************** End of data *******************************************************
OUTPUT
DSPLY 01 - Generic Demonstration Company QPRINT QGPL
Ø Explicitly
control the data area LOCK/UNLOCK by removing 'U' during declaration
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> DTARPG
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DDADS1 DS DTAARA('DTA1')
0002.00 DFLD1 1 4
0003.00 DFLD2 6 7
0004.00 DFLD3 9 14
0005.00 DFLD4 16 19
0006.00 DFLD5 21 30
0007.00 C *LOCK IN DADS1
0008.00 C FLD1 DSPLY
0009.00 C FLD2 DSPLY
0010.00 C FLD3 DSPLY
0011.00 C FLD4 DSPLY
0012.00 C FLD5 DSPLY
0013.00 C OUT DADS1
0014.00 C UNLOCK DADS1
0015.00 C SETON LR
****************** End of data *****************************************************
IV.
Indicator data
structure
The indicator data structure is used to rename the
indicators used in our program with the name that is more meaningful and
understanding.
If we want to use indicator data structure in our
program then INDARA is a mandatory keyword in the display file used.
Columns . . . : 1 80 Browse AMITCC/QRPGLESRC
SEU==> RECDSPIND
FMT DP .....AAN01N02N03T.Name++++++RLen++TDpBLinPosFunctions+++++++++++++++++++++++++++
*************** Beginning of data ********************************************************
0001.00 A INDARA >>>> Mandatory keyword
0002.00 A DSPSIZ(24 80 *DS3)
0003.00 A CA03(03)
0004.00 A R RECSFL SFL
0005.00 A S_FLD01 5S 0B 7 20
0006.00 A R RECCTL SFLCTL(RECSFL)
0007.00 A 42 SFLDSPCTL
0008.00 A 41 SFLDSP
0009.00 A 40 SFLCLR
0010.00 A 45 SFLEND(*MORE)
0011.00 A SFLSIZ(9999)
0012.00 A SFLPAG(0010)
0013.00 A RCDNBR 4S 0H SFLRCDNBR(CURSOR)
0014.00 A 1 25'TEST TO CHECK THE BUFFER'
0015.00 A 5 20'FLD01'
****************** End of data ***********************************************************
In the below program below is the alternate
name that we have available for the indicators used in the program;
03 = KEY_EXIT
40 = SFL_CLEAR
41 = SFL_DSP
42 = SFL_DSPCTL
Hence, we can give any meaningful name to
the indicators by using this data structure.
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> REC1100IND
FMT FX FFilename++IPEASF.....L.....A.Device+.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ******************************************************
0001.00 FRECDSPIND CF E WORKSTN SFILE(RECSFL:RRN) INDDS(INDDS1)
0002.00 D P_INDDS1 s * inz(%addr(*in))
0003.00 D INDDS1 ds based(P_INDDS1)
0004.00 D KEY_EXIT 1N overlay(INDDS1:03)
0005.00 D SFL_CLEAR 1N overlay(INDDS1:40)
0006.00 D SFL_DSP 1N overlay(INDDS1:41)
0007.00 D SFL_DSPCTL 1N overlay(INDDS1:42)
0008.00 DI S 5 0
0009.00 DRRN S 5 0
0010.00 C EVAL RCDNBR=9900
0011.00 C DOW KEY_EXIT=*OFF
0012.00 C IF KEY_EXIT=*ON
0013.00 C LEAVE
0014.00 C ENDIF
0015.00 C EXSR CLRSFL
0016.00 C EXSR FILSFL
0017.00 C EXSR DSPSFL
0018.00 C ENDDO
0019.00 C SETON LR
0020.00 *
0021.00 C CLRSFL BEGSR
0022.00 C EVAL SFL_CLEAR=*ON
0023.00 C WRITE RECCTL
0024.00 C EVAL SFL_CLEAR=*OFF
0025.00 C ENDSR
0026.00 *
0027.00 C FILSFL BEGSR
0028.00 C FOR I=0001 BY 1 TO 9900
0029.00 C EVAL RRN=RRN+1
0030.00 C IF RRN>9999
0031.00 C LEAVE
0032.00 C ENDIF
0033.00 C EVAL S_FLD01=I
0034.00 C WRITE RECSFL
0035.00 C ENDFOR
0036.00 C ENDSR
0037.00 *
0038.00 C DSPSFL BEGSR
0039.00 C EVAL SFL_DSP=*ON
0040.00 C EVAL SFL_DSPCTL=*ON
0041.00 C IF RRN<=0
0042.00 C EVAL SFL_DSP=*OFF
0043.00 C ENDIF
0044.00 C EXFMT RECCTL
0045.00 C EVAL SFL_DSP=*OFF
0046.00 C EVAL SFL_DSPCTL=*OFF
0047.00 C ENDSR
****************** End of data *********************************************************
OUTPUT
TEST TO CHECK THE BUFFER
FLD01
9891
9892
9893
9894
9895
9896
9897
9898
9899
9900
More...
V.
QUALIFIED data
structures
By using qualified data structures we can
define same field in different data structures.
We refer to a subfield name by name of the
data structure, then a period, and then the subfield name.
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> DS_QUAL
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DPERSONAL_DETAIL DS QUALIFIED 130225
0002.00 DNAME 10A 130225
0003.00 DSEX 10A 130225
0004.00 DADDR 10A 130225
0005.00 DEMPLOYEE_DETAIL DS QUALIFIED 130225
0006.00 DEMPID 10A 130225
0007.00 DPERSONAL_INFO LIKEDS(PERSONAL_DETAIL) 130225
0008.00 130225
0009.00 /free 130225
0010.00 PERSONAL_DETAIL.NAME='AMINEM'; 130225
0011.00 EMPLOYEE_DETAIL.PERSONAL_INFO.NAME='IROBO'; 130225
0012.00 DSPLY PERSONAL_DETAIL.NAME; 130225
0013.00 DSPLY EMPLOYEE_DETAIL.PERSONAL_INFO.NAME; 130225
0014.00 /end-free 130225
0015.00 C SETON LR 130225
****************** End of data *******************************************************
OUTPUT
DSPLY AMINEM
DSPLY IROBO
>>>>> Using
the same name in different data structure
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> DS_QUAL2
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DPERSONAL_DETAIL DS QUALIFIED 130225
0002.00 DNAME 10A 130225
0003.00 DSEX 10A 130225
0004.00 DADDR 30A 130225
0005.00 DEMPLOYEE_DETAIL DS QUALIFIED 130225
0006.00 DEMPID 10A 130225
0007.00 DNAME 10A 130225
0008.00 DSEX 10A 130225
0009.00 DADDR 22A 130225
0010.00 130225
0011.00 /free 130225
0012.00 PERSONAL_DETAIL.NAME='AMINEM'; 130225
0013.00 PERSONAL_DETAIL.SEX ='MALE'; 130225
0014.00 PERSONAL_DETAIL.ADDR='BICARDI ZONE, LANE NO-5'; 130225
0015.00 EMPLOYEE_DETAIL.EMPID='E0000001'; 130225
0016.00 EMPLOYEE_DETAIL.NAME='ERECA'; 130225
0017.00 EMPLOYEE_DETAIL.SEX='FEMALE'; 130225
0018.00 EMPLOYEE_DETAIL.ADDR='CARGO ROAD,EAST COAST'; 130225
0019.00 DSPLY PERSONAL_DETAIL; 130225
0020.00 DSPLY EMPLOYEE_DETAIL; 130225
0021.00 /end-free 130225
0022.00 C SETON LR 130225
****************** End of data *******************************************************
OUTPUT
DSPLY AMINEM MALE BICARDI ZONE, LANE NO-5
DSPLY E0000001 ERECA FEMALE CARGO ROAD,EAST COAST
Å LIKEDS
keyword
This data
structure keyword is used to inherit any data structure definition to another data
structure to define it.
Example: Using the interface
parameter as data structure
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> OP_EVAL_P4
FMT D DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 DDS0 DS 130201
0002.00 DFLD1 2 0 130201
0003.00 DFLD2 2 0 130201
0004.00 * 130201
0005.00 DCALLP1 PR 130201
0006.00 Dp 2 0 130125
0007.00 Dq 2 0 130125
0008.00 DDS_PARM0 LIKEDS(DS0) 130201
0009.00 C Z-ADD 11 a 2 0 130201
0010.00 C Z-ADD 22 b 2 0 130201
0011.00 * 130125
0012.00 C CALLP CALLP1(a:b:DS0) 130201
0013.00 C DS0 DSPLY 130201
0014.00 C SETON LR 130125
0015.00 * 130125
****************** End of data *******************************************************
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> OP_EVAL_P5
FMT H HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 HNOMAIN 130125
0002.00 DDS1 DS 130201
0003.00 DFLD1 2 0 130201
0004.00 DFLD2 2 0 130201
0005.00 * 130201
0006.00 DCALLP1 PR 130201
0007.00 Dp 2 0 130201
0008.00 Dq 2 0 130201
0009.00 DDS_PARM LIKEDS(DS1) 130201
0010.00 130201
0011.00 130201
0012.00 PCALLP1 B EXPORT 130201
0013.00 DCALLP1 PI 130201
0014.00 Dp 2 0 130201
0015.00 Dq 2 0 130201
0016.00 DDS_PARM LIKEDS(DS1) 130201
0017.00 C EVAL DS_PARM.FLD1=p 130201
0018.00 C EVAL DS_PARM.FLD2=q 130201
0019.00 PCALLP1 E 130201
****************** End of data *******************************************************
OUTPUT
DSPLY 1122
VI.
Program status data
structure
A program
status data structure (PSDS) can be defined to make program exception/error
information available to the program so that the necessary action can be taken
for the unhandled exception. The exception /errors can be Divide by zero, array index out-of-bound, Invalid Date,
Time or Timestamp value. The PSDS must be defined in the main source
section; therefore, there is only one PSDS per module.
We can see all the program/file related system messages
using the command below:
DSPMSGD RANGE(*FIRST *LAST) MSGF(QRNXMSG)
DETAIL(*BASIC)
The below table lists some of the commonly used
Status Codes.
MSG ID MESSAGE DETAIL
00100 Value out of range for string operation
00102 Divide by zero
00112 Invalid Date, Time or Timestamp value.
00121 Array index not valid
00122 OCCUR outside of range
00202 Called program or procedure failed
00211 Error calling program or procedure
00222 Pointer or parameter error
00401 Data area specified on IN/OUT not found
00413 Error on IN/OUT operation
00414 User not authorized to use data area
00415 User not authorized to change data area
00907 Decimal data error (digit or sign not valid)
01021 Tried to write a record that already exists (file being used has unique keys
and key is duplicate, or attempted to write duplicate relative record number to
a subfile).
01211 File not open.
01218 Record already locked.
01221 Update operation attempted without a prior read.
Status codes
*STATUS provides a five-digit
status code that identifies the error. Program status codes are in the range
00100 to 00999 and File status codes are in the range 01000 to 01999. Status
codes in the range 00000 to 00050 are considered to be normal (i.e., they are
not set by an exception/error condition).
Example-I
Columns . . . : 1 80 Edit AMITCC/QRPGLESRC
SEU==> PSDS_PGM
FMT D .....DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
*************** Beginning of data *******************************************************
0001.00 DMYPSDS SDS
0002.00 DPROC_NAME *PROC
0003.00 * Procedure name
0004.00 D PGM_STATUS *STATUS
0005.00 * Status code
0006.00
0007.00 D PRV_STATUS 16 20S 0
0008.00 * Previous status
0009.00
0010.00 D LINE_NUM 21 28
0011.00 * Src list line num
0012.00
0013.00 D ROUTINE *ROUTINE
0014.00 * Routine name
0015.00
0016.00 D PARMS *PARMS
0017.00 * Num passed parms
0018.00 D DATE 191 198
0019.00 * Date (*DATE fmt)
0020.00
0021.00 D YEAR 199 200S 0
0022.00 * Year (*YEAR fmt)
0023.00
0024.00 D LAST_FILE 201 208
0025.00 * Last file used
0026.00
0027.00 D FILE_INFO 209 243
0028.00 * File error info
0029.00
0030.00 D JOB_NAME 244 253
0031.00 * Job name
0032.00
0033.00 D USER 254 263
0034.00 * User name
0035.00
0036.00 D JOB_NUM 264 269S 0
0037.00 D JOB_DATE 270 275S 0
0038.00 * Date (UDATE fmt)
0039.00
0040.00 D RUN_DATE 276 281S 0
0041.00 * Run date (UDATE)
0042.00
0043.00 D RUN_TIME 282 287S 0
0044.00 * Run time (UDATE)
0045.00
0046.00 D CRT_DATE 288 293
0047.00 * Create date
0048.00
0049.00 D CRT_TIME 294 299
0050.00 * Create time
0051.00
0053.00 C SETON LR
****************** End of data *************************************************
OUTPUT
MYPSDS:
PROC_NAME OF MYPSDS = 'PSDS_PGM '
PGM_STATUS OF MYPSDS = 00000.
PRV_STATUS OF MYPSDS = 00000.
LINE_NUM OF MYPSDS = '00000000'
ROUTINE OF MYPSDS = '*DETC '
PARMS OF MYPSDS = 000.
DATE OF MYPSDS = '01212013'
YEAR OF MYPSDS = 20.
LAST_FILE OF MYPSDS = ' '
FILE_INFO OF MYPSDS = ' '
JOB_NAME OF MYPSDS = 'QPADEV000P'
USER OF MYPSDS = 'ARUN '
JOB_NUM OF MYPSDS = 914670.
JOB_DATE OF MYPSDS = 012113.
RUN_DATE OF MYPSDS = 012113.
RUN_TIME OF MYPSDS = 083303.
CRT_DATE OF MYPSDS = '012113'
CRT_TIME OF MYPSDS = '083234'
Example-II
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> PSDS_PGM2
FMT H HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 HOPTION(*SRCSTMT)
0002.00 DMYPSDS SDS
0003.00 DPROC_NAME *PROC
0004.00 * Procedure name
0005.00 DPGM_STATUS *STATUS
0006.00 * Status code
0007.00
0008.00 D LINE_NUM 21 28
0009.00 * Source statement line no.
0010.00
0011.00 DA S 2 0 INZ(*ZEROS)
0012.00 DB S 2 0 INZ(10)
0013.00 DC S 2 0 INZ(*ZEROS)
0014.00 D@ERR S 50 INZ(*BLANKS)
0015.00 C B DIV A C
0016.00 C TAG1 TAG
0017.00 C 'C=Infinite' DSPLY
0018.00 C SETON LR
0019.00 C *PSSR BEGSR
0020.00 C IF PGM_STATUS=00102
0021.00 C EVAL @ERR='Error at line no.'+
0022.00 C LINE_NUM + ' with status code '+
0023.00 c %CHAR(PGM_STATUS)
0024.00 C @ERR DSPLY
0025.00 C GOTO TAG1
0026.00 C* MOVE '*GETIN' Retur 6
0027.00 C ELSE
0028.00 C 'FATAL ERR' DSPLY
0029.00 C MOVE '*CANCL' Retur 6
0030.00 C ENDIF
0031.00 C ENDSR Retur
****************** End of data *******************************************************
OUTPUT
Error at line no.00001500 for status code 102
C=Infinite
Here if
we don't use GOTO, the control will go to the same error statement and *pssr
will get executed again and again.To avoid looping we can use GOTO or can avoid
the *pssr to get executed for the 2nd time by using some count variable. If
count=1, don't execute the *pssr again.
*GETIN ==> *GETIN
(that is, the start of the mainline). Equivalent to 'G'
*CANCL ==>
equivalent to 'C'
VII.
File information
data structure
A file information data
structure (INFDS) can be defined for each file to make file exception/error and
file feedback information available to the program.
INFDS with important File
Information
FMYFILE IF E DISK INFDS(FILEFBK)
DFILEFBK DS
D FILE *FILE * File name
D OPEN_IND 9 9N * File open?
D EOF_IND 10 10N * File at eof?
D STATUS *STATUS * Status code
D OPCODE *OPCODE * Last opcode
D ROUTINE *ROUTINE * RPG Routine
D LIST_NUM 30 37 * Listing line
D SPCL_STAT 38 42S 0 * SPECIAL status
D RECORD *RECORD * Record name
D MSGID 46 52 * Error MSGID
D SCREEN *SIZE * Screen size
D NLS_IN *INP * NLS Input?
D NLS_OUT *OUT * NLS Output?
D NLS_MODE *MODE * NLS Mode
Example: Using INFDS & EXTMBR to read all members of a PF
Columns . . . : 1 71 Browse AMIT/QRPGLESRC
SEU==> MBR_READ
FMT FX .....FFilename++IPEASF.....L.....A.Device+.Keywords++++++++++++++++++++
*************** Beginning of data *************************************
0001.00 FCUST IF E DISK EXTMBR('*ALL')
0001.01 F INFDS(FILEDS)
0001.02 *
0001.03 DFILEDS DS
0001.04 DRECORD *RECORD
0001.05 DMEMBER 129 138
0001.06 DDB_RRN 397 400I 0
0001.07 *
0001.08 *
0001.09 DDATA1 DS
0001.10 DFLD1 10
0001.11 DFILLER1 2 INZ('--')
0001.12 DFLD2 10
0001.13 DFILLER2 2 INZ('--')
0001.14 DFLD3 4 0
0001.15 DFILLER3 2 INZ('--')
0001.16 *
0001.17 *
0001.18 DDATA2 DS
0001.19 DFLD4 6
0001.20 DFILLER4 2 INZ('--')
0001.21 DFLD5 10
0001.22 DFILLER5 2 INZ('--')
0001.23 DFLD6 5 0
0001.24 DFILLER6 2 INZ('--')
0001.25 DFLD7 10 0
0001.26 *
0001.27 *
0001.28 *
0002.00 C READ CUST
0003.00 C DOW NOT %EOF(CUST) AND *IN90=*OFF
0003.02 C EVAL FLD1=MEMBER
0003.03 C EVAL FLD2=RECORD
0003.04 C EVAL FLD3=DB_RRN
0003.05 C EVAL FLD4=CSNBR
0003.06 C EVAL FLD5=CSNAME
0003.07 C EVAL FLD6=CS#OPN
0003.08 C EVAL FLD7=CS$OPN
0003.09 C DATA1 DSPLY
0003.10 C DATA2 DSPLY
0003.11 C READ CUST
0004.00 C ENDDO
0005.00 C SETON LR
****************** End of data ****************************************
Work with Members Using PDM SYSTEM09
File . . . . . . CUST
Library . . . . AMIT Position to . . . . .
Type options, press Enter.
3=Copy 4=Delete 5=Display 7=Rename 8=Display description
9=Save 13=Change text 18=Change using DFU 25=Find string ...
Opt Member Date Text
CUST 07/27/12
MBR2 07/23/12
MBR3 07/23/12
Bottom
Parameters or command
===>
F3=Exit F4=Prompt F5=Refresh F6=Create
F9=Retrieve F10=Command entry F23=More options F24=More keys
File’s member Data
CUST data
CSNBR CSNAME CS#OPN CS$OPN
000001 000001 AMI 0 .00
000002 000002 upi 0 .00
000003 000003 KUM 0 .00
000004 000004 RAHIN 12,256 454,654.51
000005 000005 HARISH 980 798,789.00
MBR2 data
CSNBR CSNAME CS#OPN CS$OPN
000001 100002 upi 0 .00
000002 100003 KUM 0 .00
MBR3 data
CSNBR CSNAME CS#OPN CS$OPN
100003 KUM 0 .00
Output
Display Program Messages
CUST --CUSTR --0001--
000001--AMI --00000--0000000000
CUST --CUSTR --0002--
000002--upi --00000--0000000000
CUST --CUSTR --0003--
000003--KUM --00000--0000000000
CUST --CUSTR --0004--
000004--RAHIN --12256--0000454654
CUST --CUSTR --0005--
000005--HARISH --00980--0000798789
MBR2 --CUSTR --0001--
100002--upi --00000--0000000000
MBR2 --CUSTR --0002--
100003--KUM --00000--0000000000
MBR3 --CUSTR --0001--
100003--KUM --00000--0000000000
Example 2: INFDS using 369 position of display file to handle
PAGEUP, PAGEDOWN, ENTER KEY…
f MyScreen c f e workstn INFDS (ScnDS)
d ScnDS ds
* Attention Indicator Byte
d PressKey 369 369
d EnterKey c const(x'F1')
d RollUp c const(x'F5')
d RollDown c const(x'F4')
select;
when PressKey = EnterKey; // Enter Key pressed
- - - - - - - - - - // Do programming for Enter Key
when PressKey = RollUp;
- - - - - - - - - - // Do programming for RollUp
when PressKey = RollDown;
- - - - - - - - - - // Do programming for RollDown
Endsl;
Seton lr;
Example 3: INFDS used with INFSR to
catch all file and program errors
By using INFSR (*PSSR), we can make a
single *PSSR subroutine that will handle both file exceptions and program
exceptions exception.
Example: Single *PSSR handling both file
and program exceptions.
Columns . . . : 6 80 Browse AMITCC/QRPGLESRC
SEU==> PSSR_PGM5
FMT H HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data ****************************************************
0001.00 HOPTION(*SRCSTMT) 130122
0002.00 FCUST UF A E DISK USROPN INFSR(*PSSR) 130131
0003.00 F INFDS(INFDS1) 130122
0004.00 DINFDS1 DS 130122
0005.00 DFILE_STATUS *STATUS 130122
0006.00 * 130122
0007.00 DMYPSDS SDS 130131
0008.00 DPROC_NAME *PROC 130131
0009.00 * Procedure name 130131
0010.00 DPGM_STATUS *STATUS 130131
0011.00 * Status code 130131
0012.00 D LINE_NUM 21 28 130131
0013.00 * Source statement line no. 130131
0014.00 * 130131
0015.00 130131
0016.00 DA S 2 0 INZ(*ZEROS) 130131
0017.00 DB S 2 0 INZ(10) 130131
0018.00 DC S 2 0 INZ(*ZEROS) 130131
0019.00 D@ERR S 50 INZ(*BLANKS) 130131
0020.00 * 130131
0021.00 C B DIV A C 667788 130131
0022.00 C TAG1 TAG 130131
0023.00 C 'C=Infinite' DSPLY 130131
0024.00 130131
0025.00 C TAG2 TAG 130131
0026.00 C N441 SETLL CUSTR 130124
0027.00 C EVAL CSNAME='MMM' 130131
0028.00 C TAG3 TAG 130131
0029.00 C UPDATE CUSTR 130122
0030.00 C SETON LR 130122
0031.00 * 130122
0032.00 C *PSSR BEGSR 130131
0033.00 C IF FILE_STATUS=01211 130131
0034.00 C OPEN CUST 130122
0035.00 C GOTO TAG2 130131
0036.00 C ELSEIF FILE_STATUS=01221 130131
0037.00 C READ(E) CUST 130122
0038.00 C EVAL CSNAME='MMM' 130131
0039.00 C SETON 44 130124
0040.00 C GOTO TAG3 130131
0041.00 C ELSEIF FILE_STATUS=00000 AND PGM_STATUS=00000 130131
0042.00 C LEAVESR 130131
0043.00 C ELSEIF FILE_STATUS=00000 AND PGM_STATUS<>00000 130131
0044.00 C*------------------Do nothing 130131
0045.00 C ELSE 130131
0046.00 C 'FILE ERR' DSPLY 130131
0047.00 C MOVE '*CANCL' Returncd 6 130131
0048.00 C ENDIF 130122
0049.00 *- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 130131
0050.00 C IF PGM_STATUS=00102 130131
0051.00 C EVAL @ERR='Error at line no.'+ 130131
0052.00 C LINE_NUM + ' with status code '+ 130131
0053.00 c %CHAR(PGM_STATUS) 130131
0054.00 C @ERR DSPLY 130131
0055.00 C RESET PGM_STATUS 130131
0056.00 C GOTO TAG1 130131
0057.00 C ELSEIF PGM_STATUS=00000 130131
0058.00 C LEAVESR 130131
0059.00 C ELSE 130131
0060.00 C 'PGM ERR' DSPLY 130131
0061.00 C MOVE '*CANCL' Retur 6 130131
0062.00 C ENDIF 130131
0063.00 C RESET PGM_STATUS 130131
0064.00 C ENDSR Returncd 130124
0065.00 130131
****************** End of data *******************************************************
Output
DSPLY Error at line no.00002100 with status code 102
DSPLY C=Infinite
Example – 4
It is used in load-all subfile as illustrated below:
0006.00 FLOAD_DSP CF E WORKSTN
0007.00 F SFILE(EXPD_SFL:RRN)
0008.00 F INFDS(infds)
0009.00 *
0010.00 Dinfds DS
0011.00 DRECNO 378 379I 0
0012.00 *____________________________________________________________________
0013.00 *______ In load-All subfile if we do PAGEDOWN and then press ENTER on
0014.00 *______ the page, by-default ENTER bring the display screen to the very
0015.00 *______ first page irrespective of the current page number. To avoid
0015.01 *______ this situation, we use file information data structure to get the
0015.02 *______ the current page RRN number and pass it to the SFLRCDNBR hidden
0015.02 *______ field defined in the display file DDS.
0016.00 *____________________________________________________________________
It is used in expandable subfile as illustrated below:
0006.00 FEXPD_DSP CF E WORKSTN
0007.00 F SFILE(EXPD_SFL:RRN)
0008.00 F INFDS(infds)
0009.00 *
0010.00 Dinfds DS
0011.00 DRECNO 378 379I 0
0012.00 *________________________________________________________________________
0013.00 *______ In Expandable subfile after PAGE UP if we press ENTER, then
0014.00 *______ the page displayed on the screen is the page that we had at our last
0015.00 *______ PAGEDOWN activity. E.g.- Suppose we are on page-3 after pressing 2
0015.01 *______ PAGEDOWN. From page-3 if we press 1 PAGEUP and then press ENTER, the
0015.02 *______ page to be displayed should be the 2nd page, but it is not the case.
0015.03 *______ In this case, the page that is displayed after pressing ENTER is 3rd
0015.04 *______ page which is the page no. that we got after the latest PAGEDOWN
0015.05 *______ activity. To avoid this situation, we use file information data
0015.06 *______ to get the current page RRN number and pass it to the SFLRCDNBR
0015.07 *______ hidden field defined in the display file DDS.
0016.00 *________________________________________________________________________