Technical data

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.
(continued on next page)
8–18 Database Programming Examples