The following is the skeleton of a user exit program segmented into discrete pieces with explanatory text added for each piece. This program, or one similar to it, is available to customers in the xxx.TBASE.SRC file (see member EXITPGMC).
IDENTIFICATION DIVISION.
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
01 H-EXIT-DUMP-ID.
05 FILLER PIC X(26) VALUE 'TABLESONLINE EXIT PROGRAM '.
05 H-PROGRAM PIC X(8) VALUE 'EXITPGM'.
05 FILLER PIC X(2) VALUE '--'.
05 H-COMPILED PIC X(8) VALUE SPACES.
05 FILLER PIC X(20) VALUE ' WORKING STORAGE --'.
*
The code presented above is essentially housekeeping information. The program will compile and run with any syntactically correct values.
Out of date information accumulates here during debugging and maintenance work.
*
COPY EXITWS.
*
*****************************************************************
* USER WORKING-STORAGE
*****************************************************************
*
01 W-XXXX-COMMAND-AREA.
05 W-XXXX-COMMAND PIC XX VALUE SPACES.
05 W-XXXX-TABLE PIC X(8) VALUE 'XXXX'.
05 W-XXXX-FOUND PIC X VALUE SPACES.
05 W-XXXX-INDIRECT-OPEN PIC X VALUE LOW-VALUES.
05 RESERVED PIC X VALUE LOW-VALUES.
05 W-XXXX-ABEND-OVERRIDE PIC X VALUE SPACES.
05 W-XXXX-ERROR PIC S9(4) COMP VALUE +0.
05 W-XXXX-COUNT PIC S9(9) COMP VALUE +0.
05 W-XXXX-LOCK PIC X(8) VALUE SPACES.
* Release 5.x/6.0 command area extension
05 W-XXXX-ROW-OVERRIDE-LENGTH PIC S9(9) COMP VALUE +0.
05 W-XXXX-ROW-ACTUAL-LENGTH PIC S9(9) COMP VALUE +0.
05 W-XXXX-FG-KEY-LENGTH PIC S9(4) COMP VALUE +0.
05 W-XXXX-FUNCTION-ID PIC S9(4) COMP VALUE +0.
05 W-XXXX-FUNCTION-AREA PIC X(28) VALUE LOW-VALUES.
05 W-XXXX-DATE-AREA REDEFINES W-XXXX-FUNCTION-AREA.
10 W-XXXX-DATE PIC X(8).
10 RESERVED PIC X(20).
05 W-XXXX-RETURNED-ABS-GEN-NO PIC S9(4) COMP VALUE +0.
05 W-XXXX-ERROR-SUBCODE PIC S9(4) COMP VALUE +0.
*
01 W-XXXX-ROW-AREA.
10 field area declarations.
*
LINKAGE SECTION.
*****************************************************************
*
* DFH EXECUTIVE INTERFACE BLOCK.
*
*****************************************************************
*
* DFH COMMUNICATIONS INITIALIZED AT ARRIVAL FROM CICS.
*
* THIS IS THE DFHCOMM AREA FOR EXIT PROCESSING
*
*****************************************************************
*
01 DFHCOMMAREA.
05 D-EXIT-PARM-POINTER POINTER.
05 D-EXIT-ITEM-POINTER POINTER.
05 D-EXIT-FIELD-POINTER POINTER.
*
COPY EXITPARM.
*
*****************************************************************
*
* TABLE ITEM AREA - USED FOR VALIDATION.
*
*****************************************************************
*
01 L-TBLX-TABLE-ITEM.
03 L-WORKING-ITEM PIC X(512).
*
*****************************************************************
* TABLE xxxxxxxx ROW AREA
*****************************************************************
*
03 L-xxxxxxxx-ROW-AREA REDEFINES L-WORKING-ITEM.
10 whatever.
*
*****************************************************************
* FIELD IN MAP AREA.
*****************************************************************
*
01 L-MAP-FIELD-DATA.
03 L-MAP-FLDATA-L PIC S9(4) COMP.
03 L-MAP-FLDATA-A PIC X.
03 L-MAP-FLDATA-X PIC X(4).
03 L-MAP-FLDATA PIC X(51).
This defines a field of the screen map tablesONLINE/CICS uses. The four parts of such a definition are length, display attribute, extended attribute, and the display data.
PROCEDURE DIVISION.
*****************************************************************
*
A000-INITIALIZATION-SECTION.
*
*****************************************************************
*
MOVE WHEN-COMPILED TO EXIT-COMPILED.
*
****************************************************************
* *
* EXIT PROGRAM LINKAGE SETUP & INITIALIZATION *
* *
****************************************************************
*
* SETUP EXIT PROGRAM LINKAGE
*
SET ADDRESS OF T-TWA TO D-EXIT-PARM-POINTER.
*
IF D-EXIT-ITEM-POINTER NOT = NULL
SET ADDRESS OF L-TBLX-TABLE-ITEM TO D-EXIT-ITEM-POINTER.
*
IF D-EXIT-FIELD-POINTER NOT = NULL
SET ADDRESS OF L-MAP-FIELD-DATA TO D-EXIT-FIELD-POINTER.
*
* EXIT PROGRAM INITIALIZATION
*
MOVE SPACES TO T-TBLX-BYPASS-ACTION-IND.
MOVE ZERO TO T-DSPL-CONV-FIELD-ERROR.
*
*
MOVE SPACES TO T-MSGX-KEY.
MOVE ZERO TO T-MSGX-INSERT1-LENGTH.
MOVE ZERO TO T-MSGX-INSERT2-LENGTH.
* SAVE ENVIRONMENT (DEBUGGING & RESTORING BEFORE RETURN)
*
MOVE T-TBLX-COMMAND-AREA TO H-COMMAND-AREA.
*
*
MOVE 'LL' TO H-COMMAND.
CALL 'TBLBASE' USING T-TRPARM
H-COMMAND-AREA
H-LIB-LIST.
*
*
MOVE 'LS' TO H-COMMAND.
CALL 'TBLBASE' USING T-TRPARM
H-COMMAND-AREA
H-STATUS-SAVE.
*
This saves the current status switches so that they may be restored to their original state before returning to tablesONLINE/CICS.
*****************************************************************
*
* EXIT PROGRAM SPECIFIC INITIALIZATION
*
*****************************************************************
Whatever is required by way of initialization for this particular exit program goes in here. One of the more important issues to consider is whether the exit program will be making any calls to tableBASE itself.
*
MOVE T-TBLX-COMMAND-AREA TO W-xxxxx-COMMAND-AREA.
*
Here the tablesONLINE/CICS command area is copied to the area that the tablesONLINE/CICS exit program interface code will use. This is necessary so that the exit program can use tableBASE commands without altering command areas which other parts of the system rely on. This area needs to be initialized so the exit will have the correct count and LOCK-LATCH password for access to the table that tablesONLINE/CICS is working with.
In some cases, the exit program requires write access to the table tablesONLINE/CICS is using. For example, an exit that works on a personnel table might update the employee count field of a supervisor’s record when it creates a record for a new person reporting to that supervisor. In a case like this, the exit will need the table name and lock key information from the tablesONLINE/CICS command area. The code above sets this up.
There may be instances where the exit’s function is to modify the behavior of a tableBASE command. For example, to make Get Next return the next row which this user is allowed to access rather than just the next row on the table, the developer must ensure that the tablesONLINE/CICS command area T-TBLX-COMMAND-AREA is returned in an appropriate state.
This is achieved by issuing whatever calls are needed using the user command area. On success, the count can be copied to the tablesONLINE/CICS command area so that tablesONLINE/CICS sees results matching the data it is getting. On failure, the tablesONLINE/CICS command area is returned largely as it was passed but with some carefully chosen fields updated. The exit might, for example, set the found indicator to N and/or adjust the count field. The necessary time should be spent here to ensure that the code handles all cases appropriately.
In an exit program which does not issue tableBASE commands — for example checking that certain field values in the current row meet certain conditions — you can simply remove the code above and the data area definitions supporting it.
*****************************************************************
* *
* TABLE / OP-MODE DEPENDENT EXIT PROCESSING *
* *
* SELECT EXIT ACTION BY EXIT INDICATORS *
* *
*****************************************************************
At this point the business logic of the exit program starts. Typically, use some form of multi-way branch on the three indicator bytes which show how the exit has been called. For example, TOB in these bytes show that the exit was called:
- T—from Table level
- O—for the Open operation
- B—Before the operation
Details will vary widely with application and developer. The branch on indicators may be done as one large branching structure using the 3-byte string or as nested structures with each byte handled at a different level.
In many applications, there will also be validation and branching on table name. Again, details will vary greatly. The table name may be examined before the indicators, and a different indicator test used for each table, or the table test may be nested under the indicators test so that different tables can be checked in each indicator case.
All possible states must be accounted for. Build the conditional structure so that the cases you expect to handle branch to the appropriate parts of your code and all other cases branch to the Y200-INVALID-CALL routine or to some similar error routine.
Typically, then, the code here will consist of some multi-way branching structure at the top level and other specific routines required to handle the various cases. Each of these will terminate by executing one of the routines on the following pages.
User code can branch to one of two labels when leaving an exit program: Y100-NORMAL-EXIT for normal exits, with or without a message to the user, or to Y200-INVALID-CALL.
Y100-NORMAL-EXIT.
******************************************************************
*
* EXIT PROGRAM RETURNS TO CALLER AFTER RESTORING TBCALL COMMAND
*
******************************************************************
*
* RESTORE LIBRARY CONCATENATION ORDER & TURN ABEND ON
*
MOVE 'ML' TO H-COMMAND.
CALL 'TBLBASE' USING T-TRPARM
H-COMMAND-AREA
H-LIB-LIST.
*
MOVE 'CS' TO H-COMMAND.
CALL 'TBLBASE' USING T-TRPARM
H-COMMAND-AREA
H-STATUS-SAVE.
The statements above restore the library concatenation list to its saved state and reset the status switches to their saved state. tablesONLINE/CICS expects its library list to remain unaltered and abend processing to be enabled at all times, so any exit program that modifies the list or disables the abend status switch must restore them as above.
*
IF T-MSGX-KEY NOT = SPACES
GO TO Y700-SEND-MESSAGE.
*
*
GO TO Y900-RETURN-TO-CALLER.
*
User code should branch here for all invalid parameter settings, that is, for any parameters that indicate a mismatch between the exit program’s design and its usage in some View.
*
INVALID-CALL.
*
* SETUP MESSAGE - ERROR IN CALLING EXIT - INVALID INDICATORS
*
MOVE user-invalid-code TO T-MSGX-KEY.
MOVE 8 TO T-MSGX-INSERT1-LENGTH.
MOVE H-PROGRAM TO T-MSGX-INSERT1-VALUE.
MOVE 12 TO T-MSGX-INSERT2-LENGTH.
MOVE T-TBLX-PARM-INDICATORS TO T-MSGX-INSERT2-VALUE.
GO TO Y700-SEND-MESSAGE.
*
All this code does is set up a message showing the exit program name and the indicator bytes, then goes to the code which sends the message.
This bypasses the restoration code used in Y100-NORMAL-EXIT. The assumption is that bad parameters will be noticed early, that user code will branch here before there are any undesired side effects that need to be backed out. If your code does not detect invalid parameters until after it has made significant changes, then it is not safe to use this route back to tablesONLINE/CICS.
The possibilities then are:
- rewrite your code to test for bad parameters before committing to any significant action
- write your own routine to handle any cleanup necessary.
The former course is strongly recommended.
T-MSGX-KEY should be set to your own message for bad parameters, which might be patterned on the TB-5600 or TB-9000 messages in the distribution version. To implement an installation-wide standard for such messages, put the standard key in an installation-standard copybook and the corresponding message in an installation-standard message table. Many users will wish to add their own error exit routines, sending a message and then returning control to tablesONLINE/CICS.
*
User-label.
*
* SETUP MESSAGE - whatever
*
MOVE message code TO T-MSGX-KEY.
MOVE n TO T-MSGX-INSERT1-LENGTH.
MOVE text TO T-MSGX-INSERT1-VALUE.
MOVE n TO T-MSGX-INSERT2-LENGTH.
MOVE text TO T-MSGX-INSERT2-VALUE.
GO TO Y100-NORMAL-EXIT.
*
Y700-SEND-MESSAGE.
*
* FOR MESSAGE CALL MESSENGER PROGRAM
*
EXEC CICS LINK PROGRAM (H-PROG-DKTBMSTK)
COMMAREA (T-MSGX-DFHCOMMAREA)
LENGTH (H-DFHCOMM-MSGLENGTH)
END-EXEC.
*
*
IF T-TBLX-BYPASS-ACTION-IND = SPACES
MOVE T-MSGX-TYPE TO T-TBLX-BYPASS-ACTION-IND.
*
If user code has already set the bypass indicator, it is left untouched. Otherwise, it is used to flag the type of message and related action:
- E—Error
- W—Warning
- I—Information
- A—Abend.
With the W and I types, tablesONLINE/CICS delivers the message but treats the operation as successful and carries on processing with the data as returned by the exit program. E indicates the operation failed; tablesONLINE/CICS will require that this error be dealt with by the terminal user.
After handling a message, the logic path falls through to RETURN-TO-CALLER. The exit program reaches this point either directly from the NORMAL-EXIT routine if there is no message, after any message set up by INVALID-CALL, or after a user routine has been dealt with.
*
Y900-RETURN-TO-CALLER.
*
* DURING TESTING PUT IN FOLLOWING CODE
*
* MOVE user-debug-message TO T-MSGX-KEY
* MOVE 8 TO T-MSGX-INSERT1-LENGTH
* MOVE H-PROGRAM TO T-MSGX-INSERT1-VALUE
* MOVE 12 TO T-MSGX-INSERT2-LENGTH
* MOVE T-TBLX-PARM-INDICATORS TO T-MSGX-INSERT2-VALUE
* EXEC CICS LINK PROGRAM (H-PROG-DKTBMSTK)
* COMMAREA (T-MSGX-DFHCOMMAREA)
* LENGTH (H-DFHCOMM-MSGLENGTH)
* END-EXEC.
*
With this code inserted, every exit program invocation produces at least one message displaying the program name and the indicators with which it was called. This can be useful in testing and debugging exit programs.
*
Y999-RETURN-TO-CALLER.
*
EXEC CICS RETURN END-EXEC.
GOBACK.
*
**** END OF PROGRAM *********************************************