ACCLOA and ACCSTO require an occurs_range if the ACCENT R field has an OCCURS clause in the Schema Definition. The occurs_range specifies which elements of the array are to be transferred.
There are 2 forms of the occurs_range list as follows:
This form specifies a single element of an ACCENT R array that is to be transferred to a specified host variable. The subscripts specified affect the ACCENT R field only. The host variable is assumed to be a non-array variable, or else a single array element.
[ , beginning value of 2nd subscript,
ending value of 2nd subscript
[ , beginning value of 3rd subscript,
ending value of 3rd subscript] ], 0
This form specifies a range of elements in an ACCENT R array that are to be transferred to the corresponding elements in a host array. The subscripts specify which elements of the ACCENT R array will be transferred.
If the host variable is specified without subscripts, the transfer will occur between equivalent elements of the arrays.
If the host variable is not an array with equivalent dimensions, each element of the ACCENT R array will be transferred to a location a certain offset beyond the beginning of the host variable specified. This offset is computed using the subscripts of the element and the dimensions of the ACCENT R array.
If you have a hierarchy of data description areas in a COBOL program, only the innermost data names should be used in HLI calls.
*create DBL acc_occurs
*define SD acc_occurs
--insert
fc1,c,2, occurs 2
fc2,c,3, occurs 2 by 3
fc3,c,4, occurs 2 by 3 by 4
fi1,i,1, occurs 2
fi2,i,2, occurs 2 by 3
fi3,i,3, occurs 2 by 3 by 4
--end
--save
*create DS acc_occurs SD acc_occurs
*use DS acc_occurs
*enter
a1,a2,b11,b12,b13,b21,b22,b23,c111,c112,c113,c114,c121,c122,c123,c124,c131,c132,c133,c134,c211,c212,c213,c214,c221,c222,c223,c224,c231,c232,c233,c234,**
*,*,*,1,2,11,12,13,21,22,23,111,112,113,114,121,122,123,124,131,132,133,134,211,212,213,214,221,222,223,224,231,232,233,234
***
program acc_occurs
C
Set up FORTRAN variables for use in several HLI calls
integer*4 ier
integer*4 idesig
character*5 iaux
C
Set up FORTRAN variables for Data Set ACC_OCCURS
integer*4 fint1,fint2(2,3),fint3(2,3,4)
character*2 fchar1
character*3 fchar2(2,3)
character*4 fchar3(2,3,4)
common fint1,fint2,fint3,fchar1,fchar2,fchar3
C
Set up the FORTRAN environment
call accfor(%descr(ier),'trace')
C
Declare the name of the ACCENT R DBL
call accdbl(%descr(ier),'trace','ACC_OCCURS')
C Open the Data Set
call accopn(%descr(ier),'trace+update',
1 'ds','ACC_OCCURS',%descr(idesig))C Set up ACCLOA with the DEFER option for automatic read on ACCGET
C This will cause 1. fc1(1) to be read into the FORTRAN variable fchar1
C 2. all elements of the array fc2 to be transferred to
C the FORTRAN array fchar2
C 3. all elements of the array fc3 to be transferred to
C the FORTRAN array fchar3
C 4. fi1(1) to be read into the FORTRAN variable fint1
C 5. all elements of the array fi2 to be transferred to
C the FORTRAN array fint2 - each element to be transferred
C explicitly to each element in the FORTRAN array
C 6. all elements of the array fi3 to be transferred to
C the FORTRAN array fint3call accloa(%descr(ier),'trace+defer',%descr(idesig),
1 'fc1',%descr(1),%descr(0), %descr(fchar1),
2 'fc2',%descr(1),%descr(2),
2 %descr(1),%descr(3),%descr(0),
2 %descr(fchar2),
3 'fc3',%descr(1),%descr(2),
3 %descr(1),%descr(3),
3 %descr(1),%descr(4),%descr(0),
3 %descr(fchar3),
4 'fi1',%descr(1),%descr(0), %descr(fint1),
5 'fi2',%descr(1),%descr(1),%descr(0),
5 %descr(fint2(1,1)),
5 'fi2',%descr(1),%descr(2),%descr(0),
5 %descr(fint2(1,2)),
5 'fi2',%descr(1),%descr(3),%descr(0),
5 %descr(fint2(1,3)),
5 'fi2',%descr(2),%descr(1),%descr(0),
5 %descr(fint2(2,1)),
5 'fi2',%descr(2),%descr(2),%descr(0),
5 %descr(fint2(2,2)),
5 'fi2',%descr(2),%descr(3),%descr(0),
5 %descr(fint2(2,3)),
6 'fi3',%descr(1),%descr(2),
6 %descr(1),%descr(3),
6 %descr(1),%descr(4),%descr(0),
6 %descr(fint3))
C
Retrieve a record
do 100,knt=1,2
call accget(%descr(ier),'trace+record',%descr(idesig),' ',%descr(knt))
type *,'CHAR: ',fchar1,fchar2(1,1),fchar2(2,3),
1 fchar3(1,1,1),fchar3(2,3,4)
type *,'INT: ',fint1,fint2(1,1),fint2(2,3),
1 fint3(1,1,1),fint3(2,3,4)
100 continue
C
Close and end
call acccls(%descr(ier),'trace',%descr(idesig))
call accend(%descr(ier))