DELETE DIRECTORY;
DEFINE DOMAIN DIRECTORY
 USING ENTRY ON DIREC.DAT;

DELETE ENTRY;
DEFINE RECORD ENTRY
 USING
01 PHONE.
   02 NAME PIC X(25).
   02 HOMEPHONE PIC X(10) EDIT_STRING IS XXX/XXX-XXXX.
   02 WORKPHONE PIC X(10) EDIT_STRING IS XXX/XXX-XXXX.
   02 ADDRESS PIC X(35).
   02 ZIP PIC X(5).
   02 TYPE PIC XX.
;

DELETE CHECK_LIST;
DEFINE PROCEDURE CHECK_LIST
READY DIRECTORY WRITE
FOR DIRECTORY WITH TYPE NE "OB" AND NAME GE *. "START W/NAME" SORTED BY NAME
BEGIN
PRINT SKIP 2, NAME
PRINT SKIP 2
IF *. "TYPE OB TO DELETE, SPACE TO KEEP" EQ "OB" MODIFY USING TYPE = "OB"
END
END-PROCEDURE

DELETE CHECK_ZIP;
DEFINE PROCEDURE CHECK_ZIP
READY DIRECTORY WRITE
FOR DIRECTORY WITH TYPE NE "OB" AND NAME GE *. "START W/NAME" SORTED BY NAME
BEGIN
PRINT SKIP 2,NAME,ZIP
PRINT SKIP 2
IF *. "M TO MODIFY,K TO KEEP" EQ "M" MODIFY ZIP
END
END-PROCEDURE

DELETE FIND_NUMBER;
DEFINE PROCEDURE FIND_NUMBER
READY DIRECTORY
FOR DIRECTORY WITH NAME CONTAINING *."WHOSE NUMBER DO YOU NEED?"
PRINT NAME,HOMEPHONE,WORKPHONE
FINISH DIRECTORY
END-PROCEDURE

DELETE PRINT_DIRECTORY;
DEFINE PROCEDURE PRINT_DIRECTORY
READY DIRECTORY
REPORT DIRECTORY WITH TYPE NE "OB" SORTED BY NAME ON PRINTLST.DAT
SET REPORT_NAME = "ALPHABETICAL DIRECTORY OF ADDRESSES AND PHONE NUMBERS"
SET LINES_PAGE = 80
SET COLUMNS_PAGE = 132
PRINT SKIP,NAME,ADDRESS,ZIP,HOMEPHONE,WORKPHONE
END_REPORT
FINISH DIRECTORY
END-PROCEDURE

DELETE STORE_ENTRY;
DEFINE PROCEDURE STORE_ENTRY
READY DIRECTORY WRITE
STORE DIRECTORY
FOR DIRECTORY WITH TYPE NOT IN TYPE_TABLE
BEGIN
PRINT "Bad type code."
PRINT NAME,TYPE
MODIFY TYPE
END
FINISH DIRECTORY
END-PROCEDURE

DELETE TYPE_TABLE;
DEFINE TABLE TYPE_TABLE
"ST":"Student",
"PF":"Personal Friend",
"BA":"Business Associate",
"BU":"Business",
"FR":"Friend of Relative",
"AQ":"Acquaintance",
"UA":"University Associate",
"RE":"Relative",
"RC":"RCA Associate",
"OB":"Obsolete",
ELSE "OTHER"
END_TABLE