DataMuseum.dk

top - download

    Length: 3744 (0xea0)
    Types: TextFile
    Notes: Mikados_K
    Names: »ORDREREO.K«

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

Mikados K File

PROGRAM ORDREREOR;
(*$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;
 ORDZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..930) OF INTEGER
  END;
VAR    F1,F:ISF;
       KZ:ORDZONE;
       KZ1:ORDZONE;
FILNAVN1,FILNAVN2:STRING(20);
N3,N4,N1,N2,IER,I:INTEGER;
       R:REAL;
       ORDRE:ORDREPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IINITIATE*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IPUTGET*)
(*$R+*)
(*$L+*)
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I KUNDEREG ',IER);
  ICLOSE(KZ.H,F);
  ICLOSE(KZ1.H,F1);
  WRITELN('ICLOSE ',IER);
  STOP
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;
BEGIN
  CLEARSCREEN;
  FILNAVN2:='ORDRERG:P2:0000:I';
  REWRITE(F,FILNAVN2);
  IOPEN(KZ.H,F,LÆS);IF IER<>0 THEN OFEJL;
  FILNAVN1:='ORDRERG:P1:0000:I';
  REWRITE(F1,FILNAVN1);
  IOPEN(KZ1.H,F1,SKRIV);IF IER<>0 THEN OFEJL;
  FOR I:=1 TO 5 DO ORDRE.HEAD(I):=0;
  NEXTREC(KZ.H,F,ORDRE.A);
  WRITELN(LIST,ORDRE.HEAD(1)*10000.0+ORDRE.HEAD(2):10:-2,
               ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4):10:-2,
               ORDRE.HEAD(5):5);
  IF IER<>-1 THEN ERROR ELSE IER:=0;
  I:=0;
  WHILE IER=0 DO
  BEGIN
    INSERT(KZ1.H,F1,ORDRE.A);
    IF (IER<>0) AND (IER<>-7) THEN ERROR;
    IF IER<>-7 THEN
  WRITELN(LIST,' ':30,ORDRE.HEAD(1)*10000.0+ORDRE.HEAD(2):10:-2,
               ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4):10:-2,
               ORDRE.HEAD(5):5)
    ELSE WRITELN(LIST,' ':30,'PRESENT');
    NEXTREC(KZ.H,F,ORDRE.A);
  WRITELN(LIST,ORDRE.HEAD(1)*10000.0+ORDRE.HEAD(2):10:-2,
               ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4):10:-2,
               ORDRE.HEAD(5):5);
    I:=I+1
  END;
  IF IER<>-2 THEN ERROR;
  WRITELN('INDPOSTER, UDPOSTER',KZ.H.RECINUSE:5,I:5);
  ICLOSE(KZ.H,F);
  ICLOSE(KZ1.H,F1);
  WRITELN('ICLOSE ',IER);
END.