|
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: 53483 (0xd0eb)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »H4001«
└─⟦74df05346⟧ Bits:30008773 50001606
└─⟦this⟧ »H4001«
/* PROGRAM-ID. H400.
AUTHOR. OLLE.
DATE-WRITTEN. 810527.
REMARKS. PROGRAMMET SKRIVER UT REGISTERINNEHÅLLET FRÅN
ABONNREG STATREG1 STATREG2 PRELAR COMMENTS.
*/
DCL AVLREG FILE,
ABONNREG FILE,
STATREG1 FILE,
STATREG2 FILE,
TAXA FILE,
TILLRAD FILE,
PARADEBF FILE,
COMMENTS FILE,
PRELAR FILE,
UDEB FILE;
DCL 1 AVLPOST,
2 AVLABNR FIXED (8),
2 AVLEMST FIXED (6),
2 AVLENOT CHAR (1),
2 AVLDAT FIXED (6),
2 AVLPMST FIXED (6),
2 AVLPNOT CHAR (1),
2 AVLPERIOD BINARY,
2 AVLUEFBR FIXED (8),
2 AVLUPFBR FIXED (6,2),
2 AVLFILLER CHAR (92);
/* AVLPOSTENS LÄNGD 125 POS */
DCL 1 ABONPOST,
2 ABABNR FIXED (8),
2 ABMAN CHAR (5), /* P1=M man P2=F um finns P3=U um*/
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 (6),
2 ABARFBR FIXED (7),
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 ST2SKR3FBR 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 (25);
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 NYST1POST,
2 NYST1DELPOST,
3 NYST1KV CHAR (1),
3 NYST1PER BINARY,
3 NYST1AVLDAT FIXED (6),
3 NYST1PMST FIXED (6),
3 NYST1PKNST FIXED (4),
3 NYST1PFBR FIXED (6,2),
3 NYST1EMST FIXED (6),
3 NYST1EKNST FIXED (4),
3 NYST1EFBR FIXED (8);
/* NYST1POSTENS LÄNGD 30 POS */
DCL 1 UDEBPOST,
2 UFILLER CHAR (47),
2 UDUMMY (15),
3 UDUM CHAR (20);
/* 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 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 COMPOST,
2 COMABNR FIXED (8),
2 COMTEXT (5) CHAR (100);
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 PRFADAT FIXED (6);
/* PRELPOSTENS LÄNGD 90 POS */
DCL 1 NYCKELST2,
2 NYCKELABNR FIXED (8),
2 NYCKELKVART CHAR (1);
DCL 1 NYCKELPREL,
2 NYCKPRABNR FIXED (8),
2 NYCKPRPER BINARY;
DCL 1 WMEFFEKTER,
2 WMEFFEKT FIXED (6,2),
2 WMP1 FIXED (6,2),
2 WMP1MAN BINARY,
2 WMP2 FIXED (6,2),
2 WMP2MAN BINARY;
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),
WPFBR FIXED (6,2),
WEFBR FIXED (8),
ABNR CHAR (8) INIT (' '),
NYCKEL FIXED (8),
ABPERSNRCH CHAR (10),
WUTHOPP CHAR (4) INIT (' '),
WTAXA (2) CHAR (3) INIT ('180','181'),
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),
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*/
M BINARY, /* ANTAL BLANKPOSITIONER VID UTSKR. */
UTHOPP CHAR (4),
SVAR CHAR (1),
STOPP CHAR (1),
PMSTRG FIXED (6),
PFBRRG FIXED (6),
PERPFBR FIXED (6),
PEKARE FIXED (5),
UPEKARE FIXED (5),
STARTP FIXED (5),
EMSTRG FIXED (6),
EFBRRG FIXED (6),
PEREFBR FIXED (8),
HK CHAR (1) INIT (' '),
PMLAGST CHAR (1) INIT ('1'),
FBR FIXED (8);
/* H Ä R B Ö R J A R H U V U D P R O G R A M M E T */
OPEN ABONNREG;
OPEN STATREG1;
OPEN STATREG2;
OPEN PRELAR;
OPEN COMMENTS;
OPEN PARADEBF;
OPEN UDEB;
A10:
READ FILE (PARADEBF) INTO (PARAPOST);
PUT FILE (D) EDIT (' ') (A(47)) ('SPEC AB = S, ALLA = A ') (A(46));
GET SKIP LIST (SVAR);
IF SVAR = 'S' THEN DO;
PUT FILE (D) EDIT ('VAR GOD ANGIV ÖNSKAT ABNR ') (A(39));
GET SKIP LIST (ABNR);
NYCKEL = ABNR;
GO TO A20;
END;
GO TO A50;
A20:
READ KEY (NYCKEL) FILE (ABONNREG) INTO (ABONPOST);
GO TO A60;
A50:
ON ENDFILE GO TO Z99;
READ FILE (ABONNREG) INTO (ABONPOST);
IF SUBSTR (ABMAN,1,1) = 'M' THEN GO TO A50;
NYCKEL = ABABNR;
GO TO A60;
A60:
ON ERROR GO TO Z99;
READ KEY (NYCKEL) FILE (STATREG1) INTO (ST1INAREA);
READ KEY (NYCKEL) FILE (COMMENTS) INTO (COMPOST);
IF SUBSTR (ABMAN,2,1) = 'H' THEN DO;
READ KEY (NYCKEL) FILE (UDEB) INTO (UDEBPOST);
END;
/* ABNR - raden */
A100:
ABPERSNRCH = ABPERSNR;
PUT SKIP (3) EDIT (' ABNR: ') (A) (ABABNR) (P'99999999')
(' ') (A(34)) ('Org.nr: ') (A) (SUBSTR(ABPERSNRCH,1,6)) (A) ('-')
(A) (SUBSTR(ABPERSNRCH,7,4))(A) (' ') (A(10)) ('Egen trafo: ')
(A);
IF ABETRAFO = 'E' THEN DO;
PUT EDIT ('JA ') (A);
END;
ELSE DO;
PUT EDIT ('NEJ ') (A);
END;
PUT EDIT ('Tariff: ') (A) (ABTAR) (A);
/* RNAMN - raden */
A110:
PUT SKIP EDIT (' Rnamn: ') (A) (ABRNAMN) (A(36)) (' ') (A(6))
('Avser: ') (A) (ABAVSER) (A) (' ') (A(6)) ('Manuelldeb: ') (A);
IF SUBSTR (ABMAN,1,1) = 'M' THEN DO;
PUT EDIT ('JA ') (A);
END;
ELSE DO;
PUT EDIT ('NEJ ') (A);
END;
PUT EDIT ('Kategori: ') (A) (ABKAT) (A);
/* MÄTARADRESS - raden */
A120:
PUT SKIP EDIT (' Mätadr: ') (A) (ABAADR) (A) (' ') (A(15))
('Int.kto: ') (A) (ABIKTO) (A(13)) (' ') (A(8)) ('Avdr U-mät: ')
(A);
IF SUBSTR (ABMAN,2,1) = 'H' THEN DO;
PUT EDIT ('JA ') (A);
END;
ELSE DO;
PUT EDIT ('NEJ ') (A);
END;
PUT EDIT ('Skattekod: ') (A) (ABSKKOD) (A);
/* RÄKNINGSADR - raden */
A130:
PUT SKIP EDIT (' Radr: ') (A) (ABRADR) (A) (' ') (A(15))
('Kontdat: ') (A) (ABKONTDAT) (P'999999') (' ') (A(15))
('Sammanlagr: ') (A);
IF SUBSTR (ABMAN,4,1) = 'S' THEN DO;
PUT EDIT ('JA ') (A);
END;
ELSE DO;
PUT EDIT ('NEJ ') (A);
END;
PUT EDIT ('Årsförbr: ') (A) (ABARFBR) (P'ZZZZZZZ9');
/* RÄKNINGSORT - raden */
A140:
PUT SKIP EDIT (' Rort: ') (A) (SUBSTR(ABRPNR,1,3)) (A(4))
(SUBSTR (ABRPNR,4,2)) (A(4)) (ABRORT) (A(8)) (' ') (A(26))
('Mätsida: ') (A);
IF ABHOGLAG = 'L' THEN DO;
PUT EDIT ('LSP') (A);
END;
IF ABHOGLAG ¬= 'L' THEN DO;
PUT EDIT ('HSP') (A);
END;
PUT EDIT (' ') (A(18)) ('Räknlöpnr: ') (A) (ABLOEPNR) (A)
(' ') (A(6)) ('Trafoeffekt: ') (A) (ABPAB) (P'ZZZZZ9');
/* MÄTARNR - raden */
A150:
PUT SKIP (2) EDIT (' Mät-nr: ') (A) (ABMNR) (A(6)) (' ') (A(5))
('Mättyp: ') (A) (ABMTYP) (A(6)) (' ') (A(4)) ('E-kap: ') (A)
(ABEKAP) (A) (' ') (A(5)) ('Deb.k-E: ') (A) (ABEKNST) (P'ZZZ9')
(' ') (A(17)) ('SK40000kWh: ') (A) (ABOREDKWH) (P'ZZZZ9') (' ')
(A(2)) ('Trafohyra: ') (A);
IF ABSLINGDUBBEL = 'S' THEN DO;
PUT EDIT ('SLINGKABEL') (A);
END;
IF ABSLINGDUBBEL = 'D' THEN DO;
PUT EDIT ('DUBBELKABEL') (A);
END;
/* UPPSÄTTN.DATUM - raden */
A160:
PUT SKIP EDIT (' Uppdat: ') (A) (ABUDAT) (P'999999') (' ') (A(5))
('P-verk: ') (A);
IF ABPMTYP = 'A' THEN DO;
PUT EDIT ('KUMUL ') (A);
END;
IF ABPMTYP = 'G' THEN DO;
PUT EDIT ('GRADV ') (A);
END;
PUT EDIT ('P-kap: ') (A) (ABPKAP) (A)
(' ') (A(5))
('Deb.k-P: ') (A) (ABPKNST) (P'ZZZ9') (' ') (A(37))
('Trafoförl: ') (A) ('1.50 %') (A);
/* PERIODRUBRIK - raden */
A170:
PUT SKIP (2) EDIT (' PER AVLDAT P-MST DEB.K-P P-AVDR')
(A)
(' P-TILL P-SUM E-MST DEB.K-E E-AVDR ') (A)
('E-TILL E-SUM') (A);
PUT SKIP EDIT (' ') (A);
R = 15;
ST1 = ADDR (ST1INAREA);
PEKARE = UNSPEC (ST1) + 5 - 30;
UIND = ADDR (UDEBPOST);
UPEKARE = UNSPEC (UIND) + 7;
/* PERIOD - raderna */
A200:
DO I = 0 TO 14;
KVARTSLUT = 0;
R = R - 1;
PEKARE = PEKARE + 30;
UNSPEC (ST1) = PEKARE;
IF I > 0 THEN DO;
UPEKARE = UPEKARE + 20;
UNSPEC (UIND) = UPEKARE;
END;
IF I = (PARADEBPER * 3) + 1 THEN DO;
PUT SKIP (R) EDIT (' ') (A);
GO TO A300;
END;
IF I = 3 ö I = 6 ö I = 9 ö I = 12 THEN DO;
IF SUBSTR (ABMAN,2,1) ¬= 'U' THEN DO;
KVARTSLUT = 1;
NYCKELABNR = ABABNR;
NYCKELKVART = I/3;
READ KEY (NYCKELST2) FILE (STATREG2) INTO (ST2POST);
END;
END;
PUT SKIP EDIT (' ') (A) (ST1PER) (P'99') (' ') (A) (ST1AVLDAT)
(A) (' ') (A(4));
IF ABPKAP = 5 THEN DO;
PUT EDIT (ST1PMST) (P'ZZZZ9.9');
END;
ELSE DO;
PUT EDIT (ST1PMST) (P'ZZ9.999');
END;
PUT EDIT (' ') (A(6)) (ST1PKNST) (P'ZZZ9') (' ') (A);
M = 20;
IF I > 0 & SUBSTR (ABMAN,2,1) = 'H' THEN DO;
PUT EDIT (UDP) (P'ZZZ9V.99');
M = 13;
IF KVARTSLUT = 1 THEN M = 3;
END;
IF KVARTSLUT = 1 THEN DO;
PUT EDIT (' ') (A(M)) (ST2TRPFORL) (P'ZZZ9V.99') (' ') (A);
WPFBR = ST1PFBR + ST2TRPFORL;
PUT EDIT (ST1PFBR) (P'ZZZ9V.99');
WPFBR = 0;
END;
ELSE DO;
PUT EDIT (' ') (A(M)) (ST1PFBR) (P'ZZZ9V.99');
WPFBR = WPFBR + ST1PFBR;
END;
PUT EDIT (' ') (A) (ST1EMST) (P'ZZZZZ9') (' ') (A(6)) (ST1EKNST)
(P' ZZZ9');
M = 21;
IF I > 0 & SUBSTR (ABMAN,2,1) = 'H' THEN DO;
PUT EDIT (' ') (A) (UDE) (P'ZZZZZZZ9');
M = 11;
IF KVARTSLUT = 1 THEN M = 2;
END;
IF KVARTSLUT = 1 THEN DO;
PUT EDIT (' ') (A(M)) (ST2TREFORL) (P'ZZZZZZZ9') (' ') (A);
WEFBR = ST1EFBR + ST2TREFORL;
PUT EDIT (ST1EFBR) (P'ZZZZZZZ9');
WEFBR = 0;
END;
ELSE DO;
PUT EDIT (' ') (A(M)) (ST1EFBR) (P'ZZZZZZZ9');
WEFBR = WEFBR + ST1EFBR;
END;
END;
/* EFFEKT - raden */
A300:
PUT SKIP (2) EDIT (' EFFEKTTOPP MÅNAD MEDELEFFEKT') (A);
PUT SKIP (2) EDIT (' ') (A) (ST2PMEDEL1) (P'ZZZ9V.99') (' kW ')(A)
(WMANAD (ST2PM1MAN)) (A) (' ') (A(7))
(ST2DEBP) (P'ZZZ9V.99') (' kW') (A);
PUT SKIP EDIT (' ') (A) (ST2PMEDEL2) (P'ZZZ9V.99') (' kW ') (A)
(WMANAD (ST2PM2MAN)) (A);
/* PRELRÄKN - raderna */
A400:
PUT SKIP (2) EDIT (' FA-DAT PREL-D FAST-AVG EFFEKT-AVG ')
('TRAFO-HYRA FBR-AVG S FBR-AVG V SKATT 4 ')
('SKATT 3 RUNDN TOTAL') (A);
PUT SKIP;
OPEN PRELAR;
NYCKPRABNR = ABABNR;
NYCKPRPER = (PARADEBPER * 3) - 2;
ON ERROR GO TO A490;RE;
READ KEY (NYCKELPREL) FILE (PRELAR) INTO (PRELPOST);
PUT SKIP EDIT (' ') (A) (PARADEBDAT) (P'999999') (' ') (A)
(PARADEBDAT) (P'999999') (' ') (A) (PRPRELDAT) (P'999999')
(PRFAVG) (P'-------9V:99')
(PRPAVG) (P'-------9V:99')
(PRTRHYR) (P'-------9V:99')
(PRFBRAVGV) (P'-------9V:99')
(PRFBRAVGV) (P'-------9V:99')
(PRFBRAVGS) (P'-------9V:99')
(PRSKATTKR4) (P'-------9V:99')
(PRSKATTKR3) (P'-------9V:99')
(PRRUND) (P'-9V:99')
(' ') (A)
(PRFAVG + PRPAVG + PRTRHYR + PRFBRAVGV + PRFBRAVGS + PRSKATTKR4
+ PRSKATTKR3 + PRRUND) (P'-------9V:99');
END;
A490:
PUT SKIP (4 - I);
/* KOMMENTAR - raderena */
A500:
PUT SKIP (2) EDIT (' Kommentarer: ') (A(20));
PEKARE = ADDR (COMPOST);
STARTP = PEKARE + 5 - 100;
DO I = 1 TO 5;
IF I = 1 THEN GO TO A510;
PUT SKIP EDIT (' ') (A(20));
A510:
PEKARE = STARTP + I * 100;
PUT EDIT (COMTEXT (I)) (A);
END;
PUT SKIP (6) EDIT (' ') (A);
IF SVAR = 'S' THEN GO TO Z99;
GO TO A50;
Z99:
END;