|
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: 6399 (0x18ff)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BUDGIN1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »BUDGIN1«
/*FÖRSTA RADEN*/
/*BUDGIN UPPLÄGGNING AV BUDGET
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,STM FIXED(2),BUDSUM(12) FIXED(7,1),REW FIXED(1),KOSVAR CHAR(4),
XPROJ FIXED(4),XKO FIXED(4),XAVD FIXED(2),XDAT FIXED(4),PD FIXED(12,2),
PK FIXED(12,2),AD FIXED(12,2),AK FIXED(12,2),KD FIXED(12,2),KK FIXED(12,2),
TD FIXED(12,2),TK FIXED(12,2),REG FIXED(1),DEL FIXED(1),RECNR BINARY,
JUMP FIXED(1),C CHAR(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
T FIXED(9),KIB FIXED(12,2);
OPEN KTOTX;OPEN DATFIL;
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))('*** UPPLÄGGNING AV BUDGET ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
JUMP=0;RAD=5;SIDA=0;IND=1;REW=0;
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('UPPLÄGGNING AV BUDGET,TUSENTAL KRONOR')(A)
(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('KTO')(A(5))('AVD')(A(6))('MÅNAD 1')(A(7));DO I=2 TO 12;PUT EDIT(I)
(P'ZZZZZZZZ9');END;PUT EDIT(' TOT')(A)SKIP(2);RAD=44;
ST:PUT FILE(D) SKIP EDIT('KONTO:')(A(33));
KTOIN:GET SKIP LIST(KOSVAR);PUT FILE(D) EDIT(KOSVAR)(A(4));
IF KOSVAR='SLUT' THEN GO TO UT;KONTO=KOSVAR;
IF(SUBSTR(KOSVAR,1,1)='2')ö((SUBSTR(KOSVAR,1,1)='1')&(KONTO¬=1210))
ö(KONTO<1000)ö(KONTO>8999) THEN GO TO FEL;
IF REW=0 THEN OPEN SAMFIL;
ON ERROR GO TO FEL;READ KEY(KONTO)FILE(KTOTX)INTO(KTO);SKO=KONTO;
PUT FILE(D) EDIT('AVDELNING (0 OM INGEN):')(A(35));GET SKIP LIST(SAVD);
AVDTEST:IF SKO<3000&SKO¬=1210&SAVD¬=0 THEN GO TO FELAVD;
IF SKO=1210&SAVD=0 THEN GO TO FELAVD;
IF SKO¬=1210 THEN SPROJ=0;ELSE SPROJ=9999;
BUD='B';KIB=0;REW=0;XAVD=SAVD;PUT FILE(D)EDIT(SAVD)(A(2))
('FR.O.M MÅNAD NR:(1=JAN):')(A(35));GET SKIP LIST(STM);
PUT FILE(D)EDIT(STM)(A(2));IF STM<1öSTM>12 THEN GO TO ST;
SMNR=STM;ON ERROR GO TO WR;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);REW=1;
WR:IF REW=0 & SMNR¬=1 THEN GO TO ST;
PUT EDIT(KONTO)(A(6))(SAVD)(P'Z9',X(1));
HJKOD=' ';
IF REW=0 THEN CALL SEOF(SAMFIL);
PUT FILE(D)SKIP EDIT('ANGE I 1000-TAL KR,MED EN DECIMAL:')(A(37));
DO I=1 TO STM-1;PUT EDIT(' ')(A(9));END;
DO I=STM TO 12;PUT FILE(D) EDIT('BUDGET MÅNAD')(A(13))(I)(A(17));
BELIN:GET SKIP LIST(BUDSUM(I));
T=10*BUDSUM(I);IF BUDSUM(I)¬=T/10 THEN GO TO BELIN;KIB=KIB+BUDSUM(I);
PUT EDIT(BUDSUM(I))(P'------9V.9');
PUT FILE(D) SKIP;
IF VERIFY(SUBSTR(KOSVAR,1,1),'3') THEN DO;SAD=0;SAK=BUDSUM(I)*1000;END;
ELSE DO;SAD=BUDSUM(I)*1000;SAK=0;END;
SMNR=I;
IF REW=0 THEN DO;WRITE FILE(SAMFIL)FROM(SAM);END;
ELSE DO;REWRITE FILE(SAMFIL)FROM(SAM);
IF I<12 THEN DO;SMNR=I+1;
ON ERROR GO TO FELUT;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);END;END;END;
IF REW=0 THEN CLOSE SAMFIL;
PUT EDIT(KIB)(P'--------9V.9');
IF VERIFY(SUBSTR(KOSVAR,1,1),'3') THEN PUT EDIT(' KRE')(A)SKIP;
ELSE PUT EDIT(' DEB')(A)SKIP;RAD=RAD-1;
IF RAD<12 THEN GO TO RUB;GO TO ST;
FEL:CALL OUTPUT(1,6);
PUT FILE(D)SKIP EDIT('KONTO ')(A)(KONTO)(A(5))('BUDGETERAS EJ')(A(26))
('FÖRSÖK IGEN:')(A(33));GO TO KTOIN;
FELAVD:CALL OUTPUT(1,6);PUT FILE(D)SKIP EDIT('FEL!')(A(37))('KONTO ')(A)
(SKO)(A(5))('BUDG. EJ PÅ AVD. ')(A)(SAVD)(A(9))('ANGE NY AVDELNING:')(A(35));
GO TO AVDTEST;
FELUT:PUT SKIP EDIT('BUDGET SAKNAS FÖR MÅNAD ')(A)(I)(A)('. RÄTTA OCH KÖR ')
(A)('EN GÅNG TILL.')(A(40));
DO JJ=1 TO 6;CALL OUTPUT(1,6);DO KK=1 TO 200;END;END;
UT:PUT SKIP(RAD-5);
SLUT:CALL TYPIST('BOKRUT┣0d┫',7);END;