|
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: 12166 (0x2f86)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BALRÄKN1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »BALRÄKN1«
/*FÖRSTA RADEN*/
/*BALRÄKN UTSKRIFT AV BALANSRÄKNING
KLART: XXXXXX PROGR:TD */
DCL 1 SAM1(15),2 SSTR1,3 SKO1 FIXED(4),3 SAVD1 FIXED(2),3 SPROJ1 FIXED(4),
3 SMNR1 FIXED(2),3 BUD1 CHAR(1),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 SAVD2 FIXED(2),3 SPROJ2 FIXED(4),
3 SMNR2 FIXED(2),3 BUD2 CHAR(1),2 SAD2 FIXED(11,2),2 SAK2 FIXED(11,2),
2 HJKOD2 CHAR(1);
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD FIXED(2),3 SPROJ FIXED(4),
3 SMNR FIXED(2),3 BUD CHAR(1),
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);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(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(12,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(13,2),B5 FIXED(13,2),DIF4 FIXED(13,2),DIF5 FIXED(13,2),
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'),
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;
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(37))
('"5"=PER AVD. I FÖREK. FALL')(A(35));
GET SKIP LIST(NI);IF NI<1öNI>5 THEN GO TO TAB;
PUT FILE(D)SKIP EDIT(' ')(A(43))('*** UTSKRIFT PÅGÅR ***')(A(67));
Q=0;XBUD='B';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;B5=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('BALANSRÄKNING 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))
('UTG. SALDO')(A(14))('ANDEL')(A(8));
IF NI>4 THEN PUT EDIT('BUDG 1000 KR')(A(15))('DIFF 1000 KR')(A)SKIP;
ELSE PUT 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=5 THEN GO TO NI5UT;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 BUD=' ' & 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 BUD=' ' & 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 BUD=' ' & 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 DO;XKO=SKO;XAVD=SAVD;END;IND=0;
IF XAVD¬=SAVDöXKO¬=SKO THEN GO TO NI5UT;
ACKUM:XAVD=SAVD;XKO=SKO;
IF BUD='B' THEN DO;B5=B5+SAD-SAK;END;
ELSE DO;S5=S5+SAD-SAK;
IF SMNR=MNR THEN DO;D5=D5+SAD;K5=K5+SAK;END;
END;
GO TO ST;
NI5UT:JUMP=5;IF RAD<12 THEN GO TO RUB;IF XKO=SKO&XAVD¬=SAVD THEN Q=1;
IF AVD¬=0 THEN DO;
DIF5=ABS((S5-B5)/1000)+.05;IF S5-B5<0 THEN DIF5=-DIF5;END;
ELSE DO;DIF=0;END;
L=XKO/1000;
IF NI>4&Q=1&XAVD¬=0 THEN DO;
PERC=ABS((S5*100)/KOKLTOT(L))+.005;
IF S5*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(XKO)(A(5))('PROJ.FÖRS AVDELNING ')(A(20))(XAVD)(A(15))
(D5)(PC)(K5)(PC)(S5)(PC)(PERC)(PCCC)(B5/1000+.05)(P'-----------9V.9')
(DIF5)(P'------------9V.9');RAD=RAD-1;END;
D4=D4+D5;K4=K4+K5;S4=S4+S5;B4=B4+B5;DIF4=DIF4+DIF5;
D5=0;K5=0;S5=0;B5=0;DIF5=0;
IF XKO¬=SKO THEN GO TO NI4UT;
GO TO ACKUM;
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);
IF NI>4&Q=1 THEN DO;PUT EDIT((B4/1000)+.05)(P'-----------9V.9')(DIF4)
(P'------------9V.9')SKIP;RAD=RAD-1;END;RAD=RAD-1;
END;
D3=D3+D4;K3=K3+K4;S3=S3+S4;D4=0;K4=0;S4=0;B4=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=4 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='SUMMA OMSÄTTNINGSTILLGÅNGAR';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 NI5UT;
SLUT:PUT SKIP(RAD-5);
SLUTT:CALL TYPIST('BOKRUT┣0d┫',7);END;