DataMuseum.dk

top - download

    Length: 9984 (0x2700)
    Types: TextFile
    Notes: Mikados_K
    Names: »OHOVSA.K«

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

Mikados K File

PROGRAM HOVSA;
CONST LNGTH=20;
TYPE   PROCSTAT=RECORD
       NP:INTEGER;
       NROSTART:INTEGER
       END;
NPFILE = FILE OF PROCSTAT;
PARMARRAY=PACKED ARRAY (1..40) 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;
VAR    PARM:^PARMARRAY;
       CLOCK:^CLOCKRECORD;
       SV,TT,OFFSET,MIN,SEC,SEC100:INTEGER;
       HOWL,ALARM,STOPWATCH:BOOLEAN;
       ALARMTIME:PACKED ARRAY (1..8) OF CHAR;
       DBUF:DIRECTBUF;
       C,CH :CHAR;
       F:STRING(11);
       NRPF,CF:NPFILE;
       QUQ:^INTEGER;
       I,SKIFT:INTEGER;
       FIL:STRING(20);
PROCEDURE SETUP(VAR BUFFER:DIRECTBUF;LENGTH:INTEGER);
EXTERNAL;
FUNCTION AVAIL:BOOLEAN;
EXTERNAL;
FUNCTION NEXT:CHAR;
EXTERNAL;
PROCEDURE FINIS;
EXTERNAL;
PROCEDURE UR;
BEGIN
  SETUP(DBUF,LNGTH);
  C:=' ';
  GOTOXY(62,1);WRITE('Alarm');
  IF ALARM THEN BEGIN GOTOXY(72,1);WRITE(ALARMTIME) END;
  GOTOXY(62,2);WRITE('Time');
  SV:=-1;
  REPEAT
  IF C<>CLOCK^.TIME(8) THEN
  BEGIN
    GOTOXY(67,2);
    WRITE(CLOCK^.TIME);
    C:=CLOCK^.TIME(8);
    OFFSET:=TIME;
  END;
  GOTOXY(76,2);
  WRITE((TIME-OFFSET) MOD 100:4);
  IF STOPWATCH THEN
  BEGIN
    IF (TIME<0) AND (TT>0) THEN
      SEC100:=SEC100+(32767-TT)+(32767+TIME+2)
    ELSE
      SEC100:=SEC100+TIME-TT;
    TT:=TIME;
    SEC:=SEC+SEC100 DIV 100;SEC100:=SEC100 MOD 100;
    MIN:=MIN+SEC DIV 60;    SEC:=SEC MOD 60;
    GOTOXY(60,3);
    WRITE(MIN:4,SEC:3,SEC100:3);
  END;
  IF ALARM THEN IF ALARMTIME<=CLOCK^.TIME THEN HOWL:=TRUE;
  IF HOWL THEN WRITE(CHR(7));
  IF AVAIL THEN
  BEGIN
    CH:=NEXT;
    CASE CH OF
    'S':BEGIN
          STOPWATCH:=NOT(STOPWATCH);
          IF STOPWATCH THEN BEGIN MIN:=0;SEC:=0;SEC100:=0;TT:=TIME END;
        END;
    'U':BEGIN GOTOXY(67,2);FOR I:=1 TO 8 DO CLOCK^.TIME(I):=NEXT END;
    'C':BEGIN STOPWATCH:=TRUE;TT:=TIME END;
'0','1','2','3','4','5','6','7','8','9':BEGIN FINIS;SV:=ORD(CH)-48 END;
    'M':BEGIN
          GOTOXY(70,3);
          IF STOPWATCH THEN
             WRITE(MIN:4,SEC:3,SEC100:3);
        END;
    'A':BEGIN
          HOWL:=FALSE;
          ALARM:=NOT(ALARM);
          CLOCK^.DATE(9):='0';
          IF ALARM THEN
          BEGIN
            CLOCK^.DATE(9):='1';
            GOTOXY(72,1);
            FOR I:=1 TO 8 DO BEGIN CLOCK^.DATE(I):=NEXT;
                                   ALARMTIME(I):=CLOCK^.DATE(I)
                             END;
            GOTOXY(72,1);WRITE(ALARMTIME)
          END;
        END;
    END;
  END;
  UNTIL SV>-1
END;
PROCEDURE LIST;
      BEGIN
        WRITELN(' ':20,'1 Messeoversigt');
        WRITELN;
        WRITELN(' ':20,'2 Disponeringsliste');
        WRITELN;
        WRITELN(' ':20,'3 Varelister');
        WRITELN(' ':20,'4 Prismærkater');
        WRITELN;
        WRITELN(' ':20,'5 Kundeliste');
        WRITELN(' ':20,'6 Alfabetisk kundeliste');
        WRITELN(' ':20,'7 Labels');
        WRITELN(' ':20,'8 Saldoliste');
        WRITELN;
        WRITELN(' ':20,'9 Restordreoversigt');
        WRITELN(' ':20,'10 Kunders restordrer');
        GOTOXY(1,20);WRITELN('Vælg 1-10');
        REPEAT
           GOTOXY(11,20);READLN;READ(I)
        UNTIL (IORESULT=0) AND (I>-1) AND (I<11);
        IF I>0 THEN
          SKIFT:=1;
        CASE I OF
        1: F:='MESSEKIK:P1';
        2: F:='DISPLIST:P1';
        3: F:='LISTKOMP:P1';
        4: F:='VARLAB:P1';
        5: F:='DUMPKUND:P1';
        6: F:='ALFAKUND:P1';
        7: F:='KNUDELBO:P1';
        8: F:='SALDOLIS:P1';
        9: F:='RESTOVER:P1';
        10: F:='KUNDREST:P1';
        END;
      END;
PROCEDURE SPØRG;
       BEGIN
        WRITELN(' ':20,'1 Vareregister');
        WRITELN(' ':20,'2 Kunderegister');
        WRITELN(' ':20,'3 Ordreregister');
        WRITELN(' ':20,'4 Restordreregister');
        WRITELN(' ':20,'5 Leverandørregister');
        WRITELN(' ':20,'6 Landeregister');
        WRITELN(' ':20,'7 Systemregister');
        WRITELN(' ':20,'8 Tekstregister');
        WRITELN(' ':20,'9 Betalingsadresseregister');
        WRITELN(' ':20,'10 Toldpositionsregister');
        WRITELN;
        WRITELN(' ':20,'Kontospørgeprogrammer');
        WRITELN(' ':20,'11 Saldostatistik');
        WRITELN(' ':20,'12 Kontoudtog');
        GOTOXY(1,20);WRITELN('Vælg 1-12');
        REPEAT
           GOTOXY(11,20);READLN;READ(I)
        UNTIL (IORESULT=0) AND (I>-1) AND (I<13);
        CASE I OF
        1: F:='VAREVEDL:P1';
        2: F:='KUNDVEDL:P1';
        3: F:='ORDREVED:P1';
        4: F:='RESTVEDL:P1';
        5: F:='LEVVEDL:P1';
        6: F:='LANDVEDL:P1';
        7: F:='SYSVEDL:P1';
        8: BEGIN F:='TEKSTVED:P1'; SKIFT:=1 END;
        9: F:='BTAVEDL:P1';
        10:F:='TOLDVEDL:P1';
        11: F:='SALDSTAT:P1';
        12: F:='KONTUDT:P1';
        END
      END;
PROCEDURE DOIT;
BEGIN
    WRITELN(' ':20,'0 Stop');
    WRITELN;
    WRITELN(' ':20,'1 Ordreindtastning');
    WRITELN(' ':20,'2 Pakkelisteudskrivning');
    WRITELN(' ':20,'3 Fakturering');
    WRITELN;
    WRITELN(' ':20,'4 Indbetalinger');
    WRITELN(' ':20,'5 Kreditnotaer');
    WRITELN;
    WRITELN(' ':20,'6 Periodeafslutninger');
    WRITELN;
    WRITELN(' ':20,'7 Spørgeprogrammer og kartoteksvedligeholdelse');
    WRITELN;
    WRITELN(' ':20,'8 Listeprogrammer');
    WRITELN;
    WRITELN(' ':20,'9 Indkøb');
    GOTOXY(1,20);WRITELN('Vælg 0-9 ');
    UR;
    I:=SV;
    CLEARSCREEN;
    CASE I OF
    1: F:='INDORDRE:P1';
    2: F:='PAKLISTE:P1';
    3: F:='FAKTURA:P1';
    4: F:='KASSERAP:P1';
    5: F:='KREDNOTA:P1';
    6: BEGIN
         WRITELN(' ':20,'1 Faktureringsjournal');
         WRITELN(' ':20,'2 Bogholderijournal');
         WRITELN(' ':20,'3 Månedsafslutning');
         WRITELN(' ':20,'4 Renteberegning');
         WRITELN(' ':20,'5 Rente-postering');
         WRITELN(' ':20,'6 Årsafslutning');
         GOTOXY(1,20);WRITELN('Vælg 1-6');
         REPEAT
           GOTOXY(11,20);READLN;READ(I)
         UNTIL (IORESULT=0) AND (I>-1) AND (I<7);
         IF I>2 THEN SKIFT:=1;
         CASE I OF
         1: F:='TESTJOU:P1';
         2: F:='BOGJOU:P1';
         3: F:='MAFSLUT:P1';
         4: F:='RENTEBER:P1';
         5: F:='RENTEBEK:P1';
         6: F:=' ';
         END
       END;
    7: SPØRG;
    8:LIST;
    9:BEGIN
        WRITELN(' ':20,'1 Varebestilling');
        WRITELN(' ':20,'2 Varehjemkomst');
        GOTOXY(1,20);WRITELN('Vælg 1-2');
        REPEAT
           GOTOXY(11,20);READLN;READ(I)
        UNTIL (IORESULT=0) AND (I>-1) AND (I<3);
        CASE I OF
        1: F:='BESTVARE:P1';
        2: F:='HJEMVARE:P1';
        END
      END;
    0: F:='STOP';
    END;
END;
BEGIN
  ALARM:=CLOCK^.DATE(9)='1';
  IF ALARM THEN FOR I:=1 TO 8 DO ALARMTIME(I):=CLOCK^.DATE(I);
  HOWL:=FALSE;STOPWATCH:=FALSE;
  FIL:='PROCSTAT:P2:0:I';
  (*$C-*)
  REPEAT
  REWRITE(NRPF,FIL);
  SEEK(NRPF,1);
  UNTIL IORESULT=0;
  (*$C+*)
  GET(NRPF);
  IF NRPF^.NP=0 THEN NRPF^.NP:=1;
  IF NRPF^.NP=-1 THEN
  BEGIN
    F:='OPSTART:P1';
    CLOSE(NRPF)
  END
  ELSE
  BEGIN
    NRPF^.NP:=NRPF^.NP-1;
    SEEK(NRPF,1);
    PUT(NRPF);
    CLOSE(NRPF);
    REPEAT
      F:=' ';
      SKIFT:=2;
      CLEARSCREEN;
      DOIT;
      IF  F<>' ' THEN
      REPEAT
        (*$C-*)
        REPEAT
          REWRITE(NRPF,FIL);
          SEEK(NRPF,1);
        UNTIL IORESULT=0;
        (*$C+*)
        GET(NRPF);
        CASE NRPF^.NP OF
        0:IF SKIFT=1 THEN
          BEGIN
            REPEAT
            GOTOXY(1,20);
            WRITELN('Sæt plade 3 i drev 1 og tryk RETURN');
            SKIFT:=0;
            READLN;
            NRPF^.NP:=3;
(*$C-*)
            REWRITE(CF,'C3:P1:0:J');
            SEEK(CF,1)
(*$C+*)
            UNTIL IORESULT=0;
            CLOSE(CF)
          END
          ELSE
          BEGIN
            IF F='STOP' THEN NRPF^.NP:=-1 ELSE NRPF^.NP:=1;
            SKIFT:=0
          END;
        1:IF (SKIFT=1) OR (F='STOP') THEN
          BEGIN
            CLOSE(NRPF);
            GOTOXY(1,20);
            WRITELN('Vil du vente til anden bruger er færdig ? (J/N) ');
            REPEAT
              GOTOXY(50,20);READLN;READ(CH)
            UNTIL (CH='J') OR (CH='N') OR (CH='n') OR (CH='j');
            IF (CH='N') OR (CH='n') THEN
            BEGIN
              SKIFT:=0;F:=' '
            END
            ELSE
            BEGIN
              GOTOXY(1,20);WRITELN('Tryk RETURN når klar');READLN
            END;
          END
          ELSE
          BEGIN
            NRPF^.NP:=2;SKIFT:=0
          END;
        3:BEGIN
            CLOSE(NRPF);
            GOTOXY(1,20);
            WRITELN('Vil du vente til anden bruger er færdig ? (J/N) ');
            REPEAT
              GOTOXY(50,20);READLN;READ(CH)
            UNTIL (CH='J') OR (CH='N') OR (CH='n') OR (CH='j');
            IF (CH='N') OR (CH='n') THEN
            BEGIN
              SKIFT:=0;F:=' '
            END
            ELSE
            BEGIN
              GOTOXY(1,20);WRITELN('Tryk RETURN når klar');READLN
            END;
          END;
       -1:BEGIN
            SKIFT:=0;
            IF F<>'STOP' THEN NRPF^.NP:=1
          END
        END;
      UNTIL SKIFT=0;
    UNTIL F<>' ';
REPEAT
(*$C-*)
    SEEK(NRPF,1);
    I:=IORESULT;
    IF I<>0 THEN WRITELN('Plade 2 må ikke røres, sæt den nu i drev 2');
(*$C+*)
UNTIL I=0;
    PUT(NRPF);
    CLOSE(NRPF);
  END;
  IF F<>'STOP' THEN
  CHAIN('INTRE   *1',F,QUQ)
END.