home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol063 / nad-3.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  23KB  |  1,075 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7. {A NAME AND ADDRESS PROGRAM BY:  CRAIG RUDLIN, M.D.
  8.                  202 OVERLOOK ROAD
  9.                  RICHMOND, VIRGINIA 23229
  10.  
  11.         
  12. VERSION 3.0}
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21. PROGRAM NAD; {$P}
  22.  
  23. CONST
  24. CITY_ONE = 'RICHMOND          ';
  25. STATE_ONE = 'VIRGINIA  ';
  26. CITY_TWO = 'BOSTON            ';
  27. STATE_TWO = 'MASS      ';
  28.  
  29.  
  30. TYPE
  31.  
  32.     MAILING = RECORD
  33.         NAME:ARRAY[1..30] OF CHAR;
  34.         STREET_NUMBER:ARRAY[1..6] OF CHAR;
  35.         STREET: ARRAY[1..20] OF CHAR;
  36.         CITY: ARRAY[1..18] OF CHAR;
  37.         STATE:ARRAY[1..10] OF CHAR;
  38.         ZIP:ARRAY[1..10] OF CHAR;
  39.         ATTENTION:ARRAY[1..30] OF CHAR;
  40.         ACCT_NUMBER:ARRAY[1..4] OF CHAR;
  41.         END;
  42.  
  43.     ALPHABET =     RECORD
  44.             START:INTEGER;
  45.             FINISH:INTEGER;
  46.             END;
  47. FA=FILE OF ALPHABET;
  48.  
  49. F = FILE OF MAILING;
  50. $STRING80 = STRING 80;
  51. $STRING0  = STRING 0;
  52. $STRING255 = STRING 255;
  53. $STRING14 = STRING 14;
  54.  
  55. TR = ARRAY [1..4] OF CHAR;
  56.  
  57. VAR
  58. FIN: F;
  59. FALP:FA;
  60. COUNTER,I,N:INTEGER;
  61. INFORMATION: MAILING;
  62. NUMBER_OF_RECORDS: INTEGER;
  63.  
  64. NA,ST_NO,ST,CIT,STA,ZI,ATT: $STRING80;
  65.  
  66. COR_FLAG,FINISH,CONTINUE,NEWFILE,LISTING: BOOLEAN;
  67. ANSWER:CHAR;
  68. ALPFILE,SORTFILE,FILENAM:$STRING14;
  69.  
  70. REC_NUMBER,END_OF_FILE:INTEGER;
  71. DESIRED_NAME:ARRAY[1..30] OF CHAR;
  72. DES_NAM:$STRING80;
  73. FOUND:BOOLEAN;
  74.  
  75. CHANGE_RECORD,DELETE_RECORD,FIND_RECORD,ADD_TO_FILE:BOOLEAN;
  76.  
  77. PROCEDURE SETLENGTH(VAR X: $STRING0; Y:INTEGER);EXTERNAL;
  78. FUNCTION LENGTH(X:$STRING255):INTEGER;EXTERNAL;
  79.  
  80.  
  81. PROCEDURE CLEAR_SCREEN;
  82. BEGIN
  83. WRITE (CHR(27),'*',CHR(0),CHR(0),CHR(0),CHR(0));
  84. END;
  85.  
  86. PROCEDURE ERASE_LINES(STARTING_LINE,NUMBER_OF_LINES:INTEGER);
  87.  
  88. VAR
  89. I:INTEGER;
  90. BLANKS:STRING 80;
  91.  
  92. BEGIN
  93. BLANKS:='                                        ';{40SPACES}
  94. FOR I:= 1 TO NUMBER_OF_LINES DO
  95.     BEGIN
  96.     WRITE(CHR(27),'=',CHR(STARTING_LINE+31),CHR(32),BLANKS,BLANKS);
  97.     STARTING_LINE:=STARTING_LINE + 1;
  98.     END
  99. END;
  100.  
  101.  
  102. PROCEDURE MOVE_CURSOR (X,Y:INTEGER);
  103. BEGIN
  104.     WRITE(CHR(27),'=',CHR(Y+31),CHR(X+31));
  105. END;
  106.  
  107. PROCEDURE PROMPT (X,Y,LENGTH:INTEGER; P:$STRING80;
  108.           PROTECTED_FIELD_DESIRED:BOOLEAN);
  109.  
  110. VAR
  111. UNDERLINE:STRING 80;
  112. I:INTEGER;
  113. BEGIN
  114. UNDERLINE:='_';
  115.     FOR I:= 1 TO LENGTH DO APPEND(UNDERLINE,'_');
  116.     IF PROTECTED_FIELD_DESIRED = FALSE THEN
  117. WRITE(CHR(27),'=',CHR(Y+31),CHR(X+31),P,UNDERLINE)
  118.     ELSE
  119. WRITE(CHR(27),'=',CHR(Y+31),CHR(X+31),')',P,
  120.     UNDERLINE,CHR(27),'(');
  121. END;
  122.  
  123.  
  124. FUNCTION INPUT_DATA (X,Y,LEN:INTEGER; ALPHANUMERIC:BOOLEAN;
  125.              MAXIMUM_VALUE,MINIMUM_VALUE:REAL):$STRING80;
  126.  
  127. VAR
  128. DATA,BLANKS:$STRING80;
  129. I:INTEGER;
  130.  
  131. PROCEDURE CORRECT(X,Y:INTEGER);
  132. VAR
  133. I,A,B:INTEGER;
  134. BEGIN
  135.  
  136.     ERASE_LINES(20,2);
  137.     WRITE (CHR(7));
  138.     MOVE_CURSOR (1,20);
  139.     
  140.     IF (ALPHANUMERIC = TRUE) AND (LENGTH(DATA)>LEN) THEN
  141.         WRITE('TERM TOO LONG');
  142.     
  143.     MOVE_CURSOR(X,Y);
  144.     WRITE(' ');
  145.     A:=X;
  146.     B:=Y;
  147.  
  148.     FOR I:= 1 TO LENGTH(DATA) DO
  149.     BEGIN
  150.         MOVE_CURSOR(A,B);
  151.         WRITE(' ');    
  152.         A:=A+1;
  153.     END;
  154.  
  155.     MOVE_CURSOR(X,Y);
  156.     WRITE('_');
  157.     A:=X;
  158.     B:=Y;
  159.     FOR I:= 1 TO (LEN-1) DO    
  160.     BEGIN
  161.         MOVE_CURSOR(A,B);
  162.         WRITE('_');
  163.         A:=A+1;
  164.     END;
  165.  
  166.     MOVE_CURSOR(X,Y);
  167.     READ(DATA);
  168.     ERASE_LINES(20,1);
  169.  
  170.  
  171. END;
  172.  
  173.  
  174.  
  175. BEGIN
  176.  
  177.     BLANKS:='                                        ';{40SPACES}
  178.  
  179. MOVE_CURSOR(X,Y);
  180. READ(DATA);
  181.  
  182. WHILE(ALPHANUMERIC = TRUE) AND (LENGTH(DATA) > LEN) DO CORRECT(X,Y);
  183.  
  184. IF LENGTH(DATA) = 0 THEN
  185. BEGIN
  186.     DATA:=' ';
  187.     FOR I:=1 TO (LEN-1) DO APPEND(DATA,' ');
  188. END;
  189.  
  190. IF LENGTH(DATA) < LEN THEN
  191.     FOR I:=  LENGTH(DATA) TO LEN DO APPEND(DATA,' ');
  192.  
  193. INPUT_DATA:=DATA;
  194.  
  195. END;
  196.  
  197.  
  198. {************  PROCEDURE TO DETERMINE NUMBER RECORDS IN FILE ******}
  199.  
  200. PROCEDURE NUMBER_RECORDS(FILENAM:$STRING14);
  201. BEGIN
  202.  
  203. RESET(FILENAM,FIN);
  204. WITH INFORMATION DO
  205. BEGIN
  206.  
  207. READ(FIN:1,INFORMATION);
  208. NUMBER_OF_RECORDS:=(((ORD(ACCT_NUMBER[1])-48)*1000)+
  209.         ((ORD(ACCT_NUMBER[2])-48)*100)+
  210.         ((ORD(ACCT_NUMBER[3])-48)*10)+
  211.         ((ORD(ACCT_NUMBER[4])-48)*1));
  212. END; {OF WITH}
  213.  
  214. END; {OF PROCEDURE}
  215.  
  216. {********** DETERMINE THE CURRENT NUMBER OF RECORDS  *******}
  217.  
  218. PROCEDURE CALC_ACCT_NO(CURRENT_NUMBER_OF_RECORDS:INTEGER);
  219. VAR
  220. ONES,TENS,HUNDREDS,THOUSANDS:CHAR;
  221. O,T,H,TH:INTEGER;
  222.  
  223. BEGIN
  224. O:=0;
  225. T:=0;
  226. H:=0;
  227. TH:=0;
  228. WITH INFORMATION DO
  229. BEGIN
  230.  
  231. IF CURRENT_NUMBER_OF_RECORDS < 10 THEN
  232. BEGIN
  233. ONES:=CHR(CURRENT_NUMBER_OF_RECORDS + 48);
  234. ACCT_NUMBER[1]:='0';
  235. ACCT_NUMBER[2]:='0';
  236. ACCT_NUMBER[3]:='0';
  237. ACCT_NUMBER[4]:=ONES;
  238. END; {IF}
  239.  
  240. IF CURRENT_NUMBER_OF_RECORDS  = 10 THEN ACCT_NUMBER:='0010';
  241. IF CURRENT_NUMBER_OF_RECORDS  = 100 THEN ACCT_NUMBER:='0100';
  242. IF CURRENT_NUMBER_OF_RECORDS = 1000 THEN ACCT_NUMBER:='1000';
  243.  
  244. IF (CURRENT_NUMBER_OF_RECORDS < 100) AND
  245.    (CURRENT_NUMBER_OF_RECORDS > 10) THEN
  246. BEGIN
  247. WHILE (CURRENT_NUMBER_OF_RECORDS < 100) AND
  248.       (CURRENT_NUMBER_OF_RECORDS > 10) DO          {FOR VALUE 1-99}
  249. BEGIN
  250. CURRENT_NUMBER_OF_RECORDS:=CURRENT_NUMBER_OF_RECORDS-10;
  251. T:=T+1;
  252. IF CURRENT_NUMBER_OF_RECORDS < 10 THEN
  253. BEGIN
  254. ONES:= CHR(CURRENT_NUMBER_OF_RECORDS + 48);
  255. TENS:=CHR(T+48);
  256. ACCT_NUMBER[1]:='0';
  257. ACCT_NUMBER[2]:='0';
  258. ACCT_NUMBER[3]:=TENS;
  259. ACCT_NUMBER[4]:=ONES;
  260. END; {IF}
  261.  
  262. END; {WHILE}
  263. END; {OF IF}
  264.  
  265. IF (CURRENT_NUMBER_OF_RECORDS < 10000) AND
  266.    (CURRENT_NUMBER_OF_RECORDS > 100) THEN
  267. BEGIN
  268. IF CURRENT_NUMBER_OF_RECORDS < 1000 THEN THOUSANDS:='0';
  269. BEGIN
  270. WHILE (CURRENT_NUMBER_OF_RECORDS < 10000) AND
  271.       (CURRENT_NUMBER_OF_RECORDS >= 1000) DO
  272. BEGIN
  273. CURRENT_NUMBER_OF_RECORDS:=CURRENT_NUMBER_OF_RECORDS - 1000;
  274. TH:=TH+1;
  275. IF CURRENT_NUMBER_OF_RECORDS < 1000 THEN THOUSANDS:=CHR(TH+48);
  276. END;
  277. IF CURRENT_NUMBER_OF_RECORDS < 100 THEN HUNDREDS:='0';
  278.  
  279. WHILE (CURRENT_NUMBER_OF_RECORDS < 1000) AND
  280.       (CURRENT_NUMBER_OF_RECORDS >= 100) DO
  281. BEGIN
  282. CURRENT_NUMBER_OF_RECORDS:=CURRENT_NUMBER_OF_RECORDS-100;
  283. H:=H+1;
  284. IF CURRENT_NUMBER_OF_RECORDS < 100 THEN HUNDREDS:=CHR(H+48);
  285. END;
  286. IF CURRENT_NUMBER_OF_RECORDS < 10 THEN TENS:='0';
  287.  
  288. WHILE (CURRENT_NUMBER_OF_RECORDS < 100) AND
  289.       (CURRENT_NUMBER_OF_RECORDS >= 10) DO
  290. BEGIN
  291. CURRENT_NUMBER_OF_RECORDS:=CURRENT_NUMBER_OF_RECORDS-10;
  292. T:=T+1;
  293. IF CURRENT_NUMBER_OF_RECORDS < 10 THEN TENS:=CHR(T+48);
  294. END;
  295.  
  296. ONES:=CHR(CURRENT_NUMBER_OF_RECORDS+48);
  297. END;
  298.  
  299. ACCT_NUMBER[1]:=THOUSANDS;
  300. ACCT_NUMBER[2]:=HUNDREDS;
  301. ACCT_NUMBER[3]:=TENS;
  302. ACCT_NUMBER[4]:=ONES;
  303.  
  304. IF CURRENT_NUMBER_OF_RECORDS  = 10 THEN ACCT_NUMBER:='0010';
  305. IF CURRENT_NUMBER_OF_RECORDS  = 100 THEN ACCT_NUMBER:='0100';
  306. IF CURRENT_NUMBER_OF_RECORDS = 1000 THEN ACCT_NUMBER:='1000';
  307.  
  308. END; {OF IF}
  309. END; {OF WITH INFORMATION DO}
  310. END; {OF PROCEDURE}
  311.  
  312.  
  313. {********************  PRINT THE FILE  ********************}
  314.  
  315. PROCEDURE PRINT_FILE(FILENAM:$STRING14);
  316.  
  317. TYPE
  318. C = FILE OF CHAR;
  319.  
  320. VAR
  321. CONTINUE,ANSWER:CHAR;
  322. AC,HARDCOPY: BOOLEAN;
  323. FOUT: C;
  324. COUNTER:INTEGER;
  325.  
  326. BEGIN
  327. CLEAR_SCREEN;
  328.  
  329. REPEAT
  330. WRITELN;
  331. WRITE ('DO YOU WANT THE ACCOUNT NUMBER INCLUDED IN THE PRINT OUT? Y/N ');
  332. READ(ANSWER);
  333. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  334. IF ANSWER = 'Y' THEN AC:=TRUE ELSE AC:=FALSE;
  335.  
  336. REPEAT
  337. WRITELN;
  338. WRITE ('DO YOU WANT A HARDCOPY OF THE FILE? Y/N ');
  339. READ(ANSWER);
  340. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  341.  
  342. IF ANSWER = 'Y' THEN 
  343.     BEGIN
  344.     HARDCOPY:=TRUE;
  345.     REWRITE('LST:',FOUT);
  346.     WRITELN('PREPARE PRINTER TO RECEIVE LISTING.');
  347.     WRITELN('WHEN READY, TYPE A CARRIAGE RETURN.');
  348.     READ(ANSWER);
  349.     CLEAR_SCREEN;
  350.     WRITELN('FILE IS NOW BEING PRINTED.');
  351.     END;
  352.  
  353. IF ANSWER = 'N' THEN HARDCOPY:= FALSE;
  354.  
  355.  
  356.  
  357. RESET(FILENAM,FIN);
  358. CLEAR_SCREEN;
  359. NUMBER_RECORDS(FILENAM);
  360.  
  361. WITH INFORMATION DO
  362. BEGIN
  363. COUNTER:=0;
  364.  
  365. FOR I:= 2 TO NUMBER_OF_RECORDS DO
  366. BEGIN
  367. READ(FIN:I,INFORMATION);
  368. IF NAME <> 'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ' THEN  {DO'NT PRINT DELETED RECORDS}
  369. BEGIN
  370.  
  371. IF HARDCOPY = FALSE THEN
  372. BEGIN
  373. WRITELN;
  374. WRITELN (NAME);
  375. WRITELN(STREET_NUMBER,'  ',STREET);
  376. WRITELN(CITY,'    ',STATE,'    ',ZIP);
  377. WRITELN;
  378. COUNTER:=COUNTER+5;
  379. IF ATTENTION <> '                              ' THEN
  380.     BEGIN
  381.     WRITELN('ATT:  ',ATTENTION);
  382.     COUNTER:=COUNTER+1;
  383.     END; {OF THIS IF}
  384. IF AC = TRUE THEN
  385.     BEGIN
  386.     WRITELN;
  387.     WRITELN('ACCOUNT NUMBER:  ',ACCT_NUMBER);
  388.     COUNTER:=COUNTER+1;
  389.     END;
  390. IF COUNTER >= 21  THEN 
  391.     BEGIN
  392.     PROMPT(1,23,0,'ENTER ANY CHARACTER TO CONTINUE',FALSE);
  393.     READ(CONTINUE);
  394.     ERASE_LINES(23,1);
  395.     COUNTER:=0;
  396.     END;
  397.  
  398.  
  399. END; {FOR HARDCOPY = FALSE}
  400.  
  401. IF HARDCOPY = TRUE THEN
  402. BEGIN
  403. WRITELN(FOUT,NAME);
  404. WRITELN(FOUT,STREET_NUMBER,'   ',STREET);
  405. WRITELN(FOUT,CITY,'     ',STATE,'    ',ZIP);
  406. WRITELN(FOUT,' ');
  407. IF ATTENTION <> '                              ' THEN
  408.     WRITELN(FOUT,'ATT:   ',ATTENTION);
  409. IF AC = TRUE THEN
  410.     BEGIN
  411.     WRITELN(FOUT,' ');
  412.     WRITELN(FOUT,'ACCOUNT NUMBER:  ',ACCT_NUMBER);
  413.     WRITELN(FOUT,'  ');
  414.     END;
  415. IF AC = FALSE THEN WRITELN(FOUT,'  ');
  416. WRITELN(FOUT,'  ');
  417.  
  418. END; {FOR HARDCOPY  =  TRUE}
  419. END; {OF NAME <> ZZZZZZ..}
  420. END;  {FOR LOOP}
  421. END; {THIS IS FOR WITH STATEMENTS}
  422. IF HARDCOPY = FALSE THEN
  423. BEGIN
  424. ERASE_LINES(22,2);
  425. MOVE_CURSOR(1,22);
  426. WRITE('ENTER A CARRIAGE RETURN TO CONTINUE PROGRAM');
  427. READ(ANSWER);
  428. END;
  429.  
  430.  
  431. END; {OF PROCEDURE}
  432.  
  433.  
  434. {*****************  CREATING THE FIRST RECORD OF FILE *******}
  435.  
  436. PROCEDURE CREATE_FIRST_RECORD (ACTNO: TR);
  437. BEGIN
  438. IF (NEWFILE = TRUE) AND (CONTINUE = TRUE) THEN REWRITE(FILENAM,FIN);
  439.  
  440. WITH INFORMATION  DO
  441. BEGIN
  442. NAME:='                              ';
  443. STREET_NUMBER:='      ';
  444. STREET:='                    ';
  445. CITY:='                  ';
  446. STATE:='          ';
  447. ZIP:='          ';
  448. ATTENTION:='FIRST RECORD OF FILE          ';
  449. IF (NEWFILE = TRUE) AND (CONTINUE = TRUE) THEN ACCT_NUMBER:='0001';
  450. IF (NEWFILE = TRUE) AND (CONTINUE = FALSE) THEN ACCT_NUMBER:=ACTNO;
  451. IF NEWFILE =  FALSE THEN ACCT_NUMBER:= ACTNO;
  452. WRITE(FIN:1,INFORMATION);
  453. END; {WITH LOOP}
  454. END; {OF PROCEDURE}
  455.  
  456.  
  457. {**************   ENTER THE  NAME OF THE  FILE *****************}
  458.  
  459. PROCEDURE ENTER_FILE_NAME;
  460.  
  461. VAR
  462. ERROR:BOOLEAN;
  463.  
  464. BEGIN
  465. REPEAT
  466. NEWFILE:=FALSE;
  467. ERROR:=FALSE;
  468. CLEAR_SCREEN;
  469. WRITELN(' ENTER THE FILE  NAME AS: DRIVE: NAME. EXTENSION');
  470. WRITELN;
  471. WRITELN(' WHERE  DRIVE IS  A SINGLE LETTER--EITHER A  OR  B');
  472. WRITELN('        NAME  IS UP TO  8 LETTERS OR SPACES');
  473. WRITELN('        EXTENSION MUST HAVE 3 LETTERS  OR  SPACES');
  474. WRITELN;
  475.  
  476. READLN(FILENAM);
  477. RESET(FILENAM,FIN);
  478.  
  479.  
  480. IF EOF(FIN) THEN
  481. BEGIN
  482. REPEAT
  483. MOVE_CURSOR(1,10);
  484. WRITE('FILE NOT FOUND.  IS THIS A NEW FILE? Y/N');
  485. READ  (ANSWER);
  486. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  487. IF ANSWER = 'N' THEN ERROR:=TRUE;
  488. IF ANSWER = 'Y' THEN NEWFILE:=TRUE ELSE NEWFILE:=FALSE;
  489. IF NEWFILE = TRUE THEN CREATE_FIRST_RECORD('0001');
  490. END; {OF IF EOF}
  491.  
  492.  
  493. UNTIL ERROR = FALSE;
  494.  
  495.  
  496. IF NEWFILE = TRUE THEN COUNTER:= 2;
  497.  
  498. IF NEWFILE = FALSE THEN
  499. BEGIN
  500. NUMBER_RECORDS(FILENAM);
  501. COUNTER:=NUMBER_OF_RECORDS + 1;
  502. END;
  503.  
  504. END; {OF PROCEDURE}
  505.  
  506. {*********** PROCEDURE TO CORRECT INCORRECT ENTRY ************}
  507.  
  508. PROCEDURE MISTAKE;
  509. VAR
  510. WRONG:CHAR;
  511.  
  512. BEGIN
  513. WITH INFORMATION DO
  514. BEGIN
  515. ERASE_LINES(12,9);
  516. PROMPT(1,12,0,'ENTER NUMBER OF INCORRECT INFORMATION',FALSE);
  517. PROMPT(1,14,0,'1-NAME ',FALSE);
  518. PROMPT(1,15,0,'2-# ',FALSE);
  519. PROMPT(1,16,0,'3-STREET ',FALSE);
  520. PROMPT(1,17,0,'4-CITY ',FALSE);
  521. PROMPT(1,18,0,'5-STATE ',FALSE);
  522. PROMPT(1,19,0,'6-ZIP ',FALSE);
  523. PROMPT(1,20,0,'7-ATTENTION ',FALSE);
  524. PROMPT(1,21,0,'8-ALL INFORMATION IS CORRECT AS DISPLAYED ',FALSE);
  525.  
  526. REPEAT
  527. MOVE_CURSOR(50,16);
  528. READ(WRONG);
  529.  
  530. CASE WRONG OF 
  531.     '1':BEGIN
  532.         PROMPT(1,3,30,'NAME',FALSE);
  533.         NA:=INPUT_DATA(6,3,30,TRUE,0,0);
  534.         FOR I:= 1 TO 30 DO NAME[I]:=NA[I];
  535.         END;
  536.  
  537.     '2': BEGIN
  538.         PROMPT(1,5,6,'#: ',FALSE);
  539.         ST_NO:=INPUT_DATA(4,5,6,TRUE,0,0);
  540.         FOR I:= 1 TO 6 DO STREET_NUMBER[I]:=ST_NO[I];
  541.         END;
  542.  
  543.     '3': BEGIN
  544.         PROMPT(10,5,20,'STREET:',FALSE);
  545.         ST:=INPUT_DATA(19,5,20,TRUE,0,0);
  546.         FOR I:= 1 TO 20 DO STREET[I]:=ST[I];
  547.         END;
  548.  
  549.     '4': BEGIN
  550.         PROMPT(1,7,10,'CITY: ',FALSE);
  551.         CIT:=INPUT_DATA(7,7,18,TRUE,0,0);
  552.  
  553.         IF (CIT[1] <> '7') AND (CIT[1] <> '8') THEN
  554.         FOR I:= 1 TO 18 DO CITY[I]:=CIT[I];
  555.  
  556. IF CIT[1] = '7' THEN    {DEFAULT TO FIRST VALUE, E.G. RICHMOND,VA.}
  557.     BEGIN
  558.     CITY:=CITY_ONE;
  559.     STATE:=STATE_ONE;
  560.     PROMPT(7,7,0,CITY_ONE,FALSE);
  561.     PROMPT(35,7,0,STATE_ONE,FALSE);
  562.     END;
  563.  
  564. IF CIT[1] = '8' THEN        {DEFAULT TO SECOND VALUE}
  565.     BEGIN
  566.     CITY:=CITY_TWO;
  567.     STATE:=STATE_TWO;
  568.     PROMPT(7,7,0,CITY_TWO,FALSE);
  569.     PROMPT(35,7,0,STATE_TWO,FALSE);
  570.     END;
  571.         END;
  572.  
  573.     '5': BEGIN
  574.         PROMPT(28,7,10,'STATE: ',FALSE);
  575.         STA:=INPUT_DATA(35,7,10,TRUE,0,0);
  576.         FOR I:= 1 TO 10 DO STATE[I]:=STA[I];
  577.         END;
  578.  
  579.     '6': BEGIN
  580.         PROMPT(48,7,10,'ZIP: ',FALSE);
  581.         ZI:= INPUT_DATA(54,7,10,TRUE,0,0);
  582.         FOR I:= 1 TO 10 DO ZIP[I]:=ZI[I];
  583.         END;
  584.  
  585.     '7': BEGIN
  586.         PROMPT(1,9,30,'ATTENTION: ',FALSE);
  587.         ATT:=INPUT_DATA(12,9,30,TRUE,0,0);
  588.         FOR I:= 1 TO 30 DO ATTENTION[I]:=ATT[I];
  589.         END;
  590.  
  591.     END; {OF CASE}
  592.  
  593. UNTIL WRONG = '8';
  594. END; {OF WITH INFORMATION}
  595. ERASE_LINES(10,12);
  596. END; {OF PROCEDURE}
  597.  
  598. {*****************  OFFER A LISTING OF THE FILE  **************}
  599.  
  600. PROCEDURE OFFER_LISTING(FILENAM:$STRING14);
  601.  
  602. BEGIN
  603. REPEAT
  604. ERASE_LINES(20,1);
  605. PROMPT(1,20,1,'DO YOU WANT A LISTING OF THE FILE? Y/N ',FALSE);
  606. MOVE_CURSOR(50,20);
  607. READ(ANSWER);
  608. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  609.  
  610. IF ANSWER = 'Y' THEN PRINT_FILE(FILENAM);
  611.  
  612. END; {OF PROCEDURE}
  613.  
  614.  
  615. {******* PROC TO GET INFORMATION & PUT INFORMATION INTO FILE ******}
  616.  
  617. PROCEDURE ENTER_INFORMATION;
  618.  
  619.  
  620. BEGIN
  621. WITH INFORMATION DO
  622. BEGIN
  623.  
  624. CLEAR_SCREEN;
  625.     PROMPT(1,3,30,'NAME',FALSE);
  626.     PROMPT(1,5,6,'#: ',FALSE);
  627.     PROMPT(10,5,20,'STREET: ',FALSE);
  628.     PROMPT(1,7,18,'CITY: ',FALSE);
  629.     PROMPT(28,7,10,'STATE: ',FALSE);
  630.     PROMPT(48,7,10,'ZIP: ',FALSE);
  631.     PROMPT(1,9,30,'ATTENTION: ',FALSE);
  632.  
  633. MOVE_CURSOR(1,22);
  634. WRITE('ENTERING  EXIT  FOR THE NAME TERMINATES THIS PROCEDURE');
  635. MOVE_CURSOR(1,23);
  636. WRITE('DEFAULT VALUES FOR CITY AND STATE ARE:');
  637. MOVE_CURSOR(40,23);
  638. WRITE('7 = RICHMOND,VA.       8 = BOSTON,MASS.');
  639.     
  640.     NA:=INPUT_DATA(6,3,30,TRUE,0,0);
  641. FOR I:= 1 TO 30 DO NAME[I]:=NA[I];
  642.  
  643.     IF NAME <> 'EXIT                          ' THEN 
  644.     BEGIN
  645.     
  646.     ST_NO:=INPUT_DATA(4,5,6,TRUE,0,0);    
  647.     ST:=INPUT_DATA(19,5,20,TRUE,0,0);
  648.     CIT:=INPUT_DATA(7,7,18,TRUE,0,0);
  649.  
  650.     IF (CIT[1] <> '7') AND (CIT[1] <> '8') THEN
  651.     STA:=INPUT_DATA(35,7,10,TRUE,0,0);
  652.  
  653. IF CIT[1] = '7' THEN  {DEFAULT TO VALUE ONE, E.G. RICHMOND,VA.}
  654.     BEGIN
  655.     CITY:=CITY_ONE;
  656.     STATE:=STATE_ONE;
  657.     PROMPT(7,7,0,CITY_ONE,FALSE);
  658.     PROMPT(35,7,0,STATE_ONE,FALSE);
  659.     END;
  660.  
  661. IF CIT[1] = '8' THEN  {DEFAULT TO VALUE TWO}
  662.     BEGIN
  663.     CITY:=CITY_TWO;
  664.     STATE:=STATE_TWO;
  665.     PROMPT(7,7,0,CITY_TWO,FALSE);
  666.     PROMPT(35,7,0,STATE_TWO,FALSE);
  667.     END;
  668.  
  669.  
  670.     ZI:=INPUT_DATA(54,7,10,TRUE,0,0);
  671.     ATT:=INPUT_DATA(12,9,30,TRUE,0,0);
  672.  
  673. FOR I:= 1 TO 30 DO NAME[I]:=NA[I];
  674. FOR I:= 1 TO 6  DO STREET_NUMBER[I]:=ST_NO[I];
  675. FOR I:= 1 TO 20 DO STREET[I]:=ST[I];
  676.  
  677. IF (CIT[1] <> '7') AND (CIT[1] <> '8') THEN
  678. BEGIN
  679. FOR I:= 1 TO 18 DO CITY[I]:=CIT[I];
  680. FOR I:= 1 TO 10 DO STATE[I]:=STA[I];
  681. END;
  682.  
  683. FOR I:= 1 TO 10 DO ZIP[I]:=ZI[I];
  684. FOR I:= 1 TO 30 DO ATTENTION[I]:=ATT[I];
  685. CALC_ACCT_NO(COUNTER);
  686.  
  687.  
  688.  
  689. REPEAT
  690. PROMPT(1,20,1,'IS INFORMATION CORRECT AS ENTERED? Y/N',FALSE);
  691. MOVE_CURSOR(50,20);
  692. READ(ANSWER);
  693. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  694. IF ANSWER = 'N' THEN MISTAKE;
  695. END;{OF IF NOT EQUAL TO 'EXIT'}
  696.  
  697.  
  698. IF NAME <> 'EXIT                          ' THEN
  699. BEGIN
  700. WRITE(FIN:COUNTER,INFORMATION);
  701. COUNTER:=COUNTER+1;
  702. END; {OF IF NAME NOT EQUAL TO 'EXIT'}
  703. END; {OF WITH}
  704. END; {OF PROCEDURE}
  705.  
  706.  
  707. {************************* MENU ******************************}
  708.  
  709. PROCEDURE MENU;
  710. VAR
  711. ANSWER:INTEGER;
  712.  
  713. BEGIN
  714. CLEAR_SCREEN;
  715.  
  716. CHANGE_RECORD:=FALSE;
  717. DELETE_RECORD:=FALSE;
  718. FIND_RECORD:=FALSE;
  719. ADD_TO_FILE:=FALSE;
  720. LISTING:=FALSE;
  721.  
  722. MOVE_CURSOR(12,2);
  723. WRITELN('  SELECT ONE PROCEDURE, AND ENTER CORRESPONDING NUMBER');
  724. WRITELN;
  725. WRITELN('1- CREATE A NEW, OR ADD TO AN EXISTING, NAME & ADDRESS FILE');
  726. WRITELN('2- CHANGE OR CORRECT A RECORD IN AN EXISTING NAME & ADDRESS FILE');
  727. WRITELN('3- DELETE A RECORD FROM AN EXISTING NAME & ADDRESS FILE');
  728. WRITELN('4- DETERMINE IF A PARTICULAR NAME ALREADY EXISTS IN THE FILE');
  729. WRITELN('5- LIST THE NAME & ADDRESS FILE ON EITHER THE CRT OR PRINTER');
  730. WRITELN;
  731. WRITELN;
  732. REPEAT
  733. WRITE('YOUR SELECTION, PLEASE: ');
  734. READ(ANSWER);
  735. UNTIL (ANSWER < 6) AND (ANSWER > 0);
  736.  
  737. CASE ANSWER OF
  738.     
  739.     1: ADD_TO_FILE:= TRUE;
  740.     2: CHANGE_RECORD:=TRUE;
  741.     3: DELETE_RECORD:=TRUE;
  742.     4: FIND_RECORD:=TRUE;
  743.     5: LISTING:=TRUE;
  744. END; {OF CASE}
  745. CLEAR_SCREEN;
  746.  
  747. END; {OF PROCEDURE MENU}
  748.  
  749.  
  750.  
  751.  
  752. {******************* ADD TO A NEW OR EXISTING FILE **************}
  753.  
  754. PROCEDURE ADD(FILENAM:$STRING14);
  755.  
  756. BEGIN
  757.  
  758. WITH INFORMATION DO
  759. BEGIN
  760.  
  761. REPEAT
  762. ENTER_INFORMATION;
  763. UNTIL NAME = 'EXIT                          ';
  764.  
  765.  
  766. CONTINUE:=FALSE;
  767. CALC_ACCT_NO(COUNTER - 1);
  768. CREATE_FIRST_RECORD(ACCT_NUMBER);
  769.  
  770. END;        {OF WITH INFORMATION}
  771. END;         {OF PROCEDURE}
  772.  
  773.  
  774. {******************** FIND A NAME IN THE FILE *******************}
  775.  
  776. PROCEDURE FIND(FILENAM:$STRING14; FLAG:INTEGER);
  777.  
  778. VAR
  779. FINISHED:BOOLEAN;
  780. I,LINE_COUNTER:INTEGER;
  781. LOCALIZERS:ALPHABET;
  782. LINE_FLAG:BOOLEAN;
  783. FIRST_LETTER:INTEGER;
  784.  
  785.  
  786. BEGIN
  787. REPEAT
  788. FINISHED:=TRUE;
  789. REC_NUMBER:=1;
  790. FOUND:=FALSE;
  791. END_OF_FILE:=COUNTER -1;  {COUNTER WAS SET = NUMBER_OF_RECORDS + 1
  792.                IN THE ENTER_FILE_NAME PROCEDURE}
  793.  
  794. CLEAR_SCREEN;
  795. MOVE_CURSOR(2,2);
  796. IF FLAG = 1 THEN
  797. WRITELN('  PROCEDURE TO DETERMINE IF A NAME IS PRESENT IN FILE ', 
  798.        FILENAM)
  799. ELSE IF FLAG = 2 THEN
  800. WRITELN('  PROCEDURE TO FIND AND CHANGE A RECORD')
  801. ELSE IF FLAG = 3 THEN
  802. WRITELN('  PROCEDURE TO FIND AND DELETE A RECORD');
  803.  
  804. PROMPT(1,4,30,'ENTER THE NAME YOU WISH TO LOCATE',FALSE);
  805. DES_NAM:=INPUT_DATA(35,4,30,TRUE,0,0);
  806. FOR I:= 1 TO 30 DO DESIRED_NAME[I]:=DES_NAM[I];
  807.  
  808. CLEAR_SCREEN;
  809. PROMPT(2,12,0,'PROGRAM NOW SEARCHING FILE. ONE MOMENT PLEASE.',FALSE);
  810. RESET(FILENAM,FIN);
  811.  
  812. I:=1;
  813. WHILE FILENAM[I] <> '.' DO
  814. BEGIN
  815. ALPFILE[I]:=FILENAM[I];
  816. I:=I+1;
  817. END;
  818. ALPFILE[I]:='.';
  819. ALPFILE[I+1]:='A';
  820. ALPFILE[I+2]:='L';
  821. ALPFILE[I+3]:='P';
  822. IF (I+4) < 14 THEN 
  823. BEGIN
  824. I:=I+4;
  825. FOR N:= I TO 14 DO 
  826. ALPFILE[N]:=' ';
  827. END;
  828. RESET(ALPFILE,FALP);
  829.  
  830. WITH LOCALIZERS DO
  831. BEGIN
  832. FIRST_LETTER:=ORD(DESIRED_NAME[1]) - 64;
  833. READ(FALP:FIRST_LETTER,LOCALIZERS);
  834. WITH INFORMATION DO
  835. BEGIN
  836. I:=START;
  837. REPEAT
  838. READ(FIN:I,INFORMATION);
  839. IF DESIRED_NAME = NAME THEN
  840. BEGIN
  841. FOUND:=TRUE;
  842. REC_NUMBER:=I;
  843. ERASE_LINES(12,1);
  844. PROMPT(1,1,0,'INFORMATION AS FOUND IN FILE: ',FALSE);
  845. PROMPT(1,3,0,'NAME: ',FALSE);
  846. PROMPT(1,5,0,'#: ',FALSE);
  847. PROMPT(10,5,0,'STREET: ',FALSE);
  848. PROMPT(1,7,0,'CITY: ',FALSE);
  849. PROMPT(28,7,0,'STATE: ',FALSE);
  850. PROMPT(48,7,0,'ZIP: ',FALSE);
  851. PROMPT(1,9,0,'ATTENTION: ',FALSE);
  852. MOVE_CURSOR(6,3);
  853. WRITE(NAME);
  854. MOVE_CURSOR(4,5);
  855. WRITE(STREET_NUMBER);
  856. MOVE_CURSOR(19,5);
  857. WRITE(STREET);
  858. MOVE_CURSOR(7,7);
  859. WRITE(CITY);
  860. MOVE_CURSOR(35,7);
  861. WRITE(STATE);
  862. MOVE_CURSOR(54,7);
  863. WRITE(ZIP);
  864. MOVE_CURSOR(12,9);
  865. WRITE(ATTENTION);
  866. END;
  867.  
  868. I:=I+1;
  869.  
  870.  
  871. UNTIL (I > FINISH) OR (FOUND = TRUE);
  872.  
  873. IF FOUND = FALSE THEN
  874. BEGIN
  875. ERASE_LINES(12,1);
  876. PROMPT(2,12,0,'NAME AS ENTERED NOT FOUND IN FILE.',FALSE);
  877. REPEAT
  878. MOVE_CURSOR(2,14);
  879. WRITE('WOULD YOU LIKE A LIST OF NAMES BEGINNING WITH ',
  880.     DESIRED_NAME[1],' ? Y/N');
  881. READ(ANSWER);
  882. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  883. IF ANSWER = 'Y' THEN
  884.     BEGIN
  885.     CLEAR_SCREEN;
  886.     LINE_COUNTER:=1;
  887.     FOR I:=START TO FINISH DO
  888.     BEGIN
  889.     READ(FIN:I,INFORMATION);
  890.     IF LINE_COUNTER < 15 THEN
  891.     BEGIN
  892.     MOVE_CURSOR(2,LINE_COUNTER);
  893.     WRITE(NAME);
  894.     END;
  895.     
  896.     IF (LINE_COUNTER >=15) AND (LINE_COUNTER < 30) THEN
  897.     BEGIN
  898.     MOVE_CURSOR(45,LINE_COUNTER-14);
  899.     WRITE(NAME);
  900.     END;
  901.     
  902.     IF LINE_COUNTER >= 30 THEN
  903.     BEGIN
  904.     PROMPT(2,23,0,'ENTER A CARRIAGE RETURN TO CONTINUE ',FALSE);
  905.     READ(ANSWER);
  906.     CLEAR_SCREEN;
  907.     LINE_COUNTER:=0;
  908.     END;
  909.  
  910.     LINE_COUNTER:=LINE_COUNTER + 1;
  911.     END; {FOR I  = START TO FINISH OF LISTING}
  912. END; {OF IF ANSWER = Y}
  913. ERASE_LINES(22,2);
  914. PROMPT(2,23,0,'ENTER A CARRIAGE RETURN TO CONTINUE',FALSE);
  915. READ(ANSWER);
  916. CLEAR_SCREEN;
  917. END; {OF FOUND = FALSE}
  918.  
  919.  
  920. END;  {OF WITH INFORMATION}
  921. END; {OF LOCALIZERS}
  922.  
  923. IF FLAG = 1 THEN
  924. BEGIN
  925. ERASE_LINES(22,1);
  926. REPEAT
  927. MOVE_CURSOR(1,22);
  928. WRITE('DO YOU WISH TO FIND ANOTHER RECORD IN FILE ',FILENAM,' Y/N?');
  929. READ(ANSWER);
  930. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  931. IF ANSWER = 'Y' THEN FINISHED:=FALSE ELSE FINISHED:=TRUE;
  932. END; {OF IF FLAG = 1}
  933.  
  934. UNTIL FINISHED = TRUE;
  935. END;  {OF PROCEDURE}
  936.  
  937. {******************** DELETE A RECORD **************************}
  938.  
  939. PROCEDURE DELETE(FILENAM:$STRING14);
  940. VAR
  941. FINISH:BOOLEAN;
  942.  
  943. BEGIN
  944. REPEAT
  945. WITH INFORMATION DO
  946. BEGIN
  947. FIND(FILENAM,3);
  948. IF FOUND = TRUE THEN
  949.     BEGIN
  950.     RESET(FILENAM,FIN);
  951.     REPEAT
  952.     MOVE_CURSOR(1,22);
  953.     WRITE('IS IT OK TO DELETE THIS RECORD? Y/N');
  954.     READ(ANSWER);
  955.     UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  956.     
  957.     IF ANSWER = 'Y' THEN
  958.     BEGIN
  959.     ERASE_LINES(22,1);
  960.     MOVE_CURSOR(1,22);
  961.     WRITE('RECORD HAS BEEN DELETED.');
  962. NAME:='ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ';
  963. STREET_NUMBER:='      ';
  964. STREET:='                    ';
  965. CITY:='                  ';
  966. STATE:='          ';
  967. ZIP:='          ';
  968. ATTENTION:='                              ';
  969. ACCT_NUMBER:='    ';
  970. WRITE(FIN:REC_NUMBER,INFORMATION);
  971.         END; {OF ANSWER = Y}
  972.     END; {OF FOUND = TRUE}
  973.  
  974. IF FOUND = FALSE THEN
  975. WRITELN('NO DELETION OCCURRED.');
  976.  
  977.  
  978. END;    {OF WITH INFORMATION}
  979. ERASE_LINES(22,1);
  980. REPEAT
  981. MOVE_CURSOR(1,22);
  982. WRITE('DO YOU WISH TO DELETE ANOTHER RECORD FROM FILE ',FILENAM,' Y/N');
  983. READ(ANSWER)
  984. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  985. IF ANSWER = 'Y' THEN FINISH:= FALSE ELSE FINISH:=TRUE;
  986.  
  987. UNTIL FINISH = TRUE;
  988.  
  989.  
  990. END; {OF PROCEDURE}
  991.  
  992.  
  993. {****************** PROCEDURE TO CHANGE A RECORD IN FILE ***********}
  994.  
  995. PROCEDURE CHANGE(FILENAM:$STRING14);
  996. VAR
  997. FINISH:BOOLEAN;
  998.  
  999. BEGIN
  1000. REPEAT
  1001. WITH INFORMATION DO
  1002. BEGIN
  1003. FIND(FILENAM,2);
  1004. IF FOUND = TRUE THEN
  1005. BEGIN
  1006. RESET(FILENAM,FIN);
  1007. MISTAKE;
  1008. WRITE(FIN:REC_NUMBER,INFORMATION);
  1009. MOVE_CURSOR(1,23);
  1010. WRITELN('RECORD HAS BEEN MODIFIED AS DESIRED');
  1011. END; {OF WITH INFORMATION}
  1012. END; {OF IF FOUND = TRUE}
  1013.  
  1014. REPEAT
  1015. ERASE_LINES(22,1);
  1016. MOVE_CURSOR(1,22);
  1017. WRITE('DO YOU WISH TO CHANGE ANOTHER RECORD IN FILE ',FILENAM,' Y/N?');
  1018. READ(ANSWER);
  1019. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  1020. IF ANSWER = 'Y' THEN FINISH:=FALSE ELSE FINISH:=TRUE;
  1021.  
  1022. UNTIL FINISH = TRUE;
  1023.  
  1024. END; {OF PROCEDURE}
  1025.  
  1026.  
  1027. {*************** OFFER A CHANCE TO GO BACK TO MENU *************}
  1028.  
  1029. PROCEDURE AGAIN;
  1030. BEGIN
  1031. CLEAR_SCREEN;
  1032. REPEAT
  1033. PROMPT(2,10,0,'WOULD YOU LIKE TO CHOOSE FROM THE MENU, AGAIN? Y/N ',FALSE);
  1034. PROMPT(2,12,0,'ENTERING AN  N  WILL TERMINATE THE PROGRAM.',FALSE);
  1035. MOVE_CURSOR(54,10);
  1036. READ(ANSWER);
  1037. UNTIL (ANSWER = 'Y') OR (ANSWER = 'N');
  1038. IF ANSWER = 'Y' THEN FINISH:= FALSE ELSE FINISH:=TRUE;
  1039. END; {OF PROCEDURE}
  1040.  
  1041.  
  1042. {****************  MAIN PROGRAM BEGINS HERE   ******************}
  1043.  
  1044. BEGIN
  1045. FINISH:=FALSE;
  1046. REPEAT
  1047. MENU;
  1048.  
  1049. CONTINUE:=TRUE;
  1050. ENTER_FILE_NAME;
  1051.  
  1052. IF CHANGE_RECORD = TRUE THEN CHANGE(FILENAM);
  1053. IF DELETE_RECORD = TRUE THEN DELETE(FILENAM);
  1054. IF FIND_RECORD = TRUE THEN FIND(FILENAM,1);
  1055. IF ADD_TO_FILE = TRUE THEN ADD(FILENAM);
  1056. IF LISTING = TRUE THEN OFFER_LISTING(FILENAM);
  1057.  
  1058. IF (ADD_TO_FILE = TRUE) OR  (DELETE_RECORD = TRUE) THEN
  1059. BEGIN
  1060. CLEAR_SCREEN;
  1061. PROMPT(2,10,0,'WHEN THE CP/M PROMPT  A> APPEARS, TYPE:',FALSE);
  1062. PROMPT(16,12,0,'ALPHABET',FALSE);
  1063. PROMPT(2,14,0,'THIS WILL RUN THE PROGRAM TO ALPHABETIZE THE FILE',FALSE);
  1064. PROMPT(2,15,0,'AND ESTABLISH THE FILE OF POINTERS.  THANK YOU.',FALSE);
  1065. FINISH:= TRUE;
  1066.  
  1067. END;
  1068.  
  1069.  
  1070. IF (ADD_TO_FILE = FALSE) AND (DELETE_RECORD = FALSE) THEN AGAIN;
  1071. UNTIL FINISH = TRUE;
  1072.  
  1073. END.
  1074.  
  1075.