DataMuseum.dk

top - download

    Length: 10176 (0x27c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »PROSPØRG.K«

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

Mikados K File

PROGRAM PROSPØRG;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
VAR    PARM:^PARMARRAY;
       QUQ:^INTEGER;
       FNAVN:STRING;
(*$P*)
PROCEDURE REGVEDL;
CONST MHISTOZ=647;
(*$IISFHEAD*)
HISTOZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MHISTOZ) OF INTEGER
END;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
HISTOPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      MATERIALER,
      LØN,
      MPLGFAKT,
      SALGSPRIS,
      AFVIGELSE,
      ANTALBESTILT,
      ANTALLEVERET  :REAL;
      PRODUKT1NR,
      PRODUKT2NR,
      DAT1,
      DAT2,
      ORDRENR       :INTEGER
END;
SYSPOST=RECORD
      MINUTFAKTOR:ARRAY (1..5) OF REAL;
      DAT1,DAT2:INTEGER
END;
SYSFILE=FILE OF SYSPOST;
VAR SF:SYSFILE;
    IER,I,J:INTEGER;
    HIF:ISF;
    HIZ:HISTOZONE;
    HIPOST:HISTOPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IREADPROC*)
(*$ISÆTØG*)
(*$IFORSKYD*)
(*$IIOPEN*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$IDELETE*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(HIZ.H,HIF);
  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 CH:STRING(1);
    R:REAL;
FUNCTION RUND(R:REAL):REAL;
VAR R1:REAL;
BEGIN
  R1:=TRUNC(R/10000.0);
  R1:=R1*10000.0;
  RUND:=ROUND(R-R1)+R1
END;
PROCEDURE SKÆRM;
BEGIN
  WRITELN(HIPOST.DAT1*10000.0+HIPOST.DAT2:6:-2,HIPOST.ORDRENR:7,
          HIPOST.ANTALBESTILT:15:-2,HIPOST.MATERIALER:15:2,
          HIPOST.MPLGFAKT:15:2,HIPOST.AFVIGELSE:15:2);
  WRITELN(' ':14,HIPOST.ANTALLEVERET:15:-2,HIPOST.LØN:15:2,
          HIPOST.SALGSPRIS:15:2)
END;
PROCEDURE SKÆRMH;
BEGIN
  CLEARSCREEN;
  WRITELN('P R O D U K T F O R E S P Ø R G S E L');
  WRITELN('Produktnr: ',R:8:-2,' ':43,'Dato',SF^.DAT1*10000.0+SF^.DAT2:8:-2);
  WRITELN('Dato   Ordrenr  Antal bestilt     Materialer        *faktor',
          '      Afvigelse');
  WRITELN(' ':16,'Antal leveret',' ':12,'Løn      Salgspris')
END;
PROCEDURE PRINT;
BEGIN
  WRITELN(LIST,HIPOST.DAT1*10000.0+HIPOST.DAT2:6:-2,HIPOST.ORDRENR:7,
          HIPOST.ANTALBESTILT:15:-2,HIPOST.MATERIALER:15:2,
          HIPOST.MPLGFAKT:15:2,HIPOST.AFVIGELSE:15:2);
  WRITELN(LIST,' ':14,HIPOST.ANTALLEVERET:15:-2,HIPOST.LØN:15:2,
          HIPOST.SALGSPRIS:15:2);
  WRITELN(LIST);
  WRITELN(LIST)
END;
PROCEDURE PRINTH;
BEGIN
  WRITELN(LIST);
  WRITELN(LIST,'P R O D U K T F O R E S P Ø R G S E L');
  WRITELN(LIST,'Produktnr: ',R:8:-2,' ':43,
               'Dato',SF^.DAT1*10000.0+SF^.DAT2:8:-2);
  WRITELN(LIST);
  WRITELN(LIST,'Dato   Ordrenr  Antal bestilt     Materialer        *faktor',
          '      Afvigelse');
  WRITELN(LIST,' ':16,'Antal leveret',' ':12,'Løn      Salgspris');
  WRITELN(LIST)
END;
(*$P*)
BEGIN
  CLEARSCREEN;
  REPEAT
    REPEAT
      GOTOXY(1,2);
      WRITELN('Produktnummer');
      GOTOXY(15,2);
      READLN;READ(R)
    UNTIL (IORESULT=0) AND (R>=0.0) AND (R<=999999.0);
    R:=RUND(R);
    HIPOST.PRODUKT1NR:=TRUNC(R/10000.0);
    HIPOST.PRODUKT2NR:=TRUNC(R-HIPOST.PRODUKT1NR*10000.0);
    HIPOST.DAT1:=0;HIPOST.DAT2:=0;
    REPEAT
      GOTOXY(1,3);
      CH:='S';
      WRITELN('Skærm: S, Printer: P');
      GOTOXY(22,3);EDIT(CH)
    UNTIL (CH='S') OR (CH='P');
    NEXTREC(HIZ.H,HIF,HIPOST.A);
    IF (IER<>0) AND (IER<>-1) AND (IER<>-2) AND (IER<>-9)
      THEN ERROR(HIZ.H.FILENAME) ELSE IER:=0;
    IF CH='S' THEN SKÆRMH ELSE PRINTH;
    I:=0;
    WHILE (IER=0) AND (HIPOST.PRODUKT1NR*10000.0+HIPOST.PRODUKT2NR=R) DO
    BEGIN
      I:=I+1;
      IF CH='S' THEN SKÆRM ELSE PRINT;
      NEXTREC(HIZ.H,HIF,HIPOST.A)
    END;
    IF (IER<>0) AND (IER<-2) AND (IER<>-9) THEN ERROR(HIZ.H.FILENAME)
    ELSE IER:=0;
    IF CH='P' THEN PAGE(LIST) ELSE BEGIN WRITELN('RETURN'); READLN END;
    IF I>10 THEN
    BEGIN
      HIPOST.PRODUKT1NR:=TRUNC(R/10000.0);
      HIPOST.PRODUKT2NR:=TRUNC(R-HIPOST.PRODUKT1NR*10000.0);
      HIPOST.DAT1:=0;HIPOST.DAT2:=0;
      NEXTREC(HIZ.H,HIF,HIPOST.A);
      IF (IER<>0) AND (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN
      ERROR(HIZ.H.FILENAME) ELSE IER:=0;
      WHILE (IER=0) AND (I>10) DO
      BEGIN
        DELETE(HIZ.H,HIF,HIPOST.A);
        I:=I-1
      END;
      IF (IER<>0) THEN ERROR(HIZ.H.FILENAME)
    END;
    CLEARSCREEN;
    CH:='J';
    GOTOXY(1,1);
    WRITELN('Flere produkter J/N');
    GOTOXY(21,1);EDIT(CH)
  UNTIL CH='N'
END;
(*$P*)
BEGIN
  CLEARSCREEN;
 
  FNAVN:='SYSREG:P2:1:I';
  REWRITE(SF,FNAVN);
  SEEK(SF,1);
  GET(SF);
  HIZ.H.FILENAME:='HISTOREG';
  FNAVN:='HISTOREG:P2:0000:I';
  REWRITE(HIF,FNAVN);
  IOPEN(HIZ.H,HIF,SKRIV);IF IER<>0 THEN OFEJL(HIZ.H.FILENAME);
  MAINTAIN;
  ICLOSE(HIZ.H,HIF);
  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.