|
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: 62015 (0xf23f)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »V101UKTO«
└─⟦ce820ec03⟧ Bits:30008772 50001604
└─⟦this⟧ »V101UKTO«
DCL VER FIXED (8) INIT (11850211);
/* PROGRAM-ID. V101UKTO.
DATE-WRITTEN. 850211.
AUTHOR. OLLE.
REMARKS. PROGRAMMET SKRIVER UT KONTERINGAR SOM
INNEHÅLLER ÖNSKAT UNDERKONTO. DOCK MÅSTE
KONTOT UNDER VILKET UNDERKONTOT ÄR BOKAT
VARA MARKERAT MED DEN UNDERKONTOPLAN SOM
ANGIVITS I BESTÄLLNINGEN.
F.N. FÅR MAN SLÅ K8 OCH KOMMER TILL HUVUDMENYN OCH FÅR GÖRA OMBEST. */
DCL KONTO1 CHAR(11),
KONTO2 CHAR(11),
RKONTO1 CHAR(13) INIT('-----.---.---'),
RKONTO2 CHAR(13) INIT('-----.---.---'),
DATUM1 CHAR(6) INIT (' '),
DATUM2 CHAR(6) INIT (' '),
DAT1BIN BINARY,
DAT2BIN BINARY,
SPTYP BINARY INIT (0), /* 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 VERTEXT FILE,
VERBELOP FILE,
KONTOP 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),
STARTSID BINARY INIT (0),
STARTSIDCH CHAR (5),
PUNDERTR BINARY INIT (0),
R BINARY INIT(0),
NAMN (3) CHAR(11) INIT('MELLANKRAFT','KVV/KWAROS','AROS'),
RTEXT(8) CHAR(22) INIT(
'KONTOUTDRAG per U-KTO',
'SALDOBESKED',
'PERDAG',
'BOKDAG',
'BOKDAG PERDAG VER.',
'',
'TEXT',
''),
RKONTO CHAR(13),
KONTONRG CHAR(11),
KONTO5FOREG CHAR (5),
TEXTKTO CHAR (5),
WKONTO1 CHAR (11),
KTOTEXT CHAR (32),
T15BELRED CHAR (15),
STARTSW BINARY INIT (1),
KONSTANT BINARY,
BUFF CHAR(20),
T1 CHAR(1),
T61 CHAR(6),
T61KOP CHAR (6),
T61KOP2 CHAR (6),
T62 CHAR(6),
T62KOP CHAR (6),
T62KOP2 CHAR (6),
T11 CHAR(11),
T13 CHAR(13),
T13KOP CHAR (13),
T13KOP2 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),
SVAR CHAR (1),
STARTKTOFEL BINARY INIT (0),
KEYT BINARY INIT (0),
FX6 FIXED(6),
TYP1 BINARY INIT(0),
TYP2 BINARY INIT(0), /* 1=UKTO I SÖKBEGR. 2=IK I SÖKBEGR.*/
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),
PP POINTER,
1 STR BASED(PP),
2 X CHAR(2),
2 Y CHAR(2), /* 5= KONTO, 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(' V10B Version 1.1 810424');
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;
IF STARTSID > SIDA THEN DO;
SIDA = SIDA + 1;
GO TO R99;
END;
IF STARTSID = SIDA THEN R = 0;
I_R=LISTTYP;
PUT SKIP(R+3) EDIT(NAMN(FIRMA-6))(A(30))(RTEXT(I_R))(A(45))('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;
R99:
R = RADANT - 8;
RETURN;
END;
STYRDATA:PROC;
PUT FILE(D) SKIP EDIT ('Kontoutdrag U-KTO ') (A(47));
J = 59;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('För U-KTO ') (A);
J = 106;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT (' ') (A);
J = 153;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('SUMMERING') (A);
J = 200;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('PERDAG = 1, BOKDAG = 2') (A);
J = 247;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('Fr.o.m. DATUM') (A);
J = 294;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('Till DATUM') (A);
J = 341;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('V.g. angiv första sidnr.') (A);
J = 81;
CALL MOVEBUFF(J);
CALL TYPIST(RKONTO1,13);
CALL TYPIST('┣10┫',1);
GET SKIP LIST (BUFF);
CALL KEYFUN (KEYT);
IF KEYT = 140 THEN GO TO SLUT;
CALL KONTORED;
RKONTO1=RKONTO;
PUT FILE(D) EDIT(RKONTO1)(A);
J = 128;
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);
CALL KEYFUN (KEYT);
IF KEYT = 140 THEN GO TO S99;
J = 175;
CALL MOVEBUFF(J);
IF OFFSET>1 & TYP2 = 2 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));
CALL KEYFUN (KEYT);
IF KEYT = 140 THEN GO TO S99;
J = 234;
CALL MOVEBUFF (J);
S4: GET SKIP LIST (SPTYP);
IF SPTYP<1 ö SPTYP>2 THEN GO TO S4;
PUT FILE (D) EDIT (SPTYP) (A);
J = 276;
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 = 323;
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='7 ';
IF TYP1=2 THEN Y='8 ';
IF Y='4 ' THEN LISTTYP=1;
ELSE LISTTYP=2;
Y = '4 ';
LISTTYP = 1;
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;
J = 373;
CALL MOVEBUFF (J);
GET SKIP LIST (STARTSID);
PUT FILE (D) EDIT (STARTSID) (A);
S99:
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 ST30;
END;
ST10:
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;
WKONTO1 = KONTO1;
IF J = -1 ö J > 5 THEN DO;
STARTKTOFEL = 1;
IF J = -1 THEN J = 11;
SUBSTR (KONTO1,J,1) = '-';
GO TO ST2;
END;
STARTKTOFEL = 2;
J = 376;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('Kontot saknar kontering') (A);
J = 517;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT ('MENYN = F7 NYTT KTO = F2') (A);
DO I = 1 TO 300;
CALL OUTPUT (1,6);
END;
ST15:
GET SKIP LIST (SVAR);
CALL KEYFUN (KEYT);
IF KEYT = 23 THEN GO TO SLUT;
IF KEYT = 18 THEN DO;
RKONTO1 = '-----.---.---';
RKONTO2 = RKONTO1;
STARTKTOFEL = 0;
OFFSET = 1;
KFLAGG = 0;
IF R ¬= 0 THEN PUT SKIP (R);
R = 0;
GO TO L0;
END;
GO TO ST15;
RCODE=1;
RETURN;
ST2:
IF STARTKTOFEL = 1 THEN DO;
J = 376;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT
('Angivet kontobegrepp saknar kontering. Följande') (A)
('begrepp finns:') (A(34))
(SUBSTR (KONTO1,1,5)) (A) ('.') (A)
(SUBSTR (KONTO1,6,3)) (A) ('.') (A)
(SUBSTR (KONTO1,9,3)) (A);
J = 517;
CALL MOVEBUFF (J);
PUT FILE (D) EDIT
('MENYN = F7 NYTT KTO = F2 TUTAochKÖR = RETURN') (A);
DO I = 1 TO 300;
CALL OUTPUT (1,6);
END;
ST20:
GET SKIP LIST (SVAR);
CALL KEYFUN (KEYT);
IF KEYT = 23 THEN GO TO SLUT;
IF KEYT = 18 THEN DO;
RKONTO1 = '-----.---.---';
RKONTO2 = RKONTO1;
STARTKTOFEL = 0;
OFFSET = 1;
KFLAGG = 0;
IF R ¬= 0 THEN PUT SKIP (R);
R = 0;
GO TO L0;
END;
IF KEYT = 13 THEN GO TO ST30;
GO TO ST20;
END;
ST30:
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;
_UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD
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 DO;
IF STARTSW = 1 THEN DO;
KONTONRG = KONTONR;
STARTSW = 0;
RETURN;
END;
RETURN;
END;
IF KONTONR¬='SLUT9999999' THEN RCODE=1;
RETURN;
END;
KONTOTEXT:PROC;
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 K88;
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:
IF STARTSID > SIDA - 1 THEN GO TO SKR5;
PUT SKIP EDIT(T11)(A(12))(T13)(A)(' ')(A(M-1))(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 STARTSID > SIDA - 1 THEN GO TO SKR90;
IF K¬=11 THEN DO;
PUT SKIP;
END;
SKR90:
IF K ¬= 11 THEN DO;
R = R - 1;
ANTAL_KONT = 0;
END;
SKR99:
RETURN;
END;
/* UTSKRIFT AV LISTRAD FÖR KONTOUTDRAG */
POSTSKRIV:PROC;
IF R < 8 THEN DO;
PUNDERTR = 1;
CALL RUB;
END;
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=' ';
IF PUNDERTR = 1 THEN DO;
PUNDERTR = 0;
GO TO P100;
END;
T13KOP2 = T13;
T61KOP2 = T61;
IF T13 ¬= T13KOP THEN GO TO P100;
T13 = (' ');
IF T61 ¬= T61KOP THEN GO TO P100;
T61 = (' ');
P100:
IF STARTSID > SIDA - 1 THEN GO TO P200;
PUT SKIP EDIT(' ')(A(12))(T13)(A(18))(T61)(A(8))(T62)(A(8))
(VERNR)(P'-----9',X(1))(T14)(A(18))(TEXT)(A);
T13KOP = T13KOP2;
T61KOP = T61KOP2;
P200:
R=R-1;
SUBSTR (KONTONRG,1,5) = SUBSTR (KONTONR,1,5);
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='7 ' ö Y='8 ' THEN DO; /* U-KONTO ELLER IK-SLAG*/
D=DATUM;
CALL PLOAD('V12 ');
END;
CALL STARTPOST;
IF RCODE = 1 & STARTKTOFEL = 2 THEN GO TO L0;
L1: CALL POST; /* INLÄSN. AV 255 REC. FRÅN VERBELOP */
CALL DATTEST;
IF RCODE¬=0 THEN GO TO L1; /* LÄST KONTO ¬= SÖKT */
IF OFFSET>1 THEN DO;
CALL KONTOTEST;
IF RCODE ¬= 0 THEN GO TO L1;
IF (SUBSTR (KONTONR,1,5) ¬= SUBSTR (KONTONRG,1,5)) ö
(SUBSTR (KONTONR,9,3) ¬= SUBSTR (KONTONRG,9,3)) THEN DO;
CALL SKRIV_SUMMA;
END;
_UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD
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:
DO I = 1 TO 2000;
END;
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) EDIT (' ') (A);
RKONTO1 = '-----.---.---';
RKONTO2 = RKONTO1;
STARTKTOFEL = 0;
OFFSET = 1;
KFLAGG = 0;
_UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD__UNREAD
GO TO L0;
SLUT:
D=DATUM;
CALL PLOAD('Q ');
END;