|
|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5088 (0x13e0)
Types: TextFile
Notes: Mikados_K
Names: »LØNLISTE.K«
└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
└─⟦this⟧ »LØNLISTE.K«
PROGRAM LØNLISTE;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
VAR PARM:^PARMARRAY;
QUQ:^INTEGER;
FNAVN:STRING;
(*$P*)
PROCEDURE REGVEDL;
CONST MMEDARZ=281;
(*$IISFHEAD*)
MEDARZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MMEDARZ) OF INTEGER
END;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
MEDARPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TTIMER,
PTIMER :REAL;
MEDARBEJDERNR,
TAIJP :INTEGER;
NAVN :PACKED ARRAY (1..30) OF CHAR
END;
SYSPOST=RECORD
MINUTFAKTOR:ARRAY (1..5) OF REAL;
DAT1,DAT2:INTEGER
END;
SYSFILE=FILE OF SYSPOST;
VAR SF:SYSFILE;
LINES,IER:INTEGER;
MAF:ISF;
MAZ:MEDARZONE;
MAPOST:MEDARPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$IPUTGET*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
ICLOSE(MAZ.H,MAF);
EXIT(REGVEDL)
END;
PROCEDURE OFEJL(VAR FIL:FILNAVN);
VAR I:INTEGER;
BEGIN
GOTOXY(1,20);
WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . SITUATIONEN ER FORSØGT REDDET.');
WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');
REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;
IF I<>0 THEN ERROR(FIL);
CLEARSCREEN
END;
(*$P*)
PROCEDURE MAINTAIN;
VAR SUM1,SUM2:REAL;
BEGIN
SUM1:=0.0;SUM2:=0.0;
MAPOST.MEDARBEJDERNR:=0;
NEXTREC(MAZ.H,MAF,MAPOST.A);
IF (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN ERROR(MAZ.H.FILENAME)
ELSE IER:=0;
WHILE IER=0 DO
BEGIN
IF LINES MOD 72=0 THEN
BEGIN
WRITELN(LIST);
WRITELN(LIST);
WRITELN(LIST,'LØNLISTE',' ':54,'Dato',SF^.DAT1*10000.0+SF^.DAT2:8:-2);
WRITELN(LIST);
WRITELN(LIST,'MEDARBEJDER',' ':41,'LØNTIMER PRODUKTIVE');
WRITELN(LIST,'NUMMER',' ':5,'NAVN',' ':54,'TIMER');
LINES:=6
END;
LINES:=LINES+2;
WRITELN(LIST,MAPOST.MEDARBEJDERNR:6,' ':5,MAPOST.NAVN,MAPOST.TTIMER:19:2,
MAPOST.PTIMER:14:2);
WRITELN(LIST);
SUM1:=SUM1+MAPOST.TTIMER;
SUM2:=SUM2+MAPOST.PTIMER;
MAPOST.TTIMER:=0.0;
MAPOST.PTIMER:=0.0;
PUTREC(MAZ.H,MAF,MAPOST.A);
IF IER<>0 THEN ERROR(MAZ.H.FILENAME);
NEXTREC(MAZ.H,MAF,MAPOST.A)
END;
IF (IER<>-2) AND (IER<>-9) THEN ERROR(MAZ.H.FILENAME);
WRITELN(LIST,'SUM',' ':45,SUM1:12:2,SUM2:14:2)
END;
(*$P*)
BEGIN
CLEARSCREEN;
FNAVN:='SYSREG:P2:1:I';
REWRITE(SF,FNAVN);
SEEK(SF,1);
GET(SF);
MAZ.H.FILENAME:='MEDARREG';
FNAVN:='MEDARREG:P2:0000:I';
REWRITE(MAF,FNAVN);
IOPEN(MAZ.H,MAF,SKRIV);IF IER<>0 THEN OFEJL(MAZ.H.FILENAME);
LINES:=72;
MAINTAIN;
PAGE(LIST);
ICLOSE(MAZ.H,MAF);
WRITELN('ICLOSE ',IER)
END;
(*$P*)
BEGIN
REGVEDL;
FNAVN:=' ';
FNAVN(1):=PARM^(1);
CHAIN('L *1',CONCAT('HOVED:P2,',FNAVN),QUQ);
IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.