|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11232 (0x2be0)
Types: TextFile
Notes: Mikados_K
Names: »KONTUDT.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »KONTUDT.K«
PROGRAM KONTOUDTOG;
(*$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;
POSTPOST=RECORD
A:AR;
(*KNR1-2,DATO1-2,TEKSTKODE,BILAGSNR1-2*) HELTAL:ARRAY(1..7) OF INTEGER;
(*BELØB,RESTBELØB*) REEL:ARRAY (1..2) OF REAL
END;
POSTZONE=RECORD
H:ISFHEAD;
T:ARRAY (1..508) OF INTEGER
END;
SYSPOST=RECORD
HELTAL:ARRAY (1..24) OF INTEGER;
KGB:ARRAY (1..5) OF REAL;
BETADAT:PACKED ARRAY (1..13) OF CHAR;
KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR
END;
SYSFILE=FILE OF SYSPOST;
VAR FPOST,FKUN:ISF;
SYSFIL:SYSFILE;
QUQ:^INTEGER;
KZ:ZONE;
PZ:POSTZONE;
PPOST:POSTPOST;
FILNAVN2:STRING(20);
M,S,J,IER,I:INTEGER;
PTYPE:ARRAY (1..10) OF PACKED ARRAY (1..15) OF CHAR;
KNAVN:STRING(4);
KUNDE:KPOST;
NAME:PACKED ARRAY (1..26) OF CHAR;
R2,R1,R,TOTAL,TTOTAL:REAL;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$IPUTGET*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I KUNDEREG ',IER);
ICLOSE(KZ.H,FKUN);
ICLOSE(PZ.H,FPOST);
WRITELN('ICLOSE ',IER);
I:=I DIV 0
END;
PROCEDURE NANU(VAR T:STRING;VAR NU1,NU2 :INTEGER);
VAR 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('KONTOUDTOG, PR. KUNDE');
GOTOXY(1,4);
WRITELN('0 FOR AFSLUTNING, 1 FOR SØGNING MED NAVN, 2 FOR ALLE');
REPEAT
R:=-1.0;
GOTOXY(1,3);
WRITELN('INDTAST KUNDENUMMER');
GOTOXY(25,3);READLN;READ(R)
UNTIL (IORESULT=0) AND (R>=0.0) AND (R<100000.0);
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);
IF IER=-6 THEN NEXTREC(KZ.H,FKUN,KUNDE.A);
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);
KUNDE.NR(2):=TRUNC(R-KUNDE.NR(1)*10000.0);
GETREC(KZ.H,FKUN,KUNDE.A)
END;
GOTOXY(1,5);
FIN:=1;
IF IER=0 THEN
BEGIN
WRITELN('KUNDENUMMER ',KUNDE.NR(1)*10000.0+KUNDE.NR(2):8:-2);
WRITELN;
WRITELN(KUNDE.NAVN(1));
WRITELN(KUNDE.NAVN(3));
WRITELN(KUNDE.POSTNR);
WRITELN;
WRITELN('TLF: ',KUNDE.TLF);
GOTOXY(40,6);WRITELN('RIGTIG KUNDE (J/N)');
REPEAT GOTOXY(60,6);READLN;READ(SVAR1) UNTIL (IORESULT=0) AND
((SVAR1='J') OR (SVAR1='N') OR (SVAR1='n') OR (SVAR1='j'));
IF ((SVAR1='N') OR (SVAR1='n')) AND (R=1.0) THEN FIN:=0
END
ELSE
IF IER=-6 THEN
BEGIN
IER:=0;
WRITELN(' ':80);
WRITELN('KUNDEN EKSISTERER IKKE, TRYK RETURN');
READLN
END
ELSE ERROR
UNTIL FIN=1
UNTIL (SVAR1='J') OR (SVAR1='j') OR (R=0.0)
END;
PROCEDURE HEAD;
BEGIN
WITH KUNDE DO
BEGIN
CLEARSCREEN;
WRITE(NR(1)*10000.0+NR(2):5:-2);
J:=0;
REPEAT J:=J+1
UNTIL (J=4) OR (NAVN(1,J)<>' ');
IF NAVN(1,J)=' ' THEN
BEGIN
MOVELEFT(NAVN(1,5),NAME,26);
WRITE(' ':4,NAME,' ':4)
END
ELSE
WRITE(' ':4,NAVN(1));
WRITELN(' ':14,'Kontoudtog',SYSFIL^.HELTAL(1)*10000.0+
SYSFIL^.HELTAL(2):10:-2);
WRITELN;
WRITELN('Art',' ':21,'Bilagsnr',' ':12,'Dato',' ':8,'Beløb',' ':4,
'Restbeløb');
END
END;
PROCEDURE PR1;
BEGIN
WITH KUNDE DO
BEGIN
TOTAL:=SALDOKØB(3)+SALDOKØB(4)+SALDOKØB(5)+SALDOKØB(6);
WRITELN('____________________________________________________________',
'______________');
WRITELN('Total',' ':43,TTOTAL/100:13:2);
WRITELN;
WRITELN(' ':10,' 0 - 15 dage',SALDOKØB(1)/100:12:2,
' ':10,'16 - 30 dage',SALDOKØB(2)/100:12:2);
WRITELN(' ':10,'30 - 45 dage',SALDOKØB(3)/100:12:2,
' ':10,'45 - 60 dage',SALDOKØB(4)/100:12:2);
WRITELN(' ':10,'Ældre saldo1',SALDOKØB(5)/100:12:2,
' ':10,'Ældre saldo2',SALDOKØB(6)/100:12:2);
WRITELN(' ':10,'Total saldo ',(TOTAL+SALDOKØB(1)+SALDOKØB(2))/100:12:2,
' ':10,'Forfalden ',TOTAL/100:12:2);
WRITELN;
IF NR(12)=0 THEN NR(12):=1;
WRITELN('Tryk Return');READLN;
END
END;
PROCEDURE HEADP;
BEGIN
WITH KUNDE DO
BEGIN
WRITELN('Monter papir og tryk RETURN');READLN;
WRITE(LIST,NR(1)*10000.0+NR(2):5:-2);
J:=0;
REPEAT J:=J+1
UNTIL (J=4) OR (NAVN(1,J)<>' ');
IF NAVN(1,J)=' ' THEN
BEGIN
MOVELEFT(NAVN(1,5),NAME,26);
WRITE(LIST,' ':4,NAME,' ':4)
END
ELSE
WRITE(LIST,' ':4,NAVN(1));
WRITELN(LIST,' ':14,'Kontoudtog',SYSFIL^.HELTAL(1)*10000.0+
SYSFIL^.HELTAL(2):10:-2);
WRITELN(LIST);
WRITELN(LIST,'Art',' ':21,'Bilagsnr',' ':12,'Dato',' ':8,'Beløb',' ':4,
'Restbeløb');
END
END;
PROCEDURE PRKUNOPL;
BEGIN
WITH KUNDE DO
BEGIN
TOTAL:=SALDOKØB(3)+SALDOKØB(4)+SALDOKØB(5)+SALDOKØB(6);
WRITELN(LIST,'__________________________________________________',
'________________________');
WRITELN(LIST,'Total',' ':43,TTOTAL/100:13:2);
WRITELN(LIST);
WRITELN(LIST,' ':10,' 0 - 15 dage',SALDOKØB(1)/100:12:2,
' ':10,'16 - 30 dage',SALDOKØB(2)/100:12:2);
WRITELN(LIST,' ':10,'30 - 45 dage',SALDOKØB(3)/100:12:2,
' ':10,'45 - 60 dage',SALDOKØB(4)/100:12:2);
WRITELN(LIST,' ':10,'Ældre saldo1',SALDOKØB(5)/100:12:2,
' ':10,'Ældre saldo2',SALDOKØB(6)/100:12:2);
WRITELN(LIST,' ':10,'Total saldo ',(TOTAL+SALDOKØB(1)+SALDOKØB(2))/100:12:2
,' ':10,'Forfalden ',TOTAL/100:12:2);
WRITELN(LIST);
IF NR(12)=0 THEN NR(12):=1;
WRITELN(LIST);
WRITELN(LIST);
END
END;
BEGIN
FILNAVN2:='KUNDERG:P2:0000:I';
RESET(FKUN,FILNAVN2);
IOPEN(KZ.H,FKUN,LÆS);
IF IER<>0 THEN ERROR;
FILNAVN2:='POSTREG:P2:0000:I';
RESET(FPOST,FILNAVN2);
IOPEN(PZ.H,FPOST,LÆS);
IF IER<>0 THEN ERROR;
FILNAVN2:='SYSREG:P2:1:I';
RESET(SYSFIL,FILNAVN2);
SEEK(SYSFIL,1);
GET(SYSFIL);
CLOSE(SYSFIL);
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 ';
PTYPE(8) :='Overførsel ';
REPEAT
FINDKUND;
IF R<>0.0 THEN
BEGIN
GOTOXY(1,13);WRITELN('Skærmudskrift ell. liste (1/2) ?');
REPEAT
GOTOXY(37,13);READLN;READ(S)
UNTIL (IORESULT=0) AND (S>0) AND (S<3);
GOTOXY(1,14);WRITELN('Siden sidste udtog, eller alle (1/2) ?');
REPEAT
GOTOXY(40,14);READLN;READ(M)
UNTIL (IORESULT=0) AND (M>0) AND (M<3);
WITH PPOST,KUNDE DO
BEGIN
TTOTAL:=0;
HELTAL(1):=NR(1);
HELTAL(2):=NR(2);
FOR I:=3 TO 7 DO HELTAL(I):=0;
NEXTREC(PZ.H,FPOST,PPOST.A);
IF IER<>-1 THEN ERROR;IER:=0;
IF S=1 THEN HEAD ELSE HEADP;
IF M=1 THEN
WHILE (HELTAL(5)<>10) AND (IER=0) AND (HELTAL(1)=NR(1)) AND
(HELTAL(2)=NR(2)) DO NEXTREC(PZ.H,FPOST,PPOST.A);
IF (IER=0) AND (HELTAL(1)=NR(1)) AND (HELTAL(2)=NR(2)) THEN
BEGIN
REPEAT
IF HELTAL(5)=10 THEN TTOTAL:=0;
TTOTAL:=TTOTAL+REEL(2);
IF S=1 THEN
WRITELN(PTYPE(HELTAL(5)),' ':5,
HELTAL(6)*10000.0+HELTAL(7):12:-2,' ':8,
HELTAL(3)*10000.0+HELTAL(4):8:-2,REEL(1)/100:13:2,
REEL(2)/100:13:2)
ELSE
WRITELN(LIST,PTYPE(HELTAL(5)),' ':5,
HELTAL(6)*10000.0+HELTAL(7):12:-2,' ':8,
HELTAL(3)*10000.0+HELTAL(4):8:-2,REEL(1)/100:13:2,
REEL(2)/100:13:2);
NEXTREC(PZ.H,FPOST,PPOST.A)
UNTIL (IER<>0) OR (NR(1)<>HELTAL(1)) OR (NR(2)<>HELTAL(2));
IF (IER<>-2) AND (IER<>0) THEN ERROR;
END
ELSE
BEGIN
IF (IER=0) OR (IER=-2) THEN WRITELN('Ingen posteringer')
ELSE ERROR
END;
IF S=1 THEN PR1 ELSE PRKUNOPL
END
END
UNTIL R=0.0;
ICLOSE(KZ.H,FKUN);
ICLOSE(PZ.H,FPOST);
CLEARSCREEN;
WRITELN('ICLOSE ',IER);
CHAIN('INTRE *1','HOVSA:P1',QUQ)
END.