573 lines
23 KiB
COBOL
573 lines
23 KiB
COBOL
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.
|
||
|