|
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: 7584 (0x1da0)
Types: TextFile
Notes: Mikados_K
Names: »RESTOVER.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »RESTOVER.K«
PROGRAM RESTORDREOVERSIGT;
(*$IISFHEAD*)
VPOST=RECORD
A :AR;
HELTAL:ARRAY (1..11) OF INTEGER;
(*VARENR,LVRNDØR,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,
DATSORD2,DÆKGRASÅ,ANAFTILG*)
NAVN:ARRAY (1..2) OF PACKED ARRAY(1..30) OF CHAR;
(*VARENAVN,NAVNHOSLEVERANDØR*)
REELTAL :ARRAY (1..15) OF REAL
(*PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
RESAFIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD*)
END;
OLINE = RECORD
VNR :ARRAY (1..2) OF INTEGER;
(*VNR,BESTILT*)
PRIS: REAL
END;
ORDREPOST = RECORD
A:AR;
(*
KNR1,KNR2,
NR1,NR2,
SIDE,
LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,RESTORDREKODE,RABAT*)
HEAD :ARRAY(1..12) OF INTEGER;
LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
ORDRELIN : ARRAY (1..15) OF OLINE
END;
KPOST=RECORD
A:AR;
NR:ARRAY (1..23) OF INTEGER;
NAVN: ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;
LANDSBY:PACKED ARRAY (1..20) OF CHAR;
POSTNR:PACKED ARRAY (1..25) OF CHAR;
TLF:PACKED ARRAY (1..10) OF CHAR;
SALDOKØB:ARRAY (1..9) OF REAL
END;
VZONE= RECORD
H:ISFHEAD;
T:ARRAY(1..451) OF INTEGER
END;
ORDZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..930) OF INTEGER
END;
KZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..918) OF INTEGER
END;
RORPOST=RECORD
A:AR;
(* KNR1,KNR2,
VNR,
DAT1,DAT2:INTEGER;*) HEAD:ARRAY(1..5) OF INTEGER;
ANTAL:REAL
END;
RORZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..327) OF INTEGER
END;
PROCSTAT=RECORD
NP,NROSTART:INTEGER
END;
NPFILE=FILE OF PROCSTAT;
VAR FVAR,FORD,FKUN,FROR:ISF;
VZ:VZONE;
KZ:KZONE;
OZ:ORDZONE;
RZ:RORZONE;
ORDRE:ORDREPOST;
KUNDE:KPOST;
VARE:VPOST;
RESTORD:RORPOST;
FNAVN:STRING(20);
NRPF,CF:NPFILE;
QUQ:^INTEGER;
IER,RIER,O1,O2,I:INTEGER;
NRS:ARRAY (1..10) OF INTEGER;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I REGISTER ',IER);
ICLOSE(VZ.H,FVAR);
ICLOSE(OZ.H,FORD);
ICLOSE(KZ.H,FKUN);
ICLOSE(RZ.H,FROR);
WRITELN('ICLOSE ',IER);
I:=I DIV 0
END;
PROCEDURE OFEJL;
BEGIN
GOTOXY(1,20);
WRITELN('REGISTERFEJL ',IER,' . 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;
CLEARSCREEN
END;
FUNCTION FOUND:BOOLEAN;
BEGIN
I:=1;
FOUND:=FALSE;
REPEAT
IF NRS(I)=RESTORD.HEAD(3) THEN
BEGIN
FOUND:=TRUE;
I:=11
END
ELSE
BEGIN
I:=I+1;
IF I<11 THEN IF NRS(I)=0 THEN I:=11
END
UNTIL I=11
END;
PROCEDURE DOIT;
BEGIN
WRITELN(LIST);
WRITELN(LIST,'ORDRER');
ORDRE.HEAD(1):=KUNDE.NR(1);
ORDRE.HEAD(2):=KUNDE.NR(2);
ORDRE.HEAD(3):=0;
ORDRE.HEAD(4):=0;
ORDRE.HEAD(5):=0;
NEXTREC(OZ.H,FORD,ORDRE.A);
IF (IER<>0) AND (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN ERROR;
IER:=0;
WHILE (IER=0) AND (ORDRE.HEAD(1)=KUNDE.NR(1)) AND
(ORDRE.HEAD(2)=KUNDE.NR(2)) DO
BEGIN
WRITELN(LIST,ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4):10:-2);
O1:=ORDRE.HEAD(3);O2:=ORDRE.HEAD(4);
WHILE (IER=0) AND (O1=ORDRE.HEAD(3)) AND (O2=ORDRE.HEAD(4)) DO
NEXTREC(OZ.H,FORD,ORDRE.A)
END;
IF (IER<>0) AND (IER<>-9) AND (IER<>-2) THEN ERROR;
IER:=0
END;
BEGIN
FNAVN:='PROCSTAT:P2:0:I';
(*$C-*)
REPEAT
REWRITE(NRPF,FNAVN);
SEEK(NRPF,1)
UNTIL IORESULT=0;
(*$C+*)
GET(NRPF);
NRPF^.NP:=1;
SEEK(NRPF,1);
PUT(NRPF);
REPEAT
GOTOXY(1,20);
WRITELN('Sæt plade 1 i drev 1 og tryk RETURN');
READLN;
(*$C-*)
REWRITE(CF,'C1:P1:0:J');
SEEK(CF,1)
(*$C+*)
UNTIL IORESULT=0;
CLOSE(CF);
CLOSE(NRPF);
CLEARSCREEN;
FNAVN:='REGVARE:P1:0000:I';
RESET(FVAR,FNAVN);
IOPEN(VZ.H,FVAR,LÆS);IF IER<>0 THEN OFEJL;
FNAVN:='ORDRERG:P2:0000:I';
RESET(FORD,FNAVN);
IOPEN(OZ.H,FORD,LÆS);IF IER<>0 THEN OFEJL;
FNAVN:='KUNDERG:P2:0000:I';
RESET(FKUN,FNAVN);
IOPEN(KZ.H,FKUN,LÆS);IF IER<>0 THEN OFEJL;
FNAVN:='RESTREG:P2:0000:I';
RESET(FROR,FNAVN);
IOPEN(RZ.H,FROR,LÆS);IF IER<>0 THEN OFEJL;
CLEARSCREEN;
WRITELN('RESTORDREOVERSIGT, VARENR 0 FOR STOP');
I:=1;
REPEAT
REPEAT
GOTOXY(40,1);READLN;READ(NRS(I))
UNTIL (IORESULT=0) AND ((NRS(I)=0) OR ((NRS(I)<10000) AND (NRS(I)>999)));
IF NRS(I)=0 THEN I:=11 ELSE I:=I+1
UNTIL I=11;
IF NRS(1)>0 THEN
BEGIN
WRITELN(LIST,'RESTORDREOVERSIGT');
I:=1;
REPEAT
VARE.HELTAL(1):=NRS(I);
GETREC(VZ.H,FVAR,VARE.A);
WRITE(LIST,'VARE',NRS(I):6,' ':4);
IF IER=-6 THEN WRITELN(LIST,'FINDES IKKE')
ELSE
BEGIN
IF IER<>0 THEN ERROR;
WRITELN(LIST,VARE.NAVN(1))
END;
I:=I+1;
IF I<11 THEN IF NRS(I)=0 THEN I:=11
UNTIL I=11;
RESTORD.HEAD(1):=0;
RESTORD.HEAD(2):=0;
RESTORD.HEAD(3):=0;
NEXTREC(RZ.H,FROR,RESTORD.A);
IF (IER=-1) OR (IER=-2) OR (IER=-9) THEN IER:=0 ELSE ERROR;
WRITELN(LIST);
REPEAT
WHILE (IER=0) AND (NOT FOUND) DO
NEXTREC(RZ.H,FROR,RESTORD.A);
RIER:=IER;
IF (IER=0) OR (IER=-2) OR (IER=-9) THEN IER:=0 ELSE ERROR;
IF FOUND AND (RIER<>-2) THEN
BEGIN
RESTORD.HEAD(3):=0;
NEXTREC(RZ.H,FROR,RESTORD.A);
IF (IER<>0) AND (IER<>-1) THEN ERROR;
KUNDE.NR(1):=RESTORD.HEAD(1);
KUNDE.NR(2):=RESTORD.HEAD(2);
GETREC(KZ.H,FKUN,KUNDE.A);
WRITE(LIST,'KUNDE',KUNDE.NR(1)*10000.0+KUNDE.NR(2):10:-2,' ':4);
IF IER=-6 THEN WRITELN(LIST,'FINDES IKKE')
ELSE
BEGIN
IF IER<>0 THEN ERROR;
WRITELN(LIST,KUNDE.NAVN(1));
WRITELN(LIST);
WRITELN(LIST,'RESTORDRER');
REPEAT
WRITELN(LIST,RESTORD.HEAD(3):6,' ':10,RESTORD.ANTAL:12:-2);
NEXTREC(RZ.H,FROR,RESTORD.A)
UNTIL (IER<>0) OR (RESTORD.HEAD(1)<>KUNDE.NR(1)) OR
(RESTORD.HEAD(2)<>KUNDE.NR(2));
RIER:=IER;
IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN ERROR;
DOIT
END
END;
WRITELN(LIST)
UNTIL RIER<>0;
IF RIER<>-2 THEN ERROR
END;
ICLOSE(VZ.H,FVAR);
ICLOSE(OZ.H,FORD);
ICLOSE(KZ.H,FKUN);
ICLOSE(RZ.H,FROR);
CHAIN('INTRE *1','HOVSA:P1',QUQ)
END.