|
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: 10902 (0x2a96)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BALANS«
└─⟦755e43167⟧ Bits:30008640 DDMQ1-0079_MSAB_BALANS_KONV_KPLANB
└─⟦this⟧ »BALANS«
└─⟦7d57c527f⟧ Bits:30008641 DDMQ1-0080_LMC_RESULTAT_for_MSAB
└─⟦this⟧ »BALANS«
└─⟦ecd18d2d3⟧ Bits:30008638 DDMQ1-0077_KOPIA_KPLANB_BALANS_KONV
└─⟦this⟧ »BALANS«
└─⟦fe1114201⟧ Bits:30008639 DDMQ1-0078_BALANS_HUVUD_RES
└─⟦this⟧ »BALANS«
DCL 1 KPL,
2 KONTO CHAR(4) INIT(' '),
2 STK CHAR(1) INIT(' '),
2 BEN CHAR(34) INIT(' '),
2 ACD(12) FIXED(10,2) INIT(0,0,0,0,0,0,0,0,0,0,0,0),
2 ACK(12) FIXED(10,2) INIT(0,0,0,0,0,0,0,0,0,0,0,0),
2 IB FIXED(11,2) INIT(0);
DCL 1 KPLB,
2 KTO CHAR(4) INIT(' '),
2 BENA CHAR(34) INIT(' ');
DCL 1 HJ,
2 KT CHAR(4) INIT(' '),
2 BN CHAR(34) INIT(' '),
2 AD FIXED(12,2)INIT(0),
2 AK FIXED(12,2)INIT(0),
2 UTG FIXED(12,2)INIT(0);
DCL PD(7) FIXED(12,2),PK(7) FIXED(12,2),PS(7) FIXED(12,2),I FIXED(3);
DO I=1 TO 7;PD(I)=0;PK(I)=0;PS(I)=0;END;
DCL TX1 CHAR(50) INIT(' SUMMA OMSÄTTNINGSTILLGÅNGAR:');
DCL TX3 CHAR(50) INIT(' SUMMA ANLÄGGNINGSTILLGÅNGAR:');
DCL TX4 CHAR(50) INIT(' SUMMA KORTFRISTIGA SKULDER:');
DCL TX5 CHAR(50) INIT(' SUMMA LÅNGFRISTIGA SKULDER:');
DCL TX6 CHAR(50) INIT(' SUMMA OBESKATTADE RESERVER:');
DCL TX7 CHAR(50) INIT(' SUMMA EGET KAPITAL:');
DCL TX CHAR(50),DEL FIXED(1);
DCL A1 FIXED(12,2),A2 FIXED(12,2),D1 FIXED(12,2),D2 FIXED(12,2),D3 FIXED(12,2);
DCL D4 FIXED(12,2),K1 FIXED(12,2),K2 FIXED(12,2),K3 FIXED(12,2),K4 FIXED(12,2);
DCL S1 FIXED(12,2),S2 FIXED(12,2),S3 FIXED(12,2),S4 FIXED(12,2);
DCL KOO CHAR(4) INIT(' ');DCL UT1 FIXED(12,2);UT1=0;DCL R FIXED(3);R=48;
A1=0;A2=0;D1=0;D2=0;D3=0;D4=0;K1=0;K2=0;K3=0;K4=0;S1=0;S2=0;S3=0;S4=0;XX1=0;
DCL MM CHAR(8),PP FIXED(3),NI FIXED(1);DCL SIDA FIXED(3);SIDA=1;
DCL R1 CHAR(25) INIT('BALANSRÄKNING');
DCL R2 CHAR(25) INIT('SIDA:');
DCL R3 CHAR(40) INIT('KONTO BENÄMNING');
DCL R4 CHAR(55) INIT('PERIOD DEBET PERIOD KREDIT SALDO ');
DCL R4A CHAR(8) INIT('ANDEL %');
DCL R5 CHAR(10)INIT('DATUM:'), R6 CHAR(10)INIT('PERIOD:');
DCL R7 CHAR(25) INIT('NIVÅ:');
DCL R8 CHAR(25) INIT('KONTOKLASS');
DCL R9 CHAR(25) INIT('KONTOGRUPP');
DCL R10 CHAR(25) INIT('KONTO');
DCL R11 CHAR(25) INIT('SAMTLIGA KONTON');
DCL R12 CHAR(25);
DCL TRO FIXED(7,4);
DCL ABB CHAR(3) INIT(' '), KO CHAR(4),A FIXED(1);A=0;
DCL XX FILE;OPEN XX;DCL KPLAN FILE;OPEN KPLAN;DCL KPLANB FILE;OPEN KPLANB;
UT=0;DCL NI1 CHAR(3), NI2 CHAR(3), NI2B CHAR(2), NI3 CHAR(3);
DCL NI4 FIXED(1);
PUT FILE(DISP)SKIP LIST('ÄR KPLAN SORTERAD? '); GET SKIP LIST(ABB);
IF(ABB = 'NEJ') THEN GO TO SLUT;
PUT FILE(DISP)SKIP LIST('DATUM '); GET SKIP LIST(MM);
PER: PUT FILE(DISP) SKIP LIST('PERIOD(=MM) '); GET SKIP LIST(PP);
IF (PP>12) THEN GO TO PER;
PUT FILE(DISP) SKIP LIST('NIVÅ? 1,2,3 ELLER 4 '); GET SKIP LIST(NI);
IF (NI=1) THEN R12=R8;IF (NI=2) THEN R12=R9;IF (NI=3) THEN R12=R10;
IF (NI=4) THEN R12=R11;
PUT FILE(D) SKIP LIST(' ');OPEN KPLAN;OPEN KPLANB;
READ FILE(KPLAN) INTO(KPL); KO = KONTO; GO TO ST;
START:ON ENDFILE GO TO NEX;READ FILE(KPLAN)INTO(KPL);
IF (SUBSTR(KONTO,1,1)>=3) THEN GO TO NEX;
IF(SUBSTR(KO,1,1) ¬= SUBSTR(KONTO,1,1) ) THEN GO TO NEXT;
ST:A1=0;A2=0;DO I=1 TO PP-1;A1=A1+ACD(I);A2=A2+ACK(I);END;SAL=A1-A2;
BN=BEN; KT=KONTO;AD=ACD(PP);AK=ACK(PP);UTG=IB+SAL+(AD-AK);
KO=KONTO;UT1=UT1+UTG;NI2B=(SUBSTR(KO,1,2));I=2;
IF (NI2B<=15) THEN I=1;
IF (SUBSTR(KO,1,3)>=162)&(NI2B<=19) THEN I=3;
IF (NI2B>=20)&(NI2B<=26) THEN I=4;
IF (NI2B=27) THEN I=5;IF (NI2B=28) THEN I=6;IF (NI2B=29) THEN I=7;
PD(I)=PD(I)+AD;PK(I)=PK(I)+AK;PS(I)=PS(I)+UTG;
WRITE FILE(XX) FROM(HJ); GO TO START;
NEXT:CLOSE XX; OPEN XX; XX1=1;A=0;IF (R>=48) THEN GO TO RUB;
XXIN: KOO=KT;
ON ENDFILE GO TO BYTXX;READ FILE(XX) INTO(HJ);D4=AD;K4=AK;S4=UTG;
IF (XX1=1) THEN DO;KOO=KT;XX1=0;END;
XXINBB:IF(SUBSTR(KOO,4,1)='0') THEN GO TO NN2BB;
IF (SUBSTR(KT,4,1)='0') THEN GO TO NN2B;
IF (SUBSTR(KT,1,3) = SUBSTR(KOO,1,3))THEN GO TO NN4;
GO TO NN2B;
NN4:IF (NI=3)&(SUBSTR(KT,4,1)¬='0') THEN NI4=0;ELSE NI4=1;A=4;
IF (NI>2)&(NI4=1) THEN DO;
PUT SKIP EDIT(KT)(A(10))(BN)(A(36))(D4)(P'------------9V.99');
PUT EDIT(K4)(P'------------9V.99')(S4)(P'------------9V.99');
TRO=((S4*100)/UT1)+0.005;
PUT EDIT(TRO)(P'------------9V.99');PUT LIST(' %');;R=R+1;END;
D3=D3+D4;K3=K3+K4;S3=S3+S4;IF (SUBSTR(KT,4,1)='0') THEN DO;
D2=D2+D3;K2=K2+K3;S2=S2+S3;D3=0;K3=0;S3=0;
END;IF (R>=48) THEN GO TO RUB;GO TO XXIN;
NN2B:NI3=SUBSTR(KOO,1,3);READ KEY(NI3) FILE(KPLANB) INTO(KPLB);A=3;
IF (NI>2) THEN DO;
PUT SKIP(2) EDIT(KTO)(A(10))(BENA)(A(36))(D3)(P'------------9V.99');
PUT EDIT(K3)(P'------------9V.99')(S3)(P'------------9V.99');
TRO=((S3*100)/UT1)+0.005;
PUT EDIT(TRO)(P'------------9V.99');PUT LIST(' %');PUT SKIP;R=R+3;END;
D2=D2+D3;K2=K2+K3;S2=S2+S3;D3=0;K3=0;S3=0;IF (R>=48) THEN GO TO RUB;
NN2BB:IF (SUBSTR(KT,1,2)=SUBSTR(KOO,1,2)) THEN GO TO XXINB;
NN2A:NI2=(SUBSTR(KOO,1,2)) CAT ' ';READ KEY(NI2) FILE(KPLANB) INTO(KPLB);A=2;
NI2B=(SUBSTR(NI2,1,2));IF (NI>1) THEN DO;
PUT SKIP(2) EDIT(KTO)(A(10))(BENA)(A(36))(D2)(P'------------9V.99');
PUT EDIT(K2)(P'------------9V.99')(S2)(P'------------9V.99');
TRO=((S2*100)/UT1)+0.005;
PUT EDIT(TRO)(P'------------9V.99');PUT LIST(' %');PUT SKIP;R=R+3;END;
DEL=0;IF (NI2B=15) THEN DO;TX=TX1;I=1;DEL=1;END;
IF (NI2B=19) THEN DO;TX=TX3;I=3;DEL=1;END;
IF (NI2B=26) THEN DO;TX=TX4;I=4;DEL=1;END;
IF (NI2B=27) THEN DO;TX=TX5;I=5;DEL=1;END;
IF (NI2B=28) THEN DO;TX=TX6;I=6;DEL=1;END;
IF (NI2B=29) THEN DO;TX=TX7;I=7;DEL=1;END;IF (R>=48) THEN GO TO RUB;
NN2AB:A=5;IF (DEL=1)&(NI>1) THEN DO; TRO=((PS(I)*100)/UT1)+0.005;
PUT SKIP(2) EDIT(TX)(A(46))(PD(I))(P'------------9V.99');
PUT EDIT(PK(I))(P'------------9V.99')(PS(I))(P'------------9V.99');
PUT EDIT(TRO)(P'------------9V.99');PUT LIST(' %');PUT SKIP;
PD(I)=0;PK(I)=0;PS(I)=0;R=R+3;END;
D1=D1+D2;K1=K1+K2;S1=S1+S2;D2=0;K2=0;S2=0;
IF (R>=48) THEN GO TO RUB;
NN2AC: IF (SUBSTR(KT,1,1)=SUBSTR(KOO,1,1)) THEN GO TO XXINB;
NN1:NI1=SUBSTR(KOO,1,1) CAT ' ';READ KEY(NI1) FILE(KPLANB) INTO(KPLB);A=1;
PUT SKIP(2) EDIT(KTO)(A(10))(BENA)(A(36))(D1)(P'------------9V.99');
PUT EDIT(K1)(P'------------9V.99')(S1)(P'------------9V.99');PUT SKIP(2);
R=R+4;D1=0;K1=0;S1=0;KO=KONTO;OPEN XX;
IF (UT=1) THEN GO TO SLUT;IF (SUBSTR(KOO,1,1)=1) THEN DO;PUT SKIP(4);R=R+4;END;
UT1=0;IF (R>=48) THEN GO TO RUB;GO TO ST;
XXINB:KOO=KT;GO TO NN4;
BYTXX: KT=' ';GO TO XXINBB;
NEX:UT=1;GO TO NEXT;
RUB: R=R-36;IF (SIDA¬=1) THEN PUT SKIP(5);
PUT SKIP(4) EDIT(R1)(A(17))(R7)(A(6))(NI)(A(3))(R12)(A(19))(R6)(A(8));
PUT EDIT(PP)(A(40))(R5)(A(7))(MM)(A(11))(R2)(A(6))(SIDA)(A(10));
PUT SKIP(2) EDIT(R3)(A(50));
PUT EDIT(R4)(A(55));IF (NI¬=1) THEN DO;PUT EDIT(R4A)(A(10));END;SIDA=SIDA+1;
PUT SKIP;
IF (A=4) THEN GO TO XXIN;IF (A=3) THEN GO TO NN2BB;IF (A=2) THEN GO TO NN2AB;
IF (A=1) THEN GO TO ST;IF (A=0) THEN GO TO XXIN;IF (A=5) THEN GO TO NN2AC;
SLUT:END;