|
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: 7742 (0x1e3e)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »AKTSAL1«
└─⟦ff53f924a⟧ Bits:30008653 DDMQ1-0093_Nya_bokforingssystemet_II_original
└─⟦this⟧ »AKTSAL1«
/*FÖRSTA RADEN*/
/*AKTSAL GER AKTUELLA SALDON PÅ KONTO:1020,1041,1211,2010,3,TOM ANGIVEN DAG
KLART: 780625 PROGR:TD */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 VER,2 KO FIXED(4),2 AVD FIXED(2),2 PROJ FIXED(4),2 DAT FIXED(4),
2 TYP CHAR(1),2 VERNR FIXED(6),2 BEL FIXED(11,2),2 KOD CHAR(1);
DCL 1 SAM,2 SKO FIXED(4),2 SAVD FIXED(2),2 SPROJ FIXED(4),
2 SAD(12) FIXED(11,2),2 SAK(12) FIXED(11,2);
DCL 1 KTX,2 KSTR,3 KONTO FIXED(4),3 Z CHAR(1),2 K CHAR(4),2 TEXT CHAR(34),
2 IB FIXED(13,2);
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1),2 HUVKOD(12) CHAR(1);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(1),2 XCO FIXED(1),
2 XHUVKOD(12) CHAR(1);
XDAG='XXXXXX ';XMNR=0;
DCL DATFIL FILE,XXMNR FIXED(2),KTOTX FILE,RAD FIXED(2),IND FIXED(1),
S CHAR(1),Q FIXED(1),ADAG FIXED(2),SAMFIL FILE,
XKO FIXED(4),AKO(10) FIXED(4) INIT(1020,1041,1211,2010,3,0,0,0,0,0),
KD FIXED(13,2),KK FIXED(13,2),QKTO BINARY,QSAM BINARY,QVER BINARY,
RECNR BINARY,I BINARY,
JUMP FIXED(1),C CHAR(20) INIT('-------------9V.99'),
KIB FIXED(13,2);
OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO SLUTT;
DO I=1 TO 14;XSK(I)=SK(I);END;XCO=CO;DO I=1 TO 12;XHUVKOD(I)=HUVKOD(I);END;
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** AKTUELLA SALDON ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
PUT FILE(D)SKIP EDIT('KONTOSTÄLLNINGEN SKA AVSE VILKEN DAG I MÅNADEN')
(A(47))(MON)(A(3))('?')(A(22));GET SKIP LIST(ADAG);
PUT FILE(D) SKIP EDIT(' ')(A(42))('*** UTSKRIFT PÅGÅR ***')(A(69));
IND=0;JUMP=0;RAD=5;
I=0;RECNR=0;
RUB:PUT SKIP(RAD)EDIT('AKTUELL SALDOSTÄLLNING ')(A)(ADAG)(A)
(' ')(A)(MON)(A)(',PÅ KONTON:')(A);
DO III=1 TO 10;IF AKO(III)¬=0 THEN PUT EDIT(AKO(III))(A)(',')(A);END;
PUT EDIT(' UTSKRIFTSDATUM:')(A)(DAG)(A(10))SKIP(2)EDIT
('KONTO')(A(8))('BENÄMNING')(A(43))('ING SALDO')(A(15))
('AKT MÅN DEB')(A(17))('AKT MÅN KRE')(A(17))('AKT MÅN SAL')(A(15))
('AKT UTG SALDO')(A)SKIP;
RAD=45;
NY:UNSPEC(SAMFIL)=0;UNSPEC(VERFIL)=0;UNSPEC(KTOTX)=0;
I=I+1;II=1;KD=0;KK=0;KIB=0;QSAM=0;QVER=0;QKTO=0;BEL=0;
DO III=1 TO 12;SAD(III)=0;SAK(III)=0;END;
IF AKO(I)=0 THEN GO TO UT;
IF AKO(I)<1000 THEN DO;
UNSPEC(SAMFIL)=0;UNSPEC(VERFIL)=0;UNSPEC(KTOTX)=0;II=10;
IF AKO(I)<100 THEN II=100;IF AKO(I)<10 THEN II=1000;
KTOIN:ON ENDFILE GOTO SAMIN;READ FILE(KTOTX)INTO(KTX);
IF KONTO<1000 THEN GOTO KTOIN;
J=KONTO/II;IF J¬=AKO(I) THEN GOTO KTOIN;
QKTO=1;
SAMIN:ON ENDFILE GO TO SAMUT1;READ FILE(SAMFIL)INTO(SAM);
J=SKO/II;
IF J¬=AKO(I) THEN GO TO SAMIN;
QSAM=1;
SAMUT1:ON ENDFILE GO TO VERUT1;READ FILE(VERFIL)INTO(VER);
J=KO/II;
IF J¬=AKO(I) THEN GO TO SAMUT1;
QVER=1;
VERUT1:END;
ELSE DO;ON ERROR GO TO SAMUT2;READ KEY(AKO(I))FILE(SAMFIL)INTO(SAM);
QSAM=1;
SAMUT2:KONTO=AKO(I);Z='A';
ON ERROR GOTO KTOUT2;READ KEY(KSTR)FILE(KTOTX)INTO(KTX);
QKTO=1;
KTOUT2:ON ERROR GO TO VERUT2;READ KEY(AKO(I))FILE(VERFIL)INTO(VER);
QVER=1;
VERUT2:END;
ACKSAM:IF QSAM=1 THEN DO III=1 TO MNR-1;KIB=KIB+SAD(III)-SAK(III);END;
ON ENDFILE GO TO ACKVER;READ FILE(SAMFIL)INTO(SAM);
J=SKO/II;IF J¬=AKO(I) THEN GO TO ACKVER;
QSAM=1;GO TO ACKSAM;
ACKVER:XXMNR=MNR-4;IF XXMNR<1 THEN XXMNR=XXMNR+12;
IF QVER=1&((DAT-100*XXMNR)<=ADAG) THEN DO;
IF KOD='D' THEN KD=KD+BEL;IF KOD='K' THEN KK=KK+BEL;
END;
ON ENDFILE GO TO ACKIB;READ FILE(VERFIL)INTO(VER);
J=KO/II;IF J¬=AKO(I) THEN GO TO ACKIB;
QVER=1;GO TO ACKVER;
ACKIB:IF QKTO=1&Z='A' THEN DO;
KIB=KIB+IB;END;
ON ENDFILE GOTO PRT;READ FILE(KTOTX)INTO(KTX);
J=KONTO/II;IF J¬=AKO(I) THEN GOTO PRT;
QKTO=1;GOTO ACKIB;
PRT:KONTO=AKO(I);Z='A';
ON ERROR GO TO EJTXT;READ KEY(KSTR)FILE(KTOTX)INTO(KTX);GO TO KOPRT;
EJTXT:TEXT='*** KONTOT SAKNAS I KONTOPLANEN ';
KOPRT:PUT SKIP EDIT(AKO(I))(P'ZZZZ9 ')(TEXT)(A(35))(KIB)(PC)(KD)(PC)(KK)(PC)
(KD-KK)(PC)(KIB+KD-KK)(PC)SKIP;RAD=RAD-2;
GO TO NY;
UT:PUT SKIP(RAD-5);
SLUTT:CALL LOAD('BOKRUT',6);END;