DataMuseum.dk

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« 

Mikados K File

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.