|
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: 5925 (0x1725)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »HUVBOK«
└─⟦3e550eca6⟧ Bits:30008695 DDMQ1-0135_DUBBEL
└─⟦this⟧ »HUVBOK«
DCL 1 VER,
2 VENR CHAR(6),
2 DATUM CHAR(6),
2 KOSTST CHAR(4) INIT(' '),
2 DEBET CHAR(4)INIT(' '),
2 KREDIT CHAR(4)INIT(' '),
2 BELOPP FIXED(11,2),
2 VTEXT CHAR(20),
2 KOD CHAR(2)INIT(' ');
DCL 1 BOK,
2 KONTONR CHAR(4),
2 TEXT CHAR(25);
DCL 1 BALANS,
2 KONTO CHAR(4),
2 DSALDO(12) FIXED(10,2),
2 KSALDO(12) FIXED(10,2);
DCL VERIFILE FILE; DCL BKONTO FILE; DCL SALREG FILE;
DCL RUB1 CHAR(50)INIT('M S T E N H A R D T A B PROGR: A101');
DCL RUB2 CHAR(55)INIT(' H U V U D B O K DATUM ');
DCL RUB3 CHAR(50)INIT('KONTO BENÄMNING');
DCL RUB4 CHAR(40)INIT('TEXT');
DCL RUB5 CHAR(55)INIT('VERIF.NR DATUM DEBET KREDIT SALDO');
DCL DAT CHAR(8); PUT FILE(DISP)SKIP LIST('ANGE DATUM '); GET LIST(DAT);
PUT SKIP(3) EDIT(RUB1) (A(50)) (RUB2) (A(50)) (DAT) (A(15));PUT LIST('SIDA');
S = 1; PUT EDIT(S) (P'ZZZ');
PUT SKIP(2) EDIT(RUB3) (A(40)) (RUB4) (A(25));PUT LIST(RUB5);
PUT SKIP(2) LIST(' ');
OPEN VERIFILE; OPEN BKONTO; OPEN SALREG;
DCL SUM1 FIXED(11,2) INIT(0), SUM2 FIXED(11,2)INIT(0);
DCL TOTS1 FIXED(12,2)INIT(0), TOTS2 FIXED(12,2)INIT(0);
DCL SAL FIXED(11,2)INIT(0), TOTSAL FIXED(11,2)INIT(0);
RADR = 6; DCL MAN CHAR(2); A = 0; B = 0; DCL C CHAR(1)INIT(' ');
PUT FILE(DISP) SKIP LIST('ANGE AKTUELL MÅNAD '); GET LIST(MAN);
START: ON ENDFILE GO TO SLUT;
READ FILE(BKONTO) INTO(BOK); OPEN VERIFILE;
OMIG: ON ENDFILE GO TO PRI;
READ FILE(VERIFILE) INTO(VER);
IF(SUBSTR(DATUM,3,2) ¬= MAN) THEN GO TO OMIG;
IF(DEBET = KONTONR ) THEN GO TO DEB;
IF(KREDIT = KONTONR) THEN GO TO KRED; GO TO OMIG;
DEB:A = A + 1; SUM1 = SUM1 + BELOPP; TOTS1 = TOTS1 + BELOPP;
IF(A = 1) THEN PUT SKIP(2)EDIT(KONTONR) (A(8)) (TEXT) (A(34));
PUT EDIT(VTEXT) (A(27));
PUT EDIT(VENR) (A(8)) (DATUM) (A(6))(BELOPP) (P'-------9V.99');
RADR = RADR + 1; IF(RADR = 43) THEN GO TO NYR; PUT SKIP EDIT(C)(A(42));
B = 1; GO TO OMIG;
KRED: B = B + 1; SUM2 = SUM2 + BELOPP; TOTS2 = TOTS2 + BELOPP;
IF(B = 1) THEN PUT SKIP(2) EDIT(KONTONR) (A(8)) (TEXT) (A(34));
PUT EDIT(VTEXT) (A(27));
PUT EDIT(VENR) (A(8)) (DATUM) (A(19)) (BELOPP)(P'--------9V.99');
RADR = RADR + 1; IF(RADR = 43) THEN GO TO NYR; PUT SKIP EDIT(C)(A(42));
A = 1; GO TO OMIG;
PRI: IF(SUM1 = 0 & SUM2 = 0) THEN GO TO START; A = 0; B = 0;
PUT SKIP EDIT(SUM1) (X(83),P'-------9V.99')(SUM2)(P'----------9V.99');
SAL = SUM1 - SUM2; PUT EDIT(SAL) (P'-------ZV.99'); M = MAN;
DSALDO(M) = SUM1; KSALDO(M) = SUM; KONTO = KONTONR;
PUT FILE(DISP) SKIP; ON ERROR GO TO BAD;
READ KEY(KONTO) FILE(SALREG) INTO(BALANS);
REWRITE FILE(SALREG) FROM (BALANS);
GO TO NY;
BAD: IF(ONCODE = 4) THEN DO;
CALL SEOF(SALREG); WRITE FILE(SALREG) FROM(BALANS); CLOSE SALREG;
OPEN SALREG; END; NY:SUM1 = 0; SUM2 = 0; PUT SKIP LIST(' ');
RADR = RADR + 3; IF(RADR = 43) THEN GO TO NYR; GO TO START;
NYR: PUT SKIP(8)EDIT(RUB1) (A(50)) (RUB2) (A(50)) (DAT) (A(15));
S = S + 1; PUT LIST('SIDA '); PUT EDIT(S) (P'ZZZ');
PUT SKIP(2)EDIT(RUB3) (A(40)) (RUB4) (A(25)); PUT LIST(RUB5);
PUT SKIP(2) LIST(42(' ')); RADR = 6; GO TO OMIG;
SLUT: PUT SKIP(2) EDIT(TOTS1)(X(83),P'-------9V.99')(TOTS2)(P'--------9V.99');
TOTSAL = TOTS1 - TOTS2;
PUT EDIT(TOTSAL) (P'---------9V.99');
END;