[an error occurred while processing this directive]

HP OpenVMS Systems Documentation
Content starts here

HP COBOL
DBMS Database Programming Manual

Previous Contents Index

8.3 Accessing and Displaying Database Information

The PARTBOM program in Example 8-3 produces a report of subcomponents (bill of materials) for a part in the PARTS database. Refer to Figure 5-23 for an explanation of the report and Section 8.6 for a sample listing.

Example 8-3 Accessing and Displaying Database Information 

IDENTIFICATION DIVISION.
PROGRAM-ID.  PARTBOM.

ENVIRONMENT DIVISION.
CONFIGURATION SECTION.


DATA DIVISION.
SUB-SCHEMA SECTION.

DB    PARTSS1 WITHIN PARTS FOR NEW.
LD    KEEP-COMPONENT.

WORKING-STORAGE SECTION.

01      INPUT-REC               PIC X(80).

01      INDENT-LEVEL            PIC 9(02)  VALUE 40.
01      END-OF-COLLECTION       PIC 9(01)  VALUE 0.
        88  END-COLLECTION                 VALUE 1.

01      INDENT-TREE.
        02  INDENT-TREE-ARRAY   PIC X(03)  OCCURS 1 TO 40 TIMES
                                DEPENDING ON INDENT-LEVEL.
PROCEDURE DIVISION.

INITIALIZATION.
    READY   MAKE, BUY EXCLUSIVE RETRIEVAL.
    MOVE    ALL "|  " TO INDENT-TREE.

SOLICIT-INPUT.
    MOVE ZERO TO END-OF-COLLECTION.
    DISPLAY    " ".
    DISPLAY    "Enter PART_ID> " WITH NO ADVANCING.
    MOVE    SPACES TO INPUT-REC.
    ACCEPT PART_ID
        AT END GO TO PARTBOM-DONE.
    FETCH    FIRST PART WITHIN ALL_PARTS USING PART_ID
        AT END DISPLAY "***  Part number ",

                                PART_ID, " not found.  ***"
               GO TO SOLICIT-INPUT.
    DISPLAY    " ".
    DISPLAY    " ".
    DISPLAY "+-----------------------------------+".
    DISPLAY "| Parts Bill of Materials Explosion |".
    DISPLAY "|          (COBOL Version)          |".
    DISPLAY "|         Part-id: " PART_ID "      |".
    DISPLAY "+-----------------------------------+".
    DISPLAY " ".
    DISPLAY " ".
    DISPLAY " ".
    DISPLAY    PART_ID, " - ", PART_DESC
    MOVE ZERO TO INDENT-LEVEL.
    FREE ALL FROM KEEP-COMPONENT.
    PERFORM PARTBOM-LOOP THRU PARTBOM-LOOP-EXIT
        UNTIL END-COLLECTION.
    GO TO SOLICIT-INPUT.

PARTBOM-DONE.
    COMMIT.
    DISPLAY " ".
    DISPLAY "END COBOL PARTBOM.".
    STOP RUN.

PARTBOM-LOOP.
    FIND NEXT COMPONENT WITHIN PART_USES
        AT END PERFORM POP-COMPONENT THRU POP-COMPONENT-EXIT
               GO TO PARTBOM-LOOP-EXIT.
    KEEP CURRENT USING KEEP-COMPONENT.
    ADD 1 TO INDENT-LEVEL.
    FIND OWNER PART_USED_ON.
    GET PART_ID, PART_DESC.
    DISPLAY INDENT-TREE, PART_ID, " - ", PART_DESC.

PARTBOM-LOOP-EXIT.
    EXIT.

POP-COMPONENT.
    FIND LAST WITHIN KEEP-COMPONENT
        AT END MOVE 1 TO END-OF-COLLECTION
               GO TO POP-COMPONENT-EXIT.
    FREE LAST WITHIN KEEP-COMPONENT.
    SUBTRACT 1 FROM INDENT-LEVEL.

POP-COMPONENT-EXIT.
    EXIT.

8.4 PARTBOM Sample Run

Example 8-4 displays a sample run of the PARTBOM program in Example 8-3.

Example 8-4 Sample Run of the PARTBOM Program 

Enter PARTID> BT163456

                 +-----------------------------------+
                 | Parts Bill of Materials Explosion |
                 |          (COBOL Version)          |
                 |         Part-id: BT163456         |
                 +-----------------------------------+

BT163456 - VT100
|  BU355678 - VT100 NON REFLECTIVE SCREEN
|  BU345670 - TERMINAL TABLE VT100
|  |  AZ345678 - 3/4 INCH SCREWS
|  |  AZ167890 - 1/2 INCH SCREWS
|  |  AZ517890 - 1/4 INCH BOLTS
|  |  AZ012345 - 3 INCH NAILS
|  |  AS234567 - 1/4 INCH TACKS
|  |  AS901234 - 3/8 INCH SCREWS
|  |  AS456789 - 4/5 INCH CLAMP
|  |  AS560890 - 1 INCH CLAMP
|  BU456789 - PLASTIC KEY ALPHA.
|  BU345438 - PLASTIC KEY NUM.
|  BU234567 - VIDEO TUBE
|  |  AZ345678 - 3/4 INCH SCREWS
|  |  AZ789012 - 3/8 INCH BOLTS
|  |  AS234567 - 1/4 INCH TACKS
|  |  AS560890 - 1 INCH CLAMP
|  BU890123 - VT100 HOUSING
|  BU876778 - VT100 SCREEN
|  AZ345678 - 3/4 INCH SCREWS
|  AZ567890 - 1/4 INCH SCREWS
|  AZ789012 - 3/8 INCH BOLTS
|  AS901234 - 3/8 INCH SCREWS
|  AS890123 - 3/4 INCH ELECTRICAL TAPE

Enter PARTID> [ctrl/z]

END COBOL PARTBOM.

8.5 Creating Relationships Between Records of the Same Type

The STOOL program in Example 8-5 illustrates how to create a relationship between records of the same type. It loads and connects the parts example discussed in Section 5.9.2.2 and produces a parts breakdown report illustrating the relationships. Section 8.6 contains the sample report.

Example 8-5 Creating Relationships Between Records of the Same Type 

IDENTIFICATION DIVISION.
PROGRAM-ID. STOOL.
DATA DIVISION.
SUB-SCHEMA SECTION.
DB  PARTSS1 WITHIN  PARTS FOR "NEW.ROO".
LD  KEEP-COMPONENT.
WORKING-STORAGE SECTION.
01  DB-ERROR-CHECK       PIC 9.
    88  DB-ERROR         VALUE 1.
    88  DB-OK            VALUE 0.
01  DB-COND              PIC 9(9).
01  DB-ID                PIC 9(4).

PROCEDURE DIVISION.
A000-BEGIN.
    READY USAGE-MODE IS CONCURRENT UPDATE.
    MOVE 0 TO DB-ERROR-CHECK.
    PERFORM B000-STORE-PARTS THROUGH
            B300-BUILD-AND-STORE-STOOL-LEG.
    IF DB-OK PERFORM C000-STORE-COMPONENTS
                     THRU 800-VERIFY-ROUTINE.

A100-EOJ.
*   IF DB-ERROR
    ROLLBACK ON ERROR DISPLAY "Error on ROLLBACK"
             PERFORM 900-DISPLAY-DB-CONDITION
             END-ROLLBACK
    DISPLAY "End of Job".
    STOP RUN.

B000-STORE-PARTS.
    FIND FIRST PART ON ERROR
         DISPLAY "Positioning to first part is unsuccessful"
         PERFORM 900-DISPLAY-DB-CONDITION
         MOVE 1 TO DB-ERROR-CHECK.

B100-BUILD-AND-STORE-STOOL.
    MOVE "SAMP1" TO PART_ID.
    MOVE "STOOL" TO PART_DESC.
    MOVE "G"     TO PART_STATUS.
    MOVE 11      TO PART_PRICE.
    MOVE 6       TO PART_COST.
    MOVE SPACES  TO PART_SUPPORT.
    IF DB-OK STORE PART ON ERROR
          DISPLAY "B100 Error in storing STOOL"
          PERFORM 900-DISPLAY-DB-CONDITION
          MOVE 1 TO DB-ERROR-CHECK.

B200-BUILD-AND-STORE-STOOL-SEAT.
    MOVE "SAMP2"      TO PART_ID.
    MOVE "STOOL SEAT" TO PART_DESC.
    MOVE "G"          TO PART_STATUS.
    MOVE 3            TO PART_PRICE.
    MOVE 2            TO PART_COST.
    MOVE SPACES       TO PART_SUPPORT.
    IF DB-OK STORE PART ON ERROR
          DISPLAY "B200 Error in storing STOOL SEAT"
          PERFORM 900-DISPLAY-DB-CONDITION
          MOVE 1 TO DB-ERROR-CHECK.

B300-BUILD-AND-STORE-STOOL-LEG.
    MOVE "SAMP3"      TO PART_ID.
    MOVE "STOOL LEGS" TO PART_DESC.
    MOVE "G"          TO PART_STATUS.
    MOVE 2            TO PART_PRICE.
    MOVE 1            TO PART_COST.
    MOVE SPACES       TO PART_SUPPORT.
    IF DB-OK STORE PART ON ERROR
          DISPLAY "B300 Error in storing STOOL LEGS"
          PERFORM 900-DISPLAY-DB-CONDITION
          MOVE 1 TO DB-ERROR-CHECK.

C000-STORE-COMPONENTS.
    MOVE "STOOL" TO PART_DESC.

C100-FIND-STOOL.
    FIND FIRST PART USING PART_DESC ON ERROR
         DISPLAY "C000 Error in finding STOOL"
         PERFORM 900-DISPLAY-DB-CONDITION
         MOVE 1 TO DB-ERROR-CHECK.
    MOVE "STOOL SEAT" TO PART_DESC.

C200-FIND-STOOL-SEAT.
    IF DB-OK
       FIND FIRST PART USING PART_DESC RETAINING PART_USES
         ON ERROR
             DISPLAY "C000 Error in finding STOOL SEAT"
             PERFORM 900-DISPLAY-DB-CONDITION
             MOVE 1 TO DB-ERROR-CHECK.

C300-CONNECT-COMPONENT-1.
    MOVE "SAMP2" TO COMP_SUB_PART.
    MOVE "SAMP1" TO COMP_OWNER_PART.
    MOVE "U"     TO COMP_MEASURE.
    MOVE 1       TO COMP_QUANTITY.
    IF DB-OK
       STORE COMPONENT RETAINING PART_USES
         ON ERROR
             DISPLAY "C000 Error in storing first component"
             PERFORM 900-DISPLAY-DB-CONDITION
             MOVE 1 TO DB-ERROR-CHECK.

C400-FIND-STOOL-LEGS.
    MOVE "STOOL LEGS" TO PART_DESC.
    IF DB-OK
       FIND FIRST PART USING PART_DESC RETAINING PART_USES
         ON ERROR
             DISPLAY "C000 Error in finding STOOL LEGS"
             PERFORM 900-DISPLAY-DB-CONDITION
             MOVE 1 TO DB-ERROR-CHECK.

C500-CONNECT-COMPONENT-4.
    MOVE "SAMP3" TO COMP_SUB_PART.
    MOVE "SAMP1" TO COMP_OWNER_PART.
    MOVE "U"     TO COMP_MEASURE.
    MOVE 4       TO COMP_QUANTITY.
    IF DB-OK
       STORE COMPONENT
         ON ERROR
             DISPLAY "C000 Error in storing second component"
             PERFORM 900-DISPLAY-DB-CONDITION
             MOVE 1 TO DB-ERROR-CHECK.

800-VERIFY-ROUTINE.
    CALL "PARTBOM".

900-DISPLAY-DB-CONDITION.
    MOVE DB-CONDITION                  TO DB-COND.
    MOVE DB-CURRENT-RECORD-ID          TO DB-ID.
    DISPLAY "DB-CONDITION            - ", DB-COND.
    DISPLAY "DB-CURRENT-RECORD-NAME  - ",
                             DB-CURRENT-RECORD-NAME.
    DISPLAY "DB-CURRENT-RECORD-ID    - ", DB-ID.
    CALL "DBM$SIGNAL".

IDENTIFICATION DIVISION.
PROGRAM-ID.  PARTBOM.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
     SELECT  INPUT-FILE ASSIGN TO "SYS$COMMAND".

DATA DIVISION.
SUB-SCHEMA SECTION.
*  DB PARTSS1 WITHIN  PARTS FOR "NEW.ROO".

FILE SECTION.
FD      INPUT-FILE
        LABEL RECORDS ARE STANDARD
        DATA  RECORD  IS  INPUT-REC.
01      INPUT-REC               PIC X(80).

WORKING-STORAGE SECTION.
01      INDENT-LEVEL            PIC 9(02)  VALUE 40.
01      DBM$_END                PIC 9(09)  COMP
                                VALUE EXTERNAL DBM$_END.
01      END-OF-COLLECTION       PIC 9(01)  VALUE 0.
        88  END-COLLECTION                 VALUE 1.
01      INDENT-TREE.
        02  INDENT-TREE-ARRAY   PIC X(03)
                                OCCURS 1 TO 40 TIMES
                                DEPENDING  ON INDENT-LEVEL.

PROCEDURE DIVISION.

INITIALIZATION.
    OPEN INPUT  INPUT-FILE.
    MOVE ALL "|  " TO INDENT-TREE.

SOLICIT-INPUT.
    MOVE ZERO TO END-OF-COLLECTION.
    DISPLAY " ".
    DISPLAY "Enter PART_ID> " WITH NO ADVANCING.
    MOVE SPACES TO INPUT-REC.
    READ INPUT-FILE INTO PART_ID
        AT END GO TO PARTBOM-DONE.
    FETCH FIRST PART WITHIN ALL_PARTS USING PART_ID
        AT END DISPLAY "*** Part number ",
                                PART_ID, " not found.  ***"
               GO TO SOLICIT-INPUT.
    DISPLAY    " ".
    DISPLAY    " ".
    DISPLAY
    DISPLAY "+-----------------------------------+".
    DISPLAY "| Parts Bill of Materials Explosion |".
    DISPLAY "|          (COBOL Version)          |".
    DISPLAY "|         Part-id: " PART_ID "      |".
    DISPLAY "+-----------------------------------+".
    DISPLAY " ".
    DISPLAY " ".
    DISPLAY " ".
    DISPLAY    PART_ID, " - ", PART_DESC
    MOVE ZERO TO INDENT-LEVEL.
    FREE ALL FROM KEEP-COMPONENT.
    PERFORM PARTBOM-LOOP THRU PARTBOM-LOOP-EXIT
        UNTIL END-COLLECTION.
    GO TO SOLICIT-INPUT.

PARTBOM-DONE.
    CLOSE INPUT-FILE.
    EXIT PROGRAM.

PARTBOM-LOOP.
    FIND NEXT COMPONENT WITHIN PART_USES
         AT END PERFORM POP-COMPONENT
                       THRU POP-COMPONENT-EXIT
         GO TO PARTBOM-LOOP-EXIT.
    KEEP CURRENT USING KEEP-COMPONENT.
    ADD 1 TO INDENT-LEVEL.
    FIND OWNER PART_USED_ON.
    GET PART_ID, PART_DESC.
    DISPLAY INDENT-TREE, PART_ID, " - ", PART_DESC.

PARTBOM-LOOP-EXIT.
    EXIT.

POP-COMPONENT.
    FIND    LAST WITHIN KEEP-COMPONENT
        AT END MOVE 1 TO END-OF-COLLECTION
               GO TO POP-COMPONENT-EXIT.
    FREE    LAST WITHIN KEEP-COMPONENT.
    SUBTRACT 1 FROM INDENT-LEVEL.

POP-COMPONENT-EXIT.
    EXIT.
END PROGRAM PARTBOM.
END PROGRAM STOOL.

Previous Next Contents Index