DataMuseum.dk

top - download

    Length: 4992 (0x1380)
    Types: TextFile
    Notes: Mikados_K
    Names: »BESTVARE.K«

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

Mikados K File

PROGRAM BESTILLING;
(*$IISFHEAD*)
VPOST=RECORD
       A:AR;
       VARENR1,LVRNDØR,OPRLAND,PAKENHED,
       FORVLEVU,DATSBES1,DATSBES2,DATSORD1,DATSORD2,
       DÆKGRASÅ,ANAFTILG:INTEGER;
       NAVN:ARRAY(1..2) OF PACKED ARRAY (1..30) OF CHAR;
       PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
       RAIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD:REAL
END;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..451) OF INTEGER
 END;
 LEVPOST=RECORD
        A:AR;
        NR,
        SBESDAT1,SBESDAT2,
        LAND1,LAND2:INTEGER;
        KOSTPFAK:ARRAY(1..5) OF INTEGER;
        ÅKØB,SÅKØB,SALDO:REAL;
        NAVN1:PACKED ARRAY (1..40) OF CHAR;
        NAVN2,
        ADR1,
        ADR2:PACKED ARRAY (1..30) OF CHAR;
        BETABET,
        LANDSBY1,LANDSBY2: PACKED ARRAY (1..20) OF CHAR;
        POSTNR1,POSTNR2: PACKED ARRAY (1..25) OF CHAR;
        TLF1,TLF2: PACKED ARRAY (1..10) OF CHAR;
END;
 LEVZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..382) 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    FLEV,F:ISF;
       CH:CHAR;
       VZ:ZONE;
       LZ:LEVZONE;
       LEVER:LEVPOST;
FILNAVN1,FILNAVN2:STRING(20);
      IER,I:INTEGER;
       VARE:VPOST;
       SYSFIL:SYSFILE;
       KODE1,KODE2:STRING(10);
       R,R1:REAL;
       QUQ:^INTEGER;
 
 
 
 
 
 
 
 
 
 
 
 
 
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$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 REGISTER ',IER);
  ICLOSE(VZ.H,F);
  ICLOSE(LZ.H,FLEV);
  WRITELN('ICLOSE ',IER);
  STOP
END;
BEGIN
  FILNAVN2:='REGVARE:P1:1137:I';
  REWRITE(F,FILNAVN2);
  I:=IORESULT;
IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;
  IOPEN(VZ.H,F,SKRIV);
  FILNAVN2:='LEVERRG:P2:0000:I';
  REWRITE(FLEV,FILNAVN2);
  IOPEN(LZ.H,FLEV,SKRIV);IF IER<>0 THEN ERROR;
  FILNAVN1:='SYSREG:P2:1:I';
  REWRITE(SYSFIL,FILNAVN1);
  SEEK(SYSFIL,1);
  GET(SYSFIL);
R1:=0;
WRITELN(LIST,'BESTILTE VARER',' ':44,SYSFIL^.HELTAL(1)*10000.0+
                                     SYSFIL^.HELTAL(2):10:-2);
WRITELN(LIST);
WRITELN(LIST,'VARENR  ','VARENAVN',' ':25,'ANTAL',' ':3,'LEVERANDØR',
             '   LEVUGE','  KOSTPRIS');
IF IER<>0 THEN WRITE('IOPEN ',IER) ELSE
REPEAT
  CLEARSCREEN;
  WRITELN('VAREBESTILLINGER');
  WRITELN('VARENR, 0 FOR SLUT');
  REPEAT
    GOTOXY(20,2);
    READLN;READ(I)
  UNTIL IORESULT=0;
  IF I>0 THEN WITH VARE DO
  BEGIN
    VARENR1:=I;
    GETREC(VZ.H,F,A);
    IF IER=-6 THEN WRITELN('VAREN FINDES IKKE')
    ELSE
    BEGIN
      IF IER<>0 THEN ERROR;
      WRITELN(NAVN(1),' ':10,'RIGTIG VARE? (J/N)');
      REPEAT
        GOTOXY(60,3);
        READLN;READ(CH)
      UNTIL (IORESULT=0) AND ((CH='J') OR (CH='N'));
      IF CH='J' THEN
      BEGIN
        WRITELN('ANTAL');
        REPEAT
          GOTOXY(10,4);
          READLN;READ(R)
        UNTIL (IORESULT=0) AND (R>0);
        IORDRE:=IORDRE+R;
        STASBEST:=R;
        DATSBES1:=SYSFIL^.HELTAL(1);
        DATSBES2:=SYSFIL^.HELTAL(2);
        WITH LEVER DO
        BEGIN
          NR:=LVRNDØR;
          GETREC(LZ.H,FLEV,A);
          IF IER=-6 THEN
             WRITELN('LEVERANDØREN ER IKKE OPRETTET')
          ELSE
          BEGIN
            IF IER<>0 THEN ERROR;
            SBESDAT1:=DATSBES1;
            SBESDAT2:=DATSBES2;
            PUTREC(LZ.H,FLEV,A)
          END;
        END;
        WRITELN('FORVENTET LEVERINGSUGE');
        REPEAT
          GOTOXY(25,5);
          READLN;READ(FORVLEVU)
        UNTIL (IORESULT=0) AND (FORVLEVU>0) AND (FORVLEVU<54);
        PUTREC(VZ.H,F,A);
        IF IER<>0 THEN ERROR;
  WRITELN(LIST,VARENR1:6,' ':2,NAVN(1),R:8:-2,' ':5,LVRNDØR:8,FORVLEVU:5,
               KOSTPRIS*R/100:14:2);
  R1:=R1+R*KOSTPRIS;
      END
    END
  END
UNTIL I=0;
  WRITELN(LIST);
  WRITELN(LIST,' ':49,'SAMLET KOSTPRIS',R1/100:14:2);
  ICLOSE(VZ.H,F);
  ICLOSE(LZ.H,FLEV);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER);
  CHAIN('INTRE   *1','HOVSA:P1',QUQ)
END.