The following examples show various uses for data structures and how to define them.
| Example | Description |
|---|---|
| Figure 54 | Using a data structure to subdivide a field |
| Figure 55 | Using a data structure to group fields |
| Figure 56 | Using keywords QUALIFIED, LIKEDS, and DIM with data structures, and how to code fully-qualified subfields |
| Figure 57 | Data structure with absolute and length notation |
| Figure 58 | Rename and initialize an externally described data structure |
| Figure 59 | Using PREFIX to rename all fields in an external data structure |
| Figure 60 | Defining a multiple occurrence data structure |
| Figure 61 | Aligning data structure subfields |
| Figure 62 | Defining a *LDA data area data structure |
| Figure 63 | Using data area data structures (1) |
| Figure 64 | Using data area data structures (2) |
| Figure 65 | Using an indicator data structure |
| Figure 66 | Using a multiple-occurrence indicator data structure |
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* Use length notation to define the data structure subfields.
* You can refer to the entire data structure by using Partno, or by
* using the individual subfields Manufactr, Drug, Strength or Count.
*
D Partno DS
D Manufactr 4
D Drug 6
D Strength 3
D Count 3 0
D
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
IFilename++SqNORiPos1+NCCPos2+NCCPos3+NCC..................................
I........................Fmt+SPFrom+To+++DcField+++++++++L1M1FrPlMnZr......
*
* Records in program described file FILEIN contain a field, Partno,
* which needs to be subdivided for processing in this program.
* To achieve this, the field Partno is described as a data structure
* using the above Definition specification
*
IFILEIN NS 01 1 CA 2 CB
I 3 18 Partno
I 19 29 Name
I 30 40 Patno*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* When you use a data structure to group fields, fields from
* non-adjacent locations on the input record can be made to occupy
* adjacent internal locations. The area can then be referred to by
* the data structure name or individual subfield name.
*
D Partkey DS
D Location 4
D Partno 8
D Type 4
D
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
IFilename++SqNORiPos1+NCCPos2+NCCPos3+NCC..................................
I........................Fmt+SPFrom+To+++DcField+++++++++L1M1FrPlMnZr......
*
* Fields from program described file TRANSACTN need to be
* compared to the field retrieved from an Item_Master file
*
ITRANSACTN NS 01 1 C1 2 C2
I 3 10 Partno
I 11 16 0Quantity
I 17 20 Type
I 21 21 Code
I 22 25 Location
I
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
*
* Use the data structure name Partkey, to compare to the field
* Item_Nbr
*
C :
C Partkey IFEQ Item_Nbr 99
C :
C* D CustomerInfo DS QUALIFIED BASED(@)
D Name 20A
D Address 50A
D ProductInfo DS QUALIFIED BASED(@)
D Number 5A
D Description 20A
D Cost 9P 2
D SalesTransaction...
D DS QUALIFIED
D Buyer LIKEDS(CustomerInfo)
D Seller LIKEDS(CustomerInfo)
D NumProducts 10I 0
D Products LIKEDS(ProductInfo)
D DIM(10)
/free
TotalCost = 0;
for i = 1 to SalesTransation. Numproducts;
TotalCost = TotalCost + SalesTransaction.Products (i).Cost;
dsply SalesTransaction.Products (i).Cost;
endfor;
dsply ('Total cost is ' + %char(TotalCost));
/end-free
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* Define a program described data structure called FRED
* The data structure is composed of 5 fields:
* 1. An array with element length 10 and dimension 70(Field1)
* 2. A field of length 30 (Field2)
* 3/4. Divide Field2 in 2 equal length fields (Field3 and Field4)
* 5. Define a binary field over the 3rd field
* Note the indentation to improve readability
*
*
* Absolute notation:
*
* The compiler will determine the array element length (Field1)
* by dividing the total length (700) by the dimension (70)
*
D FRED DS
D Field1 1 700 DIM(70)
D Field2 701 730
D Field3 701 715
D Field5 701 704B 2
D Field4 716 730
*
* Length notation:
*
* The OVERLAY keyword is used to subdivide Field2
*
D FRED DS
D Field1 10 DIM(70)
D Field2 30
D Field3 15 OVERLAY(Field2)
D Field5 4B 2 OVERLAY(Field3)
D Field4 15 OVERLAY(Field2:16)*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* Define an externally described data structure with internal name
* FRED and external name EXTDS and rename field CUST to CUSTNAME
* Initialize CUSTNAME to 'GEORGE' and PRICE to 1234.89.
* Assign to subfield ITMARR the DIM keyword.
* The ITMARR subfield is defined in the external description as a
* 100 byte character field. This divides the 100 byte character
* field into 10 array elements, each 10 bytes long.
* Using the DIM keyword on an externally described numeric subfield
* should be done with caution, because it will divide the field into
* array elements (similar to the way it does when absolute notation
* is used for program described subfields).
*
D Fred E DS EXTNAME(EXTDS)
D CUSTNAME E EXTFLD(CUST) INZ('GEORGE')
D PRICE E INZ(1234.89)
D ITMARR E DIM(10)*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
D
D extds1 E DS EXTNAME (CUSTDATA)
D PREFIX (CU_)
D Name E INZ ('Joe's Garage')
D Custnum E EXTFLD (NUMBER)
D
*
* The previous data structure will expand as follows:
* -- All externally described fields are included in the data
* structure
* -- Renamed subfields keep their new names
* -- Subfields that are not renamed are prefixed with the
* prefix string
*
* Expanded data structure:
*
D EXTDS1 E DS
D CU_NAME E 20A EXTFLD (NAME)
D INZ ('Joe's Garage')
D CU_ADDR E 50A EXTFLD (ADDR)
D CUSTNUM E 9S0 EXTFLD (NUMBER)
D CU_SALESMN E 7P0 EXTFLD (SALESMN)*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* Define a Multiple Occurrence data structure of 20 elements with:
* -- 3 fields of character 20
* -- A 4th field of character 10 which overlaps the 2nd
* field starting at the second position.
*
* Named constant 'Max_Occur' is used to define the number of
* occurrences.
*
* Absolute notation (using begin/end positions)
*
D Max_Occur C CONST(20)
D
DDataStruct DS OCCURS (Max_Occur)
D field1 1 20
D field2 21 40
D field21 22 31
D field3 41 60
*
* Mixture of absolute and length notation
*
D DataStruct DS OCCURS(twenty)
D field1 20
D field2 20
D field21 22 31
D field3 41 60*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
* Data structure with alignment:
D MyDS DS ALIGN
* Properly aligned subfields
* Integer subfields using absolute notation.
D Subf1 33 34I 0
D Subf2 37 40I 0
* Integer subfields using length notation.
* Note that Subf3 will go directly after Subf2
* since positions 41-42 are on a 2-byte boundary.
* However, Subf4 must be placed in positions 45-48
* which is the next 4-byte boundary after 42.
D Subf3 5I 0
D Subf4 10I 0
* Integer subfields using OVERLAY.
D Group 101 120A
D Subf6 5I 0 OVERLAY (Group: 3)
D Subf7 10I 0 OVERLAY (Group: 5)
D Subf8 5U 0 OVERLAY (Group: 9)
* Subfields that are not properly aligned:
* Integer subfields using absolute notation:
D SubfX1 10 11I 0
D SubfX2 15 18I 0
* Integer subfields using OVERLAY:
D BadGroup 101 120A
D SubfX3 5I 0 OVERLAY (BadGroup: 2)
D SubfX4 10I 0 OVERLAY (BadGroup: 6)
D SubfX5 10U 0 OVERLAY (BadGroup: 11)
* Integer subfields using OVERLAY:
D WorseGroup 200 299A
D SubfX6 5I 0 OVERLAY (WorseGroup)
D SubfX7 10I 0 OVERLAY (WorseGroup: 3)
*
* The subfields receive warning messages for the following reasons:
* SubfX1 - end position (11) is not a multiple of 2 for a 2 byte field.
* SubfX2 - end position (18) is not a multiple of 4 for a 4 byte field.
* SubfX3 - end position (103) is not a multiple of 2.
* SubfX4 - end position (109) is not a multiple of 4.
* SubfX5 - end position (114) is not a multiple of 4.
* SubfX6 - end position (201) is not a multiple of 2.
* SubfX7 - end position (205) is not a multiple of 4.*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* Define a data area data structure based on the *LDA.
*
* Example 1:
* A data area data structure with no name is based on the *LDA.
* In this case, the DTAARA keyword does not have to be used.
*
D UDS
D SUBFLD 1 600A
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
* Example 2:
* This data structure is explicitly based on the *LDA using
* the DTAARA keyword. Since it is not a data area data
* structure, it must be handled using IN and OUT operations.
*
D LDA_DS DS DTAARA(*LDA)
D SUBFLD 1 600A
...
C IN LDA_DS
C OUT LDA_DS
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
* Example 3:
* This data structure is explicitly based on the *LDA using
* the DTAARA keyword. Since it is a data area data
* structure, it is read in during initialization and written
* out during termination. It can also be handled using IN
* and OUT operations, since the DTAARA keyword was used.
*
D LDA_DS UDS DTAARA(*LDA)
D SUBFLD 1 600A
...
C IN LDA_DS
C OUT LDA_DS*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
H DFTNAME(Program1)
H
*
FFilename++IPEASF.....L.....A.Device+.Keywords+++++++++++++++++++++++++++
FSALESDTA IF E DISK
*
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* This program uses a data area data structure to accumulate
* a series of totals. The data area subfields are then added
* to fields from the file SALESDTA.
D Totals UDS
D Tot_amount 8 2
D Tot_gross 10 2
D Tot_net 10 2
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
CL0N01Factor1+++++++Opcode(E)+Factor2++++++++++++++++++++++++++++++++++++++
*
C :
C EVAL Tot_amount = Tot_amount + amount
C EVAL Tot_gross = Tot_gross + gross
C EVAL Tot_net = Tot_net + net*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
H DFTNAME(Program2)
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* This program processes the totals accumulated in Program1.
* Program2 then uses the total in the subfields to do calculations.
*
D Totals UDS
D Tot_amount 8 2
D Tot_gross 10 2
D Tot_net 10 2
*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
*
C :
C EVAL *IN91 = (Amount2 <> Tot_amount)
C EVAL *IN92 = (Gross2 <> Tot_gross)
C EVAL *IN93 = (Net2 <> Tot_net)
C :*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
FFilename++IPEASFRLen+LKlen+AIDevice+.Keywords++++++++++++++++++++++++++
* Indicator data structure "DispInds" is associated to file "Disp".
FDisp CF E WORKSTN INDDS (DispInds)
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
*
* This is the indicator data structure:
*
D DispInds DS
* Conditioning indicators for format "Query"
D ShowName 21 21N
* Response indicators for format "Query"
D Exit 3 3N
D Return 12 12N
D BlankNum 31 31N
* Conditioning indicators for format "DispSflCtl"
D SFLDSPCTL 41 41N
D SFLDSP 42 42N
D SFLEND 43 43N
D SFLCLR 44 44N
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
*
* Set indicators to display the subfile:
C EVAL SFLDSP = *ON
C EVAL SFLEND = *OFF
C EVAL SFLCLR = *OFF
C EXFMT DispSFLCTL
*
* Using indicator variables, we can write more readable programs:
C EXFMT Query
C IF Exit or Return
C RETURN
C ENDIF*.. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8
FFilename++IPEASFRLen+LKlen+AIDevice+.Keywords++++++++++++++++++++++++++
* Indicator data structure "ErrorInds" is associated to file "Disp".
FDisp CF E WORKSTN INDDS (ERRORINDS)
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++
D.....................................Keywords+++++++++++++++++++++++++++++
D @NameOk C 0
D @NameNotFound C 1
D @NameNotValid C 2
D @NumErrors C 2
*
* Indicator data structure for ERRMSG:
*
D ERRORINDS DS OCCURS(@NumErrors)
* Indicators for ERRMSG:
D NotFound 1 1N
D NotValid 2 2N
*
* Indicators for QUERY:
D Exit 3 3N
D Refresh 5 5N
D Return 12 12N
*
* Prototype for GetName procedure (code not shown)
D GetName PR 10I 0
D Name 50A CONST
CL0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....
*
C DOU Exit or Return
C EXFMT QUERY
* Check the response indicators
C SELECT
C WHEN Exit or Return
C RETURN
C WHEN Refresh
C RESET QUERY
C ITER
C ENDSL
*
* Check the name
C EVAL RC = GetName(Name)
*
* If it is not valid, display an error message
C IF RC <> @NameOk
C RC OCCURS ErrorInds
C EXFMT ERRMSG
C ENDIF
C ENDDO
...
C *INZSR BEGSR
*
* Initialize the occurrences of the ErrorInds data structure
C @NameNotFound OCCUR ErrorInds
C EVAL NotFound = '1'
C @NameNotValid OCCUR ErrorInds
C EVAL NotValid = '1'
C ENDSR