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.