|
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: 11929 (0x2e99)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »INVO«
└─⟦dbbef6eca⟧ Bits:30008596 DDMQ1-0028_DEMONSTRATION_DISK_LMC_SOURCE_Sept_77
└─⟦this⟧ »INVO«
DCL 1 ORDER, /*VERSION 9/19/77*/
2 ORDERDATE CHAR(6),
2 INV# CHAR(5),
2 CUS# CHAR(15),
2 SALESMEN# CHAR(6),
2 SOLDTO FIXED(5),
2 SOLDTONAME CHAR(30),
2 SOLDTOADD1 CHAR(25),
2 SOLDTOADD2 CHAR(25),
2 SHIPTO FIXED(5),
2 SHIPTONAME CHAR(30),
2 SHIPTOADD1 CHAR(25),
2 SHIPTOADD2 CHAR(25),
2 USER FIXED(5),
2 USERNAME CHAR(30),
2 PART# CHAR(8),
2 DES CHAR(25),
2 ORDERQTY FIXED(6),
2 DELIVER CHAR(6),
2 JOB CHAR(1),
2 INTER CHAR(1),
2 PROOF CHAR(1),
2 PRTO CHAR(25),
2 TERM CHAR(1),
2 COMMENT CHAR(25),
2 OVERPRICE FIXED(5,2),
2 DISPRICE FIXED(5,2),
2 RUNPRICE FIXED(5,2),
2 DISRUN FIXED(5,2),
2 ORUNITQTY BINARY,
2 ORTAX BINARY,
2 BSUP FIXED(1),
2 STARTNUM CHAR(8);
/* COMMENT=ZZZZZ FOR CLOSED ORDER COMMENT=YYYYY FOR BACK ORDER */
DCL 1 TAXST,
2 TAXCODE BINARY,
2 TAXPER FIXED(2),
2 TAXAMOUNT FIXED(9,2);
DCL TAX BINARY,A CHAR(1),CHSOLD FIXED(6,1),BINV# CHAR(5),BTERM CHAR(1);
DCL INORDERDATE CHAR(6),GTOTAL FIXED(11,2),DPART# CHAR(8),BCOMMENT CHAR(25);
DCL SQ FIXED(6),CS CHAR(1),BSQ FIXED(6),NEWDISCMESG CHAR(1),DISCDATE CHAR(8);
DCL DISCOUNT FIXED(4,2),TAXCAL FIXED(11,2),KQ FIXED(12,4);DCL BORDATE CHAR(8);
DCL MMM CHAR(3),DDD CHAR(2),YYY CHAR(2),MM CHAR(2),DD CHAR(2),YY CHAR(2);
DCL COFILE FILE,TAXFILE FILE;DCL TAXREW FIXED(1);
BP: PROCEDURE;CALL OUTPUT(1,2);CALL OUTPUT(1,6);RETURN;END;
OPEN COFILE;OPEN TAXFILE;
AGDATE:PUT FILE(D)SKIP EDIT('ENTER TODAY''S DATE : ')(A(22));
GET SKIP LIST(ORDERDATE);INORDERDATE=ORDERDATE;
MM=SUBSTR(ORDERDATE,1,2);DD=SUBSTR(ORDERDATE,3,2);
YY=SUBSTR(ORDERDATE,5,2);BORDATE=MM CAT '/' CAT DD CAT '/' CAT YY;
PUT FILE(D)LIST(BORDATE,' ? ');GET SKIP LIST(A);IF A¬='Y'THEN GOTO AGDATE;
INVOICE:N=13;GTOTAL=0;PUT FILE(D)SKIP LIST('ENTER ORDER # : ');
GET SKIP LIST(INV#);IF INV#='END ' THEN STOP;
PUT FILE(D)SKIP LIST(INV#,' ? ');GET SKIP LIST(A);IF A¬='Y'THEN GOTO INVOICE;
ON ERROR GOTO MESG2;
READ KEY(INV#)FILE(COFILE)INTO(ORDER)KEYTO(INV#);CHSOLD=SOLDTO;TAX=ORTAX;
PUT SKIP EDIT(SOLDTONAME)(X(6),A(54))(SHIPTONAME)(A(30));
PUT SKIP EDIT(SOLDTOADD1)(X(6),A(54))(SHIPTOADD1)(A(30));
PUT SKIP EDIT(SOLDTOADD2)(X(6),A(54))(SHIPTOADD2)(A(30));
PUT SKIP EDIT('(')(X(6),A(2))(SOLDTO)(P'99999')(' )')(A(47))
('(')(A(2))(SHIPTO)(P'99999')(' )')(A(2));
IF TERM='1'THEN DO;PUT SKIP (4)EDIT('NET 10 EOM')(X(13),A(24));END;
IF TERM='2' THEN DO;PUT SKIP(4) EDIT('3 % 10 EOM')(X(13),A(24));END;
BTERM=TERM;
PUT EDIT(SALESMEN#)(A(12))(CUS#)(A(18))(INV#)(A(5));
IF COMMENT='YYYYY'THEN PUT EDIT('BO')(A(12));ELSE PUT EDIT(' ')(A(12));
ORDERDATE=INORDERDATE;
MM=SUBSTR(ORDERDATE,1,2);DD=SUBSTR(ORDERDATE,3,2);YY=SUBSTR(ORDERDATE,5,2);
BORDATE=MM CAT '/' CAT DD CAT '/' CAT YY;PUT EDIT(BORDATE)(A(8));
PUT SKIP(4);
UNSPEC(COFILE)=UNSPEC(COFILE)-1;
BINV#=INV#;
INVREAD: ON ENDFILE GOTO THINV;
READ FILE(COFILE)INTO(ORDER);IF COMMENT='ZZZZZ' THEN GOTO INVREAD;
CHSOLD=SOLDTO;IF INV#¬=BINV# THEN DO;UNSPEC(COFILE)=UNSPEC(COFILE)-1;
GOTO THINV;END;
IMLN: GOTO SPCH;
SKAG:PUT EDIT(OVERPRICE)(X(6),P'ZZZV.99');
IF OVERPRICE=DISPRICE THEN DO;PUT EDIT(' ')(A(8));
END; IF DISPRICE¬=OVERPRICE THEN DO;NEWDISCMESG='0';
IF DISPRICE/OVERPRICE<.59 THEN NEWDISCMESG='1';
IF DISPRICE/OVERPRICE<.49 THEN NEWDISCMESG='2';OVERPRICE=DISPRICE;
PUT EDIT(DISPRICE)(P'ZZZZV.99',X(1));END;
IF SUBSTR(PART#,1,2)¬='SP' THEN PUT EDIT(ORUNITQTY)(P'ZZZZZ9',X(3));
IF SUBSTR(PART#,1,2)='SP'THEN PUT LIST(' FLAT ');
KQ=SQ*(OVERPRICE/ORUNITQTY);
IF SUBSTR(PART#,1,2)='SP' THEN KQ=SQ*OVERPRICE;
PUT EDIT(KQ)(P'ZZZZV.99');
GTOTAL=GTOTAL+(KQ);
V: IF SUBSTR(PART#,1,2)='SP' THEN DO;IF RUNPRICE¬=0 THEN DO;
PUT SKIP EDIT('RUNNING CHARGE')(X(34),A(27))(RUNPRICE)(P'ZZZV.99');N=N-1;
IF RUNPRICE=DISRUN THEN DO;PUT EDIT (' ')(A(9));END;
IF DISRUN¬=RUNPRICE THEN DO;
PUT EDIT(DISRUN)(P'ZZZZV.99',X(2));END;
PUT EDIT(' M ')(A(8));
PUT EDIT((BSQ/ORUNITQTY)*DISRUN)(P'ZZZZV.99');
GTOTAL=GTOTAL+((BSQ/ORUNITQTY)*DISRUN);
END;END;
IF COMMENT='YYYYY'THEN ORDERQTY=ORDERQTY - SQ;
REWRITE FILE(COFILE)FROM(ORDER);GOTO INVREAD;
SPCH: DPART#=PART#;IF SUBSTR(PART#,1,2)¬='SP' & BSUP ¬=0 THEN DO;
NOCARB: DO I =((BSUP)+1) TO 8;SUBSTR(PART#,I,1)=' ';END;END;
PUT FILE(D)SKIP EDIT(ORDERQTY)(P'ZZZZZ9',X(3))
(PART#)(A(66))('QUANTITY SHIPPED :')(A(18));;
GET SKIP LIST(SQ);PUT SKIP EDIT(SQ)(P'ZZZZZ9')(ORDERQTY)(X(4),P'ZZZZZ9',X(3))
(PART#)(A(10))(DES)(A(27));
NOROLL: PART#=DPART#;
N=N-1;BCOMMENT=COMMENT;COMMENT='ZZZZZ';
IF SQ< ORDERQTY THEN DO;BACKAG: PUT FILE(D)SKIP LIST('BACK ORDER ? ');
GET SKIP LIST(A);IF A='Y' THEN DO;COMMENT='YYYYY';GOTO BACKOK;END;
IF A¬='N' THEN GOTO BACKAG;END;
BACKOK: IF SUBSTR(PART#,1,2)¬='SP' THEN BSQ=SQ;
IMP1: GOTO SKAG;
THINV: IF SUBSTR(INV#,1,1)='P' THEN NEWDISCMESG='0';
IF NEWDISCMESG¬='0'& BTERM='2'THEN DO;
PUT SKIP(2)EDIT('TOTAL FORMS : ')(X(29),A(19));
IF NEWDISCMESG='1'THEN PUT LIST('1000 & OVER');ELSE PUT LIST('3000 & OVER');
PUT SKIP EDIT('MINIMUM : 500 EACH FORM')(X(29),A(32));
PUT SKIP EDIT('SPECIAL DISCOUNT : ')(X(29),A(19));
IF NEWDISCMESG='1'THEN PUT LIST('50%');ELSE PUT LIST('(50+5)%');
N=N-4;END;NEWDISCMESG='0';PUT SKIP(N-2)EDIT(BCOMMENT)(X(29),A(26));
IF BTERM='2'THEN DO;
MMM=MM+101;IF DD>24 THEN MMM=MMM+1;DDD=10;YYY=YY;IF SUBSTR(MMM,2,2)>12 THEN DO;
SUBSTR(MMM,2,2)=SUBSTR(MMM,2,2)-12;
YYY=YYY+1;END;IF SUBSTR(MMM,2,1)='0' THEN SUBSTR(MMM,2,2)=SUBSTR(MMM,3,1);
DISCDATE=SUBSTR(MMM,2,2) CAT '/' CAT DDD CAT '/' CAT YYY;
DISCOUNT=GTOTAL*.03;
PUT SKIP(2)EDIT('HERE''S EXTRA PROFIT FOR YOU!')(X(14),A(41));END;
ELSE PUT SKIP(2)EDIT('')(A(55));
PUT EDIT(GTOTAL)(X(22),P'ZZZ,ZZZ,ZZZV.99');
ON ERROR GOTO MESG4;
READ KEY(TAX)FILE(TAXFILE)INTO(TAXST);
TAXREW=1;
TAXAG:IF BTERM='2' THEN DO;PUT SKIP EDIT(' YOU MAY DEDUCT $')(A(17))
(DISCOUNT)(P'ZZV.99')(' FOR PAYMENT RECEIVED BY ')(A(25))(DISCDATE)(A(8));;
END;ELSE PUT SKIP EDIT('')(A(55));TAXCAL=(GTOTAL*TAXPER)/100;
TAXAMOUNT=TAXAMOUNT+TAXCAL;PUT EDIT(TAXCAL)(X(26),P'ZZZ,ZZZV.99');
PUT FILE(D)SKIP LIST('DELIVERY CHARGE : ');GET SKIP LIST(CHAMOUNT);
PUT SKIP EDIT(CHAMOUNT)(X(81),P'ZZZ,ZZZV.99');GTOTAL=GTOTAL+CHAMOUNT+TAXCAL;
PUT FILE(D)SKIP LIST('OTHER CHARGE : ');GET SKIP LIST(CHAMOUNT);
PUT SKIP EDIT(CHAMOUNT)(X(81),P'ZZZ,ZZZV.99');GTOTAL=GTOTAL+CHAMOUNT;
PUT SKIP EDIT(GTOTAL)(X(77),P'ZZZ,ZZZ,ZZZV.99');GTOTAL=0;
IF TAXREW=0 THEN GOTO PRDEL;
REWRITE FILE(TAXFILE)FROM(TAXST);
PRDEL: PUT SKIP(13);GOTO INVOICE;
MESG2: CALL BP;PUT FILE(D)SKIP LIST('SORRY WRONG INV# ');GET SKIP LIST('');
GOTO INVOICE;
MESG4: CALL BP;PUT FILE(D)SKIP LIST('NO SUCH TAX CODE ! ');GET SKIP LIST('');
PUT FILE(D)SKIP LIST('ENTER TAX % : ');GET SKIP LIST(TAXPER);GOTO TAXAG;
TAXREW=0;
END;