* FILE NAME: ESCDEMO.COB * AUTHOR: R.W.MCDOUGALL * CREATION DATE: 85 * REVISION DATE: 11/16/86 RWM added string -> numeric conversion * REVISION DATE: 11/08/86 RWM revised for Lab Assistants * LOCATION: HSTC * MAIN FRAME: VAX 11/780 * SYSTEM: VAX/VMS V4.4 * LANGUAGE: VAX-11 COBOL V3.3 * DESCRIPTION: Demo of COBOL disk I/O, screen I/O and looping * -------------------------------------------------------------------- IDENTIFICATION DIVISION. PROGRAM-ID. ESCDEMO. AUTHOR. ROBERT MCDOUGALL ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT DATA-IN ASSIGN TO "ESCDEMO-COB.DAT". SELECT DATA-OUT ASSIGN TO "ESCDEMO-COB.OUT". DATA DIVISION. FILE SECTION. FD DATA-IN DATA RECORD IS DATA-IN-RECORD RECORD CONTAINS 37 CHARACTERS LABEL RECORDS ARE STANDARD. 01 DATA-IN-RECORD. 05 DATE-SHIPPED PIC X(8). 05 ITEM-COST PIC X(6). 05 ITEM-DESC PIC X(17). 05 TOTL-AMNT PIC X(6). FD DATA-OUT DATA RECORD IS PRINTLINE RECORD CONTAINS 80 CHARACTERS LABEL RECORDS ARE STANDARD. 01 PRINTLINE PIC X(80). WORKING-STORAGE SECTION. 01 GRAPHIC-LINES. 05 HORIZ PIC X(80) VALUE ALL "_". 05 TOP-LINE. 10 FILLER PIC X(38) VALUE "lqqqqqqwqqqqqqqqqqwqqqqqqqqwqqqqqqqqqq". 10 FILLER PIC X(38) VALUE "qqqqqqqqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqk". 05 DESC-LINE. 10 FILLER PIC X(38) VALUE "tqqqqqqnqqqqqqqqqqnqqqqqqqqnqqqqqqqqqq". 10 FILLER PIC X(38) VALUE "qqqqqqqqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqu". 05 NEXT-LINE. 10 FILLER PIC X(38) VALUE "x x x x ". 10 FILLER PIC X(38) VALUE " x x". 05 BOTTOM-LINE. 10 FILLER PIC X(38) VALUE "mqqqqqqvqqqqqqqqqqvqqqqqqqqvqqqqqqqqqq". 10 FILLER PIC X(38) VALUE "qqqqqqqqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqj". 01 O-HEADING-LINE1. 05 FILLER PIC X(38) VALUE "Ord Shpd Cost Description ". 05 FILLER PIC X(11) VALUE " Amount". 01 O-HEADING-LINE2. 05 FILLER PIC X(38) VALUE "---- -------- ------ --------------". 05 FILLER PIC X(11) VALUE "--- ------". 01 O-VALUE-LINE. 05 O-ORDER-NUM PIC 9(3) VALUE IS ZEROS. 05 FILLER PIC X(3) VALUE IS SPACES. 05 O-DATE-SHIPPED PIC X(8). 05 FILLER PIC X(2) VALUE IS SPACES. 05 O-ITEM-COST PIC X(6). 05 FILLER PIC X(2) VALUE IS SPACES. 05 O-ITEM-DESC PIC X(17). 05 FILLER PIC X(2) VALUE IS SPACES. 05 O-TOTL-AMNT PIC X(6). 01 SWITCHES-AND-MORE. 02 ORDER-NUM PIC XXX VALUE ZEROS. 02 N-ORDER-NUM PIC 999. 02 TRY-SWITCH PIC 9. 02 ZERO-SW PIC 9 VALUE 0. 02 ONE-SW PIC 9 VALUE 1. 02 MIN-VAL PIC 999 VALUE 100. 02 MAX-VAL PIC 999 VALUE 999. 02 VALUE-OK-SW PIC 9. 01 SEND-DATE PIC X(8). 01 ESCAPE-VAL PIC 999 COMP VALUE 155. 01 ESCAPE-RED REDEFINES ESCAPE-VAL. 03 ESCAPE PIC X. 03 FILLER PIC X. 01 LINE-NO PIC 99 VALUE 1. 01 COL-NO PIC 99 VALUE 1. PROCEDURE DIVISION. 000-SOLVE-PROBLEM. PERFORM 100-OPEN-FILES. DISPLAY " " ERASE SCREEN. PERFORM 332-CRT-LINE. PERFORM 600-LINES. PERFORM 650-PUT-IN-DESC. PERFORM 332-CRT-LINE. PERFORM 400-GRAPHICS. MOVE ZERO-SW TO TRY-SWITCH. MOVE ZERO-SW TO VALUE-OK-SW PERFORM 450-ACCEPT-NUMBER UNTIL VALUE-OK-SW IS EQUAL TO ONE-SW. DISPLAY " " LINE 6 COLUMN 10. PERFORM 500-READ-INFO. PERFORM 520-OUTPUT-HEADINGS. PERFORM 530-LOAD-VALUE-LINE. PERFORM 540-OUTPUT-VALUE-LINE. PERFORM 750-PUT-IN-INFO. PERFORM 900-CLOSE-FILES. STOP RUN. 100-OPEN-FILES. OPEN INPUT DATA-IN OUTPUT DATA-OUT. 332-CRT-LINE. DISPLAY ESCAPE "[" LINE-NO ";" COL-NO "f" WITH NO ADVANCING. 400-GRAPHICS. DISPLAY HORIZ LINE 4 COLUMN 1. 425-BOX. DISPLAY " " LINE 7 COLUMN 0 DISPLAY ESCAPE "(0" DISPLAY ESCAPE "#6" TOP-LINE. PERFORM 510-DO-NEXT 1 TIMES. DISPLAY ESCAPE "#6" BOTTOM-LINE. DISPLAY ESCAPE "(B". 450-ACCEPT-NUMBER. IF TRY-SWITCH IS = ONE-SW DISPLAY "Order number must be [100-999]." LINE 6 COLUMN 10 DISPLAY "--- " LINE 3 COLUMN 30 DISPLAY " " LINE 3 COLUMN 29 ELSE MOVE ONE-SW TO TRY-SWITCH DISPLAY "ENTER ORDER NUMBER ---" LINE 3 COLUMN 10. DISPLAY " " LINE 3 COLUMN 29 MOVE ONE-SW TO VALUE-OK-SW ACCEPT ORDER-NUM. IF ORDER-NUM IS NOT NUMERIC MOVE ZERO-SW TO VALUE-OK-SW ELSE MOVE ORDER-NUM TO N-ORDER-NUM IF N-ORDER-NUM IS GREATER THAN MAX-VAL MOVE ZERO-SW TO VALUE-OK-SW ELSE IF N-ORDER-NUM IS LESS THAN MIN-VAL MOVE ZERO-SW TO VALUE-OK-SW. 500-READ-INFO. READ DATA-IN AT END DISPLAY " ". 510-DO-NEXT. DISPLAY NEXT-LINE. 520-OUTPUT-HEADINGS. WRITE PRINTLINE FROM O-HEADING-LINE1. WRITE PRINTLINE FROM O-HEADING-LINE2. 530-LOAD-VALUE-LINE. MOVE ORDER-NUM TO O-ORDER-NUM. MOVE DATE-SHIPPED TO O-DATE-SHIPPED. MOVE ITEM-COST TO O-ITEM-COST. MOVE ITEM-DESC TO O-ITEM-DESC. MOVE TOTL-AMNT TO O-TOTL-AMNT. 540-OUTPUT-VALUE-LINE. WRITE PRINTLINE FROM O-VALUE-LINE. 600-LINES. DISPLAY ESCAPE LINE 8 COLUMN 0 "(0" TOP-LINE PERFORM 510-DO-NEXT DISPLAY DESC-LINE PERFORM 510-DO-NEXT 9 TIMES DISPLAY BOTTOM-LINE. DISPLAY ESCAPE "(B". 650-PUT-IN-DESC. DISPLAY " " LINE 9 COLUMN 2 "Ord" "Shpd" COLUMN 10 "Cost" COLUMN 21 "Description" COLUMN 30 "Amount" COLUMN 63. 750-PUT-IN-INFO. DISPLAY " " LINE 11 COLUMN 2 O-ORDER-NUM DATE-SHIPPED COLUMN 10 ITEM-COST COLUMN 21 ITEM-DESC COLUMN 30 TOTL-AMNT COLUMN 63 " " LINE 21 COLUMN 1. 900-CLOSE-FILES. CLOSE DATA-IN DATA-OUT.