Google
 

Trailing-Edge - PDP-10 Archives - BB-H348C-RM_1982 - swskit-v21/demos/invent.cbl
There are no other files named invent.cbl in the archive.
ID DIVISION.

PROGRAM-ID. INVENT.
INSTALLATION. DIGITAL MARLBORO.
REMARKS.
	  This is the active task for a distributed data processing demo.
	This program can be run on any node in your network. It can communicate
	with any node in the network including the local node. Any number of
	users can run this program at the same time
	  Please note that the basic function of this program is to access
	data resident on another node. This program could just as easily be
	a library system or hospital patient system as an inventory system.


ENVIRONMENT DIVISION.
DATA DIVISION.

WORKING-STORAGE SECTION.
01 SAVE-THE-KEY		PIC X(16).
01 THE-NODE-NAME	PIC X(6) USAGE DISPLAY-6.
01 NODE-NAME		PIC X(6) USAGE DISPLAY-6.
01 FUNCTION		PIC X(10) USAGE DISPLAY-6.
01 NETLN		PIC S9(10) COMP VALUE 0.
01 N-TYPE		PIC S9(10) COMP VALUE 0.
01 DESC			PIC X(80) DISPLAY-7 VALUE SPACE.
01 WAIT			PIC S9(10) COMP VALUE 0.
01 RETCOD		PIC S9(10) COMP VALUE 0.
01 EOM			PIC S9(10) COMP VALUE 0.
01 N-COUNT		PIC S9(10) COMP VALUE 0.
01 N-CODE		PIC S9(10) COMP VALUE 0.
01 DATA-IO.
    05 DATA-TYPE.
	10 DATA-FUNC	PIC X(8) DISPLAY-7.
	10 DATA-RETURN	PIC 9(8) DISPLAY-7.
    05 DATA-RECORD.
	10 DATA-KEY	PIC X(16) DISPLAY-7.
	10 DATA-DATA	PIC X(128) DISPLAY-7.
PROCEDURE DIVISION.

START.
	PERFORM INFO-ROUTINE.

MAIN-LOOP.
	DISPLAY "Function? (DISPLAY, ENTER, or DELETE inventory items) "
		WITH NO ADVANCING.
	ACCEPT FUNCTION.
	IF FUNCTION = "EXIT    " STOP RUN.
	IF FUNCTION = "DISPLAY " GO TO DISPLAY-RECORD.
	IF FUNCTION = "DELETE  " GO TO DELETE-RECORD.
	IF FUNCTION = "ENTER   " GO TO ENTER-RECORD.
	PERFORM INFO-ROUTINE.
	GO TO MAIN-LOOP.
INFO-ROUTINE.
	DISPLAY " ".
	DISPLAY "	This application provides the user with a complete inventory".
	DISPLAY "control system for factories or warehouses in different locations.  The user".
	DISPLAY "may enter new inventory items, delete inventory items,".
	DISPLAY "or display inventory information for his own site or any site in the".
	DISPLAY "network.  Making this vital information immediately available has helped".
	DISPLAY "make this company a success.".
	DISPLAY " ".
	DISPLAY "	Just answer the following questions.  Every question will list".
	DISPLAY "the possible answers."
	DISPLAY " ".

OPEN-LINK.
	MOVE SPACES TO DESC
	STRING "DCN:",THE-NODE-NAME,"-TASK-DEMO"
	DELIMITED BY SPACES INTO DESC.
	CALL NFOPN USING NETLN,0,DESC,7,1,RETCOD.

CLOSE-LINK.
	MOVE SPACES TO DATA-IO.
	CALL NFCLS USING NETLN,0,0,0,DATA-IO,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		CALL NFCLS USING NETLN,1,0,0,DATA-IO,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Error closing logical link.".
	

DISPLAY-RECORD.
	DISPLAY "	Location? (LOCAL, ALL, or name) "
		WITH NO ADVANCING.
	ACCEPT NODE-NAME.
	MOVE NODE-NAME TO THE-NODE-NAME.
	IF NODE-NAME = "LOCAL" OR "ALL" MOVE " " TO THE-NODE-NAME.
	DISPLAY "	Item? (item name) " WITH NO ADVANCING.
	ACCEPT DATA-KEY.
	MOVE DATA-KEY TO SAVE-THE-KEY.
	PERFORM DISPLAY-ONE-RECORD THRU E-DISPLAY-ONE-RECORD.
	NOTE Here retrieve a record from every known node.
	IF NODE-NAME EQUALS "ALL"
		MOVE "NODE1" TO THE-NODE-NAME
		MOVE SAVE-THE-KEY TO DATA-KEY
		PERFORM DISPLAY-ONE-RECORD THRU E-DISPLAY-ONE-RECORD.
	DISPLAY " ".
	GO TO MAIN-LOOP.

DISPLAY-ONE-RECORD.
	DISPLAY " ".
	MOVE SPACES TO DATA-DATA.
	PERFORM OPEN-LINK.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available."
		DISPLAY "	Open error code => ",RETCOD
		GO TO C-DISPLAY-ONE-RECORD.
	MOVE "READ   " TO DATA-FUNC.
	MOVE ZERO TO DATA-RETURN.
	MOVE SPACES TO DATA-DATA.
	CALL NFSND USING NETLN,160,DATA-IO,1,0,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available."
		DISPLAY "	Send error code => ",RETCOD
		GO TO C-DISPLAY-ONE-RECORD.
	MOVE SPACES TO DATA-IO.
	CALL NFRCV USING NETLN,160,DATA-IO,1,1,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available."
		DISPLAY "	Send error code => ",RETCOD
		GO TO C-DISPLAY-ONE-RECORD.
	IF DATA-RETURN = ZERO
		DISPLAY "	factory name => ",THE-NODE-NAME
		DISPLAY "	Item => ", DATA-KEY
		DISPLAY "	Quantity => ", DATA-DATA.
	IF DATA-RETURN NOT EQUAL ZERO
		DISPLAY "	?Could not locate information for item ",DATA-KEY
		DISPLAY "	at factory ",THE-NODE-NAME.

C-DISPLAY-ONE-RECORD.
	PERFORM CLOSE-LINK.

E-DISPLAY-ONE-RECORD.
	EXIT.

ENTER-RECORD.
	DISPLAY "	Location? (LOCAL or name) " WITH NO ADVANCING.
	ACCEPT THE-NODE-NAME.
	IF THE-NODE-NAME EQUALS "LOCAL" MOVE " " TO THE-NODE-NAME.
	DISPLAY "	Item? (item name) " WITH NO ADVANCING.
	ACCEPT DATA-KEY.
	DISPLAY "	Quantity comment? (number  comment text) "
		WITH NO ADVANCING.
	ACCEPT DATA-DATA.	
	DISPLAY " ".
	PERFORM OPEN-LINK.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available"
		DISPLAY "	Open error code => ",RETCOD
		DISPLAY " "
		PERFORM CLOSE-LINK
		GO TO MAIN-LOOP.
	MOVE "WRITE  " TO DATA-FUNC.
	MOVE ZERO TO DATA-RETURN.
	CALL NFSND USING NETLN,160,DATA-IO,1,0,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available"
		DISPLAY "	Send error code => ",RETCOD
		PERFORM CLOSE-LINK
		DISPLAY " "
		GO TO MAIN-LOOP.
	MOVE SPACES TO DATA-IO.
	CALL NFRCV USING NETLN,160,DATA-IO,1,1,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available"
		DISPLAY "	Receive error code => ",RETCOD
		PERFORM CLOSE-LINK
		DISPLAY " "
		GO TO MAIN-LOOP.
	IF DATA-RETURN EQUALS ZERO
		DISPLAY "	OK."
	ELSE DISPLAY "	?Request to overwrite existing record denied at factory  ",THE-NODE-NAME.
	DISPLAY " ".
	PERFORM CLOSE-LINK.
	GO TO MAIN-LOOP.

DELETE-RECORD.
	DISPLAY "	Location? (LOCAL or name) " WITH NO ADVANCING.
	ACCEPT THE-NODE-NAME.
	IF THE-NODE-NAME EQUALS "LOCAL" MOVE " " TO THE-NODE-NAME.
	DISPLAY "	Item? (item name) " WITH NO ADVANCING.
	ACCEPT DATA-KEY.
	DISPLAY " ".
	PERFORM OPEN-LINK.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available"
		DISPLAY "	Open error code => ",RETCOD
		DISPLAY " "
		PERFORM CLOSE-LINK
		GO TO MAIN-LOOP.
	MOVE "DELETE " TO DATA-FUNC.
	MOVE ZERO TO DATA-RETURN.
	CALL NFSND USING NETLN,160,DATA-IO,1,0,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available"
		DISPLAY "	Send error code => ",RETCOD
		PERFORM CLOSE-LINK
		DISPLAY " "
		GO TO MAIN-LOOP.
	MOVE SPACES TO DATA-IO.
	CALL NFRCV USING NETLN,160,DATA-IO,1,1,RETCOD.
	IF RETCOD NOT EQUAL ZERO
		DISPLAY "	?Factory at ",THE-NODE-NAME," not available"
		DISPLAY "	Receive error code => ",RETCOD
		PERFORM CLOSE-LINK
		DISPLAY " "
		GO TO MAIN-LOOP.
	IF DATA-RETURN EQUALS ZERO
		DISPLAY "	OK."
	ELSE DISPLAY "	?This record does not exist at factory ",THE-NODE-NAME.
	DISPLAY " ".
	PERFORM CLOSE-LINK.
	GO TO MAIN-LOOP.