|
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: 47084 (0xb7ec)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V21«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V21«
/* V21 ÄR EN RUTIN FÖR INMATNING AV KONTERINGAR
KONTERINGARNA ÄR ORDNADE UNDER VERNUMMER
INKNAPPNING OCH ÄNDRING HANDHAS AV SAMMA RUTIN
EN AUTOMATISK INSERT & DELETE SER TILL ATT KONTERINGARNA ALLTID LIGGER
SAMMLADE PÅ FILEN
VERSION 1:5 Nya konton för PG 0011 och MOMS 0311. 800701.
PRG JÅ 780829 */
DCL 1 HJSTR,
2 VERNR BINARY,
2 LUFT CHAR(58);
/* 60 BYTES */
DCL 1 AREA, /* ARBETSAREA FÖR KONTON */
2 POST3(110) CHAR(34);
/* 3740 BYTES */
DCL PF POINTER,
1 FSTR BASED(PF), /* KONTOPOST */
2 KONTOF FIXED(11), /* KONTONUMMER 11 SIFRIGT */
2 VERNRF FIXED(5), /* VERNUMMER */
2 DATUMF FIXED(5), /* BOKFÖRINGSDATUM */
2 PDATUMF FIXED(5), /* PERDATUM BASÅR 78 */
2 BELOPPF FIXED(11), /* BELOPP I ÖREN */
2 TEXTF CHAR(13), /* TEXT */
RECLN BINARY INIT(34); /* FSTR's REKODLÄNGD */
/* 34 BYTES */
DCL PD POINTER,
1 DAREA BASED(PD), /* PAKNINGSSTRUKTUR */
2 POST1 CHAR(34),
2 POST2 CHAR(34);
/* 68 BYTES */
DCL 1 DUMMY, /* INSERT & DELIT AREA */
2 POST4(100) CHAR(34);
/* 3400 BYTES */
DCL KFIL FILE, /* HJÄLPFIL INEHÅLLER VERNR */
TRANSFIL FILE; /* TRANAKTIONSFIL INEHÅLLER KONTERINGAR */
DCL P POINTER,
D BASED(P) CHAR(6), /* ANVÄNDES AV DATCHECK */
DATUM CHAR(6), /* DAGENSDATUM */
ANTKONT BINARY, /* ANTAL KONT PÅ AVERNR */
AKTKONT BINARY, /* KONTERING SOM BEHANDLAS NUMMER I AREA */
PAREA BINARY, /* ADRESSEN FÖR AREA PROGRAMKONSTANT */
WFLAGG BINARY, /* WRITE-FLAGGA 1 OM SKRIVNING */
ADDKONT BINARY, /* ANTAL NYA KONTERINGAR PÅ AVERNR */
REKTOT BINARY, /* ANTAL REKODS I TRANSFIL */
AVERNR FIXED(5), /* AKTUELT VERNUMMER */
AREC BINARY, /* FÖRSTA KONTERING's (MED AVERNR) RECNUMMER */
RCODE BINARY, /* RETURKOD FRÅN RE WR */
DRAD BINARY, /* AKTUEL RAD PÅ DISPLAY-2 */
FRTYP BINARY, /* FRÅGA NUMMER */
KEYT BINARY, /* SENAST REG. FUNKTIONSTANGGENT */
RBELOPP CHAR(15), /* REDIGERAT BELOPP */
RKONTO CHAR(15), /* REDIGERAT KONTO */
KONTO FIXED(11),
BELOPP FIXED(11),
PERDAG FIXED(6),
BUFF CHAR(25),
ACK1 FIXED(13),
ACK2 FIXED(13),
BAS BINARY,
PDATUM FIXED(6),
FX5 FIXED(5), /* DAGENS DATUM MED 78 SOM BASÅR FÖR PERDAGINIT */
FX6 FIXED(6),
FX13 FIXED(13),
P1 CHAR(8) INIT(' 999999'),/* PIKTURE FÖR PERDAG */
P2 CHAR(14) INIT('---------9.99V'),
P3 CHAR(15) INIT('-------------9V'),
T2 CHAR(2),
T3 CHAR(3),
T5 CHAR(5),
T9 CHAR(9),
T10 CHAR(10),
TT11 CHAR(11),
T13 CHAR(13),
T16 CHAR(16),
T25 CHAR(25),
PERARMAX CHAR (2),
PERARMIN CHAR (2),
DATKOLL BINARY,
PP POINTER,
1 STR BASED(PP),
2 X CHAR(2),
2 Y CHAR(2),
2 FIRMA CHAR(1),
VERSION CHAR(47) INIT(' V21 Version 1:5 800701');
BELRED:PROC;
IF BELOPPF>=100 ö BELOPPF<=-100 THEN DO;
T13=BELOPPF;
JJ=LENGTH(T13);
RBELOPP=' :-- ';
IF SUBSTR(T13,JJ-1,2)¬='00' THEN SUBSTR(RBELOPP,13,2)=SUBSTR(T13,JJ-1,2);
SUBSTR(RBELOPP,14-JJ,JJ-2)=SUBSTR(T13,1,JJ-2);
RETURN;
END;
IF BELOPPF=0 THEN DO;
RBELOPP=' 0:-- ';
RETURN;
END;
T13=BELOPPF/100;
JJ=LENGTH(T13);
JJJ=INDEX(T13,'.');
RBELOPP=' :00 ';
SUBSTR(RBELOPP,13,JJ-JJJ)=SUBSTR(T13,JJJ+1,JJ-JJJ);
SUBSTR(RBELOPP,13-JJJ,JJJ-1)=SUBSTR(T13,1,JJJ-1);
RETURN;
END;
KONTORED:PROC;
DCL T11 CHAR(11);
T11=KONTOF;
RKONTO=' ' CAT SUBSTR(T11,1,5) CAT '.---.---';
IF SUBSTR(T11,6,3)¬='000' THEN SUBSTR(RKONTO,9,3)=SUBSTR(T11,6,3);
IF SUBSTR(T11,9,3)¬='000' THEN SUBSTR(RKONTO,13,3)=SUBSTR(T11,9,3);
RETURN;
END;
DELIT:PROC;
IF ANTKONT=1 THEN DO;
CALL OUTPUT(1,6);
RETURN;
END;
IF AKTKONT > ANTKONT THEN DO;
AKTKONT = ANTKONT;
UNSPEC (PF) = PAREA + (ANTKONT - 1) * RECLN;
END;
ACK1=ACK1-BELOPPF;
ACK2=ACK2-KONTOF;
ANTKONT=ANTKONT-1;
DO I=AKTKONT-1 TO ANTKONT;
UNSPEC(PD)=PAREA+I*RECLN;
POST1=POST2;
END;
WFLAGG=1;
ADDKONT=ADDKONT-1;
J=34;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(ACK1)(PP2);
RETURN;
END;
DAGTEST:PROC;
PUT FILE(D) SKIP EDIT(VERSION)(A(47));
OPEN TRANSFIL;
CALL SEOF(TRANSFIL);
REKTOT=UNSPEC(TRANSFIL);
OPEN TRANSFIL;
PUT FILE(D) EDIT(' TRANSAKTIONERNA KOMMER ATT DATERAS')(A(37))
(DATUM)(A(12))('TRANSAKTIONSFILEN INNEHÅLLER')(A(29))
(REKTOT)(P'----9')(' POSTER')(A(13))
('ÄR OVANSTÅENDE KORREKT? "J" ELLER "N"')(A(44));
GET SKIP LIST(T2);
IF T2¬='J ' THEN DO;
D=DATUM;
CALL PLOAD('Q ');
END;
OPEN KFIL;
READ FILE(KFIL) INTO(HJSTR);
FX5=DATUM-780000;
RETURN;
END;
HOPPA_TILL_Q:PROC;
D=DATUM;
REWRITE FILE(KFIL) FROM(HJSTR);
CALL PLOAD('Q ');
RETURN;
END;
VERIN:PROC;
AVERNR = VERNR + 1;
DO I = 0 TO 105;
UNSPEC (PF) = PAREA + I * 34;
KONTOF = 0;
VERNRF = AVERNR;
DATUMF = FX5;
PDATUMF = FX5;
BELOPPF = 0;
END;
V1:
PUT FILE (D) SKIP EDIT (' VER.NR:') (A(10));
IF REKTOT > 980 THEN DO;
CALL OUTPUT (1,6);
IF RECTOT > 1020 THEN DO;
DO J=1 TO 300;END;
CALL OUTPUT(1,6);
DO J=1 TO 300;END;
CALL OUTPUT(1,6);
END;
PUT FILE(D) EDIT('ANTAL KONTERINGAR I TRANSFIL:')(X(37),A(43))
(REKTOT)(A);
J=10;
CALL MOVEBUFF(J);
END;
GET SKIP LIST(T5);
IF T5=' ' THEN CALL HOPPA_TILL_Q;
AVERNR=T5;
ACK1=0;
ACK2=0;
IF AVERNR>VERNR+1 THEN DO;
PUT FILE(D) SKIP EDIT(' VERIFIKATIONSNUMRET')(A(22))
(AVERNR)(P'----9')(' GODKÄNNES EJ')(A(22))
('SENASTE INRAPPORTERADE VER.NR:')(A(30))(VERNR)(P'----9'); ;
GET SKIP LIST('');
GO TO V1;
END;
IF AVERNR=VERNR+1 THEN DO;
ANTKONT=0;
AREC=REKTOT;
GO TO V3;
END;
IF REKTOT<1 THEN GO TO V1;
OPEN TRANSFIL;
ON ERROR GO TO V1;
READ KEY(AVERNR) FILE(TRANSFIL) INTO(FSTR) KEYTO(VERNRF);
UNSPEC(TRANSFIL)=UNSPEC(TRANSFIL)-1;
AREC=UNSPEC(TRANSFIL);
I=REKTOT-AREC;
IF I>100 THEN I=100;
CALL RD(TRANSFIL,AREA,I,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL',ONCODE);
DO J=0 TO I-1;
UNSPEC(PF)=PAREA+J*RECLN;
IF VERNRF¬=AVERNR THEN GO TO V2;
ACK1=ACK1+BELOPPF;
ACK2=ACK2+KONTOF;
END;
V2: ANTKONT=J;
DO I = ANTKONT TO 105;
UNSPEC (PF) = PAREA + I * 34;
KONTOF = 0;
VERNRF = AVERNR;
DATUMF = FX5;
PDATUMF = FX5;
BELOPP = 0;
END;
V3: AKTKONT=1;
ADDKONT=0;
WFLAGG=0;
PUT FILE(D) EDIT(AVERNR)(A(9))('SID: SALDO:')(A(28))
(' KONTO UKTO KS PERDAG BELOPP')(A);
RETURN;
END;
DISPPUT:PROC;
D1: I=(AKTKONT-1)/10;
IF I>=9 THEN CALL OUTPUT(1,6);
IF I=10 THEN DO;
IF KEYT=22 THEN AKTKONT=100;
ELSE AKTKONT=1;
DO J=1 TO 400;END;
CALL OUTPUT(1,6);
GO TO D1;
END;
J=24;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(I+1)(A);
II=ANTKONT-10*I;
IF II>9 THEN II=10;
J=94;
CALL MOVEBUFF(J);
L=10;
DO J=I*10 TO I*10+II-1;
UNSPEC(PF)=PAREA+J*RECLN;
CALL KONTORED;
CALL BELRED;
PUT FILE(D) EDIT(RKONTO)(A(15))(PDATUMF+780000)(PP1)(RBELOPP)(A(24));
L=L-1;
END;
DO J=1 TO L;
PUT FILE(D) EDIT(' ')(A(47));
END;
DRAD=(AKTKONT-1)/10;
DRAD=AKTKONT-10*DRAD;
FRTYP=1;
RETURN;
END;
FRAEGA:PROC;
IF FRTYP=1 THEN DO;
UNSPEC(PF)=PAREA+(AKTKONT-1)*RECLN;
J=(DRAD+1)*47;
CALL MOVEBUFF(J);
IF AKTKONT>ANTKONT THEN RETURN;
CALL KONTORED;
CALL TYPIST(RKONTO,15);
CALL TYPIST('┣10┫',1);
RETURN;
END;
IF FRTYP=2 THEN DO;
T9=' ┣10┫';
SUBSTR(T9,3,6)=PDATUMF+780000;
CALL TYPIST(T9,9);
RETURN;
END;
IF FRTYP=3 THEN DO;
IF AKTKONT>ANTKONT THEN RETURN;
CALL BELRED;
T16=RBELOPP CAT '┣10┫';
CALL TYPIST(T16,16);
RETURN;
END;
PUT SKIP LIST('FEL FRTYP',FRTYP);
RETURN;
END;
POSTFLYT:PROC;
UNSPEC(TRANSFIL)=BAS;
J=J-I;
CALL RD(TRANSFIL,DUMMY,I,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('LÄSFEL I PROC POST',ONCODE);
UNSPEC(TRANSFIL)=BAS+ADDKONT;
CALL WR(TRANSFIL,DUMMY,I,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('SKRIVFEL I PROC POST',ONCODE);
RETURN;
END;
FILIN:PROC;
J=REKTOT-AREC-ANTKONT+ADDKONT;
K=0;
BAS=REKTOT;
F1: I=J;
IF I>100 THEN I=100;
BAS=BAS-I;
CALL POSTFLYT;
IF K=0 THEN DO;
CLOSE TRANSFIL;
OPEN TRANSFIL;
K=1;
END;
IF J¬=0 THEN GO TO F1;
OPEN TRANSFIL;
CALL SEOF(TRANSFIL);
REKTOT=UNSPEC(TRANSFIL);
RETURN;
END;
FILUT:PROC;
BAS=AREC+ANTKONT-ADDKONT;
J=REKTOT-BAS;
K=1;
F2: I=J;
IF I>100 THEN I=100;
CALL POSTFLYT;
BAS=BAS+I;
IF J¬=0 THEN GO TO F2;
CLOSE TRANSFIL;
OPEN TRANSFIL;
CALL SEOF(TRANSFIL);
REKTOT=UNSPEC(TRANSFIL);
RETURN;
END;
GO TO START;
SVAR:
IF FRTYP=1 THEN DO;
IF KEYT=5 THEN KONTO=FIRMA*10000000000+0311000000; /* K1 = MOMS */
IF KEYT=6 THEN KONTO=FIRMA*10000000000+0011000000; /* K2 = PG */
IF (KEYT=5) ö (KEYT=6) THEN GO TO S1;
J=1;
IF SUBSTR(BUFF,1,2)=' ' THEN J=3;
KONTO=SUBSTR(BUFF,J,5);
KONTO=KONTO*1000;
IF INDEX('0123456789',SUBSTR(BUFF,J+6,1))¬=0 THEN DO;
KONTO=KONTO+SUBSTR(BUFF,J+6,3);
J=J+3;
END;
IF SUBSTR(BUFF,J+6,1)='-' THEN J=J+3;
KONTO=KONTO*1000;
IF INDEX('0123456789',SUBSTR(BUFF,J+7,1))¬=0 THEN DO;
KONTO=KONTO+SUBSTR(BUFF,J+7,3);
END;
S1: TT11=KONTO;
IF SUBSTR(TT11,1,1)¬=FIRMA THEN GO TO L3;
IF KONTOF¬=KONTO THEN DO;
ACK2=ACK2-KONTOF+KONTO;
KONTOF=KONTO;
WFLAGG=1;
END;
CALL KONTORED;
PUT FILE(D) EDIT(RKONTO)(A(15));
END;
IF FRTYP=2 THEN DO;
IF SUBSTR(BUFF,1,2)¬=' ' THEN J=1;
ELSE J=3;
FX6=SUBSTR(BUFF,J,6);
IF FX6<700000 ö FX6>990000 THEN GO TO S3;
DATKOLL = J;
IF SUBSTR (BUFF,DATKOLL,2) > PERARMAX THEN GO TO S3;
IF SUBSTR (BUFF,DATKOLL,2) < PERARMIN THEN GO TO S3;
IF SUBSTR (BUFF,DATKOLL+2,2) > '12' THEN GO TO S3;
IF SUBSTR (BUFF,DATKOLL+2,2) < '01' THEN GO TO S3;
IF SUBSTR (BUFF,DATKOLL+4,2) > '31' THEN GO TO S3;
IF SUBSTR (BUFF,DATKOLL+4,2) < '01' THEN GO TO S3;
PUT FILE(D) EDIT(FX6)(PP1);
PDATUM=FX6-780000;
IF PDATUM¬=PDATUMF THEN DO;
PDATUMF=PDATUM;
WFLAGG=1;
END;
END;
IF FRTYP=3 THEN DO;
IF KEYT¬=138 & KEYT¬=139 THEN DO;
BELOPP=BELOPPF;
GO TO S2;
END;
IF SUBSTR(BUFF,12,1)=':' THEN DO;
IF SUBSTR(BUFF,13,1)='-' THEN DO;
SUBSTR(BUFF,12,2)='00';
END;
ELSE DO;
T2=SUBSTR(BUFF,13,2);
SUBSTR(BUFF,12,2)=T2;
SUBSTR(BUFF,14,2)=' ';
END;
END;
BELOPP=BUFF;
IF KEYT=138 & BELOPP>0 THEN BELOPP=-BELOPP;
IF KEYT=139 & BELOPP<0 THEN BELOPP=-BELOPP;
S2: IF BELOPP¬=BELOPPF THEN DO;
ACK1=ACK1-BELOPPF+BELOPP;
J=34;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(ACK1)(PP2);
CALL MOVEBUFF(J);
BELOPPF=BELOPP;
WFLAGG=1;
END;
CALL BELRED;
PUT FILE(D) EDIT(RBELOPP)(A(24));
END;
FRTYP=FRTYP+1;
IF FRTYP=4 THEN DO;
AKTKONT=AKTKONT+1;
IF AKTKONT>ANTKONT+1 THEN DO;
ANTKONT=ANTKONT+1;
ADDKONT=ADDKONT+1;
END;
DRAD=DRAD+1;
IF DRAD=11 THEN DO;
CALL DISPPUT;
END;
FRTYP=1;
END;
GO TO L3;
S3:
CALL OUTPUT (1,6);
GO TO L3;
UT:
IF ANTKONT=0 THEN GO TO L3;
J=47;
CALL MOVEBUFF(J);
DO J=1 TO 11;
PUT FILE(D) EDIT(' ')(A(47));
END;
IF WFLAGG=0 THEN GO TO U0;
J=94;
CALL MOVEBUFF(J);
IF ACK1¬=0 THEN DO;
PUT FILE(D) EDIT(' DIFFERENS')(A(23))(ACK1)(PP2);
CALL OUTPUT(1,6);
GET SKIP LIST('');
AKTKONT=1;
J=47;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(' KONTO UKTO KS PERDAG BELOPP')(A);
GO TO L2;
END;
PUT FILE(D) EDIT(' KONTONUMMERSUMMA')(A(23));
GET SKIP LIST(FX13);
IF (FX13¬=ACK2) & (FX13¬=ACK2/1000000) THEN DO;
J=94;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(' KONOTONUMMERSUMMERINGEN STÄMMER EJ')(A(49))
('DIFFERANS:')(A(23))(FX13-ACK2)(PP3);
CALL OUTPUT(1,6);
GET SKIP LIST(T25);
AKTKONT=1;
J=47;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT(' KONTO UKTO KS PERDAB BELOPP')(A);
GO TO L2;
END;
U0: J=68;
CALL MOVEBUFF(J);
PUT FILE(D) EDIT('┣0e┫')(A(26))(' TEXT.')(A(9));
UNSPEC(PF)=PAREA;
IF AREC=REKTOT THEN TEXTF=' ';
CALL TYPIST(TEXTF,13);
CALL TYPIST('┣10┫',1);
CALL CORED(0);
U1: GET SKIP LIST(T25);
DO I=25 TO 14 BY -1;
IF SUBSTR(T25,I,1)¬=' ' THEN DO;
CALL TYPIST(T25,25);
CALL TYPIST('┣10┫',1);
CALL OUTPUT(1,6);
GO TO U1;
END;
END;
IF SUBSTR(T25,1,13)=' ' THEN DO;
CALL OUTPUT(1,6);
GO TO U1;
END;
IF (SUBSTR(T25,1,13)=TEXTF) & (WFLAGG=0) THEN GO TO L1;
DO I=1 TO ANTKONT;
UNSPEC(PF)=PAREA+(I-1)*RECLN;
TEXTF=SUBSTR(T25,1,13);
END;
IF AREC<REKTOT THEN DO;
IF ADDKONT>0 THEN CALL FILIN;
IF ADDKONT<0 THEN CALL FILUT;
END;
IF REKTOT>0 THEN UNSPEC(TRANSFIL)=AREC;
CALL WR(TRANSFIL,AREA,ANTKONT,RCODE);
IF RCODE¬=0 THEN PUT SKIP LIST('SKRIVFEL I UT',ONCODE);
IF AREC=REKTOT THEN DO;
CLOSE TRANSFIL;
OPEN TRANSFIL;
CALL SEOF(TRANSFIL);
REKTOT=UNSPEC(TRANSFIL);
UNSPEC(TRANSFIL)=0;
IF AVERNR=VERNR+1 THEN VERNR=AVERNR;
END;
GO TO L1;
/* 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 ');
PERARMAX = SUBSTR (DATUM,1,2);
PERARMAX = PERARMAX + 1;
PERARMIN = SUBSTR (DATUM,1,2);
PERARMIN = PERARMIN - 1;
UNSPEC(P)=16570;
D='0';
UNSPEC(PP)=16616;
PF=ADDR(AREA);
PAREA=UNSPEC(PF);
CALL DAGTEST;
L1: CALL VERIN;
L2: CALL DISPPUT;
L3: CALL FRAEGA;
L4: GET SKIP LIST(BUFF);
CALL KEYFUN(KEYT);
IF KEYT=22 THEN DO; /* BACKAR EN KONTERING */
AKTKONT=AKTKONT-1;
IF AKTKONT<1 THEN DO;
AKTKONT=ANTKONT+1;
GO TO L2;
END;
ELSE DO;
DRAD=DRAD-1;
IF DRAD<1 THEN GO TO L2;
END;
M=16;
IF FRTYP=2 THEN M=8;
PUT FILE(D) EDIT(SUBSTR(BUFF,1,M))(A);
FRTYP=1;
GO TO L3;
END;
IF KEYT=23 THEN DO; /* FRAM EN RAD */
AKTKONT=AKTKONT+1;
IF AKTKONT>ANTKONT+1 THEN DO;
AKTKONT=1;
GO TO L2;
END;
ELSE DO;
DRAD=DRAD+1;
IF DRAD>10 THEN GO TO L2;
END;
M=16;
IF FRTYP=2 THEN M=8;
FRTYP=1;
PUT FILE(D) EDIT(SUBSTR(BUFF,1,M))(A);
GO TO L3;
END;
IF KEYT=140 THEN GO TO UT; /* AVSTÄMNING AV VERIFIKATION */
IF KEYT=17 THEN CALL HOPPA_TILL_Q;
IF KEYT=19 THEN DO; /* TAR BORT KONTERING */
CALL DELIT;
GO TO L2;
END;
GO TO SVAR;
END;