DataMuseum.dk

top - download

    Length: 2496 (0x9c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »REGREORG.K«

└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
    └─⟦this⟧ »REGREORG.K« 

Mikados K File

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.