This sample sub-program is an illustration of how calls to tableBASE from application programs can be isolated by being directed to a sub-program which handles tableBASE calls. It is a sample for the batch environment and will need to be tailored for each environment.
This is a sample only, and is not supported by DataKinetics.
The commonly used tableBASE commands are illustrated, but not all tableBASE commands have been coded to support all tableBASE calls. Note that this sub-program restricts usage of optional parameters for some supported commands for best practices.
The call structure could be modified to include a parameter indicating the level of the interface in case incompatible changes are added to this interface in the future. The call structure requires the caller to:
- Use a separate COMMAND-AREA for each table.
- Fill in the command and table name in the COMMAND-AREA as required.
- Use the V1 Internal command to set VTSNAME in the TB-PARM
- Map the TB-DATA-AREA-1 (and TB-DATA-AREA-2) appropriately for a table-row or other uses based on TB-COMMAND.
This sub-program contains the TBPARM. This works well when called in a batch environment. The TBPARM may have to be maintained in the calling program in a transaction-based or multi-tasking environment.
Input parameters to the sub-program:
- Command area – see definition TB-COMMAND-AREA for details
- Data Area 1 – see TB-DATA-AREA-1 for details
- Data Area 2 – see TB-DATA-AREA-2 for details
Output from the sub-program:
- 2 Unexpected found code
- 4 Non-zero tableBASE error code
- 8 tableBASE command not supported by this sub-program
- 12 Invalid call syntax for this sub-program
Sample invocation:
* MOVE 'FK' to TB-COMMAND
* MOVE table-name to TB-TABLE-NAME
* MOVE table-key to ROW-AREA(key-location:key-length)
* CALL TBTMPLAT USING TB-COMMAND-AREA ROW-AREA
* IF RETURN-CODE NOT = 0
* EVALUATE RETURN-CODE
* WHEN 2 PERFORM NOT-FOUND-ROUTINE
* WHEN 4 PERFORM UNEXPECTED-TABLEBASE-ERROR
* WHEN 8 PERFORM UNSUPPORTED-COMMAND
* WHEN 12 PERFORM SYNTAX-ERROR Callers must use OMITTED for missing parameters for commands with optional parameters (GD, OR, or OW). COBOL cannot detect whether parameters are missing. For example:
* CALL TBTMPLAT USING TB-COMMAND-AREA OMITTED OMITTED The following shows the TBTMPLAT program details.
IDENTIFICATION DIVISION.
PROGRAM-ID. TBTMPLAT.
AUTHOR. Data Kinetics, Ltd.
*----------------------------------------------------------------*
*----------------------------------------------------------------*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
* Definition block not currently used, could be used by N1.
01 DEFINITION-BLOCK.
05 DEF-ORG PIC X VALUE 'S'.
05 DEF-MTHD PIC X VALUE 'B'.
05 DEF-TYPE PIC X VALUE 'T'.
05 DEF-SMC PIC X VALUE 'R'.
05 DEF-READ-PSWD PIC X(8) VALUE SPACES.
05 DEF-WRITE-PSWD PIC X(8) VALUE SPACES.
05 DEF-ROW-SIZE PIC S9(8) COMP VALUE +80.
05 DEF-KEY-SIZE PIC S9(8) COMP VALUE +4.
05 DEF-KEY-LOC PIC S9(8) COMP VALUE +1.
05 DEF-EST-NO-ROWS PIC S9(8) COMP VALUE +50.
05 DEF-GENERATIONS PIC S9(4) COMP VALUE +5.
05 DEF-EXP PIC S9(4) COMP VALUE +0.
05 DEF-LO-DENSITY PIC S9(4) COMP VALUE +0.
05 DEF-UP-DENSITY PIC S9(4) COMP VALUE +0.
05 FILLER PIC X(6) VALUE LOW-VALUE.
05 DEF-DATE-TIME PIC X(12) VALUE SPACES.
05 DEF-ABS-GEN PIC S9(4) COMP.
05 DEF-DSN PIC X(44) VALUE SPACES.
05 DEF-REL-GEN PIC S9(4) COMP VALUE +0.
05 DEF-GENS-PRESENT PIC S9(4) COMP VALUE +0.
05 DEF-MAX-ITEMS PIC S9(8) COMP VALUE +0.
05 DEF-DDNAME PIC X(8).
05 DEF-TB-NAME PIC X(8).
05 DEF-OPEN-STATUS PIC X.
05 DEF-ALT-INVOKED PIC X.
05 DEF-VIEW-VERSION PIC X.
05 FILLER PIC X.
05 DEF-USERID PIC X(8).
05 DEF-VIEW-NAME PIC X(8).
05 DEF-VIEW-DATE PIC X(12).
05 DEF-USER-COMMENTS PIC X(16).
05 FILLER PIC X(76).
01 TB-PARM.
05 FILLER PIC X(2) VALUE 'TB'.
05 FILLER PIC X(2) VALUE LOW-VALUES.
05 FILLER PIC X VALUE '5'.
05 FILLER PIC X VALUE '0'.
05 FILLER PIC X(18) VALUE LOW-VALUES.
05 TB-SUBSYSTEM PIC X(08) VALUE LOW-VALUES.
05 FILLER PIC X(04) VALUE LOW-VALUES.
05 FILLER PIC X(08) VALUE LOW-VALUES.
05 FILLER PIC X(20) VALUE LOW-VALUES.
LINKAGE SECTION.
01 TB-COMMAND-AREA.
* --------------------------------------------------------------
* The following field, TB-COMMAND, determines TBTMPLAT processing
* The 88-levels sub-divide the supported commands into categories
* a) by functional group: all supported command must be listed
* b) by how the found code is to be interpreted
* c) by how many parmeters must be supplied (default is 1)
* note: not all variations of command parms are supported
* --------------------------------------------------------------
05 TB-COMMAND PIC X(02).
* Read Commands
88 READ-CMD VALUE 'GN' 'FK' 'FC' 'FG'
'GF' 'SK' 'FN' 'GL' 'GP'.
* Update Commands
88 UPDATE-CMD VALUE 'IK' 'IC' 'RK' 'RC'
'MT' 'DK' 'DC'.
* Table Control Commands
* Note: IA only supported for dynamic alternate index
88 TABLE-CMD VALUE 'OR' 'OW' 'DT' 'IA' 'CL'
'GD' 'RL' 'CD' 'ST' 'CN'.
* System Control Commands
88 CONTROL-CMD VALUE 'ML' 'LL' 'CS' 'LS' 'BN'.
* Internally Defined Commands
88 WRAPPER-CMD VALUE 'V1' 'N1'.
* Commands for which FOUND is NOT OK.
88 FOUND-NOT-GOOD VALUE 'IK' 'IC'.
* Commands with no parameters
88 NO-PARM-CMD VALUE 'MT' 'CL' 'RL' 'ST'.
* Commands with two parameters
88 TWO-PARM-CMD VALUE 'FG' 'IA' 'BN'.
* Commands with an optional number of parameters
88 OPT-PARM-CMD VALUE 'OR' 'OW' 'GD'.
* By default, remaining commands require one parameter
05 TB-TABLE-NAME PIC X(08).
05 TB-FOUND PIC X.
88 TABLE-FOUND VALUE 'Y'.
05 TB-INDIRECT-OPEN PIC X.
05 FILLER PIC X.
05 TB-ABEND-OVERRIDE-IND PIC X.
05 TB-ERROR PIC S9(4) COMP-5.
88 TB-CALL-OK VALUE 0.
05 TB-COUNT PIC S9(9) COMP-5.
05 TB-LOCK PIC X(8).
05 FILLER PIC S9(9) COMP-5.
05 FILLER PIC X(16).
05 FILLER PIC X(20).
05 FILLER PIC X(2).
05 TB-ERROR-SUB-CODE PIC S9(4) COMP-5.
* Used for Row area and embedded Key-area for Read/Update commands
* Used for DEFINE-BLOCK for GD, DT, CD
* Used for TABLE-NAME for CN, IA
* Used for LIBRARY-LIST for LL,ML
* Used for STATUS-SWITCHES for LL,ML
* Used for BANNER info for BN command
* Used for VTSNAME for V1 command
01 TB-DATA-AREA-1 PIC X(32768).
* Used for alternate definition for IA command.
* Used for level info for BN command
01 TB-DATA-AREA-2 PIC X(16).
******************************************************************
PROCEDURE DIVISION USING TB-COMMAND-AREA
TB-DATA-AREA-1
TB-DATA-AREA-2.
* Ensure sufficient parameters are provided
* Note that optional parmeters are ignored for some commands
* (FG,FK,IK,RK,DK) and required for others (IA,BN)
Evaluate True
When Opt-parm-cmd
Continue
When No-parm-cmd
Continue
When Two-parm-Cmd
If ADDRESS of TB-DATA-AREA-2 = NULL
Move +12 to RETURN-CODE
DISPLAY 'TBTMPLAT Syntax error - Insufficient parms'
End-If
When other
If ADDRESS of TB-DATA-AREA-1 = NULL
Move +12 to RETURN-CODE
DISPLAY 'TBTMPLAT Syntax error - Insufficient parms'
End-If
End-Evaluate
* Based on tableBASE command, call tableBASE appropriately
If ADDRESS of TB-COMMAND-AREA NOT = NULL
EVALUATE TRUE
WHEN READ-CMD PERFORM CALL-TBLBASE-READ-UPDATE
WHEN UPDATE-CMD PERFORM CALL-TBLBASE-READ-UPDATE
WHEN TABLE-CMD PERFORM CALL-TBLBASE-TABLE
WHEN CONTROL-CMD PERFORM CALL-TBLBASE-CONTROL
WHEN WRAPPER-CMD PERFORM DO-WRAPPER-CMD
WHEN OTHER PERFORM NO-SUCH-COMMAND
END-EVALUATE
Else
PERFORM
MOVE +12 to RETURN-CODE
DISPLAY 'TBTMPLAT Syntax error - no COMMAND-AREA'
END-PERFORM
End-if
GOBACK.
*----------------------------------------------------------------
CALL-TBLBASE-READ-UPDATE.
Evaluate True
When NO-PARM-CMD
* Must be MT command
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
When TWO-PARM-CMD
* Must be FG command
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
TB-DATA-AREA-2
When Other
* One parameter is assumed
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
End-Evaluate
If TB-CALL-OK
If TB-COMMAND = 'MT'
MOVE 0 to RETURN-CODE
Else
If FOUND-NOT-GOOD
If TABLE-FOUND
MOVE +2 to RETURN-CODE
Else
MOVE 0 to RETURN-CODE
End-if
Else
If TABLE-FOUND
MOVE 0 to RETURN-CODE
Else
MOVE +2 to RETURN-CODE
End-if
End-if
End-if
Else
PERFORM
MOVE +4 to RETURN-CODE
DISPLAY 'TBTMPLAT TableBASE error '
TB-ERROR ' ' TB-ERROR-SUB-CODE
END-PERFORM
End-if
EXIT.
*----------------------------------------------------------------
CALL-TBLBASE-TABLE.
EVALUATE TRUE
WHEN NO-PARM-CMD
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
WHEN TWO-PARM-CMD
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
TB-DATA-AREA-2
WHEN OPT-PARM-CMD
If ADDRESS of TB-DATA-AREA-1 = NULL
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
Else
If ADDRESS of TB-DATA-AREA-2 = NULL
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
Else
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
TB-DATA-AREA-2
End-if
End-if
WHEN OTHER
* One parameter is assumed
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
END-EVALUATE
If TB-CALL-OK
If TB-COMMAND = 'GD'
If TABLE-FOUND
MOVE +0 to RETURN-CODE
Else
MOVE +2 to RETURN-CODE
End-if
Else
MOVE 0 to RETURN-CODE
End-if
Else
PERFORM
MOVE +4 to RETURN-CODE
DISPLAY 'TBTMPLAT TableBASE error '
TB-ERROR ' ' TB-ERROR-SUB-CODE
' on ' TB-COMMAND ' ' TB-TABLE-NAME
END-PERFORM
End-if
EXIT.
*----------------------------------------------------------------
CALL-TBLBASE-CONTROL.
If TWO-PARM-CMD
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
TB-DATA-AREA-2
Else
CALL 'TBLBASE' USING TB-PARM
TB-COMMAND-AREA
TB-DATA-AREA-1
End-if
If TB-CALL-OK
MOVE +0 to RETURN-CODE
Else
PERFORM
MOVE +4 to RETURN-CODE
DISPLAY 'TBTMPLAT TableBASE error '
TB-ERROR '-' TB-ERROR-SUB-CODE
' on ' TB-COMMAND
END-PERFORM
End-if
EXIT.
*----------------------------------------------------------------
DO-WRAPPER-CMD.
EVALUATE TB-COMMAND
WHEN 'N1'
*--- This command would create a temporary table with a
* unique name. The table name would be maintained in
* a table so it could be later used by a CL command.
*--- It would return the table name in TB-TABLE-NAME.
Display 'TBTMPLAT command N1 not yet implemented'
MOVE +8 to RETURN-CODE
WHEN 'V1'
Move TB-DATA-AREA-1 to TB-SUBSYSTEM
MOVE 0 to TB-ERROR TB-ERROR-SUB-CODE
MOVE SPACES to TB-FOUND
MOVE 0 to RETURN-CODE
WHEN OTHER
Display 'TBTMPLAT command ' TB-COMMAND
' not yet implemented'
MOVE +8 to RETURN-CODE
END-EVALUATE
EXIT.
*----------------------------------------------------------------
NO-SUCH-COMMAND.
DISPLAY 'TBTMPLAT call error: ' TB-COMMAND ' not Supported'
MOVE +8 to RETURN-CODE
EXIT.