PROGRAM M]NEDSAFSLUTNING;
 
CONST  DK=8;
(*$IISFHEAD*)
KPOST=RECORD       A:AR;"       NR:ARRAY(1..23) OF INTEGER;"9       NAVN:ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;9,       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;ZONE= RECORD       H:ISFHEAD;!       T:ARRAY(1..918) OF INTEGER!END;
 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; VZONE= RECORD        H:ISFHEAD;"        T:ARRAY(1..451) OF INTEGER"  END;POSTPOST=RECORD       A:AR;M      (*KNR1-2,DATO1-2,TEKSTKODE,BILAGSNR1-2*) HELTAL:ARRAY(1..7) OF INTEGER;M3      (*BEL\B,RESTBEL\B*) REEL:ARRAY (1..2) OF REAL3END;POSTZONE=RECORD       H:ISFHEAD;"       T:ARRAY (1..508) OF INTEGER"END;.LANDFILE=FILE OF PACKED ARRAY (1..30) OF CHAR;.SYSPOST=RECORD'       HELTAL:ARRAY (1..24) OF INTEGER;'        KGB:ARRAY (1..5) OF REAL; ,       BETADAT:PACKED ARRAY (1..13) OF CHAR;,8       KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR8END;SYSFILE=FILE OF SYSPOST;BETAPOST=RECORD       A:AR;"       NR:ARRAY (1..3) OF INTEGER;"       (*KNR1,KNR2,LAND*)9       NAVN:ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;9       (*NAVN,UDVNAVN,ADR*),       LANDSBY:PACKED ARRAY (1..20) OF CHAR;,+       POSTNR:PACKED ARRAY (1..25) OF CHAR;+'       TLF:PACKED ARRAY (1..10) OF CHAR'END;BETAZONE=RECORD       H:ISFHEAD;!       T:ARRAY(1..374) OF INTEGER!END; RORPOST=RECORD
        A:AR;
 (*     KNR1,KNR2,        VNR,9        DAT1,DAT2:INTEGER;*) HEAD:ARRAY(1..5) OF INTEGER;9        ANTAL:REAL  END; RORZONE=RECORD        H:ISFHEAD;"        T:ARRAY(1..327) OF INTEGER"  END;PROCSTAT=RECORD       NP,NROSTART:INTEGEREND;NPFILE=FILE OF PROCSTAT;&VAR    FBETA,FVAR,FROR,FPOST,FKUN:ISF;&       BZ:BETAZONE;       BETA:BETAPOST;       VZ:VZONE;       VARE:VPOST;       SYSFIL:SYSFILE;       PZ:POSTZONE;       PPOST:POSTPOST;(       LINE:ARRAY (1..22) OF STRING(72);('       TEKST:ARRAY(1..4) OF STRING(72);'       RZ:RORZONE;       LANDFIL:LANDFILE;       RESTORD:RORPOST;       NRPF,CF:NPFILE;       QUQ:^INTEGER;       CH:CHAR;       KZ:ZONE;       FILNAVN2:STRING(20);       LINIE,J,IER,I:INTEGER;      KUNDE:KPOST;;       PTYPE:ARRAY (0..10) OF PACKED ARRAY (1..15) OF CHAR;;)       NAME:PACKED ARRAY (1..26) OF CHAR;)       R,TOTAL:REAL;       F:TEXT;       NOFIND:BOOLEAN;
 
(*$L-*)(*$R-,IEXCOMCOP*)(*$IS[T\G*)(*$IREADPROC*)(*$IFINDPOST*)
(*$IFORSKYD*)

(*$INEXTREC*)
(*$IDELETE*)(*$IINSERT*)(*$IIOPEN*)(*$IICLOSE*)(*$IPUTGET*)(*$R+*)(*$L+*)PROCEDURE ERROR;BEGIN"  WRITELN('FEJL I KUNDEREG ',IER);"  ICLOSE(KZ.H,FKUN);  ICLOSE(PZ.H,FPOST);  ICLOSE(RZ.H,FROR);  ICLOSE(VZ.H,FVAR);  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 HEAD(J:INTEGER);VAR I:INTEGER;BEGIN!  FOR I:=1 TO 9 DO WRITELN(LIST);!
WITH KUNDE DO
IF NOFIND THENBEGIN"  FOR I:=1 TO 11 DO WRITELN(LIST);"I  WRITELN(LIST,NR(1)*10000.0+NR(2):9:-2,' ':52,SYSFIL^.HELTAL(1)*10000.0+IH                                               SYSFIL^.HELTAL(2):10:-2);H  WRITELN(LIST)ENDELSEBEGIN  IF (NR(3)=1) AND (J=1) THEN  BEGIN                       I:=0;        REPEAT I:=I+1-        UNTIL (I=4) OR (BETA.NAVN(1,I)<>' ');-"        IF BETA.NAVN(1,I)=' ' THEN"       BEGIN*         MOVELEFT(BETA.NAVN(1,5),NAME,26);*&         WRITE(LIST,' ':6,NAME,' ':14)&
       END
       ELSE/         WRITE(LIST,' ':6,BETA.NAVN(1),' ':10);/       I:=0;       REPEAT I:=I+1'       UNTIL (I=4) OR (NAVN(1,I)<>' ');'       IF NAVN(1,I)=' ' THEN       BEGIN%         MOVELEFT(NAVN(1,5),NAME,26);%         WRITELN(LIST,NAME)
       END
       ELSE         WRITELN(LIST,NAVN(1));7       WRITELN(LIST,' ':6,BETA.NAVN(2),' ':10,NAVN(2));77       WRITELN(LIST,' ':6,BETA.NAVN(3),' ':10,NAVN(3));77       WRITELN(LIST,' ':6,BETA.LANDSBY,' ':20,LANDSBY);75       WRITELN(LIST,' ':6,BETA.POSTNR,' ':15,POSTNR);5       IF BETA.NR(3)=DK THEN         WRITE(LIST,' ':46)       ELSE       BEGIN"         SEEK(LANDFIL,BETA.NR(3));"         GET(LANDFIL);*         WRITE(LIST,' ':6,LANDFIL^,' ':10)*       END;       IF NR(7)=DK THEN         WRITELN(LIST)       ELSE       BEGIN         SEEK(LANDFIL,NR(7));         GET(LANDFIL);         WRITELN(LIST,LANDFIL^)
       END
  END  ELSE  BEGIN       I:=0;       REPEAT I:=I+1'       UNTIL (I=4) OR (NAVN(1,I)<>' ');'       IF NAVN(1,I)=' ' THEN       BEGIN%         MOVELEFT(NAVN(1,5),NAME,26);%!         WRITELN(LIST,' ':6,NAME)!
       END
       ELSE#       WRITELN(LIST,' ':6,NAVN(1));##       WRITELN(LIST,' ':6,NAVN(2));##       WRITELN(LIST,' ':6,NAVN(3));##       WRITELN(LIST,' ':6,LANDSBY);#"       WRITELN(LIST,' ':6,POSTNR);"       IF NR(7)=DK THEN         WRITELN(LIST)       ELSE       BEGIN         SEEK(LANDFIL,NR(7));         GET(LANDFIL);%         WRITELN(LIST,' ':6,LANDFIL^)%
       END
  END;!  FOR I:=1 TO 5 DO WRITELN(LIST);!I  WRITELN(LIST,NR(1)*10000.0+NR(2):9:-2,' ':52,SYSFIL^.HELTAL(1)*10000.0+IH                                               SYSFIL^.HELTAL(2):10:-2);H  WRITELN(LIST)ENDEND;PROCEDURE PRKUNOPL;BEGIN#  IF NOFIND THEN WRITELN(LIST) ELSE#  WITH KUNDE DO  BEGIN!  WRITE(LIST,SALDOK\B(7)/100:9:2,!2               (SALDOK\B(1)+SALDOK\B(2))/100:12:2,22               (SALDOK\B(3)+SALDOK\B(4))/100:12:2,23               (SALDOK\B(5)+SALDOK\B(6))/100:13:2);3  IF PPOST.REEL(1)<0.0 THEN1     WRITELN(LIST,' ':13,-PPOST.REEL(1)/100:13:2)1  ELSE*     WRITELN(LIST,PPOST.REEL(1)/100:13:2);*  END;
 
    WRITELN(LIST);    WRITELN(LIST);=    IF KUNDE.SALDOK\B(1)+KUNDE.SALDOK\B(2)+KUNDE.SALDOK\B(3)+=K       KUNDE.SALDOK\B(4)+KUNDE.SALDOK\B(5)+KUNDE.SALDOK\B(6)<>PPOST.REEL(1)KG    THEN WRITELN(LIST,'****** FEJL I KONTOUDTOG, UDSENDES IKKE ******')G    ELSE    WRITELN(LIST);END;PROCEDURE BREV;BEGIN
  HEAD(1);
0  FOR I:=1 TO 22 DO WRITELN(LIST,' ':4,LINE(I));0   FOR I:=1 TO 4 DO WRITELN(LIST) END;PROCEDURE SKRIVLIN;BEGIN  LINIE:=LINIE+1;  IF LINIE=20 THEN  BEGIN%    FOR I:=1 TO 103 DO WRITELN(LIST);%    HEAD(1);    LINIE:=1  END;  WITH PPOST DO  BEGIN0    WRITE(LIST,HELTAL(3)*10000.0+HELTAL(4):9:-2,01          HELTAL(6)*10000.0+HELTAL(7):7:-2,' ':2,1#          PTYPE(HELTAL(5)),' ':13);#     IF REEL(1)>0 THEN
     BEGIN
&       WRITELN(LIST,REEL(1)/100:13:2);&,       IF (TOTAL<0.0) AND (REEL(2)>0.0) THEN,       BEGIN          REEL(2):=REEL(2)+TOTAL;          IF REEL(2)<=0.0 THEN         BEGIN(           KUNDE.NR(12):=KUNDE.NR(12)+1;(           REEL(2):=0.0         END       END;       TOTAL:=TOTAL+REEL(1)     END	     ELSE	
     BEGIN
.       WRITELN(LIST,' ':13,-REEL(1)/100:13:2);.       REEL(2):=0.0;       TOTAL:=TOTAL+REEL(1)     END  ENDEND;PROCEDURE KONTOUDT;VAR    RENT:BOOLEAN;BEGIN  LINIE:=0;  WITH PPOST,KUNDE DO  BEGINA      WHILE (HELTAL(5)<>10) AND (IER=0) AND (HELTAL(1)=NR(1)) ANDA=            (HELTAL(2)=NR(2)) DO NEXTREC(PZ.H,FPOST,PPOST.A);=+      IF (IER<>0) AND (IER<>-2) THEN ERROR;+      TOTAL:=0.0;      RENT:=FALSE;      HEAD(1);B      IF (HELTAL(1)<>NR(1)) OR (HELTAL(2)<>NR(2)) OR (IER=-2) THENB      BEGIN        HELTAL(1):=NR(1);        HELTAL(2):=NR(2);&        FOR I:=3 TO 7 DO HELTAL(I):=0;&        HELTAL(5):=-1;$        NEXTREC(PZ.H,FPOST,PPOST.A);$$        IF IER<>-1 THEN ERROR;IER:=0$	      END	
      ELSE
      BEGIN        SKRIVLIN;#        DELETE(PZ.H,FPOST,PPOST.A);#
      END;
B      WHILE (IER=0) AND (NR(1)=HELTAL(1)) AND (NR(2)=HELTAL(2)) DOB      BEGIN'        IF HELTAL(5)=9 THEN RENT:=TRUE;'        SKRIVLIN;#        PUTREC(PZ.H,FPOST,PPOST.A);##        NEXTREC(PZ.H,FPOST,PPOST.A)#
      END;
+      IF (IER<>-2) AND (IER<>0) THEN ERROR;+G      IF NOFIND THEN REPEAT WRITELN(LIST);LINIE:=LINIE+1 UNTIL LINIE=26G
      ELSE
      BEGIN      HELTAL(1):=NR(1);      HELTAL(2):=NR(2);#      HELTAL(3):=SYSFIL^.HELTAL(1);##      HELTAL(4):=SYSFIL^.HELTAL(2);#      HELTAL(5):=10;      HELTAL(6):=0;      HELTAL(7):=0;      REEL(1):=TOTAL;      REEL(2):=REEL(1);!      INSERT(PZ.H,FPOST,PPOST.A);!      WHILE LINIE<19 DO      BEGIN        WRITELN(LIST);        LINIE:=LINIE+1
      END;
      IF RENT THEN      BEGIN#        WRITELN(LIST,' ',TEKST(3));#"        WRITELN(LIST,' ',TEKST(4))"	      END	
      ELSE
      BEGIN        WRITELN(LIST);        WRITELN(LIST)
      END;
      WRITELN(LIST);      LINIE:=LINIE+3;      PRKUNOPL;      R:=SALDOK\B(5);+      SALDOK\B(5):=SALDOK\B(6)+SALDOK\B(4);+      SALDOK\B(6):=R;      SALDOK\B(4):=SALDOK\B(3);      SALDOK\B(3):=SALDOK\B(2);      SALDOK\B(2):=SALDOK\B(1);      SALDOK\B(1):=0.0;      SALDOK\B(8):=0.0;	      END	  ENDEND;PROCEDURE RESTORDRER;  BEGIN#      RESTORD.HEAD(1):=KUNDE.NR(1);##      RESTORD.HEAD(2):=KUNDE.NR(2);#      RESTORD.HEAD(3):=-1;#      NEXTREC(RZ.H,FROR,RESTORD.A);#      LINIE:=0;      HEAD(0);A      IF (IER=-1) OR (IER=-2) OR (IER=-9) THEN IER:=0 ELSE ERROR;AL          IF (RESTORD.HEAD(1)=KUNDE.NR(1)) AND (RESTORD.HEAD(2)=KUNDE.NR(2))L          THEN          REPEAT            LINIE:=LINIE+1;            IF LINIE=22 THEN            BEGIN/              FOR I:=1 TO 101 DO WRITELN(LIST);/              HEAD(0);              LINIE:=1            END;,            VARE.HELTAL(1):=RESTORD.HEAD(3);,%            GETREC(VZ.H,FVAR,VARE.A);%1            IF (IER<>0) AND (IER<>-6) THEN ERROR;1          IF IER=0 THEN          BEGINF            WRITE(LIST,RESTORD.HEAD(3):9,' ':3,VARE.NAVN(1):30,' ':4);FD            WRITELN(LIST,RESTORD.ANTAL:6:-2,RESTORD.HEAD(4)*10000.0+DD                                             RESTORD.HEAD(5):12:-2);D
          END
          ELSE@            WRITELN(LIST,RESTORD.HEAD(3):9,' ':3,'FINDES IKKE');@(            NEXTREC(RZ.H,FROR,RESTORD.A)(=          UNTIL (IER<>0) OR (RESTORD.HEAD(1)<>KUNDE.NR(1)) OR=;                            (RESTORD.HEAD(2)<>KUNDE.NR(2));;          IF LINIE=0 THEN          BEGIN4            WRITELN(LIST,' ':12,'Ingen restordrer');4            LINIE:=1          END;C          WHILE LINIE<21 DO BEGIN WRITELN(LIST);LINIE:=LINIE+1 END;C%          WRITELN(LIST,' ',TEKST(1));%%          WRITELN(LIST,' ',TEKST(2));%)          FOR I:=1 TO 3 DO WRITELN(LIST);)=          IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN ERROR;=        END;PROCEDURE INITTEXT;BEGIN  PTYPE(0):='Fejl-postering ';  PTYPE(1):='Faktura        ';  PTYPE(2):='Kreditnota     ';  PTYPE(3):='Indbetaling    ';  PTYPE(4):='Udbetaling     ';  PTYPE(5):='Kasserabat     ';  PTYPE(6):='Rabatrettelse  ';  PTYPE(7):='Renterettelse  ';  PTYPE(9):='Rentenota      ';  PTYPE(10):='Sidste udtog   ';  TEKST(1):=K'Dette er en ny ajourf|rt liste over Deres restordrer, som leveres s}    ';K  TEKST(2):=K'snart varerne igen er p} lager. Bedes gemt til de modtager en ny.       ';K
TEKST(3):=
K'Da vi har konstateret, at De har overskredet vore betalingsbetingelser, ';K TEKST(4):=K'har vi tilladt os at debitere Dem renter jvnf. ovenst}ende.             ';K  REPEAT    CLEARSCREEN;    WRITELN('Rentetekst');    WRITELN(TEKST(3));    WRITELN(TEKST(4));    GOTOXY(1,2);EDIT(TEKST(3));    GOTOXY(1,3);EDIT(TEKST(4));    WRITELN('Restordretekst');    WRITELN(TEKST(1));    WRITELN(TEKST(2));    GOTOXY(1,5);EDIT(TEKST(1));    GOTOXY(1,6);EDIT(TEKST(2));    WRITELN('Tilfreds  (J/N)');
    REPEAT
#       GOTOXY(17,7);READLN;READ(CH)#J    UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'));J  UNTIL (CH='J') OR (CH='j');END;BEGIN  FILNAVN2:='BREV:P1:0:K';  RESET(F,FILNAVN2);  READLN(F);&  FOR I:=1 TO 22 DO READLN(F,LINE(I));&  CLOSE(F);  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:='KUNDERG:P2:1338:I';   REWRITE(FKUN,FILNAVN2);  IOPEN(KZ.H,FKUN,SKRIV);  IF IER<>0 THEN OFEJL;
 
  FILNAVN2:='LANDEREG:P2:0:I';  REWRITE(LANDFIL,FILNAVN2);
 
   FILNAVN2:='BETAREG:P2:0000:I';   RESET(FBETA,FILNAVN2);  IOPEN(BZ.H,FBETA,L[S);
 
   FILNAVN2:='REGVARE:P1:0000:I';   RESET(FVAR,FILNAVN2);,  IOPEN(VZ.H,FVAR,L[S);IF IER<>0 THEN ERROR;,   FILNAVN2:='RESTREG:P2:0000:I'; 
 
  RESET(FROR,FILNAVN2);,  IOPEN(RZ.H,FROR,L[S);IF IER<>0 THEN ERROR;,
 
   FILNAVN2:='POSTREG:P2:0000:I';   REWRITE(FPOST,FILNAVN2);  IOPEN(PZ.H,FPOST,SKRIV);  IF IER<>0 THEN ERROR;  FILNAVN2:='SYSREG:P2:1:I';  RESET(SYSFIL,FILNAVN2);  SEEK(SYSFIL,1);  GET(SYSFIL);  CLOSE(SYSFIL);  INITTEXT;&  FOR I:=1 TO 7 DO PPOST.HELTAL(I):=0;&  NEXTREC(PZ.H,FPOST,PPOST.A);  IF IER<>-1 THEN ERROR;IER:=0;  WHILE IER=0 DO  WITH PPOST,KUNDE DO  BEGIN    NOFIND:=FALSE;    NR(1):=HELTAL(1);    NR(2):=HELTAL(2);    GETREC(KZ.H,FKUN,KUNDE.A);)    IF (IER<>0) AND (IER<>-6) THEN ERROR;)3      IF IER=-6 THEN BEGIN NOFIND:=TRUE;IER:=0 END;3      IF NR(3)=1 THEN      BEGIN        BETA.NR(1):=NR(1);        BETA.NR(2):=NR(2);"        GETREC(BZ.H,FBETA,BETA.A);"C        IF IER<>0 THEN IF IER=-6 THEN BEGIN NOFIND:=TRUE;IER:=0 ENDC,                                 ELSE ERROR;,
      END;
      IF NOT NOFIND THEN      FOR I:=1 TO 6 DO      IF SALDOK\B(I)<>0.0 THEN      BEGIN      KONTOUDT;      BREV;      RESTORDRER;       PUTREC(KZ.H,FKUN,KUNDE.A);       I:=6;
      END;
!      NEXTREC(PZ.H,FPOST,PPOST.A)!  END;  IF IER<>-2 THEN ERROR;  ICLOSE(KZ.H,FKUN);  ICLOSE(PZ.H,FPOST);  CLEARSCREEN;  WRITELN('ICLOSE ',IER,I:7);$  CHAIN('INTRE   *1','HOVSA:P1',QUQ)$END.cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc