Sample COBOL program using TBINDX

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.