DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦8504bb75b⟧ TextFile

    Length: 12480 (0x30c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »VARESTAB.K«

Derivation

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

Mikados K File

PROGRAM VAREVEDL;
(*$IISFHEAD*)
VPOST=RECORD
       A:AR;
       VARENR1,LVRNDØR,OPRLAND,PAKENHED,
       FORVLEVU,DATSBES1,DATSBES2,DATSORD1,DATSORD2,
       DÆKGRASÅ,ANAFTILG:INTEGER;
       NAVN:ARRAY(1..2) OF PACKED ARRAY (1..30) OF CHAR;
       PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
       RAIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD:REAL
END;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..451) OF INTEGER
 END;
VAR  F1,F:ISF;
    VZ1,VZ:ZONE;
       FILNAVN2:STRING(20);
      IER,I:INTEGER;
  VARE1,VARE:VPOST;
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
(*$R-,IEXCOMCOP*)
(*$IINITIATE*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$R+*)
PROCEDURE PRVAROPL(O,KODE:INTEGER);
PROCEDURE PR1;
BEGIN
WITH VARE DO
CASE O OF
1:BEGIN
GOTOXY(1,1);WRITE('1 VARENR');GOTOXY(30,1);WRITELN(VARENR1:10);
END;
2:BEGIN
GOTOXY(1,2);WRITE('2 VARENAVN');GOTOXY(30,2);WRITELN(NAVN(1));
END;
3:BEGIN
GOTOXY(1,3);WRITE('3 NAVN HOS LEVERANDØR');GOTOXY(30,3);WRITELN(NAVN(2));
END;
4:BEGIN
GOTOXY(1,4);WRITE('4 PRIS');GOTOXY(30,4);WRITELN(PRIS/100:10:2);
END;
5:IF KODE>0 THEN BEGIN
GOTOXY(1,5);WRITE('5 KOSTPRIS');GOTOXY(30,5);WRITELN(KOSTPRIS/100:10:2);
END;
6:BEGIN
GOTOXY(1,6);WRITE('6 LEVERANDØRNR');GOTOXY(30,6);WRITELN(LVRNDØR:10);
END;
7:BEGIN
GOTOXY(1,7);WRITE('7 OPRINDELSESLAND');GOTOXY(30,7);WRITELN(OPRLAND:10);
END;
8:BEGIN
GOTOXY(1,8);WRITE('8 TOLDPOSITIONSNR');GOTOXY(30,8);
WRITELN(TOLDPNR/1000:10:3);
END;
9:BEGIN
GOTOXY(1,9);WRITE('9 PAKNINGSENHED');GOTOXY(30,9);WRITELN(PAKENHED:10);
END;
10:BEGIN
GOTOXY(1,10);WRITE('10 FYSISK LAGER');GOTOXY(30,10);
WRITE(TRUNC(FYSLAGER):10);
GOTOXY(50,10);WRITE('   PRIMOLAGER');GOTOXY(67,10);
WRITELN(TRUNC(PRIMOLAG):10);
END;
11:BEGIN
GOTOXY(1,11);WRITE('11 RESERVERET, FYSISK LAGER');GOTOXY(30,11);WRITELN(
                                                      TRUNC(RESAFLAG):10);
END;
END;
END;
PROCEDURE PR2;
BEGIN
WITH VARE DO
CASE O OF
12:BEGIN
GOTOXY(1,12);WRITE('12 MINIMUMSLAGER');GOTOXY(30,12);
WRITELN(TRUNC(MINLAGER):10);
END;
13:BEGIN
GOTOXY(1,13);WRITE('13 I ORDRE');GOTOXY(30,13);WRITELN(TRUNC(IORDRE):10);
END;
14:BEGIN
GOTOXY(1,14);WRITE('14 HERAF RESERVERET');GOTOXY(30,14);
END;
15:BEGIN
WRITELN(TRUNC(RAIORDRE):10);
GOTOXY(50,14);WRITE('15 FORV. LEV. UGE');GOTOXY(67,14);WRITELN(FORVLEVU:10);
END;
16:BEGIN
GOTOXY(1,15);WRITE('16 STØRRELSE AF SIDSTE BEST.');GOTOXY(30,15);WRITELN(
TRUNC(STASBEST):10);
END;
17:BEGIN
GOTOXY(50,15);WRITE('17 SIDST BEST');GOTOXY(67,15);
WRITELN(DATSBES1:5,DATSBES2:5);
END;
18:BEGIN
GOTOXY(1,16);WRITE('18 SIDST SOLGT');GOTOXY(30,16);WRITELN(
DATSORD1:5,DATSORD2:5);
END;
19: IF KODE>0 THEN BEGIN
GOTOXY(1,17);WRITE('19 SOLGT I ÅR');GOTOXY(30,17);
WRITELN(TRUNC(ASOLGTIÅ):10);
END;
20: IF KODE>0 THEN BEGIN
GOTOXY(50,17);WRITE('20 SOLGT S. ÅR');GOTOXY(67,17);
WRITELN(TRUNC(ASOLGTSÅ):10);
END;
21: IF KODE>0 THEN BEGIN
GOTOXY(1,18);WRITE('21 OMS. I ÅR');GOTOXY(30,18);
WRITELN(TRUNC(OMSIÅR):10);
IF (PRIMOLAG+FYSLAGER<>0) AND (OMSIÅR<>0) THEN
BEGIN
GOTOXY(50,1);
WRITELN('GODT TAL ',(PRIMOLAG+FYSLAGER)*DÆKBIDTD/(2*OMSIÅR):12:3)
END;
END;
22: IF KODE>0 THEN BEGIN
GOTOXY(50,18);WRITE('22 OMS. S. ÅR');GOTOXY(67,18);WRITELN(TRUNC(OMSSÅR):10);
END;
23: IF KODE>0 THEN BEGIN
GOTOXY(1,19);WRITE('23 DÆKNINGSBIDRAG TIL DATO');GOTOXY(30,19);WRITELN(
TRUNC(DÆKBIDTD):10);
END;
24: IF KODE>0 THEN BEGIN
GOTOXY(50,19);WRITE('24 DÆK.GRAD S. ÅR');GOTOXY(67,19);WRITELN(DÆKGRASÅ:10);
END;
25:BEGIN
GOTOXY(1,20);WRITE('25 ANDRE AFGANGE-TILGANGE');GOTOXY(30,20);WRITELN(
ANAFTILG:10);
END;
END
END;
BEGIN
  IF O<>0 THEN
  BEGIN
    IF (1<=O) AND (O<=11) THEN PR1
    ELSE
    IF (12<=O) AND (O<=25) THEN PR2
    ELSE
    BEGIN
       CLEARSCREEN;
       FOR O:=1 TO 11 DO PR1;
       FOR O:=12 TO 25 DO PR2
    END
  END
END;
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
PROCEDURE VAREOPL(O:INTEGER);
VAR STRENG:STRING;
    I:INTEGER;
FUNCTION LÆS(X,Y:INTEGER):REAL;
VAR RES:REAL;
BEGIN
  REPEAT
       GOTOXY(X,Y);
       READLN;
       READ(RES)
  UNTIL IORESULT=0;
  LÆS:=RES
END;
BEGIN
  WITH VARE DO
  CASE O OF
    1: REPEAT
       GOTOXY(20,1);READLN;READ(VARENR1)
       UNTIL (VARENR1>999) AND (VARENR1<10000) AND (IORESULT=0);
    2: BEGIN REPEAT
       GOTOXY(30,2);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<31;
       FOR I:= 1 TO LENGTH(STRENG) DO NAVN(1,I):=STRENG(I) END;
    3: BEGIN REPEAT
       GOTOXY(30,3);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<31;
       FOR I:=1 TO LENGTH(STRENG) DO NAVN(2,I):=STRENG(I) END;
    4: 
PRIS:=LÆS(20,4)*100;
    5: 
KOSTPRIS:=LÆS(20,5)*100;
    6: REPEAT
       GOTOXY(20,6);READLN;READ(LVRNDØR)
       UNTIL (IORESULT=0) AND (LVRNDØR>=1) AND (LVRNDØR<10000);
    7: REPEAT
       GOTOXY(20,7);READLN;READ(OPRLAND)
       UNTIL (IORESULT=0) AND (OPRLAND>=0) AND (OPRLAND<100);
    8: BEGIN
TOLDPNR:=LÆS(20,8);
       TOLDPNR:=TOLDPNR*1000
       END;
    9: REPEAT
       GOTOXY(20,9);READLN;READ(PAKENHED)
       UNTIL IORESULT=0;
   10: 
FYSLAGER:=LÆS(20,10);
   11: 
RESAFLAG:=LÆS(20,11);
   12: 
MINLAGER:=LÆS(20,12);
   13: 
IORDRE:=LÆS(20,13);
   14: 
RAIORDRE:=LÆS(20,14);
   15: REPEAT
       GOTOXY(68,14);READLN;READ(FORVLEVU)
       UNTIL (IORESULT=0) AND (FORVLEVU>=0) AND (FORVLEVU<=53);
   16: 
STASBEST:=LÆS(30,15);
   17: REPEAT
       GOTOXY(68,15);READLN;READ(DATSBES1,DATSBES2)
       UNTIL IORESULT=0;
   18: REPEAT
       GOTOXY(31,16);READLN;READ(DATSORD1,DATSORD2)
       UNTIL IORESULT=0;
   19: 
ASOLGTIÅ:=LÆS(30,17);
   20:
ASOLGTSÅ:=LÆS(67,17);
   21: 
OMSIÅR:=LÆS(30,18);
   22: 
OMSSÅR:=LÆS(67,18);
   23: 
DÆKBIDTD:=LÆS(30,19);
   24: REPEAT
       GOTOXY(67,19);READLN;READ(DÆKGRASÅ)
       UNTIL IORESULT=0;
   25: REPEAT
       GOTOXY(30,20);READLN;READ(ANAFTILG)
       UNTIL IORESULT=0
    END
END;
PROCEDURE ZERREC;
BEGIN
  WITH VARE DO
  BEGIN
       VARENR1:=0;
       FILLCHAR(NAVN(1),30,' ');
       FILLCHAR(NAVN(2),30,' ');
       PRIS:=0.0;
       KOSTPRIS:=0.0;
       LVRNDØR:=0;
       OPRLAND:=0;
       TOLDPNR:=0.0;
       PAKENHED:=0;
       FYSLAGER:=0.0;
       PRIMOLAG:=0.0;
       MINLAGER:=0.0;
       RESAFLAG:=0.0;
       IORDRE:=0.0;
       RAIORDRE:=0.0;
       FORVLEVU:=0;
       STASBEST:=0.0;
       DATSBES1:=0;DATSBES2:=0;
       DATSORD1:=0;DATSORD2:=0;
       ASOLGTIÅ:=0.0;
       ASOLGTSÅ:=0.0;
       OMSIÅR:=0.0;
       OMSSÅR:=0.0;
       DÆKBIDTD:=0.0;
       DÆKGRASÅ:=0;
       ANAFTILG:=0
  END
END;
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I VAREREG ',IER);
  ICLOSE(VZ.H,F);
  WRITELN('ICLOSE ',IER);
  STOP
END;
PROCEDURE MAINTAIN;
VAR I,O,P,KODE:INTEGER;
    CHANGED:BOOLEAN;
    STRENG:STRING;
    KODE1,KODE2:STRING(10);  (*KIKKENØGLE,ÆNDRENØGLE*)
BEGIN
  (*INDLÆS KODE1 OG KODE2 FRA SYSREG*)
  KODE2:='PILLEPILLE';
  KODE1:='KIKKEKIKKE';
  CLEARSCREEN;
  GOTOXY(1,1);WRITELN('ADGANGSKODE');
  GOTOXY(20,1);READLN;READ(STRENG);
  KODE:=0;
  IF STRENG=KODE1 THEN KODE:=1;
  IF STRENG=KODE2 THEN KODE:=2;
  REPEAT
  REPEAT
 GOTOXY(1,22);WRITELN('OPRETTE, KIKKE ELLER SLETTE (1/2/3), 0 FOR STOP   ');
       GOTOXY(50,22);READLN;READ(P)
  UNTIL (IORESULT=0) AND((P=1) OR (P=2) OR (P=0) OR (P=3));
  CASE P OF
    1: BEGIN
        ZERREC;
        PRVAROPL(-1,KODE);
        FOR I:=1 TO 10 DO VAREOPL(I);VAREOPL(12);
        PRVAROPL(-1,KODE);
        REPEAT
         GOTOXY(1,22);WRITELN('ÆNDRINGER, 0 FOR NEJ ELLERS FELTNR         ');
         GOTOXY(40,22);READLN;READ(O);
         IF ((O>=1) AND (O<=10)) OR (O=12) THEN VAREOPL(O);
         VARE.PRIMOLAG:=VARE.FYSLAGER;
         PRVAROPL(O,KODE)
        UNTIL O=0;
        REPEAT
        INSERT(VZ.H,F,VARE.A);
        IF IER=-7 THEN
        BEGIN
         GOTOXY(1,23);WRITELN('VARENR FINDES I FORVEJEN ');
         VAREOPL(1)
        END
        ELSE
        IF IER<>0 THEN ERROR
        UNTIL IER=0;
       END;
    2: BEGIN
         REPEAT
          GOTOXY(1,23);WRITELN('VARENR                                    ');
          GOTOXY(30,23);READLN;READ(O)
         UNTIL (IORESULT=0) AND (O>999) AND (O<10000);
         VARE.VARENR1:=O;
         GETREC(VZ.H,F,VARE.A);
         IF IER=-6 THEN WRITELN('VAREN EKSISTERER IKKE')
         ELSE
         IF IER<>0 THEN ERROR
         ELSE
         BEGIN
         PRVAROPL(-1,KODE);
         CHANGED:=FALSE;
         REPEAT
         REPEAT
          GOTOXY(1,22);WRITELN('HVILKET FELT SKAL ÆNDRES, 0 FOR SLUT      ');
          GOTOXY(40,22);READLN;READ(O)
         UNTIL IORESULT=0;
         CASE O OF
               1,10,12 : BEGIN
                               GOTOXY(1,23);
                               WRITELN('ÆNDRING IKKE TILLADT');
                               GOTOXY(25,23);
                               WRITELN('TRYK RETURN NÅR FORSTÅET');
                               GOTOXY(60,23);READLN;READ(STRENG);
                               IF STRENG='A' THEN
                               BEGIN
                                 VAREOPL(O);CHANGED:=TRUE
                               END
                         END;
4,7,8,5,19,20,21,22,23,24: IF KODE=2 THEN
                           BEGIN
                             VAREOPL(O);CHANGED:=TRUE
                           END ELSE
                     BEGIN GOTOXY(1,23);
                     WRITELN('ÆNDRING IKKE TILLADT MED OPGIVEN ADGANGSKODE');
                     END;
2,3,6,9,11,13,14,15,16,17,18,25 :BEGIN VAREOPL(O);CHANGED:=TRUE END
               END;
         PRVAROPL(O,KODE)
         UNTIL O=0;
         IF CHANGED THEN PUTREC(VZ.H,F,VARE.A);
         END
      END;
   3: BEGIN
        REPEAT
          GOTOXY(1,23);WRITELN('VARENR                                    ');
          GOTOXY(30,23);READLN;READ(O)
        UNTIL (IORESULT=0) AND (O>999) AND (O<10000);
        VARE.VARENR1:=O;
        GETREC(VZ.H,F,VARE.A);
        IF IER=-6 THEN WRITELN('VAREN EKSISTERER IKKE')
        ELSE
        IF IER<>0 THEN ERROR
        ELSE
        BEGIN
          PRVAROPL(-1,KODE);
          IF KODE=2 THEN
          WITH VARE DO
          BEGIN
            IF (FYSLAGER=0) AND (RESAFLAG=0) AND (IORDRE=0) AND (RAIORDRE=0)
            THEN BEGIN
               REPEAT
               GOTOXY(1,23);WRITELN('SKAL SLETNING UDFØRES (1), 0 FOR NEJ ');
               GOTOXY(40,23);READLN;READ(O)
               UNTIL (IORESULT=0) AND ((O=0) OR (O=1));
               IF O=1 THEN
               BEGIN
                 DELETE(VZ.H,F,VARE.A);
                 PRVAROPL(-1,KODE);
                 IF IER<>0 THEN ERROR
               END
            END
            ELSE
            BEGIN
               GOTOXY(1,23);
           WRITELN('VAREN MÅ IKKE SLETTES P.GR.A. POSITIVE LAGER/ORDRE-TAL')
            END
            END
            ELSE
            BEGIN
               GOTOXY(1,23);
               WRITELN('SLETNING MÅ IKKE UDFØRES MED OPGIVEN NØGLE')
            END
         END
      END
   END
   UNTIL P=0
END;
BEGIN
WRITELN('A');READLN;
  FILNAVN2:='REGVARE:P2:1137:I';
  REWRITE(F,FILNAVN2);
  I:=IORESULT;
IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;
  FILNAVN2:='REGVARE:P1:1137:I';
  REWRITE(F1,FILNAVN2);
  IOPEN(VZ1.H,F1,SKRIV);
  INITIATE(VZ1.H,F1,900);
  IOPEN(VZ.H,F,LÆS);
IF IER<>0 THEN WRITE('IOPEN ',IER) ELSE
WITH VARE DO
BEGIN
  VARENR1:=0;
  I:=0;
  NEXTREC(VZ.H,F,A);
  REPEAT
    INSERT(VZ1.H,F1,A);
    I:=I+1;
    WRITELN(VARENR1);
    IF VARENR1<1010 THEN
    NEXTREC(VZ.H,F,A)
  UNTIL VARENR1=1010;
  VARENR1:=1015;
  GETREC(VZ.H,F,A);
  REPEAT
    INSERT(VZ1.H,F1,A);
    I:=I+1;
    WRITELN(VARENR1);
    NEXTREC(VZ.H,F,A)
  UNTIL IER<>0;
END;
  ICLOSE(VZ.H,F);
  ICLOSE(VZ1.H,F1);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER,I:7)
END.

Full view