PROGRAM KREDNOTAER;CONST TOPMARG=6; LMARG=9; DK=8; (*$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;
 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;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;JOURPOST=RECORD       (*KNR1,KNR2,6         FAKTNR1-2,DAT1-2*) NR:ARRAY(1..6) OF INTEGER;6       (*NETTO,         MOMS,         RABAT,         BR[KAGEFORS,         FRAGT,         EMBALLAGE,/         VARESALG   *) REEL:ARRAY(1..7) OF REAL/END;JOURFILE=FILE OF JOURPOST;SYSPOST=RECORD(*DATO1,DATO2,  UGENR,	  MAXEXC,	
  ORDRENR1-2,
  FAKTNR1-2,  KREDNTNR1-2,;  BILAGSNR1-2,JOURFILNR*) 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;
 KZONE=RECORD
        H:ISFHEAD;"        T:ARRAY(1..918) OF INTEGER"  END;BETAZONE=RECORD       H:ISFHEAD;!       T:ARRAY(1..374) OF INTEGER!END;.LANDFILE=FILE OF PACKED ARRAY (1..30) OF CHAR;. VAR    FBETA,FVAR,FKUN : ISF;        SYSFIL:SYSFILE;        LANDFIL:LANDFILE;        JOURFIL:JOURFILE;        T:TEXT;*        NAME:PACKED ARRAY (1..26) OF CHAR;*        VZ:VZONE;        BZ:BETAZONE;        KZ:KZONE;        VARE:VPOST;        KUNDE:KPOST;        BETA:BETAPOST;        FNAVN:STRING(20);"        IER,I,J,K,L,SIDE :INTEGER;"        CH:CHAR;        STRENG:STRING;        KNAVN:STRING(4);        R,R1,R2         :REAL;        QUQ:^INTEGER;(*$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(VZ.H,FVAR);   ICLOSE(KZ.H,FKUN);   ICLOSE(BZ.H,FBETA);   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;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 FINDKUND;VAR    N1,N2,FIN:INTEGER;       SVAR1:CHAR;BEGIN  REPEAT	    I:=1;	    SVAR1:='N';    CLEARSCREEN;    WRITELN('KREDIT-NOTAER');    GOTOXY(1,4);D    WRITELN('0 FOR AFSLUTNING, 1 FOR S\GNING MED NAVN, 2 FOR ALLE');D
    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) OR (R=2.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?	      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 HEAD;VAR I:INTEGER;BEGIN
WITH KUNDE DO
BEGIN  WRITELN(T,'%P');$  FOR I:=1 TO TOPMARG DO WRITELN(T);$  IF NR(3)=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(T,' ':6,NAME,' ':14)#
       END
       ELSE,         WRITE(T,' ':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(T,NAME)
       END
       ELSE         WRITELN(T,NAVN(1));4       WRITELN(T,' ':6,BETA.NAVN(2),' ':10,NAVN(2));44       WRITELN(T,' ':6,BETA.NAVN(3),' ':10,NAVN(3));44       WRITELN(T,' ':6,BETA.LANDSBY,' ':20,LANDSBY);42       WRITELN(T,' ':6,BETA.POSTNR,' ':15,POSTNR);2       IF BETA.NR(3)=DK THEN         WRITE(T,' ':46)       ELSE       BEGIN"         SEEK(LANDFIL,BETA.NR(3));"         GET(LANDFIL);'         WRITE(T,' ':6,LANDFIL^,' ':10)'       END;       IF NR(7)=DK THEN         WRITELN(T)       ELSE       BEGIN         SEEK(LANDFIL,NR(7));         GET(LANDFIL);         WRITELN(T,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(T,' ':6,NAME)
       END
       ELSE        WRITELN(T,' ':6,NAVN(1));         WRITELN(T,' ':6,NAVN(2));         WRITELN(T,' ':6,NAVN(3));         WRITELN(T,' ':6,LANDSBY);        WRITELN(T,' ':6,POSTNR);       IF NR(7)=DK THEN         WRITELN(T)       ELSE       BEGIN         SEEK(LANDFIL,NR(7));         GET(LANDFIL);"         WRITELN(T,' ':6,LANDFIL^)"
       END
  END;  WRITELN(T);WRITELN(T);'  WRITELN(T,' ':50,'Kreditnotanummer ','?            SYSFIL^.HELTAL(9)*10000.0+SYSFIL^.HELTAL(10):6:-2);?
  WRITELN(T);
  WRITELN(T,' ':74,SIDE:2);  SIDE:=SIDE+1;$  WRITE(T,NR(1)*10000.0+NR(2):9:-2);$-  WRITELN(T,' ':54,SYSFIL^.HELTAL(1)*10000.0+-*                  SYSFIL^.HELTAL(2):6:-2);*  J:=1;  WRITELN(T)ENDEND;PROCEDURE LINES;BEGIN  CLEARSCREEN;%  WRITELN('Returnering af vare (1)');%%  WRITELN('Dekort p} vare      (2)');%%  WRITELN('Generel dekort      (3)');%+  WRITELN('Indtast (1,2,3), 0 for f{rdig');+  REPEAT    GOTOXY(32,4);READLN;READ(K)*  UNTIL (IORESULT=0) AND (K>-1) AND (K<4);*  CASE K OF  0: I:=15;  1,2:
     BEGIN

       REPEAT
'         GOTOXY(1,6);WRITELN('Varenr');'         REPEAT3           GOTOXY(10,6);READLN;READ(VARE.HELTAL(1))3         UNTIL IORESULT=0;!         IF VARE.HELTAL(1)>0 THEN!         BEGIN$           GETREC(VZ.H,FVAR,VARE.A);$           IF IER=0 THEN           BEGINB             GOTOXY(20,6);WRITELN(VARE.NAVN(1),'  Rigtig vare ?');B             REPEAT+               GOTOXY(67,6);READLN;READ(CH)+<             UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR<;                                     (CH='j') OR (CH='n'));;1             IF (CH='N') OR (CH='n') THEN IER:=-61           END%           ELSE IF IER<>-6 THEN ERROR%         END         ELSE IER:=0       UNTIL IER=0;,       IF VARE.HELTAL(1)<=0 THEN I:=I-1 ELSE,       BEGIN&         GOTOXY(1,7);WRITELN('Antal');&         REPEAT&           GOTOXY(10,7);READLN;READ(L)&&         UNTIL (IORESULT=0) AND (L>0);&&         GOTOXY(20,7);WRITELN('Pris');&         REPEAT'           GOTOXY(30,7);READLN;READ(R1)')         UNTIL (IORESULT=0) AND (R1>0.0);)&         GOTOXY(1,8);WRITELN('Tekst');&         REPEAT+           GOTOXY(10,8);READLN;READ(STRENG)+"         UNTIL LENGTH(STRENG)<=60;"         WRITELN(T);"         WRITELN(T,' ':11,STRENG);"A         WRITELN(T,VARE.HELTAL(1):9,' ':2,VARE.NAVN(1),L:5,' ':5,A=                                          R1:10:2,L*R1:12:2);=         J:=J+3;         IF K=1 THEN         BEGIN.           VARE.REELTAL(4):=VARE.REELTAL(4)+L;./           VARE.REELTAL(11):=VARE.REELTAL(11)-L/
         END;
5         VARE.REELTAL(13):=VARE.REELTAL(13)-L*R1*100;5G         VARE.REELTAL(15):=VARE.REELTAL(15)-L*(R1*100-VARE.REELTAL(2));G"         PUTREC(VZ.H,FVAR,VARE.A);"         R:=R+R1*L*100
       END
	     END;	
  3: BEGIN
$       GOTOXY(1,6);WRITELN('Tekst');$
       REPEAT
)         GOTOXY(10,6);READLN;READ(STRENG))        UNTIL LENGTH(STRENG)<=45; #       GOTOXY(1,7);WRITELN('Pris');#
       REPEAT
%         GOTOXY(10,7);READLN;READ(R1)%%       UNTIL (IORESULT=0) AND (R1>0);%       WRITELN(T);1       WRITELN(T,' ':11,STRENG:45,' ':5,R1:12:2);1       J:=J+2;       R:=R+R1*100     END  ENDEND;FUNCTION RUND(R:REAL):REAL;VAR R1:REAL;BEGIN  R1:=TRUNC(R/10000.0);  R1:=R1*10000.0;  RUND:=ROUND(R-R1)+R1END;PROCEDURE BODY;BEGIN    WITH KUNDE DO	    BEGIN	      IF NR(3)=1 THEN      BEGIN        BETA.NR(1):=NR(1);        BETA.NR(2):=NR(2);!        GETREC(BZ.H,FBETA,BETA.A)!
      END;
      R:=0;      SIDE:=1;      HEAD;        FOR I:=1 TO 6 DO LINES;
      J:=J+2;
      WRITELN(T);.      WRITELN(T,' ':52,'Subtotal',R/100:13:2);.      JOURFIL^.REEL(7):=-R;      JOURFIL^.REEL(3):=0;      JOURFIL^.REEL(6):=0;#      FOR I:=J TO 23 DO WRITELN(T);#*      WRITE(T,' ':10);JOURFIL^.REEL(4):=0;*      WRITE(T,' ':20);      JOURFIL^.REEL(5):=0;      WRITE(T,R/100:21:2);3      IF (KUNDE.NR(18)=0) OR (KUNDE.NR(18)=99) THEN3      BEGIN-        R1:=RUND(R*SYSFIL^.HELTAL(14)/10000);-        WRITE(T,R1/100:10:2);        R:=R+R1	      END	
      ELSE
      BEGIN        R1:=0;        WRITE(T,' ':10)
      END;
      JOURFIL^.REEL(1):=-R;      JOURFIL^.REEL(2):=-R1;      WRITELN(T,R/100:12:2);      WRITELN(T);      WRITELN(T);      WITH JOURFIL^ DO      BEGIN        NR(1):=KUNDE.NR(1);        NR(2):=KUNDE.NR(2);!        NR(3):=SYSFIL^.HELTAL(9);!"        NR(4):=SYSFIL^.HELTAL(10);"!        NR(5):=SYSFIL^.HELTAL(1);!         NR(6):=SYSFIL^.HELTAL(2) 
      END;
      PUT(JOURFIL);/      SYSFIL^.HELTAL(10):=SYSFIL^.HELTAL(10)+1;/&      IF SYSFIL^.HELTAL(10)=10000 THEN&      BEGIN/        SYSFIL^.HELTAL(9):=SYSFIL^.HELTAL(9)+1;/        SYSFIL^.HELTAL(10):=0
      END;
/      SYSFIL^.HELTAL(13):=SYSFIL^.HELTAL(13)+1;/    END;END;BEGIN  FNAVN:='REGVARE:P1:0000:I';  REWRITE(FVAR,FNAVN);.  IOPEN(VZ.H,FVAR,SKRIV);IF IER<>0 THEN OFEJL;.
 

 
  FNAVN:='KUNDERG:P2:0000:I';  RESET(FKUN,FNAVN);,  IOPEN(KZ.H,FKUN,L[S);IF IER<>0 THEN OFEJL;,
 
  FNAVN:='SYSREG:P2:1:I';  REWRITE(SYSFIL,FNAVN);  SEEK(SYSFIL,1);  GET(SYSFIL);
 
  FNAVN:='JOURNAL:P2:30:I';  REWRITE(JOURFIL,FNAVN);#  SEEK(JOURFIL,SYSFIL^.HELTAL(13));#
 
  FNAVN:='LANDEREG:P2:0:I';  RESET(LANDFIL,FNAVN);
 
  FNAVN:='BETAREG:P2:0000:I';  REWRITE(FBETA,FNAVN);  IOPEN(BZ.H,FBETA,L[S);
 
  FNAVN:='KRETEXT:P1:10:K';  REWRITE(T,FNAVN);  REPEAT
    FINDKUND;
    IF R<>0.0 THEN BODY  UNTIL R=0.0;  SEEK(SYSFIL,1);  PUT(SYSFIL);  ICLOSE(VZ.H,FVAR);  ICLOSE(KZ.H,FKUN);  ICLOSE(BZ.H,FBETA);  CLOSE(T);&    CHAIN('INTRE   *1','HOVSA:P1',QUQ)&END.ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc