DataMuseum.dk

top - download

    Length: 4992 (0x1380)
    Types: TextFile
    Notes: Mikados_K
    Names: »ISFKUND.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »ISFKUND.K« 

Mikados K File

PROGRAM OPRETVAR;
(*$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;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..1000) OF INTEGER
 END;
INFILE=FILE OF CHAR;
VAR    F:ISF;
       VZ:ZONE;
       INDFIL:INFILE;
       INDPOST:STRING(80);
       FILNAVN1,FILNAVN2:STRING(20);
   AV,IER,I:INTEGER;
       R:REAL;
       KUNDE:KPOST;
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IINITIATE*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IREPORT*)
(*$R+*)
FUNCTION UNPACK(FBYTE1,FBYTE2:INTEGER):REAL;
VAR RES:REAL;
BEGIN
  RES:=0;
  REPEAT
    RES:=RES*100+ORD(INDPOST(FBYTE1))-32;
    FBYTE1:=FBYTE1+1
  UNTIL FBYTE1>FBYTE2;
  UNPACK:=RES
END;
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
BEGIN
  FILNAVN1:='KÅNDEREG:P1';
  FILNAVN2:='NREGKUN:P2:1918:I';
  RESET(INDFIL,FILNAVN1);
  READLN(INDFIL);
  REWRITE(F,FILNAVN2);
  I:=IORESULT;
IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;
  IOPEN(VZ.H,F,SKRIV);
IF IER<>0 THEN BEGIN WRITE('IOPEN ',IER); IF IER<>-19 THEN STOP END;
INITIATE(VZ.H,F,898); IF IER<>0 THEN BEGIN WRITE('INITIATE ',IER);STOP END;
  WITH KUNDE DO
  BEGIN
  READLN(INDFIL,INDPOST);
  AV:=0;
  REPEAT
       R:=UNPACK(1,3);
       NR(1):=TRUNC(R/10000);
       NR(2):=TRUNC(R-NR(1)*10000.0);
       FOR I:=1 TO 30 DO NAVN(1,I):=INDPOST(3+I);
       FOR I:=1 TO 30 DO NAVN(2,I):=INDPOST(33+I);
       FOR I:=1 TO 13 DO NAVN(3,I):=INDPOST(63+I);
       READLN(INDFIL,INDPOST);
       FOR I:=14 TO 30 DO NAVN(3,I):=INDPOST(I-13);
       FOR I:=1 TO 20 DO LANDSBY(I):=INDPOST(17+I);
       FOR I:=1 TO 25 DO POSTNR(I):=INDPOST(37+I);
       FOR I:=1 TO  9 DO TLF(I):=INDPOST(63+I);TLF(10):=' ';
       NR(3):=TRUNC(UNPACK(73,73));
       NR(23):=TRUNC(UNPACK(74,74));
       NR(6):=TRUNC(UNPACK(75,75));
       NR(8):=TRUNC(UNPACK(76,76));
       READLN(INDFIL,INDPOST);
       NR(9):=TRUNC(UNPACK(1,1));
       NR(10):=TRUNC(UNPACK(2,2));
       FOR I:=3 TO 6 DO
       NR(12+I):=TRUNC(UNPACK(I,I));
       FOR I:=1 TO 6 DO
       SALDOKØB(I):=UNPACK(5*I+2,5*I+3)*(1E+6)+UNPACK(5*I+4,5*I+6);
       SALDOKØB(8):=UNPACK(37,38)*(1E+6)+UNPACK(39,41);
       SALDOKØB(7):=UNPACK(42,43)*(1E+6)+UNPACK(44,46);
       SALDOKØB(9):=UNPACK(47,48)*(1E+6)+UNPACK(49,51);
       NR(11):=TRUNC(UNPACK(52,53));
       NR(12):=TRUNC(UNPACK(54,55));
       R:=UNPACK(56,58);
       NR(13):=TRUNC(R/10000);
       NR(14):=TRUNC(R-NR(13)*10000.0);
       R:=UNPACK(59,61);
       NR(4):=TRUNC(R/10000);
       NR(5):=TRUNC(R-NR(4)*10000.0);
       NR(7):=TRUNC(UNPACK(62,63));
       FOR I:=19 TO 22 DO NR(I):=0;
   AV:=AV+1;
   WRITELN(NR(1)*10000.0+NR(2):10:-2,AV:6);
   INSERT(VZ.H,F,KUNDE.A); IF IER<>0 THEN BEGIN WRITE('INSERT',IER:5);
                                                         STOP END;
   READLN(INDFIL,INDPOST);
  UNTIL EOF(INDFIL)
  END;
       ICLOSE(VZ.H,F);
  WRITE(LIST,'ICLOSE ',IER:5,AV:6,KUNDE.NR(1),KUNDE.NR(2))
END.