DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »RYDOP.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »RYDOP.K« 

Mikados K File

PROGRAM OPRYD;
 
CONST  DK=8;
(*$IISFHEAD*)
POSTPOST=RECORD
       A:AR;
      (*KNR1-2,DATO1-2,TEKSTKODE,BILAGSNR1-2*) HELTAL:ARRAY(1..7) OF INTEGER;
      (*BELØB,RESTBELØB*) REEL:ARRAY (1..2) OF REAL
END;
POSTZONE=RECORD
       H:ISFHEAD;
       T:ARRAY (1..508) OF INTEGER
END;
SYSPOST=RECORD
       HELTAL:ARRAY (1..24) OF INTEGER;
       KGB:ARRAY (1..5) OF REAL;
       BETADAT:PACKED ARRAY (1..13) OF CHAR;
       KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR
END;
SYSFILE=FILE OF SYSPOST;
VAR    FPOST:ISF;
       SYSFIL:SYSFILE;
       PZ:POSTZONE;
       PPOST:POSTPOST;
       FILNAVN2:STRING(20);
       IER,I:INTEGER;
       R1,R2,R,TOTAL:REAL;
       SUPASSED:BOOLEAN;
 
(*$L-*)
(*$R-,IIOPEN*)
(*$IEXCOMCOP*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IICLOSE*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I POSTERINGSREG ',IER);
  ICLOSE(PZ.H,FPOST);
  WRITELN('ICLOSE ',IER);
  I:=I DIV 0
END;
BEGIN
  FILNAVN2:='POSTREG:P2:0000:I';
  REWRITE(FPOST,FILNAVN2);
  IOPEN(PZ.H,FPOST,SKRIV);
  IF IER<>0 THEN ERROR;
  FILNAVN2:='SYSREG:P2:1:I';
  RESET(SYSFIL,FILNAVN2);
  SEEK(SYSFIL,1);
  GET(SYSFIL);
  CLOSE(SYSFIL);
  R:=365.0*SYSFIL^.HELTAL(1)+30.0*(SYSFIL^.HELTAL(2) DIV 100) +
     (SYSFIL^.HELTAL(2) MOD 100)-60.0;
  FOR I:=1 TO 7 DO PPOST.HELTAL(I):=0;
  NEXTREC(PZ.H,FPOST,PPOST.A);
  IF IER<>-1 THEN ERROR;IER:=0;
  R1:=0.0;
  WHILE IER=0 DO
  WITH PPOST DO
  BEGIN
    R2:=HELTAL(1)*10000.0+HELTAL(2);
    IF R1<>R2 THEN BEGIN R1:=R2;SUPASSED:=FALSE END;
    IF HELTAL(5)=10 THEN SUPASSED:=TRUE;
    TOTAL:=365.0*HELTAL(3)+30.0*(HELTAL(4) DIV 100)+(HELTAL(4) MOD 100);
    IF (REEL(2)=0.0) AND (TOTAL<=R) AND (NOT SUPASSED) THEN
    BEGIN
      WRITELN(LIST,HELTAL(1)*10000.0+HELTAL(2):10:-2,
                   HELTAL(3)*10000.0+HELTAL(4):14:-2,
                   HELTAL(6)*10000.0+HELTAL(7):14:-2);
      DELETE(PZ.H,FPOST,PPOST.A)
    END
    ELSE
      NEXTREC(PZ.H,FPOST,PPOST.A)
  END;
  IF IER<>-2 THEN ERROR;
  ICLOSE(PZ.H,FPOST);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER:5,I:7);
END.