DataMuseum.dk

top - download

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

└─⟦a3d38fea3⟧ Bits:30008985 PRODUKTION NBT.
    └─⟦this⟧ »VÆRKSTED.K« 

Mikados K File

PROGRAM VÆRKSTEDSORDRE;
TYPE
PARMARRAY=PACKED ARRAY (1..39) OF CHAR;
VAR    PARM:^PARMARRAY;
       QUQ:^INTEGER;
       CH:STRING(1);
       FNAVN:STRING(18);
(*$P*)
PROCEDURE REGVEDL;
CONST MSYSZ=243;
      MFARVEZ=245;
      MOLINIEZ=344;
      MORDREHZ=331;
      MKOMBIZ=241;
(*$IISFHEAD*)
SYSZONE=RECORD
        H:ISFHEAD;
        T:ARRAY(1..MSYSZ) OF INTEGER;
END;
FARVEZONE=RECORD
         H:ISFHEAD;
         T:ARRAY(1..MFARVEZ) OF INTEGER
END;
OLINIEZONE=RECORD
           H:ISFHEAD;
           T:ARRAY(1..MOLINIEZ) OF INTEGER;
END;
 
HOVEDZONE=RECORD
          H:ISFHEAD;
          T:ARRAY(1..MORDREHZ) OF INTEGER;
END;
 
KOMBIZONE=RECORD
          H:ISFHEAD;
          T:ARRAY(1..MKOMBIZ) 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;
SYSPOST=RECORD
          AA:ARAR;
          A:AR;
          AAA:RAR;
          NR,
          ORDRENR,
          SDAT1,SDAT2:INTEGER
END;
FARVEPOST=RECORD
         AA:ARAR;
         A:AR;
         AAA:RAR;
         NR,
         KODE:INTEGER;
         TEKST:TEK;
END;
OLINIEPOST=RECORD
           AA:ARAR;
           A:AR;
           AAA:RAR;
           KOSTPRIS,
           SALGPRIS,
           RABAT:REAL;
           ORDRENR,
           POSITION,
           ANTAL,
           VINDUENR,
           FARVE1,
           FARVE2,
           RAMMENR1,
           GLASART1,
           RAMMENR2,
           GLASART2,
           RAMMENR3,
           GLASART3,
           BLAMBRED,
           BLAMHØJD:INTEGER;
           BREDDE:AR13;
           HØJDE:AR13;
           HÆNGSEL:AR14;
           MONTER:INTEGER;
           STATUS:INTEGER;
END;
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;
KOMBIPOST=RECORD
          AA:ARAR;
          A:AR;
          AAA:RAR;
          NR,
          KARMPROFIL,
          POST1,
          POST2,
          RAMMEPROFIL,
          F3PROFIL:INTEGER;
END;
VAR SYSF,FARF,HOVF,OLIF,KOMF:ISF;
    SYSZ:SYSZONE;
    HOVZ:HOVEDZONE;
    FARZ:FARVEZONE;
    OLIZ:OLINIEZONE;
    KOMZ:KOMBIZONE;
    SYSTEM:SYSPOST;
    HOVED:HOVEDPOST;
    COLOUR:FARVEPOST;
    KOMBI:KOMBIPOST;
    OLINIE:OLINIEPOST;
    ORDRENR,LINIENR,IER:INTEGER;
    HS:PACKED ARRAY (0..2) OF CHAR;
    R,GRANT:REAL;
(*$P*)
(*$L-*)
(*$R-,IFORWARD*)
(*$IIOPEN*)
(*$IICLOSE*)
(*$R+*)
(*$L+*)
SEGMENT PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
  WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER);
  ICLOSE(HOVZ.H,HOVF);
  ICLOSE(OLIZ.H,OLIF);
  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;
  SYSZ.H.FILENAME:='SYSREG  ';
  FNAVN:='SYSREG:P2:0000:I';
  REWRITE(SYSF,FNAVN);
  IOPEN(SYSZ.H,SYSF,LÆS);IF IER<>0 THEN OFEJL(SYSZ.H.FILENAME);
  FARZ.H.FILENAME:='FARVE   ';
  FNAVN:='FARVE:P2:0000:I';
  REWRITE(FARF,FNAVN);
  IOPEN(FARZ.H,FARF,LÆS);IF IER<>0 THEN OFEJL(FARZ.H.FILENAME);
  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);
  OLIZ.H.FILENAME:='OLINIE  ';
  FNAVN:='OLINIE:P2:0000:I';
  REWRITE(OLIF,FNAVN);
  IOPEN(OLIZ.H,OLIF,SKRIV);IF IER<>0 THEN OFEJL(OLIZ.H.FILENAME);
  KOMZ.H.FILENAME:='KOMBINAT';
  FNAVN:='KOMBINAT:P2:0000:I';
  REWRITE(KOMF,FNAVN);
  IOPEN(KOMZ.H,KOMF,LÆS);IF IER<>0 THEN OFEJL(KOMZ.H.FILENAME);
END;
(*$L-*)
(*$R-*)
(*$IEXCOMCOP*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IPUTGET*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
(*$P*)
PROCEDURE D23;
BEGIN
  GOTOXY(1,23);WRITELN(' ':79);GOTOXY(1,23)
END;
(*$P*)
PROCEDURE SKRIVHOVED;
BEGIN
  WITH HOVED DO
  BEGIN
    WRITELN(LIST);WRITELN(LIST);
    WRITELN(LIST,' ':30,'V Æ R K S T E D S O R D R E',' ':45,
                 'UDSKRIFTSDATO',SYSTEM.SDAT1*10000.0+SYSTEM.SDAT2:7:-2);
    WRITELN(LIST);
    WRITELN(LIST,'ORDRENR',NR:5, ' SAGSNR',SAGSNR:4, ' INITIALER ',INITIAL,
                 ' ':11, 'REFERENCENR',TILBUDNR:5,' KUNDENR',
                 KUNDENR(1)*10000.0+KUNDENR(2):6:-2,' ':6,KUNDENAVN);
    WRITELN(LIST,'TILBUDSDATO',TLBUDDATO(1)*10000.0+TLBUDDATO(2):8:-2,
                 ' ':5,'KONTAKT  ',KONTAKT,' TLF: ',TELEFON,' ':6,GADE);
    WRITELN(LIST,'ORDREDATO',DATO(1)*10000.0+DATO(2):10:-2,' ':5,
                 'LEVERING ',LEVSTED,LEVTERM:5,' ':15,
                 POSTNR(1)*10000.0+POSTNR(2):8:-2,' ',BY);
    WRITELN(LIST);
    WRITELN(LIST,'POS VDNR ANT FARVE-1/2 GLAS  BLAM-B/H  BRE1 HØJ1 BRE2 ',
    'HØJ2 BRE3 HØJ3 BSLS PROFT.1/2 SALGSPRIS RAB %     NETTO SAMLET NETTO');
    LINIENR:=9
  END
END;
(*$P*)
PROCEDURE SKRIVLINIE;
VAR I:INTEGER;
BEGIN
  WITH OLINIE DO
  BEGIN
    LINIENR:=LINIENR+1;
    WRITE(LIST,POSITION:3,VINDUENR:5,ANTAL:4);
    IER:=1;
    WRITE(LIST,' ');
    IF FARVE1>0 THEN
    BEGIN
      COLOUR.NR:=FARVE1;
      GETREC(FARZ.H,FARF,COLOUR.A);
      IF IER=0 THEN FOR I:=1 TO 4 DO WRITE(LIST,COLOUR.TEKST(I))
      ELSE IF IER<>-6 THEN ERROR(FARZ.H.FILENAME)
    END;
    IF IER<>0 THEN WRITE(LIST,' ':4);
    IER:=1;
    WRITE(LIST,' ');
    IF FARVE2>0 THEN
    BEGIN
      COLOUR.NR:=FARVE2;
      GETREC(FARZ.H,FARF,COLOUR.A);
      IF IER=0 THEN FOR I:=1 TO 4 DO WRITE(LIST,COLOUR.TEKST(I))
      ELSE IF IER<>-6 THEN ERROR(FARZ.H.FILENAME)
    END;
    IF IER<>0 THEN WRITE(LIST,' ':4);
    WRITE(LIST,GLASART1:2,GLASART2:2,GLASART3:2,BLAMBRED:5,BLAMHØJD:5);
    FOR I:=1 TO 3 DO WRITE(LIST,BREDDE(I):5,HØJDE(I):5);
    WRITE(LIST,' ');
    FOR I:=1 TO 4 DO WRITE(LIST,HS(HÆNGSEL(I)));
    KOMBI.NR:=VINDUENR DIV 1000;
    GETREC(KOMZ.H,KOMF,KOMBI.A);
    IF IER<>0 THEN ERROR(KOMZ.H.FILENAME);
    R:=(SALGPRIS*(100.0-RABAT))/100.0;
    WRITELN(LIST,KOMBI.KARMPROFIL:5,KOMBI.RAMMEPROFIL:5,SALGPRIS:10:2,
               RABAT:6:2,R:10:2,R*ANTAL:13:2);
    GRANT:=GRANT+R*ANTAL
  END
END;
(*$P*)
BEGIN
  INIT;
  HS:=' HV';
  SYSTEM.NR:=1;
  GETREC(SYSZ.H,SYSF,SYSTEM.A);
  IF IER<>0 THEN ERROR(SYSZ.H.FILENAME);
  CLEARSCREEN;
  D23;
  WRITE('Isæt 8" papir, RETURN ');READLN;
  REPEAT
    REPEAT
      D23;
      WRITE('Ordrenummer, 0 for færdig ');READLN;READ(ORDRENR)
    UNTIL (IORESULT=0) AND
                       ((ORDRENR=0) OR ((ORDRENR>999) AND (ORDRENR<10000)));
    IF ORDRENR>0 THEN
    BEGIN
      HOVED.NR:=ORDRENR;
      GETREC(HOVZ.H,HOVF,HOVED.A);
      IF IER=0 THEN
      BEGIN
        IF HOVED.STATUS>1 THEN
        BEGIN
          D23;
          WRITE('Værkstedsordre er udskrevet, RETURN ');READLN
        END
        ELSE IF HOVED.STATUS<1 THEN
        BEGIN
          D23;
          WRITE('Tilbud ikke bekræftet, RETURN ');READLN
        END
        ELSE
        BEGIN
          LINIENR:=0;
          SKRIVHOVED;
          HOVED.STATUS:=2;
          PUTREC(HOVZ.H,HOVF,HOVED.A);
          IF IER<>0 THEN ERROR(HOVZ.H.FILENAME);
          GRANT:=0.0;
          OLINIE.ORDRENR:=ORDRENR;
          OLINIE.POSITION:=0;
          NEXTREC(OLIZ.H,OLIF,OLINIE.A);
          IF -IER IN (.1,2,9.) THEN IER:=0 ELSE ERROR(OLIZ.H.FILENAME);
          WHILE (IER=0) AND (OLINIE.ORDRENR=ORDRENR) DO
          BEGIN
            SKRIVLINIE;
            OLINIE.STATUS:=2;
            PUTREC(OLIZ.H,OLIF,OLINIE.A);
            IF IER<>0 THEN ERROR(OLIZ.H.FILENAME);
            NEXTREC(OLIZ.H,OLIF,OLINIE.A)
          END;
          WRITELN(LIST,' ':109,GRANT:13:2);
          LINIENR:=LINIENR+1;
          WHILE LINIENR MOD 48<>0 DO
          BEGIN
            WRITELN(LIST);
            LINIENR:=LINIENR+1
          END;
          IF -IER IN (.0,2.) THEN IER:=0 ELSE ERROR(OLIZ.H.FILENAME)
        END
      END
      ELSE IF IER=-6 THEN
      BEGIN
        D23;
        WRITE('Ordren  findes ikke, RETURN ');READLN
      END
      ELSE ERROR(HOVZ.H.FILENAME)
    END
  UNTIL ORDRENR=0;
  ICLOSE(HOVZ.H,HOVF);
  ICLOSE(OLIZ.H,OLIF);
  WRITELN('ICLOSE ',IER)
END;
(*$P*)
BEGIN
  REGVEDL;
  FNAVN:=' ';
  FNAVN(1):=PARM^(1);
  CHAIN('L       *1',CONCAT('HOVED:P2,',FNAVN),QUQ);
  IF IORESULT<>0 THEN WRITELN('IORESULT ',IORESULT)
END.