DataMuseum.dk

top - download

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

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

Mikados K File

PROGRAM OPRETFILES;
(*$IISFHEAD*)
 PLUOLINE = RECORD
        VNR :ARRAY (1..3) OF INTEGER;
        (*VNR,LEVERET,BESTILT*)
        PRIS: REAL
  END;
 OLINE = RECORD
        VNR :ARRAY (1..2) OF INTEGER;
        (*VNR,BESTILT*)
        PRIS: REAL
  END;
 PLUORPOST=RECORD
        A:AR;
        HEAD:ARRAY (1..12) OF INTEGER;
        LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
 (*KNR1,KNR2,ONR1,ONR2,SIDE,LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,
   RESTORDREKODE,RABAT*)
        ORDRELIN : ARRAY (1..15) OF PLUOLINE
  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;
TOLDPOPOST=RECORD
  A:AR;
  NR1,NR2:INTEGER;
  TEKST:PACKED ARRAY (1..30) OF CHAR
END;
POSTPOST=RECORD
       A:AR;
      (*KNR1-2,DATO1-2,TEKSTKODE,BILAGSNR1-2*) HELTAL:ARRAY(1..7) OF INTEGER;
      (*BELØB,RESTBELØB*) REEL:ARRAY (1..2) OF REAL
END;
POSTZONE=RECORD
       H:ISFHEAD;
       T:ARRAY (1..1000) OF INTEGER
END;
 PLUZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..1000) OF INTEGER
  END;
TPZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..1000) OF INTEGER
END;
 RORPOST=RECORD
        A:AR;
 (*     KNR1,KNR2,
        VNR,
        DAT1,DAT2:INTEGER;*) HEAD:ARRAY(1..5) OF INTEGER;
        ANTAL:REAL
  END;
 RORZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..1000) OF INTEGER
  END;
 ORDZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..1000) OF INTEGER
  END;
KEYDESCRIPTION=ARRAY (1..9) OF ARRAY (1..3) OF INTEGER;
 VAR         FTP,FORD,FPLU,FROR,FPOST : ISF;
        OZ:ORDZONE;
        PZ:PLUZONE;
        TPZ:TPZONE;
        ORDRE:ORDREPOST;
        PLUORD:PLUORPOST;
        TOLDPO:TOLDPOPOST;
        FNAVN:STRING(20);
        RESTORD:RORPOST;
        POSTERIN:POSTPOST;
        RZ:RORZONE;
        PSZ:POSTZONE;
        IER,I,J,
    NREC,RECSIZE,KEYFLDS :INTEGER;
    R:REAL;
    KEYDESC:KEYDESCRIPTION;
(*$L-*)
(*$ICREATE*)
 (*$R-,IEXCOMCOP*)
 (*$IIOPEN*)
 (*$ISÆTØG*)
 (*$IREADPROC*)
 (*$IFINDPOST*)
 (*$IFORSKYD*)
 (*$IICLOSE*)
 (*$IINSERT*)
(*$IINITIATE*)
 (*$R+,L+*)
 PROCEDURE ERROR;
 BEGIN
   WRITELN('FEJL I REGISTER ',IER);
   ICLOSE(RZ.H,FROR);
   ICLOSE(OZ.H,FORD);
   ICLOSE(PZ.H,FPLU);
   ICLOSE(PSZ.H,FPOST);
   WRITELN('ICLOSE ',IER);
   I:=I DIV 0
 END;
PROCEDURE PIP;
BEGIN
  FNAVN:='POSTREG:P2';
  RECSIZE:=15;
  KEYFLDS:=1;
  KEYDESC(1,1):=1;KEYDESC(1,2):=7;KEYDESC(1,3):=1;
  CREATE(FNAVN,NREC,RECSIZE,KEYFLDS,KEYDESC,IER);
  WRITELN(LIST,'IER : ',IER);WRITELN;
  REWRITE(FPOST,FNAVN);
  IOPEN(PSZ.H,FPOST,SKRIV);IF IER<>0 THEN ERROR;
  INITIATE(PSZ.H,FPOST,PSZ.H.NBUC);
  FOR I:=1 TO 7 DO WITH POSTERIN DO HELTAL(I):=0;
  FOR I:=0 TO PSZ.H.NBUC-1 DO
  WITH POSTERIN DO
  BEGIN
       R:=10000.0+80000.0*I/(PSZ.H.NBUC-1);
       HELTAL(1):=TRUNC(R/10000);
       HELTAL(2):=TRUNC(R-HELTAL(1)*10000.0);
       INSERT(PSZ.H,FPOST,A)
  END;
  ICLOSE(PSZ.H,FPOST);
 
END;
PROCEDURE PAP;
BEGIN
  FNAVN:='TOLDPORG:P2';
  RECSIZE:=17;
  KEYFLDS:=1;
  KEYDESC(1,1):=1;KEYDESC(1,2):=2;KEYDESC(1,3):=1;
  CREATE(FNAVN,NREC,RECSIZE,KEYFLDS,KEYDESC,IER);
  WRITELN(LIST,'IER : ',IER);WRITELN;
  REWRITE(FTP,FNAVN);
  IOPEN(TPZ.H,FTP,SKRIV);IF IER<>0 THEN ERROR;
  INITIATE(TPZ.H,FTP,TPZ.H.NBUC);
  TOLDPO.NR1:=0;TOLDPO.NR2:=0;
  TOLDPO.TEKST:='TEKST IKKE OPRETTET AF BRUGER.';
  FOR I:=0 TO TPZ.H.NBUC-1 DO
  WITH TOLDPO DO
  BEGIN
       R:=1000000.0+9000000.0*I/(TPZ.H.NBUC-1);
       NR1:=TRUNC(R/1000);
       NR2:=TRUNC(R-NR1*1000.0);
       INSERT(TPZ.H,FTP,A)
  END;
  ICLOSE(TPZ.H,FTP);
 
END;
BEGIN
  CLEARSCREEN;
  REPEAT
    REPEAT
       GOTOXY(1,1);
       WRITELN('OPRETTELSE AF REGISTRE, ');
       WRITELN('ORDREREG 1, PLUOR 2, RESTORDREREG 3, POSTERINGSREG 4',
               'TOLDPNRREG 5');
       READLN;READ(J)
    UNTIL (IORESULT=0) AND (J>=0) AND (J<6);
    REPEAT
       GOTOXY(1,3);WRITELN('ANTAL POSTER');
       GOTOXY(20,3);READLN;READ(NREC)
    UNTIL (IORESULT=0) AND (NREC>0);
    CASE J OF
4:PIP;
5:PAP;
1:BEGIN
  FNAVN:='ORDRERG:P2';
  RECSIZE:=132;
  KEYFLDS:=1;
  KEYDESC(1,1):=1;KEYDESC(1,2):=5;KEYDESC(1,3):=1;
  CREATE(FNAVN,NREC,RECSIZE,KEYFLDS,KEYDESC,IER);
  WRITELN(LIST,'IER : ',IER);WRITELN;
  REWRITE(FORD,FNAVN);
  IOPEN(OZ.H,FORD,SKRIV);IF IER<>0 THEN ERROR;
  INITIATE(OZ.H,FORD,OZ.H.NBUC);
 
  FOR I:=1 TO 5 DO WITH ORDRE DO HEAD(I):=0;
  FOR I:=0 TO OZ.H.NBUC-1 DO
  WITH ORDRE DO
  BEGIN
    R:=10000.0+80000.0*I/(OZ.H.NBUC-1);
    HEAD(1):=TRUNC(R/10000);
    HEAD(2):=TRUNC(R-HEAD(1)*10000.0);
    INSERT(OZ.H,FORD,A)
  END;
  ICLOSE(OZ.H,FORD);
  END;
2:BEGIN
  FNAVN:='PLUOR:P2';
  RECSIZE:=147;
  KEYFLDS:=1;
  KEYDESC(1,1):=1;KEYDESC(1,2):=5;KEYDESC(1,3):=1;
  CREATE(FNAVN,NREC,RECSIZE,KEYFLDS,KEYDESC,IER);
  WRITELN(LIST,'IER : ',IER);WRITELN;
  REWRITE(FPLU,FNAVN);
  IOPEN(PZ.H,FPLU,SKRIV);IF IER<>0 THEN ERROR;
  INITIATE(PZ.H,FPLU,PZ.H.NBUC);
 
  FOR I:=1 TO 5 DO WITH PLUORD DO HEAD(I):=0;
  FOR I:=0 TO PZ.H.NBUC-1 DO
  WITH PLUORD DO
  BEGIN
    R:=10000.0+80000.0*I/(PZ.H.NBUC-1);
    HEAD(1):=TRUNC(R/10000);
    HEAD(2):=TRUNC(R-HEAD(1)*10000.0);
    INSERT(PZ.H,FPLU,A)
  END;
  ICLOSE(PZ.H,FPLU);
  END;
 
3:BEGIN
  FNAVN:='RESTREG:P2';
  RECSIZE:=9;
  KEYFLDS:=1;
  KEYDESC(1,1):=1;KEYDESC(1,2):=3;KEYDESC(1,3):=1;
  CREATE(FNAVN,NREC,RECSIZE,KEYFLDS,KEYDESC,IER);
  WRITELN(LIST,'IER : ',IER);WRITELN;
  REWRITE(FROR,FNAVN);
  IOPEN(RZ.H,FROR,SKRIV);IF IER<>0 THEN ERROR;
  INITIATE(RZ.H,FROR,RZ.H.NBUC);
 
  RESTORD.HEAD(3):=0;
  FOR I:=0 TO RZ.H.NBUC-1 DO
  WITH RESTORD DO
  BEGIN
    R:=10000.0+80000.0*I/(RZ.H.NBUC-1);
    HEAD(1):=TRUNC(R/10000);
    HEAD(2):=TRUNC(R-HEAD(1)*10000.0);
    INSERT(RZ.H,FROR,A)
  END;
  ICLOSE(RZ.H,FROR);
  END
  END
UNTIL J=0;
END.