|
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: 4977 (0x1371)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »IBALIN1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »IBALIN1«
/*FÖRSTA RADEN*/
/*IBALIN INMATNING AV INGÅENDE BALANSER
KLART: XXXXXX PROGR:TD */
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD FIXED(2),3 SPROJ FIXED(4),
3 SMNR FIXED(2),3 BUD CHAR(1),
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);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(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),
XPROJ FIXED(4),XKO FIXED(4),XAVD FIXED(2),XDAT FIXED(4),BEL FIXED(12,2),
JUMP FIXED(1),C CHAR(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
KIB FIXED(12,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;XSK(13)=' ';
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('** INMATNING AV INGÅENDE BALANSER **')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
RAD=5;SIDA=0;IND=1;SMNR=0;BUD=' ';SAVD=0;SPROJ=0;HJKOD=' ';
PUT FILE(D)SKIP EDIT('(FRÅN BÖRJAN TRYCK BARA RETURN)')(A(37))
('KONTO:')(A(33));
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('INMATNING 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;IF IND THEN GO TO KOIN;GO TO PRT;
ST:PUT FILE(D) SKIP EDIT('KONTO:')(A(37))('(OM LÖPANDE TRYCK RETURN)')(A(33));
KOIN:IND=0;GET SKIP LIST(SVAR);
KOIN2:IF SVAR='SLUT' THEN GO TO UT;
IF SVAR=' ' THEN IND=1;ELSE XKO=SVAR;
IF IND=0&SUBSTR(SVAR,4,1)=' ' THEN GO TO FEL;
IN:IF IND THEN DO;PUT FILE(D)SKIP EDIT('OK! VÄNTA.')(A(37));
TEST:ON ENDFILE GO TO UT;READ FILE(KTOTX)INTO(KTO);
IF KONTO<1000 THEN GO TO TEST;
PUT FILE(D)SKIP EDIT('KONTO:')(A(33))(KONTO)(A(4));END;
ELSE DO;PUT FILE(D)EDIT(XKO)(A(4));
ON ERROR GO TO FEL;READ KEY(XKO)FILE(KTOTX)INTO(KTO);END;
PUT FILE(D)EDIT(TEXT)(A(37))('ING.BALANS:')(A(24));GET SKIP LIST(BEL);
PUT FILE(D)EDIT(BEL)(P'---------9V.99');
PRT:IF RAD<12 THEN GO TO RUB;
PUT SKIP EDIT(KONTO)(A(7))(TEXT)(A(38))(BEL)(PC);RAD=RAD-1;
SKO=KONTO;SAVD=0;SPROJ=0;SMNR=0;BUD=' ';
ON ERROR GO TO WR;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
PUT EDIT(' ÄNDRAD FRÅN:')(A)(SAD-SAK)(P'---------9V.99');
SAD=0;SAK=0;HJKOD=' ';IF BEL<0 THEN SAK=-BEL;ELSE SAD=BEL;
REWRITE FILE(SAMFIL)FROM(SAM);GO TO ST;
WR:SAD=0;SAK=0;HJKOD=' ';
IF BEL<0 THEN SAK=-BEL;ELSE SAD=BEL;
CALL SEOF(SAMFIL);WRITE FILE(SAMFIL)FROM(SAM);CLOSE SAMFIL;OPEN SAMFIL;
GO TO ST;
FEL:IND=0;PUT FILE(D)SKIP EDIT('KONTO:')(A)(XKO)(A(5))('FINNS EJ.')(A(26))
('FÖRSÖK IGEN:')(A(33));GET SKIP LIST(SVAR);XKO=SVAR;IF SUBSTR(SVAR,4,1)=' '
THEN GO TO FEL;GO TO KOIN2;
UT:PUT SKIP(RAD-5);
SLUT:CALL TYPIST('BOKRUT┣0d┫',7);END;