DataMuseum.dk

top - download

    Length: 4992 (0x1380)
    Types: TextFile
    Notes: Mikados_K
    Names: »RENTEBER.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »RENTEBER.K« 

Mikados K File

PROGRAM RENTEBEREGNING;
CONST  RENTE=0.022;
(*$IISFHEAD*)
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;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..918) OF INTEGER
END;
JOURPOST=RECORD
       KONTONR1,KONTONR2,
       DATO1,DATO2,
       TEKSTKODE,
       BILAG1,BILAG2,
       KGB                     :INTEGER;
       BELØB                   :REAL
END;
JOURFILE=FILE OF JOURPOST;
PROCSTAT=RECORD
       NP,NROSTART:INTEGER
END;
NPFILE=FILE OF PROCSTAT;
VAR    F:ISF;
       NRPF,CF:NPFILE;
       QUQ:^INTEGER;
       CH:CHAR;
       LOW,HIGH:REAL;
       KZ:ZONE;
       FILNAVN2:STRING(20);
    LINIE,J,IER,I:INTEGER;
    JOURFIL:JOURFILE;
      KUNDE:KPOST;
       NAME:PACKED ARRAY (1..26) OF CHAR;
 
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$IPUTGET*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I KUNDEREG ',IER);
  ICLOSE(KZ.H,F);
  WRITELN('ICLOSE ',IER);
  I:=I DIV 0
END;
PROCEDURE OFEJL;
BEGIN
  GOTOXY(1,20);
  WRITELN('REGISTERFEJL ',IER,' . SITUATIONEN ER FORSØGT REDDET.');
  WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');
  REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;
  IF I<>0 THEN ERROR;
  CLEARSCREEN
END;
FUNCTION RUND(R:REAL):REAL;
VAR R1:REAL;
BEGIN
  R1:=TRUNC(R/10000.0);
  R1:=R1*10000.0;
  RUND:=ROUND(R-R1)+R1
END;
PROCEDURE BEREGNRENTE;
VAR    R,R1:REAL;
BEGIN
  WITH KUNDE,JOURFIL^ DO
  IF KUNDE.NR(10)=1 THEN
  BEGIN
    IF NR(20)>0 THEN
    BEGIN
      NR(20):=NR(20)-1;
      IF NR(20)=0 THEN
      BEGIN
        SALDOKØB(2):=SALDOKØB(2)+NR(19)*100.0;
        NR(19):=0
      END
    END;
    R1:=RENTE*(SALDOKØB(3)+SALDOKØB(5));
    R1:=RUND(R1);
    IF R1<HIGH THEN
       IF R1<LOW THEN R1:=0.0 ELSE R1:=HIGH;
    IF CH='N' THEN
    BEGIN
    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;
    IF SALDOKØB(2)<0.0 THEN
    BEGIN
      SALDOKØB(1):=SALDOKØB(2);
      SALDOKØB(2):=0
    END;
    END;
    IF R1>0.0 THEN
    BEGIN
      KONTONR1:=NR(1);
      KONTONR2:=NR(2);
      TEKSTKODE:=9;
      KGB:=5;
      BELØB:=R1;
      PUT(JOURFIL);
      WRITELN(LIST,LINIE:5,' ':5,NAVN(1),NR(1)*10000.0+NR(2):10:-2,
                                 BELØB/100:12:2);
      LINIE:=LINIE+1
    END;
    PUTREC(KZ.H,F,KUNDE.A)
  END
END;
BEGIN
  FILNAVN2:='KUNDERG:P2:1338:I';
  REWRITE(F,FILNAVN2);
  IOPEN(KZ.H,F,SKRIV);
  IF IER<>0 THEN OFEJL;
  LINIE:=1;
  FILNAVN2:='RENTPOST:P1:50:I';
  REWRITE(JOURFIL,FILNAVN2);
  SEEK(JOURFIL,1);
  CLEARSCREEN;
  WRITELN('Sker renteberegning i forbindelse med månedsafslutning (J/N)');
  REPEAT
    GOTOXY(63,1);READLN;READ(CH)
  UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N') OR (CH='j') OR (CH='n'));
  IF CH='n' THEN CH:='N';
 
  GOTOXY(1,2);WRITELN('Rentegrænser');
  REPEAT
    GOTOXY(20,2);READLN;READ(LOW,HIGH)
  UNTIL (IORESULT=0) AND (LOW<=HIGH) AND (LOW>=0.0);
  LOW:=LOW*100.0;
  HIGH:=HIGH*100.0;
WRITELN(LIST,'R E N T E B E R E G N I N G');
WRITELN(LIST);
WRITELN(LIST,'Linie',' ':5,'Kundenavn',' ':24,'Kundenr',' ':7,'Rente');
  WITH KUNDE DO
  BEGIN
    NR(1):=0;NR(2):=0;
    I:=0;
    NEXTREC(KZ.H,F,A);
    IF IER<>-1 THEN ERROR;
    REPEAT
       BEREGNRENTE;
       I:=I+1;
       NEXTREC(KZ.H,F,A)
    UNTIL IER<>0;
  END;
  IF IER<>-2 THEN ERROR;
  JOURFIL^.TEKSTKODE:=0;
  PUT(JOURFIL);
  CLOSE(JOURFIL);
  ICLOSE(KZ.H,F);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER,I:7);
  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);
    WRITELN('Sæt plade 1 i drev 1 og tryk RETURN');
    READLN;
(*$C-*)
    REWRITE(CF,'C1:P1:0:J');
    SEEK(CF,1)
(*$C+*)
  UNTIL IORESULT=0;
  CLOSE(CF);
  CLOSE(NRPF);
  CHAIN('INTRE   *1','HOVSA:P1',QUQ)
END.