DataMuseum.dk

top - download

    Length: 28128 (0x6de0)
    Types: TextFile
    Notes: Mikados_K
    Names: »2EDITFIL.K«

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

Mikados K File

PROGRAM TOLDSORT;
CONST TOPMARG=11; LMARG=9; DK=8;
 (*$IISFHEAD*)
 VPOST=RECORD
        A       :AR;
        HELTAL:ARRAY (1..11) OF INTEGER;
 (*VARENR,LVRNDØR,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,
   DATSORD2,DÆKGRASÅ,ANAFTILG*)
        NAVN:ARRAY (1..2) OF PACKED ARRAY(1..30) OF CHAR;
 (*VARENAVN,NAVNHOSLEVERANDØR*)
        REELTAL :ARRAY (1..15) OF REAL
 (*PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
   RESAFIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD*)
  END;
 PLUOLINE = RECORD
        VNR :ARRAY (1..3) OF INTEGER;
        (*VNR,LEVERET,BESTILT*)
        PRIS: REAL
  END;
FAKPOST= RECORD
       FORSEND:INTEGER;
       EMBAL,FRAGT:REAL;
       HEAD:ARRAY (1..12) OF INTEGER;
       LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
       DITTO:ARRAY (1..2) OF PACKED ARRAY (1..20) OF CHAR;
       TRANSPORTØR,AKOLLI:PACKED ARRAY (1..30) OF CHAR;
       KODE8,KODE9,BRUTTOVÆGT:INTEGER;
       ORDRELIN: ARRAY(1..15) OF PLUOLINE
END;
FAKFILE=FILE OF FAKPOST;
 VZONE= RECORD
        H:ISFHEAD;
        T:ARRAY(1..451) OF INTEGER
  END;
  
TOLDLINE=RECORD
       TOLDPNR:REAL;
       OPRLAND:INTEGER;
       PLUOLIN:PLUOLINE
END;
 VAR    FVAR           : ISF;
        SEXPFIL,EXPFIL :FAKFILE;
        VZ:VZONE;
        VARE:VPOST;
        FNAVN:STRING(20);
        TOLDORDR:ARRAY (1..60) OF TOLDLINE;
        TOLDLIN:TOLDLINE;
        IER,I,J,K,L
                        :INTEGER;
        QUQ:^INTEGER;
(*$L-*)
 (*$R-,IEXCOMCOP*)
 (*$IIOPEN*)
 (*$IREADPROC*)
 (*$IFINDPOST*)
 (*$IICLOSE*)
 (*$IPUTGET*)
 (*$R+,L+*)
 PROCEDURE ERROR;
 BEGIN
   WRITELN('FEJL I REGISTER ',IER);
   ICLOSE(VZ.H,FVAR);
   WRITELN('ICLOSE ',IER);
   I:=I DIV 0
 END;
BEGIN
  FNAVN:='REGVARE:P1:0000:I';
  REWRITE(FVAR,FNAVN);
  IOPEN(VZ.H,FVAR,SKRIV);IF IER<>0 THEN ERROR;
 
 
  FNAVN:='EXPREG:P2:30:I';
  REWRITE(EXPFIL,FNAVN);
 
  FNAVN:='SEXPREG:P2:30:I';
  REWRITE(SEXPFIL,FNAVN);
 
  GET(EXPFIL);
  WHILE (EXPFIL^.HEAD(1)<>0) OR (EXPFIL^.HEAD(2)<>0) DO
  BEGIN
    J:=1;
    REPEAT
      FOR I:=1 TO 15 DO
      WITH EXPFIL^.ORDRELIN(I) DO
      IF VNR(1)>1 THEN
      BEGIN
        VARE.HELTAL(1):=VNR(1);
        GETREC(VZ.H,FVAR,VARE.A);
        IF (IER<>0) AND (IER<>-6) THEN ERROR;
        WITH TOLDORDR(J) DO
        BEGIN
          TOLDPNR:=VARE.REELTAL(3);
          OPRLAND:=VARE.HELTAL(3);
          PLUOLIN:=EXPFIL^.ORDRELIN(I)
        END;
        J:=J+1
      END;
      IF EXPFIL^.HEAD(5)<>99 THEN GET(EXPFIL) ELSE I:=0
    UNTIL I=0;
    J:=J-1;
    IF J>60 THEN ERROR;
    FOR I:=1 TO J DO
    BEGIN
      K:=I;
      FOR L:=I+1 TO J DO
        IF (TOLDORDR(L).TOLDPNR<TOLDORDR(K).TOLDPNR) OR
          ((TOLDORDR(L).TOLDPNR=TOLDORDR(K).TOLDPNR) AND
           (TOLDORDR(L).OPRLAND<TOLDORDR(K).OPRLAND)) THEN K:=L;
      IF K<>I THEN
      BEGIN
        TOLDLIN:=TOLDORDR(I);
        TOLDORDR(I):=TOLDORDR(K);
        TOLDORDR(K):=TOLDLIN
      END
    END;
    FOR I:=1 TO J DO
    BEGIN
      IF I MOD 15 = 1 THEN
      BEGIN
        IF I<>1 THEN PUT(SEXPFIL);
        SEXPFIL^.HEAD:=EXPFIL^.HEAD;
        SEXPFIL^.FORSEND:=EXPFIL^.FORSEND;
        SEXPFIL^.EMBAL:=EXPFIL^.EMBAL;
        SEXPFIL^.FRAGT:=EXPFIL^.FRAGT;
        SEXPFIL^.LINE(1):=EXPFIL^.LINE(1);
        SEXPFIL^.LINE(2):=EXPFIL^.LINE(2);
        SEXPFIL^.DITTO(1):=EXPFIL^.DITTO(1);
        SEXPFIL^.DITTO(2):=EXPFIL^.DITTO(2);
        SEXPFIL^.TRANSPORTØR:=EXPFIL^.EXPORTØR;
        SEXPFIL^.AKOLLI:=EXPFIL^.AKOLLI;
        SEXPFIL^.KODE8:=EXPFIL^.KODE8;
        SEXPFIL^.KODE9:=EXPFIL^.KODE9;
        SEXPFIL^.BRUTTOVÆGT:=EXPFIL^.BRUTTOVÆGT;
        IF J-I<15 THEN SEXPFIL^.HEAD(5):=99
           ELSE SEXPFIL^.HEAD(5):=I DIV 15 +1
      END;
      SEXPFIL^.ORDRELIN((I-1) MOD 15 + 1):=TOLDORDR(I).PLUOLIN
    END;
    I:=J+1;
    WHILE I MOD 15 <> 1 DO
    BEGIN
       SEXPFIL^.ORDRELIN((I-1) MOD 15 + 1).VNR(1):=0;
    I:=I+1
    END;
    PUT(SEXPFIL);
    GET(EXPFIL)
  END;
  SEXPFIL^.HEAD(1):=0;
  SEXPFIL^.HEAD(2):=0;
  PUT(SEXPFIL);
  ICLOSE(VZ.H,FVAR);
  CHAIN('INTRE   *1','TOLDFAKT:P1',QUQ);
END.