DataMuseum.dk

top - download

    Length: 3744 (0xea0)
    Types: TextFile
    Notes: Mikados_K
    Names: »RAIORDRE.K«

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

Mikados K File

PROGRAM KUNDRESTORDREOVERSIGT;
 (*$IISFHEAD*)
 VPOST=RECORD
        A       :AR;
        HELTAL:ARRAY (1..11) OF INTEGER;
 (*VARENR,LVRNDØR,OPRLAND,PAKENHED,FORVLEVU,DATSBES1,DATSBES2,DATSORD1,
   DATSORD2,DÆKGRASÅ,ANAFTILG*)
        NAVN:ARRAY (1..2) OF PACKED ARRAY(1..30) OF CHAR;
 (*VARENAVN,NAVNHOSLEVERANDØR*)
        REELTAL :ARRAY (1..15) OF REAL
 (*PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
   RESAFIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD*)
  END;
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;
 VZONE= RECORD
        H:ISFHEAD;
        T:ARRAY(1..451) OF INTEGER
  END;
KZONE=RECORD
       H:ISFHEAD;
       T:ARRAY(1..918) OF INTEGER
END;
 RORPOST=RECORD
        A:AR;
 (*     KNR1,KNR2,
        VNR,
        DAT1,DAT2:INTEGER;*) HEAD:ARRAY(1..5) OF INTEGER;
        ANTAL:REAL
  END;
 RORZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..302) OF INTEGER
  END;
SYSPOST=RECORD
(*DATO1,DATO2,
  UGENR,
  MAXEXC,
  ORDRENR1-2,
  FAKTNR1-2,
  KREDNTNR1-2,
  BILAGSNR1-2,JOURFILNR,MOMS*) HELTAL: ARRAY (1..14) OF INTEGER;
  BETADAT:PACKED ARRAY (1..13) OF CHAR;
(*KIKKODE,ÆNDKODE*) KODE:ARRAY (1..2) OF PACKED ARRAY (1..10) OF CHAR
END;
SYSFILE=FILE OF SYSPOST;
  
  
VAR FVAR,FKUN,FROR:ISF;
    VZ:VZONE;
    KZ:KZONE;
    RZ:RORZONE;
    KUNDE:KPOST;
    VARE:VPOST;
    RESTORD:RORPOST;
    SYSFIL:SYSFILE;
    KNAVN:STRING(4);
    FNAVN:STRING(20);
    IER,RIER,O1,O2,I:INTEGER;
    R1,R2,R:REAL;
(*$L-*)
 (*$R-,IEXCOMCOP*)
 (*$IIOPEN*)
 (*$ISÆTØG*)
 (*$IREADPROC*)
 (*$IFINDPOST*)
 (*$IFORSKYD*)
 (*$IICLOSE*)
 (*$IPUTGET*)
 (*$IINSERT*)
 (*$INEXTREC*)
 (*$IDELETE*)
 (*$IREPORT*)
 (*$R+*)
(*$L+*)
 PROCEDURE ERROR;
 BEGIN
   WRITELN('FEJL I REGISTER ',IER);
   ICLOSE(VZ.H,FVAR);
   ICLOSE(RZ.H,FROR);
   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;
BEGIN
  CLEARSCREEN;
  FNAVN:='REGVARE:P1:0000:I';
  REWRITE(FVAR,FNAVN);
  IOPEN(VZ.H,FVAR,SKRIV);IF IER<>0 THEN OFEJL;
 
  FNAVN:='RESTREG:P2:0000:I';
  REWRITE(FROR,FNAVN);
  IOPEN(RZ.H,FROR,LÆS);IF IER<>0 THEN OFEJL;
      RESTORD.HEAD(1):=0;
      RESTORD.HEAD(2):=0;
      RESTORD.HEAD(3):=0;
      NEXTREC(RZ.H,FROR,RESTORD.A);
 REPEAT
 VARE.HELTAL(1):=RESTORD.HEAD(3);
 GETREC(VZ.H,FVAR,VARE.A);
 IF (IER<>0) AND (IER<>-6) THEN ERROR;
          IF IER=0 THEN
          BEGIN
            VARE.REELTAL(9):=VARE.REELTAL(9)+RESTORD.ANTAL;
            PUTREC(VZ.H,FVAR,VARE.A);
            IF IER<>0 THEN ERROR;
          END;
            NEXTREC(RZ.H,FROR,RESTORD.A);
          UNTIL (IER<>0);
      WRITELN(LIST,RESTORD.HEAD(1):8,RESTORD.HEAD(2):8,RESTORD.HEAD(3):8);
          IF (IER<>0) AND (IER<>-2) AND (IER<>-9) THEN ERROR;
     ICLOSE(VZ.H,FVAR);
     ICLOSE(RZ.H,FROR);
END.