DEFINITION-BLOCK (256 bytes)

The DEFINITION-BLOCK is used to Define Tables (DT), Change Definitions (CD), Get Definition information (GD) and Dump Definition (DD). You may use the definition block in four ways:

  • to define a new table using the DT command
  • to modify an existing table using the CD command
  • to obtain information about an existing table using the GD command
  • to obtain minimal information about an existing table using the DD command.
Because of the multi-purpose uses of the DEFINITION-BLOCK, some fields are input, while others are output. Default values are invoked by setting a field to LOW-VALUES (for any field) or SPACES (for alpha fields).

      01 XXXX-DEFINITION-BLOCK.
          05 XXXX-ORG                      PIC X VALUE 'S'.
          05 XXXX-METHOD                   PIC X VALUE 'B'.
          05 XXXX-INDEX                    PIC X VALUE 'P'.
          05 XXXX-SMC                      PIC X VALUE 'R'.
          05 XXXX-RPSWD                    PIC X(8) VALUE SPACES.
          05 XXXX-WPSWD                    PIC X(8) VALUE SPACES.
          05 XXXX-RSZ                      PIC S9(9) COMP VALUE +120.
          05 XXXX-KSZ                      PIC S9(9) COMP VALUE +11.
          05 XXXX-KLOC                     PIC S9(9) COMP VALUE +1.
          05 XXXX-ROWS                     PIC S9(9) COMP VALUE +500.
          05 XXXX-GENERATIONS              PIC S9(4) COMP VALUE +1.
          05 XXXX-EXP-FACT                 PIC S9(4) COMP VALUE +200.
          05 XXXX-LO-DEN                   PIC S9(4) COMP VALUE +200.
          05 XXXX-HI-DEN                   PIC S9(4) COMP VALUE +500.
          05 FILLER                        PIC X(6) VALUE LOW-VALUES.
          05 XXXX-DATE-TIME                PIC X(12) VALUE SPACES.
          05 XXXX-ABS-GEN-NO               PIC S9(4) COMP VALUE +0.
    * following not returned by DD command
          05 XXXX-DATASET-NAME             PIC X(44).
          05 XXXX-REL-GEN-NO               PIC S9(4) COMP.
          05 XXXX-GENS-PRESENT             PIC S9(4) COMP.
          05 XXXX-ROWS-AT-EXPAND           PIC S9(8) COMP.
          05 XXXX-DDNAME                   PIC X(8).
          05 XXXX-DATA-TABLE               PIC X(8).
          05 XXXX-OPEN-STATUS              PIC X.
          05 XXXX-ALTS-INVOKED             PIC X.
    *   Release 5.x additions follow
          05 XXXX-VIEW-VERSION             PIC X.
          05 FILLER                        PIC X.
          05 XXXX-USERID                   PIC X(8).
          05 XXXX-VIEW-NAME                PIC X(8).
          05 XXXX-VIEW-DATE                PIC X(12).
          05 XXXX-USER-COMMENTS            PIC X(16).
    *   Release 6.0.3 / 6.1.0 addition follows
          05 XXXX-VTSNAME                  PIC X(08).
          05 FILLER                        PIC X(68).

Note:
The fields VIEW-VERSION through USER-COMMENTS were added in Version 5. These fields are not captured or displayed if the TB-FORMAT field in the TB-PARM parameter is A, nor if the TB-PARM field is not supplied.