Wednesday, May 2, 2012

Turbo Pascal 6 circa 1992

Found this old sample program written in Turbo Pascal 6. My recollection is that it would process a file received from a factory in Italy and print a report. Notice the first line of code  for declaring the amount of memory? Umm…those are BYTES in the first line, as in minimum of 8K, maximum of 384K

{$M 8192, 0, 384000}
{************************************************************
  Program:  ITALYSUM
  Purpose:  Print a list of styles with a summary by style
  Author :  John H. Watson III
  Compile:  Borland Turbo Pascal 6.0

  Changed:  11/09/92 John Watson
            Use extended syntax on WriteLn to format numeric
              output right-adjusted. (e.g. "PairsNum:5"
              instead of just "PairsNum").

  Changed:  11/15/92 John Watson
            Added style description to detail & summary print.
            Removed hardcoding of field lengths in ProcessData
              and replaced with constants.
            Replaced hardcoded page titles with constants.
            Change test of result of collection from "> 0"
              to "<> -1".  Zero is a valid location in the
              collection and IndexOf will return a -1 if the
              search doesn't find anything.
 ************************************************************}
PROGRAM ITALYSUM;

USES Dos, Printer, Objects, StdPrint;

CONST
  CopyrightText = 'Copyright (c) 1992 by John H. Watson III';
  DetailTitle  : String = 'Italy Data File Listing - Detail';
  SummaryTitle : String = 'Italy Data File Listing - Summary';

VAR
  CopyrightStr : String[40];

CONST
  MaxLines = 60;
  Pagesize = 66;

{********************************************************************
  Define Objects
 ********************************************************************}

TYPE
  pSummary = ^TSummary;
  TSummary = OBJECT(TObject)
    Pairs : Integer;
    Style : String[10];
    SDesc : String[30];
    CONSTRUCTOR Init(iPairs: Integer; iStyle: String; iSDesc: String);
    PROCEDURE Print;
    PROCEDURE Accumulate(iPairs: Integer);
  END;

  PStyleSummary = ^TStyleSummary;
  TStyleSummary = OBJECT(TSortedCollection)
    FUNCTION KeyOf(Item: Pointer): Pointer; VIRTUAL;
    FUNCTION Compare(Key1, Key2: Pointer): Integer; VIRTUAL;
  END;

{********************************************************************
  Global Variables
 ********************************************************************}

VAR
  ErrorCode   : Integer;
  F           : File;
  GrandTotal  : Longint;
  Path        : PathStr;
  SummaryList : pStyleSummary;  { define global instance }

VAR
  FTime       : Longint;        { file time }
  FDT         : DateTime;       { DOS' date/time record structure }

{********************************************************************
  TSummary Object Methods
 ********************************************************************}

CONSTRUCTOR TSummary.Init(iPairs: Integer; iStyle: String; iSDesc: String);
BEGIN
  TObject.Init;         { call ancestor's init first }
  Pairs := iPairs;
  Style := iStyle;
  SDesc := iSDesc;
END;

PROCEDURE TSummary.Accumulate(iPairs: Integer);
BEGIN
  Pairs := Pairs + iPairs;
END;

PROCEDURE TSummary.Print;
BEGIN
  WRITELN(LST,Pairs:5, ' ', Style, ' ', SDesc);
END;

{********************************************************************
  TStyleSummary Methods
 ********************************************************************}

    { Define the key field for the collection.  Since KeyOf expects
      a pointer and Style is a simple string we must use the "@"
      (address of) operator to generate the address (pointer).  If
      Style was a pString, this would not be necessary. }

FUNCTION TStyleSummary.KeyOf(Item: Pointer): Pointer;
BEGIN
  KeyOf := @pSummary(Item)^.Style;
END;

FUNCTION TStyleSummary.Compare(Key1, Key2: Pointer): Integer;
BEGIN
  IF pString(Key1)^ = pString(Key2)^ THEN
    Compare := 0
  ELSE IF pString(Key1)^ < pString(Key2)^ THEN
         Compare := -1
       ELSE
         Compare := +1;
END;

{********************************************************************
  Miscellaneous Procedures and Functions
 ********************************************************************}

FUNCTION OpenFile(VAR F:File; iName:PathStr): BOOLEAN;
BEGIN
    ASSIGN(F, iName);
    {$I-} RESET(F, 1); {$I+}
    OpenFile := IOResult = 0;
END {Open};

PROCEDURE Initialize;
VAR
  Dir  : DirStr;
  Name : NameStr;
  Extn : ExtStr;
BEGIN
  CopyrightStr := CopyrightText;
  IF ParamCount = 0
    THEN Path := 'ITALYDTA'
    ELSE Path := ParamStr(1);
  Path := FExpand(Path);  { expand into full path string }
  FSplit(Path, Dir, Name, Extn);  { split into components }
  IF (Name = '') OR NOT OpenFile(F, Path) THEN BEGIN
    WRITELN('ERROR:  File not found (', Name, ').');
    HALT(1);
    END;
  GetFTime(F, FTime);
  UnpackTime(FTime, FDT);
  GrandTotal := 0;
  LineCount := PageSize;
  SummaryList := New(pStyleSummary, Init(200, 50)); { create collection }
END {Initialize};

PROCEDURE Terminate;
BEGIN
  Close(F);
  Close(LST);
  Dispose(SummaryList, Done);
END;

PROCEDURE PrintHeading(iTitle: String);
BEGIN
  IF NOT FirstPrint THEN EjectPage;
  VerticalTab(1);
  WriteLn(LST, iTitle);
  VerticalTab(1);
  IF FirstPrint THEN BEGIN
     WriteLn(LST, 'File: ', Path);
     WriteLn(LST, 'Date: ',FDT.Month,'/',FDT.Day,'/',FDT.Year,
                '  Time: ',FDT.Hour,':',FDT.Min);
     VerticalTab(1);
     END;
  IF FirstPrint
     THEN LineCount := 6
     ELSE LineCount := LineCount + 3;
  FirstPrint := False;
END;

    { Use ForEach iterator to display Summary information }

PROCEDURE PrintSummary;
    PROCEDURE PrintSummaryObject(p : pSummary); FAR;
    BEGIN
      IF LineCount >= MaxLines THEN BEGIN
         PrintHeading(SummaryTitle);
         WriteLn(LST, 'Pairs Style      Description');
         WriteLn(LST, '----- ---------- -----------');
         VerticalTab(1);
         LineCount := LineCount + 3;
         END;
      p^.Print;   { Call object's print method }
      GrandTotal := GrandTotal + p^.Pairs;
      LineCount := LineCount + 1;
    END;
BEGIN
  LineCount := MaxLines; { force initial headings to print }
  SummaryList^.ForEach(@PrintSummaryObject);
  VerticalTab(1);
  WriteLn(LST, GrandTotal:5, ' Grand Total');
  EjectPage;
END;

  { This procedure will read enough bytes to fill a record buffer.
    Since the record length exceeds 255 bytes, we cannot use ReadLn to
    read a record.  To overcome this, the file is processed as an untyped
    file and BlockRead is used to fill the buffer. }

PROCEDURE ProcessData;
CONST
  PairsPos  : Integer = 578;  PairsLen : Integer = 5;
  OrdNoPos  : Integer = 2;    OrdNoLen : Integer = 9;
  RegNoPos  : Integer = 131;  RegNoLen : Integer = 6;
  SDescPos  : Integer = 588;  SDescLen : Integer = 30;
  StylePos  : Integer = 313;  StyleLen : Integer = 10;
VAR
  Buffer    : ARRAY[1..905] OF Char; { includes two extra bytes for CR/LF }
  BytesRead : Word;
  Location  : Integer;  { location in collection of existing summary object }
  NewObj, OldObj : pSummary;
  PairsNum  : Integer;
  PairsStr  : String[5];
  OrdNo     : String[9];
  RegNo     : String[6];
  Style     : String[10];
  SDesc     : String[30];

BEGIN
  BlockRead(F, Buffer, SizeOf(Buffer), BytesRead);
  WHILE (NOT EOF(F)) DO BEGIN

      { Extract individual fields from record buffer }
    Move(Buffer[StylePos], Style[1], StyleLen);
    Style[0] := Char(StyleLen);             { force the proper string size }
    Move(Buffer[SDescPos], SDesc[1], SDescLen);
    SDesc[0] := Char(SDescLen);
    Move(Buffer[OrdNoPos], OrdNo[1], OrdNoLen);
    OrdNo[0] := Char(OrdNoLen);
    Move(Buffer[RegNoPos], RegNo[1], RegNoLen);
    RegNo[0] := Char(RegNoLen);
    Move(Buffer[PairsPos], PairsStr[1], PairsLen);
    PairsStr[0] := Char(PairsLen);
    Val(PairsStr, PairsNum, ErrorCode);  { convert string to numeric }

      { Print detail line }
    IF LineCount >= MaxLines THEN BEGIN
       PrintHeading(DetailTitle);
       WriteLn(LST, 'Order No  Reg No Pairs Style      Description');
       WriteLn(LST, '--------- ------ ----- ---------- -----------');
       VerticalTab(1);
       LineCount := LineCount + 3;
       END;
    WRITELN(LST, OrdNo, ' ', RegNo, ' ', PairsNum:5, ' ', Style, ' ', SDesc);
    LineCount := LineCount + 1;

      { Now create a new instance of a summary object with these values }
    NewObj := New(pSummary, Init(PairsNum, Style, SDesc));

      { Search the collection to see if it already exists }
    Location := SummaryList^.IndexOf(NewObj);
    IF Location <> -1 THEN BEGIN    { If found, accumulate pairs }
       OldObj := SummaryList^.AT(Location); { get ptr to obj @ location }
       OldObj^.Accumulate(PairsNum); { call that obj's accumulate method }
       END
    ELSE SummaryList^.Insert(NewObj); { else add to collection }

    BlockRead(F, Buffer, SizeOf(Buffer), BytesRead);
    END;

END {ProcessData};

BEGIN
  Initialize;
  ProcessData;
  PrintSummary;
  Terminate;
END.

Printing 1099’s in Cobol, circa 1991

20 years ago, this is how we printed 1099’s…Many liked to call Cobol “wordy” but it was more accurate to say “self documenting”:

MOVE YTD-FED-GROSS-FINAL TO DATA-2 IN LINE-1.
WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 6.

“Look Mom, no need for comments”:

IDENTIFICATION DIVISION.

       PROGRAM-ID.  PRR1099.

      *    PRINT PAYROLL 1099 FORMS
      * 11/25/91  JOHN WATSON - CREATED.

           COPY HEADER OF CBLCPYSRC SUPPRESS.

       SPECIAL-NAMES.  LOCAL-DATA IS WS.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           COPY ADM1SL OF CBLCPYSRC SUPPRESS.

           SELECT EMPLFILE ASSIGN TO DATABASE-PRCYTDPF
               ORGANIZATION IS SEQUENTIAL
               ACCESS MODE IS SEQUENTIAL
               FILE STATUS IS IO-STATUS.

           SELECT SCRNFILE ASSIGN TO WORKSTATION-PRRPTSSC-SI
               ORGANIZATION IS TRANSACTION.

           SELECT PRNTFILE ASSIGN TO PRINTER-TRCSPRTF.

       DATA DIVISION.

       FILE SECTION.

           COPY SCRNFD OF CBLCPYSRC SUPPRESS.

           COPY PRNTFD OF CBLCPYSRC SUPPRESS.

       FD  ADM1FILE.
       01  ADM1-REC.
               COPY DD-ADM1DATA OF ADM1FILE.

       FD  EMPLFILE.
       01  EMPL-REC.
               COPY DD-EMPLDATA OF PRCYTDPF.
                                                             EJECT.
       WORKING-STORAGE SECTION.

       77  X                           PIC 999.
       77  LIMITER                     PIC X  VALUE "*".

       01  FILE-STATUS.
           03  ADM1FILE-STATUS         PIC XX.
           03  IO-STATUS               PIC XX.

       01  PROGRAM-FLAGS.
           03  END-FILE-FLAG           PIC 9.

       01  PROGRAM-COUNTERS.
           03  1099-COUNT              PIC 9(5).
           03  FORM-COUNT              PIC 9.

       01  FINAL-TOTAL-FIELDS.
           03  STATE-GROSS-FINAL       PIC S9(8)V99   COMP-3.
           03  FED-GROSS-FINAL         PIC S9(8)V99   COMP-3.
           03  YTD-STATE-TAX-FINAL     PIC S9(8)V99   COMP-3.
           03  YTD-FED-TAX-FINAL       PIC S9(8)V99   COMP-3.

       01  ERROR-MESSAGE-LINES.
           03  CONFIRM-SCREEN-MESSAGE.
               05  CONFIRM-SCREEN-MESSAGE-1      PIC X(49) VALUE SPACES.
               05  CONFIRM-SCREEN-MESSAGE-2      PIC X(21) VALUE
                   "CONFIRM DATA ENTERED.".

           COPY ZBEGINDD OF CBLCPYSRC SUPPRESS.

       01  SCREEN-RECORD-IN.
           03  PAGE1-IN.
               COPY DD-W2S01 OF PRRPTSSC.

       01  ERROR-SCREEN-IN.
           03  PAGEERROR-IN.
               COPY DD-ERRORSCR OF PRRPTSSC SUPPRESS.

           COPY XPRNTDD OF CBLCPYSRC.

       01  LINE-1.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(3).
           03  DATA-2                  PIC -------9.99.
           03                          PIC X(3).
           03  DATA-3                  PIC -------9.99.

       01  LINE-2.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(12).
           03  DATA-2                  PIC X.
           03                          PIC X(13).
           03  DATA-3                  PIC X.

       01  LINE-3.
           03                          PIC X(6).
           03  DATA-1                  PIC X(15).
           03                          PIC X(2).
           03  DATA-2                  PIC X(15).
           03                          PIC X(3).
           03  DATA-3                  PIC -------9.99.
           03                          PIC X(3).
           03  DATA-4                  PIC -------9.99.

       01  LINE-4.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(2).
           03  DATA-2                  PIC X.
           03                          PIC X(9).
           03  DATA-3                  PIC X.

       01  LINE-5.
           03                          PIC X(6).
           03  DATA-1                  PIC X(32).
           03                          PIC X(3).
           03  DATA-2                  PIC -------9.99.
           03                          PIC X(2).
           03  DATA-3                  PIC X(13).
                                                             EJECT.
       PROCEDURE DIVISION.
       DECLARATIVES.
           COPY ADM1ERR OF CBLCPYSRC SUPPRESS.

       EMPLFILE-ERROR SECTION.
           USE AFTER ERROR PROCEDURE ON EMPLFILE.
       EMPLFILE-DECL.
               MOVE "EMPL" TO ERROR-FILE
               MOVE IO-STATUS TO ERROR-CODE
               MOVE FILE-ERROR-MESSAGE TO ERROR-LINE-1 OF ERRORSCR-O
               WRITE SCREEN-RECORD FROM PAGEERROR-IN FORMAT "ERRORSCR"
                   INDICATORS ARE SCREEN-INDICATORS
               READ SCRNFILE RECORD INTO PAGEERROR-IN FORMAT "ERRORSCR"
                   INDICATORS ARE SCREEN-INDICATORS
               STOP RUN.
       END DECLARATIVES.
                                                             EJECT.
       MAIN SECTION.

       CLEAR-SCREEN.
           MOVE "PRR1099 - 1099 FORMS" TO PROGRAM-NAME OF ERRORSCR-O.
           OPEN I-O    SCRNFILE
                INPUT  ADM1FILE, EMPLFILE
                OUTPUT PRNTFILE.

           COPY ZBEGIN OF CBLCPYSRC.

           INITIALIZE PROGRAM-FLAGS, PROGRAM-COUNTERS, 
                      FINAL-TOTAL-FIELDS.

           READ ADM1FILE RECORD.

       SET-UP.
           MOVE SPACES TO SCREEN-RECORD-IN.
           INITIALIZE W2S01-O.
           MOVE 1 TO START-W2-NO OF W2S01-I.

       ACCEPT-1.
           WRITE SCREEN-RECORD FROM PAGE1-IN FORMAT "W2S01"
               INDICATORS ARE SCREEN-INDICATORS.
           READ SCRNFILE RECORD INTO PAGE1-IN FORMAT "W2S01"
               INDICATORS ARE SCREEN-INDICATORS.
           IF SCR-IND(93) = B"1"
               GO TO END-PROGRAM.

           IF START-W2-NO OF W2S01-I = ZERO
               MOVE "INVALID CONTROL NUMBER.  RE-ENTER."
                   TO ERRLINE OF W2S01-I
               GO TO ACCEPT-1.
                                                             EJECT.
       READ-EMPLFILE.
           READ EMPLFILE NEXT RECORD
               AT END MOVE 1 TO END-FILE-FLAG
               GO TO CHECK-SUBTOT-FLAG.

       CHECK-START-1099-NO.
           MOVE 0 TO SUBTOT-FLAG.
           ADD 1 TO 1099-COUNT.
           IF START-W2-NO OF W2S01-I GREATER THAN 1099-COUNT
               GO TO ACCUM-1.

       CHECK-FIRST-PRINTING.
           IF FIRST-PRINTING = 1
               GO TO MOVE-DATA.
           WRITE PRINT-RECORD FROM BLANK-LINE BEFORE ADVANCING 5.
           MOVE 1 TO FIRST-PRINTING.

           INITIALIZE LINE-1.
           MOVE SCHOOL-NAME TO DATA-1 IN LINE-1.
           MOVE EMP-YTD-FED-GROSS TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 1.

           INITIALIZE LINE-1.
           MOVE SCHOOL-ADDR-1 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 1.

           MOVE SCHOOL-ADDR-2 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-3 BEFORE ADVANCING 1.

           MOVE SCHOOL-ADDR-3 TO DATA-1 IN LINE-1.
           MOVE EMP-YTD-FED-GROSS TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-3 BEFORE ADVANCING 6.

           INITIALIZE LINE-2.
           MOVE FEDERAL-ID TO DATA-1 IN LINE-2.
           MOVE SOC-SEC-NO TO DATA-2 IN LINE-2.
           MOVE EMP-YTD-FED-TAX TO DATA-4 IN LINE-2.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 3.

           INITIALIZE LINE-1.
           MOVE EMP-FULL-NAME TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 3.

           INITIALIZE LINE-1.
           MOVE ADDR-LINE-1 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 1.

           MOVE ADDR-LINE-2 TO DATA-1 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 2.

           INITIALIZE LINE-1.
           INSPECT CITY REPLACING ALL "  " BY "**".
           STRING CITY DELIMITED BY LIMITER SPACE SPACE
               STATE-CODE DELIMITED BY LIMITER SPACE
               ZIP-CODE DELIMITED BY LIMITER
               INTO DATA-1 OF LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 3.

           INITIALIZE LINE-5.
           MOVE EMP-YTD-STATE-TAX TO DATA-2 IN LINE-5.
           MOVE STATE-ID TO DATA-3 IN LINE-5.
           WRITE PRINT-RECORD FROM LINE-5 BEFORE ADVANCING PAGE.

       ACCUM-TOTALS.
           ADD EMP-YTD-FED-TAX TO YTD-FED-TAX-FINAL.
           ADD EMP-YTD-FED-GROSS TO FED-GROSS-FINAL.
           ADD EMP-YTD-STATE-TAX TO YTD-STATE-TAX-FINAL.
           ADD EMP-YTD-STATE-GROSS TO STATE-GROSS-FINAL.

       CHECK-END-FILE-FLAG.
           IF END-FILE-FLAG = 1
               GO TO PRINT-FINAL-TOTALS.
           IF START-W2-NO OF W2S01-I GREATER THAN 1099-COUNT
               GO TO READ-EMPLFILE.
           GO TO READ-EMPLFILE.

      * * * * *      FINAL SUBTOTALS     * * * * *

       PRINT-FINAL-TOTALS.
           WRITE PRINT-RECORD FROM BLANK-LINE BEFORE ADVANCING 5.
           INITIALIZE LINE-1.
           MOVE "   FINAL TOTALS" TO DATA-1 IN LINE-1.
           MOVE YTD-FED-GROSS-FINAL TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 3.

           INITIALIZE LINE-1.
           MOVE YTD-FED-GROSS-FINAL TO DATA-2 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 6.

           INITIALIZE LINE-2.
           MOVE YTD-FED-TAX-FINAL TO DATA-4 IN LINE-2.
           WRITE PRINT-RECORD FROM LINE-2 BEFORE ADVANCING 12.

           INITIALIZE LINE-1.
           MOVE YTD-STATE-TAX-FINAL TO DATA-3 IN LINE-1.
           WRITE PRINT-RECORD FROM LINE-1 BEFORE ADVANCING 1.

       END-PROGRAM.
           CLOSE ADM1FILE, EMPLFILE, PRNTFILE, SCRNFILE.
           STOP RUN.

      *********************** R O U T I N E S ************************

           COPY XDATE OF CBLCPYSRC SUPPRESS.