|
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: 30336 (0x7680)
Types: TextFile
Notes: Mikados_K
Names: »LIMEFTER.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMEFTER.K«
PROGRAM LIMEFTER;
(*EFTERKALKULATION, SLETNING AF ORDRE,PRODFORK,REGLINIER,RESSBELAST,
INDSÆTTELSE AF EFTERKALKULATION*)
(*$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 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;
REGRPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
GRUPNR,
NR :INTEGER
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;
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;
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;
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;
KUNOPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
KUNDENR :LONGINT;
ORDRENR,
EMNENR :INTEGER
END;
REGLPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TID,
MÆNGDE,
LØN :REAL;
ORDRENR,
EMNENR,
OPERANR,
MEDARBNR :INTEGER;
DATO :LONGINT;
RTYPE :INTEGER
END;
REBEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
NR,
STARTDAG,
ORDRENR,
EMNENR,
OPERANR,
SEKVNR,
VARIGHED,
GRUPPE,
STTIME :INTEGER
END;
EFTEPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
BESANTAL,
LEVANTAL,
MATOMK,
LØNOMK,
MASKOMK,
SALGSPRI,
PLUSMINU :REAL;
EMNENR :INTEGER;
DATO :LONGINT;
ORDRENR :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;
VAR FELT:NFELT;
PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
OPTION,LINES,
I,J,ANTALFELTER:INTEGER;
LINE:STRING;
RESS:RESSPOST;
RESSGRUP:REGRPOST;
KUNDE:KUNDPOST;
EMNE:EMNEPOST;
RÅVARE:RÅVAPOST;
OPERA:OPERPOST;
PROD:PRODPOST;
OMVPROD:OMVPPOST;
ORDTEKST:OTEXPOST;
ORDRE:ORDRPOST;
KUNORDRE:KUNOPOST;
POST:EFTEPOST;
REGLI:REGLPOST;
REBELAST:REBEPOST;
SYSTEM:SYSRPOST;
LONGNUL:LONGINT;
CH:CHAR;
NEJ,JA,JAOGNEJ:SET OF CHAR;
(*$P*)
(*$L-*)
FUNCTION QJN(S:STRING):CHAR;
VAR CH:STRING(1);
BEGIN
REPEAT
D(23,1);
WRITE(S,' J/N ');
CH:='J';
EDIT(CH)
UNTIL CH(1) IN JAOGNEJ;
QJN:=CH(1);
D(23,1)
END;
PROCEDURE ERROR(VAR REC:AR);
VAR CH:STRING(1);
I:INTEGER;
BEGIN
D(23,1);
(*$R-*)
WRITE('FEJL I REGISTER ',REC(-3),' FEJLKODE ',IER,' RETURN'); (*$R+*)
CH:=' ';EDIT(CH);
IF CH='Æ' THEN BEGIN IER:=0;EXIT(ERROR) END;
ICLOSE(RESS.A);
ICLOSE(RESSGRUP.A);
ICLOSE(KUNDE.A);
ICLOSE(EMNE.A);
ICLOSE(RÅVARE.A);
ICLOSE(OPERA.A);
ICLOSE(OMVPROD.A);
ICLOSE(ORDTEKST.A);
ICLOSE(ORDRE.A);
ICLOSE(KUNORDRE.A);
ICLOSE(PROD.A);
ICLOSE(POST.A);
ICLOSE(REGLI.A);
ICLOSE(REBELAST.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;
PROCEDURE EFTERKALK;
VAR LINES:INTEGER;
FTPSTK,FKRPSTK,
LSATS,MSATS,
TTPSTK,TTOTTID,TKRPSTK,
RTPSTK,RTOTTID,RKRPSTK: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,'EFTERKALKULATION',' ':36,'kunde-ordrenr',
' ':6,'linimatic ordrenr',' ':5, 'emnenr',
' ':11,'dato');
WRITELN(LIST,'ANTAL BESTILT',POST.BESANTAL:10:-2,' LEVERET',
POST.LEVANTAL:10:-2,' ':10,
ORDRE.KUNDORDR,
ORDRE.NR:20,ORDRE.EMNENR:11,
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):15:-2);
WRITELN(LIST,'tegn. nr',' ':22,'benævnelse',' ':26,'kunde',
' ':36,'kundenr');
WRITELN(LIST,EMNE.TEGNNR,' ':10,EMNE.BETEGN,' ':6
,KUNDE.NAVN
,ORDRE.KUNDENR(1)*10000.0+ORDRE.KUNDENR(2):22:-2);
WRITELN(LIST,' ':38,'FORKALKULATION',' ':18,'EFTERKALKULATION');
WRITELN(LIST,'op op- betegnelse antal a mas- stk tid total',
' time kr stk tid total kr difference');
WRITELN(LIST,'nr art kine /h /stk tid',
' sats /stk /h /stk tid /stk kr/stk tid/stk');
WRITELN(LIST);
LINES:=10
END;
(*$P*)
PROCEDURE BOTTOM;
VAR ROMK,RSMEOMK,RSMELT:REAL;
BEGIN
WITH ORDRE DO
BEGIN
POST.MASKOMK:=POST.MASKOMK/POST.LEVANTAL;
POST.LØNOMK:=POST.LØNOMK/POST.LEVANTAL;
RTPSTK:=RTOTTID/POST.LEVANTAL;
RKRPSTK:=POST.MASKOMK+POST.LØNOMK;
WRITELN(LIST,'---------------------------------------------------------',
'---------------------------------------------------------');
WRITELN(LIST,'TOTAL',' ':34,TTPSTK:9:3,TTOTTID:7:2,TKRPSTK:14:3,
RTPSTK:11:3,RTOTTID:7:2,RKRPSTK:7:3,
TKRPSTK-RKRPSTK:10:3,TTPSTK-RTPSTK:10:3);
WRITELN(LIST);
IF LINES>34 THEN HEADING;
RSMELT:=POST.MATOMK*(1000.0+EMNE.SVIND)/1000.0*
(1000.0+EMNE.SMELTTIL)/1000.0*
(1000.0+RÅVARE.SMESVIND)/1000.0;
RSMEOMK:=RSMELT*RÅVARE.SMEPRIS/1000.0;
WRITELN(LIST,'SMELTEOMKOSTNINGER',' ':27,SMEOMK:8:3,' ':16,RSMEOMK:8:3);
POST.MATOMK:=RSMELT-POST.MATOMK*(1000.0+EMNE.SVIND)/1000.0*
EMNE.SMELTTIL/1000.0; (*FORBRUG*)
POST.MATOMK:=POST.MATOMK*RÅVARE.KOSTPRIS/1000.0;
WRITELN(LIST,'MATERIALEFORBRUG ',' ':27,MATFORB:8:3,' ':16,
POST.MATOMK:8:3);
WRITELN(LIST,' ':45,'----------------',' ':8,'----------------');
POST.MATOMK:=POST.MATOMK+RSMEOMK;
WRITELN(LIST,'MAT.-OMKOSTNINGER ',' ':27,MATOMK:8:3,MATOMK:8:3,' ':8,
POST.MATOMK:8:3,POST.MATOMK:8:3);
WRITELN(LIST,'LØNOMKOSTNINGER ',' ':35,LØNOMK:8:3,
POST.LØNOMK:24:3);
WRITELN(LIST,'MASKINOMKOSTNINGER',' ':35,MASKINOM:8:3,
POST.MASKOMK:24:3);
WRITELN(LIST,' ':53,'----------------',' ':8,'------------------------');
WRITELN(LIST,'EMNEPRIS ',' ':35,MATOMK+
LØNOMK+MASKINOM:8:3,MATOMK+LØNOMK+MASKINOM:8:3,
POST.MATOMK+POST.LØNOMK+POST.MASKOMK:16:3,
POST.MATOMK+POST.LØNOMK+POST.MASKOMK:16:3);
WRITELN(LIST,'DÆKNINGSBIDRAG ',' ':35,-MATOMK+
SALGSPRI-LØNOMK-MASKINOM:16:3,
POST.SALGSPRI-(POST.MATOMK+POST.LØNOMK+POST.MASKOMK):32:3);
WRITELN(LIST,' ':61,'--------',' ':24,'--------');
WRITELN(LIST,'SALGSPRIS ',' ':35,SALGSPRI:16:3,' ':16,
POST.SALGSPRI:16:3);
WRITELN(LIST,' ':61,'========',' ':24,'========')
END;
LINES:=LINES+15;
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END;
(*$P*)
PROCEDURE FIXSATS(VAR RESSURS:INTEGER;VAR ASATS:REAL);
VAR SATS:REAL;
BEGIN
RESS.NR:=0;
IF RESSURS>0 THEN
BEGIN
RESS.NR:=RESSURS;
GETRECX(RESS.A);CHECK0(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;
GETRECX(RESS.A);CHECK0(RESS.A);
SATS:=RESS.TSATSF
END
ELSE SATS:=0.0;
IF SATS<>0.0 THEN ASATS:=ASATS+SATS;
IF RESS.NR>0 THEN
BEGIN
CASE OPERA.REBELAS OF
1:RESS.PRODTIM:=RESS.PRODTIM+ROUND(REGLI.TID);
2:RESS.VEDLTIM:=RESS.VEDLTIM+ROUND(REGLI.TID);
3:RESS.OPSTILT:=RESS.OPSTILT+ROUND(REGLI.TID);
4:RESS.OVERTIM:=RESS.OVERTIM+ROUND(REGLI.TID);
5:RESS.REPTIME:=RESS.REPTIME+ROUND(REGLI.TID)
END;
IF RESS.RESSTYPE<10 THEN RESS.RESSTYPE:=RESS.RESSTYPE+20;
(*FLAG TIL SIKRING AF EEN OMSÆTNINGSOPTÆLLING I OPTÆLRES.FIXRESS*)
PUTREC(RESS.A);
CHECK0(RESS.A)
END
END;
(*$P*)
PROCEDURE RIGHTSIDE;
VAR TPSTK,KRPSTK:REAL;
BEGIN
TPSTK:=0.0;
KRPSTK:=TPSTK;
POST.LØNOMK:=POST.LØNOMK+REGLI.LØN+LSATS*REGLI.TID;
POST.MASKOMK:=POST.MASKOMK+MSATS*REGLI.TID;
IF REGLI.TID>0.0 THEN
WRITE(LIST,POST.LEVANTAL/REGLI.TID:5:-2)
ELSE WRITE(LIST,'-':5);
IF POST.LEVANTAL>0.0 THEN
BEGIN
TPSTK:=REGLI.TID/POST.LEVANTAL;
WRITE(LIST,TPSTK:6:3);
RTPSTK:=RTPSTK+TPSTK
END
ELSE WRITE(LIST,'-':6);
WRITE(LIST,REGLI.TID:7:2);
RTOTTID:=RTOTTID+REGLI.TID;
IF POST.LEVANTAL>0.0 THEN
BEGIN
KRPSTK:=(REGLI.LØN+(LSATS+MSATS)*REGLI.TID)/POST.LEVANTAL;
WRITE(LIST,KRPSTK:7:3);
RKRPSTK:=RKRPSTK+KRPSTK
END
ELSE WRITE(LIST,'-':7);
WRITELN(LIST,FKRPSTK-KRPSTK:10:3,FTPSTK-TPSTK:10:3);
LINES:=LINES+1
END;
(*$P*)
BEGIN (*EFTERKALKULATION*)
LINES:=51;
WITH PROD DO
BEGIN
TTPSTK:=0.0;
TTOTTID:=0.0;
RTPSTK:=0.0;
RTOTTID:=0.0;
RKRPSTK:=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;
REGLI.ORDRENR:=ORDRENR;
REGLI.EMNENR:=EMNENR;
REGLI.OPERANR:=OPERANR;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
GETRECX(REGLI.A);CHECK0(REGLI.A);
WRITE(LIST,SEKVENSN:2,OPERANR:4,' ');
WITH OPERA DO
BEGIN
NR:=OPERANR;
GETREC(A);CHECK0(A);
WRITE(LIST,BETEGN:17)
END;
WRITE(LIST,REGLI.MÆNGDE:6:-2);
IF RESS1>0 THEN
WITH RESS DO
BEGIN
NR:=RESS1;
GETRECX(A);CHECK0(A);
WRITE(LIST,AFDELNR:2,NR:5)
END
ELSE
IF RESS1=0 THEN WRITE(LIST,' ':7)
ELSE WRITE(LIST,' *',-RESS1:4);
IF STKH<=0 THEN
BEGIN
FTPSTK:=-STKH/ORDRE.ANTALBES/100.0;
TTOTTID:=TTOTTID-STKH/100.0;
WRITE(LIST,-STKH/100.0:18:2)
END
ELSE
BEGIN
FTPSTK:=1/STKH;
TTPSTK:=TTPSTK+FTPSTK;
TTOTTID:=TTOTTID+ORDRE.ANTALBES*FTPSTK;
WRITE(LIST,STKH:5,FTPSTK:6:3,ORDRE.ANTALBES*FTPSTK:7:2)
END;
WRITE(LIST,KRSTK:8:2);
IF STKH<=0 THEN
FKRPSTK:=-STKH*KRSTK/ORDRE.ANTALBES/100.0
ELSE
FKRPSTK:=KRSTK/STKH;
TKRPSTK:=TKRPSTK+FKRPSTK;
WRITE(LIST,FKRPSTK:6:3);
MSATS:=0.0;
LSATS:=0.0;
FIXSATS(RESS1,MSATS);
FIXSATS(RESS2,LSATS);
FIXSATS(RESS3,MSATS);
FIXSATS(RESS4,MSATS);
RIGHTSIDE;
DELETE(REGLI.A);IF IER<>-9 THEN CHECK0(REGLI.A);
NEXTREC(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
REGLI.ORDRENR:=POST.ORDRENR;
REGLI.EMNENR:=POST.EMNENR;
REGLI.OPERANR:=0;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
MSATS:=0.0;
LSATS:=MSATS;
FTPSTK:=MSATS;
FKRPSTK:=MSATS;
NEXTRECX(REGLI.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(REGLI.A);IER:=0;
WHILE (IER=0) AND (REGLI.ORDRENR=POST.ORDRENR) AND
(REGLI.EMNENR=POST.EMNENR) DO
WITH REGLI DO
BEGIN
WRITE(LIST,OPERANR:6,' ');
WITH OPERA DO
BEGIN
NR:=OPERANR;
GETREC(A);CHECK0(A);
WRITE(LIST,BETEGN:17)
END;
WRITE(LIST,MÆNGDE:6:-2,' ':39);
RIGHTSIDE;
DELETEX(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REGLI.A);
BOTTOM
END
END;
(*$P*)
PROCEDURE SLETORDRE;
BEGIN
WITH KUNORDRE DO
BEGIN
ORDRENR:=ORDRE.NR;
KUNDENR:=ORDRE.KUNDENR;
EMNENR:=ORDRE.EMNENR;
GETRECX(A);IF NOT (-IER IN (.0,6.)) THEN ERROR(A);
DELETE(A); CHECK0(A)
END;
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;
(*$P*)
PROCEDURE ORDRESTATUS;
VAR TTID,TMÆNGDE,TLØN,TPSTK,
ATID,AMÆNGDE,ALØN:REAL;
LINES:INTEGER;
PROCEDURE HEADING;
BEGIN
WHILE LINES<53 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
WRITELN(LIST,' ':52,'kunde-ordrenr',' ':6,'linimatic ordrenr',' ':5,
'emnenr',' ':6,'dato');
WRITELN(LIST,'ORDRESTATUS',' ':41,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');
WRITELN(LIST,EMNE.TEGNNR,' ':10,EMNE.BETEGN,' ':6,
KUNDE.NAVN,
ORDRE.KUNDENR(1)*10000.0+ORDRE.KUNDENR(2):17:-2);
WRITELN(LIST);
WRITELN(LIST,' MEDARBNR DATO REALISERET REALISERET',
' ENHEDER');
WRITELN(LIST,' TIDSFORBRUG PR. ENHED LØN');
LINES:=9
END;
(*$P*)
PROCEDURE REGLINIE(ORDRENR,EMNENR,OPERANR:INTEGER);
BEGIN
IF LINES>40 THEN HEADING;
TPSTK:=0.0;
TTID:=0.0;
TLØN:=0.0;
TMÆNGDE:=0.0;
ATID:=0.0;
ALØN:=0.0;
AMÆNGDE:=0.0;
OPERA.NR:=OPERANR;
GETREC(OPERA.A);CHECK0(OPERA.A);
WRITELN(LIST);
WRITELN(LIST,OPERA.NR:4,' ',OPERA.BETEGN);
LINES:=LINES+2;
REGLI.ORDRENR:=ORDRENR;
REGLI.EMNENR:=EMNENR;
REGLI.OPERANR:=OPERANR;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
NEXTRECX(REGLI.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(REGLI.A);IER:=0;
WHILE (IER=0) AND (REGLI.OPERANR=OPERANR) AND (REGLI.ORDRENR=ORDRENR)
AND (REGLI.EMNENR=EMNENR) DO
BEGIN
IF REGLI.DATO(1)>99 THEN
BEGIN
ATID:=ATID+REGLI.TID;
ALØN:=ALØN+REGLI.LØN;
AMÆNGDE:=AMÆNGDE+REGLI.MÆNGDE
END
ELSE
BEGIN
IF LINES>44 THEN HEADING;
WRITE(LIST,REGLI.MEDARBNR:10,
REGLI.DATO(1)*10000.0+REGLI.DATO(2):10:-2,
REGLI.TID:13:2);
IF REGLI.MÆNGDE<>0.0 THEN
WRITE(LIST,REGLI.TID/REGLI.MÆNGDE:11:4)
ELSE WRITE(LIST,'-':11);
WRITELN(LIST,REGLI.LØN:12:2,REGLI.MÆNGDE:9:-2);
LINES:=LINES+1;
TTID:=TTID+REGLI.TID;
TLØN:=TLØN+REGLI.LØN;
TMÆNGDE:=TMÆNGDE+REGLI.MÆNGDE
END;
DELETEX(REGLI.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REGLI.A);
(*UDSKRIV TOTAL, GENERER ELLER CHECK TOTALPOST*)
WRITELN(LIST,
'-----------------------------------------------------------------');
WRITE(LIST,'REALISERET OPTALT',TTID:13:2);
IF TMÆNGDE<>0.0 THEN
TPSTK:=TTID/TMÆNGDE
ELSE
TPSTK:=0.0;
IF TPSTK<>0.0 THEN WRITE(LIST,TPSTK:11:4)
ELSE WRITE(LIST,'-':11);
WRITELN(LIST,TLØN:12:2,TMÆNGDE:9:-2);
WRITE(LIST,'REALISERET INDTASTET',ATID:13:2);
IF AMÆNGDE<>0.0 THEN WRITE(LIST,ATID/AMÆNGDE:11:4)
ELSE WRITE(LIST,'-':11);
WRITELN(LIST,AMÆNGDE:21:-2);
IF ATID=0.0 THEN ATID:=TTID;
IF ALØN=0.0 THEN ALØN:=TLØN;
IF AMÆNGDE=0.0 THEN AMÆNGDE:=TMÆNGDE;
LINES:=LINES+3;
REGLI.ORDRENR:=ORDRENR;
REGLI.EMNENR:=EMNENR;
REGLI.OPERANR:=OPERANR;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
REGLI.TID:=ATID;
REGLI.LØN:=ALØN;
REGLI.MÆNGDE:=AMÆNGDE;
INSERT(REGLI.A);CHECK0(REGLI.A)
END;
(*$P*)
BEGIN (*ORDRESTATUS*)
LINES:=51;
WITH PROD DO
BEGIN
ORDRENR:=POST.ORDRENR;
EMNENR:=POST.EMNENR;
SEKVENSN:=0;
OPERANR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);IER:=0;
WHILE (IER=0) AND (ORDRENR=POST.ORDRENR) AND (EMNENR=POST.EMNENR) DO
BEGIN
REGLINIE(ORDRENR,EMNENR,OPERANR);
POST.LEVANTAL:=REGLI.MÆNGDE;
WRITE(LIST,'KALKULERET',' ':13);
IF PROD.STKH<=0 THEN
WRITE(LIST,-PROD.STKH/100.0:10:2,
-PROD.STKH/ORDRE.ANTALBES/100.0:11:4)
ELSE WRITE(LIST,ORDRE.ANTALBES/PROD.STKH:10:2,1/PROD.STKH:11:4);
WRITELN(LIST,ORDRE.ANTALBES:21:-2);
LINES:=LINES+1;
NEXTREC(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
HEADING;
WRITELN(LIST,'IKKEKALKULEREDE REGISTRERINGSLINIER');
LINES:=LINES+1;
REGLI.ORDRENR:=POST.ORDRENR;
REGLI.EMNENR:=POST.EMNENR;
REGLI.OPERANR:=0;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
NEXTRECX(REGLI.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(REGLI.A);IER:=0;
WHILE (IER=0) AND (REGLI.ORDRENR=POST.ORDRENR) AND
(REGLI.EMNENR=POST.EMNENR) DO
BEGIN
IF REGLI.MEDARBNR>0 THEN
REGLINIE(REGLI.ORDRENR,REGLI.EMNENR,REGLI.OPERANR);
NEXTRECX(REGLI.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REGLI.A);
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
PROCEDURE OPTÆLRES;
PROCEDURE FIXRESS(VAR RESSURS:INTEGER);
BEGIN
RESS.NR:=0;
IF RESSURS>0 THEN
RESS.NR:=RESSURS
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
END;
IF RESS.NR>0 THEN
BEGIN
GETRECX(RESS.A);CHECK0(RESS.A);
IF RESS.RESSTYPE>10 THEN (*SE FIXSATS*)
BEGIN
RESS.RESSTYPE:=RESS.RESSTYPE-20;
RESS.SAMOMS:=RESS.SAMOMS+POST.LEVANTAL*POST.SALGSPRI;
RESS.SAMDB:=RESS.SAMDB+POST.LEVANTAL*(POST.SALGSPRI-(POST.LØNOMK+
POST.MATOMK+POST.MASKOMK))
END;
PUTREC(RESS.A);
CHECK0(RESS.A);
REBELAST.NR:=RESS.NR;
REBELAST.STARTDAG:=PROD.STARTTID MOD 1000;
REBELAST.STTIME:=PROD.STARTTID DIV 1000;
REBELAST.ORDRENR:=PROD.ORDRENR;
REBELAST.EMNENR:=PROD.EMNENR;
REBELAST.OPERANR:=PROD.OPERANR;
GETRECX(REBELAST.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(REBELAST.A);
IF IER=0 THEN BEGIN DELETE(REBELAST.A);CHECK0(REBELAST.A) END
END
END;
(*$P*)
BEGIN (*OPTÆLRES*)
WITH PROD DO
BEGIN
ORDRENR:=POST.ORDRENR;
EMNENR:=POST.EMNENR;
SEKVENSN:=0;
OPERANR:=0;
NEXTRECX(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);IER:=0;
WHILE (IER=0) AND (ORDRENR=POST.ORDRENR) AND (EMNENR=POST.EMNENR) DO
BEGIN
FIXRESS(RESS1);
FIXRESS(RESS2);
FIXRESS(RESS3);
FIXRESS(RESS4);
OMVPROD.ORDRENR:=ORDRENR;
OMVPROD.EMNENR:=EMNENR;
OMVPROD.SEKVENSN:=SEKVENSN;
OMVPROD.OPERANR:=OPERANR;
GETRECX(OMVPROD.A);CHECK0(OMVPROD.A);
DELETE(OMVPROD.A);CHECK0(OMVPROD.A);
DELETEX(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
GETREC(A);CHECK0(A) (*FJERN XCLUSIV*)
END
END;
(*$P*)
BEGIN (*MAINTAIN*)
WITH POST DO
REPEAT
CLEARSCREEN;
WRITELN('E F T E R K A L K U L A T I O N');
LÆSFELT(PICTURE(1));
IF ORDRENR>0 THEN
BEGIN
SKRIVFELT(PICTURE(1));
LÆSFELT(PICTURE(2));
SKRIVFELT(PICTURE(2));
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=EMNENR;
GETRECX(ORDRE.A);
IF IER=-6 THEN
NONEXIST('Ordren')
ELSE
BEGIN
CHECK0(ORDRE.A);
EMNE.NR:=EMNENR;
GETRECX(EMNE.A);CHECK0(EMNE.A);
SALGSPRI:=ORDRE.SALGSPRI;
LEVANTAL:=0;
BESANTAL:=ORDRE.ANTALBES;
LÆSFELT(PICTURE(4));
SKRIVFELT(PICTURE(4));
KUNDE.NR:=ORDRE.KUNDENR;
GETREC(KUNDE.A);CHECK0(KUNDE.A);
LØNOMK:=0.0;
MASKOMK:=0.0;
ORDRESTATUS;
LÆSFELT(PICTURE(3));
SKRIVFELT(PICTURE(3));
MATOMK:=LEVANTAL*EMNE.NETTOVÆG; (*LEVERET NETTOVÆGT*)
(* = SOLGT MÆNGDE*)
RÅVARE.NR:=EMNE.MATNR;
GETRECX(RÅVARE.A);CHECK0(RÅVARE.A);
RÅVARE.OMSÆTP:=RÅVARE.OMSÆTP+RÅVARE.PRISKG*MATOMK/1000.0;
RÅVARE.DBP:=RÅVARE.DBP+(RÅVARE.PRISKG-RÅVARE.KOSTPRIS)*MATOMK/1000.0;
RÅVARE.KGSOLGT:=RÅVARE.KGSOLGT+MATOMK/1000.0;
LÆSFELT(PICTURE(5));
SKRIVFELT(PICTURE(5)); (*FORBRUGT MÆNGDE*)
RÅVARE.LAGER:=RÅVARE.LAGER-MATOMK/1000.0;
RÅVARE.KGFORBRU:=RÅVARE.KGFORBRU+MATOMK/1000.0;
PUTREC(RÅVARE.A);CHECK0(RÅVARE.A);
MATOMK:=MATOMK/LEVANTAL; (*MATERIALEFORBRUG PR. LEVERET*)
(*INDGÅR I.ST.F. NETTOVÆGT I *)
(*SMELTEOMKOSTNINGSBEREGNING *)
EFTERKALK;
EMNE.SAMSALG:=EMNE.SAMSALG+LEVANTAL*SALGSPRI;
EMNE.DÆKBID:=EMNE.DÆKBID+LEVANTAL*(SALGSPRI-(LØNOMK+MATOMK+MASKOMK));
(*EMNE.STKHSA,STKHBA UDSÆTTES*)
PUTREC(EMNE.A);CHECK0(EMNE.A);
OPTÆLRES;
PLUSMINU:=-(MATOMK+LØNOMK+MASKOMK)+
(ORDRE.MATOMK+ORDRE.LØNOMK+ORDRE.MASKINOM);
SLETORDRE;
DATO:=SYSTEM.DAGSDATO;
INSERT(A);CHECK0(A)
END
END
UNTIL ORDRENR=0
END;
(*$P*)
BEGIN (*REGVEDL*)
LONGNUL(1):=0;
LONGNUL(2):=0;
JA:=(.'J','j'.);
NEJ:=(.'N','n'.);
JAOGNEJ:=JA+NEJ;
CLEARSCREEN;
LÆSDESC;
MODE:=3;(*SKRIV*)
(*$R-*)
RESS.A(-4):=0;
RESSGRUP.A(-4):=0;
KUNDE.A(-4):=0;
EMNE.A(-4):=0;
RÅVARE.A(-4):=0;
OPERA.A(-4):=0;
SYSTEM.A(-4):=0;
PROD.A(-4):=0;
OMVPROD.A(-4):=0;
ORDRE.A(-4):=0;
KUNORDRE.A(-4):=0;
POST.A(-4):=0;
REGLI.A(-4):=0;
REBELAST.A(-4):=0;
ORDTEKST.A(-4):=0;
RESS.A(-3):=4;
ORDTEKST.A(-3):=25;
RESSGRUP.A(-3):=3;
KUNDE.A(-3):=1;
EMNE.A(-3):=2;
RÅVARE.A(-3):=5;
OPERA.A(-3):=6;
SYSTEM.A(-3):=9;
PROD.A(-3):=14;
OMVPROD.A(-3):=13;
ORDRE.A(-3):=10;
KUNORDRE.A(-3):=18;
POST.A(-3):=17;
REGLI.A(-3):=16;
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(RESS.A); CHECK0(RESS.A);
IOPEN(RESSGRUP.A); CHECK0(RESSGRUP.A);
IOPEN(KUNDE.A); CHECK0(KUNDE.A);
IOPEN(EMNE.A); CHECK0(EMNE.A);
IOPEN(RÅVARE.A); CHECK0(RÅVARE.A);
IOPEN(OPERA.A); CHECK0(OPERA.A);
IOPEN(OMVPROD.A); CHECK0(OMVPROD.A);
IOPEN(ORDTEKST.A); CHECK0(ORDTEKST.A);
IOPEN(ORDRE.A); CHECK0(ORDRE.A);
IOPEN(KUNORDRE.A); CHECK0(KUNORDRE.A);
IOPEN(PROD.A); CHECK0(PROD.A);
IOPEN(POST.A); CHECK0(POST.A);
IOPEN(REGLI.A); CHECK0(REGLI.A);
IOPEN(REBELAST.A); CHECK0(REBELAST.A);
WRITELN('BEMÆRK AT DETTE ER EN AFSLUTNING,');
WRITELN('OG AT ALLE ORDRER, DER EFTERKALKULERES,');
WRITELN(' B L I V E R S L E T T E T');
WRITELN('HUSK AT LØNLISTEN SKAL VÆRE UDSKREVET');
WRITELN('MONTER BREDT PAPIR OG TRYK RETURN');
READLN;
MAINTAIN;
ICLOSE(RESS.A);
ICLOSE(RESSGRUP.A);
ICLOSE(KUNDE.A);
ICLOSE(EMNE.A);
ICLOSE(RÅVARE.A);
ICLOSE(OPERA.A);
ICLOSE(OMVPROD.A);
ICLOSE(ORDTEKST.A);
ICLOSE(ORDRE.A);
ICLOSE(KUNORDRE.A);
ICLOSE(PROD.A);
ICLOSE(POST.A);
ICLOSE(REGLI.A);
ICLOSE(REBELAST.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:='EFTEPESC: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.