|
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: 5372 (0x14fc)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »PRSLUT1«
└─⟦ff53f924a⟧ Bits:30008653 DDMQ1-0093_Nya_bokforingssystemet_II_original
└─⟦this⟧ »PRSLUT1«
/*FÖRSTA RADEN*/
/*PRSLUT AVSLUTNING AV VISSA 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 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,S CHAR(1),RAD FIXED(2),SIDA FIXED(4),IND FIXED(1),
XPROJ FIXED(4),XKO FIXED(4),XAVD FIXED(2),XDAT FIXED(4),PD(12) FIXED(13,2),
PK(12) FIXED(13,2),AD FIXED(13,2),AK FIXED(13,2),KD FIXED(13,2),KK FIXED(13,2),
TD FIXED(13,2),TK FIXED(13,2),RECNR BINARY,
JUMP FIXED(1),C CHAR(20) INIT('--------------9V.99'),
CC CHAR(20)INIT('-----------9V.99***'),
CCC CHAR(20)INIT('-------------9V.99*'),
Q FIXED(1),SAMFIL FILE,KIB FIXED(13,2),I BINARY,J BINARY,PR(100) FIXED(4);
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;XSK(13)=' ';XCO=CO;
DO I=1 TO 12;XHUVKOD(I)=HUVKOD(I);END;
REWRITE FILE(DATFIL)FROM(XDATREC);
PUT FILE(D) SKIP EDIT(' ')(A(37))('*** AVSLUTNING AV VISSA PROJEKT ***')
(A(74))('STÄLL IN PERFORERINGEN')(A(37))('TRYCK SEDAN RETURN.')(A(37));
GET SKIP LIST(S);PUT FILE(D)SKIP;
I=1;DO J=1 TO 100;PR(J)=0;END;
TAB:PUT FILE(D)SKIP EDIT('VILKA PROJEKTNUMMER SKA AVSLUTAS?')(A(37))
('TRYCK RETURN EFTER VARJE,')(A(74))
('EFTER DET SISTA SKA DU')(A(37))('TRYCKA PÅ F7 ISTÄLLET.')(A(70));
PRNR:GET SKIP LIST(PR(I));
IF PR(I)<=0 THEN CALL OUTPUT(1,6);
IF PR(I)<=0 THEN GO TO PRNR;I=I+1;
CALL KEYFUN(J);IF J¬=23&I<100 THEN GO TO PRNR;
JUMP=0;RAD=5;SIDA=0;IND=1;I=0;J=0;
RUB:SIDA=SIDA+1;PUT SKIP(RAD)EDIT('AVSLUTNING AV VISSA PROJEKT')(A)
(' DATUM:')(A)(DAG)(A(10))('SIDA:')(A)(SIDA)(A)SKIP(2)EDIT
('PROJEKT NUMMER AVSLUTAT OCH ACKUMULERAT I PROJEKT "9998"')(A)
SKIP;RAD=45;
IF JUMP=1 THEN GO TO PRFEL;IF JUMP=2 THEN GO TO SKRIV;
ST:Q=0;I=I+1;IF I>100 THEN GO TO UT;SPROJ=PR(I);
IF PR(I)<=0öPR(I)>9997 THEN GO TO ST;
MER:SPROJ=PR(I);
ON ERROR GO TO PRFEL;READ KEY(PR(I))FILE(SAMFIL)INTO(SAM)KEYTO(SPROJ);
Q=1;XKO=SKO;SKO=9999;SPROJ=-1;
DO II=1 TO 12;PD(II)=SAD(II);PK(II)=SAK(II);END;
REWRITE FILE(SAMFIL)FROM(SAM);
SKO=XKO;SPROJ=9998;
ON ERROR GO TO WR;READ KEY(SSTR)FILE(SAMFIL)INTO(SAM);
DO II=1 TO 12;SAD(II)=SAD(II)+PD(II);SAK(II)=SAK(II)+PK(II);END;
REWRITE FILE(SAMFIL)FROM(SAM);
GO TO MER;
WR:DO II=1 TO 12;SAD(II)=PD(II);SAK(II)=PK(II);END;
UNSPEC(SAMFIL)=0;CALL SEOF(SAMFIL);
WRITE FILE(SAMFIL)FROM(SAM);
CLOSE SAMFIL;OPEN SAMFIL;
GO TO MER;
PRFEL:IF Q=1 THEN GO TO SKRIV;
JUMP=1;IF RAD<12 THEN GO TO RUB;
PUT SKIP EDIT(PR(I))(P'ZZZZZZ9',X(20))('FINNS EJ REGISTRERAT')(A)SKIP;
RAD=RAD-2;GO TO ST;
SKRIV:JUMP=2;IF RAD<12 THEN GO TO RUB;
PUT SKIP EDIT(PR(I))(P'ZZZZZZ9',X(20))('*** AVSLUTAT ***')(A)SKIP;
RAD=RAD-2;GO TO ST;
UT:PUT SKIP(RAD-5);
CALL TYPIST('SORT SAMFIL SAMSORT KLIPP ',26);
SLUT:CALL TYPIST('BOKRUT┣0d┫',7);END;