|
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: 7584 (0x1da0)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »VERI«
└─⟦3e550eca6⟧ Bits:30008695 DDMQ1-0135_DUBBEL
└─⟦this⟧ »VERI«
└─⟦b4c020431⟧ Bits:30008687 DDMQ1-0127_VERFIL
└─⟦this⟧ »VERI«
└─⟦bcdd51fb7⟧ Bits:30008685 DDMQ1-0125_Denna_diskette
└─⟦this⟧ »VERI«
└─⟦be28637e3⟧ Bits:30008686 DDMQ1-0126
└─⟦this⟧ »VERI«
DCL 1 VER,
2 VENR CHAR(6),
2 DATUM CHAR(6),
2 KOSTST CHAR(4)INITIAL(' '),
2 DEBET CHAR(4) INITIAL(' '),
2 KREDIT CHAR(4) INITIAL(' '),
2 BELOPP FIXED(11,2),
2 VTEXT CHAR(20),
2 KOD CHAR(2)INITIAL(' ');
DCL CATL CHAR(6);
DCL VERIFILE FILE;
DCL RUB1 CHAR(50)INITIAL('M S T E N H A R D T A B');
DCL RUB1A CHAR(20) INIT('PROGR: A100');
DCL DAT CHAR(8);
PUT FILE(DISP)SKIP LIST('ANGE DAGENS DATUM (ÅÅ.MM.DD.) '); GET LIST(DAT);
DCL RUB2 CHAR(52)INITIAL('T R A N S A K T I O N S R E G I S T R E R I N G');
DCL RUB3 CHAR(50)INITIAL(' DATUM VER.NR TEXT');
DCL RUB4 CHAR(55)INIT('KONTO KOD DEBET KREDIT DIFFERENS');
DCL B CHAR(1); DCL Y CHAR(1)INIT(' ');
PUT SKIP(2) EDIT(RUB1) (A(35))(RUB1A)(A(15)) (RUB2) (A(50));
PUT LIST(' DATUM ');PUT EDIT(DAT)(A(12));PUT LIST(' SIDA 1');
YY = 1; PUT SKIP(2)EDIT(RUB3)(A(50))(RUB4)(A(55));
OPEN VERIFILE; DCL X CHAR(1); DCL KONTO CHAR(4); DCL VRNR CHAR(6);
DCL B1 CHAR(12)INIT(' '), BL CHAR(12)INIT(' ');
X = '1'; SUM1 = 0;SUM2 = 0; S1 = 0; S2 = 0; DCL VV CHAR(6)INIT(' ');
NYTT:B=' '; IF(SUM1 ¬= SUM2) THEN DO; S = SUM1 - SUM2; VENR = VV;
CALL OUTPUT(1,6);
PUT FILE(DISP) SKIP LIST( S,' DETTA ÄR FEL, SKRIV "X" '); GET LIST(X);END;
IF(X = '2') THEN GO TO ST;
IF(X = '1') THEN GO TO NY;
IF(X ¬= 'X') THEN PUT SKIP EDIT(S)(X(82),P'------9V.99');
IF(X = 'X') THEN GO TO START; SUM1 = 0; SUM2 = 0;
NY: PUT FILE(DISP) SKIP LIST('ANGE DATUM '); GET LIST(DATUM);
PUT FILE(DISP) SKIP LIST('ANGE VERIFIKATIONSNUMMER '); GET LIST(VENR);
IF(YY = 1) THEN VERA = VENR; YY = 0;
ST:PUT FILE(DISP) SKIP LIST('ANGE TEXT (HÖGST 20 TECKEN) '); GET LIST(VTEXT);
SUM1 = 0; SUM2 = 0;
START: KREDIT = ' ';DEBET = ' ';
PUT FILE(DISP) SKIP LIST('ANGE KONTO '); GET LIST(KONTO);
PUT FILE(DISP) SKIP LIST('ANGE BELOPP TRYCK K7 FÖR DEBET, K6 FÖR KREDIT ');
BB = 0;
XX: GET LIST(BB); CALL KEYFUN(I);
IF(I = 138) THEN GO TO KRED;
IF(I = 139) THEN GO TO DEB;
GO TO XX;
DEB:
DEBET = KONTO;
IF(SUBSTR(DEBET,1,1) = '5') THEN GO TO SOEK;
IF(SUBSTR(DEBET,1,3) = '262') THEN GO TO SOEK;
IF(SUBSTR(DEBET,1,3)= '251') THEN GO TO SOEK;
GEON:
BELOPP = BB; SUM1=SUM1+BELOPP;S1=S1+BELOPP;
CALL SEOF(VERIFILE);
WRITE FILE(VERIFILE) FROM(VER);
CLOSE VERIFILE;
OPEN VERIFILE;
PUT SKIP EDIT(DATUM)(A(10))(VENR)(A(10))(VTEXT)(A(30))(DEBET)(A(8));
IF(KOD ¬=' ') THEN DO;PUT EDIT(KOD)(A(4));PUT EDIT(BELOPP)(P'--------9V.99');
BELOPP = 0; END;
IF(KOD=' ')THEN PUT EDIT(BELOPP) (X(4),P'--------9V.99',X(10)); BELOPP = 0;
KOD = ' '; B1 = ' ';
GO TO FY;
KRED:
KREDIT = KONTO; B = 'K';
IF(SUBSTR(KREDIT,1,1) = '5') THEN GO TO SOEK;
IF(SUBSTR(KREDIT,1,3) = '251') THEN GO TO SOEK;
IF(SUBSTR(KREDIT,1,3) = '262') THEN GO TO SOEK;
B = ' ';
GOON:
BELOPP = BB;
SUM2 = SUM2 + BELOPP; S2 = S2 + BELOPP;
CALL SEOF(VERIFILE);
WRITE FILE(VERIFILE) FROM(VER);
CLOSE VERIFILE;
OPEN VERIFILE;
PUT SKIP EDIT(DATUM)(A(10)) (VENR)(A(10))(VTEXT)(A(30)) (KREDIT)(A(8));
IF(KOD ¬=' ')THEN DO;PUT EDIT(KOD)(A(19));PUT EDIT(BELOPP)(P'--------9V.99');
BELOPP = 0; END;
IF(KOD=' ')THEN PUT EDIT(BELOPP) (X(19),P'--------9V.99');
FY: KOD = ' '; X = '1'; VRNR = ' ';
PUT FILE(DISP) SKIP LIST('FÖR NYTT DATUM SKRIV "DATUM", FÖR NYTT VER.NR ');
PUT FILE(DISP)LIST(' SKRIV IN DET NYA NUMRET, "999999" FÖR SLUT ');
GET LIST(VRNR); IF(SUBSTR(VRNR,1,5) = 'DATUM')THEN GO TO NYTT ;
IF(VRNR = ' ') THEN GO TO START;
IF(VRNR = '999999') THEN GO TO SLUT; VV = VENR;
IF(VRNR ¬= VENR) THEN VENR = VRNR;X = '2'; GO TO NYTT;
SOEK:
PUT FILE(DISPLAY) SKIP LIST('ANGE INTERNKOD ');
GET LIST(KOD);
IF(B = 'K')THEN GO TO GOON;
GO TO GEON;
SLUT: IF(S1 ¬= S2) THEN GO TO NYTT;
PUT SKIP(2)EDIT(S1)(X(62),P'ZZZZZZZZ9V.99')(S2)(P'ZZZZZZZZZZZ9V.99');
S3= (S1 - S2);
PUT EDIT(S3) (X(2),P'------9V.99');
END;