PDP-10 Archive: uetp/dtordr.cbl from BB-4148F-BM

Trailing-Edge - PDP-10 Archives - BB-4148F-BM_1984 - uetp/dtordr.cbl
There is 1 other file named dtordr.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. DTORDR.

*	Program DTORDR - Order Entry Sample Test Program
*	(formerly ORDENT.CBL)
*	Part of the UETP and verify test system for DBMS-20

*                     Copyright (C) 1984 by
*             Digital Equipment Corporation, Maynard, Mass.
* 
*      This software is furnished under a license, and may be used
*      or copied only in accordance with the terms of that license.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
SCHEMA SECTION.
	INVOKE SUB-SCHEMA DTSSOC OF SCHEMA DTORD PRIVACY KEY FOR COMPILE
	IS ORDER1ENTRY-LOCK.
*	THIS AREA FILLED IS IN WITH RECORD DESCRIPTIONS FROM THE INVOKE
WORKING-STORAGE SECTION.

77	RECORD-TYPE	PIC X(6).
77	PKEY, PIC 9999, USAGE COMP.
01	FUNCTION.
	02  FUN-CODE	PIC X.
	02  FILLER	PIC X(7).
01	REPLY.
	02  REPLY-X	PIC X.
	88  REPLY-YES	VALUE 'Y'.
	88  REPLY-NO	VALUE 'N'.
	02  FILLER	PIC XX.
01	ITEM-LINE-BUILD.
	02  ITEM-LINE-ORDER	PIC 9(6).
	02  ITEM-LINE-NUMBER	PIC 999.
77	CUSTOM-CNT	PIC 9(10) COMP VALUE 0.
77	PURORD-CNT	PIC 9(10) COMP VALUE 0.
77	ITEM-CNT	PIC 9(10) COMP VALUE 0.

77	CUSCNT	PIC S9(10) COMP VALUE 1.
77	PRODCNT	PIC S9(10) COMP VALUE 1.

PROCEDURE DIVISION.
*	THIS AREA IS FILLED IN WITH A SET OF MACRO CALLS THAT 'BIND'
*	THE SCHEMA, RECORDS, AND DATA ELEMENTS ASSOCIATED WITH THE
*	INVOKED SUB-SCHEMA

FUNCTION-SECTION SECTION.
	MOVE "CUSAREA" TO IDAREA.
FIRST-START.
	DISPLAY "ENTER 'BEGIN' TO START: " WITH NO ADVANCING.
	ACCEPT FUNCTION.
	IF FUN-CODE EQUAL TO "B" GO TO BEGIN-ROUTINE.
	GO TO FIRST-START.

START-IT.
	DISPLAY "FUNCTIONS ARE:  ENTER, CHANGE, INQUIRY, QUIT".
ACCEPT-FUNCTION.
	DISPLAY "ENTER FUNCTION: " WITH NO ADVANCING.
	ACCEPT FUNCTION.
	IF FUN-CODE EQUAL TO  "E" GO TO ENTER-ROUTINE.
	IF FUN-CODE EQUAL TO "C" GO TO CHANGE-ROUTINE.
	IF FUN-CODE EQUAL TO "I" GO TO INQUIRY-ROUTINE.
	IF FUN-CODE EQUAL TO "Q" GO TO ENTRY-WRAP-UP.
	DISPLAY "%INVALID FUNCTION CODE: " FUNCTION.
	GO TO START-IT.
DISPLAY-ERROR-STATUS.
	DISPLAY '?ERROR-STATUS: ' ERROR-STATUS.
INITIALIZE-SECTION SECTION.

BEGIN-NOTE.
*	THIS IS A ONE TIME INITIALIZATION OF THE ORDER SUMMARY
*	DATA IN THE ORDSUM RECORD
BEGIN-ROUTINE.
	PERFORM OPEN-ORDAREA-EXCL-UPDATE.
	PERFORM FIND-ORDSUM.
	IF ERROR-COUNT = 0
	CLOSE AREA ORDAREA
	GO TO START-IT.
	MOVE 0 TO ORDSUM-ORDERS.
	MOVE 1 TO ORDSUM-NO.
BEGIN-ORDSUM-STORE.
	PERFORM STORE-ORDSUM.
BEGIN-ORDSUM-CLOSE.
	PERFORM CLOSE-ALL.
BEGIN-END.
	GO TO START-IT.

ENTER-SECTION SECTION.
ENTER-ROUTINE.
	PERFORM OPEN-ALL-EXCL-UPDATE.
	PERFORM FIND-ORDSUM.
	IF ERROR-COUNT = 0
	PERFORM GET-ORDSUM
	GO TO ENTER-TYPE.
	DISPLAY '%ORDER SUMMARY RECORD NOT FOUND'.
	DISPLAY '%ORDER ENTRY SYSTEM NOT INITIALIZED - '
	'KEY-IN BEGIN'.
	PERFORM CLOSE-ALL.
	GO TO FIRST-START.
ENTER-TYPE.
	ENTER MACRO JRDATA USING SYSCOM,0.
	ENTER MACRO JRTEXT USING " CHANGING ENTER MODES".
	DISPLAY "RECORD TYPES ARE: PROD, SLSENG, CUSTOM, PURORD & ITEM".
	ACCEPT RECORD-TYPE.
	IF RECORD-TYPE EQUAL TO 'PROD' GO TO ENTER-PROD.
	IF RECORD-TYPE EQUAL TO 'SLSENG' GO TO ENTER-SLSENG.
	IF RECORD-TYPE EQUAL TO 'CUSTOM' GO TO ACCEPT-CUST-NAME.
	IF RECORD-TYPE EQUAL TO 'PURORD' GO TO ENTER-PURORD.
	IF RECORD-TYPE EQUAL TO 'ITEM' GO TO ENTER-ITEM.
	IF RECORD-TYPE EQUAL TO SPACES GO TO ENTER-CLOSE.
	DISPLAY "%INVALID RECORD-TYPE: " RECORD-TYPE.
	GO TO ENTER-TYPE.
ENTER-CLOSE.
	PERFORM FIND-ORDSUM.
	PERFORM MODIFY-ORDSUM.
	PERFORM CLOSE-ALL.
	GO TO ACCEPT-FUNCTION.
ENTER-PROD.
	DISPLAY 'KEY-IN PROD-NO: ' WITH NO ADVANCING.
	ACCEPT PROD-NO.
CHECK-PROD.
	IF PROD-NO EQUAL SPACES GO TO ENTER-TYPE.

	ENTER MACRO JSTRAN USING "PROD",PRODCNT.
	PERFORM FIND-PROD.
	IF ERROR-STATUS EQUAL TO 326 OR 307
	GO TO GET-PROD-INFO.
	PERFORM DISPLAY-ERROR-STATUS.
	IF ERROR-COUNT EQUAL TO 0
	DISPLAY '%PROD-NO: ' PROD-NO ' ALREADY EXISTS'.
	ENTER MACRO JETRAN USING "PROD",PRODCNT.
	ADD 1 TO PRODCNT.
	GO TO ENTER-PROD.
GET-PROD-INFO.
	DISPLAY 'PROD DESC: ' WITH NO ADVANCING.
	ACCEPT PROD-DESC.
	DISPLAY 'PRODUCT PRICE: ' WITH NO ADVANCING.    
	ACCEPT PROD-PRICE.
	MOVE ZEROES TO PROD-LEAD-TIME, PROD-ON-HAND, PROD-IN-PROC,
		PROD-ON-ORDER, PROD-INSTALLED.
	PERFORM STORE-PROD.
	ENTER MACRO JETRAN USING "PROD",PRODCNT.
	ADD 1 TO PRODCNT.
	GO TO ENTER-PROD.
ENTER-SLSENG.
	DISPLAY 'KEY-IN SALESENG NAME :'  WITH NO ADVANCING.
	ACCEPT SLSENG-NAME.
SLSENG-ACCEPTED.
	IF SLSENG-NAME EQUAL TO SPACES GO TO ENTER-TYPE.
	PERFORM FIND-SLSENG.
	IF ERROR-STATUS EQUAL TO 326 OR 307
	GO TO GET-SLSENG-INFO.
	PERFORM DISPLAY-ERROR-STATUS.
	IF ERROR-COUNT EQUAL TO 0
	DISPLAY '%SLSENG NAME: ' SLSENG ' ALREADY ON FILE'.
	GO TO ENTER-SLSENG.
GET-SLSENG-INFO.
	DISPLAY 'SALES OFFICE: ' WITH NO ADVANCING.
	ACCEPT SLSENG-OFFICE.
	DISPLAY 'PHONE - AREA CODE: ' WITH NO ADVANCING.
	ACCEPT SLSENG-AREA-NO.
	DISPLAY 'PHONE NUMBER AS XXX-XXXX ' WITH NO ADVANCING.
	ACCEPT SLSENG-PHONE-NO.
	DISPLAY 'EXTENSION: ' WITH NO ADVANCING.
	ACCEPT SLSENG-EXTENSION.
	PERFORM STORE-SLSENG.
	IF ERROR-COUNT NOT EQUAL TO 0
	DISPLAY '?SLSENG NOT ENTERED - ERROR-STATUS: ' ERROR-STATUS.
	GO TO ENTER-SLSENG.
ACCEPT-CUST-NAME.
	ENTER MACRO JSTRAN USING "CUSTOMER",CUSCNT.
	DISPLAY 'KEY-IN CUSTOMER NAME: '  WITH NO ADVANCING.
	ACCEPT CUST-NAME.
	ENTER MACRO JRTEXT USING "THIS IS SUPPOSED TO BE A 
-	"MULTI-BLOCK TEXT EXAMPLE, I CERTAINLY HOPE THAT IT 
-	"ACTUALLY IS LONG ENOUGH".
GOT-CUST-NAME.
	PERFORM FIND-CUSTOM.
	IF ERROR-STATUS EQUAL TO 326 OR 307
	GO TO GET-CUST-INFO.
	PERFORM DISPLAY-ERROR-STATUS.
	IF ERROR-COUNT EQUAL TO 0
	DISPLAY "%CUSTOMER-NAME: " CUST-NAME "ALREADY EXISTS".
	PERFORM CLOSE-TRANS.
	GO TO ACCEPT-CUST-NAME.
GET-CUST-INFO.
	DISPLAY "STREET ADDRESS: " WITH NO ADVANCING.
	ACCEPT STREET.
	DISPLAY "CITY: " WITH NO ADVANCING.
	ACCEPT CITY.
	DISPLAY "STATE: " WITH NO ADVANCING.
	ACCEPT STATE.
	DISPLAY "ZIP: " WITH NO ADVANCING.
	ACCEPT ZIP.
	PERFORM STORE-CUSTOM.
	IF ERROR-COUNT NOT EQUAL TO 0
	DISPLAY '?CUSTOMER: ' CUST-NAME ' NOT ENTERED'
	GO TO ACCEPT-CUST-NAME.
	MOVE PKEY TO CUST-KEY.
	ADD 1 TO CUSTOM-CNT.
OBTAIN-SLSENG.
	DISPLAY "SLSENG NAME (OR SPACE, IF NONE): " WITH NO ADVANCING.
	ACCEPT SLSENG-NAME.
	IF SLSENG-NAME EQUAL TO SPACES
	GO TO OBTAIN-ORDNUM.
	PERFORM FIND-SLSENG.
	IF ERROR-COUNT NOT EQUAL TO 0
	DISPLAY "%NO SLSENG OF THIS NAME ON FILE - " SLSENG-NAME
	PERFORM DISPLAY-ERROR-STATUS
	GO TO OBTAIN-SLSENG.
	PERFORM FIND-CUSTOM.
	PERFORM INSERT-SLSCUS-SET.
	IF ERROR-COUNT EQUAL TO 0
	GO TO OBTAIN-ORDNUM.
	DISPLAY '?CUSTOM NOT ENTERED IN SLSCUS-SET'.
	PERFORM DISPLAY-ERROR-STATUS.
	GO TO OBTAIN-ORDNUM.
ENTER-PURORD.
	PERFORM ACCEPT-CUST-NAME.
	IF CUST-NAME EQUAL TO SPACES
	PERFORM CLOSE-TRANS
	GO TO ENTER-TYPE.
	PERFORM FIND-CUSTOM.
	IF ERROR-COUNT EQUAL TO 0
	GO TO GOT-ORDNUM.
	DISPLAY '%NO CUSTOMER OF THIS NAME ON FILE'.
	PERFORM CLOSE-TRANS
	GO TO ENTER-PURORD.
CLOSE-TRANS.
	ENTER MACRO JETRAN USING "CUSTOMER",CUSCNT.
	ADD 1 TO CUSCNT.
ACCEPT-ORDNUM.
	DISPLAY "ENTER ORDER-NUMBER: " WITH NO ADVANCING.
	ACCEPT ORDNUM.
OBTAIN-ORDNUM.
	DISPLAY "ANY ORDER TO BE ENTERED?  "
	WITH NO ADVANCING.
	ACCEPT REPLY.
ORDNUM-REPLY.
	IF NOT REPLY-YES
	ENTER MACRO JETRAN USING "CUSTOMER",CUSCNT
	ADD 1 TO CUSCNT
	GO TO ENTER-TYPE.
GOT-ORDNUM.
	MOVE ORDSUM-NO TO ORDNUM.
	PERFORM FIND-PURORD.
	IF ERROR-COUNT EQUAL TO 0
	DISPLAY "%ORDNUM: " ORDNUM "ALREADY EXISTS"
	GO TO ENTER-PURORD.
	DISPLAY "NEW ORDER NUMBER IS: " ORDSUM-NO.
	DISPLAY "ORDER-DATE: " WITH NO ADVANCING.
	ACCEPT ORDER-DATE.
	MOVE 0 TO ORDER-NET.
	MOVE 0 TO ORDER-LINES.
	PERFORM STORE-PURORD.
	IF ERROR-COUNT EQUAL TO 0
	ADD 1 TO ORDSUM-NO
	ADD 1 TO ORDSUM-ORDERS
	ADD 1 TO PURORD-CNT
	MOVE ORDNUM TO ITEM-LINE-ORDER
	MOVE ORDER-LINES TO ITEM-LINE-NUMBER
	GO TO ACCEPT-ITEM-LINE.
	DISPLAY "?ORDER NUMBER: "   ORDNUM "  NOT ENTERED".
	GO TO OBTAIN-ORDNUM.
ENTER-ITEM.
	PERFORM ACCEPT-CUST-NAME.
	IF CUST-NAME EQUAL TO "    "
	PERFORM CLOSE-TRANS
	GO TO ENTER-TYPE.
	PERFORM FIND-CUSTOM.
	IF ERROR-COUNT NOT EQUAL TO 0
	DISPLAY '%NO CUSTOMER OF THIS NAME ON FILE'
	PERFORM CLOSE-TRANS
	GO TO ENTER-ITEM.
ITEM-ACCEPT-ORDNUM.
	PERFORM ACCEPT-ORDNUM.
	IF ORDNUM EQUAL TO 0
	PERFORM CLOSE-TRANS
	GO TO ENTER-TYPE.
	PERFORM FIND-PURORD.
	IF ERROR-COUNT EQUAL TO 0
	PERFORM GET-PURORD
	MOVE ORDNUM TO ITEM-LINE-ORDER
	MOVE ORDER-LINES TO ITEM-LINE-NUMBER
	GO TO ACCEPT-ITEM-LINE.
	DISPLAY "%ORDER NUMBER NOT IN DATA BASE".
	GO TO ITEM-ACCEPT-ORDNUM.
ENTER-ITEM-LINE.
	ADD 1 TO ORDER-LINES.
	ADD 1 TO ITEM-CNT.
	ADD ITEM-NET TO ORDER-NET.
ACCEPT-ITEM-LINE.
	DISPLAY "PRODUCT NUMBER: " WITH NO ADVANCING.
	ACCEPT ITEM-PROD-NO.
	IF ITEM-PROD-NO EQUAL TO SPACES
	PERFORM FIND-PURORD
	PERFORM MODIFY-PURORD
	ENTER MACRO JETRAN USING "CUSTOMER",CUSCNT
	ADD 1 TO CUSCNT
	GO TO ENTER-TYPE.
	ADD 1 TO ITEM-LINE-NUMBER.
	MOVE ITEM-LINE-BUILD TO ITEM-LINE.
	MOVE ITEM-PROD-NO TO PROD-NO.
	PERFORM FIND-PROD.
	IF ERROR-COUNT EQUAL TO 0
	GO TO GET-ITEM-INFO.
	DISPLAY '%INVALID PROD-NO: ' ITEM-PROD-NO.
	GO TO ACCEPT-ITEM-LINE.
GET-ITEM-INFO.
	PERFORM GET-PROD.
	DISPLAY "QUANTITY ORDERED: " WITH NO ADVANCING.
	ACCEPT ITEM-QTY.
	MULTIPLY PROD-PRICE BY ITEM-QTY GIVING ITEM-NET.
	ADD ITEM-QTY TO PROD-ON-ORDER.
	PERFORM MODIFY-PROD.
	PERFORM STORE-ITEM.
	GO TO ENTER-ITEM-LINE.

ENTRY-WRAP-UP.
*	DISPLAY 'CUSTOM ENTRY COUNT: ' CUSTOM-CNT.
*	DISPLAY 'PURORD ENTRY COUNT: ' PURORD-CNT.
*	DISPLAY 'ITEM ENTRY COUNT:   ' ITEM-CNT.
        DISPLAY " ".
        DISPLAY " ".
        DISPLAY "THE FOLLOWING STATISTICS REPORT IS PRODUCED BY A DBMS".
        DISPLAY "SUBROUTINE NAMED 'STATS' WHICH MAY BE CALLED AT ANY".
        DISPLAY "POINT IN A USER PROGRAM".
        DISPLAY " ".
        DISPLAY " ".
	ENTER MACRO STATS.
	CLOSE RUN-UNIT.
	STOP RUN.

CHANGE-ROUTINE.
	GO TO ACCEPT-FUNCTION.

INQUIRY-ROUTINE.
	OPEN ALL USAGE-MODE IS RETRIEVAL.
INQUIRY-REQUEST.
	DISPLAY 'PROD, SLSENG, CUSTOM OR PURORD INQUIRY? ' 
	WITH NO ADVANCING.
	ACCEPT RECORD-TYPE.
	IF RECORD-TYPE EQUAL TO 'PROD' GO TO INQUIRY-PROD.
	IF RECORD-TYPE EQUAL TO 'SLSENG' GO TO INQUIRY-SLSENG.
	IF RECORD-TYPE EQUAL TO 'CUSTOM' GO TO INQUIRY-CUSTOM.
	IF RECORD-TYPE EQUAL TO 'PURORD' GO TO INQUIRY-PURORD.
	IF RECORD-TYPE EQUAL TO SPACES GO TO INQUIRY-END.
	DISPLAY '%INVALID INQUIRY TYPE - ' RECORD-TYPE.
	GO TO INQUIRY-REQUEST.
INQUIRY-PROD.
	PERFORM ENTER-PROD.
	IF PROD-NO EQUAL TO SPACES
	GO TO INQUIRY-REQUEST.
	PERFORM FIND-PROD.
	IF ERROR-COUNT EQUAL TO 0
	PERFORM GET-PROD
	PERFORM PROD-DISPLAY
	GO TO INQUIRY-PROD-ITEM.
	DISPLAY '%PROD-NO: ' PROD-NO ' NOT IN DATA BASE'.
	GO TO INQUIRY-REQUEST.
INQUIRY-PROD-ITEM.
	DISPLAY 'DISPLAY ORDER INFO FOR THIS PROD-NO? '
	WITH NO ADVANCING.
	ACCEPT REPLY.
	IF REPLY-YES
	GO TO INQUIRY-PROD-ITEM-PATH.
	IF REPLY-NO
	GO TO INQUIRY-REQUEST.
	DISPLAY '%YES OR NO PLEASE'.
	GO TO INQUIRY-PROD-ITEM.
INQUIRY-PROD-ITEM-PATH.
	PERFORM FIND-NEXT-PROD-ITEM.
	IF ERROR-STATUS EQUAL TO 307
	DISPLAY 'NO PURORDS FOR THIS PROD-NO'
	GO TO INQUIRY-REQUEST.
	DISPLAY 'PURORD    LINE    QTY    CUSTOMER'.
	GO TO INQUIRY-GET-ITEM.
INQUIRY-PROD-ITEM-NEXT.
	PERFORM FIND-NEXT-PROD-ITEM.
	IF ERROR-STATUS EQUAL TO 307
	DISPLAY ' '
	GO TO INQUIRY-REQUEST.
INQUIRY-GET-ITEM.
	PERFORM GET-ITEM.
	PERFORM FIND-ORDITM-OWNER.
	IF ERROR-COUNT NOT EQUAL TO 0
	DISPLAY '%PURORD NOT FOUND FOR THIS ITEM'
	PERFORM DISPLAY-ERROR-STATUS
	GO TO INQUIRY-PROD-ITEM-NEXT.
	PERFORM GET-PURORD.
	PERFORM FIND-CUSORD-OWNER.
	IF ERROR-COUNT NOT EQUAL TO 0
	DISPLAY '%CUSTOM FOR THIS PURORD ITEM NOT FOUND'
	PERFORM DISPLAY-ERROR-STATUS
	GO TO INQUIRY-PROD-ITEM-NEXT.
	PERFORM GET-CUSTOM.
	PERFORM FIND-SLSCUS-OWNER.
	IF ERROR-COUNT NOT EQUAL TO 0
	MOVE 'NONE' TO SLSENG-NAME
	ELSE PERFORM GET-SLSENG.
	MOVE ITEM-LINE TO ITEM-LINE-BUILD.
	DISPLAY ORDNUM '    ' ITEM-LINE-NUMBER '     '
	ITEM-QTY '     ' CUST-NAME.
	GO TO INQUIRY-PROD-ITEM-NEXT.
INQUIRY-SLSENG.
	PERFORM ENTER-SLSENG.
	IF SLSENG-NAME EQUAL TO SPACES
	GO TO INQUIRY-REQUEST.
	PERFORM FIND-SLSENG.
	IF ERROR-COUNT EQUAL TO 0
	PERFORM GET-SLSENG
	PERFORM SLSENG-DISPLAY
	GO TO INQUIRY-SLSCUS.
	DISPLAY '%SLSENG: ' SLSENG-NAME ' NOT IN DATA BASE'.
	GO TO INQUIRY-REQUEST.
INQUIRY-SLSCUS.
	DISPLAY 'DISPLAY CUSTOMERS FOR THIS SLSENG? '
	WITH NO ADVANCING.
	ACCEPT REPLY.
	IF REPLY-YES
	GO TO INQUIRY-SLSCUS-PATH.
	IF REPLY-NO
	GO TO INQUIRY-REQUEST.
	DISPLAY '%YES OR NO PLEASE'.
	GO TO INQUIRY-SLSCUS.
INQUIRY-SLSCUS-PATH.
	PERFORM FIND-NEXT-SLSCUS.
	IF ERROR-STATUS EQUAL TO 307
	DISPLAY 'NO CUSTOMERS FOR THIS SLSENG'
	GO TO INQUIRY-REQUEST.
	GO TO INQUIRY-GET-CUSTOM.
INQUIRY-SLSCUS-NEXT.
	PERFORM FIND-NEXT-SLSCUS.
	IF ERROR-STATUS EQUAL TO 307
	GO TO INQUIRY-REQUEST.
INQUIRY-GET-CUSTOM.
	PERFORM GET-CUSTOM.
	PERFORM CUSTOM-DISPLAY.
	GO TO INQUIRY-SLSCUS-NEXT.
INQUIRY-CUSTOM.
	DISPLAY 'KEY-IN CUSTOMER NAME: '  WITH NO ADVANCING.
	ACCEPT CUST-NAME.
	IF CUST-NAME EQUAL TO SPACES
	GO TO INQUIRY-END.
	PERFORM FIND-CUSTOM.
	IF ERROR-COUNT EQUAL TO 0
	PERFORM GET-CUSTOM
	PERFORM CUSTOM-DISPLAY
	GO TO INQUIRY-CUSORD.
	DISPLAY '%CUST-NAME:   ' CUST-NAME  ' NOT IN DATA BASE'.
	GO TO INQUIRY-REQUEST.
INQUIRY-CUSORD.
	DISPLAY 'DISPLAY ORDER(S) FOR THIS CUSTOMER? '  
	WITH NO ADVANCING.
	ACCEPT REPLY.
	IF REPLY-YES
	GO TO INQUIRY-CUSORD-PATH.
	IF REPLY-NO
	GO TO INQUIRY-REQUEST.
	DISPLAY '%YES OR NO PLEASE!'
	GO TO INQUIRY-CUSORD.
INQUIRY-CUSORD-PATH.
	PERFORM FIND-NEXT-CUSORD.
	IF ERROR-STATUS EQUAL TO 307
	DISPLAY 'NO ORDERS FOR THIS CUSTOMER'
	GO TO INQUIRY-REQUEST.
	GO TO INQUIRY-GET-PURORD.
INQUIRY-CUSORD-NEXT.
	PERFORM FIND-NEXT-CUSORD.
	IF ERROR-STATUS EQUAL TO 307
	GO TO INQUIRY-REQUEST.
INQUIRY-GET-PURORD.
	PERFORM GET-PURORD.
	PERFORM PURORD-DISPLAY THRU PURORD-DISPLAY-EXIT.
	GO TO INQUIRY-CUSORD-NEXT.
INQUIRY-PURORD.
	PERFORM ACCEPT-ORDNUM.
	IF ORDNUM EQUAL TO 0
	GO TO INQUIRY-REQUEST.
	PERFORM FIND-PURORD.
	IF ERROR-COUNT EQUAL TO 0
	PERFORM GET-PURORD
	PERFORM PURORD-DISPLAY THRU PURORD-DISPLAY-EXIT
	GO TO INQUIRY-PURORD.
	DISPLAY '%PURORD: ' ORDNUM ' IS NOT IN DATABASE'.
	GO TO INQUIRY-PURORD.
INQUIRY-END.
	PERFORM CLOSE-ALL.
	GO TO ACCEPT-FUNCTION.
PROD-DISPLAY.
	DISPLAY 'PROD-NO:      ' PROD-NO.
	DISPLAY '  DESCR.      ' PROD-DESC.
	DISPLAY '  PRICE       ' PROD-PRICE.
	DISPLAY '  ON ORDER    ' PROD-ON-ORDER.
	DISPLAY ' '.
SLSENG-DISPLAY.
	DISPLAY 'NAME:     ' SLSENG-NAME.
	DISPLAY '  OFFICE: ' SLSENG-OFFICE.
	DISPLAY '   PHONE:  (' SLSENG-AREA-NO ')   ' SLSENG-PHONE-NO
				'   EXT: ' SLSENG-EXTENSION.
CUSTOM-DISPLAY.
	DISPLAY 'NAME:   ' CUST-NAME.
	DISPLAY ' ADDRESS: '.
	DISPLAY '  STREET: ' STREET.
	DISPLAY '  CITY:   ' CITY.
	DISPLAY '  STATE:  ' STATE.
	DISPLAY '  ZIP:    ' ZIP.
PURORD-DISPLAY.
	DISPLAY '  ORDER NUMBER: ' ORDNUM.
	DISPLAY '    ORDER DATE:   ' ORDER-DATE.
	DISPLAY '    ORDER LINES:  ' ORDER-LINES.
	DISPLAY '    ORDER NET:    ' ORDER-NET.
PURORD-DISPLAY-ITEMS.
	IF ORDER-LINES EQUAL TO 0
	GO TO PURORD-DISPLAY-EXIT.
	DISPLAY 'DISPLAY ITEMS IN THIS ORDER? ' WITH NO ADVANCING.
	ACCEPT REPLY.
	IF REPLY-YES
	GO TO INQUIRY-ITEM-PATH.
	IF REPLY-NO
	GO TO PURORD-DISPLAY-EXIT.
	DISPLAY '%YES OR NO PLEASE'.
	GO TO PURORD-DISPLAY-ITEMS.
INQUIRY-ITEM-PATH.
	DISPLAY '     PROD-NO.    QTY.    NET'.
INQUIRY-ITEM-FIND.
	PERFORM FIND-NEXT-ITEM.
	IF ERROR-STATUS EQUAL TO 307
	GO TO PURORD-DISPLAY-EXIT.
	IF ERROR-COUNT > 0
	PERFORM DISPLAY-ERROR-STATUS
	GO TO PURORD-DISPLAY-EXIT.
	PERFORM GET-ITEM.
	DISPLAY '     ' ITEM-PROD-NO  '    ' ITEM-QTY
	'      ' ITEM-NET.
	GO TO INQUIRY-ITEM-FIND.
PURORD-DISPLAY-EXIT.
	EXIT.

DATA-MANAGEMENT-SECTION SECTION.
DML-NOTE.
*	NOTE THAT MOST OF THE DML COMMANDS FOR THIS PROGRAM HAVE
*	BEEN COLLECTED WITHIN A SINGLE SECTION OF THE PROCEDURE
*	DIVISION.  THIS IS NOT A REQUIREMENT - ONLY A CONVENIENT
*	WAY FOR THIS PROGRAM TO MAKE MULTIPLE REFERENCES FROM
*	VARIOUS ROUTINES TO THE SAME DML STATEMENTS.

STORE-ORDSUM.
	STORE ORDSUM.
FIND-ORDSUM.
	FIND FIRST ORDSUM RECORD OF ORDAREA AREA.
GET-ORDSUM.
	GET ORDSUM.
MODIFY-ORDSUM.
	MODIFY ORDSUM; ORDSUM-ORDERS, ORDSUM-NO.
STORE-PROD.
	STORE PROD.
FIND-PROD.
	FIND PROD RECORD.
GET-PROD.
	GET PROD.
MODIFY-PROD.
	MODIFY PROD; PROD-ON-ORDER.
FIND-SLSENG.
	FIND SLSENG RECORD.
STORE-SLSENG.
	STORE SLSENG.
GET-SLSENG.
	GET SLSENG.
FIND-CUSTOM.
	FIND CUSTOM RECORD.
FIND-NEXT-SLSCUS.
	FIND NEXT CUSTOM RECORD OF SLSCUS-SET SET.
FIND-SLSCUS-OWNER.
	FIND OWNER RECORD OF SLSCUS-SET SET.
STORE-CUSTOM.
	STORE CUSTOM.
	MOVE CURRENCY STATUS FOR RUN-UNIT TO PKEY.
GET-CUSTOM.
	GET CUSTOM.
INSERT-SLSCUS-SET.
	INSERT CUSTOM INTO SLSCUS-SET.
FIND-PURORD.
	FIND PURORD RECORD.
STORE-PURORD.
	STORE PURORD.
GET-PURORD.
	GET PURORD.
MODIFY-PURORD.
	MODIFY PURORD.
FIND-FIRST-CUSORD.
	FIND FIRST PURORD RECORD OF CUSORD-SET SET.
FIND-NEXT-CUSORD.
	FIND NEXT PURORD RECORD OF CUSORD-SET SET.
FIND-CUSORD-OWNER.
	FIND OWNER RECORD OF CUSORD-SET.
FIND-NEXT-ITEM.
	FIND NEXT ITEM RECORD OF ORDITM-SET SET.
FIND-NEXT-PROD-ITEM.
	FIND NEXT ITEM RECORD OF PROD-ITEM-SET SET.
FIND-ORDITM-OWNER.
	FIND OWNER RECORD OF ORDITM-SET SET.
GET-ITEM.
	GET ITEM.
STORE-ITEM.
*	DBMS
	STORE ITEM.
OPEN-ALL-RETRIEVAL.
*	DBMS
	OPEN ALL USAGE-MODE IS RETRIEVAL.
OPEN-ALL-EXCL-UPDATE.
*	DBMS
	OPEN ALL USAGE-MODE IS EXCLUSIVE UPDATE.
OPEN-ORDAREA-EXCL-UPDATE.
*	DBMS
	OPEN AREA ORDAREA USAGE-MODE IS EXCLUSIVE UPDATE.
CLOSE-ALL.
*	DBMS
	CLOSE ALL.