|
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: 13509 (0x34c5)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »VINVOICE«
└─⟦934333717⟧ Bits:30008597 DDMQ1-0029_Demonstration_Disk_SOURCE_Single_Density_Sept_77
└─⟦this⟧ »VINVOICE«
/**INVOICING DEMONSTRATION PROGRAM */
/* NAME: INVOICE FOR V.R. STINER ONLY */
DCL F1 FLOAT(1), F2 FLOAT(1), F3 FLOAT(1), F4 FLOAT(1), F5 FLOAT(1),
F6 FLOAT(1), G FLOAT(1), E BINARY, LINE BINARY;
DCL CLENTMA FILE, STOCKFL FILE, TRANFL2 FILE;
DCL 1 CLENTMAS_REC, 2 CACCT_NO CHAR(6), 2 M_NAME(4) CHAR(30),
2 M_BALANCE FLOAT(8);
DCL 1 STOCKMAS_REC, 2 M_STOCKNO CHAR(6), 2 M_DESCRIPTION CHAR(30),
2 M_UNIT CHAR(6), 2 M_UNITPRICE(4) FLOAT (5), 2 ON_HAND FLOAT(5);
DCL BLNK CHAR(30), NINE CHAR(25)INIT(' '),
MES2 CHAR(30)INIT('END OF INVOICING, CHANGE PAPER'),
MES3 CHAR(23) INIT('INVOICE PREPARATION ON:'),
MES4 CHAR(24) INIT('INITIAL INVOICE NUMBER '),
MES5 CHAR(26) INIT('TOTAL INVOICE AMOUNT IS ');
DCL VALUE FIXED(12,2), RATING CHAR(1), RRM FIXED (1);
DCL 1 TRAN, 2 ARR CHAR (25);
DCL MONTH CHAR(3), DAY FIXED(2), DD CHAR(2), YY CHAR(2), MM CHAR(2),
SINA(40) BINARY INIT (16,18,13,15,12,15,18,14,15,19,16,11,17,10,18,10,18,
18,16,16,14,16,12,16,16,11,17,14,18,15,15,14,19,16,18,16,18,10,17,9),
SINB(40) BINARY INIT (1,1,1,1,1,1,1,1,1,1,1,1,19,1,1,1,20,1,18,1,16,1,13,
17,1,13,1,16,1,17,17,1,1,1,20,18,20,1,19,11), VA FIXED(5),
SINC(41) BINARY INIT(1,1,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,
1,1,1,2,2,1,2,1,2,2,1,1,1,1,1,1),
M_CODE FIXED(2), YEAR FIXED(2), W_AREA1 FIXED(2), W_AREA2 FLOAT(2),
R BINARY, CH9 CHAR(9), C3 CHAR(2), S3 FLOAT(2), ANS CHAR(1),
DUM CHAR(9), BLANK1 CHAR(1) INIT(' '), INIT_INV FLOAT(5),
INV_NO FLOAT(5), BLANK20 CHAR(19) INIT(' '),
W_AREA3 CHAR(6), W_AREA5 CHAR(6), PASS CHAR (8), ORDER FIXED (12,2),
B4 CHAR(4) INIT(' '),QTY FLOAT(5), AMOUNT FLOAT(8),
TOTAL FLOAT(8), B10 CHAR(9) INIT(' '), INV_TOTAL FLOAT(9),
TEM BINARY, B9 CHAR(9) INIT(' '),
MESS CHAR(13) INIT('**TRY AGAIN -');
DCL NI(13) FLOAT(2) INIT(1,2,3,4,5,6,7,8,9,10,11,12,30);
DCL MON(12) CHAR(3) INIT('JAN','FEB','MAR','APR','MAY','JUN','JUL',
'AUG','SEP','OCT','NOV','DEC');
TOTAL=0; AMOUNT=0; INV_TOTAL=0; BLNK=' 'ööBLNK; R=0;
OPEN CLENTMA; OPEN STOCKFL; OPEN TRANFL2; ARR='9'ööARR;
PASSWORD: DO I=1 TO 3;
PUT FILE(DISPLAY) SKIP LIST('PLEASE ENTER YOUR PASSWORD: ');
GET SKIP LIST(PASS); IF PASS='MICROCOM' THEN GO TO AAA; END; GO TO ZZZZ;
AAA: PUT FILE(DISPLAY)SKIP;
ASK: PUT FILE(DISPLAY) LIST ('DATE (DAY MONTH YEAR): ');
GET SKIP LIST(DAY,M_CODE,YEAR); MM=M_CODE;DD=DAY; YY=YEAR;
IF M_CODE>NI(12) ö M_CODE<NI(1) THEN GO TO WRONG_DATE;
IF DAY>31 ö DAY<NI(1) THEN GO TO WRONG_DATE;
IF M_CODE¬=NI(2) THEN GO TO CHECK_MONTH;
IF DAY>29 THEN GO TO WRONG_DATE;
W_AREA1=YEAR; W_AREA1=W_AREA1/4; W_AREA1=W_AREA1*4;
IF W_AREA1¬=YEAR & DAY>28 THEN GO TO WRONG_DATE; GO TO TRANSLATE;
CHECK_MONTH: IF M_CODE=NI(4) & DAY>NI(13) THEN GO TO WRONG_DATE;
IF M_CODE=NI(6) & DAY>NI(13) THEN GO TO WRONG_DATE;
IF M_CODE=NI(11) & DAY>NI(13) THEN GO TO WRONG_DATE;
TRANSLATE: MONTH=MON(M_CODE); PUT FILE(DISPLAY) SKIP LIST ('DATE: ');
PUT FILE(DISPLAY) EDIT(DAY)(P'99')(' ')(A(1))(MONTH)(A(3))(YEAR)(P'Z99')('?')
(A(2)); GET SKIP LIST(ANS); IF ANS¬='Y' THEN GO TO AAA;
SUBSTR(ARR,1,2)=YY;SUBSTR(ARR,3,2)=MM; SUBSTR(ARR,5,2)=DD;
WRITE FILE(TRANFL2) FROM (TRAN); GO TO ASK1;
WRONG_DATE: PUT FILE(DISPLAY) SKIP EDIT('** WRONG DATE!!')(A(16))(DAY)(P'99');
PUT FILE(DISPLAY) EDIT (M_CODE)(P'Z99')(YEAR)(P'Z99')(' ')(A(13))(MESS)(A(14));
GOTO ASK;
ASK1: PUT FILE(DISPLAY)SKIP LIST('INITIAL INVOICE NO.? ');
GET SKIP LIST(INV_NO);R=0;
PUT FILE(DISPLAY) SKIP EDIT('*')(A(1))(INV_NO)(P'ZZZZZ')('?')(A(2));
GET SKIP LIST(ANS); IF ANS¬='Y' THEN GO TO ASK1; INIT_INV=INV_NO;
NEW_INV: TOTAL=0; LINE=11;
BBB: PUT FILE(DISPLAY) SKIP;
ASK2: PUT FILE(DISPLAY)LIST('ACCOUNT NUMBER: '); GET SKIP LIST(W_AREA3);
IF SUBSTR(W_AREA3,1,3)='END' THEN GO TO EOJ;
IF SUBSTR(W_AREA3,1,3)='ENQ' THEN GO TO JOB; X=W_AREA3; GOTO SEARCH;
ERR1: PUT FILE(DISPLAY) SKIP EDIT('** INVALID ACCOUNT NUMBER!! : ')(A(30))
(W_AREA3)(A(7))(MESS)(A(14)); GO TO ASK2;
JOB: PUT FILE(DISPLAY) SKIP LIST ('ENQUIRE WHICH ');
IF SUBSTR(W_AREA3,1,4)='ENQS' THEN GO TO JOB2;
IF SUBSTR(W_AREA3,1,4)='ENQC' THEN GO TO JOB1;
PUT FILE(DISPLAY) SKIP EDIT('**INVALID COMMAND**')(A(37))(MESS)(A(14));
GOTO ASK2;
JOB1: R=1; GOTO ASK2;
JOB2: R=3; GOTO ASK3;
PLAY: VALUE=M_UNITPRICE(1)*ON_HAND*0.8;
PUT FILE(DISPLAY) SKIP EDIT ('STOCK NO')(A(12))(' :')(A(3))(M_STOCKNO)(A(22));
IF SINC(NO)=2 THEN PUT FILE(DISPLAY) EDIT ('DES : ')(A(7))(M_DESCRIPTION)
(A(30)); IF SINC(NO)=1 THEN PUT FILE(DISPLAY) EDIT ('DESCRIPTION : ')(A(15))
(M_DESCRIPTION)(A(22)); PUT FILE(DISPLAY) EDIT ('UNIT')(A(13));
PUT FILE(DISPLAY) EDIT (':')(A(2))(M_UNIT)(A(22))('UNIT PRICE :')(A(14));
DO KI=1 TO 4; IF KI¬=1 THEN PUT FILE(DISPLAY) LIST (' ');
PUT FILE(DISPLAY)EDIT (M_UNITPRICE(KI))(P'Z9V.99'); END;
PUT FILE(DISPLAY) EDIT('QTY ON HAND :')(A(15))(ON_HAND)(P'ZZZZZZ9');
PUT FILE(DISPLAY) EDIT (B9)(A(15))('VALUE')(A(13))(':')(A(2));
PUT FILE(DISPLAY) EDIT (VALUE)(P'$$$$$$9V.99')(B9)(A(12));
PUT FILE(DISPLAY) EDIT ('LOCATION : STORE')(A(20))(I)(P'ZZ9');
PUT FILE(DISPLAY) LIST (B9,' REORDER LEVEL: 1000'); GOTO RESET;
PLAY1: ANS=SUBSTR(W_AREA3,6,1); MR=ANS; VALUE=M_BALANCE*0.4; NO=NO+1;
KI=31-SINB(NO); ORDER=M_BALANCE-5000; RATING='A';
IF MR>3 THEN RATING='B'; IF MR>6 THEN RATING='C';
PUT FILE(DISPLAY) SKIP EDIT ('ACCOUNT NO. :')(A(18))(CACCT_NO)(A(19));
PUT FILE(DISPLAY) EDIT('NAME')(A(16))(':')(A(2))(SUBSTR(M_NAME(1),1,SINA(NO)))
(A(19)); IF SINB(NO)¬=1 THEN PUT FILE(DISPLAY) EDIT (' ')(A(18))
(SUBSTR(M_NAME(1),SINB(NO),KI))(A(19));
PUT FILE(DISPLAY) EDIT ('RATING')(A(16));
PUT FILE(DISPLAY) EDIT (':')(A(2))(RATING)(A(19))('AMOUNT DUE')(A(16));
PUT FILE(DISPLAY) EDIT (':')(A(2))(ORDER)(P'$$$$$$$9V.99')(B9)(A(8));
PUT FILE(DISPLAY) EDIT ('LAST MNTHS ORDER:')(A(18))(VALUE)(P'$$$$$$$9V.99');
PUT FILE(DISPLAY) EDIT (B9)(A(8))('YEAR TO DATE :')(A(18));
PUT FILE(DISPLAY) EDIT (M_BALANCE)(P'$$$$$$$9V.99')(B4)(A(4));
PUT FILE(DISPLAY) LIST (' SALESMAN : SHIH WEI SHENG');
RESET: GET SKIP LIST (ANS);R=0; GOTO BBB;
SEARCH: IF VERIFY(W_AREA3,'0123456789')=0 THEN GOTO ERR1; ORDER=0;
DO I=1 TO 5; RATING=SUBSTR(W_AREA3,I,1); MR=RATING; ORDER=ORDER+(MR*I); END;
RATING=SUBSTR(W_AREA3,6,1); VALUE=RATING; ORDER=ORDER+VALUE;
VA=ORDER/10; RRM=ORDER-(VA*10);
IF RRM¬=0 THEN GOTO ERR1; YY=SUBSTR(W_AREA3,4,2); MM=SUBSTR(W_AREA3,2,1);
ORDER=YY; VALUE=MM; NO=(10*(VALUE-1))+(ORDER/5)-2; C3=NO+1;
IF NO>=40 THEN GOTO ERR1;
UNSPEC(CLENTMA)=NO; READ FILE(CLENTMA) INTO (CLENTMAS_REC);
IF W_AREA3=CACCT_NO & R=1 THEN GOTO PLAY1;
IF W_AREA3¬=CACCT_NO THEN GOTO ERR1;
PUT SKIP LIST(B10,M_NAME(1),BLANK20,B10,' ',W_AREA3);
PUT SKIP;PUT SKIP LIST (B10,M_NAME(2));
PUT SKIP LIST(B10,M_NAME(3),BLANK20);
PUT EDIT(B10)(A(11))(MONTH)(A(4))(DAY)(P'99')(',')(A(2))(YEAR)(P'99');
PUT SKIP EDIT(B10)(A(9))(M_NAME(4))(A(31))(BLANK20)(A(20))(B10)(A(10));
PUT EDIT (INV_NO)(P'99999'); PUT SKIP(7); YY=SUBSTR(CACCT_NO,2,1);
W_AREA2=YY;
CCC: PUT FILE(DISPLAY) SKIP;
ASK3: PUT FILE(DISPLAY) LIST('STOCK NUMBER: '); GET SKIP LIST(W_AREA5);
ANS=SUBSTR(W_AREA5,1,1); IF ANS='E' THEN GOTO EOI;X=W_AREA5; GOTO SEARCH2;
ERR2: PUT FILE(DISPLAY) SKIP EDIT('**INVALID STOCK NUMBER!! :')(A(28))
(W_AREA5)(A(9))(MESS)(A(14)); GO TO ASK3;
SEARCH2: IF VERIFY(W_AREA5,'0123456789')=0 THEN GOTO ERR2;
ORDER=0; DO II=1 TO 5; RATING=SUBSTR(W_AREA5,II,1); MR=RATING;
ORDER=ORDER+(MR*II);END; RATING=SUBSTR(W_AREA5,6,1); VALUE=RATING;
ORDER=ORDER+VALUE; VALUE=ORDER/10; RRM=ORDER-(VALUE*10);
IF RRM¬=0 THEN GOTO ERR2; YY=SUBSTR(W_AREA5,4,2); NO=YY;
IF NO>41 THEN GOTO ERR2;
UNSPEC(STOCKFL)=NO-1; READ FILE(STOCKFL) INTO (STOCKMAS_REC);
IF W_AREA5=M_STOCKNO & R=3 THEN GOTO PLAY;IF W_AREA5¬=M_STOCKNO THEN GOTO ERR2;
PUT SKIP EDIT(M_STOCKNO)(A(7))(' ')(A(2))(M_DESCRIPTION)(A(31));
PUT EDIT(' ')(A(4))(M_UNIT)(A(7))(' ')(A(3));
PUT EDIT(M_UNITPRICE(W_AREA2))(P'Z9V.99'); PUT FILE(DISPLAY) SKIP;
CH_QTY: PUT FILE(DISPLAY) LIST('QUANTITY: ');
GET SKIP LIST(QTY); IF QTY>ON_HAND THEN GO TO REJECT;
PUT EDIT(QTY)(P'ZZZZZ9');AMOUNT=M_UNITPRICE(W_AREA2)*QTY;
PUT EDIT(' ')(A(2))(AMOUNT)(P'ZZZZZZ9V.99'); TOTAL=TOTAL+AMOUNT;
LINE=LINE-1; IF QTY=0 THEN GO TO CCC; ON_HAND=ON_HAND-QTY;
REWRITE FILE(STOCKFL) FROM (STOCKMAS_REC); SUBSTR(ARR,1,6)=W_AREA5;
SUBSTR(ARR,7,5)=INV_NOööB4; SUBSTR(ARR,12,5)=QTYööB9; DUM=AMOUNT;
SUBSTR(ARR,17,9)=DUMööB9; WRITE FILE (TRANFL2) FROM (TRAN); GOTO CCC;
REJECT: PUT FILE(DISPLAY) SKIP EDIT ('**NOT ENOUGH STOCK FOR:')(A(24))(QTY)
(P'ZZZZ9')('!!')(A(8));
PUT FILE(DISPLAY) EDIT ('**MAX STOCK AUAILABLE :')(A(23))(ON_HAND)(P'ZZZZZ9');
PUT FILE(DISPLAY) EDIT (' ')(A(8))(MESS)(A(14)); GOTO CH_QTY;
EOI: LINE=LINE-1; PUT SKIP(LINE);
PUT SKIP LIST(BLANK20,BLANK20,BLANK20,' ');
PUT EDIT(TOTAL)(P'ZZZZZZ9V.99'); INV_TOTAL=INV_TOTAL+TOTAL;
PUT SKIP(10); INV_NO=INV_NO+1; M_BALANCE=M_BALANCE+TOTAL;
REWRITE FILE(CLENTMA) FROM (CLENTMAS_REC); SUBSTR(ARR,1,6)=W_AREA3;
DUM=INV_NO-1; SUBSTR(ARR,7,5)=DUMööB4;SUBSTR(ARR,12,2)=C3ööB4;
DUM=TOTAL; SUBSTR(ARR,17,9)=DUMööB9;
WRITE FILE(TRANFL2) FROM (TRAN); GO TO NEW_INV;
EOJ: I=1; PUT FILE(DISPLAY) SKIP LIST(MES2);
GET SKIP LIST(ANS); PUT SKIP LIST(BLANK20,MES3,' ');
PUT EDIT(MONTH)(A(4))(DAY)(P'99')(YEAR)(P'Z99');
PUT SKIP(3) LIST(BLANK20,MES4);
PUT EDIT (' ')(A(5))(INIT_INV)(P'999999'); INV_NO=INV_NO-1;
PUT SKIP LIST(BLANK20,'LAST INVOICE NUMBER ');
PUT EDIT(INV_NO)(P'999999'); INV_NO=INV_NO-INIT_INV+1;
PUT SKIP EDIT(B9)(A(19))('TOTAL INVOICE PRINTED')(A(29))(INV_NO)(P'ZZZZ9');
PUT SKIP LIST(BLANK20,MES5);
PUT EDIT(INV_TOTAL)(P'ZZZZZZ9V.99');
ARR='999999'; WRITE FILE(TRANFL2) FROM (TRAN); CLOSE TRANFL2;
ZZZZ: END;