home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / STARTER1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  8.3 KB  |  224 lines
  1. {================================================================}
  2. {                  INITIALIZE FILER FILE                         }
  3. {================================================================}
  4. PROCEDURE INITIALIZE;
  5.  
  6. BEGIN
  7. {STARTSTART:}
  8.   REPEAT
  9.     CLRSCR;
  10.     GOTOXY(1,22);
  11.     WRITE('START A LA PASCAL');    { ENTER YOUR REPORT NAME HERE }
  12.     GOTOXY(1,23);
  13.     WRITE('ENTER SOURCE FILE NAME : ');
  14.     READLN(SOURCENAME);
  15.     X := POS('.',SOURCENAME);
  16.     IF X <> 0 THEN SOURCENAME := COPY(SOURCENAME,1,X-1);
  17.     SOURCENAME := SOURCENAME + '.DAT';
  18.     FILEEXISTS := EXIST(SOURCENAME);
  19.   UNTIL FILEEXISTS = TRUE;
  20.   WRITE('ENTER CURRENT DATE (MM/DD/YY) : ');
  21.   READLN( CURRDATE );
  22.   IF LENGTH(CURRDATE) = 0 THEN CURRDATE := '  /  /  ';
  23.   ASSIGN( SOURCE, SOURCENAME );
  24.   RESET( SOURCE );
  25.   SEEK(SOURCE,1);
  26.   BLOCKREAD( SOURCE,GETDATA,1 );
  27.   BLOCKREAD( SOURCE,LBL,3 );
  28.   FILENAME := 'XXXXXX';
  29.   FOR X := 1 TO 6 DO
  30.     FILENAME[X] := GETDATA[X];
  31.   MAXNBRREC := CHTOIN(GETDATA,7,4);
  32.   NBRRECUSED := CHTOIN(GETDATA,11,4);
  33.   RCDLEN := CHTOIN(GETDATA,15,3);
  34.   BLOCKINGFACTOR := CHTOIN(GETDATA,18,2);
  35.   FIELDPERRECORD := CHTOIN(GETDATA,20,2);
  36.   FILEDATE := '  /  /  ';
  37.   MOVE(GETDATA[22],FILEDATE[1],8);
  38.  
  39. {================================================================}
  40. {  GET LABEL LENGTH, DATA LENGTH & DATA FORM INFO                }
  41. {================================================================}
  42.  
  43. LABELPOSN[1] := 1;
  44. DATAPOSN[1] := 1;
  45.  
  46. FOR X := 1 TO FIELDPERRECORD DO
  47.   BEGIN
  48.     LABELLENGTH[X] :=  BCDTOIN(GETDATA[32+X]);
  49.     DATALEN[X]     :=  BCDTOIN(GETDATA[64+X]);
  50.     DATAFORM[X]    :=  ORD(GETDATA[96+X])-48;
  51.     LABELPOSN[X+1] :=  LABELPOSN[X] + LABELLENGTH[X];
  52.     DATAPOSN[X+1]  :=  DATAPOSN[X] + DATALEN[X];
  53.   END;
  54.  
  55. {================================================================}
  56. {           TRANSLATE REPORT STRUCTURE                           }
  57. {================================================================}
  58.  
  59.   BLOCKREAD(SOURCE,GETDATA,1);  { SCREEN INFORMATION }
  60.       { ESTABLISH VALUE OF DATAFORM[Z] FOR ASCII INFORMATION }
  61.       IF GETDATA[1] = 'S' THEN ASCII := 9 ELSE ASCII := 15;
  62.   FOR X := 1 TO FIELDPERRECORD DO
  63.     BEGIN
  64.       W := X*4+1;
  65.       ROW[X]       := BCDTOIN(GETDATA[W]);
  66.       COLUMN[X] := BCDTOIN(GETDATA[W+1])*10+TRUNC(BCDTOIN(GETDATA[W+2])/10);
  67.       {FIELDNBR[X]  := BCDTOIN(GETDATA[W+3]);} { NOT IMPLEMENTED }
  68.     END;
  69. {================================================================}
  70. {          INITIALIZE VARIABLES FOR ENTRY INTO FILER             }
  71. {================================================================}
  72.   DATARECORD := NBRRECUSED;
  73.   CALCULATE;
  74.   DISKRECNOWINMEM := DISKRECORD -1; { ENSURE DISK READ FIRST TIME}
  75.   FILERECCHGD := FALSE;      { ENSURE NO WRITE BEFORE FIRST READ }
  76.   LASTRECUSED := 0;               { SET LAST RECORD USED TO ZERO }
  77.   NBRDISKRECUSED := DISKRECORD;     { ESTABLISH MAX DISK REC NBR }
  78.   RECADDEDTOFILE := FALSE; { FLAG TO INDICATE CHANGE IN FILE SIZE}
  79. END;  { INTIIALIZE PROCEDURE }
  80. {================================================================}
  81. {                      PROCEDURE NEWPAGE                         }
  82. {================================================================}
  83. PROCEDURE NEWPAGE;
  84. BEGIN
  85.   WRITE(LST,^L);      { FORMFEED COMMAND }
  86.   LINE := 1;
  87. END;
  88. {================================================================}
  89. {                 PROCEDURE PAGE TITLE                           }
  90. {================================================================}
  91. PROCEDURE PAGETITLE;
  92. BEGIN
  93.   WRITELN(LST,'                   SAMPLE REPORT TITLE               ');
  94.   WRITE(LST,CURRDATE,'                                            ');
  95.   WRITELN(LST,'       PAGE ',PAGE);
  96.   WRITELN(LST);
  97.   WRITELN(LST);
  98.   PAGE := PAGE +1;
  99.   LINE := LINE +4;      { FOUR LINES IN THIS REPORT TITLE }
  100. END;
  101. {================================================================}
  102. {                 PROCEDURE DATA HEADING                         }
  103. {================================================================}
  104. PROCEDURE DATAHEADING;
  105. BEGIN
  106.   WRITELN(LST,'      NAME                   COMPANY       ACCOUNT 1    ACCOUNT 2');
  107.   WRITELN(LST,'=================================================================');
  108.   WRITELN(LST);
  109.   LINE := LINE +3;         { THREE LINES IN THIS HEADING }
  110. END;
  111. {================================================================}
  112. {                 PROCEDURE PRINT SUB TOTALS                     }
  113. {================================================================}
  114. PROCEDURE PRINTSUBTOTALS;
  115. BEGIN
  116.   WRITELN(LST,'                                        ============   ==========');
  117.   WRITE(LST,'SUB TOTAL :                               ');
  118.   ANS := EDITNBR(SUBTOTAL[9],10,2,'$');   { SUB TOTAL FOR ACCOUNT 1 }
  119.   WRITE (LST,ANS);
  120.   ANS := EDITNBR(SUBTOTAL[10],13,1,' ');   { SUB TOTAL FOR ACCOUNT 2 }
  121.   WRITELN(LST,ANS);
  122.   WRITELN(LST);
  123.  
  124.   FOR X := 1 TO 31 DO                          { ZERO ALL SUBTOTALS }
  125.     SUBTOTAL[X] := 0;
  126.  
  127.   LINE := LINE + 3;         { THREE LINES PRINTED IN THIS SUB TOTAL }
  128.  
  129.   IF LINE > PAGEFULLLINECOUNT - 3 THEN
  130.     BEGIN
  131.       NEWPAGE;
  132.       PAGETITLE;
  133.     END;
  134. END;
  135. {================================================================}
  136. {                 PROCEDURE PRINT GRAND TOTALS                   }
  137. {================================================================}
  138. PROCEDURE PRINTGRANDTOTALS;
  139. BEGIN
  140.   WRITELN(LST,'                                        ============   ==========');
  141.   WRITE(LST,'GRAND TOTAL :                          ');
  142.   ANS := EDITNBR(GRANDTOTAL[9],13,2,'$');   { SUB TOTAL FOR ACCOUNT 1 }
  143.   WRITE (LST,ANS);
  144.   ANS := EDITNBR(GRANDTOTAL[10],13,1,' ');   { SUB TOTAL FOR ACCOUNT 2 }
  145.   WRITELN(LST,ANS);
  146. END;
  147.  
  148.  
  149.  
  150. {================================================================}
  151. {                  OUTPUT CODE GOES HERE                         }
  152. {================================================================}
  153. BEGIN
  154.  
  155.   INITIALIZE;                   { ID AND READ IN FILE PARAMETERS }
  156.  
  157.   PAGE := 1;                             { INITIALIZE FOR REPORT }
  158.   LINE := 1;
  159.   PAGEFULLLINECOUNT := 60;
  160.   DATARECORD := 1;                      { SET UP SUB TOTAL TEST }
  161.   MOVERECORDDATATOARRAY;
  162.   PREVCONTENTS := ASCIIFIELD[1];
  163.   FOR X := 1 TO 31 DO                { CLEAR SUB & GRAND TOTALS }
  164.     BEGIN
  165.       SUBTOTAL[X] := 0;
  166.       GRANDTOTAL[X] := 0;
  167.     END;
  168.  
  169.   PAGETITLE;                       {  PRINT TITLE ON TOP OF PAGE }
  170.  
  171.   DATAHEADING;                              { PRINT DATA HEADING }
  172.  
  173.  
  174.   {==============================================================}
  175.   {                 PROCESS BODY OF REPORT                       }
  176.   {==============================================================}
  177.  
  178.   FOR DATARECORD := 1 TO NBRRECUSED DO
  179.     BEGIN
  180.       MOVERECORDDATATOARRAY;
  181.       {========================================}
  182.       {   CHECK TO SEE IF SUB TOTAL IS REQD    }
  183.       {========================================}
  184.       IF ASCIIFIELD[1] <> PREVCONTENTS THEN
  185.         BEGIN
  186.           PREVCONTENTS := ASCIIFIELD[1];
  187.           PRINTSUBTOTALS;
  188.         END;
  189.       {========================================}
  190.       {       WRITE LINE OF DATA HERE          }
  191.       {========================================}
  192.       WRITE(LST,ASCIIFIELD[1],' ',ASCIIFIELD[2],' ');
  193.       ANS := EDITNBR(NUMFIELD[9],10,2,'$');   {  ACCOUNT REC }
  194.       WRITE(LST,ANS);
  195.       ANS := EDITNBR(NUMFIELD[10],13,1,' '); {  AMT PAST DUE }
  196.       WRITELN(LST,ANS);
  197.       {=======================================}
  198.       {   UPDATE SUB TOTALS & GRAND TOTALS    }
  199.       {=======================================}
  200.       FOR X := 1 TO 31 DO
  201.         BEGIN
  202.           SUBTOTAL[X] := SUBTOTAL[X] + NUMFIELD[X];
  203.           GRANDTOTAL[X] := GRANDTOTAL[X] + NUMFIELD[X];
  204.         END;
  205.       {=======================================}
  206.       {   INCREMENT LINE AND CHECK FOR EOP    }
  207.       {=======================================}
  208.       LINE := LINE + 1;
  209.       IF LINE > PAGEFULLLINECOUNT THEN
  210.         BEGIN
  211.           NEWPAGE;
  212.           PAGETITLE;
  213.           DATAHEADING;
  214.         END;
  215.     END;  { FOR DATARECORD := 1 TO  }
  216.  
  217.   PRINTSUBTOTALS;
  218.   PRINTGRANDTOTALS;
  219.  
  220. {================================================================}
  221. {                    END PROGRAM                                 }
  222. {================================================================}
  223. END.
  224.