|
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: 18486 (0x4836)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BALRÄKN1«
└─⟦7bb65a061⟧ Bits:30008625 DDMQ1-0065_Reflex_MSAB_Bokf_system_diskett_1_2_Sid2_Alla_pgm_PL1_781120_side0
└─⟦this⟧ »BALRÄKN1«
└─⟦aeb45b905⟧ Bits:30008623 DDMQ1-0063__LMC_Original_Generella_pgm_for_bokforing_Sid1_PL1_Sid2_kompil_781105_side1
└─⟦this⟧ »BALRÄKN1«
└─⟦cfd478037⟧ Bits:30008627 DDMQ1-0066_MSAB_ref_ex_Bokf_system_NFK_diskett_2_2_781120_side0
└─⟦this⟧ »BALRÄKN1«
└─⟦d1c33ffd3⟧ Bits:30008583 DDMQ1-0017_Bokforingssystem_kallkod_Msab_790411
└─⟦this⟧ »BALRÄKN1«
└─⟦f4c608b16⟧ Bits:30008624 DDMQ1-0064_LMC_Kopia_Generall_pgm_for_bokforing_Endast_PL1-vers_781105_B
└─⟦this⟧ »BALRÄKN1«
/*FÖRSTA RADEN*/
/*BALRÄKN UTSKRIFT AV BALANSRÄKNING GEN. PGM. KLART:781104 PROGR:TD */
DCL 1 DUM,2 DUM1 CHAR(3),2 BUDKOD CHAR(1),2 DUM2 CHAR(51);
DCL 1 SAM1(5),2 SSTR1,3 SKO1 FIXED(4),3 SAVD1 CHAR(3),
2 SAD1(12) FIXED(11,2),2 SAK1(12) FIXED(11,2);
DCL 1 SAM2(30),2 SSTR2,3 SKO2 FIXED(4),3 SAVD2 CHAR(3),
2 SAD2(12) FIXED(11,2),2 SAK2(12) FIXED(11,2);
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD CHAR(3),
2 SAD(12) FIXED(11,2),2 SAK(12) FIXED(11,2);
DCL 1 KTX,2 KSTR,3 TKO FIXED(4),3 TKOD CHAR(1),2 TKO2 CHAR(4),2 TEXT CHAR(34),
2 IB FIXED(13,2);
DCL 1 TX,2 KSTRX,3 KNR FIXED(4),3 ZZ CHAR(1),2 XKK CHAR(4),2 XTXT CHAR(34),
2 XXIB FIXED(13,2);
DCL 1 KBU,2 BSTR,3 BKO FIXED(4),3 BKOD CHAR(1),2 BAVD CHAR(3),
2 XBUD(12) FIXED(7);
DCL 1 DATREC,2 XDAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 KOD FIXED(1);
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),
SUB FIXED(1),DU(6) FIXED(13,2),KU(6) FIXED(13,2),SU(6) FIXED(13,2),
UT(5) FIXED(13,2),DAG CHAR(6),TD FIXED(13,2),TK FIXED(13,2),TS FIXED(13,2),
XSKO FIXED(4),TXT CHAR(34),RECNR BINARY,SAMSLUT BINARY,
KTOSLUT BINARY,JUMP FIXED(1),C CHAR(17)INIT('------------9V.99'),
CC CHAR(17)INIT('-----------9V.99*'),
CCC CHAR(16)INIT('-----9V.99% '),CCCC CHAR(15)INIT('----9V.99% '),
D CHAR(4)INIT('ZZZ9'),E CHAR(12)INIT('-------9V.9 '),Q FIXED(1),
EE CHAR(12)INIT('-------9V.9*'),J FIXED(4),K FIXED(4),L FIXED(4),PERC FLOAT(9);
RUB:PROC;
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))
('ACK. SALDO')(A(14))('ANDEL')(A(8))SKIP;
RAD=45;
RETURN;END;
ABSS:PROC(QQ);
DCL QQ FLOAT(13);
IF QQ<0 THEN QQ=-QQ;RETURN(QQ);END;
NI1UT:PROC(JX,SUBSUBKO);
DCL JX FIXED(4),SUBSUBKO FIXED(4);
IF RAD<12 THEN CALL RUB;
XTXT='*** FINNS EJ I KONTOPLANEN ***';KNR=JX;ZZ='A';
ON ERROR GOTO X1;READ KEY(KSTRX)FILE(KTOTX)INTO(TX);
X1:PERC=ABSS((S1*100)/KOKLTOT(L))+.005;IF S1*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(JX)(A(5))(XTXT)(A(36))(D1)(PCC)(K1)(PCC)(S1)(PCC)
(PERC)(PCCCC)SKIP(2);RAD=RAD-3;
TD=TD+D1;TK=TK+K1;TS=TS+S1;D1=0;K1=0;S1=0;
IF NI>2&JX=1 THEN DO;PUT SKIP(RAD-5);RAD=5;END;
RETURN;END;
KTOTXIN:PROC;
UNSPEC(KTOTX)=RECNR;
ON ENDFILE GOTO KOSLUT;READ FILE(KTOTX)INTO(DUM);RECNR=UNSPEC(KTOTX);
GOTO KTOOK;
KOSLUT:KTOSLUT=1;
KTOOK:
IF KTOSLUT=0&BUDKOD='A' THEN DO;KTX=DUM;IF TKO>2999 THEN KTOSLUT=1;END;
RETURN;
END;
SUBA:PROC(SUBKO);
DCL SUBKO FIXED(4);
IF D5=0&K5=0&S5=0&SUBKO¬=9999 THEN GO TO A1;
IF IND=1öXKTO=SUBKO THEN GO TO A6;
NI4UT:IF RAD<12 THEN CALL RUB;
L=XKTO/1000;
D3=D3+D4;K3=K3+K4;S3=S3+S4;D4=0;K4=0;S4=0;Q=0;
J=XKTO/10;K=SUBKO/10;L=XKTO/1000;
IF J¬=K THEN GOTO NI3UT;
GOTO A6;
NI3UT:IF RAD<12 THEN CALL RUB;
IF(NI=3)&(J=XKTO/10)THEN J=XKTO;
IF((J¬=XKTO/10)&(NI>3))ö(NI=3) THEN DO;KNR=J;ZZ='A';
XTXT='*** FINNS EJ I KONTOPLANEN ***';
ON ERROR GO TO X2;READ KEY(KSTRX)FILE(KTOTX)INTO(TX);
X2:PERC=ABSS((S3*100)/KOKLTOT(L))+.005;IF S3*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(J)(A(5))(XTXT)(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 NI=3&J=XKTO THEN J=XKTO/10;
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=XKTO/100;K=SUBKO/100;IF J¬=K THEN GO TO NI2UT;
GO TO A6;
NI2UT:IF RAD<14 THEN CALL RUB;
IF NI>1 THEN DO;KNR=J;ZZ='A';
XTXT='*** FINNS EJ I KONTOPLANEN ***';
ON ERROR GO TO X3;READ KEY(KSTRX)FILE(KTOTX)INTO(TX);
X3:PERC=ABSS((S2*100)/KOKLTOT(L))+.005;IF S2*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(J)(A(5))(XTXT)(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=ABSS((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=XKTO/1000;K=SUBKO/1000;IF(J¬=K)&IND¬=2 THEN CALL NI1UT(J,SUBKO);
IF SUBKO=9999 THEN GOTO SLUT;
GO TO A6;
A6:
IND=0;
NI5UT:IF RAD<12 THEN CALL RUB;
L=SUBKO/1000;
IF NI>3 THEN DO;
PERC=ABSS((S5*100)/KOKLTOT(L))+.005;
IF S5*KOKLTOT(L)<0 THEN PERC=-PERC;
PUT SKIP EDIT(SUBKO)(A(5));RAD=RAD-1;
PUT EDIT(TEXT)(A(35))(D5)(PC)(K5)(PC)(S5)(PC)(PERC)(PCCC);
END;
XKTO=SUBKO;
D4=D4+D5;K4=K4+K5;S4=S4+S5;
A1:D5=0;K5=0;S5=0;
RETURN;
END;
PROCB:PROC; /*UPPREPAR ACKUMULERING AV SALDON OCH LÄSNING I SAMFIL
TILLS ETT RECORD MED ANNAT KONTONUMMER ELLER AVD. HITTAS,ELLER FILEN TAR SLUT*/
S5=IB;
SAMIN:XSKO=SKO;
DO I=1 TO MNR;S5=S5+SAD(I)-SAK(I);END;
D5=D5+SAD(MNR);K5=K5+SAK(MNR);
ON ENDFILE GOTO SAMUT;READ FILE(SAMFIL)INTO(SAM);
GOTO SAMOK;
SAMUT:SAMSLUT=1;
SAMOK:IF SKO>2999 THEN SAMSLUT=1;
IF SAMSLUT=0 & XSKO=SKO THEN GOTO SAMIN;
CALL SUBA(XSKO);
RETURN;END;
PROCC:PROC; /*LÄSER I KTOTX OCH ACKUMULERAR BUDGET PÅ RESP AVDELNING*/
CALL SUBA(TKO);
UNSPEC(KTOTX)=RECNR;
KTOIN:ON ENDFILE GOTO KTOUT;READ FILE(KTOTX)INTO(DUM);
RECNR=UNSPEC(KTOTX);GOTO KTOOK2;
KTOUT:KTOSLUT=1;GOTO KTOKLAR;
KTOOK2:IF BUDKOD='A' THEN GOTO KTOKLAR;
KBU=DUM;IF BKO>2999 THEN KTOSLUT=1;
CALL SUBA(TKO);
GOTO KTOIN;
RETURN;
KTOKLAR:KTX=DUM;IF TKO>2999 THEN KTOSLUT=1;
RETURN;END;
OPEN KTOTX;OPEN DATFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF XDAG='XXXXXX' THEN GO TO SLUTT;
DAG=XDAG;XDAG='XXXXXX';
REWRITE FILE(DATFIL)FROM(DATREC);
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));
DEL=0;RECNR=0;JUMP=0;RAD=5;SIDA=0;IND=1;SAMSLUT=0;KTOSLUT=0;Q=0;
TD=0;TK=0;TS=0;
D1=0;D2=0;D3=0;D4=0;D5=0;S1=0;S2=0;S3=0;S4=0;S5=0;
K1=0;K2=0;K3=0;K4=0;K5=0;
DO I=1 TO 6;DU(I)=0;KU(I)=0;SU(I)=0;END;
/*START AV SJÄLVA PROGRAMMET!*/
START:
DO I=1 TO 2;KOKLTOT(I)=0;END;
IN2:ON ENDFILE GO TO IN1;READ FILE(SAMFIL)INTO(SAM2);RECNR=UNSPEC(SAMFIL);
DO I=1 TO 30;SAM=SAM2(I);J=SKO/1000;IF J>2 THEN GO TO INSLUT;
DO K=1 TO MNR;KOKLTOT(J)=KOKLTOT(J)+SAD(K)-SAK(K);
END;END;GOTO IN2;
IN1:UNSPEC(SAMFIL)=RECNR;
IN1B:ON ENDFILE GO TO IN;READ FILE(SAMFIL)INTO(SAM1);RECNR=UNSPEC(SAMFIL);
DO I=1 TO 5;SAM=SAM1(I);J=SKO/1000;IF J>2 THEN GO TO INSLUT;
DO K=1 TO MNR;KOKLTOT(J)=KOKLTOT(J)+SAD(K)-SAK(K);
END;END;GOTO 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;
DO K=1 TO MNR;KOKLTOT(J)=KOKLTOT(J)+SAD(K)-SAK(K);
END;GOTO INB;
INSLUT:UNSPEC(SAMFIL)=0;RECNR=0;
IBIN:ON ENDFILE GO TO IBUT;READ FILE(KTOTX)INTO(KTX);
IF TKO<1000 THEN GOTO IBIN;
IF TKO>2999 THEN GOTO IBUT;
IF RECNR=0 THEN RECNR=UNSPEC(KTOTX)-1;
IF IB¬=0 THEN DO;J=TKO/1000;KOKLTOT(J)=KOKLTOT(J)+IB;END;
GOTO IBIN;
IBUT:UNSPEC(KTOTX)=RECNR;
A00:ON ENDFILE GO TO SAMUT2;READ FILE(SAMFIL)INTO(SAM);
IF SKO<3000 THEN GOTO SAMOK2;
SAMUT2:SAMSLUT=1;
SAMOK2:
A0:ON ENDFILE GO TO KTOUT2;READ FILE(KTOTX)INTO(KTX);
IF TKO<3000 THEN GOTO KTOOK3;
KTOUT2:KTOSLUT=1;
KTOOK3:RECNR=UNSPEC(KTOTX);
NY:
IF KTOSLUT=1 & SAMSLUT=1 THEN GO TO AVSLUTA;
IF SAMSLUT=1öTKO<SKO THEN GOTO ONE;
IF SAMSLUT=0 & KTOSLUT=0 THEN GO TO BOTH;
IF SAMSLUT=0 & KTOSLUT=0 & SKO<TKO THEN GOTO ONESAM;
CALL PROCB;
CALL KTOTXIN;
GOTO NY;
ONE:S5=IB;
CALL PROCC;
GOTO NY;
ONESAM:S5=0;
CALL PROCB;
GOTO NY;
BOTH:
CALL PROCB;
CALL KTOTXIN;
GOTO NY;
AVSLUTA:SKO=9999;CALL SUBA(SKO);
SLUT:IF RAD<9 THEN CALL RUB;
IF TD=TK&TS=0 THEN PUT SKIP EDIT('BALANS MELLAN TILLGÅNGAR OCH SKULDER')(A);
ELSE PUT SKIP EDIT('BERÄKNAT RESULTAT:')(A(41))(TD)(PCC)(TK)(PCC)(TS)(PCC);
RAD=RAD-1;
PUT SKIP(RAD-5);
SLUTT:CALL LOAD('BOKRUT',6);END;