|
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: 25536 (0x63c0)
Types: TextFile
Notes: Mikados_K
Names: »PAKLISTE.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »PAKLISTE.K«
PROGRAM PAKKELISTEUDSKRIVNING;
(*$D-*)
CONST DK=8;
(*$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;
SYSPOST=RECORD
(*DATO1,DATO2,
UGENR,
MAXEXC,
ORDRENR1-2,
FAKTNR1-2,
KREDNTNR1-2,
BILAGSNR1-2,JOURFILNR,MOMS*) HELTAL: ARRAY (1..24) OF INTEGER;
KGB:ARRAY (1..5) OF REAL;
BETADAT:PACKED ARRAY (1..13) OF CHAR;
(*KIKKODE,ÆNDKODE*) KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR
END;
SYSFILE=FILE OF SYSPOST;
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;
PLUOLINE = RECORD
VNR :ARRAY (1..3) OF INTEGER;
(*VNR,LEVERET,BESTILT*)
PRIS: REAL
END;
PLUORPOST=RECORD
A:AR;
HEAD:ARRAY (1..12) OF INTEGER;
LINE:ARRAY (1..2) OF PACKED ARRAY (1..30) OF CHAR;
(*KNR1,KNR2,ONR1,ONR2,SIDE,LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,
RESTORDREKODE,RABAT*)
ORDRELIN : ARRAY (1..15) OF PLUOLINE
END;
PLUZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..1118) 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;
LANDFILE=FILE OF PACKED ARRAY (1..30) OF CHAR;
VAR FROR,FVAR,FORD,FKUN,FPLU : ISF;
VZ:VZONE;
PZ:PLUZONE;
KZ:KZONE;
OZ:ORDZONE;
RZ:RORZONE;
ORDRE:ORDREPOST;
RESTORD:RORPOST;
PLUORD:PLUORPOST;
VARE:VPOST;
KUNDE:KPOST;
SYSFIL:SYSFILE;
LANDFIL:LANDFILE;
FNAVN:STRING(20);
TOTORDRE:ARRAY (1..60) OF OLINE;
OLIN:OLINE;
KNAVN:STRING(4);
ØL,IER,I,J,EOF
:INTEGER;
R :REAL;
NOFIND:BOOLEAN;
QUQ:^INTEGER;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I REGISTER ',IER);
ICLOSE(VZ.H,FVAR);
ICLOSE(PZ.H,FPLU);
ICLOSE(OZ.H,FORD);
ICLOSE(KZ.H,FKUN);
ICLOSE(RZ.H,FROR);
WRITELN('ICLOSE ',IER);
I:=I DIV 0
END;
PROCEDURE HOVED;
VAR I:INTEGER;
NAME:PACKED ARRAY (1..26) OF CHAR;
BEGIN
ØL:=ØL MOD 72;
WHILE ØL<72 DO
BEGIN
WRITELN(LIST);
ØL:=ØL+1
END;
ØL:=23;
WRITELN(LIST,'V V EEEE N N DDD OO RRR ':53);
WRITELN(LIST,'V V E NN N D D O O R R':53);
WRITELN(LIST,'V V EE N N N D D O O RRR ':53);
WRITELN(LIST,'V V E N NN D D O O R R ':53);
WRITELN(LIST,'V EEEE N N DDD OO R R':53);
WRITELN(LIST);
WRITELN(LIST,'P A K L I S T E / F Ø L G E S E D D E L':53);
WRITELN(LIST);
WRITELN(LIST);
WRITELN(LIST,'KUNDENUMMER',PLUORD.HEAD(1)*10000.0+PLUORD.HEAD(2):7:-2,
'ORDRENUMMER':48,PLUORD.HEAD(3)*10000.0+PLUORD.HEAD(4):8:-2);
WRITELN(LIST);
IF NOFIND THEN FOR I:=1 TO 6 DO WRITELN(LIST) ELSE
BEGIN
I:=0;
REPEAT I:=I+1
UNTIL (I=4) OR (KUNDE.NAVN(1,I)<>' ');
IF KUNDE.NAVN(1,I)=' ' THEN
BEGIN
MOVELEFT(KUNDE.NAVN(1,5),NAME,26);
WRITELN(LIST,NAME)
END
ELSE
WRITELN(LIST,KUNDE.NAVN(1));
WRITELN(LIST,KUNDE.NAVN(2));
WRITELN(LIST,KUNDE.NAVN(3));
WRITELN(LIST,KUNDE.LANDSBY);
WRITELN(LIST,KUNDE.POSTNR);
IF KUNDE.NR(7)=DK THEN
WRITELN(LIST)
ELSE
BEGIN
SEEK(LANDFIL,KUNDE.NR(7));
GET(LANDFIL);
WRITELN(LIST,LANDFIL^)
END;
END;
WRITELN(LIST);WRITELN(LIST);
WRITELN(LIST,'DATO',SYSFIL^.HELTAL(1)*10000.0+SYSFIL^.HELTAL(2):8:-2,
'ORDREDATO':25,PLUORD.HEAD(7)*10000.0+PLUORD.HEAD(8):8:-2,
'LEVERINGSUGE':25,PLUORD.HEAD(6):4);
WRITELN(LIST);
WRITELN(LIST,'VNR':9,'LEV':6,'VARENAVN':11,'PRIS':32,'BESTILT':10,'REST':7);
WRITELN(LIST)
END;
PROCEDURE HOVED1;
VAR I:INTEGER;
NAME:PACKED ARRAY (1..26) OF CHAR;
BEGIN
ØL:=ØL+8;
WRITELN(LIST);
I:=0;
REPEAT I:=I+1
UNTIL (I=4) OR (KUNDE.NAVN(1,I)<>' ');
IF KUNDE.NAVN(1,I)=' ' THEN
BEGIN
MOVELEFT(KUNDE.NAVN(1,5),NAME,26);
WRITELN(LIST,'V ',NAME,' ':11,'V ',NAME)
END
ELSE
WRITELN(LIST,'V ',KUNDE.NAVN(1),' ':7,'V ',KUNDE.NAVN(1));
WRITELN(LIST,'E ',KUNDE.NAVN(2),' ':7,'E ',KUNDE.NAVN(2));
WRITELN(LIST,'N ',KUNDE.NAVN(3),' ':7,'N ',KUNDE.NAVN(3));
WRITELN(LIST,'D ',KUNDE.LANDSBY,' ':17,'D ',KUNDE.LANDSBY);
WRITELN(LIST,'O ',KUNDE.POSTNR,' ':12,'O ',KUNDE.POSTNR);
IF KUNDE.NR(7)=DK THEN
WRITELN(LIST,'R',' ':40,'R')
ELSE
BEGIN
SEEK(LANDFIL,KUNDE.NR(7));
GET(LANDFIL);
WRITELN(LIST,'R ',LANDFIL^,' ':7,'R ',LANDFIL^)
END;
WRITELN(LIST,' nyhavn 43 dk-1051 copenhagen',' ':12,
' nyhavn 43 dk-1051 copenhagen')
END;
PROCEDURE PAKLIST;
VAR ALI,K,L:INTEGER;
SLUT:BOOLEAN;
REST,LEV:REAL;
PROCEDURE BUND;
BEGIN
ØL:=ØL+10;
WRITELN(LIST);WRITELN(LIST);WRITELN(LIST);
WRITE(LIST,'VARERNE FREMTAGET AF:');
IF KUNDE.NR(8)=1 THEN WRITELN(LIST,' ':30,'E F T E R K R A V');
IF KUNDE.NR(8)=2 THEN WRITELN(LIST,' ':30,'K O N T A N T');
IF (KUNDE.NR(8)<>1) AND (KUNDE.NR(8)<>2) THEN WRITELN(LIST);
WRITELN(LIST);
WRITELN(LIST,'SENDT PR',':':13,' ':25,PLUORD.LINE(1));
WRITELN(LIST,' ':46,PLUORD.LINE(2));
WRITELN(LIST,'ANTAL KOLLI',':':10);
WRITELN(LIST);
WRITELN(LIST,'VÆGT',':':17);
END;
PROCEDURE INDREST;
BEGIN
RESTORD.HEAD(1):=KUNDE.NR(1);
RESTORD.HEAD(2):=KUNDE.NR(2);
RESTORD.HEAD(3):=0;
ALI:=ALI+1;
TOTORDRE(ALI).VNR(1):=1;
TOTORDRE(ALI+1).VNR(1):=0;
NEXTREC(RZ.H,FROR,RESTORD.A);
IF IER=-1 THEN IER:=0;
WHILE IER=0 DO
BEGIN
IF (RESTORD.HEAD(1)<>KUNDE.NR(1)) OR (RESTORD.HEAD(2)<>KUNDE.NR(2))
THEN IER:=-2;
IF IER=0 THEN
BEGIN
VARE.HELTAL(1):=RESTORD.HEAD(3);
GETREC(VZ.H,FVAR,VARE.A);
IF (IER=0) AND (VARE.REELTAL(4)>0.0) THEN
BEGIN
ALI:=ALI+1;
TOTORDRE(ALI).VNR(1):=VARE.HELTAL(1);
IF RESTORD.ANTAL>32000.0 THEN
BEGIN
RESTORD.ANTAL:=RESTORD.ANTAL-32000.0;
PUTREC(RZ.H,FROR,RESTORD.A);
NEXTREC(RZ.H,FROR,RESTORD.A);
TOTORDRE(ALI).VNR(2):=32000
END
ELSE
BEGIN
K:=TRUNC(RESTORD.ANTAL);
TOTORDRE(ALI).VNR(2):=K;
DELETE(RZ.H,FROR,RESTORD.A)
END;
IF ALI=60 THEN IER:=-2;
TOTORDRE(ALI).PRIS:=VARE.REELTAL(1)
END
ELSE BEGIN IF (IER<>0) AND (IER<>-6) THEN ERROR;
NEXTREC(RZ.H,FROR,RESTORD.A)
END
END
END;
IF (IER<>-2) AND (IER<>-9) THEN ERROR
END;
BEGIN
FOR J:=1 TO 12 DO PLUORD.HEAD(J):=ORDRE.HEAD(J);
PLUORD.LINE(1):=ORDRE.LINE(1);
PLUORD.LINE(2):=ORDRE.LINE(2);
K:=0;
REPEAT
FOR J:=1 TO 15 DO
BEGIN
TOTORDRE(K*15+J):=ORDRE.ORDRELIN(J);
IF TOTORDRE(K*15+J).VNR(1)<>0 THEN ALI:=K*15+J
END;
K:=K+1;
SLUT:=ORDRE.HEAD(5)=99;
DELETE(OZ.H,FORD,ORDRE.A);
EOF:=IER;
IF ((IER<>0) AND (IER<>-2) AND (IER<>-1)) THEN ERROR
UNTIL SLUT;
FOR J:=1 TO ALI DO
BEGIN
K:=J;
FOR L:=J+1 TO ALI DO
IF TOTORDRE(L).VNR(1)<TOTORDRE(K).VNR(1) THEN K:=L;
IF K<>J THEN
BEGIN
OLIN:=TOTORDRE(J);
TOTORDRE(J):=TOTORDRE(K);
TOTORDRE(K):=OLIN
END
END;
IF ALI<59 THEN
INDREST;
K:=0;
PLUORD.HEAD(5):=1;
FOR J:=1 TO ALI DO
WITH TOTORDRE(J) DO
IF VNR(1)<>1 THEN
BEGIN
VARE.HELTAL(1):=VNR(1);
GETREC(VZ.H,FVAR,VARE.A);
IF (IER<>-6) AND (IER<>0) THEN ERROR;
IF IER=-6 THEN WRITELN(LIST,VNR(1):9,' ':5,'FINDES IKKE')
ELSE
BEGIN
K:=K+1;
IF K>15 THEN
BEGIN
K:=1;
IF NOT NOFIND THEN
INSERT(PZ.H,FPLU,PLUORD.A);
PLUORD.HEAD(5):=PLUORD.HEAD(5)+1;
IF IER<>0 THEN ERROR
END;
IF K=1 THEN HOVED;
REST:=VNR(2)-VARE.REELTAL(4);
IF REST>0 THEN
BEGIN
VARE.REELTAL(4):=0;
VARE.REELTAL(7):=0
END
ELSE
BEGIN
REST:=0;
VARE.REELTAL(4):=VARE.REELTAL(4)-VNR(2);
IF VARE.REELTAL(7)>=VNR(2) THEN
VARE.REELTAL(7):=VARE.REELTAL(7)-VNR(2)
ELSE
BEGIN
VARE.REELTAL(9):=VARE.REELTAL(9)-VNR(2)+VARE.REELTAL(7);
VARE.REELTAL(7):=0
END
END;
LEV:=VNR(2)-REST;
WRITELN(LIST,' ':3,VNR(1):6,LEV:6:-2,' ':3,VARE.NAVN(1),
VARE.REELTAL(1)/100:10:2,VNR(2):10,REST:7:-2);
PLUORD.ORDRELIN(K).VNR(1):=VNR(1);
PLUORD.ORDRELIN(K).VNR(2):=TRUNC(LEV);
PLUORD.ORDRELIN(K).VNR(3):=VNR(2);
PLUORD.ORDRELIN(K).PRIS:=PRIS;
IF NOT NOFIND THEN
PUTREC(VZ.H,FVAR,VARE.A)
END;
WRITELN(LIST);
ØL:=ØL+2;
END
ELSE
IF VNR(1)=1 THEN
IF TOTORDRE(J+1).VNR(1)>0 THEN
BEGIN
WRITELN(LIST,' ':18,'Restordrer');
WRITELN(LIST);
ØL:=ØL+2;
K:=K+1;
IF K>15 THEN
BEGIN
K:=1;
IF NOT NOFIND THEN
INSERT(PZ.H,FPLU,PLUORD.A);
PLUORD.HEAD(5):=PLUORD.HEAD(5)+1;
IF IER<>0 THEN ERROR
END;
IF K=1 THEN HOVED;
PLUORD.ORDRELIN(K).VNR(1):=1;
END;
FOR J:=K+1 TO 15 DO PLUORD.ORDRELIN(J).VNR(1):=0;
PLUORD.HEAD(5):=99;
IF K>8 THEN BEGIN HOVED;K:=0 END;
BUND;
K:=K+5;
FOR J:=K+1 TO 15 DO BEGIN WRITELN(LIST);ØL:=ØL+2;
WRITELN(LIST) END;
IF NOT NOFIND THEN
BEGIN
HOVED1;
INSERT(PZ.H,FPLU,PLUORD.A)
END;
IF IER<>0 THEN ERROR
END;
PROCEDURE NANU(VAR T:STRING;VAR NU1,NU2 :INTEGER);
VAR I:INTEGER;
R:REAL;
BEGIN
R:=0.0;
FOR I:=1 TO 4 DO R:=R*29+ORD(T(I));
I:=TRUNC(R/89998.0);
R:=R-I*89998.0+10001;
NU1:=TRUNC(R/10000);
NU2:=TRUNC(R-NU1*10000.0)
END;
PROCEDURE FINDKUND;
VAR N1,N2,FIN:INTEGER;
SVAR1:CHAR;
R1,R2:REAL;
BEGIN
REPEAT
I:=1;
SVAR1:='N';
CLEARSCREEN;
WRITELN('PAKKELISTEUDSKRIVNING');
GOTOXY(1,4);
WRITELN('0 FOR AFSLUTNING, 1 FOR SØGNING MED NAVN');
REPEAT
R:=-1.0;
GOTOXY(1,3);
WRITELN('INDTAST KUNDENUMMER');
GOTOXY(25,3);READLN;READ(R)
UNTIL (IORESULT=0) AND (R>=0.0) AND (R<100000.0);
IF R=0.0 THEN EXIT(FINDKUND);
REPEAT
IF R=1.0 THEN
IF I=1 THEN
BEGIN
GOTOXY(1,4);
WRITELN('INDTAST KUNDENAVN',' ':60);
REPEAT
GOTOXY(20,4);
READLN;READ(KNAVN)
UNTIL LENGTH(KNAVN)=4;
NANU(KNAVN,N1,N2);
KUNDE.NR(1):=N1;
KUNDE.NR(2):=N2;
R1:=N1*10000.0+N2;
GETREC(KZ.H,FKUN,KUNDE.A);
IF IER=-6 THEN NEXTREC(KZ.H,FKUN,KUNDE.A);
IF (IER=-9) OR (IER=-2) OR (IER=-1) THEN IER:=0;
I:=0
END
ELSE
BEGIN
NEXTREC(KZ.H,FKUN,KUNDE.A);
IF (IER=-9) OR (IER=-2) OR (IER=-1) THEN IER:=0;
R2:=KUNDE.NR(1)*10000.0+KUNDE.NR(2);
IF (R2-R1>SYSFIL^.HELTAL(4)) OR (R2<R1) THEN IER:=-6;
END
ELSE
BEGIN
KUNDE.NR(1):=TRUNC(R/10000.0);
KUNDE.NR(2):=TRUNC(R-KUNDE.NR(1)*10000.0);
GETREC(KZ.H,FKUN,KUNDE.A)
END;
GOTOXY(1,5);
FIN:=1;
IF IER=0 THEN
BEGIN
WRITELN('KUNDENUMMER ',KUNDE.NR(1)*10000.0+KUNDE.NR(2):8:-2);
WRITELN;
WRITELN(KUNDE.NAVN(1));
WRITELN(KUNDE.NAVN(3));
WRITELN(KUNDE.POSTNR);
WRITELN;
WRITELN('TLF: ',KUNDE.TLF);
GOTOXY(40,6);WRITELN('RIGTIG KUNDE (J/N)');
REPEAT GOTOXY(60,6);READLN;READ(SVAR1) UNTIL (IORESULT=0) AND
((SVAR1='J') OR (SVAR1='N') OR (SVAR1='j') OR (SVAR1='n'));
IF ((SVAR1='N') OR (SVAR1='n')) AND (R=1.0) THEN FIN:=0
END
ELSE
IF IER=-6 THEN
BEGIN
IER:=0;
WRITELN(' ':80);
WRITELN('KUNDEN EKSISTERER IKKE, TRYK RETURN');
READLN
END
ELSE ERROR
UNTIL FIN=1
UNTIL (SVAR1='J') OR (R=0.0) OR (SVAR1='j')
END;
PROCEDURE FINDORDR;
VAR SVAR1:CHAR;
R1:REAL;
BEGIN
CLEARSCREEN;
WRITELN('INDTAST ORDRENR, 1 FOR OVERSIGT OVER KUNDENS ORDRER, 0 FOR STOP');
REPEAT
GOTOXY(65,1);READLN;READ(R)
UNTIL (IORESULT=0) AND (R<1000000.0) AND (R>=0);
IF R=0.0 THEN EXIT(FINDORDR);
WITH ORDRE DO
BEGIN
HEAD(1):=KUNDE.NR(1);
HEAD(2):=KUNDE.NR(2);
IF R>1 THEN
BEGIN
HEAD(3):=TRUNC(R/10000);
HEAD(4):=TRUNC(R-HEAD(3)*10000.0);
HEAD(5):=0;
NEXTREC(OZ.H,FORD,A);
IF (IER=-1) OR (IER=-2) OR (IER=-9) THEN IER:=0;
IF IER<>0 THEN ERROR;
IF (HEAD(3)*10000.0+HEAD(4)<>R) OR (HEAD(1)<>KUNDE.NR(1)) OR
(HEAD(2)<>KUNDE.NR(2)) THEN
BEGIN
WRITELN('ORDREN FINDES IKKE, TRYK RETURN');
READLN;
R:=-1
END ELSE R:=-2
END
ELSE
BEGIN
HEAD(3):=0;HEAD(4):=0;HEAD(5):=0;
R1:=0;
REPEAT
NEXTREC(OZ.H,FORD,A);
IF (IER=-1) OR (IER=-2) OR (IER=-9) THEN IER:=0;
IF IER<>0 THEN ERROR;
IF (HEAD(1)<>KUNDE.NR(1)) OR (HEAD(2)<>KUNDE.NR(2)) THEN
BEGIN
WRITELN('KUNDEN HAR IKKE FLERE ORDRER I SYSTEMET, TRYK RETURN');
READLN;R:=-1
END
ELSE
IF R1<>HEAD(3)*10000.0+HEAD(4) THEN
BEGIN
R1:=HEAD(3)*10000.0+HEAD(4);
GOTOXY(1,3);
WRITELN('ORDRENR:',R1:10:-2,' RIGTIGT (J/N)');
REPEAT
GOTOXY(40,3);
READLN;READ(SVAR1)
UNTIL (IORESULT=0) AND ((SVAR1='J') OR (SVAR1='N')
OR (SVAR1='j') OR (SVAR1='n'));
IF (SVAR1='J') OR (SVAR1='j') THEN R:=-2
END
UNTIL R<0;
END
END
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;
BEGIN
CLEARSCREEN;
FNAVN:='REGVARE:P1:0000:I';
REWRITE(FVAR,FNAVN);
IOPEN(VZ.H,FVAR,SKRIV);IF IER<>0 THEN OFEJL;
FNAVN:='ORDRERG:P2:0000:I';
REWRITE(FORD,FNAVN);
IOPEN(OZ.H,FORD,SKRIV);IF IER<>0 THEN OFEJL;
FNAVN:='PLUOR:P2:0000:I';
REWRITE(FPLU,FNAVN);
IOPEN(PZ.H,FPLU,SKRIV);IF IER<>0 THEN OFEJL;
FNAVN:='SYSREG:P2:1:I';
RESET(SYSFIL,FNAVN);
SEEK(SYSFIL,1);
GET(SYSFIL);
FNAVN:='KUNDERG:P2:0000:I';
RESET(FKUN,FNAVN);
IOPEN(KZ.H,FKUN,LÆS);IF IER<>0 THEN OFEJL;
FNAVN:='RESTREG:P2:0000:I';
REWRITE(FROR,FNAVN);
IOPEN(RZ.H,FROR,SKRIV);IF IER<>0 THEN OFEJL;
FNAVN:='LANDEREG:P2:0:I';
RESET(LANDFIL,FNAVN);
WRITELN('Pakkelistesider aktuelt :',PZ.H.RECINUSE:6,' Maksimalt :',
PZ.H.NREC:6);
DELAY(1000);
ØL:=0;
REPEAT
CLEARSCREEN;
WRITELN('PAKKELISTEUDSKRIVNING');
WRITELN('UGENR (0), ENKELTORDRE (1), STOP (2)');
REPEAT GOTOXY(40,2);READLN;READ(I)
UNTIL (IORESULT=0) AND (I>=0) AND (I<=2);
IF I=0 THEN
BEGIN
R:=1;
CLEARSCREEN;
WRITELN('LEVERINGSUGE');
REPEAT GOTOXY(15,1);READLN;READ(I)
UNTIL (IORESULT=0) AND (I>=0) AND (I<=53);
WITH ORDRE DO
BEGIN
FOR J:=1 TO 5 DO HEAD(J):=0;
NEXTREC(OZ.H,FORD,A);
IF IER<>-1 THEN ERROR ELSE IER:=0;
REPEAT
WHILE (HEAD(6)<>I) AND (HEAD(6)<>0) AND (IER=0) DO
NEXTREC(OZ.H,FORD,A);
EOF:=IER;
IF IER=0 THEN
BEGIN
NOFIND:=FALSE;
KUNDE.NR(1):=HEAD(1);
KUNDE.NR(2):=HEAD(2);
GETREC(KZ.H,FKUN,KUNDE.A);
IF (IER<>0) AND (IER<>-6) THEN ERROR;
IF IER=-6 THEN BEGIN IER:=0;NOFIND:=TRUE END;
IF PZ.H.NREC-PZ.H.RECINUSE<4 THEN
BEGIN
WRITELN('Ikke plads til flere pakkesedler');
EOF:=-2;
R:=0.0
END
ELSE
PAKLIST
END
UNTIL EOF<>0;
IF EOF<>-2 THEN ERROR;
END
END
ELSE
IF I=1 THEN
BEGIN
IF PZ.H.NREC-PZ.H.RECINUSE<4 THEN
BEGIN
WRITELN('Ikke plads til flere pakkesedler');
EOF:=-2;
R:=0.0
END
ELSE
FINDKUND;
IF R<>0.0 THEN FINDORDR;
IF R=-2 THEN PAKLIST
END
ELSE R:=0.0
UNTIL R=0.0;
ICLOSE(VZ.H,FVAR);
ICLOSE(OZ.H,FORD);
ICLOSE(PZ.H,FPLU);
ICLOSE(KZ.H,FKUN);
ICLOSE(RZ.H,FROR);
CHAIN('INTRE *1','HOVSA:P1',QUQ)
END.