Google
 

Trailing-Edge - PDP-10 Archives - AP-D471B-SB_1978 - regula.cbl
There are no other files named regula.cbl in the archive.
IDENTIFICATION DIVISION.
PROGRAM-ID.	REGULA.
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 "INVENTIDX"
	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
	SUB-QUEUE-1 SUB1
	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	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.
	OPEN I-O INVENTORY-FILE.

RESTART.
	MOVE 'REGULAR' TO PRIME.
	MOVE SPACES TO SUB1.

RECEIVE-ORDER-NO.
	MOVE 1 TO ITEM-SUB.
	RECEIVE IN-ORDER SEGMENT INTO ORDER-NO.
	IF IN-END-KEY EQUALS ZERO OR 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 EQUALS ZERO
	OR 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 EQUALS ZERO
	OR 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 DESTINATION-COUNT.
	MOVE 1 TO M-OUT-LENGTH.
	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.
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 RESTART
	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 CLEAR-ITEMS
	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 EPI
	AFTER ADVANCING 3 LINES.
	GO TO RESTART.
WRONG-WRITE.
	CLOSE INVENTORY-FILE.
	DISPLAY "?PROBLEM ON INVENTORY FILE".
	STOP RUN.