89 lines
2.6 KiB
COBOL
89 lines
2.6 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. TEST32a.
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
* SPECIAL-NAMES.
|
|
* DECIMAL-POINT IS PERIOD.
|
|
* INPUT-OUTPUT SECTION.
|
|
* FILE-CONTROL.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
WORKING-STORAGE SECTION.
|
|
|
|
01 WS-IDX3 PIC 9(3).
|
|
01 WS-IDX1 PIC 9(3).
|
|
01 WS-IDX2 PIC 9(3).
|
|
01 IDX2 PIC 9(3) COMP.
|
|
* 01 IDX1 PIC 9(3).
|
|
01 WS-RCODE PIC Z(4)9 VALUE ZERO.
|
|
|
|
01 WS-TABLE1-ENTRIES VALUE SPACES.
|
|
05 WS-TABLE1-ENTRY1 OCCURS 10 TIMES.
|
|
10 WS-TABLE1-ENTRY2 OCCURS 10 TIMES.
|
|
15 WS-TABLE1-ENTRY3 OCCURS 10 TIMES.
|
|
20 WS-TABLE1-IDX PIC X(3).
|
|
20 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-TABLE3-ENTRIES VALUE SPACES.
|
|
05 WS-TABLE3-ENTRY1 OCCURS 10 TIMES.
|
|
10 WS-TABLE3-ENTRY2 OCCURS 10 TIMES.
|
|
15 WS-TABLE3-ENTRY3 OCCURS 10 TIMES.
|
|
20 WS-TABLE3-IDX PIC X(3).
|
|
20 WS-TABLE3-DATA PIC X(17).
|
|
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
A-000.
|
|
|
|
PERFORM A-100
|
|
VARYING WS-IDX1 FROM 1 BY 1 UNTIL WS-IDX1 > 10
|
|
AFTER WS-IDX2 FROM 1 BY 1 UNTIL WS-IDX2 > 10
|
|
AFTER WS-IDX3 FROM 1 BY 1 UNTIL WS-IDX3 > 10.
|
|
|
|
PERFORM A-200
|
|
VARYING WS-IDX1 FROM 1 BY 2 UNTIL WS-IDX1 > 10
|
|
AFTER WS-IDX2 FROM 1 BY 3 UNTIL WS-IDX2 > 10
|
|
AFTER WS-IDX3 FROM 1 BY 3 UNTIL WS-IDX3 > 10.
|
|
|
|
MOVE RETURN-CODE TO WS-RCODE.
|
|
DISPLAY "WS-RCODE=" WS-RCODE.
|
|
|
|
STOP RUN.
|
|
|
|
A-100.
|
|
|
|
* DISPLAY "ENTER A-100".
|
|
|
|
MOVE WS-TABLE2-ENTRY (WS-IDX1)
|
|
TO WS-TABLE1-ENTRY3(WS-IDX1 WS-IDX2 WS-IDX3).
|
|
MOVE WS-TABLE1-ENTRY3 (WS-IDX1 WS-IDX2 WS-IDX3)
|
|
TO WS-TABLE3-ENTRY3(WS-IDX2 WS-IDX1 WS-IDX3).
|
|
|
|
* DISPLAY "EXIT A-100".
|
|
|
|
A-200.
|
|
|
|
* DISPLAY "ENTER A-200".
|
|
DISPLAY "WS-TABLE3-ENTRY3(" WS-IDX1 ", "
|
|
WS-IDX2 ", "
|
|
WS-IDX3 ")="
|
|
WS-TABLE3-ENTRY3(WS-IDX1 WS-IDX2 WS-IDX3).
|
|
* DISPLAY "EXIT A-200".
|