|
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: 12561 (0x3111)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »RESULT1«
└─⟦7d57c527f⟧ Bits:30008641 DDMQ1-0080_LMC_RESULTAT_for_MSAB
└─⟦this⟧ »RESULT1«
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(9) FIXED(12,2),PK(9) FIXED(12,2),PS(9) FIXED(12,2),I FIXED(3);
DO I=1 TO 9;PD(I)=0;PK(I)=0;PS(I)=0;END;
DCL TX1 CHAR(50) INIT(' SUMMA FÖRSÄLJING:');
DCL TX2 CHAR(50) INIT(' SUMMA ÖVRIGA INTÄKTER:');
DCL TX3 CHAR(50) INIT(' SUMMA VAROR:');
DCL TX4 CHAR(50) INIT(' SUMMA LÖNER OCH PERSONALKOSTNADER:');
DCL TX5 CHAR(55)INIT(' SUMMA ÖVRIGA KOSTNADER:');
DCL TX6 CHAR(50) INIT(' RÖRELSERESULTAT FÖRE AVSKRIVNINGAR:');
DCL TX7 CHAR(50)INIT(' RÖRELSERESULTAT EFTER AVSKRIVNINGAR');
DCL TX8 CHAR(60) INIT(' RESULT EFTER FIN.INTÄKTER OCH KOSTNADER:');
DCL TX9 CHAR(60)INIT(' REDOVISAT RESULTAT:');
DCL TX10 CHAR(50)INIT(' REDOVISTAT RESULTAT:');
DCL TX CHAR(60),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(6) 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('RESULTATRÄKNING');
DCL R2 CHAR(25) INIT('SIDA:');
DCL R3 CHAR(40) INIT('KONTO BENÄMNING');
DCL R4 CHAR(55) INIT('PERIOD SALDO ACK.SALDO ');
DCL R4A CHAR(8) INIT(' ');
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(6),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);
PUT FILE(DISP) SKIP LIST('PERIOD(=MM) '); GET SKIP LIST(PP);
PUT FILE(DISP) SKIP LIST('NIVÅ? 1,2,3 EL 4 '); GET SKIP LIST(NI);
IF (NI=1) THEN R12=R8;IF (NI=2) THEN R12=R9;IF (NI=3) THEN R12=R10;
DCL AA CHAR(1)INIT(' '); IF (NI=4) THEN R12=R11;
UX=0;UY=0;RX=0;RY=0;PUT FILE(D) SKIP LIST(' ');OPEN KPLAN;OPEN KPLANB;
ARX=1;FG=1;KO='3 '; GO TO ST;
START:ON ENDFILE GO TO NEX;READ FILE(KPLAN)INTO(KPL);
ST:IF (SUBSTR(KONTO,1,1)<3) THEN GO TO START;
IF(SUBSTR(KONTO,1,2)=88)THEN GO TO NEX;
IF(SUBSTR(KO,1,1) ¬= SUBSTR(KONTO,1,1) ) THEN GO TO NEXT;
A1=0;A2=0;DO J=1 TO PP-1;A1=A1+ACD(J);A2=A2+ACK(J);END;SAL=A1-A2;
BN=BEN; KT=KONTO;AD=ACD(PP);AK=ACK(PP);UTG=IB+SAL+(AD-AK);
AD=-AD;AK=-AK; UTG=-UTG;
KO=KONTO;UT1=UT1+UTG;/*NI2B=SUBSTR(KO,1,2);I=1;
IF(NI2B=30)THEN DO;Y=1;I=1;END; IF(NI2B>30&NI2B<=39)THEN DO;Y=2;I=2;END;
IF(NI2B>39 &NI2B<=49)THEN DO;Y=3;I=3;END; IF(NI2B>49&NI2B<=59)THEN DO;Y=4;
I=4;END;IF(NI2B>59 & NI2B<=78)THEN DO;I=5;Y=5; END;
IF(NI2B=79)THEN DO;Y=6;I =6;END; IF(NI2B>79 &NI2B<=81)THEN DO;Y=7;I=7; END;
IF(NI2B>81 & NI2B<=87)THEN DO;Y=8;I=8;END; IF(NI2B>=88&NI2B<89)THEN DO;Y=9;I=9;
END; PD(I)=PD(I)+AD; PK(I)=PK(I)+AK; PS(I)=PS(I)+UTG; */
IF(SUBSTR(KONTO,1,2)=79&FG=1)THEN DO; U78=UX-(-UY);R78=RX-(-RY);FG=0;END;
IF(SUBSTR(KONTO,1,1)=3)THEN DO;UX=UX+UTG;RX=RX+(AD-AK);END;
IF(SUBSTR(KONTO,1,1)>3)THEN DO;RY=RY+(AD-AK); UY=UY+UTG; END;
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(SUBSTR(KT,1,2)=79&ARX=1)THEN DO;PUT SKIP(2)EDIT
('RESULTAT FÖRE AVSKRIVNINGAR')
(A(42))(R78)(P'------------9V.99')(U78)(P'------------9V.99');PUT SKIP(2);
ARX=0;R=R+4; END;IF(R>=48)THEN GO TO RUB;
IF (NI>2)&(NI4=1) THEN DO;
PUT SKIP EDIT(KT)(A(10))(BN)(A(35))(D4-K4)(P'------------9V.99');
PUT EDIT(S4)(P'------------9V.99');
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(35))(D3-K3)(P'------------9V.99');
PUT EDIT(S3)(P'------------9V.99');
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(35))(D2-K2)(P'------------9V.99');
PUT EDIT(S2)(P'------------9V.99');
PUT SKIP;R=R+3;END;
DEL=0;/*IF (Y=1) THEN DO;TX=TX1;I=1;DEL=1;END;
IF(Y=2)THEN DO;TX=TX2;DEL=1;I=2;END;IF(Y=3)THEN DO;TX=TX3;DEL=1;I=3;
END; IF (Y=4)THEN DO;TX=TX4;I=4;DEL=1;END;
IF (Y=4) THEN DO;TX=TX5;I=5;DEL=1; END;
IF (Y=5) THEN DO;TX=TX7;I=6;DEL=1;END;
IF (Y=6) THEN DO;TX=TX8;I=7;DEL=1;END;
IF(Y=7)THEN DO; I=8;TX=TX9;DEL=1; END;
IF(Y=8)THEN DO; I=9; TX=TX10;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(42))(PD(I)-PK(I))(P'------------9V.99');
PUT EDIT(PS(I))(P'------------9V.99');
PUT SKIP;IF(Y=6)THEN DO; PX=(PD(3)+PD(4)+PD(5))-(PK(3)+PK(4)+PK(5));
PUT SKIP(2)EDIT(TX)(A(65))(PX)(P'------------9V.99');PY=PS(3)+PS(4)+PS(5);
PUT EDIT(PY)(P'------------9V.99'); R=R+2; END;
R=R+3;END; */ IF(R>=48)THEN GO TO RUB;
NN2AB:A=5;D1=D1+D2;K1=K1+K2;S1=S1+S2;D2=0;K2=0;S2=0;
IF(NI2='87 ')THEN DO;PUT SKIP(2)EDIT('RESULTAT EFTER FIN. INT. & KOSTN')
(A(42))(RX-(-RY))(P'------------9V.99')(UX-(-UY))(P'------------9V.99');R=R+4;
PUT SKIP(2);END; 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;
IF(SUBSTR(KONTO,1,2)=88)THEN GO TO SLUT;
PUT SKIP(2) EDIT(KTO)(A(10))(BENA)(A(35))(D1-K1)(P'------------9V.99');
PUT EDIT(S1)(P'------------9V.99');PUT SKIP(2);
R=R+4;IF(R>=48)THEN GO TO RUB;
IF(NI1='7 ')THEN DO;PUT SKIP(2)EDIT('RESULTAT EFTER AVSKRIVNINGAR')(A(42));
PUT EDIT(RX-(-RY))(P'------------9V.99')(UX-(-UY))(P'------------9V.99');
PUT SKIP(2);R=R+4; END;
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(49));
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:PUT SKIP(2)EDIT('RÖRELSERESULTAT')(A(42))
(RX-(-RY))(P'------------9V.99')(UX-(-UY))
(P'------------9V.99');END;