|
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: 13193 (0x3389)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V41_1:2«
└─⟦60d3ae5fc⟧ Bits:30008760 50001599
└─⟦this⟧ »V41_1:2«
/* V4 ÄR ETT PROGRAM FÖR UTSKRIFT AV KONTO,UKONTO & IK-SLAG.
V 0:1
PRG JÅ 780907 */
DCL 1 KONTOSTR,
2 KONTO5 CHAR(5),
2 SDATUM5 FIXED(6),
2 TEXT5 CHAR(32),
2 UHMARK5 CHAR(1),
2 LISTB BINARY,
2 IKB BINARY;
/* 46 BYTES */
DCL 1 UKSTR,
2 KONTO3 CHAR(3),
2 SDATUM3 FIXED(6),
2 TEXT CHAR(32),
2 UHMARK CHAR(1);
/* 40 BYTES */
DCL 1 FSTR,
2 FIL1 FILE;
DCL 1 STR,
2 XN CHAR(24) INIT(' KONTOP ');
DCL T70 CHAR(70) INIT
('KONTO TEXT SDATUM UM LISTM UK IKSLAG'),
T74 CHAR(74) INIT
(' 12345 0123456789'),
TAB(5) CHAR(25) INIT('KONTOPLAN ',
'U-KONTOTABELL ',
'K-SLAGSTABELL ',
'ALLA KONTON ',
'ENDAST 5-SIFFRIGA KONTON '),
LISTM CHAR(5),
UK CHAR(1),
IKSLAG CHAR(10),
TOM CHAR(10) INIT(' '),
NAMN(2) CHAR(10) INIT('KVV/KWAROS','AROS'),
SDATUM CHAR(6),
KONTO CHAR(5),
FIL BINARY,
SIDA BINARY INIT(0),
R BINARY INIT(0),
S CHAR(1),
DATUM CHAR(6),
P POINTER,
D BASED(P) CHAR(6),
PP POINTER,
1 STRX BASED(PP),
2 X CHAR(2),
2 Y CHAR(2),
2 FIRMA CHAR(1),
2 OP_KOD BINARY,
2 RADANT BINARY,
VERSION CHAR (47) INIT (' V41 Version 1.2 790412');
STRGEN:PROC;
IF FIL=1 THEN DO;
LISTM=TOM;
IKSLAG=TOM;
J=1;
DO I=1 TO 5;
IF (J&LISTB)=J THEN SUBSTR(LISTM,I,1)='1';
J=J*2;
END;
J=1;
DO I=0 TO 9;
UK=I;
IF (J&IKB)=J THEN SUBSTR(IKSLAG,I+1,1)=UK;
J=J*2;
END;
UK=' ';
IF (J & IKB) = J THEN UK='1';
SDATUM=SDATUM5;
TEXT=TEXT5;
UHMARK=UHMARK5;
RETURN;
END;
ELSE DO;
SDATUM=SDATUM3;
RETURN;
END;
END;
RUB:PROC;
SIDA=SIDA+1;
PUT SKIP(R+4) EDIT(NAMN(FIRMA-7))(A(19))(TAB(FIL))(A)(TAB(S+3))(A)
(' ')(A(6))('19')(A)(DATUM)(A(2))('-')(A)(SUBSTR(DATUM,3,2))(A(2))
('-')(A)(SUBSTR(DATUM,5,2))(A(5))('SID')(A(4))(SIDA)(A) SKIP(2);
IF FIL=1 THEN PUT EDIT(T70)(A)SKIP EDIT(T74)(A)SKIP;
ELSE PUT EDIT(T70)(A(51))SKIP(2);
R= RADANT - 8;
RETURN;
END;
SKRIV:PROC;
PUT SKIP EDIT(KONTO)(A(7))(TEXT)(A(34));
IF SDATUM=0 THEN PUT EDIT(TOM)(A(8))(UHMARK)(A(4));
ELSE PUT EDIT(SDATUM)(A(8))(UHMARK)(A(4));
IF FIL=1 THEN PUT EDIT(LISTM)(A(7))(UK)(A(4))(IKSLAG)(A);
R=R-1;
RETURN;
END;
FRAEGA:PROC;
PUT FILE(D) SKIP EDIT('SKA ALLA KONTO SKRIVAS UT, ELLER')(A(47))
('BARA DE')(A(8))(J)(A)('-SIFFRIGA')(A(38))
('DVS DE SOMM ÄR AKTUELLA VID KONTERING')(A(47))
('1 = ALLA')(A(47))('2 = ENDAST')(A(11))(J)(A)('-SIFFRIGA')(A(35));
GET SKIP LIST(S);
IF VERIFY(S,'12')=0 THEN GO TO UT;
PUT FILE(D) SKIP EDIT(VERSION)(A(105))('*** UTSKRIFT PÅGÅR ***')
(A(36));
CALL CORED(0);
RETURN;
END;
/* H Ä R B Ö R J A R H U V U D P R O G R A M M E T */
START:
UNSPEC(P)=16570;
UNSPEC(PP)=16616;
CALL DATCHECK(DATUM);
IF DATUM='0 ' THEN GO TO UT;
D='0';
J=5;
FIL=Y;
IF FIL¬=1 THEN DO;
SUBSTR(TAB(5),8,1)='3';
J=3;
END;
IF FIL=2 THEN XN=' UKONTOP ';
IF FIL=3 THEN XN=' KSKONTOP';
FSTR=STR;
OPEN FIL1;
CALL FRAEGA;
L0: IF R<5 THEN CALL RUB;
L1: IF FIL=1 THEN DO;
ON ENDFILE GO TO UT;
READ FILE(FIL1) INTO(KONTOSTR);
KONTO=KONTO5;
END;
ELSE DO;
ON ENDFILE GO TO UT;
READ FILE(FIL1) INTO(UKSTR);
KONTO=KONTO3;
END;
IF (SUBSTR(KONTO,J,1)=' ') & (S='2') THEN GO TO L1;
CALL STRGEN;
CALL SKRIV;
GO TO L0;
UT: D=DATUM;
PUT SKIP(R);
CALL PLOAD('Q ');
END;