|
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: 35392 (0x8a40)
Types: TextFile
Notes: Mikados_K
Names: »LIMORDRE.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMORDRE.K«
PROGRAM LIMORDRE;
(*ORDREREGISTRERING, ORDRESPECIFIK FORKALKULATION,
UDSKRIFT AF FORKALKULATION*)
(*$L-*)
CONST MAXRECSIZE=1000;
(*@@*)
PROGRAMNR=4;
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+*)
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;
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;
EMNFPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
FORMNR,
EMNENR :INTEGER
END;
KUNEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KUNDENR :LONGINT;
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;
OTEXPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
EMNENR,
LBNR :INTEGER;
TEKST :PACKED ARRAY (1..70) OF CHAR
END;
OMVPPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ORDRENR,
SEKVENSN,
OPERANR,
EMNENR :INTEGER
END;
FORKPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KRSTK :REAL;
EMNENR,
SEKVENSN,
OPERANR,
LØNTYPE,
STKH,
RESS1,
RESS2,
RESS3,
RESS4,
RESS5 :INTEGER;
ORDRENR:INTEGER;
KUNDENR:LONGINT;
ØLEVTERM:INTEGER;
INIT:PACKED ARRAY (1..4) OF CHAR;
KUORDNR:PACKED ARRAY (1..16) OF CHAR
END;
KUNOPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KUNDENR :LONGINT;
ORDRENR,
EMNENR :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;
(*$P*)
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;
PROD:PRODPOST;
OMVPROD:OMVPPOST;
ORDRE:ORDRPOST;
ORDTEKST:OTEXPOST;
KUNEMNE:KUNEPOST;
KUNORDRE:KUNOPOST;
EMNIFORM:EMNFPOST;
POST:FORKPOST;
SYSTEM:SYSRPOST;
LONGNUL:LONGINT;
CH:CHAR;
NEJ,JA,JAOGNEJ:SET OF CHAR;
RESSTEXT:ARRAY (10..13) OF PACKED ARRAY (1..10) 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(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(POST.A);
ICLOSE(OMVPROD.A);
ICLOSE(ORDRE.A);
ICLOSE(KUNEMNE.A);
ICLOSE(KUNORDRE.A);
ICLOSE(EMNIFORM.A);
ICLOSE(PROD.A);
ICLOSE(ORDTEKST.A);
ICLOSE(SYSTEM.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;
FELTNR:INTEGER;
KALKULER:BOOLEAN;
(*
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 Æ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 (.5..7.) THEN BEGIN LÆSFELT(PICTURE(FELTNR));
SKRIVFELT(PICTURE(FELTNR))
END;
CASE FELTNR OF
4:BEGIN
REPEAT
STKH:=0;
D(23,1);
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:='Æ';
D(23,1);
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
END
END;
*)
(*$P*)
PROCEDURE TILPASFORK;
VAR FELTNR:INTEGER;
PROCEDURE FIXSATS(VAR RESSURS:INTEGER;VAR OMKOST:REAL);
VAR SATS:REAL;
BEGIN
IF RESSURS>0 THEN
BEGIN
RESS.NR:=RESSURS;
GETREC(RESS.A);IF IER<>0 THEN ERROR(RESS.A);
SATS:=RESS.TSATSF
END
ELSE
IF RESSURS<0 THEN
BEGIN
RESSGRUP.GRUPNR:=-RESSURS;
RESSGRUP.NR:=-1;
NEXTREC(RESSGRUP.A);IF NOT (-IER IN (.1,2,9.)) THEN
ERROR(RESSGRUP.A);IER:=0;
RESS.NR:=RESSGRUP.NR;
GETREC(RESS.A);IF IER<>0 THEN ERROR(RESS.A);
SATS:=RESS.TSATSF
END
ELSE SATS:=0.0;
IF SATS<>0.0 THEN
WITH PROD,ORDRE DO
BEGIN
IF STKH<=0 THEN
OMKOST:=-STKH*SATS/ANTALBES/100.0+OMKOST
ELSE
OMKOST:=SATS/STKH+OMKOST;
KRSTK:=KRSTK+SATS
END
END;
(*$P*)
BEGIN (*TILPASFORK*)
POST.EMNENR:=EMNE.NR;
POST.SEKVENSN:=0;
POST.OPERANR:=0;
NEXTREC(POST.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(POST.A);IER:=0;
WHILE (IER=0) AND (POST.EMNENR=EMNE.NR) DO
BEGIN
(*
CLEARSCREEN;
SKRIVLINIE;
IF QJN('Skal operationen med') IN JA THEN
BEGIN
REPEAT
REPEAT
D(23,1);
WRITE('Ændring af feltnr 4-13, 0 for færdig ');
READLN;READ(FELTNR)
UNTIL (IORESULT=0) AND (FELTNR IN (.0,4..13.));
IF FELTNR>0 THEN ÆNDLINIE(FELTNR)
UNTIL FELTNR=0;
*)
PROD.ORDRENR:=ORDRE.NR;
PROD.EMNENR:=ORDRE.EMNENR;
PROD.SEKVENSN:=POST.SEKVENSN;
PROD.OPERANR:=POST.OPERANR;
PROD.STKH:=POST.STKH;
PROD.REAANTAL:=0.0;
PROD.STARTTID:=0;
PROD.OPERAFSL:=0;
PROD.RESS1:=POST.RESS1;
PROD.RESS2:=POST.RESS2;
PROD.RESS3:=POST.RESS3;
PROD.RESS4:=POST.RESS4;
PROD.RESS5:=POST.RESS5;
CASE POST.LØNTYPE OF
1:IF POST.STKH<0 THEN
PROD.KRSTK:=-POST.KRSTK/POST.STKH/100.0
ELSE
PROD.KRSTK:=POST.KRSTK*POST.STKH;
2:PROD.KRSTK:=POST.KRSTK;
3:PROD.KRSTK:=SYSTEM.AKKTIME(TRUNC(POST.KRSTK));
4:BEGIN
LØNGRUP.NR:=TRUNC(POST.KRSTK);
GETREC(LØNGRUP.A);IF IER<>0 THEN ERROR(LØNGRUP.A);
PROD.KRSTK:=LØNGRUP.TIMESATS
END;
5:BEGIN
MEDARB.NR:=TRUNC(POST.KRSTK);
GETREC(MEDARB.A);IF IER<>0 THEN ERROR(MEDARB.A);
PROD.KRSTK:=MEDARB.TIMESATS
END
END;
IF PROD.STKH<=0 THEN
BEGIN
PROD.VARIGHED:=ROUND(-PROD.STKH/100.0+0.499);
ORDRE.LØNOMK:=-PROD.STKH*PROD.KRSTK/ORDRE.ANTALBES/100.0+ORDRE.LØNOMK
END
ELSE
BEGIN
PROD.VARIGHED:=ROUND(ORDRE.ANTALBES/PROD.STKH+0.499);
ORDRE.LØNOMK:=PROD.KRSTK/PROD.STKH+ORDRE.LØNOMK
END;
FIXSATS(PROD.RESS1,ORDRE.MASKINOM);(*MASKINE*)
FIXSATS(PROD.RESS2,ORDRE.LØNOMK); (*OPERATØR*)
FIXSATS(PROD.RESS3,ORDRE.MASKINOM);(*VÆRKTØJ*)
FIXSATS(PROD.RESS4,ORDRE.MASKINOM);(*HJÆLPEVÆRKTØJ*)
INSERT(PROD.A);IF IER<>0 THEN ERROR(PROD.A);
OMVPROD.ORDRENR:=PROD.ORDRENR;
OMVPROD.SEKVENSN:=PROD.SEKVENSN;
OMVPROD.OPERANR:=PROD.OPERANR;
OMVPROD.EMNENR:=PROD.EMNENR;
INSERT(OMVPROD.A);IF IER<>0 THEN ERROR(OMVPROD.A)
(*END*);
NEXTREC(POST.A)
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(POST.A)
END;
(*$P*)
PROCEDURE BEREGNMAT;
VAR SMELT,FORBRUG,OMK:REAL;
BEGIN
RÅVARE.NR:=EMNE.MATNR;
GETREC(RÅVARE.A);IF IER<>0 THEN ERROR(RÅVARE.A);
WITH RÅVARE,EMNE DO
BEGIN
SMELT:=NETTOVÆG*(1000.0+SVIND)/1000.0*(1000.0+SMELTTIL)/1000.0*
(1000.0+SMESVIND)/1000.0;
OMK:=SMELT*SMEPRIS/1000.0;
(*WRITELN(LIST,'SMELTEOMKOSTNINGER',SMELT:7:3,' g a',SMEPRIS:5:2,
' Kr pr. g',OMK:8:3);*)
ORDRE.SMEOMK:=OMK;
FORBRUG:=SMELT-NETTOVÆG*(1000.0+SVIND)/1000.0*SMELTTIL/1000.0;
OMK:=FORBRUG*KOSTPRIS/1000.0;
(*WRITELN(LIST,'MATERIALEFORBRUG ',FORBRUG:7:3,' g a',KOSTPRIS:5:2,
' Kr pr. g',OMK:8:3);*)
ORDRE.MATFORB:=OMK;
ORDRE.MATOMK:=ORDRE.SMEOMK+OMK
END
END;
(*$P*)
PROCEDURE FORKALKULATION;
VAR LINES:INTEGER;
EMNFOUND,KUNFOUND:BOOLEAN;
TTPSTK,TTOTTID,TKRPSTK:REAL;
PROCEDURE HEADING;
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
FOR LINES:=1 TO 2 DO WRITELN(LIST);
WRITELN(LIST,' ':52,'kunde-ordrenr',' ':6,'linimatic ordrenr',' ':5,
'emnenr',' ':6,'dato');
WRITELN(LIST,'FORKALKULATION',' ':38,ORDRE.KUNDORDR,
ORDRE.NR:20,ORDRE.EMNENR:11,
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,'tegn. nr',' ':22,'benævnelse',' ':26,'kunde',
' ':31,'kundenr');
IF EMNFOUND THEN
WRITE(LIST,EMNE.TEGNNR,' ':10,EMNE.BETEGN,' ':6)
ELSE WRITE(LIST,'IKKE OPRETTET':66);
IF KUNFOUND THEN WRITE(LIST,KUNDE.NAVN)
ELSE WRITE(LIST,'IKKE OPRETTET':26);
WRITELN(LIST,ORDRE.KUNDENR(1)*10000.0+ORDRE.KUNDENR(2):17:-2);
WRITELN(LIST);
WRITELN(LIST,'op op- betegnelse antal a mas- stk tid total',
' time kr');
WRITELN(LIST,'nr art kine /h /stk tid',
' sats /stk');
WRITELN(LIST);
LINES:=10
END;
PROCEDURE BOTTOM;
BEGIN
WITH ORDRE DO
BEGIN
WRITELN(LIST,'---------------------------------------------------------',
'------------');
WRITELN(LIST,'TOTAL',' ':35,TTPSTK:8:3,TTOTTID:7:2,TKRPSTK:14:3);
WRITELN(LIST);
IF LINES>34 THEN HEADING;
(*IF KALKULER THEN BEREGNMAT
ELSE
BEGIN*)
WRITELN(LIST,'SMELTEOMKOSTNINGER',' ':27,SMEOMK:8:3);
WRITELN(LIST,'MATERIALEFORBRUG ',' ':27,MATFORB:8:3)
(*END*);
WRITELN(LIST,' ':45,'----------------');
WRITELN(LIST,'MAT.-OMKOSTNINGER ',' ':27,MATOMK:8:3,MATOMK:8:3);
WRITELN(LIST,'LØNOMKOSTNINGER ',' ':35,LØNOMK:8:3);
WRITELN(LIST,'MASKINOMKOSTNINGER',' ':35,MASKINOM:8:3);
WRITELN(LIST,' ':53,'----------------');
WRITELN(LIST,'EMNEPRIS ',' ':35,MATOMK+
LØNOMK+MASKINOM:8:3,MATOMK+LØNOMK+MASKINOM:8:3);
WRITELN(LIST,'DÆKNINGSBIDRAG ',' ':35,-MATOMK+
SALGSPRI-LØNOMK-MASKINOM:16:3);
WRITELN(LIST,' ':61,'--------');
WRITELN(LIST,'SALGSPRIS ',' ':35,SALGSPRI:16:3);
WRITELN(LIST,' ':61,'========')
END;
LINES:=LINES+15;
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END;
(*$P*)
BEGIN (*FORKALKULATION*)
(*
REPEAT
CH:=QJN('Ønskes testprint');
IF CH IN JA THEN
BEGIN
FOR LINES:=1 TO 4 DO WRITELN(LIST);
WRITELN(LIST,' ':35,'XXXXXX');
FOR LINES:=6 TO 51 DO WRITELN(LIST)
END
UNTIL CH IN NEJ;
*)
LINES:=51;
WITH PROD DO
BEGIN
WITH KUNDE DO
BEGIN
NR:=ORDRE.KUNDENR;
GETREC(A);IF NOT (-IER IN (.0,6.)) THEN ERROR(A);
KUNFOUND:=(IER=0)
END;
WITH EMNE DO
BEGIN
NR:=ORDRE.EMNENR;
GETREC(A);IF NOT (-IER IN (.0,6.)) THEN ERROR(A);
EMNFOUND:=(IER=0)
END;
TTPSTK:=0.0;
TTOTTID:=0.0;
TKRPSTK:=0.0;
ORDRENR:=ORDRE.NR;
EMNENR:=ORDRE.EMNENR;
SEKVENSN:=0;
OPERANR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (EMNENR=ORDRE.EMNENR) AND (ORDRENR=ORDRE.NR) DO
BEGIN
IF LINES>48 THEN HEADING;
LINES:=LINES+1;
WRITE(LIST,SEKVENSN:2,OPERANR:4,' ');
WITH OPERA DO
BEGIN
NR:=OPERANR;
GETREC(A);IF NOT (-IER IN (.0,6.)) THEN ERROR(A);
IF IER=0 THEN WRITE(LIST,BETEGN:17)
ELSE WRITE(LIST,'IKKE OPRETTET':17)
END;
WRITE(LIST,ORDRE.ANTALBES:6:-2);
IF RESS1>0 THEN
WITH RESS DO
BEGIN
NR:=RESS1;
GETREC(A);IF NOT (-IER IN (.0,6.)) THEN ERROR(A);
IF IER=0 THEN
WRITE(LIST,AFDELNR:2,NR:5)
ELSE WRITE(LIST,'UO',RESS1:5)
END
ELSE
IF RESS1=0 THEN WRITE(LIST,' ':7)
ELSE WRITE(LIST,' *',-RESS1:4);
IF STKH<=0 THEN
BEGIN
TTOTTID:=TTOTTID-STKH/100.0;
WRITE(LIST,-STKH/100.0:18:2)
END
ELSE
BEGIN
TTPSTK:=TTPSTK+1/STKH;
TTOTTID:=TTOTTID+ORDRE.ANTALBES/STKH;
WRITE(LIST,STKH:5,1/STKH:6:3,ORDRE.ANTALBES/STKH:7:2)
END;
WRITE(LIST,KRSTK:8:2);
IF STKH<=0 THEN
BEGIN
TKRPSTK:=TKRPSTK-STKH*KRSTK/ORDRE.ANTALBES/100.0;
WRITELN(LIST,-STKH*KRSTK/ORDRE.ANTALBES/100.0:6:3)
END
ELSE
BEGIN
TKRPSTK:=TKRPSTK+KRSTK/STKH;
WRITELN(LIST,KRSTK/STKH:6:3)
END;
NEXTREC(A)
END;
BOTTOM;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A)
END
END;
(*$P*)
PROCEDURE OPRETORDRE;
VAR I,ANTALEMN:INTEGER;
PROCEDURE OHOVED(VAR I:INTEGER);
BEGIN
LÆSFELT(PICTURE(I));
SKRIVFELT(PICTURE(I));
CASE I OF
12:ORDRE.ANTALBES:=POST.KRSTK;
13:ORDRE.SALGSPRI:=POST.KRSTK;
14:ORDRE.ØNSKLEV:=POST.ØLEVTERM;
15:ORDRE.INITIALE:=POST.INIT;
16:ORDRE.KUNDORDR:=POST.KUORDNR
END
END;
(*$P*)
PROCEDURE VÆLGFELT(FRA:INTEGER);
VAR I:INTEGER;
BEGIN
REPEAT
REPEAT
D(23,1);
WRITE('Ændring af felt',FRA:2,'-7, 0 for færdig ');
READLN;
READ(I)
UNTIL (IORESULT=0) AND ((I IN (.0,4..7.)) OR (I=FRA));
I:=I+9;
IF I>9 THEN OHOVED(I)
UNTIL I=9
END;
PROCEDURE COMMENT;
VAR COMLINE:STRING(70);
I:INTEGER;
BEGIN
WITH ORDTEKST DO
BEGIN
NR:=ORDRE.NR;
EMNENR:=ORDRE.EMNENR;
(*$R-*)
COMLINE(0):=CHR(70);
(*$R+*)
D(22,2);
WRITE('Indtast kommentarlinier. Slut med "." i position 1');
I:=0;
REPEAT
I:=I+1;
FILLCHAR(COMLINE(2),69,' ');
COMLINE(1):='.';
GOTOXY(1,23);
EDIT(COMLINE);
IF COMLINE(1)<>'.' THEN
BEGIN
MOVELEFT(COMLINE(1),TEKST,70);
LBNR:=I;
INSERT(A);IF IER<>0 THEN ERROR(A)
END ELSE I:=10
UNTIL I=10;
D(22,2)
END
END;
(*$P*)
(*$L+*)
BEGIN (*OPRETORDRE*)
REPEAT
LÆSFELT(PICTURE(11));
SKRIVFELT(PICTURE(11));
KUNDE.NR:=POST.KUNDENR;
GETREC(KUNDE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(KUNDE.A);
IF IER=-6 THEN NONEXIST('Kunden')
UNTIL IER=0;
GOTOXY(40,5);WRITELN(KUNDE.NAVN);
IF QJN('Rigtig kunde') IN JA THEN
BEGIN
GOTOXY(1,6);
WRITELN('Kundens emner');
KUNEMNE.KUNDENR:=KUNDE.NR;
KUNEMNE.EMNENR:=0;
NEXTREC(KUNEMNE.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(KUNEMNE.A);
IER:=0;
ANTALEMN:=0;
WHILE (IER=0) AND (KUNEMNE.KUNDENR=KUNDE.NR) DO
BEGIN
WRITE(KUNEMNE.EMNENR:10);
ANTALEMN:=ANTALEMN+1;
IF ANTALEMN MOD 7=0 THEN WRITELN;
NEXTREC(KUNEMNE.A)
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(KUNEMNE.A);
REPEAT
LÆSFELT(PICTURE(1));
SKRIVFELT(PICTURE(1));
IF POST.EMNENR=0 THEN EXIT(OPRETORDRE);
EMNE.NR:=POST.EMNENR;
GETREC(EMNE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(EMNE.A);
IF IER=-6 THEN NONEXIST('Emnet');
IF EMNE.KUNDENR<>KUNDE.NR THEN
BEGIN
NONEXIST('Emne-kunde');
IER:=-6
END
UNTIL IER=0;
D(6,(ANTALEMN-1) DIV 7+2);
WRITELN('Emner i formen');
EMNIFORM.FORMNR:=EMNE.FORMNR;
EMNIFORM.EMNENR:=0;
NEXTREC(EMNIFORM.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(EMNIFORM.A);
IER:=0;
ANTALEMN:=0;
WHILE (IER=0) AND (EMNIFORM.FORMNR=EMNE.FORMNR) DO
BEGIN
EMNE.NR:=EMNIFORM.EMNENR;
ANTALEMN:=ANTALEMN+1;
GETREC(EMNE.A);IF IER<>0 THEN ERROR(EMNE.A);
WRITELN(EMNE.NR:6,' ',EMNE.BEMÆRK);
NEXTREC(EMNIFORM.A)
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(EMNIFORM.A);
IF ANTALEMN>1 THEN
BEGIN
D(23,1);
WRITE('Bemærk flere emner i form, RETURN ');
READLN;
D(23,1)
END;
D(6,ANTALEMN+1);
EMNE.NR:=POST.EMNENR;
GETREC(EMNE.A);IF IER<>0 THEN ERROR(EMNE.A);
ORDRE.KUNDENR:=KUNDE.NR;
ORDRE.EMNENR:=EMNE.NR;
ORDRE.REGDATO:=SYSTEM.DAGSDATO;
ORDRE.BEKRÆLEV:=0;
LÆSFELT(PICTURE(10));
IF POST.ORDRENR>0 THEN
ORDRE.NR:=POST.ORDRENR
ELSE
BEGIN
GETRECX(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A);
ORDRE.NR:=SYSTEM.ORDRENR;
POST.ORDRENR:=ORDRE.NR;
SYSTEM.ORDRENR:=SYSTEM.ORDRENR+1;
PUTREC(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A)
END;
SKRIVFELT(PICTURE(10));
POST.INIT:=' ';
POST.KUORDNR:=' ';
FOR I:=12 TO 16 DO OHOVED(I);
VÆLGFELT(3);
COMMENT;
KUNORDRE.ORDRENR:=ORDRE.NR;
KUNORDRE.KUNDENR:=ORDRE.KUNDENR;
KUNORDRE.EMNENR:=ORDRE.EMNENR;
INSERT(KUNORDRE.A);IF NOT (-IER IN (.0.)) THEN ERROR(KUNORDRE.A);
ORDRE.MATOMK:=0.0;
ORDRE.LØNOMK:=0.0;
ORDRE.MASKINOM:=0.0;
ORDRE.SMEOMK:=0.0;
ORDRE.MATFORB:=0.0;
TILPASFORK;
KALKULER:=TRUE;
(*
REPEAT
FORKALKULATION;
CH:=QJN('Kalkulation færdig');
IF CH IN NEJ THEN
BEGIN
CLEARSCREEN;
SKRIVFELT(PICTURE(1));
POST.KRSTK:=ORDRE.ANTALBES;
FOR I:=10 TO 12 DO SKRIVFELT(PICTURE(I));
POST.KRSTK:=ORDRE.SALGSPRI;
FOR I:=13 TO 16 DO SKRIVFELT(PICTURE(I));
VÆLGFELT(4)
END
UNTIL CH IN JA;
*)
BEREGNMAT;
INSERT(ORDRE.A);IF IER<>0 THEN ERROR(ORDRE.A)
END
END;
(*$P*)
PROCEDURE SLETORDRE;
BEGIN
IF QJN('Sletning korrekt') IN JA THEN
BEGIN
KUNORDRE.ORDRENR:=ORDRE.NR;
KUNORDRE.KUNDENR:=ORDRE.KUNDENR;
KUNORDRE.EMNENR:=ORDRE.EMNENR;
GETRECX(KUNORDRE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(KUNORDRE.A);
DELETE(KUNORDRE.A);IF NOT (-IER IN (.0.)) THEN ERROR(KUNORDRE.A);
PROD.ORDRENR:=ORDRE.NR;
PROD.EMNENR:=ORDRE.EMNENR;
PROD.SEKVENSN:=0;
PROD.OPERANR:=0;
NEXTRECX(PROD.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(PROD.A);IER:=0;
WHILE (PROD.ORDRENR=ORDRE.NR) AND (PROD.EMNENR=ORDRE.EMNENR) AND
(IER=0) DO DELETEX(PROD.A);
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(PROD.A);
GETREC(PROD.A);IF IER<>0 THEN ERROR(PROD.A);
OMVPROD.ORDRENR:=ORDRE.NR;
OMVPROD.EMNENR:=ORDRE.EMNENR;
OMVPROD.SEKVENSN:=0;
OMVPROD.OPERANR:=0;
NEXTRECX(OMVPROD.A);IF NOT (-IER IN (.1,2,9.)) THEN
ERROR(OMVPROD.A);IER:=0;
WHILE (OMVPROD.ORDRENR=ORDRE.NR) AND (OMVPROD.EMNENR=ORDRE.EMNENR) AND
(IER=0) DO DELETEX(OMVPROD.A);
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(OMVPROD.A);
GETREC(OMVPROD.A);IF IER<>0 THEN ERROR(OMVPROD.A);
ORDTEKST.NR:=ORDRE.NR;
ORDTEKST.EMNENR:=ORDRE.EMNENR;
ORDTEKST.LBNR:=0;
NEXTRECX(ORDTEKST.A);IF NOT (-IER IN (.1,2,9.)) THEN
ERROR(ORDTEKST.A);IER:=0;
WHILE (ORDTEKST.NR=ORDRE.NR) AND (ORDTEKST.EMNENR=ORDRE.EMNENR) AND
(IER=0) DO DELETEX(ORDTEKST.A);
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(ORDTEKST.A);
GETREC(ORDTEKST.A);IF IER<>0 THEN ERROR(ORDTEKST.A);
DELETE(ORDRE.A);IF NOT (-IER IN (.0,2,9.)) THEN ERROR(ORDRE.A)
END
ELSE
OPTION:=0
END;
(*$P*)
BEGIN (*MAINTAIN*)
CLEARSCREEN;
KALKULER:=FALSE;
REPEAT
GOTOXY(1,20);
WRITELN('1 Oprettelse af ny ordre');
WRITELN('2 Sletning af ordre');
WRITELN('3 Udskrift af forkalkulation');
D(23,1);
WRITE('Vælg 1-3 ');
READLN;
IF NOT EOLN THEN READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION IN (.1..3.));
D(20,4);
IF OPTION IN (.2..3.) THEN
BEGIN
LÆSFELT(PICTURE(10));SKRIVFELT(PICTURE(10));
ORDRE.NR:=POST.ORDRENR;
ORDRE.EMNENR:=0;
NEXTRECX(ORDRE.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ORDRE.A);IER:=0;
CH:='N';
IF ORDRE.NR<>POST.ORDRENR THEN BEGIN NONEXIST('Ordren');OPTION:=-1 END
ELSE
WHILE (IER=0) AND (ORDRE.NR=POST.ORDRENR) AND (CH IN NEJ) DO
BEGIN
CLEARSCREEN;
POST.ORDRENR:=ORDRE.NR;
POST.KUNDENR:=ORDRE.KUNDENR;
POST.EMNENR:=ORDRE.EMNENR;
POST.ØLEVTERM:=ORDRE.ØNSKLEV;
POST.INIT:=ORDRE.INITIALE;
POST.KUORDNR:=ORDRE.KUNDORDR;
POST.KRSTK:=ORDRE.ANTALBES;
SKRIVFELT(PICTURE(1));
FOR I:=10 TO 12 DO SKRIVFELT(PICTURE(I));
POST.KRSTK:=ORDRE.SALGSPRI;
FOR I:=13 TO 16 DO SKRIVFELT(PICTURE(I));
WITH ORDRE DO
BEGIN
GOTOXY(40,8);WRITE('Bekr. levterm',BEKRÆLEV:5);
GOTOXY(1,11);WRITELN('Reg. dato',
REGDATO(1)*10000.0+REGDATO(2):10:-2);
WRITELN('SMELTEOMKOSTNINGER',' ':25,SMEOMK:8:3);
WRITELN('MATERIALEFORBRUG ',' ':25,MATFORB:8:3);
WRITELN(' ':43,'----------------');
WRITELN('MAT.-OMKOSTNINGER ',' ':25,MATOMK:8:3,MATOMK:8:3);
WRITELN('LØNOMKOSTNINGER ',' ':33,LØNOMK:8:3);
WRITELN('MASKINOMKOSTNINGER',' ':33,MASKINOM:8:3);
WRITELN(' ':51,'----------------');
WRITELN('EMNEPRIS ',' ':33,MATOMK+
LØNOMK+MASKINOM:8:3,MATOMK+LØNOMK+MASKINOM:8:3);
WRITELN('DÆKNINGSBIDRAG ',' ':33,-MATOMK+
SALGSPRI-LØNOMK-MASKINOM:16:3);
WRITELN(' ':59,'--------');
WRITELN('SALGSPRIS ',' ':33,SALGSPRI:16:3)
END;
CH:=QJN('Rigtig ordre');
IF CH IN NEJ THEN NEXTRECX(ORDRE.A)
END;
IF NOT (-IER IN (.0..2,9.)) THEN ERROR(ORDRE.A);
IF ORDRE.NR<>POST.ORDRENR THEN OPTION:=0
END;
IF (OPTION=2) AND (ORDRE.BEKRÆLEV<>0) THEN
BEGIN
D(23,1);
WRITE('Ordren er indgået i planlægningen og må ikke slettes, RETURN ');
OPTION:=0;
READLN
END;
CASE OPTION OF
1:(*IF RESPRINT THEN BEGIN*) OPRETORDRE;(*FREEPR END;*)
2:SLETORDRE;
3:IF RESPRINT THEN BEGIN FORKALKULATION;FREEPR END
END;
IF OPTION=0 THEN
BEGIN GETREC(ORDRE.A);IF IER<>0 THEN ERROR(ORDRE.A) END (*FJERN XSTATUS*)
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;
POST.A(-4):=0;
SYSTEM.A(-4):=0;
PROD.A(-4):=0;
OMVPROD.A(-4):=0;
ORDRE.A(-4):=0;
KUNEMNE.A(-4):=0;
KUNORDRE.A(-4):=0;
EMNIFORM.A(-4):=0;
ORDTEKST.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;
POST.A(-3):=11;
SYSTEM.A(-3):=9;
PROD.A(-3):=14;
OMVPROD.A(-3):=13;
ORDRE.A(-3):=10;
KUNEMNE.A(-3):=19;
KUNORDRE.A(-3):=18;
EMNIFORM.A(-3):=20;
ORDTEKST.A(-3):=25;
(*$R+*)
(*@@EVT. ÅBNING AF ANDRE ANDRE DATAFILER*)
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(POST.A); IF IER<>0 THEN ERROR(POST.A);
IOPEN(OMVPROD.A); IF IER<>0 THEN ERROR(OMVPROD.A);
IOPEN(ORDRE.A); IF IER<>0 THEN ERROR(ORDRE.A);
IOPEN(KUNEMNE.A); IF IER<>0 THEN ERROR(KUNEMNE.A);
IOPEN(KUNORDRE.A);IF IER<>0 THEN ERROR(KUNORDRE.A);
IOPEN(EMNIFORM.A);IF IER<>0 THEN ERROR(EMNIFORM.A);
IOPEN(PROD.A); IF IER<>0 THEN ERROR(PROD.A);
IOPEN(ORDTEKST.A);IF IER<>0 THEN ERROR(ORDTEKST.A);
IOPEN(SYSTEM.A); IF IER<>0 THEN ERROR(SYSTEM.A);
SYSTEM.NR:=0;
GETREC(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A);
REPEAT
CLEARSCREEN;
GOTOXY(10,10);
WRITELN('O R D R E S P E C I F I K F O R K A L K U L A T I O N');
CH:=QJN('Flere forkalkulationer');
IF CH IN JA THEN MAINTAIN
UNTIL CH 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(POST.A);
ICLOSE(OMVPROD.A);
ICLOSE(ORDRE.A);
ICLOSE(KUNEMNE.A);
ICLOSE(KUNORDRE.A);
ICLOSE(EMNIFORM.A);
ICLOSE(PROD.A);
ICLOSE(ORDTEKST.A);
ICLOSE(SYSTEM.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*)
FILNR:=11;
DESCNAVN:='ORDRFORK: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.