|
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: 15264 (0x3ba0)
Types: TextFile
Notes: Mikados_K
Names: »ORDAFSLT.K«
└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
└─⟦this⟧ »ORDAFSLT.K«
PROGRAM ORDAFSLT;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
VAR PARM:^PARMARRAY;
QUQ:^INTEGER;
FNAVN:STRING;
(*$P*)
PROCEDURE REGVEDL;
CONST MORDREZ=295;
MOPLINZ=370;
MOPERAZ=257;
MREGLIZ=583;
MHISTOZ=647;
(*$IISFHEAD*)
ORDREZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MORDREZ) OF INTEGER
END;
REGLIZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MREGLIZ) OF INTEGER
END;
OPLINZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MOPLINZ) OF INTEGER
END;
OPERAZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MOPERAZ) OF INTEGER
END;
HISTOZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..MHISTOZ) OF INTEGER
END;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
REGLIPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
LØN :REAL;
ORDRENR,
PRODUKT1NR,
PRODUKT2NR,
OPERATIONSNR,
MEDARBEJDERNR,
DAT1,DAT2,
CENTIMER,
ENHEDER :INTEGER
END;
ORDREPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ANTALBESTILT,
MATERIALEPRIS,
SALGSPRIS,
FAKTOR :REAL;
ORDRENR,
PRODUKT1NR,
PRODUKT2NR :INTEGER
END;
OPLINPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
MINUTFAKTOR :REAL;
ORDRENR,
PRODUKT1NR,
PRODUKT2NR,
OPERATIONSNR,
CENTIMER :INTEGER
END;
OPERAPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
OPERATIONSNR,
GRUPPE :INTEGER;
BETEGNELSE :PACKED ARRAY (1..30) OF CHAR
END;
HISTOPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
MATERIALER,
LØN,
MPLGFAKT,
SALGSPRIS,
AFVIGELSE,
ANTALBESTILT,
ANTALLEVERET :REAL;
PRODUKT1NR,
PRODUKT2NR,
DAT1,
DAT2,
ORDRENR :INTEGER
END;
SYSPOST=RECORD
MINUTFAKTOR:ARRAY (1..5) OF REAL;
DAT1,DAT2:INTEGER
END;
SYSFILE=FILE OF SYSPOST;
VAR SF:SYSFILE;
IER,I,J:INTEGER;
HIF,RGF,ORF,OPF,OAF:ISF;
ORZ:ORDREZONE;
OPZ:OPLINZONE;
OAZ:OPERAZONE;
RGZ:REGLIZONE;
HIZ:HISTOZONE;
ORPOST:ORDREPOST;
OPPOST:OPLINPOST;
OAPOST:OPERAPOST;
RGPOST:REGLIPOST;
HIPOST:HISTOPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IREADPROC*)
(*$ISÆTØG*)
(*$IFORSKYD*)
(*$IIOPEN*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IINSERT*)
(*$L+*)
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
ICLOSE(ORZ.H,ORF);
ICLOSE(OPZ.H,OPF);
ICLOSE(OAZ.H,OAF);
ICLOSE(RGZ.H,RGF);
ICLOSE(HIZ.H,HIF);
EXIT(REGVEDL)
END;
PROCEDURE OFEJL(VAR FIL:FILNAVN);
VAR I:INTEGER;
BEGIN
GOTOXY(1,20);
WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . SITUATIONEN ER FORSØGT REDDET.');
WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');
REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;
IF I<>0 THEN ERROR(FIL);
CLEARSCREEN
END;
(*$P*)
PROCEDURE MAINTAIN;
VAR CH:STRING(1);
R,SUM1,SUM2,SUM3,SUM4:REAL;
KCENT,RCENT,RENHED,KLØN,RLØN:ARRAY (0..6) OF REAL;
FUNCTION RUND(R:REAL):REAL;
VAR R1:REAL;
BEGIN
R1:=TRUNC(R/10000.0);
R1:=R1*10000.0;
RUND:=ROUND(R-R1)+R1
END;
(*$P*)
PROCEDURE DOIT;
BEGIN
NEXTREC(RGZ.H,RGF,RGPOST.A);
IF (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN ERROR(RGZ.H.FILENAME)
ELSE IER:=0;
WHILE (OPPOST.ORDRENR=ORPOST.ORDRENR) AND
(OPPOST.PRODUKT1NR=ORPOST.PRODUKT1NR) AND
(OPPOST.PRODUKT2NR=ORPOST.PRODUKT2NR) AND (IER=0) DO
BEGIN
IF (OPPOST.OPERATIONSNR<>RGPOST.OPERATIONSNR) OR
(OPPOST.ORDRENR<>RGPOST.ORDRENR) OR
(OPPOST.PRODUKT1NR<>RGPOST.PRODUKT1NR) OR
(OPPOST.PRODUKT2NR<>RGPOST.PRODUKT2NR) THEN
BEGIN
IF (OPPOST.OPERATIONSNR<>0) THEN
BEGIN
WRITELN(LIST,'----------------------------------------',
'----------------------------------');
IF HIPOST.ANTALBESTILT=0 THEN R:=1 ELSE R:=HIPOST.ANTALBESTILT;
WRITELN(LIST,OPPOST.OPERATIONSNR:4,' ':11,'REALISERET',
RCENT(0):12:-2,RCENT(0)/R:8:1,
RLØN(0):14:2,
RENHED(0):15:-2);
WRITELN(LIST,' ':15,'KALKULERET',KCENT(0):12:-2,
OPPOST.CENTIMER:8,
KLØN(0):14:2);
KCENT(OAPOST.GRUPPE):=KCENT(OAPOST.GRUPPE)+KCENT(0);
RCENT(OAPOST.GRUPPE):=RCENT(OAPOST.GRUPPE)+RCENT(0);
KLØN(OAPOST.GRUPPE):=KLØN(OAPOST.GRUPPE)+KLØN(0);
RLØN(OAPOST.GRUPPE):=RLØN(OAPOST.GRUPPE)+RLØN(0);
WRITE(LIST,' ':19,'%');
IF KCENT(0)=0.0 THEN
WRITE(LIST,'----------')
ELSE
WRITE(LIST,100.0*RCENT(0)/KCENT(0):10:2);
WRITE(LIST,' ':12);
IF KLØN(0)=0.0 THEN
WRITE(LIST,'----------')
ELSE
WRITE(LIST,100.0*RLØN(0)/KLØN(0):10:2);
WRITE(LIST,' ':12);
IF ORPOST.ANTALBESTILT=0.0 THEN
WRITELN(LIST,'----------')
ELSE
WRITELN(LIST,100.0*RENHED(0)/ORPOST.ANTALBESTILT:10:2);
WRITELN(LIST);
RENHED(0):=0.0;KCENT(0):=0.0;KLØN(0):=0.0;
RCENT(0):=0.0;
RLØN(0):=0.0;
DELETE(OPZ.H,OPF,OPPOST.A)
END ELSE NEXTREC(OPZ.H,OPF,OPPOST.A);
IF (IER<>0) AND (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN
ERROR(OPZ.H.FILENAME) ELSE IER:=0;
IF (OPPOST.ORDRENR=ORPOST.ORDRENR) AND
(OPPOST.PRODUKT1NR=ORPOST.PRODUKT1NR) AND
(OPPOST.PRODUKT2NR=ORPOST.PRODUKT2NR) THEN
BEGIN
OAPOST.OPERATIONSNR:=OPPOST.OPERATIONSNR MOD 100;
GETREC(OAZ.H,OAF,OAPOST.A);
IF IER<>0 THEN ERROR(OAZ.H.FILENAME);
WRITELN(LIST,OAPOST.BETEGNELSE);
KCENT(0):=KCENT(0)+OPPOST.CENTIMER*ORPOST.ANTALBESTILT;
KLØN(0):=KLØN(0)+ORPOST.ANTALBESTILT*OPPOST.CENTIMER*
OPPOST.MINUTFAKTOR
END
END
ELSE
BEGIN
IF RGPOST.ENHEDER=0 THEN IER:=1 ELSE IER:=RGPOST.ENHEDER;
WRITELN(LIST,RGPOST.MEDARBEJDERNR:10,RGPOST.DAT1*10000.0+
RGPOST.DAT2:11:-2,RGPOST.CENTIMER:16,
1.0*RGPOST.CENTIMER/IER:8:1,
RGPOST.LØN:14:2,RGPOST.ENHEDER:15);
RCENT(0):=RCENT(0)+RGPOST.CENTIMER;
RLØN(0):=RLØN(0)+RGPOST.LØN;
RENHED(0):=RENHED(0)+RGPOST.ENHEDER;
DELETE(RGZ.H,RGF,RGPOST.A)
END
END;
IF (IER<>0) AND (IER<>-9) THEN ERROR(RGZ.H.FILENAME) ELSE IER:=0;
END;
PROCEDURE DOTWO;
BEGIN
FOR I:=1 TO 6 DO
IF (KCENT(I)<>0.0) OR (RCENT(I)<>0.0) OR (KLØN(I)<>0.0) OR
(RLØN(I)<>0.0) THEN
BEGIN
SUM1:=SUM1+KCENT(I);
SUM2:=SUM2+RCENT(I);
SUM3:=SUM3+KLØN(I);
SUM4:=SUM4+RLØN(I)
END;
IF HIPOST.ANTALBESTILT=0 THEN R:=1 ELSE R:=HIPOST.ANTALBESTILT;
HIPOST.LØN:=SUM4/R;
HIPOST.MPLGFAKT:=(HIPOST.MATERIALER+HIPOST.LØN)*ORPOST.FAKTOR;
HIPOST.AFVIGELSE:=(ORPOST.MATERIALER+SUM3/R)*
ORPOST.FAKTOR-HIPOST.MPLGFAKT;
WRITELN(LIST,'REALISERET LØN PR. STK. KALKULERET LØN PR. STK.');
WRITELN(LIST,HIPOST.LØN:22:2,SUM3/HIPOST.ANTALBESTILT:32:2);
WRITELN(LIST,'(MATERIALER+LØN)*FAKTOR',HIPOST.MPLGFAKT:15:2);
PAGE(LIST);
INSERT(HIZ.H,HIF,HIPOST.A);IF IER<>0 THEN ERROR(HIZ.H.FILENAME);
DELETE(ORZ.H,ORF,ORPOST.A);
IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN ERROR(ORZ.H.FILENAME)
END;
(*$P*)
BEGIN
REPEAT
CLEARSCREEN;
REPEAT
GOTOXY(1,5);
WRITELN('Ordrenummer');
GOTOXY(13,5);
READLN;READ(ORPOST.ORDRENR)
UNTIL IORESULT=0;
REPEAT
GOTOXY(1,6);
WRITELN('Produktnummer');
GOTOXY(15,6);
READLN;READ(R)
UNTIL (IORESULT=0) AND (R>=0.0) AND (R<=999999.0);
ORPOST.PRODUKT1NR:=TRUNC(R/10000.0);
ORPOST.PRODUKT2NR:=TRUNC(R-ORPOST.PRODUKT1NR*10000.0);
GETREC(ORZ.H,ORF,ORPOST.A);
IF (IER<>0) AND (IER<>-6) THEN ERROR(ORZ.H.FILENAME);
IF IER=0 THEN
BEGIN
REPEAT
GOTOXY(1,7);
CH:='N';
WRITELN('Ønskes afslutning J/N');
GOTOXY(23,7);EDIT(CH)
UNTIL (CH='N') OR (CH='J');
IF CH='J' THEN
BEGIN
HIPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
HIPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
HIPOST.DAT1:=SF^.DAT1;
HIPOST.DAT2:=SF^.DAT2;
HIPOST.ORDRENR:=ORPOST.ORDRENR;
HIPOST.ANTALBESTILT:=ORPOST.ANTALBESTILT;
HIPOST.SALGSPRIS:=ORPOST.SALGSPRIS;
REPEAT
GOTOXY(1,8);
WRITELN('Realiseret materialepris');
GOTOXY(26,8);
READLN;READ(HIPOST.MATERIALEPRIS)
UNTIL (IORESULT=0) AND (HIPOST.MATERIALEPRIS>=0.0) AND
(HIPOST.MATERIALEPRIS<=10000000.0);
REPEAT
GOTOXY(1,9);
WRITELN('Leveret antal');
GOTOXY(15,9);
READLN;READ(HIPOST.ANTALLEVERET)
UNTIL (IORESULT=0) AND (HIPOST.ANTALLEVERET>=0.0) AND
(HIPOST.ANTALLEVERET<=10000000.0);
WRITELN(LIST,' ':30,'ORDREAFSLUTNING');
WRITELN(LIST,'ORDRESTATUS',' ':7,'ORDRENR',ORPOST.ORDRENR:6,
' ':3,'PRODUKTNR',ORPOST.PRODUKT1NR*10000.0+
ORPOST.PRODUKT2NR:8:-2,' ':11,'Dato',
SF^.DAT1*10000.0+SF^.DAT2:8:-2);
WRITELN(LIST,'MATERIALEPRIS',' ':5,'SALGSPRIS',' ':7,
'KALKULATIONSFAKTOR',' ':6,
'KALKULERET ANTAL');
WRITELN(LIST,ORPOST.MATERIALEPRIS:13:2,ORPOST.SALGSPRIS:14:2,
ORPOST.FAKTOR:25:2,ORPOST.ANTALBESTILT:22:-2);
WRITELN(LIST,'REALISERET MATERIALEPRIS',' ':34,'REALISERET ANTAL');
WRITELN(LIST,HIPOST.MATERIALEPRIS:13:2,' ':48,HIPOST.ANTALLEVERET:13:-2);
WRITELN(LIST);
WRITELN(LIST,'MEDARBEJDERNR',' ':4,'Dato',' ':5,
'1/100 TIMER',' ':19,'LØN',
' ':8,'ENHEDER');
WRITELN(LIST,' ':32,'REALI',' ':3,'PR.',' ':11,'REALI',
' ':5,'REALISERET');
WRITELN(LIST,' ':32,'SERET',' ':3,'ENHED',' ':9,'SERET');
WRITELN(LIST);
FOR I:=0 TO 6 DO
BEGIN
KCENT(I):=0.0;
RCENT(I):=0.0;
KLØN(I):=0.0;
RLØN(I):=0.0;
RENHED(I):=0.0
END;
SUM1:=0.0;SUM2:=0.0;SUM3:=0.0;SUM4:=0.0;
OPPOST.ORDRENR:=ORPOST.ORDRENR;
OPPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
OPPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
OPPOST.OPERATIONSNR:=0;
RGPOST.ORDRENR:=ORPOST.ORDRENR;
RGPOST.PRODUKT1NR:=ORPOST.PRODUKT1NR;
RGPOST.PRODUKT2NR:=ORPOST.PRODUKT2NR;
RGPOST.OPERATIONSNR:=0;
DOIT;
WRITELN(LIST);WRITELN(LIST);WRITELN(LIST);WRITELN(LIST);
DOTWO;
END
END;
CH:='J';
GOTOXY(1,10);
WRITELN('Flere ordrer');
GOTOXY(14,10);EDIT(CH)
UNTIL CH='N'
END;
(*$P*)
BEGIN
CLEARSCREEN;
FNAVN:='SYSREG:P2:1:I';
REWRITE(SF,FNAVN);
SEEK(SF,1);
GET(SF);
ORZ.H.FILENAME:='ORDREREG';
FNAVN:='ORDREREG:P2:0000:I';
REWRITE(ORF,FNAVN);
IOPEN(ORZ.H,ORF,SKRIV);IF IER<>0 THEN OFEJL(ORZ.H.FILENAME);
OPZ.H.FILENAME:='OPLINREG';
FNAVN:='OPLINREG:P2:0000:I';
REWRITE(OPF,FNAVN);
IOPEN(OPZ.H,OPF,SKRIV);IF IER<>0 THEN OFEJL(OPZ.H.FILENAME);
OAZ.H.FILENAME:='OPERAREG';
FNAVN:='OPERAREG:P2:0000:I';
REWRITE(OAF,FNAVN);
IOPEN(OAZ.H,OAF,LÆS);IF IER<>0 THEN OFEJL(OAZ.H.FILENAME);
RGZ.H.FILENAME:='REGLIREG';
FNAVN:='REGLIREG:P2:0000:I';
REWRITE(RGF,FNAVN);
IOPEN(RGZ.H,RGF,SKRIV);IF IER<>0 THEN OFEJL(RGZ.H.FILENAME);
HIZ.H.FILENAME:='HISTOREG';
FNAVN:='HISTOREG:P2:0000:I';
REWRITE(HIF,FNAVN);
IOPEN(HIZ.H,HIF,SKRIV);IF IER<>0 THEN OFEJL(HIZ.H.FILENAME);
MAINTAIN;
ICLOSE(ORZ.H,ORF);
ICLOSE(OPZ.H,OPF);
ICLOSE(OAZ.H,OAF);
ICLOSE(RGZ.H,RGF);
ICLOSE(HIZ.H,HIF);
WRITELN('ICLOSE ',IER)
END;
(*$P*)
BEGIN
REGVEDL;
FNAVN:=' ';
FNAVN(1):=PARM^(1);
CHAIN('L *1',CONCAT('HOVED:P2,',FNAVN),QUQ);
IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.