|
HP OpenVMS Systems Documentation |
|
HP COBOL
|
| Previous | Contents | Index |
PARTSS3 Program Map Listing (VAX)
PARTSS3-PROGRAM in Example 7-6 includes the HP COBOL for OpenVMS VAX subschema map of the PARTSS3 subschema.
| Example 7-6 PARTSS3-PROGRAM Compiler Listing (VAX) |
|---|
PARTSS3-PROGRAM 31-May-2004 12:31:18 Compaq COBOL V5.7-63 Page 1
Source Listing 31-May-2004 12:25:37 [SYSTEST.DBM]PARTSS3-PROGRAM.COB;2 (1)
1 IDENTIFICATION DIVISION.
2 PROGRAM-ID. PARTSS3-PROGRAM.
3
4 DATA DIVISION.
5 SUB-SCHEMA SECTION.
6 DB PARTSS3 WITHIN PARTS.
7
8 PROCEDURE DIVISION.
9 END PROGRAM PARTSS3-PROGRAM.
PARTSS3-PROGRAM 31-May-2004 12:31:18 Compaq COBOL V5.7-63 Page 2
Data Names in Alphabetic Order 31-May-2004 12:25:37 [SYSTEST.DBM]PARTSS3-PROGRAM.COB;2 (1)
Line Level Name Location Size Bytes Usage Category Subs Attribute
6 01 DB-CONDITION 7 00000028 9 4 COMP N Glo
6 01 DB-CURRENT-RECORD-ID
7 00000000 4 2 COMP N Glo
6 01 DB-CURRENT-RECORD-NAME
7 00000005 31 31 DISPLAY AN Glo
6 01 DB-KEY 7 00000064 18 8 COMP N Glo
6 01 DB-UWA 7 00000000 108 108 DISPLAY AN Glo
6 01 PART 7 00000084 61 61 DISPLAY Group Glo
6 02 PART_DESC 7 0000008C 50 50 DISPLAY AN Glo
6 02 PART_ID 7 00000084 8 8 DISPLAY AN Glo
6 02 PART_STATUS 7 000000BE 1 1 DISPLAY AN Glo
6 02 PART_SUPPORT 7 000000BF 2 2 DISPLAY AN Glo
6 02 SUP_LAG_TIME 7 000000C9 10 10 DISPLAY AN Glo
6 02 SUP_RATING 7 000000C4 1 1 DISPLAY AN Glo
6 02 SUP_TYPE 7 000000C5 4 4 DISPLAY AN Glo
6 01 SUPPLY 7 000000C4 15 15 DISPLAY Group Glo
6 02 VEND_ADDRESS 7 00000122 15 15 DISPLAY AN 1 Glo
6 02 VEND_CONTACT 7 00000104 30 30 DISPLAY AN Glo
6 02 VEND_ID 7 000000D4 8 8 DISPLAY AN Glo
6 02 VEND_NAME 7 000000DC 40 40 DISPLAY AN Glo
6 02 VEND_PHONE 7 0000014F 10 10 DISPLAY N Glo
6 01 VENDOR 7 000000D4 133 133 DISPLAY Group Glo
PARTSS3-PROGRAM 31-May-2004 12:31:18 Compaq COBOL V5.7-63 Page 3
Procedure Names in Alphabetic Order 31-May-2004 12:25:37 [SYSTEST.DBM]PARTSS3-PROGRAM.COB;2 (1)
Line Name Location Type
2 PARTSS3-PROGRAM 0 00000000 Program
PARTSS3-PROGRAM 31-May-2004 12:31:18 Compaq COBOL V5.7-63 Page 4
External References 31-May-2004 12:25:37 [SYSTEST.DBM]PARTSS3-PROGRAM.COB;2 (1)
DBM$_NOT_BOUND
PARTSS3-PROGRAM 31-May-2004 12:31:18 Compaq COBOL V5.7-63 Page 5
Sub-schema Map 31-May-2004 12:25:37 [SYSTEST.DBM]PARTSS3-PROGRAM.COB;2 (1)
* SYS$COMMON:[SYSTEST.DBM.CDDPLUS1]PARTS.DBM$SUBSCHEMAS.PARTSS3
*
* Subschema version number: 31-MAY-2004 12:28:53.22
*
SUBSCHEMA NAME PARTSS3 FOR CDDPLUS1]PARTS SCHEMA
REALM MARKETS
* Within areas: MARKETS
* Owner of sets: PART_SUPPLY
*
01 PART.
02 PART_ID PIC X(8).
02 PART_DESC PIC X(50).
02 PART_STATUS PIC X.
02 PART_SUPPORT PIC X(2).
* Within areas: MARKETS
* Member of sets: PART_SUPPLY
* VENDOR_SUPPLY
*
01 SUPPLY.
02 SUP_RATING PIC X.
02 SUP_TYPE PIC X(4).
02 SUP_LAG_TIME PIC X(10).
* Within areas: MARKETS
* Owner of sets: VENDOR_SUPPLY
*
01 VENDOR.
02 VEND_ID PIC X(8).
02 VEND_NAME PIC X(40).
02 VEND_CONTACT PIC X(30).
02 VEND_ADDRESS PIC X(15) OCCURS 3 TIMES.
02 VEND_PHONE PIC 9(10).
SET NAME PART_SUPPLY
OWNER PART
MEMBER SUPPLY
INSERTION AUTOMATIC
RETENTION FIXED
ORDER NEXT
SET NAME VENDOR_SUPPLY
OWNER VENDOR
MEMBER SUPPLY
INSERTION AUTOMATIC
RETENTION FIXED
ORDER NEXT
PARTSS3-PROGRAM 31-May-2004 12:31:18 Compaq COBOL V5.7-63 Page 6
Compilation Summary 31-May-2004 12:25:37 [SYSTEST.DBM]PARTSS3-PROGRAM.COB;2 (1)
PROGRAM SECTIONS
Name Bytes Attributes
0 $CODE 6 PIC CON REL LCL SHR EXE RD NOWRT Align(2)
3 COB$NAMES_____2 24 PIC CON REL LCL SHR NOEXE RD NOWRT Align(2)
4 COB$NAMES_____4 16 PIC CON REL LCL SHR NOEXE RD NOWRT Align(2)
5 DBM$SSC_B 28 PIC CON REL GBL NOSHR NOEXE RD NOWRT Align(2)
7 DBM$UWA_B 345 PIC OVR REL GBL SHR NOEXE RD WRT Align(2)
DIAGNOSTICS
Informational: 1 (suppressed by command qualifier)
COMMAND QUALIFIERS
COBOL /LIST/MAP PARTSS3-PROGRAM.COB
/NOCOPY_LIST /NOMACHINE_CODE /NOCROSS_REFERENCE
/NOANSI_FORMAT /NOSEQUENCE_CHECK /MAP=ALPHABETICAL
/NOTRUNCATE /NOAUDIT /NOCONDITIONALS
/CHECK=(NOPERFORM,NOBOUNDS,NODUPLICATE_KEYS) /DEBUG=(NOSYMBOLS,TRACEBACK)
/WARNINGS=(NOSTANDARD,OTHER,NOINFORMATION) /NODEPENDENCY_DATA
/STANDARD=(NOSYNTAX,NOPDP11,NOV3,85,NOALPHA_AXP) /NOFIPS
/LIST /OBJECT /NODIAGNOSTICS /NOFLAGGER /NOANALYSIS_DATA
/INSTRUCTION_SET=DECIMAL_STRING /DESIGN=(NOPLACEHOLDERS,NOCOMMENTS)
/NATIONALITY=US
STATISTICS
Run Time: 1.76 seconds
Elapsed Time: 4.23 seconds
Page Faults: 13713
Dynamic Memory: 8790 pages <>
|
The next few pages show programming examples of how to do the following:
This chapter also provides an example of how to create a bill of
materials and sample runs of some of the programming examples.
8.1 Populating a Database
The DBMPARTLD program in Example 8-1 loads a series of sequential data files into the PARTS database. The PARTS database consists of a NEW root file with a default extension of .ROO describing the database instance and a series of .DBS storage files containing the actual data records. PARTS is the schema relative to the current position in CDD/Repository when the program is compiled. As the DBCS inserts the records, it creates set relationships based on the PARTSS1 subschema definitions. In the DB statement PARTS and NEW can be logical names. If PARTS is not a logical name, HP COBOL appends PARTS to CDD$DEFAULT; for example, CDD$DEFAULT.PARTS. If NEW is not a logical name, the DBCS appends .ROO as the default file type; for example, NEW.ROO.
| Example 8-1 Populating a Database |
|---|
IDENTIFICATION DIVISION.
PROGRAM-ID. DBMPARTLD.
**********************************************************
* *
* This program loads the PARTS database *
* *
**********************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAKE-FILE
ASSIGN TO "DBM$PARTS:DBMMAKE.DAT".
SELECT BUY-FILE
ASSIGN TO "DBM$PARTS:DBMBUY.DAT".
SELECT VENDOR-FILE
ASSIGN TO "DBM$PARTS:DBMVENDOR.DAT".
SELECT EMPLOYEE-FILE
ASSIGN TO "DBM$PARTS:DBMEMPLOY.DAT".
SELECT COMPONENT-FILE
ASSIGN TO "DBM$PARTS:DBMCOMPON.DAT".
SELECT SUPPLY-FILE
ASSIGN TO "DBM$PARTS:DBMSUPPLY.DAT".
SELECT DIVISION-FILE
ASSIGN TO "DBM$PARTS:DBMSUPER.DAT".
SELECT RESP-FOR-FILE
ASSIGN TO "DBM$PARTS:DBMRESPON.DAT".
DATA DIVISION.
SUB-SCHEMA SECTION.
DB PARTSS1 WITHIN PARTS FOR NEW.
FILE SECTION.
FD MAKE-FILE
RECORD VARYING FROM 24 TO 80 CHARACTERS.
01 MAKE-PART-RECORD.
02 CONTROL-FIELD PIC X.
02 PART_ID PIC X(8).
02 PART_DESC PIC X(50).
02 PART_STATUS PIC X(1).
02 PART_PRICE PIC 9(6)V9(3).
02 PART_COST PIC 9(6)V9(3).
02 PART_SUPPORT PIC X(2).
01 MAKE-CLASS-RECORD.
02 CONTROL-FIELD PIC X.
02 CLASS_CODE PIC XX.
02 CLASS_DESC PIC X(20).
02 CLASS_STATUS PIC X.
FD BUY-FILE
RECORD VARYING FROM 24 TO 80 CHARACTERS.
01 BUY-PART-RECORD.
02 CONTROL-FIELD PIC X.
02 PART_ID PIC X(8).
02 PART_DESC PIC X(50).
02 PART_STATUS PIC X(1).
02 PART_PRICE PIC 9(6)V9(3).
02 PART_COST PIC 9(6)V9(3).
02 PART_SUPPORT PIC X(2).
01 BUY-CLASS-RECORD.
02 CONTROL-FIELD PIC X.
02 CLASS_CODE PIC XX.
02 CLASS_DESC PIC X(20).
02 CLASS_STATUS PIC X.
FD COMPONENT-FILE
LABEL RECORDS ARE STANDARD.
01 COMPONENT-RECORD.
02 COMP_SUB_PART PIC X(8).
02 COMP_OWNER_PART PIC X(8).
02 COMP_MEASURE PIC X.
02 COMP_QUANTITY PIC 9(5).
FD VENDOR-FILE
LABEL RECORDS ARE STANDARD.
01 VENDOR-RECORD.
02 VEND_ID PIC X(8).
02 VEND_NAME PIC X(40).
02 VEND_CONTACT PIC X(30).
02 VEND_ADD OCCURS 3 TIMES
PIC X(15).
02 VEND_PHONE PIC 9(10).
FD SUPPLY-FILE
RECORD VARYING FROM 37 TO 64 CHARACTERS.
01 SUPPLY-RECORD.
02 CONTROL-FIELD PIC X.
02 PART-ID PIC X(8).
02 VEND-NAME PIC X(40).
02 SUP_RATING PIC X.
02 SUP_TYPE PIC X(4).
02 SUP_LAG_TIME PIC X(10).
01 QUOTE-RECORD.
02 CONTROL-FIELD PIC X.
02 QUOTE_ID PIC X(7).
02 QUOTE_DATE PIC 9(6).
02 QUOTE_MIN_ORDER PIC X(5).
02 QUOTE_UNIT_PRIC PIC 9(6)V9(3).
02 QUOTE_QTY_PRICE PIC 9(6)V9(3).
FD EMPLOYEE-FILE
LABEL RECORDS ARE STANDARD.
01 EMPLOYEE-RECORD.
02 EMP_ID PIC 9(5).
02 EMP_NAME.
03 EMP_LAST_NAME PIC X(20).
03 EMP_FIRST_NAME PIC X(10).
02 EMP_PHONE PIC X(7).
02 EMP_LOC PIC X(5).
FD DIVISION-FILE
RECORD VARYING FROM 6 TO 26 CHARACTERS.
01 MANAGES-RECORD.
02 CONTROL-FIELD PIC X.
02 GROUP_NAME PIC X(20).
02 EMP_ID PIC 9(5).
01 CONSISTS-RECORD.
02 CONTROL-FIELD PIC X.
02 EMP_ID PIC 9(5).
FD RESP-FOR-FILE
LABEL RECORDS ARE STANDARD.
01 RESP-FOR-RECORD.
02 EMP_ID PIC 9(5).
02 PART_ID PIC X(8).
WORKING-STORAGE SECTION.
77 ITEM-USED PIC X(70).
77 STAT PIC 9(9) USAGE COMP.
77 DB-TEMP PIC 9(9) USAGE IS COMP.
77 CLASS-COUNT PIC 999 VALUE IS 0.
77 PART-COUNT PIC 999 VALUE IS 0.
77 COMPONENT-COUNT PIC 999 VALUE IS 0.
77 VENDOR-COUNT PIC 999 VALUE IS 0.
77 SUPPLY-COUNT PIC 999 VALUE IS 0.
77 QUOTE-COUNT PIC 999 VALUE IS 0.
77 EMPLOYEE-COUNT PIC 999 VALUE IS 0.
77 DIVISION-COUNT PIC 999 VALUE IS 0.
PROCEDURE DIVISION.
DECLARATIVES.
100-DATABASE-EXCEPTIONS SECTION.
USE FOR DB-EXCEPTION ON OTHER.
100-PROCEDURE.
DISPLAY "DATABASE EXCEPTION CONDITION".
PERFORM 150-DISPLAY-MESSAGE.
150-DISPLAY-MESSAGE.
*
* DBM$SIGNAL displays diagnostic messages based on the
* status code in DB-CONDITION.
*
CALL "DBM$SIGNAL".
ROLLBACK.
STOP RUN.
END DECLARATIVES.
DB-PROCESSING SECTION.
INITIALIZATION-ROUT.
READY EXCLUSIVE UPDATE.
CONTROL-ROUT.
OPEN INPUT MAKE-FILE.
PERFORM MAKE-LOAD THRU MAKE-LOAD-END.
CLOSE MAKE-FILE.
* DISPLAY " ".
* DISPLAY CLASS-COUNT, " CLASS records loaded from MAKE".
* DISPLAY PART-COUNT, " PART records loaded from MAKE".
OPEN INPUT BUY-FILE.
MOVE 0 TO CLASS-COUNT.
MOVE 0 TO PART-COUNT.
PERFORM BUY-LOAD THRU BUY-LOAD-END.
CLOSE BUY-FILE.
* DISPLAY " ".
* DISPLAY CLASS-COUNT, " CLASS records loaded from BUY".
* DISPLAY PART-COUNT, " PART records loaded from BUY".
OPEN INPUT VENDOR-FILE.
PERFORM VENDOR-LOAD THRU VENDOR-LOAD-END.
CLOSE VENDOR-FILE.
* DISPLAY " ".
* DISPLAY VENDOR-COUNT, " VENDOR records loaded".
OPEN INPUT COMPONENT-FILE.
PERFORM COMPONENT-LOAD THRU COMPONENT-LOAD-END.
CLOSE COMPONENT-FILE.
* DISPLAY " ".
* DISPLAY COMPONENT-COUNT, " COMPONENT records loaded".
OPEN INPUT EMPLOYEE-FILE.
PERFORM EMPLOYEE-LOAD THRU EMPLOYEE-LOAD-END.
CLOSE EMPLOYEE-FILE.
* DISPLAY " ".
* DISPLAY EMPLOYEE-COUNT, " EMPLOYEE records loaded".
OPEN INPUT SUPPLY-FILE.
PERFORM SUPPLY-LOAD THRU SUPPLY-LOAD-END.
CLOSE SUPPLY-FILE.
* DISPLAY " ".
* DISPLAY SUPPLY-COUNT, " SUPPLY records loaded".
* DISPLAY QUOTE-COUNT, " QUOTE records loaded".
OPEN INPUT DIVISION-FILE.
PERFORM DIVISION-LOAD THRU DIVISION-LOAD-END.
CLOSE DIVISION-FILE.
* DISPLAY " ".
* DISPLAY DIVISION-COUNT, " DIVISION records loaded".
OPEN INPUT RESP-FOR-FILE.
PERFORM RESP-FOR-LOAD THRU RESP-FOR-LOAD-END.
CLOSE RESP-FOR-FILE.
COMMIT.
STOP RUN.
MAKE-LOAD.
READ MAKE-FILE AT END GO TO MAKE-LOAD-END.
IF CONTROL-FIELD OF MAKE-PART-RECORD = "C"
MOVE CORR MAKE-CLASS-RECORD TO CATEGORY
STORE CATEGORY WITHIN MAKE
ADD 1 TO CLASS-COUNT
ELSE
MOVE CORR MAKE-PART-RECORD TO PART
STORE PART WITHIN MAKE
ADD 1 TO PART-COUNT.
GO TO MAKE-LOAD.
MAKE-LOAD-END.
EXIT.
BUY-LOAD.
READ BUY-FILE AT END GO TO BUY-LOAD-END.
IF CONTROL-FIELD OF BUY-PART-RECORD = "C"
MOVE CORR BUY-CLASS-RECORD TO CATEGORY
STORE CATEGORY WITHIN BUY
ADD 1 TO CLASS-COUNT
ELSE
MOVE CORR BUY-PART-RECORD TO PART
STORE PART WITHIN BUY
ADD 1 TO PART-COUNT.
GO TO BUY-LOAD.
BUY-LOAD-END.
EXIT.
VENDOR-LOAD.
READ VENDOR-FILE AT END GO TO VENDOR-LOAD-END.
MOVE VEND_ID OF VENDOR-RECORD TO VEND_ID OF VENDOR.
MOVE VEND_NAME OF VENDOR-RECORD TO VEND_NAME OF VENDOR.
MOVE VEND_CONTACT OF VENDOR-RECORD TO VEND_CONTACT OF VENDOR.
MOVE VEND_ADD (1) TO VEND_ADDRESS (1).
MOVE VEND_ADD (2) TO VEND_ADDRESS (2).
MOVE VEND_ADD (3) TO VEND_ADDRESS (3).
MOVE VEND_PHONE OF VENDOR-RECORD TO VEND_PHONE OF VENDOR.
STORE VENDOR.
ADD 1 TO VENDOR-COUNT.
GO TO VENDOR-LOAD.
VENDOR-LOAD-END.
EXIT.
COMPONENT-LOAD.
READ COMPONENT-FILE AT END GO TO COMPONENT-LOAD-END.
IF COMP_OWNER_PART OF COMPONENT-RECORD =
COMP_OWNER_PART OF COMPONENT
GO TO COMPONENT-SUB-LOAD.
MOVE COMP_OWNER_PART OF COMPONENT-RECORD TO PART_ID OF PART.
FIND FIRST PART WITHIN ALL_PARTS USING PART_ID OF PART
AT END DISPLAY PART_ID OF PART,
"COMP_OWNER_PART does not exist for COMPONENT"
GO TO COMPONENT-LOAD.
COMPONENT-SUB-LOAD.
MOVE COMP_SUB_PART OF COMPONENT-RECORD TO PART_ID OF PART.
FIND FIRST PART WITHIN ALL_PARTS USING PART_ID OF PART
RETAINING PART_USES
AT END DISPLAY PART_ID OF PART,
"COMP_SUB_PART does not exist for COMPONENT"
GO TO COMPONENT-LOAD.
MOVE CORR COMPONENT-RECORD TO COMPONENT.
STORE COMPONENT.
ADD 1 TO COMPONENT-COUNT.
GO TO COMPONENT-LOAD.
COMPONENT-LOAD-END.
EXIT.
EMPLOYEE-LOAD.
READ EMPLOYEE-FILE AT END GO TO EMPLOYEE-LOAD-END.
MOVE CORR EMPLOYEE-RECORD TO EMPLOYEE.
STORE EMPLOYEE.
ADD 1 TO EMPLOYEE-COUNT.
GO TO EMPLOYEE-LOAD.
EMPLOYEE-LOAD-EXIT
EXIT.
SUPPLY-LOAD.
READ SUPPLY-FILE AT END GO TO SUPPLY-LOAD-END.
SUPPLY-LOAD-LOOP.
IF CONTROL-FIELD OF SUPPLY-RECORD = "S"
MOVE PART-ID OF SUPPLY-RECORD TO PART_ID OF PART
FIND FIRST PART WITHIN ALL_PARTS USING PART_ID OF PART
AT END
DISPLAY PART_ID OF PART,
" PART-ID for SUPPLY does not exist"
MOVE " " TO CONTROL-FIELD OF SUPPLY-RECORD
PERFORM BAD-SUPPLY THRU BAD-SUPPLY-END
UNTIL CONTROL-FIELD OF SUPPLY-RECORD = "S"
GO TO SUPPLY-LOAD-LOOP
END-FIND
MOVE VEND-NAME OF SUPPLY-RECORD TO VEND_NAME OF VENDOR
FIND FIRST VENDOR WITHIN ALL_VENDORS USING VEND_NAME OF VENDOR
AT END
DISPLAY VEND_NAME OF VENDOR
"VEND-NAME for SUPPLY does not exist"
MOVE " " TO CONTROL-FIELD OF SUPPLY-RECORD
PERFORM BAD-SUPPLY THRU BAD-SUPPLY-END
UNTIL CONTROL-FIELD OF SUPPLY-RECORD = "S"
GO TO SUPPLY-LOAD-LOOP
END-FIND
MOVE CORR SUPPLY-RECORD TO SUPPLY
STORE SUPPLY
ADD 1 TO SUPPLY-COUNT
GO TO SUPPLY-LOAD
ELSE
MOVE CORR QUOTE-RECORD TO PR_QUOTE
STORE PR_QUOTE
ADD 1 TO QUOTE-COUNT
GO TO SUPPLY-LOAD.
BAD-SUPPLY.
READ SUPPLY-FILE AT END GO TO SUPPLY-LOAD-END.
IF CONTROL-FIELD OF SUPPLY-RECORD = "Q"
DISPLAY QUOTE_ID OF QUOTE-RECORD, " QUOTE_ID not stored".
BAD-SUPPLY-END.
EXIT.
SUPPLY-LOAD-END.
EXIT.
DIVISION-LOAD.
READ DIVISION-FILE AT END GO TO DIVISION-LOAD-END.
DIVISION-LOAD-LOOP.
IF CONTROL-FIELD OF MANAGES-RECORD = "M"
MOVE EMP_ID OF MANAGES-RECORD TO EMP_ID OF EMPLOYEE
FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES
USING EMP_ID OF EMPLOYEE
AT END DISPLAY EMP_ID OF EMPLOYEE,
" EMP_ID for MANAGES does not exist"
MOVE " " TO CONTROL-FIELD OF MANAGES-RECORD
PERFORM BAD-DIVISION THRU BAD-DIVISION-END UNTIL
CONTROL-FIELD OF MANAGES-RECORD = "M"
GO TO DIVISION-LOAD-LOOP
END-FIND
MOVE CORR MANAGES-RECORD TO WK_GROUP
STORE WK_GROUP
ADD 1 TO DIVISION-COUNT
GO TO DIVISION-LOAD
ELSE
MOVE EMP_ID OF CONSISTS-RECORD TO EMP_ID OF EMPLOYEE
FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING
EMP_ID OF EMPLOYEE
AT END DISPLAY EMP_ID OF CONSISTS-RECORD,
" EMP_ID for CONSISTS_OF does not exist"
GO TO DIVISION-LOAD
END-FIND
CONNECT EMPLOYEE TO CONSISTS_OF
GO TO DIVISION-LOAD.
BAD-DIVISION.
READ DIVISION-FILE AT END GO TO DIVISION-LOAD-END.
IF CONTROL-FIELD OF MANAGES-RECORD = "C"
DISPLAY EMP_ID OF CONSISTS-RECORD, " EMP_ID not connected".
BAD-DIVISION-END.
EXIT.
DIVISION-LOAD-END.
EXIT.
RESP-FOR-LOAD.
READ RESP-FOR-FILE AT END GO TO RESP-FOR-LOAD-END.
RESP-FOR-LOAD-LOOP.
MOVE EMP_ID OF RESP-FOR-RECORD TO EMP_ID OF EMPLOYEE.
FETCH FIRST EMPLOYEE WITHIN ALL_EMPLOYEES
USING EMP_ID OF EMPLOYEE
AT END
DISPLAY EMP_ID OF RESP-FOR-RECORD,
" EMP_ID for RESPONSIBLE_FOR does not exist"
GO TO RESP-FOR-LOAD.
RESP-PART-LOOP.
MOVE PART_ID OF RESP-FOR-RECORD TO PART_ID OF PART.
FIND FIRST PART WITHIN ALL_PARTS USING PART_ID OF PART
AT END
DISPLAY PART_ID OF RESP-FOR-RECORD,
" PART_ID for RESPONSIBLE_FOR does not exist"
GO TO RESP-FOR-LOAD.
CONNECT PART TO RESPONSIBLE_FOR.
READ RESP-FOR-FILE AT END GO TO RESP-FOR-LOAD-END.
IF EMP_ID OF RESP-FOR-RECORD = EMP_ID OF EMPLOYEE
GO TO RESP-PART-LOOP
ELSE
GO TO RESP-FOR-LOAD-LOOP.
RESP-FOR-LOAD-END.
EXIT.
|
| Previous | Next | Contents | Index |