|
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: 65728 (0x100c0)
Types: TextFile
Notes: Mikados_K
Names: »LIMPUDSK.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMPUDSK.K«
PROGRAM LIMPUDSK;
(*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=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+*)
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;
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;
LONGNUL:LONGINT;
CH:CHAR;
NEJ,JA,JAOGNEJ:SET OF CHAR;
SKEMA:PACKED ARRAY (1..52) OF CHAR;
PIND:PACKED ARRAY (1..50) 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 FORMULAR(I:INTEGER);
VAR LINES:INTEGER;
BEGIN
CASE I OF
1:BEGIN
D(23,1);
WRITE('Monter bredt 8.5" papir, RETURN ');
READLN;
WHILE QJN('Ønskes testprint') IN JA DO
BEGIN
WRITELN(LIST,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX');
FOR LINES:=2 TO 50 DO WRITELN(LIST);
WRITELN(LIST,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX')
END
END;
2:BEGIN
D(23,1);
WRITE('Monter generel formular, RETURN ');
READLN;
WHILE QJN('Ønskes testprint') IN JA DO
BEGIN
FOR LINES:=1 TO 4 DO WRITELN(LIST);
WRITELN(LIST,' ':35,'XXXXXX');
FOR LINES:=6 TO 72 DO WRITELN(LIST)
END
END;
3:BEGIN
D(23,1);
WRITE('Monter blankt A4 papir, RETURN ');
READLN;
WHILE QJN('Ønskes testprint') IN JA DO
BEGIN
WRITELN(LIST,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
'XXXXXXXXXXXXXXXXXXXXXXXX');
FOR LINES:=2 TO 71 DO WRITELN(LIST);
WRITELN(LIST,'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
'XXXXXXXXXXXXXXXXXXXXXXXX')
END
END
END
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(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 PLANUDSK;
VAR UDSKTYPE:INTEGER;
PROCEDURE BELASTPLAN;
VAR NSTARTDAG,RÅDIGTID,RESTETID,OVERSKUD,CURRUGE,NRPÅLIN:INTEGER;
ORDRETIM:ARRAY (1..15,1..2) OF INTEGER;
FØRSTE,SIDSTE:BOOLEAN;
PROCEDURE HOVED;
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
WRITELN(LIST,'Belastningsplan for',RESS.NR:5,' ',RESS.BETEGN,
' ':10,'Kapacitetsfaktor',POST.FAKTOR:5,' ':28,
'Udskriftsdato',SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):9:-2);
WRITELN(LIST,' ':86,' Total Til Akkumuleret');
WRITELN(LIST,' ':86,' rådighed overunderskud');
LINES:=3
END;
PROCEDURE SKRIVLINIE;
VAR I:INTEGER;
BEGIN
IF NRPÅLIN=0 THEN EXIT(SKRIVLINIE);
IF LINES>45 THEN HOVED;
IF FØRSTE THEN WRITE(LIST,'Ugenr') ELSE WRITE(LIST,' ':5);
WRITE(LIST,' Ordre');
FOR I:=1 TO 15 DO
IF I>NRPÅLIN THEN WRITE(LIST,' ':5) ELSE WRITE(LIST,ORDRETIM(I,1):5);
WRITELN(LIST);
IF FØRSTE THEN
IF CURRUGE=0 THEN WRITE(LIST,' FØR') ELSE WRITE(LIST,CURRUGE:5)
ELSE WRITE(LIST,' ':5);
WRITE(LIST,' Timer');
FOR I:=1 TO 15 DO
IF I>NRPÅLIN THEN WRITE(LIST,' ':5)
ELSE
BEGIN
WRITE(LIST,ORDRETIM(I,2):5);
RESTETID:=RESTETID+ORDRETIM(I,2)
END;
NRPÅLIN:=0;
FØRSTE:=FALSE;
IF SIDSTE THEN
BEGIN
SIDSTE:=FALSE;
OVERSKUD:=OVERSKUD+POST.FAKTOR*RÅDIGTID-RESTETID;
WRITELN(LIST,RESTETID:7,POST.FAKTOR*RÅDIGTID:9,OVERSKUD:14);
RÅDIGTID:=0;
RESTETID:=0
END
ELSE WRITELN(LIST);
WRITELN(LIST);
LINES:=LINES+3
END;
(*$P*)
BEGIN (*BELASTPLAN*)
REPEAT
LÆSFELT(PICTURE(1));
IF POST.RESSOURCE=0 THEN EXIT(BELASTPLAN);
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(BELASTPLAN) END;
POST.FAKTOR:=1;
LÆSFELT(PICTURE(18));
RESTETID:=0;
RÅDIGTID:=0;
OVERSKUD:=0;
NRPÅLIN:=0;
FØRSTE:=TRUE;
SIDSTE:=FALSE;
CURRUGE:=0;
LINES:=51;
NSTARTDAG:=PSTARTDAG;
ARBEDAG.NR:=0;
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A);
IER:=0; (*GÅ FREM TIL DAGSDATO*)
WHILE (IER=0) AND (ARBEDAG.DATO<>SYSTEM.DAGSDATO) DO NEXTREC(ARBEDAG.A);
CHECK0(ARBEDAG.A);
WHILE (IER=0) AND (ARBEDAG.NR<>NSTARTDAG) DO
BEGIN (*OPTÆL TIMER FRA DAGSDATO TIL PERIODESTART*)
RÅDIGTID:=RÅDIGTID+ARBEDAG.ARBTIMER;
NEXTREC(ARBEDAG.A)
END;
CHECK0(ARBEDAG.A);
REBELAST.NR:=RESS.NR;
REBELAST.STARTDAG:=0;
REBELAST.STTIME:=0;
REBELAST.EMNENR:=0;
REBELAST.OPERANR:=0;
REBELAST.SEKVNR:=0;
NEXTREC(REBELAST.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(REBELAST.A);
IER:=0;
WHILE (IER=0) AND (REBELAST.NR=RESS.NR)
AND (REBELAST.STARTDAG<NSTARTDAG) DO
BEGIN
ORDRE.NR:=REBELAST.ORDRENR;
ORDRE.EMNENR:=REBELAST.EMNENR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
PROD.ORDRENR:=REBELAST.ORDRENR;
PROD.EMNENR:=REBELAST.EMNENR;
PROD.SEKVENSN:=REBELAST.SEKVNR;
PROD.OPERANR:=REBELAST.OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF NRPÅLIN=15 THEN SKRIVLINIE;
NRPÅLIN:=NRPÅLIN+1;
ORDRETIM(NRPÅLIN,1):=REBELAST.ORDRENR;
ORDRETIM(NRPÅLIN,2):=
ROUND((1.0-PROD.REAANTAL/ORDRE.ANTALBES)*REBELAST.VARIGHED);
NEXTREC(REBELAST.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REBELAST.A);
SIDSTE:=TRUE;
SKRIVLINIE;
IER:=0;
WHILE (IER=0) AND (REBELAST.NR=RESS.NR) DO
BEGIN
FØRSTE:=TRUE;
CURRUGE:=ARBEDAG.UGENR;
WHILE (IER=0) AND (CURRUGE=ARBEDAG.UGENR) DO
BEGIN
RÅDIGTID:=RÅDIGTID+ARBEDAG.ARBTIMER;
NEXTREC(ARBEDAG.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(ARBEDAG.A);
IF IER=0 THEN
NSTARTDAG:=ARBEDAG.NR
ELSE
NSTARTDAG:=32000;
IER:=0;
WHILE (IER=0) AND (REBELAST.NR=RESS.NR)
AND (REBELAST.STARTDAG<NSTARTDAG) DO
BEGIN
ORDRE.NR:=REBELAST.ORDRENR;
ORDRE.EMNENR:=REBELAST.EMNENR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
PROD.ORDRENR:=REBELAST.ORDRENR;
PROD.EMNENR:=REBELAST.EMNENR;
PROD.SEKVENSN:=REBELAST.SEKVNR;
PROD.OPERANR:=REBELAST.OPERANR;
GETREC(PROD.A);CHECK0(PROD.A);
IF NRPÅLIN=15 THEN SKRIVLINIE;
NRPÅLIN:=NRPÅLIN+1;
ORDRETIM(NRPÅLIN,1):=REBELAST.ORDRENR;
ORDRETIM(NRPÅLIN,2):=
ROUND((1.0-PROD.REAANTAL/ORDRE.ANTALBES)*REBELAST.VARIGHED);
NEXTREC(REBELAST.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REBELAST.A);
SIDSTE:=TRUE;
SKRIVLINIE
END;
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
UNTIL POST.RESSOURCE=0
END;
(*$P*)
PROCEDURE GANTTKORT;
VAR LINIER:INTEGER;
PROCEDURE SKRIVLINIE;
VAR I,AKTWEEK,AKTDAG:INTEGER;
UDLINIE:PACKED ARRAY (1..52) OF CHAR;
BEGIN
IF LINES>45 THEN
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
SKEMA:='. .';
WRITELN(LIST,'GANTTKORT',' ':81,
'Udskriftsdato',SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):9:-2);
WRITE(LIST,'Ressource:',RESS.NR:5,' ',RESS.BETEGN,' ':14);
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(LIST,ARBEDAG.UGENR MOD 100:2)
END
ELSE WRITE(LIST,' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(LIST,' Leveres Start Varig');
WRITE(LIST,'Nr Ordre Betegnelse ',' ':20);
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(LIST,AKTDAG:2)
END
ELSE WRITE(LIST,' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(LIST,' Uge ant time hed');
LINES:=3
END;
WITH REBELAST,EMNE,ORDRE DO
BEGIN
LINIER:=LINIER+1;
WRITE(LIST,LINIER:2,ORDRENR:6,' ',BETEGN);
UDLINIE:=SKEMA;
IF (STARTDAG-PSTARTDAG) IN (.0..24.) THEN
BEGIN
I:=2*(STARTDAG-PSTARTDAG)+2;
IF STTIME>4 THEN I:=I+1;
IF STARTDAG-PSTARTDAG+VARIGHED DIV 8<26 THEN
MOVELEFT(PIND(1),UDLINIE(I),(VARIGHED-1) DIV 4+1)
ELSE
MOVELEFT(PIND(1),UDLINIE(I),50-(STARTDAG-PSTARTDAG)*2)
END;
WRITE(LIST,UDLINIE);
IF BEKRÆLEV>0 THEN
WRITE(LIST,BEKRÆLEV MOD 100:2,'!')
ELSE
WRITE(LIST,ØNSKLEV MOD 100:2,' ');
WRITELN(LIST,ANTALBES:5:-2,STTIME:7,VARIGHED:6);
LINES:=LINES+1
END
END;
(*$P*)
PROCEDURE GETBELAST;
BEGIN
REBELAST.NR:=RESS.NR;
REBELAST.STARTDAG:=PSTARTDAG;
REBELAST.ORDRENR:=0;
NEXTREC(REBELAST.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(REBELAST.A);
IER:=0;
LINES:=51;
LINIER:=0;
WHILE (IER=0) AND (REBELAST.NR=RESS.NR) AND
(REBELAST.STARTDAG-PSTARTDAG<25) DO
BEGIN
EMNE.NR:=REBELAST.EMNENR;
GETREC(EMNE.A);CHECK0(EMNE.A);
ORDRE.NR:=REBELAST.ORDRENR;
ORDRE.EMNENR:=REBELAST.EMNENR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
SKRIVLINIE;
NEXTREC(REBELAST.A)
END;
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REBELAST.A)
END;
(*$P*)
BEGIN (*GANTTKORT*)
REPEAT
LÆSFELT(PICTURE(15));
CASE POST.OPTION OF
1:REPEAT
LÆSFELT(PICTURE(1));
IF POST.RESSOURCE=0 THEN EXIT(GANTTKORT);
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(GANTTKORT) END;
GETBELAST
UNTIL POST.RESSOURCE=0;
2:REPEAT
LÆSFELT(PICTURE(16));
IF POST.AFDELING=0 THEN EXIT(GANTTKORT);
RESS.NR:=0;
NEXTREC(RESS.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(RESS.A);
IER:=0;
WHILE IER=0 DO
BEGIN
IF RESS.AFDELNR=POST.AFDELING THEN GETBELAST;
NEXTREC(RESS.A)
END;
IF NOT (-IER IN (.2,9.)) THEN ERROR(RESS.A)
UNTIL POST.AFDELING=0;
3:REPEAT
LÆSFELT(PICTURE(17));
IF POST.GRUPPE=0 THEN EXIT(GANTTKORT);
RESSGRUP.GRUPNR:=POST.GRUPPE;
RESSGRUP.NR:=0;
NEXTREC(RESSGRUP.A);
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(RESSGRUP.A);
IER:=0;
WHILE (IER=0) AND (RESSGRUP.GRUPNR=POST.GRUPPE) DO
BEGIN
RESS.NR:=RESSGRUP.NR;
GETREC(RESS.A);CHECK0(RESS.A);
GETBELAST;
NEXTREC(RESSGRUP.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(RESSGRUP.A)
UNTIL POST.GRUPPE=0
END
UNTIL POST.OPTION=0
END;
(*$P*)
PROCEDURE PRODPLAN;
VAR LINIER,TVARIG,IUGE,STTID,SLTID:INTEGER;
AFDOK:BOOLEAN;
PROCEDURE SKRIVLINIE;
VAR I,AKTWEEK,AKTDAG,STARTDAG,STTIME,VARIGHED:INTEGER;
UDLINIE:PACKED ARRAY (1..52) OF CHAR;
BEGIN
STARTDAG:=STTID MOD 1000;
STTIME:=STTID DIV 1000;
IF STARTDAG<PSTARTDAG THEN
BEGIN
STARTDAG:=PSTARTDAG;
STTIME:=1
END;
VARIGHED:=SLTID-8*STARTDAG-STTIME+1;
IF (VARIGHED<=0) OR NOT ((STARTDAG-PSTARTDAG) IN (.0..24.)) THEN
EXIT(SKRIVLINIE);
IF LINES>45 THEN
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
SKEMA:='. .';
WRITELN(LIST,'Produktionsplan for afdeling ',POST.AFDELING,' ':64,
'Udskriftsdato',SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):9:-2);
IF POST.AFDELING=3 THEN
WRITE(LIST,' ':40,'Indl stk tot lev ')
ELSE
WRITE(LIST,' ':40,' tot form tot lev ');
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(LIST,ARBEDAG.UGENR MOD 100:2)
END
ELSE WRITE(LIST,' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(LIST);
WRITE(LIST,' Nr Ord. Betegnelse ',' ':13);
IF POST.AFDELING=3 THEN
WRITE(LIST,' kunde uge /t tid uge antal ')
ELSE
WRITE(LIST,' mat kg nr tid uge antal ');
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(LIST,AKTDAG:2)
END
ELSE WRITE(LIST,' ':2);
NEXTREC(ARBEDAG.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ARBEDAG.A)
END;
WRITELN(LIST);
LINES:=3
END;
WITH EMNE,ORDRE DO
BEGIN
EMNE.NR:=EMNENR;
GETREC(EMNE.A);CHECK0(EMNE.A);
LINIER:=LINIER+1;
WRITE(LIST,LINIER:3,ORDRE.NR:5,' ',BETEGN:24);
IF POST.AFDELING=3 THEN
BEGIN
ARBEDAG.NR:=(IUGE-1) DIV 8;
GETREC(ARBEDAG.A);IF IER=-6 THEN ARBEDAG.UGENR:=0 ELSE
CHECK0(ARBEDAG.A);
WRITE(LIST,KUNDENR(1)*10000.0+KUNDENR(2):6:-2,ARBEDAG.UGENR:5,
ANTALBES/TVARIG:5:-2,TVARIG:4,BEKRÆLEV:5,ANTALBES:6:-2)
END
ELSE
BEGIN
ARBEDAG.NR:=(SLTID-1) DIV 8;
GETREC(ARBEDAG.A);IF IER=-6 THEN ARBEDAG.UGENR:=0 ELSE
CHECK0(ARBEDAG.A);
WRITE(LIST,MATNR:6,ANTALBES*NETTOVÆG/1000.0:5:-2,FORMNR:5,
TVARIG:4,ARBEDAG.UGENR:5,ANTALBES:6:-2)
END;
UDLINIE:=SKEMA;
IF (STARTDAG-PSTARTDAG) IN (.0..24.) THEN
BEGIN
I:=2*(STARTDAG-PSTARTDAG)+2;
IF STTIME>4 THEN I:=I+1;
IF STARTDAG-PSTARTDAG+VARIGHED DIV 8<26 THEN
MOVELEFT(PIND(1),UDLINIE(I),(VARIGHED-1) DIV 4+1)
ELSE
MOVELEFT(PIND(1),UDLINIE(I),50-(STARTDAG-PSTARTDAG)*2)
END;
WRITELN(LIST,UDLINIE);
LINES:=LINES+1
END
END;
(*$P*)
PROCEDURE CHECKRESS(NR:INTEGER);
BEGIN
IF AFDOK OR (NR<=0) THEN EXIT(CHECKRESS);
RESS.NR:=NR;
GETREC(RESS.A);CHECK0(RESS.A);
AFDOK:=(RESS.AFDELNR=POST.AFDELING)
END;
PROCEDURE GETPROD;
BEGIN
LINIER:=0;
TVARIG:=0;
IUGE:=0;
STTID:=0;
SLTID:=0;
WITH PROD DO
BEGIN
ORDRENR:=0;
EMNENR:=0;
SEKVENSN:=0;
OPERANR:=0;
NEXTREC(PROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(PROD.A);
IER:=0;
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=EMNENR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
WHILE IER=0 DO
BEGIN
AFDOK:=FALSE;
CHECKRESS(RESS1);
CHECKRESS(RESS2);
CHECKRESS(RESS3);
IF AFDOK THEN
BEGIN
IF STTID=0 THEN STTID:=STARTTID;
IF STARTTID MOD 1000*8+STARTTID DIV 1000+VARIGHED>SLTID THEN
SLTID:=STARTTID MOD 1000*8+STARTTID DIV 1000+VARIGHED;
TVARIG:=TVARIG+VARIGHED
END
ELSE
IF STTID=0 THEN
IF STARTTID MOD 1000*8+STARTTID DIV 1000+VARIGHED>IUGE THEN
IUGE:=STARTTID MOD 1000*8+STARTTID DIV 1000+VARIGHED;
NEXTREC(A);
IF (IER=0) AND (ORDRENR<>ORDRE.NR) THEN
BEGIN
IF TVARIG>0 THEN SKRIVLINIE;
IF IER=0 THEN
BEGIN
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=EMNENR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
TVARIG:=0;
IUGE:=0;
STTID:=0;
SLTID:=0
END
END
END;
IF TVARIG>0 THEN SKRIVLINIE;
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
END
END;
(*$P*)
BEGIN (*PRODPLAN*)
LINES:=51;
REPEAT
LÆSFELT(PICTURE(16));
IF POST.AFDELING=0 THEN EXIT(PRODPLAN);
GETPROD
UNTIL POST.AFDELING=0
END;
(*$P*)
PROCEDURE OVERLAP;
VAR CURRRESS,CURRSLUT,CURRUGE:INTEGER;
PROCEDURE SKRIVLINIE;
BEGIN
IF LINES>68 THEN
BEGIN
WHILE LINES<72 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
WRITELN(LIST,'OVERLAPPENDE RESSOURCER',' ':20,
'Udskriftsdato',SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):9:-2);
WRITELN(LIST,'Ressource Nr Uge');
WRITELN(LIST);
RESS.NR:=0;
LINES:=3
END;
ARBEDAG.NR:=REBELAST.STARTDAG;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
IF CURRRESS<>RESS.NR THEN
BEGIN
CURRUGE:=0;
RESS.NR:=CURRRESS;
GETREC(RESS.A);CHECK0(RESS.A);
WRITE(LIST,RESS.BETEGN,RESS.NR:6)
END
ELSE
IF CURRUGE<>ARBEDAG.UGENR THEN WRITE(LIST,' ':16);
IF CURRUGE<>ARBEDAG.UGENR THEN
BEGIN
WRITELN(LIST,ARBEDAG.UGENR:6);
CURRUGE:=ARBEDAG.UGENR;
LINES:=LINES+1
END
END;
BEGIN (*OVERLAP*)
WITH REBELAST DO
BEGIN
NR:=0;
STARTDAG:=0;
STTIME:=0;
EMNENR:=0;
OPERANR:=0;
SEKVNR:=0;
ORDRENR:=0;
CURRRESS:=0;
CURRSLUT:=0;
LINES:=72;
NEXTREC(A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(A);
IER:=0;
WHILE IER=0 DO
BEGIN
IF NR<>CURRRESS THEN BEGIN CURRSLUT:=0;CURRRESS:=NR END;
IF 8*STARTDAG+STTIME<CURRSLUT THEN SKRIVLINIE;
IF CURRSLUT<8*STARTDAG+STTIME+VARIGHED THEN
CURRSLUT:=8*STARTDAG+STTIME+VARIGHED;
NEXTREC(A)
END;
IF NOT (-IER IN (.2,9.)) THEN ERROR(A);
WHILE LINES<72 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
BEGIN (*PLANUDSK*)
D(10,7);
WRITELN('0 Fortryd');
WRITELN('1 Gantt-kort for ressource');
WRITELN('2 Belastningsplan for ressource');
WRITELN('3 Produktionsplan');
WRITELN('4 Ressourceoverlap');
LÆSFELT(PICTURE(13));
CASE POST.OPTION OF
1,2,3:FORMULAR(1);
4:FORMULAR(3)
END;
CASE POST.OPTION OF
1:GANTTKORT;
2:BELASTPLAN;
3:PRODPLAN;
4:OVERLAP
END
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 (SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2))>
(ARBEDAG.DATO(1)*10000.0+ARBEDAG.DATO(2)) THEN IER:=-6
END
UNTIL IER=0;
PSTARTDAG:=UGEDAG.ARBDAGNR;
PLANUDSK
END;
(*$P*)
BEGIN (*REGVEDL*)
LONGNUL(1):=0;
LONGNUL(2):=0;
JA:=(.'J','j'.);
NEJ:=(.'N','n'.);
JAOGNEJ:=JA+NEJ;
PIND:='**************************************************';
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);
SYSTEM.NR:=0;
GETREC(SYSTEM.A);CHECK0(SYSTEM.A);
ICLOSE(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(RESSGRUP.A); CHECK0(RESSGRUP.A);
IOPEN(EMNE.A); CHECK0(EMNE.A);
IOPEN(RESS.A); CHECK0(RESS.A);
POST.STARTUGE:=0;
REPEAT
CLEARSCREEN;
IF QJN('Flere planlægningsudskrifter') IN JA THEN
BEGIN
OPTION:=1;
MAINTAIN
END ELSE OPTION:=0
UNTIL OPTION=0;
ICLOSE(ORDRE.A);
ICLOSE(REBELAST.A);
ICLOSE(PROD.A);
ICLOSE(UGEDAG.A);
ICLOSE(ARBEDAG.A);
ICLOSE(RESSGRUP.A);
ICLOSE(EMNE.A);
ICLOSE(RESS.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.