|
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: 68256 (0x10aa0)
Types: TextFile
Notes: Mikados_K
Names: »LIMPLANL.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMPLANL.K«
PROGRAM LIMPLANL;
(*$D-*)
(*RESSOURCE- OG ORDRE-PLANLÆGNING*)
(*$L-*)
CONST MAXRECSIZE=1000;
(*@@*)
PROGRAMNR=8;
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 WRITE(' ':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=20;
(*@@*)
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+*)
RESSPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TSATSF,
SAMOMS,
SAMOMSSÅ,
SAMDB,
SAMDBSÅ,
KØBSPRIS,
SALGSPRI :REAL;
NR,
AFDELNR,
PRODTIM,
VEDLTIM,
OPSTILT,
OVERTIM,
REPTIME,
TOTALTI,
PRODTIMS,
VEDLTIMS,
OPSTILTS,
OVERTIMS,
REPTIMES,
TOTALTIS,
RESSTYPE :INTEGER;
DATOFLEV :LONGINT;
HYLDENR :INTEGER;
BETEGN :PACKED ARRAY (1..10) OF CHAR
END;
REGRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
GRUPNR,
NR :INTEGER
END;
EMNEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ÅRSFORBR,
NETTOVÆG,
BRUTTOVÆ,
SAMSALG,
DÆKBID,
DÆKBIDSÅ,
SAMSALGS :REAL;
NR,
FORMNR :INTEGER;
KUNDENR :LONGINT;
MASKINE :INTEGER;
TILDATO :LONGINT;
MATNR,
SVIND,
SMELTTIL,
STKHSA,
STKHBA :INTEGER;
BEMÆRK,
BETEGN,
ALTERNP :PACKED ARRAY (1..30) OF CHAR;
TEGNNR :PACKED ARRAY (1..20) OF CHAR
END;
OPERPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TILLÆG :REAL;
NR,
GRUPPE,
REBELAS :INTEGER;
BETEGN :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;
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;
REBEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
STARTDAG,
ORDRENR,
EMNENR,
OPERANR,
SEKVNR,
VARIGHED,
GRUPPE,
STTIME :INTEGER
END;
UGEDPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
UGENR,
ARBDAGNR :INTEGER
END;
ARBEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR :INTEGER;
DATO :LONGINT;
UGENR,
ARBTIMER :INTEGER
END;
SYSRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
AKKTIME :ARRAY (1..9) OF REAL;
NR :INTEGER;
DAGSDATO,
PERSTDAT :LONGINT;
ARBTIMDA,
ORDRENR :INTEGER
END;
PLANPESC=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
RESSOURCE,
ORDRE,
EMNENR,
STARTUGE,
LINIENR,
UGE,
DAG,
TIME,
VARIGHED,
FRALINIE,
TILLINIE,
ØLEVUGE,
OPTION,
AFDELING,
GRUPPE,
FAKTOR :INTEGER
END;
REBEXTRA=RECORD
PLANLAGT:BOOLEAN;
BETEGN:PACKED ARRAY (1..10) OF CHAR;
BEKRÆLEV,
ØNSKLEV:INTEGER;
ANTALBES:REAL
END;
VAR FELT:NFELT;
PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
(*PRODPLAN:BOOLEAN;*)
OPTION,LINES,
UDE,ANTLINE,PSTARTDAG,DIRECTION,HUSK,HUSKTID,
I,J,ANTALFELTER:INTEGER;
LINE:STRING;
RESS:RESSPOST;
RESSGRUP:REGRPOST;
EMNE:EMNEPOST;
OPERA:OPERPOST;
PROD:PRODPOST;
ORDRE:ORDRPOST;
REBELAST:REBEPOST;
SYSTEM:SYSRPOST;
UGEDAG:UGEDPOST;
ARBEDAG:ARBEPOST;
POST:PLANPESC;
DAGSDATO,
LONGNUL:LONGINT;
CH:CHAR;
NEJ,JA,JAOGNEJ:SET OF CHAR;
(*$P*)
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(SYSTEM.A);
ICLOSE(RESS.A);
ICLOSE(RESSGRUP.A);
ICLOSE(EMNE.A);
ICLOSE(OPERA.A);
ICLOSE(ORDRE.A);
ICLOSE(PROD.A);
ICLOSE(REBELAST.A);
ICLOSE(UGEDAG.A);
ICLOSE(ARBEDAG.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 RESSPLAN;
VAR CH:STRING(1);
CHECKOK:BOOLEAN;
SKEMA:PACKED ARRAY (1..52) OF CHAR;
REBENR:ARRAY (1..20) OF INTEGER;
REBELIN:ARRAY (1..20) OF REBEPOST;
REBXTRA:ARRAY (1..20) OF REBEXTRA;
PROCEDURE RESSBILLEDE(FRA,TIL:INTEGER); (*FRA=0 => ALLE + HOVED*)
VAR I,AKTWEEK,AKTDAG,
REST,C:INTEGER;
ESC:PACKED ARRAY (1..2) OF CHAR;
CH:CHAR;
BEGIN
ESC:=' N';ESC(1):=CHR(27);
IF FRA=0 THEN
BEGIN
CLEARSCREEN;
SKEMA:='ü ü';
WRITE('Ressource:',RESS.NR:5,' ':5);
ARBEDAG.NR:=PSTARTDAG;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
AKTWEEK:=0;
FOR I:=1 TO 25 DO
BEGIN
IF AKTWEEK<>ARBEDAG.UGENR THEN
BEGIN
SKEMA(2*I-1):='ü';
AKTWEEK:=ARBEDAG.UGENR;
WRITE(ARBEDAG.UGENR MOD 100:2)
END
ELSE WRITE(' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(' Leveres');
WRITE('Nr Ordre Betegnelse ');
ARBEDAG.NR:=PSTARTDAG;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
AKTDAG:=0;
AKTWEEK:=0;
FOR I:=1 TO 25 DO
BEGIN
IF AKTWEEK<>ARBEDAG.UGENR THEN
BEGIN AKTDAG:=0; AKTWEEK:=ARBEDAG.UGENR END;
IF AKTDAG<5 THEN
BEGIN
AKTDAG:=AKTDAG+1;
WRITE(AKTDAG:2)
END
ELSE WRITE(' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(' Uge ant');
FRA:=1
END;
FOR I:=FRA TO TIL DO
WITH REBELIN(REBENR(I)),REBXTRA(REBENR(I)) DO
BEGIN
GOTOXY(1,I+2);
WRITE(I:2,ORDRENR:6,' ',BETEGN,SKEMA);
IF (STARTDAG-PSTARTDAG) IN (.0..24.) THEN
BEGIN
GOTOXY(21+2*(STARTDAG-PSTARTDAG),I+2);
IF STTIME>4 THEN WRITE(' ');
IF STARTDAG-PSTARTDAG+(VARIGHED-1) DIV 8<26 THEN
REST:=VARIGHED
ELSE
REST:=200-(STARTDAG-PSTARTDAG)*8;
CASE STTIME MOD 4 OF
0:BEGIN C:=40;REST:=REST-1 END;
2:CASE VARIGHED OF
1:BEGIN C:=36;REST:=REST-1 END;
2:BEGIN C:=38;REST:=REST-2 END;
OTHERWISE BEGIN C:=46;REST:=REST-3 END;
3:IF VARIGHED=1 THEN BEGIN C:=34;REST:=REST-1 END
ELSE BEGIN C:=42;REST:=REST-2 END;
OTHERWISE C:=0;
IF C>0 THEN
BEGIN
CH:=CHR(C);
WRITE(ESC,CH)
END;
CH:=CHR(47);
WHILE REST>3 DO
BEGIN
WRITE(ESC,CH);
REST:=REST-4
END;
CASE REST OF
1:C:=33;
2:C:=37;
3:C:=39;
OTHERWISE C:=0;
IF C>0 THEN
BEGIN
CH:=CHR(C);
WRITE(ESC,CH)
END
END;
GOTOXY(72,I+2);
IF BEKRÆLEV>0 THEN
WRITE(BEKRÆLEV MOD 100:2,'!')
ELSE
WRITE(ØNSKLEV MOD 100:2,' ');
WRITE(ANTALBES:5:-2)
END
END;
(*$P*)
PROCEDURE GETBELAST;
BEGIN
REBELAST.NR:=POST.RESSOURCE;
REBELAST.STARTDAG:=PSTARTDAG;
REBELAST.ORDRENR:=0;
NEXTREC(REBELAST.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(REBELAST.A);
IER:=0;
ANTLINE:=0;
UDE:=0; (*FLYTTET TIL ANDEN RESSOURCE*)
WHILE (IER=0) AND (REBELAST.NR=POST.RESSOURCE) AND
(REBELAST.STARTDAG-PSTARTDAG<25) AND (ANTLINE<20) DO
BEGIN
ANTLINE:=ANTLINE+1;
REBENR(ANTLINE):=ANTLINE;
(*$R-*)
MOVELEFT(REBELAST.A(1),REBELIN(ANTLINE).A(1),18);
(*$R+*)
EMNE.NR:=REBELAST.EMNENR;
GETREC(EMNE.A);CHECK0(EMNE.A);
MOVELEFT(EMNE.BETEGN(1),REBXTRA(ANTLINE).BETEGN(1),10);
ORDRE.NR:=REBELAST.ORDRENR;
ORDRE.EMNENR:=REBELAST.EMNENR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
REBXTRA(ANTLINE).BEKRÆLEV:=ORDRE.BEKRÆLEV;
IF ORDRE.BEKRÆLEV>0 THEN
REBXTRA(ANTLINE).ØNSKLEV:=ORDRE.BEKRÆLEV
ELSE
REBXTRA(ANTLINE).ØNSKLEV:=ORDRE.ØNSKLEV;
REBXTRA(ANTLINE).ANTALBES:=ORDRE.ANTALBES;
REBXTRA(ANTLINE).PLANLAGT:=FALSE;
NEXTREC(REBELAST.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REBELAST.A)
END;
(*$P*)
PROCEDURE ÆSTART;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(5));IF LINIENR>ANTLINE THEN EXIT(ÆSTART);
LÆSFELT(PICTURE(6));
IF UGE IN (.1..20.) THEN
BEGIN
IF UGE>ANTLINE THEN EXIT(ÆSTART);
IF UGE<LINIENR THEN UGE:=UGE-1;
WITH REBELIN(REBENR(LINIENR)) DO
IF UGE=0 THEN
BEGIN
STARTDAG:=PSTARTDAG;
STTIME:=1
END
ELSE
BEGIN
STARTDAG:=REBELIN(REBENR(UGE)).STARTDAG+
REBELIN(REBENR(UGE)).VARIGHED DIV 8;
STTIME:=REBELIN(REBENR(UGE)).STTIME+
REBELIN(REBENR(UGE)).VARIGHED MOD 8;
IF STTIME>8 THEN
BEGIN
STARTDAG:=STARTDAG+1;
STTIME:=STTIME-8
END
END;
IF UGE>LINIENR THEN
BEGIN
HUSK:=REBENR(LINIENR);
FOR I:=LINIENR TO UGE-1 DO REBENR(I):=REBENR(I+1);
REBENR(UGE):=HUSK;
RESSBILLEDE(LINIENR,UGE)
END
ELSE
BEGIN
HUSK:=REBENR(LINIENR);
FOR I:=LINIENR DOWNTO UGE+2 DO REBENR(I):=REBENR(I-1);
REBENR(UGE+1):=HUSK;
RESSBILLEDE(UGE+1,LINIENR)
END
END
ELSE
BEGIN
LÆSFELT(PICTURE(7));
LÆSFELT(PICTURE(8));
WITH REBELIN(REBENR(LINIENR)) DO
BEGIN
HUSKTID:=8*STARTDAG+STTIME;
UGEDAG.UGENR:=UGE;
GETREC(UGEDAG.A);IF IER=-6 THEN EXIT(ÆSTART);CHECK0(UGEDAG.A);
STARTDAG:=UGEDAG.ARBDAGNR+DAG-1;
STTIME:=TIME;
IF HUSKTID<8*STARTDAG+STTIME THEN DIRECTION:=1 ELSE DIRECTION:=-1;
HUSKTID:=8*STARTDAG+STTIME;
I:=LINIENR;
IF ((I=1) AND (DIRECTION=-1))
OR ((I=ANTLINE) AND (DIRECTION=1)) THEN DIRECTION:=0;
HUSK:=REBENR(I);
WHILE DIRECTION*HUSKTID>
DIRECTION*(REBELIN(REBENR(I+DIRECTION)).STARTDAG*8+
REBELIN(REBENR(I+DIRECTION)).STTIME) DO
BEGIN
REBENR(I):=REBENR(I+DIRECTION);
I:=I+DIRECTION;
IF ((I=1) AND (DIRECTION=-1))
OR ((I=ANTLINE) AND (DIRECTION=1)) THEN DIRECTION:=0
END;
REBENR(I):=HUSK;
IF I<LINIENR THEN RESSBILLEDE(I,LINIENR) ELSE RESSBILLEDE(LINIENR,I)
END
END
END
END;
(*$P*)
PROCEDURE ÆVARIG;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(5));IF LINIENR>ANTLINE THEN EXIT(ÆVARIG);
VARIGHED:=REBELIN(REBENR(LINIENR)).VARIGHED;
LÆSFELT(PICTURE(9));
REBELIN(REBENR(LINIENR)).VARIGHED:=VARIGHED;
RESSBILLEDE(LINIENR,LINIENR)
END
END;
(*$P*)
PROCEDURE ÆRESS;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(5));IF LINIENR>ANTLINE THEN EXIT(ÆRESS);
HUSK:=POST.RESSOURCE;
LÆSFELT(PICTURE(1));
RESS.NR:=POST.RESSOURCE;
POST.RESSOURCE:=HUSK;
GETREC(RESS.A);IF IER=-6 THEN EXIT(ÆRESS) ELSE CHECK0(RESS.A);
REBELIN(REBENR(LINIENR)).NR:=RESS.NR;
HUSK:=REBENR(LINIENR);
FOR I:=LINIENR TO ANTLINE-1 DO REBENR(I):=REBENR(I+1);
REBENR(ANTLINE):=HUSK;
D(ANTLINE+2,1);
ANTLINE:=ANTLINE-1;
UDE:=UDE+1;
RESSBILLEDE(LINIENR,ANTLINE)
END
END;
(*$P*)
PROCEDURE SEKVUDL;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(10));IF FRALINIE>ANTLINE THEN EXIT(SEKVUDL);
IF FRALINIE=0 THEN
BEGIN
TILLINIE:=ANTLINE;
REBELIN(REBENR(1)).STARTDAG:=PSTARTDAG;
REBELIN(REBENR(1)).STTIME:=1;
FRALINIE:=1
END;
LÆSFELT(PICTURE(11));IF TILLINIE>ANTLINE THEN EXIT(SEKVUDL);
I:=FRALINIE;
IF FRALINIE<TILLINIE THEN
BEGIN
WHILE I<TILLINIE DO
BEGIN
WITH REBELIN(REBENR(I)) DO
HUSKTID:=STARTDAG*8+
STTIME+
VARIGHED;
WITH REBELIN(REBENR(I+1)) DO
BEGIN
STARTDAG:=(HUSKTID-1) DIV 8;
STTIME:=(HUSKTID-1) MOD 8 +1
END;
I:=I+1
END;
RESSBILLEDE(FRALINIE,TILLINIE)
END
ELSE
BEGIN
WHILE I>TILLINIE DO
BEGIN
WITH REBELIN(REBENR(I)) DO
HUSKTID:=STARTDAG*8+
STTIME;
WITH REBELIN(REBENR(I-1)) DO
BEGIN
HUSKTID:=HUSKTID-VARIGHED;
STARTDAG:=(HUSKTID-1) DIV 8;
STTIME:=(HUSKTID-1) MOD 8 +1
END;
I:=I-1
END;
RESSBILLEDE(TILLINIE,FRALINIE)
END;
END
END;
(*$P*)
PROCEDURE CHECKPLAN;
VAR K,THISSTART,THISSLUT,LASTSTART,LASTSLUT,DIFF:INTEGER;
PRODLINE:ARRAY (1..50) OF ARRAY (1..4) OF INTEGER;
PROCEDURE NU(ORDRE,EMNE,OPERA:INTEGER);
BEGIN
D(24,1);
WRITE('Nu behandles: Ordre',ORDRE:5,' Emne',EMNE:5,' Operation',OPERA:5)
END;
BEGIN (*CHECKPLAN*)
CHECKOK:=TRUE;
FOR I:=1 TO ANTLINE+UDE DO
WITH REBELIN(REBENR(I)) DO
IF NOT REBXTRA(REBENR(I)).PLANLAGT THEN
BEGIN
NU(ORDRENR,EMNENR,OPERANR);
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVNR;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF STARTDAG*8+STTIME<PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000 THEN
BEGIN
(*OPERATIONEN ER LAGT TIDLIGERE, CHECK FORANLIGGENDE OPERATIONER*)
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
J:=0;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE PROD.OPERANR<>OPERANR DO
BEGIN
J:=J+1;
PRODLINE(J,1):=PROD.SEKVENSN;
PRODLINE(J,2):=PROD.OPERANR;
PRODLINE(J,3):=PROD.STARTTID;
PRODLINE(J,4):=PROD.VARIGHED;
NEXTREC(PROD.A);CHECK0(PROD.A)
END;
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
WHILE J>0 DO
BEGIN
THISSTART:=PRODLINE(J,3) MOD 1000*8+PRODLINE(J,3) DIV 1000;
THISSLUT:=THISSTART+PRODLINE(J,4);
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT<DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF>0 THEN
J:=0
ELSE
BEGIN
NU(PROD.ORDRENR,PROD.EMNENR,PRODLINE(J,2));
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
FOR K:=I+1 TO ANTLINE+UDE DO
WITH REBELIN(REBENR(K)) DO
IF (ORDRENR=PROD.ORDRENR) AND
(EMNENR=PROD.EMNENR) AND
(SEKVNR=PRODLINE(J,1)) AND
(OPERANR=PRODLINE(J,2)) THEN
BEGIN
STARTDAG:=(LASTSTART-1) DIV 8;
STTIME:=(LASTSTART-1) MOD 8+1;
REBXTRA(REBENR(I)).PLANLAGT:=TRUE
END
END;
J:=J-1;
(*CHECK FRA I+1 TIL ANTLINE+UDE OM DENNE PROD ER PÅ PLANLÆGNINGSSIDEN,
DEN SKAL I SÅ FALD HAVE ÆNDRET TIDEN, PLANLAGT:=TRUE, SORTERES IND
PÅ PLADS SOM I ÆSTART*)
END;
IF J=0 THEN
BEGIN
ARBEDAG.NR:=(LASTSTART-1) DIV 8; (*!*)
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
IF ARBEDAG.DATO(1)*10000.0+ARBEDAG.DATO(2)<
DAGSDATO(1)*10000.0+DAGSDATO(2) THEN
BEGIN
GOTOXY(1,23);
WRITE('Startdato ligger før dagsdato, RETURN ');
READLN;
CHECKOK:=FALSE;
EXIT(CHECKPLAN)
END
END
END;
IF STARTDAG*8+STTIME+VARIGHED>PROD.STARTTID MOD 1000*8+PROD.VARIGHED+
PROD.STARTTID DIV 1000 THEN
BEGIN
(*OPERATIONEN SLUTTER SENERE END PLANLAGT, CHECK EFTERFØLGENDE*)
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE (IER=0) AND (PROD.ORDRENR=ORDRENR) AND (PROD.EMNENR=EMNENR) DO
BEGIN
THISSTART:=PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000;
THISSLUT:=THISSTART+PROD.VARIGHED;
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT>DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF<0 THEN
IER:=-1
ELSE
BEGIN
NU(PROD.ORDRENR,PROD.EMNENR,PROD.OPERANR);
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
FOR K:=I+1 TO ANTLINE+UDE DO
WITH REBELIN(REBENR(K)) DO
IF (ORDRENR=PROD.ORDRENR) AND
(EMNENR=PROD.EMNENR) AND
(SEKVNR=PROD.SEKVENSN) AND
(OPERANR=PROD.OPERANR) THEN
BEGIN
STARTDAG:=(LASTSTART-1) DIV 8;
STTIME:=(LASTSTART-1) MOD 8+1;
REBXTRA(REBENR(I)).PLANLAGT:=TRUE
END;
(*CHECK FRA I+1 TIL ANTLINE+UDE OM DENNE PROD ER PÅ PLANLÆGNINGSSIDEN,
DEN SKAL I SÅ FALD HAVE ÆNDRET TIDEN, PLANLAGT:=TRUE, SORTERES IND
PÅ PLADS SOM I ÆSTART*)
NEXTREC(PROD.A)
END
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IF IER<>-1 THEN
BEGIN
ARBEDAG.NR:=(LASTSLUT-1) DIV 8;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
IF ARBEDAG.UGENR>REBXTRA(REBENR(I)).ØNSKLEV THEN
BEGIN
IF QJN('Skal leveringsuge rykkes') IN JA THEN
BEGIN
REBXTRA(REBENR(I)).ØNSKLEV:=ARBEDAG.UGENR;
IF REBXTRA(REBENR(I)).BEKRÆLEV>0 THEN
REBXTRA(REBENR(I)).BEKRÆLEV:=ARBEDAG.UGENR
END
ELSE
BEGIN
CHECKOK:=FALSE;
EXIT(CHECKPLAN)
END
END
END
END
END
ELSE
REBXTRA(REBENR(I)).PLANLAGT:=FALSE
END;
(*$P*)
PROCEDURE UDFPLAN;
VAR K,THISSTART,THISSLUT,LASTSTART,LASTSLUT,DIFF:INTEGER;
PRODLINE:ARRAY (1..50) OF ARRAY (1..4) OF INTEGER;
PROCEDURE NU(ORDRE,EMNE,OPERA:INTEGER);
BEGIN
D(24,1);
WRITE('Nu behandles: Ordre',ORDRE:5,' Emne',EMNE:5,' Operation',OPERA:5)
END;
PROCEDURE DESERVER(VAR RESSNR:INTEGER);
BEGIN
IF RESSNR>0 THEN
WITH REBELAST DO
BEGIN
RESS.NR:=RESSNR;
GETREC(RESS.A);CHECK0(RESS.A);
IF RESS.RESSTYPE>0 THEN
BEGIN
NR:=RESSNR;
GOTOXY(52,24);WRITE('Ressource',NR:5);
ORDRENR:=PROD.ORDRENR;
EMNENR:=PROD.EMNENR;
OPERANR:=PROD.OPERANR;
SEKVNR:=PROD.SEKVENSN;
STARTDAG:=PROD.STARTTID MOD 1000;
STTIME:=PROD.STARTTID DIV 1000;
VARIGHED:=PROD.VARIGHED;
GETRECX(A);CHECK0(A);
DELETE(A);CHECK0(A)
END
END
END;
(*$P*)
PROCEDURE RESERVER(VAR RESSNR:INTEGER);
BEGIN
IF RESSNR>0 THEN
WITH REBELAST DO
BEGIN
RESS.NR:=RESSNR;
GETREC(RESS.A);CHECK0(RESS.A);
IF RESS.RESSTYPE>0 THEN
BEGIN
NR:=RESSNR;
GOTOXY(52,24);WRITE('Ressource',NR:5);
ORDRENR:=PROD.ORDRENR;
EMNENR:=PROD.EMNENR;
OPERANR:=PROD.OPERANR;
SEKVNR:=PROD.SEKVENSN;
STARTDAG:=PROD.STARTTID MOD 1000;
STTIME:=PROD.STARTTID DIV 1000;
VARIGHED:=PROD.VARIGHED;
INSERT(A);CHECK0(A)
END
END
END;
(*$P*)
BEGIN
CHECKOK:=TRUE;
FOR I:=1 TO ANTLINE+UDE DO
WITH REBELIN(REBENR(I)) DO
IF NOT REBXTRA(REBENR(I)).PLANLAGT THEN
BEGIN
NU(ORDRENR,EMNENR,OPERANR);
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVNR;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
DESERVER(PROD.RESS1);
DESERVER(PROD.RESS2);
DESERVER(PROD.RESS3);
IF STARTDAG*8+STTIME<PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000 THEN
BEGIN
(*OPERATIONEN ER LAGT TIDLIGERE, CHECK FORANLIGGENDE OPERATIONER*)
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
J:=0;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE PROD.OPERANR<>OPERANR DO
BEGIN
J:=J+1;
PRODLINE(J,1):=PROD.SEKVENSN;
PRODLINE(J,2):=PROD.OPERANR;
PRODLINE(J,3):=PROD.STARTTID;
PRODLINE(J,4):=PROD.VARIGHED;
NEXTREC(PROD.A);CHECK0(PROD.A)
END;
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
WHILE J>0 DO
BEGIN
THISSTART:=PRODLINE(J,3) MOD 1000*8+PRODLINE(J,3) DIV 1000;
THISSLUT:=THISSTART+PRODLINE(J,4);
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT<DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF>0 THEN
J:=0
ELSE
BEGIN
NU(ORDRENR,EMNENR,PRODLINE(J,2));
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=PRODLINE(J,1);
PROD.OPERANR:=PRODLINE(J,2);
GETRECX(PROD.A);CHECK0(PROD.A);
DESERVER(PROD.RESS1);
DESERVER(PROD.RESS2);
DESERVER(PROD.RESS3);
PROD.STARTTID:=(LASTSTART-1) DIV 8+((LASTSTART-1) MOD 8+1)*1000;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
FOR K:=I+1 TO ANTLINE+UDE DO
WITH REBELIN(REBENR(K)) DO
IF (ORDRENR=PROD.ORDRENR) AND
(EMNENR=PROD.EMNENR) AND
(SEKVNR=PROD.SEKVENSN) AND
(OPERANR=PROD.OPERANR) THEN
BEGIN
STARTDAG:=(LASTSTART-1) DIV 8;
STTIME:=(LASTSTART-1) MOD 8+1;
REBXTRA(REBENR(I)).PLANLAGT:=TRUE
END;
PUTREC(PROD.A);CHECK0(PROD.A)
END;
J:=J-1
(*CHECK FRA I+1 TIL ANTLINE+UDE OM DENNE PROD ER PÅ PLANLÆGNINGSSIDEN,
DEN SKAL I SÅ FALD HAVE ÆNDRET TIDEN, PLANLAGT:=TRUE, SORTERES IND
PÅ PLADS SOM I ÆSTART*)
END
END;
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVNR;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF STARTDAG*8+STTIME+VARIGHED>PROD.STARTTID MOD 1000*8+PROD.VARIGHED+
PROD.STARTTID DIV 1000 THEN
BEGIN
(*OPERATIONEN SLUTTER SENERE END PLANLAGT, CHECK EFTERFØLGENDE*)
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
NEXTRECX(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE (IER=0) AND (PROD.ORDRENR=ORDRENR) AND (PROD.EMNENR=EMNENR) DO
BEGIN
THISSTART:=PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000;
THISSLUT:=THISSTART+PROD.VARIGHED;
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT>DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF<0 THEN
IER:=-1
ELSE
BEGIN
NU(PROD.ORDRENR,PROD.EMNENR,PROD.OPERANR);
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
DESERVER(PROD.RESS1);
DESERVER(PROD.RESS2);
DESERVER(PROD.RESS3);
PROD.STARTTID:=(LASTSTART-1) DIV 8+((LASTSTART-1) MOD 8+1)*1000;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
FOR K:=I+1 TO ANTLINE+UDE DO
WITH REBELIN(REBENR(K)) DO
IF (ORDRENR=PROD.ORDRENR) AND
(EMNENR=PROD.EMNENR) AND
(SEKVNR=PROD.SEKVENSN) AND
(OPERANR=PROD.OPERANR) THEN
BEGIN
STARTDAG:=(LASTSTART-1) DIV 8;
STTIME:=(LASTSTART-1) MOD 8+1;
REBXTRA(REBENR(I)).PLANLAGT:=TRUE
END;
PUTREC(PROD.A);CHECK0(PROD.A);
(*CHECK FRA I+1 TIL ANTLINE+UDE OM DENNE PROD ER PÅ PLANLÆGNINGSSIDEN,
DEN SKAL I SÅ FALD HAVE ÆNDRET TIDEN, PLANLAGT:=TRUE, SORTERES IND
PÅ PLADS SOM I ÆSTART*)
NEXTRECX(PROD.A)
END
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A)
END;
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVNR;
PROD.OPERANR:=OPERANR;
GETRECX(PROD.A);CHECK0(PROD.A);
PROD.STARTTID:=STARTDAG+1000*STTIME;
PROD.VARIGHED:=VARIGHED;
IF PROD.RESS1=POST.RESSOURCE THEN PROD.RESS1:=NR;
IF PROD.RESS2=POST.RESSOURCE THEN PROD.RESS2:=NR;
IF PROD.RESS3=POST.RESSOURCE THEN PROD.RESS3:=NR;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
PUTREC(PROD.A);CHECK0(PROD.A);
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=EMNENR;
GETRECX(ORDRE.A);CHECK0(ORDRE.A);
ORDRE.BEKRÆLEV:=REBXTRA(REBENR(I)).ØNSKLEV;
PUTREC(ORDRE.A);CHECK0(ORDRE.A)
END
END;
(*$P*)
PROCEDURE AFSLUT;
BEGIN
IF QJN('Ønskes check og ændringer foretaget') IN JA THEN
BEGIN
GETRECX(SYSTEM.A);CHECK0(SYSTEM.A);
CHECKPLAN;
IF CHECKOK THEN
BEGIN
UDFPLAN;
GETBELAST;
RESSBILLEDE(0,ANTLINE)
END
ELSE CH(1):='5';
PUTREC(SYSTEM.A);CHECK0(SYSTEM.A)
END
END;
(*$P*)
BEGIN (*RESSPLAN*)
CHECKOK:=FALSE;
REPEAT
LÆSFELT(PICTURE(1));
IF POST.RESSOURCE=0 THEN EXIT(RESSPLAN);
RESS.NR:=POST.RESSOURCE;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=-6 THEN BEGIN NONEXIST('Ressourcen'); EXIT(RESSPLAN) END;
GETBELAST;
RESSBILLEDE(0,ANTLINE);
REPEAT
D(23,2);
WRITELN('Ændring af 1: Starttid 2: Varighed 3: Ressource',
' Vælg 1-6');
WRITE('4: Sekventiel udlægning 5: Check plan 6: Afslut');
REPEAT
CH:='1';
GOTOXY(75,23);
EDIT(CH)
UNTIL CH(1) IN (.'1'..'6'.);
CASE CH(1) OF
'1':ÆSTART;
'2':ÆVARIG;
'3':ÆRESS;
'4':SEKVUDL;
'5':BEGIN CHECKPLAN;RESSBILLEDE(0,ANTLINE) END;
'6':AFSLUT
END
UNTIL CH(1)='6'
UNTIL POST.RESSOURCE=0
END;
(*$P*)
PROCEDURE ORDREPLAN;
VAR CH:STRING(1);
CHECKOK:BOOLEAN;
SKEMA:PACKED ARRAY (1..52) OF CHAR;
REBXTRA:ARRAY (1..20) OF REBEXTRA;
ORDENR:ARRAY (1..20) OF INTEGER;
ORDELIN:ARRAY (1..20) OF PRODPOST;
PROCEDURE ORDBILLEDE(FRA,TIL:INTEGER); (*FRA=0 => ALLE + HOVED*)
VAR I,AKTWEEK,AKTDAG,STARTDAG,STTIME,
REST,C:INTEGER;
ESC:PACKED ARRAY (1..2) OF CHAR;
CH:CHAR;
BEGIN
ESC:=' N';ESC(1):=CHR(27);
IF FRA=0 THEN
BEGIN
CLEARSCREEN;
SKEMA:='ü ü';
WRITE('Ordrenr :',ORDRE.NR:5,' ':5);
ARBEDAG.NR:=PSTARTDAG;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
AKTWEEK:=0;
FOR I:=1 TO 25 DO
BEGIN
IF AKTWEEK<>ARBEDAG.UGENR THEN
BEGIN
SKEMA(2*I-1):='ü';
AKTWEEK:=ARBEDAG.UGENR;
WRITE(ARBEDAG.UGENR MOD 100:2)
END
ELSE WRITE(' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(' Leveres');
WRITE('Nr Opera Betegnelse ');
ARBEDAG.NR:=PSTARTDAG;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
AKTDAG:=0;
AKTWEEK:=0;
FOR I:=1 TO 25 DO
BEGIN
IF AKTWEEK<>ARBEDAG.UGENR THEN
BEGIN AKTDAG:=0; AKTWEEK:=ARBEDAG.UGENR END;
IF AKTDAG<5 THEN
BEGIN
AKTDAG:=AKTDAG+1;
WRITE(AKTDAG:2)
END
ELSE WRITE(' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(' Uge ant');
FRA:=1
END;
FOR I:=FRA TO TIL DO
WITH ORDELIN(ORDENR(I)),REBXTRA(ORDENR(I)) DO
BEGIN
STARTDAG:=STARTTID MOD 1000;STTIME:=STARTTID DIV 1000;
GOTOXY(1,I+2);
WRITE(I:2,OPERANR:6,' ',BETEGN,SKEMA);
IF (STARTDAG-PSTARTDAG) IN (.0..24.) THEN
BEGIN
GOTOXY(21+2*(STARTDAG-PSTARTDAG),I+2);
IF STTIME>4 THEN WRITE(' ');
IF STARTDAG-PSTARTDAG+(VARIGHED-1) DIV 8<26 THEN
REST:=VARIGHED
ELSE
REST:=200-(STARTDAG-PSTARTDAG)*8;
CASE STTIME MOD 4 OF
0:BEGIN C:=40;REST:=REST-1 END;
2:CASE VARIGHED OF
1:BEGIN C:=36;REST:=REST-1 END;
2:BEGIN C:=38;REST:=REST-2 END;
OTHERWISE BEGIN C:=46;REST:=REST-3 END;
3:IF VARIGHED=1 THEN BEGIN C:=34;REST:=REST-1 END
ELSE BEGIN C:=42;REST:=REST-2 END;
OTHERWISE C:=0;
IF C>0 THEN
BEGIN
CH:=CHR(C);
WRITE(ESC,CH)
END;
CH:=CHR(47);
WHILE REST>3 DO
BEGIN
WRITE(ESC,CH);
REST:=REST-4
END;
CASE REST OF
1:C:=33;
2:C:=37;
3:C:=39;
OTHERWISE C:=0;
IF C>0 THEN
BEGIN
CH:=CHR(C);
WRITE(ESC,CH)
END
END;
GOTOXY(72,I+2);
IF BEKRÆLEV>0 THEN
WRITE(BEKRÆLEV MOD 100:2,'!')
ELSE
WRITE(ØNSKLEV MOD 100:2,' ');
WRITE(ORDRE.ANTALBES:5:-2)
END
END;
(*$P*)
PROCEDURE GETPROD;
BEGIN
PROD.ORDRENR:=POST.ORDRE;
PROD.EMNENR:=POST.EMNENR;
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
UDE:=0;
ANTLINE:=0;
WHILE (IER=0) AND (PROD.ORDRENR=POST.ORDRE) AND (PROD.EMNENR=POST.EMNENR)
AND (PROD.STARTTID MOD 1000-PSTARTDAG<25) AND (ANTLINE<20) DO
BEGIN
IF PROD.STARTTID MOD 1000>=PSTARTDAG THEN
BEGIN
ANTLINE:=ANTLINE+1;
ORDENR(ANTLINE):=ANTLINE;
(*$R-*)
MOVELEFT(PROD.A(1),ORDELIN(ANTLINE).A(1),42);
(*$R+*)
OPERA.NR:=PROD.OPERANR;
GETREC(OPERA.A);CHECK0(OPERA.A);
MOVELEFT(OPERA.BETEGN(1),REBXTRA(ANTLINE).BETEGN(1),10);
REBXTRA(ANTLINE).BEKRÆLEV:=ORDRE.BEKRÆLEV;
IF ORDRE.BEKRÆLEV>0 THEN
REBXTRA(ANTLINE).ØNSKLEV:=ORDRE.BEKRÆLEV
ELSE
REBXTRA(ANTLINE).ØNSKLEV:=ORDRE.ØNSKLEV;
REBXTRA(ANTLINE).PLANLAGT:=FALSE;
END;
NEXTREC(PROD.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(PROD.A)
END;
(*$P*)
PROCEDURE ÆSTART;
VAR GSTTIME,STTIME,DIFF:INTEGER;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(5));IF LINIENR>ANTLINE THEN EXIT(ÆSTART);
LÆSFELT(PICTURE(6));
IF UGE IN (.1..20.) THEN
BEGIN
IF (UGE>ANTLINE) OR
(UGE=LINIENR) OR (UGE>LINIENR+1) OR (UGE<LINIENR-1) THEN EXIT(ÆSTART);
STTIME:=ORDELIN(ORDENR(UGE)).STARTTID DIV 1000+
ORDELIN(ORDENR(UGE)).STARTTID MOD 1000*8;
DIFF:=ORDELIN(ORDENR(UGE)).VARIGHED-
ORDELIN(ORDENR(LINIENR)).VARIGHED;
IF DIFF*(UGE-LINIENR)<0 THEN STTIME:=STTIME+DIFF
END
ELSE
BEGIN
LÆSFELT(PICTURE(7));
LÆSFELT(PICTURE(8));
UGEDAG.UGENR:=UGE;
GETREC(UGEDAG.A);IF IER=-6 THEN EXIT(ÆSTART);CHECK0(UGEDAG.A);
DIFF:=UGEDAG.ARBDAGNR+DAG-1;
IF (DIFF<PSTARTDAG) OR (DIFF>PSTARTDAG+25) THEN EXIT(ÆSTART);
STTIME:=DIFF*8+TIME;
GSTTIME:=ORDELIN(ORDENR(LINIENR)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR)).STARTTID MOD 1000*8;
IF (STTIME>GSTTIME) AND (LINIENR<ANTLINE) THEN
BEGIN
IF STTIME>ORDELIN(ORDENR(LINIENR+1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR+1)).STARTTID MOD 1000*8 THEN
STTIME:=ORDELIN(ORDENR(LINIENR+1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR+1)).STARTTID MOD 1000*8;
DIFF:=ORDELIN(ORDENR(LINIENR+1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR+1)).STARTTID MOD 1000*8+
ORDELIN(ORDENR(LINIENR+1)).VARIGHED-STTIME-
ORDELIN(ORDENR(LINIENR)).VARIGHED;
IF DIFF<0 THEN STTIME:=STTIME+DIFF
END;
IF (STTIME<GSTTIME) AND (LINIENR>1) THEN
BEGIN
IF STTIME<ORDELIN(ORDENR(LINIENR-1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR-1)).STARTTID MOD 1000*8 THEN
STTIME:=ORDELIN(ORDENR(LINIENR-1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR-1)).STARTTID MOD 1000*8;
DIFF:=ORDELIN(ORDENR(LINIENR-1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR-1)).STARTTID MOD 1000*8+
ORDELIN(ORDENR(LINIENR-1)).VARIGHED-STTIME-
ORDELIN(ORDENR(LINIENR)).VARIGHED;
IF DIFF>0 THEN STTIME:=STTIME+DIFF
END
END;
ORDELIN(ORDENR(LINIENR)).STARTTID:=
(STTIME-1) DIV 8+((STTIME-1) MOD 8+1)*1000;
ORDBILLEDE(LINIENR,LINIENR)
END
END;
(*$P*)
PROCEDURE ÆVARIG;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(5));IF LINIENR>ANTLINE THEN EXIT(ÆVARIG);
VARIGHED:=ORDELIN(ORDENR(LINIENR)).VARIGHED;
LÆSFELT(PICTURE(9));
IF (LINIENR<ANTLINE) AND
(VARIGHED>ORDELIN(ORDENR(LINIENR)).VARIGHED) THEN
IF (ORDELIN(ORDENR(LINIENR+1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR+1)).STARTTID MOD 1000*8+
ORDELIN(ORDENR(LINIENR+1)).VARIGHED)<
(ORDELIN(ORDENR(LINIENR)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR)).STARTTID MOD 1000*8+
VARIGHED) THEN EXIT(ÆVARIG);
IF (LINIENR>1) AND
(VARIGHED<ORDELIN(ORDENR(LINIENR)).VARIGHED) THEN
IF (ORDELIN(ORDENR(LINIENR-1)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR-1)).STARTTID MOD 1000*8+
ORDELIN(ORDENR(LINIENR-1)).VARIGHED)>
(ORDELIN(ORDENR(LINIENR)).STARTTID DIV 1000+
ORDELIN(ORDENR(LINIENR)).STARTTID MOD 1000*8+
VARIGHED) THEN EXIT(ÆVARIG);
ORDELIN(ORDENR(LINIENR)).VARIGHED:=VARIGHED;
ORDBILLEDE(LINIENR,LINIENR)
END
END;
(*$P*)
PROCEDURE SEKVUDL;
VAR THISSTART,THISSLUT,LASTSTART,LASTSLUT,DIFF:INTEGER;
BEGIN
WITH POST DO
BEGIN
LÆSFELT(PICTURE(10));IF FRALINIE>ANTLINE THEN EXIT(SEKVUDL);
IF FRALINIE=0 THEN
BEGIN
TILLINIE:=ANTLINE;
ORDELIN(ORDENR(1)).STARTTID:=PSTARTDAG+1000;
FRALINIE:=1
END;
LÆSFELT(PICTURE(11));IF TILLINIE>ANTLINE THEN EXIT(SEKVUDL);
I:=FRALINIE;
IF FRALINIE<TILLINIE THEN
BEGIN
WHILE I<TILLINIE DO
BEGIN
WITH ORDELIN(ORDENR(I)) DO
HUSKTID:=STARTTID MOD 1000*8+
STARTTID DIV 1000+
VARIGHED;
ORDELIN(ORDENR(I+1)).STARTTID:=(HUSKTID-1) DIV 8 +
((HUSKTID-1) MOD 8+1)*1000;
I:=I+1
END;
LASTSTART:=HUSKTID;
LASTSLUT:=ORDELIN(ORDENR(TILLINIE)).VARIGHED+LASTSTART;
I:=TILLINIE+1;
WHILE I<=ANTLINE DO
WITH ORDELIN(ORDENR(I)) DO
BEGIN
THISSTART:=STARTTID MOD 1000*8+STARTTID DIV 1000;
THISSLUT:=THISSTART+VARIGHED;
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT>DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF>0 THEN
BEGIN
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
STARTTID:=(LASTSTART-1) DIV 8+((LASTSTART-1) MOD 8+1)*1000;
I:=I+1
END
ELSE I:=ANTLINE+1
END;
ORDBILLEDE(FRALINIE,ANTLINE)
END
ELSE
BEGIN
WHILE I>TILLINIE DO
BEGIN
WITH ORDELIN(ORDENR(I)) DO
HUSKTID:=STARTTID MOD 1000*8+STARTTID DIV 1000;
WITH ORDELIN(ORDENR(I-1)) DO
BEGIN
HUSKTID:=HUSKTID-VARIGHED;
STARTTID:=(HUSKTID-1) DIV 8 +
((HUSKTID-1) MOD 8+1)*1000
END;
I:=I-1
END;
LASTSTART:=HUSKTID;
LASTSLUT:=ORDELIN(ORDENR(TILLINIE)).VARIGHED+LASTSTART;
I:=TILLINIE-1;
WHILE I>0 DO
WITH ORDELIN(ORDENR(I)) DO
BEGIN
THISSTART:=STARTTID MOD 1000*8+STARTTID DIV 1000;
THISSLUT:=THISSTART+VARIGHED;
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT<DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF<0 THEN
BEGIN
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
STARTTID:=(LASTSTART-1) DIV 8+((LASTSTART-1) MOD 8+1)*1000;
I:=I-1
END
ELSE I:=0
END;
ORDBILLEDE(1,FRALINIE)
END;
END
END;
(*$P*)
PROCEDURE CHECKPLAN;
VAR STARTDAG,STTIME,K,THISSTART,THISSLUT,LASTSTART,LASTSLUT,DIFF:INTEGER;
PRODLINE:ARRAY (1..50) OF ARRAY (1..4) OF INTEGER;
PROCEDURE NU(OPERA:INTEGER);
BEGIN
D(24,1);
WRITE('Nu behandles: Operation',OPERA:5)
END;
BEGIN (*CHECKPLAN*)
CHECKOK:=TRUE;
WITH ORDELIN(ORDENR(1)) DO
BEGIN
STARTDAG:=STARTTID MOD 1000;
STTIME:=STARTTID DIV 1000;
NU(OPERANR);
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVENSN;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF STARTDAG*8+STTIME<PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000 THEN
BEGIN
(*OPERATIONEN ER LAGT TIDLIGERE, CHECK FORANLIGGENDE OPERATIONER*)
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
J:=0;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE PROD.OPERANR<>OPERANR DO
BEGIN
J:=J+1;
PRODLINE(J,1):=PROD.SEKVENSN;
PRODLINE(J,2):=PROD.OPERANR;
PRODLINE(J,3):=PROD.STARTTID;
PRODLINE(J,4):=PROD.VARIGHED;
NEXTREC(PROD.A);CHECK0(PROD.A)
END;
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
WHILE J>0 DO
BEGIN
THISSTART:=PRODLINE(J,3) MOD 1000*8+PRODLINE(J,3) DIV 1000;
THISSLUT:=THISSTART+PRODLINE(J,4);
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT<DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF>0 THEN
J:=0
ELSE
BEGIN
NU(PRODLINE(J,2));
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF
END;
J:=J-1
END;
IF J=0 THEN
BEGIN
ARBEDAG.NR:=(LASTSTART-1) DIV 8; (*!*)
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
IF ARBEDAG.DATO(1)*10000.0+ARBEDAG.DATO(2)<
DAGSDATO(1)*10000.0+DAGSDATO(2) THEN
BEGIN
GOTOXY(1,23);
WRITE('Startdato ligger før dagsdato, RETURN ');
READLN;
CHECKOK:=FALSE;
EXIT(CHECKPLAN)
END
END
END;
END;
WITH ORDELIN(ORDENR(ANTLINE)) DO
BEGIN
STARTDAG:=STARTTID MOD 1000;
STTIME:=STARTTID DIV 1000;
NU(OPERANR);
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVENSN;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF STARTDAG*8+STTIME+VARIGHED>PROD.STARTTID MOD 1000*8+PROD.VARIGHED+
PROD.STARTTID DIV 1000 THEN
BEGIN
(*OPERATIONEN SLUTTER SENERE END PLANLAGT, CHECK EFTERFØLGENDE*)
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE (IER=0) AND (PROD.ORDRENR=ORDRENR) AND (PROD.EMNENR=EMNENR) DO
BEGIN
THISSTART:=PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000;
THISSLUT:=THISSTART+PROD.VARIGHED;
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT>DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF<0 THEN
IER:=-1
ELSE
BEGIN
NU(PROD.OPERANR);
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
NEXTREC(PROD.A)
END
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IF IER<>-1 THEN
BEGIN
ARBEDAG.NR:=(LASTSLUT-1) DIV 8;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
IF ARBEDAG.UGENR>REBXTRA(ORDENR(ANTLINE)).ØNSKLEV THEN
BEGIN
IF QJN('Skal leveringsuge rykkes') IN JA THEN
FOR I:=1 TO ANTLINE DO
BEGIN
REBXTRA(ORDENR(I)).ØNSKLEV:=ARBEDAG.UGENR;
IF REBXTRA(ORDENR(I)).BEKRÆLEV>0 THEN
REBXTRA(ORDENR(I)).BEKRÆLEV:=ARBEDAG.UGENR
END
ELSE
BEGIN
CHECKOK:=FALSE;
EXIT(CHECKPLAN)
END
END
END
END
END
END;
(*$P*)
PROCEDURE UDFPLAN;
VAR STARTDAG,STTIME,K,THISSTART,THISSLUT,LASTSTART,LASTSLUT,DIFF:INTEGER;
PRODLINE:ARRAY (1..50) OF ARRAY (1..4) OF INTEGER;
PROCEDURE NU(OPERA:INTEGER);
BEGIN
D(24,1);
WRITE('Nu behandles: Operation',OPERA:5)
END;
PROCEDURE DESERVER(VAR RESSNR:INTEGER);
BEGIN
IF RESSNR>0 THEN
WITH REBELAST DO
BEGIN
RESS.NR:=RESSNR;
GETREC(RESS.A);CHECK0(RESS.A);
IF RESS.RESSTYPE>0 THEN
BEGIN
NR:=RESSNR;
GOTOXY(31,24);WRITE('Ressource',NR:5);
ORDRENR:=PROD.ORDRENR;
EMNENR:=PROD.EMNENR;
OPERANR:=PROD.OPERANR;
SEKVNR:=PROD.SEKVENSN;
STARTDAG:=PROD.STARTTID MOD 1000;
STTIME:=PROD.STARTTID DIV 1000;
VARIGHED:=PROD.VARIGHED;
GETRECX(A);CHECK0(A);
DELETE(A);CHECK0(A)
END
END
END;
(*$P*)
PROCEDURE RESERVER(VAR RESSNR:INTEGER);
BEGIN
IF RESSNR>0 THEN
WITH REBELAST DO
BEGIN
RESS.NR:=RESSNR;
GETREC(RESS.A);CHECK0(RESS.A);
IF RESS.RESSTYPE>0 THEN
BEGIN
NR:=RESSNR;
ORDRENR:=PROD.ORDRENR;
EMNENR:=PROD.EMNENR;
OPERANR:=PROD.OPERANR;
SEKVNR:=PROD.SEKVENSN;
STARTDAG:=PROD.STARTTID MOD 1000;
STTIME:=PROD.STARTTID DIV 1000;
VARIGHED:=PROD.VARIGHED;
INSERT(A);CHECK0(A)
END
END
END;
(*$P*)
BEGIN
FOR I:=1 TO ANTLINE DO
WITH ORDELIN(ORDENR(I)) DO
BEGIN
STARTDAG:=STARTTID MOD 1000;
STTIME:=STARTTID DIV 1000;
NU(OPERANR);
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVENSN;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
DESERVER(PROD.RESS1);
DESERVER(PROD.RESS2);
DESERVER(PROD.RESS3);
IF (STARTDAG*8+STTIME<PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000)
AND (I=1) THEN
BEGIN
(*OPERATIONEN ER LAGT TIDLIGERE, CHECK FORANLIGGENDE OPERATIONER*)
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
J:=0;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE PROD.OPERANR<>OPERANR DO
BEGIN
J:=J+1;
PRODLINE(J,1):=PROD.SEKVENSN;
PRODLINE(J,2):=PROD.OPERANR;
PRODLINE(J,3):=PROD.STARTTID;
PRODLINE(J,4):=PROD.VARIGHED;
NEXTREC(PROD.A);CHECK0(PROD.A)
END;
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
WHILE J>0 DO
BEGIN
THISSTART:=PRODLINE(J,3) MOD 1000*8+PRODLINE(J,3) DIV 1000;
THISSLUT:=THISSTART+PRODLINE(J,4);
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT<DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF>0 THEN
J:=0
ELSE
BEGIN
NU(PRODLINE(J,2));
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=PRODLINE(J,1);
PROD.OPERANR:=PRODLINE(J,2);
GETRECX(PROD.A);CHECK0(PROD.A);
DESERVER(PROD.RESS1);
DESERVER(PROD.RESS2);
DESERVER(PROD.RESS3);
PROD.STARTTID:=(LASTSTART-1) DIV 8+((LASTSTART-1) MOD 8+1)*1000;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
PUTREC(PROD.A);CHECK0(PROD.A)
END;
J:=J-1
END
END;
STARTDAG:=STARTTID MOD 1000;
STTIME:=STARTTID DIV 1000;
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVENSN;
PROD.OPERANR:=OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF (STARTDAG*8+STTIME+VARIGHED>PROD.STARTTID MOD 1000*8+PROD.VARIGHED+
PROD.STARTTID DIV 1000) AND (I=ANTLINE) THEN
BEGIN
(*OPERATIONEN SLUTTER SENERE END PLANLAGT, CHECK EFTERFØLGENDE*)
LASTSTART:=STARTDAG*8+STTIME;
LASTSLUT:=LASTSTART+VARIGHED;
NEXTRECX(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
WHILE (IER=0) AND (PROD.ORDRENR=ORDRENR) AND (PROD.EMNENR=EMNENR) DO
BEGIN
THISSTART:=PROD.STARTTID MOD 1000*8+PROD.STARTTID DIV 1000;
THISSLUT:=THISSTART+PROD.VARIGHED;
DIFF:=LASTSTART-THISSTART;
IF LASTSLUT-THISSLUT>DIFF THEN DIFF:=LASTSLUT-THISSLUT;
IF DIFF<0 THEN
IER:=-1
ELSE
BEGIN
NU(PROD.OPERANR);
LASTSTART:=THISSTART+DIFF;
LASTSLUT:=THISSLUT+DIFF;
DESERVER(PROD.RESS1);
DESERVER(PROD.RESS2);
DESERVER(PROD.RESS3);
PROD.STARTTID:=(LASTSTART-1) DIV 8+((LASTSTART-1) MOD 8+1)*1000;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
PUTREC(PROD.A);CHECK0(PROD.A);
NEXTRECX(PROD.A)
END
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A)
END;
PROD.ORDRENR:=ORDRENR;
PROD.EMNENR:=EMNENR;
PROD.SEKVENSN:=SEKVENSN;
PROD.OPERANR:=OPERANR;
GETRECX(PROD.A);CHECK0(PROD.A);
PROD.STARTTID:=STARTTID;
PROD.VARIGHED:=VARIGHED;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
PUTREC(PROD.A);CHECK0(PROD.A);
IF I=ANTLINE THEN
BEGIN
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=EMNENR;
GETRECX(ORDRE.A);CHECK0(ORDRE.A);
ORDRE.BEKRÆLEV:=REBXTRA(ORDENR(I)).ØNSKLEV;
PUTREC(ORDRE.A);CHECK0(ORDRE.A)
END
END
END;
(*$P*)
PROCEDURE AFSLUT;
BEGIN
IF QJN('Ønskes check og ændringer foretaget') IN JA THEN
BEGIN
GETRECX(SYSTEM.A);CHECK0(SYSTEM.A);
CHECKPLAN;
IF CHECKOK THEN
BEGIN
UDFPLAN;
GETPROD;
ORDBILLEDE(0,ANTLINE)
END
ELSE CH(1):='4';
PUTREC(SYSTEM.A);CHECK0(SYSTEM.A)
END
END;
(*$P*)
BEGIN (*ORDREPLAN*)
CHECKOK:=FALSE;
REPEAT
LÆSFELT(PICTURE(2));
IF POST.ORDRE=0 THEN EXIT(ORDREPLAN);
LÆSFELT(PICTURE(3));
ORDRE.NR:=POST.ORDRE;
ORDRE.EMNENR:=POST.EMNENR;
GETREC(ORDRE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(ORDRE.A);
IF IER=-6 THEN BEGIN NONEXIST('Ordren'); EXIT(ORDREPLAN) END;
GETPROD;
ORDBILLEDE(0,ANTLINE);
REPEAT
D(23,2);
WRITELN('Ændring af 1: Starttid 2: Varighed ',
' Vælg 1-5');
WRITE('3: Sekventiel udlægning 4: Check plan 5: Afslut');
REPEAT
CH:='1';
GOTOXY(75,23);
EDIT(CH)
UNTIL CH(1) IN (.'1'..'5'.);
CASE CH(1) OF
'1':ÆSTART;
'2':ÆVARIG;
'3':SEKVUDL;
'4':BEGIN CHECKPLAN;ORDBILLEDE(0,ANTLINE) END;
'5':AFSLUT
END
UNTIL CH(1)='5'
UNTIL POST.ORDRE=0
END;
(*$P*)
PROCEDURE UDLÆGORDRE;
VAR VARIGHED,TIDSFORB,ØLEVDAG,DAGE,TIMER,STARTTIME,STARTDAY :INTEGER;
PROCEDURE RESERVER(VAR RESSNR:INTEGER);
BEGIN
IF RESSNR<0 THEN
WITH RESSGRUP DO
BEGIN
GRUPNR:=-RESSNR;
NR:=0;
REBELAST.GRUPPE:=GRUPNR;
NEXTREC(A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(A);
IF GRUPNR=-RESSNR THEN RESSNR:=NR
END
ELSE REBELAST.GRUPPE:=0;
IF RESSNR>0 THEN
WITH REBELAST DO
BEGIN
RESS.NR:=RESSNR;
GETREC(RESS.A);CHECK0(RESS.A);
IF RESS.RESSTYPE>0 THEN
BEGIN
NR:=RESSNR;
ORDRENR:=PROD.ORDRENR;
EMNENR:=PROD.EMNENR;
OPERANR:=PROD.OPERANR;
SEKVNR:=PROD.SEKVENSN;
STARTDAG:=PROD.STARTTID MOD 1000;
STTIME:=PROD.STARTTID DIV 1000;
VARIGHED:=PROD.VARIGHED;
INSERT(A);CHECK0(A)
END
END
END;
(*$P*)
BEGIN (*UDLÆGORDRE*)
REPEAT
LÆSFELT(PICTURE(2));
IF POST.ORDRE=0 THEN EXIT(UDLÆGORDRE);
LÆSFELT(PICTURE(3));
ORDRE.NR:=POST.ORDRE;
ORDRE.EMNENR:=POST.EMNENR;
GETRECX(ORDRE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(ORDRE.A);
IF IER=-6 THEN
NONEXIST('Ordren')
ELSE
BEGIN
IF ORDRE.BEKRÆLEV<>0 THEN
BEGIN
D(23,1);
WRITE('Ordren er allerede udlagt');
READLN
END
ELSE
WITH PROD DO
BEGIN
ORDRE.BEKRÆLEV:=-1;
TIDSFORB:=0;
ORDRENR:=ORDRE.NR;
EMNENR:=ORDRE.EMNENR;
SEKVENSN:=0;
OPERANR:=0;
NEXTREC(A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (ORDRENR=ORDRE.NR) AND (EMNENR=ORDRE.EMNENR) DO
BEGIN
TIDSFORB:=TIDSFORB+PROD.VARIGHED;
OPERA.NR:=PROD.OPERANR;
GETREC(OPERA.A);CHECK0(OPERA.A);
TIDSFORB:=TIDSFORB+ROUND(OPERA.TILLÆG);
NEXTREC(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
UGEDAG.UGENR:=ORDRE.ØNSKLEV;
GETREC(UGEDAG.A);CHECK0(UGEDAG.A);
ØLEVDAG:=UGEDAG.ARBDAGNR;
DAGE:=TIDSFORB DIV 8;
TIMER:=TIDSFORB MOD 8;
STARTTIME:=1;
STARTDAY:=ØLEVDAG-DAGE;
IF TIMER>0 THEN
BEGIN
STARTDAY:=STARTDAY-1;
STARTTIME:=9-TIMER
END;
ORDRENR:=ORDRE.NR;
EMNENR:=ORDRE.EMNENR;
SEKVENSN:=0;
OPERANR:=0;
NEXTRECX(A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (ORDRENR=ORDRE.NR) AND (EMNENR=ORDRE.EMNENR) DO
BEGIN
OPERA.NR:=PROD.OPERANR;
GETREC(OPERA.A);CHECK0(OPERA.A);
GOTOXY(1,24);
WRITE('Nu behandles operation ',OPERA.BETEGN,OPERA.NR:5);
IF STARTDAY>=PSTARTDAG THEN
PROD.STARTTID:=1000*STARTTIME+STARTDAY
ELSE
PROD.STARTTID:=1000+PSTARTDAG;
RESERVER(PROD.RESS1);
RESERVER(PROD.RESS2);
RESERVER(PROD.RESS3);
PUTREC(A);CHECK0(A);
STARTTIME:=STARTTIME+VARIGHED+ROUND(OPERA.TILLÆG);
STARTDAY:=STARTDAY+STARTTIME DIV 8;
STARTTIME:=STARTTIME MOD 8;
IF STARTTIME=0 THEN
BEGIN
STARTDAY:=STARTDAY-1;
STARTTIME:=8
END;
NEXTRECX(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
D(24,1)
END;
PUTREC(ORDRE.A);CHECK0(ORDRE.A)
END
UNTIL POST.ORDRE=0
END;
(*$P*)
PROCEDURE MAINTAIN;
VAR CH:CHAR;
BEGIN (*MAINTAIN*)
REPEAT
LÆSFELT(PICTURE(4));
UGEDAG.UGENR:=POST.STARTUGE;
GETREC(UGEDAG.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(UGEDAG.A);
IF IER=0 THEN
BEGIN
ARBEDAG.NR:=UGEDAG.ARBDAGNR;
GETREC(ARBEDAG.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(ARBEDAG.A);
IF (DAGSDATO(1)*10000.0+DAGSDATO(2))>
(ARBEDAG.DATO(1)*10000.0+ARBEDAG.DATO(2)) THEN IER:=-6
END
UNTIL IER=0;
PSTARTDAG:=UGEDAG.ARBDAGNR;
CASE OPTION OF
1:RESSPLAN;
2:ORDREPLAN;
3:UDLÆGORDRE
END
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-*)
RESS.A(-4):=0;
RESSGRUP.A(-4):=0;
EMNE.A(-4):=0;
OPERA.A(-4):=0;
SYSTEM.A(-4):=0;
PROD.A(-4):=0;
ORDRE.A(-4):=0;
REBELAST.A(-4):=0;
UGEDAG.A(-4):=0;
ARBEDAG.A(-4):=0;
UGEDAG.A(-3):=21;
ARBEDAG.A(-3):=22;
RESS.A(-3):=4;
RESSGRUP.A(-3):=3;
EMNE.A(-3):=2;
OPERA.A(-3):=6;
SYSTEM.A(-3):=9;
PROD.A(-3):=14;
ORDRE.A(-3):=10;
REBELAST.A(-3):=15;
(*$R+*)
(*@@EVT. ÅBNING AF ANDRE ANDRE DATAFILER*)
IOPEN(SYSTEM.A); CHECK0(SYSTEM.A);
IOPEN(ORDRE.A); CHECK0(ORDRE.A);
IOPEN(REBELAST.A); CHECK0(REBELAST.A);
IOPEN(PROD.A); CHECK0(PROD.A);
IOPEN(UGEDAG.A); CHECK0(UGEDAG.A);
IOPEN(ARBEDAG.A); CHECK0(ARBEDAG.A);
IOPEN(RESS.A); CHECK0(RESS.A);
IOPEN(RESSGRUP.A); CHECK0(RESSGRUP.A);
IOPEN(EMNE.A); CHECK0(EMNE.A);
IOPEN(OPERA.A); CHECK0(OPERA.A);
SYSTEM.NR:=0;
GETREC(SYSTEM.A);CHECK0(SYSTEM.A);
DAGSDATO:=SYSTEM.DAGSDATO;
SYSTEM.NR:=1;
POST.STARTUGE:=0;
REPEAT
CLEARSCREEN;
GOTOXY(1,10);
WRITELN('0 Færdig');
WRITELN('1 Ressourceplanlægning');
WRITELN('2 Ordreplanlægning');
WRITELN('3 Udlægning af ordre');
LÆSFELT(PICTURE(13));
OPTION:=POST.OPTION;
IF OPTION>0 THEN MAINTAIN
UNTIL OPTION=0;
ICLOSE(RESS.A);
ICLOSE(RESSGRUP.A);
ICLOSE(EMNE.A);
ICLOSE(OPERA.A);
ICLOSE(ORDRE.A);
ICLOSE(PROD.A);
ICLOSE(REBELAST.A);
ICLOSE(UGEDAG.A);
ICLOSE(ARBEDAG.A);
ICLOSE(SYSTEM.A);
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:='PLANPESC:P2:05:J';
IF RESPRINT THEN
BEGIN
REGVEDL;
FREEPR
END;
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.