'Library of functions used with SCM5B and SCT1P test programs.
'Created from LIB49.BAS
'Author:        John Lehman   9/15/95
'KEPCO ABC125 Upgrade code development - Tom Orlando
'Date:          10/25/2007
'
'       REVISION RECORD
'
'Date of Change 	Description
'--------------		-----------
'10/5/95  	JL		Initial Release.
' ...				See "Revs.txt" file.
'1/23/12  	TSO		Modified RTDTHCAL to send failing initialization results to the printer.
'12/18/12 	CJT		Revision record and mods to make print to file and ask user for print to paper.
'10/30/13 	PWR		Version for lot-status and extended serial numbers release. Updated "GETSN"
'					sub and added "GETWO$" and "GETDS$", "ISPOSNUMBER%" and "GETWOSFNAME$"
'					functions and "SNPARSE" and "GETDSFNAME" subs. Added restrictions and error
'					messages for dash number (sequential number) and work order number. Work
'					order number restrictions and datasheet file name creation will support
'					work order numbers beyond "99999".
'11/06/13	PWR		Updated "GETWO$" function to require two matching work order entries, and
'					"GETDS" function to allow alphabetic and alphanumeric entries for prototype
'					or debug testing. Added the "ISALLLETTERS%" function as part of the new
'					validation of the dash number entries. The "REPEAT$" and "REPEAT2$" functions
'					were also modified to explicitly require that the "Y" or "N" keys be
'					pressed (uppercase or lowercase), not "any" key.
'11/07/13	PWR 	Fixed first-entry problem for work order number in "GETWO$" function in "NLIBATED.BAS".
'11/14/13	PWR 	Removed "DATASHEETWRITE" declaration.
' 
DECLARE SUB CALDAC (TE$)                        'Read main and vernier DAC limits
DECLARE SUB CASEINST ()                         'Tell user to install a case over the unit
DECLARE SUB CHANGEDN (SN$)
DECLARE SUB CONTINUE ()                         'Waits for a key press
DECLARE SUB GETSN (SN$)
DECLARE SUB HS1 ()                              'GPIB communications handshake
DECLARE SUB INIT488 (DVMADDR%)                  'Initialize 488 interface
DECLARE SUB INITPS (VINADDR%, OVERI!, OVERV!)      'Initialize Kepco DPS power supply
DECLARE SUB LOADDAC (BINDATA%, DAC%)            'Send data to DAC
DECLARE SUB LOADMUX (CH%, CHON%)                'Set relay multiplexer
DECLARE SUB OHMSET (OHM!)                       'Set resistor DAC
DECLARE SUB PAUSE (TIME!)                       'Pause for TIME
DECLARE SUB RTDTHCAL ()                         'Check test head operation
DECLARE SUB SETDAC (VOLTAGE!, CH%, VSENATTEN!)  'Set DAC voltage
DECLARE SUB SETDAC2 (VOLTAGE!, CH%, VSENATTEN!) 'Sets DAC, output module test heads
DECLARE SUB SETDACFAST (VOLTAGE!)               'Set main DAC voltage (fast operation)
DECLARE SUB SETTEST (TEST%)                     'Set test 0-7 on RTD test head
DECLARE SUB SETTH (DOUT%, BANK%)                'Load test head controlbank data
DECLARE SUB SETTHFAST (DOUT%, BANK%)            'Load test head, don't disable
DECLARE SUB TRIGGER ()                          'Send trigger to 488 device
DECLARE SUB WRITEDVM (CMD$, value!)            	'Send command to 488 DVM
DECLARE SUB WRITEGEN (CMD$, value!)            	'Send command to 488 function generator
DECLARE SUB WRITEPS (ADDR%, CMD$)
DECLARE SUB SNPARSE (SN$, WO$, DS$)				'Parses serial number into work order and dash numbers
DECLARE SUB GETDSFNAME (SN$, DSSNAME$, DSFNAME$)	'Gets datasheet search and file names from serial number



DECLARE SUB WORKORDERLINE (FAILSTATE%, SN$)
DECLARE SUB WORKORDERPRINT (SN$)
DECLARE SUB WORKORDERHEADER (SN$)



DECLARE FUNCTION BESTFIT! (SLOPE!, OFFSETS!, TSIM!(), NUMPTS%, ERRO!())
DECLARE FUNCTION FAILCOM! (SETP$)               'Sends a "FAIL" flag to SETPOWER if serial COM FAILURE
DECLARE FUNCTION GETTHID% ()                    '** Get test head id #
DECLARE FUNCTION KEYBDIN$ ()                    '** Get keyboard input
DECLARE FUNCTION MEASRES! (OHM!, RESNUM%, TE$)  'Measure loop current sense resistor
DECLARE FUNCTION POWERIO$ (ADDR%, CMD$)         '** Kepco DPS power supply I/O
DECLARE FUNCTION READDVM! (TOL!)                '** Get Fluke meter reading
DECLARE FUNCTION READDATA$ (ADDR%)
DECLARE FUNCTION READPS$ (ADDR%, CMD$)
DECLARE FUNCTION READGPIB$ (ADDR%, CMD$)
DECLARE FUNCTION REPEAT$ (N$)                   '** Ask if you would like to repeat test
DECLARE FUNCTION REPEAT2$ (N$, SN$)
DECLARE FUNCTION RTDOHMS! (TEMP!, SENTYPE$)     '** Convert RTD in temp to ohms
DECLARE FUNCTION RTDTEMP! (OHMS!, SENTYPE$)     '** Convert RTD ohms to temp
DECLARE FUNCTION SETATTEN% (VOLTAGE!)           '** Sets test head R/2R ladder
DECLARE FUNCTION SETPOWER$ (ADDR%, VSUPPLY!, FUNC$)    '** Controls Kepco DPS 125
DECLARE FUNCTION SETRANGE$ (value!)             'Library fn only. Set Fluke range.
DECLARE FUNCTION STRINGVAL% (a$)                '**
DECLARE FUNCTION TCTEMP! (TCV!, SENTYPE$)       '** Convert TC volts to deg. C
DECLARE FUNCTION TCVOLTS! (TEMP!, SENTYPE$)     '** Convert TC in temp to V

DECLARE FUNCTION GETWO$ ()						'Gets and returns the work order number
DECLARE FUNCTION GETDS$(ISNEWDS%, SN$)			'Gets and returns the dash number
DECLARE FUNCTION ISPOSNUMBER% (TESTVALUE$)		'Returns "1" for positive number, "0" otherwise
DECLARE FUNCTION ISALLLETTERS% (TESTVALUE$)		'Returns "1" for all letters, "0" otherwise
DECLARE FUNCTION GETWOSFNAME$ (SN$)         	'Returns work order status file name from serial number

DECLARE FUNCTION UPSN$ (SN$)                    '** Increments dash# of serial#
												'** Function called from main programs.
												'   Declare in programs which call this function.
												
DECLARE FUNCTION FAILS% (STATUS$())             'Tests for failed tests

												
COMMON SHARED CB0VAL%, CB1VAL%, CB2VAL%, CB3VAL%
COMMON SHARED MAINMAX!, MAINMIN!, VERNMAX!, VERNMIN!
COMMON SHARED BADDRS%, LPTADDR%, MUXADDR%, THADDR%, PSADDR%, VINADDR%
COMMON SHARED PSPORT%, DVMADDR%, GENADDR%
COMMON SHARED DPSPSADDR%, DPSVINADDR%, ABCPSADDR%, ABCVINADDR%
COMMON SHARED PSMODEL$, VINMODEL$

'VINMODEL$ will be used if 2 different KEPCOs are used.

'assign constants to Fluke meter commands
CONST OHM4$ = "F4", OHM2$ = "F3"

CONST CON% = 1, COFF% = 0
CONST CB0% = 0, CB1% = 1, CB2% = 2, CB3% = 3
CONST VODC$ = "F1", FREQ$ = "FREQ"

'CONST DVMADDR% = 1                      'GPIB address of Fluke 8842A meter
'CONST GENADDR% = 2                      'GPIB address of HP33120A function generator
CONST MTA% = &H40                       'GPIB talk address
CONST MLA% = &H20                       'GPIB listen address
CONST MAIN% = 1
CONST VERN% = 0

CONST VOLT$ = "STV=", READVOLT$ = "RTV"
CONST CURRENT$ = "RTC", ISTAT$ = "RCS"
CONST LOOPON$ = "SOP=ON", LOOPOFF$ = "SOP=OFF", LOCAL$ = "LOC"

'KEY(10) ON                              'Activates F10 key
'ON KEY(10) GOSUB FINISH                 'Traps for F10 key Exits if pressed


'FINISH: END


'******** THERMOCOUPLE POLYNOMIAL COEFFICIENTS EMF = F(T) ******************
	   
	'Type J TC polynomial   -210C to +760C (RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES)
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEJ1:    DATA -212, 760, 0, 5.0381187815E1, 3.0475836930E-02, -8.5681065720E-05, 1.3228195295E-07
	   DATA -1.7052958337E-10, 2.0948090697E-13, -1.2538395336E-16, 1.5631725697E-20, 0
	'Type J TC polynomial   +760C to +1200C
TYPEJ2:    DATA 760, 1202, 2.9645625681E5, -1.4976127786E3, 3.1787103924, -3.1847686701E-3, 1.5720819004E-6
	   DATA -3.0691369056E-10, 0

	   
	'Type K TC polynomial   -270C to 0C
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEKNEG:  DATA -272, 0, 0, 3.9450128025E1, 2.3622373598E-2, -3.2858906784E-4, -4.9904828777E-6
	   DATA -6.7509059173E-08, -5.7410327428E-10, -3.1088872894E-12
	   DATA -1.0451609365E-14, -1.9889266878E-17, -1.6322697486E-20, 0
	'Type K TC polynomial   0C to +1372C
TYPEKPOS:  DATA 0, 1374, -1.7600413686E1, 3.8921204975E1, 1.8558770032E-2, -9.9457592874E-5
	   DATA 3.1840945719E-07, -5.6072844889E-10, 5.6075059059E-13
	   DATA -3.2020720003E-16, 9.7151147152E-20, -1.2104721275e-23, 0
	  

	'Type T TC polynomial   -270C to 0C
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPETNEG:  DATA -272, 0, 0, 3.8748106364E1, 4.4194434347E-2, 1.1844323105E-4, 2.0032973554E-5
	   DATA 9.0138019559E-07, 2.2651156593E-08, 3.6071154205E-10, 3.8493939883E-12
	   DATA 2.8213521925E-14, 1.4251594779E-16, 4.8768662286E-19
	   DATA 1.0795539270E-21, 1.3945027062E-24, 7.9795153927E-28, 0
	'Type T TC polynomial   0C TO +400C
TYPETPOS:  DATA 0, 402, 0, 3.8748106364E1, 3.3292227880E-2, 2.0618243404E-4, -2.1882256846E-6
	   DATA 1.0996880928E-08, -3.0815758772E-11, 4.5479135290E-14, -2.7512901673E-17, 0


	'Type E TC polynomial   -270C TO 0C
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEENEG:  DATA -272, 0, 0, 5.8665508708E1, 4.541098E-2, -7.799805E-4, -2.580016E-5
	   DATA -5.945258E-07, -9.321406E-9, -1.028761E-10, -8.037012E-13
	   DATA -4.397950E-15, -1.641478E-17, -3.967362E-20, -5.582733E-23, -3.465784E-26, 0
	'Type E TC polynomial   0C to +1000C
TYPEEPOS:  DATA 0, 1005, 0, 5.8665508710E1, 4.503228E-2, 2.890841E-5, -3.305690E-07
	   DATA 6.502440E-10, -1.919750E-13, -1.253660E-15, 2.148922E-18
	   DATA -1.438804E-21, 3.596090E-25, 0

	  
	 'Type R TC polynomial   -50C to +1064.18
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPER1:  DATA -52, 1064.18, 0, 5.28961729765, 1.391666E-2, -2.388557E-5, 3.569160E-08
	 DATA -4.623477E-11, 5.007774E-14, -3.731059E-17, 1.577165E-20, -2.810386E-24, 0
	'Type R TC polynomial   +1064.18C TO 1664.5C
TYPER2:  DATA 1064.18, 1664.5, 2.95157925316E3, -2.52061251332, 1.595645E-2, -7.640860E-06
	 DATA 2.053053E-9, -2.933597E-13, 0
	'Type R TC polynomial   +1664.5C TO +1768.1C
TYPER3:  DATA 1664.5, 1770.1, 1.52232118209E5, -2.68819888545E2, 1.712803E-1, -3.458957E-5
	 DATA -9.346340E-12, 0
	   
	   
	'Type S TC polynomial   -50C to +1064.18
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPES1:  DATA -52, 1064.18, 0, 5.40313308631, 1.259343E-2, -2.324780E-5, 3.220288E-08
	 DATA -3.314652E-11, 2.557443E-14, -1.250689E-17, 2.714432E-21, 0
	'Type S TC polynomial   +1064.18C TO 1664.5C
TYPES2:  DATA 1064.18, 1664.5, 1.32900444085E3, 3.34509311344, 6.548052E-3, -1.648563E-06
	 DATA 1.299896E-11, 0
	'Type S TC polynomial   +1664.5C TO +1768.1C
TYPES3:  DATA 1664.5, 1770.1, 1.46628232636E5, -2.58430516752E2, 1.636936E-1, -3.304390E-5
	 DATA -9.432237E-12, 0


	'Type B TC polynomial   0C TO +630.615C
	'POLYNOMIAL RANGE MODIFIED BY 2 DEGREES C ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
TYPEB1:  DATA -2, 630.615, 0, -2.465081E-1, 5.904042E-3, -1.325793E-6, 1.566829E-09
	DATA -1.694453E-12, 6.299035E-16, 0
	'Type B TC polynomial   630.615C TO +1820C
TYPEB2:  DATA 630.615, 1822, -3.8938168621E3, 2.857174747E1, -8.488511E-2, 1.578528E-4, -1.683535E-07
	DATA 1.110979E-10, -4.451543E-14, 9.897564E-18, -9.379133E-22, 0


	'Type C TC polynomial 0C to +2315C (-32F to 4208F)
	'**These coeffs are for temp in deg F.
TYPEC:  DATA -33, 4209, -234.471, 0.7190027E1, 0.3956443E-2, -0.1842722E-5
	DATA 0.3471851E-9, -0.2616792E-13, 0

   
	'Type N TC polynomial  -270C to 0C
TYPENNEG:  DATA -272, 0, 0, 2.6159105962E1, 1.095748E-2, -9.384111E-5, -4.641204E-8
	   DATA -2.630336E-9, -2.265344E-11, -7.608930E-14, -9.341967E-17, 0
	'Type N TC polynomial   0C to +1300C
TYPENPOS:  DATA 0, 1302, 0, 2.5929394601E1, 1.571014E-2, 4.382563E-5, -2.526117E-7
	   DATA 6.431182E-10, -1.006347E-12, 9.974534E-16, -6.086325E-19
	   DATA 2.084923E-22, -3.068220E-26, 0
	   
	   

'******* THERMOCOUPLE INVERSE POLYNOMIAL COEFFICIENTS T = F(EMF) **************
	
	'Type J TC INVERSE polynomial -210C to 0C, -0.05C to +0.03C accurate
	'-8095uV to 0uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVJ1:  DATA -8135, 0, 0, 1.952827E-2, -1.228619E-6, -1.075218E-9, -5.908693E-13
	DATA -1.725671E-16, -2.813151E-20, -2.396337E-24, -8.382332E-29, 0
	'Type J TC INVERSE polynomial 0C to +760C, +/-0.04C accurate
	'0uV to +42919uV
INVJ2:  DATA 0, 42919, 0, 1.978425E-2, -2.001204E-7, 1.036969E-11, -2.549687E-16
	DATA 3.585153E-21, -5.344285E-26, 5.099890E-31, 0
	'Type J TC INVERSE polynomial +760C to +1200C, -0.04C to +0.03C accurate
	'42919uV to +69593uV
INVJ3:  DATA 42919, 69653, -3.11358187E3, 3.005437E-1, -9.947732E-6, 1.702766E-10
	DATA -1.430335E-15, 4.738861E-21, 0
	   
	   
	'Type K TC INVERSE polynomial -200C to +0C, -0.02C to +0.04C accurate
	'-5891uV to 0uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVK1:  DATA -5931, 0, 0, 2.517346E-2, -1.166288E-6, -1.083364E-9, -8.977354E-13
	DATA -3.734238E-16, -8.663264E-20, -1.045060E-23, -5.192058E-28, 0
	'Type K TC INVERSE polynomial 0C to +500C, -0.05C to +0.04C accurate
	'0uV to 20644uV
INVK2:  DATA 0, 20644, 0, 2.508355E-2, 7.860106E-8, -2.503131E-10, 8.315270E-14
	DATA -1.228034E-17, 9.804036E-22, -4.413030E-26, 1.057734E-30
	DATA -1.052755E-35, 0
	'Type K TC INVERSE polynomial +500C to +1372C, -0.05C to +0.06C accurate
	'20644uV to 54866uV
INVK3:  DATA 20644, 54906, -1.318058E2, 4.830222E-2, -1.646031E-6, 5.464731E-11, -9.650715E-16
	DATA 8.802193E-21, -3.110810E-26, 0
	
	   
	'Type T TC INVERSE polynomial -200C to 0C, -0.02C to +0.04C accurate
	'-5603uV to 0uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVTNEG:  DATA -5643, 0, 0, 2.594919E-2, -2.131697E-7, 7.901869E-10, 4.252778E-13
	  DATA 1.330477E-16, 2.024145E-20, 1.266817E-24, 0
	'Type T TC INVERSE polynomial 0C to +400C, +/-0.03C accurate
	'0uV to 20872uV
INVTPOS:  DATA 0, 20912, 0, 2.592800E-2, -7.602961E-7, 4.637791E-11, -2.165394E-15
	  DATA 6.048144E-20, -7.293422E-25, 0
	   

	'Type E TC INVERSE polynomial -200C to 0C, -0.01C to 0.03C accurate
	'-8825uV to 0uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVENEG:  DATA -8865, 0, 0, 1.6977288E-2, -4.351497E-7, -1.5859697E-10, -9.2502871E-14
	  DATA -2.6084314E-17, -4.1360199E-21, -3.403403E-25, -1.156489E-29, 0
	'Type E TC INVERSE polynomial 0C to +1000C, +/-0.02C accurate
	'0uV to 76373uV
INVEPOS:  DATA 0, 76748, 0, 1.705704E-2, -2.330176E-7, 6.543559E-12, -7.356275E-17
	  DATA -1.789600E-21, 8.403617E-26, -1.373588E-30, 1.062982E-35
	  DATA -3.244709E-41, 0


	'Type R TC INVERSE polynomial -50C to +250C, +/-0.02C accurate
	'-226uV to 1923uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVR1:  DATA -300, 1923, 0, 1.889138E-1, -9.383529E-5, 1.306862E-7, -2.270358E-10
	DATA 3.514566E-13, -3.895390E-16, 2.823947E-19, -1.260728E-22
	DATA 3.135361E-26, -3.318777E-30, 0
	'Type R TC INVERSE polynomial +250C to +1064C, +/-0.005C accurate
	'1923uV to 11361uV
INVR2:  DATA 1923, 11361, 1.334585E1, 1.472645E-1, -1.844025E-5, 4.031130E-9, -6.249428E-13
	DATA 6.468412E-17, -4.458750E-21, 1.994710E-25, -5.313402E-30
	DATA 6.481976E-35, 0
	'Type R TC INVERSE polynomial +1064C to +1664.5C, -0.0005C to +0.001C accurate
	'11361uV to 19739uV
INVR3:  DATA 11361, 19739, -8.199599E1, 1.553962E-1, -8.342198E-6, 4.279434E-10
	DATA -1.191578E-14, 1.492290E-19, 0
	'Type R TC INVERSE polynomial +1664.5C to +1768.1C, -0.001C to +0.002C accurate
	'19739uV to 21103uV
INVR4:  DATA 19739, 21143, 3.406178E4, -7.023729, 5.582904E-4, -1.952395E-8
	DATA 2.560740E-13, 0


	'Type S TC INVERSE polynomial -50C to +250C, +/-0.02C accurate
	'-235uV to +1874uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE OF TEST EQUIMENT ITERATIONS
INVS1:  DATA -275, 1874, 0, 1.849495E-1, -8.005041E-5, 1.022374E-7, -1.522486E-10
	DATA 1.888213E-13, -1.590859E-16, 8.230279E-20, -2.341819E-23
	DATA 2.797863E-27, 0
	'Type S TC INVERSE polynomial +250C to +1064C, +/-0.01C accurate
	'1874uV to 10332uV
INVS2:  DATA 1874, 10332, 1.291507E1, 1.466299E-1, -1.534713E-5, 3.145946E-9
	DATA -4.163258E-13, 3.187964E-17, -1.291638E-21, 2.183475E-26
	DATA -1.477380E-31, 8.211272E-36, 0
	'Type S TC INVERSE polynomial +1064C to +1664.5C, +/-0.0002C accurate
	'10332uV to 17536uV
INVS3:  DATA 10332, 17536, -8.087801E1, 1.621573E-1, -8.536869E-6, 4.719687E-10
	DATA -1.441694E-14, 2.081619E-19, 0
	'Type S TC INVERSE polynomial +1664.5C to +1768.1C, +/-0.002C accurate
	'17536uV to 18693uV
INVS4:  DATA 17536, 18733, 5.333875E4, -1.235892E1, 1.092658E-3, -4.265694E-8
	DATA 6.247205E-13, 0

	   
	'Type B TC INVERSE polynomial about 0C - KEPT AT ZERO
	'-50uV to +2.28uV
INVB0:  DATA -100, 2.28, 0, 0
	'Type B TC INVERSE polynomial +50C to +100C, MATLAB calculated.
	'+2.28uV to +33.2uV
INVB1:  DATA 2.28, 33.2, 41.96648525858551, 4.17611917690301
	DATA -3.6363063524752E-1, 4.062282514548E-2, -3.27375413268E-3
	DATA 1.6908870534E-4, -5.26545664E-6, 8.960324E-8, -6.3806E-10, 0
	'Type B TC INVERSE polynomial +100C to +150C, MATLAB calculated.
	'+33.2uV to +92.06uV
INVB2:  DATA 33.2, 92.06, 50.88527475773098, 2.00987431811108
	DATA -2.203802052765E-02, 2.2299977771E-04, -1.33317504E-06
	DATA 3.42225E-09, 0
	'Type B TC INVERSE polynomial +150C to +200C, MATLAB calculated.
	'+92.06uV to 178.26uV
INVB3:  DATA 92.06, 178.26, 64.97083255397403, 1.25020250628510
	DATA -4.69901536023E-03, 1.427652212E-05, -1.919530E-08, 0
	'Type B TC INVERSE polynomial +200C to +250C, MATLAB calculated.
	'+178.26uV to 291.28uV
INVB4:  DATA 178.26, 291.28, 75.70857872803234, 9.8679299982849E-01
	DATA -2.25934986745E-03, 4.16854466E-06, -3.39906E-09, 0
	'Type B TC INVERSE polynomial +250C to +700C, -0.02C to +0.03C accurate
	'291uV to 2431uV
INVB5:  DATA 291.28, 2431, 9.842332E1, 6.997150E-1, -8.476530E-4
	DATA 1.005264E-6, -8.334595E-10, 4.550854E-13, -1.552304E-16
	DATA 2.988675E-20, -2.474286E-24, 0
	'Type B TC INVERSE polynomial +700C to +1820C, -0.01C to +0.02C accurate
	'2431uV to 13820uV
INVB6:  DATA 2431, 13900, 2.131507E2, 2.851050E-1, -5.274289E-5, 9.916080E-9
	DATA -1.296530E-12, 1.119587E-16, -6.062520E-21, 1.866170E-25
	DATA -2.487859E-30, 0


	'Type C TC INVERSE polynomial +32F to +1000F, max. accuracy +/-0.05F
	'0.0 uV to 9395 uV
	'POLYNOMIAL RANGE MODIFIED BY -40 MICROVOLTS ON -FS BECAUSE OF TEST EQUIMENT ITERATIONS
INVC1:  DATA -40, 9395, 32.2462, 0.133353, -7.67462E-6, 8.891E-10
	DATA -6.2196E-14, 1.91477E-18, 0
   
	'Type C TC INVERSE polynomial +1000F to +3000F, max. accuracy +/-0.0063F
	'9395uV to 28955uV
INVC2:  DATA 9395, 28955, 69.4813, 0.112055, -2.16715E-6, 9.92444E-11
	DATA -1.81613E-15, 1.81995E-20, 0
   
	'Type C TC INVERSE polynomial +3000F to +4208F, max. accuracy +/-0.057F
	'28955uV to 37107uV
	'POLYNOMIAL RANGE MODIFIED BY +40 MICROVOLTS ON +FS BECAUSE OF TEST EQUIMENT ITERATIONS
INVC3:  DATA 28955, 37147, -143161, 22.7646, -1.43581E-3, 4.54959E-8
	DATA -7.21241E-13, 4.5844E-18, 0
   

	'Type N TC INVERSE polynomial -200C to 0C, -0.02C to +0.03C accurate
	'-3990uV to 0uV
	'POLYNOMIAL RANGE MODIFIED BY 40 MICROVOLTS ON BOTH EXTREMES BECAUSE TO TEST EQUIMENT ITERATIONS
INVNNEG:  DATA -4030, 0, 0, 3.843685E-2, 1.101049E-6, 5.222931E-9, 7.206053E-12
	  DATA 5.848859E-15, 2.775492E-18, 7.707517E-22, 1.158267E-25
	  DATA 7.313887E-30, 0
	'Type N TC INVERSE polynomial 0C to +1300C, +/-0.06C accurate
	'0uV to 47513uV
INVNPOS:  DATA 0, 47553, 0, 3.878328E-2, -1.161234E-6, 6.952566E-11, -3.009008E-15
	  DATA 8.831158E-20, -1.621384E-24, 1.669336E-29, -7.311754E-35, 0



'**************** RTD POLYNOMIAL COEFFICIENTS R = F(T) ********************

	'NIST Pt RTD polynomial tested accurate to +/-0.01% from -200C to +850C
	'Type Pt RTD polynomial -200C to 0C.  Alpha = 0.00385
TYPEPTNEG:  DATA -201, 0, 100, 3.90802E-1, -5.802E-5, 4.2735E-8, -4.2735E-10, 0

	   
	'Type Pt RTD polynomial 0C to +850C
TYPEPTPOS:  DATA 0, 851, 100, 3.90802E-1, -5.802E-5, 0

	'Type E1 Pt100 (Rosemount) RTD polynomial 0C to +370C; accuracy better than +/-0.01%
TYPEE1PT100:  DATA -1, 371, 100, 0.39486, -5.81579E-5, 0
	   
	   
	'Type Pt100 RTD polynomial -200C to 0C.  Alpha = 0.00392
TYPEPT392NEG:  DATA -201, 0, 100, 3.9848E-1, -5.87E-5, 4.0E-8, -4.0E-10, 0

		  
	'Type Pt100 RTD polynomial 0C to +630C  Alfa = 0.00392
TYPEPT392POS:  DATA 0, 631, 100, 3.9848E-1, -5.87E-5, 0

	   
	   
	'Type Ni RTD polynomial 0C to +150C; accuracy better than +/-0.01%
TYPENI1:  DATA -1, 150, 120, 7.086472E-1, 8.145844E-4, 3.004712E-6, -1.804135E-8
	  DATA 4.379183E-11, 0

	   
	'Type Ni RTD polynomial +150C to +300C; accuracy better than +/-0.013%
TYPENI2:  DATA  150, 301, 9.506276E1, 1.243133, -3.164436E-3, 1.339464E-5, -1.301027E-8, 0

	   
	'Type Cu RTD polynomial; accuracy better than +/-0.01% from 0C to +190C
	'Polynomial is for sensors which are 10 ohms @ 25C.
TYPECU:  DATA -1, 191, 9.035, 3.865188E-2, -9.702684E-7, 9.564953E-9, -6.434575E-11
	 DATA 2.474374E-13, 0
	   
	  
	'Type LEWIS Ni RTD polynomial -17.77C to +120C; Accuracy better than +/-0.02%
TYPENI90NEG:  DATA -20, 120, 90.37878, 0.3380199, 4.086852E-4, 9.321948E-7, -5.017392E-9, 1.547324E-11, 0

		 
	'Type LEWIS Ni RTD polynomial +120C to +260C; Accuracy better than +/-0.015%
TYPENI90POS:  DATA 120, 266, 82.86723, 0.5150368, -1.024307E-3, 5.189308E-6, -5.295223E-9, 0



'************** RTD INVERSE POLYNOMIAL COEFFICIENTS T = F(R) ***************
	   
	'Type Pt RTD INVERSE polynomial -200C to 0C; +/-0.006% accuracy
	'33.01 ohms to 100 ohms
INVPTNEG:  DATA 17.49, 100, -2.421006E2, 2.230334, 2.454677E-3, -5.484812E-6, 0
	   
	   
	'Type Pt RTD INVERSE polynomial 0C to +850C; +/-0.005% accuracy
	'100 ohms to 345.13 ohms
INVPTPOS:  DATA 100, 390.26, -2.462745E2, 2.369714, 9.225909E-4, -6.977814E-8, 1.506860E-9, 0

	'Type E1 Pt100 (Rosemount) INVERSE polynomial 0C to +370C; +/-0.00047% accuracy
	'100 ohms to 238.138 ohms
INVE1PT100:  DATA 99, 240, -245.031, 2.3766, 0.000643374, 9.31902E-7, 0
	   
	'Type Pt392 RTD INVERSE polynomial -200C to 0C; +/-0.006% accuracy
	'16.996 ohms to 100 ohms
INVPT392NEG:  DATA 15.996, 100, -2.3809E2, 2.2032, 2.3E-3, -5.0E-6, 0
		  
		  
	'Type Pt392 RTD INVERSE polynomial 0C to +630C; +/-0.005% accuracy
	'100 ohms to 327.744 ohms
INVPT392POS:  DATA 100, 328.744, -2.43932E2, 2.37547, 5.22608E-4, 1.11348E-06, 0

	   
	'Type Ni RTD INVERSE polynomial 0C to +150C; +/-0.006% accuracy
	'120 ohms to 248.95 ohms
INVNI1:  DATA 119, 248.95, -2.210800E2, 2.394604, -5.785688E-3, 1.097436E-5, -9.322357e-9, 0

	   
	'Type Ni RTD INVERSE polynomial +150C to +300C; +/-0.006% accuracy
	'248.95 ohms to 439.44 ohms
INVNI2:  DATA 248.95, 440.44, -1.790702E2, 1.666061, -1.307243E-3, -6.926585E-7, 1.559142E-9, 0

	   
	'Type Cu RTD INVERSE polynomial 0C to +190C; +/-0.003% accuracy
	'Polynomial is for sensors which are 10 ohms @ 25C.
	'9.035 ohms to 16.386 ohms
INVCU:  DATA 8.9, 16.5, -2.415982E2, 2.882270E1, -4.163392E-1, 2.598613E-2, -5.999452E-4, 0

	'Type LEWIS Ni RTD INVERSE polynomial -17.77C to +260C; Accuracy better than +/-0.003%
	'84.19 ohms to 214.55 ohms
INVNI90:  DATA 83.19, 218.55, -4.74928E2, 9.28092, -7.10136E-2, 3.83725E-4, -1.12616E-6, 1.33984E-9, 0

FUNCTION BESTFIT! (SLOPE!, OFFSETS!, TSIM!(), NUMPTS%, ERRO!())

		'Calculates Max error of data from bestfit line
			  
		MTERR! = 0

		FOR INC% = 1 TO NUMPTS%                         'Increments thru test points

				BVEC! = TSIM!(INC%) * SLOPE! + OFFSETS! 'Calculates point on best fit line
				AVEC! = ERRO!(INC%)                     'Gets corresponding data point
			   
				TERR! = AVEC! - BVEC!                   'Calculates difference
			  
				IF ABS(TERR!) > ABS(MTERR!) THEN        'Checks if bigger than last Max
						MTERR! = TERR!                  'Assigns max error
				END IF
		NEXT

		BESTFIT! = MTERR!                               'Passes Max error back

END FUNCTION

'       Module Name - CALDAC
'
'       Inputs - None
'       Output - None
'       Description - CALDAC makes sure the output of the DAC will swing at
'       least +/- 9.2V
SUB CALDAC (TE$)
	CALL WRITEDVM(VODC$, 10!)               'Sets up meter to read 10VDC
	   
	IF TE$ = "TE1035" OR TE$ = "TE1036" OR TE$ = "TE1052" OR TE$ = "TE1088" OR TE$ = "TE1089" THEN
		CH% = 3                         'Attenuator input, SCT, DSC test heads
	ELSEIF TE$ = "TE1054" OR TE$ = "TE1055" OR TE$ = "TE1186" THEN
		CH% = 1                         'DSCA and 8B voltage & current output module test heads
	ELSE
		CH% = 8                         'Attenuator input, SCM test heads
	END IF

	CALL LOADMUX(CH%, CON%)                 'Mux CHn = R/2R ladder input
	   
	CALL LOADDAC(2048, VERN%)               'Sets vernier DAC at 0V
	  
	DO
		ITER1% = ITER1% + 1
		CALL LOADDAC(4095, MAIN%)       'Sets main DAC at -10V
		MAINMIN! = READDVM!(0!)
	LOOP WHILE MAINMIN! > -9.2 AND ITER1% < 10
								   
	DO
		ITER2% = ITER2% + 1
		CALL LOADDAC(0, MAIN%)          'Sets main DAC at 10V
		MAINMAX! = READDVM!(0!)
	LOOP WHILE MAINMAX! < 9.2 AND ITER2% < 10

	CALL WRITEDVM(VODC$, .01)               'Sets meter to read 5mV DC
	CALL LOADDAC(2048, MAIN%)               'Sets main DAC at 0V

	DO
		ITER3% = ITER3% + 1
		CALL LOADDAC(4095, VERN%)       'Sets vernier DAC at -5mV DC
		VERNMIN! = READDVM!(0!)
	LOOP WHILE VERNMIN! > -.005 AND ITER3% < 10

	DO
		ITER4% = ITER4% + 1
		CALL LOADDAC(0, VERN%)          'Sets vernier DAC at 5mV DC
		VERNMAX! = READDVM!(0!)
	LOOP WHILE VERNMAX! < .005 AND ITER4% < 10

	CALL LOADMUX(CH%, COFF%)                'Turns CHn off
	IF ITER1% > 9 OR ITER2% > 9 OR ITER3% > 9 OR ITER4% > 9 THEN TE$ = "ERROR"

END SUB

SUB CASEINST

		COLOR 20, 1, 1
		CLS
		LOCATE 8
		PRINT TAB(15); "                   --  NOTE  --                   "
		COLOR 15, 1, 1
		PRINT TAB(15); "**************************************************"
		PRINT ;
		COLOR 14, 1, 1
		PRINT TAB(15); " INSTALL A CASE OVER THE UNIT (NO LABEL REQUIRED) "
		COLOR 15, 1, 1
		PRINT ;
		PRINT TAB(15); "**************************************************"
		SOUND 400, 1
		CONTINUE
		COLOR 11, 0, 0
		CLS

END SUB

SUB CHANGEDN (SN$)
	'Sub to update the module serial number with a new dash number
	NDS$ = GETDS$(1, SN$)	'Get new dash number from function
	CALL SNPARSE(SN$, WO$, DS$)	'Get current work order and dash numbers from module serial number
	SN$ = WO$ + "-" + NDS$
	PRINT "New serial number is: "; SN$
END SUB

SUB CONTINUE
		X% = POS(0)
		Y% = CSRLIN
		LOCATE 22, 10: PRINT "Press any key to continue"
		a$ = KEYBDIN$
		LOCATE 22, 10: PRINT "                         "
		LOCATE Y%, X%
END SUB

FUNCTION FAILCOM (COMSTATUS$)
	   
	IF  LEFT$(COMSTATUS$, 4) = "FAIL" THEN
		LOCATE 15, 10
		PRINT "A Required KEPCO is not connected"
		PRINT TAB(10); "Please confirm connectivity to required power supplies."
		PRINT TAB(10); "Exiting Program......"
		END
	END IF

END FUNCTION

FUNCTION GETTHID%

	'Reads and returns the test head identification number
	'
	'There are only 3 bits for test head identification which is not enough
	'to give each type of test head for each product a unique address.  Use
	'the following addresses to identify test heads within a given product line.
	'
	'Test Head ID#      Use To Test Product
	'-------------      -------------------
	'       0           Voltage, Current, TC, Strain Gage, 2W TX, DC LVDT, Input
	'                   7B Voltage Output, 7B Current Output
	'       1           RTD, Thermistor, Resistance Input
	'       2           5B, DSC Current Output
	'       3           5B, DSC Voltage Output
	'       4           Frequency Input
	'       5           VAS
	'       6
	'       7
	'
	'
	'Test Head Output Data Line     Function Description            Paralled Port Signal
	'--------------------------     --------------------            --------------------
	'       D00                     Switch S1 input -               Acknowledge Data\
	'                               reserved for future use
	'       D01                     Fixture identification, LSB     Busy\
	'       D02                     Fixture identification          Paper Out
	'       D03                     Fixture identification, MSB     On Line\
	'       D04                     Hardwired, Logic 1              Error\
	'
	'
	'Status Register, located at parallel port address + 1
	'               MSB                                                    LSB
	'DB25 pin #     11      10      12      13      15      X       X       X
	'Data Line      D01     D00     D02     D03     D04
	'
	'NOTES; Bit D01 (pin 11) reads opposite the expected value
	'       * Only when D02 is pulled low * JL 06/01/01
	'       Logic levels may be present on pins 10-15 which represent the active state.
	'       For the first board tested, 3.3Kohm was not enough to pull down the
	'       logic 1 signal on pin 12 to a logic 0.  Use 510 ohms for this line.

	BYTE% = THADDR% * 4 + 0                 'Select control bank #0, W/R control
	OUT (LPTADDR%), BYTE%
	OUT (LPTADDR% + 2), &HE                 'D/A line low
	CALL PAUSE(.0001)
	OUT (LPTADDR% + 2), &H4                 'W/R  EN/  D/A   S/ high
	OUT (LPTADDR% + 2), &HC                 'W/R line low
											'Enables test head output data
	CALL PAUSE(.05)

	I% = INP(LPTADDR% + 1)                  'Gets data from the test head.
	D01% = INT(I% / 2 ^ 7)
	I% = I% - 2 ^ 7 * D01%
	D00% = INT(I% / 2 ^ 6)
	I% = I% - 2 ^ 6 * D00%
	D02% = INT(I% / 2 ^ 5)
	I% = I% - 2 ^ 5 * D02%
	D03% = INT(I% / 2 ^ 4)
   
	IF D01% = 0 THEN D01% = 1 ELSE D01% = 0
  
	GETTHID% = D03% * 4 + D02% * 2 + D01%

	OUT (LPTADDR% + 2), &H4                 'W/R  EN/  D/A   S/ high
											'Disables test head output data

END FUNCTION

SUB HS1
'       Module Name - HS1
'
'       Inputs - None
'       Outputs - None
'       Description - HS1 waits for the last instruction to be sent
'                     Check Bit #4 for true
	CNT = 0
	CNTR = 50000  '1000 is too little, causes SUPPLYSEN to display error message below

	BYTE% = 0
	WHILE (BYTE% AND 16) = 0
		BYTE% = INP(BADDRS% + 0)
		IF CNT > CNTR THEN
			'GPIBFLAG! = 1!
			CLS
			PRINT
			PRINT TAB(25); "COMMUNICATIONS FAILURE."
			PRINT
			PRINT TAB(5); "Please check connectivity of external test devices and power supplies."
			PRINT TAB(5); "KEPCO DPS-125 Power Supply address should be set to 1."
			PRINT TAB(5); "KEPCO DPS-125 High Voltage Input source address should be set to 2."
			PRINT
			PRINT TAB(5); "The newer KEPCO ABC 125 Power Supply's GPIB address is set to 5"
			PRINT TAB(5); "from the front panel by pressing: Menu, Menu, 05, ENTER, RESET."
			PRINT
			PRINT TAB(5); "The newer KEPCO ABC 125 High-Voltage Supply's GPIB address is set to 6"
			PRINT
			PRINT TAB(10); "Program will return to main menu."
			   
			END
			'BYTE% = 1
		END IF
		CNT = CNT + 1
	WEND
END SUB

SUB INIT488 (DVMADDR%)
	
'       Module Name - INIT488
'
'       Inputs - None
'       Outputs - None
'       Description - Initalizes the IEEE 488 interface
	   
	OUT (BADDRS% + 8), &H0          'Configure PC4311 as controller
	OUT (BADDRS% + 3), &H80         'Release ACDS holdoff, set operation
	OUT (BADDRS% + 3), &H0          'Software reset, set operation
	OUT (BADDRS% + 4), DVMADDR%     'Enable dual primary addressing mode
	OUT (BADDRS% + 0), &H0          'Disable all interrupts
	OUT (BADDRS% + 3), &H8F         'Request control, clear operation
	OUT (BADDRS% + 3), &HF          'Send remote enable, clear operation
	OUT (BADDRS% + 3), &H90         'Listen only, set operation

END SUB

SUB INITPS (ADDR%, OVERI!, OVERV!)

	IF PSMODEL$ = "DPS125" THEN
		   
			'******** Initialize Kepco power supply
			'****** Select over-current protection mode
		PS$ = POWERIO$(ADDR%, "SMD=OC")

			'****** Select Over-Current Limit
		STLEN% = LEN(STR$(OVERI!))
		PS$ = POWERIO$(ADDR%, "SOC=" + RIGHT$(STR$(OVERI!), STLEN% - 1))
	  
			'****** Set Over-Voltage Limit
		STLEN% = LEN(STR$(OVERV!))
		PS$ = POWERIO$(ADDR%, "SOV=" + RIGHT$(STR$(OVERV!), STLEN% - 1))

		PS$ = POWERIO$(ADDR%, "ZER")   'Clear errors if any

	ELSEIF PSMODEL$ = "ABC125" THEN

		CALL WRITEPS(ADDR%, "*CLS")             'Clears Status Data
	   
		NUMBER$ = READPS(ADDR%, "OUTP?")        'If output is off, turn on
		IF NUMBER$ = "0" THEN
			CALL WRITEPS(ADDR%, "OUTP ON")
		END IF

		'******* Initialize KEPCO ABC Power Supply

'For the KEPCO ABC125, the numeric parameter sent to the power supply
'with the command VOLT:PROT has to be in exponential notation.
'The code below converts the overvoltage integer (125)
'to an exponential (1.25E+2)
		   
		STLEN% = LEN(STR$(OVERV!))
		NUMSTR$ = RIGHT$(STR$(OVERV!), STLEN% - 1)
		  
		IF STLEN% > 2 THEN
			EXPSTR$ = LEFT$(NUMSTR$, 1) + "." + RIGHT$(NUMSTR$, STLEN% - 2) + "E+" + RIGHT$(STR$(STLEN% - 2), 1)
			CALL WRITEPS(ADDR%, "VOLT:PROT " + EXPSTR$)
		ELSE
			CALL WRITEPS(ADDR%, "VOLT:PROT 1.0E+1") 'set to 10V limit
		END IF
			'******* Sets the voltage limit
		CALL WRITEPS(ADDR%, "VOLT:LIM:HIGH")

		CALL WRITEPS(ADDR%, "CURR:PROT" + STR$(OVERI! / 1000))
			'******* Sets the current limit
		CALL WRITEPS(ADDR%, "CURR:LIM:HIGH")
	  
	ELSE
		PRINT "Neither KEPCO model could be identified and initialized"
	END IF

END SUB

FUNCTION KEYBDIN$

	DO
		X$ = INKEY$
	LOOP WHILE X$ = ""
	KEYBDIN$ = X$

END FUNCTION

'       Module Name - LOADDAC
'
'       Inputs - BINDATA Binary value to write to DAC
'                DAC Selects main DAC if 1 else selects vernier DAC
'       Output - None
'       Description - Loads the binary value in BINDATA to the DAC specified
'       by the DAC variable.
SUB LOADDAC (BINDATA%, DAC%)

	IF BINDATA% > 4095 THEN
		BINDATA% = 4095
	ELSEIF BINDATA% < 0 THEN
		BINDATA% = 0
	END IF

	IF DAC% = 1 THEN
		ADDRLO% = 770
		ADDRHI% = 771
	ELSE
		ADDRLO% = 768
		ADDRHI% = 769
	END IF

	DATAHI% = INT(BINDATA% / 16)
	DATALO% = (BINDATA% - 16 * DATAHI%) * 16

	OUT ADDRLO%, DATALO%
	OUT ADDRHI%, DATAHI%

END SUB

SUB LOADMUX (CH%, CHON%)
	
	'Parallel Port Control Register is located at address LPTADDR% + 2
	'Bits 0, 1, and 3 toggle the opposite way expected.
	'                       W/R  EN/  D/A   S/
	'  X    X    X    X      X    X    X    X
	'C                       1    1    0    0  (0 1 1 1)
	'D                       1    1    0    1  (0 1 1 0)
	'4                       0    1    0    0  (1 1 1 1)
	   
	IF CH% = 0 THEN                         'Reset all channels (open)
		OUT (LPTADDR% + 2), &H4         'W/R line high
		OUT (LPTADDR% + 2), &HC         'W/R line low
	ELSE
		RELAY% = (MUXADDR% * 16) + ((CH% - 1) * 2) + CHON%
		OUT (LPTADDR%), RELAY%
		CALL PAUSE(.01)                 'Waits data to estabilize
		OUT (LPTADDR% + 2), &HD         'S/ line low
		CALL PAUSE(.01)                 'Waits for relays to settle
										'0.5ms operate + 0.5ms bounce
		OUT (LPTADDR% + 2), &HC         'S/ line high
	END IF
	   
END SUB

SUB OHMSET (OHM!)

	'Convert the desired ohms to a 20 bit representation and
	'set the resistor DAC
	   
	E1! = 16.1

	IF OHM! >= -1 THEN
		BIT! = 0: B2! = 1E+30
		J1! = 0
		FOR K% = 1 TO 20
			M% = 1
			FOR J! = J1! TO 19
				B! = 2 ^ J!
				IF M% = 1 AND OHM! / E1! <= 1 / (1 / B! + 1 / B2!) THEN M% = 2
				IF M% = 2 THEN
					M% = 0
					BIT! = BIT! + B!
					B2! = 1 / (1 / B2! + 1 / B!)
					J1! = J! + 1
				END IF
			NEXT J!
		NEXT K%
	ELSE
		BIT! = 2 ^ 20        'open all relays
	END IF

	CB3VAL% = &HFF - (BIT! - INT(BIT! / 2 ^ 8) * 2 ^ 8)
	'06/15/99  SETTHFAST was previously used here.  Paul's station was erroneously
	'setting the resistance.  Adding a 0.1s pause after the S/ line is set
	'cures the problem.  Use SETTH instead.  Performance is not noticeably slowed.
	CALL SETTH(CB3VAL%, CB3%)
	CB2VAL% = &HFF - (INT(BIT! / 2 ^ 8) - INT(BIT! / 2 ^ 16) * 2 ^ 8)
	CALL SETTH(CB2VAL%, CB2%)
	CB1VAL% = (&HFF - (INT(BIT! / 2 ^ 16) * 16 - INT(BIT! / 2 ^ 20) * 2 ^ 8)) AND (CB1VAL% OR &HF0)
	CALL SETTH(CB1VAL%, CB1%)
   
	' Disables the test head by clearing the address.
	OUT (LPTADDR%), 0
	OUT (LPTADDR% + 2), &HE                 'D/A line low
	OUT (LPTADDR% + 2), &HC                 'D/A line high

	'PRINT OHM!, BIT!
	'PRINT CB3VAL%, CB2VAL%, CB1VAL%
	'CALL CONTINUE

END SUB

SUB PAUSE (TIME!)
	T1 = TIMER
	DO
		T2 = TIMER
	LOOP UNTIL (T2 - T1) > TIME!

END SUB

FUNCTION POWERIO$ (ADDR%, CMD$)

	'This function sends commands and receives output from the
	'Kepco DPS 125-0.5M programmable power supply.
	'Inputs:        power supply address, command
	'Outputs:       supply response, if any

	'Open and initialize the power supply controller communications channel for I/O
	PSPORTDATA$ = "COM" + RIGHT$(STR$(PSPORT%), 1) + ":9600,N,8,1,CS0,DS0"
	OPEN PSPORTDATA$ FOR RANDOM AS #1          ',BIN,CD0,CS0,DS0,OP0,RS,TB2048,RB2048

	DEVSEL = ADDR% + &HE0
	RXOK = ADDR% + &HC0
					'DEVSEL must be sent without a <CR>
					'prior to each command
					'Send DEVSEL byte to DPS
	PRINT #1, CHR$(DEVSEL);
	N = 0                           'Await input buffer to become non-zero
	LOOPCOUNT! = 5000               'print message if not successful
	DO
		N = N + 1
		IF N = LOOPCOUNT! THEN
			POWERIO$ = "FAIL"
		END IF
		
	LOOP WHILE (LOC(1) = 0) AND N < LOOPCOUNT!
	   
	IF N = LOOPCOUNT! THEN
		CLOSE #1                'close power supply communication channel
	END IF
					 'RXOK is returned (without a <CR>) in
	IF N < 5000 THEN              'response to DEVSEL
		a$ = INPUT$(1, #1)       'Input RXOK byte
		PRINT #1, CMD$
					'Await input buffer to become non-zero
		DO
		LOOP WHILE (LOC(1) = 0)

		a$ = INPUT$(1, #1)       'Input first (non-ASCII) character of
					 'string and discard
		INPUT #1, B$             'Input balance of string
		POWERIO$ = B$
		CLOSE #1                 'close power supply communication channel

	'ELSE       'N is not less than LOOPCOUNT (5000)
	'     'Insert message here
	END IF

END FUNCTION

FUNCTION READDATA$ (ADDR%)

	 BYTE% = (MTA% OR ADDR%)
	 OUT (BADDRS% + 7), BYTE%     'Send out talk address
	 CALL HS1

	 OUT (BADDRS% + 3), &H89      'Request control, clear
	 OUT (BADDRS% + 3), &HB       'Remote enable, clear
	   
		   
	 ITERATION% = ITERATION% + 1
		   
	 M1! = M2!
	 'CALL PAUSE(.1)
	 DATABYTE$ = ""
	 DO
	  DO                      'Check for Bit #5 = true
		   BYTE% = INP(BADDRS% + 0)
	  LOOP WHILE (BYTE% AND 32) = 0
				   
	  DATABYTE = INP(BADDRS% + 7)
	  IF DATABYTE <> &HA THEN
		   DATABYTE$ = DATABYTE$ + CHR$(DATABYTE)
	  END IF
	 
	  LOOP WHILE DATABYTE <> &HA
		   
	  CALL PAUSE(.01)                   'Slow down execution on faster computers

	  OUT (BADDRS% + 3), &HC          'Remote enable, set command
	  OUT (BADDRS% + 3), &H9          'Clear listen only
	  OUT (BADDRS% + 7), &H5F         'Un-talk command
	  CALL HS1
					   'Don't exit loop if over-ranged
	  READDATA$ = DATABYTE$

END FUNCTION

FUNCTION READDVM! (TOL!)
'       Inputs - None
'       Outputs - Returns meter reading
'       Description - Triggers the meter to take a reading with current
'               function, range, and rate.  Then returns the measurement.
'               Successive readings must differ by less than TOL! to assure
'               that filter response has settled.  If TOL! = 0 then only
'               one reading is taken.
	  
	CALL INIT488(DVMADDR%)

	M2! = 999
	ITERATION% = 0
	DO
		CALL TRIGGER
		   
		BYTE% = (MTA% OR DVMADDR%)
		OUT (BADDRS% + 7), BYTE%     'Send out talk address
		CALL HS1

		OUT (BADDRS% + 3), &H89      'Request control, clear
		OUT (BADDRS% + 3), &HB       'Remote enable, clear
		   
		ITERATION% = ITERATION% + 1
		   
		M1! = M2!
		'CALL PAUSE(.1)
		DATABYTE$ = ""
		DO
			DO                      'Check for Bit #5 = true
				BYTE% = INP(BADDRS% + 0)
			LOOP WHILE (BYTE% AND 32) = 0
				   
			DATABYTE = INP(BADDRS% + 7)
			IF DATABYTE <> &HA THEN
				DATABYTE$ = DATABYTE$ + CHR$(DATABYTE)
			END IF
		LOOP WHILE DATABYTE <> &HA
		   
		CALL PAUSE(.01)                   'Slow down execution on faster computers
	  
		M2! = VAL(DATABYTE$)

		OUT (BADDRS% + 3), &HC          'Remote enable, set command
		OUT (BADDRS% + 3), &H9          'Clear listen only
		OUT (BADDRS% + 7), &H5F         'Un-talk command
		CALL HS1
		   
		'IF M2! > 1E+07 THEN CALL WRITEDVM(VODC$, 2000!) 'autorange
		IF ABS(M2!) > 1E+07 THEN M2! = 0        '12/19/07 JL
	LOOP WHILE (TOL! <> 0! AND ABS(M2! - M1!) > ABS(TOL!) AND ITERATION% < 20) '12/19/07 JL

	READDVM! = M2!
'       if measurement has not settled in 20 readings due to noise or
'       module malfunction, accept 20th reading and continue.

END FUNCTION

FUNCTION READGPIB$ (ADDR%, CMD$)
'       Inputs - CMD$ = instruction sent to GPIB device
'              - ADDR% = GPIB Address of device
'       Outputs - Returns device reading as a string that could be
'       converted back to an integer value
'
'       Description - Triggers the KEPCO ABC125 Power Supply to apply a constant
'       voltage or current and/or retrieve specific status information such as if
'       the power supply has reached overcurrent limit.
	 
	TOL! = .01
	CALL INIT488(DVMADDR%)

	M2! = 999               'Why is this 999 instead of 0?
	ITERATION% = 0
	   
	DO
'****** WRITEPS starts here
'*****               'CALL WRITEPS(ADDR%, CMD$)
'****
		CALL INIT488(ADDR%)
		DDATA$ = CMD$
		BYTE% = ADDR% OR MLA%
		OUT (BADDRS% + 7), BYTE%        'Send byte out as data
		CALL HS1
		OUT (BADDRS% + 3), &H8A         'Request control, set operation
		CALL PAUSE(.001)   'TSO - required for the KEPCO ABC
		OUT (BADDRS% + 3), &HB          'Remote enable, clear
	   
		FOR X1 = 1 TO LEN(DDATA$)
			BYTE% = ASC(MID$(DDATA$, X1, 1))
			OUT (BADDRS% + 7), BYTE%        'Successively send each character

'***** HS1 starts here
'                CALL HS1                        'of DDATA$ to 488 device
	   
		CNT = 0
		CNTR = 1000
		BYTE% = 0
		WHILE (BYTE% AND 16) = 0 AND GPIBFLAG! <> 1!
			BYTE% = INP(BADDRS% + 0)
			IF CNT > CNTR THEN
				GPIBFLAG! = 1!
				'PRINT
				'PRINT TAB(10); "GPIB COM FAILURE. Please Check GPIB connectivity."
				'END
				BYTE% = 1!
			END IF
			CNT = CNT + 1
	WEND

'***** HS1 ends here
	   
	NEXT X1

	IF GPIBFLAG! <> 1 THEN
		OUT (BADDRS% + 7), &HD          'Send CR, tell device to execute command
		CALL HS1
		OUT (BADDRS% + 7), &HA          'Send LF
		CALL HS1
		OUT (BADDRS% + 3), &HC          'Remote enable, set operation
		OUT (BADDRS% + 3), &HA          'Clear talk only
		OUT (BADDRS% + 7), &H3F         'Un-listen
		CALL HS1

'****** WRITEPS ends here
		   
		BYTE% = (MTA% OR ADDR%)
		OUT (BADDRS% + 7), BYTE%     'Send out talk address
		CALL HS1

		OUT (BADDRS% + 3), &H89      'Request control, clear
		CALL PAUSE(.001)   'TSO - required for the KEPCO ABC
		OUT (BADDRS% + 3), &HB       'Remote enable, clear
		
		ITERATION% = ITERATION% + 1
		
		M1! = M2!
		'CALL PAUSE(.1)
		DATABYTE$ = ""

		DO
			DO                      'Check for Bit #5 = true
				BYTE% = INP(BADDRS% + 0)
			LOOP WHILE (BYTE% AND 32) = 0
				
			DATABYTE = INP(BADDRS% + 7)
			IF DATABYTE <> &HA THEN
				DATABYTE$ = DATABYTE$ + CHR$(DATABYTE)
			END IF
		LOOP WHILE DATABYTE <> &HA
		 
		CALL PAUSE(.01)                   'Slow down execution on faster computers
		 
		'M2! = VAL(DATABYTE$)
		OUT (BADDRS% + 3), &HC          'Remote enable, set command
		OUT (BADDRS% + 3), &H9          'Clear listen only
		OUT (BADDRS% + 7), &H5F         'Un-talk command
		CALL HS1
	END IF
		'IF M2! > 1E+07 THEN CALL WRITEDVM(VODC$, 2000!) 'autorange
	LOOP WHILE (TOL! <> 0! AND ABS(M2! - M1!) > ABS(TOL!) AND ITERATION% < 20 AND GPIBFLAG! <> 1)
	   
	READGPIB$ = DATABYTE$

END FUNCTION

FUNCTION READPS$ (ADDR%, CMD$)
'       Inputs - CMD$ = instruction sent to Power Supply
'              - ADDR% = GPIB Address of Power Supply
'       Outputs - Returns Power Supply reading as a string that could be
'       converted back to an integer value
'
'       Description - Triggers the KEPCO ABC125 Power Supply to apply a constant
'       voltage or current and/or retrieve specific status information such as if
'       the power supply has reached overcurrent limit.
	   
	TOL! = .01
	CALL INIT488(DVMADDR%)

	M2! = 999               'Why is this 999 instead of 0?
	ITERATION% = 0
	DO
		CALL WRITEPS(ADDR%, CMD$)

		BYTE% = (MTA% OR ADDR%)
		OUT (BADDRS% + 7), BYTE%     'Send out talk address
		CALL HS1

		OUT (BADDRS% + 3), &H89       'Request control, clear
		CALL PAUSE(.001)   'TSO - required for the KEPCO ABC
		OUT (BADDRS% + 3), &HB       'Remote enable, clear
		  
		ITERATION% = ITERATION% + 1
		  
		M1! = M2!
		'CALL PAUSE(.1)
		DATABYTE$ = ""

		DO
			DO                      'Check for Bit #5 = true
				BYTE% = INP(BADDRS% + 0)
			LOOP WHILE (BYTE% AND 32) = 0
				  
			DATABYTE = INP(BADDRS% + 7)
			IF DATABYTE <> &HA THEN
				DATABYTE$ = DATABYTE$ + CHR$(DATABYTE)
			END IF
		LOOP WHILE DATABYTE <> &HA
		   
		CALL PAUSE(.01)                   'Slow down execution on faster computers
		   
		'M2! = VAL(DATABYTE$)
		OUT (BADDRS% + 3), &HC          'Remote enable, set command
		OUT (BADDRS% + 3), &H9          'Clear listen only
		OUT (BADDRS% + 7), &H5F         'Un-talk command
		CALL HS1
		   
		'IF M2! > 1E+07 THEN CALL WRITEDVM(VODC$, 2000!) 'autorange
	LOOP WHILE (TOL! <> 0! AND ABS(M2! - M1!) > ABS(TOL!) AND ITERATION% < 20)

	READPS$ = DATABYTE$

'       if measurement has not settled in 20 readings due to noise or
'       module malfunction, accept 20th reading and continue.

END FUNCTION

FUNCTION REPEAT$ (N$)
	'Function to determine whether to test another module. Changed to explicitly require
	'that the "Y" or "N" key be pressed (uppercase or lowercase)
	'
	COLOR 15, 0, 0	'Bright white on black background
	CLS
	LOCATE 10, 10: PRINT "Do you want to test another "; N$; " module?"
	LOCATE 11, 10: PRINT "Either the 'Y' or 'N' must be pressed."

	DO	'Loop until the "Y" or "N" key is pressed
		a$ = INKEY$
		a$ = UCASE$(a$)	'Set key value to uppercase
	LOOP WHILE (a$ <> "N") AND (a$ <> "Y") 
	 
	IF (a$ = "Y") THEN
		LOCATE 14, 10: PRINT "Insert the next module"
		CALL CONTINUE
	END IF
	  
	REPEAT$ = a$

	COLOR 11, 0, 0	'Cyan on black background

END FUNCTION

FUNCTION REPEAT2$ (N$, SN$)
	'Function to determine whether to test another module. If testing another module
	'is desired, a menu of options is presented. The function has been changed to
	'explicitly require that the "Y" or "N" key be pressed (uppercase or lowercase)
	'
	COLOR 15, 0, 0	'Bright white on black background
	CLS
	LOCATE 10, 10: PRINT "Do you want to test another "; N$; " module?"
	LOCATE 11, 10: PRINT "Either the 'Y' or 'N' must be pressed."

	DO	'Loop until the "Y" or "N" key is pressed
		a$ = INKEY$
		a$ = UCASE$(a$)	'Set key value to uppercase
	LOOP WHILE (a$ <> "N") AND (a$ <> "Y") 
	 
	IF (a$ = "Y") THEN
		CLS		
		COLOR 14, 0, 0 'color 14, 1, 1 ' cjt		
		LOCATE 3, 23: PRINT N$; " NEXT MODULE TEST OPTIONS"
		LOCATE 4, 23: PRINT "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
		COLOR 15, 0, 0 'color 15, 1, 1 ' cjt		
		LOCATE 6, 10: PRINT "Please select the desired option for the next module to test:"
		COLOR 11, 0, 0 'color 11, 1, 1 ' cjt		
		LOCATE  8, 15: PRINT "1.) Same work order, next sequential number"
		LOCATE  9, 15: PRINT "2.) Same work order, different sequential number"
		LOCATE 10, 15: PRINT "3.) Different work order, different sequential number"
		LOCATE 11, 15: PRINT "4.) Retest the same unit"
		LOCATE 14, 10: PRINT  "The serial number for the module just tested is: "; SN$
  
		DO
			I$ = INKEY$
		LOOP WHILE VAL(I$) < 1 OR VAL(I$) > 4

		SEL2% = VAL(I$)

		SELECT CASE SEL2%                   'Changes S/N information as selected
		CASE 1
			SN$ = UPSN$(SN$)                'Increments the Dash# of the serial #
		CASE 2
			CALL CHANGEDN(SN$)              'Changes dash number only
		CASE 3
			CALL WORKORDERPRINT (SN$)		'Print the work order status file
			CALL GETSN(SN$)					'Changes work order and dash number
			CALL WORKORDERHEADER (SN$)		'Write header to work order status file (with new number)
		CASE 4
			' Do nothing since same unit will be tested
		END SELECT
	END IF

	REPEAT2$ = a$

	COLOR 11, 0, 0	'Cyan on black background
	
END FUNCTION

FUNCTION RTDOHMS! (TEMP!, SENTYPE$)

	'Function inputs;  temperature, RTD type
	'Function Output;  RTD resistance in ohms

	'Polynomial format; OHMS = c0 + c1*T + c2*T^2 + c3*T^3 + ...

	'RTD sensor types are:  P1 = Pt100, P2 = Pt600, P3 = Pt500, P4 = E1 Pt100 Rosemount
	'                       NI = Ni120
	'                       C1 = Cu10 (10 ohms @ 25C), C2 = Cu10 (10 ohms @ 0C)
	'                       P8 = Pt392 (50 Ohm RTD alfa=0.00392)
	'                       P9 = Pt392 (100 Ohm RTD alfa=0.00392)
	'                       N9 = LEWIS NICKEL RTD


	ST$ = UCASE$(LEFT$(SENTYPE$, 2))
	   
	IF ST$ = "P1" OR ST$ = "P2" OR ST$ = "P3" OR ST$ = "P5" THEN  'Select the proper polynomial
		IF TEMP! < 0 THEN                           '100 ohm Platinum RTD
			RESTORE TYPEPTNEG
		ELSE
			RESTORE TYPEPTPOS
		END IF
		T2! = TEMP!
	ELSEIF ST$ = "P4" THEN   'E1 Pt100 Rosemount
		RESTORE TYPEE1PT100
		T2! = TEMP!
	ELSEIF ST$ = "P8" OR ST$ = "P9" THEN 'Pt100 with alfa=0.00392
		IF TEMP! < 0 THEN
			RESTORE TYPEPT392NEG
		ELSE
			RESTORE TYPEPT392POS
		END IF
		T2! = TEMP!
	ELSEIF ST$ = "NI" THEN   '120 ohm Nickel RTD
		IF TEMP! < 150 THEN
			RESTORE TYPENI1
		ELSE
			RESTORE TYPENI2
		END IF
		T2! = TEMP!
	ELSEIF ST$ = "N9" THEN   'LEWIS Nickel RTD
		IF TEMP! < 120 THEN
			RESTORE TYPENI90NEG
		ELSE
			RESTORE TYPENI90POS
		END IF
		T2! = TEMP!
	ELSEIF ST$ = "C1" THEN   '10 ohm Copper RTD
		RESTORE TYPECU                          '10 ohms @ 25C
		T2! = TEMP!
	ELSEIF ST$ = "C2" THEN   '10 ohm Copper RTD
		RESTORE TYPECU                          '10 ohms @ 0C
		T2! = TEMP! + 25!                       'offset before using polynomial
	ELSE
		RTDOHMS! = 99          'invalid sensor type
		EXIT FUNCTION
	END IF

					'Check if TEMP is within polynomial limits
	READ MINTEMP!, MAXTEMP!
	IF T2! < MINTEMP! OR T2! > MAXTEMP! THEN
		PRINT "Error! Polynomial limits exceeded.  Contact engineering."
		PRINT SENTYPE$, TEMP!, MINTEMP!, MAXTEMP!
		RTDOHMS! = 98
		STOP
		'EXIT FUNCTION
	END IF
	   
	DO
		READ COEFF#
		R! = R! + COEFF# * T2! ^ EXPNT%
		EXPNT% = EXPNT% + 1
	LOOP WHILE COEFF# <> 0 OR EXPNT% = 1      'look for coeff = 0, end of data

	IF ST$ = "P2" THEN
		RTDOHMS! = 6 * R!                       'Pt 600 sensor
	ELSEIF ST$ = "P3" THEN
		RTDOHMS! = 5 * R!                       'Pt 500 sensor
	ELSEIF ST$ = "P5" THEN
		RTDOHMS! = 10 * R!                      'Pt 1000 sensor
	ELSEIF ST$ = "P8" THEN
		RTDOHMS! = .5 * R!                       'Pt 50 sensor
	   
	ELSE
		RTDOHMS! = R!
	END IF

END FUNCTION

FUNCTION RTDTEMP! (OHMS!, SENTYPE$)
	   
	'Function inputs;  measured ohms from simulated RTD, RTD type
	'Function Output;  RTD temperature in deg. C.

	'Polynomial format; T = c0 + c1*OHM + c2*OHM^2 + c3*OHM^3 + ...

	'RTD sensor types are:  P1 = Pt100, P2 = Pt600, P3 = Pt500, P4 = E1 Pt100 Rosemount
	'                       NI = Ni120
	'                       C1 = Cu10 (10 ohms @ 25C), C2 = Cu10 (10 ohms @ 0C)
	'                       P8 = Pt392 (50 Ohm RTD alfa=0.00392)
	'                       P9 = Pt392 (100 Ohm RTD alfa=0.00392)
	'                       N9 = LEWIS Nickel RTD

	ST$ = UCASE$(LEFT$(SENTYPE$, 2))
   
	IF ST$ = "P1" OR ST$ = "P2" OR ST$ = "P3" OR ST$ = "P5" THEN 'Select the proper polynomial
		IF ST$ = "P2" THEN
			OHMS! = OHMS! / 6                   'Pt 600 sensor
		ELSEIF ST$ = "P3" THEN
			OHMS! = OHMS! / 5                   'Pt 500 sensor
		ELSEIF ST$ = "P5" THEN
			OHMS! = OHMS! / 10                  'Pt 1000 sensor
		END IF
		IF OHMS! < 100 THEN                     '100 ohm Platinum RTD
			RESTORE INVPTNEG
		ELSE
			RESTORE INVPTPOS
		END IF
		  
	ELSEIF ST$ = "P4" THEN          'E1 Pt100 Rosemount
		RESTORE INVE1PT100

	ELSEIF ST$ = "P8" OR ST$ = "P9" THEN  'Pt100 RTD Alfa = 0.00392
		IF ST$ = "P8" THEN
			OHMS! = OHMS! * 2
		END IF
		IF OHMS! < 100 THEN
			RESTORE INVPT392NEG
		ELSE
			RESTORE INVPT392POS
		END IF

	ELSEIF ST$ = "NI" THEN          '120 ohm Nickel RTD
		IF OHMS! < 248.95 THEN
			RESTORE INVNI1
		ELSE
			RESTORE INVNI2
		END IF
   
	ELSEIF ST$ = "N9" THEN    'LEWIS Nickel RTD
		RESTORE INVNI90
   
	ELSEIF ST$ = "C1" OR ST$ = "C2" THEN    '10 ohm Copper RTD
		RESTORE INVCU
	ELSE
		RTDTEMP! = 99                           'invalid sensor type
		EXIT FUNCTION
	END IF

			'Check if OHMS is within polynomial limits
	READ MINOHM!, MAXOHM!
	IF OHMS! < MINOHM! OR OHMS! > MAXOHM! THEN
		PRINT "Error! Polynomial limits exceeded.  Contact engineering."
		PRINT SENTYPE$, OHMS!, MINOHM!, MAXOHM!
		RTDTEMP! = 98
		STOP
		'EXIT FUNCTION
	END IF
	   
	DO
		READ COEFF#
		T! = T! + COEFF# * OHMS! ^ EXPNT%
		EXPNT% = EXPNT% + 1
	LOOP WHILE COEFF# <> 0 OR EXPNT% = 1        'look for coeff = 0, end of data

	IF ST$ = "C2" THEN                          '10 ohm Copper RTD
		RTDTEMP! = T! - 25!                     '10 ohms @ 0C
	ELSE
		RTDTEMP! = T!
	END IF

END FUNCTION

SUB RTDTHCAL

'   This subroutine checks the basic operation of the RTD testhead.

	OHMFAIL% = 0
	DFTFAIL% = 0
	DIM RES!(5)

	DIM RDRIFT(100)

	CONTRES! = MEASRES!(1!, 4, CRSTAT$)  'Measure contact resistance
	   
	CLS
	PRINT TAB(10); USING "SERIES RELAY CONTACT RESISTANCE = #.#### OHMS"; CONTRES!
	PRINT TAB(15); "RELAY      CMD R (ê)        MEAS R (ê)      STATUS"
	PRINT TAB(15); "--------------------------------------------------"
	'PRINT TAB(15); " ##         #######        ########.###      &"; E%; OHMS!; TEMP!; OHMSTAT$
	
	FOR E% = 1 TO 20                                'Test relays controlling
							'resistors up to 500Kohm for emf
		OHMS! = 16.1 * 2 ^ (E% - 1)
		CALL OHMSET(OHMS!)

		CALL SETTEST(2)                         'Open series relay
		IF OHMS! < 1000 THEN
			CALL WRITEDVM(OHM4$, OHMS! / 1000)  'Sets meter
			CALL LOADMUX(1, CON%)               'Sets mux channel
			CALL LOADMUX(8, CON%)               'set sense channel
		ELSE
			CALL WRITEDVM(OHM2$, OHMS! / 1000)  'Sets meter
			CALL LOADMUX(1, CON%)               'Sets mux channel
		END IF

		IF OHMS! > 1000000! THEN
			INITTOL! = .15                      '15% initial tolerance
			MEASTOL! = .005                     '0.5% measurement tolerance
		ELSE
			INITTOL! = .05                      '5% initial tolerance
			MEASTOL! = .0005                    '0.05% measurement tolerance
		END IF
   
		TEMP! = READDVM!(MEASTOL! * OHMS!)      'Measure resistor value to tolerance
  
		IF ABS(TEMP! - OHMS!) > (OHMS! * INITTOL!) THEN   'Test for 15% deviation
			OHMSTAT$ = "FAIL"
			OHMFAIL% = OHMFAIL% + 1
		ELSE
			OHMSTAT$ = "PASS"
		END IF
	   
		CALL LOADMUX(0, CON%)                           'Clears mux

		PRINT TAB(15); USING " ##         #######        ########.###      &"; E%; OHMS!; TEMP!; OHMSTAT$

		IF  LEFT$(CRSTAT$, 4) = "FAIL" THEN		
			LPRINT TAB(10); USING "SERIES RELAY CONTACT RESISTANCE FAILURE AT #.#### OHMS"; CONTRES!
			LPRINT
			LPRINT CHR$(12)
		END IF

		IF OHMFAIL% = 1 THEN
			LPRINT TAB(25); "RELAY TEST RESULTS"
			LPRINT
			LPRINT TAB(10); USING "SERIES RELAY CONTACT RESISTANCE = #.#### OHMS"; CONTRES!
			LPRINT TAB(15); "RELAY      CMD R (ê)        MEAS R (ê)      STATUS"
			LPRINT TAB(15); "--------------------------------------------------"
			OHMFAIL% = OHMFAIL% + 1
		END IF
		   
		IF  LEFT$(OHMSTAT$, 4) = "FAIL" THEN
			LPRINT TAB(15); USING " ##         #######        ########.###      &"; E%; OHMS!; TEMP!; OHMSTAT$
			LPRINT TAB(15); "--------------------------------------------------"
			OHMSTAT$ = "PASS"
		END IF

	NEXT
						'4M and 8M resistance don't measure
						'consistent due to emf's
	FOR E% = 1 TO 20

		IF E% = 1 OR E% = 6 OR E% = 11 OR E% = 16 THEN
			CALL PAUSE(1)
			CLS : PRINT
			PRINT TAB(8); "RELAY      CMD R (ê)      DELTA R (%)   Elapsed Time (s)   STATUS"
			PRINT TAB(8); "-----------------------------------------------------------------"
			'PRINT TAB(8); "  ##        #######        ###.###            ###.#         &"; E%; RES2!; DRIFTPERC!; ELAP!; DRIFTSTAT$
		END IF

		N% = 1
		DO
			DRIFTSTAT$ = "PASS"
			OHMS! = 16.1 * 2 ^ (E% - 1)
			IF N% = 1 THEN
				CALL OHMSET(OHMS!)
				TIME1! = TIMER
				CALL SETTEST(2)                         'Open series relay
				IF OHMS! < 1000 THEN
					CALL WRITEDVM(OHM4$, OHMS! / 1000)  'Sets meter
					CALL LOADMUX(1, CON%)               'Sets mux channel
					CALL LOADMUX(8, CON%)               'set sense channel
				ELSE
					CALL WRITEDVM(OHM2$, OHMS! / 1000)  'Sets meter
					CALL LOADMUX(1, CON%)               'Sets mux channel
				END IF
				IF OHMS! > 1000000! THEN
					MEASTOL! = .005                     '0.5% measurement tolerance
				ELSE
					MEASTOL! = .0005                    '0.05% measurement tolerance
				END IF
			END IF
		  
			CALL PAUSE(.5)
			RES!(N%) = READDVM!(MEASTOL! * OHMS!)       'Measure resistor value to tolerance
			ELAP! = TIMER - TIME1!

			RDRIFT!(N%) = (RES!(N%) - RES!(1)) / RES!(1) * 100
			DRIFTPERC! = RDRIFT!(N%) - RDRIFT!(1)
			IF OHMS! > 1000000! THEN
				DRIFTSPEC! = .5             '%
			ELSE
				DRIFTSPEC! = .05            '%
			END IF
			IF ABS(DRIFTPERC!) > DRIFTSPEC! THEN
				DFTFAIL% = DFTFAIL% + 1
				DRIFTSTAT$ = "FAIL"
			END IF

			PRINT TAB(8); USING "  ##        #######        #####.###          ###.#         &"; E%; RES!(N%); DRIFTPERC!; ELAP!; DRIFTSTAT$
		   
			N% = N% + 1
			IF N% = 4 THEN PRINT
		   
			IF DFTFAIL% = 1 THEN
				LPRINT
				LPRINT
				LPRINT TAB(8); "RELAY      CMD R (ê)      DELTA R (%)   Elapsed Time (s)   STATUS"
				LPRINT TAB(8); "-----------------------------------------------------------------"
				DFTFAIL% = DFTFAIL% + 1
			END IF

			IF  LEFT$(DRIFTSTAT$, 4) = "FAIL" THEN
				LPRINT TAB(8); USING " ##        #######        #####.###          ###.#         &"; E%; RES!(N%); DRIFTPERC!; ELAP!; DRIFTSTAT$
				LPRINT TAB(8); "-----------------------------------------------------------------"
				DRIFTSTAT$ = "PASS"
			END IF
		   
		LOOP WHILE N% < 4
	NEXT

	CALL PAUSE(3)
   
	IF OHMFAIL% > 0 OR DFTFAIL% > 0 THEN
		CLS
		LOCATE 10, 10
		PRINT "THIS TEST HEAD HAS FAILED THE STARTUP TEST."
		PRINT TAB(10); "PLEASE CONTACT ENGINEERING."
		LPRINT
		LPRINT TAB(10); "THIS TEST HEAD HAS FAILED THE STARTUP TEST."
		LPRINT TAB(10); "PLEASE CONTACT ENGINEERING."
		LPRINT CHR$(12)
		STOP
	END IF
   
	CB1VAL% = &HFF
	CALL SETTH(CB1VAL%, CB1%)           '1 1 1 1  1 1 1 1
										'Disable K11 (-IN floats)
	CALL PAUSE(.2)
	 
END SUB

FUNCTION SETATTEN% (VOLTAGE!)
	 
	'Set the test head R/2R ladder
	'Find largest attenuation ratio for Vdac < 9.7V
	'Leave 0.3V margin for low computer power supplies and 1% attenuator
	'accuracy

	IF ABS(VOLTAGE!) > 4.85 THEN
		EXPNT% = 0
		IF VOLTAGE! > MAINMAX! THEN
			VOLTAGE! = MAINMAX!             'DAC limitation
		ELSEIF VOLTAGE! < MAINMIN! THEN
			VOLTAGE! = MAINMIN!             'DAC limitation
		END IF
	ELSE
		EXPNT% = 10                             'first attenuator position
		DO                                      'is atten = 1
			EXPNT% = EXPNT% - 1             'max. atten = 512 = 2^9
		LOOP WHILE ABS(VOLTAGE!) >= (9.7 / (2 ^ EXPNT%))
	END IF

	IF (EXPNT% - 7) > 0 THEN
		CHOOSECB% = CB1%
		MASK1% = &H3F                      '0 0 1 1  1 1 1 1
		MASK2% = 2 ^ (EXPNT% - 2)          'X X 0 0  0 0 0 0
		CBVAL% = (CB1VAL% AND MASK1%) OR MASK2%
		CB1VAL% = CBVAL%
	ELSE
		CHOOSECB% = CB2%
		CBVAL% = &HFF - 2 ^ (7 - EXPNT%)
		CB2VAL% = CBVAL%
	END IF
	   
	CALL SETTH(CBVAL%, CHOOSECB%)

	IF CHOOSECB% = 1 THEN                    'Clear attenuator lines on unused controlbank
		CHOOSECB% = 2
		CBVAL% = (CB2VAL% OR &HFF)
		CB2VAL% = CBVAL%
	ELSE
		CHOOSECB% = 1
		CBVAL% = (CB1VAL% OR &HC0)       '1 1 0 0  0 0 0 0
		CB1VAL% = CBVAL%
	END IF

	CALL SETTH(CBVAL%, CHOOSECB%)
	SETATTEN% = 2 ^ EXPNT%

END FUNCTION

SUB SETDAC (VOLTAGE!, CH%, VSENATTEN!)
	
	'main dac = 12 bits,  vernier dac = 12 bits
	'vernier overlap is approximately 4 bits
	'total dac resolution is approx. 20 bits
	'+/-10V / 2^20 = 19uV
	'R/2R ladder attenuation is 512 max.
	'max. DUT input voltage resolution is 29 bits or 37nV
	'
	'For voltages greater than DAC range, use and external high voltage
	'power supply (Kepco DPS 125-0.5M)

	IF ABS(VOLTAGE!) < .00001 THEN              'DAC limitation
		CB0VAL% = CB0VAL% AND &HE3              'short inputs and ground
		CALL SETTH(CB0VAL%, CB0%)               '1 1 1 0  0 0 1 1
	   
		CALL SETTH((CB1VAL% OR &HC0), CB1%)     'Clear R/2R ladder
		CALL SETTH((CB2VAL% OR &HFF), CB2%)
	   
		CB3VAL% = CB3VAL% OR &HE0               '1 1 1 0  0 0 0 0
		CALL SETTH(CB3VAL%, CB3%)               'D.U.T. input = R/2R ladder
	
		VERNBIT% = 2048
		CALL LOADDAC(VERNBIT%, VERN%)           'zero vernier DAC
		MAINBIT% = 2048
		CALL LOADDAC(MAINBIT%, MAIN%)           'zero main DAC
	   
		CALL LOADMUX(CH%, CON%)
		CALL WRITEDVM(VODC$, VOLTAGE!)
		'CALL PAUSE(.01)
		DO
			VMEAS! = READDVM!(0!)               'Read actual input voltage
		LOOP WHILE ABS(VMEAS!) > 1
		CALL LOADMUX(CH%, COFF%)
	ELSEIF ABS(VOLTAGE!) <= 10 THEN             'Check if within DAC range
												'Remove high voltage from +/-IN
		CALL SETTH((CB3VAL% OR &HC0), CB3%)     '1 1 0 0  0 0 0 0
		'CALL PAUSE(.1)                          'Allow time to open inputs
		'                                        'before high V is applied
		VERNBIT% = 2048
		CALL LOADDAC(VERNBIT%, VERN%)           'zero vernier DAC
		IF VSENATTEN! = 0 THEN                  'Voltage input to D.U.T.
			CB0VAL% = (CB0VAL% AND &HEB) OR &H8 '1 1 1 0  1 0 1 1
							'ground inputs, short series R
							'remove short on inputs
			'Remove high voltage from +/-IN
			CB3VAL% = CB3VAL% OR &HE0       '1 1 1 0  0 0 0 0
							'D.U.T. input = R/2R ladder
			ATTEN! = SETATTEN%(VOLTAGE!)
		ELSE                                    'Current input to D.U.T.
			IF VSENATTEN! = 1 THEN              '2W TX Input
				CB0VAL% = CB0VAL% AND &HE3      '1 1 1 0  0 0 1 1
												'ground inputs, short series R
			ELSE                                    'Current Input
				CB0VAL% = (CB0VAL% AND &HEB) OR &H8 '1 1 1 0  1 0 1 1
													'ground inputs, short series R
													'remove short on inputs
			END IF
			CB3VAL% = CB3VAL% AND &HDF          '1 1 0 1  1 1 1 1
												'D.U.T. input = current source
			ATTEN! = VSENATTEN!
		END IF
		CALL SETTH(CB0VAL%, CB0%)
		CALL SETTH(CB3VAL%, CB3%)
		CALL LOADMUX(CH%, CON%)
		   
		'0.015% resolution for input voltage spans < 7mV
		'IF ABS(VOLTAGE!) < .007 THEN
		'        ACCURAY! = .0000002             '> 0.015% resolution down to 1.3mV
		'ELSEIF ABS(VOLTAGE!) < .18 THEN
		'    ACCURAY! = .000001              '> 0.014% resolution down to 7mV
		'ELSEIF ABS(VOLTAGE!) < 1.8 THEN
		'    ACCURAY! = .00001               '> 0.006% resolution down to 181mV
		'ELSE
		'    ACCURAY! = .0001                '> 0.006% resolution down to 1.81V
		'END IF
		ACCURAY! = .001

		CALL WRITEDVM(VODC$, VOLTAGE!)
	
		IF ABS(MAINMAX!) < ABS(MAINMIN!) THEN   'Choose smaller of the two values
			MAINDENOM! = ABS(MAINMAX!)
		ELSE
			MAINDENOM! = ABS(MAINMIN!)
		END IF
	
		MBITVOLT! = 2048 / MAINDENOM!
		VBITVOLT! = 4096 / (VERNMAX! - VERNMIN!)
		   
		MAINBIT% = CINT(2048 - (MBITVOLT! * VOLTAGE! * ATTEN!))
		IF MAINBIT% > 4095 THEN
			MAINBIT% = 4095
			VOLTAGE! = (MAINMIN! + .1) / ATTEN!
		ELSEIF MAINBIT% < 0 THEN
			MAINBIT% = 0
			VOLTAGE! = (MAINMAX! - .1) / ATTEN!
		END IF

		ITERATION% = 0
		DO
			ITERATION% = ITERATION% + 1
			CALL LOADDAC(MAINBIT%, MAIN%)
			ATTENERR! = READDVM!(0!) - VOLTAGE!
			IF ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) THEN
				'abs(vernmin) generally < vernmax
				'Main DAC setting and R/2R ladder setting resulted
				'in a voltage which is out of the vernier adjustment
				'range.
				BITCOMP% = CINT(ATTENERR! * ATTEN! * MBITVOLT!)
				MAINBIT% = MAINBIT% + BITCOMP%  'Increasing mainbit
								'decreases DAC voltage
				CALL LOADDAC(MAINBIT%, MAIN%)
				'ATTEN! = (2048 - MAINBIT%) / MBITVOLT! / VOLTAGE!
			END IF
		LOOP WHILE ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) AND ITERATION% < 20
	
		'IF ITERATION% = 20 THEN
		'    BEEP
		'    PRINT "Faulty test head connection or current input"
		'    PRINT "module not installed in test sockets."
		'    STOP
		'END IF

		ITERATION% = 0
		LIMIT = 0
	
		'CALL PAUSE(.01)
		VMEAS! = READDVM!(0!)
	   
		DO
			ITERATION% = ITERATION% + 1
			ADJUST! = VMEAS! - VOLTAGE!
			 
			IF ABS(ADJUST!) > ABS(ACCURAY! * VOLTAGE!) THEN
				IF ABS(VBITVOLT! * ADJUST! * ATTEN!) < 32767 THEN
					ADJUSTBIT% = CINT(VBITVOLT! * ADJUST! * ATTEN!)
					VERNBIT% = VERNBIT% + ADJUSTBIT%
					IF VERNBIT% > 4095 THEN
						VERNBIT% = 4095
						LIMIT = 1
					ELSEIF VERNBIT% < 0 THEN
						VERNBIT% = 0
						LIMIT = 1
					END IF
				ELSE
					LIMIT = 1
				END IF
				CALL LOADDAC(VERNBIT%, VERN%)
				'CALL PAUSE(.01)
				VMEAS! = READDVM!(0!)
			ELSE
				LIMIT = 1                       'abs(adjust!) < accuray!
								'set flag to exit loop
			END IF
		LOOP WHILE ITERATION% < 20 AND LIMIT = 0
	
		IF ITERATION% = 30 THEN
			BEEP
			PRINT "Unable to find required voltage."
			PRINT "Error = "; ADJUST!
			PRINT "Please notify engineering."
		END IF
		CALL LOADMUX(CH%, COFF%)

	ELSE
		'Configure test head for high voltage ( > 10V ) unipolar input
		'supplied by a second Kepco DPS 125 power supply

		CALL SETTH((CB1VAL% OR &HC0), CB1%)             'Clear R/2R ladder
		CALL SETTH((CB2VAL% OR &HFF), CB2%)
	
	
'        CB0VAL% = CB0VAL% OR &H1C                              '0 0 0 1  1 1 0 0
'                                        'un-ground inputs, remove short on series R
		CB0VAL% = CB0VAL% OR &H18                       '0 0 0 1  1 0 0 0
								'un-ground inputs, short series R
		IF VOLTAGE! >= 0 THEN
			CB3VAL% = (CB3VAL% OR &H80) AND &HBF    '1 0 0 0  0 0 0 0
								'1 0 1 1  1 1 1 1
		ELSE
			CB3VAL% = (CB3VAL% OR &H40) AND &H7F    '0 1 0 0  0 0 0 0
								'0 1 1 1  1 1 1 1
		END IF

		CALL SETTH(CB0VAL%, CB0%)
		'CALL PAUSE(.1)                                  'Allow time to open inputs
		'                                                'before high V is applied
		CALL SETTH(CB3VAL%, CB3%)
		DO
			 SL$ = SETPOWER$(VINADDR%, ABS(VOLTAGE!), FUNC$)    'Set Vin
		LOOP WHILE ABS(VAL(SETPOWER$(VINADDR%, 999!, READVOLT$)) - ABS(VOLTAGE!)) > 1
		VMEAS! = VOLTAGE!
		  
	END IF

	VOLTAGE! = VMEAS!
END SUB

SUB SETDAC2 (VOLTAGE!, CH%, VSENATTEN!)
   
	'SETDAC routine with controlbank values for
	'voltage and current output module test heads
	'
	'main dac = 12 bits,  vernier dac = 12 bits
	'vernier overlap is approximately 4 bits
	'total dac resolution is approx. 20 bits
	'+/-10V / 2^20 = 19uV
	'
	'For voltages greater than DAC range, use and external high voltage
	'power supply (Kepco DPS 125-0.5M)
   
	IF ABS(VOLTAGE!) <= 10.1 THEN                   'Check if within DAC range
	   
		VERNBIT% = 2048
		CALL LOADDAC(VERNBIT%, VERN%)           'zero vernier DAC
	   
		IF VSENATTEN! = 0 THEN                  'Voltage input to D.U.T.
			IF VOLTAGE! > MAINMAX! THEN
				VOLTAGE! = MAINMAX!     'DAC limitation
			ELSEIF VOLTAGE! < MAINMIN! THEN
				VOLTAGE! = MAINMIN!     'DAC limitation
			END IF
		   
			ATTEN! = 1
		ELSE                                    'Current input to D.U.T.
												'Current Input
			ATTEN! = VSENATTEN!
	   
		END IF
	  
		CB0VAL% = (CB0VAL% OR &H6) AND &HDE     'Sets relays K00, K05, resets K01, K02
												'0 0 0 0  0 1 1 0
												'1 1 0 1  1 1 1 0
		CALL SETTH(CB0VAL%, CB0%)
		CALL LOADMUX(CH%, CON%)
		 
		'0.015% resolution for input voltage spans < 7mV
		'IF ABS(VOLTAGE!) < .007 THEN
		'        ACCURAY! = .0000002            '> 0.015% resolution down to 1.3mV
		IF ABS(VOLTAGE!) < .18 THEN
			ACCURAY! = .001  '.000001       '> 0.014% resolution down to 7mV
		ELSEIF ABS(VOLTAGE!) < 1.8 THEN
			ACCURAY! = .001  '.00001        '> 0.006% resolution down to 181mV
		ELSE
			ACCURAY! = .001  '.0001         '> 0.006% resolution down to 1.81V
		END IF

		CALL WRITEDVM(VODC$, 2000!) 'VOLTAGE!)  'Without autorange, can overrange
												'when setting 0V.
	   
		IF ABS(MAINMAX!) < ABS(MAINMIN!) THEN   'Choose smaller of the two values
			MAINDENOM! = ABS(MAINMAX!)
		ELSE
			MAINDENOM! = ABS(MAINMIN!)
		END IF
	  
		MBITVOLT! = 2048 / MAINDENOM!
		VBITVOLT! = 4096 / (VERNMAX! - VERNMIN!)
		 
		MAINBIT% = CINT(2048 - (MBITVOLT! * VOLTAGE! * ATTEN!))
		IF MAINBIT% > 4095 THEN
			MAINBIT% = 4095
			VOLTAGE! = (MAINMIN! + .1) / ATTEN!
		ELSEIF MAINBIT% < 0 THEN
			MAINBIT% = 0
			VOLTAGE! = (MAINMAX! - .1) / ATTEN!
		END IF

		ITERATION% = 0
		DO
			ITERATION% = ITERATION% + 1
			CALL LOADDAC(MAINBIT%, MAIN%)
				ATTENERR! = READDVM!(0!) - VOLTAGE!
			IF ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) THEN
				'abs(vernmin) generally < vernmax
				'Main DAC setting and R/2R ladder setting resulted
				'in a voltage which is out of the vernier adjustment
				'range.
				BITCOMP% = CINT(ATTENERR! * ATTEN! * MBITVOLT!)
				MAINBIT% = MAINBIT% + BITCOMP%  'Increasing mainbit
								'decreases DAC voltage
				CALL LOADDAC(MAINBIT%, MAIN%)
				'ATTEN! = (2048 - MAINBIT%) / MBITVOLT! / VOLTAGE!
			END IF
		LOOP WHILE ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) AND ITERATION% < 20
	  
		IF ITERATION% = 20 THEN
			BEEP
			PRINT "Faulty test head connection or current input"
			PRINT "module not installed in test sockets."
		   
			STOP
		END IF

		ITERATION% = 0
		LIMIT = 0
		DO
			ITERATION% = ITERATION% + 1
			'CALL PAUSE(.01)
			VMEAS! = READDVM!(0!)
			ADJUST! = VMEAS! - VOLTAGE!
			
			IF ABS(ADJUST!) > ABS(ACCURAY! * VOLTAGE!) THEN
				IF ABS(VBITVOLT! * ADJUST! * ATTEN!) < 32767 THEN
					ADJUSTBIT% = CINT(VBITVOLT! * ADJUST! * ATTEN!)
					VERNBIT% = VERNBIT% + ADJUSTBIT%
					IF VERNBIT% > 4095 THEN
						VERNBIT% = 4095
						LIMIT = 1
					ELSEIF VERNBIT% < 0 THEN
						VERNBIT% = 0
						LIMIT = 1
					END IF
				ELSE
					LIMIT = 1
				END IF
				CALL LOADDAC(VERNBIT%, VERN%)
			ELSE
				LIMIT = 1               'abs(adjust!) < accuray!
							'set flag to exit loop
			END IF
		LOOP WHILE ITERATION% < 20 AND LIMIT = 0
	  
		IF ITERATION% = 30 THEN
			BEEP
			PRINT "Unable to find required voltage."
			PRINT "Error = "; ADJUST!
			PRINT "Please notify engineering."
		END IF
		CALL LOADMUX(CH%, COFF%)

	ELSE
		'Configure test head for high voltage ( > 10V ) unipolar input
		'supplied by a second Kepco DPS 125 power supply

		CB0VAL% = CB0VAL% OR &H1C               '0 0 0 1  1 1 0 0
										'un-ground inputs, remove short on series R
										'remove short on inputs
										'D.U.T. input should be R/2R ladder

										'High voltage power supply is unipolar.
										'Set polarity based on required Vin
		IF VOLTAGE! >= 0 THEN
			CB3VAL% = (CB3VAL% OR &H80) AND &HBF    '1 0 0 0  0 0 0 0
													'1 0 1 1  1 1 1 1
		ELSE
			CB3VAL% = (CB3VAL% OR &H40) AND &H7F    '0 1 0 0  0 0 0 0
													'0 1 1 1  1 1 1 1
		END IF

		CALL SETTH(CB0VAL%, CB0%)
		'CALL PAUSE(.1)                         'Allow time to open inputs
							'before high V is applied
		CALL SETTH(CB3VAL%, CB3%)
		   
		DO
			  SL$ = SETPOWER(VINADDR%, ABS(VOLTAGE!), FUNC$)    'Set Vin
		LOOP WHILE ABS(VAL(SETPOWER(VINADDR%, 999!, READVOLT$)) - ABS(VOLTAGE!)) > 1
		VMEAS! = VOLTAGE!
		PRINT "VMEAS!"
	   
	   
	END IF
  
	VOLTAGE! = VMEAS!

END SUB

SUB SETDACFAST (VOLTAGE!)
	
	'Sets main DAC only, zeros vernier DAC.
	'Does not set attenuator (R/2R ladder).  Set prior to calling.
	'Does not measure error in set voltage.
	'Assumes test head is configured for DAC input to transmitter

	VERNBIT% = 2048
	CALL LOADDAC(VERNBIT%, VERN%)           'zero vernier DAC
		 
	MBITVOLT! = 4096 / (MAINMAX! - MAINMIN!)
	MAINBIT% = CINT(2048 - (MBITVOLT! * VOLTAGE!))
	IF MAINBIT% > 4095 THEN
		MAINBIT% = 4095
	ELSEIF MAINBIT% < 0 THEN
		MAINBIT% = 0
	END IF
	   
	CALL LOADDAC(MAINBIT%, MAIN%)

END SUB

FUNCTION SETPOWER$ (ADDR%, VSUPPLY!, CMD$)
'****** PSMODEL$ is the selection of either the Older "DPS125" KEPCO Power Supply
'****** or the new KEPCO "ABC125" Power Supply

	IF PSMODEL$ = "DPS125" THEN
	 
		IF CMD$ = LOCAL$ THEN
			SETP$ = POWERIO$(ADDR%, CMD$)
			STATE = FAILCOM(SETP$)
			SETPOWER$ = SETP$
	 
		ELSEIF CMD$ = ISTAT$ THEN
			SETP$ = MID$(POWERIO$(ADDR%, CMD$), 5, 3)
			STATE = FAILCOM(SETP$)
			SETPOWER$ = SETP$
	 
		ELSEIF CMD$ = READVOLT$ THEN
			SETP$ = MID$(POWERIO$(ADDR%, CMD$), 5, 3)
			STATE = FAILCOM(SETP$)
			SETPOWER$ = SETP$
		   
		ELSEIF CMD$ = CURRENT$ THEN
			SETP$ = MID$(POWERIO$(ADDR%, CMD$), 5, 3)
			STATE = FAILCOM(SETP$)
			SETPOWER$ = SETP$
		   
		ELSE
			IF VSUPPLY! = 999! THEN
				FUNC$ = CMD$
			ELSE
				FUNC$ = VOLT$ + RIGHT$(STR$(VSUPPLY!), LEN(STR$(VSUPPLY!)) - 1)
			END IF
			   
			SETP$ = POWERIO$(ADDR%, FUNC$)
			STATE = FAILCOM(SETP$)
			SETPOWER$ = SETP$
	
	 '*** Check for OverCurrent
			IF POWERIO$(ADDR%, ISTAT$) = "RCS=01" THEN    'Check for over-current
				SOUND 1000, .5
				LOCATE , 10
				PRINT "Power supply current and/or voltage has exceeded maximum value."
				PRINT TAB(10); "Power supply has been disabled."
				PRINT TAB(10); "Press any key to continue"
				a$ = KEYBDIN$
			END IF
			   
			IF CMD$ <> LOOPOFF$ THEN
				LPN$ = POWERIO$(ADDR%, LOOPON$)  'enable power supply output
			END IF
			   
			CALL PAUSE(.2)                        '200ms over-current prot. delay
		   
		END IF
		   
'****** Below is the case where the power supply is the new KEPCO ABC 125
	   
	ELSEIF PSMODEL$ = "ABC125" THEN
		   
		IF CMD$ = ISTAT$ THEN
			CALL WRITEPS(ADDR%, "CURR:PROT:TRIP?")
			SETP$ = READPS$(ADDR%, "VOLT?")
			   
			IF SETP$ = "0" THEN
				SETPOWER$ = "RCS=01"
			ELSE
				SETPOWER$ = ""
			END IF

		ELSEIF CMD$ = READVOLT$ THEN
			SETP$ = READPS$(ADDR%, "VOLT?")
			SETPOWER$ = SETP$
	
		ELSEIF CMD$ = CURRENT$ THEN
			SETP$ = READPS$(ADDR%, "READ:CURR?")
			ReadCurrent! = VAL(SETP$) * 1000
			SETP$ = STR$(ReadCurrent!)
			SETPOWER$ = SETP$
	 
		ELSEIF CMD$ = "ID" THEN
			SETP$ = READPS$(ADDR%, "*IDN?")
			SETPOWER$ = SETP$
		  
		ELSE                      'VALUE = 999! AND CMD$ <> "INIT"
			IF CMD$ = "LOC" THEN
				FUNC$ = "SYST:KLOC OFF"
			ELSEIF CMD$ = LOOPOFF$ THEN
				FUNC$ = "OUTP OFF"
			ELSEIF CMD$ = LOOPON$ THEN
				FUNC$ = "OUTP ON"
			ELSEIF CMD$ = "ZER" THEN
				FUNC$ = "*RST"       'Zeroes out the error queue
			ELSE
				IF VSUPPLY! = 999! THEN
					FUNC$ = CMD$
				ELSE
					FUNC$ = "VOLT" + STR$(VSUPPLY!) + "; CURR 0.5"
					   
					OCF$ = READPS$(ADDR%, "CURR:PROT:TRIP?")
					IF OCF$ = "1" THEN
						CALL WRITEPS(ADDR%, "CURR:PROT:CLE")
						CALL WRITEPS(ADDR%, "*CLS")
						SOUND 1000, .5
						LOCATE , 10
						PRINT "Power supply current and/or voltage has exceeded maximum value."
						PRINT TAB(10); "Power supply has been disabled."
						PRINT TAB(10); "Press any key to continue"
						a$ = KEYBDIN$
						'END
						'CHAIN "C:\ATE\MENUX"
					END IF
				END IF
			END IF
			   
			CALL WRITEPS(ADDR%, FUNC$)
			SETP$ = READPS$(ADDR%, "VOLT?")
			SETPOWER$ = SETP$
		  
			IF CMD$ <> LOOPOFF$ THEN
				CALL WRITEPS(ADDR%, "OUTP ON")              'enable power supply output
			END IF
			'CALL PAUSE(.2)                                '20ms over-current prot. delay
		END IF
	ELSE
		PRINT "KEPCO Power Supply is *** NOT *** connected"
	END IF

END FUNCTION

FUNCTION SETRANGE$ (value!)
	   
	'range does not switch at exactly 2^n volts.  value at switch
	'occurs depends on previous voltage (higher or lower than new voltage).

	'IF ABS(VALUE!) <= .007 THEN
	'        SETRANGE$ = "R8"                '20mV range
						'use to maintain better than
						'0.015% resolution for
						'input voltage spans < 7mV
	IF ABS(value!) <= .195 THEN
		SETRANGE$ = "R1"                '200mV, 200ohm range
	ELSEIF ABS(value!) < 1.8 THEN
		SETRANGE$ = "R2"                '2V, 2Kohm range
	ELSEIF ABS(value!) < 18 THEN
		SETRANGE$ = "R3"                '20V, 20Kohm range
						'DAC range is +/-10V max.
	ELSEIF ABS(value!) < 180 THEN
		SETRANGE$ = "R4"                '200V, 200Kohm range
	ELSE
		SETRANGE$ = "R0"                'autorange
	END IF
	
END FUNCTION

SUB SETTEST (TEST%)
	   
	'Set test 0-7 on the RTD test head
   
	CB0VAL% = (CB0VAL% OR &H7) AND (&HF8 + TEST%)   '0 0 0 0  0 1 1 1
													'1 1 1 1  1 0 0 0
	CALL SETTH(CB0VAL%, CB0%)                       'Set Test TEST%

END SUB

SUB SETTH (DOUT%, CB%)

	'Parallel Port Control Register is located at address LPTADDR% + 2
	'Bits 0, 1, and 3 toggle the opposite way expected.
	'Hold W/R low to prevent resetting the relay mux.
	'NOTE:  Sending data out to LPTADDR%+0 resets the relay mux

	'                       W/R  EN/  D/A   S/
	'  X    X    X    X      X    X    X    X
	'C                       1    1    0    0  (0 1 1 1)
	'D                       1    1    0    1  (0 1 1 0)
	'E                       1    1    1    0  (0 1 0 1)

	   
	' Writes the test head address and selects which control bank
	' the data will be written to.
	BYTE% = THADDR% * 4 + CB%
	OUT (LPTADDR%), BYTE%
	OUT (LPTADDR% + 2), &HE                 'D/A line low
	OUT (LPTADDR% + 2), &HC                 'D/A line high
	CALL PAUSE(.01)                         'Reduced to 0.01 from 0.1 (3/19/04)
	   
	' Writes the data to the addressed control bank in the test head.
	   
	OUT (LPTADDR%), DOUT%
	CALL PAUSE(.01)                         'Test head would not process commnad in some stations
											'(so far with PCI parallel cards)
	OUT (LPTADDR% + 2), &HD                 'S/ line low
	OUT (LPTADDR% + 2), &HC                 'S/ line high
	CALL PAUSE(.01)                         'Reduced to 0.01 from 0.1 (3/19/04)
	   
	' Disables the test head by clearing the address.
	OUT (LPTADDR%), 0
	OUT (LPTADDR% + 2), &HE                 'D/A line low
	OUT (LPTADDR% + 2), &HC                 'D/A line high
	CALL PAUSE(.01)                         'Reduced to 0.01 from 0.1 (3/19/04)
	   
	' Clear mux in case in case DOUT% 4 MSB's matched mux address.
	' DOUT% 4 LSB's would be loaded as mux data.
	OUT (LPTADDR% + 2), &H4                 'W/R line high
	OUT (LPTADDR% + 2), &HC                 'W/R line low

END SUB

SUB SETTHFAST (DOUT%, CB%)
	   
	' Same operation as SETTH except test head is not disabled
	' to avoid pauses.  Use with Step Response test only.
	' Writes the test head address and selects which control bank
	' the data will be written to.

	BYTE% = THADDR% * 4 + CB%
	OUT (LPTADDR%), BYTE%
	OUT (LPTADDR% + 2), &HE                 'D/A line high
	OUT (LPTADDR% + 2), &HC                 'D/A line low
	   
	' Writes the data to the addressed control bank in the test head.
	OUT (LPTADDR%), DOUT%
	OUT (LPTADDR% + 2), &HD                 'S/ line low
	OUT (LPTADDR% + 2), &HC                 'S/ line high
	   
	' Clear mux in case in case DOUT% 4 MSB's matched mux address.
	' DOUT% 4 LSB's would be loaded as mux data.
	OUT (LPTADDR% + 2), &H4                 'W/R line high
	OUT (LPTADDR% + 2), &HC                 'W/R line low
	  
END SUB

FUNCTION STRINGVAL% (a$)

	'Calculate and return the value of the characters in A$
	'which follow the hyphen
 
	T% = LEN(a$)

	DO
		L% = L% + 1
	LOOP UNTIL MID$(a$, L%, 1) = "-" OR L% = T%

	STRINGVAL% = VAL(RIGHT$(a$, T% - L%))

END FUNCTION

FUNCTION TCTEMP! (TCV!, SENTYPE$)
	   
	'Function inputs;  Measured simulated TC voltage in V, and TC type
	'Function Output;  TC temperature in deg. C
	 
	'Polynomial format; T = c0 + c1*EMF + c2*EMF^2 + c3*EMF^3 + ...

	IF UCASE$(LEFT$(SENTYPE$, 1)) = "J" THEN        'Select the proper polynomial
		IF TCV! < 0 THEN
			RESTORE INVJ1
		ELSEIF TCV! < .042919 THEN
			RESTORE INVJ2
		ELSE
			RESTORE INVJ3
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "K" THEN
		IF TCV! < 0 THEN
			RESTORE INVK1
		ELSEIF TCV! < .020644 THEN
			RESTORE INVK2
		ELSE
			RESTORE INVK3
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "T" THEN
		IF TCV! < 0 THEN
			RESTORE INVTNEG
		ELSE
			RESTORE INVTPOS
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "E" THEN
		IF TCV! < 0 THEN
			RESTORE INVENEG
		ELSE
			RESTORE INVEPOS
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "R" THEN
		IF TCV! < .001923 THEN
			RESTORE INVR1
		ELSEIF TCV! < .011361 THEN
			RESTORE INVR2
		ELSEIF TCV! < .019739 THEN
			RESTORE INVR3
		ELSE
			RESTORE INVR4
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "S" THEN
		IF TCV! < .001874 THEN
			RESTORE INVS1
		ELSEIF TCV! < .010332 THEN
			RESTORE INVS2
		ELSEIF TCV! < .017536 THEN
			RESTORE INVS3
		ELSE
			RESTORE INVS4
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "B" THEN
		IF TCV! < 2.28E-06 THEN
			RESTORE INVB0
		ELSEIF TCV! < .0000332 THEN
			RESTORE INVB1
		ELSEIF TCV! < 9.206E-05 THEN
			RESTORE INVB2
		ELSEIF TCV! < 1.7826E-04 THEN
			RESTORE INVB3
		ELSEIF TCV! < 2.9128E-04 THEN
			RESTORE INVB4
		ELSEIF TCV! < .002431 THEN
			RESTORE INVB5
		ELSE
			RESTORE INVB6
		END IF
   
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "C" THEN
	   IF TCV! < .009395 THEN
			RESTORE INVC1
		ELSEIF TCV! < .028955 THEN
			RESTORE INVC2
		ELSE
			RESTORE INVC3
		END IF

	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "N" THEN
		IF TCV! < 0 THEN
			RESTORE INVNNEG
		ELSE
			RESTORE INVNPOS
		END IF
	ELSE
		TCV! = 99               'invalid sensor type
		EXIT FUNCTION
	END IF

			'Check if TCV is within polynomial limits
	READ MINTCV!, MAXTCV!
	IF TCV! * 1000000! < MINTCV! OR TCV! * 1000000! > MAXTCV! THEN
		PRINT "Error! Polynomial limits exceeded.  Contact engineering."
		PRINT SENTYPE$, TCV!, MINTCV!, MAXTCV!
		TCTEMP! = 98            'out of range
		STOP
	END IF
	   
	EXPNT% = 0
	T! = 0
   
	DO
		READ COEFF#
		T! = T! + COEFF# * (TCV! * 1000000!) ^ EXPNT%
		EXPNT% = EXPNT% + 1
	LOOP WHILE COEFF# <> 0 OR EXPNT% = 1      'look for coeff = 0, end of data

	IF UCASE$(LEFT$(SENTYPE$, 1)) = "C" THEN
		TCTEMP! = (T! - 32!) * 5 / 9    'Convert from deg. F to deg C.
	ELSE
		TCTEMP! = T!
	END IF

END FUNCTION

FUNCTION TCVOLTS! (TEMP!, SENTYPE$)

	'Function inputs;  temperature, TC type
	'Function Output;  TC voltage in V

	'Polynomial format; EMF = c0 + c1*T + c2*T^2 + c3*T^3 + ...
	   
	IF UCASE$(LEFT$(SENTYPE$, 1)) = "J" THEN        'Select the proper polynomial
		IF TEMP! < 760 THEN
			RESTORE TYPEJ1
		ELSE
			RESTORE TYPEJ2
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "K" THEN
		IF TEMP! < 0 THEN
			RESTORE TYPEKNEG
		ELSE
			RESTORE TYPEKPOS
			XTRATERM! = 118.5976 * EXP(-1.183432E-04 * (TEMP! - 126.9686) ^ 2)
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "T" THEN
		IF TEMP! < 0 THEN
			RESTORE TYPETNEG
		ELSE
			RESTORE TYPETPOS
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "E" THEN
		IF TEMP! < 0 THEN
			RESTORE TYPEENEG
		ELSE
			RESTORE TYPEEPOS
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "R" THEN
		IF TEMP! < 1064.18 THEN
			RESTORE TYPER1
		ELSEIF TEMP! < 1664.5 THEN
			RESTORE TYPER2
		ELSE
			RESTORE TYPER3
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "S" THEN
		IF TEMP! < 1064.18 THEN
			RESTORE TYPES1
		ELSEIF TEMP! < 1664.5 THEN
			RESTORE TYPES2
		ELSE
			RESTORE TYPES3
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "B" THEN
		IF TEMP! < 630.615 THEN
			RESTORE TYPEB1
		ELSE
			RESTORE TYPEB2
		END IF
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "C" THEN
		TEMPDEGC! = TEMP!
		TEMP! = TEMPDEGC! * 9 / 5 + 32      'Polynomial expects temp. in deg F.
		RESTORE TYPEC
	ELSEIF UCASE$(LEFT$(SENTYPE$, 1)) = "N" THEN
		IF TEMP! < 0 THEN
			RESTORE TYPENNEG
		ELSE
			RESTORE TYPENPOS
		END IF
	ELSE
		TCVOLTS! = 99          'invalid sensor type
		EXIT FUNCTION
	END IF

					'Check if TEMP is within polynomial limits
	READ MINTEMP!, MAXTEMP!
	IF TEMP! < MINTEMP! OR TEMP! > MAXTEMP! THEN
		PRINT TEMP!, MINTEMP!, MAXTEMP!
		PRINT "Error! Polynomial limits exceeded.  Contact engineering."
		PRINT SENTYPE$, TEMP!, MINTEMP!, MAXTEMP!
		TCVOLTS! = 98
		STOP
		'EXIT FUNCTION
	END IF
	  
	EXPNT% = 0
	V! = 0

	DO
		READ COEFF#
		V! = V! + COEFF# * TEMP! ^ EXPNT%
		EXPNT% = EXPNT% + 1
	LOOP WHILE COEFF# <> 0 OR EXPNT% = 1      'look for coeff = 0, end of data

	TCVOLTS! = (V! + XTRATERM!) / 1000000!  'Polynomials return EMF in uV
   
	IF UCASE$(LEFT$(SENTYPE$, 1)) = "C" THEN TEMP! = TEMPDEGC!  'Re-assign original value.

END FUNCTION

SUB TRIGGER

'       Module Name - TRIGGER
'       Inputs - None
'       Outputs - None
'       Description - TRIGGER, sends the Fluke meter the command to take a
'                     measurement.
'
	   
	ADD = (MLA% OR DVMADDR%)
	OUT (BADDRS% + 7), ADD                           'Sends listen address
	CALL HS1
 
	OUT (BADDRS% + 3), &H8A                          'Sets request high
	OUT (BADDRS% + 3), &HB                           'Sets remote low
	OUT (BADDRS% + 7), ASC("?")                      'Outputs trigger command
	CALL HS1
	OUT (BADDRS% + 7), &HD                           'Outputs CR to trigger Fluke 8842A
	CALL HS1
	OUT (BADDRS% + 3), &HC                           'Sets remote high
	OUT (BADDRS% + 3), &H89                          'Sets request low

END SUB

FUNCTION UPSN$ (SN$)
	'Function that returns a new module serial number, with the dash number incremented
	'by one, from the passed value of the module serial number
	CALL SNPARSE(SN$, WO$, DS$)	'Get current work order and dash numbers from module serial number
	DSNV% = VAL(DS$) + 1		'Get value of new dash number
	DS$ = LTRIM$(STR$(DSNV%))	'Make string of new dash number value

	UPSN$ = WO$ + "-" + DS$		'Set function return to new module serial number

END FUNCTION

SUB WRITEDVM (FUNC$, value!)
'       Module Name - WRITEDVM
'       Inputs -  String of commands to be sent to the meter
'       Outputs - None
'       Description - Writes a previously set up string of commands to
'       the fluke 8842A meter, through the IEEE 488 interface
	   
	CALL INIT488(DVMADDR%)
	   
	DDATA$ = FUNC$ + SETRANGE$(value!)
	BYTE% = DVMADDR% OR MLA%
	OUT (BADDRS% + 7), BYTE%        'Send byte out as data
	CALL HS1

	OUT (BADDRS% + 3), &H8A         'Request control, set operation
	OUT (BADDRS% + 3), &HB          'Remote enable, clear
	FOR X1 = 1 TO LEN(DDATA$)
		   
		BYTE% = ASC(MID$(DDATA$, X1, 1))
		OUT (BADDRS% + 7), BYTE%        'Successively send each character
		CALL HS1                        'of DDATA$ to 488 device

	NEXT X1
	OUT (BADDRS% + 7), &HD          'Send CR, tell device to execute command
	CALL HS1
	OUT (BADDRS% + 7), &HA          'Send LF
	CALL HS1
	OUT (BADDRS% + 3), &HC          'Remote enable, set operation
	OUT (BADDRS% + 3), &HA          'Clear talk only
	OUT (BADDRS% + 7), &H3F         'Un-listen
	CALL HS1

END SUB

SUB WRITEGEN (FUNC$, value!)
'       Inputs -  String of commands to be sent to the HP33120A
'       Outputs - None
'       Description - Writes a string of commands to the HP33120A
'                     function generator, through the IEEE 488 interface
'       If VALUE! = -99 then the command is a string only

	CALL INIT488(GENADDR%)
	   
	IF value! = -99 THEN
		value$ = ""             'Command contains no numerical value
	ELSEIF FUNC$ = FREQ$ AND value! = 0! THEN
		'VALUE! = .0001          'Func. gen. min output = 100uHz
		value! = .001           'Temporarily gets around layout problem,
								'modules go +f.s. out momentarily when .0001
								'Hz is applied.  Recovers in 10-30s.  .001Hz
								'reduces recovery to 1-3s.
		value$ = STR$(value!)
	ELSEIF (LEFT$(FUNC$, 3) = "FSK" OR LEFT$(FUNC$, 7) = "FREQ:ST") AND value! <= .0001 THEN
		value! = .01            'Func. gen. min FSK value = 10mHz
		value$ = STR$(value!)   'Func. gen. min sweep value = 10mHz
	ELSE
		value$ = STR$(value!)
	END IF
	   
	DDATA$ = FUNC$ + " " + value$
	   
	BYTE% = GENADDR% OR MLA%
	OUT (BADDRS% + 7), BYTE%        'Send byte out as data
	CALL HS1

	OUT (BADDRS% + 3), &H8A         'Request control, clear operation
	OUT (BADDRS% + 3), &HB          'Remote enable, clear
	FOR X1 = 1 TO LEN(DDATA$)
		BYTE% = ASC(MID$(DDATA$, X1, 1))
		OUT (BADDRS% + 7), BYTE%   'Successively send each character
		CALL HS1                   'of DDATA$ to 488 device
	NEXT X1
	OUT (BADDRS% + 7), &HD          'Send CR, tell device to execute command
	CALL HS1
	OUT (BADDRS% + 7), &HA          'Send LF
	CALL HS1
	OUT (BADDRS% + 3), &HC          'Remote enable, set operation
	OUT (BADDRS% + 3), &HA          'Clear talk only
	OUT (BADDRS% + 7), &H3F         'Un-listen
	CALL HS1
	   
END SUB

SUB WRITEPS (ADDR%, CMD$)

'       Module Name - WRITEPS
'       Inputs -  String of commands to be sent to the GPIB Power Supply
'       Outputs - None
'       Description - Writes a previously set up string of commands to
'       the KEPCO ABC125 power supply, through the IEEE 488 interface
	  
	CALL INIT488(ADDR%)
	  
	DDATA$ = CMD$     'the new KEPCO ABC125
	   
	BYTE% = ADDR% OR MLA%
	OUT (BADDRS% + 7), BYTE%        'Send byte out as data
	CALL HS1

	OUT (BADDRS% + 3), &H8A         'Request control, set operation
	CALL PAUSE(.001)   'TSO - required for the KEPCO ABC
	OUT (BADDRS% + 3), &HB          'Remote enable, clear
	   
	FOR X1 = 1 TO LEN(DDATA$)
		BYTE% = ASC(MID$(DDATA$, X1, 1))
		OUT (BADDRS% + 7), BYTE%        'Successively send each character
		CALL HS1                        'of DDATA$ to 488 device
	NEXT X1
	   
	OUT (BADDRS% + 7), &HD          'Send CR, tell device to execute command
	CALL HS1
	OUT (BADDRS% + 7), &HA          'Send LF
	CALL HS1
	OUT (BADDRS% + 3), &HC          'Remote enable, set operation
	OUT (BADDRS% + 3), &HA          'Clear talk only
	OUT (BADDRS% + 7), &H3F         'Un-listen
	CALL HS1
END SUB

'********************************************
SUB GETSN (SN$)
	'Sub to get work order number and dash number to generate serial number for module

	'Get work order number
	WO$ = GETWO$	'Get work order number from function

	'Get dash number
	DS$ = GETDS$(0, SN$)	'Get (starting) dash number from function
	
	'Create serial number from work order number and dash number
	SN$ = WO$ + "-" + DS$
	
END SUB

'********************************************
FUNCTION GETWO$
	'Function to get and return the work order number. A valid work order number has to be entered
	'twice. If the first and second valid work order numbers do not match, then they have to be
	'entered again. Once the two numbers match, the function returns the work order number. Valid
	'values for work order numbers are listed below:
	'---------------------------------------------------------------------------------------------
	'Valid work order number = 		1)	6 characters only if first character is "1"
	'									and the remaining characters are numbers
	'								2)	5 alpha-numeric characters:
	'                                   a) If the next four characters are numeric,
	'                                      the first character cannot be A through J,
	'                                      since that format is reserved for datasheet
	'                                      file names with work order numbers of six
	'                                      digits.
	'                                   b) If any of the next four characters are
	'                                      alphabetic, then there is no restriction
	'                                      on the first character.
	'								3)	1 to 4 alpha-numeric characters
	'---------------------------------------------------------------------------------------------
	CLS
	CURLOC% = 2
	WOFLAG1% = 1	'Flag = "1" to stay in inner loop waiting for valid work order number ("0" to exit loop)
	WOFLAG2% = 1	'Flag = "1" to stay in outer loop waiting for matching work order numbers ("0" to exit loop)
	LOOPNUM% = 1	'Outer loop index (for matching work order numbers)
	WO1E$ = ""		'Initialize first work order number entered
	WO2E$ = ""		'Initialize second work order number entered
	DO WHILE WOFLAG2% = 1	'Loop to match first and second work order numbers entered
		DO WHILE WOFLAG1% = 1	'Loop to get and validate work order number	
			WO$ = ""			'Initialize work order number
			'Clear entry line on loop-back
			LOCATE CURLOC% + 4, 10: PRINT "                                                                       "
			IF LOOPNUM% = 1 THEN
				LOCATE CURLOC% + 4, 10: INPUT "Enter Work Order number "; WO$
			ELSE
				LOCATE CURLOC% + 4, 10: INPUT "Enter Work Order number again "; WO$
			END IF
			WO$ = UCASE$(WO$)	'Set to upper case
			WOL% = LEN(WO$)	'Get length of work order number
			IF (WOL% > 6) THEN
				'Clear any previous warning lines
				CLS
				COLOR 28, 0, 0	'Flashing light red 
				LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
				COLOR 12, 0, 0	'Light red 
				LOCATE CURLOC% + 2, 10: PRINT "Entered: "; WO$
				LOCATE CURLOC% + 3, 10: PRINT "Must be 6 characters or less"
				COLOR 15, 0, 0	'White on black
			ELSEIF (WOL% = 6) THEN			'Six characters
				IF (LEFT$(WO$, 1) <> "1") THEN
					'Clear any previous warning lines
					CLS
					COLOR 28, 0, 0	'Flashing light red 
					LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
					COLOR 12, 0, 0	'Light red 
					LOCATE CURLOC% + 2, 10: PRINT "Entered: "; WO$
					LOCATE CURLOC% + 3, 10: PRINT "1st character can only be '1' for 6-digit entry"
					COLOR 15, 0, 0	'White on black
				ELSE	'Six characters, with 6th character = 1
					IF (ISPOSNUMBER%(WO$) = 1) THEN	'Whole entry is a positive number
						WOFLAG1% = 0		'Valid work order number, set flag to exit loop
					ELSE
						'Clear any previous warning lines
						CLS
						COLOR 28, 0, 0	'Flashing light red 
						LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
						COLOR 12, 0, 0	'Light red 
						LOCATE CURLOC% + 2, 10: PRINT "Entered: "; WO$
						LOCATE CURLOC% + 3, 10: PRINT "All digits must be numeric for 6-character entry"
						COLOR 15, 0, 0	'White on black
					END IF
				END IF
			ELSEIF (WOL% = 5) THEN			'Five characters
				WO4CHAR$ = RIGHT$(WO$, 4)	'Get last four characters
				IF (ISPOSNUMBER%(WO4CHAR$) = 1) THEN	'Last four characters are a positive number
					'Check that first character is not A through J
					WO1STCHAR$ = MID$(WO$, 1, 1)		'Get 1st character (from left)
					SELECT CASE WO1STCHAR$
						CASE "A" TO "J"
							'Clear any previous warning lines
							CLS
							COLOR 28, 0, 0	'Flashing light red 
							LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
							COLOR 12, 0, 0	'Light red 
							LOCATE CURLOC% + 2, 10: PRINT "Entered: "; WO$
							LOCATE CURLOC% + 3, 10: PRINT "With 5-character entry, 1st character cannot be A through J"
							COLOR 15, 0, 0	'White on black
						CASE ELSE
							WOFLAG1% = 0			'Valid work order number, set flag to exit loop
					END SELECT
				ELSE
					'No entry restrictions with a 5-character entry if last four
					'characters are not a positive number 
					WOFLAG1% = 0			'Valid work order number, set flag to exit loop
				END IF
			ELSEIF (WO$ = "") THEN
				'Clear any previous warning lines
				CLS
				COLOR 28, 0, 0	'Flashing light red 
				LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
				COLOR 12, 0, 0	'Light red 
				LOCATE CURLOC% + 2, 10: PRINT "Entered: <blank>"
				LOCATE CURLOC% + 3, 10: PRINT "Cannot be blank"
				COLOR 15, 0, 0	'White on black
			ELSE				'Less than 5 characters, but not blank
				WOFLAG1% = 0	'Valid work order number, set flag to exit loop
			END IF
			IF WOFLAG1% = 1 THEN
			END IF
			'List allowable values if a good entry was not found the first time through
			LOCATE CURLOC% + 5, 10: PRINT "Values allowed: up to 6 digits matching the WO#, or";
			LOCATE CURLOC% + 6, 10: PRINT "                for debug or non-production purposes:";
			LOCATE CURLOC% + 7, 10: PRINT "                4 alpha-numeric characters";
			LOCATE CURLOC% + 8, 10: PRINT "                5 characters not starting with A-J";
		LOOP	'Loop when flag = "1" (waiting for valid work order number)
		WOFLAG1% = 1	'Good work order number entered - reinitialize inner loop flag for 2nd entry
		CLS				'Good work order number entered - clear screen
		'Store valid work order numbers for comparison
		IF LOOPNUM% = 1 THEN
			WO1E$ = WO$	'Store value of first valid work order number entered
			LOOPNUM% = LOOPNUM% + 1	'Increment outer loop index
		ELSE
			WO2E$ = WO$	'Store value of second valid work order number entered
			'Compare valid work order numbers
			IF WO2E$ = WO1E$ THEN	'Matching work order numbers
				WO$ = WO1E$		'Set work order number to first valid work order number entered
				WOFLAG2% = 0	'Matching work order numbers, set flag to exit loop
			ELSE
				'Clear any previous warning lines
				CLS
				COLOR 28, 0, 0	'Flashing light red 
				LOCATE CURLOC% + 1, 10: PRINT "WORK ORDER NUMBERS ENTERED DO NOT MATCH!"
				COLOR 12, 0, 0	'Light red 
				LOCATE CURLOC% + 2, 10: PRINT "First number entered:  " + WO1E$
				LOCATE CURLOC% + 3, 10: PRINT "Second number entered: " + WO2E$
				COLOR 15, 0, 0	'White on black
				LOOPNUM% = 1	'Matching failed - reinitialize outer loop index
				WO1E$ = ""		'Matching failed - reinitialize first work order number entered
				WO2E$ = ""		'Matching failed - reinitialize second work order number entered
			END IF
		END IF
	LOOP	'Loop when flag = "1" (waiting for matching work order number)
	
	'Clear warnings
	COLOR 11, 0, 0	'Cyan on black background
	CLS

	GETWO$ = WO$	'Set function return

END FUNCTION

'********************************************
FUNCTION GETDS$(ISNEWDS%, SN$)
	'Function to get and return the dash number
	'---------------------------------------------------------------------------------------------
	'Valid dash number = 			1)	One or two characters, both numeric (but not "0")
	'								2)	Blank (defaults to "1")
	'Note:	For prototype or debug, one or two alphabetic or alphanumeric characters
	'		are also accepted for the dash number, but this is not mentioned on the
	'		screen.
	'---------------------------------------------------------------------------------------------
	CLS
	'COLOR 15, 0, 0	'White on black
	CURLOC% = 2
	DSFLAG% = 1	'Flag = "1" to stay in loop waiting for valid dash number ("0" to exit loop)
	'Loop to get and validate dash number	
	DO WHILE DSFLAG% = 1
		DS$ = ""	'Initialize dash number
		'Clear lines on loop-back
		LOCATE CURLOC% + 4, 10: PRINT "                                                                     "
		LOCATE CURLOC% + 5, 10: PRINT "                                                                     "
		IF ISNEWDS% = 1 THEN
			LOCATE CURLOC% + 4, 10: PRINT "Old serial number: "; SN$
			LOCATE CURLOC% + 5, 10: INPUT "Enter new dash number: "; DS$
		ELSE
			LOCATE CURLOC% + 5, 10: INPUT "Starting dash number (Press 'Enter' for 1) "; DS$
		END IF
		DS$ = UCASE$(DS$)	'Set to upper case
		DSL% = LEN(DS$)	'Get length of dash number
		'Validate dash number entry
		IF (DS$ = "") THEN	'Blank.
			DS$ = "1"	'Default to 1 if blank
			DSFLAG% = 0	'Valid dash number, set flag to exit loop
		ELSEIF (DSL% > 2) THEN	'More than two characters
			DSFLAG% = 1	'Bad dash number entry, remain in loop
		ELSEIF (DSL% = 1) THEN	'One character
			IF (ISALLLETTERS%(DS$) = 1) THEN	'Alphabetic character
				DSFLAG% = 0	'Valid dash number, set flag to exit loop
			ELSEIF ((VAL(DS$) > 0) AND (VAL(DS$) < 10))	THEN	'Positive number from 1 to 9
				DSFLAG% = 0	'Valid dash number, set flag to exit loop
			ELSE	'Not alphabetic or number from 1 to 9
				DSFLAG% = 1	'Bad dash number entry, remain in loop
			END IF
		ELSEIF (DSL% = 2) THEN	'Two characters
			IF (ISPOSNUMBER%(DS$) = 1) THEN	'Two-character positive number
				VALDS% = VAL(DS$)	'Get value of dash number
				IF ((VALDS% > 0) AND (VALDS% < 100)) THEN	'Two-character number from 1 to 99
					DSFLAG% = 0	'Valid dash number, set flag to exit loop
				ELSE	'Not from 1 to 99
					DSFLAG% = 1	'Bad dash number entry, remain in loop
				END IF
			ELSEIF (ISALLLETTERS%(DS$) = 1) THEN	'Two alphabetic characters
				DSFLAG% = 0	'Valid dash number, set flag to exit loop
			ELSE	'Not all alphabetic or number from 1 to 99, check for valid alphanumeric
				DSLC$ = LEFT$(DS$,1)			'Get left character	
				DSRC$ = RIGHT$(DS$,1)			'Get right character	
				'Check for valid alphanumeric dash number with first character alphabetic
				IF (ISALLLETTERS%(DSLC$) = 1) THEN	'First (left) character is alphabetic
					IF ((VAL(DSRC$) > 0) AND (VAL(DSRC$) < 10))	THEN	'Last (right) character is number from 1 to 9
						'Valid alphanumeric (left character alphabetic, right character number)
						DSFLAG% = 0	'Valid dash number, set flag to exit loop
					ELSE	'Right character not a valid number
							'Left character alphabetic, but right character not valid
							'number, so not a valid alphanumeric dash number
							DSFLAG% = 1	'Bad dash number entry, remain in loop
					END IF
				'Check for valid alphanumeric dash number with first character alphabetic
				ELSEIF (ISALLLETTERS%(DSRC$) = 1) THEN	'Last (right) character is alphabetic
					IF ((VAL(DSLC$) > 0) AND (VAL(DSLC$) < 10)) THEN	'First (left) character is number from 1 to 9
						'Valid alphanumeric (left character number, right character alphabetic)
						DSFLAG% = 0	'Valid dash number, set flag to exit loop
					ELSE	'Left character not a valid number
							'Right character alphabetic, but left character not valid
							'number, so not a valid alphanumeric dash number
							DSFLAG% = 1	'Bad dash number entry, remain in loop
					END IF
				ELSE	'Not a valid alphanumeric
					DSFLAG% = 1	'Bad dash number entry, remain in loop
				END IF
			END IF
		END IF
		'Post error text and list allowable values if a good entry was not found the first time through
		COLOR 28, 0, 0	'Flashing light red 
		LOCATE CURLOC% + 1, 10: PRINT "INVALID DASH NUMBER!"
		COLOR 12, 0, 0	'Light red 
		LOCATE CURLOC% + 2, 10: PRINT "Entered: "; DS$
		LOCATE CURLOC% + 3, 10: PRINT "Must be number between 1 and 99"
		COLOR 15, 0, 0	'White on black
		LOCATE CURLOC% + 6, 10: PRINT "Values allowed: numbers from 0 to 99 or blank for '1'";
	LOOP	'Loop when flag = "1"
	'Clear warnings and messages
	COLOR 11, 0, 0	'Cyan on black background
	CLS

	GETDS$ = DS$	'Set function return

END FUNCTION

'********************************************
FUNCTION ISPOSNUMBER% (TESTVALUE$)
	'Function that checks if the passed string is a positive number (entirely numerical)
	'or is a string (at least one non-numerical character). Returns "1" for a positive
	' number or "0" anything else
	ISPOSNUMBER% = 1 'Initialize to function return for numerical string
	N% = LEN(TESTVALUE$)	'Get length of passed string
	DO UNTIL N% = 0
		TVC$ = MID$(TESTVALUE$, N%, 1)	'Get nth character of passed string
		CHARVALUE% = ASC(TVC$)			'Get decimal ASCII code for nth character
		if((CHARVALUE% < 48) OR (CHARVALUE% > 57)) THEN
			ISPOSNUMBER% = 0	'Character not ASCII code for 0 through 9
		END IF
		N% = N% - 1
	LOOP

END FUNCTION

'********************************************
FUNCTION ISALLLETTERS% (TESTVALUE$)
	'Function that checks if the passed string is all letter characters. Returns "1" for a letter
	'or "0" anything else.
	ISALLLETTERS% = 1 'Initialize to function return for all-letter string
	N% = LEN(TESTVALUE$)	'Get length of passed string
	DO UNTIL N% = 0
		TVC$ = MID$(TESTVALUE$, N%, 1)	'Get nth character of passed string
		CHARVALUE% = ASC(TVC$)			'Get decimal ASCII code for nth character
		IF NOT (((CHARVALUE% >= 65) AND (CHARVALUE% <= 90)) OR ((CHARVALUE% >= 97) AND (CHARVALUE% <= 122))) THEN
			'If character is not within the range of uppercase letters (65 to 90 for "A" to "Z") or
			'within the range of lowercase letters (97 to 122 for "a" to "z")
			ISALLLETTERS% = 0 			'Character is not a letter
		END IF
		N% = N% - 1
	LOOP
END FUNCTION

'********************************************
SUB SNPARSE (SN$, WO$, DS$)
	'Sub to parse the module serial into work order and dash numbers
	N% = 0  'Initialize character number (char. in serial number string)
	SNL% = LEN(SN$) 'Get length of serial number
	DO  'Loop until the dash location is found
		N% = N% + 1 'Increment character number
		SNCHAR$ = MID$(SN$, N%, 1)  'Get next char. in serial number
	LOOP WHILE SNCHAR$ <> "-"       'Loop until the dash is found        
	WO$ = LEFT$(SN$, N% - 1)        'Parse work order# from serial number
	DS$ = MID$(SN$, N% + 1, SNL% - N%)  'Parse dash# from serial number
END SUB

'********************************************
SUB GETDSFNAME (SN$, DSSNAME$, DSFNAME$)
	'Sub to create and return the datasheet search name (DSSNAME$) and datasheet file name
	'(DSFNAME) as parameters from the the passed serial number string. The serial number is
	'in the form: "work order number" + "-" "dash number" (for example: "12345-1"). The Sub
	'parses out the work order number from the serial number, checks its validity, and
	'modifies valid six-character work order numbers to create specially coded five-character
	'work order numbers as described below. The modified or unmodified work order numbers then
	'become part of the datasheet search and file names.
	'---------------------------------------------------------------------------------------------
	'The datasheet search and file names produced depend on the parsed work order number as shown
	'below:
	'  1)	If the work order number is 5 characters or less, then the datasheet file name is
	'		"work order #" + "-" + "dash #" + ".TXT" and the search name is "work order #".
	'		For example, if the serial number is "12345-1":
	'		Datasheet file name =   "12345-1.TXT"
	'		Datasheet search name =	"12345"
	'  2)	If the work order number is 6 characters with the first two characters from "10"
	'		to "19" then convert the first two characters to "A" from "10" up to "J" for "19".
	'		Then the datasheet file name is "modified work order #" + "-" "dash #" + ".TXT"
	'		and the datasheet search name is "modified work order #".
	'		For example, if the serial number is "123456-1":
	'		Datasheet file name =   "C3456-1.TXT"
	'		Datasheet search name =	"C3456"
	' 3)	If the work order number is invalid (blank, more than six characters, six characters
	'		with the first two characters not a number from "10" to "19" inclusive), then the
	'		datasheet file name is "BAD" + "-" + "dash #" + ".TXT" and the datasheet search name
	'		is "BAD".
	'		For example, if the serial number is "223456-1":
	'		Datasheet file name =   "BAD-1.TXT"
	'		Datasheet search name =	"BAD"
	'---------------------------------------------------------------------------------------------
	CALL SNPARSE(SN$, WO$, DS$)	'Parse work order number and dash number from serial number
	LWO% = LEN(WO$)	'Get length of work order number
	IF WO$ = "" THEN
		'Work order is blank
		CLS
		CURLOC% = 2
		COLOR 28, 0, 0	'Flashing light red 
		LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
		COLOR 12, 0, 0	'Light red 
		LOCATE CURLOC% + 2, 10: PRINT "Work order number is: "; "<blank>"
		LOCATE CURLOC% + 3, 10: PRINT "Valid datasheet file name cannot be created!"
		LOCATE CURLOC% + 4, 10: PRINT "Contact Engineering!"
		COLOR 15, 0, 0	'White on black
		DSFNAME$ = "BAD" + "-" + DS$ + ".TXT"	'Create "bad" datasheet file name.
		DSSNAME$ = "BAD"						'Create "bad" datasheet search name.
	ELSEIF LWO% > 6 THEN
		'Work order more than six characters
		CLS
		CURLOC% = 2
		COLOR 28, 0, 0	'Flashing light red 
		LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
		COLOR 12, 0, 0	'Light red 
		LOCATE CURLOC% + 2, 10: PRINT "Work order number is more than six characters: "; WO$
		LOCATE CURLOC% + 3, 10: PRINT "Valid datasheet file name cannot be created!"
		LOCATE CURLOC% + 4, 10: PRINT "Contact Engineering!"
		COLOR 15, 0, 0	'White on black
		DSFNAME$ = "BAD" + "-" + DS$ + ".TXT"	'Create "bad" datasheet file name.
		DSSNAME$ = "BAD"						'Create "bad" datasheet search name.
	ELSEIF LWO% = 6 THEN
		'Work order is six characters long
		VALLEFT2% = VAL(LEFT$(WO$, 2))	'Get numerical value of left two characters in work order number
		IF ((VALLEFT2% < 10) OR (VALLEFT2% > 19)) THEN
			'Value of left two characters are not between 10 to 19 (including the two endpoints)
			CLS
			CURLOC% = 2
			COLOR 28, 0, 0	'Flashing light red 
			LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
			COLOR 12, 0, 0	'Light red 
			LOCATE CURLOC% + 2, 10: PRINT "1st and 2nd digits or work order # must be '10' to '19': "; WO$
			LOCATE CURLOC% + 3, 10: PRINT "Valid datasheet file name cannot be created!"
			LOCATE CURLOC% + 4, 10: PRINT "Contact Engineering!"
			COLOR 15, 0, 0	'White on black
			DSFNAME$ = "BAD" + "-" + DS$ + ".TXT"	'Create "bad" datasheet file name.
			DSSNAME$ = "BAD"						'Create "bad" datasheet search name.
		ELSE
			'Six character work order number with valid first two characters
			SELECT CASE VALLEFT2%
				CASE 10
					WO1$ = "A"	'Single alpha for the two-character value
				CASE 11
					WO1$ = "B"	'Single alpha for the two-character value
				CASE 12
					WO1$ = "C"	'Single alpha for the two-character value
				CASE 13
					WO1$ = "D"	'Single alpha for the two-character value
				CASE 14
					WO1$ = "E"	'Single alpha for the two-character value
				CASE 15
					WO1$ = "F"	'Single alpha for the two-character value
				CASE 16
					WO1$ = "G"	'Single alpha for the two-character value
				CASE 17
					WO1$ = "H"	'Single alpha for the two-character value
				CASE 18
					WO1$ = "I"	'Single alpha for the two-character value
				CASE ELSE
					'Value of "19" (already checked that value in "10" to "19" range)
					WO1$ = "J"	'Single alpha for the two-character value
			END SELECT
			WONXT4$ = RIGHT$(WO$, 4)	'Get the last for characters of the work order number
			'Create datasheet file name from the new 1st character and then the next 4 characters
			'of the six-character work order number, then using the dash number
			'Create "good" datasheet file and search names from modified work order#.
			DSFNAME$ = WO1$ + WONXT4$ + "-" + DS$ + ".TXT"
			DSSNAME$ = WO1$ + WONXT4$
		END IF
	ELSE	'Work order number is 5 characters of less (but not blank)
		'Create "good" datasheet file and search names from unmodified work order#.
		DSFNAME$ = WO$ + "-" + DS$ + ".TXT"
		DSSNAME$ = WO$
	END IF
END SUB

'********************************************
FUNCTION GETWOSFNAME$ (SN$)
	'Function to create and return the work order status file name from
	'the passed serial number string
	'---------------------------------------------------------------------------------------------
	'Valid work order file name =	1)	If work order number is 6 characters or less, then
	'									"work order #" + ".TXT"
	'								2)	"BAD" + ".TXT" for error cases (work order number
	'									more than 6 characters or blank.
	'---------------------------------------------------------------------------------------------
	CALL SNPARSE(SN$, WO$, DS$)
	LWO% = LEN(WO$)	'Get length of work order number
	IF WO$ = "" THEN
		'Work order is blank
		CLS
		CURLOC% = 2
		'Clear any previous warning lines
		COLOR 28, 0, 0	'Flashing light red 
		LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
		COLOR 12, 0, 0	'Light red 
		LOCATE CURLOC% + 2, 10: PRINT "Work order number is: "; "<blank>"
		LOCATE CURLOC% + 3, 10: PRINT "Valid work order status file name cannot be created!"
		LOCATE CURLOC% + 4, 10: PRINT "Contact Engineering!"
		COLOR 15, 0, 0	'White on black
		GETWOSFNAME$ = "BAD" + ".TXT"	'Create "bad" work order status file name.
	ELSEIF LWO% > 6 THEN
		'Work order more than six characters
		CLS
		CURLOC% = 2
		'Clear any previous warning lines
		COLOR 28, 0, 0	'Flashing light red 
		LOCATE CURLOC% + 1, 10: PRINT "INVALID WORK ORDER NUMBER!"
		COLOR 12, 0, 0	'Light red 
		LOCATE CURLOC% + 2, 10: PRINT "Work order number is more than six characters: "; WO$
		LOCATE CURLOC% + 3, 10: PRINT "Valid work order status file name cannot be created!"
		LOCATE CURLOC% + 4, 10: PRINT "Contact Engineering!"
		COLOR 15, 0, 0	'White on black
		GETWOSFNAME$ = "BAD" + ".TXT"	'Create "bad" work order status file name.
	ELSE
		'Work order number is 6 characters of less (but not blank)
		GETWOSFNAME$ = WO$ + ".TXT"		'Create work order status file name directly from wo#.
	END IF
END FUNCTION


