|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12008 (0x2ee8)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »COLINVPR«
└─⟦dbbef6eca⟧ Bits:30008596 DDMQ1-0028_DEMONSTRATION_DISK_LMC_SOURCE_Sept_77
└─⟦this⟧ »COLINVPR«
/* THIS IS THE SOURCE LISTING FOR CREATING RECORDS IN THE MATERIAL MASTER FILE
COLONIAL SYSTEMS VERSION 07/27/77 */
DCL 1 MATERIAL,
2 PART# CHAR(8),
2 DESCRIPT CHAR(25),
2 STOCK_ON_HAND FIXED (6),
2 FSCH(5) FIXED(5),
2 DEALPRICE(5) FIXED(5,2),
2 DIRPRICE(5)FIXED(5,2),
2 DIS FIXED(2),
2 UNITQTY BINARY,2 VAL FIXED(6,2),
2 LOCATION CHAR(4),
2 LASTDATE CHAR(6),
2 LDATE CHAR(6),
2 AM1 FIXED(6),
2 AM2 FIXED(6),
2 LEVEL FIXED(7);
DCL MG CHAR(2), DG CHAR(2), YG CHAR(2),KSTOCK FIXED(7);
DCL A CHAR(1),Y CHAR(2), X CHAR(5), XG CHAR(4),XB BINARY,TODATE CHAR(6);
DCL NPART# CHAR(8),MM CHAR(2),DD CHAR(2),YY CHAR(2),TTDATE CHAR(8);
DCL OLDPART CHAR (8), VALUE FIXED(8,2), SUM FIXED (10,2);
DCL BL CHAR(1) INITIAL (' ');
DCL SUBT FIXED(6), TOTAL FIXED(6), SUBTL FIXED(6);
DCL INVFILE FILE;
DCL SY CHAR(2), G CHAR(5);
START:
PUT FILE (DISPLAY) SKIP LIST('THIS IS A PROGRAM TO MAINTAIN THE ');
PUT FILE(D)EDIT('COLONIAL SYSTEMS INVENTORY FILE ')(A(37))
('DO YOU WANT TO (1) PRINT ')(A(37))
('(2) CHANGE OR (3) INQUIRE THIS MASTER FILE ?')(A(37));
GET SKIP LIST (A);OPEN INVFILE;
PUT FILE (DISPLAY) SKIP LIST('');
IF (A='1') THEN GOTO PRINT;
IF (A='2') THEN GOTO CHANGE;
IF (A='3') THEN GOTO ENQUIRE;IF A='E' THEN STOP;GOTO START;
ADD: PUT FILE (DISPLAY) SKIP LIST ('PART# : ');OPEN INVFILE;
GET SKIP LIST(PART#);IF PART#='END 'THEN GOTO START;
PUT FILE(D)EDIT(PART#)(A(25));
PUT FILE (DISPLAY) LIST('DESCRIP : ');
GET SKIP LIST (DESCRIPT);
PUT FILE (DISPLAY) LIST (DESCRIPT);
PUT FILE (DISPLAY) LIST ('LOCATION : ');
GET SKIP LIST (LOCATION);
PUT FILE (DISPLAY) EDIT (LOCATION)(A(25));
PUT FILE (DISPLAY) LIST ('STOCK QTY : ');GET SKIP LIST (STOCK_ON_HAND);
PUT FILE (DISPLAY) EDIT (STOCK_ON_HAND) (P 'ZZ,ZZ9');
PUT FILE (DISPLAY) LIST (' ');
PUT FILE (DISPLAY) LIST ('IS THE ABOVE INFORMATION CORRECT? ');
GET SKIP LIST (A);
IF (A='Y') THEN DO;CALL SEOF (INVFILE);WRITE FILE(INVFILE)FROM(MATERIAL);
CLOSE INVFILE;GOTO ADD;END;
PUT FILE (DISPLAY) SKIP LIST('PRESS RETURN AND TRY AGAIN ! ');
GET SKIP LIST('');GOTO ADD;
CHANGE: PUT FILE (DISPLAY) SKIP LIST ('DO YOU WANT TO (1)DELETE , (2)ADD ');
PUT FILE (DISPLAY) LIST (' OR (3)MODIFY ?');
GET SKIP LIST (A);
IF (A='1') THEN GOTO DELETE;
IF (A='2') THEN GOTO ADD;
IF (A='3') THEN GOTO MODIFY; IF A='E' THEN GOTO START;
DELETE: PUT FILE (DISPLAY)SKIP LIST ('PART#: ');
GET SKIP LIST(PART#);IF PART#='END ' THEN GOTO START;
PUT FILE(D)LIST(PART#,' DELETE ? ');GET SKIP LIST(A);
IF A¬='Y' THEN DO;PUT FILE(D)SKIP LIST('WRONG ENTRY ! TRY AGAIN. ');
GET SKIP LIST('');GOTO DELETE;END;
ON ERROR GOTO MESG;READ KEY(PART#)FILE(INVFILE) INTO (MATERIAL);
PART#='ZZZZZZZZ';
STORE: REWRITE FILE (INVFILE) FROM (MATERIAL); GOTO DELETE;
MODIFY: PUT FILE (DISPLAY) SKIP LIST ('PART#: ');
GET SKIP LIST (PART#);OLDPART=PART#;
PUT FILE (DISPLAY) SKIP LIST ('OLD PART# : ');
PUT FILE (DISPLAY) EDIT (PART#)(A(25));
PUT FILE (DISPLAY) LIST ('NEW PART# : ');
GET SKIP LIST (PART#);
NPART#=PART#;
IF (PART#='END ') THEN GOTO START;
ON ERROR GOTO MESG;READ KEY(PART#) FILE (INVFILE) INTO (MATERIAL);
PUT FILE (DISPLAY) EDIT (PART#)(A(25));
PART#=NPART#;
PUT FILE (DISPLAY) LIST ('NEW DES : ');
GET SKIP LIST (DESCRIPT);
PUT FILE (DISPLAY) LIST (DESCRIPT);
PUT FILE (DISPLAY) LIST ('NEW LOCAT : ');
GET SKIP LIST (LOCATION);
PUT FILE (DISPLAY) EDIT (LOCATION)(A(25));
PUT FILE (DISPLAY) LIST ('NEW ST QTY: ');
GET SKIP LIST (STOCK_ON_HAND);
PUT FILE (DISPLAY) EDIT (STOCK_ON_HAND) (P 'ZZ,ZZ9');
PUT FILE (DISPLAY) LIST (' ');
PUT FILE (DISPLAY) LIST ('IS THE ABOVE INFORMATION CORRECT? ');
GET SKIP LIST (A);
IF (A='Y') THEN GO TO STORE;
PUT FILE(D)SKIP LIST('PRESS RETURN AND TRY AGAIN ! ');GET SKIP LIST('');
GOTO START;
ENQUIRE: PUT FILE (DISPLAY) SKIP LIST ('PART# TO BE INQUIRED ? ');
GET SKIP LIST (PART#);
ON ERROR GOTO MESG;READ KEY(PART#) FILE (INVFILE) INTO (MATERIAL);
PUT FILE (DISPLAY) SKIP LIST ('PART# : ');
PUT FILE (DISPLAY) EDIT (PART#)(A(26));
PUT FILE (DISPLAY) LIST ('DESCRIPT : ');
PUT FILE (DISPLAY) EDIT (DESCRIPT)(A(26));
PUT FILE (DISPLAY) LIST ('LOCATION : ');PUT FILE (DISPLAY) LIST (LOCATION);
PUT FILE (DISPLAY) LIST (' ');
PUT FILE (DISPLAY) LIST ('STOCK AMT: ');
PUT FILE (DISPLAY) EDIT (STOCK_ON_HAND) (P 'ZZZ,ZZ9');
PUT FILE (DISPLAY) LIST (' ');
GET SKIP LIST (''); GOTO START;
MESG: PUT FILE(D)SKIP LIST('WRONG PART # RETURN AND TRY AGAIN ! ');
GET SKIP LIST('');GOTO START;
PRINT: MMM=0;TVAL =0;
PUT FILE (DISPLAY) SKIP EDIT ('(1) DETAILED INVENTORY LISTING ')(A(37))
('(2) INVENTORY STATUS REPORT')(A(37))('(3) REORDER EXCEPTION REPORT')(A(37));
GET SKIP LIST (A);IF A='E' THEN GOTO START;
IF (A='2')ö(A='3') THEN MMM = 1;
IF(VERIFY(A,'123E')=0)THEN GOTO PRINT;
PUT FILE (DISPLAY)SKIP LIST('TODAY''S DATE: ');GET SKIP LIST(TODATE);
PUT FILE(DISPLAY)SKIP LIST('ARRANGE PAPER PLEASE! ');GET SKIP LIST('');
PUT SKIP LIST ('COLONIAL SYSTEMS STOCK STATUS REPORT');
MM=SUBSTR(TODATE,1,2);DD=SUBSTR(TODATE,3,2);YY=SUBSTR(TODATE,5,2);
TTDATE=MM CAT '/' CAT DD CAT '/' CAT YY;
PUT SKIP (2) LIST (TTDATE);
PUT SKIP(2) LIST('PART# DESCRIPTION ST QTY ');
IF MMM¬=1 THEN DO;
PUT LIST(' UNIT VALUE TOTAL VALUE'); END;
PUT LIST(' LAST PULL ');IF MMM=1 THEN DO;
PUT LIST(' MAX_LEVEL RE-ORDER LEVEL RE-ORDER QTY');END;
IF MMM¬=1 THEN DO; PUT EDIT('PRICE SCHEDULE')(X(11),A(26))
('UNIT')(A(6))('DISCOUNT')(A(8));END;
PP: ON ENDFILE GOTO DONE;READ FILE (INVFILE) INTO (MATERIAL);
IF PART#='ZZZZZZZZ' THEN GOTO PP;
IF A='3' THEN DO;IF (LEVEL/3)>STOCK_ON_HAND THEN GOTO PPK;GOTO PP;END;
PPK: PUT SKIP EDIT (PART#)(A(11))
(DESCRIPT)(A(26))(LOCATION) (A(7));
PUT EDIT(STOCK_ON_HAND)(P'ZZZ,ZZ9',X(1));
IF MMM¬=1 THEN DO;
PUT EDIT(VAL)(X(2),P'Z,ZZZV.99');
PUT EDIT((VAL*STOCK_ON_HAND)/UNITQTY)(X(2),P'ZZZ,ZZZV.99',X(2));
TVAL=TVAL+((VAL*STOCK_ON_HAND)/UNITQTY);END;
MM=SUBSTR(LASTDATE,1,2);DD=SUBSTR(LASTDATE,3,2);YY=SUBSTR(LASTDATE,5,2);
TTDATE=MM CAT '/' CAT DD CAT '/' CAT YY; PUT EDIT(TTDATE)(X(8),A(10));
IF MMM=1 THEN DO;PUT EDIT(LEVEL)(X(6),P'ZZZZZZ9',X(11))(LEVEL/3)(P'ZZZZZZ9');
KSTOCK=LEVEL-STOCK_ON_HAND;IF KSTOCK < 0 THEN KSTOCK=0;
PUT EDIT(KSTOCK)(X(12),P'ZZZZZZ9');END;
IF MMM¬=1 THEN DO;DO I=1 TO 5;PUT EDIT(FSCH(I))(P'ZZZZ9',X(2));END;
PUT SKIP EDIT('DEALER PRICE = ')(X(77),A(18));
DO I =1 TO 5;PUT EDIT(DEALPRICE(I))(P'ZZ9V.99',X(1));END;
PUT EDIT(UNITQTY)(P'ZZZZ9',X(5))(DIS)(P'Z9');
PUT SKIP EDIT('CUSTOMER PRICE = ')(X(77),A(18));
DO I =1 TO 5;PUT EDIT(DIRPRICE(I))(P'ZZ9V.99',X(1));END;
PUT EDIT (UNITQTY)(P'ZZZZ9',X(5))(DIS)(P'Z9');END;GOTO PP;
DONE: IF MMM¬=1 THEN DO;
PUT SKIP(2)EDIT('GRAND TOTAL= ')(X(52),A)(TVAL)(P'ZZZ,ZZV.99');END;
PUT SKIP LIST('');GOTO START;END;