|
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: 20224 (0x4f00)
Types: TextFile
Notes: Mikados_K
Names: »LIMTIDSF.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMTIDSF.K«
PROGRAM LIMTIDSF;
(*REGISTRERING AF TIDSFORBRUG*)
(*$L-*)
CONST MAXRECSIZE=1000;
(*@@*)
PROGRAMNR=6;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
POSTADR=0..MAXRECSIZE;
COMMBUF =ARRAY (POSTADR) OF INTEGER;(*commbuf(0)=filnr,resten er posten*)
POINTREC=^COMMBUF;
NAME =STRING(10);
PCB =^INTEGER;
MESSAGETYPE=(ÅBEN,LUK,LÆSPOST,LÆSPOSTX,NÆSTE,NÆSTEX,SLET,SLETX,GEMPOST,
INDSÆT,INITIER,UTILMELD,UAFMELD,PTILMELD,PAFMELD,STOPSYS,
RETURNHEAD,RETURNSTAT);
MESSAGE =RECORD
KOMMANDO:MESSAGETYPE;
INFO,IREC:INTEGER
END;
AR=ARRAY (-4..-4) OF INTEGER;
VAR PARM:^PARMARRAY;
USERNIVEAU:NIVEAU;
F:STRING(18);
QUQ:^INTEGER;
IER,IREC,STATUSER,MODE,REMUSERS,
FILNR,I:INTEGER;
FNAVN,REGNAVN,DESCNAVN:STRING(18);
SEMAFOR:NAME;
FILEINIT:BOOLEAN;
SNYD:AR;
CPPCB:PCB;
COMREC:POINTREC;
BESKED:MESSAGE;
(*$P*)
(*$L-*)
PROCEDURE D(FRA,NR:INTEGER);
VAR I:INTEGER;
BEGIN
GOTOXY(1,FRA);
FOR I:=1 TO NR DO WRITELN(' ':79);
GOTOXY(1,FRA)
END;
PROCEDURE NONEXIST(S:STRING);
BEGIN
D(23,1);
WRITE(S,' findes ikke, RETURN ');
READLN;D(23,1)
END;
PROCEDURE BAD(IDENT,STATUS:INTEGER);
BEGIN
D(23,1);
WRITE('BAD',IDENT:5,STATUS:5);
READLN
END;
(*$P*)
PROCEDURE ALLOCA(VAR ADDRESS:POINTREC;LENGTH:INTEGER;
VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE DEALLO(ADDRESS:POINTREC;VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE SENDM(RECEIVER:PCB;VAR CONTENTS:MESSAGE;
LENGTH:INTEGER;VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE RECEIV(VAR SENDER:PCB;VAR CONTENTS:MESSAGE;
VAR LENGTH:INTEGER);
EXTERNAL;
PROCEDURE RESERV(RESOURCE:NAME;EXCLUSIVE,WAIT:BOOLEAN;
VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE RELEAS(RESOURCE:NAME;VAR STATUS:INTEGER);
EXTERNAL;
(*$IRESPRINT*)
(*$P*)
(*$IUDFØR*)
(*$IFISFPROC*)
(*$P*)
PROCEDURE REGVEDL;
CONST MAXFELTER=30;
(*@@*)
TYPE
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;
FELTNAVN:STRING(8);
CASE DESCTYPE:BESKRIVELSESTYPE OF
FELTDESC:
(INDPOS,UDPOS:SKÆRMPOS;
KIKKENIVEAU,ÆNDRENIVEAU:NIVEAU;
EDITERING:INTEGER;
LEDETEKST,FØLGETEKST:STRING;
INDEKS,
LÆNGDE,
HÆGTE,
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;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
LONGINT = ARRAY (1..2) OF INTEGER;
(*@@EVT. TOTAL POSTERKLÆRING,FLERE POSTER*)
(*$P*)
(*$L+*)
MEDAPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TIMESATS,
PERSTIME,
TOTTIMLØ,
PRODTIME,
AKKORDLØ,
AKKORDAR :REAL;
NR,
AFDELING :INTEGER;
NAVN :PACKED ARRAY (1..30) OF CHAR
END;
PRODPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KRSTK, (*SAMLET TIMESATS FOR ALLE RESSOURCER*)
REAANTAL :REAL;
ORDRENR,
SEKVENSN,
OPERANR,
STARTTID,
OPERAFSL,
STKH,
RESS1,
RESS2,
RESS3,
RESS4,
RESS5,
EMNENR,
VARIGHED :INTEGER
END;
OMVPPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ORDRENR,
SEKVENSN,
OPERANR,
EMNENR :INTEGER
END;
ORDRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ANTALBES,
SALGSPRI,
MATOMK,
LØNOMK,
MASKINOM,
SMEOMK,
MATFORB :REAL;
NR :INTEGER;
KUNDENR :LONGINT;
EMNENR :INTEGER;
REGDATO :LONGINT;
ØNSKLEV,
BEKRÆLEV :INTEGER;
KUNDORDR :PACKED ARRAY (1..16) OF CHAR;
INITIALE :PACKED ARRAY (1..4) OF CHAR
END;
REGLPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TID,
MÆNGDE,
LØN :REAL;
ORDRENR,
EMNENR,
OPERANR,
MEDARBNR :INTEGER;
DATO :LONGINT;
RTYPE :INTEGER
END;
OMVRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
MEDARBNR,
ORDRENR,
EMNENR,
OPERANR :INTEGER;
DATO :LONGINT
END;
SYSRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
AKKTIME :ARRAY (1..9) OF REAL;
NR :INTEGER;
DAGSDATO,
PERSTDAT :LONGINT;
ARBTIMDA,
ORDRENR :INTEGER
END;
(*$P*)
VAR FELT:NFELT;
HUSKNIV:NIVEAU;
PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
OPTION,LINES,
I,J,ANTALFELTER:INTEGER;
LINE:STRING;
MEDARB:MEDAPOST;
PROD:PRODPOST;
OMVPROD:OMVPPOST;
ORDRE:ORDRPOST;
POST:REGLPOST;
OMVRREGL:OMVRPOST;
SYSTEM:SYSRPOST;
LONGNUL:LONGINT;
CH:CHAR;
NEJ,JA,JAOGNEJ:SET OF CHAR;
(*$P*)
(*$L-*)
FUNCTION QJN(S:STRING):CHAR;
VAR CH:STRING(1);
BEGIN
REPEAT
D(23,1);
WRITE(S,' J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JAOGNEJ;
QJN:=CH(1);
D(23,1)
END;
PROCEDURE ERROR(VAR REC:AR);
VAR CH:STRING(1);
I:INTEGER;
BEGIN
D(23,1);
(*$R-*)
WRITE('FEJL I REGISTER ',REC(-3),' FEJLKODE ',IER,' RETURN'); (*$R+*)
CH:=' ';EDIT(CH);
IF CH='Æ' THEN BEGIN IER:=0;EXIT(ERROR) END;
ICLOSE(MEDARB.A);
ICLOSE(POST.A);
ICLOSE(OMVPROD.A);
ICLOSE(SYSTEM.A);
ICLOSE(ORDRE.A);
ICLOSE(OMVRREGL.A);
ICLOSE(PROD.A);
EXIT(REGVEDL)
END;
PROCEDURE CHECK0(VAR REC:AR);
BEGIN
IF IER<>0 THEN ERROR(REC)
END;
(*$P*)
(*$L-*)
(*$IRLÆSDESC*)
(*$P*)
(*$IMOVETOLI*)
(*$P*)
(*$L+*)
PROCEDURE MAINTAIN;
VAR CH:CHAR;
C:STRING(1);
POSTFOUND,
PRODFOUND:BOOLEAN;
LINIER:INTEGER;
PROCEDURE SUMTID;
VAR SUM:REAL;
BEGIN
SUM:=0.0;
POST.MEDARBNR:=0;
POST.DATO:=LONGNUL;
REPEAT
NEXTRECX(POST.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(POST.A);
SUM:=SUM+POST.TID
UNTIL POST.DATO(1)>99;
POST.TID:=SUM
END;
PROCEDURE FINDTOTAL;
VAR TOTAL:REAL;
BEGIN
TOTAL:=0.0;
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
REPEAT
NEXTRECX(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);IER:=0;
IF (PROD.SEKVENSN<>OMVPROD.SEKVENSN) OR (PROD.OPERANR<>POST.OPERANR) THEN
TOTAL:=PROD.REAANTAL
UNTIL (PROD.SEKVENSN=OMVPROD.SEKVENSN) AND (PROD.OPERANR=POST.OPERANR);
POST.MÆNGDE:=TOTAL
END;
(*$P*)
PROCEDURE REGLINIE;
VAR HTID,HMÆNGDE,HLØN:REAL;
HDATO1,HTYPE:INTEGER;
PROCEDURE AFSLUTNING;
BEGIN
WITH POST DO
BEGIN
LØN:=0.0;
LÆSFELT(PICTURE(12));
TID:=TID/100.0;
IF TID=0.0 THEN SUMTID;
GOTOXY(55,LINIER+3);
WRITE(TID:8:2,' Afslutning');
D(15,5);
WRITELN(' Total mængde beregnes efter');
WRITELN('1 Hidtil realiserede tal');
WRITELN('2 Indtastet antal');
WRITELN('3 Ordreantal');
WRITELN('4 Forrige operations total');
REPEAT
D(20,1);
WRITE('Vælg 1-4 ');
READLN;READ(OPTION);
IF NOT PRODFOUND AND (OPTION IN (.1,4.)) THEN OPTION:=0
UNTIL (IORESULT=0) AND (OPTION IN (.1..4.));
D(15,6);
CASE OPTION OF
1:MÆNGDE:=PROD.REAANTAL;
2:BEGIN
LÆSFELT(PICTURE(11))
END;
3:MÆNGDE:=ORDRE.ANTALBES;
4:MÆNGDE:=-1.0
END;
IF OPTION=4 THEN FINDTOTAL;
GOTOXY(32,LINIER+3);WRITE(MÆNGDE:6:-2);
IF QJN('Skal linien accepteres') IN NEJ THEN
BEGIN
D(LINIER+3,1);
IF NOT POSTFOUND THEN
BEGIN
GETRECX(A);CHECK0(A);
DELETE(A);IF NOT (-IER IN (.0,2.)) THEN ERROR(A)
END;
EXIT(REGLINIE)
END;
PROD.REAANTAL:=MÆNGDE;
PROD.OPERAFSL:=1;
HTID:=TID;
HMÆNGDE:=MÆNGDE;
GETRECX(A);CHECK0(A);
TID:=HTID;
MÆNGDE:=HMÆNGDE;
LØN:=0.0;
RTYPE:=0;
PUTREC(A);
CHECK0(A);
D(LINIER+3,1)
END
END;
(*$P*)
PROCEDURE SLETLINIE;
VAR CH:CHAR;
BEGIN
CH:='N';
IF PRODFOUND AND (PROD.OPERAFSL=1) THEN
BEGIN
POST.DATO(1):=POST.DATO(1)+100;
GETRECX(POST.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(POST.A);
IF IER=0 THEN
CH:=QJN('Ønskes afslutningsregistreringen slettet')
ELSE
POST.DATO(1):=POST.DATO(1)-100
END;
IF CH IN JA THEN
BEGIN
PROD.OPERAFSL:=0;
PROD.REAANTAL:=0;
D(LINIER+3,1)
END
ELSE
BEGIN
GETRECX(POST.A);CHECK0(POST.A);
IF POST.RTYPE>0 THEN
PROD.REAANTAL:=PROD.REAANTAL-POST.MÆNGDE;
IF ABS(POST.RTYPE)=1 THEN
MEDARB.PRODTIME:=MEDARB.PRODTIME-POST.TID
ELSE
IF ABS(POST.RTYPE)=2 THEN
BEGIN
MEDARB.AKKORDAR:=MEDARB.AKKORDAR-POST.TID;
IF PROD.STKH>0 THEN
MEDARB.AKKORDLØ:=MEDARB.AKKORDLØ-POST.MÆNGDE/PROD.STKH
ELSE
MEDARB.AKKORDLØ:=
MEDARB.AKKORDLØ-POST.MÆNGDE/ORDRE.ANTALBES*PROD.STKH/100.0
END
ELSE
BEGIN
MEDARB.AKKORDAR:=MEDARB.AKKORDAR-POST.TID;
MEDARB.AKKORDLØ:=MEDARB.AKKORDLØ-POST.TID
END
END;
PUTREC(PROD.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(PROD.A);
WITH OMVRREGL DO
BEGIN
MEDARBNR:=POST.MEDARBNR;
ORDRENR:=POST.ORDRENR;
EMNENR:=POST.EMNENR;
OPERANR:=POST.OPERANR;
DATO:=POST.DATO;
GETRECX(A);IF NOT (-IER IN (.0,6.)) THEN ERROR(A);
IF IER=0 THEN
BEGIN
DELETE(A);IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A)
END
END;
DELETE(POST.A);IF NOT (-IER IN (.0,2,9.)) THEN ERROR(POST.A)
END;
(*$P*)
PROCEDURE AFLØN;
BEGIN
WITH POST DO
BEGIN
D(16,4);
WRITELN(' Aflønning efter');
WRITELN('1 Medarbejders timesats');
WRITELN('2 Indtastet timesats');
WRITELN('3 Indtastet akkordnr');
WRITELN('4 Indtastet kr pr stk');
REPEAT
D(21,1);
WRITE('Vælg 1-4 ');
READLN;READ(OPTION);
IF NOT PRODFOUND AND (OPTION=3) THEN OPTION:=0
UNTIL (IORESULT=0) AND (OPTION IN (.1..4.));
D(16,6);
CASE OPTION OF
1: LØN:=(MEDARB.TIMESATS+MEDARB.PERSTIME)*TID;
2:BEGIN
LÆSFELT(PICTURE(9));
LØN:=(LØN+MEDARB.PERSTIME)*TID
END;
3:BEGIN
RTYPE:=RTYPE*2;
LÆSFELT(PICTURE(10));
IF PROD.STKH>0.0 THEN
LØN:=TID*MEDARB.PERSTIME+
MÆNGDE/PROD.STKH*SYSTEM.AKKTIME(DATO(1))
ELSE
LØN:=TID*MEDARB.PERSTIME-
MÆNGDE/ORDRE.ANTALBES*PROD.STKH/100.0*SYSTEM.AKKTIME(DATO(1))
END;
4:BEGIN
RTYPE:=RTYPE*3;
LÆSFELT(PICTURE(13));
LØN:=TID*MEDARB.PERSTIME+MÆNGDE*LØN;
END
END;
GOTOXY(40,LINIER+3);WRITE(LØN:10:2)
END
END;
(*$P*)
BEGIN (*REGLINIE*)
WITH POST DO
BEGIN
LÆSFELT(PICTURE(6));
HDATO1:=DATO(1);
DATO:=SYSTEM.DAGSDATO;
IF HDATO1=0 THEN BEGIN DATO(1):=DATO(1)+100;MEDARBNR:=10000 END;
TID:=0.0;
RTYPE:=0;
MÆNGDE:=0.0;
LØN:=0.0;
C:='A';
INSERT(A);IF NOT (-IER IN (.0,7.)) THEN ERROR(A);
IF IER=-7 THEN
BEGIN
POSTFOUND:=TRUE;
GOTOXY(1,21);
WRITELN('ORDRE-EMNE-OPERATION-MEDARBEJDER-DATO ',
'KOMBINATIONEN FINDES ALLEREDE');
WRITELN('Ønskes: Nyindtastning: N, Addition til ',
'eksisterende: A , Sletning: S');
REPEAT
D(23,1);
WRITE('Vælg N/A/S ');
C:='N';
EDIT(C)
UNTIL C(1) IN (.'N','n','a','A','S','s'.);
D(21,3)
END ELSE POSTFOUND:=FALSE;
IF C(1) IN (.'N','n'.) THEN EXIT(REGLINIE);
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.OPERANR:=OPERANR;
PROD.SEKVENSN:=OMVPROD.SEKVENSN;
GETRECX(PROD.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(PROD.A);
IF C(1) IN (.'A','a'.) THEN
BEGIN
IF HDATO1>0 THEN
BEGIN
DATO(1):=HDATO1;
LÆSFELT(PICTURE(7));
IF DATO(2)>0 THEN
TID:=(DATO(2)-DATO(1))/100.0
ELSE
TID:=DATO(1)/100.0;
GOTOXY(55,LINIER+3);
WRITE(TID:8:2);
REPEAT
LÆSFELT(PICTURE(8))
UNTIL PRODFOUND OR (LENGTH(LINE)>0);
RTYPE:=-1;
IF LENGTH(LINE)>0 THEN
BEGIN
RTYPE:=1;
PROD.REAANTAL:=PROD.REAANTAL+MÆNGDE
END
ELSE
IF PROD.STKH>=0 THEN
MÆNGDE:=PROD.STKH*TID
ELSE
MÆNGDE:=-TID*ORDRE.ANTALBES/PROD.STKH*100.0;
GOTOXY(32,LINIER+3);WRITE(MÆNGDE:6:-2);
AFLØN;
HTYPE:=RTYPE;
HLØN:=LØN;
HTID:=TID;
HMÆNGDE:=MÆNGDE;
DATO:=SYSTEM.DAGSDATO;
IF QJN('Skal linien accepteres') IN NEJ THEN
BEGIN
D(LINIER+3,1);
IF NOT POSTFOUND THEN
BEGIN
GETRECX(A);CHECK0(A);
DELETE(A);IF NOT (-IER IN (.0,2.)) THEN ERROR(A)
END;
EXIT(REGLINIE)
END;
LINIER:=LINIER+1;
CASE ABS(RTYPE) OF
1:MEDARB.PRODTIME:=MEDARB.PRODTIME+TID;
2:BEGIN
IF PROD.STKH>0.0 THEN
MEDARB.AKKORDLØ:=MEDARB.AKKORDLØ+MÆNGDE/PROD.STKH
ELSE
MEDARB.AKKORDLØ:=MEDARB.AKKORDLØ-
MÆNGDE/ORDRE.ANTALBES*PROD.STKH/100.0;
MEDARB.AKKORDAR:=MEDARB.AKKORDAR+TID
END;
3:BEGIN
MEDARB.AKKORDAR:=MEDARB.AKKORDAR+TID;
MEDARB.AKKORDLØ:=MEDARB.AKKORDLØ+TID
END
END;
GETRECX(A);CHECK0(A);
RTYPE:=HTYPE;
LØN:=LØN+HLØN;
TID:=TID+HTID;
MÆNGDE:=MÆNGDE+HMÆNGDE;
PUTREC(A);CHECK0(A)
END
ELSE
AFSLUTNING
END
ELSE
BEGIN
SLETLINIE;
EXIT(REGLINIE)
END;
OMVRREGL.MEDARBNR:=MEDARBNR;
OMVRREGL.ORDRENR:=ORDRENR;
OMVRREGL.EMNENR:=EMNENR;
OMVRREGL.OPERANR:=OPERANR;
OMVRREGL.DATO:=DATO;
INSERT(OMVRREGL.A);IF NOT (-IER IN (.0,7.)) THEN ERROR(OMVRREGL.A);
PUTREC(PROD.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(PROD.A)
END
END;
(*$P*)
BEGIN (*MAINTAIN*)
WITH POST DO
REPEAT
NULPOST;
CLEARSCREEN;
WRITELN('REGISTRERING AF TIMESEDLER');
LINIER:=0;
WRITELN('ORDRE EMNE OPERATION',
' MÆNGDE LØN TID');
LÆSFELT(PICTURE(1));
IF MEDARBNR>0 THEN
BEGIN
SKRIVFELT(PICTURE(1));
MEDARB.NR:=MEDARBNR;
GETRECX(MEDARB.A);
IF IER=-6 THEN
NONEXIST('Medarbejder')
ELSE
BEGIN
CHECK0(MEDARB.A);
LÆSFELT(PICTURE(2));TID:=TID/100.0;SKRIVFELT(PICTURE(2));
DATO:=SYSTEM.DAGSDATO;
LÆSFELT(PICTURE(14));
SYSTEM.DAGSDATO:=DATO;
MEDARB.TOTTIMLØ:=MEDARB.TOTTIMLØ+TID;
REPEAT
MEDARBNR:=MEDARB.NR;
IF LINIER>12 THEN BEGIN D(3,12);LINIER:=0 END;
LÆSFELT(PICTURE(3));
IF ORDRENR>0 THEN
BEGIN
GOTOXY(1,LINIER+3);WRITE(ORDRENR:5);
LÆSFELT(PICTURE(4));
GOTOXY(10,LINIER+3);WRITE(EMNENR:5);
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=EMNENR;
GETREC(ORDRE.A);
IF NOT (-IER IN (.0,6.)) THEN ERROR(ORDRE.A);
IF IER=-6 THEN
NONEXIST('Ordren')
ELSE
BEGIN
LÆSFELT(PICTURE(5));
GOTOXY(20,LINIER+3);WRITE(OPERANR:10);
OMVPROD.ORDRENR:=ORDRENR;
OMVPROD.EMNENR:=EMNENR;
OMVPROD.OPERANR:=OPERANR;
OMVPROD.SEKVENSN:=0;
NEXTREC(OMVPROD.A);
IF NOT (-IER IN (.1,2,9.)) THEN ERROR(OMVPROD.A);
CH:='J';
PRODFOUND:=TRUE;
IF OMVPROD.OPERANR<>OPERANR THEN
BEGIN
PRODFOUND:=FALSE;
D(22,1);
WRITELN('Operationen findes ikke på forkalkulationen');
CH:=QJN('Ønskes registreringen fortsat');
D(22,1)
END;
IF CH IN JA THEN REGLINIE
END
END
UNTIL ORDRENR=0;
PUTREC(MEDARB.A);CHECK0(MEDARB.A)
END
END
UNTIL MEDARBNR=0
END;
(*$P*)
BEGIN (*REGVEDL*)
LONGNUL(1):=0;
LONGNUL(2):=0;
JA:=(.'J','j'.);
NEJ:=(.'N','n'.);
JAOGNEJ:=JA+NEJ;
CLEARSCREEN;
LÆSDESC;
MODE:=3;(*SKRIV*)
(*$R-*)
MEDARB.A(-4):=0;
POST.A(-4):=0;
SYSTEM.A(-4):=0;
PROD.A(-4):=0;
OMVPROD.A(-4):=0;
OMVRREGL.A(-4):=0;
ORDRE.A(-4):=0;
MEDARB.A(-3):=7;
POST.A(-3):=16;(*REGL*)
SYSTEM.A(-3):=9;
PROD.A(-3):=14;
ORDRE.A(-3):=10;
OMVPROD.A(-3):=13;
OMVRREGL.A(-3):=23;
(*$R+*)
(*@@EVT. ÅBNING AF ANDRE ANDRE DATAFILER*)
IOPEN(SYSTEM.A); CHECK0(SYSTEM.A);
SYSTEM.NR:=0;
GETREC(SYSTEM.A);CHECK0(SYSTEM.A);
ICLOSE(SYSTEM.A);
IOPEN(MEDARB.A); CHECK0(MEDARB.A);
IOPEN(POST.A); CHECK0(POST.A);
IOPEN(PROD.A); CHECK0(PROD.A);
IOPEN(OMVPROD.A); CHECK0(OMVPROD.A);
IOPEN(ORDRE.A); CHECK0(ORDRE.A);
IOPEN(OMVRREGL.A); CHECK0(OMVRREGL.A);
MAINTAIN;
ICLOSE(MEDARB.A);
ICLOSE(POST.A);
ICLOSE(ORDRE.A);
ICLOSE(PROD.A);
ICLOSE(OMVPROD.A);
ICLOSE(OMVRREGL.A);
(*@@EVT. LUKNING AF ANDRE DATAFILER*)
CLEARSCREEN
END;
(*$P*)
BEGIN
SEMAFOR:='ALLOCOMBUF';
I:=ORD(PARM^(1))-48;
USERNIVEAU:=MENIG;
WHILE I>0 DO
BEGIN
USERNIVEAU:=SUCC(USERNIVEAU);
I:=I-1
END; (*$R-*)
SNYD(-3):=0;
FOR I:=6 DOWNTO 2 DO SNYD(-3):=10*SNYD(-3)+ORD(PARM^(I))-48;
IF PARM^(7)='-' THEN SNYD(-3):=-SNYD(-3); (*$R+*)
UDFØR(PTILMELD,SNYD);
UDFØRT(PTILMELD,SNYD);
IF IER<>0 THEN BAD(1,IER);
(*@@TILPASSES*)
DESCNAVN:='TIDSPESC:P2:05:J';
REGVEDL;
UDFØR(PAFMELD,SNYD);
UDFØRT(PAFMELD,SNYD);
IF IER<>0 THEN BAD(2,IER);
FNAVN:=' ';
FOR I:=1 TO 7 DO FNAVN(I):=PARM^(I);
CHAIN('HOVED *1',FNAVN,QUQ);
IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.