DataMuseum.dk

top - download

    Length: 6240 (0x1860)
    Types: TextFile
    Notes: Mikados_K
    Names: »MESSEKIK.K«

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

Mikados K File

PROGRAM MESSEOVERSIGTSUDSKRIVNING;
 (*$IISFHEAD*)
 OLINE = RECORD
        VNR :ARRAY (1..2) OF INTEGER;
        (*VNR,BESTILT*)
        PRIS: REAL
  END;
 ORDREPOST = RECORD
        A:AR;
 (*
        KNR1,KNR2,
        NR1,NR2,
        SIDE,
        LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,RESTORDREKODE,RABAT*)
        HEAD :ARRAY(1..12) OF INTEGER;
        LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
        ORDRELIN : ARRAY (1..15) OF OLINE
  END;
KPOST=RECORD
       A:AR;
       NR:ARRAY (1..23) OF INTEGER;
       NAVN: ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;
       LANDSBY:PACKED ARRAY (1..20) OF CHAR;
       POSTNR:PACKED ARRAY (1..25) OF CHAR;
       TLF:PACKED ARRAY (1..10) OF CHAR;
       SALDOKØB:ARRAY (1..9) OF REAL
END;
 ORDZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..930) OF INTEGER
  END;
KZONE=RECORD
       H:ISFHEAD;
       T:ARRAY(1..918) OF INTEGER
END;
  
  
PROCSTAT=RECORD
       NP,NROSTART:INTEGER
END;
NPFILE=FILE OF PROCSTAT;
  
  
 VAR    FORD,FKUN : ISF;
        KZ:KZONE;
        OZ:ORDZONE;
        ORDRE:ORDREPOST;
        KUNDE:KPOST;
        FNAVN:STRING(20);
        NRPF,CF:NPFILE;
        TOTORDRE:ARRAY (1..60) OF OLINE;
        OLIN:OLINE;
        KNAVN:STRING(4);
        T:TEXT;
  SVAR1,SVAR3:CHAR;
        IER,I,J,K,L,ALI,EOF
                        :INTEGER;
O1,O2,R,R1,R2,SUM,SUM1 :REAL;
        QUQ:^INTEGER;
(*$L-*)
 (*$R-,IEXCOMCOP*)
 (*$IIOPEN*)
 (*$IREADPROC*)
 (*$IFINDPOST*)
 (*$IICLOSE*)
 (*$IPUTGET*)
 (*$INEXTREC*)
 (*$R+*)
(*$L+*)
 PROCEDURE ERROR;
 BEGIN
   WRITELN('FEJL I REGISTER ',IER);
   ICLOSE(OZ.H,FORD);
   ICLOSE(KZ.H,FKUN);
   WRITELN('ICLOSE ',IER);
   I:=I DIV 0
 END;
PROCEDURE OFEJL;
BEGIN
  GOTOXY(1,20);
  WRITELN('REGISTERFEJL ',IER,' . 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;
  CLEARSCREEN
END;
PROCEDURE HOVED;
BEGIN
  WRITE(LIST,ORDRE.HEAD(1)*10000.0+ORDRE.HEAD(2):7:-2,
            ' ':2,ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4):8:-2);
  WRITE(LIST,' ':2,KUNDE.NAVN(1));
END;
PROCEDURE PAKLIST;
VAR S:INTEGER;
    SLUT:BOOLEAN;
    REST,LEV:REAL;
BEGIN
  SUM:=0;
  HOVED;
  S:=0;
  REPEAT
    FOR J:=1 TO 15 DO
    BEGIN
      TOTORDRE(S*15+J):=ORDRE.ORDRELIN(J);
      IF TOTORDRE(S*15+J).VNR(1)<>0 THEN ALI:=S*15+J
    END;
    S:=S+1;
    SLUT:=ORDRE.HEAD(5)=99;
    NEXTREC(OZ.H,FORD,ORDRE.A);
    EOF:=IER;
    IF ((IER<>0) AND (IER<>-2) AND (IER<>-1)) THEN ERROR
  UNTIL SLUT;
  FOR J:=1 TO ALI DO
  WITH TOTORDRE(J) DO
  IF VNR(1)<>0 THEN
  BEGIN
      LEV:=VNR(2);
      SUM:=SUM+LEV*PRIS;
  END;
  WRITELN(LIST,' ':3,SUM/100:12:2);
  WRITELN(LIST);
  SUM1:=SUM1+SUM;
END;
FUNCTION FOUND:BOOLEAN;
VAR R:REAL;
BEGIN
  R:=ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4);
  IF (R>=O1) AND (R<=O2) THEN FOUND:=TRUE ELSE FOUND:=FALSE
END;
BEGIN
  CLEARSCREEN;
  FNAVN:='PROCSTAT:P2:0:I';
(*$C-*)
  REPEAT
    REWRITE(NRPF,FNAVN);
    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);
 
  FNAVN:='ORDRERG:P2:0000:I';
  RESET(FORD,FNAVN);
  IOPEN(OZ.H,FORD,LÆS);IF IER<>0 THEN OFEJL;
 
 
 
  FNAVN:='KUNDERG:P2:0000:I';
  RESET(FKUN,FNAVN);
  IOPEN(KZ.H,FKUN,LÆS);IF IER<>0 THEN OFEJL;
 
  WRITELN(LIST,'M E S S E O V E R S I G T');
  WRITELN(LIST);
  SUM:=0;SUM1:=0;
      CLEARSCREEN;
      WRITELN('STARTNR');
      REPEAT GOTOXY(15,1);READLN;READ(O1);
       WRITELN('SLUTNR');
       GOTOXY(15,2);READLN;READ(O2)
      UNTIL (IORESULT=0) AND (O1<=O2);
      WITH ORDRE DO
      BEGIN
        FOR J:=1 TO 5 DO HEAD(J):=0;
        NEXTREC(OZ.H,FORD,A);
        IF IER<>-1 THEN ERROR ELSE IER:=0;
        REPEAT
          WHILE (NOT FOUND) AND (IER=0) DO NEXTREC(OZ.H,FORD,A);
          EOF:=IER;
          IF IER=0 THEN
               BEGIN
               KUNDE.NR(1):=HEAD(1);
               KUNDE.NR(2):=HEAD(2);
               GETREC(KZ.H,FKUN,KUNDE.A);
               IF IER<>0 THEN ERROR;
               PAKLIST
               END
        UNTIL EOF<>0;
        IF EOF<>-2 THEN ERROR;
      END;
  WRITELN(LIST,'TOTAL',' ':47,SUM1/100:12:2);
     ICLOSE(OZ.H,FORD);
     ICLOSE(KZ.H,FKUN);
  CHAIN('INTRE   *1','HOVSA:P1',QUQ)
END.
     CHAIN('INTRE   *1','HOVSA:P1',QUQ)