{            INVENTORY PROGRAM FOR
               TURBO PASCAL
               WRITTEN BY CHARLES STEWART
                                              }

PROGRAM INVENT;
TYPE
  ITEM=(A,E,T,F,J,M,X); { X IS FOR DELETED FILE FLAG}
  INVRECORD=RECORD
            ID:STRING[6];
            INVTYPE:ITEM;
            DESCRIPTION:STRING[20];
            COST:STRING[6];
  END;

  RINV= ARRAY[1..100] OF INVRECORD;

VAR
  FNAME:STRING[12];
  SELECTION:CHAR;
  RIDNUMBER:STRING[6];
  RTYPE:ITEM;
  RDESCRIPTION:STRING[20];
  RCOST:STRING[6];
  RINVRECORD:INVRECORD;
  INFILE, OUTFILE : FILE OF INVRECORD;
  RESPONSE:STRING[30];
  ALLDONE:BOOLEAN;
  TEMP:INVRECORD;
  TOTAL:REAL;
  AMT:REAL;
  CODE:INTEGER;
  INVENTORY:RINV;

PROCEDURE STALL;
BEGIN
 WRITELN;
 WRITELN('PRESS RETURN TO CONTINUE ');
 WRITELN;
 READLN;
END; {STALL}

PROCEDURE DELETE(VAR R:RINV);
VAR CODE, I:INTEGER;
   ALLDONE:BOOLEAN;
   RE:INTEGER;
   CLASS:CHAR;
   PP,PG:INTEGER;
   RCLASS:ITEM;
BEGIN
  ALLDONE := FALSE;
  CLRSCR;
  PP := 0;
  PG := 20;
  ASSIGN(OUTFILE,FNAME);
  RESET(OUTFILE);
  I:=0;
  CLRSCR;
     REPEAT
     IF PP < PG THEN
      BEGIN
       READ (OUTFILE,RINVRECORD);
       WITH RINVRECORD DO
       BEGIN
          WRITE(I:3,' ');
          WRITE(ID:8);
          WRITE(DESCRIPTION:22);
          WRITE(COST:8);
          IF INVTYPE = X THEN WRITE('----DELETED---');
          WRITELN;
          PP := PP + 1;
          I:=I+1;

        END;
      END
     ELSE
      BEGIN
        WRITE(' PRESS RETURN FOR NEXT PAGE');
        PP := 0;
        READLN;
        CLRSCR;
      END;
  UNTIL EOF(OUTFILE);
  WRITELN;
  I:= I - 1;
  WRITELN('DELETE WHICH ITEM ');
  READLN(RE);
    IF RE > I THEN
       BEGIN
          WRITELN('ERROR',^G,' THAT ITEM DOES NOT EXIST');
          STALL;
       END
    ELSE
       BEGIN
          SEEK(OUTFILE,0); {REWIND THE POINTER TO 0 POS IN FILE}
          SEEK(OUTFILE,RE);
          RINVRECORD.INVTYPE := X; {DELETE FILE CODE}
          WRITE(OUTFILE,RINVRECORD);
       END;
CLOSE(OUTFILE);
END;{DELETE}

PROCEDURE CHANGE(VAR R:RINV);
VAR CODE, I:INTEGER;
   ALLDONE:BOOLEAN;
   PP,PG:INTEGER;
   CLASS:CHAR;
   RE:INTEGER;
   RCLASS:ITEM;
BEGIN
  ALLDONE := FALSE;
  CLRSCR;
  ASSIGN(OUTFILE,FNAME);
  RESET(OUTFILE);
  I:=0;
  CLRSCR;
     PP:= 0; PG := 20;
     REPEAT
     IF PP < PG THEN
      BEGIN
       READ (OUTFILE,RINVRECORD);
       WITH RINVRECORD DO
        BEGIN
          WRITE(I:3,' ');
          WRITE(ID:8);
          WRITE(DESCRIPTION:22);
          WRITE(COST:8);
          IF INVTYPE = X THEN WRITE ('------DELETED-------');
          WRITELN;
          I:=I+1;
          PP := PP +1;
        END;
      END
     ELSE
       BEGIN
          WRITE('PRESS RETURN FOR NEXT PAGE');
          PP :=0;
          READLN;
          CLRSCR;
       END;
  UNTIL EOF(OUTFILE);
  WRITELN;
  I:= I - 1;
  WRITELN('CHANGE WHICH ITEM ');
  READLN(RE);
  IF RE > I THEN
       BEGIN
                WRITELN('ERROR NO SUCH RECORD',^G);
                STALL;
       END
  ELSE
       BEGIN
              SEEK(OUTFILE,0); {REWIND THE POINTER TO 0 POS IN FILE}
              SEEK(OUTFILE,RE);
                  WRITELN('PURCHASE DATE AS YYMMDD');
                      READLN(RIDNUMBER);
                      R[I].ID := RIDNUMBER;
                      WRITELN('INVENTORY TYPE  A,E,T,F,J,M,? ');
                      READLN(CLASS);
                      IF CLASS <> '?' THEN
                         BEGIN
                              IF CLASS = 'A' THEN RCLASS := A
                                 ELSE
                                     IF CLASS = 'E' THEN RCLASS := E
                                     ELSE
                                     IF CLASS = 'T' THEN RCLASS := T
                                     ELSE
                                     IF CLASS = 'F' THEN RCLASS := F
                                     ELSE
                                     IF CLASS = 'J' THEN RCLASS := J
                                     ELSE
                                     RCLASS := M;
                         END
                     ELSE
                         BEGIN
                            CLRSCR;
                            WRITELN('A- > APPLIANCE');
                            WRITELN('E- > ELECTRONIC');
                            WRITELN('T- > TOY');
                            WRITELN('F- > FURNITURE');
                            WRITELN('J- > JEWERY');
                            WRITELN('M- > MISC. ');
                            WRITELN('INVENTORY TYPE  A,E,T,F,J,M');
                            READLN(CLASS);
                         END;

    WRITELN('DESCRIPTION OF ITEM 20 CHARACTER MAXIMUM ');
    WRITELN('-------------------* AS INDICATED BY THE ASTERISK');
    READLN(RDESCRIPTION);
    R[I].DESCRIPTION := RDESCRIPTION;
    WRITELN(' ITEM COST TO NEAREST DOLLAR (NO DECIMALS)');
    READLN(RCOST);
    R[I].COST := RCOST;
    WRITE(OUTFILE,R[I]);
    CLOSE(OUTFILE);
END;
END;{CHANGE}

PROCEDURE SORT(VAR R:RINV);
VAR J,I,INDEX:INTEGER;
BEGIN
  CLRSCR;
  WRITELN('SORT ROUTINE OF THE INPUT DATA');
  ASSIGN(INFILE,FNAME);
  RESET(INFILE);
  INDEX := 0;
  WHILE NOT EOF(INFILE) DO
     BEGIN
       INDEX := INDEX + 1;
       READ (INFILE,R[INDEX]);
     END;
  CLOSE(INFILE);
  ASSIGN(OUTFILE,FNAME);
  REWRITE(OUTFILE);
  FOR I := 1 TO INDEX-1 DO
      FOR J := I+1 TO INDEX DO
          IF R[I].ID > R[J].ID
                   THEN
                        BEGIN  {SWAP EM}
                          TEMP := R[I];
                          R[I] := R[J];
                          R[J] := TEMP;
                        END;
  FOR I:= 1 TO INDEX DO
      WRITE(OUTFILE,R[I]);
  WRITELN(' SORTED FILE WRITTEN TO DISK FILE ',FNAME);
  CLOSE(OUTFILE);
  STALL;
END; {SORT ROUTINE}
PROCEDURE TYPESORT(VAR R:RINV);
VAR J,I,INDEX:INTEGER;
BEGIN
  CLRSCR;
  WRITELN('SORT ROUTINE OF THE INPUT DATA');
  RESET(INFILE);
  INDEX := 0;
  WHILE NOT EOF(INFILE) DO
     BEGIN
       INDEX := INDEX + 1;
       READ (INFILE,R[INDEX]);
     END;
  CLOSE(INFILE);
  ASSIGN(OUTFILE,FNAME);
  REWRITE(OUTFILE);
  FOR I := 1 TO INDEX-1 DO
      FOR J := I+1 TO INDEX DO
          IF R[I].INVTYPE > R[J].INVTYPE
                   THEN
                        BEGIN  {SWAP EM}
                          TEMP := R[I];
                          R[I] := R[J];
                          R[J] := TEMP;
                        END;
  FOR I:= 1 TO INDEX DO
      WRITE(OUTFILE,R[I]);
  CLOSE(OUTFILE);
END; {SORT ROUTINE}

PROCEDURE CREATE(VAR R:RINV);
VAR CLASS:CHAR;
  RCLASS:ITEM;
BEGIN
  ALLDONE:=FALSE;
  ASSIGN(OUTFILE,FNAME);
  REWRITE(OUTFILE);
  WHILE NOT ALLDONE DO
     BEGIN
    WRITELN('PURCHASE DATE AS YYMMDD');
    READLN(RIDNUMBER);
    RINVRECORD.ID := RIDNUMBER;
    WRITELN('INVENTORY TYPE  A,E,T,F,J,M,? ');
    READLN(CLASS);
    IF CLASS <> '?' THEN
    BEGIN
        IF CLASS = 'A' THEN RCLASS := A
    ELSE
       IF CLASS = 'E' THEN RCLASS := E
       ELSE
          IF CLASS = 'T' THEN RCLASS := T
          ELSE
             IF CLASS = 'F' THEN RCLASS := F
             ELSE
                IF CLASS = 'J' THEN RCLASS := J
                ELSE
                   RCLASS := M;
   END
   ELSE
      BEGIN
        CLRSCR;
        WRITELN('A- > APPLIANCE');
        WRITELN('E- > ELECTRONIC');
        WRITELN('T- > TOY');
        WRITELN('F- > FURNITURE');
        WRITELN('J- > JEWERY');
        WRITELN('M- > MISC. ');
        WRITELN('INVENTORY TYPE  A,E,T,F,J,M,? ');
        READLN(CLASS);
      END;

    RINVRECORD.INVTYPE := RCLASS;
    WRITELN('DESCRIPTION OF ITEM 20 CHARACTER MAXIMUM ');
    WRITELN('-------------------* AS INDICATED BY THE ASTERISK');
    READLN(RDESCRIPTION);
    RINVRECORD.DESCRIPTION := RDESCRIPTION;
    WRITELN(' ITEM COST TO NEAREST DOLLAR (NO DECIMALS)');
    READLN(RCOST);
    RINVRECORD.COST := RCOST;
    WRITE(OUTFILE,RINVRECORD);
    WRITELN(' IF YOU ARE DONE TYPE AN ASTERISK (*), OTHERWISE JUST HIT ENTER');
    READLN (RESPONSE);
    IF RESPONSE = '*' THEN ALLDONE := TRUE;
  END; {WHILE ALLDONE LOOP}
  CLOSE(OUTFILE);
  SORT(INVENTORY);
END; {CREATE}


PROCEDURE MENU(VAR SELECTION:CHAR);
  BEGIN
      CLRSCR;
      WRITELN('Inventory Management System':53);
      WRITELN('by Charles A. Stewart':50);
      WRITELN;
      WRITELN('Copyright 1986 all rights reserved':56);
      WRITELN;
      WRITELN('Work file name ',fname);
      WRITELN;
      WRITELN(' A--> Create new inventory file');
      WRITELN(' B--> Add items to inventory  ');
      WRITELN(' C--> Change items in inventory');
      WRITELN(' D--> Delete item in inventory');
      WRITELN(' E--> Print the inventory to printer');
      WRITELN(' F--> Assign file name ');
      WRITELN(' G--> END PROGRAM');
      WRITELN;
      READLN (SELECTION);
      IF SELECTION = 'F' THEN
         BEGIN
           WRITE('File name please ');
           readln(fname);
         END;
  END;{MENU}

PROCEDURE ADD(VAR R:RINV);
VAR I:INTEGER;
   ALLDONE:BOOLEAN;
    CLASS:CHAR;
    RCLASS:ITEM;
BEGIN
  ALLDONE := FALSE;
  CLRSCR;
  ASSIGN(OUTFILE,FNAME);
  RESET(OUTFILE);
  SEEK(OUTFILE,FILESIZE(OUTFILE));
  WHILE NOT ALLDONE DO
     BEGIN
    WRITELN('PURCHASE DATE AS YYMMDD');
    READLN(RIDNUMBER);
    RINVRECORD.ID := RIDNUMBER;
    WRITELN('INVENTORY TYPE  A,E,T,F,J,M,? ');
    READLN(CLASS);
    IF CLASS <> '?' THEN
    BEGIN
        IF CLASS = 'A' THEN RCLASS := A
    ELSE
       IF CLASS = 'E' THEN RCLASS := E
       ELSE
          IF CLASS = 'T' THEN RCLASS := T
          ELSE
             IF CLASS = 'F' THEN RCLASS := F
             ELSE
                IF CLASS = 'J' THEN RCLASS := J
                ELSE
                   RCLASS := M;
   END
   ELSE
      BEGIN
        CLRSCR;
        WRITELN('A- > APPLIANCE');
        WRITELN('E- > ELECTRONIC');
        WRITELN('T- > TOY');
        WRITELN('F- > FURNITURE');
        WRITELN('J- > JEWERY');
        WRITELN('M- > MISC. ');
        WRITELN('INVENTORY TYPE  A,E,T,F,J,M,? ');
        READLN(CLASS);
      END;

    RINVRECORD.INVTYPE := RCLASS;
    WRITELN('DESCRIPTION OF ITEM 20 CHARACTER MAXIMUM ');
    WRITELN('-------------------* AS INDICATED BY THE ASTERISK');
    READLN(RDESCRIPTION);
    RINVRECORD.DESCRIPTION := RDESCRIPTION;
    WRITELN(' ITEM COST TO NEAREST DOLLAR (NO DECIMALS)');
    READLN(RCOST);
    RINVRECORD.COST := RCOST;
    WRITE(OUTFILE,RINVRECORD);
    WRITELN(' IF YOU ARE DONE TYPE AN ASTERISK (*), OTHERWISE JUST HIT ENTER');
    READLN (RESPONSE);
    IF RESPONSE = '*' THEN ALLDONE := TRUE;
  END; {WHILE ALLDONE LOOP}
  FLUSH(OUTFILE);
  CLOSE(OUTFILE);
  SORT(INVENTORY);
END; {ADD}

PROCEDURE PRINT(VAR R:RINV);
CONST PP=56;
VAR PG:INTEGER;
BEGIN
  CLRSCR;
  ASSIGN (INFILE,FNAME);
  RESET(INFILE);
  TYPESORT(INVENTORY);
  WRITELN(LST,'Household Inventory');
  WRITELN;
  WRITELN(LST,'Copyright 1986 by Charles Stewart');
  WRITELN(LST,'All Rights Reserved.');
  WRITELN(LST);
  ASSIGN(INFILE,FNAME);
  RESET(INFILE);
  TOTAL := 0;
  WRITELN(LST,'DATE':8,'DESCRIPTION':22,'       COST':6,'        CLASS');
  WRITELN(LST,'===============================================================');
  Pg := 7;
  REPEAT
       READ (INFILE,RINVRECORD);
       WITH RINVRECORD DO
       BEGIN
        IF Pg > PP THEN
           BEGIN
               WRITELN(LST,^l); { FORM FEED }
               WRITELN(LST,'Household Inventory');
               WRITELN;
               WRITELN(LST,'Copyright 1986 by Charles Stewart');
               WRITELN(LST,'All Rights Reserved.');
               WRITELN(LST);
               WRITELN(LST,'DATE':8,'DESCRIPTION':22,'       COST':6,'        CLASS');
               WRITELN(LST,'===============================================================');
               Pg := 7;
           END; {IF PP}
        IF INVTYPE <> X THEN
         BEGIN
          VAL (COST,AMT,CODE);
          TOTAL := TOTAL + AMT;
          Pg := Pg + 1;
          WRITE(LST,ID:8);
          WRITE(LST,DESCRIPTION:22);
          WRITE(LST,'  $');
          WRITE(LST,COST:6);
          WRITE(LST,'    ');
          CASE INVTYPE OF
          A: WRITE(LST,'APPLANCE');
          E: WRITE(LST,'ELECTRONIC');
          T: WRITE(LST,'TOY');
          J: WRITE(LST,'JEWELRY');
          F: WRITE(LST,'FURNITURE');
          M: WRITE(LST,'MISC. ');
          END; {CASE}
         WRITELN(LST);
         END;{WHILE}
       END;
  UNTIL EOF(INFILE);
  CLOSE(INFILE);
  WRITELN(LST);
  WRITELN(LST,'===============================================================');
  WRITELN(LST,'TOTAL ----------------> $',TOTAL:5:2);
END;{PRINT}

BEGIN {MAIN PROGRAM}
FNAME :=('INVENT.DAT'); {DEFAULT FILE NAME}
REPEAT
 MENU(SELECTION);
 CASE SELECTION OF
  'A': CREATE(INVENTORY);
  'B': ADD(INVENTORY);
  'D': DELETE(INVENTORY);
  'C': CHANGE(INVENTORY);
  'E': PRINT(INVENTORY);
 END;{CASE}
UNTIL SELECTION > 'F';
END. {PROGRAM}



You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.