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

⟦e02c09ff1⟧ TextFile

    Length: 20352 (0x4f80)
    Types: TextFile
    Notes: Mikados_K
    Names: »FORKALK.K«

Derivation

└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
    └─⟦this⟧ »FORKALK.K« 

Mikados K File

PROGRAM FORKALK;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
VAR    PARM:^PARMARRAY;
       USERNIVEAU:NIVEAU;
       QUQ:^INTEGER;
       I:INTEGER;
       FNAVN,DESCNAVN:STRING;
(*$P*)
PROCEDURE REGVEDL;
CONST MAXFELTER=30;
      MAXNØGLER=9;
      MORDREZ=295;
      MOPLINZ=370;
      MOPERAZ=257;
(*$IISFHEAD*)
ORDREZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MORDREZ) OF INTEGER
END;
OPLINZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MOPLINZ) OF INTEGER
END;
OPERAZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MOPERAZ) OF INTEGER
END;
NFELT=^FELTBESKRIVELSE;
SKÆRMPOS=RECORD
   X,Y:INTEGER
END;
FTYPE=(HELTAL,DOBBTAL,REEL,TEKST);
VTYPE=(HINTERVAL,DINTERVAL,RINTERVAL,DATO,CPR);
BESKRIVELSESTYPE=(FELTDESC,VALIDESC);
FELTBESKRIVELSE=RECORD
   NÆSTEVAL:NFELT;
   CASE DESCTYPE:BESKRIVELSESTYPE OF
   FELTDESC:
  (INDPOS,UDPOS:SKÆRMPOS;
   KIKKENIVEAU,ÆNDRENIVEAU:NIVEAU;
   EDITERING:INTEGER;
   LEDETEKST,FØLGETEKST:STRING;
   INDEKS:INTEGER;
   LÆNGDE:INTEGER;
   FORAN0:INTEGER;
   CASE FELTTYPE:FTYPE OF
   REEL:(DEC:INTEGER);
   HELTAL,DOBBTAL,TEKST:());
   VALIDESC:
  (CASE VALIDITETSTYPE:VTYPE OF
      HINTERVAL:(MIN,MAX:INTEGER);
      DINTERVAL:(MIN1,MIN2,MAX1,MAX2:INTEGER);
      RINTERVAL:(RMIN,RMAX:REAL);
      DATO,CPR:())
END;
FELTFIL=FILE OF FELTBESKRIVELSE;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
ORDREPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      ANTALBESTILT,
      MATERIALEPRIS,
      SALGSPRIS,
      FAKTOR        :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR    :INTEGER
END;
OPLINPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      MINUTFAKTOR   :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR,
      OPERATIONSNR,
      CENTIMER      :INTEGER
END;
OPERAPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      OPERATIONSNR,
      GRUPPE        :INTEGER;
      BETEGNELSE    :PACKED ARRAY (1..30) OF CHAR
END;
SYSPOST=RECORD
      MINUTFAKTOR:ARRAY (1..5) OF REAL;
      DAT1,DAT2:INTEGER
END;
SYSFILE=FILE OF SYSPOST;
VAR FELT:NFELT;
    SF:SYSFILE;
    HUSKNIV:NIVEAU;
    PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
    DAT1,DAT2,OPTION,IER,I,J,ANTALFELTER,FELTNR:INTEGER;
    CH:STRING(1);
    LINE:STRING;
    FFIL:FELTFIL;
    ORF,OPF,OAF:ISF;
    ORZ:ORDREZONE;
    OPZ:OPLINZONE;
    OAZ:OPERAZONE;
    ORPOST:ORDREPOST;
    OPPOST:OPLINPOST;
    OAPOST:OPERAPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(ORZ.H,ORF);
  ICLOSE(OPZ.H,OPF);
  ICLOSE(OAZ.H,OAF);
  EXIT(REGVEDL)
END;
PROCEDURE OFEJL(VAR FIL:FILNAVN);
VAR I:INTEGER;
BEGIN
  GOTOXY(1,20);
  WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . 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(FIL);
  CLEARSCREEN
END;
(*$P*)
PROCEDURE LÆSDESC;
BEGIN
  REWRITE(FFIL,DESCNAVN);
 
  GET(FFIL);
  I:=0;
  WHILE FFIL^.INDPOS.X>0 DO
  BEGIN
    I:=I+1;
    CASE FFIL^.FELTTYPE OF
    REEL:NEW(PICTURE(I),FELTDESC,REEL);
    HELTAL,DOBBTAL,TEKST:NEW(PICTURE(I),FELTDESC,HELTAL)
    END;
    FELT:=PICTURE(I);
    WITH PICTURE(I)^ DO
    BEGIN
      DESCTYPE:=FELTDESC;
      INDPOS.X:=FFIL^.INDPOS.X;
      INDPOS.Y:=FFIL^.INDPOS.Y;
      UDPOS.X:=FFIL^.UDPOS.X;
      UDPOS.Y:=FFIL^.UDPOS.Y;
      KIKKENIVEAU:=FFIL^.KIKKENIVEAU;
      ÆNDRENIVEAU:=FFIL^.ÆNDRENIVEAU;
      LEDETEKST:=FFIL^.LEDETEKST;
      FØLGETEKST:=FFIL^.FØLGETEKST;
      EDITERING:=FFIL^.EDITERING;
      FELTTYPE:=FFIL^.FELTTYPE;
      INDEKS:=FFIL^.INDEKS;
      LÆNGDE:=FFIL^.LÆNGDE;
      FORAN0:=FFIL^.FORAN0;
      IF FELTTYPE=REEL THEN DEC:=FFIL^.DEC;
      WHILE FFIL^.NÆSTEVAL<>NIL DO
      BEGIN
        GET(FFIL);
        WITH FELT^ DO
        CASE FFIL^.VALIDITETSTYPE OF
          HINTERVAL:BEGIN
                      NEW(NÆSTEVAL,VALIDESC,HINTERVAL);
                      NÆSTEVAL^.MIN:=FFIL^.MIN;
                      NÆSTEVAL^.MAX:=FFIL^.MAX
                    END;
          DINTERVAL:BEGIN
                      NEW(NÆSTEVAL,VALIDESC,DINTERVAL);
                      NÆSTEVAL^.MIN1:=FFIL^.MIN1;NÆSTEVAL^.MIN2:=FFIL^.MIN2;
                      NÆSTEVAL^.MAX1:=FFIL^.MAX1;NÆSTEVAL^.MAX2:=FFIL^.MAX2
                    END;
          RINTERVAL:BEGIN
                      NEW(NÆSTEVAL,VALIDESC,RINTERVAL);
                      NÆSTEVAL^.RMIN:=FFIL^.RMIN;
                      NÆSTEVAL^.RMAX:=FFIL^.RMAX
                    END;
          DATO,CPR:NEW(NÆSTEVAL,VALIDESC,DATO)
        END;
        FELT:=FELT^.NÆSTEVAL;
        FELT^.DESCTYPE:=VALIDESC;
        FELT^.VALIDITETSTYPE:=FFIL^.VALIDITETSTYPE
      END;
      FELT^.NÆSTEVAL:=NIL
    END;
    GET(FFIL)
  END;
  CLOSE(FFIL);
  ANTALFELTER:=I
END;
(*$P*)
PROCEDURE LÆSFELT(VAR F:NFELT);
VAR I,TAL,TAL1:INTEGER;
    VAL:NFELT;
    RESULT:REAL;
    BUMMED:BOOLEAN;
 
(*$P*)
PROCEDURE LÆSLINIE;
VAR OK:BOOLEAN;
    DECS,I,FORTEGN:INTEGER;
    DM:REAL;
 
BEGIN
  REPEAT
    OK:=FALSE;
    RESULT:=0.0;
    TAL:=0;
    TAL1:=0;
    GOTOXY(F^.INDPOS.X,F^.INDPOS.Y);
    WRITELN(F^.LEDETEKST,' ':F^.LÆNGDE+2,F^.FØLGETEKST);
    GOTOXY(F^.INDPOS.X+LENGTH(F^.LEDETEKST)+1,F^.INDPOS.Y);
    LINE:='0';
    EDIT(LINE:F^.LÆNGDE);
    WHILE LINE(LENGTH(LINE))=' ' DO LINE(0):=CHR(ORD(LINE(0))-1);
    CASE F^.FELTTYPE OF
TEKST:
    IF LENGTH(LINE)<=F^.LÆNGDE THEN
    BEGIN
      OK:=TRUE;
      WHILE LENGTH(LINE)<F^.LÆNGDE DO
        IF F^.FORAN0=0 THEN
          LINE:=CONCAT(LINE,' ')
        ELSE
          LINE:=CONCAT(' ',LINE)
    END;
HELTAL,DOBBTAL:
    IF LENGTH(LINE)>0 THEN
    BEGIN
      I:=0;
      FORTEGN:=1;
      IF LINE(1)='-' THEN
      BEGIN
        FORTEGN:=-1;
        I:=1
      END;
      WHILE LENGTH(LINE)>I DO
      BEGIN
        OK:=TRUE;
        I:=I+1;
        IF NOT (LINE(I) IN (.'0'..'9'.)) THEN
        BEGIN
          OK:=FALSE;
          I:=LENGTH(LINE)
        END;
        RESULT:=10*RESULT+ORD(LINE(I))-48
      END;
      RESULT:=RESULT*FORTEGN;
      IF OK THEN
      CASE F^.FELTTYPE OF
      HELTAL:IF ABS(RESULT)<=32767 THEN TAL:=TRUNC(RESULT) ELSE OK:=FALSE;
      DOBBTAL:IF ABS(RESULT)<=327679999.0 THEN
              BEGIN
                TAL:=TRUNC(RESULT/10000.0);
                TAL1:=TRUNC(RESULT-10000.0*TAL)
              END
              ELSE OK:=FALSE
      END
    END ELSE OK:=TRUE;
REEL:
    IF LENGTH(LINE)>0 THEN
    BEGIN
      I:=0;
      FORTEGN:=1;
      DECS:=-1;
      IF LINE(1)='-' THEN
      BEGIN
        FORTEGN:=-1;
        I:=1
      END;
      WHILE (LENGTH(LINE)>I) AND (DECS<0) DO
      BEGIN
        OK:=TRUE;
        I:=I+1;
        IF LINE(I) IN (.'0'..'9'.) THEN
          RESULT:=10*RESULT+ORD(LINE(I))-48
        ELSE
        IF (LINE(I)='.') OR (LINE(I)=',') THEN
          DECS:=0
        ELSE
        BEGIN
          OK:=FALSE;
          I:=LENGTH(LINE)
        END
      END;
      DM:=1.0;
      WHILE LENGTH(LINE)>I DO
      BEGIN
        I:=I+1;
        DM:=DM/10.0;
        IF LINE(I) IN (.'0'..'9'.) THEN
        BEGIN
          RESULT:=RESULT+DM*(ORD(LINE(I))-48);
          DECS:=DECS+1
        END
        ELSE
        BEGIN
          OK:=FALSE;
          I:=LENGTH(LINE)
        END
      END;
      RESULT:=FORTEGN*RESULT;
      IF DECS>F^.DEC THEN OK:=FALSE
    END
    ELSE OK:=TRUE
    END
  UNTIL OK
END;
(*$P*)
PROCEDURE CHECKVAL;
VAR I,DAT0,MÅNED,ÅR,MODULC:INTEGER;
    CPN:ARRAY (1..10) OF INTEGER;
BEGIN
  CASE VAL^.VALIDITETSTYPE OF
  HINTERVAL:
    BUMMED:=((TAL<VAL^.MIN) OR (TAL>VAL^.MAX));
  DINTERVAL:
    BUMMED:=((TAL*10000.0+TAL1<VAL^.MIN1*10000.0+VAL^.MIN2) OR
             (TAL*10000.0+TAL1>VAL^.MAX1*10000.0+VAL^.MAX2));
  RINTERVAL:
    BUMMED:=((RESULT<VAL^.RMIN) OR (RESULT>VAL^.RMAX));
  DATO:
    IF LENGTH(LINE)=6 THEN
    BEGIN
      ÅR:=10*(ORD(LINE(1))-48)+ORD(LINE(2))-48;
      MÅNED:=10*(ORD(LINE(3))-48)+ORD(LINE(4))-48;
      DAT0:=10*(ORD(LINE(5))-48)+ORD(LINE(6))-48;
      IF (DAT0<1) OR (MÅNED<1) OR (MÅNED>12) OR (DAT0>31) THEN BUMMED:=TRUE;
      IF NOT BUMMED THEN
      CASE MÅNED OF
      4,6,9,11: IF DAT0>30 THEN BUMMED:=TRUE;
      2: IF (DAT0>29) OR ((DAT0=29) AND (ÅR MOD 4 <>0)) THEN BUMMED:=TRUE
      END
    END
    ELSE BUMMED:=TRUE;
  CPR:
    IF LENGTH(LINE)=10 THEN
    BEGIN
      FOR I:=1 TO 10 DO CPN(I):=ORD(LINE(I))-48;
      DAT0:=CPN(1)*10+CPN(2);
      MÅNED:=CPN(3)*10+CPN(4);
      ÅR:=CPN(5)*10+CPN(6);
      IF (DAT0<1) OR (MÅNED<1) OR (MÅNED>12) OR (DAT0>31) THEN BUMMED:=TRUE;
      IF NOT BUMMED THEN
      CASE MÅNED OF
      4,6,9,11: IF DAT0>30 THEN BUMMED:=TRUE;
      2: IF (DAT0>29) OR ((DAT0=29) AND (ÅR MOD 4<>0)) THEN BUMMED:=TRUE
      END;
      IF NOT BUMMED THEN
      BEGIN
      MODULC:=CPN(1)*4+CPN(2)*3+CPN(3)*2+CPN(4)*7+CPN(5)*6+CPN(6)*5+CPN(7)*4+
              CPN(8)*3+CPN(9)*2+CPN(10);
        IF MODULC MOD 11<>0 THEN BUMMED:=TRUE
      END
    END
    ELSE BUMMED:=TRUE;
  END
END;
(*$P*)
(*PROCEDURE LÆSFELT*)
BEGIN
  REPEAT
    LÆSLINIE;
    VAL:=F^.NÆSTEVAL;
    BUMMED:=FALSE;
    WHILE (VAL<>NIL) AND (NOT BUMMED) DO
    BEGIN
      CHECKVAL;
      VAL:=VAL^.NÆSTEVAL
    END;
    IF NOT BUMMED THEN
    CASE FELTNR OF
    7:IF TAL<>0 THEN
      BEGIN
        OAPOST.OPERATIONSNR:=TAL MOD 100;
        GETREC(OAZ.H,OAF,OAPOST.A);
        IF (IER<>0) AND (IER<>-6) THEN ERROR(OAZ.H.FILENAME);
        BUMMED:=(IER=-6)
      END
    END
  UNTIL NOT BUMMED;
  CASE FELTNR OF
  3,4,5,6:ORPOST.AAA(F^.INDEKS):=RESULT;
  1      :ORPOST.A(F^.INDEKS):=TAL;
  2      :BEGIN
            ORPOST.A(F^.INDEKS):=TAL;
            ORPOST.A(F^.INDEKS+1):=TAL1
          END;
  7,8    :OPPOST.A(F^.INDEKS):=TAL;
  9      :OPPOST.MINUTFAKTOR:=SF^.MINUTFAKTOR(TAL);
  10     :BEGIN
            DAT1:=TAL;
            DAT2:=TAL1
          END
  END
END;
(*$P*)
PROCEDURE MAINTAIN;
VAR CH:STRING(1);
    LØN,LØNSUM:REAL;
PROCEDURE KALKULATION;
BEGIN
  WRITELN(LIST,'OPERATION',' ':31,'1/100 TIMER  MINUT-',' ':12,'LØN');
  WRITELN(LIST,'NUMMER    BETEGNELSE',' ':20,'PR.ENHED IA  FAKTOR');
  LØNSUM:=0.0;
  OPPOST.ORDRENR:=ORPOST.ORDRENR;
  OPPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
  OPPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
  OPPOST.OPERATIONSNR:=0;
  NEXTREC(OPZ.H,OPF,OPPOST.A);
  IF (IER<>-1) AND (IER<>-2) THEN ERROR(OPZ.H.FILENAME) ELSE IER:=0;
  WHILE (IER=0) AND (OPPOST.ORDRENR=ORPOST.ORDRENR) AND
        (OPPOST.PRODUKT1NR=ORPOST.PRODUKT1NR) AND
        (OPPOST.PRODUKT2NR=ORPOST.PRODUKT2NR) DO
  BEGIN
    OAPOST.OPERATIONSNR:=OPPOST.OPERATIONSNR MOD 100;
    GETREC(OAZ.H,OAF,OAPOST.A); IF IER<>0 THEN ERROR(OAZ.H.FILENAME);
    LØN:=OPPOST.CENTIMER*OPPOST.MINUTFAKTOR;
    LØNSUM:=LØNSUM+LØN;
    WRITELN(LIST,OPPOST.OPERATIONSNR:5,' ':5,OAPOST.BETEGNELSE,
                     OPPOST.CENTIMER:4,
                     ORPOST.ANTALBESTILT*OPPOST.CENTIMER:7:-2,
                     OPPOST.MINUTFAKTOR:8:2,LØN:15:2);
    NEXTREC(OPZ.H,OPF,OPPOST.A)
  END;
  IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN ERROR(OPZ.H.FILENAME);
  WRITELN(LIST);
  WRITELN(LIST,'LØN I ALT',' ':50,LØNSUM:15:2);
  WRITELN(LIST,'SAMLET PRIS PR. ENHED',' ':39,(ORPOST.MATERIALEPRIS+
               LØNSUM)*ORPOST.FAKTOR:14:2);
  PAGE(LIST)
END;
(*$P*)
BEGIN
  REPEAT
    CLEARSCREEN;
    FOR FELTNR:=1 TO 2 DO LÆSFELT(PICTURE(FELTNR));
    INSERT(ORZ.H,ORF,ORPOST.A);
    IF (IER<>0) AND (IER<>-7) THEN ERROR(ORZ.H.FILENAME);
    IF IER=-7 THEN
    BEGIN
      CH:='N';
      GOTOXY(1,22);
      WRITELN('ORDRE-PRODUKTNR KOMBINATIONEN FINDES ALLEREDE');
      WRITELN('Ønskes: Nyt nr : N, nyindtastning af Gl.nr : G,',
              ' Tilføjelse til gl.nr : T');
      GOTOXY(76,23);EDIT(CH)
    END
    ELSE CH:='G'
  UNTIL (CH='G') OR (CH='T');
  GOTOXY(1,22);WRITELN(' ':77);WRITELN(' ':77);
  IF CH='G' THEN
  BEGIN
    FOR FELTNR:=3 TO 6 DO LÆSFELT(PICTURE(FELTNR));
    PUTREC(ORZ.H,ORF,ORPOST.A);
    IF IER<>0 THEN ERROR(OAZ.H.FILENAME)
  END
  ELSE
  BEGIN
    GETREC(ORZ.H,ORF,ORPOST.A); IF IER<>0 THEN ERROR(ORZ.H.FILENAME)
  END;
  FELTNR:=10;LÆSFELT(PICTURE(FELTNR));
  WRITELN(LIST);WRITELN(LIST);
  WRITELN(LIST,'FORKALKULATION',' ':20,'Leveringsdato',DAT1*10000.0+
                                                       DAT2:8:-2,' ':7,
               'Dato',
                SF^.DAT1*10000.0+SF^.DAT2:8:-2);
  WRITELN(LIST);
  WRITELN(LIST,'ORDRE-   PRODUKT       ANTAL    MATERIALEPRIS     ',
               '            KALKULATIONS');
  WRITELN(LIST,'NUMMER   -NUMMER       BESTILT',' ':37,'-FAKTOR');
  WRITELN(LIST,ORPOST.ORDRENR:6,
               ORPOST.PRODUKT1NR*10000.0+ORPOST.PRODUKT2NR:10:-2,
               ORPOST.ANTALBESTILT:14:-2,
               ORPOST.MATERIALEPRIS:15:2,
               ORPOST.FAKTOR:29:2);
  WRITELN(LIST);
  REPEAT
    FELTNR:=7;
    LÆSFELT(PICTURE(FELTNR));
    IF OPPOST.OPERATIONSNR<>0 THEN
    BEGIN
      OPPOST.ORDRENR:=ORPOST.ORDRENR;
      OPPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
      OPPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
      INSERT(OPZ.H,OPF,OPPOST.A);
      IF (IER<>0) AND (IER<>-7) THEN ERROR(OPZ.H.FILENAME);
      IF IER=-7 THEN
      BEGIN
        CH:='N';
        GOTOXY(1,22);
        WRITELN('ORDRE-PRODUKT-OPERATION-NR KOMBINATIONEN FINDES ALLEREDE');
        WRITELN('Ønskes: Nyt operationsnr: N, nyindtastning af Gl.',
                ' operationsnr : G');
        GOTOXY(68,23);EDIT(CH);GOTOXY(1,22);WRITELN(' ':77);WRITELN(' ':77)
      END
      ELSE CH:='G';
      IF CH='G' THEN
      BEGIN
        GOTOXY(30,5);
        WRITELN(OAPOST.BETEGNELSE);
        FOR FELTNR:=8 TO 9 DO LÆSFELT(PICTURE(FELTNR));
        PUTREC(OPZ.H,OPF,OPPOST.A);
        IF IER<>0 THEN ERROR(OPZ.H.FILENAME);
      END
    END;
    GOTOXY(1,5);WRITELN(' ':77);WRITELN(' ':77);WRITELN(' ':77)
  UNTIL OPPOST.OPERATIONSNR=0;
  WRITELN(LIST);
  KALKULATION
END;
(*$P*)
BEGIN
  CLEARSCREEN;
 
  FNAVN:='SYSREG:P2:1:I';
  REWRITE(SF,FNAVN);
  SEEK(SF,1);
  GET(SF);
  ORZ.H.FILENAME:='ORDREREG';
  FNAVN:='ORDREREG:P2:0000:I';
  REWRITE(ORF,FNAVN);
  IOPEN(ORZ.H,ORF,SKRIV);IF IER<>0 THEN OFEJL(ORZ.H.FILENAME);
  OPZ.H.FILENAME:='OPLINREG';
  FNAVN:='OPLINREG:P2:0000:I';
  REWRITE(OPF,FNAVN);
  IOPEN(OPZ.H,OPF,SKRIV);IF IER<>0 THEN OFEJL(OPZ.H.FILENAME);
  OAZ.H.FILENAME:='OPERAREG';
  FNAVN:='OPERAREG:P2:0000:I';
  REWRITE(OAF,FNAVN);
  IOPEN(OAZ.H,OAF,LÆS);IF IER<>0 THEN OFEJL(OAZ.H.FILENAME);
(*$XT*) WRITELN('MEMAVAIL ',MEMAVAIL); (*$X-*)
  DESCNAVN:='FORKDESC:P2:0:J';
  LÆSDESC;
(*$XT*) WRITELN('MEMAVAIL ',MEMAVAIL);READLN; (*$X-*)
  REPEAT
    CH:='J';
    GOTOXY(1,23);
    WRITELN('Flere forkalkulationer J/N');
    GOTOXY(28,23);EDIT(CH);
    IF CH='J' THEN MAINTAIN
  UNTIL CH='N';
  ICLOSE(ORZ.H,ORF);
  ICLOSE(OPZ.H,OPF);
  ICLOSE(OAZ.H,OAF);
  WRITELN('ICLOSE ',IER)
END;
(*$P*)
BEGIN
  I:=ORD(PARM^(1))-48;
  USERNIVEAU:=MENIG;
  WHILE I>0 DO
  BEGIN
    USERNIVEAU:=SUCC(USERNIVEAU);
    I:=I-1
  END;
  REGVEDL;
  FNAVN:=' ';
  FNAVN(1):=PARM^(1);
  CHAIN('L       *1',CONCAT('HOVED:P2,',FNAVN),QUQ);
  IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.

Full view