Previous | Contents | Index |
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. |
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. |
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. |
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 |
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. |
This sample report (Example 8-7), created by the preceding PERSONNEL-UPDATE program, corresponds to the data in Figure 5-25.
Example 8-7 Sample Run of PERSONNEL-UPDATE Before Promotion |
---|
EMPLOYEE LISTING MANAGER OF GROUP A IS: HOWELL GROUP B2 SUPERVISOR IS: MOORE GROUP B2 EMPLOYEES EMPLOYEE NUMBER EMPLOYEE NAME 05500 BAKER 02000 DEANE 07400 FIFER 05000 KLEIN 01400 RILEY GROUP B1 SUPERVISOR IS: NOYCE GROUP B1 EMPLOYEES EMPLOYEE NUMBER EMPLOYEE NAME 04000 BURLEW 07000 NEILS 01000 RAVAN |
Previous | Next | Contents | Index |