|
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: 4266 (0x10aa)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BUDGUT1«
└─⟦2d3ae9df8⟧ Bits:30008654 DDMQ1-0094_Nya_bokforingssystemet_I_LMC_MSAB_COPY_Skriv_BOKRUT_780220_TD
└─⟦this⟧ »BUDGUT1«
/*FÖRSTA RADEN*/
/*BUDGUT UTSKRIFT AV BUDGET
KLART: XXXXXX PROGR:TD */
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD FIXED(2),3 SSTR2,4 SPROJ FIXED(4),
4 SMNR FIXED(2),4 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,BUDSUM FIXED(7,1),
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(2) BINARY,
JUMP FIXED(1),C CHAR(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
KOSVAR CHAR(4),KIB FIXED(12,2);
OPEN DATFIL;OPEN SAMFIL;
READ FILE(DATFIL)INTO(DATREC);IF DAG='XXXXXX' THEN GO TO SLUT;
DO I=1 TO 14;XSK(I)=SK(I);END;
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** UTSKRIFT AV BUDGET ***')
(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));
KIB=0;RECNR(1)=-1;RECNR(2)=0;JUMP=0;RAD=5;SIDA=0;IND=1;
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('UTSKRIFT AV BUDGET 1000-TAL 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;RAD=45;
IF JUMP=0 THEN GO TO ST;IF JUMP=1 THEN GO TO FLER;
ST:JUMP=0;IF RAD<12 THEN GO TO RUB;
ON ERROR GO TO UT;READ KEY('B')FILE(SAMFIL)INTO(SAM)KEYTO(BUD);
KOSVAR=SKO;IF RECNR(1)>=UNSPEC(SAMFIL) THEN GO TO UT;RECNR(1)=UNSPEC(SAMFIL);
FLER:/*OM FLERA AVD-BUDGETAR PÅ SAMMA KONTO*/
JUMP=1;IF RAD<12 THEN GO TO RUB;
PUT SKIP EDIT(SKO)(A(6))(SAVD)(P'Z9',X(1));RAD=RAD-1;KIB=0;
DO I=1 TO 12;BUDSUM=(SAD/1000-SAK/1000);
IF VERIFY(SUBSTR(KOSVAR,1,1),'3')THEN BUDSUM=-BUDSUM;
PUT EDIT(BUDSUM)(P'------9V.9');KIB=KIB+BUDSUM;
IF I<12 THEN DO;SMNR=I+1;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);END;END;
PUT EDIT(KIB)(P'--------9V.9');
IF VERIFY(SUBSTR(KOSVAR,1,1),'3') THEN PUT EDIT(' KRE')(A);
ELSE PUT EDIT(' DEB')(A);
RECNR(2)=UNSPEC(SAMFIL);
UNSPEC(SAMFIL)=RECNR(1);XKO=SKO;XAVD=SAVD;SPROJ=0;SMNR=1;BUD='B';
READ KEY(SSTR2)FILE(SAMFIL)INTO(SAM)KEYTO(SSTR2);IF SAVD>XAVD&SKO=XKO THEN DO;
RECNR(1)=UNSPEC(SAMFIL);GO TO FLER;END;
ELSE DO;UNSPEC(SAMFIL)=RECNR(2);GO TO ST;END;
UT:PUT SKIP(RAD-5);
SLUT:CALL TYPIST('BOKRUT┣0d┫',7);END;