|
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: 10744 (0x29f8)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »FONDLST1«
└─⟦c0e22f10d⟧ Bits:30008754 50001590
└─⟦this⟧ »FONDLST1«
/* PROGRAM-ID. FONDLST1.
DATE-WRITTEN. 1981-08-14.
AUTHOR. OLLE.
REMARKS. PROGRAMMET SKRIVER FONDLISTA ÅT VA-VERKET. */
DCL ANLAVG FILE;
DCL 1 ANLPOST,
2 BTEXT CHAR (38),
2 BPGF FIXED (5),
2 BANSL FIXED (10),
2 BUPPDEB FIXED (10),
2 BFONDEN FIXED (10),
2 BSALDO FIXED (10),
2 BKOM CHAR (38);
DCL 1 BNLPOST,
2 ATEXT CHAR (38),
2 APGF FIXED (3,2),
2 AANSL FIXED (8,2),
2 AUPPDEB FIXED (8,2),
2 AFONDEN FIXED (8,2),
2 ASALDO FIXED (8,2),
2 AKOM CHAR (38);
DCL SID BINARY INIT (0),
R BINARY INIT (42),
RADANT BINARY INIT (42),
RDATUM CHAR (10),
AR CHAR (4),
CPGF FIXED (3),
DPGF FIXED (3,2),
F11 FIXED (11),
T15 CHAR (15),
PGFAR CHAR (2),
PGFARDEC FIXED (1,2),
ACCSALDO FIXED (8,2) INIT (0);
RUB: PROC;
RP10:
SID = SID + 1;
PUT SKIP (4) EDIT (' ') (A(20)) ('VA-VERKETS FOND FÖR ') (A)
('ANLÄGGNINGSAVGIFTER ÅR ') (A) (AR) (A) (' ') (A(20))
('Datum: ') (A) (RDATUM) (A(12)) (' ') (A(10)) ('Sid: ') (A) (SID)
(P'ZZ');
PUT SKIP (2) EDIT ('TEXT ') (A)
('TV$ ANSLAG UPPDEB FONDEN +/- SALDO ') (A)
('KOMMENTAR ') (A);
PUT SKIP (1);
R = RADANT;
RP99:
RETURN;
END;
SKRIV: PROC;
SP10:
IF R < 4 THEN DO;
PUT SKIP (3);
CALL RUB;
END;
PUT SKIP EDIT (ATEXT) (A(39)) (APGF) (P'ZZ9V/99') (' ') (A(10));
F11 = AANSL * 100;
CALL BELREDP (F11,T15);
PUT EDIT (T15) (A(15));
F11 = AUPPDEB * 100;
CALL BELREDP (F11,T15);
PUT EDIT (T15) (A(15));
F11 = AFONDEN * 100;
CALL BELREDP (F11,T15);
PUT EDIT (T15) (A(15));
F11 = ASALDO * 100;
CALL BELREDP (F11,T15);
PUT EDIT (T15) (A(15));
PUT EDIT (' ') (A(5)) (AKOM) (A);
R = R - 1;
SP99:
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 ANLAVG;
PUT FILE (D) EDIT ('Var god angiv rubrikdatum ÅÅÅÅ-MM-DD:') (A);
GET SKIP LIST (RDATUM);
PUT FILE (D) EDIT (RDATUM) (A);
PUT FILE (D) EDIT ('Var god angiv "anslagsåret ÅÅÅÅ: ') (A);
GET SKIP LIST (AR);
PUT FILE (D) EDIT (AR) (A) (' ') (A(6));
PUT FILE (D) EDIT ('Var god angiv "Paragrafåret ÅÅ: ') (A);
GET SKIP LIST (PGFAR);
PUT FILE (D) EDIT (PGFAR) (A) (' ') (A(8));
PGFARDEC = PGFAR * 0.01;
CALL RUB;
A20:
ON ENDFILE GO TO D10;
ON ERROR GO TO C10;
READ FILE (ANLAVG) INTO (ANLPOST);
AANSL = BANSL * 0.01;
AUPPDEB = BUPPDEB * 0.01;
AFONDEN = BFONDEN * 0.01;
ASALDO = BSALDO * 0.01;
CPGF = BPGF * 0.01;
DPGF = BPGF * 0.01;
IF CPGF = DPGF THEN DO;
APGF = DPGF + PGFARDEC;
END;
ELSE DO;
APGF = DPGF;
END;
IF (AANSL = 0 & AUPPDEB = 0 & AFONDEN ¬= 0) THEN GO TO A30;
AFONDEN = AUPPDEB + AANSL;
A30:
ASALDO = ACCSALDO + AFONDEN;
ACCSALDO = ASALDO;
CALL SKRIV;
BPGF = APGF * 100;
BANSL = AANSL * 100;
BUPPDEB = AUPPDEB * 100;
BFONDEN = AFONDEN * 100;
BSALDO = ASALDO * 100;
REWRITE FILE (ANLAVG) FROM (ANLPOST);
GO TO A20;
C10:
PUT SKIP LIST ('FEL I REG KOD = ',ONCODE);
D10:
END;