PROGRAM BESTILLING; (*$IISFHEAD*) VPOST=RECORD A:AR;( VARENR1,LVRND\R,OPRLAND,PAKENHED,(4 FORVLEVU,DATSBES1,DATSBES2,DATSORD1,DATSORD2,4! D[KGRAS],ANAFTILG:INTEGER;!8 NAVN:ARRAY(1..2) OF PACKED ARRAY (1..30) OF CHAR;8H PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,HF RAIORDRE,STASBEST,ASOLGTI],ASOLGTS],OMSI]R,OMSS]R,D[KBIDTD:REALFEND;ZONE= RECORD H:ISFHEAD;! T:ARRAY(1..451) OF INTEGER! END; LEVPOST=RECORD A:AR; NR, SBESDAT1,SBESDAT2, LAND1,LAND2:INTEGER;( KOSTPFAK:ARRAY(1..5) OF INTEGER;( ]K\B,S]K\B,SALDO:REAL;+ NAVN1:PACKED ARRAY (1..40) OF CHAR;+ NAVN2, ADR1, * ADR2:PACKED ARRAY (1..30) OF CHAR;* BETABET,8 LANDSBY1,LANDSBY2: PACKED ARRAY (1..20) OF CHAR;86 POSTNR1,POSTNR2: PACKED ARRAY (1..25) OF CHAR;60 TLF1,TLF2: PACKED ARRAY (1..10) OF CHAR;0END; LEVZONE=RECORD H:ISFHEAD;" T:ARRAY(1..382) OF INTEGER" END;SYSPOST=RECORDHELTAL:ARRAY(1..24) OF INTEGER;KGB:ARRAY (1..5) OF REAL;%BETADAT:PACKED ARRAY (1..13) OF CHAR;%1KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR1END;SYSFILE=FILE OF SYSPOST;VAR FLEV,F:ISF; CH:CHAR; VZ:ZONE; LZ:LEVZONE; LEVER:LEVPOST;FILNAVN1,FILNAVN2:STRING(20); IER,I:INTEGER; VARE:VPOST; SYSFIL:SYSFILE; KODE1,KODE2:STRING(10); R,R1:REAL; QUQ:^INTEGER; (*$L-*)(*$R-,IEXCOMCOP*)(*$IIOPEN*)(*$IS[T\G*)(*$IREADPROC*)(*$IFINDPOST*) (*$IFORSKYD*) (*$IICLOSE*)(*$IPUTGET*)(*$IINSERT*) (*$INEXTREC*) (*$IDELETE*)(*$R+*)(*$L+*)PROCEDURE STOP;VAR I:INTEGER;BEGIN I:=I DIV 0 END;PROCEDURE ERROR;BEGIN" WRITELN('FEJL I REGISTER ',IER);" ICLOSE(VZ.H,F); ICLOSE(LZ.H,FLEV); WRITELN('ICLOSE ',IER); STOPEND;BEGIN FILNAVN2:='REGVARE:P1:1137:I'; REWRITE(F,FILNAVN2); I:=IORESULT;2IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;2 IOPEN(VZ.H,F,SKRIV); FILNAVN2:='LEVERRG:P2:0000:I'; REWRITE(FLEV,FILNAVN2);. IOPEN(LZ.H,FLEV,SKRIV);IF IER<>0 THEN ERROR;. FILNAVN1:='SYSREG:P2:1:I'; REWRITE(SYSFIL,FILNAVN1); SEEK(SYSFIL,1); GET(SYSFIL);R1:=0;?WRITELN(LIST,'BESTILTE VARER',' ':44,SYSFIL^.HELTAL(1)*10000.0+?> SYSFIL^.HELTAL(2):10:-2);>WRITELN(LIST);EWRITELN(LIST,'VARENR ','VARENAVN',' ':25,'ANTAL',' ':3,'LEVERAND\R',E' ' LEVUGE',' KOSTPRIS');''IF IER<>0 THEN WRITE('IOPEN ',IER) ELSE'REPEAT CLEARSCREEN; WRITELN('VAREBESTILLINGER'); WRITELN('VARENR, 0 FOR SLUT'); REPEAT GOTOXY(20,2); READLN;READ(I) UNTIL IORESULT=0; IF I>0 THEN WITH VARE DO BEGIN VARENR1:=I; GETREC(VZ.H,F,A);/ IF IER=-6 THEN WRITELN('VAREN FINDES IKKE')/ ELSE BEGIN IF IER<>0 THEN ERROR;3 WRITELN(NAVN(1),' ':10,'RIGTIG VARE? (J/N)');3 REPEAT GOTOXY(60,3); READLN;READ(CH)4 UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N'));4 IF CH='J' THEN BEGIN WRITELN('ANTAL'); REPEAT GOTOXY(10,4); READLN;READ(R)% UNTIL (IORESULT=0) AND (R>0);% IORDRE:=IORDRE+R; STASBEST:=R;$ DATSBES1:=SYSFIL^.HELTAL(1);$$ DATSBES2:=SYSFIL^.HELTAL(2);$ WITH LEVER DO BEGIN NR:=LVRND\R; GETREC(LZ.H,FLEV,A); IF IER=-6 THEN5 WRITELN('LEVERAND\REN ER IKKE OPRETTET')5 ELSE BEGIN! IF IER<>0 THEN ERROR;! SBESDAT1:=DATSBES1; SBESDAT2:=DATSBES2; PUTREC(LZ.H,FLEV,A) END; END;* WRITELN('FORVENTET LEVERINGSUGE');* REPEAT GOTOXY(25,5); READLN;READ(FORVLEVU)> UNTIL (IORESULT=0) AND (FORVLEVU>0) AND (FORVLEVU<54);> PUTREC(VZ.H,F,A); IF IER<>0 THEN ERROR;I WRITELN(LIST,VARENR1:6,' ':2,NAVN(1),R:8:-2,' ':5,LVRND\R:8,FORVLEVU:5,I$ KOSTPRIS*R/100:14:2);$ R1:=R1+R*KOSTPRIS; END END END UNTIL I=0; WRITELN(LIST);5 WRITELN(LIST,' ':49,'SAMLET KOSTPRIS',R1/100:14:2);5 ICLOSE(VZ.H,F); ICLOSE(LZ.H,FLEV); CLEARSCREEN; WRITELN('ICLOSE ',IER);$ CHAIN('INTRE *1','HOVSA:P1',QUQ)$END.ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc