DataMuseum.dk

top - download

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

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

Mikados K File

PROGRAM TIDSFORB;
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;
      MREGLIZ=583;
      MOPLINZ=370;
      MMEDARZ=281;
(*$IISFHEAD*)
REGLIZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MREGLIZ) OF INTEGER
END;
OPLINZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MOPLINZ) OF INTEGER
END;
MEDARZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MMEDARZ) 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;
REGLIPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      LØN           :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR,
      OPERATIONSNR,
      MEDARBEJDERNR,
      DAT1,DAT2,
      CENTIMER,
      ENHEDER       :INTEGER
END;
OPLINPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      MINUTFAKTOR   :REAL;
      ORDRENR,
      PRODUKT1NR,
      PRODUKT2NR,
      OPERATIONSNR,
      CENTIMER      :INTEGER
END;
MEDARPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      TTIMER,
      PTIMER        :REAL;
      MEDARBEJDERNR,
      TAIJP         :INTEGER;
      NAVN          :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;
    LINES,OPTION,IER,I,J,ANTALFELTER,FELTNR:INTEGER;
    CH:STRING(1);
    LINE:STRING;
    FFIL:FELTFIL;
    RGF,OPF,MAF:ISF;
    RGZ:REGLIZONE;
    OPZ:OPLINZONE;
    MAZ:MEDARZONE;
    RGPOST:REGLIPOST;
    OPPOST:OPLINPOST;
    MAPOST:MEDARPOST;
    RESULT:REAL;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(RGZ.H,RGF);
  ICLOSE(OPZ.H,OPF);
  ICLOSE(MAZ.H,MAF);
  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;
    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
    1:BEGIN
        MAPOST.MEDARBEJDERNR:=TAL;
        GETREC(MAZ.H,MAF,MAPOST.A);
        IF (IER<>0) AND (IER<>-6) THEN ERROR(MAZ.H.FILENAME);
        BUMMED:=(IER=-6)
      END
    END
  UNTIL NOT BUMMED;
  CASE FELTNR OF
  1,3,5,6,7:BEGIN
              RGPOST.A(F^.INDEKS):=TAL;
              IF FELTNR=6 THEN MAPOST.PTIMER:=MAPOST.PTIMER+TAL/100;
              IF (FELTNR=3) AND (TAL=0) THEN FELTNR:=5
            END;
  2        :MAPOST.TTIMER:=MAPOST.TTIMER+RESULT;
  4      :BEGIN
            RGPOST.A(F^.INDEKS):=TAL;
            RGPOST.A(F^.INDEKS+1):=TAL1
          END
  END
END;
(*$P*)
PROCEDURE MAINTAIN;
VAR CH:STRING(1);
    ENHEDER,CENTIMER:INTEGER;
    LØN:REAL;
FUNCTION RUND(R:REAL):REAL;
VAR R1:REAL;
BEGIN
  R1:=TRUNC(R/10000.0);
  R1:=R1*10000.0;
  RUND:=ROUND(R-R1)+R1
END;
BEGIN
  CLEARSCREEN;
  FOR FELTNR:=1 TO 2 DO LÆSFELT(PICTURE(FELTNR));
  IF LINES=72 THEN
  BEGIN
  WRITELN(LIST);
  WRITELN(LIST,'REGISTRERING AF ARBEJDSSEDLER',' ':33,'Dato',
                SF^.DAT1*10000.0+SF^.DAT2:8:-2);
  LINES:=2
  END;
  WRITELN(LIST);
  WRITELN(LIST,'MEDARBEJDER',' ':53,'TOTALTIMER');
  WRITELN(LIST,RGPOST.MEDARBEJDERNR:6,' ':10,
               MAPOST.NAVN,' ':18,RESULT:10:2);
  WRITELN(LIST);
  WRITELN(LIST,'ORDRE-    PRODUKT   OPERATIONS-    1/100   ENHEDER',
               '       LØN   PR. ENHED');
  WRITELN(LIST,'NUMMER    -NUMMER        NUMMER    TIMER',' ':23,
                                                   'KALK   REAL');
  LINES:=LINES+6;
  REPEAT
    FOR FELTNR:=3 TO 5 DO LÆSFELT(PICTURE(FELTNR));
    IF RGPOST.ORDRENR<>0 THEN
    BEGIN
      OPPOST.ORDRENR:=RGPOST.ORDRENR;
      OPPOST.PRODUKT1NR:=RGPOST.PRODUKT1NR;
      OPPOST.PRODUKT2NR:=RGPOST.PRODUKT2NR;
      OPPOST.OPERATIONSNR:=RGPOST.OPERATIONSNR;
      GETREC(OPZ.H,OPF,OPPOST.A);
      IF (IER<>0) AND (IER<>-6) THEN ERROR(OPZ.H.FILENAME);
      IF IER=0 THEN
      BEGIN
        RGPOST.DAT1:=SF^.DAT1;
        RGPOST.DAT2:=SF^.DAT2;
        INSERT(RGZ.H,RGF,RGPOST.A);
        IF (IER<>0) AND (IER<>-7) THEN ERROR(RGZ.H.FILENAME);
        IF IER=-7 THEN
        BEGIN
          CH:='N';
          GOTOXY(1,22);
          WRITELN(
              'ORDRE-PRODUKT-OPERATION-DATO KOMBINATIONEN FINDES ALLEREDE');
          WRITELN('Ønskes: Nyindtastning: N, Addition til eksisterende: A',
                  ' Sletning: S');
          GOTOXY(68,23);EDIT(CH);
          GOTOXY(1,22);WRITELN(' ':77);WRITELN(' ':77);
          IF CH='A' THEN
          BEGIN
            GETREC(RGZ.H,RGF,RGPOST.A);
            IF IER<>0 THEN ERROR(RGZ.H.FILENAME);
            CENTIMER:=RGPOST.CENTIMER;
            ENHEDER:=RGPOST.ENHEDER
          END
          ELSE
          IF CH='S' THEN
          BEGIN
            DELETE(RGZ.H,RGF,RGPOST.A);
            IF (IER<>0) AND (IER<>-2) THEN ERROR(RGZ.H.FILENAME) ELSE IER:=0
          END
        END
        ELSE
        BEGIN CH:='A';CENTIMER:=0;ENHEDER:=0;RGPOST.LØN:=0.0 END;
        IF CH='A' THEN
        BEGIN
          GOTOXY(30,5);
          FOR FELTNR:=6 TO 7 DO LÆSFELT(PICTURE(FELTNR));
          LØN:=RGPOST.CENTIMER*SF^.MINUTFAKTOR(MAPOST.TAIJP);
          LINES:=LINES+1;
          WRITE(LIST,RGPOST.ORDRENR:6,RGPOST.PRODUKT1NR*10000.0+
                       RGPOST.PRODUKT2NR:11:-2,
                       RGPOST.OPERATIONSNR:14,
                       RGPOST.CENTIMER:9,
                       RGPOST.ENHEDER:10,
                       LØN:10:2,OPPOST.CENTIMER:7);
           IF RGPOST.ENHEDER=0 THEN WRITELN(LIST,'  -----')
           ELSE WRITELN(LIST,RGPOST.CENTIMER/RGPOST.ENHEDER:7:1);
          RGPOST.CENTIMER:=RGPOST.CENTIMER+CENTIMER;
          RGPOST.ENHEDER:=RGPOST.ENHEDER+ENHEDER;
          RGPOST.LØN:=RGPOST.LØN+LØN;
          PUTREC(RGZ.H,RGF,RGPOST.A);
          IF IER<>0 THEN ERROR(RGZ.H.FILENAME);
        END
      END
    END;
    GOTOXY(1,5);WRITELN(' ':77);WRITELN(' ':77);WRITELN(' ':77)
  UNTIL RGPOST.ORDRENR=0;
  WHILE (LINES-2) MOD 10<>0 DO
  BEGIN
    WRITELN(LIST);
    LINES:=LINES+1
  END;
  PUTREC(MAZ.H,MAF,MAPOST.A);
  IF IER<>0 THEN ERROR(MAZ.H.FILENAME)
END;
(*$P*)
BEGIN
  CLEARSCREEN;
 
  FNAVN:='SYSREG:P2:1:I';
  REWRITE(SF,FNAVN);
  SEEK(SF,1);
  GET(SF);
  RGZ.H.FILENAME:='REGLIREG';
  FNAVN:='REGLIREG:P2:0000:I';
  REWRITE(RGF,FNAVN);
  IOPEN(RGZ.H,RGF,SKRIV);IF IER<>0 THEN OFEJL(RGZ.H.FILENAME);
  OPZ.H.FILENAME:='OPLINREG';
  FNAVN:='OPLINREG:P2:0000:I';
  REWRITE(OPF,FNAVN);
  IOPEN(OPZ.H,OPF,LÆS);IF IER<>0 THEN OFEJL(OPZ.H.FILENAME);
  MAZ.H.FILENAME:='MEDARREG';
  FNAVN:='MEDARREG:P2:0000:I';
  REWRITE(MAF,FNAVN);
  IOPEN(MAZ.H,MAF,SKRIV);IF IER<>0 THEN OFEJL(MAZ.H.FILENAME);
(*$XT*) WRITELN('MEMAVAIL ',MEMAVAIL); (*$X-*)
  DESCNAVN:='TIDSDESC:P2:0:J';
  LÆSDESC;
(*$XT*) WRITELN('MEMAVAIL ',MEMAVAIL);READLN; (*$X-*)
  LINES:=72;
  REPEAT
    CH:='J';
    GOTOXY(1,23);
    WRITELN('Flere arbejdssedler J/N');
    GOTOXY(28,23);EDIT(CH);
    IF CH='J' THEN MAINTAIN
  UNTIL CH='N';
  PAGE(LIST);
  ICLOSE(RGZ.H,RGF);
  ICLOSE(OPZ.H,OPF);
  ICLOSE(MAZ.H,MAF);
  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.