The following is a sample of a COBOL program using TBINDX commands.
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 P-4 PIC X(32) VALUE 'SAMPLE WORKING STORAGE STARTS'.
**************************************************************
* FOR KEY 1
**************************************************************
01 X1-TBL-DEF.
05 X1-N PIC S9(9) COMP VALUE +0.
05 X1-RSZ PIC S9(9) COMP VALUE +100.
05 X1-ASZ PIC S9(9) COMP VALUE +7.
05 X1-ALOC PIC S9(9) COMP VALUE +4.
05 X1-M PIC S9(9) COMP VALUE +1000.
05 X1-TAG-I PIC S9(9) COMP VALUE +0.
05 X1-ORG PIC X VALUE 'S'.
05 X1-FND-CD PIC X.
88 X1-FND VALUE 'Y'.
05 X1-OVFL-CD PIC X.
88 X1-OVFL VALUE 'Y'.
05 X1-ACTION PIC X VALUE 'S'.
05 X1-METHOD PIC X VALUE 'C'.
05 FILLER PIC XXX VALUE LOW-VALUES.
05 X1-PRIMARY-I PIC S9(9) COMP VALUE +0.
05 FILLER PIC X(220) VALUE LOW-VALUES.
01 TAG-AREA-1.
05 FILLER PIC X(8) OCCURS 1000.
**************************************************************
* FOR KEY 2
**************************************************************
01 X2-TBL-DEF.
05 X2-N PIC S9(9) COMP VALUE +0.
05 X2-RSZ PIC S9(9) COMP VALUE +100.
05 X2-ASZ PIC S9(9) COMP VALUE +6.
05 X2-ALOC PIC S9(9) COMP VALUE +16.
05 X2-M PIC S9(9) COMP VALUE +1000.
05 X2-TAG-I PIC S9(9) COMP VALUE +0.
05 X2-ORG PIC X VALUE 'S'.
05 X2-FND-CD PIC X.
88 X2-FND VALUE 'Y'.
05 X2-OVFL-CD PIC X.
88 X2-OVFL VALUE 'Y'.
05 X2-ACTION PIC X VALUE 'S'.
05 X2-METHOD PIC X VALUE 'C'.
05 FILLER PIC XXX VALUE LOW-VALUES.
05 X2-PRIMARY-I PIC S9(9) COMP VALUE +0.
05 FILLER PIC X(220) VALUE LOW-VALUES.
01 TAG-AREA-2.
05 FILLER PIC X(8) OCCURS 1000.
**************************************************************
* FOR KEY 3
**************************************************************
01 X3-TBL-DEF.
05 X3-N PIC S9(9) COMP VALUE +0.
05 X3-RSZ PIC S9(9) COMP VALUE +100.
05 X3-ASZ PIC S9(9) COMP VALUE +10.
05 X3-ALOC PIC S9(9) COMP VALUE +36.
05 X3-M PIC S9(9) COMP VALUE +1000.
05 X3-TAG-I PIC S9(9) COMP VALUE +0.
05 X3-ORG PIC X VALUE 'S'.
05 X3-FND-CD PIC X.
88 X3-FND VALUE 'Y'.
05 X3-OVFL-CD PIC X.
88 X3-OVFL VALUE 'Y'.
05 X3-ACTION PIC X VALUE 'S'.
05 X3-METHOD PIC X VALUE 'C'.
05 FILLER PIC XXX VALUE LOW-VALUES.
05 X3-PRIMARY-I PIC S9(9) COMP VALUE +0.
05 FILLER PIC X(220) VALUE LOW-VALUES.
01 TAG-AREA-3.
05 FILLER PIC X(8) OCCURS 1000.
*************************************************************
* FOR KEY 1 BUT FOR HASH ORGANIZATION
*************************************************************
01 XH-TBL-DEF.
05 XH-N PIC S9(9) COMP VALUE +0.
05 XH-RSZ PIC S9(9) COMP VALUE +100.
05 XH-ASZ PIC S9(9) COMP VALUE +7.
05 XH-ALOC PIC S9(9) COMP VALUE +4.
05 XH-M PIC S9(9) COMP VALUE +1000.
05 XH-TAG-I PIC S9(9) COMP VALUE +0.
05 XH-ORG PIC X VALUE 'H'.
05 XH-FND-CD PIC X.
88 XH-FND VALUE 'Y'.
05 XH-OVFL-CD PIC X.
88 XH-OVFL VALUE 'Y'.
05 XH-ACTION PIC X VALUE 'S'.
05 XH-METHOD PIC X VALUE 'H'.
05 FILLER PIC XXX VALUE LOW-VALUES.
05 XH-PRIMARY-I PIC S9(9) COMP VALUE +0.
05 XH-TAG-MAX PIC S9(9) COMP VALUE +1500.
05 FILLER PIC X(4) VALUE LOW-VALUES.
05 FILLER PIC X(212) VALUE LOW-VALUES.
01 TAG-AREA-H.
05 FILLER PIC X(8) OCCURS 1500.
01 TBL-AREA.
05 TBL-X PIC X(100) OCCURS 1000.
01 ROW-AREA.
05 FILLER PIC X(4).
05 ROW-KEY-1 PIC X(7).
05 FILLER PIC X(5).
05 ROW-KEY-2 PIC X(6).
05 FILLER PIC X(14).
05 ROW-KEY-3 PIC X(10).
05 FILLER PIC X(54).
PROCEDURE DIVISION.
**************************************************************
* NORMAL PROCESSING IN WHICH TABLE IS BUILT OR OBTAINED.
**************************************************************
**************************************************************
* INITIALIZE TAG TABLES
**************************************************************
MOVE 'G' TO X1-ACTION.
CALL 'TBINDX' USING X1-TBL-DEF
TBL-AREA
TAG-AREA-1.
MOVE 'G' TO X2-ACTION.
CALL 'TBINDX' USING X2-TBL-DEF
TBL-AREA
TAG-AREA-2.
MOVE 'G' TO X3-ACTION.
CALL 'TBINDX' USING X3-TBL-DEF
TBL-AREA
TAG-AREA-3.
**************************************************************
* SEARCH USING KEY-1
**************************************************************
MOVE 'S' TO X1-ACTION.
CALL 'TBINDX' USING X1-TBL-DEF
TBL-AREA
TAG-AREA-1
ROW-KEY-1.
IF X1-FND
PERFORM FOUND-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* SEARCH USING KEY-2
**************************************************************
MOVE 'S' TO X2-ACTION.
CALL 'TBINDX' USING X2-TBL-DEF
TBL-AREA
TAG-AREA-2
ROW-KEY-2.
IF X2-FND
PERFORM FOUND-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* SEARCH USING KEY-3
**************************************************************
MOVE 'S' TO X3-ACTION.
CALL 'TBINDX' USING X3-TBL-DEF
TBL-AREA
TAG-AREA-3
ROW-KEY-3.
IF X3-FND
PERFORM FOUND-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* SEARCH USING KEY-1 BUT WITH HASH TABLE ORGANIZATION
**************************************************************
MOVE 'S' TO XH-ACTION.
CALL 'TBINDX' USING XH-TBL-DEF
TBL-AREA
TAG-AREA-H
ROW-KEY-1.
IF XH-FND
PERFORM FOUND-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* INSERT USING LOCATION FOUND BY MEANS OF PREVIOUS
* SEARCH USING KEY-1.
**************************************************************
MOVE 'I' TO X1-ACTION.
CALL 'TBINDX' USING X1-TBL-DEF
TBL-AREA
TAG-AREA-1
ROW-AREA.
IF X1-OVFL
PERFORM OVER-FLOW-ROUTINE.
**************************************************************
* INSERT USING LOCATION FOUND BY MEANS OF PREVIOUS SEARCH
* USING KEY-2.
**************************************************************
MOVE 'I' TO X2-ACTION.
CALL 'TBINDX' USING X2-TBL-DEF
TBL-AREA
TAG-AREA-2
ROW-AREA.
IF X2-OVFL
PERFORM OVER-FLOW-ROUTINE.
**************************************************************
* INSERT USING LOCATION FOUND BY MEANS OF PREVIOUS
* SEARCH USING KEY-3.
**************************************************************
MOVE 'I' TO X3-ACTION.
CALL 'TBINDX' USING X3-TBL-DEF
TBL-AREA
TAG-AREA-3
ROW-AREA.
IF X3-OVFL
PERFORM OVER-FLOW-ROUTINE.
**************************************************************
* INSERT USING LOCATION FOUND BY MEANS OF PREVIOUS
* UNSUCCESSFUL SEARCH USING KEY-1.
**************************************************************
MOVE 'I' TO XH-ACTION.
CALL 'TBINDX' USING XH-TBL-DEF
TBL-AREA
TAG-AREA-H
ROW-AREA.
IF XH-OVFL
PERFORM OVERFLOW-ROUTINE.
**************************************************************
* SEARCH & INSERT (U) USING KEY-1
**************************************************************
MOVE 'U' TO X1-ACTION.
CALL 'TBINDX' USING X1-TBL-DEF
TBL-AREA
TAG-AREA-1
ROW-KEY-1
ROW-AREA.
IF NOT X1-FND
PERFORM NOT-FOUND-ROUTINE.
*
* IF FOUND CHECK WHETHER TABLE OVERFLOWED.
*
IF X1-OVFL
PERFORM OVER-FLOW-ROUTINE
ELSE
PERFORM FOUND-ROUTINE.
**************************************************************
* SEARCH & INSERT (U) USING KEY-2
**************************************************************
MOVE 'U' TO X2-ACTION.
CALL 'TBINDX' USING X2-TBL-DEF
TBL-AREA
TAG-AREA-2
ROW-KEY-2
ROW-AREA.
IF NOT X2-FND
PERFORM NOT-FOUND-ROUTINE.
*
* IF FOUND CHECK WHETHER TABLE OVERFLOWED.
*
IF X2-OVFL
PERFORM OVER-FLOW-ROUTINE
ELSE
PERFORM FOUND-ROUTINE.
**************************************************************
* SEARCH & INSERT (U) USING KEY-3
**************************************************************
MOVE 'U' TO X3-ACTION.
CALL 'TBINDX' USING X3-TBL-DEF
TBL-AREA
TAG-AREA-3
ROW-KEY-3
ROW-AREA.
IF NOT X3-FND
PERFORM NOT-FOUND-ROUTINE.
*
* IF FOUND, CHECK WHETHER TABLE OVERFLOWED.
*
IF X3-OVFL
PERFORM OVER-FLOW-ROUTINE
ELSE
PERFORM FOUND-ROUTINE.
**************************************************************
* SEARCH & INSERT (U) USING KEY-1 BUT WITH HASH ORGANIZATION
**************************************************************
MOVE 'U' TO XH-ACTION.
CALL 'TBINDX' USING XH-TBL-DEF
TBL-AREA
TAG-AREA-H
ROW-KEY-1
ROW AREA.
IF NOT XH-FND
PERFORM NOT-FOUND-ROUTINE.
*
* IF FOUND CHECK WHETHER TABLE OVERFLOWED.
*
IF XH-OVFL
PERFORM OVER-FLOW-ROUTINE
ELSE
PERFORM FOUND-ROUTINE.
**************************************************************
* GENERATE INDICES
*IF ORG = R INDICES ARE GENERATED IN SAME SEQUENCE
*AS PRIMARY TABLE.
*IF ORG = S INDICES WILL BE SORTED.
*IF ORG = H A HASH INDEX TABLE IS GENERATED.
**************************************************************
MOVE 'G' TO XH-ACTION.
CALL 'TBINDX' USING X1-TBL-DEF
TBL-AREA
TAG-AREA-1.
**************************************************************
* HASH IN PLACE
**************************************************************
MOVE 'H' TO XH-ACTION.
CALL 'TBINDX' USING XH-TBL-DEF
TBL-AREA
TAG-AREA-H
ROW-AREA.
FOUND-ROUTINE.
NOT-FOUND-ROUTINE.
OVER-FLOW-ROUTINE.