Coding a program in PL/I
The following sample PL/I program shows how the different parts of a command-level program fit together, and how the EXEC DLI commands are coded in a CICS® online program.
Except for a few commands, this program applies to batch, BMP, and CICS programs. Any differences are highlighted in the notes for the sample PL/I code. The numbering on the right of the sample code references those notes.
*PROCESS INCLUDE,GN,XOPTS(CICS,DLI); 1
SAMPLE: PROCEDURE OPTIONS(MAIN);
DCL SEGKEYA CHAR (4);
DCL SEGKEYB CHAR (4); 2
DCL SEGKEYC CHAR (4);
DCL SEGKEY1 CHAR (4);
DCL SEGKEY2 CHAR (4);
DCL SEGKEY3 CHAR (4);
DCL SEGKEY4 CHAR (4);
DCL CONKEYB CHAR (8);
DCL SEGNAME CHAR (8);
DCL PCBNUM FIXED BIN (15);
DCL AREAA CHAR (80);
/* DEFINE SEGMENT I/O AREA */
DCL AREAB CHAR (80);
DCL AREAC CHAR (80); 3
DCL AREAG CHAR (250);
DCL AREASTAT CHAR (360);
%INCLUDE MAPSET
/* */
/* */
/* ************************************************************ */
/* INITIALIZATION */
/* HANDLE ERROR CONDITIONS IN ERROR ROUTINE */
/* HANDLE ABENDS (DLI ERROR STATUS CODES) IN ABEND PROGRAM */
/* RECEIVE INPUT MESSAGE */
/* ************************************************************ */
/* */
EXEC CICS HANDLE CONDITION ERROR(ERRORS); 4
/* */
EXEC CICS HANDLE ABEND PROGRAM('ABENDS'); 4
/* */
EXEC CICS RECEIVE MAP ('SAMPMAP') MAPSET('MAPSET'); 4
/* ANALYZE INPUT MESSAGE AND PERFORM NON-DLI PROCESSING */
/* */
/* ************************************************************ */
/* SCHEDULE PSB NAMED 'SAMPLE1' */
/* ************************************************************ */
/* */
EXEC DLI SCHD PSB(SAMPLE1);
CALL TEST_DIB; 5
/* ************************************************************* */
/* RETRIEVE ROOT SEGMENT AND ALL ITS DEPENDENTS */
/* ************************************************************* */
/* */
SEGKEYA = 'A300';
EXEC DLI GU USING PCB(1) SEGMENT(SEGA) INTO(AREAA)
WHERE(KEYA=SEGKEYA); 6
CALL TEST_DIB;
GNPLOOP:
EXEC DLI GNP USING PCB(1) INTO(AREAG); 7
IF DIBSTAT = 'GE' THEN GO TO LOOPDONE;
CALL TEST_DIB;
GO TO GNPLOOP;
LOOPDONE:
/* */
/* ************************************************************ */
/* INSERT NEW ROOT SEGMENT */
/* ************************************************************ */
/* */
AREAA = 'DATA FOR NEW SEGMENT INCLUDING KEY';
EXEC DLI ISRT USING PCB(1) SEGMENT(SEGA) FROM(AREAA);
CALL TEST_DIB;
/* */
/* ************************************************************* */
/* RETRIEVE 3 SEGMENTS IN PATH AND REPLACE THEM */
/* ************************************************************* */
/* */
SEGKEYA = 'A200';
SEGKEYB = 'B240';
SEGKEYC = 'C241';
EXEC DLI GU USING PCB(1)
SEGMENT(SEGA) WHERE(KEYA=SEGKEYA) 8
INTO(AREAA)
SEGMENT(SEGB) WHERE(KEYB=SEGKEYB)
INTO(AREAB)
SEGMENT(SEGC) WHERE(KEYC=SEGKEYC)
INTO(AREAC);
CALL TEST_DIB;
/* UPDATE FIELDS IN THE 3 SEGMENTS */
EXEC DLI REPL USING PCB(1)
SEGMENT(SEGA) FROM(AREAA)
SEGMENT(SEGB) FROM(AREAB)
SEGMENT(SEGC) FROM(AREAC);
CALL TEST_DIB;
/* */
/* ************************************************************* */
/* INSERT NEW SEGMENT USING CONCATENATED KEY TO QUALIFY PARENT */
/* ************************************************************* */
/* */
AREAC = 'DATA FOR NEW SEGMENT INCLUDING KEY';
CONKEYB = 'A200B240';
EXEC DLI ISRT USING PCB(1)
SEGMENT(SEGB) KEYS(CONKEYB)
SEGMENT(SEGC) FROM(AREAC);
CALL TEST_DIB;
/* */
/* ************************************************************ */
/* RETRIEVE SEGMENT DIRECTLY USING CONCATENATED KEY */
/* AND THEN DELETE IT AND ITS DEPENDENTS */
/* ************************************************************ */
/* */
CONKEYB = 'A200B230';
EXEC DLI GU USING PCB(1)
SEGMENT(SEGB)
KEYS(CONKEYB)
INTO(AREAB);
CALL TEST_DIB;
EXEC DLI DLET USING PCB(1)
SEGMENT(SEGB) FROM(AREAB);
CALL TEST_DIB;
/* */
/* ************************************************************* */
/* RETRIEVE SEGMENT BY QUALIFYING PARENT WITH CONCATENATED KEY, */
/* OBJECT SEGMENT WITH WHERE OPTION */
/* AND THEN SET PARENTAGE */
/* */
/* USE VARIABLES FOR PCB INDEX, SEGMENT NAME */
/* ************************************************************* */
/* */
CONKEYB = 'A200B230';
SEGNAME = 'SEGA';
SEGKEYC = 'C520';
PCBNUM = 1;
EXEC DLI GU USING PCB(PCBNUM)
SEGMENT((SEGNAME))
KEYS(CONKEYB) SETPARENT
SEGMENT(SEGC) INTO(AREAC)
WHERE(KEYC=SEGKEYC);
CALL TEST_DIB;
/* */
/* ************************************************************* */
/* RETRIEVE DATABASE STATISTICS */
/* ************************************************************* */
/* */
EXEC DLI STAT USING PCB(1) INTO(AREASTAT) VSAM FORMATTED;
CALL TEST_DIB;
/* */
/* ************************************************************ */
/* RETRIEVE ROOT SEGMENT USING BOOLEAN OPERATORS */
/* ************************************************************ */
/* */
SEGKEY1 = 'A050';
SEGKEY2 = 'A150';
SEGKEY3 = 'A275';
SEGKEY4 = 'A350';
EXEC DLI GU USING PCB(1) SEGMENT(SEGA) INTO(AREAA)
WHERE(KEYA &Ar; SEGKEY1 AND KEYA &Al; SEGKEY2 OR
KEYA &Ar; SEGKEY3 AND KEYA &Al; SEGKEY4);
CALL TEST_DIB;
/* */
/* ************************************************************* */
/* TERMINATE PSB WHEN DLI PROCESSING IS COMPLETED */
/* ************************************************************* */
/* */
EXEC DLI TERM;
9
/* */
/* ************************************************************* */
/* SEND OUTPUT MESSAGE */
/* ************************************************************* */
/* */
EXEC CICS SEND MAP('SAMPMAP') MAPSET('MAPSET'); 4
EXEC CICS WAIT TERMINAL;
/* */
/* ************************************************************* */
/* COMPLETE TRANSACTION AND RETURN TO CICS */
/* ************************************************************* */
/* */
EXEC CICS RETURN; 4
/* */
/* ************************************************************ */
/* CHECK STATUS IN DIB */
/* ************************************************************ */
/* */
TEST_DIB: PROCEDURE;
IF DIBSTAT = ' ' RETURN; 10
/* HANDLE DLI STATUS CODES REPRESENTING EXCEPTIONAL CONDITIONS */
/* */
OK:
END TEST_DB;
ERRORS:
/* HANDLE ERROR CONDITIONS */
/* */
END SAMPLE;Notes to the sample PL/I code:
- 1 For a CICS online program containing EXEC DLI commands, you must specify the DLI and CICS options. For a batch or BMP program containing EXEC DLI, you must specify only the DLI option.
- 2 Define, in automatic storage, each of the areas; I/O areas, key feedback areas, and segment name areas.
- 3 Define an I/O area for each segment you retrieve, add, or replace in a single command.
- 4 Do not code EXEC CICS commands in a batch or BMP program.
- 5 For CICS online programs,
you use a
SCHD PSBcommand to obtain a PSB. You do not schedule a PSB in a batch or BMP program. - 6 This
GUcommand retrieves the first occurrence of SEGA with a key of A300. Notice that you do not need to include the KEYLENGTH and SEGLENGTH options. - 7 This
GNPcommand retrieves all dependents under segment SEGA. TheGE status code indicates that no more dependents exist. - 8 This
GUcommand is an example of a path command. You must use a separate I/O area for each segment you retrieve. - 9 For a CICS online program,
the
TERMcommand terminates the PSB scheduled earlier. You do not terminate the PSB in a batch or BMP program. - 10 After issuing each command, you should check the status code in the DIB.