|
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: 12480 (0x30c0)
Types: TextFile
Notes: Mikados_K
Names: »TOLDPAP.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »TOLDPAP.K«
PROGRAM TOLDPAP;
CONST LMARG=9;TOPMARG=4;
(*$IISFHEAD*)
KPOST=RECORD
A:AR;
NR:ARRAY (1..23) OF INTEGER;
(*KNR1,KNR2,ANDBETADR,KÆDENR1,KÆDENR2,RESTORDRE,LAND,BETAKODE,LEVKODE,
RENTKODE,KREDDAGE,ANTFAKT,SIDFAKD1,SIDFAKD2,EMBALLAGE,BRÆKAGE,RABAT,
EXPORT,RFSALDO,PERTRENT,NPOSTNR1,NPOSTNR2*)
(* NAVN,UDVNAVN,LEVADR*)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;
(*SALDO1-6,ÅRKØB,MÅNKØB,SIDÅRKØB*)
END;
TOLDPAPPOST=RECORD
KNR1,KNR2,
OPRILAND,
KODE8,KODE9,
BRUTTOVÆGT,
SUPPMÆNGDE,
FAKTNR1,FAKTNR2 :INTEGER;
TRANSPORTØR,AKOLLI: PACKED ARRAY (1..30) OF CHAR;
VÆRDI,TOLDPONR: REAL; (*VÆRDI ER FAKTURABELØB NÅR OPRILAND=0, KUN
DEN SIDSTE ER =0 *)
LEVBET: PACKED ARRAY (1..16) OF CHAR (*DITTO(1)'S FØRSTE 16 TEGN *)
END;
TOLDPFILE=FILE OF TOLDPAPPOST;
SORTPOST=RECORD
OPRILAND,
SUPPMÆNGDE:INTEGER;
VÆRDI,
TOLDPNR:REAL
END;
TOLDPOPOST=RECORD
A:AR;
NR1,NR2:INTEGER;
TEKST:PACKED ARRAY (1..30) OF CHAR
END;
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;
(*KIKKODE,ÆNDKODE*) KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR
END;
SYSFILE=FILE OF SYSPOST;
KZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..918) OF INTEGER
END;
TPZONE=RECORD
H:ISFHEAD;
T:ARRAY (1..1000) OF INTEGER
END;
LANDFILE=FILE OF PACKED ARRAY (1..30) OF CHAR;
VAR FTP,FKUN : ISF;
SYSFIL:SYSFILE;
TOLDPHIL:TOLDPFILE;
LANDFIL:LANDFILE;
T,T1:TEXT;
KZ:KZONE;
TPZ:TPZONE;
KUNDE:KPOST;
TOLDPO:TOLDPOPOST;
FNAVN:STRING(20);
IER,I,J,M,K,LINE
:INTEGER;
TMÅDE,UDPSTED:ARRAY (1..20) OF PACKED ARRAY (1..30) OF CHAR;
EFLANDE:ARRAY (1..20) OF INTEGER;
LINES:ARRAY (1..60) OF SORTPOST;
HPOST:TOLDPAPPOST;
BYTPOST:SORTPOST;
QUQ:^INTEGER;
(*$L-*)
(*$R-,IIOPEN*)
(*$IEXCOMCOP*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I REGISTER ',IER);
ICLOSE(KZ.H,FKUN);
ICLOSE(TPZ.H,FTP);
WRITELN('ICLOSE ',IER);
I:=I DIV 0
END;
PROCEDURE INIT;
BEGIN
TMÅDE(1):= 'Dansk skib 11';
TMÅDE(2):= 'Udenlandsk skib 15';
TMÅDE(3):= 'Bane 20';
TMÅDE(4):= 'Post 30';
TMÅDE(5):= 'Fly 40';
TMÅDE(6):= 'Dansk bil 51';
TMÅDE(7):= 'Udenlandsk bil 55';
TMÅDE(8):= 'Anden transportmåde 90';
FOR I:=9 TO 20 DO
TMÅDE(I):= '______________________________';
UDPSTED(1):= ' 010';
UDPSTED(2):= ' 020';
UDPSTED(3):= 'Københavns havn 040';
UDPSTED(4):= 'Københavns frihavn 041';
UDPSTED(5):= 'Dragør havn 044';
UDPSTED(6):= 'Københavns lufthavn 050';
UDPSTED(7):= 'Gedser havn 593';
UDPSTED(8):= 'Padborg 650';
UDPSTED(9):= 'Rødby havn 730';
FOR I:=10 TO 20 DO
UDPSTED(I):='______________________________';
FOR I:=1 TO 9 DO EFLANDE(I):=I;
FOR I:=10 TO 20 DO EFLANDE(I):=0
END;
PROCEDURE UDFØRSELSANGIVELSE;
VAR OPLAND,NRIOPLAND:INTEGER;
KLAND:PACKED ARRAY (1..12) OF CHAR;
PROCEDURE BUND;
BEGIN
IF (LINE=I) OR (NRIOPLAND=7) OR (NRIOPLAND MOD 2=0) OR
(OPLAND<>LINES(LINE+1-LINE DIV I).OPRILAND) THEN
BEGIN
IF NRIOPLAND MOD 2=1 THEN FOR J:=1 TO 9 DO WRITELN(T);
FOR J:=1 TO 7 DO WRITELN(T);
IF HPOST.VÆRDI>700000.0 THEN
WRITELN(T,' ':LMARG+15,'1')
ELSE WRITELN(T);
IF (NRIOPLAND<7) AND (OPLAND=LINES(LINE+1-LINE DIV I).OPRILAND) AND
(LINE<I) THEN
BEGIN
WRITELN(T,' ':LMARG+33,'Tilladelse til anvendelse af A29');
WRITELN(T,' ':LMARG+33,'som supplementsangivelse')
END
ELSE BEGIN WRITELN(T);WRITELN(T) END;
FOR J:=1 TO 7 DO WRITELN(T);
WRITELN(T,' ':LMARG+32,'X');
WRITELN(T);
IF HPOST.VÆRDI>700000.0 THEN
WRITELN(T,' ':LMARG+15,'1')
ELSE
WRITELN(T,' ':LMARG+15,'0');
IF NRIOPLAND=7 THEN NRIOPLAND:=0;
FOR J:=1 TO 7 DO WRITELN(T)
END;
END;
BEGIN
KUNDE.NR(1):=HPOST.KNR1;
KUNDE.NR(2):=HPOST.KNR2;
GETREC(KZ.H,FKUN,KUNDE.A);
IF IER<>0 THEN ERROR;
SEEK(LANDFIL,KUNDE.NR(7));
GET(LANDFIL);
FOR J:=1 TO 12 DO KLAND(J):=LANDFIL^(J);
OPLAND:=0;
NRIOPLAND:=0;
FOR LINE:=1 TO I DO
BEGIN
IF (OPLAND<>LINES(LINE).OPRILAND) OR
(NRIOPLAND=7) OR
(NRIOPLAND MOD 2 = 0) THEN
BEGIN
FOR J:=1 TO TOPMARG DO WRITELN(T);
WRITELN(T,' ':LMARG+14,'587765-2 02',
SYSFIL^.HELTAL(1)*10000.0+SYSFIL^.HELTAL(2):11:-2,
' Almindelig udførsel');
WRITELN(T);
WRITELN(T,' ':LMARG,'Vendor');
WRITELN(T,' ':LMARG,'Nyhavn 43');
WRITELN(T,' ':LMARG,'1051 København K');
FOR J:=10 TO 12 DO WRITELN(T);
WRITELN(T,' ':LMARG,KUNDE.NAVN(1));
WRITELN(T,' ':LMARG,KUNDE.NAVN(3));
WRITELN(T,' ':LMARG,KUNDE.POSTNR);
WRITELN(T);
IF OPLAND<>LINES(LINE).OPRILAND THEN
BEGIN
OPLAND:=LINES(LINE).OPRILAND;
NRIOPLAND:=0;
SEEK(LANDFIL,OPLAND);
GET(LANDFIL)
END;
WRITELN(T,' ':LMARG+50,KLAND,KUNDE.NR(7):4);
WRITELN(T,' ':LMARG,HPOST.TRANSPORTØR);
WRITE(T,' ':LMARG+32);
FOR J:=1 TO 12 DO WRITE(T,LANDFIL^(J));
WRITELN(T,OPLAND:4,' ':2,KLAND,KUNDE.NR(7):4);
WRITELN(T);
IF HPOST.KODE8=0 THEN WRITELN(T) ELSE
WRITELN(T,' ':LMARG,TMÅDE(HPOST.KODE8));
WRITELN(T);
WRITE(T,' ':LMARG);
IF HPOST.KODE9=0 THEN WRITE(T,' ':30) ELSE
WRITE(T,UDPSTED(HPOST.KODE9));
WRITELN(T,SYSFIL^.HELTAL(1)*10000.0+SYSFIL^.HELTAL(2):9:-2,
HPOST.FAKTNR1*10000.0+HPOST.FAKTNR2:19:-2);
WRITELN(T);
WRITELN(T,' ':LMARG+32,HPOST.LEVBET,HPOST.VÆRDI/100:11:2);
FOR J:= 26 TO 28 DO WRITELN(T)
END;
IF NRIOPLAND MOD 2=0 THEN
BEGIN
WRITELN(T,' ':LMARG+50,HPOST.BRUTTOVÆGT:6);
WRITELN(T,' ':LMARG,'Mrk. adr. ',HPOST.AKOLLI);
WRITELN(T)
END
ELSE FOR J:=37 TO 40 DO WRITELN(T);
TOLDPO.NR1:=TRUNC(LINES(LINE).TOLDPNR/1000);
TOLDPO.NR2:=TRUNC(LINES(LINE).TOLDPNR-1000.0*TOLDPO.NR1);
GETREC(TPZ.H,FTP,TOLDPO.A);
IF IER=0 THEN
WRITELN(T,' ':LMARG+10,TOLDPO.TEKST)
ELSE
IF IER<>-6 THEN ERROR
ELSE WRITELN(T,' ':LMARG,'*** TEKST IKKE OPRETTET ***');
NRIOPLAND:=NRIOPLAND+1;
FOR J:=42 TO 44 DO WRITELN(T);
WRITELN(T,' ':LMARG+5,LINES(LINE).TOLDPNR/1000:11:3,2:5,
LINES(LINE).VÆRDI/100:20:-2,
TRUNC((LINES(LINE).VÆRDI/HPOST.VÆRDI)*
(HPOST.BRUTTOVÆGT-8.17*HPOST.BRUTTOVÆGT/100.0)):9,
LINES(LINE).SUPPMÆNGDE:7);
BUND;
END;
END;
PROCEDURE VARECERTIFIKAT;
VAR OFFSET,FDK:INTEGER;
PROCEDURE HEAD;
BEGIN
FOR J:=1 TO TOPMARG DO WRITELN(T1);
WRITELN(T1,' ':LMARG,'Vendor');
WRITELN(T1,' ':LMARG,'Nyhavn 43');
WRITELN(T1,' ':LMARG,'1051 København K');
FOR J:=8 TO 10 DO WRITELN(T1);
SEEK(LANDFIL,KUNDE.NR(7));
GET(LANDFIL);
WRITELN(T1,' ':LMARG,KUNDE.NAVN(1));
WRITELN(T1,' ':LMARG,KUNDE.NAVN(2));
WRITELN(T1,' ':LMARG,KUNDE.NAVN(3),' ':4,LANDFIL^);
WRITELN(T1,' ':LMARG,KUNDE.LANDSBY);
WRITELN(T1,' ':LMARG,KUNDE.POSTNR);
WRITELN(T1,' ':LMARG,LANDFIL^);
WRITELN(T1);
WRITE(T1,' ':LMARG+34,'Se under 8 ');
FOR J:=1 TO 15 DO WRITE(T1,LANDFIL^(J));
FOR J:=18 TO 20 DO WRITELN(T1);
FDK:=0;
FOR J:=1 TO 10 DO
IF OFFSET+J<=I THEN
IF LINES(OFFSET+J).OPRILAND=8 THEN
BEGIN
FDK:=OFFSET+J;
J:=12
END;
IF FDK>0 THEN
BEGIN
WRITELN(T1,' ':LMARG+34,'Artikel 25-1 opfyldt for pos:');
WRITELN(T1);
WRITE(T1,' ':LMARG+34,FDK-OFFSET:3);
FDK:=FDK+1;
WHILE FDK<=I DO
IF LINES(FDK).OPRILAND=8 THEN
BEGIN
WRITE(T1,',',FDK-OFFSET:2+((FDK-OFFSET) DIV 10));
FDK:=FDK+1
END
ELSE FDK:=I+1;
WRITELN(T1)
END
ELSE FOR J:=21 TO 23 DO WRITELN(T1);
FOR J:=24 TO 30 DO WRITELN(T1);
WRITELN(T1,' ':LMARG,'Mrk. adr. ',HPOST.AKOLLI,
HPOST.BRUTTOVÆGT:17,
HPOST.FAKTNR1*10000.0+HPOST.FAKTNR2:9:-2);
WRITELN(T1,' ':LMARG,'----------------------------------',
'---------------------------------');
WRITELN(T1)
END;
BEGIN
OFFSET:=0;
LINE:=0;
WHILE LINE+OFFSET<I DO
BEGIN
IF LINE=0 THEN HEAD;
LINE:=LINE+1;
TOLDPO.NR1:=TRUNC(LINES(LINE+OFFSET).TOLDPNR/1000);
TOLDPO.NR2:=TRUNC(LINES(LINE+OFFSET).TOLDPNR-1000.0*TOLDPO.NR1);
GETREC(TPZ.H,FTP,TOLDPO.A);
WRITE(T1,' ':LMARG,LINE:3,':',LINES(LINE+OFFSET).SUPPMÆNGDE:5,' stk. ');
IF IER=0 THEN
WRITELN(T1,TOLDPO.TEKST)
ELSE
BEGIN
WRITELN(T1,'TEKST IKKE OPRETTET');
IF IER<>-6 THEN ERROR
END;
SEEK(LANDFIL,LINES(LINE+OFFSET).OPRILAND);
GET(LANDFIL);
WRITELN(T1,' ':LMARG+7,LINES(LINE+OFFSET).TOLDPNR/1000:10:3,' ',
LANDFIL^);
IF (LINE=10) OR (OFFSET+LINE=I) THEN
BEGIN
WRITELN(T1,' ':LMARG,'-------------------------',
'------------------------');
WHILE LINE<10 DO
BEGIN
WRITELN(T1);
WRITELN(T1);
LINE:=LINE+1
END;
FOR J:=55 TO 60 DO WRITELN(T1);
WRITELN(T1,' ':LMARG+42,'København',SYSFIL^.HELTAL(1)*10000.0+
SYSFIL^.HELTAL(2):14:-2);
FOR J:=62 TO 63 DO WRITELN(T1);
WRITELN(T1,' ':LMARG,'København',SYSFIL^.HELTAL(1)*10000.0+
SYSFIL^.HELTAL(2):12:-2);
FOR J:=65 TO 72 DO WRITELN(T1);
OFFSET:=OFFSET+10;
LINE:=0
END
END
END;
BEGIN
WRITELN('START TOLDPAP');
FNAVN:='KUNDERG:P2:0000:I';
RESET(FKUN,FNAVN);
IOPEN(KZ.H,FKUN,LÆS);IF IER<>0 THEN ERROR;
FNAVN:='TOLDPORG:P2:0000:I';
RESET(FTP,FNAVN);
IOPEN(TPZ.H,FTP,LÆS);IF IER<>0 THEN ERROR;
FNAVN:='SYSREG:P2:1:I';
REWRITE(SYSFIL,FNAVN);
SEEK(SYSFIL,1);
GET(SYSFIL);
FNAVN:='LANDEREG:P2:0:I';
RESET(LANDFIL,FNAVN);
FNAVN:='TOLDPAPI:P1:10:K';
REWRITE(TOLDPHIL,FNAVN);
FNAVN:='TOLDPTXT:P1:10:K';
REWRITE(T,FNAVN);
FNAVN:='CERTITXT:P1:10:K';
REWRITE(T1,FNAVN);
INIT;
GET(TOLDPHIL);
WHILE (TOLDPHIL^.KNR1<>0) AND (TOLDPHIL^.KNR2<>0) DO
WITH TOLDPHIL^ DO
BEGIN
I:=0;
REPEAT
I:=I+1;
LINES(I).OPRILAND:=OPRILAND;
LINES(I).SUPPMÆNGDE:=SUPPMÆNGDE;
LINES(I).VÆRDI:=VÆRDI;
LINES(I).TOLDPNR:=TOLDPONR;
GET(TOLDPHIL)
UNTIL OPRILAND=0;
HPOST:=TOLDPHIL^;
FOR J:=1 TO I DO
BEGIN
M:=J;
FOR K:=J+1 TO I DO
IF LINES(K).OPRILAND<LINES(M).OPRILAND THEN M:=K;
IF M<>J THEN
BEGIN
BYTPOST:=LINES(M);
LINES(M):=LINES(J);
LINES(J):=BYTPOST
END
END; (*SORTERET*)
UDFØRSELSANGIVELSE;
K:=0;
FOR J:=1 TO 20 DO IF EFLANDE(J)=KUNDE.NR(7) THEN K:=1;
IF K=0 THEN VARECERTIFIKAT;
GET(TOLDPHIL)
END;
ICLOSE(KZ.H,FKUN);
ICLOSE(TPZ.H,FTP);
WRITELN('SLUT TOLDPAP');
CHAIN('INTRE *1','SKRIVFAK:P1',QUQ);
END.