136 lines
3.2 KiB
COBOL
136 lines
3.2 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. TEST20a.
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
* INPUT-OUTPUT SECTION.
|
|
* FILE-CONTROL.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
WORKING-STORAGE SECTION.
|
|
|
|
01 WS-IDX PIC 9(3).
|
|
01 WS-IDX1 PIC 9(3).
|
|
01 WS-IDX2 PIC 9(3).
|
|
01 IDX2 PIC 9(3) COMP.
|
|
01 WS-RCODE PIC Z(4)9 VALUE ZERO.
|
|
|
|
01 WS-TABLE1-ENTRIES.
|
|
* copy TCtable1.
|
|
copy 'TCtable1.cpy'.
|
|
01 WS-TABLE1 REDEFINES WS-TABLE1-ENTRIES.
|
|
05 WS-TABLE1-ENTRY OCCURS 10 TIMES INDEXED BY IDX1.
|
|
10 WS-TABLE1-IDX PIC X(3).
|
|
10 WS-TABLE1-DATA PIC X(17).
|
|
|
|
01 WS-TABLE2-ENTRIES.
|
|
05 FILLER PIC X(20) VALUE '001MIS '.
|
|
05 FILLER PIC X(20) VALUE '002PAYROLL '.
|
|
05 FILLER PIC X(20) VALUE '003SALES '.
|
|
05 FILLER PIC X(20) VALUE '004SHIPPING '.
|
|
05 FILLER PIC X(20) VALUE '005ACCOUNTING '.
|
|
05 FILLER PIC X(20) VALUE '006DEPT1 '.
|
|
05 FILLER PIC X(20) VALUE '007DEPT2 '.
|
|
05 FILLER PIC X(20) VALUE '008DEPT3 '.
|
|
05 FILLER PIC X(20) VALUE '009DEPT4 '.
|
|
05 FILLER PIC X(20) VALUE '010OTHERS '.
|
|
01 WS-TABLE2 REDEFINES WS-TABLE2-ENTRIES.
|
|
05 WS-TABLE2-ENTRY OCCURS 10 TIMES.
|
|
10 WS-TABLE2-IDX PIC 9(3).
|
|
10 WS-TABLE2-DATA PIC X(17).
|
|
|
|
01 WS-TESTNO PIC 9(3).
|
|
01 WS-TABLENAME PIC X(2).
|
|
01 WS-E-IDX PIC 9(3).
|
|
PROCEDURE DIVISION.
|
|
|
|
A-000.
|
|
|
|
MOVE 0 TO WS-TESTNO.
|
|
MOVE "T1" TO WS-TABLENAME.
|
|
|
|
ADD 1 TO WS-TESTNO.
|
|
MOVE 3 TO WS-IDX1.
|
|
PERFORM A-100.
|
|
ADD 1 TO WS-TESTNO.
|
|
MOVE 5 TO WS-IDX1.
|
|
PERFORM A-100.
|
|
ADD 1 TO WS-TESTNO.
|
|
MOVE 33 TO WS-IDX1.
|
|
PERFORM A-100.
|
|
|
|
MOVE "T2" TO WS-TABLENAME.
|
|
|
|
ADD 1 TO WS-TESTNO.
|
|
MOVE 6 TO WS-IDX2.
|
|
PERFORM A-200.
|
|
ADD 1 TO WS-TESTNO.
|
|
MOVE 7 TO WS-IDX2.
|
|
PERFORM A-200.
|
|
ADD 1 TO WS-TESTNO.
|
|
MOVE 44 TO WS-IDX2.
|
|
PERFORM A-200.
|
|
|
|
MOVE RETURN-CODE TO WS-RCODE.
|
|
DISPLAY "WS-RCODE=" WS-RCODE.
|
|
|
|
STOP RUN.
|
|
|
|
A-100.
|
|
|
|
SET IDX1 TO 1.
|
|
|
|
SEARCH WS-TABLE1-ENTRY
|
|
AT END PERFORM A-400
|
|
WHEN WS-IDX1 = WS-TABLE1-IDX (IDX1)
|
|
MOVE 0 TO WS-IDX
|
|
PERFORM A-300.
|
|
|
|
A-200.
|
|
|
|
SET IDX2 TO 1.
|
|
|
|
SEARCH WS-TABLE2-ENTRY
|
|
VARYING IDX2
|
|
AT END PERFORM A-600
|
|
WHEN WS-IDX2 = WS-TABLE2-IDX (IDX2)
|
|
MOVE 0 TO WS-IDX
|
|
PERFORM A-500.
|
|
|
|
A-300.
|
|
|
|
MOVE IDX1 TO WS-E-IDX.
|
|
IF IDX1 = 3
|
|
DISPLAY "S" WS-TESTNO ":(" WS-TABLE1-ENTRY(IDX1)
|
|
"):(003SALES ):Entry "
|
|
WS-TABLENAME "/" WS-E-IDX
|
|
ELSE
|
|
DISPLAY "S" WS-TESTNO ":(" WS-TABLE1-ENTRY(IDX1)
|
|
"):(005ACCOUNTING ):Entry "
|
|
WS-TABLENAME "/" WS-E-IDX
|
|
END-IF.
|
|
|
|
A-400.
|
|
|
|
MOVE IDX1 TO WS-E-IDX.
|
|
DISPLAY "S" WS-TESTNO ":(" "NOT FOUND "
|
|
WS-E-IDX
|
|
"):(NOT FOUND 011):Entry T1/033".
|
|
A-500.
|
|
|
|
MOVE IDX2 TO WS-E-IDX.
|
|
IF IDX2 = 6
|
|
DISPLAY "S" WS-TESTNO ":(" WS-TABLE2-ENTRY(IDX2)
|
|
"):(006DEPT1 ):Entry "
|
|
WS-TABLENAME "/" WS-E-IDX
|
|
ELSE
|
|
DISPLAY "S" WS-TESTNO ":(" WS-TABLE2-ENTRY(IDX2)
|
|
"):(007DEPT2 ):Entry "
|
|
WS-TABLENAME "/" WS-E-IDX
|
|
END-IF.
|
|
|
|
A-600.
|
|
|
|
MOVE IDX2 TO WS-E-IDX.
|
|
DISPLAY "S006:(" "NOT FOUND " WS-E-IDX
|
|
"):(NOT FOUND 011):Entry T2/044".
|