|
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: 10665 (0x29a9)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BAL«
└─⟦89202cd22⟧ Bits:30008732 DDMQ1-0174_Progra_Disk_PL1_vers_4_2_LMC_init_dat_781004_TD
└─⟦this⟧ »BAL«
/*FÖRSTA RADEN*/
/*BALRÄKN UTSKRIFT AV BALANSRÄKNING
KLART: 780428 FÖR MSAB PROGR:TD */
DCL 1 SAM1(15),2 SSTR1,3 SKO1 FIXED(4),
3 SMNR1 FIXED(2),2 SAD1 FIXED(11,2),2 SAK1 FIXED(11,2),
2 HJKOD1 CHAR(1);
DCL 1 SAM2(200),2 SSTR2,3 SKO2 FIXED(4),
3 SMNR2 FIXED(2),2 SAD2 FIXED(11,2),2 SAK2 FIXED(11,2),
2 HJKOD2 CHAR(1);
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),
3 SMNR FIXED(2),
2 SAD FIXED(11,2),2 SAK FIXED(11,2),2 HJKOD CHAR(1);
DCL 1 KTO,2 KONTO FIXED(4),2 TEXT CHAR(34);
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 KOD FIXED(1);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(1),2 XKOD FIXED(1);
XDAG='XXXXXX ';XMNR=0;
DCL DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
SAMFIL FILE,NI FIXED(1),KOKLTOT(9) FIXED(13,2),
D1 FIXED(13,2),D2 FIXED(13,2),D3 FIXED(13,2),D4 FIXED(13,2),D5 FIXED(13,2),
K1 FIXED(13,2),K2 FIXED(13,2),K3 FIXED(13,2),K4 FIXED(13,2),K5 FIXED(13,2),
S1 FIXED(13,2),S2 FIXED(13,2),S3 FIXED(13,2),S4 FIXED(13,2),S5 FIXED(13,2),
B4 FIXED(8,1),PB4 FIXED(8,1),B5 FIXED(8,1),PB5 FIXED(8,1),
DIF4 FIXED(8,1),DIF5 FIXED(8,1),
SUB FIXED(1),DU(6) FIXED(13,2),KU(6) FIXED(13,2),SU(6) FIXED(13,2),
XKO FIXED(4),XAVD FIXED(2),PERC FLOAT(9),TXT CHAR(34),Q FIXED(1),
RECNR BINARY,DEL FIXED(1),
JUMP FIXED(1),C CHAR(20) INIT('------------9V.99'),
CC CHAR(20)INIT('-----------9V.99*'),
CCC CHAR(20)INIT('-----9V.99% '),CCCC CHAR(20)INIT('----9V.99% '),
D CHAR(4)INIT('ZZZ9'),E CHAR(13)INIT('-------9V.9 '),
EE CHAR(13)INIT('-------9V.9*'),J FIXED(4),K FIXED(4),L FIXED(4);
OPEN KTOTX;OPEN DATFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO SLUTT;
DO I=1 TO 14;XSK(I)=SK(I);END;XKOD=KOD;
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** BALANSRÄKNING ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
TAB:PUT FILE(D)SKIP EDIT('VILKEN NIVÅ?')(A(37))
('"1"=ENDAST KONTOKLASS')(A(37))
('"2"=PER KONTOGRUPP')(A(37))
('"3"=PER KONTO (3-SIFFRIGT)')(A(37))
('"4"=PER UNDERKONTO (4-SIFFRIGT)')(A(35));
GET SKIP LIST(NI);IF NI<1öNI>4 THEN GO TO TAB;
PUT FILE(D)SKIP EDIT(' ')(A(43))('*** UTSKRIFT PÅGÅR ***')(A(67));
Q=0;DEL=0;RECNR=0;JUMP=0;RAD=5;SIDA=0;IND=1;
D1=0;D2=0;D3=0;D4=0;D5=0;K1=0;K2=0;K3=0;K4=0;K5=0;S1=0;S2=0;S3=0;S4=0;S5=0;
B4=0;PB4=0;B5=0;PB5=0;DIF4=0;DIF5=0;
DO I=1 TO 6;DU(I)=0;KU(I)=0;SU(I)=0;END;
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('BESTÄLLNINGAR NIVÅ ')(A)(NI)(A(4))
('AVSEENDE MÅNAD ')(A)(MON)(A(5))
(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('KTO')(A(5))('BENÄMNING')(A(44))('MÅN DEB')(A(16))('MÅN KRE')(A(13))
('ACK. SALDO')(A(14))('ANDEL')(A(8))SKIP;
RAD=45;
IF JUMP=1 THEN GO TO NI1UT;;IF JUMP=2 THEN GO TO NI2UT;
IF JUMP=3 THEN GO TO NI3UT;IF JUMP=4 THEN GO TO NI4UT;
IF JUMP=6 THEN GO TO ACKUM;
DO I=1 TO 9;KOKLTOT(I)=0;END;
IN2:ON ENDFILE GO TO IN1;READ FILE(SAMFIL)INTO(SAM2);RECNR=UNSPEC(SAMFIL);
DO I=1 TO 200;SAM=SAM2(I);J=SKO/1000;IF J>2 THEN GO TO INSLUT;
IF MNR>=SMNR THEN KOKLTOT(J)=KOKLTOT(J)+SAD-SAK;END;GO TO IN2;
IN1:UNSPEC(SAMFIL)=RECNR;
IN1B:ON ENDFILE GO TO IN;READ FILE(SAMFIL)INTO(SAM1);RECNR=UNSPEC(SAMFIL);
DO I=1 TO 15;SAM=SAM1(I);J=SKO/1000;IF J>2 THEN GO TO INSLUT;
IF MNR>=SMNR THEN KOKLTOT(J)=KOKLTOT(J)+SAD-SAK;END;GO TO IN1B;
IN:UNSPEC(SAMFIL)=RECNR;
INB:ON ENDFILE GO TO INSLUT;READ FILE(SAMFIL)INTO(SAM);
J=SKO/1000;IF J>2 THEN GO TO INSLUT;
IF MNR>=SMNR THEN KOKLTOT(J)=KOKLTOT(J)+SAD-SAK;GO TO INB;
INSLUT:UNSPEC(SAMFIL)=0;
ST:ON ENDFILE GO TO UT;READ FILE(SAMFIL)INTO(SAM);
IF SKO>2999 THEN GO TO UT;
IF SMNR>MNR THEN GO TO ST;
IF IND=1 THEN XKO=SKO;IND=0;
IF XKO¬=SKO THEN GO TO NI4UT;
ACKUM:XKO=SKO;
S4=S4+SAD-SAK;
IF SMNR=MNR THEN DO;D4=D4+SAD;K4=K4+SAK;END;
GO TO ST;
NI4UT:JUMP=4;IF RAD<12 THEN GO TO RUB;J=XKO/10;K=SKO/10;L=XKO/1000;
IF NI>3 THEN DO;READ KEY(XKO)FILE(KTOTX)INTO(KTO);
PERC=ABS((S4*100)/KOKLTOT(L))+.005;IF S4*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(XKO)(A(5))(TEXT)(A(35))(D4)(PC)(K4)(PC)(S4)(PC)(PERC)(PCCC);
RAD=RAD-1;
END;
D3=D3+D4;K3=K3+K4;S3=S3+S4;D4=0;K4=0;S4=0;B4=0;PB4=0;DIF4=0;Q=0;
IF J¬=K THEN GO TO NI3UT;
GO TO ACKUM;
NI3UT:JUMP=3;IF RAD<12 THEN GO TO RUB;IF(NI=3)&(J=XKO/10)THEN J=XKO;
IF((J¬=XKO/10)&(NI>3))ö(NI=3) THEN DO;READ KEY(J)FILE(KTOTX)INTO(KTO);
PERC=ABS((S3*100)/KOKLTOT(L))+.005;IF S3*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(KONTO)(A(5))(TEXT)(A(35))(D3)(PC)(K3)(PC)(S3)(PC)
(PERC)(PCCC);RAD=RAD-1;IF NI>3 THEN DO;PUT SKIP;RAD=RAD-1;END;END;
D2=D2+D3;K2=K2+K3;S2=S2+S3;I=0;
IF J<160 THEN I=1;IF J>161&J<200 THEN I=2;IF J>199&J<270 THEN I=3;
IF J>269&J<280 THEN I=4;IF J>279&J<290 THEN I=5;IF J>289&J<300 THEN I=6;
IF I¬=0 THEN DO;DU(I)=DU(I)+D3;KU(I)=KU(I)+K3;SU(I)=SU(I)+S3;END;
D3=0;K3=0;S3=0;
J=XKO/100;K=SKO/100;IF J¬=K THEN GO TO NI2UT;
GO TO ACKUM;
NI2UT:JUMP=2;IF RAD<14 THEN GO TO RUB;
IF NI>1 THEN DO;READ KEY(J)FILE(KTOTX)INTO(KTO);
PERC=ABS((S2*100)/KOKLTOT(L))+.005;IF S2*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(KONTO)(A(5))(TEXT)(A(35))(D2)(PC)(K2)(PC)(S2)(PC)
(PERC)(PCCC);RAD=RAD-1;IF NI>2 THEN DO;PUT SKIP;RAD=RAD-1;END;END;
D1=D1+D2;K1=K1+K2;S1=S1+S2;D2=0;K2=0;S2=0;SUB=0;TXT=' ';
IF J<16&K>15 THEN DO;TXT=' ';SUB=1;END;
IF J>15&J<20&K>19 THEN DO;TXT='SUMMA ANLÄGGNINGSTILLGÅNGAR';SUB=2;END;
IF J>19&J<27&K>26 THEN DO;TXT='SUMMA KORTFRISTIGA SKULDER';SUB=3;END;
IF J=27&K>27 THEN DO;TXT='SUMMA LÅNGFRISTIGA SKULDER';SUB=4;END;
IF J=28&K>28 THEN DO;TXT='SUMMA OBESKATTADE RESERVER';SUB=5;END;
IF J=29&K>29 THEN DO;TXT='SUMMA EGET KAPITAL';SUB=6;END;
IF SUB¬=0 THEN DO;PERC=ABS((SU(SUB)*100)/KOKLTOT(L))+.005;
IF SU(SUB)*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(' ')(A(5))(TXT)(A(35))(DU(SUB))(PC)(KU(SUB))(PC)
(SU(SUB))(PC)(PERC)(PCCC)SKIP;RAD=RAD-2;END;
J=XKO/1000;K=SKO/1000;IF(J¬=K)ö(SKO=9999) THEN GO TO NI1UT;
GO TO ACKUM;
NI1UT:JUMP=1;IF RAD<12 THEN GO TO RUB;READ KEY(J)FILE(KTOTX)INTO(KTO);
PERC=ABS((S1*100)/KOKLTOT(L))+.005;IF S1*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(KONTO)(A(5))(TEXT)(A(36))(D1)(PCC)(K1)(PCC)(S1)(PCC);
RAD=RAD-1;
PUT EDIT(PERC)(PCCCC)SKIP(2);RAD=RAD-2;
D1=0;K1=0;S1=0;
IF SKO=9999 THEN GO TO SLUT;
IF NI<3 THEN GO TO ACKUM;
JUMP=6;GO TO RUB;
UT:SKO=9999;GO TO NI4UT;
SLUT:PUT SKIP(RAD-5);
SLUTT:CALL LOAD('BOKRUT',6);END;