PROGRAM BOGHOLDERIJOURNAL;(*$IISFHEAD*) KPOST=RECORD        A:AR;$        NR:ARRAY (1..23) OF INTEGER;$G (*KNR1,KNR2,ANDBETADR,K[DENR1,K[DENR2,RESTORDRE,LAND,BETAKODE,LEVKODE,GG   RENTKODE,KREDDAGE,ANTFAKT,SIDFAKD1,SIDFAKD2,EMBALLAGE,BR[KAGE,RABAT,G.   EXPORT,RFSALDO,PERTRENT,NPOSTNR1,NPOSTNR2*).N     (* NAVN,UDVNAVN,LEVADR*)NAVN:ARRAY(1..3) OF PACKED ARRAY (1..30) OF CHAR;N-        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;'# (*SALDO1-6,]RK\B,M]NK\B,SID]RK\B*)#  END;JOURPOST=RECORD       KONTONR1,KONTONR2,       DATO1,DATO2,       TEKSTKODE,       BILAG1,BILAG2,(       KGB                     :INTEGER;($       BEL\B                   :REAL$END;JOURFILE=FILE OF JOURPOST;SYSPOST=RECORDHELTAL: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;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; KZONE=RECORD        H:ISFHEAD;"        T:ARRAY(1..918) OF INTEGER"  END; VAR    FPOST,FKUN : ISF;        JOURFIL:JOURFILE;        SYSFIL:SYSFILE;        KZ:KZONE;        PZ:POSTZONE;        PPOST:POSTPOST;        KUNDE:KPOST;        FNAVN:STRING(20);        IER,I,K,LINIE,SIDE!                        :INTEGER;!        QUQ:^INTEGER;        R1:REAL;&        DKB1,DKB:ARRAY (1..5) OF REAL;&<        TEKST:ARRAY (1..10) OF PACKED ARRAY (1..15) OF CHAR;<:        KONTO:ARRAY (1..5) OF PACKED ARRAY (1..5) OF CHAR;:(*$L-*) (*$R-,IEXCOMCOP*) (*$IIOPEN*) (*$IS[T\G*) (*$IREADPROC*) (*$IFINDPOST*) (*$IFORSKYD*) (*$IICLOSE*) (*$IPUTGET*) (*$IINSERT*) (*$INEXTREC*) (*$R+*)(*$L+*) PROCEDURE ERROR; BEGIN#   WRITELN('FEJL I REGISTER ',IER);#   ICLOSE(KZ.H,FKUN);   ICLOSE(PZ.H,FPOST);   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 NEDT[L[LDSTE;BEGIN  WITH KUNDE,PPOST DO  BEGIN    HELTAL(1):=KUNDE.NR(1);    HELTAL(2):=KUNDE.NR(2);"    FOR I:=3 TO 7 DO HELTAL(I):=0;"    NEXTREC(PZ.H,FPOST,A);1    IF (IER<>-1) AND (IER<>-2) THEN ERROR;IER:=0;1A    WHILE (HELTAL(1)=NR(1)) AND (HELTAL(2)=NR(2)) AND (R1<0.0) DOA	    BEGIN	J      IF ((HELTAL(5)=1) OR (HELTAL(5)=4) OR (HELTAL(5)=9)) AND (REEL(2)>0)J
      THEN
      BEGIN        REEL(2):=REEL(2)+R1;        IF REEL(2)<=0.0 THEN        BEGIN          R1:=REEL(2);          REEL(2):=0;          IF HELTAL(5)=1 THEN          BEGIN            NR(12):=NR(12)+1;!            NR(11):=NR(11)+TRUNC(!B                  JOURFIL^.DATO1*360.0+JOURFIL^.DATO2 DIV 100*30.0B+                  +JOURFIL^.DATO2 MOD 100 -+L                  HELTAL(3)*360.0-HELTAL(4) DIV 100*30.0-HELTAL(4) MOD 100);L          END        END        ELSE R1:=0.0;        PUTREC(PZ.H,FPOST,A)	      END	      ELSE IF HELTAL(5)=10 THEN      BEGIN(        REEL(2):=REEL(2)+JOURFIL^.BEL\B;($        IF REEL(2)<0 THEN REEL(2):=0$
      END;
      NEXTREC(PZ.H,FPOST,A)    END  ENDEND;PROCEDURE PRUT;VAR I:INTEGER;    DIFFE:REAL;BEGIN DIFFE:=0.0; FOR I:=1 TO 5 DO BEGINJ   WRITELN(LIST,LINIE:5,' ':5,KONTO(I),SIDE-1:22,' ':10,DKB1(I)/100:12:2);J   LINIE:=LINIE+1;   DIFFE:=DIFFE+DKB1(I)-DKB(I) END; WRITELN(LIST);1 WRITELN(LIST,'Difference',' ':37,DIFFE/100:12:2)1END;PROCEDURE DOIT;BEGIN  LINIE:=1;%  FOR K:=1 TO SYSFIL^.HELTAL(16)-1 DO%  BEGIN    GET(JOURFIL);    WITH JOURFIL^ DO	    BEGIN	      CASE TEKSTKODE OF$      0: DKB1(KGB):=DKB1(KGB)+BEL\B;$5,6,7,9,3,4:BEGIN!           IF LINIE MOD 60=1 THEN!           BEGIN<             IF LINIE>1 THEN FOR I:=1 TO 8 DO WRITELN(LIST);<M             WRITELN(LIST,'B O G H O L D E R I J O U R N A L',' ':39,SIDE:5);M             WRITELN(LIST);L      WRITELN(LIST,'Linie',' ':5,'Tekst',' ':17,'Bilag',' ':5,'Debet',' ':7,LK                          'Bel|b',' ':4,'Kredit',SYSFIL^.HELTAL(1)*10000.0+K2                          SYSFIL^.HELTAL(2):8:-2);2             WRITELN(LIST);             SIDE:=SIDE+1           END;$           DKB(KGB):=DKB(KGB)-BEL\B;$!           KUNDE.NR(1):=KONTONR1;!!           KUNDE.NR(2):=KONTONR2;!%           GETREC(KZ.H,FKUN,KUNDE.A);%            IF IER<>0 THEN ERROR;            WITH KUNDE DO           BEGIN             R1:=BEL\B;             CASE TEKSTKODE OF       4,6,9:BEGIN.               SALDOK\B(1):=SALDOK\B(1)+BEL\B;.;               WRITELN(LIST,LINIE:5,' ':5,TEKST(TEKSTKODE),;3                       BILAG1*10000.0+BILAG2:12:-2,37                       KONTONR1*10000.0+KONTONR2:10:-2,77                       BEL\B/100:12:2,' ':4,KONTO(KGB),70                       DATO1*10000.0+DATO2:9:-2)0             END;       3,5,7:BEGIN/                SALDOK\B(6):=SALDOK\B(6)+BEL\B;/                I:=5;6                WHILE (SALDOK\B(I+1)<0.0) AND (I>0) DO6                BEGIN9                  SALDOK\B(I):=SALDOK\B(I)+SALDOK\B(I+1);9%                  SALDOK\B(I+1):=0.0;%                  I:=I-1                END;<                WRITELN(LIST,LINIE:5,' ':5,TEKST(TEKSTKODE),<D                       BILAG1*10000.0+BILAG2:12:-2,' ':5,KONTO(KGB),DF                       -BEL\B/100:12:2,KONTONR1*10000.0+KONTONR2:9:-2,F1                       DATO1*10000.0+DATO2:9:-2);1                NEDT[L[LDSTE             END             END           END;           LINIE:=LINIE+1;%           PUTREC(KZ.H,FKUN,KUNDE.A);%            IF IER<>0 THEN ERROR;            WITH PPOST DO           BEGIN!             HELTAL(1):=KONTONR1;!!             HELTAL(2):=KONTONR2;!             HELTAL(3):=DATO1;             HELTAL(4):=DATO2;"             HELTAL(5):=TEKSTKODE;"             HELTAL(6):=BILAG1;             HELTAL(7):=BILAG2;             REEL(1):=BEL\B;             REEL(2):=R1;"             INSERT(PZ.H,FPOST,A);"!             IF IER<>0 THEN ERROR!           END;         END
      END;
    END;  END;  PRUTEND;BEGIN    FNAVN:='KUNDERG:P2:0000:I';  REWRITE(FKUN,FNAVN);.  IOPEN(KZ.H,FKUN,SKRIV);IF IER<>0 THEN OFEJL;.   FNAVN:='POSTREG:P2:0000:I';  REWRITE(FPOST,FNAVN);  IOPEN(PZ.H,FPOST,SKRIV);  IF IER<>0 THEN OFEJL;  FNAVN:='SYSREG:P2:1:I';  REWRITE(SYSFIL,FNAVN);  SEEK(SYSFIL,1);  GET(SYSFIL);  SIDE:=SYSFIL^.HELTAL(19);  FNAVN:='JOURKASS:P1:30:I';  REWRITE(JOURFIL,FNAVN); 6  FOR I:=1 TO 5 DO BEGIN DKB(I):=0.0;DKB1(I):=0.0 END;6  KONTO(1):='Kasse';  KONTO(2):='Bank ';  KONTO(3):='Giro ';  KONTO(4):='Rabat';  KONTO(5):='Rente';  TEKST(3):='Indbetaling    ';  TEKST(4):='Udbetaling     ';  TEKST(5):='Kasserabat     ';  TEKST(6):='Rabat-rettelse ';  TEKST(7):='Rente-rettelse ';  TEKST(9):='Rentenota      '; 8  IF (SYSFIL^.HELTAL(16)-1>PZ.H.NREC-PZ.H.RECINUSE) THEN87     WRITELN('Der er ikke plads til flere posteringer')7  ELSE  BEGIN    SEEK(JOURFIL,1);	    DOIT;	    ICLOSE(KZ.H,FKUN);    ICLOSE(PZ.H,FPOST);    SYSFIL^.HELTAL(16):=1;    FOR I:=1 TO 5 DO-      SYSFIL^.KGB(I):=SYSFIL^.KGB(I)+DKB1(I);-    SYSFIL^.HELTAL(19):=SIDE;    SEEK(SYSFIL,1);    PUT(SYSFIL);  END;  CLOSE(JOURFIL);  CLOSE(SYSFIL);$  CHAIN('INTRE   *1','HOVSA:P1',QUQ)$END.  EC-PZ.H.RECINUSE) THEN87     WRITELN('Der er ikke plads til flere posteringer')7  ELSE  BEGIN    SEEK(JOURFIL,1);  DOIT;  ICLOSE(KZ.H,FKUN);  ICLOSE(PZ.H,FPOST);  SYSFIL^.HELTAL(16):=1;)  SYSFIL^.KGB(1):=SYSFIL^.KGB(1)+DKB1(1);))  SYSFIL^.KGB(2):=SYSFIL^.KGB(2)+DKB1(2);))  SYSFIL^.KGB(3):=SYSFIL^.KGB(3)+DKB1(3);)  SEEK(SYSFIL,1);  PUT(SYSFIL);  END;  CLOSE(JOURFIL);  CLOSE(SYSFIL);$  CHAIN('INTRE   *1','HOVSA:P1',QUQ)$END.  cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 