Ü  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

 

2012-10-15

 

   

 



 

Ü 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  *________________________________________________________________________      

 











User Comments:



Copyright © www.go4as400.com, 2013-2023. Copyright notice   Terms of services   Privacy policy