|
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: 7979 (0x1f2b)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »AKTSAL1«
└─⟦d4a65d31f⟧ Bits:30008722 DDMQ1-0163_MSAB_Bokf_pgm_i_PL1_781112_TD
└─⟦this⟧ »AKTSAL1«
/*FÖRSTA RADEN*/
/*AKTSAL GER AKTUELLA SALDON PÅ KONTO:1020,1041,1211,2010,3,TOM ANGIVEN DAG
DESSA KONTONR ANGES MED "INIT"-SATS NEDAN OCH KAN ÄNDRAS TILL VILKA
NUMMER SOM HELST,MED 1-4 SIFFROR.
GENERELLT PGM. KLART: 781104 PROGR:TD */
DCL VERFIL FILE;CALL KFILE(VERFIL);
DCL 1 VER,2 KO FIXED(4),2 AVD CHAR(3),2 DAT FIXED(4),
2 VERNR FIXED(7),2 VTXT CHAR(20),2 BEL FIXED(11,2),2 KOD CHAR(1);
DCL 1 SAM,2 SKO FIXED(4),2 SAVD CHAR(3),
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 XDAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1);
DCL DATFIL FILE,XXMNR FIXED(2),KTOTX FILE,RAD FIXED(2),IND FIXED(1),
DAG CHAR(6),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,MS FIXED(13,2),US FIXED(13,2),
JUMP FIXED(1),C CHAR(18)INIT('-------------9V.99'),
KIB FIXED(13,2);
OPEN KTOTX;OPEN DATFIL;OPEN VERFIL;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))('*** 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-0;IF XXMNR<1 THEN XXMNR=XXMNR+12;
/*HÄR LÄGGES BOKFÖRINGSÅRETS "OFFSET" IN. 1:A MÅNAD=JUL T.EX GER EN SEXA*/
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:MS=KD-KK;US=KIB+KD-KK;
IF AKO(I)*II>2999 THEN DO;KIB=-KIB;MS=-MS;US=-US;END;
PUT SKIP EDIT(AKO(I))(P'ZZZZ9 ')(TEXT)(A(35))(KIB)(PC)(KD)(PC)(KK)(PC)
(MS)(PC)(US)(PC)SKIP;RAD=RAD-2;
GO TO NY;
UT:PUT SKIP(RAD-5);
SLUTT:CALL LOAD('BOKRUT',6);END;