Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
rush.cbl
There are no other files named rush.cbl in the archive.
IDENTIFICATION DIVISION.
PROGRAM-ID. RUSH.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INVENTORY-FILE ASSIGN TO DSK
ACCESS MODE IS INDEXED
SYMBOLIC KEY IS S-ITEM-NO
RECORD KEY IS ITEM-NO
RECORDING MODE IS SIXBIT.
DATA DIVISION.
FILE SECTION.
FD INVENTORY-FILE
VALUE OF ID "INRUSHIDX"
BLOCK CONTAINS 12 RECORDS.
01 INVENTORY-RECORD.
02 ITEM-NO PIC 9(9).
02 DESCRIPTION PIC X(25).
02 ON-HAND PIC S9(9).
02 ON-ORDER PIC 9(9).
COMMUNICATION SECTION.
CD IN-ORDER FOR INPUT
QUEUE PRIME
MESSAGE DATE IS M-DATE
MESSAGE TIME IS M-TIME
SYMBOLIC SOURCE IS M-SOURCE
TEXT LENGTH IS M-LENGTH
END KEY IS IN-END-KEY
STATUS KEY IS IN-STATUS-KEY.
CD OUT-ORDER FOR OUTPUT
TEXT LENGTH IS M-OUT-LENGTH
STATUS KEY IS OUT-STATUS-KEY
ERROR KEY IS PUT-ERROR-KEY
SYMBOLIC DESTINATION IS OUT-DESTINATION
DESTINATION COUNT IS DESTINATION-COUNT.
WORKING-STORAGE SECTION.
77 JUNK PIC X(72).
77 RUSHH PIC X(15) VALUE "*** R U S H ***".
77 DELIVERY-AREA PIC X(50).
77 NUMERIC-QUANTITY PIC 9(9).
77 EXAMINE-QUANTITY REDEFINES NUMERIC-QUANTITY PIC X(9).
77 ITEM-SUB PIC S99 COMP VALUE 1.
77 DELIVER-SUB PIC S99 COMP VALUE 1.
77 S-ITEM-NO PIC 9(9) VALUE ZERO.
77 ORDER-ERROR PIC X(31)
VALUE "YOU BLEW IT-RESTART WITH ORDER#".
01 ORDER-GROUP.
02 ORDER-NO PIC X(9) VALUE ZEROS.
02 ITEMS OCCURS 10 TIMES.
03 ITEM PIC X(9).
03 FILLER PIC X(5).
03 DESCRPT PIC X(25).
03 FILLER PIC XX.
03 QUANTITY PIC X(9).
01 DUMMY-COMP PIC S9(10) VALUE 14 COMP.
01 DUMMY-ASCII REDEFINES DUMMY-COMP USAGE DISPLAY-7.
02 FILLER PIC X(4).
02 BELL PIC X.
01 NO-ITEM-MSG.
02 FILLER PIC X(22)
VALUE "INVALID ITEM NO. FOR ".
02 BAD-ONE PIC 9(9).
PROCEDURE DIVISION.
START.
MOVE 'RUSH' TO PRIME.
OPEN I-O INVENTORY-FILE.
RECEIVE-ORDER-NO.
MOVE 1 TO ITEM-SUB.
RECEIVE IN-ORDER SEGMENT INTO ORDER-NO.
IF IN-END-KEY NOT EQUAL TO "1" GO TO FLUSH.
RECEIVE-ITEM-NO.
RECEIVE IN-ORDER SEGMENT INTO ITEM(ITEM-SUB).
IF IN-END-KEY NOT EQUAL TO "1" GO TO FLUSH.
MOVE ITEM (ITEM-SUB) TO S-ITEM-NO.
RECEIVE-QUANTITY.
RECEIVE IN-ORDER MESSAGE INTO QUANTITY (ITEM-SUB).
IF IN-END-KEY LESS THAN "2" GO TO FLUSH.
READ-INVENTORY.
READ INVENTORY-FILE INVALID KEY GO TO NO-ITEM.
MOVE DESCRIPTION TO DESCRPT (ITEM-SUB).
UPDATE-INVENTORY.
UNSTRING QUANTITY (ITEM-SUB) DELIMITED BY SPACE
INTO NUMERIC-QUANTITY.
EXAMINE EXAMINE-QUANTITY REPLACING ALL SPACES
BY ZEROS.
COMPUTE ON-HAND = ON-HAND - NUMERIC-QUANTITY.
REWRITE INVENTORY-RECORD INVALID KEY GO TO WRONG-WRITE.
CHECK-FOR-DELIVERY-TIME.
IF ITEM-SUB GREATER THAN 9 OR IN-END-KEY EQUALS "3"
GO TO DELIVER.
ADD 1 TO ITEM-SUB.
GO TO RECEIVE-ITEM-NO.
DELIVER.
MOVE 1 TO DELIVER-SUB.
MOVE 1 TO M-OUT-LENGTH.
MOVE 1 TO DESTINATION-COUNT.
MOVE "WAREHOUSE" TO OUT-DESTINATION.
PERFORM ATTENTION 6 TIMES.
MOVE 9 TO M-OUT-LENGTH.
SEND OUT-ORDER FROM ORDER-NO WITH EMI
AFTER ADVANCING 5 LINES.
MOVE 15 TO M-OUT-LENGTH.
SEND OUT-ORDER FROM RUSHH WITH EMI AFTER ADVANCING 2 LINES.
ITEM-LOOP.
MOVE 50 TO M-OUT-LENGTH.
MOVE ITEMS (DELIVER-SUB) TO DELIVERY-AREA.
SEND OUT-ORDER FROM DELIVERY-AREA WITH EMI
AFTER ADVANCING 1 LINE.
ADD 1 TO DELIVER-SUB.
IF DELIVER-SUB GREATER THAN ITEM-SUB
MOVE 0 TO M-OUT-LENGTH
SEND OUT-ORDER WITH EPI
MOVE 1 TO DELIVER-SUB ITEM-SUB
GO TO RECEIVE-ORDER-NO
ELSE GO TO ITEM-LOOP.
NO-ITEM.
MOVE ITEM (ITEM-SUB) TO BAD-ONE.
MOVE 31 TO M-OUT-LENGTH.
MOVE M-SOURCE TO OUT-DESTINATION.
MOVE 1 TO DESTINATION-COUNT.
SEND OUT-ORDER FROM NO-ITEM-MSG WITH EMI
AFTER ADVANCING 3 LINES.
IF IN-END-KEY EQUALS "3" SEND OUT-ORDER WITH EPI
GO TO RECEIVE-ORDER-NO
ELSE GO TO RECEIVE-ITEM-NO.
ATTENTION.
SEND OUT-ORDER FROM BELL.
CLEAR-ITEMS.
MOVE ZEROS TO ORDER-NO.
MOVE 1 TO DELIVER-SUB.
KEEP-CLEAR.
MOVE SPACES TO ITEMS(DELIVER-SUB).
ADD 1 TO DELIVER-SUB.
IF DELIVER-SUB GREATER THAN ITEM-SUB
GO TO RECEIVE-ORDER-NO
ELSE GO TO KEEP-CLEAR.
FLUSH.
RECEIVE IN-ORDER MESSAGE INTO JUNK.
IF IN-END-KEY NOT EQUAL TO "3"
GO TO FLUSH.
MOVE 31 TO M-OUT-LENGTH.
MOVE 1 TO DESTINATION-COUNT.
MOVE M-SOURCE TO OUT-DESTINATION.
SEND OUT-ORDER FROM ORDER-ERROR WITH EMI
AFTER ADVANCING 3 LINES.
SEND OUT-ORDER WITH EPI.
GO TO RECEIVE-ORDER-NO.
WRONG-WRITE.
CLOSE INVENTORY-FILE.
DISPLAY "?PROBLEM ON INVENTORY-FILE".
STOP RUN.