[an error occurred while processing this directive]

HP OpenVMS Systems Documentation

Content starts here

HP COBOL
DBMS Database Programming Manual


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    <>


Chapter 8
Database Programming Examples

The next few pages show programming examples of how to do the following:

  • Populate a database
  • Back up a database
  • Access and display database information
  • Create new record relationships

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