|
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: 5767 (0x1687)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BUDGIN1«
└─⟦7bb65a061⟧ Bits:30008625 DDMQ1-0065_Reflex_MSAB_Bokf_system_diskett_1_2_Sid2_Alla_pgm_PL1_781120_side0
└─⟦this⟧ »BUDGIN1«
└─⟦cfd478037⟧ Bits:30008627 DDMQ1-0066_MSAB_ref_ex_Bokf_system_NFK_diskett_2_2_781120_side0
└─⟦this⟧ »BUDGIN1«
/*FÖRSTA RADEN*/
/*BUDGIN UPPLÄGGNING AV BUDGET GENERELLT PGM.
KLART: 781104 PROGR:TD */
DCL 1 KTO,2 BSTR,3 KONTO FIXED(4),3 XZ CHAR(1),3 KAVD CHAR(3),
2 KBUD(12) FIXED(7);
DCL 1 KTX,2 KSTR,3 KO FIXED(4),3 Z CHAR(1),2 KKK 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,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
STM FIXED(2),BUDSUM(12) FIXED(7,1),REW FIXED(1),KOSVAR CHAR(4),
XKO FIXED(4),XAVD CHAR(3),
RECNR BINARY,
JUMP FIXED(1),C CHAR(19)INIT('--------------9V.99'),
CC CHAR(19)INIT('-----------9V.99***'),
CCC CHAR(19)INIT('-------------9V.99*'),
DAG CHAR(6),T FIXED(9),KIB FIXED(13,2),I BINARY,J BINARY;
OPEN KTOTX;OPEN DATFIL;
READ FILE(DATFIL)INTO(DATREC);IF XDAG='XXXXXX' THEN GO TO SLUT;
DAG=XDAG;XDAG='XXXXXX';SK(14)=' ';
REWRITE FILE(DATFIL)FROM(DATREC);
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);PUT FILE(D)SKIP;
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)
(' (kkr) 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 (KONTO<3000)ö(KONTO>8999) THEN GO TO FEL;
IF REW=0 THEN OPEN KTOTX;
KO=KONTO;Z='A';
ON ERROR GO TO FEL;READ KEY(KSTR)FILE(KTOTX)INTO(KTX);
PUT FILE(D)EDIT(TEXT)(A(37))
('AVDELNING (RETURN OM INGEN):')(A(34));
AVDIN:GET SKIP LIST(KAVD);
KIB=0;REW=0;PUT FILE(D)EDIT(KAVD)(A(3))
('FR.O.M MÅNAD NR:(1=JULI):')(A(35));GET SKIP LIST(STM);
PUT FILE(D)EDIT(STM)(A(2));IF STM<1öSTM>12 THEN GO TO ST;
XZ='B';
ON ERROR GO TO WR;READ KEY(BSTR)FILE(KTOTX)INTO(KTO);REW=1;
WR:IF REW=0 & STM¬=1 THEN GO TO ST;
PUT EDIT(KONTO)(A(6))(KAVD)(A(3));
IF REW=0 THEN DO;UNSPEC(KTOTX)=0;CALL SEOF(KTOTX);END;
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));PUT FILE(D)SKIP;
T=10*BUDSUM(I);IF BUDSUM(I)=T/10 THEN GO TO BELOK;CALL OUTPUT(1,6);GOTO BELIN;
BELOK:
PUT EDIT(BUDSUM(I))(P'------9V.9');
IF VERIFY(SUBSTR(KOSVAR,1,1),'3') THEN KBUD(I)=-BUDSUM(I)*10;
ELSE KBUD(I)=BUDSUM(I)*10;END;
IF REW=0 THEN DO;XZ='B';WRITE FILE(KTOTX)FROM(KTO);CLOSE KTOTX;END;
ELSE DO;REWRITE FILE(KTOTX)FROM(KTO);END;
KIB=0;
DO I=1 TO 12;
KIB=KIB+KBUD(I)/10;
END;
J=KONTO/1000;IF J=3 THEN KIB=-KIB;
PUT EDIT(KIB)(P'--------9V.9');
IF J=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('KTO ')(A)(KONTO)(A(5))('SAKNAS,ELLER BUDGETERAS EJ')
(A(28))('FÖRSÖK IGEN:')(A(33));GO TO KTOIN;
UT:PUT SKIP(RAD-5);
SLUT:CALL LOAD('BOKRUT',6);END;