PROGRAM DISPONERINGSLISTE; (*$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; 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; ZONE= RECORD  H:ISFHEAD;! T:ARRAY(1..451) OF INTEGER! END;PROCSTAT=RECORD NP,NROSTART:INTEGEREND;NPFILE=FILE OF PROCSTAT;VAR FLEV,F:ISF; NRPF,CF:NPFILE; VZ:ZONE; LZ:LEVZONE; LEVER:LEVPOST;. VARTAB:ARRAY (1..2,1..1000) OF INTEGER;. FILNAVN2:STRING(20); L,M,J,K,IER,I,II:INTEGER; MAGI:REAL; QUQ:^INTEGER; VARE:VPOST;(*$L-*)(*$R-,IEXCOMCOP*) (*$IIOPEN*) (*$IREADPROC*)(*$IFINDPOST*) (*$IICLOSE*) (*$IPUTGET*) (*$INEXTREC*) (*$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;PROCEDURE HEAD;BEGIN8 WRITELN(LIST,'D I S P O N E R I N G S - L I S T E');8 WRITELN(LIST);I WRITELN(LIST,' ':10,'Disponible;Sidste k|b: antal,dato;Magisk tal;');IH WRITELN(LIST,' ':10,'Solgt i }r;I ordre ;Disponible; Kostpris;');H WRITELN(LIST);END;PROCEDURE DOIT;BEGIN WITH VARE DO BEGIN VARENR1:=0; I:=1;  NEXTREC(VZ.H,F,A); REPEAT  VARTAB(1,I):=VARENR1; VARTAB(2,I):=LVRND\R; I:=I+1; NEXTREC(VZ.H,F,A) UNTIL IER<>0; IF IER<>-2 THEN ERROR; I:=I-1;  FOR J:=1 TO I DO BEGIN M:=J;  FOR K:=J+1 TO I DO BEGIN ' IF (VARTAB(2,K)J THEN BEGIN ? L:=VARTAB(1,M);VARTAB(1,M):=VARTAB(1,J);VARTAB(1,J):=L;?> L:=VARTAB(2,M);VARTAB(2,M):=VARTAB(2,J);VARTAB(2,J):=L> END  END; II:=I; REPEAT  CLEARSCREEN; I:=II;  GOTOXY(1,1);5 WRITELN('Leverand|rnr, 0 for alle, -1 for STOP');5 REPEAT " GOTOXY(39,1);READLN;READ(K)" UNTIL (IORESULT=0); IF K>=0 THEN BEGIN  IF K=0 THEN J:=1  ELSE BEGIN J:=0; M:=1;  WHILE M<=I DO BEGIN 8 IF J=0 THEN BEGIN IF VARTAB(2,M)=K THEN J:=M END8+ ELSE IF VARTAB(2,M)<>K THEN I:=M-1;+ M:=M+1 END  END; HEAD; ! VARTAB(2,I+1):=VARTAB(2,I)+1;! IF J>0 THEN WITH LEVER DO REPEAT  NR:=VARTAB(2,J); GETREC(LZ.H,FLEV,LEVER.A);  WRITE(LIST,NR:8); IF IER<>0 THEN" IF IER<>-6 THEN ERROR ELSE" BEGIN & WRITELN(LIST,' FINDES IKKE');& WRITELN(LIST);' WHILE NR=VARTAB(2,J) DO J:=J+1;' END ELSE BEGIN ! WRITELN(LIST,' ',NAVN1);!2 WRITELN(LIST,' ':10,ADR1,' ':10,LANDSBY1);2% WRITELN(LIST,' ':10,POSTNR1);% WRITELN(LIST);I WRITELN(LIST,' ':10,KOSTPFAK(1):10,KOSTPFAK(2):10,KOSTPFAK(3):10,I; KOSTPFAK(4):10,KOSTPFAK(5):10);; WRITELN(LIST); WHILE NR=VARTAB(2,J) DO BEGIN  VARENR1:=VARTAB(1,J); GETREC(VZ.H,F,VARE.A); L IF (PRIMOLAG+FYSLAGER)*OMSI]R<>0 THEN MAGI:=ASOLGTI]*200*D[KBIDTD/LJ ((PRIMOLAG+FYSLAGER)*OMSI]R) ELSE MAGI:=0;J7 WRITELN(LIST,' ':10,VARENR1:4,' ':5,NAVN(2));7E WRITELN(LIST,' ':10,FYSLAGER-RESAFLAG:10:-2,STASBEST:10:-2,EJ DATSBES1*10000.0+DATSBES2:10:-2,MAGI:12:-2);J- WRITELN(LIST,' ':10,ASOLGTI]:10:-2,-A IORDRE:10:-2,IORDRE-RAIORDRE:10:-2,A1 KOSTPRIS/100:12:2);1 WRITELN(LIST); J:=J+1 END;  WRITELN(LIST); END;  UNTIL J>I; END UNTIL K<0  END;END;BEGIN FILNAVN2:='PROCSTAT:P2:0:I';(*$C-*) REPEAT REWRITE(NRPF,FILNAVN2); SEEK(NRPF,1) UNTIL IORESULT=0;(*$C+*) GET(NRPF);  NRPF^.NP:=1; SEEK(NRPF,1); PUT(NRPF);  REPEAT GOTOXY(1,20);3 WRITELN('S{t plade 1 i drev 1 og tryk RETURN');3 READLN; (*$C-*) REWRITE(CF,'C1:P1:0:J'); SEEK(CF,1)(*$C+*) UNTIL IORESULT=0; CLOSE(CF);  CLOSE(NRPF); FILNAVN2:='REGVARE:P1:1137:I';  RESET(F,FILNAVN2); IOPEN(VZ.H,F,L[S);  FILNAVN2:='LEVERRG:P2:0000:I';  RESET(FLEV,FILNAVN2); IOPEN(LZ.H,FLEV,L[S); IF IER<>0 THEN ERROR;  DOIT; ICLOSE(VZ.H,F); ICLOSE(LZ.H,FLEV);$ CHAIN('INTRE *1','HOVSA:P1',QUQ)$END.cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc