 |
HP COBOL
DBMS Database Programming Manual
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.
|
|
