Using based addressing with COBOL

COBOL provides a simple method of obtaining addressability to CICS data areas defined in the LINKAGE SECTION using pointer variables and the ADDRESS special register.

CICS® application programs need to access data dynamically when the data is in a CICS internal area, and only the address is passed to the program. Examples are:
  • CICS areas such as the CWA, TWA, and TCTTE user area (TCTUA), accessed using the ADDRESS command.
  • Input data, obtained by EXEC CICS commands such as READ and RECEIVE with the SET option.

The ADDRESS special register holds the address of a record defined in the LINKAGE SECTION with level 01 or 77. This register can be used in the SET option of any command in ADDRESS mode. These commands include GETMAIN, LOAD, READ, and READQ.

Figure 1 shows the use of ADDRESS special registers in COBOL. If the records in the READ or REWRITE commands are of fixed length, no LENGTH option is required. This example assumes variable-length records. After the read, you can get the length of the record from the field named in the LENGTH option (here, LRECL-REC1). In the REWRITE command, you must code a LENGTH option if you want to replace the updated record with a record of a different length.
Figure 1. Addressing CICS data areas in locate mode
WORKING-STORAGE SECTION.
77 LRECL-REC1 PIC S9(4) COMP.
LINKAGE SECTION.
01 REC-1.
02 FLAG1 PIC X.
02 MAIN-DATA PIC X(5000).
02 OPTL-DATA PIC X(1000).
01 REC-2.
02 ...
PROCEDURE DIVISION.
EXEC CICS READ UPDATE...
SET(ADDRESS OF REC-1)
LENGTH(LRECL-REC1)
END-EXEC.
IF FLAG1 EQUAL X'Y'
MOVE OPTL-DATA TO ...

EXEC CICS REWRITE...
FROM(REC-1)
END-EXEC.