DataMuseum.dk

top - download

    Length: 12640 (0x3160)
    Types: TextFile
    Notes: Mikados_K
    Names: »NULVAR.K«

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

Mikados K File

PROGRAM VAREVEDL;
(*$IISFHEAD*)
VPOST=RECORD
       A:AR;
       VARENR1,VARENR2,LVRNDØR,OPRLAND,PAKENHED,
       FORVLEVU,DATSBES1,DATSBES2,DATSORD1,DATSORD2,
       DÆKGRASÅ,ANAFTILG:INTEGER;
       NAVN:ARRAY(1..2) OF PACKED ARRAY (1..30) OF CHAR;
       PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
       RAIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD:REAL
END;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..451) OF INTEGER
 END;
VAR    F:ISF;
       VZ:ZONE;
       FILNAVN2:STRING(20);
      IER,I:INTEGER;
       VARE:VPOST;
(*$L-,R-,IIOPEN*)
(*$IEXCOMCOP*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$INEXTREC*)
(*$L+,R+*)
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
PROCEDURE ZERREC;
BEGIN
  WITH VARE DO
  BEGIN
       PRIMOLAG:=FYSLAGER;
       ASOLGTSÅ:=ASOLGTIÅ;
       ASOLGTIÅ:=0.0;
       OMSSÅR:=OMSIÅR;
       OMSIÅR:=0.0;
       IF OMSSÅR>0.0 THEN
         DÆKGRASÅ:=TRUNC((DÆKBIDTD/OMSSÅR)*100)
       ELSE
         DÆKGRASÅ:=0;
       DÆKBIDTD:=0.0;
       ANAFTILG:=0
  END
END;
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I VAREREG ',IER);
  ICLOSE(VZ.H,F);
  WRITELN('ICLOSE ',IER);
  STOP
END;
BEGIN
  FILNAVN2:='REGVARE:P1:1137:I';
  REWRITE(F,FILNAVN2);
  I:=IORESULT;
IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;
  IOPEN(VZ.H,F,SKRIV);
IF IER<>0 THEN WRITE('IOPEN ',IER) ELSE
WITH VARE DO
BEGIN
  VARENR1:=0;
  VARENR2:=0;
  I:=0;
  NEXTREC(VZ.H,F,A);
  REPEAT
ZERREC;
PUTREC(VZ.H,F,A);
IF IER<>0 THEN ERROR;
    I:=I+1;
    NEXTREC(VZ.H,F,A)
  UNTIL IER<>0;
END;
  ICLOSE(VZ.H,F);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER,I:7)
END.