|
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: 9243 (0x241b)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »GENLEDA«
└─⟦934333717⟧ Bits:30008597 DDMQ1-0029_Demonstration_Disk_SOURCE_Single_Density_Sept_77
└─⟦this⟧ »GENLEDA«
PAGE: PROCEDURE(LINE);
DCL LINE BINARY;
PUT SKIP (LINE); RETURN; END;
DCL 1 TRAN,
2 ACCT BINARY, 2 YEAR(13)BINARY, 2 MONTH(13)BINARY,
2 DAY(13)BINARY, 2 V#(13)BINARY, 2 V#1(13)BINARY,
2 AMT(13)FLOAT(9), 2 DES(13)CHAR (18);
DCL TRANFL FILE;
DCL AC CHAR (1), B CHAR (1), C CHAR (1),
D CHAR (1), E CHAR (1), FF CHAR (1);
DCL REM FLOAT (3), VOU FLOAT (8), VO FLOAT (8), VO1 FLOAT (8),
STOREV CHAR (8),VCH CHAR (8),B1 CHAR (1),
B50 CHAR(50)INIT(' '),
C11 CHAR (11) INIT ('-----------'),
B10 CHAR (10) INIT (' '), DR# CHAR (6),
CR# CHAR (6), N# CHAR (6), A$ FLOAT (9), AA$ FLOAT (9),
DDES CHAR (19), ND FLOAT (4), SAVD FLOAT (4), SAVC FLOAT (4),
VN BINARY, VM BINARY, DD BINARY, MM BINARY,
YY BINARY, X CHAR (3), Y CHAR(1), DRTL FLOAT(11), CRTL FLOAT(11);
SEEOF: PROCEDURE(FL);
DCL FL(1) BINARY;
FL(1)=FL(6); RETURN; END;
CHECK: PROCEDURE(A1); DCL A1 CHAR(1), Q FLOAT(1);
A1=(AC); Q=2;
GET LIST(B,C,D,E,FF);
REM=((A1*6)+(B*5)+(C*4)+(D*3)+(E*2)+FF);
PUT FILE(DISPLAY) LIST(A1,B,C,D,E,FF);
RS: IF REM<7 THEN GO TO REMAIN; REM=REM-7; GO TO RS;
REMAIN: IF REM¬=0 THEN GOTO CAD; Q=1;
RT: N#=A1ööBööCööDööEööFF;
X=DööE; ND=B*5+X; ND=ND+1;
CAD: RETURN(Q);END;
OPEN TRANFL; READ FILE (TRANFL) INTO (TRAN);
IF ACCT¬=0 THEN GO TO ST;
IF SUBSTR(DES(1),1,8)¬=' TRANFL' THEN GOTO ST;
SWITCH=0; ND=0; III=0; DRTL=0; CRTL=0;
ASK: PUT FILE (DISPLAY) SKIP LIST ('DATE (DAY MONTH YEAR): ');
GET SKIP LIST (DD,MM,YY);
IF DD>31 ö MM>12 THEN GOTO ASK;
DAY(2)=DD; MONTH(2)=MM; YEAR(2)=YY;
REWRITE FILE (TRANFL) FROM (TRAN);
PUT SKIP EDIT(B50) (A(51))(' A B C INT''L LTD.,')(A(21));
PUT SKIP(3) EDIT (B50) (A(51)) (' TRANSACTION JOURNAL')(A(22));
PN=2; PUT SKIP(PN);
PUT SKIP EDIT (B10)(A(11)) ('VOUCHER#')(A(9)) (B10)(A(11));
PUT EDIT ('DESCRIPTION ')(A(20))(B10)(A(11));
PUT EDIT (C11)(A(12))('DEBIT')(A(6))(C11)(A(12));
PUT EDIT (B10)(A(11)) (C11) (A(12));
PUT EDIT ('CREDIT')(A(7));
PUT EDIT (C11)(A(11)); PUT SKIP(3);
AGA: PUT FILE(DISPLAY) SKIP EDIT (' ')(A(37))('DEBIT ACCOUNT NO')(A(17))
(':')(A(20))('CREDIT ACCOUNT NO:')(A(37))('AMOUNT')(A(17))(':')(A(20))
('DESCRIPTION')(A(17))(':')(A(131))('VOUCHER NO')(A(17))(':')(A(2));
AAG: GET SKIP LIST (STOREV);
IF SUBSTR(STOREV,1,3)='END' THEN GOTO TOT;
IF VERIFY(STOREV,'0123456789 ')=0 ö STOREV=' ' THEN GOTO AAG;
VOU=STOREV; VN=0; VM=VOU; PUT FILE(DISPLAY) EDIT(VOU)(P'99999999')
(' ')(A(10)); IF VOU<250 THEN GOTO NEXT;
VO=VOU/250; REM=VO; VO1=VO;
IF REM¬=0 THEN VO1=VO1+1;
VO1=250-(VO1*250-VOU); VO=VO-REM;
IF VO1=250 THEN VO1=0; VN=VO; VM=VO1;
NEXT: STOREV=VOU; VCH='0'ööVCH; L=INDEX(STOREV,' ');
M=8-L; SUBSTR(VCH,M,L)=STOREV; GOTO DRCR;
DRA: PUT FILE(DISPLAY) SKIP EDIT (' ')(A(111))('CREDIT ACCOUNT NO:')(A(37))
('AMOUNT')(A(17))(':')(A(20))('DESCRIPTION')(A(17))(':')(A(94))
('VOUCHER NO')(A(17))(':')(A(2))(VOU)(P'99999999')(' ')(A(10))
('DEBIT ACCOUNT NO')(A(17))(':')(A(2));
PUT FILE(DISPLAY) LIST (AC,B,C,D,E,FF,'-WRONG A/C #');
DRCR: PUT FILE (DISPLAY) LIST ('DEBIT ACCOUNT NO : ');
GET SKIP LIST(AC); IF AC=' ' THEN GOTO CR;
IF CHECK(AC)¬=1 THEN GO TO DRA; PUT FILE(DISPLAY) EDIT (' ')(A(12));
SAVD=ND; MDX=X; X=BööC; NDX=X; DR#=N#; GOTO CR;
CRA: PUT FILE(DISPLAY) SKIP EDIT (' ')(A(148))('AMOUNT')(A(17))(':')(A(20))
('DESCRIPTION')(A(17))(':')(A(94))('VOUCHER NO')(A(17))(':')(A(2))
(VOU)(P'99999999',X(10))('DEBIT ACCOUNT NO')(A(17))(':')(A(2))(N#)
(A(18))('CREDIT ACCOUNT NO:')(A(19));
PUT FILE(DISPLAY) LIST (AC,B,C,D,E,FF,'-WRONG A/C #');
CR: PUT FILE(DISPLAY) LIST('CREDIT ACCOUNT NO: ');
GET SKIP LIST(B1);IF B1=' ' THEN GOTO AMD;AC=B1;
IF CHECK(AC)¬=1 THEN GOTO CRA; PUT FILE(DISPLAY) EDIT(' ')(A(12));
SAVC=ND; MCX=X; X=BööC; NCX=X; CR#=N#;
AMD: PUT FILE (DISPLAY) EDIT ('AMOUNT')(A(17))(':')(A(2)); GET SKIP LIST(A$);
PUT FILE(DISPLAY) EDIT(A$)(P'$$$$$$$$9V.99')(' ')(A(6))('DESCRIPTION')
(A(17))(':')(A(2)); GET SKIP LIST(DDES);
IF SUBSTR(DDES,1,2)='AG' THEN GOTO AGA; AA$=A$; CRTL=CRTL+AA$;
DRTL=DRTL+A$; VO1=STOREV;
PUT EDIT (B10)(A(11))(VO1)(P'99999999') (B10)(A(11));
PUT LIST (SUBSTR(DDES,1,18)); PUT EDIT (B10)(A(14));
IF SWITCH=0 THEN PUT EDIT (DR#)(A(7)) (B10)(A(10));
PUT EDIT (A$)(P'ZZZZZZZZ9V.99');
PUT EDIT (B10)(A(12));
IF SUBSTR(B1,1,1)=' 'THEN GOTO PCR;
PUT EDIT (CR#)(A(7)) (B10)(A(11));
PUT EDIT (AA$)(P'ZZZZZZZZ9V.99');
PCR: PUT SKIP;
IF SWITCH=0 THEN DO I=1 TO 1;
III=SAVD-1; UNSPEC (TRANFL)=III;
READ FILE (TRANFL) INTO (TRAN);
DES(DAY(1))=DDES; AMT(DAY(1))=A$;
DAY(DAY(1))=DD; MONTH(DAY(1))=MM; YEAR(DAY(1))=YY;
V#(DAY(1))=VN; V#1(DAY(1))=VM;
DAY(1)=DAY(1)+1; MONTH(1)=MONTH(1)+1;
REWRITE FILE(TRANFL) FROM(TRAN);
END;
IF SUBSTR(B1,1,1)=' ' THEN GOTO AGA;
III=SAVC-1; UNSPEC (TRANFL)=III;
READ FILE (TRANFL) INTO (TRAN);
DES(DAY(1))=DDES; AMT(DAY(1))=AA$-AA$*2;
DAY(DAY(1))=DD; MONTH(DAY(1))=MM; YEAR(DAY(1))=YY;
V#(DAY(1))=VN; V#1(DAY(1))=VM;
DAY(1)=DAY(1)+1; MONTH(1)=MONTH(1)+1;
REWRITE FILE (TRANFL) FROM (TRAN);
GOTO AGA;
TOT: PUT SKIP(3) EDIT (' ')(A(32))('TOTAL:')(A(47))(DRTL)(P'ZZZZZZZZ9V.99')
(' ')(A(30))(CRTL)(P'ZZZZZZZZ9V.99'); PUT SKIP(50);
ST: END;