DataMuseum.dk

top - download

    Length: 6240 (0x1860)
    Types: TextFile
    Notes: Mikados_K
    Names: »DUMPKUND.K«

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

Mikados K File

PROGRAM DUMPKUND;
(*$IISFHEAD*)
KPOST=RECORD
       A:AR;
       NR:ARRAY(1..23) OF INTEGER;
       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
END;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..918) OF INTEGER
END;
PROCSTAT=RECORD
       NP,NROSTART:INTEGER
END;
NPFILE=FILE OF PROCSTAT;
VAR    F:ISF;
       NRPF,CF:NPFILE;
       QUQ:^INTEGER;
       KZ:ZONE;
       FILNAVN2:STRING(20);
    J,IER,I:INTEGER;
      KUNDE:KPOST;
       NAME:PACKED ARRAY (1..26) OF CHAR;
 
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
PROCEDURE FF;
VAR I:INTEGER;
BEGIN
  FOR I:=16 TO 48 DO WRITELN(LIST)
END;
PROCEDURE ERROR;
BEGIN
  WRITELN('FEJL I KUNDEREG ',IER);
  ICLOSE(KZ.H,F);
  WRITELN('ICLOSE ',IER);
  I:=I DIV 0
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;
PROCEDURE PRKUNOPL(O:INTEGER);
BEGIN
  WITH KUNDE DO
  BEGIN
    WRITELN(LIST,NR(1)*10000.0+NR(2):5:-2);
       J:=0;
       REPEAT J:=J+1
       UNTIL (J=4) OR (NAVN(1,J)<>' ');
       IF NAVN(1,J)=' ' THEN
       BEGIN
         MOVELEFT(NAVN(1,5),NAME,26);
         WRITELN(LIST,' ':6,NAME)
       END
       ELSE
    WRITELN(LIST,' ':6,NAVN(1));
    WRITELN(LIST,' ':6,NAVN(2));
    WRITELN(LIST,' ':6,NAVN(3));
    WRITELN(LIST,' ':6,LANDSBY);
    WRITELN(LIST,' ':6,POSTNR);
    WRITELN(LIST,' ':6,TLF);
    WRITE(LIST,' ':6,NR(7):10,' ':10);
    IF NR(3)=1 THEN WRITE(LIST,'J':10) ELSE WRITE(LIST,'N':10);
    WRITELN(LIST,' ':10,NR(4)*10000.0+NR(5):10:-2);
    WRITE(LIST,' ':6,NR(6):10);
    WRITE(LIST,' ':10,NR(8):10,' ':10);
    WRITE(LIST,NR(9):10,' ':10);
    WRITELN(LIST,NR(10):10);
    WRITE(LIST,' ':6,NR(17):10);
    WRITE(LIST,' ':10,NR(18):10,' ':10);
    IF NR(15)=1 THEN WRITE(LIST,'J':10) ELSE WRITE(LIST,'N':10);
    IF NR(16)=1 THEN WRITELN(LIST,' ':10,'J':10)
       ELSE WRITELN(LIST,' ':10,'N':10);
    WRITE(LIST,' ':6,SALDOKØB(1)/100:10:2);
    WRITE(LIST,' ':10,SALDOKØB(2)/100:10:2,' ':10);
    WRITELN(LIST,SALDOKØB(3)/100:10:2);
    WRITE(LIST,' ':6,SALDOKØB(4)/100:10:2);
    WRITE(LIST,' ':10,SALDOKØB(5)/100:10:2,' ':10);
    WRITELN(LIST,SALDOKØB(6)/100:10:2);
    WRITE(LIST,' ':6,SALDOKØB(8)/100:10:2);
    WRITE(LIST,' ':10,SALDOKØB(7)/100:10:2,' ':10);
    WRITELN(LIST,SALDOKØB(9)/100:10:2);
    WRITE(LIST,' ':6,NR(11):10,' ':10);
    WRITE(LIST,NR(12):10,' ':10);
    WRITELN(LIST,NR(13)*10000.0+NR(14):10:-2);
    WRITE(LIST,' ':6,NR(19):10,' ':10);
    WRITE(LIST,NR(20):10,' ':10);
    IF NR(23)=1 THEN WRITELN(LIST,'J':10) ELSE WRITELN(LIST,'N':10);
  END
END;
BEGIN
  WRITELN('KUNDEDUMP');
  FILNAVN2:='KUNDERG:P2:1338:I';
  RESET(F,FILNAVN2);
  IOPEN(KZ.H,F,LÆS);
  IF IER<>0 THEN OFEJL;
  FF;
  WRITELN(LIST,'NUMMER');
  WRITELN(LIST,'NAVN');
WRITELN(LIST,'NAVNE-UDV');
WRITELN(LIST,'ADRESSE');
WRITELN(LIST,'LANDSBY');
WRITELN(LIST,'POSTNR');
WRITELN(LIST,'TLF');
WRITELN(LIST,'LAND',' ':16,'BETADR',' ':14,'KÆDENR');
WRITELN(LIST,'RESTORDRE',' ':11,'BETALING',' ':12,'LEVERING',' ':12,'RENTE');
WRITELN(LIST,'RABAT',' ':15,'EXPORT',' ':14,
'EMBALLAGE',' ':11,'BRÆKAGE');
WRITELN(LIST,'SALDO 0-15',' ':10,'SALDO 16-30',' ':9,'SALDO 30-45');
WRITELN(LIST,'SALDO 45-60',' ':9,'ÆLDRE SALDO1',' ':8,'ÆLDRE SALDO2');
WRITELN(LIST,'MÅN. KØB',' ':12,'ÅRETS KØB ',' ':10,'S. ÅRS KØB');
WRITELN(LIST,'KREDITDAGE',' ':10,'FAKTURAER ',' ':10,'SID. FAK. D');
WRITELN(LIST,'RENTFR. SA',' ':10,'PER. T. RT',' ':10,'LUKKET');
FF;
  WITH KUNDE DO
  BEGIN
    NR(1):=0;NR(2):=0;
    I:=0;
    NEXTREC(KZ.H,F,A);
    IF IER<>-1 THEN ERROR;
    REPEAT
       PRKUNOPL(-1);
       FF;
       I:=I+1;
       NEXTREC(KZ.H,F,A)
    UNTIL IER<>0;
  END;
  IF IER<>-2 THEN ERROR;
  ICLOSE(KZ.H,F);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER,I:7);
  FILNAVN2:='PROCSTAT:P2:0:I';
(*$C-*)
  REPEAT
    REWRITE(NRPF,FILNAVN2);
    SEEK(NRPF,1)
  UNTIL IORESULT=0;
(*$C+*)
  GET(NRPF);
  NRPF^.NP:=1;
  SEEK(NRPF,1);
  PUT(NRPF);
  REPEAT
    GOTOXY(1,20);
    WRITELN('Sæt plade 1 i drev 1 og tryk RETURN');
    READLN;
(*$C-*)
    REWRITE(CF,'C1:P1:0:J');
    SEEK(CF,1)
(*$C+*)
  UNTIL IORESULT=0;
  CLOSE(CF);
  CLOSE(NRPF);
  CHAIN('INTRE   *1','HOVSA:P1',QUQ)
END.