|
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: 22752 (0x58e0)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V121«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V121«
/* V12 SKRIVER UT SALDOLISTOR FÖR UKONTO IKKONTO
LISTANS OMFATTNING BEGRÄNSAS AV 2 KONTONUMMER & 2 DATUM
V 0:1
780927 JÅ */
DCL KONTO1 CHAR(11),
KONTO2 CHAR(11),
RKONTO1 CHAR(13),
RKONTO2 CHAR(13),
DATUM1 CHAR(6),
DATUM2 CHAR(6),
DAT1BIN BINARY,
DAT2BIN BINARY,
SPTYP BINARY,
STAB(11) BINARY,
S_MARK CHAR(13);
DCL 1 TSTR,
2 VERNRT FIXED(5),
2 DATUMT BINARY,
2 TEXT CHAR(13),
2 ANTVERP BINARY;
DCL PK POINTER,
1 BSTR BASED(PK),
2 KONTONR CHAR(11);
DCL PB POINTER,
1 BELSTR BASED(PB),
2 VERNR BINARY,
2 PDATUM BINARY,
2 BELOPP FIXED(11);
DCL 1 AREA,
2 CH(255) CHAR(61);
/* 16 555 BYTES */
DCL VERTEXT FILE,
VERBELOP FILE,
BSTRL BINARY INIT(61),
BLOCKANT BINARY,
JK BINARY,
JJ BINARY,
LISTTYP BINARY INIT(2),
RCODE BINARY,
KONTOG CHAR(11),
SIDA BINARY INIT(1),
R BINARY INIT(0),
NAMN(2) CHAR(10) INIT('KVV/KWAROS','AROS'),
RTEXT(8) CHAR(22) INIT(
'KONTOUTDRAG',
'SALDOBESKED',
'PERDAG',
'BOKDAG',
'BOKDAG PERDAG VER.',
'',
'TEXT',
''),
RKONTO CHAR(13),
KONTONRG CHAR(11),
KONSTANT BINARY,
SKFLAGG BINARY INIT(0),
FLAGG1 BINARY INIT(0),
FLAGG2 BINARY INIT(0),
FLAGG3 BINARY INIT(0),
SUMMA1 FIXED(11) INIT(0),
SUMMA2 FIXED(11) INIT(0),
SUMMA3 FIXED(11) INIT(0),
T4 CHAR(4),
T61 CHAR(6),
T62 CHAR(6),
T11 CHAR(11),
T13 CHAR(13),
T14 CHAR(14),
FX6 FIXED(6),
KONTOSUM(0:999) FIXED(11) INIT((250)0,(250)0,(250)0,(250)0),
KONTOANT(0:999) BINARY INIT((250)0,(250)0,(250)0,(250)0),
OFFSET BINARY INIT(6),
OFF1 BINARY INIT(7),
P POINTER,
D BASED(P) CHAR(6),
DATUM CHAR(6),
PP POINTER,
1 STR 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(' V12 Version 1.2 800331');
RUB:PROC;
I_R=LISTTYP;
PUT SKIP(R+4) EDIT(NAMN(FIRMA-7))(A(20))(RTEXT(I_R))(A(35))('19')(A)
(SUBSTR(DATUM,1,2))(A)('-')(A)(SUBSTR(DATUM,3,2))(A)('-')(A)
(SUBSTR(DATUM,5,2))(A(5))('SID')(A(4))(SIDA)(A) SKIP EDIT
('Fr.o.m konto')(A(13))(RKONTO1)(A)(', till konto')(A(13))(RKONTO2)
(A) SKIP EDIT(' ')(A(13))(S_MARK)(A) SKIP EDIT('Fr.o.m datum')(A(13))
(DATUM1)(A(7))('till datum')(A(11))(DATUM2)(A(7))('m.a.p')(A(6))
(RTEXT(SPTYP+2))(A) SKIP EDIT(' ')(A(12))('KONTO')(A(25))
('BELOPP')(A(10)) SKIP;
SIDA=SIDA+1;
R = RADANT - 7;
RETURN;
END;
STARTPOST:PROC;
OPEN VERBELOP;
CALL SEOF(VERBELOP);
MAX=UNSPEC(VERBELOP);
UNSPEC(VERBELOP)=0;
READ FILE(VERBELOP) INTO(BSTR);
KONTONRG=KONTONR;
UNSPEC(VERBELOP)=UNSPEC(VERBELOP)-1;
BLOCKANT=MAX-UNSPEC(VERBELOP);
JJ=5;
JK=0;
IF (LISTTYP=1) ö (SPTYP=2) THEN DO;
OPEN VERTEXT;
READ FILE(VERTEXT) INTO(TSTR);
KONSTANT=VERNRT;
END;
RETURN;
END;
POST:PROC;
P1: JJ=JJ+1;
IF JJ>5 THEN DO;
IF JK<1 THEN DO;
IF BLOCKANT>0 THEN DO;
JK=255;
IF JK>BLOCKANT THEN JK=BLOCKANT;
BLOCKANT=BLOCKANT-JK;
CALL RD(VERBELOP,AREA,JK,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I VERBELOP',RCODE);
PK=ADDR(AREA);
END;
ELSE DO;
KONTONR='SLUT9999999';
PDATUM=DAT1BIN;
DATUMT=DAT2BIN;
RETURN;
END;
END;
ELSE DO;
UNSPEC(PK)=UNSPEC(PK)+BSTRL;
END;
JK=JK-1;
JJ=1;
END;
UNSPEC(PB)=UNSPEC(PK)+JJ*10+1;
IF PDATUM=0 THEN GO TO P1;
RETURN;
END;
DATTEST:PROC;
RCODE=0;
IF (SPTYP=2) & (PDATUM<0) THEN DO;
IF VERNR¬=VERNRT THEN DO;
UNSPEC(VERTEXT)=VERNR-KONSTANT;
ON ERROR GO TO D1;
ON ENDFILE GO TO D1;
READ FILE(VERTEXT) INTO(TSTR);
END;
IF (DAT1BIN>DATUMT) ö (DAT2BIN<=DATUMT) THEN RCODE=1;
END;
ELSE DO;
IF PDATUM<0 THEN PDATUM=-PDATUM;
IF (DAT1BIN>PDATUM) ö (DAT2BIN<=PDATUM) THEN RCODE=1;
END;
RETURN;
D1: PUT SKIP LIST('LÄSFEL I VERTEXT',ONCODE);
R=R-1;
RCODE=1;
RETURN;
END;
SKRIV_SUMMA:PROC;
DCL ANTAL_KONT BINARY INIT(0),
C CHAR(10) INIT('---------9');
T13='-----.---.---';
DO III=0 TO 900 BY 100;
DO J=0 TO 90 BY 10;
DO K=0 TO 9;
L=III+J+K;
IF KONTOANT(L)>0 THEN DO;
IF R<8 THEN CALL RUB;
IF SKFLAGG=1 THEN DO;
SKFLAGG=0;
PUT SKIP;
R=R-1;
END;
T4=L+1000;
SUBSTR(T13,OFF1,3)=SUBSTR(T4,2,3);
CALL BELRED(KONTOSUM(L),T14);
PUT SKIP EDIT(T13)(X(12),A(20))(T14)(A)(KONTOANT(L))(PC);;
R=R-1;
SUMMA3=SUMMA3+KONTOSUM(L);
FLAGG1=1;
FLAGG2=1;
FLAGG3=1;
ANTAL_KONT=ANTAL_KONT+KONTOANT(L);
END;
END;
IF (FLAGG3=1) & (STAB(OFFSET+2)=1) THEN DO;
SUBSTR(T13,OFF1+2,1)=' ';
CALL BELRED(SUMMA3,T14);
PUT SKIP EDIT(' *')(A(12))(T13)(A(20))(T14)(A);
IF ANTAL_KONT>0 THEN PUT EDIT(ANTAL_KONT)(PC);
ANTAL_KONT=0;
R=R-1;
SKFLAGG=1;
END;
SUMMA2=SUMMA2+SUMMA3;
SUMMA3=0;
FLAGG3=0;
END;
IF (FLAGG2=1) & STAB(OFFSET+1) THEN DO;
SUBSTR(T13,OFF1+1,2)=' ';
CALL BELRED(SUMMA2,T14);
PUT SKIP EDIT(' **')(A(12))(T13)(A(20))(T14)(A);
IF ANTAL_KONT>0 THEN PUT EDIT(ANTAL_KONT)(PC);
ANTAL_KONT=0;
R=R-1;
SKFLAGG=1;
END;
SUMMA1=SUMMA1+SUMMA2;
SUMMA2=0;
FLAGG2=0;
END;
IF (FLAGG1=1) & (STAB(OFFSET)=1)THEN DO;
SUBSTR(T13,OFF1,3)=' ';
CALL BELRED(SUMMA1,T14);
PUT SKIP EDIT(' ***')(A(12))(T13)(A(20))(T14)(A);
IF ANTAL_KONT>0 THEN PUT EDIT(ANTAL_KONT)(PC);
PUT SKIP;
R=R-2;
END;
IF R¬=0 THEN PUT SKIP(R);
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:
CALL DATCHECK(DATUM);
IF DATUM='0 ' THEN CALL PLOAD('Q ');
UNSPEC(P)=16570;
D='0';
J=0;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(VERSION)(A(47));
UNSPEC(PP)=16616;
PK=ADDR(AREA);
IF Y='7 ' THEN OFFSET=9;
IF Y='7 ' THEN OFF1=11;
ISTART=SUBSTR(KONTO1,OFFSET,3);
ISTOPP=SUBSTR(KONTO2,OFFSET,3);
CALL STARTPOST;
L1: CALL POST;
CALL DATTEST;
IF RCODE¬=0 THEN GO TO L1;
IF KONTONR='SLUT9999999' THEN GO TO L2;
I=SUBSTR(KONTONR,OFFSET,3);
IF I>=ISTART & I<ISTOPP THEN DO;
KONTOSUM(I)=KONTOSUM(I)+BELOPP;
KONTOANT(I)=KONTOANT(I)+1;
END;
GO TO L1;
L2: CALL SKRIV_SUMMA;
D=DATUM;
CALL PLOAD('Q ');
END;