LU 6.2 API Application Programmer's Reference Guide (30294-90008)

Appendix B 183
Sample Programs
CICS Program (PL/I)
/* If the partner TP deallocated, exit the receive loop. */
IF DFHEIBLK.EIBFREE = HIGH(1) THEN
DO;
CONV_GONE = '1'B;
LEAVE RCV_LOOP;
END;
/* If the partner TP called MCConfirm, exit the receive loop. */
IF DFHEIBLK.EIBCONF = HIGH(1) THEN
DO;
CONFIRM_REQ = '1'B;
LEAVE RCV_LOOP;
END;
/* If End-Of-Chain & DATA_COMPLETE & partner TP called MCPrepToRcv */
IF ( (DFHEIBLK.EIBEOC = HIGH(1)) &
(DFHEIBLK.EIBCOMPL = HIGH(1)) &
(DFHEIBLK.EIBRECV = LOW(1)) ) THEN
DO;
IF VERIFY(RECEIVE_AREA.KEY,'0123456789') = 0 THEN
DO;
/* Query the database for the key received from the remote TP. */
EXEC CICS ENQ RESOURCE(RSC) LENGTH(6);
EXEC CICS READ DATASET('TPFILE') INTO(SEND_AREA)
RIDFLD(RECEIVE_AREA.KEY);
EXEC CICS DEQ RESOURCE(RSC) LENGTH(6);
IF RECEIVE_AREA.NAME ¬ = SEND_AREA.NAME THEN
/* The above line contains a logicalnot or (NOT EQUAL) sign. */
/* If the name in the database doesn't match the name from the remote TP, */
/* issue an error code and call McPrepToRcv (INVITE WAIT). */
DO;
EXEC CICS SEND FROM(INVALID_NAME) INVITE WAIT;
END;
/* If names match, send the data record and call MCPrepToRcv (INVITE WAIT).
*/
ELSE DO;
EXEC CICS SEND FROM(SEND_AREA) INVITE WAIT;
END;
END;
/* Otherwise, report a misc. error and call MCPrepToRcv (INVITE WAIT). */