DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦90b106744⟧ TextFile

    Length: 20224 (0x4f00)
    Types: TextFile
    Notes: Mikados_K
    Names: »KUNDVEDL.K«

Derivation

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »KUNDVEDL.K« 
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
    └─⟦this⟧ »KUNDVEDL.K« 

Mikados K File

PROGRAM KUNDVEDL;
(*TILPASSES TIL SPECIELLE REGISTERVEDLIGEHOLDELSER, HÆGTER OSV.*)
CONST LNGTH=20;
      TIMER=120;
      MAXRECSIZE=1000;
(*@@*)
      PROGRAMNR=3;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
DIRECTBUF=PACKED ARRAY (1..LNGTH) OF CHAR;
CLOCKRECORD = RECORD
               DATE:PACKED ARRAY (1..10) OF CHAR;
               TIME:PACKED ARRAY (1..8) OF CHAR
              END;
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
POSTADR=0..MAXRECSIZE;
COMMBUF =ARRAY (POSTADR) OF INTEGER;(*commbuf(0)=filnr,resten er posten*)
POINTREC=^COMMBUF;
NAME    =STRING(10);
PCB     =^INTEGER;
MESSAGETYPE=(ÅBEN,LUK,LÆSPOST,LÆSPOSTX,NÆSTE,NÆSTEX,SLET,SLETX,GEMPOST,
             INDSÆT,INITIER,UTILMELD,UAFMELD,PTILMELD,PAFMELD,STOPSYS,        
             RETURNHEAD,RETURNSTAT);                                    
MESSAGE =RECORD
           KOMMANDO:MESSAGETYPE;
           INFO,IREC:INTEGER 
         END;
AR=ARRAY (-4..-4) OF INTEGER;
VAR    PARM:^PARMARRAY;
       CLOCK:^CLOCKRECORD;
       STIMER,SV,TT,OFFSET,MIN,SEC,SEC100:INTEGER;
       TÆNDT,HOWL,ALARM,STOPWATCH:BOOLEAN;
       ALARMTIME:PACKED ARRAY (1..8) OF CHAR;
       DBUF:DIRECTBUF;
       USERNIVEAU:NIVEAU;
       F:STRING(18);
       QUQ:^INTEGER;
       IER,IREC,STATUSER,MODE,REMUSERS,
       FILNR,I:INTEGER;
       FNAVN,REGNAVN,DESCNAVN:STRING(18);
       SEMAFOR:NAME;
       FILEINIT:BOOLEAN;
       SNYD:AR;
       CPPCB:PCB;
       COMREC:POINTREC;
       BESKED:MESSAGE;
(*$P*)
(*$L-*)
PROCEDURE BAD(IDENT,STATUS:INTEGER);
BEGIN
  GOTOXY(1,23);
  WRITE('BAD',IDENT:5,STATUS:5);
  READLN
END;
(*$P*)
PROCEDURE SETUP(VAR BUFFER:DIRECTBUF;LENGTH:INTEGER);
EXTERNAL;
FUNCTION AVAIL:BOOLEAN;
EXTERNAL;
FUNCTION NEXT:CHAR;
EXTERNAL;
PROCEDURE FINIS;
EXTERNAL;
PROCEDURE ALLOCA(VAR ADDRESS:POINTREC;LENGTH:INTEGER;
                 VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE DEALLO(ADDRESS:POINTREC;VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE SENDM(RECEIVER:PCB;VAR CONTENTS:MESSAGE;
                LENGTH:INTEGER;VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE RECEIV(VAR SENDER:PCB;VAR CONTENTS:MESSAGE;
                 VAR LENGTH:INTEGER);
EXTERNAL;
PROCEDURE RESERV(RESOURCE:NAME;EXCLUSIVE,WAIT:BOOLEAN;
                 VAR STATUS:INTEGER);
EXTERNAL;
PROCEDURE RELEAS(RESOURCE:NAME;VAR STATUS:INTEGER);
EXTERNAL;
(*$L+*)
(*$IRESPRINT*)
(*$P*)
(*$IUR*)
(*$L-*)
(*$P*)
(*$IUDFØR*)
(*$IFISFPROC*)
(*$P*)
(*$L+*)
PROCEDURE REGVEDL;
CONST MAXFELTER=30;
      MAXNØGLER=9;
(*@@*)
      MAXPOST=80; 
      MAXHÆGTER=3;
      MAXHPOST=20;
      MAXIDENT=9;
TYPE
NFELT=^FELTBESKRIVELSE;
SKÆRMPOS=RECORD
   X,Y:INTEGER
END;
FTYPE=(HELTAL,DOBBTAL,REEL,TEKST);
VTYPE=(HINTERVAL,DINTERVAL,RINTERVAL,DATO,CPR);
BESKRIVELSESTYPE=(FELTDESC,VALIDESC);
FELTBESKRIVELSE=RECORD
   NÆSTEVAL:NFELT;
   FELTNAVN:STRING(8);
   CASE DESCTYPE:BESKRIVELSESTYPE OF
   FELTDESC:
  (INDPOS,UDPOS:SKÆRMPOS;
   KIKKENIVEAU,ÆNDRENIVEAU:NIVEAU;
   EDITERING:INTEGER;
   LEDETEKST,FØLGETEKST:STRING;
   INDEKS,
   LÆNGDE,
   HÆGTE,
   FORAN0:INTEGER;
   CASE FELTTYPE:FTYPE OF
   REEL:(DEC:INTEGER);
   HELTAL,DOBBTAL,TEKST:());
   VALIDESC:
  (CASE VALIDITETSTYPE:VTYPE OF
      HINTERVAL:(MIN,MAX:INTEGER);
      DINTERVAL:(MIN1,MIN2,MAX1,MAX2:INTEGER);
      RINTERVAL:(RMIN,RMAX:REAL);
      DATO,CPR:())
END;
ARAR=PACKED ARRAY (-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
LONGINT = ARRAY (1..2) OF INTEGER;
(*@@EVT. TOTAL POSTERKLÆRING,FLERE POSTER*)
PPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
  KUNDENR             :LONGINT;
  DATO                :ARRAY (1..3) OF LONGINT;
  POSTNR,
  ARETUR,
  AMANKO,
  ABYTTE,
  MBLACK,
  MORDRE,
  MKVALI              :INTEGER;
  SELECTKEY           :ARRAY (1..10) OF INTEGER;
  NAVN1,
  NAVN2,
  GADE                :PACKED ARRAY (1..30) OF CHAR 
END;
HPOST=RECORD
      AA:ARAR;
      A:AR;
      AAA:RAR;
      CONTENTS: ARRAY (1..MAXHPOST) OF INTEGER
END;
SYSPOST = RECORD
  AA:ARAR;
  A:AR;
  AAA:RAR;
  GEBYR               :REAL;
  DAGSDATO,
  NKUNDENR,
  NEKRAVSNR           :LONGINT;
  NR                  :INTEGER;
  UDSEKODE            :PACKED ARRAY (1..4) OF CHAR
END;
BYPOST  = RECORD
  AA:ARAR;
  A:AR;
  AAA:RAR;
  POSTNR              :INTEGER;
  BYNAVN              :PACKED ARRAY (1..30) OF CHAR
END;
VAR FELT:NFELT;
    HUSKNIV:NIVEAU;
    PICTURE:ARRAY (1..MAXFELTER) OF NFELT;
    NØGLER:ARRAY (1..MAXNØGLER) OF NFELT;
    HÆGTER:ARRAY (1..MAXHÆGTER) OF NFELT;
    IDENT:ARRAY (1..MAXIDENT) OF NFELT;
    ANTALIDENT,
    LINES,OPTION,I,J,ANTALFELTER,ANTALNØGLER,ANTALHÆGTER:INTEGER;
    LINE:STRING;
    POST:PPOST;
    HÆGTEREC:ARRAY (1..MAXHÆGTER) OF HPOST;
    SYSTEM:SYSPOST;
    BYFIL:BYPOST;
    LONGNUL:LONGINT;
(*$P*)
PROCEDURE ERROR(VAR REC:AR);
VAR CH:STRING(1);
    I:INTEGER;
BEGIN
  IF LINES>0 THEN PAGE(LIST);                                          (*$R-*)
  WRITELN('FEJL I REGISTER ',REC(-3),' FEJLKODE ',IER,' RETURN');      (*$R+*)
  CH:=' ';EDIT(CH);
  ICLOSE(POST.A);
  FOR I:=1 TO ANTALHÆGTER DO ICLOSE(HÆGTEREC(I).A);
  ICLOSE(SYSTEM.A);
  ICLOSE(BYFIL.A);
(*@@LUK EVT. ANDRE DATAFILER*)
  EXIT(REGVEDL)
END;
(*$P*)
(*$L-*)
(*$IHLÆSDESC*)
(*$P*)
(*$IMOVETOLI*)
(*$P*)
(*$L+*)
PROCEDURE MAINTAIN;
VAR J,NØGLENR,HNR,HINDEKS:INTEGER;
    HCHANGED,HÆGTSØG:BOOLEAN;
    CH:STRING(1);
(*$P*)
(*$L-*)
(*$ISØGPOST*)
(*$P*)
(*$L+*)
PROCEDURE UDPÅLIST;
VAR CH:STRING(1);
    AEKS,EKS:INTEGER;
BEGIN
  REPEAT
    CH:='E';
    GOTOXY(1,23);
    WRITE('Listeudskrift eller Etiketter, L/E ');EDIT(CH)
  UNTIL CH(1) IN (.'L','E','l','e'.);
  REPEAT
    GOTOXY(1,23);WRITE(' ':79);
    GOTOXY(1,23);
    WRITELN('Antal poster, 0 for fortryd 1');
    GOTOXY(29,23);
    READLN;
    IF EOLN THEN
    BEGIN
      SETIORESULT(0);J:=1
    END
    ELSE READ(J)
  UNTIL (IORESULT=0) AND (J>=0);
  IF J=0 THEN EXIT(UDPÅLIST);
  IF CH(1) IN (.'L','l'.) THEN
  BEGIN
    REPEAT
      IF (LINES+2+ANTALFELTER)>=72 THEN
      BEGIN
        IF LINES<>100 THEN PAGE(LIST);
        WRITELN(LIST,REGNAVN,' UDSKRIFT');
        WRITELN(LIST);
        LINES:=2
      END;
      PRINTPOST;
      J:=J-1;
      WRITELN(LIST);WRITELN(LIST);LINES:=LINES+2;
      NEXTREC(POST.A);
      IF (IER=-2) AND (J>0) THEN IER:=0
    UNTIL (J=0) OR (IER<>0);
    IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN
       ERROR(POST.A) ELSE IER:=0
  END
  ELSE
  BEGIN
    REPEAT
      GOTOXY(1,23);WRITE(' ':79);
      GOTOXY(1,23);
      WRITE('Antal eksemplarer ');
      READLN;READ(EKS)
    UNTIL (IORESULT=0) AND (EKS>0) AND (EKS<20);
    IOPEN(BYFIL.A);IF IER<>0 THEN ERROR(BYFIL.A);
    REPEAT
      BYFIL.POSTNR:=POST.POSTNR-1;
      NEXTREC(BYFIL.A);IF NOT (-IER IN (.0,1,2.)) THEN ERROR(BYFIL.A);
      AEKS:=0;  
      REPEAT
        WRITELN(LIST);
        WRITELN(LIST);
        WRITELN(LIST,POST.KUNDENR(1)*10000.0+POST.KUNDENR(2):25:-2);
        WRITELN(LIST,POST.NAVN1);
        WRITELN(LIST,POST.NAVN2);
        WRITELN(LIST,POST.GADE);
        WRITELN(LIST,POST.POSTNR,' ',BYFIL.BYNAVN);
        WRITELN(LIST);
        WRITELN(LIST);
        AEKS:=AEKS+1
      UNTIL AEKS=EKS;
      J:=J-1;
      NEXTREC(POST.A);
      IF (IER=-2) AND (J>0) THEN IER:=0
    UNTIL (J=0) OR (IER<>0);
    IF NOT (-IER IN (.0,2,9.)) THEN ERROR(POST.A) ELSE IER:=0;
    ICLOSE(BYFIL.A)
  END
END;
(*$P*)
PROCEDURE SLETPOST;
BEGIN
             GOTOXY(1,20);
             CH:='J';
             WRITELN('Sletning korrekt J/N');
             GOTOXY(22,20);EDIT(CH);
             IF CH='J' THEN
             BEGIN
               FOR HNR:=1 TO ANTALHÆGTER DO
               BEGIN
                 SÆTHÆGTE;
                 SÆTNØGLE
               END;
               DELETE(POST.A);
               IF IER=-9 THEN
               BEGIN
                 WRITELN('Eneste post, kan ikke slettes, RETURN');
                 READLN;
                 IER:=0
               END 
               ELSE
               FOR HNR:=1 TO ANTALHÆGTER DO
               BEGIN
                 IOPEN(HÆGTEREC(HNR).A);
                 IF IER<>0 THEN ERROR(HÆGTEREC(HNR).A);
                 GETRECX(HÆGTEREC(HNR).A);
                 IF NOT (-IER IN (.0,6.)) THEN ERROR(HÆGTEREC(HNR).A);
                 DELETE(HÆGTEREC(HNR).A);
                 IF NOT (-IER IN (.0,6.)) THEN ERROR(HÆGTEREC(HNR).A);
                 IER:=0;
                 ICLOSE(HÆGTEREC(HNR).A) 
               END
             END
             ELSE GETREC(POST.A);
             IF IER<>0 THEN ERROR(POST.A)
END;
(*$P*) 
PROCEDURE OPNNR;
BEGIN
  SYSTEM.NR:=1;
  GETRECX(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A);
  POST.KUNDENR:=SYSTEM.NKUNDENR;
  IF SYSTEM.NKUNDENR(2)=9999 THEN
  BEGIN
    SYSTEM.NKUNDENR(2):=0;
    SYSTEM.NKUNDENR(1):=SYSTEM.NKUNDENR(1)+1
  END
  ELSE SYSTEM.NKUNDENR(2):=SYSTEM.NKUNDENR(2)+1;
  PUTREC(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A)
END;
(*$P*)
PROCEDURE OPRET;
BEGIN
  NULPOST;
  SKRIVPOST;
  FOR J:=1 TO ANTALFELTER DO
  BEGIN
    IF PICTURE(J)^.ÆNDRENIVEAU=UMULIUS THEN
    BEGIN
      HUSKNIV:=USERNIVEAU; 
      USERNIVEAU:=UMULIUS  
    END;
    LÆSFELT(PICTURE(J));
    SKRIVFELT(PICTURE(J));
    IF PICTURE(J)^.ÆNDRENIVEAU=UMULIUS THEN USERNIVEAU:=HUSKNIV;
    IF (J=1) AND (POST.KUNDENR=LONGNUL) THEN 
    BEGIN
      OPNNR;
      SKRIVFELT(PICTURE(1))
    END
  END;
  USERNIVEAU:=HUSKNIV;
  IF NOT FILEINIT THEN
  BEGIN
    FILEINIT:=TRUE;
    REPEAT
      GOTOXY(1,23);                          
      WRITELN('ANTAL INITIALISERINGSPOSTER');
      GOTOXY(30,23);                         
      READLN;READ(IREC)                         
    UNTIL (IORESULT=0) AND (IREC>0);
    INITIATE(POST.A);
    IF IER<>0 THEN ERROR(POST.A)
  END;
  INSERT(POST.A);
  IF IER<>0 THEN
  IF IER=-7 THEN
  BEGIN
    WRITELN('Posten findes, RETURN');READLN
  END
  ELSE ERROR(POST.A)
  ELSE (*@@EVT. INDSÆT/VEDL AF ANDRE POSTER*)
  FOR HNR:=1 TO ANTALHÆGTER DO 
  BEGIN
    IOPEN(HÆGTEREC(HNR).A);
    IF IER<>0 THEN ERROR(HÆGTEREC(HNR).A);
    SÆTHÆGTE;
    SÆTNØGLE;
    INSERT(HÆGTEREC(HNR).A);
    IF IER<>0 THEN ERROR(HÆGTEREC(HNR).A);
    ICLOSE(HÆGTEREC(HNR).A) 
  END
END;
(*$P*)
BEGIN (*MAINTAIN*)
      CLEARSCREEN;
      IF OPTION<>4 THEN
      BEGIN
        HUSKNIV:=USERNIVEAU;
        USERNIVEAU:=UMULIUS;
        NULPOST;
        HÆGTSØG:=FALSE;
        IF ANTALHÆGTER>0 THEN SØGPOST;
        IF NOT HÆGTSØG THEN
        BEGIN
          J:=1;
          LÆSFELT(NØGLER(J));
          WHILE (J<ANTALNØGLER) AND NOT EOF DO
          BEGIN
            J:=J+1;
            LÆSFELT(NØGLER(J))
          END;
          USERNIVEAU:=HUSKNIV;
          IF OPTION IN (.1,5.) THEN 
            GETRECX(POST.A) 
          ELSE
            GETREC(POST.A);
          IF (IER<>0) AND (IER<>-6) THEN ERROR(POST.A);
          IF EOF THEN
          BEGIN
            IF IER=-6 THEN
            BEGIN
              IF OPTION IN (.1,5.) THEN
                NEXTRECX(POST.A) 
              ELSE
                NEXTREC(POST.A);
              IF (IER<>-1) AND (IER<>-2) AND (IER<>-9) THEN
                ERROR(POST.A)
            END;
            REPEAT
              SKRIVPOST;
              GOTOXY(1,23);
              CH:='F';
              WRITELN('Rigtig post R, Flere poster F, Stop S');
              GOTOXY(39,23);
              EDIT(CH);
              IF CH(1) IN (.'f','r','s'.) THEN
                 CH(1):=CHR(ORD(CH(1))-32);
              IF CH='F' THEN
              BEGIN
                IF OPTION IN (.1,5.) THEN
                  NEXTRECX(POST.A) 
                ELSE
                  NEXTREC(POST.A);
                IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN
                  ERROR(POST.A)
              END
            UNTIL CH<>'F';
            GOTOXY(1,23);WRITELN(' ':77);
            IF (OPTION IN (.1,5.)) AND (CH<>'R') THEN GETREC(POST.A);
            (*FOR AT FJERNE XCLUSIV-STATUS*)
            IF OPTION=2 THEN CH:='S'
          END
          ELSE
          BEGIN
            IF IER=0 THEN
            BEGIN
              CH:='R';
              SKRIVPOST
            END
            ELSE
            BEGIN
              CH:='S';
              GOTOXY(1,23);WRITELN('Posten findes ikke, RETURN');
              GOTOXY(28,23);READLN
            END
          END
        END
      END;
      IF (OPTION=4) OR (CH='R') THEN
      CASE OPTION OF
        1: BEGIN
             REPEAT
               REPEAT
                 GOTOXY(1,23);
                 J:=0;
                 WRITELN('Feltnr, 0 for færdig ',J,' ':57);
                 GOTOXY(22,23);READLN;
                 IF NOT (EOLN OR (INPUT^=' ')) THEN READ(J)
               UNTIL (IORESULT=0) AND (J>=0) AND (J<=ANTALFELTER);
               IF J>0 THEN BEGIN    (*@@EVT. BEHANDLING AF ANDRE POSTER*)
                             HNR:=0;
                             IF PICTURE(J)^.HÆGTE>0 THEN
                             BEGIN
                               REPEAT
                                 HNR:=HNR+1
                               UNTIL PICTURE(J)^.HÆGTE=HÆGTER(HNR)^.HÆGTE;
                               SÆTHÆGTE; 
                             END;
                             LÆSFELT(PICTURE(J));SKRIVFELT(PICTURE(J));
                             HCHANGED:=FALSE;
                             IF HNR>0 THEN
                             BEGIN
                               CASE PICTURE(J)^.FELTTYPE OF           (*$R-*)
                               HELTAL :HCHANGED:=(HÆGTEREC(HNR).A(1)<>
                                                POST.A(PICTURE(J)^.INDEKS));
                               DOBBTAL:HCHANGED:=(
                                         (HÆGTEREC(HNR).A(1)<>
                                            POST.A(PICTURE(J)^.INDEKS)) OR
                                         (HÆGTEREC(HNR).A(2)<>
                                            POST.A(PICTURE(J)^.INDEKS+1)));
                               TEKST:FOR HINDEKS:=1 TO PICTURE(J)^.FORAN0 DO
                                       IF HÆGTEREC(HNR).AA(HINDEKS)<>
                                        POST.AA(PICTURE(J)^.INDEKS-1+HINDEKS)
                                       THEN HCHANGED:=TRUE
                               END
                             END;                                     (*$R+*)
                             IF HCHANGED THEN
                             BEGIN
                               IOPEN(HÆGTEREC(HNR).A);
                               IF IER<>0 THEN ERROR(HÆGTEREC(HNR).A);
                               SÆTNØGLE;    
                               GETRECX(HÆGTEREC(HNR).A);
                               IF IER=0 THEN DELETE(HÆGTEREC(HNR).A);
                               SÆTHÆGTE;
                               SÆTNØGLE;
                               INSERT(HÆGTEREC(HNR).A);
                               IF IER<>0 THEN ERROR(HÆGTEREC(HNR).A);
                               ICLOSE(HÆGTEREC(HNR).A) 
                             END
                           END
             UNTIL J=0;
             PUTREC(POST.A);
             IF IER<>0 THEN ERROR(POST.A)
           END;
        2: BEGIN GOTOXY(1,24);WRITE('Tryk RETURN ');READLN END;
        3: UDPÅLIST;
        4: OPRET;
        5: SLETPOST
      END
END;
(*$P*)
BEGIN (*REGVEDL*)
  LONGNUL(1):=0;
  LONGNUL(2):=0;
  CLEARSCREEN;
(*$XT*) WRITELN('MEMAVAIL ',MEMAVAIL); (*$X-*)
  LÆSDESC;
(*$XT*) WRITELN('MEMAVAIL ',MEMAVAIL);READLN; (*$X-*)
  MODE:=3;(*SKRIV*)
  LINES:=100;                                                          (*$R-*)
  SYSTEM.A(-4):=0;
  POST.A(-4):=0;
  BYFIL.A(-4):=0;
  BYFIL.A(-3):=4;
  SYSTEM.A(-3):=1;
  POST.A(-3):=FILNR;                                                   (*$R+*)
(*FOR I:=1 TO ANTALHÆGTER DO
  BEGIN
    IOPEN(HÆGTEREC(I).A);
    IF IER<>0 THEN ERROR(HÆGTEREC(I).A)
  END;*)
  IOPEN(POST.A);IF IER<>0 THEN ERROR(POST.A);
  IOPEN(SYSTEM.A);IF IER<>0 THEN ERROR(SYSTEM.A);
(*@@EVT. ÅBNING AF ANDRE ANDRE DATAFILER*)
  REPEAT
    CLEARSCREEN;
    GOTOXY(10,10);
    WRITELN(REGNAVN,' R E G I S T E R - V E D L I G E H O L D E L S E');
    GOTOXY(10,12);
    WRITELN('0 Færdig');
    WRITELN(' ':9,'1 Ændring');
    WRITELN(' ':9,'2 Udskrift på skærm');
    WRITELN(' ':9,'3 Udskrift på printer');
    WRITELN(' ':9,'4 Oprettelse');
    WRITELN(' ':9,'5 Sletning');
    REPEAT
      GOTOXY(10,19);
      WRITELN('Vælg 0-5');
      GOTOXY(21,19);UR;
      OPTION:=SV
    UNTIL (OPTION>=0) AND (OPTION<=5);
    IF OPTION>0 THEN MAINTAIN 
  UNTIL OPTION=0;
  IF LINES<>100 THEN PAGE(LIST);
  ICLOSE(POST.A);
  ICLOSE(SYSTEM.A);
(*FOR I:=1 TO ANTALHÆGTER DO ICLOSE(HÆGTEREC(I).A);*)
(*@@EVT. LUKNING AF ANDRE DATAFILER*)
  CLEARSCREEN 
END;
(*$P*)
BEGIN
  ALARM:=CLOCK^.DATE(9)='1';
  IF ALARM THEN FOR I:=1 TO 8 DO ALARMTIME(I):=CLOCK^.DATE(I);
  HOWL:=FALSE;STOPWATCH:=FALSE;TÆNDT:=FALSE;
  SEMAFOR:='ALLOCOMBUF';
  I:=ORD(PARM^(1))-48;
  USERNIVEAU:=MENIG;
  WHILE I>0 DO
  BEGIN
    USERNIVEAU:=SUCC(USERNIVEAU);
    I:=I-1
  END;                                                                 (*$R-*)
  SNYD(-3):=0;
  FOR I:=6 DOWNTO 2 DO SNYD(-3):=10*SNYD(-3)+ORD(PARM^(I))-48;
  IF PARM^(7)='-' THEN SNYD(-3):=-SNYD(-3);                            (*$R+*)
  UDFØR(PTILMELD,SNYD);
  UDFØRT(PTILMELD,SNYD);
  IF IER<>0 THEN BAD(1,IER);
(*@@TILPASSES*)
  (*$XA*)
  FILNR:=5;
  DESCNAVN:='KUNDDESC:P2:05:J';
  (*$X-*)
  (*$XB*)
  FILNR:=14;
  DESCNAVN:='KNUDDESC:P2:05:J';
  (*$X-*)
  (*$XC*)
  FILNR:=15;
  DESCNAVN:='KNUDDESC:P2:05:J';
  (*$X-*)
  REGNAVN:='Kunde';
  IF RESPRINT THEN
    REGVEDL;
  FREEPR;
  UDFØR(PAFMELD,SNYD);
  UDFØRT(PAFMELD,SNYD);
  IF IER<>0 THEN BAD(2,IER);
  FNAVN:='       ';
  FOR I:=1 TO 7 DO FNAVN(I):=PARM^(I);
  CHAIN('HOVED   *1',FNAVN,QUQ);
  IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.

Full view