000100 IDENTIFICATION DIVISION.
000200 ENVIRONMENT DIVISION.
000300 INPUT-OUTPUT SECTION.
000400 FILE-CONTROL.
000500     SELECT NAME-FILE        ASSIGN TO DISK
000600                             ORGANIZATION IS INDEXED
000700                             ACCESS MODE IS DYNAMIC
000800                             RECORD KEY IS
000900                                 NAME-NAME.
001000     SELECT PRINT-FILE       ASSIGN TO PRINTER.
001100 DATA DIVISION.
001200 FILE SECTION.
001300
001400 FD  NAME-FILE
001500     VALUE OF FILE-ID IS "NAME.DAT".
001600 01  NAME-RECORD.
001700     03  NAME-NAME               PIC  X(30).
001800     03  NAME-ADDR-1             PIC  X(30).
001900     03  NAME-ADDR-2             PIC  X(30).
002000     03  NAME-PHONE              PIC  X(16).
002100     03  NAME-COMMENT            PIC  X(30).
002200
002300 FD  PRINT-FILE.
002400 01  PRINT-RECORD.
002500     03  PR-TEXT1                PIC  X(30).
002600     03      FILLER              PIC  X(01).
002700     03  PR-TEXT2                PIC  X(30).
002800     03      FILLER              PIC  X(01).
002900     03  PR-PHONE                PIC  X(16).
003000     03      FILLER              PIC  X(02).
003100
003200 WORKING-STORAGE SECTION.
003300 78  WC-LOWER-CASE       VALUE "abcdefghijklmnopqrstuvwxyz".
003400 78  WC-UPPER-CASE       VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
003500 78  WC-FG-DEFAULT       VALUE  7.
003600 78  WC-BG-DEFAULT       VALUE  0.
003700 78  WC-FG-NORM          VALUE  7.
003800 78  WC-BG-NORM          VALUE  1.
003900 78  WC-FG-HILITE        VALUE  2.
004000 78  WC-BG-HILITE        VALUE  1.
004100 78  WC-FG-ERROR         VALUE  2.
004200 78  WC-BG-ERROR         VALUE  1.
004300 78  WC-MAX-LINES        VALUE 57.
004400 77  WS-LINE-COUNT               PIC  9(02)  VALUE 0.
004500 77  WS-PAGE-COUNT               PIC  9(04)  VALUE 0.
004600 77  WS-NAME-COUNT               PIC  9(04)  VALUE 0.
004700 77  WS-END-FLAG                 PIC  9(01)  VALUE 0.
004800 77  WS-NAME-PRESENT-FLAG        PIC  9(01)  VALUE 0.
004900
005000 01  SCREEN-HOLD-AREA.
005100     03  SH-ERROR-FLAG           PIC  9(01)  VALUE 0.
005200     03  SH-ESCAPE-FLAG          PIC  9(01)  VALUE 0.
005300     03  SH-ERROR-MSG            PIC  X(70)  VALUE SPACES.
005400     03  SH-ANSWER                           VALUE SPACES.
005500         05  SH-ANSWER-NUM       PIC  9(01).
005600     03  SH-NAME-DATA.
005700         05  SH-NAME             PIC  X(30)  VALUE SPACES.
005800         05  SH-ADDR-1           PIC  X(30)  VALUE SPACES.
005900         05  SH-ADDR-2           PIC  X(30)  VALUE SPACES.
006000         05  SH-PHONE            PIC  X(16)  VALUE SPACES.
006100         05  SH-COMMENT          PIC  X(30)  VALUE SPACES.
006200
006300 78  NT-SIZE             VALUE 9.
006400 01  NAME-TABLE.
006500     03  NT-ENTRY                OCCURS NT-SIZE TIMES.
006600         05  NT-NAME                 PIC  X(30).
006700         05      FILLER              PIC  X(01).
006800         05  NT-PHONE                PIC  X(16).
006900         05      FILLER              PIC  X(01).
007000         05  NT-COMMENT              PIC  X(30).
007100     03  NT-EX                   PIC  9(02)  VALUE 0.
007200
007300 01  PAGE-HEADER.
007400     03      FILLER              PIC  X(30)  VALUE SPACES.
007500     03      FILLER              PIC  X(19)  VALUE
007600         "N A M E   L I S T".
007700     03      FILLER              PIC  X(20)  VALUE SPACES.
007800     03      FILLER              PIC  X(05)  VALUE "Page ".
007900     03  PH-PAGE-NBR             PIC  ZZZ9   VALUE ZEROS.
008000
008100 01  TOTAL-LINE.
008200     03      FILLER              PIC  X(27)  VALUE SPACES.
008300     03  TL-NAME-COUNT           PIC  ZZZ9   VALUE ZEROS.
008400     03      FILLER              PIC  X(14)  VALUE
008500         " names printed".
008600
008700 SCREEN SECTION.
008800
008900 01  MENU-SCREEN
009000         FOREGROUND-COLOR WC-FG-NORM
009100         BACKGROUND-COLOR WC-BG-NORM
009200         BLANK SCREEN.
009300     03  LINE 01  COLUMN 29  VALUE
009400         "N A M E   P R O G R A M".
009500     03  LINE 03  COLUMN 25  VALUE "Press: A = Add Name".
009600     03  LINE 04  COLUMN 32  VALUE "F = Find Name".
009700     03  LINE 05  COLUMN 32  VALUE "P = Print Names".
009800     03  LINE 07  COLUMN 29  VALUE "or X = Exit Program: ".
009900     03  PIC  X(01)          TO SH-ANSWER  AUTO.
010000
010100 01  GET-NAME-SCREEN
010200         FOREGROUND-COLOR WC-FG-NORM
010300         BACKGROUND-COLOR WC-BG-NORM.
010400     03  LINE 11  COLUMN 16  BLANK LINE
010500         VALUE "Find Name: ".
010600     03  PIC  X(30)          USING SH-NAME.
010700
010800 01  SELECT-SCREEN
010900         FOREGROUND-COLOR WC-FG-NORM
011000         BACKGROUND-COLOR WC-BG-NORM
011100         BLANK SCREEN.
011200     03  LINE 01  COLUMN 30  VALUE
011300         "S E L E C T   N A M E".
011400     03  LINE 03  COLUMN 03  VALUE
011500         "NAME-------------------------- PHONE----------- COMMENT-
011600-        "----------------------".
011700     03  LINE 04  COLUMN 01  VALUE "1 ".
011800     03  PIC  X(78)          FROM NT-ENTRY(1).
011900     03  LINE 05  COLUMN 01  VALUE "2 ".
012000     03  PIC  X(78)          FROM NT-ENTRY(2).
012100     03  LINE 06  COLUMN 01  VALUE "3 ".
012200     03  PIC  X(78)          FROM NT-ENTRY(3).
012300     03  LINE 07  COLUMN 01  VALUE "4 ".
012400     03  PIC  X(78)          FROM NT-ENTRY(4).
012500     03  LINE 08  COLUMN 01  VALUE "5 ".
012600     03  PIC  X(78)          FROM NT-ENTRY(5).
012700     03  LINE 09  COLUMN 01  VALUE "6 ".
012800     03  PIC  X(78)          FROM NT-ENTRY(6).
012900     03  LINE 10  COLUMN 01  VALUE "7 ".
013000     03  PIC  X(78)          FROM NT-ENTRY(7).
013100     03  LINE 11  COLUMN 01  VALUE "8 ".
013200     03  PIC  X(78)          FROM NT-ENTRY(8).
013300     03  LINE 12  COLUMN 01  VALUE "9 ".
013400     03  PIC  X(78)          FROM NT-ENTRY(9).
013500     03      FOREGROUND-COLOR WC-FG-HILITE
013600             BACKGROUND-COLOR WC-BG-HILITE.
013700         05  LINE 14  COLUMN 13  BLANK LINE  VALUE
013800         "1-9=Select Name, N=Next Page, P=Prev Page, Esc=Exit: ".
013900         05  PIC  X              TO SH-ANSWER AUTO.
014000
014100 01  CLEAR-DEFAULT-SCREEN
014200         FOREGROUND-COLOR WC-FG-DEFAULT
014300         BACKGROUND-COLOR WC-BG-DEFAULT
014400         BLANK SCREEN.
014500
014600 01  CLEAR-NORM-SCREEN
014700         FOREGROUND-COLOR WC-FG-NORM
014800         BACKGROUND-COLOR WC-BG-NORM
014900         BLANK SCREEN.
015000
015100 01  ADD-HEADER-SCREEN
015200         FOREGROUND-COLOR WC-FG-NORM
015300         BACKGROUND-COLOR WC-BG-NORM.
015400     03  LINE 01  COLUMN 34  BLANK LINE  VALUE
015500         "A D D   N A M E".
015600
015700 01  DELETE-HEADER-SCREEN
015800         FOREGROUND-COLOR WC-FG-NORM
015900         BACKGROUND-COLOR WC-BG-NORM.
016000     03  LINE 01  COLUMN 30  BLANK LINE  VALUE
016100         "D E L E T E   N A M E".
016200
016300 01  MODIFY-HEADER-SCREEN
016400         FOREGROUND-COLOR WC-FG-NORM
016500         BACKGROUND-COLOR WC-BG-NORM.
016600     03  LINE 01  COLUMN 30  BLANK LINE  VALUE
016700         "M O D I F Y   N A M E".
016800
016900 01  VIEW-HEADER-SCREEN
017000         FOREGROUND-COLOR WC-FG-NORM
017100         BACKGROUND-COLOR WC-BG-NORM.
017200     03  LINE 01  COLUMN 32  BLANK LINE  VALUE
017300         "V I E W   N A M E".
017400
017500 01  DATA-SCREEN
017600         FOREGROUND-COLOR WC-FG-NORM
017700         BACKGROUND-COLOR WC-BG-NORM.
017800     03  LINE 03  COLUMN 09  VALUE "Name:  ".
017900     03  PIC  X(30)          USING SH-NAME  REQUIRED.
018000     03  LINE 05  COLUMN 09  VALUE "Addr1: ".
018100     03  PIC  X(30)          USING SH-ADDR-1.
018200     03  LINE 06  COLUMN 09  VALUE "Addr2: ".
018300     03  PIC  X(30)          USING SH-ADDR-2.
018400     03  LINE 08  COLUMN 09  VALUE "Phone: ".
018500     03  PIC  X(16)          USING SH-PHONE.
018600     03  LINE 10  COLUMN 09  VALUE "Comment: ".
018700     03  PIC  X(30)          USING SH-COMMENT.
018800
018900 01  VIEW-MENU-SCREEN
019000         FOREGROUND-COLOR WC-FG-HILITE
019100         BACKGROUND-COLOR WC-BG-HILITE.
019200     03  LINE 13  COLUMN 05  BLANK LINE  VALUE
019300         "N=Next Name, P=Prev Name, M=Modify Name, D=Delete Name,
019400-        "Esc=Exit: ".
019500     03  PIC  X(01)          TO SH-ANSWER  AUTO.
019600
019700 01  ESCAPE-SCREEN
019800         FOREGROUND-COLOR WC-FG-HILITE
019900         BACKGROUND-COLOR WC-BG-HILITE.
020000     03  LINE 13  COLUMN 32  BLANK LINE  VALUE
020100         "Esc=Exit".
020200
020300 01  QUERY-DELETE-SCREEN
020400         FOREGROUND-COLOR WC-FG-HILITE
020500         BACKGROUND-COLOR WC-BG-HILITE.
020600     03  LINE 13  COLUMN 15  BLANK LINE  VALUE
020700         "Do you REALLY want to delete this name (Y/N)? ".
020800     03  PIC  X(01)          TO SH-ANSWER  AUTO.
020900
021000 01  WAIT-PRINTER-SCREEN
021100         FOREGROUND-COLOR WC-FG-HILITE
021200         BACKGROUND-COLOR WC-BG-HILITE.
021300     03  LINE 11  COLUMN 16  BLANK LINE  VALUE
021400         "Ready printer and press a key (Esc=Exit)".
021500     03  PIC  X(01)          TO SH-ANSWER  AUTO.
021600
021700 01  PRINTING-SCREEN
021800         FOREGROUND-COLOR WC-FG-HILITE
021900         BACKGROUND-COLOR WC-BG-HILITE.
022000     03  LINE 11  COLUMN 28  BLANK LINE
022100         PIC  ZZZ9           FROM WS-NAME-COUNT.
022200     03  VALUE " names printed".
022300
022400 01  ERROR-SCREEN
022500         FOREGROUND-COLOR WC-FG-ERROR
022600         BACKGROUND-COLOR WC-BG-ERROR.
022700     03  LINE 24  COLUMN 05  BLANK LINE
022800         PIC  X(70)          FROM SH-ERROR-MSG.
022900
023000 01  ERASE-ERROR-SCREEN
023100         FOREGROUND-COLOR WC-FG-NORM
023200         BACKGROUND-COLOR WC-BG-NORM.
023300     03  LINE 24             BLANK LINE.
023400
023500 PROCEDURE DIVISION.
023600
023700 000000-CONTROL.
023800     OPEN I-O NAME-FILE.
023900     DISPLAY MENU-SCREEN.
024000     PERFORM 000100-PROCESS
024100         UNTIL (WS-END-FLAG = 1).
024200     DISPLAY CLEAR-DEFAULT-SCREEN.
024300     CLOSE NAME-FILE.
024400     STOP RUN.
024500
024600 000100-PROCESS.
024700     MOVE SPACE TO SH-ANSWER.
024800     ACCEPT MENU-SCREEN.
024900     INSPECT SH-ANSWER
025000         CONVERTING WC-LOWER-CASE
025100                 TO WC-UPPER-CASE.
025200     EVALUATE SH-ANSWER
025300         WHEN "A"
025400             PERFORM 010000-ADD
025500         WHEN "F"
025600             PERFORM 020000-FIND
025700         WHEN "P"
025800             PERFORM 030000-PRINT
025900         WHEN "X"
026000             MOVE 1 TO WS-END-FLAG
026100             EXIT PARAGRAPH
026200         WHEN OTHER
026300             EXIT PARAGRAPH
026400     END-EVALUATE.
026500     DISPLAY MENU-SCREEN.
026600
026700 010000-ADD.
026800     INITIALIZE SCREEN-HOLD-AREA.
026900     DISPLAY CLEAR-NORM-SCREEN.
027000     DISPLAY ADD-HEADER-SCREEN.
027100     DISPLAY DATA-SCREEN.
027200     DISPLAY ESCAPE-SCREEN.
027300     PERFORM 011000-ADD-LOOP
027400         WITH TEST AFTER
027500         UNTIL (SH-ESCAPE-FLAG = 1).
027600
027700 011000-ADD-LOOP.
027800     MOVE 0 TO SH-ESCAPE-FLAG.
027900     ACCEPT DATA-SCREEN
028000         ON EXCEPTION
028100             MOVE 1 TO SH-ESCAPE-FLAG
028200             EXIT PARAGRAPH.
028300     INSPECT SH-NAME-DATA
028400         CONVERTING WC-LOWER-CASE
028500                 TO WC-UPPER-CASE.
028600     DISPLAY ERASE-ERROR-SCREEN.
028700
028800     INITIALIZE NAME-RECORD.
028900     MOVE SH-NAME    TO NAME-NAME.
029000     MOVE SH-ADDR-1  TO NAME-ADDR-1.
029100     MOVE SH-ADDR-2  TO NAME-ADDR-2.
029200     MOVE SH-PHONE   TO NAME-PHONE.
029300     MOVE SH-COMMENT TO NAME-COMMENT.
029400     WRITE NAME-RECORD
029500         INVALID KEY
029600             MOVE "DUPLICATE NAME" TO SH-ERROR-MSG
029700             DISPLAY ERROR-SCREEN
029800             EXIT PARAGRAPH.
029900
030000     INITIALIZE SCREEN-HOLD-AREA.
030100     DISPLAY DATA-SCREEN.
030200     DISPLAY ERASE-ERROR-SCREEN.
030300
030400 020000-FIND.
030500     INITIALIZE SCREEN-HOLD-AREA.
030600     DISPLAY GET-NAME-SCREEN.
030700     MOVE 0 TO SH-ESCAPE-FLAG.
030800     MOVE 0 TO WS-NAME-PRESENT-FLAG.
030900     PERFORM 020100-GET-NAME
031000         WITH TEST AFTER
031100         UNTIL (SH-ESCAPE-FLAG = 1)
031200                OR
031300               (WS-NAME-PRESENT-FLAG = 1).
031400     IF (WS-NAME-PRESENT-FLAG = 1)
031500         PERFORM 020300-FORWARD
031600         MOVE 0 TO SH-ESCAPE-FLAG
031700         PERFORM 020200-SELECT-LOOP
031800             UNTIL (SH-ESCAPE-FLAG = 1).
031900
032000 020100-GET-NAME.
032100     MOVE SPACE TO SH-ANSWER.
032200     ACCEPT GET-NAME-SCREEN
032300         ON EXCEPTION
032400             MOVE 1 TO SH-ESCAPE-FLAG
032500             EXIT PARAGRAPH.
032600     INSPECT SH-NAME
032700         CONVERTING WC-LOWER-CASE
032800                 TO WC-UPPER-CASE.
032900     DISPLAY ERASE-ERROR-SCREEN.
033000     INITIALIZE NAME-RECORD.
033100     MOVE SH-NAME TO NAME-NAME.
033200     START NAME-FILE
033300         KEY NOT < NAME-NAME
033400         INVALID KEY
033500             MOVE "NO RECORDS FOUND" TO SH-ERROR-MSG
033600             DISPLAY ERROR-SCREEN
033700             EXIT PARAGRAPH.
033800     READ NAME-FILE NEXT.
033900     MOVE 1 TO WS-NAME-PRESENT-FLAG.
034000
034100 020200-SELECT-LOOP.
034200     MOVE SPACE TO SH-ANSWER.
034300     ACCEPT SELECT-SCREEN
034400         ON EXCEPTION
034500             MOVE 1 TO SH-ESCAPE-FLAG
034600             EXIT PARAGRAPH.
034700     DISPLAY ERASE-ERROR-SCREEN.
034800     INSPECT SH-ANSWER
034900         CONVERTING WC-LOWER-CASE
035000                 TO WC-UPPER-CASE.
035100     EVALUATE SH-ANSWER
035200         WHEN "N"
035300             IF (NT-NAME(NT-SIZE) NOT = SPACES)
035400                 INITIALIZE NAME-RECORD
035500                 MOVE NT-NAME(NT-SIZE) TO NAME-NAME
035600                 READ NAME-FILE
035700                 READ NAME-FILE NEXT
035800                     NOT AT END
035900                         PERFORM 020300-FORWARD
036000                 END-READ
036100             END-IF
036200         WHEN "P"
036300             IF (NT-NAME(1) NOT = SPACES)
036400                 INITIALIZE NAME-RECORD
036500                 MOVE NT-NAME(1) TO NAME-NAME
036600                 READ NAME-FILE
036700                 READ NAME-FILE PREVIOUS
036800                     NOT AT END
036900                         PERFORM 020400-BACKWARD
037000                 END-READ
037100             END-IF
037200         WHEN "1" THRU "9"
037300             IF (NT-NAME(SH-ANSWER-NUM) NOT = SPACES)
037400                 INITIALIZE NAME-RECORD
037500                 MOVE NT-NAME(SH-ANSWER-NUM) TO NAME-NAME
037600                 READ NAME-FILE
037700                 PERFORM 021000-VIEW
037800                 MOVE 1 TO SH-ESCAPE-FLAG
037900                 EXIT PARAGRAPH
038000             END-IF
038100         WHEN OTHER
038200             EXIT PARAGRAPH
038300     END-EVALUATE.
038400     DISPLAY SELECT-SCREEN.
038500
038600 020300-FORWARD.
038700     INITIALIZE NAME-TABLE.
038800     MOVE 1 TO NT-EX.
038900     MOVE 1 TO WS-NAME-PRESENT-FLAG.
039000     PERFORM 020310-NEXT-ADDR
039100         UNTIL (NT-EX > NT-SIZE)
039200                OR
039300               (WS-NAME-PRESENT-FLAG = 0).
039400     DISPLAY SELECT-SCREEN.
039500
039600 020310-NEXT-ADDR.
039700     MOVE NAME-NAME    TO NT-NAME   (NT-EX).
039800     MOVE NAME-PHONE   TO NT-PHONE  (NT-EX).
039900     MOVE NAME-COMMENT TO NT-COMMENT(NT-EX).
040000     ADD 1 TO NT-EX.
040100     READ NAME-FILE NEXT
040200         AT END
040300             MOVE 0 TO WS-NAME-PRESENT-FLAG.
040400
040500 020400-BACKWARD.
040600     INITIALIZE NAME-TABLE.
040700     MOVE NT-SIZE TO NT-EX.
040800     MOVE 1       TO WS-NAME-PRESENT-FLAG.
040900     PERFORM 020410-PREV-ADDR
041000         UNTIL (NT-EX < 1)
041100                OR
041200               (WS-NAME-PRESENT-FLAG = 0).
041300     DISPLAY SELECT-SCREEN.
041400
041500 020410-PREV-ADDR.
041600     MOVE NAME-NAME    TO NT-NAME   (NT-EX).
041700     MOVE NAME-PHONE   TO NT-PHONE  (NT-EX).
041800     MOVE NAME-COMMENT TO NT-COMMENT(NT-EX).
041900     SUBTRACT 1 FROM NT-EX.
042000     READ NAME-FILE PREVIOUS
042100         AT END
042200             MOVE 0 TO WS-NAME-PRESENT-FLAG.
042300
042400 021000-VIEW.
042500     MOVE NAME-NAME    TO SH-NAME.
042600     MOVE NAME-ADDR-1  TO SH-ADDR-1.
042700     MOVE NAME-ADDR-2  TO SH-ADDR-2.
042800     MOVE NAME-PHONE   TO SH-PHONE.
042900     MOVE NAME-COMMENT TO SH-COMMENT.
043000     DISPLAY CLEAR-NORM-SCREEN.
043100     DISPLAY VIEW-HEADER-SCREEN.
043200     DISPLAY DATA-SCREEN.
043300     DISPLAY VIEW-MENU-SCREEN.
043400     MOVE 0 TO SH-ESCAPE-FLAG.
043500     PERFORM 021010-FUNCTION-LOOP
043600         UNTIL SH-ESCAPE-FLAG = 1.
043700
043800 021010-FUNCTION-LOOP.
043900     MOVE SPACE TO SH-ANSWER.
044000     ACCEPT VIEW-MENU-SCREEN
044100         ON EXCEPTION
044200             MOVE 1 TO SH-ESCAPE-FLAG
044300             EXIT PARAGRAPH.
044400     INSPECT SH-ANSWER
044500         CONVERTING WC-LOWER-CASE
044600                 TO WC-UPPER-CASE.
044700     EVALUATE SH-ANSWER
044800         WHEN "N"
044900             PERFORM 021100-NEXT
045000         WHEN "P"
045100             PERFORM 021200-PREVIOUS
045200         WHEN "M"
045300             PERFORM 021300-MODIFY
045400             MOVE 1 TO SH-ESCAPE-FLAG
045500             EXIT PARAGRAPH
045600         WHEN "D"
045700             PERFORM 021400-DELETE
045800             MOVE 1 TO SH-ESCAPE-FLAG
045900             EXIT PARAGRAPH
046000         WHEN OTHER
046100             EXIT PARAGRAPH
046200     END-EVALUATE.
046300     MOVE NAME-NAME    TO SH-NAME.
046400     MOVE NAME-ADDR-1  TO SH-ADDR-1.
046500     MOVE NAME-ADDR-2  TO SH-ADDR-2.
046600     MOVE NAME-PHONE   TO SH-PHONE.
046700     MOVE NAME-COMMENT TO SH-COMMENT.
046800     DISPLAY DATA-SCREEN.
046900
047000 021100-NEXT.
047100     READ NAME-FILE NEXT
047200         AT END
047300             MOVE SH-NAME TO NAME-NAME
047400             READ NAME-FILE
047500             EXIT PARAGRAPH
047600     END-READ.
047700
047800 021200-PREVIOUS.
047900     READ NAME-FILE PREVIOUS
048000         AT END
048100             MOVE SH-NAME TO NAME-NAME
048200             READ NAME-FILE
048300             EXIT PARAGRAPH
048400     END-READ.
048500
048600 021300-MODIFY.
048700     DISPLAY MODIFY-HEADER-SCREEN.
048800     DISPLAY ESCAPE-SCREEN.
048900     MOVE 0 TO SH-ESCAPE-FLAG.
049000     PERFORM 021310-ACCEPT-MOD
049100         WITH TEST AFTER
049200         UNTIL (SH-ESCAPE-FLAG = 1).
049300
049400 021310-ACCEPT-MOD.
049500     ACCEPT DATA-SCREEN
049600         ON EXCEPTION
049700             MOVE 1 TO SH-ESCAPE-FLAG
049800             EXIT PARAGRAPH.
049900     INSPECT SH-NAME-DATA
050000         CONVERTING WC-LOWER-CASE
050100                 TO WC-UPPER-CASE.
050200     DISPLAY ERASE-ERROR-SCREEN.
050300     IF (SH-NAME NOT = NAME-NAME)
050400         MOVE "NAME IS KEY-CAN'T MODIFY" TO SH-ERROR-MSG
050500         DISPLAY ERROR-SCREEN
050600         MOVE NAME-NAME TO SH-NAME
050700         EXIT PARAGRAPH.
050800     MOVE SH-ADDR-1  TO NAME-ADDR-1.
050900     MOVE SH-ADDR-2  TO NAME-ADDR-2.
051000     MOVE SH-PHONE   TO NAME-PHONE.
051100     MOVE SH-COMMENT TO NAME-COMMENT.
051200     REWRITE NAME-RECORD
051300         INVALID KEY
051400             MOVE "INVALID KEY" TO SH-ERROR-MSG
051500             DISPLAY ERROR-SCREEN
051600             EXIT PARAGRAPH.
051700     MOVE 1 TO SH-ESCAPE-FLAG.
051800
051900 021400-DELETE.
052000     DISPLAY DELETE-HEADER-SCREEN.
052100     DISPLAY QUERY-DELETE-SCREEN.
052200     MOVE 0 TO SH-ESCAPE-FLAG.
052300     PERFORM 021410-ACCEPT-DEL
052400         UNTIL (SH-ESCAPE-FLAG = 1).
052500
052600 021410-ACCEPT-DEL.
052700     ACCEPT QUERY-DELETE-SCREEN
052800         ON EXCEPTION
052900             MOVE 1 TO SH-ESCAPE-FLAG
053000             EXIT PARAGRAPH.
053100     INSPECT SH-ANSWER
053200         CONVERTING WC-LOWER-CASE
053300                 TO WC-UPPER-CASE.
053400     EVALUATE SH-ANSWER
053500         WHEN "N"
053600             MOVE 1 TO SH-ESCAPE-FLAG
053700             EXIT PARAGRAPH
053800         WHEN "Y"
053900             DELETE NAME-FILE
054000             MOVE 1 TO SH-ESCAPE-FLAG
054100             EXIT PARAGRAPH
054200     END-EVALUATE.
054300
054400 030000-PRINT.
054500     MOVE SPACE TO SH-ANSWER.
054600     DISPLAY WAIT-PRINTER-SCREEN.
054700     ACCEPT WAIT-PRINTER-SCREEN
054800         ON EXCEPTION
054900             EXIT PARAGRAPH.
055000     INITIALIZE NAME-RECORD.
055100     MOVE 1 TO WS-NAME-PRESENT-FLAG.
055200     START NAME-FILE
055300         KEY NOT < NAME-NAME
055400         INVALID KEY
055500             MOVE 0 TO WS-NAME-PRESENT-FLAG
055600         NOT INVALID KEY
055700             READ NAME-FILE NEXT
055800                 AT END
055900                     MOVE 0 TO WS-NAME-PRESENT-FLAG
056000             END-READ
056100     END-START.
056200
056300     OPEN OUTPUT PRINT-FILE.
056400     MOVE 0 TO WS-PAGE-COUNT.
056500     PERFORM 039000-PAGE-HEADING.
056600
056700     MOVE 0 TO WS-NAME-COUNT.
056800     PERFORM 031000-PRINT-ADDR
056900         UNTIL (WS-NAME-PRESENT-FLAG = 0).
057000
057100     MOVE WS-NAME-COUNT TO TL-NAME-COUNT.
057200     WRITE PRINT-RECORD FROM TOTAL-LINE BEFORE PAGE.
057300     CLOSE PRINT-FILE.
057400
057500 031000-PRINT-ADDR.
057600     IF (WS-LINE-COUNT > WC-MAX-LINES)
057700         PERFORM 039000-PAGE-HEADING
057800     END-IF.
057900
058000     MOVE NAME-NAME    TO PR-TEXT1.
058100     MOVE NAME-ADDR-1  TO PR-TEXT2.
058200     MOVE NAME-PHONE   TO PR-PHONE.
058300     WRITE PRINT-RECORD BEFORE 1.
058400     MOVE SPACES TO PRINT-RECORD.
058500     MOVE NAME-COMMENT TO PR-TEXT1.
058600     MOVE NAME-ADDR-2  TO PR-TEXT2.
058700     WRITE PRINT-RECORD BEFORE 2.
058800     MOVE SPACES TO PRINT-RECORD.
058900     ADD 3 TO WS-LINE-COUNT.
059000
059100     ADD 1 TO WS-NAME-COUNT.
059200     DISPLAY PRINTING-SCREEN.
059300     READ NAME-FILE NEXT
059400         AT END
059500             MOVE 0 TO WS-NAME-PRESENT-FLAG.
059600
059700 039000-PAGE-HEADING.
059800     IF (WS-LINE-COUNT > 0)
059900         WRITE PRINT-RECORD BEFORE PAGE
060000     END-IF.
060100     ADD 1 TO WS-PAGE-COUNT.
060200     MOVE WS-PAGE-COUNT TO PH-PAGE-NBR.
060300     WRITE PRINT-RECORD FROM PAGE-HEADER BEFORE 2.
060400     MOVE SPACES TO PRINT-RECORD.
060500     MOVE 2 TO WS-LINE-COUNT.
