227 lines
9.0 KiB
COBOL
227 lines
9.0 KiB
COBOL
|
IDENTIFICATION DIVISION.
|
|||
|
PROGRAM-ID. BUILD.
|
|||
|
SECURITY.
|
|||
|
THIS PROGRAM CREATES AN INDEXED FILE OF NAMES, ADDRESSES,
|
|||
|
AND PHONE NUMBERS
|
|||
|
*
|
|||
|
ENVIRONMENT DIVISION.
|
|||
|
INPUT-OUTPUT SECTION.
|
|||
|
FILE-CONTROL.
|
|||
|
SELECT ISAM-FILE
|
|||
|
ASSIGN TO DISK
|
|||
|
FILE STATUS IS ISAM-STATUS
|
|||
|
RECORD KEY IS ISAM-KEY
|
|||
|
ACCESS MODE IS RANDOM
|
|||
|
ORGANIZATION IS INDEXED.
|
|||
|
|
|||
|
DATA DIVISION.
|
|||
|
FILE SECTION.
|
|||
|
FD ISAM-FILE
|
|||
|
LABEL RECORDS ARE STANDARD
|
|||
|
VALUE OF FILE-ID IS 'ISAM.DAT'.
|
|||
|
|
|||
|
01 ISAM-RECORD.
|
|||
|
05 ISAM-KEY.
|
|||
|
10 ISAM-LAST-NAME PIC X(20).
|
|||
|
10 ISAM-FIRST-NAME PIC X(20).
|
|||
|
05 ISAM-ADDRESS-LINE-1 PIC X(40).
|
|||
|
05 ISAM-ADDRESS-LINE-2 PIC X(40).
|
|||
|
05 ISAM-PHONE PIC X(12).
|
|||
|
|
|||
|
|
|||
|
WORKING-STORAGE SECTION.
|
|||
|
|
|||
|
01 WORK-FIELDS.
|
|||
|
05 IIX PIC S9(5) VALUE 0 COMP-0.
|
|||
|
05 JIX PIC S9(5) VALUE 0 COMP-0.
|
|||
|
05 KIX PIC S9(5) VALUE 0 COMP-0.
|
|||
|
05 ISAM-STATUS PIC XX VALUE SPACES.
|
|||
|
|
|||
|
|
|||
|
05 WS-MORE PIC X VALUE SPACES.
|
|||
|
88 NO-MORE VALUE 'N', 'n'.
|
|||
|
|
|||
|
05 ANY-CHAR PIC X VALUE SPACE.
|
|||
|
|
|||
|
01 SWITCHES.
|
|||
|
05 ON-VALUE PIC X VALUE 'Y'.
|
|||
|
05 OFF-VALUE PIC X VALUE 'N'.
|
|||
|
05 BUILD-FINISHED-SW PIC X VALUE 'N'.
|
|||
|
88 BUILD-FINISHED VALUE 'Y'.
|
|||
|
|
|||
|
01 WS-DATA-RECORD.
|
|||
|
05 WS-KEY.
|
|||
|
10 WS-LAST-NAME PIC X(20) VALUE SPACES.
|
|||
|
10 WS-FIRST-NAME PIC X(20) VALUE SPACES.
|
|||
|
05 WS-ADDRESS-LINE-1 PIC X(40) VALUE SPACES.
|
|||
|
05 WS-ADDRESS-LINE-2 PIC X(40) VALUE SPACES.
|
|||
|
05 WS-PHONE PIC X(12) VALUE SPACES.
|
|||
|
|
|||
|
LINKAGE SECTION.
|
|||
|
01 LS-TITLE PIC X(50).
|
|||
|
|
|||
|
SCREEN SECTION.
|
|||
|
|
|||
|
01 BLANK-SCREEN.
|
|||
|
03 BLANK SCREEN.
|
|||
|
|
|||
|
01 TUTOR-SCREEN.
|
|||
|
03 BLANK SCREEN.
|
|||
|
03 LINE 1 COLUMN 17 VALUE
|
|||
|
'MS-COBOL INDEXED FILE CREATION DEMONSTRATION'.
|
|||
|
03 LINE 2 COLUMN 15 PIC X(50) FROM LS-TITLE HIGHLIGHT.
|
|||
|
03 LINE 4 COLUMN 5 VALUE
|
|||
|
'This is subprogram BUILD, CALLed from main program DEM
|
|||
|
- 'O.'.
|
|||
|
03 LINE 5 COLUMN 5 VALUE
|
|||
|
'The title above was passed as a parameter from DEMO.'.
|
|||
|
03 LINE 7 COLUMN 1 VALUE
|
|||
|
'In this program, you will create an indexed (ISAM) fil
|
|||
|
- 'e of records containing '.
|
|||
|
03 LINE 8 COLUMN 1 VALUE
|
|||
|
'names, addresses, and phone numbers. After the data fo
|
|||
|
- 'r one person '.
|
|||
|
03 LINE 9 COLUMN 1 VALUE
|
|||
|
'has been entered, you will be given the opportunity to
|
|||
|
- ' review the data.'.
|
|||
|
03 LINE 11 COLUMN 1 VALUE
|
|||
|
'If the data is ok, it will be written to files ISAM.DA
|
|||
|
- 'T and ISAM.KEY.'.
|
|||
|
03 LINE 13 COLUMN 1 VALUE
|
|||
|
'The full name of the person will be used as a key for
|
|||
|
- 'searching the'.
|
|||
|
03 LINE 14 COLUMN 1 VALUE
|
|||
|
'file in program UPDATE.'.
|
|||
|
03 LINE 16 COLUMN 1 VALUE
|
|||
|
'To end this program, reply N to the question:'.
|
|||
|
03 LINE 17 COLUMN 1 VALUE
|
|||
|
' "Do you wish to enter more data?(Y/N)"'.
|
|||
|
03 LINE 18 COLUMN 1 VALUE
|
|||
|
'when it appears on the screen.'.
|
|||
|
03 LINE 20 COLUMN 1 HIGHLIGHT VALUE
|
|||
|
'Hit ENTER to continue. '.
|
|||
|
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
|
|||
|
|
|||
|
01 DATA-SCREEN.
|
|||
|
03 BLANK SCREEN.
|
|||
|
03 LINE 1 COLUMN 17 VALUE
|
|||
|
'MS-COBOL INDEXED FILE CREATION DEMONSTRATION'.
|
|||
|
03 LINE 2 COLUMN 15 PIC X(50) FROM LS-TITLE HIGHLIGHT.
|
|||
|
03 LINE 4 COLUMN 1 VALUE
|
|||
|
'Please enter the data requested below. To end this pro
|
|||
|
- 'gram'.
|
|||
|
03 LINE 5 COLUMN 1 VALUE
|
|||
|
'reply N to the question: "Do you wish to enter more da
|
|||
|
- 'ta?(Y/N)"'.
|
|||
|
03 LINE 6 COLUMN 1 VALUE
|
|||
|
'when it appears on the screen.'.
|
|||
|
03 LINE 8 COLUMN 1 VALUE
|
|||
|
'Enter FIRST name and initial (1 to 20 characters): '.
|
|||
|
03 LINE 9 COLUMN 1 VALUE '[' HIGHLIGHT.
|
|||
|
03 LINE 9 COLUMN 2 PIC X(20) USING WS-FIRST-NAME.
|
|||
|
03 LINE 9 COLUMN 22 VALUE ']' HIGHLIGHT.
|
|||
|
03 LINE 10 COLUMN 1 VALUE
|
|||
|
'Enter LAST name (1 to 20 characters): '.
|
|||
|
03 LINE 11 COLUMN 1 VALUE '[' HIGHLIGHT.
|
|||
|
03 LINE 11 COLUMN 2 PIC X(20) USING WS-LAST-NAME.
|
|||
|
03 LINE 11 COLUMN 22 VALUE ']' HIGHLIGHT.
|
|||
|
03 LINE 13 COLUMN 1 VALUE
|
|||
|
'Enter first address line (1 to 40 characters): '.
|
|||
|
03 LINE 14 COLUMN 1 VALUE '[' HIGHLIGHT.
|
|||
|
03 LINE 14 COLUMN 2 PIC X(40) USING WS-ADDRESS-LINE-1.
|
|||
|
03 LINE 14 COLUMN 42 VALUE ']' HIGHLIGHT.
|
|||
|
03 LINE 15 COLUMN 1 VALUE
|
|||
|
'Enter second address line (1 to 40 characters): '.
|
|||
|
03 LINE 16 COLUMN 1 VALUE '[' HIGHLIGHT.
|
|||
|
03 LINE 16 COLUMN 2 PIC X(40) USING WS-ADDRESS-LINE-2.
|
|||
|
03 LINE 16 COLUMN 42 VALUE ']' HIGHLIGHT.
|
|||
|
03 LINE 18 COLUMN 1 VALUE
|
|||
|
'Enter phone number (XXX-XXXX or XXX-XXX-XXXX): '.
|
|||
|
03 LINE 19 COLUMN 1 VALUE '[' HIGHLIGHT.
|
|||
|
03 LINE 19 COLUMN 2 PIC X(12) USING WS-PHONE.
|
|||
|
03 LINE 19 COLUMN 14 VALUE ']' HIGHLIGHT.
|
|||
|
03 LINE 21 COLUMN 10 VALUE
|
|||
|
'If data is OK, hit ENTER to write to the file. You can
|
|||
|
- 'use BACK TAB to '.
|
|||
|
03 LINE 22 COLUMN 15 VALUE
|
|||
|
'return to previous fields and modify data with cursor pos
|
|||
|
- 'itioning'.
|
|||
|
03 LINE 23 COLUMN 15 VALUE
|
|||
|
'keys.'.
|
|||
|
03 LINE 23 COLUMN 21 HIGHLIGHT VALUE
|
|||
|
'Hit ENTER by itself to continue: '.
|
|||
|
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
|
|||
|
|
|||
|
01 WRITE-SCREEN.
|
|||
|
03 BLANK SCREEN.
|
|||
|
03 LINE 1 COLUMN 20 VALUE
|
|||
|
'MS-COBOL INDEXED FILE CREATION DEMONSTRATION'.
|
|||
|
03 LINE 2 COLUMN 15 PIC X(50) FROM LS-TITLE HIGHLIGHT.
|
|||
|
03 LINE 5 COLUMN 1 VALUE
|
|||
|
'Record written to file ISAM.DAT. File status = '.
|
|||
|
03 PIC XX FROM ISAM-STATUS HIGHLIGHT.
|
|||
|
03 LINE 8 COLUMN 1 VALUE
|
|||
|
'File status = 00 means action was successful'.
|
|||
|
03 LINE 9 COLUMN 1 VALUE
|
|||
|
'File status = 10 means END-OF-FILE encountered'.
|
|||
|
03 LINE 10 COLUMN 1 VALUE
|
|||
|
'File status = 21 means KEY NOT IN SEQUENCE'.
|
|||
|
03 LINE 11 COLUMN 1 VALUE
|
|||
|
'File status = 22 means ATTEMPT TO WRITE DUPLICATE KEY'.
|
|||
|
03 LINE 12 COLUMN 1 VALUE
|
|||
|
'File status = 23 means NO RECORD FOUND'.
|
|||
|
03 LINE 13 COLUMN 1 VALUE
|
|||
|
'File status = 24 means DISK FULL'.
|
|||
|
03 LINE 14 COLUMN 1 VALUE
|
|||
|
'File status = 30 means PERMANENT INPUT-OUTPUT ERROR'.
|
|||
|
03 LINE 15 COLUMN 1 VALUE
|
|||
|
'File status = 91 means FILE STRUCTURE WAS DAMAGED'.
|
|||
|
03 LINE 18 COLUMN 1 VALUE
|
|||
|
' Do you wish to enter more data?(Y/N)'.
|
|||
|
03 LINE 19 COLUMN 10 HIGHLIGHT VALUE
|
|||
|
'Type response (Y or N) followed by ENTER: '.
|
|||
|
03 COLUMN PLUS 1 PIC X TO WS-MORE.
|
|||
|
|
|||
|
|
|||
|
|
|||
|
|
|||
|
PROCEDURE DIVISION USING LS-TITLE.
|
|||
|
|
|||
|
P000-MAIN-LINE.
|
|||
|
MOVE OFF-VALUE TO BUILD-FINISHED-SW.
|
|||
|
MOVE SPACE TO WS-MORE.
|
|||
|
DISPLAY TUTOR-SCREEN.
|
|||
|
ACCEPT TUTOR-SCREEN.
|
|||
|
|
|||
|
OPEN OUTPUT ISAM-FILE.
|
|||
|
IF ISAM-STATUS NOT = '00'
|
|||
|
DISPLAY ' FILE OPEN FAILURE. JOB CANCELLED'
|
|||
|
DISPLAY 'FILE STATUS = ', ISAM-STATUS
|
|||
|
DISPLAY 'TYPE ANY CHARACTER TO END JOB'
|
|||
|
ACCEPT ANY-CHAR
|
|||
|
ELSE
|
|||
|
PERFORM P100-GET-DATA
|
|||
|
UNTIL BUILD-FINISHED.
|
|||
|
|
|||
|
CLOSE ISAM-FILE.
|
|||
|
DISPLAY BLANK-SCREEN.
|
|||
|
EXIT PROGRAM.
|
|||
|
|
|||
|
|
|||
|
P100-GET-DATA.
|
|||
|
MOVE SPACES TO WS-DATA-RECORD.
|
|||
|
DISPLAY DATA-SCREEN.
|
|||
|
ACCEPT DATA-SCREEN.
|
|||
|
|
|||
|
PERFORM P500-WRITE-DATA.
|
|||
|
DISPLAY WRITE-SCREEN.
|
|||
|
PERFORM P110-CONTINUE.
|
|||
|
|
|||
|
P110-CONTINUE.
|
|||
|
ACCEPT WRITE-SCREEN.
|
|||
|
IF NO-MORE
|
|||
|
MOVE ON-VALUE TO BUILD-FINISHED-SW.
|
|||
|
|
|||
|
P500-WRITE-DATA.
|
|||
|
WRITE ISAM-RECORD FROM WS-DATA-RECORD.
|
|||
|
|