|
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: 28361 (0x6ec9)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V51«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V51«
/* V51 KONTROLLERAR KONTERINGARNA MED AVSEENDE PÅ ATT KONTO,UKONTU & IK-SLAG
FINNS I RESP KONTOTABELL, ATT SPÄRRDATUM INTE ÖVERSKRIDITS,
OCH ATT INTE FELAKTIGT KSKONTO ANVÄNDS
KONTOTABELLERNA STACKAS I MINNT VAREFTER SAMTLIGA KONTERINGAR KONTROLLERAS
EV FEL STACKAS I EN FELSTACK MED FELKOD & RECNUMMER
MED HJÄLP AV FELSTACKEN SKRIVS SEDAN FELLISTOR UT
OM INTE NÅGOT FEL INDIKERATS HOPPAR RUTINEN TILL NÄSTA FAS I BATCHEN
ANNARS SKER HOPP TILL Q
VERSION 1:3 UKTO-textfältet anger i vilka UKTO-tabeller visst UKTO har
representation. 800701.
PRG JÅ 780911 */
DCL AREAP POINTER,
1 KONTOSTR BASED(AREAP),
2 KONTO5 CHAR(5),
2 SDATUM5 FIXED(6),
2 TEXT5 CHAR(32),
2 UHMARK CHAR(1), /* Används numer för angivande av UKTO-tab.till.*/
2 LISTB BINARY,
2 IKB BINARY;
/* 46 BYTES */
DCL 1 UKSTR BASED(AREAP),
2 KONTO3 CHAR(3),
2 SDATUM3 FIXED(6),
2 TEXT3 CHAR(32),
2 UHMARK3 CHAR(1);
/* 40 BYTES */
DCL SPK POINTER,
1 STACKST1 BASED(SPK),
2 KONTO5S CHAR(5),
2 SDATUM5S FIXED(5),
2 KOPPLING BINARY,
2 SPKUKTOTAB CHAR (1);
/* 11 BYTES */
DCL 1 STACKST2 BASED(SPK),
2 KONTO3S CHAR(3),
2 SDATUM3S FIXED(5);
/* 6 BYTES */
DCL SP POINTER,
1 FELSTR BASED(SP),
2 RECNR BINARY,
2 FELTYP BINARY;
/* 4 BYTES */
DCL 1 VERSTR BASED(AREAP),
2 KONTOF FIXED(11),
2 VERNR FIXED(5),
2 BDATUM FIXED(5),
2 PDATUM FIXED(5),
2 BELOPP FIXED(11),
2 TEXTF CHAR(13);
/* 34 BYTES */
DCL 1 AREA,
2 CH(100) CHAR(50);
/* 5000 BYTES */
DCL 1 UKTOTABPOST,
2 UTABKONTO CHAR (3),
2 UTABDATUM FIXED (6),
2 UTABTABELL CHAR (32),
2 UTABUHMARK CHAR (1);
DCL UKONTOP FILE;
DCL 1 FSTR,
2 FIL FILE;
DCL 1 STR,
2 XN CHAR(24);
DCL KONTOADR(3) BINARY, /* LAGRAR STARTPOS FÖR VAR OCH EN AV KONTOTABELLERNA
1,2,3 I MINNET EFTER INLÄSNINGEN */
MINNE FIXED(5) INIT(49100),
FILTAB(4) CHAR(24) INIT(' KONTOP ',' UKONTOP ',' KSKONTOP',
' TRANSFIL'),
RLENGD(4) BINARY INIT(46,40,40,34),
MAX BINARY,
KONT1 CHAR(5),
KONT2 CHAR(3),
KONT3 CHAR(3),
PPP POINTER,
KONTO BASED(PPP) CHAR(11),
T14 CHAR(14),
T13 CHAR(13),
UKTOMARK CHAR (1),
STACKDJ BINARY,
SIDA BINARY INIT(1),
R BINARY,
DATUM CHAR(6),
FELSTACK BINARY,
UTABIND BINARY,
RCODE BINARY INIT(0),
NAMN(2) CHAR(10) INIT('KVV/KWAROS','AROS'),
TEXT(5) CHAR(40) INIT(
'VER. KONTO BELOPP SPÄRRDATUM',
'VER. U.KTO BELOPP SPÄRRDATUM',
'VER. IK BELOPP SPÄRRDATUM',
'VER. KONTO UK IK BELOPP',' '),
BT(0:9) BINARY INIT(1,2,4,8,16,32,64,128,256,512),
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(' V5 Version 1.3 800701');
/* KONTOGEN LÄER IN ALLA KONTOTABELLERNA, I FÖRKORTADE RECORDS, I
MINNET
KONTOGEN BYGGER UPP EN STACK MED KONTONUMMER ,SPÄRRDATUM & KONTOSPÄRR
INLÄSNINGEN SKER I BLOCK */
KONTOGEN:PROC;
UNSPEC(SPK)=27000;
DO I=1 TO 3; /* 1 = KTOTAB, 2 = UKTOTAB, 3 = KSKTOTAB */
KONTOADR(I)=UNSPEC(SPK);
XN=FILTAB(I);
FSTR=STR;
OPEN FIL; /* ÖPPNAR ALLA FILERNA BER. PÅ "XN" OCH "I" */
CALL SEOF(FIL);
MAX=UNSPEC(FIL);
UNSPEC(FIL)=0;
J=5000/RLENGD(I);
K1: IF J>MAX THEN J=MAX;
MAX=MAX-J;
CALL RD(FIL,AREA,J,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL UNDER K1 I',FILTAB(I),RCODE);
AREAP=ADDR(AREA);
DO K=1 TO J;
IF I=1 THEN DO;
KONTO5S=KONTO5;
IF SDATUM5¬=0 THEN SDATUM5S=SDATUM5-780000;
ELSE SDATUM5S=0;
KOPPLING=IKB;
SPKUKTOTAB = UHMARK;
UNSPEC(SPK)=UNSPEC(SPK)+11; /* KTOTABBENS KONTR.REC = 11 POS */
END;
ELSE DO;
KONTO3S=KONTO3;
IF SDATUM3¬=0 THEN SDATUM3S=SDATUM3-780000;
ELSE SDATUM3S=0;
UNSPEC(SPK)=UNSPEC(SPK)+6; /* IKTABBENS KONTR.REC = 6 POS */
END;
UNSPEC(AREAP)=UNSPEC(AREAP)+RLENGD(I);
END;
IF MAX¬=0 THEN GO TO K1;
END;
RETURN;
END;
STACKAF:PROC;
RECNR=UNSPEC(FIL)-J+K-1;
UNSPEC(SP)=UNSPEC(SP)+4;
STACKDJ=STACKDJ+1;
RETURN;
END;
UKTOTABTEST: PROC;
UKT10:
OPEN UKONTOP;
READ KEY (KONT2) FILE (UKONTOP) INTO (UKTOTABPOST);
UKT20:
IF UKTOMARK = ' ' THEN GO TO UKT99;
DO UTABIND = 1 TO 32;
IF SUBSTR(UTABTABELL, UTABIND,1) = UKTOMARK THEN GO TO UKT99;
END;
UKT30:
FELTYP = 8;
CALL STACKAF;
UKT99:
RETURN;
END;
/* TEST TESTAR KONTERINGARNA OCH SÄTTER FELKOD VID FEL
1 FEL KONTO 2 FEL PERDAG
3 FEL UKONTO 4 FEL PERDAG
5 FEL KSKONTO 6 FEL PERDAG
7 & 8 FEL KONTOSPÄR
RECNUMMER & FELKOD STACKAS I EN FELSTACK */
TEST:PROC;
UNSPEC(SPK)=KONTOADR(1);
T1: IF KONT1=KONTO5S THEN DO;
UKTOMARK = SPKUKTOTAB;
IF (KONT3¬='000') & (KOPPLING & BT(SUBSTR(KONT3,1,1))=0) THEN DO;
FELTYP=7;
CALL STACKAF;
END;
IF (KONT2¬='000') & ((KOPPLING & 1024)=0) THEN DO;
FELTYP=8;
CALL STACKAF;
END;
IF (SDATUM5S¬=0) & (SDATUM5S<PDATUM) THEN DO;
FELTYP=2;
CALL STACKAF;
END;
GO TO T2;
END;
UNSPEC(SPK)=UNSPEC(SPK)+11;
IF UNSPEC(SPK)=KONTOADR(2) THEN DO;
FELTYP=1;
CALL STACKAF;
GO TO T2;
END;
GO TO T1;
T2: IF KONT2='000' THEN GO TO T3;
UNSPEC(SPK)=KONTOADR(2);
T22: IF KONT2=KONTO3S THEN DO;
IF (SDATUM3S¬=0) & (SDATUM3S<PDATUM) THEN DO;
FELTYP=4;
CALL STACKAF;
END;
CALL UKTOTABTEST;
GO TO T3;
END;
UNSPEC(SPK)=UNSPEC(SPK)+6;
IF UNSPEC(SPK)=KONTOADR(3) THEN DO;
FELTYP=3;
CALL STACKAF;
GO TO T3;
END;
GO TO T22;
T3: IF KONT3='000' THEN GO TO T4;
UNSPEC(SPK)=KONTOADR(3);
T33: IF KONT3=KONTO3S THEN DO;
IF (SDATUM3S¬=0) & (SDATUM3S<PDATUM) THEN DO;
FELTYP=6;
CALL STACKAF;
END;
GO TO T4;
END;
UNSPEC(SPK)=UNSPEC(SPK)+6;
IF UNSPEC(SPK)=FELSTACK THEN DO;
FELTYP=5;
CALL STACKAF;
GO TO T4;
END;
GO TO T33;
T4: RETURN;
END;
RUB:PROC;
PUT SKIP(R+4) EDIT(NAMN(FIRMA-7))(A(20))('IFRÅGASATTA KONTERINGAR 19')
(A(27))(DATUM)(A(2))('-')(A)(SUBSTR(DATUM,3,2))(A(2))('-')(A)
(SUBSTR(DATUM,5,2))(A(5))('SID')(A(4))(SIDA)(A(4)) SKIP(2)
EDIT(' ')(A(1))(TEXT(I))(A) SKIP (1);
R = RADANT - 8;
SIDA=SIDA+1;
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 SLUT;
D='0';
PUT FILE(D) SKIP EDIT(VERSION)(A(96))('KONTROLL AV KONTERINGAR PÅGÅR')
(A(45));
CALL CORED(0);
PPP=ADDR(KONT1);
CALL KONTOGEN;
FELSTACK=UNSPEC(SPK);
OPEN UKONTOP;
UNSPEC(SP)=UNSPEC(SPK);
STACKDJ=0;
XN=FILTAB(4); /* I = 4 GER TRANSFIL */
FSTR=STR;
OPEN FIL;
CALL SEOF(FIL);
MAX=UNSPEC(FIL);
UNSPEC(FIL)=0;
J=5000/RLENGD(4); /* BLOCK OM 147 RECORDS */
L1: IF MAX=0 THEN GO TO SKRIV;
IF J>MAX THEN J=MAX;
MAX=MAX-J;
CALL RD(FIL,AREA,J,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL UNDER L1 I',FILTAB(4),RCODE);
AREAP=ADDR(AREA);
DO K=1 TO J;
KONTO=KONTOF;
CALL TEST;
IF UNSPEC(SP)>MINNE THEN GO TO SKRIV;
UNSPEC(AREAP)=UNSPEC(AREAP)+RLENGD(4);
END;
GO TO L1;
SKRIV:
K=1;
OPEN FIL;
J=5;
L=5;
DO I=1 TO 4;
IF I=2 THEN K=6;
IF I=3 THEN K=9;
IF I¬=1 THEN L=3;
R=0;
M=-1;
DO J=1 TO STACKDJ;
UNSPEC(SP)=FELSTACK+4*(J-1);
IF (FELTYP=I*2-1) ö (FELTYP=I*2) THEN DO;
IF R<6 THEN CALL RUB;
IF M¬=RECNR THEN DO;
UNSPEC(FIL)=RECNR;
ON ERROR GO TO FEL;
READ FILE(FIL) INTO(VERSTR);
KONTO=KONTOF;
CALL BELRED(BELOPP,T14);
M=RECNR;
END;
IF I<4 THEN DO;
PUT SKIP EDIT(VERNR)(P'ZZZZ9',X(5))(SUBSTR(KONTO,K,L))
(A(6))(T14)(A(19));
IF FELTYP=I*2 THEN PUT EDIT(PDATUM+780000)(A);
END;
ELSE DO;
IF FELTYP=I*2 THEN PUT SKIP EDIT(VERNR)(P'ZZZZ9',X(5))
(KONT1)(A(5))('.')(A)(KONT2)(A(3))('.xxx')(A(8))(T14)(A);
ELSE PUT SKIP EDIT(VERNR)(P'ZZZZ9',X(5))(KONT1)
(A(5))('.xxx.')(A(5))(KONT3)(A(7))(T14)(A);
END;
R=R-1;
END;
FEL: END;
PUT SKIP(R);
END;
SLUT:
D=DATUM;
IF (SIDA¬=1) ö (Y¬='1 ') THEN CALL PLOAD('Q ');
I = 5;
CALL RUB;
PUT SKIP(2) EDIT(' **** INGA IFRÅGASATTA KONTERINGAR ****')(A);
R = R - 2;
PUT SKIP (R);
CALL PLOAD('V8 ');
END;