|
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: 5088 (0x13e0)
Types: TextFile
Notes: Mikados_K
Names: »KUNDFIX.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »KUNDFIX.K«
PROGRAM KUNDREOR;
(*$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;
KUNDZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..918) OF INTEGER
END;
VAR F1,F:ISF;
KZ:KUNDZONE;
KZ1:KUNDZONE;
FILNAVN1,FILNAVN2:STRING(20);
N3,N4,N1,N2,IER,I:INTEGER;
R:REAL;
KUNDE:KPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IINITIATE*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IPUTGET*)
(*$R+*)
(*$L+*)
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I KUNDEREG ',IER);
ICLOSE(KZ.H,F);
ICLOSE(KZ1.H,F1);
WRITELN('ICLOSE ',IER);
STOP
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;
BEGIN
CLEARSCREEN;
WRITELN('SIDSTE GODE');
READLN;READ(R);
N1:=TRUNC(R/10000.0);
N2:=TRUNC(R-N1*10000.0);
WRITELN('FØRSTE GODE');
READLN;READ(R);
N3:=TRUNC(R/10000.0);
N4:=TRUNC(R-N3*10000.0);
FILNAVN2:='KUNDERG:P2:0000:I';
REWRITE(F,FILNAVN2);
IOPEN(KZ.H,F,LÆS);IF IER<>0 THEN OFEJL;
FILNAVN1:='KUNDERG:P1:0000:I';
REWRITE(F1,FILNAVN1);
IOPEN(KZ1.H,F1,SKRIV);IF IER<>0 THEN OFEJL;
KUNDE.NR(1):=0;
KUNDE.NR(2):=0;
NEXTREC(KZ.H,F,KUNDE.A);
IF IER<>-1 THEN ERROR ELSE IER:=0;
INITIATE(KZ1.H,F1,KZ.H.RECINUSE);
IF IER<>0 THEN ERROR;
I:=0;
WHILE IER=0 DO
BEGIN
INSERT(KZ1.H,F1,KUNDE.A);
IF IER<>0 THEN ERROR;
WRITELN('INS ',KUNDE.NR(1):8,KUNDE.NR(2):8);
IF KUNDE.NR(1)*10000.0+KUNDE.NR(2)=N1*10000.0+N2 THEN
BEGIN
KUNDE.NR(1):=N3;
KUNDE.NR(2):=N4;
GETREC(KZ.H,F,KUNDE.A);
IF IER<>0 THEN ERROR;
WRITELN('GETREC ',KUNDE.NR(1):8,KUNDE.NR(2):8);
INSERT(KZ1.H,F1,KUNDE.A);
IF IER<>0 THEN ERROR
END;
NEXTREC(KZ.H,F,KUNDE.A);
WRITELN('NXT ',KUNDE.NR(1):8,KUNDE.NR(2):8);
I:=I+1
END;
IF IER<>-2 THEN ERROR;
WRITELN('INDPOSTER, UDPOSTER',KZ.H.RECINUSE:5,I:5);
ICLOSE(KZ.H,F);
ICLOSE(KZ1.H,F1);
WRITELN('ICLOSE ',IER);
END.
0x0000…0013 Line {l1=0x11, l2=»PROGRAM KUNDREOR;«, l3=0x11}
0x0013…0022 Line {l1=0x0d, l2=»(*$IISFHEAD*)«, l3=0x0d}
0x0022…0031 Line {l1=0x0d, l2=» KPOST=RECORD«, l3=0x0d}
0x0031…0040 Line {l1=0x0d, l2=» A:AR;«, l3=0x0d}
0x0040…0066 Line {l1=0x24, l2=» NR:ARRAY (1..23) OF INTEGER;«, l3=0x24}
0x0066…00af Line {l1=0x47, l2=» (*KNR1,KNR2,ANDBETADR,KÆDENR1,KÆDENR2,RESTORDRE,LAND,BETAKODE,LEVKODE,«, l3=0x47}
0x00af…00f8 Line {l1=0x47, l2=» RENTKODE,KREDDAGE,ANTFAKT,SIDFAKD1,SIDFAKD2,EMBALLAGE,BRÆKAGE,RABAT,«, l3=0x47}
0x00f8…0128 Line {l1=0x2e, l2=» EXPORT,RFSALDO,PERTRENT,NPOSTNR1,NPOSTNR2*)«, l3=0x2e}
0x0128…0178 Line {l1=0x4e, l2=» (* NAVN,UDVNAVN,LEVADR*)NAVN:ARRAY(1..3) OF PACKED ARRAY (1..30) OF CHAR;«, l3=0x4e}
0x0178…01a7 Line {l1=0x2d, l2=» LANDSBY:PACKED ARRAY (1..20) OF CHAR;«, l3=0x2d}
0x01a7…01d5 Line {l1=0x2c, l2=» POSTNR:PACKED ARRAY (1..25) OF CHAR;«, l3=0x2c}
0x01d5…0200 Line {l1=0x29, l2=» TLF:PACKED ARRAY (1..10) OF CHAR;«, l3=0x29}
0x0200…0229 Line {l1=0x27, l2=» SALDOKØB :ARRAY (1..9) OF REAL;«, l3=0x27}
0x0229…024e Line {l1=0x23, l2=» (*SALDO1-6,ÅRKØB,MÅNKØB,SIDÅRKØB*)«, l3=0x23}
0x024e…0256 Line {l1=0x06, l2=» END;«, l3=0x06}
0x0256…0268 Line {l1=0x10, l2=» KUNDZONE=RECORD«, l3=0x10}
0x0268…027c Line {l1=0x12, l2=» H:ISFHEAD;«, l3=0x12}
0x027c…02a0 Line {l1=0x22, l2=» T:ARRAY(1..918) OF INTEGER«, l3=0x22}
0x02a0…02a8 Line {l1=0x06, l2=» END;«, l3=0x06}
0x02a8…02ba Line {l1=0x10, l2=»VAR F1,F:ISF;«, l3=0x10}
0x02ba…02cf Line {l1=0x13, l2=» KZ:KUNDZONE;«, l3=0x13}
0x02cf…02e5 Line {l1=0x14, l2=» KZ1:KUNDZONE;«, l3=0x14}
0x02e5…0304 Line {l1=0x1d, l2=»FILNAVN1,FILNAVN2:STRING(20);«, l3=0x1d}
0x0304…0320 Line {l1=0x1a, l2=»N3,N4,N1,N2,IER,I:INTEGER;«, l3=0x1a}
0x0320…0330 Line {l1=0x0e, l2=» R:REAL;«, l3=0x0e}
0x0330…0345 Line {l1=0x13, l2=» KUNDE:KPOST;«, l3=0x13}
0x0345…034e Line {l1=0x07, l2=»(*$L-*)«, l3=0x07}
0x034e…0361 Line {l1=0x11, l2=»(*$R-,IEXCOMCOP*)«, l3=0x11}
0x0361…0371 Line {l1=0x0e, l2=»(*$IINITIATE*)«, l3=0x0e}
0x0371…037e Line {l1=0x0b, l2=»(*$IIOPEN*)«, l3=0x0b}
0x037e…038b Line {l1=0x0b, l2=»(*$ISÆTØG*)«, l3=0x0b}
0x038b…039b Line {l1=0x0e, l2=»(*$IREADPROC*)«, l3=0x0e}
0x039b…03ab Line {l1=0x0e, l2=»(*$IFINDPOST*)«, l3=0x0e}
0x03ab…03ba Line {l1=0x0d, l2=»(*$IFORSKYD*)«, l3=0x0d}
0x03ba…03c8 Line {l1=0x0c, l2=»(*$IICLOSE*)«, l3=0x0c}
0x03c8…03d6 Line {l1=0x0c, l2=»(*$IINSERT*)«, l3=0x0c}
0x03d6…03e5 Line {l1=0x0d, l2=»(*$INEXTREC*)«, l3=0x0d}
0x03e5…03f3 Line {l1=0x0c, l2=»(*$IPUTGET*)«, l3=0x0c}
0x03f3…03fc Line {l1=0x07, l2=»(*$R+*)«, l3=0x07}
0x03fc…0405 Line {l1=0x07, l2=»(*$L+*)«, l3=0x07}
0x0405…0416 Line {l1=0x0f, l2=»PROCEDURE STOP;«, l3=0x0f}
0x0416…0426 Line {l1=0x0e, l2=»VAR I:INTEGER;«, l3=0x0e}
0x0426…043d Line {l1=0x15, l2=»BEGIN I:=I DIV 0 END;«, l3=0x15}
0x043d…044f Line {l1=0x10, l2=»PROCEDURE ERROR;«, l3=0x10}
0x044f…0456 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x0456…047a Line {l1=0x22, l2=» WRITELN('FEJL I KUNDEREG ',IER);«, l3=0x22}
0x047a…048d Line {l1=0x11, l2=» ICLOSE(KZ.H,F);«, l3=0x11}
0x048d…04a2 Line {l1=0x13, l2=» ICLOSE(KZ1.H,F1);«, l3=0x13}
0x04a2…04bd Line {l1=0x19, l2=» WRITELN('ICLOSE ',IER);«, l3=0x19}
0x04bd…04c5 Line {l1=0x06, l2=» STOP«, l3=0x06}
0x04c5…04cb Line {l1=0x04, l2=»END;«, l3=0x04}
0x04cb…04dd Line {l1=0x10, l2=»PROCEDURE OFEJL;«, l3=0x10}
0x04dd…04e4 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x04e4…04f5 Line {l1=0x0f, l2=» GOTOXY(1,20);«, l3=0x0f}
0x04f5…053a Line {l1=0x43, l2=» WRITELN('REGISTERFEJL ',IER,' . SITUATIONEN ER FORSØGT REDDET.');«, l3=0x43}
0x053a…056a Line {l1=0x2e, l2=» WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');«, l3=0x2e}
0x056a…05a3 Line {l1=0x37, l2=» REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;«, l3=0x37}
0x05a3…05ba Line {l1=0x15, l2=» IF I<>0 THEN ERROR;«, l3=0x15}
0x05ba…05c9 Line {l1=0x0d, l2=» CLEARSCREEN«, l3=0x0d}
0x05c9…05cf Line {l1=0x04, l2=»END;«, l3=0x04}
0x05cf…05d6 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x05d6…05e6 Line {l1=0x0e, l2=» CLEARSCREEN;«, l3=0x0e}
0x05e6…0601 Line {l1=0x19, l2=» WRITELN('SIDSTE GODE');«, l3=0x19}
0x0601…0614 Line {l1=0x11, l2=» READLN;READ(R);«, l3=0x11}
0x0614…062d Line {l1=0x17, l2=» N1:=TRUNC(R/10000.0);«, l3=0x17}
0x062d…0649 Line {l1=0x1a, l2=» N2:=TRUNC(R-N1*10000.0);«, l3=0x1a}
0x0649…0664 Line {l1=0x19, l2=» WRITELN('FØRSTE GODE');«, l3=0x19}
0x0664…0677 Line {l1=0x11, l2=» READLN;READ(R);«, l3=0x11}
0x0677…0690 Line {l1=0x17, l2=» N3:=TRUNC(R/10000.0);«, l3=0x17}
0x0690…06ac Line {l1=0x1a, l2=» N4:=TRUNC(R-N3*10000.0);«, l3=0x1a}
0x06ac…06af Line {l1=0x01, l2=» «, l3=0x01}
0x06af…06d1 Line {l1=0x20, l2=» FILNAVN2:='KUNDERG:P2:0000:I';«, l3=0x20}
0x06d1…06e9 Line {l1=0x16, l2=» REWRITE(F,FILNAVN2);«, l3=0x16}
0x06e9…0714 Line {l1=0x29, l2=» IOPEN(KZ.H,F,LÆS);IF IER<>0 THEN OFEJL;«, l3=0x29}
0x0714…0736 Line {l1=0x20, l2=» FILNAVN1:='KUNDERG:P1:0000:I';«, l3=0x20}
0x0736…074f Line {l1=0x17, l2=» REWRITE(F1,FILNAVN1);«, l3=0x17}
0x074f…077e Line {l1=0x2d, l2=» IOPEN(KZ1.H,F1,SKRIV);IF IER<>0 THEN OFEJL;«, l3=0x2d}
0x077e…0791 Line {l1=0x11, l2=» KUNDE.NR(1):=0;«, l3=0x11}
0x0791…07a4 Line {l1=0x11, l2=» KUNDE.NR(2):=0;«, l3=0x11}
0x07a4…07c0 Line {l1=0x1a, l2=» NEXTREC(KZ.H,F,KUNDE.A);«, l3=0x1a}
0x07c0…07e6 Line {l1=0x24, l2=» IF IER<>-1 THEN ERROR ELSE IER:=0;«, l3=0x24}
0x07e6…080b Line {l1=0x23, l2=» INITIATE(KZ1.H,F1,KZ.H.RECINUSE);«, l3=0x23}
0x080b…0824 Line {l1=0x17, l2=» IF IER<>0 THEN ERROR;«, l3=0x17}
0x0824…082d Line {l1=0x07, l2=» I:=0;«, l3=0x07}
0x082d…083f Line {l1=0x10, l2=» WHILE IER=0 DO«, l3=0x10}
0x083f…0848 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x0848…0867 Line {l1=0x1d, l2=» INSERT(KZ1.H,F1,KUNDE.A);«, l3=0x1d}
0x0867…0882 Line {l1=0x19, l2=» IF IER<>0 THEN ERROR;«, l3=0x19}
0x0882…08b0 Line {l1=0x2c, l2=»WRITELN('INS ',KUNDE.NR(1):8,KUNDE.NR(2):8);«, l3=0x2c}
0x08b0…08eb Line {l1=0x39, l2=» IF KUNDE.NR(1)*10000.0+KUNDE.NR(2)=N1*10000.0+N2 THEN«, l3=0x39}
0x08eb…08f6 Line {l1=0x09, l2=» BEGIN«, l3=0x09}
0x08f6…090e Line {l1=0x16, l2=» KUNDE.NR(1):=N3;«, l3=0x16}
0x090e…0926 Line {l1=0x16, l2=» KUNDE.NR(2):=N4;«, l3=0x16}
0x0926…0945 Line {l1=0x1d, l2=» GETREC(KZ.H,F,KUNDE.A);«, l3=0x1d}
0x0945…0962 Line {l1=0x1b, l2=» IF IER<>0 THEN ERROR;«, l3=0x1b}
0x0962…0999 Line {l1=0x35, l2=» WRITELN('GETREC ',KUNDE.NR(1):8,KUNDE.NR(2):8);«, l3=0x35}
0x0999…09ba Line {l1=0x1f, l2=» INSERT(KZ1.H,F1,KUNDE.A);«, l3=0x1f}
0x09ba…09d6 Line {l1=0x1a, l2=» IF IER<>0 THEN ERROR«, l3=0x1a}
0x09d6…09e0 Line {l1=0x08, l2=» END;«, l3=0x08}
0x09e0…09fe Line {l1=0x1c, l2=» NEXTREC(KZ.H,F,KUNDE.A);«, l3=0x1c}
0x09fe…0a2c Line {l1=0x2c, l2=»WRITELN('NXT ',KUNDE.NR(1):8,KUNDE.NR(2):8);«, l3=0x2c}
0x0a2c…0a38 Line {l1=0x0a, l2=» I:=I+1«, l3=0x0a}
0x0a38…0a40 Line {l1=0x06, l2=» END;«, l3=0x06}
0x0a40…0a5a Line {l1=0x18, l2=» IF IER<>-2 THEN ERROR;«, l3=0x18}
0x0a5a…0a91 Line {l1=0x35, l2=» WRITELN('INDPOSTER, UDPOSTER',KZ.H.RECINUSE:5,I:5);«, l3=0x35}
0x0a91…0aa4 Line {l1=0x11, l2=» ICLOSE(KZ.H,F);«, l3=0x11}
0x0aa4…0ab9 Line {l1=0x13, l2=» ICLOSE(KZ1.H,F1);«, l3=0x13}
0x0ab9…0ad4 Line {l1=0x19, l2=» WRITELN('ICLOSE ',IER);«, l3=0x19}
0x0ad4…0ada Line {l1=0x04, l2=»END.«, l3=0x04}
0x0ada…0ae0 00 00 2e 04 00 00 ┆ . ┆
0x0ae0…0b00 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 ┆cccccccccccccccccccccccccccccccc┆
[…0x46…]
0x13c0…13e0 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 63 00 ┆ccccccccccccccccccccccccccccccc ┆