home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / COBOL650.ZIP / COBSRC.ZIP / ACCEPT4.COB next >
Encoding:
Text File  |  1990-05-16  |  7.4 KB  |  161 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID. ACCEPT4 .
  3.        ENVIRONMENT DIVISION.
  4.        CONFIGURATION SECTION.
  5.        SPECIAL-NAMES.
  6.            PRINTER IS PRINTER-DISPLAY.
  7.        INPUT-OUTPUT SECTION.
  8.        FILE-CONTROL.
  9.            SELECT NAMES-LIST ASSIGN TO DISK
  10.            ORGANIZATION IS SEQUENTIAL.
  11.  
  12.        DATA DIVISION.
  13.        FILE SECTION.
  14.        FD NAMES-LIST
  15.           LABEL RECORDS STANDARD
  16.           VALUE OF FILE-ID "NAMES.LST".
  17.        01 NAMES-RECORD                           PIC X(80).
  18.        WORKING-STORAGE SECTION.
  19.        01 W005-KEYBOARD-KEY-SWITCH               PIC 99.
  20.           88 W005-F1-KEY-ACTIVATED               VALUE 02.
  21.           88 W005-F7-KEY-ACTIVATED               VALUE 08.
  22.        01 W005-RECORD-ACCEPTED-COUNT             PIC 9(4) VALUE +0.
  23.        01 W010-EMPLOYEE-WK-RECORD.
  24.           05 W010-EMPLOYEE-WK-NAME.
  25.              10 W010-EMPLOYEE-WK-NAME-CHAR1      PIC X.
  26.              10 FILLER                           PIC X(29).
  27.           05 W010-EMPLOYEE-WK-STREET.
  28.              10 W010-EMPLOYEE-WK-STREET-CHAR1    PIC X.
  29.              10 FILLER                           PIC X(24).
  30.           05 W010-EMPLOYEE-WK-CITY               PIC X(25).
  31.        01 W025-SCREEN1-ALL-ERRORS.
  32.           05 W025-SCREEN1-ERROR-FIELDS.
  33.              10 W025-SCREEN1-ERROR1                 PIC X(6).
  34.              10 W025-SCREEN1-ERROR2                 PIC X(6).
  35.           05 W025-SCREEN1-ERROR-FIELDS2
  36.              REDEFINES W025-SCREEN1-ERROR-FIELDS.
  37.              10 W025-SCREEN1-ERROR               OCCURS 2
  38.                                                  INDEXED BY W025-ERROR-I
  39.                                                  PIC X(6).
  40.        01 W025-ERROR-LITERAL                     PIC X(10).
  41.        01 FILE-ACCESS-FLAG                       PIC 9 VALUE +0.
  42.        SCREEN SECTION.
  43.        01 SCREEN1-ADDRESS-ENTRY.
  44.           05 BLANK SCREEN.
  45.           05 LINE 1 COLUMN 16       VALUE "E M P L O Y E E"
  46.                                     HIGHLIGHT.
  47.           05 LINE 1 COLUMN 35       VALUE "A D D R E S S"
  48.                                     HIGHLIGHT.
  49.           05 LINE 1 COLUMN 52       VALUE "E N T R Y"
  50.                                     HIGHLIGHT.
  51.           05 LINE 3 COLUMN 24       HIGHLIGHT
  52.                                     VALUE "NAME:".
  53.           05 SCREEN1-NAME           LINE 3 COLUMN 30
  54.                                     PIC X(30)
  55.                                     REVERSE-VIDEO
  56.                                     USING W010-EMPLOYEE-WK-NAME.
  57.           05 LINE 5 COLUMN 22       HIGHLIGHT
  58.                                     VALUE "STREET:".
  59.           05 SCREEN1-STREET         LINE 5 COLUMN 30
  60.                                     PIC X(25)
  61.                                     REVERSE-VIDEO
  62.                                     USING W010-EMPLOYEE-WK-STREET.
  63.           05 LINE 7 COLUMN 18       HIGHLIGHT
  64.                                     VALUE "CITY/STATE:".
  65.           05 SCREEN1-CITY           LINE 7 COLUMN 30
  66.                                     PIC X(25)
  67.                                     REVERSE-VIDEO
  68.                                     USING W010-EMPLOYEE-WK-CITY.
  69.           05 SCREEN1-ERR-LIT        LINE 10 COLUMN 27
  70.                                     PIC X(10)
  71.                                     FROM W025-ERROR-LITERAL.
  72.           05 SCREEN1-ERROR1         LINE 10 COLUMN 38
  73.                                     HIGHLIGHT
  74.                                     BLINK
  75.                                     PIC X(6)
  76.                                     FROM W025-SCREEN1-ERROR1.
  77.           05 SCREEN1-ERROR2         LINE 11 COLUMN 38
  78.                                     HIGHLIGHT
  79.                                     BLINK
  80.                                     PIC X(6)
  81.                                     FROM W025-SCREEN1-ERROR2.
  82.        PROCEDURE DIVISION.
  83.        C000-MAIN-LINE SECTION.
  84.        C020-MAIN-LINE-LOGIC.
  85.            PERFORM C990-INPUT-OUTPUT-FILE-ACCESS.
  86.            MOVE 98 TO W005-KEYBOARD-KEY-SWITCH.
  87.            PERFORM C200-DISPLAY-NEW-SCREEN.
  88.            PERFORM C040-PROCESS-SCREEN1-ENTRY
  89.                                    THRU C160-PROCESS-SCREEN1-EXIT
  90.                                    UNTIL W005-F7-KEY-ACTIVATED.
  91.            PERFORM C980-EOJ-ROUTINE.
  92.            CLOSE NAMES-LIST.
  93.            STOP RUN.
  94.        C040-PROCESS-SCREEN1-ENTRY.
  95.            ACCEPT SCREEN1-ADDRESS-ENTRY.
  96.            ACCEPT W005-KEYBOARD-KEY-SWITCH FROM ESCAPE KEY.
  97.            IF W005-F1-KEY-ACTIVATED
  98.                 PERFORM C200-DISPLAY-NEW-SCREEN
  99.                 GO TO C160-PROCESS-SCREEN1-EXIT
  100.            ELSE IF W005-F7-KEY-ACTIVATED
  101.                 GO TO C160-PROCESS-SCREEN1-EXIT.
  102.            MOVE SPACES TO W025-SCREEN1-ERROR-FIELDS.
  103.            SET W025-ERROR-I TO 0.
  104.        C060-PROCESS-NAME-ENTRY.
  105.            IF W010-EMPLOYEE-WK-NAME-CHAR1 ALPHABETIC
  106.               AND W010-EMPLOYEE-WK-NAME-CHAR1 NOT EQUAL TO SPACES
  107.               NEXT SENTENCE
  108.            ELSE SET W025-ERROR-I UP BY 1
  109.               MOVE "NAME" TO W025-SCREEN1-ERROR (W025-ERROR-I)
  110.               IF W025-ERROR-I EQUAL TO 1
  111.                  MOVE "===>" TO W025-ERROR-LITERAL
  112.               ELSE IF W025-ERROR-I EQUAL TO 2
  113.                  GO TO C120-END-OF-EDITING.
  114.        C080-PROCESS-STREET-ENTRY.
  115.            IF W010-EMPLOYEE-WK-STREET-CHAR1 NOT EQUAL TO SPACE
  116.               NEXT SENTENCE
  117.            ELSE SET W025-ERROR-I UP BY 1
  118.               MOVE "STREET" TO W025-SCREEN1-ERROR (W025-ERROR-I)
  119.               IF W025-ERROR-I EQUAL TO 1
  120.                  MOVE "===>" TO W025-ERROR-LITERAL
  121.               ELSE IF W025-ERROR-I EQUAL TO 2
  122.                  GO TO C120-END-OF-EDITING.
  123.        C100-PROCESS-CITY-ENTRY.
  124.            IF W010-EMPLOYEE-WK-CITY NOT EQUAL TO SPACE
  125.               NEXT SENTENCE
  126.            ELSE SET W025-ERROR-I UP BY 1
  127.               MOVE "CITY" TO W025-SCREEN1-ERROR (W025-ERROR-I)
  128.               IF W025-ERROR-I EQUAL TO 1
  129.                  MOVE "===>" TO W025-ERROR-LITERAL
  130.            ELSE IF W025-ERROR-I EQUAL TO 2
  131.               GO TO C120-END-OF-EDITING.
  132.        C120-END-OF-EDITING.
  133.            IF W025-ERROR-I NOT EQUAL TO ZERO
  134.               PERFORM C220-DISPLAY-ERROR-MESSAGES
  135.               GO TO C160-PROCESS-SCREEN1-EXIT.
  136.        C140-VALID-SCREEN1-EXIT.
  137.            PERFORM C990-INPUT-OUTPUT-FILE-ACCESS.
  138.            ADD 1 TO W005-RECORD-ACCEPTED-COUNT.
  139.            PERFORM C200-DISPLAY-NEW-SCREEN.
  140.        C160-PROCESS-SCREEN1-EXIT.  EXIT.
  141.        C200-DISPLAY-NEW-SCREEN.
  142.            MOVE SPACES TO        W010-EMPLOYEE-WK-NAME
  143.                                  W010-EMPLOYEE-WK-STREET
  144.                                  W010-EMPLOYEE-WK-CITY
  145.                                  W025-SCREEN1-ERROR-FIELDS
  146.                                  W025-ERROR-LITERAL.
  147.            DISPLAY SCREEN1-ADDRESS-ENTRY.
  148.        C220-DISPLAY-ERROR-MESSAGES.
  149.            DISPLAY SCREEN1-ADDRESS-ENTRY.
  150.        C980-EOJ-ROUTINE.
  151.            IF W005-RECORD-ACCEPTED-COUNT  GREATER THAN ZEROS
  152.               DISPLAY "JOB ACCEPT4 : SUCCESSFUL ENTRY COMPLETED" 
  153.            ELSE DISPLAY "JOB ACCEPT4 : UNSUCCESSFUL ENTRY ".
  154.            EXHIBIT NAMED W005-RECORD-ACCEPTED-COUNT.
  155.        C990-INPUT-OUTPUT-FILE-ACCESS.
  156.            IF FILE-ACCESS-FLAG EQUAL 0
  157.               OPEN OUTPUT NAMES-LIST
  158.               ADD 1 TO FILE-ACCESS-FLAG
  159.            ELSE MOVE W010-EMPLOYEE-WK-RECORD TO NAMES-RECORD
  160.               WRITE NAMES-RECORD.
  161.