OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
59ba7ec487
dos_compilers/Microsoft COBOL v112/UPDATE.COB

573 lines
23 KiB
COBOL
Raw Normal View History

Microsoft COBOL v1.12
2024-07-24 15:45:46 +02:00
IDENTIFICATION DIVISION.
PROGRAM-ID. UPDATE.
SECURITY.
THIS PROGRAM MODIFIES AND LISTS 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 DYNAMIC
ORGANIZATION IS INDEXED.
SELECT MAIL-LIST-FILE
ASSIGN TO DISK
FILE STATUS IS MAIL-LIST-STATUS
ORGANIZATION IS LINE SEQUENTIAL.
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).
FD MAIL-LIST-FILE
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS 'MAIL.DAT'.
01 MAIL-LIST-RECORD PIC X(41).
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 WS-START PIC S9(5) VALUE 0 COMP-0.
05 WS-END PIC S9(5) VALUE 0 COMP-0.
05 ISAM-STATUS PIC XX VALUE SPACES.
05 MAIL-LIST-STATUS PIC XX VALUE SPACES.
05 WS-ACTION PIC X(20) VALUE SPACES.
05 WS-OPTION PIC X VALUE SPACE.
88 ADD-OPTION VALUE 'A', 'a'.
88 LIST-OPTION VALUE 'L', 'l'.
88 DELETE-OPTION VALUE 'D', 'd'.
88 MODIFY-OPTION VALUE 'M', 'm'.
88 EXIT-OPTION VALUE 'E', 'e'.
05 WS-TERMINATE PIC X VALUE SPACES.
88 TERMINATED VALUE 'T', 't', 'N', 'n',
'S', 's'.
05 ANY-CHAR PIC X VALUE SPACE.
01 SWITCHES.
05 ON-VALUE PIC X VALUE 'Y'.
05 OFF-VALUE PIC X VALUE 'N'.
05 UPDT-FINISHED-SW PIC X VALUE 'N'.
88 UPDT-FINISHED VALUE 'Y'.
01 WS-DATA-RECORD.
05 WS-KEY.
10 WS-LAST-NAME.
15 WS-LAST-NAME-CHAR OCCURS 20 TIMES PIC X.
10 WS-FIRST-NAME PIC X(20).
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.
01 WS-MAIL-LIST-RECORD.
05 WS-ML-NAME.
10 WS-ML-NAME-CHAR PIC X OCCURS 41 TIMES.
05 WS-ML-ADDRESS-LINE-1 PIC X(40) VALUE SPACES.
05 WS-ML-ADDRESS-LINE-2 PIC X(40) VALUE SPACES.
01 WS-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 UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 5 VALUE
'This is main program UPDATE, CHAINed to from main prog
- 'ram DEMO.'.
03 LINE 5 COLUMN 5 VALUE
'Since UPDATE was CHAINed to and not CALLed, control wi
- 'll not return'.
03 LINE 6 COLUMN 5 VALUE
'to DEMO.'.
03 LINE 8 COLUMN 1 VALUE
'In this program, you may list, add, delete, or modify
- 'records in file ISAM.DAT'.
03 LINE 9 COLUMN 1 VALUE
'which was created in subprogram BUILD. If you did not
- 'try the CREATE option'.
03 LINE 10 COLUMN 1 VALUE
'yet, please terminate this program by responding T bel
- 'ow, then execute'.
03 LINE 11 COLUMN 1 VALUE
'DEMO again, this time selecting option C to create the
- ' file which is'.
03 LINE 12 COLUMN 1 VALUE
'updated in this program. OK?.'.
03 LINE 14 COLUMN 1 VALUE
'To terminate this program type T, then hit ENTER.'.
03 LINE 15 COLUMN 1 HIGHLIGHT VALUE
'Hit ENTER by itself to continue:'.
03 COLUMN PLUS 1 PIC X TO WS-TERMINATE.
01 TUTOR-SCREEN-2.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'Ok. Since you have created file ISAM.DAT, you may now
- 'modify or'.
03 LINE 5 COLUMN 1 VALUE
'display its contents. One advantage of the MS-COBOL in
- 'dexed file'.
03 LINE 6 COLUMN 1 VALUE
'structure is that it automatically returns records sor
- 'ted by key when'.
03 LINE 7 COLUMN 1 VALUE
'the file is read sequentially.'.
03 LINE 9 COLUMN 1 VALUE
'You will now see a menu screen which will let you:'.
03 LINE 10 COLUMN 5 VALUE
'List the file, creating a file of mailing labels sorte
- 'd by last name,'.
03 LINE 11 COLUMN 10 VALUE
'then first name;'.
03 LINE 12 COLUMN 5 VALUE
'Add records to the file;'.
03 LINE 13 COLUMN 5 VALUE
'Delete records from the file;'.
03 LINE 14 COLUMN 5 VALUE
'Modify records on the file.'.
03 LINE 17 COLUMN 1 VALUE
'You will return to the options menu after you have com
- 'pleted'.
03 LINE 18 COLUMN 1 VALUE
'any set of actions, so that you may modify, then list
- 'the'.
03 LINE 19 COLUMN 1 VALUE
'file, as many times as you like.'.
03 LINE 21 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to continue.'.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 OPTION-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 6 COLUMN 1 VALUE
'Please select one of the following options by typing t
- 'he first letter'.
03 LINE 7 COLUMN 1 VALUE
'of the option in the space below, then hitting ENTER.
- 'Option E'.
03 LINE 8 COLUMN 1 VALUE
'followed by ENTER will end this demonstration.'.
03 LINE 10 COLUMN 5 VALUE
'Option L: List records in indexed file sorted by last nam
- 'e, then first name'.
03 LINE 11 COLUMN 15 VALUE
'and create a mailing label file in the same order'.
03 LINE 12 COLUMN 5 VALUE
'Option A: Add a record to the indexed file'.
03 LINE 13 COLUMN 5 VALUE
'Option D: Delete a specified record in the indexed file'.
03 LINE 14 COLUMN 5 VALUE
'Option M: Modify a specified record in the indexed file'.
03 LINE 16 COLUMN 5 VALUE
'Option E: End this program'.
03 LINE 23 COLUMN 10 HIGHLIGHT VALUE
'Enter option here followed by ENTER: '.
03 COLUMN PLUS 1 PIC X TO WS-OPTION.
01 AFTERMATH-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 20 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'Action requested = '.
03 PIC X(20) FROM WS-ACTION HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'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 '.
03 PIC X(6) FROM WS-ACTION HIGHLIGHT.
03 VALUE ' any more records (Y/N)?'.
03 LINE 20 COLUMN 10 HIGHLIGHT VALUE
'Reply (followed by ENTER) = '.
03 COLUMN PLUS 1 PIC X TO WS-TERMINATE.
01 LIST-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 4 COLUMN 1 VALUE
'The following record was written by you to file ISAM.D
- 'AT, and is now '.
03 LINE 5 COLUMN 1 VALUE
'sorted in ascending order by LAST NAME followed by FIR
- 'ST name.'.
03 LINE 7 COLUMN 1 PIC X(20) FROM WS-FIRST-NAME
HIGHLIGHT.
03 LINE 8 COLUMN 1 PIC X(20) FROM WS-LAST-NAME
HIGHLIGHT.
03 LINE 9 COLUMN 1 PIC X(40) FROM WS-ADDRESS-LINE-1
HIGHLIGHT.
03 LINE 10 COLUMN 1 PIC X(40) FROM WS-ADDRESS-LINE-2
HIGHLIGHT.
03 LINE 11 COLUMN 1 PIC X(12) FROM WS-PHONE AUTO
HIGHLIGHT.
03 LINE 13 COLUMN 1 VALUE
'The following records were written to file MAIL.DAT to
- 'be used for mailing'.
03 LINE 14 COLUMN 1 VALUE
'labels. File status of last write = '.
03 PIC XX FROM MAIL-LIST-STATUS HIGHLIGHT.
03 LINE 15 COLUMN 9 VALUE
'File status = 00 means action was successful'.
03 LINE 17 COLUMN 1 PIC X(41) FROM WS-ML-NAME
HIGHLIGHT.
03 LINE 18 COLUMN 1 PIC X(40) FROM WS-ML-ADDRESS-LINE-1
HIGHLIGHT.
03 LINE 19 COLUMN 1 PIC X(40) FROM WS-ML-ADDRESS-LINE-2
HIGHLIGHT.
03 LINE 21 COLUMN 9 VALUE
'Do you wish to read the next record?'.
03 LINE 22 COLUMN 12 VALUE
'Reply ENTER by itself to continue reading the file. Type
- 'S followed '.
03 LINE 23 COLUMN 12 VALUE
'by ENTER to stop reading the file.'.
03 LINE 23 COLUMN 50 HIGHLIGHT VALUE
'Reply = '.
03 COLUMN PLUS 1 PIC X TO WS-TERMINATE.
01 NAME-ADDRESS-SCREEN.
03 NAME-SCREEN.
05 BLANK SCREEN.
05 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
05 LINE 2 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
05 LINE 4 COLUMN 1 VALUE
'Please enter the data requested below. To exit from th
- 'is program'.
05 LINE 5 COLUMN 1 VALUE
'reply N to the question: "Do you wish to enter more da
- 'ta?(Y/N)"'.
05 LINE 6 COLUMN 1 VALUE
'when it appears on the screen.'.
05 LINE 8 COLUMN 1 VALUE
'Enter FIRST name and initial (1 to 20 characters): '.
05 LINE 9 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 9 COLUMN 2 PIC X(20) FROM WS-FIRST-NAME
TO WS-FIRST-NAME.
05 LINE 9 COLUMN 22 VALUE ']' HIGHLIGHT.
05 LINE 10 COLUMN 1 VALUE
'Enter LAST name (1 to 20 characters): '.
05 LINE 11 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 11 COLUMN 2 PIC X(20) FROM WS-LAST-NAME
TO WS-LAST-NAME.
05 LINE 11 COLUMN 22 VALUE ']' HIGHLIGHT.
03 ADDRESS-SCREEN.
05 LINE 13 COLUMN 1 VALUE
'Enter first address line (1 to 40 characters): '.
05 LINE 14 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 14 COLUMN 2 PIC X(40) FROM WS-ADDRESS-LINE-1
TO WS-ADDRESS-LINE-1.
05 LINE 14 COLUMN 42 VALUE ']' HIGHLIGHT.
05 LINE 15 COLUMN 1 VALUE
'Enter second address line (1 to 40 characters): '.
05 LINE 16 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 16 COLUMN 2 PIC X(40) TO WS-ADDRESS-LINE-2
FROM WS-ADDRESS-LINE-2.
05 LINE 16 COLUMN 42 VALUE ']' HIGHLIGHT.
05 LINE 18 COLUMN 1 VALUE
'Enter phone number (XXX-XXXX or XXX-XXX-XXXX): '.
05 LINE 19 COLUMN 1 VALUE '[' HIGHLIGHT.
05 LINE 19 COLUMN 2 PIC X(12) FROM WS-PHONE
TO WS-PHONE.
05 LINE 19 COLUMN 14 VALUE ']' HIGHLIGHT.
05 LINE 21 COLUMN 10 VALUE
'If data is OK, hit ENTER to write to the file. You can
- 'use BACK TAB to '.
05 LINE 22 COLUMN 15 VALUE
'return to previous fields and modify data with cursor pos
- 'itioning.'.
05 LINE 23 COLUMN 15 VALUE
'keys. '.
05 LINE 23 COLUMN 21 HIGHLIGHT VALUE
'Hit ENTER here to continue: '.
05 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 EOF-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 17 VALUE
'MS-COBOL INDEXED FILE UPDATE DEMONSTRATION'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 6 COLUMN 1 VALUE
'You have reached the end of the file ISAM.DAT.'.
03 LINE 8 COLUMN 1 VALUE
'You have also built the line sequential file MAIL.DAT, a
- 'sorted file'.
03 LINE 9 COLUMN 1 VALUE
'of mailing labels. You will now return to the options scr
- 'een, where '.
03 LINE 10 COLUMN 1 VALUE
'you can again modify or list ISAM.DAT. When you choose op
- 'tion E to end'.
03 LINE 11 COLUMN 1 VALUE
'this demonstration and return to the operating system, yo
- 'u may use the'.
03 LINE 12 COLUMN 1 VALUE
'system TYPE command to list file MAIL.DAT.'.
03 LINE 18 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to return to the options menu: '.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
01 FINAL-SCREEN.
03 BLANK SCREEN.
03 LINE 1 COLUMN 21 VALUE
' END OF MICROSOFT MS-COBOL DEMONSTRATION'.
03 LINE 3 COLUMN 15 PIC X(50) FROM WS-TITLE HIGHLIGHT.
03 LINE 5 COLUMN 1 VALUE
'Thank you for taking part in this demonstration of '.
03 LINE 6 COLUMN 1 VALUE
'the features of Microsoft MS-COBOL.'.
03 LINE 8 COLUMN 1 VALUE
'After hitting ENTER to end this program, you can use the
- 'system TYPE '.
03 LINE 9 COLUMN 5 VALUE
'command to list file MAIL.DAT and see the mailing list
- ' you have built. '.
03 LINE 16 COLUMN 1 HIGHLIGHT VALUE
'Please hit ENTER to end this program.'.
03 COLUMN PLUS 1 PIC X TO ANY-CHAR.
PROCEDURE DIVISION CHAINING WS-TITLE.
P000-MAIN-LINE.
DISPLAY TUTOR-SCREEN.
ACCEPT TUTOR-SCREEN.
IF TERMINATED
STOP RUN.
OPEN I-O 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
DISPLAY TUTOR-SCREEN-2
ACCEPT TUTOR-SCREEN-2
PERFORM P100-GET-DATA
UNTIL UPDT-FINISHED.
CLOSE ISAM-FILE.
DISPLAY BLANK-SCREEN.
STOP RUN.
P100-GET-DATA.
MOVE SPACE TO WS-TERMINATE.
MOVE SPACE TO WS-OPTION.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY OPTION-SCREEN.
ACCEPT OPTION-SCREEN.
IF LIST-OPTION
MOVE 'MAIL LIST' TO WS-ACTION
PERFORM P110-START-FILE
OPEN OUTPUT MAIL-LIST-FILE
PERFORM P200-MAIL-LIST
UNTIL TERMINATED
CLOSE MAIL-LIST-FILE
ELSE IF ADD-OPTION
MOVE 'ADD' TO WS-ACTION
PERFORM P300-ADD
UNTIL TERMINATED
ELSE IF DELETE-OPTION
MOVE 'DELETE' TO WS-ACTION
PERFORM P400-DELETE
UNTIL TERMINATED
ELSE IF MODIFY-OPTION
MOVE 'MODIFY' TO WS-ACTION
PERFORM P500-MODIFY
UNTIL TERMINATED
ELSE IF EXIT-OPTION
DISPLAY FINAL-SCREEN
ACCEPT FINAL-SCREEN
MOVE ON-VALUE TO UPDT-FINISHED-SW
ELSE
NEXT SENTENCE.
P110-START-FILE.
MOVE SPACES TO ISAM-KEY.
START ISAM-FILE
KEY IS GREATER THAN ISAM-KEY
INVALID KEY PERFORM P900-START-ERROR.
P200-MAIL-LIST.
PERFORM P800-READ-ISAM.
IF NOT TERMINATED
PERFORM P210-BUILD-MAIL
DISPLAY LIST-SCREEN
ACCEPT LIST-SCREEN.
P210-BUILD-MAIL.
* PREPARE MAIL LIST RECORD. PLACE FIRST NAME AND
* INITIAL ON LINE, SEARCH FOR END, THEN MOVE LAST
* NAME TO LINE AND WRITE TO FILE MAIL.DAT.
MOVE WS-ADDRESS-LINE-1 TO WS-ML-ADDRESS-LINE-1.
MOVE WS-ADDRESS-LINE-2 TO WS-ML-ADDRESS-LINE-2.
MOVE WS-FIRST-NAME TO WS-ML-NAME.
IF WS-FIRST-NAME = SPACES
MOVE 1 TO IIX
ELSE
PERFORM P220-NOTHING VARYING IIX FROM 20 BY -1
UNTIL (WS-ML-NAME-CHAR (IIX) NOT = SPACE)
OR (IIX < 1)
ADD 2 TO IIX.
* ** IIX IS LOCATION FOR START OF LAST NAME
* *** FIND FIRST NON-BLANK IN LAST NAME
IF WS-LAST-NAME = SPACES
MOVE 1 TO WS-START, WS-END
ELSE
PERFORM P220-NOTHING VARYING JIX FROM 1 BY 1
UNTIL (WS-LAST-NAME-CHAR (JIX) NOT = SPACE)
OR (JIX > 20)
MOVE JIX TO WS-START
PERFORM P220-NOTHING VARYING JIX FROM 20 BY -1
UNTIL (WS-LAST-NAME-CHAR (JIX) NOT = SPACE)
OR (JIX < 1)
MOVE JIX TO WS-END.
* **** MOVE LAST NAME TO LINE
PERFORM P230-MOVE-NAME VARYING KIX FROM WS-START BY 1
UNTIL KIX > WS-END.
PERFORM P240-WRITE-MAIL-LIST.
P220-NOTHING.
EXIT.
P230-MOVE-NAME.
MOVE WS-LAST-NAME-CHAR (KIX) TO WS-ML-NAME-CHAR (IIX).
ADD 1 TO IIX.
P240-WRITE-MAIL-LIST.
WRITE MAIL-LIST-RECORD FROM WS-ML-NAME.
WRITE MAIL-LIST-RECORD FROM WS-ML-ADDRESS-LINE-1.
WRITE MAIL-LIST-RECORD FROM WS-ML-ADDRESS-LINE-2.
MOVE SPACES TO MAIL-LIST-RECORD.
WRITE MAIL-LIST-RECORD.
P300-ADD.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY NAME-ADDRESS-SCREEN.
ACCEPT NAME-ADDRESS-SCREEN.
PERFORM P700-WRITE-ISAM.
DISPLAY AFTERMATH-SCREEN.
ACCEPT AFTERMATH-SCREEN.
P400-DELETE.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY NAME-SCREEN.
ACCEPT NAME-SCREEN.
PERFORM P820-DELETE-ISAM.
DISPLAY AFTERMATH-SCREEN.
ACCEPT AFTERMATH-SCREEN.
P500-MODIFY.
MOVE SPACES TO WS-DATA-RECORD.
DISPLAY NAME-SCREEN.
ACCEPT NAME-SCREEN.
PERFORM P810-RANDOM-READ-ISAM.
IF ISAM-STATUS = '00'
DISPLAY NAME-SCREEN
DISPLAY ADDRESS-SCREEN
ACCEPT ADDRESS-SCREEN
PERFORM P710-REWRITE-ISAM.
DISPLAY AFTERMATH-SCREEN.
ACCEPT AFTERMATH-SCREEN.
P700-WRITE-ISAM.
WRITE ISAM-RECORD FROM WS-DATA-RECORD.
P710-REWRITE-ISAM.
REWRITE ISAM-RECORD FROM WS-DATA-RECORD.
P800-READ-ISAM.
READ ISAM-FILE NEXT INTO WS-DATA-RECORD
AT END
MOVE 'T' TO WS-TERMINATE
DISPLAY EOF-SCREEN
ACCEPT EOF-SCREEN.
P810-RANDOM-READ-ISAM.
MOVE WS-DATA-RECORD TO ISAM-RECORD.
READ ISAM-FILE INTO WS-DATA-RECORD.
P820-DELETE-ISAM.
MOVE WS-DATA-RECORD TO ISAM-RECORD.
DELETE ISAM-FILE RECORD.
P900-START-ERROR.
MOVE 'T' TO WS-TERMINATE.
DISPLAY EOF-SCREEN.
ACCEPT EOF-SCREEN.

Reference in New Issue Copy Permalink