|
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: 5056 (0x13c0)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »PROJRED1«
└─⟦ff53f924a⟧ Bits:30008653 DDMQ1-0093_Nya_bokforingssystemet_II_original
└─⟦this⟧ »PROJRED1«
/*FÖRSTA RADEN*/
/*PROJRED REDOVISNING AV PROJEKT
KLART: 780531 PROGR:TD */
DCL 1 SAM,2 SSTR,3 SKO FIXED(4),3 SAVD FIXED(2),3 SPROJ FIXED(4),
2 SAD(12) FIXED(11,2),2 SAK(12) FIXED(11,2);
DCL 1 KTO,2 KSTR,3 KONTO FIXED(4),3 Z CHAR(1),2 K CHAR(4),2 TEXT CHAR(34),
2 IB FIXED(13,2);
DCL 1 DATREC,2 DAG CHAR(6),2 MON CHAR(3),2 MNR FIXED(2),2 SK(14) CHAR(1),
2 CO FIXED(1),2 HUVKOD(12) CHAR(1);
DCL 1 XDATREC,2 XDAG CHAR(9),2 XMNR FIXED(2),2 XSK(14) CHAR(1),2 XCO FIXED(1),
2 XHUVKOD(12) CHAR(1);
XDAG='XXXXXX ';XMNR=0;
DCL DATFIL FILE,KTOTX FILE,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
Q FIXED(1),XPROJ FIXED(4),XKO FIXED(4),XAVD FIXED(2),XM FIXED(2),
JUMP FIXED(1),C CHAR(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
SAMFIL FILE,PS FIXED(13,2),TV FIXED(13,2),MX FIXED(1);
OPEN KTOTX;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;XCO=CO;DO I=1 TO 12;XHUVKOD(I)=HUVKOD(I);END;
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** PROJEKTREDOVISNING ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);
PUT FILE(D)SKIP EDIT(' ')(A(37)) (' *** UTSKRIFT PÅGÅR ***')(A(74));
Q=1;JUMP=0;RAD=5;SIDA=0;IND=1;KS=0;PS=0;TV=0;
GO TO ST;
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('PROJEKTREDOVISNING AKTUELLA PROJEKT')(A)
(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('PROJ.NR')(A(11))('AVD')(A(5))('KONTO')(A(8))('BENÄMNING')
(A(37))('MÅNAD')(A(17))('ACK. SALDO')(A(24))('VINST')(A)SKIP;RAD=45;
IF JUMP=1 THEN GO TO KOUT;IF JUMP=2 THEN GO TO PROJUT;
ST:ON ENDFILE GO TO SISTA;READ FILE(SAMFIL)INTO(SAM);
IF SPROJ=0öSKO<3000 THEN GO TO ST;
IF IND=1 THEN DO;XPROJ=SPROJ;XKO=SKO;XAVD=SAVD;END;
IND=0;
IF SPROJ¬=XPROJ THEN GO TO PROJUT;
KOUT:JUMP=1;IF RAD<13 THEN GO TO RUB;XKO=SKO;XPROJ=SPROJ;XAVD=SAVD;
KONTO=XKO;Z='A';
ON ERROR GO TO FELKO;READ KEY(KSTR)FILE(KTOTX)INTO(KTO);GO TO KOOK;
FELKO:TEXT='*** FINNS EJ I KONTOPLANEN ***';
KOOK:IF Q=1 THEN PUT SKIP EDIT(XPROJ)(P'ZZZZZZ9');
ELSE PUT SKIP EDIT(' ')(A(7));
Q=0;RAD=RAD-1;
PUT EDIT(XAVD)(P'ZZZZZZ9')(XKO)(P'ZZZZZZ9 ')(TEXT)(A(38));
MX=0;
DO I=1 TO 12;IF SAD(I)¬=0öSAK(I)¬=0 THEN DO;
IF MX=1 THEN PUT SKIP EDIT('')(A(62));
MX=1;
PUT EDIT(I)(P'ZZZ9 ')(SAD(I)-SAK(I))(PC);PS=PS+SAD(I)-SAK(I);END;END;
GO TO ST;
PROJUT:IF XPROJ=0&SPROJ=-9999 THEN GO TO UT;
JUMP=2;IF RAD<12 THEN GO TO RUB;
PUT SKIP EDIT(XPROJ)(P'ZZZZZZ9')(' TOTALT HELA PROJEKTET')(A(64))
(PS)(PCCC)(-PS)(PC)SKIP;
TV=TV-PS;PS=0;
Q=1;RAD=RAD-2;
IF SPROJ=-9999 THEN GO TO UT;
GO TO KOUT;
SISTA:SPROJ=-9999;GO TO PROJUT;
UT:PUT SKIP(3)EDIT(' **** TOTALT ALLA PROJEKT')(A(92))(TV)(PCC)SKIP(RAD-8);
SLUT:CALL LOAD('BOKRUT',6);END;