DataMuseum.dk

top - download

    Length: 18720 (0x4920)
    Types: TextFile
    Notes: Mikados_K
    Names: »REGVEDL.K«

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

Mikados K File

PROGRAM REGVEDL;
CONST MAXFELTER=30;
      MAXNØGLER=9;
      MAXZONE=1000;
      MAXPOST=250;
(*$IISFHEAD*)
ZZONE   =RECORD
        H:ISFHEAD;
        T:ARRAY(1..MAXZONE) OF INTEGER
END;
NFELT=^FELTBESKRIVELSE;
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
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;
PPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      CONTENTS: ARRAY (1..MAXPOST) OF INTEGER
END;
PARMARRAY=PACKED ARRAY (1..40) OF CHAR;
CLOCKRECORD=RECORD
             DATE:PACKED ARRAY (1..10) OF CHAR;
             TIME:PACKED ARRAY (1..8) OF CHAR
END;
VAR PARM:^PARMARRAY;
    CLOCK:^CLOCKRECORD;
    FELT:NFELT;
    USERNIVEAU,HUSKNIV:NIVEAU;
    PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
    NØGLER:ARRAY (1..MAXNØGLER) OF NFELT;
    OPTION,IER,I,J,ANTALFELTER,ANTALNØGLER:INTEGER;
    CH:STRING(1);
    REGNAVN,LINE:STRING;
    FFIL:FELTFIL;
    FNAVN:STRING;
       REGISTER:ISF;
       ZONE:ZZONE;
       POST:PPOST;
       QUQ:^INTEGER;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IINITIATE*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(ZONE.H,REGISTER);
  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,FNAVN);
 
  GET(FFIL);
  I:=0;
  ANTALNØGLER:=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;
      IF ÆNDRENIVEAU=UMULIUS THEN
      BEGIN
        ANTALNØGLER:=ANTALNØGLER+1;
        NØGLER(ANTALNØGLER):=PICTURE(I)
      END;
      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 MOVETOLINE(VAR F:NFELT);
VAR CH:STRING(1);
    TAL,DECS,I:INTEGER;
    RESULT,DM,DD:REAL;
BEGIN
  CH:=' ';
      CASE F^.FELTTYPE OF
      HELTAL:BEGIN
               LINE:='';
               TAL:=ABS(POST.A(F^.INDEKS));
               REPEAT
                 CH(1):=CHR(TAL MOD 10+48);
                 LINE:=CONCAT(CH,LINE);
                 TAL:=TAL DIV 10
               UNTIL TAL=0;
               WHILE LENGTH(LINE)<F^.FORAN0 DO LINE:=CONCAT('0',LINE);
               IF POST.A(F^.INDEKS)<0 THEN LINE:=CONCAT('-',LINE)
             END;
     DOBBTAL:BEGIN
               LINE:='';
               RESULT:=ABS(POST.A(F^.INDEKS)*10000.0+POST.A(F^.INDEKS+1));
               DM:=100000000.0;
               REPEAT
                 I:=TRUNC(RESULT/DM)+48;
                 RESULT:=RESULT-DM*(I-48);
                 DM:=DM/10
               UNTIL (I>48) OR (DM<1.0);
               REPEAT
                 CH(1):=CHR(I);
                 LINE:=CONCAT(LINE,CH);
                 I:=TRUNC(RESULT/DM)+48;
                 RESULT:=RESULT-DM*(I-48);
                 DM:=DM/10.0
               UNTIL DM<0.09;
               WHILE LENGTH(LINE)<F^.FORAN0 DO LINE:=CONCAT('0',LINE);
               IF POST.A(F^.INDEKS)*10000.0+POST.A(F^.INDEKS+1)<0.0 THEN
                 LINE:=CONCAT('-',LINE)
             END;
       TEKST:BEGIN
               LINE:='';
               FOR I:=F^.INDEKS TO F^.INDEKS+F^.LÆNGDE-1 DO
               BEGIN
                 CH(1):=POST.AA(I);
                 LINE:=CONCAT(LINE,CH)
               END
             END;
        REEL:BEGIN
               RESULT:=ABS(POST.AAA(F^.INDEKS));
               DECS:=F^.DEC;
               IF DECS=0 THEN
                 DD:=0.0
               ELSE
               BEGIN
                 DD:=0.1;
                 FOR I:=1 TO DECS DO BEGIN RESULT:=RESULT*10.0;DD:=DD*10 END
               END;
               LINE:='';
               IF F^.FORAN0=0 THEN
               BEGIN
                 DM:=100000000000.0;
                 REPEAT
                   I:=TRUNC(RESULT/DM)+48;
                   RESULT:=RESULT-DM*(I-48);
                   DM:=DM/10.0
                 UNTIL (I>48) OR (DM<1.0)
               END
               ELSE
               BEGIN
                 DM:=1.0;
                 FOR I:=2 TO F^.FORAN0 DO DM:=DM*10.0;
                 I:=TRUNC(RESULT/DM)+48;
                 RESULT:=RESULT-DM*(I-48);
                 DM:=DM/10.0
               END;
               REPEAT
                 CH(1):=CHR(I);
                 LINE:=CONCAT(LINE,CH);
                 IF DM=DD THEN LINE:=CONCAT(LINE,'.');
                 I:=TRUNC(RESULT/DM)+48;
                 RESULT:=RESULT-DM*(I-48);
                 DM:=DM/10.0
               UNTIL DM<0.09;
               IF POST.AAA(F^.INDEKS)<0.0 THEN LINE:=CONCAT('-',LINE)
             END
      END
END;
(*$P*)
PROCEDURE NULPOST;
VAR I,J:INTEGER;
BEGIN
  FOR J:=1 TO ANTALFELTER DO WITH PICTURE(J)^ DO
  BEGIN
    CASE FELTTYPE OF
    HELTAL:POST.A(INDEKS):=0;
    DOBBTAL:BEGIN
              POST.A(INDEKS):=0;
              POST.A(INDEKS+1):=0
            END;
    REEL:POST.AAA(INDEKS):=0.0;
    TEKST:FOR I:=INDEKS TO LÆNGDE+INDEKS-1 DO
            POST.AA(I):=' ';
    END
  END
END;
 
PROCEDURE SKRIVFELT(VAR F:NFELT);
BEGIN
 IF USERNIVEAU>=F^.KIKKENIVEAU THEN
 BEGIN
  GOTOXY(F^.UDPOS.X,F^.UDPOS.Y);
  WRITE(F^.LEDETEKST,' ');
  MOVETOLINE(F);
  WRITELN(LINE);
 END
END;
 
PROCEDURE SKRIVPOST;
VAR I:INTEGER;
BEGIN
  CLEARSCREEN;
  FOR I:=1 TO ANTALFELTER DO SKRIVFELT(PICTURE(I));
END;
 
PROCEDURE PRINTPOST;
VAR I:INTEGER;
BEGIN
  PAGE(LIST);
  WRITELN(LIST,REGNAVN,' UDSKRIFT');
  WRITELN(LIST);
  FOR I:=1 TO ANTALFELTER DO
  BEGIN
    WRITE(LIST,PICTURE(I)^.LEDETEKST,' ');
    MOVETOLINE(PICTURE(I));
    WRITELN(LIST,LINE)
  END
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);
    IF F^.EDITERING=0 THEN
    BEGIN
      READLN;READ(LINE)
    END
    ELSE
    BEGIN
      MOVETOLINE(F);
      EDIT(LINE:F^.LÆNGDE);
      WHILE LINE(LENGTH(LINE))=' ' DO LINE(0):=CHR(ORD(LINE(0))-1)
    END;
    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
 IF USERNIVEAU>=F^.ÆNDRENIVEAU THEN
 BEGIN
  REPEAT
    LÆSLINIE;
    VAL:=F^.NÆSTEVAL;
    BUMMED:=FALSE;
    WHILE (VAL<>NIL) AND (NOT BUMMED) DO
    BEGIN
      CHECKVAL;
      VAL:=VAL^.NÆSTEVAL
    END
  UNTIL NOT BUMMED;
  CASE F^.FELTTYPE OF
  HELTAL:POST.A(F^.INDEKS):=TAL;
  DOBBTAL:BEGIN
            POST.A(F^.INDEKS):=TAL;
            POST.A(F^.INDEKS+1):=TAL1
          END;
  REEL:POST.AAA(F^.INDEKS):=RESULT;
  TEKST:FOR I:=1 TO F^.LÆNGDE DO
            POST.AA(I+F^.INDEKS-1):=LINE(I)
  END
 END
END;
(*$P*)
PROCEDURE MAINTAIN;
VAR J:INTEGER;
    CH:STRING(1);
BEGIN
      CLEARSCREEN;
      IF OPTION<>4 THEN
      BEGIN
        HUSKNIV:=USERNIVEAU;
        USERNIVEAU:=UMULIUS;
        NULPOST;
        FOR J:=1 TO ANTALNØGLER DO LÆSFELT(NØGLER(J));
        USERNIVEAU:=HUSKNIV;
        GETREC(ZONE.H,REGISTER,POST.A);
        IF (IER<>0) AND (IER<>-6) THEN ERROR(ZONE.H.FILENAME);
      END;
      CASE OPTION OF
        1: IF IER=0 THEN
           BEGIN
             SKRIVPOST;
             REPEAT
               REPEAT
                 GOTOXY(1,23);
                 J:=0;
                 WRITELN('Feltnr, 0 for færdig ',J);
                 GOTOXY(22,23);READLN;
                 IF NOT (EOLN OR (INPUT^=' ')) THEN READ(J)
               UNTIL (IORESULT=0) AND (J>=0) AND (J<=ANTALFELTER);
               IF J>0 THEN LÆSFELT(PICTURE(J))
             UNTIL J=0;
             PUTREC(ZONE.H,REGISTER,POST.A);
             IF IER<>0 THEN ERROR(ZONE.H.FILENAME)
           END
           ELSE
           BEGIN
             WRITELN('Post findes ikke, tryk RETURN');
             READLN
           END;
        2: IF IER=0 THEN
           BEGIN
             SKRIVPOST;
             WRITELN('Tryk RETURN');READLN
           END
           ELSE
           BEGIN
             WRITELN('Post findes ikke, tryk RETURN');READLN
           END;
        3: IF IER=0 THEN
             PRINTPOST
           ELSE BEGIN WRITELN('Post findes ikke, tryk RETURN');READLN END;
        4: BEGIN
             NULPOST;
             SKRIVPOST;
             HUSKNIV:=USERNIVEAU;
             USERNIVEAU:=UMULIUS;
             FOR J:=1 TO ANTALFELTER DO LÆSFELT(PICTURE(J));
             USERNIVEAU:=HUSKNIV;
             IF (NOT ZONE.H.FILEINIT) AND (ZONE.H.RECINUSE=0) THEN
             BEGIN
               GOTOXY(1,23);
               WRITELN('ANTAL INITIALISERINGSPOSTER');
               GOTOXY(30,23);
               READLN;READ(J);
               INITIATE(ZONE.H,REGISTER,J);
               IF IER<>0 THEN ERROR(ZONE.H.FILENAME)
             END;
             INSERT(ZONE.H,REGISTER,POST.A);
             IF IER<>0 THEN
             IF IER=-7 THEN
             BEGIN
               WRITELN('Posten findes, RETURN');READLN
             END
             ELSE ERROR(ZONE.H.FILENAME)
           END;
        5: IF IER=0 THEN
           BEGIN
             SKRIVPOST;
             GOTOXY(1,20);
             CH:='J';
             WRITELN('Sletning korrekt J/N');
             GOTOXY(22,20);EDIT(CH);
             IF CH='J' THEN
             BEGIN
               DELETE(ZONE.H,REGISTER,POST.A);
               IF IER=-9 THEN
               BEGIN
                 WRITELN('Eneste post, kan ikke slettes, RETURN');
                 READLN;
                 IER:=0
               END;
               IF IER<>0 THEN ERROR(ZONE.H.FILENAME)
             END
           END
           ELSE
           BEGIN
             WRITELN('Post findes ikke, tryk RETURN');READLN
           END
      END
END;
(*$P*)
BEGIN
  CLEARSCREEN;
 
  CH:=' ';FNAVN:='';I:=1;
  REPEAT
    CH(1):=PARM^(I);
    FNAVN:=CONCAT(FNAVN,CH);
    I:=I+1
  UNTIL PARM^(I)=',';
  FOR J:=1 TO I-4 DO ZONE.H.FILENAME(J):=PARM^(J);
  I:=I+1;
  J:=ORD(PARM^(I))-48;
  USERNIVEAU:=MENIG;
  WHILE J>0 DO BEGIN USERNIVEAU:=SUCC(USERNIVEAU);J:=J-1 END;
  I:=I+2;
  REGNAVN:='';
  REPEAT
    CH(1):=PARM^(I);
    REGNAVN:=CONCAT(REGNAVN,CH);
    I:=I+1
  UNTIL PARM^(I)=' ';
  FNAVN:=CONCAT(FNAVN,':0000:I');
  REWRITE(REGISTER,FNAVN);
  IOPEN(ZONE.H,REGISTER,SKRIV);IF IER<>0 THEN OFEJL(ZONE.H.FILENAME);
  LINE:=CONCAT(COPY(FNAVN,1,4),'DESC:P');
  LINE:=CONCAT(LINE,COPY(FNAVN,POS(':P',FNAVN)+2,1),':30:J');
  FNAVN:=LINE;
  WRITELN('MEMAVAIL ',MEMAVAIL);
  LÆSDESC;
  WRITELN('MEMAVAIL ',MEMAVAIL);READLN;
  REPEAT
    CLEARSCREEN;
    GOTOXY(10,10);
    WRITELN(REGNAVN,' R E G I S T E R - V E D L I G E H O L D E L S E');
    GOTOXY(10,12);
    WRITELN('0 Færdig');
    WRITELN(' ':9,'1 Ændring');
    WRITELN(' ':9,'2 Udskrift på skærm');
    WRITELN(' ':9,'3 Udskrift på printer');
    WRITELN(' ':9,'4 Oprettelse');
    WRITELN(' ':9,'5 Sletning');
    REPEAT
      CH:='2';
      GOTOXY(10,19);
      WRITELN('Vælg 0-5');
      GOTOXY(21,19);EDIT(CH)
    UNTIL CH(1) IN (.'0'..'5'.);
    OPTION:=ORD(CH(1))-48;
    IF OPTION>0 THEN
      MAINTAIN
  UNTIL OPTION=0;
  ICLOSE(ZONE.H,REGISTER);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER);
  CHAIN('INTRE   *1','START:P1',QUQ)
END.