|
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: 50560 (0xc580)
Types: TextFile
Notes: Mikados_K
Names: »LIMUDSKR.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »LIMUDSKR.K«
PROGRAM LIMUDSKR;
(*DIVERSE UDSKRIFTER:RUTEKORT OSV.*)
(*$D-*)
(*$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;
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;
OMVPPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
ORDRENR,
SEKVENSN,
OPERANR,
EMNENR :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;
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;
REGLPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
TID,
MÆNGDE,
LØN :REAL;
ORDRENR,
EMNENR,
OPERANR,
MEDARBNR :INTEGER;
DATO :LONGINT;
RTYPE :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;
UDSKPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
EMNENR,
ORDRENR :INTEGER;
KUNDENR :LONGINT;
RTYPE :INTEGER;
ANTEX,
TEMNE,
TORDRE :INTEGER;
TKUNDE :LONGINT
END;
(*$P*)
VAR FELT:NFELT;
HUSKNIV:NIVEAU;
PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
OPTION,LINES,AKTFORM,
I,J,ANTALFELTER:INTEGER;
LINE:STRING;
REGLI:REGLPOST;
RESS:RESSPOST;
KUNDE:KUNDPOST;
EMNE:EMNEPOST;
RÅVARE:RÅVAPOST;
OPERA:OPERPOST;
PROD:PRODPOST;
ORDRE:ORDRPOST;
KUNEMNE:KUNEPOST;
KUNORDRE:KUNOPOST;
OMVPROD:OMVPPOST;
EMNIFORM:EMNFPOST;
SYSTEM:SYSRPOST;
UGEDAG:UGEDPOST;
ARBEDAG:ARBEPOST;
ORDTEKST:OTEXPOST;
POST:UDSKPOST;
LONGNUL:LONGINT;
CH:CHAR;
NEJ,JA,JAOGNEJ:SET OF CHAR;
STREG:STRING(116);
(*$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;
(*$L+*)
PROCEDURE FORMULAR(I:INTEGER);
VAR LINES:INTEGER;
BEGIN
IF AKTFORM=I THEN EXIT(FORMULAR);
AKTFORM:=I;
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,STREG);
FOR LINES:=2 TO 50 DO WRITELN(LIST);
WRITELN(LIST,STREG)
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,STREG:6);
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,STREG:82);
FOR LINES:=2 TO 71 DO WRITELN(LIST);
WRITELN(LIST,STREG:82)
END
END
END
END;
(*$L-*)
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(EMNE.A);
ICLOSE(RÅVARE.A);
ICLOSE(OPERA.A);
ICLOSE(ORDRE.A);
ICLOSE(REGLI.A);
ICLOSE(KUNEMNE.A);
ICLOSE(OMVPROD.A);
ICLOSE(KUNORDRE.A);
ICLOSE(EMNIFORM.A);
ICLOSE(PROD.A);
ICLOSE(UGEDAG.A);
ICLOSE(ARBEDAG.A);
ICLOSE(ORDTEKST.A);
EXIT(REGVEDL)
END;
PROCEDURE CHECK0(VAR REC:AR);
BEGIN
IF IER<>0 THEN ERROR(REC)
END;
(*$P*)
(*$L-*)
(*$IRLÆSDESC*)
(*$P*)
(*$IMOVETOLI*)
(*$L+*)
(*$P*)
PROCEDURE MAINTAIN;
VAR CH:CHAR;
RÅVFOUND,
KUNFOUND:BOOLEAN;
ANTEX,LINES:INTEGER;
(*$P*)
PROCEDURE FORKALKULATION;
VAR 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');
WRITE(LIST,EMNE.TEGNNR,' ':10,EMNE.BETEGN,' ':6);
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,STREG:69);
WRITELN(LIST,'TOTAL',' ':35,TTPSTK:8:3,TTOTTID:7:2,TKRPSTK:14:3);
WRITELN(LIST);
IF LINES>34 THEN HEADING;
WRITELN(LIST,'SMELTEOMKOSTNINGER',' ':27,SMEOMK:8:3);
WRITELN(LIST,'MATERIALEFORBRUG ',' ':27,MATFORB:8:3);
WRITELN(LIST,' ':45,STREG:16);
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,STREG:16);
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,STREG:8);
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*)
LINES:=51;
WITH PROD DO
BEGIN
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;
IF LINES<51 THEN BOTTOM;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
END
END;
(*$P*)
PROCEDURE RUTEKORT;
BEGIN
LINES:=72;
WITH PROD DO
BEGIN
RÅVARE.NR:=EMNE.MATNR;
GETREC(RÅVARE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RÅVARE.A);
RÅVFOUND:=(IER=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>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,'RUTEKORT',
KUNDENR(1)*10000.0+KUNDENR(2):20:-2,' ',ORDRE.KUNDORDR,
NR:5,ORDRE.NR:10);
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,
ORDRE.ANTALBES*NETTOVÆG/1000.0:8:2,ORDRE.ANTALBES:12:-2,
ORDRE.ØNSKLEV:6,ORDRE.BEKRÆLEV:6,
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):7:-2,
ORDRE.INITIALE:5)
END;
WRITELN(LIST);
WRITELN(LIST,' ':48,' arbnr dato antal');
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);
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*)
PROCEDURE PRODUKTIONSORDRE;
VAR HYLDE:INTEGER;
PROCEDURE HEADING;
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,'PRODUKTIONSORDRE',
KUNDENR(1)*10000.0+KUNDENR(2):12:-2,' ',ORDRE.KUNDORDR,
NR:5,ORDRE.NR:10);
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,
ORDRE.ANTALBES*NETTOVÆG/1000.0:8:2,ORDRE.ANTALBES:12:-2,
ORDRE.ØNSKLEV:6,ORDRE.BEKRÆLEV:6,
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):7:-2,
ORDRE.INITIALE:5)
END;
WRITELN(LIST);
WRITELN(LIST,' ':48,'start varigh værkt hjvt hyld');
LINES:=15
END;
BEGIN
LINES:=72;
WITH PROD DO
BEGIN
RÅVARE.NR:=EMNE.MATNR;
GETREC(RÅVARE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RÅVARE.A);
RÅVFOUND:=(IER=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>68 THEN HEADING;
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 STARTTID>0 THEN
BEGIN
ARBEDAG.NR:=STARTTID MOD 1000;
GETREC(ARBEDAG.A);CHECK0(ARBEDAG.A);
UGEDAG.UGENR:=ARBEDAG.UGENR;
GETREC(UGEDAG.A);CHECK0(UGEDAG.A);
WRITE(LIST,UGEDAG.UGENR MOD 100:3,'/',
ARBEDAG.NR-UGEDAG.ARBDAGNR+1)
END
ELSE
WRITE(LIST,STARTTID:5);
WRITE(LIST,VARIGHED:7,' ');
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;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
ORDTEKST.NR:=ORDRE.NR;
ORDTEKST.EMNENR:=ORDRE.EMNENR;
ORDTEKST.LBNR:=0;
NEXTREC(ORDTEKST.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(ORDTEKST.A);
IER:=0;
WHILE (IER=0) AND (ORDTEKST.NR=ORDRE.NR) AND (ORDTEKST.EMNENR=ORDRE.EMNENR)
DO
BEGIN
IF LINES>68 THEN HEADING;
WRITELN(LIST);
WRITELN(LIST,' ':7,ORDTEKST.TEKST);
LINES:=LINES+2;
NEXTREC(ORDTEKST.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(ORDTEKST.A);
WHILE LINES<72 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
PROCEDURE EMNELIST;
PROCEDURE HEADING;
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
FOR LINES:=1 TO 2 DO WRITELN(LIST);
WRITELN(LIST,'Emnespecifikaton pr. kunde');
WRITELN(LIST,STREG:109);
WRITELN(LIST,'Kundenr:',KUNDE.NR(1)*10000.0+KUNDE.NR(2):7:-2,' ':12,
'Navn: ',KUNDE.NAVN,' ':35,'Dato:',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,STREG:109);
WRITELN(LIST,' nr Tegn. nr',' ':13,'Betegnelse',' ':21,'Matr.',
' ':17,'vægt',' ':2,'tid SA/BA Værk Maskine');
WRITELN(LIST,STREG:109);
LINES:=8
END;
(*$P*)
BEGIN
LINES:=51;
WITH KUNEMNE DO
BEGIN
KUNDENR:=KUNDE.NR;
EMNENR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (KUNDENR=KUNDE.NR) DO
WITH EMNE DO
BEGIN
IF LINES>48 THEN HEADING;
NR:=EMNENR;
GETREC(A);CHECK0(A);
RÅVARE.NR:=EMNE.MATNR;
GETREC(RÅVARE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(RÅVARE.A);
RÅVFOUND:=(IER=0);
WRITE(LIST,NR:5,' ',TEGNNR,' ',BETEGN,' ');
IF RÅVFOUND THEN WRITE(LIST,RÅVARE.BETEGN)
ELSE WRITE(LIST,'IKKE OPRETTET':16);
WRITELN(LIST,NETTOVÆG:10:2,STKHSA:6,'/',STKHBA:5,FORMNR:5,MASKINE:8);
LINES:=LINES+1;
NEXTREC(KUNEMNE.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
PROCEDURE FORMLIST;
PROCEDURE HEADING;
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
FOR LINES:=1 TO 2 DO WRITELN(LIST);
WRITELN(LIST,STREG);
WRITELN(LIST,'Formregistreringsliste',' ':79,'Dato:',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,STREG);
WRITELN(LIST,'Form. Kunde',' ':22,'Emnenr Emne',' ':27,'Tegn.nr',
' ':14,'Bemærkning',' ':10,'Mask');
WRITELN(LIST,STREG);
LINES:=7
END;
(*$P*)
BEGIN
LINES:=51;
WITH EMNIFORM DO
BEGIN
FORMNR:=0;
EMNENR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (NOT EOF(OUTPUT)) DO
WITH EMNE DO
BEGIN
IF LINES>48 THEN HEADING;
NR:=EMNENR;
GETREC(A);CHECK0(A);
KUNDE.NR:=EMNE.KUNDENR;
GETREC(KUNDE.A);CHECK0(KUNDE.A);
WRITELN(LIST,FORMNR:5,' ',KUNDE.NAVN,NR:7,
' ',BETEGN,' ',TEGNNR,' ',
BEMÆRK:19,MASKINE:5);
LINES:=LINES+1;
NEXTREC(EMNIFORM.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
PROCEDURE ORDRLIST;
PROCEDURE HEADING;
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
FOR LINES:=1 TO 2 DO WRITELN(LIST);
WRITELN(LIST,STREG);
WRITELN(LIST,'Ordreoversigt',' ':88,'Dato:',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,STREG);
WRITELN(LIST,'Ordre Kunde',' ':19,'Emnenr Emne',' ':24,'Tegn.nr',
' ':16,'Antal',' ':2,'Init Dato Mask Øuge');
WRITELN(LIST,STREG);
LINES:=7
END;
(*$P*)
BEGIN
WITH ORDRE,EMNE DO
BEGIN
IF LINES>48 THEN HEADING;
WRITE(LIST,ORDRE.NR:5,' ');
IF KUNFOUND THEN WRITE(LIST,KUNDE.NAVN:23)
ELSE WRITE(LIST,'KUNDEN ER IKKE OPRETTET');
WRITELN(LIST,NR:7,
' ',BETEGN:27,' ',TEGNNR,
ORDRE.ANTALBES:8:-2,' ',ORDRE.INITIALE,
ORDRE.REGDATO(1)*10000.0+ORDRE.REGDATO(2):7:-2,
MASKINE:5,ORDRE.ØNSKLEV:5);
LINES:=LINES+1
END
END;
(*$P*)
PROCEDURE KUNOLIST;
PROCEDURE HEADING;
BEGIN
IF CH IN NEJ THEN
BEGIN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
FOR LINES:=1 TO 2 DO WRITELN(LIST);
WRITELN(LIST,'Kundeordreoversigt');
WRITELN(LIST,STREG);
WRITELN(LIST,'Kundenr:',KUNDE.NR(1)*10000.0+KUNDE.NR(2):7:-2,' ':6,
'Navn: ',KUNDE.NAVN,' ':48,'Dato:',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,STREG);
WRITELN(LIST,'Tegn. nr',' ':13,' Kundens ordrenr Emnenr Emne',
' ':27,'Ordrenr Antal',' ':2,
'Ø.lev.uge B.lev.uge');
WRITELN(LIST,STREG);
LINES:=8
END
ELSE
BEGIN
IF LINES<51 THEN
BEGIN
GOTOXY(1,24);
WRITE('RETURN ');
READLN
END;
CLEARSCREEN;
WRITELN('Tegn. nr',' ':13,'Kundens ordrenr Emne',
' ':16,'Ordnr Antal',
' Øuge Buge');
LINES:=1
END
END;
(*$P*)
BEGIN
LINES:=51;
WITH KUNORDRE DO
BEGIN
KUNDENR:=KUNDE.NR;
ORDRENR:=0;
EMNENR:=0;
NEXTREC(A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(A);
IER:=0;
WHILE (IER=0) AND (KUNDENR=KUNDE.NR) DO
WITH EMNE DO
BEGIN
IF (LINES>48) OR ((CH IN JA) AND (LINES>22)) THEN HEADING;
NR:=EMNENR;
GETREC(A);CHECK0(A);
ORDRE.NR:=ORDRENR;
ORDRE.EMNENR:=NR;
GETREC(ORDRE.A);CHECK0(ORDRE.A);
IF CH IN NEJ THEN
WRITELN(LIST,TEGNNR,' ',ORDRE.KUNDORDR,NR:5,' ':3,
BETEGN,' ',ORDRE.NR:7,ORDRE.ANTALBES:10:-2,
ORDRE.ØNSKLEV:11,ORDRE.BEKRÆLEV:11)
ELSE
WRITELN(TEGNNR,' ',ORDRE.KUNDORDR,NR:5,' ',
BETEGN:15,ORDRE.NR:5,ORDRE.ANTALBES:6:-2,
ORDRE.ØNSKLEV:5,ORDRE.BEKRÆLEV:5);
LINES:=LINES+1;
NEXTREC(KUNORDRE.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
IF CH IN NEJ THEN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
ELSE IF LINES<>51 THEN BEGIN WRITE('RETURN ');READLN END
END
END;
(*$P*)
PROCEDURE ORDRESTATUS;
VAR TTID,TMÆNGDE,TLØN,
ATID,AMÆNGDE,ALØN:REAL;
LINES:INTEGER;
PROCEDURE HEADING;
BEGIN
IF CH IN NEJ THEN
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
ELSE
BEGIN
IF LINES<51 THEN
BEGIN
GOTOXY(1,24);
WRITE('RETURN ');
READLN
END;
CLEARSCREEN;
WRITELN(' MEDARBNR DATO REALISERET REALISERET',
' ENHEDER');
WRITELN(' TIDSFORBRUG PR. ENHED LØN');
LINES:=2
END
END;
(*$P*)
PROCEDURE REGLINIE(ORDRENR,EMNENR,OPERANR:INTEGER);
BEGIN
IF (LINES>40) OR ((CH IN JA) AND (LINES>16)) THEN HEADING;
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);
IF CH IN NEJ THEN
BEGIN
WRITELN(LIST);
WRITELN(LIST,OPERA.NR:4,' ',OPERA.BETEGN)
END
ELSE
BEGIN
WRITELN;
WRITELN(OPERA.NR:4,' ',OPERA.BETEGN)
END;
LINES:=LINES+2;
REGLI.ORDRENR:=ORDRENR;
REGLI.EMNENR:=EMNENR;
REGLI.OPERANR:=OPERANR;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
NEXTREC(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) OR ((CH IN JA) AND (LINES>20)) THEN HEADING;
IF CH IN NEJ THEN
WRITE(LIST,REGLI.MEDARBNR:10,
REGLI.DATO(1)*10000.0+REGLI.DATO(2):10:-2,
REGLI.TID:13:2)
ELSE
WRITE(REGLI.MEDARBNR:10,
REGLI.DATO(1)*10000.0+REGLI.DATO(2):10:-2,
REGLI.TID:13:2);
IF REGLI.MÆNGDE<>0.0 THEN
IF CH IN NEJ THEN
WRITE(LIST,REGLI.TID/REGLI.MÆNGDE:11:4)
ELSE
WRITE(REGLI.TID/REGLI.MÆNGDE:11:4)
ELSE
IF CH IN NEJ THEN
WRITE(LIST,'-':11)
ELSE
WRITE('-':11);
IF CH IN NEJ THEN
WRITELN(LIST,REGLI.LØN:12:2,REGLI.MÆNGDE:9:-2)
ELSE
WRITELN(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;
NEXTREC(REGLI.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REGLI.A);
(*UDSKRIV TOTAL, GENERER ELLER CHECK TOTALPOST*)
IF CH IN NEJ THEN
BEGIN
WRITELN(LIST,STREG:65);
WRITE(LIST,'REALISERET OPTALT',TTID:13:2);
IF TMÆNGDE<>0.0 THEN WRITE(LIST,TTID/TMÆNGDE: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)
END
ELSE
BEGIN
WRITELN(STREG:65);
WRITE('REALISERET OPTALT',TTID:13:2);
IF TMÆNGDE<>0.0 THEN WRITE(TTID/TMÆNGDE:11:4)
ELSE WRITE('-':11);
WRITELN(TLØN:12:2,TMÆNGDE:9:-2);
WRITE('REALISERET INDTASTET',ATID:13:2);
IF AMÆNGDE<>0.0 THEN WRITE(ATID/AMÆNGDE:11:4)
ELSE WRITE('-':11);
WRITELN(AMÆNGDE:21:-2)
END;
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
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);
IF CH IN NEJ THEN
BEGIN
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)
END
ELSE
BEGIN
WRITE('KALKULERET',' ':13);
IF PROD.STKH<=0 THEN
WRITE(-PROD.STKH/100.0:10:2,-PROD.STKH/ORDRE.ANTALBES/100.0:11:4)
ELSE WRITE(ORDRE.ANTALBES/PROD.STKH:10:2,1/PROD.STKH:11:4);
WRITELN(ORDRE.ANTALBES:21:-2)
END;
LINES:=LINES+1;
NEXTREC(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(A);
HEADING;
IF CH IN NEJ THEN
WRITELN(LIST,'IKKEKALKULEREDE REGISTRERINGSLINIER')
ELSE
WRITELN('IKKEKALKULEREDE REGISTRERINGSLINIER');
LINES:=LINES+1;
REGLI.ORDRENR:=POST.ORDRENR;
REGLI.EMNENR:=POST.EMNENR;
REGLI.OPERANR:=0;
REGLI.MEDARBNR:=0;
REGLI.DATO:=LONGNUL;
NEXTREC(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) AND (NOT EOF(OUTPUT)) DO
BEGIN
OMVPROD.ORDRENR:=REGLI.ORDRENR;
OMVPROD.EMNENR:=REGLI.EMNENR;
OMVPROD.OPERANR:=REGLI.OPERANR;
OMVPROD.SEKVENSN:=0;
NEXTREC(OMVPROD.A);IF NOT (-IER IN (.0..2,9.)) THEN ERROR(OMVPROD.A);
IER:=0;
IF (REGLI.OPERANR<>OMVPROD.OPERANR) OR (REGLI.EMNENR<>OMVPROD.EMNENR)
OR (REGLI.ORDRENR<>OMVPROD.ORDRENR) THEN
REGLINIE(REGLI.ORDRENR,REGLI.EMNENR,REGLI.OPERANR)
ELSE
NEXTREC(REGLI.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(REGLI.A);
IF CH IN NEJ THEN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
ELSE BEGIN WRITE('RETURN ');READLN END
END
END;
(*$P*)
PROCEDURE RESOMSÆT;
VAR R:ARRAY(1..4) OF REAL;
I:ARRAY(1..12) OF REAL;
PROCEDURE HEADING;
BEGIN
WHILE LINES<53 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
WRITELN(LIST,'RESSOURCE-OMSÆTNINGSOVERSIGT TYPE',RESS.RESSTYPE:5,
' ':53,'DATO',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,' NR BETEGN SAMOMS SAMDB PRODTIM',
' VEDLTIM OPSTILT OVERTIM REPTIME TOTALTI',
' DB/P.TIM');
WRITELN(LIST,' TIMESATS SAMOMSSÅ SAMDBSÅ PRODTIMS',
' VEDLTIMS OPSTILTS OVERTIMS REPTIMES TOTALTIS',
' DB/P.TIMS');
LINES:=5
END;
PROCEDURE PERAFSLT;
BEGIN
WITH RESS DO
BEGIN
SAMOMSSÅ:=SAMOMS;
SAMDBSÅ :=SAMDB;
SAMOMS:=0;
SAMDB:=0;
PRODTIMS:=PRODTIM;
VEDLTIMS:=VEDLTIM;
OPSTILTS:=OPSTILT;
OVERTIMS:=OVERTIM;
REPTIMES:=REPTIME;
TOTALTIS:=TOTALTI;
PRODTIM:=0;
VEDLTIM:=0;
OPSTILT:=0;
OVERTIM:=0;
REPTIME:=0;
TOTALTI:=0;
PUTREC(A);CHECK0(A)
END;
END;
(*$P*)
BEGIN
LÆSFELT(PICTURE(4));
SKRIVFELT(PICTURE(4));
FOR J:=1 TO 12 DO I(J):=0.0;
FOR J:=1 TO 4 DO R(J):=0.0;
LINES:=51;
WITH RESS DO
BEGIN
NR:=0;
NEXTRECX(A);IF NOT (-IER IN (.0..2,9.)) THEN CHECK0(A);IER:=0;
WHILE (IER=0) AND (NOT EOF(OUTPUT)) DO
BEGIN
IF (RESSTYPE=POST.RTYPE) OR (POST.RTYPE=0) THEN
BEGIN
IF LINES>45 THEN HEADING;
LINES:=LINES+3;
WRITELN(LIST);
WRITE(LIST,NR:5,' ',BETEGN,SAMOMS:10:-2,SAMDB:10:-2,PRODTIM:10,
VEDLTIM:10,OPSTILT:10,OVERTIM:10,REPTIME:10,TOTALTI:10);
IF PRODTIM<>0 THEN WRITELN(LIST,SAMDB/PRODTIM:10:-2)
ELSE WRITELN(LIST,'-':10);
WRITE(LIST,TSATSF:16:2,SAMOMSSÅ:10:-2,SAMDBSÅ:10:-2,PRODTIMS:10,
VEDLTIMS:10,OPSTILTS:10,OVERTIMS:10,REPTIMES:10,TOTALTIS:10);
IF PRODTIMS<>0 THEN WRITELN(LIST,SAMDBSÅ/PRODTIMS:10:-2)
ELSE WRITELN(LIST,'-':10);
R(1):=R(1)+SAMOMS;
R(2):=R(2)+SAMDB;
R(3):=R(3)+SAMOMSSÅ;
R(4):=R(4)+SAMDBSÅ;
I(1):=I(1)+PRODTIM; I(7):=I(7)+PRODTIMS;
I(2):=I(2)+VEDLTIM; I(8):=I(8)+VEDLTIMS;
I(3):=I(3)+OPSTILT; I(9):=I(9)+OPSTILTS;
I(4):=I(4)+OVERTIM; I(10):=I(10)+OVERTIMS;
I(5):=I(5)+REPTIME; I(11):=I(11)+REPTIMES;
I(6):=I(6)+TOTALTI; I(12):=I(12)+TOTALTIS;
IF CH IN JA THEN PERAFSLT
END;
NEXTRECX(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN CHECK0(A);
PUTREC(A);CHECK0(A)
END;
IF LINES<51 THEN
BEGIN
LINES:=LINES+3;
WRITELN(LIST,STREG:106);
WRITE(LIST,'TOTAL',' ':11,R(1):10:-2,R(2):10:-2,I(1):10:-2,
I(2):10:-2,I(3):10:-2,I(4):10:-2,I(5):10:-2,I(6):10:-2);
IF I(1)<>0 THEN WRITELN(LIST,R(2)/I(1):10:-2)
ELSE WRITELN(LIST,'-':10);
WRITE(LIST,' ':16,R(3):10:-2,R(4):10:-2,I(7):10:-2,
I(8):10:-2,I(9):10:-2,I(10):10:-2,I(11):10:-2,I(12):10:-2);
IF I(7)<>0 THEN WRITELN(LIST,R(4)/I(7):10:-2)
ELSE WRITELN(LIST,'-':10);
(*TOTAL*)
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
PROCEDURE RÅVOMSÆT;
VAR R:ARRAY(1..4) OF REAL;
PROCEDURE HEADING;
BEGIN
WHILE LINES<53 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
WRITELN(LIST,'RÅVARE-OMSÆTNINGSOVERSIGT',' ':53,'DATO',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,' NR BETEGN OMSÆT DB KOSTPRIS',
' LAGER KGINDKØB KGFORBRUG SMESVIND');
WRITELN(LIST,' KGPRIS OMSÆTS DBS KOSTPRSÅ',
' MINLAGER KGSOLGT SMEPRIS');
LINES:=5
END;
(*$P*)
BEGIN
FOR J:=1 TO 4 DO R(J):=0.0;
LINES:=51;
WITH RÅVARE DO
BEGIN
NR:=0;
NEXTRECX(A);IF NOT (-IER IN (.0..2,9.)) THEN CHECK0(A);IER:=0;
WHILE (IER=0) AND (NOT EOF(OUTPUT)) DO
BEGIN
IF LINES>45 THEN HEADING;
LINES:=LINES+3;
WRITELN(LIST);
WRITELN(LIST,NR:5,' ',BETEGN,OMSÆTP:10:-2,DBP:10:-2,KOSTPRIS:10:2,
LAGER:10:-2,KGINDKØB:10:-2,KGFORBRU:10:-2,SMESVIND:10);
WRITELN(LIST,' ':12,PRISKG:10:2,OMSÆTSP:10:-2,DBSÅ:10:-2,KOSTPRSÅ:10:2,
MINLAGE:10:-2,KGSOLGT:10:-2,SMEPRIS:20:2);
R(1):=R(1)+OMSÆTP;
R(2):=R(2)+DBP;
R(3):=R(3)+OMSÆTSP;
R(4):=R(4)+DBSÅ;
IF CH IN JA THEN
BEGIN
OMSÆTSP:=OMSÆTP;OMSÆTP:=0;
DBSÅ:=DBP;DBP:=0;
KOSTPRSÅ:=KOSTPRIS;
PUTREC(A);CHECK0(A)
END;
NEXTRECX(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN CHECK0(A);
PUTREC(A);CHECK0(A)
END;
IF LINES<51 THEN
BEGIN
LINES:=LINES+3;
WRITELN(LIST,STREG:92);
WRITELN(LIST,'TOTAL',' ':17,R(1):10:-2,R(2):10:-2);
WRITELN(LIST,' ':22,R(3):10:-2,R(4):10:-2);
(*TOTAL*)
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
(*$P*)
PROCEDURE EMNOMSÆT;
VAR R:ARRAY(1..4) OF REAL;
PROCEDURE HEADING;
BEGIN
WHILE LINES<53 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
WRITELN(LIST,'EMNE-OMSÆTNINGSOVERSIGT',' ':49,'DATO',
SYSTEM.DAGSDATO(1)*10000.0+SYSTEM.DAGSDATO(2):10:-2);
WRITELN(LIST,' NR BETEGN KUNDENR SAMSALG',
' DÆKBID SVIND STKHSA');
WRITELN(LIST,' SAMSALGS',
' DÆKBIDSÅ SMELTTIL STKHBA');
LINES:=5
END;
(*$P*)
BEGIN
FOR J:=1 TO 4 DO R(J):=0.0;
LINES:=51;
WITH EMNE DO
BEGIN
NR:=0;
NEXTRECX(A);IF NOT (-IER IN (.0..2,9.)) THEN CHECK0(A);IER:=0;
WHILE (IER=0) AND (NOT EOF(OUTPUT)) DO
BEGIN
IF LINES>45 THEN HEADING;
LINES:=LINES+3;
WRITELN(LIST);
WRITELN(LIST,NR:5,' ',BETEGN,KUNDENR(1)*10000.0+KUNDENR(2):10:-2,
SAMSALG:10:-2,DÆKBID:10:-2,SVIND:10,STKHSA:10);
WRITELN(LIST,' ':46,
SAMSALGS:10:-2,DÆKBIDSÅ:10:-2,SMELTTIL:10,STKHBA:10);
R(1):=R(1)+SAMSALG;
R(2):=R(2)+DÆKBID;
R(3):=R(3)+SAMSALGS;
R(4):=R(4)+DÆKBIDSÅ;
IF CH IN JA THEN
BEGIN
SAMSALGS:=SAMSALG;SAMSALG:=0;
DÆKBIDSÅ:=DÆKBID;DÆKBID:=0;
PUTREC(A);CHECK0(A)
END;
NEXTRECX(A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN CHECK0(A);
PUTREC(A);CHECK0(A)
END;
IF LINES<51 THEN
BEGIN
LINES:=LINES+3;
WRITELN(LIST,STREG:86);
WRITELN(LIST,'TOTAL',' ':41,R(1):10:-2,R(2):10:-2);
WRITELN(LIST,' ':46,R(3):10:-2,R(4):10:-2);
(*TOTAL*)
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END
END
END;
PROCEDURE VÆLGLIST;
BEGIN
CASE OPTION OF
1:FORKALKULATION;
2:RUTEKORT;
3:PRODUKTIONSORDRE;
4:EMNELIST;
5:FORMLIST;
6:ORDRLIST;
7:KUNOLIST;
8:ORDRESTATUS;
9:RESOMSÆT;
10:RÅVOMSÆT;
11:EMNOMSÆT
END
END;
(*$P*)
BEGIN (*MAINTAIN*)
CLEARSCREEN;
REPEAT
GOTOXY(1,10);
WRITELN('1 Forkalkulation');
WRITELN('2 Rutekort');
WRITELN('3 Produktionsordre');
WRITELN('4 Emnespecifikation');
WRITELN('5 Formregistreringsliste');
WRITELN('6 Ordreoversigt');
WRITELN('7 Kundeordreoversigt');
WRITELN('8 Ordrestatus');
WRITELN('9 Ressource-omsætningsoversigt');
WRITELN('10 Råvare-omsætningsoversigt');
WRITELN('11 Emne-omsætningsoversigt');
D(23,1);
WRITE('Vælg 0-11 ');
READLN;
IF NOT EOLN THEN READ(OPTION)
UNTIL (IORESULT=0) AND (OPTION IN (.0..11.));
IF OPTION=0 THEN EXIT(MAINTAIN);
REPEAT
CLEARSCREEN;
IER:=0;
CASE OPTION OF
1,2,3,6,8:
BEGIN
LÆSFELT(PICTURE(2));
SKRIVFELT(PICTURE(2));
IF POST.ORDRENR=0 THEN
BEGIN
POST.TORDRE:=32000;
POST.EMNENR:=0;
POST.TEMNE:=32000
END
ELSE
BEGIN
LÆSFELT(PICTURE(1));
SKRIVFELT(PICTURE(1));
POST.TORDRE:=POST.ORDRENR;
LÆSFELT(PICTURE(7));
SKRIVFELT(PICTURE(7));
IF POST.TORDRE=0 THEN
BEGIN
POST.TORDRE:=32000;
POST.TEMNE:=32000
END
ELSE
BEGIN
POST.TEMNE:=POST.EMNENR;
LÆSFELT(PICTURE(6));
SKRIVFELT(PICTURE(6))
END
END;
POST.ANTEX:=1;
LÆSFELT(PICTURE(5));
SKRIVFELT(PICTURE(5));
IF OPTION=8 THEN
CH:=QJN('Skærmudskrift')
ELSE CH:='N';
ORDRE.NR:=POST.ORDRENR;
ORDRE.EMNENR:=POST.EMNENR;
GETREC(ORDRE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(ORDRE.A);
IF IER=-6 THEN
BEGIN
NEXTREC(ORDRE.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(ORDRE.A);
IF IER=-1 THEN IER:=0
END;
IF (CH IN NEJ) AND (OPTION=6) THEN LINES:=51;
WHILE (IER=0) AND ((ORDRE.NR<POST.TORDRE) OR ((ORDRE.NR=POST.TORDRE)
AND (ORDRE.EMNENR<=POST.TEMNE))) AND (NOT EOF(OUTPUT)) 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);CHECK0(A)
END;
IF CH IN NEJ THEN
CASE OPTION OF
1,6,8:FORMULAR(1);
2,3:FORMULAR(2)
END;
ANTEX:=POST.ANTEX;
WHILE (ANTEX>0) AND (NOT EOF(OUTPUT)) DO
BEGIN
VÆLGLIST;
ANTEX:=ANTEX-1
END;
NEXTREC(ORDRE.A)
END;
IF (CH IN NEJ) AND (OPTION=6) THEN
WHILE LINES<51 DO BEGIN WRITELN(LIST);LINES:=LINES+1 END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(ORDRE.A)
END;
4,7:BEGIN
LÆSFELT(PICTURE(3));
SKRIVFELT(PICTURE(3));
IF POST.KUNDENR=LONGNUL THEN
BEGIN
POST.TKUNDE(1):=9999;
POST.TKUNDE(2):=9999
END
ELSE
BEGIN
POST.TKUNDE:=POST.KUNDENR;
LÆSFELT(PICTURE(8));
SKRIVFELT(PICTURE(8));
IF POST.TKUNDE=LONGNUL THEN
BEGIN
POST.TKUNDE(1):=9999;
POST.TKUNDE(2):=9999
END
END;
POST.ANTEX:=1;
LÆSFELT(PICTURE(5));
SKRIVFELT(PICTURE(5));
IF OPTION=7 THEN
CH:=QJN('Skærmudskrift')
ELSE CH:='N';
KUNDE.NR:=POST.KUNDENR;
GETREC(KUNDE.A);IF NOT (-IER IN (.0,6.)) THEN ERROR(KUNDE.A);
IF IER=-6 THEN
BEGIN
NEXTREC(KUNDE.A);IF NOT (-IER IN (.1,2,9.)) THEN ERROR(KUNDE.A);
IF IER=-1 THEN IER:=0
END;
WHILE (IER=0) AND
(KUNDE.NR(1)*10000.0+KUNDE.NR(2)<=
POST.TKUNDE(1)*10000.0+POST.TKUNDE(2))
AND (NOT EOF(OUTPUT)) DO
BEGIN
IF CH IN NEJ THEN FORMULAR(1);
ANTEX:=POST.ANTEX;
WHILE (ANTEX>0) AND (NOT EOF(OUTPUT)) DO
BEGIN
VÆLGLIST;
ANTEX:=ANTEX-1
END;
NEXTREC(KUNDE.A)
END;
IF NOT (-IER IN (.0,2,9.)) THEN ERROR(KUNDE.A)
END;
5,9,10,11:
BEGIN
FORMULAR(1);
IF OPTION IN (.9..11.) THEN
CH:=QJN('Ønskes periodeafslutning med nulstilling af omsætningstal');
VÆLGLIST
END
END;
UNTIL QJN('Flere af samme slags') IN NEJ
END;
(*$P*)
BEGIN (*REGVEDL*)
LONGNUL(1):=0;
LONGNUL(2):=0;
JA:=(.'J','j'.);
NEJ:=(.'N','n'.);
JAOGNEJ:=JA+NEJ;
AKTFORM:=0;
LÆSDESC;
MODE:=3;
(*$R-*)
STREG(0):=CHR(116);
FILLCHAR(STREG(1),116,'-');
RESS.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;
ORDRE.A(-4):=0;
REGLI.A(-4):=0;
KUNEMNE.A(-4):=0;
OMVPROD.A(-4):=0;
KUNORDRE.A(-4):=0;
EMNIFORM.A(-4):=0;
UGEDAG.A(-4):=0;
ARBEDAG.A(-4):=0;
ORDTEKST.A(-4):=0;
ORDTEKST.A(-3):=25;
UGEDAG.A(-3):=21;
ARBEDAG.A(-3):=22;
RESS.A(-3):=4;
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;
ORDRE.A(-3):=10;
REGLI.A(-3):=16;
KUNEMNE.A(-3):=19;
OMVPROD.A(-3):=13;
KUNORDRE.A(-3):=18;
EMNIFORM.A(-3):=20;
(*$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(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(ORDRE.A); CHECK0(ORDRE.A);
IOPEN(REGLI.A); CHECK0(REGLI.A);
IOPEN(KUNEMNE.A); CHECK0(KUNEMNE.A);
IOPEN(OMVPROD.A); CHECK0(OMVPROD.A);
IOPEN(KUNORDRE.A); CHECK0(KUNORDRE.A);
IOPEN(EMNIFORM.A); CHECK0(EMNIFORM.A);
IOPEN(PROD.A); CHECK0(PROD.A);
IOPEN(UGEDAG.A); CHECK0(UGEDAG.A);
IOPEN(ARBEDAG.A); CHECK0(ARBEDAG.A);
IOPEN(ORDTEKST.A); CHECK0(ORDTEKST.A);
REPEAT
CLEARSCREEN;
GOTOXY(10,10);
WRITELN('U D S K R I F T S - P R O G R A M');
CH:=QJN('Flere udskrifter');
IF CH IN JA THEN
IF RESPRINT THEN
BEGIN
MAINTAIN;
FREEPR
END
UNTIL CH IN NEJ;
ICLOSE(RESS.A);
ICLOSE(KUNDE.A);
ICLOSE(EMNE.A);
ICLOSE(RÅVARE.A);
ICLOSE(OPERA.A);
ICLOSE(ORDRE.A);
ICLOSE(REGLI.A);
ICLOSE(KUNEMNE.A);
ICLOSE(OMVPROD.A);
ICLOSE(KUNORDRE.A);
ICLOSE(EMNIFORM.A);
ICLOSE(PROD.A);
ICLOSE(UGEDAG.A);
ICLOSE(ARBEDAG.A);
ICLOSE(ORDTEKST.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*)
DESCNAVN:='UDSKDESC:P2:05:J';
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.