Software to assist QC (Quality Control)

You cannot inspect-in quality. If your process is bad, 100% inspections only increase your garbage. Quality must be designed into your product in the very early stages. Still, many things can go wrong ;ater on, even with well designed products. Machines wear. Raw materials change. Operators change. To name only a few factors.
Therefore inspection can be useful: take a small enough sample to still be able to tell something about the properties of the full population. Sounds easy but requires a lot of experience and skills.
Later these results need to be analysed to filter out the random noise and produce cold digits that serve as parameters to quantify a process.

One such number is the process capability constant. It is a measure how good one specific lot of products fit in the specification the customer supplied when he order his materials. In a formula:

   Cpk = delta / (3.0 * StdDev)
   
in which: So the Cpk shows the amount of head-room there still is in the specification. Many customers require a Cpk of 1.5 as a bare minimum.

The software source

At Ushio we used to make a few hundred types of lamps, some in long production runs and some in runs as low as ten pieces. So lots of data needed to be available and looking up the data in a paper filer system took very much time.

Another factor was the way of operation. Many lamps would be completed on the same day. But some were spread out over a few days. And some were manufactured in several discrete steps and each step had its own QC regime. Therefore I had to make a parking lot for partly completed lamps.
For this, a special subdirectory was made in which files were stored with the temporary data. The filenames were made by adding the extension 'SDF' to the coil number. ;SDF' is short for Stored Data File. It was erased after the lamp was finalised.

Below is the source for QC08. This is DOS source and the letters were meant to be used with the DOS characterset. So some tokens may look odd...
This program is six years old. I forgot why and how I programmed some things... If time permits I will come back to this source regularly and give some more background.

      
MODULE QC08;

(*  QC06 :  Working version. Does not support asymm specifications.     *)
(*  QC07 :  Major rewrite to enable asymmetric specification values.    *)
(*  QC08 :  Add printersupport. Works nice.                             *)

IMPORT  ASCII;
IMPORT  Display;
IMPORT  Files;

FROM    Display             IMPORT  displayAttr, snowy, ClrEOS, Goto, SetCursorType;
FROM    FileSystem          IMPORT  Close, File, LLength, Lookup, ReadChar, Response, SetLPos, WriteChar;
FROM    InOut               IMPORT  CloseInput, CloseOutput, Done, RedirectInput, RedirectOutput, Read,
                                        ReadCard, ReadString, termCH, Write, WriteCard, WriteLn, WriteLine,
                                        WriteString;
FROM    Keyboard            IMPORT  GetKeyCh;
FROM    MathLib0            IMPORT  exp, ln;
FROM    NumberConversion    IMPORT  CardToString;
FROM    Printer             IMPORT  CheckPrinter, Bold, Italics, MakePrinter, LogicState;
FROM    RealConversions     IMPORT  RealToString, StringToReal;
FROM    RealInOut           IMPORT  ReadReal;
FROM    Statistics          IMPORT  Average, Cpk, Range, StdDev;
FROM    Storage             IMPORT  ALLOCATE, Available;
FROM    Strings             IMPORT  Append, Assign, CompareStr, Length;
FROM    System              IMPORT  Terminate;
FROM    TimeDate            IMPORT  GetTime, Time;
FROM    Xchar               IMPORT  CompressName, KeyW8, Print, ReadName, SkipUntil, UpperString;
   
A lot of imports. With my current knowledge I would not have imported 'Terminate' from 'System', but I would have called it, when needed as a qualified import: "System.Terminate". Sam with other, less frequently used, symbols and keywords.
      
CONST   EndKey      = 0C1X;     (*  End key  = this was last value entered      *)
        UpKey       = 0BAX;     (*  Up arrow = back to previous field           *)
        HaltKey     = 0E7X;     (*  Ctrl-End = Abort Now and store in "On-Hold" *)
        MinCpk      = 1.77;     (*  Rank Xerox lowest Cpk to accept             *)
   
These are the keycodes for DOS. Also known as scan codes. Plus the lowest acceptable Cpk as ordered by one of the major customers: Rank Xerox. Luckily, their QA engineer was a real dork. I even forgot his name. He made Excel sheets for us to use, that contained major errors.
      
TYPE    lampname    = ARRAY [0..31] OF CHAR;
        PathName    = ARRAY [0..19] OF CHAR;
        CardStorage = ARRAY [0..2] OF CARDINAL;
        LampTests   = (LD, HD, TL);                                 (*  Special tests       *)
        SetOfTests  = SET OF LampTests;
        DataStatus  = (empty, suspend, final);
        StatVals    = RECORD
                        Target, USL, LSL,
                        Actual, Range, Cpk  : REAL;
                      END;


VAR     LookUpName, LampName        : lampname;                     (*  Lampname            *)
        FileName, path              : PathName;                     (*  Name of datafiles   *)
        CoilNr                      : ARRAY [0..11] OF CHAR;
        ReflexDate                  : ARRAY [0..11] OF CHAR;        (*  Date in format MM/DD/YYYY   *)
        TestsToDo                   : SetOfTests;
        SaveFile                    : DataStatus;
        tLine                       : CHAR;
        VisInsp                     : ARRAY [0..7] OF CHAR;
        QAremark                    : ARRAY [0..63] OF CHAR;
        Factor, Delta               : REAL;
        OldAttr, Tijd, Voltage,
        LDP, dag, maand, jaar       : CARDINAL;

        Answer, EndFlag, EscFlag, HaltFlag, NonEmpty, ok, Suspended, UpFlag                     : BOOLEAN;
        Colour, CoilLen, CoilW8, LampLen, Lumen, Lead1, Lead2, Power, TipHi, TipPos, TubeDia    : StatVals;
   
TYPEs en VARs. The neat stuff of Modula-2.
      
PROCEDURE Confirm (text : ARRAY OF CHAR) : BOOLEAN;

(*  Ask the user if it is agreed to commence or better to abort.        *)

VAR     old         : CARDINAL;
        char        : CHAR;

BEGIN
    old := displayAttr;         (*  Save old colour     *)
    displayAttr := 14;          (*  Define new colour   *)
    Goto (23, 0);
        Print ("��� ");     Print (text);       Print (" ���");     Write (ASCII.HT);
        Print ("Yes or No");
    LOOP
        GetKeyCh (char);
        char := CAP (char);
        IF (char = 'Y') OR (char = 'N') THEN   EXIT   END;
        Write (ASCII.BEL)
    END;
    displayAttr := old;
    Goto (23, 0);           Display.ClrEOL;
    IF char = 'Y' THEN
        RETURN TRUE
    ELSE
        RETURN FALSE
    END
END Confirm;


PROCEDURE ReadText (VAR s   : ARRAY OF CHAR);   (*  Read a string of freeform text from the terminal    *)

VAR     token       : CHAR;
        i           : CARDINAL;

BEGIN
    i := 0;
     UpFlag := FALSE;       EndFlag := FALSE;
    EscFlag := FALSE;      HaltFlag := FALSE;       NonEmpty := FALSE;
    LOOP
        GetKeyCh (token);
        CASE token OF
            ASCII.CR  : EXIT;                     | (*  CR => done                      *)
            UpKey     :   UpFlag := TRUE;   EXIT; |
            EndKey    :  EndFlag := TRUE;   EXIT; | (*  End pressed. Abort entry.       *)
            HaltKey   : HaltFlag := TRUE;   EXIT; | (*  Ctrl-End = store until later    *)
            ASCII.ESC :  EscFlag := TRUE;   EXIT; | (*  Escape pressed, get out NOW     *)
            ASCII.BS  : IF i > 0 THEN               (*  Rub out last character          *)
                            DEC (i);
                            Write (ASCII.BS);       (*  First backup one position       *)
                            Write (' ');            (*  Rub out old character           *)
                            Write (ASCII.BS)        (*  Compensate for Rub-out space    *)
                        END;
        ELSE
            IF (i <= HIGH (s)) AND (token < '|') AND (token >= ' ') THEN
                s [i] := token;
                INC (i);
                Write (token)
            END
        END
    END;
    IF i <= HIGH (s) THEN
        s [i] := 0C
    END;
    IF i > 0 THEN NonEmpty := TRUE END
END ReadText;


PROCEDURE PrintDate;                        (*  Print Date and Time     *)

VAR     t                   : Time;
        minuut, uur, dag,
        maand, jaar         : CARDINAL;

BEGIN
    GetTime (t);
    uur := t.minute DIV 60;             minuut := t.minute MOD 60;
    dag := t.day MOD 32;                 maand := (t.day DIV 32) MOD 16;
    jaar := (t.day DIV 512) + 1900;
    CASE maand OF
      1 :   WriteString ("Jan");      |
      2 :   WriteString ("Feb");      |
      3 :   WriteString ("Mar");      |
      4 :   WriteString ("Apr");      |
      5 :   WriteString ("May");      |
      6 :   WriteString ("Jun");      |
      7 :   WriteString ("Jul");      |
      8 :   WriteString ("Aug");      |
      9 :   WriteString ("Sep");      |
     10 :   WriteString ("Oct");      |
     11 :   WriteString ("Nov");      |
     12 :   WriteString ("Dec")
    END;
    WriteCard (dag, 3);     Write (',');
    WriteCard (jaar, 5);
    WriteCard (uur, 5);     Write (':');
    IF minuut < 10 THEN
        Write ('0');
        WriteCard (minuut, 1)
    ELSE
        WriteCard (minuut, 2)
    END
END PrintDate;


PROCEDURE UserMessage (n  : CARDINAL);      (*  Various messages to inform the user of his/her stupidity    *)

VAR     ch          : CHAR;

BEGIN
    WriteLn;
    CASE n OF
      1 :   WriteLine ("The file 'Master.Dat' is missing. Please restore from your backup.");
            WriteLine ("Program aborted. No use in carrying on without it. Bye.");
            |
      2 :   WriteLine ("This lamp is not in the database. Please check your data.");
            WriteLine ("Press the SpaceBar to continue. PRESS, don't slam!");
            |
      3 :   WriteLine ("Cannot open specification file for this lampdesign.");
            WriteLine ("Please check your settings and data structure. Press Enter to continue.");
    END
END UserMessage;


PROCEDURE FindSpec (lamp  : ARRAY OF CHAR; VAR file  : ARRAY OF CHAR) : BOOLEAN;

VAR     i, j        : CARDINAL;
        name        : lampname;

BEGIN
    RedirectInput ("Master.Dat");
    LOOP
        ReadName (name);
        IF CompareStr (name, lamp) = 0 THEN  EXIT  END;
        IF CompareStr (name, "End-Of-File") = 0 THEN
            CloseInput;
            RETURN FALSE
        END;
        SkipUntil (ASCII.EOL)
    END;
    ReadString (file);
    CloseInput;
    RETURN TRUE
END FindSpec;


PROCEDURE ReadSpec (VAR Value   : StatVals);    (*  Read specification values from file     *)

VAR     ch              : CHAR;
        target, tol     : REAL;
        Plus, Minus     : BOOLEAN;

BEGIN
    Plus    := FALSE;
    Minus   := FALSE;                       (*  Initialize some flags           *)
    ReadReal (target);
    Value.Target := target;                 (*  Store targetvalue into array    *)
    LOOP
        REPEAT
            Read (ch)
        UNTIL ch # ' ';                     (*  Skip over all spaces until first non-blank  *)
        CASE ch OF
            '�' :   ReadReal (tol);                             (*  Symmetric tolerances?   *)
                    Value.USL := target + tol;
                    Value.LSL := target - tol;
                    EXIT;
                    |
            '+' :   ReadReal (tol);                 (*  Asymmetric tolerance: process PLUS  *)
                    Value.USL := target + tol;
                    Plus := TRUE;
                    |
            '-' :   ReadReal (tol);                 (*  Asymmetric tolerance: process MINUS *)
                    Value.LSL := target - tol;
                    Minus := TRUE
        END;
        IF (Plus = TRUE) AND (Minus = TRUE) THEN EXIT END           (*  If +/- done, EXIT   *)
    END
END ReadSpec;


PROCEDURE ReadParameters (f   : ARRAY OF CHAR; VAR ok  : BOOLEAN);

VAR     item        : ARRAY [0..31] OF CHAR;
        path        : ARRAY [0..63] OF CHAR;
        token       : CHAR;
        value       : CARDINAL;

BEGIN
    ok := TRUE;
    path := "QCD\";     Append (path, f);   RedirectInput (path);
    IF NOT Done THEN
        ok := FALSE;
        RETURN
    END;
    REPEAT
        ReadString (item)
    UNTIL CompareStr (item, "BEGIN") = 0;
    LOOP
        ReadString (item);
        IF CompareStr (item, "End-Of-File") = 0 THEN EXIT END;

        IF CompareStr (item, "Voltage") = 0 THEN  ReadCard (Voltage)

        ELSIF CompareStr (item, "Power")          = 0 THEN  ReadSpec (Power)
        ELSIF CompareStr (item, "Lumens")         = 0 THEN  ReadSpec (Lumen)
        ELSIF CompareStr (item, "ColourTemp")     = 0 THEN  ReadSpec (Colour)
        ELSIF CompareStr (item, "CoilWeight")     = 0 THEN  ReadSpec (CoilW8)
        ELSIF CompareStr (item, "TubeDiameter")   = 0 THEN  ReadSpec (TubeDia)
        ELSIF CompareStr (item, "TipPos")         = 0 THEN  ReadSpec (TipPos)
        ELSIF CompareStr (item, "TipHeight")      = 0 THEN  ReadSpec (TipHi)
        ELSIF CompareStr (item, "FlangeToFlange") = 0 THEN  ReadSpec (LampLen)
        ELSIF CompareStr (item, "LightLength")    = 0 THEN  ReadSpec (CoilLen)
        ELSIF CompareStr (item, "LeadWireLen1")   = 0 THEN  ReadSpec (Lead1)
        ELSIF CompareStr (item, "LeadWireLen2")   = 0 THEN  ReadSpec (Lead2)

        ELSIF CompareStr (item, "QAremark")       = 0 THEN  ReadName (QAremark)
        ELSIF CompareStr (item, "CoilNumber")     = 0 THEN  ReadName (CoilNr)

        ELSIF CompareStr (item, "LDtest") = 0 THEN
            ReadString (item);
            UpperString (item);
            IF CompareStr (item, "YES") = 0 THEN    INCL (TestsToDo, LD)    END

        ELSIF CompareStr (item, "HDtest") = 0 THEN
            ReadString (item);
            UpperString (item);
            IF CompareStr (item, "YES") = 0 THEN    INCL (TestsToDo, HD)    END

        ELSIF CompareStr (item, "LumenTest") = 0 THEN
            ReadString (item);
            UpperString (item);
            IF CompareStr (item, "YES") = 0 THEN    INCL (TestsToDo, TL)    END

        END;
        IF  termCH # ASCII.EOL  THEN  SkipUntil (ASCII.EOL)  END
    END;
    CloseInput
END ReadParameters;


PROCEDURE FillScreen;

VAR     buffer          : ARRAY [0..11] OF CHAR;
        ok              : BOOLEAN;
        diff            : REAL;
        margin, OldVal  : CARDINAL;

BEGIN
    OldVal := displayAttr;
    displayAttr := 2;
    Goto ( 3, 68);  Print (CoilNr);

    Goto ( 4, 15);  RealToString (CoilW8.LSL, 3, 6, buffer, ok);    Print (buffer);
                    Print (" - ");
                    RealToString (CoilW8.USL, 3, 6, buffer, ok);    Print (buffer);
                    Print (" g");

    Goto ( 6, 15);  CardToString (TRUNC (Power.Target), buffer, 6); Print (buffer);
                    Print (" � ");
                    margin := TRUNC (Power.USL - Power.LSL) DIV 2;
                    CardToString (margin, buffer, 3);               Print (buffer);
                    Goto ( 6, 31);                                  Display.Write ("W");

    Goto ( 7, 15);  IF Lumen.Target # 0.0 THEN
                        CardToString (TRUNC (Lumen.Target), buffer, 4);     Print (buffer);
                        IF Lumen.USL = Lumen.LSL THEN
                            Print (" REF")
                        ELSE
                            Print (" � ");
                            margin := TRUNC (Lumen.USL - Lumen.LSL) DIV 2;
                            CardToString (margin, buffer, 4);               Print (buffer);
                        END
                    END;
                    Goto ( 7, 30);                                  Print ("Lm");

    Goto ( 8, 17);  CardToString (TRUNC (Colour.Target), buffer, 4);    Print (buffer);
                    Print (" � ");
                    margin := TRUNC (Colour.USL - Colour.LSL) DIV 2;
                    CardToString (margin, buffer, 3);                   Print (buffer);
                    Goto ( 8, 31);                                      Display.Write ("K");

    Goto ( 9, 17);  CardToString (TRUNC (CoilLen.Target), buffer, 4);   Print (buffer);
                    Print (" � ");
                    margin := TRUNC(CoilLen.USL - CoilLen.LSL) DIV 2;
                    CardToString (margin, buffer, 3);                   Print (buffer);
                    Goto ( 9, 30);                                      Print ("mm");

    Goto (10, 15);  CardToString (TRUNC (TipPos.Target), buffer, 6);    Print (buffer);
                    Print (" � ");
                    margin := TRUNC (TipPos.USL - TipPos.LSL) DIV 2;
                    CardToString (margin, buffer, 3);                   Print (buffer);
                    Goto (10, 30);                                      Print ("mm");

    Goto (12, 15);  RealToString (TubeDia.Target, 1, 6, buffer, ok);    Print (buffer);
                    Print (" �   1.0");
                    Goto (12, 30);                                      Print ("mm");

    Goto (13, 22);  Print ("< ");
                    RealToString (TipHi.USL, 1, 5, buffer, ok);         Print (buffer);
                    Goto (13, 30);                                      Print ("mm");

    Goto (15, 15);  RealToString (LampLen.Target, 1, 6, buffer, ok);    Print (buffer);
                    Print (" � ");
                    diff := (LampLen.USL - LampLen.LSL) / 2.0;
                    RealToString (diff, 1, 5, buffer, ok);              Print (buffer);
                    Goto (15, 30);                                      Print ("mm");

    Goto (16, 15);  CardToString (TRUNC (Lead1.Target), buffer, 4);     Print (buffer);
                    Print ("   � ");
                    margin := TRUNC (Lead1.USL - Lead1.LSL) DIV 2;
                    CardToString (margin, buffer, 3);                   Print (buffer);
                    Goto (16, 30);                                      Print ("mm");

    Goto (17, 15);  CardToString (TRUNC (Lead2.Target), buffer, 4);     Print (buffer);
                    Print ("   � ");
                    margin := TRUNC (Lead2.USL - Lead2.LSL) DIV 2;
                    CardToString (margin, buffer, 3);                   Print (buffer);
                    Goto (17, 30);                                      Print ("mm");

    IF TL IN TestsToDo THEN     Goto (20, 63);  Print ("��")        END;
    IF HD IN TestsToDo THEN     Goto (20, 67);  Print ("��")        END;
    IF LD IN TestsToDo THEN     Goto (20, 71);  Print ("��")        END;
    IF QAremark [0] # 0C THEN
        displayAttr := 14;      Goto (22, 10);  Print (QAremark)
    END;
    displayAttr := OldVal
END FillScreen;


PROCEDURE SetLine ( line, decimals, places  : CARDINAL;     (*  Fill in a line on screen with results   *)
                    Property                : StatVals);    (*  which were retrieved from file.         *)

VAR     buffer      : ARRAY [0..11] OF CHAR;
        oldvalue    : CARDINAL;

BEGIN
    oldvalue := displayAttr;
    displayAttr := 7;
    Goto (line, 33);
        IF decimals = 0 THEN
            WriteCard (TRUNC (Property.Actual), places)
        ELSE
            RealToString (Property.Actual, decimals, places, buffer, ok);       Print (buffer)
        END;
        IF Property.Range < 10000.0 THEN
            Print (" �");
            IF decimals = 0 THEN
                RealToString (Property.Range, 1, places, buffer, ok)
            ELSE
                RealToString (Property.Range, decimals, places, buffer, ok)
            END;
            Print (buffer)
        END;
    Goto (line, 50);
        IF Property.Cpk > 0.0 THEN
            IF Property.Cpk > 10.0 THEN
                WriteCard (TRUNC (Property.Cpk), 5)
            ELSE
                RealToString (Property.Cpk, 1, 5, buffer, ok);                  Print (buffer)
            END
        ELSE
            displayAttr := 6;           Print ("  REF")
        END;
    Goto (line, 57);
        IF Property.Range < 10000.0 THEN
            IF Property.Cpk > MinCpk THEN
                displayAttr := 10;      Print (" Yes")
            ELSE
                displayAttr := 12;      Print ("  No")
            END
        ELSE
            IF (Property.Actual > Property.LSL) AND (Property.Actual < Property.USL) THEN     (*  Within spec?    *)
                displayAttr := 10;      Print (" Yes")
            ELSE
                displayAttr := 12;      Print ("STOP")
            END
        END;
    displayAttr := oldvalue
END SetLine;


PROCEDURE EraseWindow;

VAR     n           : CARDINAL;

BEGIN
    displayAttr := OldAttr;
    FOR n := 0 TO 9 DO
        Goto (n+5, 63); Print ("                 ")
    END
END EraseWindow;


PROCEDURE OpenWindow (text          : ARRAY OF CHAR;            (*  Open a window on screen and ask for data    *)
                      vals          : CARDINAL;                 (*  Return values in array of real 'store'      *)
                      VAR store     : ARRAY OF REAL) : CARDINAL;

VAR     n           : CARDINAL;
        ValStr      : ARRAY [0..5] OF CHAR;
        val         : REAL;
        ok          : BOOLEAN;

BEGIN
    OldAttr     := displayAttr;
    displayAttr := 1EH;
    Goto ( 5, 63);      Print ("+---------------+");
    FOR n := 1 TO 8 DO
        Goto (n+5, 63); Print ("|               |")
    END;
    Goto (14, 63);      Print ("+---------------/");
    Goto ( 6, 66);  Print (text);
    FOR n := 1 TO 6 DO
        Goto (n+7, 65);
        Write ("#");
        WriteCard (n, 1)
    END;
    n := 0;
    REPEAT
        LOOP
            Goto (n+8, 69);
            ReadText (ValStr);
            IF UpFlag THEN  EXIT  END;
            IF EndFlag OR HaltFlag THEN
                EraseWindow;
                RETURN n
            END;
            StringToReal (ValStr, val, ok);
            IF ok THEN
                IF (Factor # 1.0) OR (Delta # 0.0) THEN         (*  Calibrated data?                *)
                    val := Factor * val + Delta;                (*  If so, use calibration formula  *)
                    Goto (n+8, 69);     Print ("        ");
                    Goto (n+8, 69);     WriteCard (TRUNC (val), 5)
                END;
                EXIT
            END;
            Goto (n+8, 69);         Print ("        ")
        END;
        IF UpFlag THEN
            IF n > 0 THEN
                DEC (n);
                Goto (n+8, 69);     Print ("        ")
            ELSE
                RETURN 0
            END
        ELSE
            store [n] := val;
            INC (n)
        END
    UNTIL n = vals;
    EraseWindow;
    RETURN n
END OpenWindow;


PROCEDURE GetLine  (text                    : ARRAY OF CHAR;
                    max, line, prec, total  : CARDINAL;
                    VAR Property            : StatVals);

(*      Print "text" in the spreadsheet window and ask for at most <max> numbers. Print the results on <line>
        of the screen, using <prec> decimals in an array of <total> nr of characters.
        Calculate the Cpk using Property.Target and Property.USL/LSL values.                                *)

VAR     Values          : ARRAY [0..5] OF REAL;
        buffer          : ARRAY [0..9] OF CHAR;
        ok              : BOOLEAN;
        Sigma           : REAL;
        n, OldVal       : CARDINAL;

BEGIN
    OldVal := displayAttr;
    displayAttr := 7;
    FOR n := 0 TO HIGH (Values) DO
        Values [n] := 0.0
    END;
    n := OpenWindow (text, max, Values);            (*  Get at most <max> values    *)
    IF HaltFlag THEN   RETURN   END;                (*  After 1st 10 lamps, suspend *)
    IF n > 1 THEN                                   (*  if more than one point,     *)
        Property.Actual  := Average (Values, n);                (*  Do some math    *)
        Property.Range   := 3.0 * StdDev (Values, n)
    ELSE
        Property.Actual  := Values [0];                     (*  ELSE fake some math *)
        Property.Range   := 10000.0;
        Property.Cpk     := 0.0
    END;
    Goto (line, 33);
        IF prec = 0 THEN
            WriteCard (TRUNC (Property.Actual), total)
        ELSE
            RealToString (Property.Actual, prec, total, buffer, ok);
            Print (buffer)                                  (*  Print the average   *)
        END;
        IF n > 1 THEN
            Print (" �");
            IF prec = 0 THEN
                RealToString (Property.Range, 1, total, buffer, ok)
            ELSE
                RealToString (Property.Range, prec, total, buffer, ok)
            END;
            Print (buffer);
        END;
    Goto (line, 50);
        IF n > 1 THEN
            IF Property.Range > 0.0 THEN
                Sigma := Property.Range / 3.0;
                Property.Cpk := Cpk (Property.USL, Property.LSL, Property.Actual, Sigma);
                IF Property.Cpk > 10.0 THEN
                    WriteCard (TRUNC (Property.Cpk), 5)
                ELSE
                    RealToString (Property.Cpk, 1, 5, buffer, ok);          Print (buffer)
                END
            ELSE
                Property.Cpk := 100.0;  Print ("  INF")
            END
        ELSE
            displayAttr := 6;           Print ("  REF")
        END;
    Goto (line, 57);
        IF n > 1 THEN
            IF Property.Cpk > MinCpk THEN
                displayAttr := 10;      Print (" Yes")
            ELSE
                displayAttr := 12;      Print ("  No")
            END
        ELSE
            IF (Property.Actual > Property.LSL) AND (Property.Actual < Property.USL) THEN     (*  Within spec?    *)
                displayAttr := 10;      Print (" Yes")
            ELSE
                displayAttr := 12;      Print ("STOP")
            END
        END;
        displayAttr := OldVal
END GetLine;


PROCEDURE GetClass (pos  : CARDINAL; VAR s  : ARRAY OF CHAR);

(*  Ask for a quality class for this organoleptic check.            *)

VAR     token           : CHAR;

BEGIN
    UpFlag  := FALSE;
    EndFlag := FALSE;
    Goto (20, pos);
    LOOP                                (*  Repeat indefinitely     *)
        GetKeyCh (token);               (*  Read keybored           *)
        token := CAP (token);
        IF (token >= 'A') AND (token <= 'D') THEN
            Print (token);
            Append (s, token);
            EXIT
        ELSIF token = UpKey THEN
            UpFlag := TRUE;
            EXIT
        ELSIF token = EndKey THEN       (*  If valid function key, act appropriately    *)
            EndFlag := TRUE;
            EXIT
        END
    END
END GetClass;


PROCEDURE GetData (StartValue: CARDINAL);

(*      Collect the data for the QC work. The STARTVALUE parameter is used to enable "split-time"
        data gathering for those lamps which are offered for inspection twice (the majority)        *)

VAR     n, i            : CARDINAL;
        Volts, ExVoR    : REAL;                 (*  Temporary vars for voltage   *)
        dummy           : ARRAY [0..1] OF REAL;

BEGIN
    n := StartValue;
    Volts := FLOAT (Voltage);                   (*  Voltage as a REAL number    *)
    ExVoR := exp (1.54 * ln (Volts / 290.0));   (*  Exponential Voltage Ratio   *)
    LOOP
        Factor := 1.0;
        Delta  := 0.0;
        CASE n OF
         1 :    GetLine ("CoilWeight", 3,  4, 3, 7, CoilW8);
                IF UpFlag THEN   n := 1    ELSE   n := 2    END;
                |
         2 :    IF Voltage < 290 THEN
                    IF Power.Target < 1950.0 THEN
                        GetLine ("Enter Watts", 6,  6, 0, 7, Power)
                    ELSE
                        Factor := Volts;
                        GetLine ("Enter AMPs",  6,  6, 0, 7, Power)
                    END;
                ELSE
                    IF Power.Target / ExVoR < 1950.0 THEN
                        Factor := ExVoR;
                        GetLine ("Watt @ 290V", 6,  6, 0, 7, Power)
                    ELSE
                        Factor := Volts * ExVoR;
                        GetLine ("AMPs @ 290V", 6,  6, 0, 7, Power)
                    END;
                END;
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         3 :    IF Lumen.Target > 0.0 THEN
                    GetLine ("Total Lumen", 6, 7, 0, 7, Lumen)
                END;
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         4 :    Factor := 1.18;
                Delta  := -250.0;
                GetLine ("Colour Temp", 6,  8, 0, 7, Colour);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         5 :    GetLine ("Coil Length", 6,  9, 1, 7, CoilLen);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         6 :    GetLine ("Tip Pos.",    1, 10, 0, 7, TipPos);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         7 :    GetLine ("Tube Diam.",  1, 12, 1, 7, TubeDia);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         8 :    GetLine ("Tip height",  6, 13, 1, 7, TipHi);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
         9 :    GetClass (12, VisInsp);                             (* Coil *)
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                IF EndFlag THEN EXIT END;
                |
        10 :    GetClass (19, VisInsp);                             (* Supporters   *)
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        11 :    GetClass (26, VisInsp);                             (* Seal *)
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        12 :    GetLine ("Total Length",  6, 15, 1, 7, LampLen);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                IF HaltFlag THEN   EXIT   END;
                |
        13 :    GetLine ("LeadWire 1",  6, 16, 1, 7, Lead1);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        14 :    GetLine ("LeadWire 2",  6, 17, 1, 7, Lead2);
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        15 :    GetClass (33, VisInsp);                             (* Base *)
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        16 :    GetClass (40, VisInsp);                             (* Marking *)
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        17 :    GetClass (47, VisInsp);                             (* Leadwire *)
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        18 :    IF LD IN TestsToDo THEN
                    i   := OpenWindow ("LD Percent", 1, dummy);
                    LDP := TRUNC (dummy [0]);
                    Goto (20, 71);
                        WriteCard (LDP, 2);     Write ('%')
                END;
                IF UpFlag THEN   DEC (n)   ELSE   INC (n)   END;
                |
        19 :    SaveFile := final;
                EXIT
        END
    END
END GetData;
   
GetData is a big procedure. It relies on 'GetLine'. It's getting complex here...
      
PROCEDURE BuildScreen (n  : CARDINAL);      (*  General function for building up screens    *)

BEGIN
    CASE n OF
      1 :   Goto (0, 0);    displayAttr := 07;
            ClrEOS;         displayAttr := 14;

            Goto (2, 8);    Print ("+-+  +-+ +------+ +-+  +-+ +-+ +------+     +------+  +------+");
            Goto (3, 8);    Print ("| |  | | | +----+ | |  | | +-+ | +--+ |     | +--+ |  | +--+ |");
            Goto (4, 8);    Print ("| |  | | | |      | |  | | +-+ | |  | |     | |  | |  | |  +-+");
            Goto (5, 8);    Print ("| |  | | | +----+ | +--+ | | | | |  | |     | |  | |  | |");
            Goto (6, 8);    Print ("| |  | | +----+ | | +--+ | | | | |  | |     | |  | |  | |  +-+");
            Goto (7, 8);    Print ("| +--+ | +----+ | | |  | | | | | +--+ |     | +--+ ++ | +--+ |");
            Goto (8, 8);    Print ("+------+ +------+ +-+  +-+ +-+ +------+     +----+  | +------+");
            Goto (9, 57);                                                    Print ("+--+");
                Goto (19, 60);  Print ("Press END to end.");

            displayAttr := 15;
                Goto (11, 14);  Print ("USHIO Europe (Tilburg) B.V. Quality Control System");
                Goto (12, 17);  Print ("Part of the ADI (Accessable Data Initiative)");
            displayAttr :=  7;
                Goto (19,  8);  PrintDate;
                Goto (24,  0);  Print ("CopyLeft Ushio Europe (Tilburg) BV");
                Goto (24, 60);  Print ("qa.ushio@hetnet.nl");
            displayAttr := 11;
            SetCursorType (8, 8);
                Goto (14,  8);  Print ("Enter Lampname : ");
            |
      2 :   Goto (0, 0);
            displayAttr :=  7;   ClrEOS;
                Goto (0,  0);   Print ("Quality Control for : ");   Print (LampName);
                Goto (0, 58);   PrintDate;
            displayAttr :=  2;
                Goto (2,  2);   Print ("Line : ");          Print (tLine);
                Goto (2, 15);   Print ("Nominal value");
                Goto (3, 15);   Print ("---------------");
            displayAttr :=  3;
                Goto (2, 34);   Print ("Measured value");
                Goto (3, 34);   Print ("---------------");
                Goto (2, 52);   Print ("Cpk");
                Goto (3, 52);   Print ("---");
                Goto (2, 57);   Print ("Pass");
                Goto (3, 57);   Print ("----");
                Goto (2, 64);   Print ("Coil :");
            displayAttr :=  2;
                Goto ( 4,  1);  Print ("Coilweight  :");
                Goto ( 6,  1);  Print ("Power       :");
                Goto ( 7,  1);  Print ("Lumen       :");
                Goto ( 8,  1);  Print ("Colour      :");
                Goto ( 9,  1);  Print ("Length Coil :");
                Goto (10,  1);  Print ("Tip position:");
                Goto (12,  1);  Print ("Tube diam.  :");
                Goto (13,  1);  Print ("Tip height  :");
                Goto (15,  1);  Print ("Length F->F :");
                Goto (16,  1);  Print ("Leadwire #1 :");
                Goto (17, 10);  Print ("#2 :");
                Goto (22,  1);  Print ("Remarks:");
            displayAttr := 11;
                Goto (19, 11);  Print ("Coil   Supp   Seal   Base   Mark   Wire");
                Goto (20,  1);  Print ("Visual :");
            displayAttr :=  4;
                Goto (19, 63);  Print ("TL  HD  LD");
                Goto (20, 53);  Print ("Perform :");
            displayAttr :=  7;
                Goto (24,  0);  Print ("CopyLeft Ushio Europe (Tilburg) BV");
                Goto (24, 60);  Print ("qa.ushio@hetnet.nl")
    END
END BuildScreen;
   
Function to build the screen. The original used DOS style line draw characters.
      
PROCEDURE ResumeData (filepath   : PathName);

(*  If we have some old data waiting (from the "first 10 aged" series), read in the file and
    continue with the new test parameters.
    *)

VAR     buffer      : ARRAY [0..19] OF CHAR;        (*  buffer for reading REALs            *)
        ok          : BOOLEAN;
        n, oldvalue : CARDINAL;


    PROCEDURE ReadRecord (VAR  Record    : StatVals);   (*  Read one stored record from file.   *)

    BEGIN
        WITH Record DO
            ReadString (buffer);    StringToReal (buffer, Actual, ok);
            ReadString (buffer);    StringToReal (buffer, Range,  ok);
            ReadString (buffer);    StringToReal (buffer, Cpk,    ok)
        END
    END ReadRecord;


BEGIN
    oldvalue    := displayAttr;
    displayAttr := 7;
    RedirectInput (filepath);
    ReadName (buffer);                      (*  Get rid of "lamp name" field    *)
    ReadString (CoilNr);
    ReadString (ReflexDate);                (*  Date in Reflex date-format      *)

    ReadRecord (CoilW8);        SetLine ( 4, 3, 7, CoilW8);
    ReadRecord (Power);         SetLine ( 6, 0, 7, Power);
    ReadRecord (Lumen);         IF Lumen.Target # 0.0 THEN   SetLine ( 7, 0, 7, Lumen)   END;
    ReadRecord (Colour);        SetLine ( 8, 0, 7, Colour);
    ReadRecord (CoilLen);       SetLine ( 9, 1, 7, CoilLen);
    ReadRecord (TipHi);         SetLine (13, 1, 7, TipHi);

    ReadReal (TipPos.Actual);   TipPos.Range := 10000.0;        TipPos.Cpk := 0.0;
        Goto (10, 33);          WriteCard (TRUNC (TipPos.Actual), 7);
        Goto (10, 50);          displayAttr := 6;       Print ("  REF");
        Goto (10, 57);
        IF (TipPos.Actual > TipPos.LSL) AND (TipPos.Actual < TipPos.USL) THEN
            displayAttr := 10;      Print (" Yes")
        ELSE
            displayAttr := 12;      Print ("STOP")
        END;
    displayAttr := 7;

    ReadString (buffer);                        (*  Retrieve outside diameter of tube   *)
        StringToReal (buffer, TubeDia.Actual, ok);
        IF TubeDia.Actual > 9.9 THEN
            Goto (12, 36)
        ELSE
            Goto (12, 37)
        END;
        TubeDia.Range := 10000.0;       TubeDia.Cpk := 0.0;
        Print (buffer);
        Goto (12, 50);      displayAttr := 6;       Print ("  REF");
        Goto (12, 57);
        IF (TubeDia.Actual > TubeDia.LSL) AND (TubeDia.Actual < TubeDia.USL) THEN
            displayAttr := 10;      Print (" Yes")
        ELSE
            displayAttr := 12;      Print ("STOP")
        END;

    displayAttr := 2;
    ReadString (VisInsp);                   (*  Retrieve results of visual inspections  *)
        Goto (20, 12);      Display.Write (VisInsp [0]);
        Goto (20, 19);      Display.Write (VisInsp [1]);
        Goto (20, 26);      Display.Write (VisInsp [2]);

    displayAttr := oldvalue;
    CloseInput
END ResumeData;


PROCEDURE SaveToFile (path  : ARRAY OF CHAR);

VAR     in, out     : File;             Max         : LONGCARD;
        ch          : CHAR;             i, max      : CARDINAL;

BEGIN
    RedirectOutput ("Store.Dat");       WriteData (2);      CloseOutput;    (*  Save to temp file   *)
    Lookup (out, path, TRUE);                                               (*  Open real file      *)
    IF out.res = notdone THEN
        Lookup (out, "TempRes.Dat", TRUE)
    END;
    LLength (out, Max);
    SetLPos (out, Max);
    Lookup (in, "Store.Dat", FALSE);
    LLength (in, Max);                          (*  Prepare to add data to end of file  *)
    max := SHORT (Max);
    ReadChar (in, ch);
    WHILE (ch # ASCII.EOF) AND (ch # 0C) DO
        WriteChar (out, ch);                    (*  Transfer data byte by byte          *)
        ReadChar (in, ch)
    END;
    Close (out);
    Close (in)
END SaveToFile;


PROCEDURE WriteData (status     : CARDINAL);

VAR     n           : CARDINAL;
        ok          : BOOLEAN;
        buffer      : ARRAY [0..11] OF CHAR;

BEGIN
    Write ('"');                WriteString (LampName);     Write ('"');        Write (ASCII.HT);
    WriteString (CoilNr);       Write (ASCII.HT);
    WriteCard (maand, 1);       Write ("/");
    WriteCard (dag, 1);         Write ("/");
    WriteCard (jaar, 1);        WriteLn;                    Write (ASCII.HT);

    WITH CoilW8 DO
        RealToString (Actual, 5, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  5, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    5, 10, buffer, ok);       WriteString (buffer)
    END;
    WITH Power DO
        RealToString (Actual, 2, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    5, 10, buffer, ok);       WriteString (buffer)
    END;
        WriteLn;    Write (ASCII.HT);

    WITH Lumen DO
        RealToString (Actual, 2, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  3, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    5, 10, buffer, ok);       WriteString (buffer)
    END;
    WITH Colour DO
        RealToString (Actual, 2, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    4, 10, buffer, ok);       WriteString (buffer)
    END;
        WriteLn;        Write (ASCII.HT);

    WITH CoilLen DO
        RealToString (Actual, 4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    4, 10, buffer, ok);       WriteString (buffer)
    END;
    WITH TipHi DO
        RealToString (Actual, 4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    4, 10, buffer, ok);       WriteString (buffer)
    END;
        WriteLn;        Write (ASCII.HT);

    RealToString (TipPos.Actual,  2, 10, buffer, ok);   WriteString (buffer);
    RealToString (TubeDia.Actual, 2, 10, buffer, ok);   WriteString (buffer);

        IF status = 1 THEN  RETURN  END;

    WITH LampLen DO
        RealToString (Actual, 3, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    4, 10, buffer, ok);       WriteString (buffer)
    END;
        WriteLn;        Write (ASCII.HT);

    WITH Lead1 DO
        RealToString (Actual, 3, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    4, 10, buffer, ok);       WriteString (buffer)
    END;
    WITH Lead2 DO
        RealToString (Actual, 3, 10, buffer, ok);       WriteString (buffer);
        RealToString (Range,  4, 10, buffer, ok);       WriteString (buffer);
        RealToString (Cpk,    4, 10, buffer, ok);       WriteString (buffer)
    END;
        WriteLn;        Write (ASCII.HT);

    IF LD IN TestsToDo THEN     WriteCard (LDP, 8)  ELSE    WriteCard (200, 8)  END;

    WriteString ('   ');
    FOR n := 0 TO 5 DO
        Write (VisInsp [n]);
        Write (' ')
    END;
    WriteLn
END WriteData;


PROCEDURE SaveData;

(*  Save the results to file.
    After the "first 10", save the file as a Suspended Data File (SDF) in the SUSPEND directory.
    After the "first  5", save the data in the monthly file.                                        *)

VAR     name        : ARRAY [0..7] OF CHAR;
        buffer      : ARRAY [0..11] OF CHAR;
        t           : Time;

BEGIN
    GetTime (t);
    dag := t.day MOD 32;                 maand := (t.day DIV 32) MOD 16;
    jaar := (t.day DIV 512) + 1900;
    IF SaveFile = suspend   THEN
        Assign (CoilNr, name);              (*  Take first 8 (or less) chars of CoilNumber      *)
        path := "SUSPEND\";                             (*  Start constructing the pathname     *)
        Append (path, name);
        Append (path, ".SDF");                          (*  Top it off with an extension        *)
        RedirectOutput (path);
            WriteData (1);
            Write (ASCII.HT);
            WriteLine (VisInsp);
            Write (0C);
        CloseOutput

    ELSIF SaveFile = final  THEN
        path := "RESULTS\";
        CASE maand OF
            1 : buffer := 'JAN';    |       2 : buffer := 'FEB';    |       3 : buffer := 'MAR';    |
            4 : buffer := 'APR';    |       5 : buffer := 'MAY';    |       6 : buffer := 'JUN';    |
            7 : buffer := 'JUL';    |       8 : buffer := 'AUG';    |       9 : buffer := 'SEP';    |
           10 : buffer := 'OCT';    |      11 : buffer := 'NOV';    |      12 : buffer := 'DEC'
        ELSE
            buffer := 'ERR'
        END;
        Append (path, buffer);
        CardToString (jaar, buffer, 4);     Append (path, buffer);      Append (path, '.DAT');
        SaveToFile (path)
    END;
    SaveFile := empty
END SaveData;


PROCEDURE PrintResults (Property    : StatVals; Unit    : ARRAY OF CHAR);

VAR     ok          : BOOLEAN;
        buffer      : ARRAY [0..15] OF CHAR;

BEGIN
    WITH Property DO
        RealToString (LSL,    1, 7, buffer, ok);    WriteString (buffer);   WriteString (" -");
        RealToString (USL,    1, 7, buffer, ok);    WriteString (buffer);   Write (" ");
                WriteString (Unit);                 WriteString ("  ");

        RealToString (Actual, 2, 8, buffer, ok);    WriteString (buffer);
        IF Range >= 100.0 THEN
            RealToString (Range,  1, 6, buffer, ok)
        ELSE
            RealToString (Range,  2, 6, buffer, ok)
        END;
        IF Range < 10000.0 THEN
            WriteString (" �");
            WriteString (buffer)
        ELSE
            WriteString ('        ')
        END;                                        WriteString ("  ");
        RealToString (Cpk,    1, 5, buffer, ok);
            IF    Range =     0.0 THEN  WriteString ("  INF")
            ELSIF Range = 10000.0 THEN  WriteString ("  REF")
            ELSE
                WriteString (buffer)
            END;                                        WriteString ("  ");
        IF Cpk > MinCpk THEN
            WriteLine ("OK")
        ELSE
            IF Cpk = 0.0 THEN
                IF (Actual > LSL) AND (Actual < USL) THEN   WriteLine ("OK")   END
            ELSE
                WriteLine ("FAILED")
            END
        END
    END
END PrintResults;


PROCEDURE PrintSheet;

VAR     n           : CARDINAL;
        buffer      : ARRAY [0..11] OF CHAR;

BEGIN
    RedirectOutput ("PRN");
    Write (ASCII.ESC);      Write ('E');
    WriteLn;
    WriteLn;
    Write (ASCII.HT);       Write (ASCII.ESC);      WriteString ('(s1p25v0s3b4148T');       WriteLine (LampName);
    WriteLn;
    WriteLn;

    Write (ASCII.ESC);      WriteString ('(s1p18v0s3b4148T');
    Write (ASCII.HT);       WriteString ('Coil nr : ');             WriteString (CoilNr);
    Write (ASCII.HT);       Write (ASCII.HT);                       WriteString ('T-');         Write (tLine);
    Write (ASCII.HT);       Write (ASCII.HT);                       PrintDate;
    WriteLn;
    WriteLn;

    Write (ASCII.ESC);      WriteLine ('(s0p12h10v0s1b3T');         WriteLn;
    Write (ASCII.HT);       WriteLine ('Property            Target values       Average � 3.�      Cpk  Result');
    Write (ASCII.HT);       WriteLine ('----------------   ------------------   ---------------   ----  ------');

    Write (ASCII.HT);       WriteString ('Coiling weight  : ');
        WITH CoilW8 DO
            RealToString (LSL,    3, 7, buffer, ok);    WriteString (buffer);   WriteString (" -");
            RealToString (USL,    3, 7, buffer, ok);    WriteString (buffer);   WriteString (" g   ");
            RealToString (Actual, 3, 8, buffer, ok);    WriteString (buffer);   WriteString (" �");
            RealToString (Range,  3, 6, buffer, ok);    WriteString (buffer);   WriteString ("  ");
            RealToString (Cpk,    1, 5, buffer, ok);    WriteString (buffer);   WriteString ("  ");
            IF Cpk > MinCpk THEN
                WriteLine ("OK")
            ELSE
                WriteLine ("FAILED")
            END
        END;
    WriteLn;

    Write (ASCII.HT);       WriteString ('Power (Wattage) : ');     PrintResults (Power, 'W ');
    Write (ASCII.HT);       WriteString ('Lumen           : ');
    IF Lumen.USL # 0.0 THEN
        PrintResults (Lumen, 'Lm')
    ELSE
        WriteLn
    END;
    Write (ASCII.HT);       WriteString ('Colour temp     : ');     PrintResults (Colour,  'K ');
    Write (ASCII.HT);       WriteString ('Coil length     : ');     PrintResults (CoilLen, 'mm');
    Write (ASCII.HT);       WriteString ('Tip position    : ');     PrintResults (TipPos,  'mm');
    WriteLn;
    Write (ASCII.HT);       WriteString ('Tube diameter   : ');     PrintResults (TubeDia, 'mm');
    Write (ASCII.HT);       WriteString ('Tip height      : ');     PrintResults (TipHi,   'mm');
    WriteLn;
    Write (ASCII.HT);       WriteString ('Total length    : ');     PrintResults (LampLen, 'mm');
    Write (ASCII.HT);       WriteString ('Leadwire 1      : ');     PrintResults (Lead1,   'mm');
    Write (ASCII.HT);       WriteString ('Leadwire 2      : ');     PrintResults (Lead2,   'mm');
    WriteLn;
    Write (ASCII.HT);       WriteLine ('Coil    Supp    Seal    Base    Mark    Wire');
    Write (ASCII.HT);       Write (' ');
        FOR n := 0 TO 5 DO
            Write (VisInsp [n]);    WriteString ('       ')
        END;

    Write (ASCII.FF);
    CloseOutput
END PrintSheet;


PROCEDURE Initialize;

(*  Initialize the software with some defaults. In the future, the calibration datafiles
    might be loaded and interpreted here as well.               *)

VAR     InFile      : File;

BEGIN
    snowy := FALSE;
    Factor := 1.0;
    TestsToDo := SetOfTests {};
    Lookup (InFile, "Master.Dat", FALSE);
    IF InFile.res = notdone THEN
        UserMessage (1);
        Terminate (1)
    END;
    Close (InFile);
    SaveFile := empty;
END Initialize;


PROCEDURE ShutDown;         (*  Prepare the system for shutdown of the software     *)

BEGIN
    SetCursorType (7, 8);
    displayAttr := 7;
    Goto (0, 0);
    ClrEOS
END ShutDown;


PROCEDURE FindSuspendedFile (Name   : ARRAY OF CHAR; VAR path   : PathName) : BOOLEAN;

(*  Check if we still have data pending from this lamp. This function is here due to the timelapse
    between the "first 10 aged" series of lamps and the "first 5 finished" lamps.
    The function simply tries to open a file with the name <COILNR> and extension "SDF".    *)

VAR     InFile      : File;
        name        : ARRAY [0..7] OF CHAR;

BEGIN
    Assign (Name, name);                (*  Take first 8 (or less) chars of CoilNumber      *)
    path := "SUSPEND\";                             (*  Start constructing the pathname     *)
    Append (path, name);
    Append (path, ".SDF");                          (*  Top it off with an extension        *)
    Lookup (InFile, path, FALSE);
    IF InFile.res = done THEN
        Close (InFile);
        RETURN TRUE
    ELSE
        Close (InFile);
        RETURN FALSE
    END
END FindSuspendedFile;


BEGIN
    LOOP
        Initialize;
        BuildScreen (1);
        REPEAT
            ReadText (LampName);            IF EndFlag THEN  EXIT  END
        UNTIL NonEmpty;

        UpperString (LampName);
        CompressName (LampName, LookUpName);
        IF FindSpec (LookUpName, FileName) = TRUE THEN
            ReadParameters (FileName, ok);
            IF ok THEN
                Goto (16, 8);   WriteString ("Productionline : ");
                REPEAT   Read (tLine)   UNTIL (tLine >= '0') AND (tLine <= '9');
                BuildScreen (2);            FillScreen;
                VisInsp := "";
                Suspended := FindSuspendedFile (CoilNr, path);
                IF Suspended THEN
                    ResumeData (path);      GetData (12)
                ELSE
                    SaveFile := suspend;    GetData (1)
                END;
                IF Suspended THEN
                    Answer := Confirm ("Delete suspended data?");
                    IF  Answer = TRUE  THEN  Files.Delete (path)  END
                END;
                Goto (23, 0);
                IF SaveFile = final THEN
                    Answer := Confirm ("Print summary?");   IF Answer = TRUE THEN  PrintSheet  END
                END;
                Answer := Confirm ("Save data?");
                IF Answer = TRUE  THEN  SaveData;  Print ("Data saved. ")  END;
                displayAttr := 0EH;
                Print ("Press [Enter] to continue");        KeyW8 (ASCII.CR)
            ELSE
                UserMessage (3);        KeyW8 (ASCII.CR)
            END
        ELSE
            UserMessage (2);            KeyW8 (' ')
        END
    END;
    ShutDown
END QC08.
   

Page created April 26, 2007 and