home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol064 / locaccts.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-10  |  3.9 KB  |  209 lines
  1. PROGRAM ACCTPOI;
  2. TYPE
  3.     MAILING = RECORD
  4.         NAD:ARRAY[1..124] OF CHAR;
  5.         ACCT_NUMBER:ARRAY[1..4] OF CHAR;
  6.         END;
  7.  
  8.     XXPOINTERS = RECORD
  9.         START:INTEGER;
  10.         FINISH:INTEGER;
  11.         END;
  12.  
  13.     ENTRY = RECORD
  14.         ACCT_NO:INTEGER;
  15.         DATE:ARRAY[1..6] OF CHAR;
  16.                 INVOICE_NUMBER:ARRAY[1..10] OF CHAR;
  17.                 PURCHASE_ORDER_NUMBER:ARRAY[1..10] OF CHAR;
  18.         AMOUNT:REAL;
  19.         END;
  20.  
  21. FO = FILE OF XXPOINTERS;
  22. FN = FILE OF ENTRY;
  23. FI  = FILE OF MAILING;
  24.  
  25. $STRING14 = STRING 14;
  26. XR = ARRAY[1..3] OF CHAR;
  27. $STRING0 = STRING 0;
  28. $STRING255 = STRING 255;
  29. $STRING80 = STRING 80;
  30.  
  31.  
  32. VAR
  33. FNAD:FI;
  34. FIN:FN;  
  35. FOUT:FO;
  36.  
  37. NAME:MAILING;
  38. POINTERS:XXPOINTERS;
  39. INFORMATION:ENTRY;
  40.  
  41. N,I,NUMBER,COUNTER,RECORD_NUMBER,NUMBER_OF_RECORDS,NUMBER_ACCOUNTS:INTEGER;
  42. LAST_RECORD_NUMBER:INTEGER;
  43.  
  44. FILENAM,LOCFILE,INVFILE:$STRING14;
  45. {$C-}
  46. {$M-}
  47. {$F-}
  48.  
  49. PROCEDURE SETLENGTH(VAR X:$STRING0;Y:INTEGER);EXTERNAL;
  50. FUNCTION LENGTH(X:$STRING255):INTEGER;EXTERNAL;
  51.  
  52. PROCEDURE CLEAR_SCREEN;
  53. BEGIN
  54. WRITE(CHR(27),'*',CHR(0),CHR(0),CHR(0),CHR(0));
  55. END;
  56.  
  57.  
  58. PROCEDURE ENTER_FILE_NAME;èVAR
  59. ERROR:BOOLEAN;
  60.  
  61. BEGIN
  62. REPEAT
  63. ERROR:=FALSE;
  64. CLEAR_SCREEN;
  65. WRITELN;
  66. WRITE('ENTER THE NAME AND ADDRESS FILE AS: DRIVE:NAME.EXTENSION  ');
  67. READ(FILENAM);
  68. RESET(FILENAM,FNAD);
  69.  
  70. IF EOF(FNAD) THEN
  71. BEGIN
  72. WRITELN;
  73. WRITELN('FILE NOT FOUND. PLEASE RE-ENTER');
  74. ERROR:=TRUE;
  75. END;
  76.  
  77. UNTIL ERROR = FALSE;
  78. END; {OF PROCEDURE}
  79.  
  80. PROCEDURE NO_ACCOUNTS (FNAME:$STRING14);
  81. BEGIN
  82. RESET(FNAME,FNAD);
  83. WITH NAME DO
  84. BEGIN
  85. READ(FNAD:1,NAME);
  86. NUMBER_ACCOUNTS:=(((ORD(ACCT_NUMBER[1])-48)*1000)+
  87.                   ((ORD(ACCT_NUMBER[2])-48)*100)+
  88.                   ((ORD(ACCT_NUMBER[3])-48)*10)+
  89.                   (ORD(ACCT_NUMBER[4])-48));
  90.  
  91. WRITELN('NUMBER OF ACCOUNTS IN NAD FILE ',NUMBER_ACCTS);
  92.  
  93. END;
  94.  
  95. END; {OF PROCEDURE}
  96.  
  97.  
  98.  
  99. {************ PROCEDURE TO DETERMINE NUMBER OF RECORDS****}
  100.  
  101. PROCEDURE NUMBER_RECORDS (FNAM:$STRING14);
  102. BEGIN
  103. RESET(FNAM,FIN);
  104. WITH INFORMATION DO
  105. BEGIN
  106.  
  107. READ(FIN:1,INFORMATION);
  108. NUMBER_OF_RECORDS:=(((ORD(PURCHASE_ORDER_NUMBER[1])-48)*1000)+
  109.     ((ORD(PURCHASE_ORDER_NUMBER[2])-48)*100)+
  110.     ((ORD(PURCHASE_ORDER_NUMBER[3])-48)*10)+
  111.     (ORD(PURCHASE_ORDER_NUMBER[4])-48));
  112. END; {OF WITH}
  113. WRITELN(' NUMBER OF RECORDS IN THE ACCOUNT FILE ',FNAM,' : ',
  114.         NUMBER_OF_RECORDS); 
  115. END; {OF PROCEDURE}
  116. è
  117.  
  118. FUNCTION MAKE_FILE_NAMES(XFILNAME:$STRING14;EXT:XR):$STRING14;
  119. VAR
  120. FILENAME:$STRING14;
  121. L:INTEGER;
  122.  
  123.  
  124. BEGIN
  125. I:=1;
  126. SETLENGTH(FILENAME,0);
  127. WHILE XFILNAME[I] <> '.' DO
  128.     BEGIN
  129.     APPEND(FILENAME,XFILNAME[I]);
  130.     I:=I+1;
  131.     END;
  132.  
  133. APPEND(FILENAME,'.');
  134. FOR N:=1 TO 3 DO
  135. BEGIN
  136. APPEND(FILENAME,EXT[N]);
  137. END;
  138.  
  139. IF (I+4) < 14 THEN
  140. BEGIN
  141. I:=I+4;
  142. WHILE I < 15 DO
  143. BEGIN
  144. APPEND(FILENAME,' ');
  145. I:=I+1;
  146. END;
  147. END;
  148. WRITELN('FILENAME IS ',FILENAME);
  149. MAKE_FILE_NAMES:=FILENAME;
  150.  
  151. END; {OF FUNCTION}
  152.  
  153.  
  154. PROCEDURE XPOINTERS (FNAME:$STRING14);
  155. VAR
  156. I:INTEGER;
  157. MATCH:BOOLEAN;
  158.  
  159. BEGIN
  160. LAST_RECORD_NUMBER:=2;
  161. RECORD_NUMBER:=2;
  162. NUMBER:=2;
  163. REWRITE(LOCFILE,FOUT);
  164. RESET(FNAME,FIN);
  165.  
  166. REPEAT
  167. WITH INFORMATION DO
  168. BEGIN
  169.  
  170. REPEAT
  171. READ(FIN:RECORD_NUMBER,INFORMATION);
  172. IF ACCT_NO = NUMBER THEN
  173.     BEGIN
  174.     MATCH:=TRUE;
  175.     RECORD_NUMBER:=RECORD_NUMBER+1;
  176.     END;
  177.     
  178. IF ACCT_NO <> NUMBER THEN MATCH:=FALSE;
  179. UNTIL (MATCH = FALSE) OR (RECORD_NUMBER > NUMBER_OF_RECORDS);
  180.  
  181. END; {OF INFORMATION}
  182.  
  183. WITH POINTERS DO
  184. BEGIN
  185. START:=LAST_RECORD_NUMBER;
  186. FINISH:=RECORD_NUMBER;
  187. IF FINISH < START THEN FINISH:=START;
  188. COUNTER:=NUMBER;
  189. WRITE(FOUT:COUNTER,POINTERS);
  190. LAST_RECORD_NUMBER:=RECORD_NUMBER;
  191. WRITELN('ACCOUNT # ',NUMBER:4,' START= ',START:3,'  FINISH= ',
  192.         FINISH:3,'  # RECS WITH THIS ACCT # ',(FINISH-START):3);
  193. END;
  194.  
  195. NUMBER:=NUMBER+1;
  196.  
  197. UNTIL NUMBER > NUMBER_ACCOUNTS
  198.  
  199. END; {OF PROCEDURE}
  200.  
  201.  
  202. BEGIN    {OF MAIN}
  203. ENTER_FILE_NAME;
  204. NO_ACCOUNTS(FILENAM);
  205. LOCFILE:=MAKE_FILE_NAMES(FILENAM,'LOC');
  206. INVFILE:=MAKE_FILE_NAMES(FILENAM,'INV');
  207. NUMBER_RECORDS(INVFILE);
  208. XPOINTERS(INVFILE);
  209. END.