DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦30fc4bdca⟧ TextFile

    Length: 5088 (0x13e0)
    Types: TextFile
    Notes: Mikados_K
    Names: »LØNLISTE.K«

Derivation

└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
    └─⟦this⟧ »LØNLISTE.K« 

Mikados K File

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.

Full view