⟦fd175456a⟧

Text

PROGRAM KUNDVEDL;
(*$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;
 SYSPOST=RECORD
       HELTAL:ARRAY(1..24) OF INTEGER;
       KGB:ARRAY (1..5) OF REAL;
       BETADAT:PACKED ARRAY (1..13) OF CHAR;
       KODE:ARRAY(1..2) OF PACKED ARRAY (1..10) OF CHAR
 END;
 SYSFILE=FILE OF SYSPOST;
VAR    F:ISF;
       CHAR1:CHAR;
       KZ:KUNDZONE;
       KNAVN:STRING(4);
FILNAVN1,FILNAVN2:STRING(20);
ÆNDRE,N1,N2,IER,I:INTEGER;
      KODE1,KODE2:STRING(10);
       R:REAL;
       KUNDE:KPOST;
       SYSFIL:SYSFILE;
       QUQ:^INTEGER;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IINITIATE*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$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);
  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;
PROCEDURE NANU(VAR T:STRING;VAR NU1,NU2 :INTEGER);
VAR I:INTEGER;
    R:REAL;
BEGIN
  R:=0.0;
  FOR I:=1 TO 4 DO R:=R*29+ORD(T(I));
  I:=TRUNC(R/89998.0);
  R:=R-I*89998.0+10001;
  NU1:=TRUNC(R/10000);
  NU2:=TRUNC(R-NU1*10000.0)
END;
PROCEDURE FINDKUND;
VAR    N1,N2,FIN:INTEGER;
       SVAR1:CHAR;
       R1,R2:REAL;
BEGIN
  REPEAT
    I:=1;
    SVAR1:='N';
    CLEARSCREEN;
    WRITELN('KUNDEVEDLIGEHOLDELSE');
    GOTOXY(1,4);
    WRITELN('0 FOR AFSLUTNING, 1 FOR SØGNING MED NAVN');
    REPEAT
      R:=-1.0;
      GOTOXY(1,3);
      WRITELN('INDTAST KUNDENUMMER');
      GOTOXY(25,3);READLN;READ(R)
    UNTIL (IORESULT=0) AND (R>=0.0) AND (R<100000.0);
    IF R=0.0 THEN EXIT(FINDKUND);
    REPEAT
      IF R=1.0 THEN
        IF I=1 THEN
        BEGIN
          GOTOXY(1,4);
          WRITELN('INDTAST KUNDENAVN',' ':60);
          REPEAT
          GOTOXY(20,4);
          READLN;READ(KNAVN)
          UNTIL LENGTH(KNAVN)=4;
          NANU(KNAVN,N1,N2);
          KUNDE.NR(1):=N1;
          KUNDE.NR(2):=N2;
          R1:=N1*10000.0+N2;
          GETREC(KZ.H,F,KUNDE.A);
          IF IER=-6 THEN NEXTREC(KZ.H,F,KUNDE.A);
          IF (IER=-9) OR (IER=-2) OR (IER=-1) THEN IER:=0;
          I:=0
        END
        ELSE
        BEGIN
          NEXTREC(KZ.H,F,KUNDE.A);
          IF (IER=-9) OR (IER=-2) OR (IER=-1) THEN IER:=0;
          R2:=KUNDE.NR(1)*10000.0+KUNDE.NR(2);
          IF (R2-R1>SYSFIL^.HELTAL(4)) OR (R2<R1) THEN IER:=-6;
        END
      ELSE
      BEGIN
        KUNDE.NR(1):=TRUNC(R/10000.0);
        KUNDE.NR(2):=TRUNC(R-KUNDE.NR(1)*10000.0);
        GETREC(KZ.H,F,KUNDE.A)
      END;
      GOTOXY(1,5);
      FIN:=1;
      IF IER=0 THEN
      BEGIN
        WRITELN('KUNDENUMMER ',KUNDE.NR(1)*10000.0+KUNDE.NR(2):8:-2);
        WRITELN;
        WRITELN(KUNDE.NAVN(1));
        WRITELN(KUNDE.NAVN(3));
        WRITELN(KUNDE.POSTNR);
        WRITELN;
        WRITELN('TLF: ',KUNDE.TLF);
        GOTOXY(40,6);WRITELN('RIGTIG KUNDE (J/N)');
        REPEAT  GOTOXY(60,6);READLN;READ(SVAR1) UNTIL (IORESULT=0) AND
                ((SVAR1='J') OR (SVAR1='N') OR (SVAR1='n') OR (SVAR1='j'));
        IF ((SVAR1='N') OR (SVAR1='n')) AND (R=1.0) THEN FIN:=0
      END
      ELSE
      IF IER=-6 THEN
      BEGIN
        IER:=0;
        WRITELN(' ':80);
        WRITELN('KUNDEN EKSISTERER IKKE, TRYK RETURN');
        READLN
      END
      ELSE ERROR
    UNTIL FIN=1
  UNTIL (SVAR1='J') OR (R=0.0) OR (SVAR1='j')
END;
(*$L+*)
PROCEDURE PRKUNOPL(O,KODE:INTEGER);
PROCEDURE PR1;
BEGIN
WITH KUNDE DO
CASE O OF
1:BEGIN
GOTOXY(1,1);WRITE('1 KUNDENR');GOTOXY(25,1);
WRITELN(NR(1)*10000.0+NR(2):10:-2);
END;
2:BEGIN
GOTOXY(1,2);WRITE('2 KUNDENAVN');GOTOXY(30,2);WRITELN(NAVN(1));
END;
3:BEGIN
GOTOXY(1,3);WRITE('3 NAVNEUDVIDELSE');GOTOXY(30,3);WRITELN(NAVN(2));
END;
4:BEGIN
GOTOXY(1,4);WRITE('4 ADRESSE');GOTOXY(30,4);WRITELN(NAVN(3));
END;
5:BEGIN
GOTOXY(1,5);WRITE('5 LANDSBY');GOTOXY(30,5);WRITELN(LANDSBY);
END;
6:BEGIN
GOTOXY(1,6);WRITE('6 POSTNR');GOTOXY(30,6);WRITELN(POSTNR);
END;
8:BEGIN
GOTOXY(1,8);WRITE('8 TLF');GOTOXY(30,8);WRITELN(TLF);
END;
7:BEGIN
GOTOXY(1,7);WRITE('7 LAND, 8 FOR DANMARK');GOTOXY(30,7);
WRITELN(NR(7));
END;
9:BEGIN
GOTOXY(1,9);WRITE('9 BETALINGSADRESSE J/N');GOTOXY(36,9);
IF NR(3)=1 THEN WRITELN('J') ELSE WRITELN('N');
END;
10:BEGIN
GOTOXY(40,9);WRITE('10 KÆDENR');GOTOXY(65,9);
WRITELN(NR(4)*10000.0+NR(5):7:-2)
END;
11:BEGIN
GOTOXY(1,10);WRITE('11 RESTORDREKODE');GOTOXY(27,10);WRITELN(NR(6):10);
END;
END;
END;
PROCEDURE PR2;
BEGIN
WITH KUNDE DO
CASE O OF
12:BEGIN
GOTOXY(40,10);WRITE('12 BETALINGSKODE');GOTOXY(65,10);
WRITELN(NR(8):7);
END;
13:BEGIN
GOTOXY(1,11);WRITE('13 LEVERINGSKODE');GOTOXY(27,11);WRITELN(NR(9):10);
END;
14:BEGIN
GOTOXY(40,11);WRITE('14 RENTEKODE');GOTOXY(65,11);WRITELN(NR(10):7);
END;
15:IF KODE>0 THEN BEGIN
GOTOXY(1,12);WRITE('15 RABAT %');GOTOXY(27,12);WRITELN(NR(17):10);
END;
16:BEGIN
GOTOXY(40,12);WRITE('16 EXPORTKODE');GOTOXY(65,12);WRITELN(NR(18):7);
END;
17:BEGIN
GOTOXY(1,13);WRITE('17 EMBALLAGE J/N');GOTOXY(36,13);
IF NR(15)=1 THEN WRITELN('J') ELSE WRITELN('N');
END;
18:BEGIN
GOTOXY(40,13);WRITE('18 BRÆKAGEFORSIKRING J/N');GOTOXY(71,13);
IF NR(16)=1 THEN WRITELN('J') ELSE WRITELN('N');
END;
19:IF KODE>0 THEN BEGIN
GOTOXY(1,14);WRITE('19 SALDO 0-15 DAGE');GOTOXY(25,14);
WRITELN(SALDOKØB(1)/100:12:2);
END;
20:IF KODE>0 THEN BEGIN
GOTOXY(40,14);WRITE('20 SALDO 16-30 DAGE');GOTOXY(60,14);
WRITELN(SALDOKØB(2)/100:12:2);
END;
21:IF KODE>0 THEN BEGIN
GOTOXY(1,15);WRITE('21 SALDO 30-45 DAGE');GOTOXY(25,15);
WRITELN(SALDOKØB(3)/100:12:2);
END;
22:IF KODE>0 THEN BEGIN
GOTOXY(40,15);WRITE('22 SALDO 45-60 DAGE');GOTOXY(60,15);
WRITELN(SALDOKØB(4)/100:12:2);
END;
23:IF KODE>0 THEN BEGIN
GOTOXY(1,16);WRITE('23 ÆLDRE SALDO1');GOTOXY(25,16);
WRITELN(SALDOKØB(5)/100:12:2);
END;
24:IF KODE>0 THEN BEGIN
GOTOXY(40,16);WRITE('24 ÆLDRE SALDO2');GOTOXY(60,16);
WRITELN(SALDOKØB(6)/100:12:2);
END;
25:IF KODE>0 THEN BEGIN
GOTOXY(1,17);WRITE('25 MÅNEDENS KØB');GOTOXY(25,17);
WRITELN(SALDOKØB(8)/100:12:2);
END;
26:IF KODE>0 THEN BEGIN
GOTOXY(40,17);WRITE('26 ÅRETS KØB');GOTOXY(60,17);
WRITELN(SALDOKØB(7)/100:12:2);
END;
END
END;
PROCEDURE PR3;
BEGIN
WITH KUNDE DO
CASE O OF
27:BEGIN
GOTOXY(1,18);WRITE('27 SIDSTE ÅRS KØB');GOTOXY(25,18);
WRITELN(SALDOKØB(9)/100:12:2);
END;
28:BEGIN
GOTOXY(40,18);WRITELN('28 KREDITDAGE',NR(11):19);
END;
29:BEGIN
GOTOXY(1,19);WRITELN('29 FAKTURAER',NR(12):24);
END;
30:BEGIN
GOTOXY(40,19);WRITELN('30 S. FAKTURA DATO',NR(13)*10000.0+NR(14):14:-2);
END;
31:BEGIN
GOTOXY(1,20);WRITELN('31 RENTEFRI SALDO',NR(19):19);
END;
32:BEGIN
GOTOXY(40,20);WRITELN('32 PERIODER TIL RENTE',NR(20):11);
END;
33:BEGIN
GOTOXY(1,21);WRITE('33 LUKKET FOR KREDIT');
GOTOXY(36,21);
IF NR(23)=1 THEN WRITELN('J') ELSE WRITELN('N');
END;
END
END;
BEGIN
  IF O<>0 THEN
  BEGIN
    IF (1<=O) AND (O<=11) THEN PR1
    ELSE
    IF (12<=O) AND (O<=26) THEN PR2
    ELSE
    IF (27<=O) AND (O<=34) THEN BEGIN IF KODE>0 THEN PR3 END
    ELSE
    BEGIN
       CLEARSCREEN;
       FOR O:=1 TO 11 DO PR1;
       FOR O:=12 TO 26 DO PR2;
       FOR O:=27 TO 34 DO IF KODE>0 THEN PR3
    END
  END
END;
PROCEDURE KUNDOPL(O:INTEGER);
VAR STRENG:STRING;
    I:INTEGER;
FUNCTION LÆS(X,Y:INTEGER):REAL;
VAR RES:REAL;
BEGIN
  REPEAT
       GOTOXY(X,Y);
       READLN;
       READ(RES)
  UNTIL IORESULT=0;
  LÆS:=RES
END;
PROCEDURE INCH(X,Y:INTEGER);
BEGIN
  REPEAT
       GOTOXY(X,Y);
       READLN;
       READ(CHAR1)
  UNTIL (CHAR1='N') OR (CHAR1='J') OR (CHAR1='n') OR (CHAR1='j')
END;
PROCEDURE OPL1;
BEGIN
  WITH KUNDE DO
  CASE O OF
    2: BEGIN REPEAT
       GOTOXY(30,2);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<5;
       FILLCHAR(NAVN(1),30,' ');
       FOR I:= 1 TO LENGTH(STRENG) DO NAVN(1,I):=STRENG(I);
       REPEAT
         GOTOXY(34,2);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<27;
       FOR I:=5 TO LENGTH(STRENG)+4 DO NAVN(1,I):=STRENG(I-4) END;
    3: BEGIN REPEAT
       GOTOXY(30,3);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<31;
       FILLCHAR(NAVN(2),30,' ');
       FOR I:=1 TO LENGTH(STRENG) DO NAVN(2,I):=STRENG(I) END;
    4: BEGIN REPEAT
       GOTOXY(30,4);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<31;
       FILLCHAR(NAVN(3),30,' ');
       FOR I:=1 TO LENGTH(STRENG) DO NAVN(3,I):=STRENG(I) END;
    5: BEGIN REPEAT
       GOTOXY(30,5);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<21;
       FILLCHAR(LANDSBY,20,' ');
       FOR I:=1 TO LENGTH(STRENG) DO LANDSBY(I):=STRENG(I) END;
    6: BEGIN REPEAT
       GOTOXY(30,6);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<26;
       FILLCHAR(POSTNR,25,' ');
       FOR I:=1 TO LENGTH(STRENG) DO POSTNR(I):=STRENG(I) END;
    8: BEGIN REPEAT
       GOTOXY(30,8);READLN;READ(STRENG)
       UNTIL LENGTH(STRENG)<11;
       FILLCHAR(TLF,10,' ');
       FOR I:=1 TO LENGTH(STRENG) DO TLF(I):=STRENG(I) END;
    7: NR(7):=8;
    9: BEGIN
       INCH(36,9);
       IF (CHAR1='N') OR (CHAR1='n') THEN NR(3):=0 ELSE NR(3):=1 END;
   10: BEGIN REPEAT
       R:=LÆS(67,9)
       UNTIL (R>9999) AND (R<100000.0) OR (R=0);
       NR(4):=TRUNC(R/10000);
       NR(5):=TRUNC(R-NR(4)*10000.0)
       END;
   11: REPEAT
       GOTOXY(36,10);READLN;READ(NR(6))
       UNTIL (IORESULT=0) AND (NR(6)>=0) AND (NR(6)<100);
   12: REPEAT
       GOTOXY(71,10);READLN;READ(NR(8))
       UNTIL (IORESULT=0) AND (NR(8)>=0) AND (NR(8)<100);
   13: REPEAT
       GOTOXY(36,11);READLN;READ(NR(9))
       UNTIL (IORESULT=0) AND (NR(9)>=0) AND (NR(9)<100);
   14: REPEAT
       GOTOXY(71,11);READLN;READ(NR(10))
       UNTIL (IORESULT=0) AND (NR(10)>=0) AND (NR(10)<100);
   15: REPEAT
       GOTOXY(35,12);READLN;READ(NR(17))
       UNTIL (IORESULT=0) AND (NR(17)>=0) AND (NR(17)<100);
  END
END;
PROCEDURE OPL2;
BEGIN
  WITH KUNDE DO
  CASE O OF
   16: REPEAT
       GOTOXY(71,12);READLN;READ(NR(18))
       UNTIL (IORESULT=0) AND (NR(18)>=0) AND (NR(18)<100);
   17: BEGIN
       INCH(36,13);
       IF (CHAR1='N') OR (CHAR1='n') THEN NR(15):=0 ELSE NR(15):=1 END;
   18: BEGIN
       INCH(71,13);
       IF (CHAR1='N') OR (CHAR1='n') THEN NR(16):=0 ELSE NR(16):=1 END;
   19: 
SALDOKØB(1):=LÆS(25,14)*100;
   20:
SALDOKØB(2):=LÆS(65,14)*100;
   21: 
SALDOKØB(3):=LÆS(25,15)*100;
   22: 
SALDOKØB(4):=LÆS(65,15)*100;
   23: 
SALDOKØB(5):=LÆS(25,16)*100;
  24: SALDOKØB(6):=LÆS(65,16)*100;
  25: SALDOKØB(8):=LÆS(25,17)*100;
  26: SALDOKØB(7):=LÆS(65,17)*100;
  27: SALDOKØB(9):=LÆS(25,18)*100;
   28: REPEAT
       GOTOXY(69,18);READLN;READ(NR(11))
       UNTIL IORESULT=0;
   29: REPEAT
       GOTOXY(31,19);READLN;READ(NR(12))
       UNTIL IORESULT=0;
   30: BEGIN REPEAT
       R:=LÆS(64,19)
       UNTIL (R>800000.0) AND (R<850000.0);
       NR(13):=TRUNC(R/10000);
       NR(14):=TRUNC(R-NR(13)*10000.0)
       END;
   31: REPEAT
       GOTOXY(31,20);READLN;READ(NR(19))
       UNTIL IORESULT=0;
   32: REPEAT
       GOTOXY(71,20);READLN;READ(NR(20))
       UNTIL IORESULT=0;
   33: BEGIN
       INCH(36,21);
       IF (CHAR1='N') OR (CHAR1='n') THEN NR(23):=0 ELSE NR(23):=1
       END;
   34: BEGIN REPEAT
       R:=LÆS(65,21)
       UNTIL (R>9999) AND (R<100000.0);
       NR(21):=TRUNC(R/10000);
       NR(22):=TRUNC(R-NR(21)*10000.0)
       END;
    END
END;
BEGIN
  IF O<=15 THEN OPL1 ELSE OPL2
END;
PROCEDURE ZERREC;
BEGIN
  WITH KUNDE DO
  BEGIN
       FOR I:=1 TO 23 DO NR(I):=0;
       FOR I:=1 TO 9 DO SALDOKØB(I):=0.0;
       FILLCHAR(NAVN(1),30,' ');
       FILLCHAR(NAVN(2),30,' ');
       FILLCHAR(NAVN(3),30,' ');
       FILLCHAR(LANDSBY,20,' ');
       FILLCHAR(POSTNR,25,' ');
       FILLCHAR(TLF,10,' ');
  END
END;
PROCEDURE MAINTAIN;
VAR EXC,I,O,P,KODE:INTEGER;
    CHANGED:BOOLEAN;
    STRENG:STRING;
    STRENG1:STRING(10);
BEGIN
  (*INDLÆS KODE1 OG KODE2 FRA SYSREG*)
  CLEARSCREEN;
  GOTOXY(1,1);WRITELN('ADGANGSKODE');
  GOTOXY(20,1);READLN;READ(STRENG1);
  KODE:=0;
  IF STRENG1=KODE1 THEN KODE:=1;
  IF STRENG1=KODE2 THEN KODE:=2;
  REPEAT
  REPEAT
 GOTOXY(1,22);WRITELN('OPRETTE, KIKKE ELLER SLETTE (1/2/3), 0 FOR STOP   ');
       GOTOXY(50,22);READLN;READ(P)
  UNTIL (IORESULT=0) AND((P=1) OR (P=2) OR (P=0) OR (P=3));
  CASE P OF
    1: IF ÆNDRE=1 THEN BEGIN
        ZERREC;
        PRKUNOPL(-1,KODE);
        FOR I:=2 TO 8 DO KUNDOPL(I);
        PRKUNOPL(-1,KODE);
        REPEAT
         GOTOXY(1,22);WRITELN('ÆNDRINGER, 0 FOR NEJ ELLERS FELTNR         ');
         GOTOXY(40,22);READLN;READ(O);
         IF ((O>1) AND (O<=18))  THEN KUNDOPL(O);
         PRKUNOPL(O,KODE)
        UNTIL O=0;
        KNAVN:='    ';
        FOR I:=1 TO 4 DO KNAVN(I):=KUNDE.NAVN(1,4+I);
        NANU(KNAVN,N1,N2);
        KUNDE.NR(1):=N1;
        KUNDE.NR(2):=N2;
        EXC:=0;
        REPEAT
        INSERT(KZ.H,F,KUNDE.A);
        IF IER=-7 THEN
        BEGIN
          KUNDE.NR(2):=KUNDE.NR(2)+1;
          EXC:=EXC+1;
          IF KUNDE.NR(2)=10000 THEN
          BEGIN
            KUNDE.NR(1):=KUNDE.NR(1)+1;
            KUNDE.NR(2):=0
          END
        END
        ELSE
        IF IER<>0 THEN ERROR
        UNTIL IER=0;
        PRKUNOPL(1,KODE);
        IF EXC>SYSFIL^.HELTAL(4) THEN SYSFIL^.HELTAL(4):=EXC;
       END;
    2: BEGIN
          FINDKUND;
         IF R<>0.0 THEN
         BEGIN
         PRKUNOPL(-1,KODE);
         CHANGED:=FALSE;
         REPEAT
         REPEAT
          GOTOXY(1,22);WRITELN('HVILKET FELT SKAL ÆNDRES, 0 FOR SLUT      ');
          GOTOXY(40,22);READLN;READ(O)
         UNTIL (IORESULT=0) AND ((O=0) OR (ÆNDRE=1));
         CASE O OF
19,20,21,22,23,24,25,26,27,28,29,30: BEGIN
                               GOTOXY(1,23);
                               WRITELN('ÆNDRING IKKE TILLADT');
                               GOTOXY(25,23);
                               WRITELN('TRYK RETURN NÅR FORSTÅET');
                               GOTOXY(60,23);READLN;READ(STRENG);
                               IF STRENG='A' THEN
                               BEGIN
                                 KUNDOPL(O);CHANGED:=TRUE
                               END
                         END;
10,11,12,13,14,15,16,17,18,31,32,33: IF KODE=2 THEN
                           BEGIN
                             KUNDOPL(O);CHANGED:=TRUE
                           END ELSE
                     BEGIN GOTOXY(1,23);
                     WRITELN('ÆNDRING IKKE TILLADT MED OPGIVEN ADGANGSKODE');
                     END;
3,4,5,6,7,8,9 :BEGIN KUNDOPL(O);CHANGED:=TRUE END
               END;
         PRKUNOPL(O,KODE)
         UNTIL O=0;
         IF CHANGED THEN PUTREC(KZ.H,F,KUNDE.A);
         END
      END;
   3: IF ÆNDRE=1 THEN BEGIN
        FINDKUND;
        IF R<>0.0 THEN
        BEGIN
          PRKUNOPL(-1,KODE);
          IF KODE=2 THEN
          WITH KUNDE DO
          BEGIN
               REPEAT
               GOTOXY(1,23);WRITELN('SKAL SLETNING UDFØRES (1), 0 FOR NEJ ');
               GOTOXY(40,23);READLN;READ(O)
               UNTIL IORESULT=0;
               IF O=4711 THEN
               BEGIN
                 DELETE(KZ.H,F,KUNDE.A);
                 PRKUNOPL(-1,KODE);
                 IF IER<>0 THEN ERROR
               END
            END
            ELSE
            BEGIN
               GOTOXY(1,23);
               WRITELN('SLETNING MÅ IKKE UDFØRES MED OPGIVEN NØGLE')
            END
         END
      END
   END
   UNTIL P=0
END;
BEGIN
  CLEARSCREEN;
  WRITELN('0 Kikke, 1 Ændre');
  REPEAT
    GOTOXY(18,1);
    READLN;READ(ÆNDRE)
  UNTIL (IORESULT=0) AND (ÆNDRE>=0) AND (ÆNDRE<=1);
 
  FILNAVN2:='KUNDERG:P2:0000:I';
  IF ÆNDRE=1 THEN
    REWRITE(F,FILNAVN2) ELSE RESET(F,FILNAVN2);
  IF ÆNDRE=1 THEN
    IOPEN(KZ.H,F,SKRIV) ELSE IOPEN(KZ.H,F,LÆS);IF IER<>0 THEN OFEJL;
  FILNAVN1:='SYSREG:P2:1:I';
  REWRITE(SYSFIL,FILNAVN1);
  SEEK(SYSFIL,1);
  GET(SYSFIL);
  KODE1:='          ';
  KODE2:=KODE1;
  FOR I:=1 TO 10 DO
  BEGIN
    KODE1(I):=SYSFIL^.KODE(1,I);
    KODE2(I):=SYSFIL^.KODE(2,I)
  END;
IF IER<>0 THEN WRITE('IOPEN ',IER) ELSE
BEGIN
  IF KZ.H.RECINUSE<1 THEN INITIATE(KZ.H,F,1);
  MAINTAIN;
END;
  ICLOSE(KZ.H,F);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER);
  SEEK(SYSFIL,1);
  PUT(SYSFIL);
  CLOSE(SYSFIL);
  CHAIN('INTRE   *1','HOVSA:P1',QUQ)
END.
DataMuseum.dk

MIKADOS

⟦fd175456a⟧

Derivation

Text
