|
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: 3634 (0xe32)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »IBALUT1«
└─⟦1f3202981⟧ Bits:30008731 DDMQ1-0173_MSAB_Bokföring_Alla_Program_i_PL1_ref_ex_780428
└─⟦this⟧ »IBALUT1«
/*FÖRSTA RADEN*/
/*IBALUT UTSKRIFT AV INGÅENDE BALANSER
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 CO FIXED(1);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(1),2 XCO FIXED(1);
XDAG='XXXXXX ';XMNR=0;
DCL DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
SAMFIL FILE,SVAR CHAR(4),REC BINARY,
XPROJ FIXED(4),XKO FIXED(4),XAVD FIXED(2),XDAT FIXED(4),BEL FIXED(13,2),
JUMP FIXED(1),C CHAR(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
TIB FIXED(13,2);
OPEN DATFIL;OPEN KTOTX;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO SLUT;
DO I=1 TO 14;XSK(I)=SK(I);END;XCO=CO;
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** UTSKRIFT AV INGÅENDE BALANSER ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
PUT FILE(D)SKIP EDIT(' ')(A(43))('*** UTSKRIFT PÅGÅR ***')(A(68));
TIB=0;RAD=5;SIDA=0;IND=1;REC=0;
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('UTSKRIFT AV INGÅENDE BALANSER.')(A(40))
('DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('KONTO')(A(7))('BENÄMNING')(A(38))('ING. BALANS VID ÅRETS BÖRJAN')(A)SKIP;
RAD=45;
ST:ON ERROR GO TO UT;READ KEY(0)FILE(SAMFIL)INTO(SAM)KEYTO(SMNR);
IF UNSPEC(SAMFIL)<REC THEN GO TO UT;ELSE REC=UNSPEC(SAMFIL);
IF SKO<1000 THEN GO TO ST;
PUT SKIP EDIT(SKO)(A(7));
ON ERROR GO TO TXFEL;READ KEY(SKO)FILE(KTOTX)INTO(KTO);GO TO KOOK;
TXFEL:TEXT='*** SAKNAS I KONTOPLANEN ***';
KOOK:PUT EDIT(TEXT)(A(38))(SAD-SAK)(P'---------9V.99');RAD=RAD-1;
TIB=TIB+SAD-SAK;
IF RAD<12 THEN GO TO RUB;GO TO ST;
UT:PUT SKIP(2)EDIT('*** TOTAL INGÅENDE BALANS:')(A)(TIB)(PCC)SKIP(RAD-7);
SLUT:CALL TYPIST('BOKRUT┣0d┫',7);END;
SLUT:CALL LOAD('BOKRUT',6);END;