|
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: 49849 (0xc2b9)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V101«
└─⟦256585323⟧ Bits:30008759 50001598
└─⟦this⟧ »V101«
/* V10 SKRIVER UT KONTOUTDRAG & SALDOLISTOR
LISTANS OMFATTNING BEGRÄNSAS AV 2 KONTONUMMER & 2 DATUM
V 0:1
780927 JÅ
Ändrad 800129 OBg. Kontotext på saldolistan inlagd. Version 1.3.
Rättad m.a.p. föreg. ändr. samt vissa nötter tillf. Ver 1.4 800331.
Rättelse av stoppkto 99999999999 till SLUT99999999999 för att summering
av AROSKRAFT på företagskod skulle bli möjlig800916. Version 1.5.
Punkter i beloppsfältet mellan hundra och tusental ock mellan tusen och
milliontal. Tillämpas först efter boksl. 79/80. Version 1.6 800917.
Kompletteras med Mellankraft 840110. Version 1.6 */
DCL KONTO1 CHAR(11),
KONTO2 CHAR(11),
RKONTO1 CHAR(13) INIT('-----.---.---'),
RKONTO2 CHAR(13) INIT('-----.---.---'),
DATUM1 CHAR(6),
DATUM2 CHAR(6),
DAT1BIN BINARY,
DAT2BIN BINARY,
SPTYP BINARY, /* 1 = PERDAG 2 = BOKDAG */
STAB(11) BINARY,
S_MARK CHAR(13) INIT(' . . ');
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);
/* 15 555 BYTES */
DCL 1 KONTOPOST,
2 TABSPARRDAT FIXED (6),
2 TABUPPHMARK CHAR (1),
2 TABLISTMARK BINARY,
2 TABIKKORSN BINARY,
2 TABTEXT CHAR (32);
DCL 1 LIKVIDPOST,
2 LKTO FIXED (5),
2 LDAT BINARY,
2 LBEL FIXED (11),
2 FILLER CHAR (9);
DCL VERTEXT FILE,
VERBELOP FILE,
KONTOP FILE,
LIKVID FILE,
BSTRL BINARY INIT(61),
MAX BINARY,
BLOCKANT BINARY,
JK BINARY,
JJ BINARY,
LISTTYP BINARY, /* 1 = KONTOUTDRAG, 2 = SALDOBESKED */
RCODE BINARY,
KONTOG CHAR(11),
SIDA BINARY INIT(1),
R BINARY INIT(0),
NAMN (3) CHAR(11) INIT('MELLANKRAFT','KVV/KWAROS','AROS'),
RTEXT(8) CHAR(22) INIT(
'KONTOUTDRAG',
'SALDOBESKED',
'PERDAG',
'BOKDAG',
'BOKDAG PERDAG VER.',
'',
'TEXT',
''),
RKONTO CHAR(13),
KONTONRG CHAR(11),
KONTO5FOREG CHAR (5) INIT ('00000'),
TEXTKTO CHAR (5),
KTOTEXT CHAR (32),
T15BELRED CHAR (15),
KONSTANT BINARY,
BUFF CHAR(20),
T1 CHAR(1),
T61 CHAR(6),
T62 CHAR(6),
T11 CHAR(11),
T13 CHAR(13),
T14 CHAR(14),
T15 CHAR (15),
KT1 CHAR(1),
KT2 CHAR(2),
KT3 CHAR(3),
KT4 CHAR(4),
KT5 CHAR(5),
KT6 CHAR(6),
KT7 CHAR(7),
KT8 CHAR(8),
KT9 CHAR(9),
KT10 CHAR(10),
KT11 CHAR(11),
FX6 FIXED(6),
TYP1 BINARY INIT(0),
TYP2 BINARY INIT(0),
OFFSET BINARY INIT(1),
LENGD BINARY INIT(0),
SUMMA(11) FIXED(11) INIT((11)0),
P POINTER,
D CHAR(6) BASED(P),
DATUM CHAR(6),
BRYTDAT BINARY,
DATSW BINARY INIT (0),
PP POINTER,
1 STR BASED(PP),
2 X CHAR(2),
2 Y CHAR(2), /* 6 = UKTO, 7 = IKSLAG */
2 FIRMA CHAR (1),
2 OP_KOD BINARY,
2 RADANT BINARY,
T4 CHAR(4),
ANTAL_KONT BINARY INIT(0),
TOT_ANTAL_KONT BINARY INIT(0),
VERSION CHAR(47) INIT(' V10 Version 1.6 840110');
KONTORED:PROC;
DCL KFLAGG BINARY INIT(0);
KONTO2='-----------';
RKONTO='-----.---.---';
T1=SUBSTR(BUFF,1,1);
IF T1 ¬= '7' & T1¬='8' & T1¬='9' & Y='5 ' THEN DO;
T1=SUBSTR(BUFF,7,1);
I=6;
J=7;
TYP2=1; /* DET FINNS U-KTO ANGIVET */
IF INDEX('0123456789',T1)¬=0 THEN GO TO K1;
T1=SUBSTR(BUFF,11,1);
I=9;
J=11;
TYP2=2; /* DET FINNS IK-SLAG ANGIVET */
IF INDEX('0123456789',T1)=0 THEN GO TO KUT;
K1: DO K=1 TO 3;
SUBSTR(KONTO2,I,1)=T1;
SUBSTR(RKONTO,J,1)=T1;
T1=SUBSTR(BUFF,J+1,1);
IF INDEX('0123456789',T1)=0 THEN GO TO KUT;
J=J+1;
I=I+1;
END;
GO TO KUT;
END;
J=0;
TYP2=0;
DO I=1 TO 11;
IF I=6 ö I=9 THEN J=J+2; /* ADDERING FÖRBI PUNKTERNA */
ELSE J=J+1;
T1=SUBSTR(BUFF,J,1);
IF INDEX('0123456789',T1)=0 & LENGD>0 THEN GO TO KUT;
IF INDEX('0123456789',T1)¬=0 THEN DO;
SUBSTR(KONTO2,I,1)=T1;
SUBSTR(RKONTO,J,1)=T1;
LENGD=LENGD+1;
END;
ELSE DO;
OFFSET=OFFSET+1;
SUBSTR(KONTO2,I,1)='-';
SUBSTR(RKONTO,J,1)='-';
END;
END;
KUT: IF KFLAGG=0 THEN DO;
KONTO1=KONTO2;
KFLAGG=1;
TYP1=TYP2;
END;
RETURN;
END;
SRED:PROC;
J=14;
DO I=11 TO 1 BY -1;
IF (I=5) ö (I=8) THEN J=J-2;
ELSE J=J-1;
IF SUBSTR(BUFF,J,1)='S' THEN DO;
STAB(I)=1;
SUBSTR(S_MARK,J,1)='S';
END;
ELSE DO;
STAB(I)=0;
END;
END;
RETURN;
END;
RUB:PROC;
I_R=LISTTYP;
PUT SKIP(R+3) EDIT(NAMN(FIRMA-6))(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(18))(RTEXT(I_R+4))
(A)(' ')(A(6))('BELOPP')(A(13))(RTEXT(I_R+6))(A) SKIP;
SIDA=SIDA+1;
R = RADANT - 8;
RETURN;
END;
STYRDATA:PROC;
PUT FILE(D) SKIP EDIT(VERSION)(A(49))(RTEXT(Y-3))(A(47))
('Fr.o.m. KONTO')(A(47))('Till KONTO')(A(47))('SUMMERING')(A);
J=128;
CALL MOVEBUFF(J);
CALL TYPIST(RKONTO1,13);
CALL TYPIST('┣10┫',1);
GET SKIP LIST(BUFF);
CALL KONTORED;
RKONTO1=RKONTO;
PUT FILE(D) EDIT(RKONTO1)(A);
J=175;
CALL MOVEBUFF(J);
IF OFFSET>1 THEN GO TO S15;
CALL TYPIST(RKONTO2,13);
CALL TYPIST('┣10┫',1);
S1: GET SKIP LIST(BUFF);
CALL KONTORED;
S15: RKONTO2=RKONTO;
IF (KONTO1>KONTO2) ö (TYP1¬=TYP2) THEN GO TO S1; /*KLAR I KONTORED*/
PUT FILE(D) EDIT(RKONTO2)(A);
J=222;
CALL MOVEBUFF(J);
IF OFFSET>1 THEN GO TO S17;
CALL TYPIST(S_MARK,13);
CALL TYPIST('┣10┫',1);
GET SKIP LIST(BUFF);
CALL SRED;
S17: PUT FILE(D) EDIT(S_MARK)(A(15))('DATUMSPÄRR')(A(47))
('1 = PERDATUM')(A(47))('2 = BOKDATUM')(A(44));
S4: GET SKIP LIST(SPTYP);
IF SPTYP<1 ö SPTYP>2 THEN GO TO S4;
PUT FILE(D) EDIT(SPTYP)(A(3))('Fr.o.m DATUM')(A(47))
('Till DATUM')(A);
J=417;
CALL MOVEBUFF(J);
S3: GET SKIP LIST(D);
CALL DATCHECK(DATUM1);
IF DATUM1='0 ' THEN GO TO S3;
PUT FILE(D) EDIT(DATUM1)(A);
J=464;
CALL MOVEBUFF(J);
S2: GET SKIP LIST(D);
CALL DATCHECK(DATUM2);
IF DATUM1>=DATUM2 THEN GO TO S2;
D='0';
PUT FILE(D) EDIT(DATUM2)(A);
IF TYP1=1 THEN Y='6 ';
IF TYP1=2 THEN Y='7 ';
IF Y='4 ' THEN LISTTYP=1;
ELSE LISTTYP=2;
DAT1BIN=372*(SUBSTR(DATUM1,1,2)-78)+31*(SUBSTR(DATUM1,3,2)-1)+
SUBSTR(DATUM1,5,2)-1;
DAT2BIN=372*(SUBSTR(DATUM2,1,2)-78)+31*(SUBSTR(DATUM2,3,2)-1)+
SUBSTR(DATUM2,5,2)-1;
RETURN;
END;
STARTPOST:PROC;
RCODE=0;
PK=ADDR(AREA);
OPEN VERBELOP;
CALL SEOF(VERBELOP);
MAX=UNSPEC(VERBELOP);
UNSPEC(VERBELOP)=0;
IF OFFSET>1 THEN DO;
READ FILE(VERBELOP) INTO(BSTR);
GO TO ST2;
END;
J=INDEX(KONTO1,'-')-1; /* FASTSTÄLLER LÄNGD PÅ ANGIVET KONTOBEGREPP*/
IF J=1 THEN DO;
KT1=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT1) FILE(VERBELOP) INTO(AREA);
END;
IF J=2 THEN DO;
KT2=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT2) FILE(VERBELOP) INTO(AREA);
END;
IF J=3 THEN DO;
KT3=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT3) FILE(VERBELOP) INTO(AREA);
END;
IF J=4 THEN DO;
KT4=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT4) FILE(VERBELOP) INTO(AREA);
END;
IF J=5 THEN DO;
KT5=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT5) FILE(VERBELOP) INTO(AREA);
END;
IF J=6 THEN DO;
KT6= KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT6) FILE(VERBELOP) INTO(AREA);
END;
IF J=7 THEN DO;
KT7=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT7) FILE(VERBELOP) INTO(AREA);
END;
IF J=8 THEN DO;
KT8=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT8) FILE(VERBELOP) INTO(AREA);
END;
IF J=9 THEN DO;
KT9=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT9) FILE(VERBELOP) INTO(AREA);
END;
IF J=10 THEN DO;
KT10=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT10) FILE(VERBELOP) INTO(AREA);
END;
IF J=-1 THEN DO;
KT11=KONTO1;
ON ERROR GO TO ST1;
READ KEY(KT11) FILE(VERBELOP) INTO(AREA);
END;
GO TO ST2;
ST1: IF ONCODE¬=4 THEN DO;
PUT SKIP LIST('LÄSFEL I VERBELOP I POST: PROC ',RCODE);
D=DATUM;
CALL PLOAD('Q ');
END;
RCODE=1;
RETURN;
ST2:
TEXTKTO = SUBSTR (KONTONR,1,5);
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=DAT1BIN;
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 UNDER LABEL D1 ',ONCODE);
R=R-1;
RCODE=1;
RETURN;
END;
KONTOTEST:PROC;
RCODE=0;
IF SUBSTR(KONTONR,OFFSET,LENGD)=SUBSTR(KONTO2,OFFSET,LENGD) THEN RETURN;
IF KONTONR¬='SLUT9999999' THEN RCODE=1;
RETURN;
END;
KONTOTEXT:PROC;
IF SUBSTR (RKONTO1,1,5) = SUBSTR (RKONTO2,1,5) THEN GO TO K77;
TEXTKTO = SUBSTR (KONTONRG,1,5);
IF SUBSTR (KONTONRG,1,5) = KONTO5FOREG THEN GO TO K88;
IF TEXTKTO = 'SLUT9' THEN GO TO K88;
K77:
IF KONTO5FOREG = SUBSTR (KONTONRG,1,5) THEN GO TO K88;
IF ONCODE = 4 THEN GO TO K99;
READ KEY (TEXTKTO) FILE (KONTOP) INTO (KONTOPOST);
KTOTEXT = TABTEXT;
GO TO K99;
K88:
KTOTEXT = (' ');
K99:
RETURN;
END;
SKRIV_SUMMA:PROC;
T13=' ';
T11=T13;
DO I=2 TO 11;
SUMMA(I)=SUMMA(I)+SUMMA(1);
END;
T4=ANTAL_KONT;
TOT_ANTAL_KONT=TOT_ANTAL_KONT+ANTAL_KONT;
DO I=1 TO 11;
IF SUBSTR(KONTONRG,I,1)¬=SUBSTR(KONTONR,I,1) THEN GO TO SKR1;
END;
SKR1: DO N=11 TO 1 BY-1;
IF SUBSTR(KONTONRG,N,1)¬='0' THEN GO TO SKR2;
END;
SKR2: IF R<8 THEN CALL RUB;
K=11;
SKR3: DO J=1 TO 12-I;
IF STAB(12-J)=1 THEN DO;
IF R<2 THEN CALL RUB;
SUBSTR(T11,K,1)='*';
K=K-1;
CALL BELRED(SUMMA(J),T14);
M=0;
T13=' ';
DO L=1 TO 12-J;
M=M+1;
IF (L=6) ö (L=9) THEN DO;
SUBSTR(T13,M,1)='.';
M=M+1;
END;
SUBSTR(T13,M,1)=SUBSTR(KONTONRG,L,1);
END;
IF LISTTYP=1 THEN M=28;
ELSE M=2;
T15BELRED = ' ';
IF SUBSTR (T14,1,5) = ' ' THEN GO TO SKR4;
IF SUBSTR (T14,1,5) = ' -' THEN DO;
SUBSTR (T15BELRED,5,1) = '-';
GO TO SKR43;
END;
SUBSTR (T15BELRED,1,4) = SUBSTR (T14,2,4);
SUBSTR (T15BELRED,5,1) = '.';
GO TO SKR43;
SKR4:
IF SUBSTR (T14,6,3) = ' ' ö SUBSTR (T14,6,3) = ' -'
THEN GO TO SKR45;
SKR43:
SUBSTR (T15BELRED,6,3) = SUBSTR (T14,6,3);
SUBSTR (T15BELRED,9,1) = '.';
SUBSTR (T15BELRED,10,6) = SUBSTR (T14,9,6);
T15 = T15BELRED;
GO TO SKR47;
SKR45:
SUBSTR (T15BELRED,2,14) = T14;
T15 = T15BELRED;
SKR47:
PUT SKIP EDIT(T11)(A(12))(T13)(A)(' ')(A(M))(T15)(A(33))
(T4) (A(4));
IF SUBSTR (T13,5,1) = ' ' THEN GO TO SKR5;
IF SUBSTR (KONTONRG,1,5) > '70001' THEN DO;
CALL KONTOTEXT;
PUT EDIT (' ') (A) (KTOTEXT) (A);
KONTO5FOREG = SUBSTR (KONTONRG,1,5);
END;
SKR5:
T4=' ';
R=R-1;
END;
SUMMA(J)=0;
END;
KONTONRG=KONTONR;
SUMMA(1)=0;
IF K¬=11 THEN DO;
PUT SKIP;
R=R-1;
ANTAL_KONT=0;
END;
RETURN;
END;
/* UTSKRIFT AV LISTRAD FÖR KONTOUTDRAG */
POSTSKRIV:PROC;
IF R<8 THEN CALL RUB;
IF VERNR¬=VERNRT THEN DO;
UNSPEC(VERTEXT)=VERNR-KONSTANT;
ON ERROR GO TO P3;
ON ENDFILE GO TO D1;
READ FILE(VERTEXT) INTO(TSTR);
GO TO P2;
P3: TEXT='**** FINNS EJ';
DATUMT=PDATUM;
P2: END;
I=0;
DO J=1 TO 11;
IF (J=6) ö (J=9) THEN DO;
I=I+1;
SUBSTR(T13,I,1)='.';
END;
I=I+1;
SUBSTR(T13,I,1)=SUBSTR(KONTONR,J,1);
END;
IF PDATUM<0 THEN PDATUM=-PDATUM;
IIII=DATUMT;
CALL BINTOCH(IIII,T61);
CALL BINTOCH(PDATUM,T62);
CALL BELRED(BELOPP,T14);
IF T61=T62 THEN T62=' ';
PUT SKIP EDIT(' ')(A(12))(T13)(A(18))(T61)(A(8))(T62)(A(8))
(VERNR)(P'-----9',X(1))(T14)(A(18))(TEXT)(A);
R=R-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:
CALL DATCHECK(DATUM);
IF DATUM='0 ' THEN CALL PLOAD('Q ');
UNSPEC(P)=16570;
D='0';
UNSPEC(PP)=16616;
OPEN KONTOP;
L0: CALL STYRDATA;
IF Y='6 ' ö Y='7 ' THEN DO; /* U-KONTO ELLER IK-SLAG*/
D=DATUM;
CALL PLOAD('V12 ');
END;
CALL STARTPOST;
IF RCODE=1 THEN GO TO L0;
L1: CALL POST; /* INLÄSN. AV 255 REC. FRÅN VERBELOP */
CALL DATTEST;
IF RCODE¬=0 THEN GO TO L1;
IF OFFSET>1 THEN DO;
CALL KONTOTEST;
IF RCODE¬=0 THEN GO TO L1;
IF KONTONR='SLUT9999999' THEN DO;
IF R<3 THEN CALL RUB;
CALL BELRED(SUMMA(1),T14);
T4=ANTAL_KONT;
TOT_ANTAL_KONT=ANTAL_KONT;
PUT SKIP EDIT(RKONTO1)(X(12),A(41))(T14)(A(33))(T4)(A);
R=R-1;
END;
END;
ELSE DO;
IF KONTONR>=KONTO2 THEN KONTONR='SLUT9999999';
IF KONTONR¬=KONTONRG THEN CALL SKRIV_SUMMA;
END;
IF KONTONR='SLUT9999999' THEN GO TO UT;
IF LISTTYP=1 THEN CALL POSTSKRIV; /* KONTOUTDRAG */
SUMMA(1)=SUMMA(1)+BELOPP;
ANTAL_KONT=ANTAL_KONT+1;
GO TO L1;
UT: IF TOT_ANTAL_KONT=0 THEN DO;
CALL OUTPUT(1,6);
PUT SKIP(2) EDIT('**** INGEN KONTERING INOM BEGÄRT OMRÅDE')(A);
R=R-2;
END;
IF R¬=0 THEN PUT SKIP(R);
D=DATUM;
CALL PLOAD('Q ');
END;