000100 IDENTIFICATION DIVISION.
000200*
000300 PROGRAM-ID.    NAMES.
000400*
000500*        *******************************
000600*        *                             *
000700*        *     Judson D. McClendon     *
000800*        *     Sun Valley Systems      *
000900*        *     329 37th Court N.E.     *
001000*        *     Birmingham, AL 35215    *
001100*        *        205-853-8440         *
001200*        *                             *
001300*        *******************************
001400*
001500 ENVIRONMENT DIVISION.
001600*
001700 INPUT-OUTPUT SECTION.
001800*
001900 FILE-CONTROL.
002000*
002100     SELECT NAME-FILE        ASSIGN TO DISK
002200                             ORGANIZATION IS INDEXED
002300                             ACCESS MODE IS DYNAMIC
002400                             RECORD KEY IS
002500                                 NAME-NAME.
002600*
002700     SELECT PRINT-FILE       ASSIGN TO PRINTER.
002800*
002900 DATA DIVISION.
003000*
003100 FILE SECTION.
003200*
003300 FD  NAME-FILE
003400     VALUE OF FILE-ID IS "NAME.DAT".
003500*
003600 01  NAME-RECORD.
003700     03  NAME-NAME               PIC  X(30).
003800     03  NAME-ADDR-1             PIC  X(30).
003900     03  NAME-ADDR-2             PIC  X(30).
004000     03  NAME-PHONE              PIC  X(16).
004100     03  NAME-COMMENT            PIC  X(30).
004200
004300 FD  PRINT-FILE.
004400*
004500 01  PRINT-RECORD.
004600     03  PR-TEXT1                PIC  X(30).
004700     03      FILLER              PIC  X(01).
004800     03  PR-TEXT2                PIC  X(30).
004900     03      FILLER              PIC  X(01).
005000     03  PR-PHONE                PIC  X(16).
005100     03      FILLER              PIC  X(02).
005200*
005300 WORKING-STORAGE SECTION.
005400*
005500 78  WC-LOWER-CASE       VALUE "abcdefghijklmnopqrstuvwxyz".
005600 78  WC-UPPER-CASE       VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
005700*
005800*
005900*                S C R E E N   C O L O R S
006000*
006100*  ** Default Colors: White on Black **
006200*
006300 78  WC-FG-DEFAULT       VALUE  7.
006400 78  WC-BG-DEFAULT       VALUE  0.
006500*
006600*  ** Normal Colors: White on Blue **
006700*
006800 78  WC-FG-NORM          VALUE  7.
006900 78  WC-BG-NORM          VALUE  1.
007000*
007100*  ** Hilite Colors: Green on Blue **
007200*
007300 78  WC-FG-HILITE        VALUE  2.
007400 78  WC-BG-HILITE        VALUE  1.
007500*
007600*  ** Error Colors: Red on Blue **
007700*
007800 78  WC-FG-ERROR         VALUE  4.
007900 78  WC-BG-ERROR         VALUE  1.
008000*
008100 78  WC-MAX-LINES        VALUE 57.
008200 77  WS-LINE-COUNT               PIC  9(02)  VALUE 0.
008300 77  WS-PAGE-COUNT               PIC  9(04)  VALUE 0.
008400 77  WS-NAME-COUNT               PIC  9(04)  VALUE 0.
008500 77  WS-END-FLAG                 PIC  9(01)  VALUE 0.
008600 77  WS-NAME-PRESENT-FLAG        PIC  9(01)  VALUE 0.
008700*
008800*
008900*           S C R E E N   H O L D   A R E A
009000*
009100 01  SCREEN-HOLD-AREA.
009200     03  SH-ERROR-FLAG           PIC  9(01)  VALUE 0.
009300     03  SH-ESCAPE-FLAG          PIC  9(01)  VALUE 0.
009400     03  SH-ERROR-MSG            PIC  X(70)  VALUE SPACES.
009500     03  SH-ANSWER                           VALUE SPACES.
009600         05  SH-ANSWER-NUM       PIC  9(01).
009700     03  SH-NAME-DATA.
009800         05  SH-NAME             PIC  X(30)  VALUE SPACES.
009900         05  SH-ADDR-1           PIC  X(30)  VALUE SPACES.
010000         05  SH-ADDR-2           PIC  X(30)  VALUE SPACES.
010100         05  SH-PHONE            PIC  X(16)  VALUE SPACES.
010200         05  SH-COMMENT          PIC  X(30)  VALUE SPACES.
010300*
010400*
010500*                 N A M E   T A B L  E
010600*
010700 78  NT-SIZE             VALUE 9.
010800 01  NAME-TABLE.
010900     03  NT-ENTRY                OCCURS NT-SIZE TIMES.
011000         05  NT-NAME                 PIC  X(30).
011100         05      FILLER              PIC  X(01).
011200         05  NT-PHONE                PIC  X(16).
011300         05      FILLER              PIC  X(01).
011400         05  NT-COMMENT              PIC  X(30).
011500     03  NT-EX                   PIC  9(02)  VALUE 0.
011600*
011700*
011800*               P R I N T   H E A D E R S
011900*
012000 01  PAGE-HEADER.
012100     03      FILLER              PIC  X(30)  VALUE SPACES.
012200     03      FILLER              PIC  X(19)  VALUE
012300         "N A M E   L I S T".
012400     03      FILLER              PIC  X(20)  VALUE SPACES.
012500     03      FILLER              PIC  X(05)  VALUE "Page ".
012600     03  PH-PAGE-NBR             PIC  ZZZ9   VALUE ZEROS.
012700*
012800 01  TOTAL-LINE.
012900     03      FILLER              PIC  X(27)  VALUE SPACES.
013000     03  TL-NAME-COUNT           PIC  ZZZ9   VALUE ZEROS.
013100     03      FILLER              PIC  X(14)  VALUE
013200         " names printed".
013300*
013400 SCREEN SECTION.
013500*
013600*
013700*                 M E N U   S C R E E N
013800*
013900 01  MENU-SCREEN
014000         FOREGROUND-COLOR WC-FG-NORM
014100         BACKGROUND-COLOR WC-BG-NORM
014200         BLANK SCREEN.
014300     03  LINE 01  COLUMN 29  VALUE
014400         "N A M E   P R O G R A M".
014500     03  LINE 03  COLUMN 25  VALUE "Press: A = Add Name".
014600     03  LINE 04  COLUMN 32  VALUE "F = Find Name".
014700     03  LINE 05  COLUMN 32  VALUE "P = Print Names".
014800     03  LINE 07  COLUMN 29  VALUE "or X = Exit Program: ".
014900     03  PIC  X(01)          TO SH-ANSWER  AUTO.
015000*
015100*
015200*             G E T   N A M E  S C R E E N
015300*
015400 01  GET-NAME-SCREEN
015500         FOREGROUND-COLOR WC-FG-NORM
015600         BACKGROUND-COLOR WC-BG-NORM.
015700     03  LINE 11  COLUMN 16  BLANK LINE
015800         VALUE "Find Name: ".
015900     03  PIC  X(30)          USING SH-NAME.
016000*
016100*
016200*                S E L E C T   S C R E E N
016300*
016400 01  SELECT-SCREEN
016500         FOREGROUND-COLOR WC-FG-NORM
016600         BACKGROUND-COLOR WC-BG-NORM
016700         BLANK SCREEN.
016800     03  LINE 01  COLUMN 30  VALUE
016900         "S E L E C T   N A M E".
017000     03  LINE 03  COLUMN 03  VALUE
017100         "NAME-------------------------- PHONE----------- COMMENT-
017200-        "----------------------".
017300*
017400     03  LINE 04  COLUMN 01  VALUE "1 ".
017500     03  PIC  X(78)          FROM NT-ENTRY(1).
017600     03  LINE 05  COLUMN 01  VALUE "2 ".
017700     03  PIC  X(78)          FROM NT-ENTRY(2).
017800     03  LINE 06  COLUMN 01  VALUE "3 ".
017900     03  PIC  X(78)          FROM NT-ENTRY(3).
018000     03  LINE 07  COLUMN 01  VALUE "4 ".
018100     03  PIC  X(78)          FROM NT-ENTRY(4).
018200     03  LINE 08  COLUMN 01  VALUE "5 ".
018300     03  PIC  X(78)          FROM NT-ENTRY(5).
018400     03  LINE 09  COLUMN 01  VALUE "6 ".
018500     03  PIC  X(78)          FROM NT-ENTRY(6).
018600     03  LINE 10  COLUMN 01  VALUE "7 ".
018700     03  PIC  X(78)          FROM NT-ENTRY(7).
018800     03  LINE 11  COLUMN 01  VALUE "8 ".
018900     03  PIC  X(78)          FROM NT-ENTRY(8).
019000     03  LINE 12  COLUMN 01  VALUE "9 ".
019100     03  PIC  X(78)          FROM NT-ENTRY(9).
019200*
019300     03      FOREGROUND-COLOR WC-FG-HILITE
019400             BACKGROUND-COLOR WC-BG-HILITE.
019500         05  LINE 14  COLUMN 13  BLANK LINE  VALUE
019600         "1-9=Select Name, N=Next Page, P=Prev Page, Esc=Exit: ".
019700         05  PIC  X              TO SH-ANSWER AUTO.
019800*
019900*
020000*             C L E A R   D E F A U L T   S C R E E N
020100*
020200 01  CLEAR-DEFAULT-SCREEN
020300         FOREGROUND-COLOR WC-FG-DEFAULT
020400         BACKGROUND-COLOR WC-BG-DEFAULT
020500         BLANK SCREEN.
020600*
020700*
020800*                C L E A R   N O R M   S C R E E N
020900*
021000 01  CLEAR-NORM-SCREEN
021100         FOREGROUND-COLOR WC-FG-NORM
021200         BACKGROUND-COLOR WC-BG-NORM
021300         BLANK SCREEN.
021400*
021500*
021600*                A D D   H E A D E R   S C R E E N
021700*
021800 01  ADD-HEADER-SCREEN
021900         FOREGROUND-COLOR WC-FG-NORM
022000         BACKGROUND-COLOR WC-BG-NORM.
022100     03  LINE 01  COLUMN 34  BLANK LINE  VALUE
022200         "A D D   N A M E".
022300*
022400*
022500*             D E L E T E   H E A D E R   S C R E E N
022600*
022700 01  DELETE-HEADER-SCREEN
022800         FOREGROUND-COLOR WC-FG-NORM
022900         BACKGROUND-COLOR WC-BG-NORM.
023000     03  LINE 01  COLUMN 30  BLANK LINE  VALUE
023100         "D E L E T E   N A M E".
023200*
023300*
023400*             M O D I F Y   H E A D E R   S C R E E N
023500*
023600 01  MODIFY-HEADER-SCREEN
023700         FOREGROUND-COLOR WC-FG-NORM
023800         BACKGROUND-COLOR WC-BG-NORM.
023900     03  LINE 01  COLUMN 30  BLANK LINE  VALUE
024000         "M O D I F Y   N A M E".
024100*
024200*
024300*               V I E W   H E A D E R   S C R E E N
024400*
024500 01  VIEW-HEADER-SCREEN
024600         FOREGROUND-COLOR WC-FG-NORM
024700         BACKGROUND-COLOR WC-BG-NORM.
024800     03  LINE 01  COLUMN 32  BLANK LINE  VALUE
024900         "V I E W   N A M E".
025000*
025100*
025200*                      D A T A   S C R E E N
025300*
025400 01  DATA-SCREEN
025500         FOREGROUND-COLOR WC-FG-NORM
025600         BACKGROUND-COLOR WC-BG-NORM.
025700     03  LINE 03  COLUMN 09  VALUE "Name:  ".
025800     03  PIC  X(30)          USING SH-NAME  REQUIRED.
025900     03  LINE 05  COLUMN 09  VALUE "Addr1: ".
026000     03  PIC  X(30)          USING SH-ADDR-1.
026100     03  LINE 06  COLUMN 09  VALUE "Addr2: ".
026200     03  PIC  X(30)          USING SH-ADDR-2.
026300     03  LINE 08  COLUMN 09  VALUE "Phone: ".
026400     03  PIC  X(16)          USING SH-PHONE.
026500     03  LINE 10  COLUMN 09  VALUE "Comment: ".
026600     03  PIC  X(30)          USING SH-COMMENT.
026700*
026800*
026900*                 V I E W   M E N U   S C R E E N
027000*
027100 01  VIEW-MENU-SCREEN
027200         FOREGROUND-COLOR WC-FG-HILITE
027300         BACKGROUND-COLOR WC-BG-HILITE.
027400     03  LINE 13  COLUMN 05  BLANK LINE  VALUE
027500         "N=Next Name, P=Prev Name, M=Modify Name, D=Delete Name,
027600-        "Esc=Exit: ".
027700     03  PIC  X(01)          TO SH-ANSWER  AUTO.
027800*
027900*
028000*                    E S C A P E   S C R E E N
028100*
028200 01  ESCAPE-SCREEN
028300         FOREGROUND-COLOR WC-FG-HILITE
028400         BACKGROUND-COLOR WC-BG-HILITE.
028500     03  LINE 13  COLUMN 32  BLANK LINE  VALUE
028600         "Esc=Exit".
028700*
028800*
028900*              Q U E R Y   D E L E T E   S C R E E N
029000*
029100 01  QUERY-DELETE-SCREEN
029200         FOREGROUND-COLOR WC-FG-HILITE
029300         BACKGROUND-COLOR WC-BG-HILITE.
029400     03  LINE 13  COLUMN 15  BLANK LINE  VALUE
029500         "Do you REALLY want to delete this name (Y/N)? ".
029600     03  PIC  X(01)          TO SH-ANSWER  AUTO.
029700*
029800*
029900*              W A I T   P R I N T E R   S C R E E N
030000*
030100 01  WAIT-PRINTER-SCREEN
030200         FOREGROUND-COLOR WC-FG-HILITE
030300         BACKGROUND-COLOR WC-BG-HILITE.
030400     03  LINE 11  COLUMN 16  BLANK LINE  VALUE
030500         "Ready printer and press a key (Esc=Exit)".
030600     03  PIC  X(01)          TO SH-ANSWER  AUTO.
030700*
030800*
030900*                  P R I N T I N G   S C R E E N
031000*
031100 01  PRINTING-SCREEN
031200         FOREGROUND-COLOR WC-FG-HILITE
031300         BACKGROUND-COLOR WC-BG-HILITE.
031400     03  LINE 11  COLUMN 28  BLANK LINE
031500         PIC  ZZZ9           FROM WS-NAME-COUNT.
031600     03  VALUE " names printed".
031700*
031800*
031900*                     E R R O R   S C R E E N
032000*
032100 01  ERROR-SCREEN
032200         FOREGROUND-COLOR WC-FG-ERROR
032300         BACKGROUND-COLOR WC-BG-ERROR.
032400     03  LINE 24  COLUMN 05  BLANK LINE
032500         PIC  X(70)          FROM SH-ERROR-MSG.
032600*
032700*
032800*               E R A S E   E R R O R   S C R E E N
032900*
033000 01  ERASE-ERROR-SCREEN
033100         FOREGROUND-COLOR WC-FG-NORM
033200         BACKGROUND-COLOR WC-BG-NORM.
033300     03  LINE 24             BLANK LINE.
033400*
033500 PROCEDURE DIVISION.
033600*
033700*
033800*                          C O N T R O L
033900*
034000 000000-CONTROL.
034100*
034200     OPEN I-O NAME-FILE.
034300     DISPLAY MENU-SCREEN.
034400*
034500     PERFORM 000100-PROCESS
034600         UNTIL (WS-END-FLAG = 1).
034700*
034800     DISPLAY CLEAR-DEFAULT-SCREEN.
034900     CLOSE NAME-FILE.
035000     STOP RUN.
035100*
035200*
035300*                          P R O C E S S
035400*
035500 000100-PROCESS.
035600*
035700     MOVE SPACE TO SH-ANSWER.
035800     ACCEPT MENU-SCREEN.
035900     INSPECT SH-ANSWER
036000         CONVERTING WC-LOWER-CASE
036100                 TO WC-UPPER-CASE.
036200*
036300     EVALUATE SH-ANSWER
036400         WHEN "A"
036500             PERFORM 010000-ADD
036600         WHEN "F"
036700             PERFORM 020000-FIND
036800         WHEN "P"
036900             PERFORM 030000-PRINT
037000         WHEN "X"
037100             MOVE 1 TO WS-END-FLAG
037200             EXIT PARAGRAPH
037300         WHEN OTHER
037400             EXIT PARAGRAPH
037500     END-EVALUATE.
037600     DISPLAY MENU-SCREEN.
037700*
037800*
037900*                              A D D
038000*
038100 010000-ADD.
038200*
038300     INITIALIZE SCREEN-HOLD-AREA.
038400     DISPLAY CLEAR-NORM-SCREEN.
038500     DISPLAY ADD-HEADER-SCREEN.
038600     DISPLAY DATA-SCREEN.
038700     DISPLAY ESCAPE-SCREEN.
038800*
038900     PERFORM 011000-ADD-LOOP
039000         WITH TEST AFTER
039100         UNTIL (SH-ESCAPE-FLAG = 1).
039200*
039300*
039400*                         A D D   L O O P
039500*
039600 011000-ADD-LOOP.
039700*
039800     MOVE 0 TO SH-ESCAPE-FLAG.
039900     ACCEPT DATA-SCREEN
040000         ON EXCEPTION
040100             MOVE 1 TO SH-ESCAPE-FLAG
040200             EXIT PARAGRAPH.
040300     INSPECT SH-NAME-DATA
040400         CONVERTING WC-LOWER-CASE
040500                 TO WC-UPPER-CASE.
040600     DISPLAY ERASE-ERROR-SCREEN.
040700*
040800     INITIALIZE NAME-RECORD.
040900     MOVE SH-NAME    TO NAME-NAME.
041000     MOVE SH-ADDR-1  TO NAME-ADDR-1.
041100     MOVE SH-ADDR-2  TO NAME-ADDR-2.
041200     MOVE SH-PHONE   TO NAME-PHONE.
041300     MOVE SH-COMMENT TO NAME-COMMENT.
041400     WRITE NAME-RECORD
041500         INVALID KEY
041600             MOVE "DUPLICATE NAME" TO SH-ERROR-MSG
041700             DISPLAY ERROR-SCREEN
041800             EXIT PARAGRAPH.
041900*
042000     INITIALIZE SCREEN-HOLD-AREA.
042100     DISPLAY DATA-SCREEN.
042200     DISPLAY ERASE-ERROR-SCREEN.
042300*
042400*
042500*                             F I N D
042600*
042700 020000-FIND.
042800*
042900     INITIALIZE SCREEN-HOLD-AREA.
043000     DISPLAY GET-NAME-SCREEN.
043100*
043200     MOVE 0 TO SH-ESCAPE-FLAG.
043300     MOVE 0 TO WS-NAME-PRESENT-FLAG.
043400     PERFORM 020100-GET-NAME
043500         WITH TEST AFTER
043600         UNTIL (SH-ESCAPE-FLAG = 1)
043700                OR
043800               (WS-NAME-PRESENT-FLAG = 1).
043900*
044000     IF (WS-NAME-PRESENT-FLAG = 1)
044100         PERFORM 020300-FORWARD
044200         MOVE 0 TO SH-ESCAPE-FLAG
044300         PERFORM 020200-SELECT-LOOP
044400             UNTIL (SH-ESCAPE-FLAG = 1).
044500*
044600*
044700*                         G E T   N A M E
044800*
044900 020100-GET-NAME.
045000*
045100     MOVE SPACE TO SH-ANSWER.
045200     ACCEPT GET-NAME-SCREEN
045300         ON EXCEPTION
045400             MOVE 1 TO SH-ESCAPE-FLAG
045500             EXIT PARAGRAPH.
045600     INSPECT SH-NAME
045700         CONVERTING WC-LOWER-CASE
045800                 TO WC-UPPER-CASE.
045900     DISPLAY ERASE-ERROR-SCREEN.
046000*
046100     INITIALIZE NAME-RECORD.
046200     MOVE SH-NAME TO NAME-NAME.
046300     START NAME-FILE
046400         KEY NOT < NAME-NAME
046500         INVALID KEY
046600             MOVE "NO RECORDS FOUND" TO SH-ERROR-MSG
046700             DISPLAY ERROR-SCREEN
046800             EXIT PARAGRAPH.
046900*
047000     READ NAME-FILE NEXT.
047100     MOVE 1 TO WS-NAME-PRESENT-FLAG.
047200*
047300*
047400*                      S E L E C T   L O O P
047500*
047600 020200-SELECT-LOOP.
047700*
047800     MOVE SPACE TO SH-ANSWER.
047900     ACCEPT SELECT-SCREEN
048000         ON EXCEPTION
048100             MOVE 1 TO SH-ESCAPE-FLAG
048200             EXIT PARAGRAPH.
048300     DISPLAY ERASE-ERROR-SCREEN.
048400     INSPECT SH-ANSWER
048500         CONVERTING WC-LOWER-CASE
048600                 TO WC-UPPER-CASE.
048700*
048800     EVALUATE SH-ANSWER
048900         WHEN "N"
049000             IF (NT-NAME(NT-SIZE) NOT = SPACES)
049100                 INITIALIZE NAME-RECORD
049200                 MOVE NT-NAME(NT-SIZE) TO NAME-NAME
049300                 READ NAME-FILE
049400                 READ NAME-FILE NEXT
049500                     NOT AT END
049600                         PERFORM 020300-FORWARD
049700                 END-READ
049800             END-IF
049900         WHEN "P"
050000             IF (NT-NAME(1) NOT = SPACES)
050100                 INITIALIZE NAME-RECORD
050200                 MOVE NT-NAME(1) TO NAME-NAME
050300                 READ NAME-FILE
050400                 READ NAME-FILE PREVIOUS
050500                     NOT AT END
050600                         PERFORM 020400-BACKWARD
050700                 END-READ
050800             END-IF
050900         WHEN "1" THRU "9"
051000             IF (NT-NAME(SH-ANSWER-NUM) NOT = SPACES)
051100                 INITIALIZE NAME-RECORD
051200                 MOVE NT-NAME(SH-ANSWER-NUM) TO NAME-NAME
051300                 READ NAME-FILE
051400                 PERFORM 021000-VIEW
051500                 MOVE 1 TO SH-ESCAPE-FLAG
051600                 EXIT PARAGRAPH
051700             END-IF
051800         WHEN OTHER
051900             EXIT PARAGRAPH
052000     END-EVALUATE.
052100     DISPLAY SELECT-SCREEN.
052200*
052300*
052400*                          F O R W A R D
052500*
052600 020300-FORWARD.
052700*
052800     INITIALIZE NAME-TABLE.
052900*
053000     MOVE 1 TO NT-EX.
053100     MOVE 1 TO WS-NAME-PRESENT-FLAG.
053200     PERFORM 020310-NEXT-ADDR
053300         UNTIL (NT-EX > NT-SIZE)
053400                OR
053500               (WS-NAME-PRESENT-FLAG = 0).
053600*
053700     DISPLAY SELECT-SCREEN.
053800*
053900*
054000*                        N E X T   A D D R
054100*
054200 020310-NEXT-ADDR.
054300*
054400     MOVE NAME-NAME    TO NT-NAME   (NT-EX).
054500     MOVE NAME-PHONE   TO NT-PHONE  (NT-EX).
054600     MOVE NAME-COMMENT TO NT-COMMENT(NT-EX).
054700*
054800     ADD 1 TO NT-EX.
054900     READ NAME-FILE NEXT
055000         AT END
055100             MOVE 0 TO WS-NAME-PRESENT-FLAG.
055200*
055300*
055400*                         B A C K W A R D
055500*
055600 020400-BACKWARD.
055700*
055800     INITIALIZE NAME-TABLE.
055900*
056000     MOVE NT-SIZE TO NT-EX.
056100     MOVE 1       TO WS-NAME-PRESENT-FLAG.
056200     PERFORM 020410-PREV-ADDR
056300         UNTIL (NT-EX < 1)
056400                OR
056500               (WS-NAME-PRESENT-FLAG = 0).
056600*
056700     DISPLAY SELECT-SCREEN.
056800*
056900*
057000*                        P R E V   A D D R
057100*
057200 020410-PREV-ADDR.
057300*
057400     MOVE NAME-NAME    TO NT-NAME   (NT-EX).
057500     MOVE NAME-PHONE   TO NT-PHONE  (NT-EX).
057600     MOVE NAME-COMMENT TO NT-COMMENT(NT-EX).
057700*
057800     SUBTRACT 1 FROM NT-EX.
057900     READ NAME-FILE PREVIOUS
058000         AT END
058100             MOVE 0 TO WS-NAME-PRESENT-FLAG.
058200*
058300*
058400*                             V I E W
058500*
058600 021000-VIEW.
058700*
058800     MOVE NAME-NAME    TO SH-NAME.
058900     MOVE NAME-ADDR-1  TO SH-ADDR-1.
059000     MOVE NAME-ADDR-2  TO SH-ADDR-2.
059100     MOVE NAME-PHONE   TO SH-PHONE.
059200     MOVE NAME-COMMENT TO SH-COMMENT.
059300*
059400     DISPLAY CLEAR-NORM-SCREEN.
059500     DISPLAY VIEW-HEADER-SCREEN.
059600     DISPLAY DATA-SCREEN.
059700     DISPLAY VIEW-MENU-SCREEN.
059800*
059900     MOVE 0 TO SH-ESCAPE-FLAG.
060000     PERFORM 021010-FUNCTION-LOOP
060100         UNTIL SH-ESCAPE-FLAG = 1.
060200*
060300*
060400*                    F U N C T I O N   L O O P
060500*
060600 021010-FUNCTION-LOOP.
060700*
060800     MOVE SPACE TO SH-ANSWER.
060900     ACCEPT VIEW-MENU-SCREEN
061000         ON EXCEPTION
061100             MOVE 1 TO SH-ESCAPE-FLAG
061200             EXIT PARAGRAPH.
061300     INSPECT SH-ANSWER
061400         CONVERTING WC-LOWER-CASE
061500                 TO WC-UPPER-CASE.
061600*
061700     EVALUATE SH-ANSWER
061800         WHEN "N"
061900             PERFORM 021100-NEXT
062000         WHEN "P"
062100             PERFORM 021200-PREVIOUS
062200         WHEN "M"
062300             PERFORM 021300-MODIFY
062400             MOVE 1 TO SH-ESCAPE-FLAG
062500             EXIT PARAGRAPH
062600         WHEN "D"
062700             PERFORM 021400-DELETE
062800             MOVE 1 TO SH-ESCAPE-FLAG
062900             EXIT PARAGRAPH
063000         WHEN OTHER
063100             EXIT PARAGRAPH
063200     END-EVALUATE.
063300*
063400     MOVE NAME-NAME    TO SH-NAME.
063500     MOVE NAME-ADDR-1  TO SH-ADDR-1.
063600     MOVE NAME-ADDR-2  TO SH-ADDR-2.
063700     MOVE NAME-PHONE   TO SH-PHONE.
063800     MOVE NAME-COMMENT TO SH-COMMENT.
063900     DISPLAY DATA-SCREEN.
064000*
064100*
064200*                             N E X T
064300 021100-NEXT.
064400*
064500     READ NAME-FILE NEXT
064600         AT END
064700             MOVE SH-NAME TO NAME-NAME
064800             READ NAME-FILE
064900             EXIT PARAGRAPH
065000     END-READ.
065100*
065200*
065300*                         P R E V I O U S
065400*
065500 021200-PREVIOUS.
065600*
065700     READ NAME-FILE PREVIOUS
065800         AT END
065900             MOVE SH-NAME TO NAME-NAME
066000             READ NAME-FILE
066100             EXIT PARAGRAPH
066200     END-READ.
066300*
066400*
066500*                           M O D I F Y
066600*
066700 021300-MODIFY.
066800*
066900     DISPLAY MODIFY-HEADER-SCREEN.
067000     DISPLAY ESCAPE-SCREEN.
067100*
067200     MOVE 0 TO SH-ESCAPE-FLAG.
067300     PERFORM 021310-ACCEPT-MOD
067400         WITH TEST AFTER
067500         UNTIL (SH-ESCAPE-FLAG = 1).
067600*
067700*
067800*                       A C C E P T   M O D
067900*
068000 021310-ACCEPT-MOD.
068100*
068200     ACCEPT DATA-SCREEN
068300         ON EXCEPTION
068400             MOVE 1 TO SH-ESCAPE-FLAG
068500             EXIT PARAGRAPH.
068600     INSPECT SH-NAME-DATA
068700         CONVERTING WC-LOWER-CASE
068800                 TO WC-UPPER-CASE.
068900     DISPLAY ERASE-ERROR-SCREEN.
069000*
069100     IF (SH-NAME NOT = NAME-NAME)
069200         MOVE "NAME IS KEY-CAN'T MODIFY" TO SH-ERROR-MSG
069300         DISPLAY ERROR-SCREEN
069400         MOVE NAME-NAME TO SH-NAME
069500         EXIT PARAGRAPH.
069600*
069700     MOVE SH-ADDR-1  TO NAME-ADDR-1.
069800     MOVE SH-ADDR-2  TO NAME-ADDR-2.
069900     MOVE SH-PHONE   TO NAME-PHONE.
070000     MOVE SH-COMMENT TO NAME-COMMENT.
070100     REWRITE NAME-RECORD
070200         INVALID KEY
070300             MOVE "INVALID KEY" TO SH-ERROR-MSG
070400             DISPLAY ERROR-SCREEN
070500             EXIT PARAGRAPH.
070600     MOVE 1 TO SH-ESCAPE-FLAG.
070700*
070800*
070900*                           D E L E T E
071000*
071100 021400-DELETE.
071200*
071300     DISPLAY DELETE-HEADER-SCREEN.
071400     DISPLAY QUERY-DELETE-SCREEN.
071500*
071600     MOVE 0 TO SH-ESCAPE-FLAG.
071700     PERFORM 021410-ACCEPT-DEL
071800         UNTIL (SH-ESCAPE-FLAG = 1).
071900*
072000*
072100*                       A C C E P T   D E L
072200*
072300 021410-ACCEPT-DEL.
072400*
072500     ACCEPT QUERY-DELETE-SCREEN
072600         ON EXCEPTION
072700             MOVE 1 TO SH-ESCAPE-FLAG
072800             EXIT PARAGRAPH.
072900     INSPECT SH-ANSWER
073000         CONVERTING WC-LOWER-CASE
073100                 TO WC-UPPER-CASE.
073200*
073300     EVALUATE SH-ANSWER
073400         WHEN "N"
073500             MOVE 1 TO SH-ESCAPE-FLAG
073600             EXIT PARAGRAPH
073700         WHEN "Y"
073800             DELETE NAME-FILE
073900             MOVE 1 TO SH-ESCAPE-FLAG
074000             EXIT PARAGRAPH
074100     END-EVALUATE.
074200*
074300*
074400*                            P R I N T
074500*
074600 030000-PRINT.
074700*
074800     MOVE SPACE TO SH-ANSWER.
074900     DISPLAY WAIT-PRINTER-SCREEN.
075000     ACCEPT WAIT-PRINTER-SCREEN
075100         ON EXCEPTION
075200             EXIT PARAGRAPH.
075300*
075400     INITIALIZE NAME-RECORD.
075500     MOVE 1 TO WS-NAME-PRESENT-FLAG.
075600     START NAME-FILE
075700         KEY NOT < NAME-NAME
075800         INVALID KEY
075900             MOVE 0 TO WS-NAME-PRESENT-FLAG
076000         NOT INVALID KEY
076100             READ NAME-FILE NEXT
076200                 AT END
076300                     MOVE 0 TO WS-NAME-PRESENT-FLAG
076400             END-READ
076500     END-START.
076600*
076700     OPEN OUTPUT PRINT-FILE.
076800     MOVE 0 TO WS-PAGE-COUNT.
076900     PERFORM 039000-PAGE-HEADING.
077000*
077100     MOVE 0 TO WS-NAME-COUNT.
077200     PERFORM 031000-PRINT-ADDR
077300         UNTIL (WS-NAME-PRESENT-FLAG = 0).
077400*
077500     MOVE WS-NAME-COUNT TO TL-NAME-COUNT.
077600     WRITE PRINT-RECORD FROM TOTAL-LINE BEFORE PAGE.
077700     CLOSE PRINT-FILE.
077800*
077900*
078000*                       P R I N T   A D D R
078100*
078200 031000-PRINT-ADDR.
078300*
078400     IF (WS-LINE-COUNT > WC-MAX-LINES)
078500         PERFORM 039000-PAGE-HEADING
078600     END-IF.
078700*
078800     MOVE NAME-NAME    TO PR-TEXT1.
078900     MOVE NAME-ADDR-1  TO PR-TEXT2.
079000     MOVE NAME-PHONE   TO PR-PHONE.
079100     WRITE PRINT-RECORD BEFORE 1.
079200     MOVE SPACES TO PRINT-RECORD.
079300*
079400     MOVE NAME-COMMENT TO PR-TEXT1.
079500     MOVE NAME-ADDR-2  TO PR-TEXT2.
079600     WRITE PRINT-RECORD BEFORE 2.
079700     MOVE SPACES TO PRINT-RECORD.
079800     ADD 3 TO WS-LINE-COUNT.
079900*
080000     ADD 1 TO WS-NAME-COUNT.
080100     DISPLAY PRINTING-SCREEN.
080200     READ NAME-FILE NEXT
080300         AT END
080400             MOVE 0 TO WS-NAME-PRESENT-FLAG.
080500*
080600*
080700*                     P A G E   H E A D I N G
080800*
080900 039000-PAGE-HEADING.
081000*
081100     IF (WS-LINE-COUNT > 0)
081200         WRITE PRINT-RECORD BEFORE PAGE
081300     END-IF.
081400*
081500     ADD 1 TO WS-PAGE-COUNT.
081600     MOVE WS-PAGE-COUNT TO PH-PAGE-NBR.
081700     WRITE PRINT-RECORD FROM PAGE-HEADER BEFORE 2.
081800     MOVE SPACES TO PRINT-RECORD.
081900     MOVE 2 TO WS-LINE-COUNT.
