{$M 65520,0,655000}
PROGRAM BBSLister (Input,Output,FileName,Going);
{Written by Jason J Schwarz in Turbo Pascal v6.0
Purpose : BBS Store House keeps track of the Name,
           Baud, System, Node, Country, and Telephone
           Number of BBSs.  It uses variant records
           to keep track of different phone formats
           for different countries.}
USES
    CRT;
CONST
     Version='3.0';
TYPE
     Countries = (USA, Overseas);
     Point =^BBSRecord;
     BBSRecord = RECORD
               Name : STRING[30];
               Baud : STRING[5];
               System : STRING[15];
               Node : STRING[10];
               Left : Point;
               Right : Point;
               CASE Country : Countries OF
                    Overseas : (CountryCode : STRING[4];
                                City : STRING[4];
                                Number : STRING[6]);
                    USA      : (AreaCode : STRING[3];
                                Phone : STRING[7]);
     END;{RECORD}
     NameArray = ARRAY[1..30] OF CHAR;
     BaudArray = ARRAY[1..5] OF CHAR;
     SystemArray = ARRAY[1..15] OF CHAR;
     NodeArray = ARRAY[1..10] OF CHAR;
     CountryArray = ARRAY[1..4] OF CHAR;
     NumberArray = ARRAY[1..6] OF CHAR;
     AreaArray = ARRAY[1..3] OF CHAR;
     PhoneArray = ARRAY[1..7] OF CHAR;

VAR
   BBS : Point;
   FileName : TEXT;
   Going : TEXT;

PROCEDURE Initialize;
BEGIN
     BBS:=NIL;
END;{Initialize}

PROCEDURE DisplayRecord (Head : Point);
BEGIN
        WRITE(Going,Head^.Name);
        WRITE(Going,Head^.Baud:6);
        WRITE(Going,Head^.System:16);
        WRITE(Going,Head^.Node:11);
        IF Head^.Country=USA THEN WRITELN(Going,
           '('+Head^.AreaCode+')'+Head^.Phone:15);
        IF Head^.Country=Overseas THEN WRITELN(Going,'+'+
           Head^.CountryCode+Head^.City+Head^.Number:16);
END;{DisplayRecord}

PROCEDURE DisplayHeader;
BEGIN
     {$I-}
     CLRSCR;
     WRITE(Going,'BBS Name                       ');
     WRITE(Going,'Baud  ':6);
     WRITE(Going,'System          ':16);
     WRITE(Going,'Node       ':11);
     WRITELN(Going,'Phone Number   ':15);
     WRITE(Going,'------------------------------ ');
     WRITE(Going,'----- ');
     WRITE(Going,'--------------- ');
     WRITE(Going,'---------- ');
     WRITELN(Going,'---------------');
     {$I+}
END;{DisplayHeader}

PROCEDURE Wait;
VAR
   Dummy : CHAR;
BEGIN
     GOTOXY(27,25);
     WRITE(Output,'Press any key to continue...');
     Dummy:=READKEY;
END;{Wait}

PROCEDURE NotFound;
BEGIN
     CLRSCR;
     GOTOXY(32,13);
     WRITELN(Output,'Entry not found!',CHR(7));
     WAIT;
END;{NotFound}

PROCEDURE Page (VAR Count : INTEGER);
BEGIN
     Count:=0;
     Wait;
     CLRSCR;
     DisplayHeader;
END;{Page}

PROCEDURE PrinterPage (VAR Count : INTEGER);
BEGIN
     Count:=0;
     WRITELN(Output,CHR(12));
     DisplayHeader;
END;{PrinterPage}

PROCEDURE DisplayList (Head : Point; VAR Count : INTEGER; Response : CHAR);
BEGIN
     IF Head<>NIL THEN BEGIN
        DisplayList(Head^.Left,Count,Response);
        Count:=Count+1;
        IF (Response='D') AND (Count=22) THEN PAGE(Count);
        IF (Response='P') AND (Count=60) THEN PRINTERPAGE(Count);
        DisplayRecord(Head);
        DisplayList(Head^.Right,Count,Response);
     END;{Head<>NIL}
END;{DisplayList}

PROCEDURE Print (Response : CHAR; Dummy:INTEGER);
BEGIN
     {$I-}
     ASSIGN(Going,'PRN');
     REWRITE(Going);
     DisplayList(BBS,Dummy,Response);
     WRITELN(Going,CHR(12));
     CLOSE(Going);
     {$I+}
     IF IOResult<>0 THEN BEGIN
        WRITE(Output,CHR(7));
        WRITELN(Output,'PRINTER ERROR!');
        WAIT;
     END;
END;{Print}

PROCEDURE Display;
VAR
   Response : CHAR;
   Dummy : INTEGER;
BEGIN
     Dummy:=0;
     REPEAT
           WRITELN(Output,'Send output to (D)isplay or (P)rinter');
           Response:=UPCASE(READKEY);
     UNTIL Response IN ['D','P'];
     IF Response='P' THEN Print(Response,Dummy)
     ELSE BEGIN
          ASSIGN(Going,'CON');
          REWRITE(Going);
          DisplayHeader;
          DisplayList(BBS,Dummy,Response);
          CLOSE(Going);
          WAIT;
     END;{Else}
END;{Display}

PROCEDURE LoadError;
BEGIN
     REWRITE(FileName);
END;{LoadError}

PROCEDURE Insert (BBS : Point;Head : Point);
BEGIN
     IF BBS<>NIL THEN BEGIN
        IF (Head^.Name>=BBS^.Name) AND (BBS^.Right<>NIL) THEN
           Insert(BBS^.Right,Head) ELSE
           IF (Head^.Name>=BBS^.Name) THEN BBS^.Right:=Head;
        IF (Head^.Name<BBS^.Name) AND (BBS^.Left<>NIL) THEN
           Insert(BBS^.Left,Head) ELSE
           IF (Head^.Name<BBS^.Name) THEN BBS^.Left:=Head;
     END;{BBS<>NIL}
END;{Insert}

PROCEDURE Clean(VAR Head : Point);
VAR
   Count : INTEGER;
BEGIN
     FOR Count:=1 TO 30 DO Head^.Name[Count]:=UPCASE(Head^.Name[Count]);
END;{Clean}

PROCEDURE FileRead;
VAR
   CountryC : CHAR;
   Dummy : CHAR;
   Head : Point;
BEGIN
     NEW(Head);
     READ(FileName,Head^.Name);
     Clean(Head);
     READ(FileName,Head^.Baud);
     READ(FileName,Head^.System);
     READ(FileName,Head^.Node);
     READ(FileName,CountryC);
     IF CountryC='U' THEN BEGIN
        Head^.Country:=USA;
        READ(FileName,Head^.AreaCode);
        READ(FileName,Head^.Phone);
     END;{CountryC='U'}
     IF CountryC='O' THEN BEGIN
        Head^.Country:=Overseas;
        READ(FileName,Head^.CountryCode);
        READ(FileName,Head^.City);
        READ(FileName,Head^.Number);
     END;{CountryC='O'}
     READLN(FileName);
     Head^.Left:=NIL;
     Head^.Right:=NIL;
     IF BBS<>NIL THEN INSERT(BBS,Head) ELSE BBS:=Head;
     Head:=NIL;
END;{FileRead}

PROCEDURE Load;
BEGIN
     WRITELN(Output,'Loading...');
     {$I-}
     RESET(FileName);
     {$I+}
     IF IOResult <>0 THEN LoadError
     ELSE BEGIN
             WHILE NOT EOF(FileName) DO BEGIN
                IF NOT EOLN(FileName) THEN BEGIN
                   FileRead;
                END;{EOLN(FileName)}
             END;{EOF(FileName)}
     END;{ELSE}
     CLOSE(FileName);
END;{LOAD}

PROCEDURE RecordSave(Head : Point);
BEGIN
            WRITE(FileName,Head^.Name);
            WRITE(FileName,Head^.Baud);
            WRITE(FileName,Head^.System);
            WRITE(FileName,Head^.Node);
            IF Head^.Country=Overseas THEN BEGIN
               WRITE(FileName,'O');
               WRITE(FileName,Head^.CountryCode);
               WRITE(FileName,Head^.City);
               WRITELN(FileName,Head^.Number);
            END;{Head^.Country=Overseas}
            IF Head^.Country=USA THEN BEGIN
               WRITE(FileName,'U');
               WRITE(FileName,Head^.AreaCode);
               WRITELN(FileName,Head^.Phone);
            END;{Head^.Country=USA}
END;{RecordSave}

PROCEDURE Save2(BBS : Point);
BEGIN
     IF BBS<>NIL THEN BEGIN
        Save2(BBS^.Left);
        RecordSave(BBS);
        Save2(BBS^.Right);
     END;{BBS<>NIL}
END;{Save2}

PROCEDURE Save1;
BEGIN
     REWRITE(FileName);
     Save2(BBS);
     CLOSE(FileName);
END;{Save1}

FUNCTION Replacement (Head : Point) : Point;
BEGIN
     IF Head^.Left<>NIL THEN BEGIN
        Head:=Head^.Left;
        IF Head<>NIL THEN BEGIN
           IF Head^.Left<>NIL THEN BEGIN
              IF Head^.Right<>NIL THEN BEGIN
                 WHILE Head^.Right^.Right<> NIL DO BEGIN
                       Head:=Head^.Right;
                 END;{Head^.Right^.Right}
                 Replacement:=Head^.Right;
                 Head^.Right:=Head^.Right^.Left;
              END{Head^.Right<>NIL} ELSE
              Replacement:=Head;
           END;{Left<>NIL}
        END;{Head<>NIL}
     END{Head^.Left<>NIL} ELSE Replacement:=NIL;
END;{Replacement}

PROCEDURE Found(Name : NameArray;VAR BBS : Point);
VAR
   Temp : Point;
   Temp2 : Point;
BEGIN
     IF Name>=BBS^.Name THEN Temp:=BBS^.Right ELSE Temp:=BBS^.Left;
     IF Replacement(Temp)<>NIL THEN BEGIN
        Temp2:=Replacement(Temp);
        Temp2^.Right:=Temp^.Right;
        Temp2^.Left:=Temp^.Left;
        IF Name>=BBS^.Name THEN BBS^.Right:=Temp2 ELSE BBS^.Left:=Temp2;
     END ELSE
         IF Name>=BBS^.Name THEN BBS^.Right:=Temp^.Right ELSE
            BBS^.Left:=Temp^.Right;
     DISPOSE(Temp);
END;{Found}

PROCEDURE DeleteItem(Name : NameArray; BBS : Point; VAR FoundIt : Boolean);
VAR
   Choice : CHAR;
BEGIN
     IF BBS<>NIL THEN BEGIN
        IF Name>=BBS^.Name THEN BEGIN
           IF BBS^.Right^.Name=Name THEN BEGIN
              FoundIt:=True;
              REPEAT
                    CLRSCR;
                    DisplayHeader;
                    DisplayRecord(BBS^.Right);
                    WRITE(Output,'Are you sure that you wish to delete this BBS entry? ');
                    Choice:=UPCASE(READKEY);
              UNTIL Choice IN ['Y','N'];
              IF Choice='Y' THEN Found(Name,BBS);
           END;{BBS^.Right^.Name=Name}
           IF Name>=BBS^.Name THEN DeleteItem(Name,BBS^.Right,FoundIt);
        END;{Name>=BBS^.Name}
        IF Name<BBS^.Name THEN BEGIN
           IF BBS^.Left^.Name=Name THEN BEGIN
              FoundIt:=True;
              REPEAT
                    CLRSCR;
                    DisplayHeader;
                    DisplayRecord(BBS^.Left);
                    WRITE(Output,'Are you sure that you wish to delete this BBS entry? ');
                    Choice:=UPCASE(READKEY);
              UNTIL Choice IN ['Y','N'];
              IF Choice='Y' THEN Found(Name,BBS) ELSE DeleteItem(Name,BBS^.Left,FoundIt);
           END;{IF BBS<BBS^.Name}
           IF Name<BBS^.Name THEN DeleteItem(Name,BBS^.Right,FoundIt);
        END;{Name<BBS^.Name}
     END;{BBS<>NIL}
END;{DeleteItem}

PROCEDURE DelHead(VAR FoundIt:Boolean);
VAR
   Temp : Point;
   Temp2 : Point;
   Choice : CHAR;
BEGIN
     FoundIt:=True;
     REPEAT
           DisplayHeader;
           DisplayRecord(BBS);
           WRITE(Output,'Are you sure that you wish to delete this BBS entry? ');
           Choice:=UPCASE(READKEY);
     UNTIL Choice IN ['Y','N'];
     IF Choice='Y' THEN BEGIN
        Temp:=BBS;
        IF Replacement(BBS)<>NIL THEN BEGIN
           Temp2:=Replacement(BBS);
           Temp2^.Right:=Temp^.Right;
           Temp2^.Left:=Temp^.Left;
           BBS:=Temp2;
        END ELSE BBS:=BBS^.Right;
        Dispose(Temp);
     END;{Choice='Y'}
END;{Found}

PROCEDURE Delete;
VAR
   Name : NameArray;
   Count : INTEGER;
   Locator : Point;
   FoundIt : Boolean;
BEGIN
     FoundIt:=False;
     FOR Count:=1 TO 30 DO Name[Count]:=CHR(32);
     CLRSCR;
     WRITELN(Output,'What is the name of the BBS entry you wish to delete?');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <= 30)) DO
     BEGIN
          READ(Input,Name[Count]);
          Name[Count]:=UPCASE(Name[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     ASSIGN(Going,'CON');
     REWRITE(Going);
     IF Name=BBS^.Name THEN DelHead(FoundIt);
     DeleteItem(Name,BBS,FoundIt);
     CLOSE(Going);
     IF FoundIt=False THEN NotFound;
END;{Delete}

PROCEDURE ModifyName(VAR Head : Point);
VAR
   Count : INTEGER;
   Name : NameArray;
BEGIN
     For Count:=1 TO 30 DO Name[Count]:=CHR(32);
     WRITELN(Output,'What is the name of the BBS (up to 30 characters)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count<=30)) DO
     BEGIN
          READ(Input,Name[Count]);
          Name[Count]:=UPCASE(Name[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.Name:=Name;
END;{ModifyName}

PROCEDURE ModifyBaud(VAR Head : Point);
VAR
   Count : INTEGER;
   Baud : BaudArray;
BEGIN
     FOR Count:=1 TO 5 DO Baud[Count]:=CHR(32);
     WRITELN(Output,'What is the baud rate of the system (up to 5 characters)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <= 5)) DO
     BEGIN
          READ(Input,Baud[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.Baud:=Baud;
END;{ModifyBaud}

PROCEDURE ModifySystem(VAR Head : Point);
VAR
   Count : INTEGER;
   System : SystemArray;
BEGIN
     FOR Count:=1 TO 15 DO System[Count]:=CHR(32);
     WRITELN(Output,'What is the system software of the BBS (up to 15 characters)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <= 15)) DO
     BEGIN
          READ(Input,System[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.System:=System;
END;{ModifySystem}

PROCEDURE ModifyNode(VAR Head : Point);
VAR
   Count : INTEGER;
   Node : NodeArray;
BEGIN
     FOR Count:=1 TO 10 DO Node[Count]:=CHR(32);
     WRITELN(Output,'What node is this number, if known (up to 10 characters)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <=10)) DO
     BEGIN
          READ(Input,Node[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.Node:=Node;
END;{ModifyNode}

PROCEDURE ModUSA (VAR Head : Point);
VAR
   Count : INTEGER;
   Area : AreaArray;
   Phone : PhoneArray;
BEGIN
     FOR Count:=1 TO 3 DO Area[Count]:=CHR(32);
     FOR Count:=1 TO 7 DO Phone[Count]:=CHR(32);
     WRITELN(Output,'What is the 3 digit area code');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <=3)) DO
     BEGIN
          READ(Input,Area[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.AreaCode:=Area;
     WRITELN(Output,'What is the 7 digit phone number');
     WRITELN(Output,'DO NOT USE A DASH');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <=7)) DO
     BEGIN
          READ(Input,Phone[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.Phone:=Phone;
END;{ModUSA}

PROCEDURE ModOverseas (VAR Head : Point);
VAR
   City : CountryArray;
   Number : NumberArray;
   Count : INTEGER;
BEGIN
     FOR Count:=1 TO 4 DO City[Count]:=CHR(32);
     WRITELN(Output,'What is the country code (up to 4 digits)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <= 4)) DO
     BEGIN
          READ(Input,City[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.CountryCode:=City;
     FOR Count:=1 TO 4 DO City[Count]:=CHR(32);
     WRITELN(Output,'What is the city code (up to 4 digits)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <= 4)) DO
     BEGIN
          READ(Input,City[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.City:=City;
     FOR Count:=1 TO 6 DO Number[Count]:=CHR(32);
     WRITELN(Output,'What is the phone number (up to 6 digits)');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <=6)) DO
     BEGIN
          READ(Input,Number[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Head^.Number:=Number;
END;{ModOverseas}

PROCEDURE ModifyMenu;
BEGIN
     CLRSCR;
     GOTOXY(28,1);
     WRITELN(Output,'Choose Letter to Modify');
     GOTOXY(1,3);
     WRITELN(Output,'B for Baud');
     WRITELN(Output,'S for System');
     WRITELN(Output,'D for Node');
     WRITELN(Output,'P for Phone Number');
     WRITELN;
     WRITELN(Output,'Q to Quit Modifying this Record');
END;{ModifyMenu}

PROCEDURE ModifyReact(VAR Head : Point);
VAR
   Choice : CHAR;
BEGIN
     REPEAT
           ModifyMenu;
           Choice:=UPCASE(READKEY);
           CASE Choice OF
                'B' : ModifyBaud(Head);
                'S' : ModifySystem(Head);
                'D' : ModifyNode(Head);
                'P' : CASE Head^.Country OF
                           USA : ModUSA(Head);
                           Overseas : ModOverseas(Head);
                      END;{Case}
                'Q' : WRITELN(Output,'Saving this record...');
           END;{Case}
     UNTIL Choice='Q'
END;{ModifyReact}

PROCEDURE Find(BBS:Point;Name:NameArray;VAR Found : Boolean);
VAR
   Head : POINT;
   Choice : CHAR;
BEGIN
     IF BBS<>NIL THEN BEGIN
        IF Name>=BBS^.Name THEN Find(BBS^.Right,Name,Found);
        IF Name=BBS^.Name THEN BEGIN
           CLRSCR;
           DisplayHeader;
           DisplayRecord(BBS);
           WRITE(Output,'Do you wish to modify this record? ');
           Choice:=UPCASE(READKEY);
           IF Choice='Y' THEN BEGIN
              Found:=True;
              Head:=BBS;
              ModifyReact(Head);
           END;{Choice='Y'}
        END;{Name=BBS^.Name}
        IF Name<BBS^.Name THEN Find(BBS^.Left,Name,Found);
     END;{BBS<>NIL}
END;{Find}

PROCEDURE Edit;
VAR
   Choice : CHAR;
   Name : NameArray;
   Count : INTEGER;
   Found : Boolean;
BEGIN
     CLRSCR;
     Found:=False;
     FOR Count:=1 TO 30 DO Name[Count]:=CHR(32);
     ASSIGN(Going,'CON');
     REWRITE(Going);
     WRITELN(Output,'What is the name of the BBS entry you wish to modify?');
     Count:=1;
     WHILE ((NOT EOLN(Input)) AND (Count <= 30)) DO
     BEGIN
          READ(Input,Name[Count]);
          Name[Count]:=UPCASE(Name[Count]);
          Count:=Count+1;
     END;
     READLN(Input);
     Find(BBS,Name,Found);
     If Found=False THEN NotFound;
     CLOSE(Going);
END;{Edit}

PROCEDURE RecAdd(VAR Head : Point);
VAR
   Country : CHAR;
BEGIN
     CLRSCR;
     ModifyName(Head);
     ModifyBaud(Head);
     ModifySystem(Head);
     ModifyNode(Head);
     WRITELN(Output,'What country is this BBS located in');
     WRITELN(Output,'U for USA');
     WRITELN(Output,'O for Overseas');
     REPEAT
           Country:=UPCASE(READKEY);
     UNTIL Country IN ['U','O'];
     IF Country='U' THEN BEGIN
        Head^.Country:=USA;
        ModUSA(Head);
     END;
     IF Country='O' THEN BEGIN
        Head^.Country:=Overseas;
        ModOverseas(Head);
     END;
     Head^.Left:=NIL;
     Head^.Right:=NIL;
END;{RecAdd}

PROCEDURE Add;
VAR
   Head : Point;
   Choice : CHAR;
BEGIN
     REPEAT
           NEW(Head);
           RecAdd(Head);
           REPEAT
                 WRITE(Output,'Is all of this information correct?(Y/N) ');
                 Choice:=UPCASE(READKEY);
           UNTIL Choice IN ['Y','N'];
           IF Choice='N' THEN DISPOSE(Head);
     UNTIL Choice='Y';
     INSERT(BBS,Head);
END;{Add}

PROCEDURE Menu;
BEGIN
     CLRSCR;
     GOTOXY(32,1);
     WRITELN(Output,'BBS Store House');
     GOTOXY(28,2);
     WRITELN(Output,'Written by Jason Schwarz');
     GOTOXY(35,3);
     WRITELN(Output,'Main Menu');
     WRITELN(Output);
     WRITELN(Output,'A to Add BBS to list');
     WRITELN(Output,'D to Delete BBS from list');
     WRITELN(Output,'E to Edit BBS on list');
     WRITELN(Output,'I to Display INFORMATION');
     WRITELN(Output,'S to Show BBS list to Display or Printer');
     WRITELN(Output,'Q to Save list and Quit');
     WRITELN(Output,'X to Exit WITHOUT saving list');
END;{Menu}

PROCEDURE Exit (VAR Option : CHAR);
BEGIN
     WRITE(Output,'Are you sure you wish to leave without saving?(Y/N) ');
     REPEAT
           Option:=UPCASE(READKEY);
     UNTIL Option IN ['Y','N'];
END;{Exit}

PROCEDURE Information;
BEGIN
     CLRSCR;
     GOTOXY(32,1);
     WRITELN(Output,'BBS Store House');
     GOTOXY(34,2);
     WRITELN(Output,'Version ',Version);
     GOTOXY(28,4);
     WRITELN(Output,'Written by Jason Schwarz');
     WRITELN(Output);
     WRITELN(Output,'AS THE AUTHOR OF THIS PROGRAM I WILL CLAIM NO RESPONSIBLITY');
     WRITELN(Output,'FOR ANY DAMAGES CAUSED BY THE NORMAL OR ABNORMAL WORKING');
     WRITELN(Output,'OF THIS PROGRAM OR ANYTHING IT PRODUCES.');
     WRITELN(Output);
     WRITELN(Output,'     This program is SHAREWARE!  Please feel free to use it');
     WRITELN(Output,'for 15 days before paying.  If you find it useful then');
     WRITELN(Output,'send me what it is worth to you!  My address is:');
     WRITELN(Output,'          Jason J Schwarz');
     WRITELN(Output,'          SYSOP ESTA BBS');
     WRITELN(Output,'          5305 Calypso Court');
     WRITELN(Output,'          Hope Mills, NC 28348');
     WRITELN(Output);
     WRITELN(Output,'     Please also send me any suggestions you have via mail or');
     WRITELN(Output,'to my address on InterNet:');
     WRITELN(Output,'          /PN=JASON.SCHWARZ/O=GTEES/ADMD=TELEMAIL/C=US/@sprint.com');
     WRITELN(Output,'(Hint: For CompuServe Users just add ">INTERNET:" before');
     WRITELN(Output,' this address and you can reach me too.)');
     WAIT;
END;{Information}

PROCEDURE React;
VAR
   Choice : CHAR;
   Option : CHAR;
BEGIN
     REPEAT
           Option:='Y';
           Menu;
           Choice:=UPCASE(Readkey);
           CASE Choice OF
                'A' : Add;
                'D' : Delete;
                'E' : Edit;
                'I' : Information;
                'S' : Display;
                'X' : Exit(Option);
                'Q' : Save1;
           END {CASE}
     UNTIL (Choice IN ['Q','X']) AND (Option='Y');
END;{React}

PROCEDURE Welcome;
BEGIN
     CLRSCR;
     GOTOXY(32,5);
     WRITELN(Output,'BBS Store House');
     GOTOXY(34,6);
     WRITELN(Output,'Version ',Version);
     GOTOXY(28,8);
     WRITELN(Output,'Written by Jason Schwarz');
     Initialize;
     GOTOXY(37,10);
     Load;
END;{Welcome}

BEGIN{BBSLister}
ASSIGN(FileName,'BBS.DTA');
Welcome;
React;
END.{BBSLister}