|
|
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: 2496 (0x9c0)
Types: TextFile
Notes: Mikados_K
Names: »REGREORG.K«
└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
└─⟦this⟧ »REGREORG.K«
PROGRAM REGREORG;
(*$IISFHEAD*)
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR= ARRAY (0..0) OF REAL;
REGLIZONE=RECORD
H:ISFHEAD;
T:ARRAY(1..583) OF INTEGER
END;
REGLIPOST=RECORD
AA:ARAR;
A:AR;
AAA:RAR;
LØN :REAL;
ORDRENR,
PRODUKT1NR,
PRODUKT2NR,
OPERATIONSNR,
MEDARBEJDERNR,
DAT1,DAT2,
CENTIMER,
ENHEDER :INTEGER
END;
VAR F1,RGF:ISF;
RGZ,RGZ1:REGLIZONE;
FILNAVN1:STRING(20);
IER,I:INTEGER;
RGPOST:REGLIPOST;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IINITIATE*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IINSERT*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
ICLOSE(RGZ.H,RGF);
ICLOSE(RGZ1.H,RGF);
EXIT(REGREORG)
END;
PROCEDURE OFEJL(VAR FIL:FILNAVN);
VAR I:INTEGER;
BEGIN
GOTOXY(1,20);
WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . 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(FIL);
CLEARSCREEN
END;
BEGIN
CLEARSCREEN;
RGZ.H.FILENAME:='REGLIREG';
FILNAVN1:='REGLIREG:P2:0000:I';
REWRITE(RGF,FILNAVN1);
IOPEN(RGZ.H,RGF,LÆS);IF IER<>0 THEN OFEJL(RGZ.H.FILENAME);
RGZ1.H.FILENAME:='REGLIREK';
FILNAVN1:='REGLIREK:P1:0000:I';
REWRITE(F1,FILNAVN1);
IOPEN(RGZ1.H,F1,SKRIV);IF IER<>0 THEN OFEJL(RGZ1.H.FILENAME);
FOR I:=5 TO 10 DO RGPOST.A(I):=0;
NEXTREC(RGZ.H,RGF,RGPOST.A);
IF IER<>-1 THEN ERROR(RGZ.H.FILENAME) ELSE IER:=0;
INITIATE(RGZ1.H,F1,2*RGZ.H.RECINUSE);
IF IER<>0 THEN ERROR(RGZ1.H.FILENAME);
I:=0;
WHILE IER=0 DO
WITH RGPOST DO
BEGIN
INSERT(RGZ1.H,F1,A);
IF IER<>0 THEN ERROR(RGZ1.H.FILENAME);
WRITELN('INS ',ORDRENR:6,PRODUKT1NR*10000.0+PRODUKT2NR:10:-2,OPERATIONSNR:6,
MEDARBEJDERNR:6,DAT1*10000.0+DAT2:10:-2);
NEXTREC(RGZ.H,RGF,A);
I:=I+1
END;
IF IER<>-2 THEN ERROR(RGZ.H.FILENAME);
WRITELN('INDPOSTER, UDPOSTER',RGZ.H.RECINUSE:5,I:5);
ICLOSE(RGZ.H,RGF);
ICLOSE(RGZ1.H,F1);
WRITELN('ICLOSE ',IER);
END.
0x000…013 Line {l1=0x11, l2=»PROGRAM REGREORG;«, l3=0x11}
0x013…022 Line {l1=0x0d, l2=»(*$IISFHEAD*)«, l3=0x0d}
0x022…049 Line {l1=0x25, l2=»ARAR=PACKED ARRAY (-11..-10) OF CHAR;«, l3=0x25}
0x049…065 Line {l1=0x1a, l2=»RAR= ARRAY (0..0) OF REAL;«, l3=0x1a}
0x065…077 Line {l1=0x10, l2=»REGLIZONE=RECORD«, l3=0x10}
0x077…08b Line {l1=0x12, l2=» H:ISFHEAD;«, l3=0x12}
0x08b…0af Line {l1=0x22, l2=» T:ARRAY(1..583) OF INTEGER«, l3=0x22}
0x0af…0b5 Line {l1=0x04, l2=»END;«, l3=0x04}
0x0b5…0c7 Line {l1=0x10, l2=»REGLIPOST=RECORD«, l3=0x10}
0x0c7…0d7 Line {l1=0x0e, l2=» AA:ARAR;«, l3=0x0e}
0x0d7…0e4 Line {l1=0x0b, l2=» A:AR;«, l3=0x0b}
0x0e4…0f4 Line {l1=0x0e, l2=» AAA:RAR;«, l3=0x0e}
0x0f4…110 Line {l1=0x1a, l2=» LØN :REAL;«, l3=0x1a}
0x110…120 Line {l1=0x0e, l2=» ORDRENR,«, l3=0x0e}
0x120…133 Line {l1=0x11, l2=» PRODUKT1NR,«, l3=0x11}
0x133…146 Line {l1=0x11, l2=» PRODUKT2NR,«, l3=0x11}
0x146…15b Line {l1=0x13, l2=» OPERATIONSNR,«, l3=0x13}
0x15b…171 Line {l1=0x14, l2=» MEDARBEJDERNR,«, l3=0x14}
0x171…183 Line {l1=0x10, l2=» DAT1,DAT2,«, l3=0x10}
0x183…194 Line {l1=0x0f, l2=» CENTIMER,«, l3=0x0f}
0x194…1b2 Line {l1=0x1c, l2=» ENHEDER :INTEGER«, l3=0x1c}
0x1b2…1b8 Line {l1=0x04, l2=»END;«, l3=0x04}
0x1b8…1cc Line {l1=0x12, l2=»VAR F1,RGF:ISF;«, l3=0x12}
0x1cc…1e8 Line {l1=0x1a, l2=» RGZ,RGZ1:REGLIZONE;«, l3=0x1a}
0x1e8…205 Line {l1=0x1b, l2=» FILNAVN1:STRING(20);«, l3=0x1b}
0x205…21c Line {l1=0x15, l2=» IER,I:INTEGER;«, l3=0x15}
0x21c…236 Line {l1=0x18, l2=» RGPOST:REGLIPOST;«, l3=0x18}
0x236…23f Line {l1=0x07, l2=»(*$L-*)«, l3=0x07}
0x23f…252 Line {l1=0x11, l2=»(*$R-,IEXCOMCOP*)«, l3=0x11}
0x252…262 Line {l1=0x0e, l2=»(*$IINITIATE*)«, l3=0x0e}
0x262…26f Line {l1=0x0b, l2=»(*$IIOPEN*)«, l3=0x0b}
0x26f…27c Line {l1=0x0b, l2=»(*$ISÆTØG*)«, l3=0x0b}
0x27c…28c Line {l1=0x0e, l2=»(*$IREADPROC*)«, l3=0x0e}
0x28c…29c Line {l1=0x0e, l2=»(*$IFINDPOST*)«, l3=0x0e}
0x29c…2ab Line {l1=0x0d, l2=»(*$IFORSKYD*)«, l3=0x0d}
0x2ab…2b9 Line {l1=0x0c, l2=»(*$IICLOSE*)«, l3=0x0c}
0x2b9…2c7 Line {l1=0x0c, l2=»(*$IINSERT*)«, l3=0x0c}
0x2c7…2d6 Line {l1=0x0d, l2=»(*$INEXTREC*)«, l3=0x0d}
0x2d6…2df Line {l1=0x07, l2=»(*$R+*)«, l3=0x07}
0x2df…2e8 Line {l1=0x07, l2=»(*$L+*)«, l3=0x07}
0x2e8…30b Line {l1=0x21, l2=»PROCEDURE ERROR(VAR FIL:FILNAVN);«, l3=0x21}
0x30b…312 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x312…347 Line {l1=0x33, l2=» WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);«, l3=0x33}
0x347…35d Line {l1=0x14, l2=» ICLOSE(RGZ.H,RGF);«, l3=0x14}
0x35d…374 Line {l1=0x15, l2=» ICLOSE(RGZ1.H,RGF);«, l3=0x15}
0x374…386 Line {l1=0x10, l2=» EXIT(REGREORG)«, l3=0x10}
0x386…38c Line {l1=0x04, l2=»END;«, l3=0x04}
0x38c…3af Line {l1=0x21, l2=»PROCEDURE OFEJL(VAR FIL:FILNAVN);«, l3=0x21}
0x3af…3bf Line {l1=0x0e, l2=»VAR I:INTEGER;«, l3=0x0e}
0x3bf…3c6 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x3c6…3d7 Line {l1=0x0f, l2=» GOTOXY(1,20);«, l3=0x0f}
0x3d7…426 Line {l1=0x4d, l2=» WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . SITUATIONEN ER FORSØGT REDDET.');«, l3=0x4d}
0x426…456 Line {l1=0x2e, l2=» WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');«, l3=0x2e}
0x456…48f Line {l1=0x37, l2=» REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;«, l3=0x37}
0x48f…4ab Line {l1=0x1a, l2=» IF I<>0 THEN ERROR(FIL);«, l3=0x1a}
0x4ab…4ba Line {l1=0x0d, l2=» CLEARSCREEN«, l3=0x0d}
0x4ba…4c0 Line {l1=0x04, l2=»END;«, l3=0x04}
0x4c0…4c7 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x4c7…4d7 Line {l1=0x0e, l2=» CLEARSCREEN;«, l3=0x0e}
0x4d7…4f6 Line {l1=0x1d, l2=» RGZ.H.FILENAME:='REGLIREG';«, l3=0x1d}
0x4f6…519 Line {l1=0x21, l2=» FILNAVN1:='REGLIREG:P2:0000:I';«, l3=0x21}
0x519…533 Line {l1=0x18, l2=» REWRITE(RGF,FILNAVN1);«, l3=0x18}
0x533…571 Line {l1=0x3c, l2=» IOPEN(RGZ.H,RGF,LÆS);IF IER<>0 THEN OFEJL(RGZ.H.FILENAME);«, l3=0x3c}
0x571…591 Line {l1=0x1e, l2=» RGZ1.H.FILENAME:='REGLIREK';«, l3=0x1e}
0x591…5b4 Line {l1=0x21, l2=» FILNAVN1:='REGLIREK:P1:0000:I';«, l3=0x21}
0x5b4…5cd Line {l1=0x17, l2=» REWRITE(F1,FILNAVN1);«, l3=0x17}
0x5cd…60e Line {l1=0x3f, l2=» IOPEN(RGZ1.H,F1,SKRIV);IF IER<>0 THEN OFEJL(RGZ1.H.FILENAME);«, l3=0x3f}
0x60e…633 Line {l1=0x23, l2=» FOR I:=5 TO 10 DO RGPOST.A(I):=0;«, l3=0x23}
0x633…653 Line {l1=0x1e, l2=» NEXTREC(RGZ.H,RGF,RGPOST.A);«, l3=0x1e}
0x653…689 Line {l1=0x34, l2=» IF IER<>-1 THEN ERROR(RGZ.H.FILENAME) ELSE IER:=0;«, l3=0x34}
0x689…6b2 Line {l1=0x27, l2=» INITIATE(RGZ1.H,F1,2*RGZ.H.RECINUSE);«, l3=0x27}
0x6b2…6dc Line {l1=0x28, l2=» IF IER<>0 THEN ERROR(RGZ1.H.FILENAME);«, l3=0x28}
0x6dc…6e5 Line {l1=0x07, l2=» I:=0;«, l3=0x07}
0x6e5…6f7 Line {l1=0x10, l2=» WHILE IER=0 DO«, l3=0x10}
0x6f7…709 Line {l1=0x10, l2=» WITH RGPOST DO«, l3=0x10}
0x709…712 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x712…72c Line {l1=0x18, l2=» INSERT(RGZ1.H,F1,A);«, l3=0x18}
0x72c…758 Line {l1=0x2a, l2=» IF IER<>0 THEN ERROR(RGZ1.H.FILENAME);«, l3=0x2a}
0x758…7a6 Line {l1=0x4c, l2=»WRITELN('INS ',ORDRENR:6,PRODUKT1NR*10000.0+PRODUKT2NR:10:-2,OPERATIONSNR:6,«, l3=0x4c}
0x7a6…7e0 Line {l1=0x38, l2=» MEDARBEJDERNR:6,DAT1*10000.0+DAT2:10:-2);«, l3=0x38}
0x7e0…7fb Line {l1=0x19, l2=» NEXTREC(RGZ.H,RGF,A);«, l3=0x19}
0x7fb…807 Line {l1=0x0a, l2=» I:=I+1«, l3=0x0a}
0x807…80f Line {l1=0x06, l2=» END;«, l3=0x06}
0x80f…839 Line {l1=0x28, l2=» IF IER<>-2 THEN ERROR(RGZ.H.FILENAME);«, l3=0x28}
0x839…871 Line {l1=0x36, l2=» WRITELN('INDPOSTER, UDPOSTER',RGZ.H.RECINUSE:5,I:5);«, l3=0x36}
0x871…887 Line {l1=0x14, l2=» ICLOSE(RGZ.H,RGF);«, l3=0x14}
0x887…89d Line {l1=0x14, l2=» ICLOSE(RGZ1.H,F1);«, l3=0x14}
0x89d…8b8 Line {l1=0x19, l2=» WRITELN('ICLOSE ',IER);«, l3=0x19}
0x8b8…8be Line {l1=0x04, l2=»END.«, l3=0x04}
0x8be…8c0 00 00 ┆ ┆
0x8c0…8e0 45 20 27 2c 49 45 52 29 3b 19 04 45 4e 44 2e 04 00 00 01 95 a4 01 f8 82 cc 04 d5 83 9d c6 08 03 ┆E ',IER); END. ┆
0x8e0…900 01 0a 88 01 95 a4 01 f8 0a 8f c6 08 04 01 0a 88 01 95 a4 01 f8 82 cc 05 d5 83 9e c6 08 05 01 0a ┆ ┆
0x900…920 88 01 95 a4 01 f8 0a 8f c6 08 06 01 0a 88 01 95 a4 01 f8 82 cc 06 d5 83 9f db 01 c9 dc 01 c9 8d ┆ ┆
0x920…940 dc 0c c5 8d db 1f c5 8d a1 06 d5 83 9f d8 00 9a d5 83 a0 d8 f8 01 c3 a1 4b d5 83 a1 dc b9 2a d5 ┆ K * ┆
0x940…960 83 a2 db 1e c5 a1 06 d5 83 a2 d8 00 9a b9 35 d5 83 a3 db 1d c5 db 1d c3 dd 04 8e 00 cb 84 8d a1 ┆ 5 ┆
0x960…980 06 d5 83 a3 d8 00 9a b9 1b ac 02 00 0b 00 b9 14 21 00 04 00 35 00 08 00 39 00 0c 00 0e 00 3f 00 ┆ ! 5 9 ? ┆
0x980…9a0 12 00 43 00 d5 83 a5 d8 f8 01 c3 a1 f4 d5 83 a6 d5 83 a7 c6 08 01 01 0a 88 01 95 a4 01 f8 04 8f ┆ C ┆
0x9a0…9c0 c6 08 02 01 0a 88 01 95 a4 01 f8 03 8f 82 c6 08 03 01 0a 88 01 95 a4 01 f8 02 8f 82 c6 08 04 01 ┆ ┆