|
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: 27808 (0x6ca0)
Types: TextFile
Notes: Mikados_K
Names: »LIMFORKA.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMFORKA.K«
PROGRAM LIMFORKA;
(*OPRETTELSE AF GENEREL FORKALKULATION,
UDSKRIFT AF OPERATIONSKORT*)
(*$L-*)
CONST MAXRECSIZE=1000;
(*@@*)
PROGRAMNR=3;
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 D23;
BEGIN
GOTOXY(1,23);WRITELN(' ':79);GOTOXY(1,23)
END;
PROCEDURE NONEXIST(S:STRING);
BEGIN
D23;
WRITE(S,' findes ikke, RETURN ');
READLN
END;
PROCEDURE BAD(IDENT,STATUS:INTEGER);
BEGIN
D23;
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*)
(*$L+*)
(*$P*)
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;
KUNDPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR :LONGINT;
NAVN :PACKED ARRAY (1..26) OF CHAR;
KONTAKT1,
KONTAKT2,
KONTAKT3,
KONTAKT4 :PACKED ARRAY (1..30) 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;
RÅVAPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
PRISKG,
OMSÆTP,
DBP,
KOSTPRIS,
OMSÆTSP,
DBSÅ,
KOSTPRSÅ,
LAGER,
MINLAGE,
RESERVER,
SMEPRIS,
KGINDKØB,
KGFORBRU,
KGSOLGT :REAL;
NR,
LEVUGE,
SMESVIND :INTEGER;
BETEGN :PACKED ARRAY (1..16) OF CHAR
END;
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;
OPERPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TILLÆG :REAL;
NR,
GRUPPE,
REBELAS :INTEGER;
BETEGN :PACKED ARRAY (1..30) OF CHAR
END;
LØNGPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TIMESATS :REAL;
NR :INTEGER;
BETEGN :PACKED ARRAY (1..30) OF CHAR
END;
OMVFPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
EMNENR,
SEKVNR,
OPERANR :INTEGER
END;
FORKPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KRSTK :REAL;
EMNENR,
SEKVENSN,
OPERANR,
LØNTYPE,
STKH,
RESS1,
RESS2,
RESS3,
RESS4,
RESS5 :INTEGER
END;
SYSRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
AKKTIME1,
AKKTIME2,
AKKTIME3,
AKKTIME4,
AKKTIME5,
AKKTIME6,
AKKTIME7,
AKKTIME8,
AKKTIME9 :REAL;
NR :INTEGER;
DAGSDATO,
PERSTDAT :LONGINT;
ARBTIMDA,
ORDRENR :INTEGER
END;
(*$P*)
(*$L-*)
VAR FELT:NFELT;
HUSKNIV:NIVEAU;
PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
OPTION,LINES,
I,J,ANTALFELTER:INTEGER;
LINE:STRING;
RESS:RESSPOST;
KUNDE:KUNDPOST;
RESSGRUP:REGRPOST;
EMNE:EMNEPOST;
RÅVARE:RÅVAPOST;
MEDARB:MEDAPOST;
OPERA:OPERPOST;
LØNGRUP:LØNGPOST;
OMVEMNE:OMVFPOST;
POST:FORKPOST;
SYSTEM:SYSRPOST;
LONGNUL:LONGINT;
CH:STRING(1);
NEJ,JA,JAOGNEJ:SET OF CHAR;
RESSTEXT:ARRAY (10..13) OF PACKED ARRAY (1..10) OF CHAR;
(*$P*)
PROCEDURE ERROR(VAR REC:AR);
VAR CH:STRING(1);
I:INTEGER;
BEGIN
D23;
(*$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(KUNDE.A);
ICLOSE(RESSGRUP.A);
ICLOSE(EMNE.A);
ICLOSE(RÅVARE.A);
ICLOSE(MEDARB.A);
ICLOSE(OPERA.A);
ICLOSE(LØNGRUP.A);
ICLOSE(OMVEMNE.A);
ICLOSE(POST.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:STRING(1);
FELTNR:INTEGER;
PROCEDURE SKRIVEMNE;
BEGIN
WITH EMNE DO
BEGIN
GOTOXY(1,1);
WRITELN('Kundenr',
KUNDENR(1)*10000.0+KUNDENR(2):6:-2,' Emnenr',NR:6,
' Formnr',FORMNR:5);
WRITELN('Tegningsnr ',TEGNNR,' Benævnelse ',BETEGN)
END
END;
PROCEDURE SKRIVLINIE;
VAR J:INTEGER;
HKRSTK:REAL;
BEGIN
WITH POST DO
BEGIN
SKRIVFELT(PICTURE(1));
SKRIVFELT(PICTURE(2));
SKRIVFELT(PICTURE(3));
OPERA.NR:=OPERANR;
GETREC(OPERA.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(OPERA.A);
IF IER=0 THEN BEGIN GOTOXY(25,6);WRITE(OPERA.BETEGN) END;
GOTOXY(1,7);
WRITE(' 4 Stk/h :');
IF STKH<0 THEN WRITE('T');
WRITE(ABS(STKH));
HKRSTK:=KRSTK;KRSTK:=0.0;
FOR J:=5 TO 9 DO SKRIVFELT(PICTURE(J));
KRSTK:=HKRSTK;
IF LØNTYPE>0 THEN SKRIVFELT(PICTURE(4+LØNTYPE));
GOTOXY(1,13);
FOR J:=10 TO 13 DO
BEGIN
WRITE(J:2,' ',RESSTEXT(J),' :');
CASE J OF
10:IF RESS1<0 THEN WRITELN('*',-RESS1:6) ELSE WRITELN(RESS1:7);
11:IF RESS2<0 THEN WRITELN('*',-RESS2:6) ELSE WRITELN(RESS2:7);
12:IF RESS3<0 THEN WRITELN('*',-RESS3:6) ELSE WRITELN(RESS3:7);
13:IF RESS4<0 THEN WRITELN('*',-RESS4:6) ELSE WRITELN(RESS4:7)
END
END
END
END;
(*$P*)
PROCEDURE SLETOMV;
BEGIN
OMVEMNE.EMNENR:=POST.EMNENR;
OMVEMNE.SEKVNR:=POST.SEKVENSN;
OMVEMNE.OPERANR:=POST.OPERANR;
GETRECX(OMVEMNE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(OMVEMNE.A);
IF IER=0 THEN
BEGIN
DELETE(OMVEMNE.A);IF NOT (-IER IN (.0,9.)) THEN ERROR(OMVEMNE.A)
END
END;
PROCEDURE SLETLINIE;
BEGIN
SLETOMV;
DELETEX(POST.A);IF NOT (-IER IN (.0,9.)) THEN ERROR(POST.A)
END;
(*$P*)
PROCEDURE ÆNDLINIE(FELTNR:INTEGER);
VAR CH:CHAR;
RESSURS:INTEGER;
BEGIN
WITH POST DO
BEGIN
IF FELTNR IN (.5..9.) THEN
BEGIN
KRSTK:=0.0;
IF LØNTYPE>0 THEN SKRIVFELT(PICTURE(LØNTYPE+4));
LØNTYPE:=FELTNR-4
END;
IF (FELTNR IN (.2,3.)) AND (SEKVENSN>0) THEN SLETOMV;
IF FELTNR IN (.2,5..7.) THEN BEGIN LÆSFELT(PICTURE(FELTNR));
SKRIVFELT(PICTURE(FELTNR))
END;
CASE FELTNR OF
3:REPEAT
LÆSFELT(PICTURE(FELTNR));
SKRIVFELT(PICTURE(FELTNR));
OPERA.NR:=OPERANR;
GETREC(OPERA.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(OPERA.A);
IF IER=-6 THEN NONEXIST('Operation')
UNTIL IER=0;
4:BEGIN
REPEAT
STKH:=0;
D23;
WRITE(' Stk/h ');
READLN;
IF NOT EOLN THEN
BEGIN
IF INPUT^ IN (.'T','t'.) THEN READ(CH);
IF INPUT^ IN (.'0'..'9'.) THEN READ(STKH);
IF CH IN (.'T','t'.) THEN STKH:=-STKH
END
UNTIL STKH<>0;
GOTOXY(17,7);
IF STKH<0 THEN WRITE('T',-STKH) ELSE WRITE(STKH)
END;
8:REPEAT
LÆSFELT(PICTURE(FELTNR));
SKRIVFELT(PICTURE(FELTNR));
LØNGRUP.NR:=TRUNC(KRSTK);
GETREC(LØNGRUP.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(LØNGRUP.A);
IF IER=-6 THEN NONEXIST('Løngruppe')
UNTIL IER=0;
9:REPEAT
LÆSFELT(PICTURE(FELTNR));
SKRIVFELT(PICTURE(FELTNR));
MEDARB.NR:=TRUNC(KRSTK);
GETREC(MEDARB.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(MEDARB.A);
IF IER=-6 THEN NONEXIST('Medarbejder')
UNTIL IER=0;
10,11,12,13:
BEGIN
REPEAT
CH:='Æ';
D23;
WRITE(FELTNR:2,' ',RESSTEXT(FELTNR),' :');
READLN;
IF EOLN THEN
BEGIN
CH:='Å';
RESSURS:=0
END
ELSE
IF INPUT^='*' THEN
BEGIN
READ(CH);
IF INPUT^ IN (.'0'..'9'.) THEN
BEGIN
READ(RESSURS);
RESSURS:=-RESSURS;
RESSGRUP.GRUPNR:=-RESSURS;
RESSGRUP.NR:=-1;
NEXTREC(RESSGRUP.A);IF NOT (-IER IN (.1,2,9.)) THEN
ERROR(RESSGRUP.A);
IF RESSGRUP.GRUPNR<>-RESSURS THEN
NONEXIST('Ressourcegruppe')
ELSE CH:='Å'
END
END
ELSE
BEGIN
IF INPUT^ IN (.'0'..'9'.) THEN
BEGIN
READ(RESSURS);
IF RESSURS<>0 THEN
BEGIN
RESS.NR:=RESSURS;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=-6 THEN NONEXIST('Ressource')
ELSE CH:='Å'
END ELSE CH:='Å'
END
END
UNTIL CH='Å';
GOTOXY(1,FELTNR+3);
WRITE(FELTNR:2,' ',RESSTEXT(FELTNR),' :');
IF RESSURS<0 THEN WRITE('*',-RESSURS:6) ELSE WRITE(RESSURS:7);
CASE FELTNR OF
10:RESS1:=RESSURS;
11:RESS2:=RESSURS;
12:RESS3:=RESSURS;
13:RESS4:=RESSURS
END
END
END;
IF FELTNR IN (.2,3.) THEN
BEGIN
OMVEMNE.EMNENR:=EMNENR;
OMVEMNE.SEKVNR:=SEKVENSN;
OMVEMNE.OPERANR:=OPERANR;
INSERT(OMVEMNE.A);IF IER<>0 THEN ERROR(OMVEMNE.A);
END
END
END;
(*$P*)
PROCEDURE OPRETLINIE;
BEGIN
SKRIVLINIE;
ÆNDLINIE(2);
ÆNDLINIE(4);
REPEAT
D23;
WRITE('Vælg feltnr 5-9 ');
READLN;
IF NOT EOLN THEN READ(FELTNR)
UNTIL (IORESULT=0) AND (FELTNR IN (.5..9.));
ÆNDLINIE(FELTNR);
FOR FELTNR:=10 TO 13 DO ÆNDLINIE(FELTNR);
SKRIVLINIE;
REPEAT
REPEAT
D23;
WRITE('Feltnr 2-13, 0 for færdig ');
READLN;
IF NOT EOLN THEN READ(FELTNR)
UNTIL (IORESULT=0) AND (FELTNR IN (.0,2..13.));
IF FELTNR>0 THEN ÆNDLINIE(FELTNR)
UNTIL FELTNR=0;
INSERT(POST.A);IF IER<>0 THEN ERROR(POST.A)
END;
(*$P*)
PROCEDURE SOPERATIONSKORT;
VAR LINES,HYLDE:INTEGER;
KUNFOUND,RÅVFOUND:BOOLEAN;
BEGIN
LINES:=23;
WITH POST DO
BEGIN
KUNDE.NR:=EMNE.KUNDENR;
GETREC(KUNDE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(KUNDE.A);
KUNFOUND:=(IER=0);
RÅVARE.NR:=EMNE.MATNR;
GETREC(RÅVARE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RÅVARE.A);
RÅVFOUND:=(IER=0);
EMNENR:=EMNE.NR;
SEKVENSN:=0;
OPERANR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (EMNENR=EMNE.NR) DO
BEGIN
IF LINES>21 THEN
BEGIN
CLEARSCREEN;
WITH EMNE DO
BEGIN
WRITELN(' ':12,'OPERATIONSKORT',
KUNDENR(1)*10000.0+KUNDENR(2):15:-2,NR:21);
WRITE(TEGNNR,' ',BETEGN,' ');
IF KUNFOUND THEN WRITELN(KUNDE.NAVN)
ELSE WRITELN('IKKE OPRETTET');
IF RÅVFOUND THEN WRITE(RÅVARE.BETEGN)
ELSE WRITE('IKKE OPRETTET ');
WRITELN(NETTOVÆG:8:2,BRUTTOVÆ:9:2,' ':32,
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):6:-2)
END;
WRITELN(' ':48,'stk/h total værkt hjvt hyld');
LINES:=4
END;
LINES:=LINES+1;
WRITE(SEKVENSN:2,OPERANR:4,' ');
OPERA.NR:=OPERANR;
GETREC(OPERA.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(OPERA.A);
IF IER=0 THEN WRITE(OPERA.BETEGN:24)
ELSE WRITE('IKKE OPRETTET ');
IF RESS1>0 THEN
BEGIN
RESS.NR:=RESS1;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=0 THEN
WRITE(RESS.AFDELNR:2,RESS.NR:5,' ',RESS.BETEGN:9)
ELSE WRITE(RESS1:7,' UOPRETTET')
END
ELSE
IF RESS1=0 THEN WRITE(' ':17)
ELSE WRITE(' *',-RESS1:4,' ':10);
IF STKH<0 THEN
WRITE(-STKH/100.0:12:2,' ')
ELSE WRITE(STKH:5,' ':9);
HYLDE:=0;
IF RESS3>0 THEN
BEGIN
WRITE(RESS3:5);
RESS.NR:=RESS3;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=0 THEN HYLDE:=RESS.HYLDENR
END
ELSE
IF RESS3=0 THEN WRITE(' ':5)
ELSE WRITE('*',-RESS3:4);
IF RESS4>0 THEN
BEGIN
WRITE(RESS4:5);
IF HYLDE=0 THEN
BEGIN
RESS.NR:=RESS4;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=0 THEN HYLDE:=RESS.HYLDENR
END
END
ELSE
IF RESS4=0 THEN WRITE(' ':5)
ELSE WRITE('*',-RESS4:4);
IF HYLDE>0 THEN WRITELN(HYLDE:5)
ELSE
WRITELN;
NEXTREC(A);
IF LINES=22 THEN
BEGIN
D23;
WRITE('RETURN ');READLN
END
END;
IF LINES<22 THEN
D23;WRITE('RETURN ');READLN;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A)
END
END;
(*$P*)
PROCEDURE OPERATIONSKORT;
VAR LINES,HYLDE:INTEGER;
KUNFOUND,RÅVFOUND:BOOLEAN;
BEGIN
REPEAT
REPEAT
D23;
WRITE('Ønskes testprint, J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JAOGNEJ;
IF CH(1) IN JA THEN
BEGIN
FOR LINES:=1 TO 4 DO WRITELN(LIST);
WRITELN(LIST,' ':35,'XXXXXX');
FOR LINES:=6 TO 72 DO WRITELN(LIST)
END
UNTIL CH(1) IN NEJ;
LINES:=72;
WITH POST DO
BEGIN
KUNDE.NR:=EMNE.KUNDENR;
GETREC(KUNDE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(KUNDE.A);
KUNFOUND:=(IER=0);
RÅVARE.NR:=EMNE.MATNR;
GETREC(RÅVARE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RÅVARE.A);
RÅVFOUND:=(IER=0);
EMNENR:=EMNE.NR;
SEKVENSN:=0;
OPERANR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (EMNENR=EMNE.NR) DO
BEGIN
IF LINES>68 THEN
BEGIN
WHILE LINES<72 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
FOR LINES:=1 TO 4 DO WRITELN(LIST);
WITH EMNE DO
BEGIN
WRITELN(LIST,' ':12,'OPERATIONSKORT',
KUNDENR(1)*10000.0+KUNDENR(2):15:-2,NR:21);
FOR LINES:=6 TO 8 DO WRITELN(LIST);
WRITE(LIST,TEGNNR,' ',BETEGN,' ');
IF KUNFOUND THEN WRITELN(LIST,KUNDE.NAVN)
ELSE WRITELN(LIST,'IKKE OPRETTET');
FOR LINES:=10 TO 12 DO WRITELN(LIST);
IF RÅVFOUND THEN WRITE(LIST,RÅVARE.BETEGN)
ELSE WRITE(LIST,'IKKE OPRETTET ');
WRITELN(LIST,NETTOVÆG:8:2,BRUTTOVÆ:9:2,' ':32,
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):6:-2)
END;
WRITELN(LIST);
WRITELN(LIST,' ':48,'stk/h total værkt hjvt hyld');
LINES:=15
END;
LINES:=LINES+2;
WRITELN(LIST);
WRITE(LIST,SEKVENSN:2,OPERANR:4,' ');
OPERA.NR:=OPERANR;
GETREC(OPERA.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(OPERA.A);
IF IER=0 THEN WRITE(LIST,OPERA.BETEGN:24)
ELSE WRITE(LIST,'IKKE OPRETTET ');
IF RESS1>0 THEN
BEGIN
RESS.NR:=RESS1;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=0 THEN
WRITE(LIST,RESS.AFDELNR:2,RESS.NR:5,' ',RESS.BETEGN:9)
ELSE WRITE(LIST,RESS1:7,' UOPRETTET')
END
ELSE
IF RESS1=0 THEN WRITE(LIST,' ':17)
ELSE WRITE(LIST,' *',-RESS1:4,' ':10);
IF STKH<0 THEN
WRITE(LIST,-STKH/100.0:12:2,' ')
ELSE WRITE(LIST,STKH:5,' ':9);
HYLDE:=0;
IF RESS3>0 THEN
BEGIN
WRITE(LIST,RESS3:5);
RESS.NR:=RESS3;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=0 THEN HYLDE:=RESS.HYLDENR
END
ELSE
IF RESS3=0 THEN WRITE(LIST,' ':5)
ELSE WRITE(LIST,'*',-RESS3:4);
IF RESS4>0 THEN
BEGIN
WRITE(LIST,RESS4:5);
IF HYLDE=0 THEN
BEGIN
RESS.NR:=RESS4;
GETREC(RESS.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RESS.A);
IF IER=0 THEN HYLDE:=RESS.HYLDENR
END
END
ELSE
IF RESS4=0 THEN WRITE(LIST,' ':5)
ELSE WRITE(LIST,'*',-RESS4:4);
IF HYLDE>0 THEN WRITELN(LIST,HYLDE:5)
ELSE
WRITELN(LIST);
NEXTREC(A)
END;
WHILE LINES<72 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A)
END
END;
(*$P*)
BEGIN (*MAINTAIN*)
CLEARSCREEN;
LÆSFELT(PICTURE(1));
EMNE.NR:=POST.EMNENR;
GETREC(EMNE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(EMNE.A);
IF IER=-6 THEN BEGIN NONEXIST('Emne'); EXIT(MAINTAIN) END;
SKRIVEMNE;
REPEAT
D23;
WRITE('Rigtigt emne J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JAOGNEJ;
IF CH(1) IN NEJ THEN EXIT(MAINTAIN);
REPEAT
GOTOXY(1,19);
WRITELN('1 Oprettelse/ændring af forkalkulation');
WRITELN('2 Sletning af eksisterende forkalkulation');
WRITELN('3 Udskrivning af operationskort');
WRITELN('4 Skærmudskrift af operationskort');
D23;
WRITE('Vælg 1-4 ');
READLN;
IF NOT EOLN THEN READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION IN (.1..4.));
CASE OPTION OF
1:REPEAT
NULPOST;
POST.LØNTYPE:=0;
POST.RESS1:=0;
POST.RESS2:=0;
POST.RESS3:=0;
POST.RESS4:=0;
POST.RESS5:=0;
POST.EMNENR:=EMNE.NR;
REPEAT
CLEARSCREEN;
SKRIVEMNE;
GOTOXY(1,10);
WRITELN('0 Færdig');
WRITELN('1 Tilføjelse af ny operation');
WRITELN('2 Ændring af eksisterende operation');
WRITELN('3 Sletning af eksisterende operation');
GOTOXY(1,17);
WRITE('Vælg 0-3 ');
READLN;IF EOLN THEN OPTION:=0 ELSE READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION IN (.0..3.));
IF OPTION=0 THEN EXIT(MAINTAIN);
CLEARSCREEN;
LÆSFELT(PICTURE(3));
OPERA.NR:=POST.OPERANR;
GETREC(OPERA.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(OPERA.A);
IF IER=-6 THEN NONEXIST('Operationen')
ELSE
BEGIN
OMVEMNE.EMNENR:=POST.EMNENR;
OMVEMNE.OPERANR:=POST.OPERANR;
OMVEMNE.SEKVNR:=0;
NEXTREC(OMVEMNE.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(OMVEMNE.A);
IF (OPTION=1) AND (OMVEMNE.EMNENR=POST.EMNENR)
AND (OMVEMNE.OPERANR=POST.OPERANR) THEN
BEGIN
OPTION:=-1;
D23;
WRITE('Operationen er på forkalkulationen, RETURN ');
READLN
END;
IF (OPTION IN (.2,3.)) AND ((OMVEMNE.EMNENR<>POST.EMNENR)
OR (OMVEMNE.OPERANR<>POST.OPERANR)) THEN
BEGIN
OPTION:=-1;
D23;
WRITE('Operationen er ikke på forkalkulationen, RETURN ');
READLN
END;
IF OPTION>0 THEN BEGIN CLEARSCREEN;SKRIVEMNE END;
CASE OPTION OF
1:OPRETLINIE;
2,3:BEGIN
POST.SEKVENSN:=OMVEMNE.SEKVNR;
GETRECX(POST.A);IF IER<>0 THEN ERROR(POST.A);
SKRIVLINIE;
IF OPTION=2 THEN
REPEAT
REPEAT
D23;
WRITE('Feltnr 4-14, 0 for færdig ');
READLN;
READ(FELTNR)
UNTIL (IORESULT=0) AND (FELTNR IN (.0,4..14.));
IF FELTNR>0 THEN ÆNDLINIE(FELTNR)
ELSE
BEGIN
PUTREC(POST.A);
IF IER<>0 THEN ERROR(POST.A)
END
UNTIL FELTNR=0
ELSE
BEGIN
REPEAT
D23;
WRITE('Sletning rigtig, J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JA+NEJ;
IF CH(1) IN JA THEN
BEGIN
SLETLINIE;
PUTREC(POST.A);IF IER<>0 THEN ERROR(POST.A)
END
END
END
END;
END
UNTIL OPTION=0;
2:BEGIN
REPEAT
D23;
WRITE('Sletning rigtig, J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JA+NEJ;
IF CH(1) IN JA THEN
BEGIN
POST.SEKVENSN:=0;
POST.OPERANR:=0;
NEXTRECX(POST.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(POST.A);
WHILE POST.EMNENR=EMNE.NR DO SLETLINIE;
PUTREC(POST.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(POST.A)
END
END;
3:IF RESPRINT THEN
BEGIN
OPERATIONSKORT;
FREEPR
END;
4:SOPERATIONSKORT
END
END;
(*$P*)
BEGIN (*REGVEDL*)
LONGNUL(1):=0;
LONGNUL(2):=0;
JA:=(.'J','j'.);
NEJ:=(.'N','n'.);
JAOGNEJ:=JA+NEJ;
RESSTEXT(10):='Maskine ';
RESSTEXT(11):='Operatør ';
RESSTEXT(12):='Værktøj ';
RESSTEXT(13):='Hjælpeværk';
CLEARSCREEN;
LÆSDESC;
MODE:=3;(*SKRIV*)
(*$R-*)
RESS.A(-4):=0;
KUNDE.A(-4):=0;
RESSGRUP.A(-4):=0;
EMNE.A(-4):=0;
RÅVARE.A(-4):=0;
MEDARB.A(-4):=0;
OPERA.A(-4):=0;
LØNGRUP.A(-4):=0;
OMVEMNE.A(-4):=0;
POST.A(-4):=0;
SYSTEM.A(-4):=0;
RESS.A(-3):=4;
KUNDE.A(-3):=1;
RESSGRUP.A(-3):=3;
EMNE.A(-3):=2;
RÅVARE.A(-3):=5;
MEDARB.A(-3):=7;
OPERA.A(-3):=6;
LØNGRUP.A(-3):=8;
OMVEMNE.A(-3):=12;
POST.A(-3):=11;
SYSTEM.A(-3):=9;
(*$R+*)
(*@@EVT. ÅBNING AF ANDRE ANDRE DATAFILER*)
IOPEN(SYSTEM.A); IF IER<>0 THEN ERROR(SYSTEM.A);
SYSTEM.NR:=0;
GETREC(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A);
ICLOSE(SYSTEM.A);
IOPEN(RESS.A); IF IER<>0 THEN ERROR(RESS.A);
IOPEN(KUNDE.A); IF IER<>0 THEN ERROR(KUNDE.A);
IOPEN(RESSGRUP.A);IF IER<>0 THEN ERROR(RESSGRUP.A);
IOPEN(EMNE.A); IF IER<>0 THEN ERROR(EMNE.A);
IOPEN(RÅVARE.A); IF IER<>0 THEN ERROR(RÅVARE.A);
IOPEN(MEDARB.A); IF IER<>0 THEN ERROR(MEDARB.A);
IOPEN(OPERA.A); IF IER<>0 THEN ERROR(OPERA.A);
IOPEN(LØNGRUP.A); IF IER<>0 THEN ERROR(LØNGRUP.A);
IOPEN(OMVEMNE.A); IF IER<>0 THEN ERROR(OMVEMNE.A);
IOPEN(POST.A); IF IER<>0 THEN ERROR(POST.A);
REPEAT
CLEARSCREEN;
GOTOXY(10,10);
WRITELN('G E N E R E L F O R K A L K U L A T I O N');
REPEAT
GOTOXY(10,12);
WRITE('Flere forkalkulationer J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JA+NEJ;
IF CH(1) IN JA THEN MAINTAIN
UNTIL CH(1) IN NEJ;
ICLOSE(RESS.A);
ICLOSE(KUNDE.A);
ICLOSE(RESSGRUP.A);
ICLOSE(EMNE.A);
ICLOSE(RÅVARE.A);
ICLOSE(MEDARB.A);
ICLOSE(OPERA.A);
ICLOSE(LØNGRUP.A);
ICLOSE(OMVEMNE.A);
ICLOSE(POST.A);
(*@@EVT. LUKNING AF ANDRE DATAFILER*)
CLEARSCREEN
END;
(*$P*)
(*$L-*)
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*)
FILNR:=11;
DESCNAVN:='FORKPESC:P2:05:J';
REGNAVN:='FORKALKULATION';
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.