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:
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 on 26 April 2007 and
Page equipped with FroogleBuster technology