PROGRAM ORDREINDDATERING; (*$IISFHEAD*)
 VPOST=RECORD
        A       :AR;(        HELTAL:ARRAY (1..11) OF INTEGER;(G (*VARENR,LVRND\R,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,G   DATSORD2,D[KGRAS],ANAFTILG*)9        NAVN:ARRAY (1..2) OF PACKED ARRAY(1..30) OF CHAR;9 (*VARENAVN,NAVNHOSLEVERAND\R*)&        REELTAL :ARRAY (1..15) OF REAL&D (*PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,DB   RESAFIORDRE,STASBEST,ASOLGTI],ASOLGTS],OMSI]R,OMSS]R,D[KBIDTD*)B  END; OLINE = RECORD%        VNR :ARRAY (1..2) OF INTEGER;%        (*VNR,BESTILT*)        PRIS: REAL  END; ORDREPOST = RECORD
        A:AR;
 (*        KNR1,KNR2,        NR1,NR2,
        SIDE,
B        LEVUGE,ORDREDATO1-2,LEVKODE,BETAKODE,RESTORDREKODE,RABAT*)B&        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;'E(*KIKKODE,[NDKODE*) KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAREEND;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;  VLIN=RECORD       VNR,ANTAL:INTEGER;       PRIS:REAL;&       NAVN:PACKED ARRAY(1:30) OF CHAR&END;      " VAR    FVAR,FORD,FKUN      : ISF;"        VZ:VZONE;        KZ:KZONE;        OZ:ORDZONE;        ORDRE:ORDREPOST;        VARE:VPOST;        KUNDE,KUNDE1:KPOST;        SYSFIL:SYSFILE;        LIN:STRING(30);        FNAVN:STRING(20);&        VARELIN:ARRAY (1..16) OF VLIN;&        KNAVN:STRING(4);        SVAR3:CHAR;        IER,I,J,K,L,ALI!                        :INTEGER;!        R,R1,R2         :REAL;        QUQ:^INTEGER;(*$L-*) (*$R-,IEXCOMCOP*) (*$IIOPEN*) (*$IS[T\G*) (*$IREADPROC*) (*$IFINDPOST*) (*$IFORSKYD*)
 (*$IICLOSE*)

 (*$IPUTGET*)

 (*$IINSERT*)
 (*$INEXTREC*)
 (*$IDELETE*)
 (*$R+*)(*$L+*) PROCEDURE ERROR; BEGIN#   WRITELN('FEJL I REGISTER ',IER);#   ICLOSE(VZ.H,FVAR);   ICLOSE(OZ.H,FORD);   ICLOSE(KZ.H,FKUN);   SEEK(SYSFIL,1);   PUT(SYSFIL);   CLOSE(SYSFIL);   WRITELN('ICLOSE ',IER);
   I:=I DIV 0
 END;PROCEDURE OFEJL;BEGIN  GOTOXY(1,20);C  WRITELN('REGISTERFEJL ',IER,' . SITUATIONEN ER FORS\GT REDDET.');C.  WRITELN('TAST 0, HVIS DER SKAL FORTS[TTES');.7  REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;7  IF I<>0 THEN ERROR;
  CLEARSCREEN
END;PROCEDURE VALI;BEGIN  WITH VARELIN(J) DO  BEGIN  REPEAT    VNR:=-1;    GOTOXY(5,5+I);    READLN;READ(VNR)"  UNTIL (IORESULT=0) AND (VNR>=0);"  IF VNR=0 THEN EXIT(VALI);  REPEAT    ANTAL:=-1;    GOTOXY(16,5+I);    READLN;READ(ANTAL)#  UNTIL (IORESULT=0) AND (ANTAL>0);#  REPEAT    GOTOXY(25,5+I);    READLN;READ(PRIS)  UNTIL (IORESULT=0);  PRIS:=PRIS*100;  GOTOXY(21,5+I);  WRITELN(PRIS/100:10:2)  ENDEND;2PROCEDURE NANU(VAR T:STRING;VAR NU1,NU2 :INTEGER);2VAR 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 LINIE;VAR R:REAL;BEGIN  GOTOXY(1,5+I);  WRITELN(I:3);  J:=I;  VALI;  IF VARELIN(I).VNR=0 THEN       I:=17  ELSE  WITH VARELIN(I) DO  BEGIN    VARE.HELTAL(1):=VNR;    GETREC(VZ.H,FVAR,VARE.A);    IF IER=0 THEN	    BEGIN	      NAVN:=VARE.NAVN(1);      GOTOXY(40,5+I);      WRITELN(NAVN);      R:=VARE.REELTAL(1);!      WHILE VARELIN(J).PRIS<>R DO!      BEGIN        GOTOXY(27,7+I);E        WRITELN('PRISEN STEMMER IKKE MED VAREREGISTRET, SOM SIGER ');E0        WRITELN(VNR:8,ANTAL:8,' ':4,R/100:10:2);0         WRITELN('INDTAST IGEN');         I:=I+3;        J:=16;
        VALI;
        I:=I-3;#        IF VNR<>VARELIN(J).VNR THEN#
        BEGIN
)          VARE.HELTAL(1):=VARELIN(J).VNR;)#          GETREC(VZ.H,FVAR,VARE.A);#          IF IER=0 THEN          BEGIN#            VARELIN(I):=VARELIN(J);#            NAVN:=VARE.NAVN(1);            R:=VARE.REELTAL(1)
          END
        END        ELSE
        BEGIN
           VARELIN(J).NAVN:=NAVN;           GOTOXY(5,5+I);/          IF VARELIN(I)=VARELIN(J) THEN R:=PRIS/)             ELSE VARELIN(I):=VARELIN(J);)        END;*        IF IER<>0 THEN R:=VARELIN(J).PRIS;*        GOTOXY(5,5+I);>        WRITELN(VNR:4,ANTAL:8,' ':4,PRIS/100:10:2,' ':9,NAVN);>        WRITELN(' ':77);        WRITELN(' ':77);        WRITELN(' ':77);        WRITELN(' ':77);
      END;
      IF IER=0 THEN      WITH VARE DO      BEGIND        IF (HELTAL(5)>ORDRE.HEAD(6)) OR (HELTAL(5)<ORDRE.HEAD(6)-30)D%            OR (ORDRE.HEAD(6)=0) THEN%
        BEGIN
-          IF REELTAL(7)+ANTAL>REELTAL(4) THEN-          BEGIN?            REELTAL(9):=REELTAL(9)+ANTAL+REELTAL(7)-REELTAL(4);?"            REELTAL(7):=REELTAL(4)"
          END
+          ELSE REELTAL(7):=REELTAL(7)+ANTAL+        END*        ELSE REELTAL(9):=REELTAL(9)+ANTAL;*!        PUTREC(VZ.H,FVAR,VARE.A);!        IF IER<>0 THEN ERROR	      END	    END;    IF IER=-6 THEN	    BEGIN	      GOTOXY(40,5+I);,      WRITELN('VARENUMMER EKSISTERER IKKE');,      I:=I-1    END    ELSE IF IER<>0 THEN ERROR  ENDEND;PROCEDURE FINDKUND;VAR    N1,N2,FIN:INTEGER;       SVAR1:CHAR;BEGIN  REPEAT	    I:=1;	    SVAR1:='N';    CLEARSCREEN;!    WRITELN('ORDREREGISTRERING');!    GOTOXY(1,4);8    WRITELN('0 FOR AFSLUTNING, 1 FOR S\GNING MED NAVN');8
    REPEAT
      R:=-1.0;      GOTOXY(1,3);%      WRITELN('INDTAST KUNDENUMMER');%!      GOTOXY(25,3);READLN;READ(R)!5    UNTIL (IORESULT=0) AND (R>=0.0) AND (R<100000.0);5!    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);$4          IF IER=-6 THEN NEXTREC(KZ.H,FKUN,KUNDE.A);4:          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);&2        KUNDE.NR(2):=TRUNC(R-KUNDE.NR(1)*10000.0);2!        GETREC(KZ.H,FKUN,KUNDE.A)!
      END;
      GOTOXY(1,5);
      FIN:=1;
      IF IER=0 THEN      BEGINE        WRITELN('KUNDENUMMER ',KUNDE.NR(1)*10000.0+KUNDE.NR(2):8:-2);E        WRITELN;        WRITELN(KUNDE.NAVN(1));        WRITELN(KUNDE.NAVN(3));        WRITELN(KUNDE.POSTNR);        WRITELN;#        WRITELN('TLF: ',KUNDE.TLF);#3        GOTOXY(40,6);WRITELN('RIGTIG KUNDE (J/N)');3F        REPEAT  GOTOXY(60,6);READLN;READ(SVAR1) UNTIL (IORESULT=0) ANDFK                ((SVAR1='J') OR (SVAR1='N') OR (SVAR1='n') OR (SVAR1='j'));K?        IF ((SVAR1='N') OR (SVAR1='n')) AND (R=1.0) THEN FIN:=0?        ELSE;               IF (KUNDE.NR(4)<>0) OR (KUNDE.NR(5)<>0) THEN;                 BEGIN1                       KUNDE1.NR(1):=KUNDE.NR(4);11                       KUNDE1.NR(2):=KUNDE.NR(5);12                       GETREC(KZ.H,FKUN,KUNDE1.A);2+                       IF IER<>0 THEN ERROR+                 END	      END	
      ELSE
      IF IER=-6 THEN      BEGIN        IER:=0;        WRITELN(' ':80);7        WRITELN('KUNDEN EKSISTERER IKKE, TRYK RETURN');7        READLN	      END	      ELSE ERROR    UNTIL FIN=1-  UNTIL (SVAR1='J') OR (SVAR1='j') OR (R=0.0)-END;PROCEDURE RETBETINGELSER;VAR J,I:INTEGER;BEGIN
WITH ORDRE DO
BEGIN  REPEAT    CLEARSCREEN;    GOTOXY(1,1);%    WRITELN('G[LDENDE BETINGELSER:');%    GOTOXY(1,4);$    WRITELN('1 LEVERING',HEAD(9):5);$%    WRITELN('2 BETALING',HEAD(10):5);%&    WRITELN('3 RESTORDRE',HEAD(11):4);&"    WRITELN('4 RABAT',HEAD(12):8);""    WRITELN('5 TEKST 1 ',LINE(1));""    WRITELN('6 TEKST 2 ',LINE(2));"
    REPEAT
      GOTOXY(1,11);$      WRITELN('[NDRING, 0 FOR NEJ');$      GOTOXY(20,11);      READLN;READ(I),    UNTIL (IORESULT=0) AND (I<7) AND (I>=0);,    IF (I>0) AND (I<5) THEN5         REPEAT GOTOXY(20,3+I);READLN;READ(HEAD(8+I))5B         UNTIL (IORESULT=0) AND (HEAD(8+I)<=99) AND (HEAD(8+I)>=0)B    ELSE    IF I>0 THEN	    BEGIN	,      FOR J:=1 TO 30 DO LIN(J):=LINE(I-4,J);,      GOTOXY(11,3+I);      EDIT(LIN:30);+      FOR J:=1 TO 30 DO LINE(I-4,J):=LIN(J)+    END  UNTIL I=0ENDEND;PROCEDURE RETSIDE;VAR SVAR1:CHAR;BEGIN  GOTOXY(1,6+ALI);WRITELN;  REPEAT    FOR I:=1 TO ALI DO    WITH VARELIN(I) DO	    BEGIN	      GOTOXY(1,5+I);?      WRITELN(I:3,VNR:5,ANTAL:8,' ':4,PRIS/100:10:2,' ':9,NAVN)?    END;
    REPEAT
      GOTOXY(1,21);,      WRITELN('Er ordresiden f{rdig (J/N)');,      GOTOXY(28,21);      READLN;READ(SVAR1)H    UNTIL (IORESULT=0) AND ((SVAR1='N') OR (SVAR1='J') OR (SVAR1='j') ORH)                            (SVAR1='n'));)K    IF ((SVAR1='J') OR (SVAR1='j')) AND (ALI=15) AND (ORDRE.HEAD(5)<4) THENK      REPEAT)        GOTOXY(30,21);WRITELN('Ny side');)(        GOTOXY(40,21);READLN;READ(SVAR3)(J      UNTIL (IORESULT=0) AND ((SVAR3='J') OR (SVAR3='N') OR (SVAR3='j') ORJ*                              (SVAR3='n'))*    ELSE SVAR3:='N';5    IF (SVAR1='J') OR (SVAR1='j') THEN EXIT(RETSIDE);57    GOTOXY(1,22);WRITELN('A: Tilf|jelse   B:Sletning');7+    REPEAT GOTOXY(35,22);READLN;READ(SVAR1)+H    UNTIL (IORESULT=0) AND ((SVAR1='A') OR (SVAR1='B') OR (SVAR1='a') ORH)                            (SVAR1='b'));)    CASE SVAR1 OF   'A','a' :IF ALI < 15 THEN      BEGIN        ALI:=ALI+1;        I:=ALI;        LINIE;.        IF (I=17) OR (I=ALI-1) THEN ALI:=ALI-1.
      END;
 'b','B':WITH VARE,ORDRE DO BEGIN         GOTOXY(1,23);        WRITELN('Linienummer');+        REPEAT GOTOXY(15,23);READLN;READ(I)+2        UNTIL (IORESULT=0) AND (I>0) AND (I<=ALI);2"        HELTAL(1):=VARELIN(I).VNR;"!        GETREC(VZ.H,FVAR,VARE.A);!        IF IER<>0 THEN ERROR;;        IF (HELTAL(5)>HEAD(6)) OR (HELTAL(5)<HEAD(6)-30) OR;           (HEAD(6)=0) THEN-          IF VARELIN(I).ANTAL>REELTAL(7) THEN-          BEGIN>           REELTAL(9):=REELTAL(9)-VARELIN(I).ANTAL+REELTAL(7);>           REELTAL(7):=0
          END
6          ELSE REELTAL(7):=REELTAL(7)-VARELIN(I).ANTAL65        ELSE REELTAL(9):=REELTAL(9)-VARELIN(I).ANTAL;5!        PUTREC(VZ.H,FVAR,VARE.A);!        IF IER<>0 THEN ERROR;6        FOR J:=I TO ALI-1 DO VARELIN(J):=VARELIN(J+1);6(        GOTOXY(1,5+ALI);WRITELN(' ':77);(        ALI:=ALI-1
      END;
    END;"  UNTIL (SVAR1='J') OR (SVAR1='j')"END;PROCEDURE L[SORD;BEGIN
WITH ORDRE DO
BEGIN     REPEAT      CLEARSCREEN;#      WRITELN('ORDREREGISTRERING');#      WRITELN;L      WRITELN(KUNDE.NAVN(1),' ':4,'Ordredato:',HEAD(7)*10000.0+HEAD(8):8:-2,L+              'Leveringsuge':20,HEAD(6):3);+      WRITELN(' ':77);=      WRITELN('  Varenummer','Antal':8,'Pris':10,'Tekst':14);=      FOR I:=1 TO 15 DO      BEGIN        ALI:=I;
        LINIE
      END;
      IF I=18 THEN ALI:=ALI-1;      RETSIDE;#      (*ORDREN TIL ORDREREGISTRET*)#      FOR I:=1 TO 15 DO      WITH ORDRELIN(I) DO      BEGIN        IF I<= ALI THEN
        BEGIN
        VNR(1):=VARELIN(I).VNR;!        VNR(2):=VARELIN(I).ANTAL;!        PRIS:=VARELIN(I).PRIS        END        ELSE VNR(1):=0
      END;
5      IF (SVAR3='N') OR (SVAR3='n') THEN HEAD(5):=99;5      INSERT(OZ.H,FORD,A);      IF IER<>0 THEN ERROR;      HEAD(5):=HEAD(5)+1&     UNTIL (SVAR3='N') OR (SVAR3='n');&ENDEND;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:='SYSREG:P2:1:I';  REWRITE(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;,(  LIN:='123456789012345678901234567890';(
 
C  WRITELN('Ordresider   aktuelt :',OZ.H.RECINUSE:6,'  Maksimalt :',C0                                   OZ.H.NREC:6);0  DELAY(1000);
 
  REPEAT%    IF OZ.H.NREC-OZ.H.RECINUSE<4 THEN%	    BEGIN	-      WRITELN('Ikke plads til flere ordrer');-      R:=0.0    END    ELSE
    FINDKUND;
    IF R<>0.0 THEN    IF KUNDE.NR(23)=1 THEN(      WRITELN('KUNDENS KONTO ER LUKKET')(    ELSE    WITH ORDRE DO	    BEGIN	      HEAD(5):=1;      HEAD(1):=KUNDE.NR(1);      HEAD(2):=KUNDE.NR(2);      HEAD(9):=KUNDE.NR(9);      HEAD(11):=KUNDE.NR(6);      FILLCHAR(LINE(1),30,' ');      FILLCHAR(LINE(2),30,' ');3       IF (KUNDE.NR(4)<>0) OR (KUNDE.NR(5)<>0) THEN3         BEGIN&               HEAD(10):=KUNDE1.NR(8);&&               HEAD(12):=KUNDE1.NR(17)&         END       ELSE         BEGIN%               HEAD(10):=KUNDE.NR(8);%%               HEAD(12):=KUNDE.NR(17)%
         END;
      REPEAT        GOTOXY(1,16);'        WRITELN('ORDREDATO (]]MMDD):');'$        GOTOXY(21,16);READLN;READ(R)$-      UNTIL (IORESULT=0) AND (R>800000.0) AND-M                            (R<=SYSFIL^.HELTAL(1)*10000.0+SYSFIL^.HELTAL(2));M      HEAD(7):=TRUNC(R/10000);(      HEAD(8):=TRUNC(R-HEAD(7)*10000.0);(
 
!      HEAD(3):=SYSFIL^.HELTAL(5);!!      HEAD(4):=SYSFIL^.HELTAL(6);!      REPEAT        GOTOXY(1,16);0        WRITELN('LEVERINGSUGE, 0 FOR OMG]ENDE');0$        GOTOXY(40,16);READLN;READ(I)$0      UNTIL (IORESULT=0) AND (I>=0) AND (I<=53);0      HEAD(6):=I;      RETBETINGELSER;     L[SORD;     WITH SYSFIL^ DO
     BEGIN
     HELTAL(6):=HELTAL(6)+1;     IF HELTAL(6)=10000 THEN
     BEGIN
       HELTAL(5):=HELTAL(5)+1;       HELTAL(6):=0	     END;		     END;	     GOTOXY(1,22);H     WRITELN('ORDRENUMMER : ',ORDRE.HEAD(3)*10000.0+ORDRE.HEAD(4):12:-2,H/             ' ':10,'TRYK RETURN N]R NOTERET');/     GOTOXY(70,22);READLN    END  UNTIL R=0.0;     ICLOSE(VZ.H,FVAR);     ICLOSE(OZ.H,FORD);     ICLOSE(KZ.H,FKUN);     SEEK(SYSFIL,1);     PUT(SYSFIL);     CLOSE(SYSFIL);'     CHAIN('INTRE   *1','HOVSA:P1',QUQ)'END.     HELTAL:ARRAY (1..11) OF INTEGER;(G (*VARENR,LVRND\R,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,G   DATSORD2,D[KGRAS],ANAFTILccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc