HP OpenVMS Systems Documentation

HP COBOL
DBMS Database Programming Manual

Contents

Index

8.6 STOOL Program Parts Breakdown Report---Sample Run

This is the report output by the STOOL program in Example 8-5.

      Enter PARTID>  (SAMP1 [RET]
          +-----------------------------------+
          | Parts Bill of Materials Explosion |
          |         (COBOL Version)           |
          |          Part-id: SAMP1           |
          +-----------------------------------+

          SAMP1    - STOOL
          SAMP3    - STOOL LEGS
          SAMP2    - STOOL SEAT

          Enter PARTID> [ctrl/z]
          End of Job

8.7 Creating New Record Relationships

The PERSONNEL-UPDATE program in Example 8-6 creates the records and implements the relationships described in Section 5.9.2.3. It directly contains two other programs: PROMOTION-UPDATE and PERSONNEL-REPORT. PROMOTION-UPDATE is directly contained by PERSONNEL-UPDATE. It changes the record relationships created by PERSONNEL-UPDATE. PERSONNEL-REPORT is also directly contained by PERSONNEL-UPDATE. It generates one report showing the record relationships just after creation by PERSONNEL-UPDATE and another report showing the new record relationships. PERSONNEL-REPORT is a Report Writer program. Section 8.7.1 and Section 8.7.2 each contain a report generated by the PERSONNEL-UPDATE program.

Example 8-6 Creating New Record Relationships

IDENTIFICATION DIVISION.
PROGRAM-ID. PERSONNEL-UPDATE.

DATA DIVISION.
SUB-SCHEMA SECTION.
DB PARTSS1 WITHIN PARTS FOR "NEW.ROO".
LD KEEPSUPER.
LD KEEP-EMPLOYEE.

WORKING-STORAGE SECTION.
01  ANSWER      PIC X.

PROCEDURE DIVISION.
A000-BEGIN.
    READY USAGE-MODE IS UPDATE.
    PERFORM A100-EMPLOYEE-LOAD.
    PERFORM A200-CONNECTING-TO-CONSISTS-OF.
    DISPLAY "Employees and groups are loaded".
    DISPLAY "Personnel Report before update ..."
    CALL "PERSONNEL-REPORT".
    DISPLAY "Press your carriage return key to continue".
    ACCEPT ANSWER.
    CALL "PROMOTION-UPDATE".
    DISPLAY "Promotions completed".
    DISPLAY "Press your carriage return key to continue".
    ACCEPT ANSWER.
    DISPLAY "Personnel Report after update ...".
    CALL "PERSONNEL-REPORT".

A010-EOJ.
    ROLLBACK.
    DISPLAY "End of PERSONNEL-UPDATE".
    STOP RUN.

A100-EMPLOYEE-LOAD.
    MOVE 10500     TO EMP_ID.
    MOVE "HOWELL"  TO EMP_LAST_NAME.
    MOVE "JOHN"    TO EMP_FIRST_NAME.
    MOVE 1111111   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 08400     TO EMP_ID.
    MOVE "NOYCE"   TO EMP_LAST_NAME.
    MOVE "BILL"    TO EMP_FIRST_NAME.
    MOVE 2222222   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 06600     TO EMP_ID.
    MOVE "MOORE"   TO EMP_LAST_NAME.
    MOVE "BRUCE"   TO EMP_FIRST_NAME.
    MOVE 3333333   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 01000     TO EMP_ID.
    MOVE "RAVAN"   TO EMP_LAST_NAME.
    MOVE "JERRY"   TO EMP_FIRST_NAME.
    MOVE 5555555   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 04000     TO EMP_ID.
    MOVE "BURLEW"  TO EMP_LAST_NAME.
    MOVE "THOMAS"  TO EMP_FIRST_NAME.
    MOVE 6666666   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 07000     TO EMP_ID.
    MOVE "NEILS"   TO EMP_LAST_NAME.
    MOVE "ALBERT"  TO EMP_FIRST_NAME.
    MOVE 7777777   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 05000     TO EMP_ID.
    MOVE "KLEIN"   TO EMP_LAST_NAME.
    MOVE "DON"     TO EMP_FIRST_NAME.
    MOVE 8888888   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 02000     TO EMP_ID.
    MOVE "DEANE"   TO EMP_LAST_NAME.
    MOVE "FRANK"   TO EMP_FIRST_NAME.
    MOVE 9999999   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 01400     TO EMP_ID.
    MOVE "RILEY"   TO EMP_LAST_NAME.
    MOVE "GEORGE"  TO EMP_FIRST_NAME.
    MOVE 1234567   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 05500     TO EMP_ID.
    MOVE "BAKER"   TO EMP_LAST_NAME.
    MOVE "DOUGH"   TO EMP_FIRST_NAME.
    MOVE 7654321   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

    MOVE 07400     TO EMP_ID.
    MOVE "FIFER"   TO EMP_LAST-NAME.
    MOVE "MIKE"    TO EMP_FIRST_NAME.
    MOVE 1212121   TO EMP_PHONE.
    MOVE "N.H."    TO EMP_LOC.
    STORE EMPLOYEE.

A200-CONNECTING-TO-CONSISTS-OF.
    MOVE 10500 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    MOVE "A" TO GROUP_NAME.
    STORE WK_GROUP.

    MOVE 08400 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 06600 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 08400 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    MOVE "B1" TO GROUP_NAME.
    STORE WK_GROUP.

    MOVE 01000 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 04000 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 07000 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 06600 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    MOVE "B2" TO GROUP_NAME.
    STORE WK_GROUP.

    MOVE 01400 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 02000 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 05000 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 05500 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

    MOVE 07400 TO EMP_ID.
    FIND FIRST EMPLOYEE WITHIN ALL_EMPLOYEES USING EMP_ID.
    CONNECT EMPLOYEE TO CONSISTS_OF.

IDENTIFICATION DIVISION.
PROGRAM-ID. PROMOTION-UPDATE.

PROCEDURE DIVISION.
A000-BEGIN.
    MOVE "A" TO GROUP_NAME.
*
* The next statement makes HOWELL's GROUP "A" record current
*
    FIND FIRST WK_GROUP USING GROUP_NAME.
*
* The next two statements fetch KLEIN using EMP_ID.
* The RETAINING clause keeps the WK_GROUP record "A"
* as current of the CONSISTS_OF set. This allows the program
* to connect KLEIN to the correct occurrence of WK_GROUP.
* A fetch to KLEIN without the RETAINING clause makes KLEIN
* current of CONSISTS_OF thus destroying the pointer to the
* WK_GROUP record "A".
*
    MOVE 05000 TO EMP_ID.
    FETCH FIRST EMPLOYEE USING EMP_ID RETAINING CONSISTS_OF.
*
* The next statement disconnects KLEIN from the WK_GROUP "B1"
* record and connects him to the current WK_GROUP "A" record.
*
    RECONNECT EMPLOYEE WITHIN CONSISTS_OF.
*
* The next two sentences create and store a WK_GROUP record.
* Because KLEIN is current of EMPLOYEE, a STORE WK_GROUP
* automatically connects WK_GROUP as a member of the MANAGES
* set owned by KLEIN, and makes "B3" current of the MANAGES
* and CONSISTS_OF sets.
*
    MOVE "B3" TO WK_GROUP.
    STORE WK_GROUP.
*
* The next two statements fetch NEILS and retain WK_GROUP
* "B3" as current of CONSISTS_OF.
*
    MOVE 7000 TO EMP_ID.
    FETCH FIRST EMPLOYEE USING EMP_ID RETAINING CONSISTS_OF.
*
* The next statement disconnects NEILS from WK_GROUP "B1"
* record and reconnects him to the WK_GROUP "B3" record.
* It also retains "B3" as current of CONSISTS_OF. This
* maintains the pointer at "B3" allowing the program to
* reassign RILEY to KLEIN.
*
    RECONNECT EMPLOYEE WITHIN CONSISTS_OF RETAINING CONSISTS_OF.
*
* The next three statements fetch RILEY, disconnect him from
* "B2" and reconnect him to "B3".
*
    MOVE 01400 TO EMP_ID.
    FETCH FIRST EMPLOYEE USING EMP_ID RETAINING CONSISTS_OF.
    RECONNECT EMPLOYEE WITHIN CONSISTS_OF.

END PROGRAM PROMOTION-UPDATE.

IDENTIFICATION DIVISION.
PROGRAM-ID. PERSONNEL-REPORT.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
    SELECT PERSONNEL-REPORT-FILE ASSIGN TO "TT:".

DATA DIVISION.
FILE SECTION.
FD  PERSONNEL-REPORT-FILE
    VALUE OF ID IS "PERSONNEL.LIS"
    REPORT IS PERSONNEL-LISTING.

WORKING-STORAGE SECTION.
01  CONTROL-FIELDS.
    02  MANAGER-NAME      PIC X(20).
    02  MANAGES-GROUP     PIC XX.
    02  SUPERVISOR-NAME   PIC X(20).
    02  SUPERVISES-GROUP  PIC XX.
    02  EMPLOYEE-NUMBER   PIC XXXXX.
    02  EMPLOYEE-NAME     PIC X(20).
REPORT SECTION.
RD  PERSONNEL-LISTING
    PAGE LIMIT IS 66
    HEADING       1
    FIRST DETAIL  3
    LAST DETAIL   60
    CONTROLS ARE  MANAGES-GROUP
                  SUPERVISES-GROUP.
01  TYPE IS PAGE HEADING.
    02  LINE 1 COLUMN 22
               PIC X(16) VALUE "EMPLOYEE LISTING".
01  MANAGER-CONTROL TYPE IS CONTROL HEADING MANAGES-GROUP.
    02  LINE IS PLUS 1.
        03  COLUMN 16 PIC X(17)
                      VALUE "MANAGER OF GROUP ".
        03  COLUMN 33 PIC XX
                      SOURCE MANAGES-GROUP.
        03  COLUMN 35 PIC XXXX
                      VALUE "IS: ".
        03  COLUMN 39 PIC X(20)
                      SOURCE MANAGER-NAME.
01  GROUP-CONTROL TYPE IS CONTROL HEADING SUPERVISES-GROUP.
    02  LINE IS PLUS 1.
        03  COLUMN 3  PIC XXXXXXX
                      VALUE "GROUP: ".
        03  COLUMN 10 PIC XX
                      SOURCE SUPERVISES-GROUP.
    02  LINE IS PLUS 1.
        03  COLUMN 3  PIC X(15)
                      VALUE IS "SUPERVISOR IS: ".
        03  COLUMN 18 PIC X(20)
                      SOURCE IS SUPERVISOR-NAME.
    02  LINE IS PLUS 2.
        03  COLUMN 3  PIC X(6)
                      VALUE "GROUP ".
        03  COLUMN 9  PIC XX
                      SOURCE IS SUPERVISES-GROUP.
        03  COLUMN 12 PIC X(9)
                      VALUE "EMPLOYEES".
        03  COLUMN 24 PIC X(15)
                      VALUE "EMPLOYEE NUMBER".
        03  COLUMN 43 PIC X(13)
                      VALUE "EMPLOYEE NAME".
01  EMPLOYEE-LINE TYPE IS DETAIL.
    02  LINE IS PLUS 1.
        03  COLUMN 28 PIC XXXXX SOURCE IS EMPLOYEE-NUMBER.
        03  COLUMN 44 PIC X(20) SOURCE IS EMPLOYEE-NAME.

PROCEDURE DIVISION.
A000-BEGIN.
    OPEN OUTPUT PERSONNEL-REPORT-FILE.
    INITIATE PERSONNEL-LISTING.
    PERFORM A100-GET-THE-BOSS THROUGH A700-DONE-THE-BOSS.
    TERMINATE PERSONNEL-LISTING.
    CLOSE PERSONNEL-REPORT-FILE.
    EXIT PROGRAM.

A100-GET-THE-BOSS.
    MOVE 10500 TO EMP_ID.
    FETCH FIRST EMPLOYEE USING EMP_ID.
    MOVE EMP_LAST_NAME TO MANAGER-NAME.
    FETCH FIRST WK_GROUP WITHIN MANAGES.
    MOVE GROUP_NAME TO MANAGES-GROUP.

A200-GET-SUPERVISORS.
    FETCH NEXT EMPLOYEE WITHIN CONSISTS_OF
               AT END GO TO A700-DONE-THE-BOSS.
    MOVE EMP_LAST_NAME TO SUPERVISOR-NAME.
    KEEP CURRENT USING KEEPSUPER.
    FETCH NEXT WK_GROUP WITHIN MANAGES.
    MOVE GROUP_NAME TO SUPERVISES-GROUP.
    PERFORM A500-GET-EMPLOYEES THROUGH A600-DONE-EMPLOYEES.
    GO TO A200-GET-SUPERVISORS.

A500-GET-EMPLOYEES.
    FETCH NEXT EMPLOYEE WITHIN CONSISTS_OF
               AT END GO TO A510-FIND-CURRENT-SUPER.
    MOVE EMP_LAST_NAME TO EMPLOYEE-NAME.
    MOVE EMP_ID        TO EMPLOYEE-NUMBER.
    GENERATE EMPLOYEE-LINE.
    GO TO A500-GET-EMPLOYEES.

A510-FIND-CURRENT-SUPER.
    FIND FIRST WITHIN KEEPSUPER.
    FREE ALL FROM KEEPSUPER.

A600-DONE-EMPLOYEES.
    EXIT.

A700-DONE-THE-BOSS.
    EXIT.

END PROGRAM PERSONNEL-REPORT.

END PROGRAM PERSONNEL-UPDATE.