The EXITPARM copybook

The next several pages describe the copybook EXITPARM which defines the tablesONLINE/CICS Transient Work Area. It should be included in all user exit programs.

Note:
Areas labelled RESERVED or FILLER here are used internally by tablesONLINE/CICS or tableBASE and should not be tampered with.
*---------------------------------------------------------------*
* COBOL COPY BOOK MAPPING THE PARAMETERS PASSED TO TABLESONLINE
* CICS EXIT PROGRAMS VERSION 6 (RELEASE 5.1 FORMAT)
*---------------------------------------------------------------*
*                                                               *
     EJECT
*****************************************************************
*                                                               *
 01 T-TWA.
*                                                               *
*****************************************************************
*
*    TRANSACTION MANAGEMENT AREA POINTERS FOR TBLBASE
*
   03    T-TBPARM.
         10  RESERVED                    PIC X(64).
*****************************************************************
*                                                               *
   03    T-SESSION-TABLE-ITEM.
*                                                               *
*****************************************************************
     05  T-TERMINAL-ID                   PIC X(4).
     05  T-TERMINAL-INPUT.
         10 T-TERMINAL-APPL-ID           PIC X(04).
         10 T-TERMINAL-USER-ID           PIC X(08).
     05  T-SESSION-KEY.
         10 T-SESSION-TSQ-ID             PIC X(02).
         10 T-SESSION-ID.
            15 T-SESSION-PRIM-ALLOC      PIC S9(8) COMP.
            15 T-SESSION-WINDOW-ID       PIC S9(4) COMP. 
These fields are used to uniquely identify the tablesONLINE/CICS session and window which invoked the exit.

************************************************************
*    PROGRAM IN PROGRESS CONTROLS
************************************************************
     05 T-PROGID-IN-PROCESS              PIC X(8).
     05 RESERVED                         PIC X(8).

This is fundamental information for tablesONLINE/CICS. User code should treat it as strictly read-only data.

****************************************************************
*    PARM AREA FOR HOOK PROCESSING    PARM-ID-TBL-ITM-FLD
****************************************************************

     05  T-TBLX-PARMS.
         10  T-TBLX-PARM-INDICATORS.
             15  T-TBLX-EXIT-INDICATORS.
                 20  T-TBLX-EXIT-STIF-IND    PIC X.
                 20  T-TBLX-EXIT-IO-IND      PIC X.
                 20  T-TBLX-EXIT-BA-IND      PIC X.
             15  T-TBLX-BYPASS-ACTION-IND    PIC X.
             15  T-TBLX-ALL-UPD-IND          PIC X.
             15  T-TBLX-KEY-UPD-IND          PIC X.
             15  T-TBLX-ITEM-UPD-IND         PIC X.
             15  T-OPER-PGM-OP-MODE          PIC X.
             15  T-TBLX-ITEM-ACTION          PIC X.
             15  T-TBLX-DUPSOK-IND           PIC X.
These are the main control variables for exit programs. They are described earlier in this chapter, in the section Interacting with tablesONLINE/CICS. The Exit Indicators and Bypass Action Indicator are also described in the comments in the exit program.

         10  T-TBLX-PARM-VALUES.
             15 T-DSPL-CONV-FIELD-ERROR     PIC S9(4) COMP.
             15 T-FDTX-ERR-FIELD-COUNT      PIC S9(8) COMP.
             15 T-TBLX-CURR-ITM-COUNT       PIC S9(8) COMP.  
These three fields are used for flagging field conversion errors in the tablesONLINE/CICS editor. The first identifies a field conversion error, the second the field to highlight in the multi-field item display, and the third identifies the row in the table. All three may be set by exit programs. For example, an IXF exit might set ERR-FIELD-COUNT so that tablesONLINE/CICS would scroll to the problematic field. Developers altering these must ensure that only sensible values are placed here. Count values pointing beyond end-of-row or outside the table can lead to erratic behavior.

             15  T-TBLX-TARGET-COUNT         PIC S9(8) COMP.
The tablesONLINE/CICS row move command uses the tableBASE Delete by Count (DC) and Insert by Count (IC) commands. (In multi-user update mode, DK and IK are used.) T-TBLX-TARGET-COUNT is the count the IC command requires to put the row in the right place. tablesONLINE/CICS has already allowed for such considerations as whether the target was flagged A (after) or B (before) and whether the deleted row was before or after the target.

             15  T-TBLX-PASSWD         PIC X(8).
             15  T-TBLX-GENERATION     PIC S9(8) COMP.
Specifies the password and generation number of the table for which tablesONLINE/CICS called the exit program.

     10  T-TBLX-ITEM-ENQUEUED         PIC X.
     10  RESERVED                     PIC X(5).
     10  T-OPER-TBLX-NAME             PIC X(8).
     10  RESERVED                     PIC X(6).
*        
     10  T-SCRL-FIRST-SCR-CNT         PIC S9(8) COMP.
This field is used to set the count of the first row to appear on the Edit Table screen.

****************************************************************
*    LINE COMMAND INFORMATION AREA
****************************************************************

     05  T-LCMD-COUNT                    PIC S9(8) COMP.
     05  T-LCMD-ID                       PIC X.
     05  RESERVED                        PIC X(7).
* PLEASE NOTE THE OFFSET OF THE FOLLOWING SUBPARAMETER HAS
* INCREASED BY 4 BYTES STARTING WITH VERSION 6. ALL OTHER SUBPARAMETERS
* ARE IN THE IDENTICAL POSITIONS OF RELEASE 5.1.
     05  T-LCMD-NO-OF-ITEMS              PIC S9(8) COMP.
     05  RESERVED                        PIC X(24).
These fields are used in processing Line Commands on the Edit Table screen in a CSA exit. LCMD-COUNT contains the count of the first row of a Line Command as presented to the CSA exit. LCMD-ID identifies the Line Command. LCMD-NO-OF-ITEMS contains the range of items in a block line command as presented to the CSA exit. It has a value of zero if the command is a single character (non-block) command.

****************************************************************
*    THIS IS THE DFHCOMM WORK AREA FOR MSGS PROCESSING
****************************************************************

     05  T-MSGX-DFHCOMMAREA.
         10  RESERVED                    PIC X(8).
         10  T-MSGX-KEY                  PIC X(7).
         10  T-MSGX-FOUND                PIC X.
         10  T-MSGX-INSERT1-LENGTH       PIC S9(8) COMP.
         10  T-MSGX-INSERT1-VALUE        PIC X(60).
         10  T-MSGX-INSERT2-LENGTH       PIC S9(8) COMP.
         10  T-MSGX-INSERT2-VALUE        PIC X(60).
         10  T-MSGX-TYPE                 PIC X.
         10  RESERVED                    PIC X(3).
*

To send a message an exit program sets KEY and the various INSERT-xxxxx fields here.

When NORMAL-EXIT then calls the tablesONLINE/CICS message handler, that program takes a series of actions:

  1.          Looks up the KEY in the message table
  2.          Builds a message from the retrieved text and the two INSERT-VALUEs
  3.          Puts that message on a queue for the tablesONLINE/CICS screen handler
  4.          Reports success or failure of the above in FOUND
  5.          Puts the message type (A, E, I, or W) in TYPE here.
NORMAL-EXIT then copies TYPE to BYPASS-ACTION-INDicator, unless the user code has already set that indicator.

****************************************************************
*    ITEM AREA FOR PF KEY/COMMAND TRANSLATION.
****************************************************************

     05  T-PFKS-TABLE-ITEM.
         10  RESERVED                    PIC X(5).
         10  T-COMMAND                   PIC X(20).
         10  T-CMD-PARM                  PIC X(79).
     05  T-CMD-PARM-COUNT                PIC S9(8) COMP.
     05  T-CMD-COUNT-VALUE               PIC S9(8) COMP.
     05  RESERVED                        PIC X(132).
*
T-COMMAND holds the tablesONLINE/CICS command the user gave; T-CMD-PARM contains the command-line arguments to that command. T-CMD-PARM-COUNT is the length of the contents of T-CMD-PARM. T-CMD-COUNT-VALUE contains zero at the CSB exit; after this exit it contains either the numeric value entered into T-CMD-PARM, if any, or the relative cursor position. This is typically used with all commands which take a numeric parameter (DOWN, UP, FREEZEKEYS, etc.).

****************************************************************
*    APPLICATIONS LIB LIST
****************************************************************

     05  T-LIB-LIST.
         10  T-LIBDDN                    PIC X(8)
                               OCCURS 10
                               INDEXED BY T-LIB-LIST-INDEX.
*
The tableBASE library concatenation list which the calling tablesONLINE/CICS application is using in its searches. This area is read-only.

*****************************************************************
*    COMMAND AREA TABLE XXXXXXXXX        PARM-TBL-ITM-FLD
*****************************************************************
     05  T-TBLX-COMMAND-AREA.
         10  T-TBLX-COMMAND              PIC X(02).
         10  T-TBLX-TABLE                PIC X(08).
         10  T-TBLX-FOUND                PIC X.
         10  T-TBLX-INDIRECT-OPEN        PIC X.
         10  T-TBLX-RESERVED             PIC X.
         10  T-TBLX-ABEND-OVERRIDE       PIC X.
         10  T-TBLX-ERROR                PIC S9(04) COMP.
         10  T-TBLX-COUNT                PIC S9(08) COMP.
         10  T-TBLX-LOCK-LATCH           PIC X(08).
*** REL 5 OR LATER COMMAND EXTENSION
         10  T-TBLX-ITEM-LENGTH          PIC S9(08) COMP.
         10  T-TBLX-ACTUAL-ITEM-LENGTH   PIC S9(08) COMP.
         10  T-TBLX-FG-KEY-LENGTH        PIC S9(04) COMP.
         10  T-TBLX-FUNCTION-ID          PIC S9(04) COMP.
         10  T-TBLX-FUNCTION-PARM.
             15  T-TBLX-DATE             PIC 9(08).
             15  RESERVED                PIC X(20).
         10  T-TBLX-ABS-GEN-NO           PIC S9(04) COMP.
         10  T-TBLX-ERROR-SUBCODE        PIC S9(04) COMP.

The tableBASE command area for tablesONLINE/CICS is read-only in most applications. The exception occurs when the exit program replaces the tableBASE action with its own. Consider an exit program that operates at item input time replacing tableBASE retrieval operations with versions that only retrieve certain types of rows. This program must update T-TBLX-COUNT to point to the row actually retrieved.

Developers of such programs must ensure that only valid values are written here; tablesONLINE/CICS does no error checking on this area since normally only tableBASE writes here and tableBASE will never report, for example, a count that points beyond the end of a table.

****************************************************************
*    DEFINITION AREA FOR TABLE xxxxxxxx
*****************************************************************

     05  T-TBLX-DEF-AREA.
         10  T-TBLX-DEF-O-M-T-S.
             15  T-TBLX-DEF-ORG          PIC X.
             15  T-TBLX-DEF-MTHD         PIC X.
             15  T-TBLX-DEF-TYPE         PIC X.
             15  T-TBLX-DEF-SMC          PIC X.
         10  T-TBLX-DEF-RPSWD            PIC X(8).
         10  T-TBLX-DEF-WPSWD            PIC X(8).
         10  T-TBLX-DEF-ISZ              PIC S9(8) COMP.
         10  T-TBLX-DEF-KSZ              PIC S9(8) COMP.
         10  T-TBLX-DEF-KLOC             PIC S9(8) COMP.
         10  T-TBLX-DEF-EST              PIC S9(8) COMP.
         10  T-TBLX-DEF-GENS             PIC S9(4) COMP.
         10  T-TBLX-DEF-EXP              PIC S9(4) COMP.
         10  T-TBLX-DEF-LO-DEN           PIC S9(4) COMP.
         10  T-TBLX-DEF-HI-DEN           PIC S9(4) COMP.
         10  RESERVED                    PIC X(6).
         10  T-TBLX-DEF-DATE-TIME-2000.
             15  T-TBLX-DEF-CENTURY      PIC X(2).
             15  T-TBLX-DEF-DATE-TIME    PIC X(10).
         10  T-TBLX-DEF-ABS-GEN          PIC S9(4) COMP.
**** THESE FIELDS USED ONLY BY 'GD' COMMAND.
         10  T-TBLX-DEF-DSN              PIC X(44).
         10  T-TBLX-DEF-REL-GEN          PIC S9(4) COMP.
         10  T-TBLX-DEF-GEN-CNT          PIC S9(4) COMP.
         10  T-TBLX-DEF-MAX-ITEMS        PIC S9(8) COMP.
         10  T-TBLX-DEF-DDNAME           PIC X(8).
         10  T-TBLX-DEF-DATA-TABLE       PIC X(8).
         10  T-TBLX-DEF-OPEN-STATUS      PIC X.
         10  T-TBLX-DEF-ALTS-INVOKED     PIC X.
**** THESE FIELDS USED FOR 5.0 UPGRADE.
         10  T-TBLX-DEF-VERSION          PIC X.
         10  RESERVED                    PIC X.
         10  T-TBLX-DEF-USER-ID          PIC X(8).
         10  T-TBLX-DEF-VIEW-DATA-NAME   PIC X(8).
         10  RESERVED                    PIC X(12).
         10  T-TBLX-DEF-USER-COMMENTS    PIC X(16).
         10  RESERVED                    PIC X(76).
*

This is the tableBASE DT block, the table definition stored in the tableBASE library for the table for which tablesONLINE/CICS called the exit program. This area is read-only.

See the documentation for the DT command in Chapter 3 and the DEFINITION-BLOCK parameter in Chapter 4, or the table definition section of the tablesONLINE/CICS User’s Guide to interpret these fields.

****************************************************************
*    TRAILER AREA OF VIEW TABLE          PARM-TBL-ITM-FLD
****************************************************************

     05  T-TRLX-TABLE-ITEM.
         10  T-TRLX-DSPL-SEQ             PIC 9(5).
         10  T-TRLX-TBLDEFN-SUFFIX       PIC X.
         10  T-TRLX-KEY-IND              PIC X.
         10  T-TRLX-FLD-NAME             PIC X(20).
         10  RESERVED                    PIC X(8).
         10  T-TRLX-HELP-TABLE           PIC X(8).
         10  T-TRLX-EXITPGM-VERSION      PIC X.
         10  RESERVED                    PIC X(8).
         10  T-TRLX-TBLX-SUFFIX-LNGTH    PIC S9(4) COMP.
         10  T-TRLX-TBLX-SUFFIX-LOCN     PIC S9(4) COMP.
         10  T-TRLX-TBLX-DUPSOK-IND      PIC X.
         10  T-TRLX-TBLX-KEY-PROT-IND    PIC X.
         10  T-TRLX-TBLX-REORG-CODE      PIC X.
         10  T-TRLX-TBLX-MULTI-USER-IND  PIC X.
         10  T-TRLX-ITEM-HK-PGM          PIC X(8).
         10  T-TRLX-ITEM-HK-IN-IND       PIC X.
         10  T-TRLX-ITEM-HK-OUT-IND      PIC X.
         10  T-TRLX-ITEM-HK-XFLDCHK-IND  PIC X.
         10  T-TRLX-ITEM-EXCLUDE-IND     PIC X.
         10  T-TRLX-TABL-HK-PGM          PIC X(8).
         10  T-TRLX-TABL-HK-IN-IND       PIC X.
         10  T-TRLX-TABL-HK-OUT-IND      PIC X.
         10  T-TRLX-TABL-HK-CLOSE-IND    PIC X.
         10  T-TRLX-TABL-HK-UTIL-IND     PIC X.
         10  T-TRLX-TABL-HK-DEF-NEW-IND  PIC X.
         10  T-TRLX-TABL-HK-DEF-UPD-IND  PIC X.
         10  T-TRLX-TABL-HK-DEF-GET-IND  PIC X.
         10  RESERVED                    PIC X.
         10  T-TRLX-TBLX-ISZ             PIC S9(4) COMP.
         10  T-TRLX-TBLX-KLOC            PIC S9(4) COMP.
         10  T-TRLX-TBLX-KSZ             PIC S9(4) COMP.
         10  T-TRLX-FREEZE-KEY-CNT       PIC S9(4) COMP.
         10  T-TRLX-ROLL-THRU-FDT-IND    PIC X.
         10  RESERVED                    PIC X(103).
*

This is the View trailer area. Many of these fields are documented in the section on Supplementary View Information in the Defining Tables chapter of the tablesONLINE/CICS User’s Guide, which describes editing this trailer.

The three fields here, T-TRLX-TBLX-ISZ, T-TRLX-TBLX-KLOC, and T-TRLX-TBLX-KSZ, are respectively, the ITEM (ROW) SIZE, KEY LOCATION, and KEY SIZE as calculated from the View by tablesONLINE/CICS. These are checked at Table Open time for consistency with the tableBASE library information by tablesONLINE/CICS internal code, and the open fails if an inconsistency is encountered.

****************************************************************
*    COMMAND AREA FOR VIEW TABLE             PARM-ITM-FLD
****************************************************************
     05  T-FDTX-COMMAND-AREA.
         10  T-FDTX-COMMAND                  PIC X(2).
         10  T-FDTX-TABLE                    PIC X(8).
         10  T-FDTX-FOUND                    PIC X.
         10  T-FDTX-INDIRECT-OPEN            PIC X.
         10  T-FDTX-FILLER                   PIC X.
         10  T-FDTX-ABEND-STATUS             PIC X.
         10  T-FDTX-ERROR                    PIC S9(4) COMP.
         10  T-FDTX-COUNT                    PIC S9(8) COMP.
         10  T-FDTX-LOCK-LATCH               PIC X(8).
* REL 5 OR LATER COMMAND EXTENSION
         10  T-FDTX-ROW-OVERRIDE-LENGTH      PIC S9(8) COMP.
         10  T-FDTX-ROW-ACTUAL-LENGTH        PIC S9(8) COMP.
         10  T-FDTX-FG-KEY-LENGTH            PIC S9(4) COMP.
         10  T-FDTX-FUNCTION-ID              PIC S9(4) COMP.
         10  T-FDTX-FUNCTION-AREA.
             15  T-FDTX-DATE                 PIC 9(8).
         10  T-FDTX-RESERVED                 PIC X(24).
This is the tableBASE command area tablesONLINE/CICS uses to retrieve View information for the table it is operating on. This area is read-only.

****************************************************************
*    ITEM AREA OF VIEW TABLE                 PARM-FLD
****************************************************************
     05  T-FDTX-TABLE-ITEM.
         10  T-FDTX-DSPL-SEQ                 PIC 9(5).
         10  T-FDTX-DSPL-KEY           REDEFINES T-FDTX-DSPL-SEQ.
             15  T-FDTX-99KEY                PIC XX.
             15  T-FDTX-999SUFFIX            PIC XXX.
         10  T-FDTX-TBLDEFN-SUFFIX           PIC X.
         10  T-FDTX-KEY-IND                  PIC X.
         10  T-FDTX-FLD-NAME                 PIC X(20).
         10  T-FDTX-XTND-IND                 PIC X.
         10  T-FDTX-FLDN-EXTATT              PIC X(4).
         10  T-FDTX-DSPL-LNGTH               PIC S9(4) COMP.
         10  T-FDTX-DSPL-FORMT               PIC X.
         10  T-FDTX-DSPL-ATTR                PIC X.
         10  T-FDTX-DSPL-FEAT                PIC X.
         10  T-FDTX-DSPL-EXTATT              PIC X(4).
         10  RESERVED                        PIC X(10).
         10  T-FDTX-EXITPGM-VERSION          PIC X.
         10  T-FDTX-TBLX-LOCN                PIC S9(8) COMP.
         10  T-FDTX-TBLX-LNGTH               PIC S9(8) COMP.
         10  T-FDTX-TBLX-FORMT               PIC X.
         10  T-FDTX-EDIT-ACTION              PIC X.
         10  T-FDTX-EDIT-TBLNAME             PIC X(8).
         10  T-FDTX-EDIT-INPT-REF            PIC X(20).
         10  T-FDTX-EDIT-HK-PGM              PIC X(8).
         10  T-FDTX-EDIT-HK-IN-IND           PIC X.
         10  T-FDTX-EDIT-HK-OUT-IND          PIC X.
         10  RESERVED                        PIC X(100).
*
****************************************************************

This area holds the View row last retrieved by tablesONLINE/CICS. For field-level exits, it can be relied on to hold the View description of the current field.

Higher-level exits (item- and table-level) should not rely on information here. There is no way to know in an item-level or table-level exit what field was last accessed.

****************************************************************
*    EXIT USER AREA IN TRANSACTION WORK AREA  (96 BYTES)
****************************************************************

     05 T-EXIT-USER-AREA                 PIC X(96).

This area is reserved for exit-to-exit data passing and is entirely controlled by the exit developer.

Warning:
Some caution is necessary if several exits in one application use this area since there is only one such area. It is possible to create a situation in which exit program A leaves data here for exit B but exit X overwrites it before B sees it. If B blindly accepts it as valid data, this can become messy.
Where there is a potential problem the following recommendation applies: use part of the area to identify the writing process so that the reading process can validate at least that the data available was intended for it.

****************************************************************
*    ITEM AREA FROM PROFILE TABLE
****************************************************************

     05 RESERVED                             PIC X(1396).
 
****************************************************************
*    ITEM AREA FOR MENU OPTION TABLE
****************************************************************

     05  T-MENU-TABLE-ITEM.
         10  T-MENU-TRANSFER-OPTION.
             15  T-MENU-MAP-ID               PIC X(8).
             15  T-MENU-SELECT-SYMBOL        PIC X(4).
         10  T-MENU-TBLDEFN-SUFFIX           PIC X.
         10  T-MENU-SELECT-SYMBOL-X          PIC X(4).
         10  T-MENU-DESC-SHORT               PIC X(20).
         10  T-MENU-DESC-SHORT-X             PIC X(4).
         10  T-MENU-DESC-LONG                PIC X(50).
         10  T-MENU-DESC-LONG-X              PIC X(4).
         10  T-MENU-DISPLY-SW                PIC X(1).
         10  T-MENU-TRANSFER-PGM             PIC X(8).
         10  T-MENU-PGM-OP-MODE              PIC X.
         10  T-MENU-TBOL-SYSTEM-PGM          PIC X.
         10  T-MENU-TRANSFER-TRANID          PIC X(4).
         10  T-MENU-NEXT-SELECT              PIC X(4).
         10  T-MENU-TRANSFER-PARMS.
           12  T-MENU-TRANSFER-PARM1A.
             15  T-TRANS-MENU-MAP-ID         PIC X(8).
             15  T-TRANS-MENU-SEL-SYMBOL     PIC X(4).
             15  RESERVED                    PIC X(54).
           12  T-MENU-TRANSFER-PARM1B      REDEFINES
                                           T-MENU-TRANSFER-PARM1A.
             15  T-MENU-DBTYPE               PIC X(8).
             15  T-MENU-TBLX-NAME            PIC X(8).
             15  T-MENU-TBLX-FUNCTION        PIC X(8).
             15  T-MENU-TABLE-LIB            PIC X(8).
             15  T-MENU-SPECIAL-FDTX         PIC X(8).
             15  T-MENU-TBLX-RECOVER-IND     PIC X.
             15  T-MENU-TBLX-LOG-IND         PIC X.
             15  T-MENU-TBLX-DUPSOK-IND      PIC X.
             15  T-MENU-UTIL-FUNCTION-KEY    PIC X(8).
             15  T-MENU-VIEW-LIB             PIC X(8).
             15  RESERVED                    PIC X(7).
This area contains the row from the menu table corresponding to the selected menu option for Menu Command-level exits CMB and CMA.

*
  03  RESERVED                           PIC X(2352).
************************************************************
*    TBPARM FOR EDITING/BROWSING TABLE IN REMOTE VTS
*
************************************************************
  03  T-TRPARM.
     10  RESERVED                        PIC X(64).
*
*****************************************************************
*  END OF USER ACCESSIBLE EXITPARM
*****************************************************************

This last area is the new TBPARM created with Version 6 and is required when a table is opened in a VTS-TSR that is different from the designated systems VTS-TSR. If your installation has opted for VTS, and if you are writing exits using a table in a VTS-TSR that is not the systems VTS-TSR, then you should review the exit programs currently in use and determine if the exit is processing the same table that is being operated in by tablesONLINE/CICS. If it is, change the tableBASE calls in the exit program to use T-TRPARM rather than T-TBPARM. If you are unsure whether VTS is in use, making this change will not affect the operation of existing exits not using VTS-TSR processing, as TRPARM defaults to TBPARM if the table is in a local TSR.