The following is a sample of a COBOL program using TBACC commands:
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NOTE1 PIC X(32) VALUE
'SAMPLEWORKINGSTORAGESTARTS'.
01 xxxx-TBL-DEF.
05 xxxx-ROWS PIC S9(8)COMPVALUE+0.
05 xxxx-SIZE PIC S9(8)COMPVALUE+100.
05 xxxx-KEYSIZE PIC S9(8)COMPVALUE+7.
05 xxxx-KEYLOC PIC S9(8)COMPVALUE+4.
05 xxxx-MAX PIC S9(8)COMPVALUE+1000.
05 xxxx-SUB PIC S9(8)COMPVALUE+0.
05 xxxx-ORG PIC XVALUE'S'.
05 xxxx-FOUND PIC X.
05 xxxx-OVFLOW PIC X.
05 xxxx-ACTION PIC XVALUE'S'.
05 xxxx-METHOD PIC XVALUE'C'.
05 RESERVED PIC X(111)VALUELOW-VALUES.
01 TBL-AREA.
05 TBL-X PIC X(100) OCCURS 1000.
01 ROW-AREA.
05 FILLER PIC xxxx.
05 ROW-KEY PIC X(7).
05 FILLER PIC X(89).
01 NOTE2 PIC X(32)VALUE
'SAMPLEWORKINGSTORAGEENDS'.
PROCEDURE DIVISION.
**************************************************************
* NORMAL PROCESSING IN WHICH TABLE IS BUILT OR OBTAINED
**************************************************************
**************************************************************
* SEARCH (S)
**************************************************************
MOVE 'S' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-KEY.
IF xxxx-FOUND = 'Y'
PERFORM FOUND-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* INSERT (I)
**************************************************************
MOVE 'I' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-AREA.
IF xxxx-OVFLOW = 'Y'
PERFORM OVER-FLOW-ROUTINE.
**************************************************************
* DELETE (D)
**************************************************************
MOVE 'D' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA.
**************************************************************
* SEARCH & INSERT (U)
**************************************************************
MOVE 'U' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-KEY
ROW-AREA.
IF xxxx-FOUND = 'Y'
PERFORM FOUND-ROUTINE.
*
* IF NOT FOUND CHECK WHETHER TABLE OVERFLOWED.
*
IF xxxx-OVFLOW = 'Y'
PERFORM OVER-FLOW-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* SEARCH & DELETE (R)
**************************************************************
MOVE 'R' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-KEY.
IF xxxx-FOUND = 'Y'
PERFORM FOUND-ROUTINE
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* TAKE (T) --- COPY FROM TBL-X (xxxx-SUB) TO ROW-AREA
**************************************************************
MOVE 'T' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-AREA.
**************************************************************
* FETCH (F) --- SEARCH FOLLOWED BY A TAKE IF FOUND
**************************************************************
MOVE 'F' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-KEY
ROW-AREA.
IF xxxx-FOUND = 'Y'
PERFORM FOUND-ROUTINE-1
ELSE
PERFORM NOT-FOUND-ROUTINE.
**************************************************************
* PUT (P) --- COPY FROM ROW-AREA TO TBL-X (xxxx-SUB)
**************************************************************
MOVE 'P' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA
ROW-AREA.
**************************************************************
* ARRANGE (A)
**************************************************************
MOVE 'A' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA.
**************************************************************
* COMPRESS (C)
**************************************************************
MOVE 'C' TO xxxx-ACTION.
CALL 'TBACC' USING xxxx-TBL-DEF
TBL-AREA.
FOUND-ROUTINE.
* USING THIS FOUND ROUTINE, THE FOUND ROW MUST BE
* ADRESSED IN THE TABLE BY MEANS OF SUBSCRIPTING,
* OR MOVED OUT INTO A WORK AREA.
FOUND-ROUTINE-1.
* USING THIS FOUND ROUTINE, THE FOUND ROW IS IN
* ROW-AREA.
NOT-FOUND-ROUTINE.
OVERFLOW-ROUTINE.
*
**************************************************************