DataMuseum.dk

top - download

    Length: 2528 (0x9e0)
    Types: TextFile
    Notes: Mikados_K
    Names: »VARNUMRE.K«

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

Mikados K File

PROGRAM VARNUMRE;
(*$IISFHEAD*)
VPOST=RECORD
       A:AR;
       VARENR1,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;
PROCSTAT=RECORD
       NP,NROSTART:INTEGER
END;
NPFILE=FILE OF PROCSTAT;
VAR    F:ISF;
       NRPF,CF:NPFILE;
       VZ:ZONE;
         FILNAVN2:STRING(20);
      GNR,IER,NR,I,J,K  :INTEGER;
      CH:CHAR;
      QUQ:^INTEGER;
       VARE:VPOST;
       R,FRA,TIL :REAL;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I VAREREG ',IER);
  ICLOSE(VZ.H,F);
  WRITELN('ICLOSE ',IER);
  STOP
END;
BEGIN
  FILNAVN2:='PROCSTAT:P2:0:I';
(*$C-*)
  REPEAT
    REWRITE(NRPF,FILNAVN2);
    SEEK(NRPF,1)
  UNTIL IORESULT=0;
(*$C+*)
  GET(NRPF);
  NRPF^.NP:=1;
  SEEK(NRPF,1);
  PUT(NRPF);
  REPEAT
    GOTOXY(1,20);
    WRITELN('Sæt plade 1 i drev 1 og tryk RETURN');
    READLN;
(*$C-*)
    REWRITE(CF,'C1:P1:0:J');
    SEEK(CF,1)
(*$C+*)
  UNTIL IORESULT=0;
  CLOSE(CF);
  CLOSE(NRPF);
  FILNAVN2:='REGVARE:P1:1137:I';
  RESET(F,FILNAVN2);
  IOPEN(VZ.H,F,LÆS);
  VARE.VARENR1:=0;
  GNR:=1000;
  NEXTREC(VZ.H,F,VARE.A);
  IF IER<>-1 THEN ERROR;
  IER:=0;
  WHILE IER=0 DO
  BEGIN
    WHILE GNR<VARE.VARENR1 DO
    BEGIN
      WRITELN(LIST,GNR:6);
      GNR:=GNR+1;
      IF GNR=5000 THEN GNR:=9000
    END;
    GNR:=GNR+1;
    IF GNR=5000 THEN GNR:=9000;
    WRITELN(LIST,VARE.VARENR1:6,'  ',VARE.NAVN(1));
    NEXTREC(VZ.H,F,VARE.A)
  END;
  WRITELN(LIST);
  IF IER<>-2 THEN ERROR;
  ICLOSE(VZ.H,F);
  CHAIN('INTRE   *1','HOVSA:P1',QUQ)
END.