|
|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 20352 (0x4f80)
Types: TextFile
Notes: Mikados_K
Names: »FORKALK.K«
└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
└─⟦this⟧ »FORKALK.K«
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.