|
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: 9954 (0x26e2)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »RESRÄKN1«
└─⟦1f3202981⟧ Bits:30008731 DDMQ1-0173_MSAB_Bokföring_Alla_Program_i_PL1_ref_ex_780428
└─⟦this⟧ »RESRÄKN1«
/*FÖRSTA RADEN*/
/*RESRÄKN UTSKRIFT AV RESULTATRÄKNING KLART:780428 FÖR MSAB PROGR:TD */
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),
AVDSIDA FIXED(4),SAMFIL FILE,NI FIXED(1),SAVD FIXED(2),
P1 FIXED(13,2),P2 FIXED(13,2),P3 FIXED(13,2),P4 FIXED(13,2),
S1 FIXED(13,2),S2 FIXED(13,2),S3 FIXED(13,2),S4 FIXED(13,2),
SUB FIXED(1),PU(6) FIXED(13,2),SU(6) FIXED(13,2),
UT(5) FIXED(13,2),
AP FIXED(13,2),AS FIXED(13,2),
TP FIXED(13,2),TS FIXED(13,2),
XKO FIXED(4),TXT CHAR(34),RECNR BINARY,
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))('*** RESULTATRÄ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;AVDSIDA=0;IND=1;
P1=0;P2=0;P3=0;P4=0;S1=0;S2=0;S3=0;S4=0;
AP=0;TP=0;AS=0;TS=0;
DO I=1 TO 6;PU(I)=0;SU(I)=0;END;
GO TO ST;
RUB:SIDA=SIDA+1;AVDSIDA=AVDSIDA+1;PUT SKIP(RAD)EDIT('RESULTATRÄKNING NIVÅ ')
(A)(NI)(A);
PUT EDIT('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. SALDO')(A(16))
('ACK. SALDO')(A(14))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 ACKUM;
IF JUMP=7 THEN GO TO TOTUT;
ST:ON ENDFILE GO TO UTT;READ FILE(SAMFIL)INTO(SAM);
IF SKO<3000ö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 P4=P4+SAD-SAK;
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);
PUT SKIP EDIT(XKO)(A(5))(TEXT)(A(38))(P4)(PC)(S4)(PC,X(7));
RAD=RAD-1;END;
P3=P3+P4;S3=S3+S4;
P4=0;S4=0;
IF (J¬=K)öSAVD=99 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);
PUT SKIP EDIT(KONTO)(A(5))(TEXT)(A(38))(P3)(PC)(S3)(PC,X(7));
RAD=RAD-1;IF NI>3 THEN DO;PUT SKIP;RAD=RAD-1;END;END;
P2=P2+P3;S2=S2+S3;I=0;
IF J>299&J<340 THEN I=1;IF J>339&J<400 THEN I=2;IF J>399&J<600 THEN I=3;
IF J>599&J<790 THEN I=4;IF J>789&J<800 THEN I=5;IF J>799&J<999 THEN I=6;
IF I¬=0 THEN DO;PU(I)=PU(I)+P3;SU(I)=SU(I)+S3;
END;
P3=0;S3=0;
J=XKO/100;K=SKO/100;IF J¬=KöSAVD=99 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);
PUT SKIP EDIT(KONTO)(A(5))(TEXT)(A(38))(P2)(PC)(S2)(PC,X(7));
RAD=RAD-1;IF NI>2 THEN DO;PUT SKIP;RAD=RAD-1;END;END;
P1=P1+P2;S1=S1+S2;
P2=0;S2=0;SUB=0;TXT=' ';
IF J<34&K>33 THEN DO;TXT='SUMMA FÖRSÄLJNING';SUB=1;END;
IF J>33&J<40&K>39 THEN DO;TXT='SUMMA ÖVRIGA INTÄKTER';SUB=2;END;
IF J>59&J<79&K>78 THEN DO;TXT='SUMMA ÖVRIGA KOSTNADER';SUB=4;END;
IF SUB¬=0 THEN DO;
UT(1)=PU(SUB);UT(2)=SU(SUB);
PUT SKIP EDIT(TXT)(A(43))(UT(1))(PC)(UT(2))(PC)
SKIP;RAD=RAD-2;END;
IF J<79*K>78 THEN DO;
DO JJ=1 TO 5;UT(JJ)=0;END;
DO JJ=1 TO 4;UT(1)=UT(1)+PU(JJ);UT(2)=UT(2)+SU(JJ);
END;
PUT SKIP EDIT('RESULTAT FÖRE AVSKRIVNINGAR')(A(43))(UT(1))(PC)(UT(2))(PC)
SKIP;RAD=RAD-2;END;
IF J<80&K>79 THEN DO;
DO JJ=1 TO 5;UT(JJ)=0;END;
DO JJ=1 TO 5;UT(1)=UT(1)+PU(JJ);UT(2)=UT(2)+SU(JJ);
END;
PUT SKIP EDIT('RESULTAT EFTER AVSKRIVNINGAR')(A(43))(UT(1))(PC)
(UT(2))(PC)SKIP;RAD=RAD-2;END;
IF J<88&K>87 THEN DO;
DO JJ=1 TO 5;UT(JJ)=0;END;
DO JJ=1 TO 6;UT(1)=UT(1)+PU(JJ);UT(2)=UT(2)+SU(JJ);
END;
PUT SKIP EDIT('RESULTAT EFTER FIN. INT. & KOSTNADER')(A(43))(UT(1))(PC)
(UT(2))(PC)SKIP;RAD=RAD-2;END;
J=XKO/1000;K=SKO/1000;IF J¬=KöSAVD=99 THEN GO TO NI1UT;
GO TO ACKUM;
NI1UT:JUMP=1;IF RAD<12 THEN GO TO RUB;READ KEY(J)FILE(KTOTX)INTO(KTO);
PUT SKIP EDIT(KONTO)(A(5))(TEXT)(A(39))(P1)(PCC)(S1)(PCC)SKIP(2);
RAD=RAD-3;
TP=TP+P1;TS=TS+S1;
P1=0;S1=0;
IF SAVD=99 THEN GO TO TOTUT;
GO TO ACKUM;
TOTUT:JUMP=7;IF RAD<14 THEN GO TO RUB;
PUT SKIP(3)EDIT('*** TOTALT')(A(44))(TP)(PCC)(TS)(PCC);
RAD=RAD-3;GO TO SLUT;
UTT:SAVD=99;GO TO NI4UT;
SLUT:PUT SKIP(RAD-5);
SLUTT:CALL LOAD('BOKRUT',6);END;