|
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: 5214 (0x145e)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »COLORBK«
└─⟦dbbef6eca⟧ Bits:30008596 DDMQ1-0028_DEMONSTRATION_DISK_LMC_SOURCE_Sept_77
└─⟦this⟧ »COLORBK«
/* THIS IS THE SOURCE LISTING FOR COLONIAL SYSTEMS ORDER BOOK PRINT-OUT
VERSION 7/16/77 */
DCL 1 HORDER,
2 HUSER FIXED(5),
2 HORDERDATE CHAR(6),
2 HINV# CHAR(5),
2 HUSERNAME CHAR(30),
2 HPART# CHAR(8),
2 HORDERQTY FIXED(6),
2 HDISPRICE FIXED(5,2),
2 HDISRUN FIXED(5,2),
2 HORUNITQTY BINARY;
DCL BINV# CHAR(5),MM CHAR(2),DD CHAR(2),YY CHAR(2),BORDERDATE CHAR(8);
DCL A CHAR(1),BUSER FIXED(5),B CHAR(1);
DCL HOFILE FILE;
S: PUT FILE(D)SKIP LIST('HAVE YOU SORTED THE CUSTOMER CARDS ? ');
GET SKIP LIST(A);IF A='N' THEN DO;
PUT FILE(D)SKIP LIST('PLEASE PUT CUSTOMER CARD SORT DISK IN DRIVE !');
GET SKIP LIST('');CALL TYPIST('SORT HOFILE CSCRATCH CUSCARD┣0d┫',29);STOP;
END;
START: PUT FILE(D)SKIP EDIT('THIS IS THE COLONIAL SYSTEMS ORDER')(A(37))
('BOOK APPLICATION')(A(37))('(1) INDIVIDUAL CUSTOMER CARD OR')(A(37))
('(2) ALL CUSTOMER CARD')(A(37));GET SKIP LIST(B);IF B='E' THEN STOP;
IF (VERIFY(B,'12E')=0) THEN GOTO START;OPEN HOFILE;
ASK: PUT FILE(D)SKIP LIST('TODAY''S DATE : ');GET SKIP LIST(HORDERDATE);
MM=SUBSTR(HORDERDATE,1,2);DD=SUBSTR(HORDERDATE,3,2);
YY=SUBSTR(HORDERDATE,5,2);BORDERDATE=MM CAT '/' CAT DD CAT '/' CAT YY;
PUT FILE(D) LIST(BORDERDATE,' ? ');GET SKIP LIST(A);
IF A='Y' THEN GOTO PR;GOTO ASK;
PUT FILE(D)SKIP LIST('ARRANGE PLEASE');GET SKIP LIST('');
PR: PUT SKIP EDIT('COLONIAL SYSTEMS')(X(13),A);
PUT SKIP EDIT('CUSTOMER CARDS')(X(15),A);
PUT SKIP(2) LIST('TODAY''S DATE : ',BORDERDATE );
IF B='1' THEN DO;
ASK#: PUT FILE(D)SKIP LIST('ENTER CUSTOMER # ');GET SKIP LIST(HUSER);
PUT FILE(D)EDIT(HUSER)(P'99999')(' ? ')(A);GET SKIP LIST(A);
IF A¬='Y' THEN GOTO ASK#;ON ERROR GOTO MESG;
READ KEY(HUSER)FILE(HOFILE)INTO(HORDER);UNSPEC(HOFILE)=UNSPEC(HOFILE)-1;
GTOTAL=0;GK=0;END;
BINV#='ZZZZZ';LK=0;BUSER=0;GTOTAL=0;
BKAG: ON ENDFILE GOTO FIN;READ FILE(HOFILE)INTO(HORDER);
IF HUSER¬=BUSER & LK¬=0 THEN DO;PUT EDIT('ORDER TOTAL = ')(X(2),A(14))
(GTOTAL)(P'ZZZ,ZZ9V.99');GTOTAL=0;LK=0;GK=1;END;
IF HUSER¬=BUSER THEN DO;IF B='1' & GK¬=0 THEN GOTO START;
PUT SKIP (2)EDIT('USER # : ')(A)(HUSER)(P'99999');
PUT SKIP EDIT('USER NAME: ')(A)(HUSERNAME)(A);END;
IF HINV#¬=BINV# & LK¬=0 THEN DO;PUT EDIT('ORDER TOTAL = ')(X(2),A(14))
(GTOTAL)(P'ZZZ,ZZ9V.99');GTOTAL=0;GK=1;END;
MM=SUBSTR(HORDERDATE,1,2);DD=SUBSTR(HORDERDATE,3,2);YY=SUBSTR(HORDERDATE,5,2);
BORDERDATE=MM CAT '/' CAT DD CAT '/' CAT YY;
IF HINV#¬= BINV# THEN PUT SKIP EDIT(BORDERDATE)(A(9))(HINV#)(A(6));
ELSE PUT SKIP EDIT(' ')(A(15));
PUT EDIT(HPART#)(A(9))(HORDERQTY)(P'ZZZ,ZZ9');
KQ=((HORDERQTY/HORUNITQTY)*HDISPRICE);
IF SUBSTR(HPART#,1,2)='SP' THEN KQ=HORDERQTY*HDISPRICE;BINV#=HINV#;LK=1;
BUSER=HUSER;GTOTAL=GTOTAL+KQ;
PUT EDIT(KQ)(P'ZZZ,ZZ9V.99');
IF HDISRUN¬=0 & SUBSTR(HPART#,1,2)='SP' THEN DO;
PUT SKIP EDIT('RUNNING CHARGE')(X(15),A(17))
(HDISRUN*(BSQ/HORDERQTY))(P'ZZZ,ZZ9V.99');
GTOTAL=GTOTAL+(DISRUN*(BSQ/HORUNITQTY));
END;BSQ=ORDERQTY;GOTO BKAG;
MESG: PUT FILE(D)SKIP LIST('NO SUCH CUSTOMER # ');GET SKIP LIST('');
GOTO START;
FIN:PUT EDIT('ORDER TOTAL = ')(X(2),A(14))(GTOTAL)(P'ZZZ,ZZ9V.99');PUT SKIP(5);
GOTO START;END;