DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Notes: Mikados TextFile, Mikados_K
    Names: »KNUDELBO«

└─⟦206949bb3⟧ Bits:30004653 Kunderegister P1 til messe (MIKADOS)
    └─ ⟦this⟧ »KNUDELBO« 

Text

PROGRAM KNUDELBO;
(*$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;
LANDFILE=FILE OF PACKED ARRAY(1..30) OF CHAR;
VAR    F:ISF;
       KZ:ZONE;
       LANDFIL:LANDFILE;
       QUQ:^INTEGER;
       FILNAVN2:STRING(20);
    J,IER,I:INTEGER;
      KUNDE:KPOST;
      T:TEXT;
       NAME:PACKED ARRAY (1..26) OF CHAR;
       FIRST,LAST:PACKED ARRAY (1..4) OF CHAR;
       STRENG:STRING(4);
   PNR,FINIS:BOOLEAN;
 
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
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;
FUNCTION CHECK:BOOLEAN;
VAR P:PACKED ARRAY (1..4) OF CHAR;
    K:INTEGER;
BEGIN
  FOR K:=1 TO 4 DO P(K):=KUNDE.POSTNR(K);
  IF (P>=FIRST) AND (P<=LAST) THEN CHECK:=TRUE ELSE CHECK:=FALSE
END;
PROCEDURE PRKUNOPL(O:INTEGER);
BEGIN
  WITH KUNDE DO
  BEGIN
       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(T,' ':6,NAME)
       END
       ELSE
    WRITELN(T,' ':6,NAVN(1));
    WRITELN(T,' ':6,NAVN(2));
    WRITELN(T,' ':6,NAVN(3));
    WRITELN(T,' ':6,LANDSBY);
    WRITELN(T,' ':6,POSTNR);
       WRITELN(T,' ')
  END
END;
BEGIN
  CLEARSCREEN;
  WRITELN('KUNDELABELS');
  FILNAVN2:='KLABELS:P1:30:K';
  REWRITE(T,FILNAVN2);
  FILNAVN2:='KUNDERG:P2:1338:I';
  RESET(F,FILNAVN2);
  IOPEN(KZ.H,F,LÆS);
  IF IER<>0 THEN OFEJL;
  REPEAT
    GOTOXY(1,22);
  WRITELN('I POSTNR-INTERVALLER (1), ET INTERVAL (2), KNR-ORDEN (3)');
  GOTOXY(60,22);
  READLN;READ(J)
  UNTIL (IORESULT=0) AND (J>0) AND (J<4);
  IF J=1 THEN BEGIN FINIS:=FALSE;PNR:=TRUE END;
  IF J=2 THEN BEGIN FINIS:=TRUE;PNR:=TRUE END;
  IF J=3 THEN BEGIN FINIS:=TRUE;PNR:=FALSE END;
  IF J=2 THEN
  BEGIN
    REPEAT
       CLEARSCREEN;
    REPEAT
       GOTOXY(1,22);
       WRITELN('START');
       GOTOXY(10,22);
       READLN;READ(STRENG)
    UNTIL LENGTH(STRENG)=4;
    FOR I:=1 TO 4 DO FIRST(I):=STRENG(I);
    REPEAT
       GOTOXY(20,22);
       WRITELN('SLUT');
       GOTOXY(30,22);
       READLN;READ(STRENG)
    UNTIL LENGTH(STRENG)=4;
    FOR I:=1 TO 4 DO LAST(I):=STRENG(I);
    UNTIL LAST>=FIRST;
  END
  ELSE
  BEGIN
    FIRST:='1000';
    LAST:='1999'
  END;
  I:=0;
  WITH KUNDE DO
  REPEAT
    NR(1):=0;NR(2):=0;
    NEXTREC(KZ.H,F,A);
    IF IER<>-1 THEN ERROR;
    REPEAT
       IF (PNR=FALSE) OR (CHECK=TRUE) THEN
       BEGIN
       PRKUNOPL(-1);
       WRITELN(T,' ':6,'afs. H.S.Møller Trommesalen 5 1614 V.');
       WRITELN(T,' ');
       WRITELN(T,' ');
       I:=I+1;
       END;
       NEXTREC(KZ.H,F,A)
    UNTIL IER<>0;
  IF IER<>-2 THEN ERROR;
  IF LAST='9999' THEN FINIS:=TRUE;
  LAST(1):=CHR(ORD(LAST(1))+1);
  FIRST(1):=CHR(ORD(FIRST(1))+1);
  UNTIL FINIS;
  ICLOSE(KZ.H,F);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER,I:7);
  CHAIN('INTRE   *1','LISTKNUD:P1',QUQ)
END.