|
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: 86320 (0x15130)
Types: Q1_Text, reclen=80
Notes: q1file
Names: »H6001«
└─⟦74df05346⟧ Bits:30008773 50001606
└─⟦this⟧ »H6001«
/* PROGRAM-ID. H500.
AUTHOR. OLLE.
DATE-WRITTEN. 810527.
REMARKS. PROGRAMMET SKRIVER UT HÖGSPÄNNINGSFAKTUROR
*/
DCL ABONNREG FILE,
STATREG1 FILE,
STATREG2 FILE,
TAXA FILE,
TILLRAD FILE,
PARADEBF FILE,
NOTER FILE,
PRELAR FILE;
DCL 1 ABONPOST,
2 ABABNR FIXED (8),
2 ABMAN CHAR (5), /* POS1 = M man POS2 = U undermät*/
2 ABPERSNR FIXED (10),
2 ABAADR CHAR (27),
2 ABRNAMN CHAR (36),
2 ABRADR CHAR (27),
2 ABRPNR CHAR (5),
2 ABRORT CHAR (8),
2 ABAVSER CHAR (15),
2 ABIKTO FIXED (13),
2 ABKONTDAT FIXED (6),
2 ABHOGLAG CHAR (1),
2 ABETRAFO CHAR (1),
2 ABTRFORL FIXED (3,2),
2 ABTAR CHAR (3),
2 ABKAT CHAR (3),
2 ABSKKOD CHAR (1),
2 ABPAB FIXED (5),
2 ABARFBR FIXED (8),
2 ABMNR CHAR (6),
2 ABUDAT FIXED (6),
2 ABEMST FIXED (6),
2 ABEKNST FIXED (4),
2 ABEKAP FIXED (1),
2 ABMTYP CHAR (6),
2 ABPMST FIXED (6),
2 ABPKNST FIXED (4),
2 ABPKAP FIXED (1),
2 ABPMTYP CHAR (1),
2 ABSLINGDUBBEL CHAR (1),
2 ABLOEPNR CHAR (1),
2 ABOREDKWH FIXED (5),
2 ABFILLER CHAR (13);
/* ABPOSTENS LÄNGD 220 POS */
DCL 1 ST2POST,
2 ST2ABNR FIXED (8),
2 ST2KV CHAR (1),
2 ST2LOEPNR CHAR (5),
2 ST2DEBP FIXED (6,2),
2 ST2FAVG FIXED (6,2),
2 ST2PAVG FIXED (10,2),
2 ST2EAVG FIXED (10,2),
2 ST2TRPFORL FIXED (10,2), /* EFFEKTFÖRL I TRAFO */
2 ST2TRPKRTILL FIXED (10,2), /* TILLÄGGSAVG FÖR TRAFOFÖRL */
2 ST2TREFORL FIXED (8), /* ENERGIFÖRL I TRAFO */
2 ST2TREKRTILL FIXED (10,2),/* ENERGITILLÄGG F TRAFOFÖRL */
2 ST2TRHYR FIXED (10,2), /* HYESBELOPP, P * A-PRIS/KW */
2 ST2TRPTILLAPRIS FIXED (4,2), /* A-PRIS/KW I TRFOHYRA */
2 ST2OVERTILL FIXED (10,2),
2 ST2NOTT CHAR (1),
2 ST2OVRAVDR FIXED (10,2),
2 ST2NOTA CHAR (1),
2 ST2SK4FBR FIXED (8),
2 ST2SK4 FIXED (10,2),
2 ST2SK3FBR FIXED (8),
2 ST2SK3 FIXED (10,2),
2 ST2TARAD CHAR (1),
2 ST2FARAD CHAR (1),
2 ST2PARAD CHAR (1),
2 ST2EARAD CHAR (1),
2 ST2SARAD CHAR (1),
2 ST2PMEDEL1 FIXED (6,2),
2 ST2PM1MAN BINARY,
2 ST2PMEDEL2 FIXED (6,2),
2 ST2PM2MAN BINARY,
2 ST2FILLER CHAR (5);
/* ST2POSTENS LÄNGD 125 POS */
DCL 1 ST1INAREA,
2 ST1INABNR FIXED (8),
2 ST1INDUMMY (15),
3 ST1DUMMYFILLER CHAR (30),
2 ST1DUMMYFILLER2 CHAR (22);
DCL 1 ST1 POINTER;
DCL 1 ST1POST BASED (ST1),
2 ST1DELPOST,
3 ST1KV CHAR (1),
3 ST1PER BINARY,
3 ST1AVLDAT FIXED (6),
3 ST1PMST FIXED (6),
3 ST1PKNST FIXED (4),
3 ST1PFBR FIXED (6,2),
3 ST1EMST FIXED (6),
3 ST1EKNST FIXED (4),
3 ST1EFBR FIXED (8);
/* ST1POSTENS LÄNGD 480 POS */
DCL 1 TAR180,
2 TP180 CHAR (3),
2 TP180FROM FIXED (6),
2 TP180FAVG FIXED (6,2),
2 TP180PAVG FIXED (6,2),
2 TP180EAVG FIXED (6,2),
2 TP180FBRU FIXED (3,2),
2 TR180FBRN FIXED (3,2),
2 TP180FILLER CHAR (7);
/* TAR180POSTENS LÄNGD 30 POS */
DCL 1 TAR181,
2 TP181 CHAR (3),
2 TP181FROM FIXED (6),
2 TP181FAVG FIXED (6,2),
2 TP181PAVG FIXED (6,2),
2 TP181EAVG FIXED (6,2),
2 TP181FBRU FIXED (3,2),
2 TP181FBRN FIXED (3,2),
2 TP181FILLER CHAR (7);
DCL 1 TARAKT,
2 TPAKTTARIFF CHAR (3),
2 TPAKTFROM FIXED (6),
2 TPAKTFAVG FIXED (6,2),
2 TPAKTPAVG FIXED (6,2),
2 TPAKTEAVG FIXED (6,2),
2 TPAKTFBRU FIXED (3,2),
2 TPAKTFBRN FIXED (3,2),
2 TPAKTFILLER CHAR (7);
DCL 1 TILLRADPOST,
2 TILLABNR FIXED (8),
2 TILLRKOD BINARY,
2 TILLORNR BINARY,
2 TILLTEXT CHAR (30),
2 TILLNOT CHAR (4),
2 TILLDAT1 FIXED (6),
2 TILLDAT2 FIXED (6),
2 TILLMSTIN FIXED (6),
2 TILLMSTUT FIXED (6),
2 TILLFBR FIXED (7),
2 TILLBELOPP FIXED (10,2),
2 TILLFILLER CHAR (12);
/* TILLRADPOSTENS LÄNGD 80 POS */
DCL 1 PARAPOST,
2 PARADEBAR CHAR (2),
2 PARADEBPER CHAR (1),
2 PARADEBDAT FIXED (6),
2 PARAFFD CHAR (6),
2 PARAFILLER CHAR (7);
/* PARAPOSTENS LÄNGD 30 POS */
DCL 1 NOTPOST,
2 NOT CHAR (1),
2 NOTLANGD BINARY,
2 NOTAVSTAV (5) BINARY,
2 NOTTEXT CHAR (87);
/* NOTPOSTENS LÄNGD 100 POS */
DCL 1 PRELAREA,
2 PRELABNR FIXED (8),
2 PRELRAKN (4),
3 PRELARNA CHAR (16),
2 PRELFILLER CHAR (21);
DCL 1 PREL POINTER;
DCL 1 PRELPOST BASED (PREL),
2 PRRAKN (4),
3 PRLOEPNR CHAR (6),
3 PRBELOPP FIXED (10,2),
3 PRFDAT FIXED (6);
/* PRELPOSTENS LÄNGD 90 POS */
DCL P0 FIXED (5),
P1 FIXED (5),
P2 FIXED (5),
P3 FIXED (5),
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 (' '),
WST2DEBPMELL FIXED (6,2),
WST2PAVGMELL FIXED (10,2),
WTAXA (2) CHAR (3) INIT ('180','181'),
WEFBR FIXED (8),
WFBR (2) FIXED (10) INIT ((20)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),
WSK0FBR (2) FIXED (10),
WSKORESUTJ (2) FIXED (10,2),
WABANT (2) BINARY,
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),
STOPP CHAR (1);
DEBBEST: PROC;
DB10:
READ FILE (PARADEBF) INTO (PARAPOST);
ST1 = ADDR (ST1INAREA);
IF PARADEBPER = '1' THEN P0 = ST1 + 5;
IF PARADEBPER = '2' THEN P0 = (ST1 + (30 * 3) + 5);
IF PARADEBPER = '3' THEN P0 = (ST1 + (30 * 6) + 5);
IF PARADEBPER = '4' THEN P0 = (ST1 + (30 * 9) + 5);
P1 = P0 + 30;
P2 = P0 + 60;
P3 = P0 + 90;
DB20:
WMANADNR = SUBSTR (PARAFFD,3,2);
DB99:
RETURN;
END;
BELSKRIV: PROC;
DCL BELOPP FIXED (10,2);
BP10:
PUT EDIT (BELOPP) (P'-------9V,99');
BP99:
RETURN;
END;
/* UTSKRIFT PMSTIN PMSTU EFFEKT KW */
PMST: PROC;
DCL PPMST1 FIXED (6,3),
PPMST2 FIXED (6,3),
PPEFF FIXED (6,2);
PP10:
PUT EDIT (' ') (A) (PPMST1) (P'ZZ9V,999') (' ') (A) (PPMST2)
(P'ZZ9V,999') (' ') (A) (PPEFF) (P'ZZZ9V,99') (' kW') (A);
PP99:
RETURN;
END;
PEFF: PROC;
DCL PEPEFF FIXED (6,2);
PEP10:
PUT EDIT (' ') (A(33)) (PEPEFF) (P'---9V,99') (' kW') (A);
PEP99:
RETURN;
END;
/* UTSKRIFT EFFEKT KW BELOPP */
PBEL: PROC;
DCL PBELP FIXED (6,2),
PBELKR FIXED (10,2);
PB10:
PUT EDIT (' ') (A(33)) (PBELP) (P'ZZZ9V,99') (' kW') (A) (' ') (A)
(PBELKR) (P'-------9V,99');
PB99:
RETURN;
END;
/* UTSKRIFT INDATUM UTDATUM */
DATSKRIV: PROC;
DCL DSDATUM1 FIXED (6),
DSDATUM2 FIXED (6);
DS10:
PUT EDIT (DSDATUM1) (P'-----9') (' - ') (A) (DSDATUM2) (P'-----9');
DS99:
RETURN;
END;
/* UTSKRIFT FAKTURAHUVUD */
HUVUD: PROC;
HP10:
PUT SKIP (4) EDIT (' ') (A(6)) (ABABNR) (P'99999999') ('-') (A)
(ST2LOEPNR) (A(21)) (PARADEBDAT) (P'-----9') (' Avser: ') (A)
(ABAADR) (A);
IF ABAVSER ¬= (' ') THEN DO;
PUT EDIT (', ') (A) (ABAVSER) (A);
END;
PUT SKIP (2) EDIT (' ') (A(6)) ('HÖGSPÄNNINGSDEB kvartal ') (A)
(PARADEBPER) (A) ('-') (A) (PARADEBAR) (A);
R = 23;
HP99:
RETURN;
END;
/* UPPLÄGGNING AV DEBITERINGSPARAMETRAR */
PERBEST: PROC;
PBP10:
CALL LOAD ('FORM BESTFORM PARADEBF',22);
PBP99:
RETURN;
END;
/* INLÄGGNING AV NOT FÖR UTSKRIFT I NOTINDEX */
NOTTEST: PROC;
DCL NOTEN CHAR (1);
NP10:
DO I = 1 TO 10;
IF NOTINDEX (I) = ' ' THEN DO;
NOTINDEX (I) = NOTEN;
GO TO NP99;
END;
IF NOTINDEX (I) = NOTEN THEN GO TO NP99;
END;
NP99:
RETURN;
END;
/* UTSKRIFT MSTIN MSTUT ENERGIFÖRBR SORT */
EMST: PROC;
DCL EMST1 FIXED (6),
EMST2 FIXED (6),
EFBR FIXED (7);
EP10:
PUT EDIT (' ') (A) (EMST1) (P'ZZZZZ9') (' ') (A) (EMST2) (P'ZZZZZ9')
(' ') (A) (EFBR) (P'ZZZZZZ9') (' kWh') (A);
EP99:
RETURN;
END;
/* UTSKRIFT ENERGIFÖRBR SORT */
EPFBR: PROC;
DCL EFFBR FIXED (8);
EF10:
PUT EDIT (' ') (A(32)) (EFFBR) (P'-------9') (' kWh') (A);
EF99:
RETURN;
END;
/* UTSKRIFT ENERGIFÖRBR kWh BELOPP */
EBEL: PROC;
DCL EBFBR FIXED (8),
EBBEL FIXED (10,2);
EB10:
PUT EDIT (' ') (A(32)) (EBFBR) (P'-------9') (' kWh ') (A)
(EBBEL) (P'-------9V,99');
EB99:
RETURN;
END;
/* UTSKRIFT PNOTEN MED TVÅ EFFEKTTOPPAR */
PNOTEN: PROC;
PNP10:
PUT SKIP EDIT (' P = Medeleffekt av de två högsta effektvärdena. ')
(A);
PUT EDIT (' ') (A) (ST2PMEDEL1) (P'ZZZ9V,99') (' kW = ') (A)
(WMANAD (ST2PM1MAN)) (A)
(ST2PMEDEL2) (P'ZZZ9V,99') (' kW = ') (A) (WMANAD (ST2PM2MAN)) (A);
P = P - 1;
PNP99:
RETURN;
END;
/* BERÄKNING KORNTALSRUNDNING */
RUNDBEL: PROC;
DCL RWTOTA FIXED (10,2),
RWTOTB FIXED (10,2),
RWTOTC FIXED (8),
RWTOTD FIXED (8),
RUND FIXED (10,2),
RUNDAD CHAR (1);
RB10:
RWTOTB = 0.00;
RWTOTC = 0.00;
RWTOTD = 0.00;
RUND = 0.00;
RWTOTB = RWTOTA + 0.50;
RWTOTC = RWTOTA;
RWTOTD = RWTOTB;
IF RWTOTD = RWTOTC THEN DO;
RUND = RWTOTD - RWTOTA;
IF RUND = 0.50 THEN RUND = 0.00;
GO TO RB90;
END;
IF RWTOTD > RWTOTC THEN DO;
RUND = RWTOTD - RWTOTA;
GO TO RB90;
END;
RB90:
WTOT = WTOT + RUND;
RUNDAD = 'J';
RB99:
RETURN;
END;
NOTINDEXNOLL: PROC;
NTP10:
DO J = 1 TO 10;
NOTINDEX (J) = ' ';
END;
NTP99:
RETURN;
END;
NOLLSTALLN: PROC;
NSP10:
RUNDAD = ' ';
WTOT = 0;
WEFBR = 0;
WST2DEBPMELL = 0;
WST2PAVGMELL = 0;
CALL NOTINDEXNOLL;
I = 0;
P = 0;
T = 0;
NSP99:
RETURN;
END;
PRINTINST: PROC;
DCL SVAR CHAR (1);
PRI10:
PUT FILE (D) SKIP EDIT ('ÄR PAPPERSINST. BRA? "J" eller "N"') (A(46));
GET SKIP LIST (SVAR);
IF SVAR = 'N' THEN GO TO PRI20;
IF SVAR = 'J' THEN GO TO PRI99;
GO TO PRI10;
PRI20:
PUT SKIP (2) EDIT (' 1234567-10101') (A);
PUT SKIP (8) EDIT (' 123456789012345678901234567890 AB ÅÅMMDD - ')
(A) ('ÅÅMMDD ') (A);
PUT EDIT ('X99,999 X99,999 X999,99 kWh X9999999,99') (A);
PUT SKIP (65) EDIT (' ') (A);
GO TO PRI10;
PRI99:
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:
OPEN ABONNREG;
OPEN STATREG1;
OPEN STATREG2;
OPEN TILLRAD;
OPEN NOTER;
OPEN PRELAR;
OPEN TAXA;
READ FILE (TAXA) INTO (TAR180);
READ FILE (TAXA) INTO (TAR181);
OPEN PARADEBF;
CALL DEBBEST;
CALL PRINTINST;
A20:
CALL NOLLSTALLN;
A30:
ON ENDFILE GO TO H10;
ON ERROR GO TO H00;
READ FILE (STATREG2) INTO (ST2POST);
IF ST2KV ¬= PARADEBPER THEN GO TO A30;
ON ENDFILE GO TO G10;
ON ERROR GO TO G00;
READ KEY (ST2ABNR) FILE (STATREG1) INTO (ST1INAREA);
ON ENDFILE GO TO F10;
ON ERROR GO TO F00;
READ KEY (ST2ABNR) FILE (ABONNREG) INTO (ABONPOST);
CALL HUVUD;
/* TARIFFRAD */
IF ABTAR = '180' THEN DO;
TARAKT = TAR180;
T = 1;
END;
IF ABTAR = '181' THEN DO;
TARAKT = TAR181;
T = 2;
END;
WABANT (T) = WABANT (T) + 1;
PUT SKIP(2) EDIT (' ')(A(6)) ('TARIFF ') (A) (ABTAR) (A);
R = R - 1;
/* FAST AVG RAD */
PUT SKIP (2) EDIT (' ') (A(6)) ('FAST AVG') (A(17)) (TPAKTFAVG)
(P'---9V,99') (' kr/år') (A) (' T ') (A);
NOTEN = 'T';
CALL NOTTEST;
UNSPEC (ST1) = P0;
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P3;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
PUT EDIT (' ') (A(31));
BELOPP = ST2FAVG;
CALL BELSKRIV;
WTOT = WTOT + ST2FAVG;
WFASTAVG (T) = WFASTAVG (T) + ST2FAVG;
R = R - 2;
IF ST2FARAD = '0' THEN GO TO A100;
A100:
/* EFFEKT AVG RAD */
PUT SKIP (2) EDIT (' ') (A(6)) ('Uppmätta effektvärden') (A(34));
UNSPEC (ST1) = P0;
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P1;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
UNSPEC (ST1) = P0;
PPMST1 = ST1PMST * 0.001;
UNSPEC (ST1) = P1;
PPMST2 = ST1PMST * 0.001;
PPEFF = ST1PFBR;
CALL PMST;
R = R - 2;
PUT SKIP EDIT (' (Mätare nr ')(A)(ABMNR)(A(6))(')')(A)
(' ') (A(4));
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P2;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
UNSPEC (ST1) = P1;
PPMST1 = ST1PMST * 0.001;
UNSPEC (ST1) = P2;
PPMST2 = ST1PMST * 0.001;
PPEFF = ST1PFBR;
CALL PMST;
R = R - 1;
PUT SKIP EDIT (' (Effekt konst. ')(A)(ABPKNST)(P'ZZZ9')
(')') (A) (' ') (A(4));
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P3;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
UNSPEC (ST1) = P2;
PPMST1 = ST1PMST * 0.001;
UNSPEC (ST1) = P3;
PPMST2 = ST1PMST * 0.001;
PPEFF = ST1PFBR;
CALL PMST;
R = R - 1;
PUT SKIP EDIT (' Medeleffekt ') (A)(' P ') (A);
NOTEN = 'P';
CALL NOTTEST;
WST2DEBPMELL = ST2DEBP;
WST2PAVGMELL = ST2PAVG;
PEPEFF = ST2DEBP;
CALL PEFF;
R = R - 1;
IF SUBSTR(ABMAN,2,1) = 'U' THEN DO;
OPEN TILLRAD;
END;
/* TRAFO FÖRLUST-EFFEKT */
A150:
IF ST2TRPFORL > 0.00 THEN DO;
PUT SKIP EDIT (' Tillägg transfo.förluster 1,5%') (A)
(' ') (A(4));
PEPEFF = ST2TRPFORL;
WST2DEBPMELL = WST2DEBPMELL + ST2TRPFORL;
WST2PAVGMELL = WST2PAVGMELL + ST2TRPKRTILL;
CALL PEFF;
R = R - 1;
END;
PUT SKIP EDIT (' EFFEKTAVG ')(A) (TPAKTPAVG)(P'ZZZ9V,99')
(' kr/kW o år') (A) (' T ') (A);
NOTEN = 'P';
CALL NOTTEST;
NOTEN = 'T';
CALL NOTTEST;
PBELP = WST2DEBPMELL;
PBELKR = WST2PAVGMELL;
WTOT = WTOT + WST2PAVGMELL;
WFASTAVG (T) = WFASTAVG (T) + WST2PAVGMELL;
CALL PBEL;
R = R - 1;
/* TRAFO HYRA */
IF ABETRAFO = 'T' THEN DO;
PUT SKIP EDIT (' Tillägg ') (A) (ST2TRPTILLAPRIS)
(P'-9V,99') (' kr/kW o år QT ') (A);
NOTEN = 'Q';
CALL NOTTEST;
PBELP = WST2DEBPMELL;
PBELKR = ST2TRHYR;
WTOT = WTOT + ST2TRHYR;
WFASTAVG (T) = WFASTAVG (T) + ST2TRHYR;
CALL PBEL;
R = R - 1;
END;
IF ST2PARAD = '0' THEN GO TO A200;
A200:
/* ENERGI- AVG RAD */
IF R < 2 THEN DO;
UTHOPP = ('A200');
GO TO A500;
END;
PUT SKIP (2)EDIT(' Uppmätta energiförbrukningar ')(A)(' ')(A);
UNSPEC (ST1) = P0;
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P1;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
UNSPEC (ST1) = P0;
EMST1 = ST1EMST;
UNSPEC (ST1) = P1;
EMST2 = ST1EMST;
EFBR = ST1EFBR;
CALL EMST;
R = R - 2;
A210:
IF R < 1 THEN DO;
UTHOPP = ('A210');
GO TO A500;
END;
PUT SKIP EDIT(' (Mätare nr ') (A)(ABMNR)(A(6))(')')(A)
(' ') (A(4));
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P2;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
UNSPEC (ST1) = P1;
EMST1 = ST1EMST;
UNSPEC (ST1) = P2;
EMST2 = ST1EMST;
EFBR = ST1EFBR;
CALL EMST;
R = R- 1;
A220:
IF R < 1 THEN DO;
UTHOPP = ('A220');
GO TO A500;
END;
PUT SKIP EDIT (' (Energi konst. ')(A)(ABEKNST)(P'ZZZ9')
(')') (A) (' ') (A(4));
DSDATUM1 = ST1AVLDAT;
UNSPEC (ST1) = P3;
DSDATUM2 = ST1AVLDAT;
CALL DATSKRIV;
UNSPEC (ST1) = P2;
EMST1 = ST1EMST;
UNSPEC (ST1) = P3;
EMST2 = ST1EMST;
EFBR = ST1EFBR;
CALL EMST;
R = R - 1;
A230:
IF R < 1 THEN DO;
UTHOPP = ('A230');
GO TO A500;
END;
UNSPEC (ST1) = P1;
WEFBR = ST1EFBR;
UNSPEC (ST1) = P2;
WEFBR = WEFBR + ST1EFBR;
UNSPEC (ST1) = P3;
WEFBR = WEFBR + ST1EFBR;
IF ABETRAFO = 'J' THEN GO TO A250;
PUT SKIP EDIT (' Summa uppmätt energi ') (A);
EFFBR = WEFBR;
CALL EPFBR;
R = R - 1;
A235:
IF SUBSTR (ABMAN,2,1) = 'U' THEN DO;
OPEN TILLRAD;
END;
A240:
IF R < 1 THEN DO;
UTHOPP = ('A240');
GO TO A500;
END;
IF ST2TREFORL > 0 THEN DO;
PUT SKIP EDIT (' Tillägg transfo.förluster 1,5% ') (A);
EFFBR = ST2TREFORL;
WEFBR = WEFBR + ST2TREFORL;
CALL EPFBR;
R = R - 1;
END;
A250:
IF R < 1 THEN DO;
UTHOPP = ('A250');
END;
PUT SKIP EDIT (' ENERGIAVG ') (A) (TPAKTEAVG) (P'---9V,99')
(' öre/kWh ') (A);
EBFBR = WEFBR;
EBBEL = ST2EAVG + ST2TREKRTILL;
WTOT = WTOT + EBBEL;
WFBR (T) = WFBR (T) + WEFBR;
WFBRAVG (T) = WFBRAVG (T) + EBBEL;
CALL EBEL;
R = R - 1;
IF ST2EARAD = '0' THEN GO TO A300;
A300:
/* ENERGISKATTE RAD */
IF R < 3 THEN DO;
UTHOPP = ('A300');
GO TO A500;
END;
IF ABSKKOD = '0' THEN DO;
WSK0FBR (T) = WSK0FBR (T) + WEFBR;
GO TO A350;
END;
PUT SKIP (2) EDIT (' ENERGISKATT ') (A);
IF ST2SK4 > 0 THEN DO;
PUT EDIT ('4,00 öre/kWh ') (A);
EBFBR = ST2SK4FBR;
EBBEL = ST2SK4;
WTOT = WTOT + EBBEL;
WSKATT4 (T) = WSKATT4 (T) + ST2SK4;
WSK4FBR (T) = WSK4FBR (T) + ST2SK4FBR;
CALL EBEL;
R = R - 2;
END;
IF ST2SK3 = 0 THEN GO TO A350;
IF ST2SK3 > 0 THEN DO;
IF ST2SK4 = 0 THEN DO;
PUT EDIT ('3,00 öre/kWh ') (A);
R = R - 1;
END;
ELSE DO;
PUT SKIP EDIT (' ') (A(24)) ('3,00 öre/kWh ') (A);
END;
EBFBR = ST2SK3FBR;
EBBEL = ST2SK3;
WSKATT3 (T) = WSKATT3 (T) + ST2SK3;
WSK3FBR (T) = WSK3FBR (T) + ST2SK3FBR;
WTOT = WTOT + EBBEL;
CALL EBEL;
R = R - 1;
END;
A350:
IF ST2SARAD = '0' THEN GO TO A400;
/* RUNDNINGSBELOPPS RAD */
A400:
IF R < 2 THEN DO;
UTHOPP = ('A400');
GO TO A500;
END;
RWTOTA = WTOT;
CALL RUNDBEL;
IF RUND = 0.00 THEN DO;
R = R + 2;
GO TO A500;
END;
PUT SKIP (2) EDIT (' RUNDNINGSBELOPP ') (A)
(' ') (A(46)) (RUND) (P'-------9V,99');
WSKORESUTJ (T) = WSKORESUTJ (T) + RUND;
/* TOTALRAD */
A500:
IF RUNDAD = 'J' THEN GO TO A550;
PUT SKIP (25-R) EDIT (' ') (A(64)) ('Transport ') (A)
(WTOT) (P'-------9V,99');
GO TO A600;
A550:
PUT SKIP (R - 1) EDIT (' ') (A);
IF ABIKTO > 0 THEN DO;
PUT SKIP EDIT (' XXXXXXXXXXXXXXX Internkonto ') (A)
(ABIKTO) (P'9999999999999')(' ')(A(37)) (WTOT)(P'-------9V,99');
GO TO A600;
END;
PUT SKIP EDIT (' ') (A(22)) (SUBSTR(PARAFFD,5,2)) (P'ZP') (' ') (A)
(WMANAD (WMANADNR)) (A(8)) (' 19') (A)
(SUBSTR (PARAFFD,1,2)) (A) (' ') (A(48)) (WTOT) (P'-------9V,99');
GO TO A600;
/* NOTRADERNA */
A600:
IF NOTINDEX (1) = ' ' THEN DO;
PUT SKIP (6) EDIT (' ') (A);
GO TO A800;
END;
IF NOTINDEX (6) = ' ' THEN GO TO A650;
A650:
P = 5;
PUT SKIP EDIT (' ') (A);
DO I = 1 TO 10;
READ KEY (NOTINDEX (I)) FILE (NOTER) INTO (NOTPOST);
IF NOT = 'P' THEN DO;
CALL PNOTEN;
GO TO A660;
END;
IF NOT = ' ' THEN GO TO A670;
PUT SKIP EDIT (' ') (A(6)) (NOT) (A) (' = ') (A) (NOTTEXT) (A);
A660:
P = P - 1;
END;
A670:
IF P > 0 THEN DO;
PUT SKIP (P) EDIT (' ') (A);
END;
CALL NOTINDEXNOLL;
/* ADRESSRADERNA */
A800:
PUT SKIP (3) EDIT (' ') (A(37)) (ABRNAMN) (A(36))
(' ') (A(9)) (' ') (A);
PUT SKIP EDIT (' ') (A(37)) (ABRADR) (A(36))
(' ') (A(9)) (' ') (A);
PUT SKIP (2) EDIT(' ')(A(37))(SUBSTR(ABRPNR,1,3))
(A) (' ') (A) (SUBSTR(ABRPNR,4,2)) (A) (' ') (A)
(ABRORT) (A(28)) (' ') (A(9)) (' ') (A);
/* INBETALNINGSKORTET */
A900:
IF RUNDAD ¬= 'J' THEN GO TO A950;
PUT SKIP (8) EDIT (' ') (A);
GO TO A20;
A950:
IF RUNDAD ¬= 'J' THEN DO;
PUT SKIP (5) EDIT (' ') (A(79)) ('forts.räkning') (A);
PUT SKIP (2) EDIT (' ') (A);
CALL HUVUD;
PUT SKIP (2) EDIT (' ') (A(27)) (' ') (A(48)) ('Transport') (A)
(WTOT) (P'ZZZZZZZ9V,99');
R = R - 1;
GO TO HOPPET;
END;
PUT SKIP (6) EDIT (' ') (A);
GO TO A20;
HOPPET:
IF UTHOPP = 'A200' THEN GO TO A200;
IF UTHOPP = 'A210' THEN GO TO A210;
IF UTHOPP = 'A220' THEN GO TO A220;
IF UTHOPP = 'A230' THEN GO TO A230;
IF UTHOPP = 'A240' THEN GO TO A240;
IF UTHOPP = 'A250' THEN GO TO A250;
IF UTHOPP = 'A300' THEN GO TO A300;
IF UTHOPP = 'A400' THEN GO TO A400;
PUT SKIP LIST ('UTHOPPSFEL ITLL HOPPET ',UTHOPP);
F00:
PUT SKIP LIST ('LÄSFEL I ABONNREG ',ST2ABNR);
GO TO Z99;
F10:
PUT SKIP LIST ('POSTEN SAKNAS I ABONNREG ',ST2ABNR);
GO TO Z99;
G00:
PUT SKIP LIST ('LÄSFEL I STATREG1 ',ST2ABNR);
GO TO Z99;
G10:
PUT SKIP LIST ('POSTEN SAKNAS I STATREG1 ',ST2ABNR);
GO TO Z99;
H00:
PUT SKIP LIST ('LÄSFEL I ST2REG ',ONCODE);
GO TO Z99;
H10:
PUT FILE (D) EDIT (' ') (A(47))
('SÄTT A4B 1 ex I PRINTERN') (A);
CALL OUTPUT (1,6);
GET SKIP LIST (STOPP);
PUT SKIP (4) EDIT (' AVSTÄMNINGSBLAD för HÖGSPÄNNINGSDEBITERING ')
(A) ('kvartal: ') (A) (PARADEBPER) (A) (' DATUM: ') (A)
(PARADEBDAT) (P'ZZZZZ9');
PUT SKIP (4) EDIT ('TARIFF') (A(31))
('FÖRBRUKNING FÖRBR.AVG FAST AVG SKATT4 ')
(A) ('SKATT3 RUND.BEL TOTAL ANTAL') (A);
DO T = 1 TO 2;
PUT SKIP (2) EDIT (WTAXA (T)) (A(32)) (WFBR (T)) (P'ZZZZZZZZZ9')
(' ') (A(5))
(' ') (A) (WFBRAVG (T)) (P'-------9V:99')
(' ') (A) (WFASTAVG (T)) (P'-------9V:99')
(' ') (A) (WSKATT4 (T)) (P'-------9V:99')
(' ') (A) (WSKATT3 (T)) (P'-------9V:99')
(' ') (A) (WSKORESUTJ (T)) (P'-------9V:99');
WSAMTOT (T) = (WFBRAVG (T) + WFASTAVG (T) + WSKATT4 (T) +
WSKATT3 (T) + WSKORESUTJ (T));
PUT EDIT (' ') (A) (WSAMTOT (T)) (P'-------9V:99')
(' ') (A) (WABANT (T)) (P'ZZZZ9');
END;
PUT SKIP(2) EDIT ('SUMMA') (A(32)) (WFBR (1) + WFBR (2))(P'ZZZZZZZZZ9')
(' ') (A(7)) (WFBRAVG (1) + WFBRAVG (2)) (P'-------9V:99')
(' ') (A(2)) (WFASTAVG (1) + WFASTAVG (2)) (P'-------9V:99')
(' ') (A(2)) (WSKATT4 (1) + WSKATT4 (2)) (P'-------9V:99')
(' ') (A(2)) (WSKATT3 (1) + WSKATT3 (2)) (P'-------9V:99')
(' ') (A(2)) (WSKORESUTJ (1) + WSKORESUTJ (2)) (P'-------9V:99')
(' ') (A(2)) (WSAMTOT (1) + WSAMTOT (2)) (P'-------9V:99')
(' ') (A) (WABANT (1) + WABANT (2)) (P'ZZZZ9');
PUT SKIP (4) EDIT ('FÖRDELNING AV FÖRBRUKNINGAR PÅ SKATTESATSER') (A);
PUT SKIP (2) EDIT ('SKATT 4 öre/kWh ') (A(32))
(WSK4FBR (1) + WSK4FBR (2)) (P'---------9') (' kWh') (A);
PUT SKIP (2) EDIT ('SKATT 3 öre/kWh ') (A(32))
(WSK3FBR (1) + WSK3FBR (2)) (P'---------9') (' kWh') (A);
PUT SKIP (2) EDIT ('SKATTEFRI ') (A(32)) (WSK0FBR (1) + WSK0FBR (2))
(P'---------9') (' kWh') (A);
PUT SKIP (2) EDIT ('SUMMA förbrukning ') (A(32))
(WSK4FBR (1) + WSK4FBR (2) + WSK3FBR (1) + WSK3FBR (2) + WSK0FBR (1)
+ WSK0FBR (2)) (P'---------9') (' kWh') (A);
PUT SKIP (25) EDIT (' ') (A);
Z99:
END;