|
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: 65965 (0x101ad)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »H3001«
└─⟦74df05346⟧ Bits:30008773 50001606
└─⟦this⟧ »H3001«
/* PROGRAM-ID. H300.
AUTHOR. OLLE.
DATE-WRITTEN. 810527.
REMARKS. PROGRAMMET BERÄKNAR FAKTUROR I HÖGSPÄNNINGS-
DEBITERINGEN.
*/
DCL AVLREG FILE,
ABONNREG FILE,
STATREG1 FILE,
STATREG2 FILE,
TAXA FILE,
TILLRAD FILE,
PARADEBF FILE,
NOTER FILE,
PRELAR FILE,
SAMFIL FILE,
UDEB FILE;
%INCLUDE AVLREGP;
%INCLUDE ABONREGP;
%INCLUDE ST1REGP;
%INCLUDE ST2REGP;
%INCLUDE TARREGP;
%INCLUDE TILLRADP;
%INCLUDE PARAREGP;
%INCLUDE PREGP;
DCL 1 SAMINAREA,
2 SAMHABNR FIXED (8),
2 SAMHFILLER CHAR (30),
2 SAMDUMMY (20),
3 SAMDUMMYFILLER CHAR (20);
/* SAMBANDSPOSTENS LÄNGD 435 POS */
DCL 1 SIND POINTER;
DCL 1 SPOST BASED (SIND),
2 SDELPOST,
3 SUABNR FIXED (8),
3 SP CHAR (1),
3 SE CHAR (1),
3 SDEBMARK CHAR (1),
3 SFILLER CHAR (12);
DCL 1 UDEBPOST,
2 UABNR FIXED (8),
2 UNAMN CHAR (20),
2 UDEBFILLER CHAR (22),
2 UDUMMY (15),
3 UKV CHAR (1),
3 UPER BINARY,
3 UP FIXED (6,2),
3 UE FIXED (8),
3 UFILLER CHAR (7);
/* UDEBPOSTENS LÄNGD 350 POS */
DCL 1 UIND POINTER;
DCL 1 UPOST BASED (UIND),
2 UDELPOST,
3 UDKV CHAR (1),
3 UDPER BINARY,
3 UDP FIXED (6,2),
3 UDE FIXED (8),
3 UDFILLER CHAR (7);
DCL 1 NOTPOST,
2 NOT CHAR (1),
2 NOTLANGD BINARY,
2 NOTAVSTAV (5) BINARY,
2 NOTTEXT CHAR (87);
/* NOTPOSTENS LÄNGD 100 POS */
DCL P0 FIXED (5),
P1 FIXED (5),
P2 FIXED (5),
P3 FIXED (5),
WST2DEBPMELL FIXED (6,2),
WST2PAVGMELL FIXED (10,2),
WMANAD (12) CHAR (10) INIT('januari ',
'februari ',
'mars ',
'april ',
'maj ',
'juni ',
'juli ',
'augusti ',
'september ',
'oktober ',
'november ',
'december '),
WMANADNR FIXED (2),
NOTINDEX (10) CHAR (1),
WUTHOPP CHAR (4) INIT (' '),
WTAXA (2) CHAR (3) INIT ('180','181'),
WEFBR (2) FIXED (10) INIT ((2)0),
WFBRAVG (2) FIXED (10,2),
WFASTAVG (2) FIXED (10,2),
WSKATT4 (2) FIXED (10,2),
WSK4FBR (2) FIXED (10),
WSKATT3 (2) FIXED (10,2),
WSK3FBR (2) FIXED (10),
WSAMTOT (2) FIXED (10,2),
I BINARY, /* NOTINDEX */
P BINARY, /* NOTRADSRÄKNARE */
T BINARY, /* INDEX UTSKRIFT AV TAXESAMMANDRAG*/
R BINARY, /* RADRÄKNARE FÖR FAKTURASPECEN */
J BINARY, /* I DO-SATS VID NOLLST. AV NOTINDEX*/
UTHOPP CHAR (4),
SVAR CHAR (1),
STOPP CHAR (1),
PMSTRG FIXED (6),
PFBRRG FIXED (6),
RADACC BINARY INIT (0),
PERPFBR FIXED (6),
PEKARE BINARY,
UPEKARE BINARY,
HJUPEKARE BINARY,
STARTP BINARY,
STARTPERIOD BINARY,
EMSTRG FIXED (6),
EFBRRG FIXED (6),
PEREFBR FIXED (8),
HK CHAR (1) INIT ('0'),
PMLAGST CHAR (1) INIT ('1'),
WFBR FIXED (8),
WUEFBRMELL FIXED (8) INIT (0),
WUPFBRMELL FIXED (6,2) INIT (0),
WUEFELLIST FIXED (8) INIT (0),
WOREDKWH FIXED (5) INIT (40000),
WST2SK4FBR FIXED (8);
DCL 1 ST2REGNYCKEL,
2 ST2NABNR FIXED (8),
2 ST2NPER CHAR (1);
DATFEL: PROC;
DF10:
PUT SKIP LIST ('DATUMFEL ',AVLDAT,ABABNR);
DF99:
RETURN;
END;
INUTDAT: PROC;
DCL IUINDAT FIXED (6),
IUUTDAT FIXED (6),
IUDANT FIXED (5);
IU10:
READ KEY (AVLABNR) FILE (PRELAR) INTO (PRELPOST);
IUINDAT = PRPRELDAT;
PEKARE = ADDR (ST1INAREA);
PEKARE = PEKARE + ((PARADEBPER - 1) * 3 *30);
DO I = 1 TO 3;
PEKARE = PEKARE + 30;
UNSPEC (ST1) = PEKARE;
IF ST1AVLDAT > PRPRELDAT THEN IUUDAT = ST1AVLDAT;
END;
CALL DAGBER65 (IUINDAT,IUUTDAT,IUDANT);
IF IUDANT = 99999 THEN DO;
PUT SKIP LIST ('DATUMFEL ',ABABNR,IUINDAT,IUUTDAT,IUDANT);
END;
IU99:
RETURN;
END;
RUB: PROC;
RP10:
PUT SKIP (2);
IF RADACC = 0 THEN GO TO RP20;
PUT SKIP (5);
RP20:
PUT EDIT (' HÖGSPÄNNINGSDEBITERING, SIGNALLISTA FÖR KONTR')
(A) ('OLL AV UNDERMÄTARFÖRBRUKNINGAR AVSEENDE PERIOD ') (A)
(PARADEBPER) (A(4)) ('DATUM ') (A) (PARADEBDAT) (A(8));
RADACC = 45;
PUT SKIP (2) EDIT ('AB-NR EFFEKT ENERGIFBR ') (A)
(' ÅRSFBR NAMN') (A);
PUT SKIP;
RP99:
RETURN;
END;
FELLISTA: PROC;
FL10:
IF RADACC < 5 THEN DO;
CALL RUB;
END;
PUT SKIP EDIT (ABABNR) (A(12)) (' ') (A(5)) (WUPFBRMELL)(P'------V,99')
(' ') (A(5)) (WUEFBRMELL) (P'-------9') (' ') (A(5)) (ABARFBR)
(P'-------9') (' ') (A(6)) (ABRNAMN) (A(36));
RADACC = RADACC - 1;
WUEFBRMELL = 0;
WUPFBRMELL = 0;
FL99:
RETURN;
END;
PMSTFEL: PROC;
PP10:
PUT SKIP LIST ('PMSTFEL, ABNR ',AVLPMST,ABABNR);
PP99:
RETURN;
END;
PMAXFEL: PROC;
PM10:
/* PUT SKIP LIST ('EFFEKTFEL ', NYST1PFBR); */
PM99:
RETURN;
END;
PEKADR: PROC;
PA10:
PEKARE = ADDR (ST1INAREA);
STARTP = PEKARE + 5;
PA99:
RETURN;
END;
ST2NOLLSTALL: PROC;
DCL 1 BINOLL BINARY INIT (0);
ST2P10:
DO I = 1 TO 120;
SUBSTR (ST2KV,I,1) = BINOLL;
END;
ST2SK4FBR = 0;
ST2SK4 = 0;
ST2SK3FBR = 0;
ST2SK3 = 0;
SUBSTR (ST2TARAD,1,5) = '00000';
ST2P99:
RETURN;
END;
/* BER. AV ÅRSMEDELEFFEKTER */
APMEDEL: PROC;
DCL 1 APM,
2 APML (4) FIXED (6,2),
2 APMLMAN (4) FIXED (2);
APM10:
DO J = 1 TO 4;
/* PUT SKIP LIST ('ST1PFBR = ',ST1PFBR,' APML = ',APML(J),APMLMAN(J)); */
IF ST1PFBR > APML (J) THEN GO TO APM50;
END;
GO TO APM99;
APM50:
K = 4;
DO L = (5-J) TO 1 BY -1;
IF K = 1 THEN GO TO APM60;
APML (K) = APML (K-1);
APMLMAN (K) = APMLMAN (K-1);
K = K - 1;
END;
APM60:
APML (J) = ST1PFBR;
APMLMAN (J) = I;
APM99:
RETURN;
END;
/* H Ä R B Ö R J A R H U V U D P R O G R A M M E T */
A10:
PUT FILE (D) EDIT (' ') (A(47)) ('AVLÄSN REGISTRERING = 1') (A(47))
('DEBITERINGSBERÄKNING = 2 ') (A(47))
('ÅRSAVRÄKNING = 3 ') (A(47)) (' ') (A(47))
('DITT VAL = ') (A);
GET SKIP LIST (SVAR);
PUT FILE (D) EDIT (SVAR) (A);
A15:
OPEN AVLREG;
OPEN ABONNREG;
OPEN STATREG1;
OPEN STATREG2;
OPEN UDEB;
OPEN TILLRAD;
OPEN TAXA;
READ FILE (TAXA) INTO (TAR180);
READ FILE (TAXA) INTO (TAR181);
CALL PEKADR;
A20:
ON ENDFILE GO TO F10;
ON ERROR GO TO F00;
READ FILE (AVLREG) INTO (AVLPOST);
ON ERROR GO TO G00;
READ KEY (AVLABNR) FILE (ABONNREG) INTO (ABONPOST);
IF SUBSTR (ABMAN,2,1) = 'M' THEN GO TO A20;
ON ERROR GO TO H00;
READ KEY (AVLABNR) FILE (STATREG1) INTO (ST1INAREA);
IF ABTAR = '180' THEN TARAKT = TAR180;
ELSE TARAKT = TAR181;
IF SVAR = '1' THEN GO TO A30;
IF SVAR = '2' THEN GO TO B10;
IF SVAR = '3' THEN DO;
OPEN PARADEBF;
READ FILE (PARADEBF) INTO (PARAPOST);
GO TO C10;
END;
/* KONTROLL AVLÄSNINGSDATUM */
A30:
PEKARE = STARTP + ((AVLPERIOD - 1) * 30);
UNSPEC (ST1) = PEKARE;
IF (AVLDAT < ST1AVLDAT ö AVLDAT = ST1AVLDAT) THEN DO;
CALL DATFEL;
END;
/* PUT SKIP LIST ('ABNR = ', AVLABNR);
PUT SKIP LIST ('AVLUPFBR = ',AVLUPFBR);
PUT SKIP LIST ('AVLUEFBR = ',AVLUEFBR);*/
/* BERÄKNING EFFEKTVÄRDE */
IF ABPMTYP = 'G' THEN DO;
NYST1PFBR = AVLPMST * ABPKNST * 0.001;
GO TO A250;
END;
IF AVLPMST < ST1PMST THEN DO;
IF ABPKAP = 1 THEN PMSTRG = 10000;
IF ABPKAP = 2 THEN PMSTRG = 100000;
IF ABPKAP = 3 THEN PMSTRG = 1000000;
PFBRRG = PMSTRG - ST1PMST;
PERPFBR = PFBRRG + AVLPMST;
NYST1PFBR = PERPFBR * ABPKNST * 0.001;
GO TO A100;
END;
A100:
IF AVLUPFBR ¬= 0 THEN DO;
IF AVLUPFBR = 99999999 THEN DO;
NYST1PFBR = 0;
GO TO A250;
END;
NYST1PFBR = AVLUPFBR * 0.01;
GO TO A250;
END;
IF SUBSTR (ABMAN,2,1) = 'U' ö SUBSTR (ABMAN,2,1) = 'M' THEN GO TO A150;
IF AVLPNOT = 'A' THEN GO TO A150;
IF AVLPMST < ST1PMST THEN GO TO A200;
IF AVLPMST = ST1PMST THEN DO;
CALL PMSTFEL;
END;
A150:
PERPFBR = AVLPMST - ST1PMST;
NYST1PFBR = PERPFBR * ABPKNST * 0.001;
A200:
IF NYST1PFBR > ABPAB THEN DO;
CALL PMAXFEL;
END;
A250:
/* BERÄKNING ENERGIFÖRBRUKNING */
IF AVLEMST < ST1EMST THEN DO;
IF ABEKAP = 1 THEN EMSTRG = 10;
IF ABEKAP = 2 THEN EMSTRG = 100;
IF ABEKAP = 3 THEN EMSTRG = 1000;
IF ABEKAP = 4 THEN EMSTRG = 10000;
IF ABEKAP = 5 THEN EMSTRG = 100000;
IF ABEKAP = 6 THEN EMSTRG = 1000000;
EFBRRG = EMSTRG - ST1EMST;
PEREFBR = EFBRRG + AVLEMST;
NYST1EFBR = PEREFBR * ABEKNST;
GO TO A300;
END;
A270:
IF AVLUEFBR ¬= 0 THEN DO;
IF AVLUEFBR = 99999999 THEN DO;
NYST1EFBR = 0;
GO TO A300;
END;
NYST1EFBR = AVLUEFBR;
GO TO A300;
END;
PEREFBR = AVLEMST - ST1EMST;
NYST1EFBR = PEREFBR * ABEKNST;
A300:
NYST1KV = AVLKVARTAL;
NYST1PER = AVLPERIOD;
NYST1AVLDAT = AVLDAT;
NYST1PMST = AVLPMST;
NYST1PKNST = ABPKNST;
NYST1EMST = AVLEMST;
NYST1EKNST = ABEKNST;
ST1INDUMMY (AVLPERIOD + 1) = NYST1DELPOST;
REWRITE FILE (STATREG1) FROM (ST1INAREA);
ABEMST = NYST1EMST;
ABPMST = NYST1PMST;
REWRITE FILE (ABONNREG) FROM (ABONPOST);
GO TO A20;
B10:
IF SUBSTR (ABMAN,1,1) = 'M' THEN GO TO A20;
IF HK = '1' THEN GO TO B13; /* HK=1, SEOF STATREG2 GÖRS EJ*/
IF HK = '2' THEN GO TO B20; /* SLUT UMÄTKONTR. AVL FINNS */
OPEN STATREG2;
CALL SEOF (STATREG2);
OPEN PARADEBF;
READ FILE (PARADEBF) INTO (PARAPOST);
HK = '1';
OPEN SAMFIL;
B11:
ON ENDFILE GO TO B12; /* NOLLST.AV DEBMARK. */
READ FILE (SAMFIL) INTO (SAMINAREA);
SIND = ADDR (SAMINAREA);
UPEKARE = SIND + 15;
DO J = 1 TO 20;
UPEKARE = UPEKARE + 20;
UNSPEC (SIND) = UPEKARE;
SDEBMARK = '0';
END;
GO TO B11;
B12:
ON ENDFILE GO TO B13; /* NOLLST. AV UDEBFILEN. */
READ FILE (UDEB) INTO (UDEBPOST);
UDEBFILLER = ' ';
UPEKARE = ADDR (UDEBPOST);
HJUPEKARE = UPEKARE + 27;
UPEKARE = HJUPEKARE + (PARADEBPER - 1) * 3 * 20;
DO J = 1 TO 3;
UPEKARE = UPEKARE + 20;
UNSPEC (UIND) = UPEKARE;
UDKV = ' ';
UDPER = 0;
UDP = 0;
UDE = 0;
UDFILLER = ' ';
END;
REWRITE FILE (UDEB) FROM (UDEBPOST);
GO TO B12;
B13:
IF HK = '2' THEN GO TO B20;
OPEN UDEB;
OPEN SAMFIL;
IF SUBSTR (ABMAN,2,1) = 'S' ö SUBSTR (ABMAN,2,1) = 'U' THEN GO TO B14;
GO TO A20;
B14:
READ KEY (ABHABNR) FILE (UDEB) INTO (UDEBPOST);
READ KEY (ABHABNR) FILE (SAMFIL) INTO (SAMINAREA);
SIND = ADDR (SAMINAREA);
UPEKARE = SIND + 15;
DO J = 1 TO 20;
UPEKARE = UPEKARE + 20;
UNSPEC (SIND) = UPEKARE;
IF SUABNR = ABABNR THEN GO TO B15;
END;
PUT SKIP LIST ('SAMFIL SAKNAR POST, ABNR = ',ABABNR);
GO TO A20;
B15:
/* PUT SKIP LIST ('UABNR, ABNR ',ABABNR,ABHABNR); */
DO I = 0 TO 2;
UPEKARE = ADDR (UDEBPOST);
HJUPEKARE = UPEKARE + 47;
UPEKARE = HJUPEKARE + ((PARADEBPER - 1) * 3 * 20) + I * 20;
/* PUT SKIP LIST ('UPEK1 = ',UPEKARE); */
UNSPEC (UIND) = UPEKARE;
PEKARE = STARTP + ((PARADEBPER - 1) * 3 + 1) * 30 + I * 30;
/* PUT SKIP LIST ('ST1PEK1 = ',PEKARE); */
UNSPEC (ST1) = PEKARE;
/* PUT SKIP LIST ('ST1PFBR = ',ST1PFBR);*/
IF SP = 'N' THEN GO TO B16;
WUPFBRMELL = ST1PFBR;
IF SP = '-' THEN DO;
WUPFBRMELL = WUPFBRMELL * -1;
END;
/* PUT SKIP LIST ('UDP1 = ',UDP); */
UDP = UDP + WUPFBRMELL;
/* PUT SKIP LIST ('UDP = ',UDP); */
B16:
IF SE = 'N' THEN GO TO B17;
WUEFBRMELL = ST1EFBR;
/* PUT SKIP LIST ('WUEFBR = ',WUEFBRMELL); */
IF SE = '-' THEN DO;
WUEFBRMELL = WUEFBRMELL * -1;
END;
/* PUT SKIP LIST ('UDE1 = ',UDE); */
UDE = UDE + WUEFBRMELL;
/* PUT SKIP LIST ('UDE = ', UDE); */
UDKV = PARADEBPER;
UDPER = (PARADEBPER - 1) * 3 + I;
B17:
IF SUBSTR (ABMAN,2,1) = 'U' THEN DO;
CALL FELLISTA;
END;
END;
SDEBMARK = '1';
REWRITE FILE (UDEB) FROM (UDEBPOST);
REWRITE FILE (SAMFIL) FROM (SAMINAREA);
GO TO A20;
B20:
IF SUBSTR (ABMAN,2,1) = 'S' ö SUBSTR (ABMAN,2,1) = 'U' THEN GO TO A20;
CALL ST2NOLLSTALL;
ST2ABNR = ABABNR;
ST2KV = PARADEBPER;
SUBSTR (ST2LOEPNR,1,1) = SUBSTR (PARADEBAR,2,1);
SUBSTR (ST2LOEPNR,2,1) = '0';
SUBSTR (ST2LOEPNR,3,1) = PARADEBPER;
SUBSTR (ST2LOEPNR,4,1) = '0';
SUBSTR (ST2LOEPNR,5,1) = ABLOEPNR + 1;
ABLOEPNR = ABLOEPNR + 1;
B25:
IF SUBSTR (ABMAN,2,1) = 'H' THEN DO; /* ADD UEFBR o UPFBR t ST1POST*/
OPEN UDEB;
READ KEY (ABABNR) FILE (UDEB) INTO (UDEBPOST);
/* PUT SKIP LIST ('ABNR = ',ABABNR); */
UIND = ADDR (UDEBPOST);
UPEKARE = UNSPEC (UIND) + 27 + (PARADEBPER - 1) * 60;
ST1 = ADDR (ST1INAREA);
PEKARE = UNSPEC (ST1) + 5 + (PARADEBPER -1) * 90;
DO I = 1 TO 3;
/* PUT SKIP LIST ('I = ', I); */
PEKARE = PEKARE + 30;
/* PUT SKIP LIST ('ST1PEK2 = ',PEKARE); */
UNSPEC (ST1) = PEKARE;
UPEKARE = UPEKARE + 20;
/* PUT SKIP LIST ('UPEK2 = ',UPEKARE); */
UNSPEC (UIND) = UPEKARE;
/* PUT SKIP LIST ('ST1PFBR = ',ST1PFBR); */
/* PUT SKIP LIST ('UDP = ',UDP); */
ST1PFBR = ST1PFBR + UDP;
/* PUT SKIP LIST ('ST1PFBRUT = ',ST1PFBR); */
ST1EFBR = ST1EFBR + UDE;
END;
REWRITE FILE (UDEB) FROM (UDEBPOST);
END;
ST1 = ADDR (ST1INAREA);
PEKARE = UNSPEC (ST1) + 5;
WFBR = 0;
ST2PMEDEL1 = 0;
ST2PMEDEL2 = 0;
/* BERÄKNING AV MEDELEFFEKTEN FÖR DE TVÅ HÖGSTA EFFEKTTOPPARNA */
B30:
/* DETTA ÄR EN PROVISORISK LÖSNING */
STARTPERIOD = 1;
IF SUBSTR (ABMAN,3,1) = 'A' THEN DO;
STARTPERIOD = 10;
PEKARE = PEKARE + (9 * 30);
END;
DO I = STARTPERIOD TO PARADEBPER * 3;
PEKARE = PEKARE + 30;
UNSPEC (ST1) = PEKARE;
IF I = 1 THEN GO TO B32;
IF I = 2 THEN GO TO B35;
IF PMLAGST = 1 THEN GO TO B32;
IF PMLAGST = 2 THEN GO TO B35;
B32:
IF SUBSTR (ABMAN,5,1) = 'V' THEN DO;
IF (I > 3 & I < 10) THEN DO;
ST2PMEDEL1 = 0;
GO TO B40;
END;
END;
IF ST1PFBR > ST2PMEDEL1 THEN DO;
ST2PMEDEL1 = ST1PFBR;
ST2PM1MAN = I;
GO TO B40;
END;
B35:
IF SUBSTR (ABMAN,5,1) = 'V' THEN DO;
IF (I > 3 & I < 10) THEN DO;
ST2PMEDEL2 = 0;
GO TO B40;
END;
END;
IF ST1PFBR > ST2PMEDEL2 THEN DO;
ST2PMEDEL2 = ST1PFBR;
ST2PM2MAN = I;
GO TO B40;
END;
B40:
IF ST2PMEDEL2 < ST2PMEDEL1 THEN PMLAGST = '2';
ELSE PMLAGST = '1';
B42:
END;
ST2DEBP = (ST2PMEDEL1 + ST2PMEDEL2) / 2;
B43:
/* IF SUBSTR (ABMAN,5,1) = 'V' THEN GÖR NÅGONTING TILL MARS 82. */
CALL INUTDAT;
IF IUDANT = 99999 THEN GO TO A20;
ST2FAVG = TPAKTFAVG * IUDANT / 365;
IF SUBSTR (ABMAN,5,1) = 'F' THEN ST2FAVG = 0;
ST2PAVG = ST2DEBP * TPAKTPAVG * IUDANT / 365;
WFBR = 0;
ST1 = ADDR (ST1INAREA);
PEKARE = UNSPEC (ST1) + 5;
PEKARE = PEKARE + 3 * ((PARADEBPER - 1) * 30);
DO I = 1 TO 3;
PEKARE = PEKARE + 30;
UNSPEC (ST1) = PEKARE;
WFBR = WFBR + ST1EFBR;
END;
ST2EAVG = WFBR * TPAKTEAVG * 0.01;
ST2TRPFORL = 0;
ST2TRPKRTILL = 0;
ST2TREFORL = 0;
ST2TREKRTILL = 0;
ST2TRHYR = 0;
ST2TRTILLAPRIS = 0.00;
IF ABHOGLAG = 'L' & ABETRAFO = 'E' THEN DO;
ST2TRPFORL = ST2DEBP * 0.015;
ST2TRPKRTILL = ST2TRPFORL * TPAKTPAVG * IUDANT / 365;
ST2TREFORL = WFBR * 0.015;
WFBR = WFBR + ST2TREFORL;
ST2TREKRTILL = ST2TREFORL * TPAKTEAVG * 0.01;
GO TO B46;
END;
IF ABHOGLAG = 'L' & ABETRAFO = 'T' THEN DO;
ST2TREFORL = WFBR * 0.015;
WFBR = WFBR + ST2TREFORL;
ST2TREKRTILL = ST2TREFORL * TPAKTEAVG * 0.01;
ST2TRHYR = (TPAKTPTILLKR + (ST2DEBP * TPAKTPKRPERKW))* IUDANT /365;
END;
B46:
ST2OVERTILL = 0.00;
ST2NOTT = ' ';
ST2OVRAVDR = 0.00;
ST2NOTA = ' ';
IF ABSKKOD = '1' THEN DO;
ST2SK4FBR = WFBR;
ST2SK4 = WFBR * 0.04;
ST2SK3FBR = 0;
ST2SK3 = 0.00;
GO TO B80;
END;
IF ABSKKOD = '2' THEN GO TO B50;
IF ABSKKOD = '0' THEN DO;
ST2SK4FBR = 0;
ST2SK4 = 0.00;
ST2SK3FBR = 0;
ST2SK3 = 0.00;
GO TO B80;
END;
PUT SKIP LIST ('NU ÄR DET FEL I SKATTEKODEN = ',ABSKKOD);
GO TO B80;
B50:
IF ABOREDKWH = WOREDKWH THEN GO TO B60;
IF ABOREDKWH < WOREDKWH THEN GO TO B70;
PUT SKIP LIST ('FEL I SKATTEFÄLTET ABNR = ',ABABNR);
GO TO B80;
B60:
ST2SK3FBR = WFBR;
ST2SK3 = WFBR * 0.03;
GO TO B80;
B70:
ST2SK4FBR = WOREDKWH - ABOREDKWH;
ABOREDKWH = ABOREDKWH + ST2SK4FBR;
ST2SK4 = ST2SK4FBR * 0.04;
ST2SK3FBR = WFBR - ST2SK4FBR;
ST2SK3 = ST2SK3FBR * 0.03;
GO TO B80;
/* MARKERING I STATREG2 AV ATT TILLRADER FINNS OCH AV VILKEN TYP DE ÄR. */
B80:
OPEN TILLRAD;
B85:
ON ENDFILE GO TO B100;
ON ERROR GO TO B90;
READ FILE (TILLRAD) INTO (TILLRADPOST);
IF TILLABNR = ABABNR THEN DO;
IF TILLKVARTAL = PARADEBPER THEN DO;
I = SUBSTR (TILLRKOD,1,1);
SUBSTR (ST2TARAD,I,1) = SUBSTR (ST2TARAD,I,1) + '1';
GO TO B85;
END;
END;
GO TO B85;
B90:
PUT SKIP LIST ('LÄSFEL I TILLRAD ABNR RKOD = ',ABABNR,ONCODE);
GO TO Z99;
B100:
WRITE FILE (STATREG2) FROM (ST2POST);
REWRITE FILE (ABONNREG) FROM (ABONPOST);
REWRITE FILE (STATREG1) FROM (ST1INAREA);
GO TO A20;
/* ÅRSAVRÄKNING */
C10:
IF ABFLYTT = 'F' THEN GO TO A20;
IF SUBSTR (ABMAN,2,1) = 'M' THEN GO TO A20;
IF SUBSTR (ABMAN,2,1) = 'U' THEN GO TO A20;
DO I = 1 TO 4;
APML (I) = 0;
APMLMAN (I) = 0;
END;
C20:
DO I = 1 TO 12;
PEKARE = STARTP + (I * 30);
UNSPEC (ST1) = PEKARE;
IF SUBSTR (ABMAN,5,1) = 'V' THEN DO;
IF (I > 3 & I < 10) THEN DO;
ST1PFBR = 0;
END;
END;
CALL APMEDEL;
END;
C50:
APML (1) = APML (1) + APML (2) + APML (3) + APML (4);
APML (2) = APML (1) / 4;
C60:
OPEN STATREG2;
ST2NABNR = ABABNR;
ST2NPER = PARADEBPER;
READ KEY (ST2REGNYCKEL) FILE (STATREG2) INTO (ST2POST);
ST2DEBP = APML (2);
ST2PAVG = ST2DEBP * TPAKTPAVG;
IF ABHOGLAG = 'L' THEN DO;
ST2TRPFORL = ST2DEBP * 0.015;
ST2TRPKRTILL = ST2TRPFORL * TPAKTPAVG;
END;
IF ABETRAFO = 'T' THEN DO;
ST2TRHYR = (ST2DEBP + ST2TRPFORL) * 12.00;
IF ABSLINGDUBBEL = 'D' THEN DO;
ST2TRHYR = (ST2DEBP + ST2TRPFORL) * 15.00;
END;
END;
ST2ARSAVR = 'J';
DO I = 1 TO 4;
ST2PTOPP (I) = APMLMAN (I);
END;
REWRITE FILE (STATREG2) FROM (ST2POST);
GO TO A20;
F00:
F10:
IF SVAR = '1' THEN GO TO Z99;
IF SVAR = '3' THEN GO TO Z99;
IF HK = '2' THEN GO TO F20;
IF HK = '1' THEN HK = '2';
GO TO A15;
F20:
CLOSE STATREG2;
G00:
H00:
I00:
IF SVAR ¬= '2' THEN GO TO Z99;
PUT SKIP (RADACC);
Z99:
END;