DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »PRODUDSK.K«

└─⟦a3d38fea3⟧ Bits:30008985 PRODUKTION NBT.
    └─⟦this⟧ »PRODUDSK.K« 

Mikados K File

PROGRAM PRODUDSKRIFTER;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
VAR    PARM:^PARMARRAY;
       QUQ:^INTEGER;
       CH:STRING(1);
       FNAVN:STRING(18);
(*$P*)
PROCEDURE REGVEDL;
CONST MORDREHZ=331;
      MSYSZ=243;
(*$IISFHEAD*)
HOVEDZONE=RECORD
          H:ISFHEAD;
          T:ARRAY(1..MORDREHZ) OF INTEGER;
END;
 
SYSZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MSYSZ) OF INTEGER;
END;
ARAR=PACKED ARRAY(-11..-10) OF CHAR;
RAR=ARRAY (0..0) OF REAL;
AR13=ARRAY(1..3) OF INTEGER;
AR14=ARRAY(1..4) OF INTEGER;
AR15=ARRAY(1..5) OF INTEGER;
AR19=ARRAY(1..9) OF INTEGER;
 
DOBBINT=ARRAY(1..2) OF INTEGER;
 
TEK=PACKED ARRAY(1..30) OF CHAR;
 
HOVEDPOST=RECORD
          AA:ARAR;
          A:AR;
          AAA:RAR;
          NR:INTEGER;
          DATO:DOBBINT;
          TILBUDNR:INTEGER;
          TLBUDDATO:DOBBINT;
          SAGSNR:INTEGER;
          KUNDENR,
          POSTNR:DOBBINT;
          LEVTERM,
          STATUS:INTEGER;
          KUNDENAVN,
          GADE,
          BY,
          KONTAKT:TEK;
          TELEFON:PACKED ARRAY(1..10) OF CHAR;
          LEVSTED:TEK;
          INITIAL:PACKED ARRAY(1..4) OF CHAR
END;
SYSPOST=RECORD
          AA:ARAR;
          A:AR;
          AAA:RAR;
          NR,
          ORDRENR,
          SDAT1,SDAT2:INTEGER
END;
VAR HOVF,SYSF:ISF;
    HOVZ:HOVEDZONE;
    SYSZ:SYSZONE;
    HOVED:HOVEDPOST;
    SYSTEM:SYSPOST;
    IER,ORDRENR:INTEGER;
(*$P*)
(*$L-*)
(*$R-,IFORWARD*)
(*$IIOPEN*)
(*$IICLOSE*)
(*$L+*)
SEGMENT PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(HOVZ.H,HOVF);
  ICLOSE(SYSZ.H,SYSF);
  EXIT(REGVEDL)
END;
SEGMENT PROCEDURE OFEJL(VAR FIL:FILNAVN);
VAR I:INTEGER;
BEGIN
  GOTOXY(1,20);
  WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . 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(FIL);
  CLEARSCREEN
END;
(*$P*)
PROCEDURE INIT;
BEGIN
  CLEARSCREEN;
  HOVZ.H.FILENAME:='ORDREHOV';
  FNAVN:='ORDREHOV:P2:0000:I';
  REWRITE(HOVF,FNAVN);
  IOPEN(HOVZ.H,HOVF,SKRIV);IF IER<>0 THEN OFEJL(HOVZ.H.FILENAME);
  SYSZ.H.FILENAME:='SYSREG  ';
  FNAVN:='SYSREG:P2:0000:I';
  REWRITE(SYSF,FNAVN);
  IOPEN(SYSZ.H,SYSF,SKRIV);IF IER<>0 THEN OFEJL(SYSZ.H.FILENAME);
END;
(*$L-*)
(*$IEXCOMCOP*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IPUTGET*)
(*$L+*)
(*$P*)
PROCEDURE D23;
BEGIN
  GOTOXY(1,23);WRITELN(' ':79);GOTOXY(1,23)
END;
(*$P*)
BEGIN
  INIT;
  REPEAT
    CH:='N';
    REPEAT
      D23;
      WRITE('Ordrenummer ');READLN;READ(ORDRENR)
    UNTIL (IORESULT=0) AND (ORDRENR>=0) AND (ORDRENR<=9999);
    IF ORDRENR>0 THEN
    BEGIN
      HOVED.NR:=ORDRENR;
      GETREC(HOVZ.H,HOVF,HOVED.A);
      IF IER=-6 THEN
      BEGIN
        D23;
        WRITE('Ordren findes ikke, RETURN ');READLN
      END
      ELSE IF IER=0 THEN
      BEGIN
        IF HOVED.STATUS>2 THEN
        BEGIN
          D23;
          WRITE('Ordre allerede i produktion, RETURN ');READLN
        END
        ELSE IF HOVED.STATUS<2 THEN
        BEGIN
          D23;
          CH:='J';
          WRITE('Ordre ikke reserveret, ønskes etiketter J/N ');EDIT(CH)
        END
        ELSE
        BEGIN
          CH:='J';
          HOVED.STATUS:=3;
          PUTREC(HOVZ.H,HOVF,HOVED.A);
          IF IER<>0 THEN ERROR(HOVZ.H.FILENAME)
        END;
        IF CH='J' THEN
        BEGIN
          SYSTEM.NR:=2;
          GETREC(SYSZ.H,SYSF,SYSTEM.A);
          IF IER<>0 THEN ERROR(SYSZ.H.FILENAME);
          SYSTEM.ORDRENR:=ORDRENR;
          SYSTEM.SDAT1:=HOVED.STATUS;
          SYSTEM.SDAT2:=0;
          PUTREC(SYSZ.H,SYSF,SYSTEM.A);
          IF IER<>0 THEN ERROR(SYSZ.H.FILENAME)
        END
      END
      ELSE ERROR(HOVZ.H.FILENAME)
    END
  UNTIL (ORDRENR=0) OR (CH='J');
  ICLOSE(HOVZ.H,HOVF);
  ICLOSE(SYSZ.H,SYSF);
  WRITELN('ICLOSE ',IER)
END;
(*$P*)
BEGIN
  REGVEDL;
  FNAVN:=' ';
  FNAVN(1):=PARM^(1);
  IF CH='J' THEN
    CHAIN('L       *1',CONCAT('INTRE,PROFILET:P2,',FNAVN),QUQ)
  ELSE
    CHAIN('L       *1',CONCAT('HOVED:P2,',FNAVN),QUQ);
  IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.