DataMuseum.dk

top - download

    Length: 15264 (0x3ba0)
    Types: TextFile
    Notes: Mikados_K
    Names: »ORDSPØRG.K«

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

Mikados K File

PROGRAM ORDSPØRG;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
VAR    PARM:^PARMARRAY;
       QUQ:^INTEGER;
       FNAVN:STRING;
(*$P*)
PROCEDURE REGVEDL;
CONST MORDREZ=295;
      MOPLINZ=370;
      MOPERAZ=257;
      MREGLIZ=583;
(*$IISFHEAD*)
ORDREZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MORDREZ) OF INTEGER
END;
REGLIZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MREGLIZ) OF INTEGER
END;
OPLINZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MOPLINZ) OF INTEGER
END;
OPERAZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MOPERAZ) OF INTEGER
END;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
REGLIPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      LØN           :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR,
      OPERATIONSNR,
      MEDARBEJDERNR,
      DAT1,DAT2,
      CENTIMER,
      ENHEDER       :INTEGER
END;
ORDREPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      ANTALBESTILT,
      MATERIALEPRIS,
      SALGSPRIS,
      FAKTOR        :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR    :INTEGER
END;
OPLINPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      MINUTFAKTOR   :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR,
      OPERATIONSNR,
      CENTIMER      :INTEGER
END;
OPERAPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      OPERATIONSNR,
      GRUPPE        :INTEGER;
      BETEGNELSE    :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;
    IER,I,J:INTEGER;
    RGF,ORF,OPF,OAF:ISF;
    ORZ:ORDREZONE;
    OPZ:OPLINZONE;
    OAZ:OPERAZONE;
    RGZ:REGLIZONE;
    ORPOST:ORDREPOST;
    OPPOST:OPLINPOST;
    OAPOST:OPERAPOST;
    RGPOST:REGLIPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$INEXTREC*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(ORZ.H,ORF);
  ICLOSE(OPZ.H,OPF);
  ICLOSE(OAZ.H,OAF);
  ICLOSE(RGZ.H,RGF);
  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,SUM1,SUM2,SUM3,SUM4:REAL;
    KCENT,RCENT,RENHED,KLØN,RLØN:ARRAY (1..6) OF 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;
(*$P*)
PROCEDURE DOIT;
BEGIN
      NEXTREC(RGZ.H,RGF,RGPOST.A);
      IF (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN ERROR(RGZ.H.FILENAME)
                                               ELSE IER:=0;
      WHILE (OPPOST.ORDRENR=ORPOST.ORDRENR) AND
            (OPPOST.PRODUKT1NR=ORPOST.PRODUKT1NR) AND
            (OPPOST.PRODUKT2NR=ORPOST.PRODUKT2NR) AND (IER=0) DO
      BEGIN
        IF (OPPOST.OPERATIONSNR<>RGPOST.OPERATIONSNR) OR
           (OPPOST.ORDRENR<>RGPOST.ORDRENR) OR
           (OPPOST.PRODUKT1NR<>RGPOST.PRODUKT1NR) OR
           (OPPOST.PRODUKT2NR<>RGPOST.PRODUKT2NR) THEN
        BEGIN
          IF (OPPOST.OPERATIONSNR<>0) AND (CH='N') THEN
          BEGIN
            WRITELN(LIST,'----------------------------------------',
                         '----------------------------------');
            IF ORPOST.ANTALBESTILT=0 THEN R:=1 ELSE R:=ORPOST.ANTALBESTILT;
            WRITELN(LIST,OPPOST.OPERATIONSNR:4,' ':11,'REALISERET',
                         RCENT(1):12:-2,RCENT(1)/R:8:1,
                         RLØN(1):14:2,
                         RENHED(1):15:-2);
             WRITELN(LIST,' ':15,'KALKULERET',KCENT(1):12:-2,
                                              OPPOST.CENTIMER:8,
                                              KLØN(1):14:2);
            SUM1:=SUM1+KCENT(1);
            SUM2:=SUM2+RCENT(1);
            SUM3:=SUM3+KLØN(1);
            SUM4:=SUM4+RLØN(1);
            WRITE(LIST,' ':19,'%');
            IF KCENT(1)=0.0 THEN
              WRITE(LIST,'----------')
            ELSE
              WRITE(LIST,100.0*RCENT(1)/KCENT(1):10:2);
            WRITE(LIST,' ':12);
            IF KLØN(1)=0.0 THEN
              WRITE(LIST,'----------')
            ELSE
              WRITE(LIST,100.0*RLØN(1)/KLØN(1):10:2);
            WRITE(LIST,' ':12);
            IF ORPOST.ANTALBESTILT=0.0 THEN
              WRITELN(LIST,'----------')
            ELSE
              WRITELN(LIST,100.0*RENHED(1)/ORPOST.ANTALBESTILT:10:2);
            WRITELN(LIST);
            RENHED(1):=0.0;KCENT(1):=0.0;KLØN(1):=0.0;
            RCENT(1):=0.0;
            RLØN(1):=0.0
          END;
          NEXTREC(OPZ.H,OPF,OPPOST.A);
          IF (IER<>0) AND (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN
             ERROR(OPZ.H.FILENAME) ELSE IER:=0;
          IF (OPPOST.ORDRENR=ORPOST.ORDRENR) AND
             (OPPOST.PRODUKT1NR=ORPOST.PRODUKT1NR) AND
             (OPPOST.PRODUKT2NR=ORPOST.PRODUKT2NR) THEN
          BEGIN
            OAPOST.OPERATIONSNR:=OPPOST.OPERATIONSNR MOD 100;
            GETREC(OAZ.H,OAF,OAPOST.A);
            IF IER<>0 THEN ERROR(OAZ.H.FILENAME);
            IF CH='N' THEN
            BEGIN
              WRITELN(LIST,OAPOST.BETEGNELSE);
              OAPOST.GRUPPE:=1
            END;
            KCENT(OAPOST.GRUPPE):=KCENT(OAPOST.GRUPPE)+OPPOST.CENTIMER*
                                                       ORPOST.ANTALBESTILT;
            KLØN(OAPOST.GRUPPE):=KLØN(OAPOST.GRUPPE)+
                   ORPOST.ANTALBESTILT*OPPOST.CENTIMER*
                   OPPOST.MINUTFAKTOR
          END
        END
        ELSE
        BEGIN
          IF RGPOST.ENHEDER=0 THEN IER:=1 ELSE IER:=RGPOST.ENHEDER;
     IF CH='N' THEN WRITELN(LIST,RGPOST.MEDARBEJDERNR:10,RGPOST.DAT1*10000.0+
                       RGPOST.DAT2:11:-2,RGPOST.CENTIMER:16,
                       1.0*RGPOST.CENTIMER/IER:8:1,
                       RGPOST.LØN:14:2,RGPOST.ENHEDER:15);
          RCENT(OAPOST.GRUPPE):=RCENT(OAPOST.GRUPPE)+RGPOST.CENTIMER;
          RLØN(OAPOST.GRUPPE):=RLØN(OAPOST.GRUPPE)+RGPOST.LØN;
          RENHED(OAPOST.GRUPPE):=RENHED(OAPOST.GRUPPE)+RGPOST.ENHEDER;
          NEXTREC(RGZ.H,RGF,RGPOST.A)
        END
      END;
      IF (IER<>0) AND (IER<>-9) THEN ERROR(RGZ.H.FILENAME) ELSE IER:=0;
END;
PROCEDURE DOTWO;
BEGIN
      FOR I:=1 TO 6 DO
      IF (KCENT(I)<>0.0) OR (RCENT(I)<>0.0) OR (KLØN(I)<>0.0) OR
         (RLØN(I)<>0.0) THEN
      BEGIN
        WRITELN(LIST,I:4,' ':11,KCENT(I):12:-2,RCENT(I):10:-2,
                     KLØN(I):12:2,RLØN(I):10:2);
        WRITE(LIST,' ':20);
        IF KCENT(I)=0.0 THEN
          WRITE(LIST,'----------')
        ELSE WRITE(LIST,100.0*RCENT(I)/KCENT(I):10:2);
        WRITE(LIST,' ':12);
        IF KLØN(I)=0.0 THEN WRITELN(LIST,'----------')
        ELSE WRITELN(LIST,100.0*RLØN(I)/KLØN(I):10:2);
        WRITELN(LIST);
        SUM1:=SUM1+KCENT(I);
        SUM2:=SUM2+RCENT(I);
        SUM3:=SUM3+KLØN(I);
        SUM4:=SUM4+RLØN(I)
      END;
END;
(*$P*)
BEGIN
  REPEAT
    CLEARSCREEN;
    REPEAT
      GOTOXY(1,5);
      WRITELN('Ordrenummer');
      GOTOXY(13,5);
      READLN;READ(ORPOST.ORDRENR)
    UNTIL IORESULT=0;
    REPEAT
      GOTOXY(1,6);
      WRITELN('Produktnummer');
      GOTOXY(15,6);
      READLN;READ(R)
    UNTIL (IORESULT=0) AND (R>=0.0) AND (R<=999999.0);
    ORPOST.PRODUKT1NR:=TRUNC(R/10000.0);
    ORPOST.PRODUKT2NR:=TRUNC(R-ORPOST.PRODUKT1NR*10000.0);
    GETREC(ORZ.H,ORF,ORPOST.A);
    IF (IER<>0) AND (IER<>-6) THEN ERROR(ORZ.H.FILENAME);
    IF IER=0 THEN
    BEGIN
      REPEAT
        GOTOXY(1,7);
        CH:='N';
        WRITELN('Gruppeopdelt J/N');
        GOTOXY(18,7);EDIT(CH)
      UNTIL (CH='N') OR (CH='J');
      WRITELN(LIST,'ORDRESTATUS',' ':7,'ORDRENR',ORPOST.ORDRENR:6,
                   ' ':3,'PRODUKTNR',ORPOST.PRODUKT1NR*10000.0+
                   ORPOST.PRODUKT2NR:8:-2,' ':11,'Dato',
                   SF^.DAT1*10000.0+SF^.DAT2:8:-2);
      WRITELN(LIST,'MATERIALEPRIS',' ':5,'SALGSPRIS',' ':7,
                   'KALKULATIONSFAKTOR',' ':6,
                   'KALKULERET ANTAL');
      WRITELN(LIST,ORPOST.MATERIALEPRIS:13:2,ORPOST.SALGSPRIS:14:2,
                   ORPOST.FAKTOR:25:2,ORPOST.ANTALBESTILT:22:-2);
      WRITELN(LIST);
      IF CH='J' THEN
      BEGIN
        WRITELN(LIST,'GRUPPENR    ',
                     ' ':8,'ANTAL 1/100 TIMER',' ':19,'LØN');
      WRITELN(LIST,' ':22,'KALKU     REALI',' ':7,'KALKU     REALI');
      WRITELN(LIST,' ':22,'LERET  %  SERET',' ':7,'LERET  %  SERET');
      WRITELN(LIST)
      END
      ELSE
      BEGIN
      WRITELN(LIST,'MEDARBEJDERNR',' ':4,'Dato',' ':5,
                 '1/100 TIMER',' ':19,'LØN',
                   ' ':8,'ENHEDER');
      WRITELN(LIST,' ':32,'REALI',' ':3,'PR.',' ':11,'REALI',
                   ' ':5,'REALISERET');
      WRITELN(LIST,' ':32,'SERET',' ':3,'ENHED',' ':9,'SERET');
      WRITELN(LIST)
      END;
      FOR I:=1 TO 6 DO
      BEGIN
        KCENT(I):=0.0;
        RCENT(I):=0.0;
        KLØN(I):=0.0;
        RLØN(I):=0.0;
        RENHED(I):=0.0
      END;
      SUM1:=0.0;SUM2:=0.0;SUM3:=0.0;SUM4:=0.0;
      OPPOST.ORDRENR:=ORPOST.ORDRENR;
      OPPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
      OPPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
      OPPOST.OPERATIONSNR:=0;
      RGPOST.ORDRENR:=ORPOST.ORDRENR;
      RGPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
      RGPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
      RGPOST.OPERATIONSNR:=0;
      DOIT;
      IF CH='J' THEN
      BEGIN
        DOTWO;
      WRITELN(LIST,'SUM',' ':12,SUM1:12:-2,SUM2:10:-2,SUM3:12:2,SUM4:10:2);
      WRITE(LIST,' ':20);
      IF SUM1=0.0 THEN WRITE(LIST,'----------')
      ELSE WRITE(LIST,100.0*SUM2/SUM1:10:2);
      WRITE(LIST,' ':12);
      IF SUM3=0.0 THEN WRITELN(LIST,'----------')
      ELSE WRITELN(LIST,100.0*SUM4/SUM3:10:2);
      END;
      PAGE(LIST)
    END;
    CH:='J';
    GOTOXY(1,8);
    WRITELN('Flere ordrer');
    GOTOXY(14,8);EDIT(CH)
  UNTIL CH='N'
END;
(*$P*)
BEGIN
  CLEARSCREEN;
 
  FNAVN:='SYSREG:P2:1:I';
  REWRITE(SF,FNAVN);
  SEEK(SF,1);
  GET(SF);
  ORZ.H.FILENAME:='ORDREREG';
  FNAVN:='ORDREREG:P2:0000:I';
  REWRITE(ORF,FNAVN);
  IOPEN(ORZ.H,ORF,LÆS);IF IER<>0 THEN OFEJL(ORZ.H.FILENAME);
  OPZ.H.FILENAME:='OPLINREG';
  FNAVN:='OPLINREG:P2:0000:I';
  REWRITE(OPF,FNAVN);
  IOPEN(OPZ.H,OPF,LÆS);IF IER<>0 THEN OFEJL(OPZ.H.FILENAME);
  OAZ.H.FILENAME:='OPERAREG';
  FNAVN:='OPERAREG:P2:0000:I';
  REWRITE(OAF,FNAVN);
  IOPEN(OAZ.H,OAF,LÆS);IF IER<>0 THEN OFEJL(OAZ.H.FILENAME);
  RGZ.H.FILENAME:='REGLIREG';
  FNAVN:='REGLIREG:P2:0000:I';
  REWRITE(RGF,FNAVN);
  IOPEN(RGZ.H,RGF,LÆS);IF IER<>0 THEN OFEJL(RGZ.H.FILENAME);
  MAINTAIN;
  ICLOSE(ORZ.H,ORF);
  ICLOSE(OPZ.H,OPF);
  ICLOSE(OAZ.H,OAF);
  ICLOSE(RGZ.H,RGF);
  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.