Attribute VB_Name = "Module1"
'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       REV     APPR    DESCRIPTION
'----       ---     ----    -----------
'10/5/95    n/a     JL      Initial Release.
' ...
' ...                       See "Revs.txt" file.
' ...
'2015/05/29 B.08    PWR     Revised CuRTD polynomial and inverse polynomial to allow 2% bounds (from 1%).
'
'02/08/19                   MR    Added NI50, 50 Ohm at 75F Nickel RTD

Const LIBVERSION$ = "B.09 2019.02.08 MR"       'Version (Revision Date) and initials of engr.
 
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%, VRANGE!, VSENATTEN!)     'Set DAC voltage
DECLARE SUB SETDAC2 (VOLTAGE!, CH%, VRANGE!, 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
DECLARE FUNCTION LIBVERVAL$ ()                  'Function to return the library source file version
DECLARE SUB FINISHSUB ()                    'Subroutine to run at "FINISH" label (after F10 keypress).

                                                                                                
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$
COMMON SHARED TTYPE%, MAXINVAR!

'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:
        Call FINISHSUB
        End 'End of program

'******** 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, 50.381187815, 0.03047583693, -0.00008568106572, 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, 296456.25681, -1497.6127786, 3.1787103924, -0.0031847686701, 1.5720819004E-06
                        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, 39.450128025, 0.023622373598, -0.00032858906784, -4.9904828777E-06
                        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, -17.600413686, 38.921204975, 0.018558770032, -0.000099457592874
                        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, 38.748106364, 0.044194434347, 0.00011844323105, 0.000020032973554
                        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.079553927E-21, 1.3945027062E-24, 7.9795153927E-28, 0
'Type T TC polynomial   0C TO +400C
TYPETPOS:   Data 0, 402, 0, 38.748106364, 0.03329222788, 0.00020618243404, -2.1882256846E-06
                        Data 1.0996880928E-08, -3.0815758772E-11, 4.547913529E-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, 58.665508708, 0.04541098, -0.0007799805, -0.00002580016
                        Data -0.0000005945258, -0.000000009321406, -1.028761E-10, -8.037012E-13
                        Data -4.39795E-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, 58.66550871, 0.04503228, 0.00002890841, -0.000000330569
                        Data 0.000000000650244, -1.91975E-13, -1.25366E-15, 2.148922E-18
                        Data -1.438804E-21, 3.59609E-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, 0.01391666, -0.00002388557, 0.0000000356916
                        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, 2951.57925316, -2.52061251332, 0.01595645, -0.00000764086
                        Data 0.000000002053053, -2.933597E-13, 0
'Type R TC polynomial   +1664.5C TO +1768.1C
TYPER3:     Data 1664.5, 1770.1, 152232.118209, -268.819888545, 0.1712803, -0.00003458957
                        Data -9.34634E-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, 0.01259343, -0.0000232478, 0.00000003220288
                        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, 1329.00444085, 3.34509311344, 0.006548052, -0.000001648563
                        Data 1.299896E-11, 0
'Type S TC polynomial   +1664.5C TO +1768.1C
TYPES3:     Data 1664.5, 1770.1, 146628.232636, -258.430516752, 0.1636936, -0.0000330439
                        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, -0.2465081, 0.005904042, -0.000001325793, 0.000000001566829
                        Data -1.694453E-12, 6.299035E-16, 0
'Type B TC polynomial   630.615C TO +1820C
TYPEB2:     Data 630.615, 1822, -3893.8168621, 28.57174747, -0.08488511, 0.0001578528, -0.0000001683535
                        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, 7.190027, 0.003956443, -0.000001842722
                        Data 3.471851E-10, -2.616792E-14, 0
   
'Type N TC polynomial  -270C to 0C
TYPENNEG:   Data -272, 0, 0, 26.159105962, 0.01095748, -0.00009384111, -0.00000004641204
                        Data -0.000000002630336, -2.265344E-11, -7.60893E-14, -9.341967E-17, 0
'Type N TC polynomial   0C to +1300C
TYPENPOS:   Data 0, 1302, 0, 25.929394601, 0.01571014, 0.00004382563, -0.0000002526117
                        Data 6.431182E-10, -1.006347E-12, 9.974534E-16, -6.086325E-19
                        Data 2.084923E-22, -3.06822E-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, 0.01952827, -0.000001228619, -0.000000001075218, -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, 0.01978425, -0.0000002001204, 1.036969E-11, -2.549687E-16
                        Data 3.585153E-21, -5.344285E-26, 5.09989E-31, 0
'Type J TC INVERSE polynomial +760C to +1200C, -0.04C to +0.03C accurate
'42919uV to +69593uV
INVJ3:      Data 42919, 69653, -3113.58187, 0.3005437, -0.000009947732, 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, 0.02517346, -0.000001166288, -0.000000001083364, -8.977354E-13
                        Data -3.734238E-16, -8.663264E-20, -1.04506E-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, 0.02508355, 0.00000007860106, -2.503131E-10, 8.31527E-14
                        Data -1.228034E-17, 9.804036E-22, -4.41303E-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, -131.8058, 0.04830222, -0.000001646031, 5.464731E-11, -9.650715E-16
                        Data 8.802193E-21, -3.11081E-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, 0.02594919, -0.0000002131697, 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, 0.025928, -0.0000007602961, 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, 0.016977288, -0.0000004351497, -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, 0.01705704, -0.0000002330176, 6.543559E-12, -7.356275E-17
                        Data -1.7896E-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, 0.1889138, -0.00009383529, 0.0000001306862, -2.270358E-10
                        Data 3.514566E-13, -3.89539E-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, 13.34585, 0.1472645, -0.00001844025, 0.00000000403113, -6.249428E-13
                        Data 6.468412E-17, -4.45875E-21, 1.99471E-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, -81.99599, 0.1553962, -0.000008342198, 4.279434E-10
                        Data -1.191578E-14, 1.49229E-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, 34061.78, -7.023729, 0.0005582904, -0.00000001952395
                        Data 2.56074E-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, 0.1849495, -0.00008005041, 0.0000001022374, -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, 12.91507, 0.1466299, -0.00001534713, 0.000000003145946
                        Data -4.163258E-13, 3.187964E-17, -1.291638E-21, 2.183475E-26
                        Data -1.47738E-31, 8.211272E-36, 0
'Type S TC INVERSE polynomial +1064C to +1664.5C, +/-0.0002C accurate
'10332uV to 17536uV
INVS3:      Data 10332, 17536, -80.87801, 0.1621573, -0.000008536869, 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, 53338.75, -12.35892, 0.001092658, -0.00000004265694
                        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.9664852585855, 4.17611917690301
                        Data -0.36363063524752, 0.04062282514548, -0.00327375413268
                        Data 0.00016908870534, -0.00000526545664, 0.00000008960324, -0.00000000063806, 0
'Type B TC INVERSE polynomial +100C to +150C, MATLAB calculated.
'+33.2uV to +92.06uV
INVB2:      Data 33.2, 92.06, 50.885274757731, 2.00987431811108
                        Data -0.02203802052765, 0.00022299977771, -0.00000133317504
                        Data 0.00000000342225, 0
'Type B TC INVERSE polynomial +150C to +200C, MATLAB calculated.
'+92.06uV to 178.26uV
INVB3:      Data 92.06, 178.26, 64.970832553974, 1.2502025062851
                        Data -0.00469901536023, 0.00001427652212, -0.0000000191953, 0
'Type B TC INVERSE polynomial +200C to +250C, MATLAB calculated.
'+178.26uV to 291.28uV
INVB4:      Data 178.26, 291.28, 75.7085787280323, 0.98679299982849
                        Data -0.00225934986745, 0.00000416854466, -0.00000000339906, 0
'Type B TC INVERSE polynomial +250C to +700C, -0.02C to +0.03C accurate
'291uV to 2431uV
INVB5:      Data 291.28, 2431, 98.42332, 0.699715, -0.000847653
                        Data 0.000001005264, -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, 213.1507, 0.285105, -0.00005274289, 0.00000000991608
                        Data -1.29653E-12, 1.119587E-16, -6.06252E-21, 1.86617E-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, -0.00000767462, 0.0000000008891
                        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, -0.00000216715, 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, -0.00143581, 0.0000000454959
                        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, 0.03843685, 0.000001101049, 0.000000005222931, 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, 0.03878328, -0.000001161234, 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, 0.39083, -0.00005775, 0.00000004183, -0.0000000004183, 0
'Type Pt RTD polynomial 0C to +850C
TYPEPTPOS:  Data 0, 851, 100, 0.39083, -0.00005775, 0

'Type E1 Pt100 (Rosemount) RTD polynomial 0C to +370C; accuracy better than +/-0.01%
TYPEE1PT100:    Data -1, 371, 100, 0.39486, -0.0000581579, 0

'Type Pt100 RTD polynomial -200C to 0C.  Alpha = 0.00392
TYPEPT392NEG:   Data -201, 0, 100, 0.39848, -0.0000587, 0.00000004, -0.0000000004, 0
'Type Pt100 RTD polynomial 0C to +630C  Alfa = 0.00392
TYPEPT392POS:   Data 0, 631, 100, 0.39848, -0.0000587, 0
           
'Type Ni RTD polynomial 0C to +150C; accuracy better than +/-0.01%
TYPENI1:    Data -1, 150, 120, 0.7086472, 0.0008145844, 0.000003004712, -0.00000001804135
                        Data 4.379183E-11, 0
'Type Ni RTD polynomial +150C to +300C; accuracy better than +/-0.013%
TYPENI2:    Data 150, 301, 95.06276, 1.243133, -0.003164436, 0.00001339464, -0.00000001301027, 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
'Updated PWR 2015-05-29
TYPECU:     Data -2, 192, 9.035, 0.03865188, -0.0000009702684, 0.000000009564953, -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, 0.0004086852, 0.0000009321948, -0.000000005017392, 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, -0.001024307, 0.000005189308, -0.000000005295223, 0

        'Type 50 Ohm at 75F Ni RTD polynomial -60C to +150C; Polynomials created from Table Vishay TN-506-3
TYPENI50:  Data -60, 150, 43.78743239, 0.2538277596, 0.0002663627284, 9.264565362E-08, 7.262789981E-10
                Data 5.652904273E-12, -2.20910324E-14, 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, -242.02, 2.2228, 0.0025859, -0.000004826, -0.000000028183, 0.00000000015243, 0
           
'Type Pt RTD INVERSE polynomial 0C to +850C; +/-0.005% accuracy
'100 ohms to 345.13 ohms
INVPTPOS:   Data 100, 390.26, 0, 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, 0.000000931902, 0
           
'Type Pt392 RTD INVERSE polynomial -200C to 0C; +/-0.006% accuracy
'16.996 ohms to 100 ohms
INVPT392NEG:    Data 15.996, 100, -238.09, 2.2032, 0.0023, -0.000005, 0
'Type Pt392 RTD INVERSE polynomial 0C to +630C; +/-0.005% accuracy
'100 ohms to 327.744 ohms
INVPT392POS:    Data 100, 328.744, -243.932, 2.37547, 0.000522608, 0.00000111348, 0
           
'Type Ni RTD INVERSE polynomial 0C to +150C; +/-0.006% accuracy
'120 ohms to 248.95 ohms
INVNI1:     Data 119, 248.95, -221.08, 2.394604, -0.005785688, 0.00001097436, -0.000000009322357, 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, -179.0702, 1.666061, -0.001307243, -0.0000006926585, 0.000000001559142, 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
'Updated PWR 2015-05-29
'INVCU:      DATA 8.9, 16.5, -2.415982E2, 2.882270E1, -4.163392E-1, 2.598613E-2, -5.999452E-4, 0
INVCU:      Data 8.8, 16.6, -241.5982, 28.8227, -0.4163392, 0.02598613, -0.0005999452, 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, -474.928, 9.28092, -0.0710136, 0.000383725, -0.00000112616, 0.00000000133984, 0

        'Type 50 Ohm at 75F Ni RTD polynomial -60C to +150C; Polynomials created from Table Vishay TN-506-3
        '29.5 Ohms to 88.71 Ohms
INVNI50:  Data 29.5, 88.71, -220.7334849, 6.760139867, -0.05982731918, 0.0006456926033, -0.000004696053099
                Data 1.598365447E-08, -1.211366077E-11, 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

Sub CALDAC(TE$)
        'Calibrates the DAC to make sure it will swing at least +/- 9.2V
        '
        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$, 0.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! > -0.005 And ITER3% < 10

        Do
                ITER4% = ITER4% + 1
                Call LOADDAC(0, VERN%)          'Sets vernier DAC at 5mV DC
                VERNMAX! = READDVM!(0!)
        Loop While VERNMAX! < 0.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 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

'********************************************
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

'********************************************
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 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            Parallel 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(0.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(0.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

'********************************************
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 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

Sub HS1()
        'GPIB "handshake:       waits for the last instruction to be sent then
        '                   checks bit #4 for "True".
        CNT = 0
        CNTR = 50000  'Loop exit count. 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%)
        'Initializes the IEEE488 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!)
        'Initializes the Kepco power supply (either model).
        '
        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
                '******* Initialize KEPCO ABC Power Supply
                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

                '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 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

'********************************************
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 KEYBDIN$()
        Do
                X$ = INKEY$
        Loop While X$ = ""
        KEYBDIN$ = X$
End Function

Function LIBVERVAL$()
        'Function to return the library source file version
        LIBVERVAL$ = LIBVERSION$
End Function

Sub LOADDAC(BINDATA%, DAC%)
'       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.
'
        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(0.01)                'Waits for data to stabilize
                OUT (LPTADDR% + 2), &HD         'S/ line low
                Call PAUSE(0.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(0.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.9     'Initialize current measurement
        ITERATION% = 0  'Initialize loop number (iteration) to zero
        MAXLOOPS% = 20  'Initialize maximum number of loops (iterations) to 20
        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(0.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

                'Changes made to measurement loop exit criteria to account
                'for overrange measurements: 2014/03/04 PWR
                If (Abs(M2!) > 10000000#) Then
                        'An overrange value is measured. The meter is set
                        'to autorange. The only exit while in overrange
                        'is when the maximum number of iterations has been
                        'reached (see the loop-exit criteria at the end of
                        'the loop).
                        Call WRITEDVM(VODC$, 2000!) 'Autorange meter
                Else
                        'No overrange. Three valid exits (accomplished by
                        'letting the iterations reach the maximum allowed
                        'or setting the iteration to the max. allowed):
                        '1) The difference between the last two measurements are within the
                        '   measurement tolerance passed to the function.
                        '2) The passed measurement tolerance is zero, calling for only a single
                        '   measurement.
                        '3) The measurements have not matched to the tolerance, but the
                        '   maximum number if iterations has been reached (see the
                        '   loop-exit criteria at the end of the loop).
                        If (Abs(M2! - M1!) <= TOL!) Then
                                'If the difference between the last two measurements are within the measurement
                                'tolerance passed to the function, accept the last measurement.
                                ITERATION% = MAXLOOPS%  'Set the iteration to exit the loop
                        End If

                        If (TOL! = 0!) Then
                                'The passed tolerance is zero, calling for a single measurement. The
                                'loop exits and the current measurement (M2) is used.
                                ITERATION% = MAXLOOPS%  'Set the iteration to exit the loop
                        End If
                        
                End If
        
        'If the measurement has not settled in 20 readings due to noise or
        'module malfunction, accept 20th reading and continue.
        Loop While (ITERATION% < MAXLOOPS%)

        'Previous code:
           '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!

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! = 0.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(0.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(0.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(0.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! = 0.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(0.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(0.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 "; RTrim$(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 "; RTrim$(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
                LOCATE 3, 23: Print N$; " NEXT MODULE TEST OPTIONS"
                LOCATE 4, 23: Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
                Color 15, 0, 0
                LOCATE 6, 10: Print "Please select the desired option for the next module to test:"
                Color 11, 0, 0
                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
        '                                N2 = 50 Ohm at 75 F NNICKEL 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
        ElseIf ST$ = "N2" Then   '50 ohm Nickel RTD
                RESTORE TYPENI50                          '50 ohms @ 75F
                T2! = TEMP!
        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! = 0.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
        '                                N2 = 50 Ohm at 75F 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                   'Coefficient set to zero
                        T! = (-0.0039083 + (0.00001758480889 - 0.0000000231 * OHMS!) ^ 0.5) / (-0.000001155)
                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

        ElseIf ST$ = "N2" Then    '50 Ohm Nickel RTD
                RESTORE INVNI50
   
        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
        Color 11, 0 'Text color to bright cyan (blue) on black  'PWR 2014-04-10
        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! = 0.15                     '15% initial tolerance
                        MEASTOL! = 0.005                    '0.5% measurement tolerance
                Else
                        INITTOL! = 0.05                     '5% initial tolerance
                        MEASTOL! = 0.0005                   '0.05% measurement tolerance
                End If
   
                TEMP! = READDVM!(MEASTOL! * OHMS!)      'Measure resistor value to tolerance
  
                Print Tab(15); USING; " ##         #######        ########.###      "; E%; OHMS!; TEMP!; 'PWR 2014-04-10
                If Abs(TEMP! - OHMS!) > (OHMS! * INITTOL!) Then   'Test for 15% deviation
                        Color 12, 0 'Text color to bright red on black  'PWR 2014-04-10
                        OHMSTAT$ = "FAIL"
                        OHMFAIL% = OHMFAIL% + 1
                Else
                        Color 10, 0 'Text color to light green on black 'PWR 2014-04-10
                        OHMSTAT$ = "PASS"
                End If

                '                      1    2         3         4         5         6         7
                '                      56789012345678901234567890123456789012345678901234567890
                'PRINT TAB(15); USING " ##         #######        ########.###      &"; E%; OHMS!; TEMP!; OHMSTAT$
                Print Tab(60); OHMSTAT$
                Color 11, 0 'Text color to bright cyan (blue) on black  'PWR 2014-04-10


                Call LOADMUX(0, CON%)                           'Clears mux

                If Left$(CRSTAT$, 4) = "FAIL" Then
                        LPRINT TAB(10); USING "SERIES RELAY CONTACT RESISTANCE FAILURE AT #.#### OHMS"; CONTRES!
                        LPRINT
                        LPRINT Chr$(12) 'Page feed
                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
        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
                        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! = 0.005                    '0.5% measurement tolerance
                                Else
                                        MEASTOL! = 0.0005                   '0.05% measurement tolerance
                                End If
                        End If
                  
                        Call PAUSE(0.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! = 0.5            '%
                        Else
                                DRIFTSPEC! = 0.05           '%
                        End If
                        
                        Print Tab(8); USING; "  ##        #######        #####.###          ###.#         "; E%; RES!(N%); DRIFTPERC!; ELAP!; 'PWR 2014-04-10
                        If Abs(DRIFTPERC!) > DRIFTSPEC! Then
                                Color 12, 0 'Text color to bright red on black  'PWR 2014-04-10
                                DFTFAIL% = DFTFAIL% + 1
                                DRIFTSTAT$ = "FAIL"
                        Else
                                Color 10, 0 'Text color to light green on black 'PWR 2014-04-10
                                DRIFTSTAT$ = "PASS"
                        End If

                        '                       1         2         3         4         5         6         7
                        '                     890123456789012345678901234567890123456789012345678901234567890
                        'PRINT TAB(8); USING "  ##        #######        #####.###          ###.#         &"; E%; RES!(N%); DRIFTPERC!; ELAP!; DRIFTSTAT$
                        Print Tab(68); DRIFTSTAT$   'PWR 2014-04-10
                        Color 11, 0 'Text color to bright cyan (blue) on black  'PWR 2014-04-10
                   
                        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(0.2)

        'CALL CONTINUE
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%, VRANGE!, VSENATTEN!)
        'Sub to set DAC for module input.
        '   VOLTAGE!:   Voltage to set, and returned measured voltage.
        '   CH%:        Measurement channel.
        '   VRANGE!:    Voltage range. Also used in calculating set/meas. servo loop tolerance.
        '               When VRANGE! = 0, loop exit on maximum count is ignored.
        '   VSENATTEN!: Used to set type of DUT input (voltage, current, source of current).
        '
        'NOTES:
        'Main DAC = 12 bits,  vernier DAC = 12 bits, vernier overlap is approximately 4 bits,
        'total DAC effective resolution is approx. 20 bits (+/-10V / 2^20 = 19uV).
        'R/2R ladder attenuation is 512 max. so max. DUT input voltage resolution is 29 bits or 37nV.
        '
        'For voltages greater than DAC range, use an external high voltage power supply (Kepco DPS 125-0.5M)
        '
        If Abs(VOLTAGE!) < 0.00001 Then             'DAC limitation
                'Short to ground instead of input from DAC.
                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%)

                'Control how the DVM range is set. If VRANGE! is zero, use the
                'passed voltage (as it was before), otherwise use the passed
                'voltage range (PWR: 2014-10-29).
                If (VRANGE! <> 0!) Then
                        Call WRITEDVM(VODC$, VRANGE!)   'Set DVM range from passed VRANGE! value.
                Else
                        Call WRITEDVM(VODC$, VOLTAGE!)  'Set DVM range from passed VOLTAGE! value.
                End If
                
                '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%)
                   
                ACCURAY! = 0.001

                'CALL WRITEDVM(VODC$, VOLTAGE!)
                
                'Control how the DVM range is set. If VRANGE! is zero, use the
                'passed voltage (as it was before), otherwise use the passed
                'voltage range (PWR: 2014-10-29).
                If (VRANGE! <> 0!) Then
                        Call WRITEDVM(VODC$, VRANGE!)   'Set DVM range from passed VRANGE! value.
                Else
                        Call WRITEDVM(VODC$, VOLTAGE!)  'Set DVM range from passed VOLTAGE! value.
                End If

                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! + 0.1) / ATTEN!
                ElseIf MAINBIT% < 0 Then
                        MAINBIT% = 0
                        VOLTAGE! = (MAINMAX! - 0.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!
                        Else
                                Exit Do
                        End If
                'LOOP WHILE ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) AND ITERATION% < 20
                Loop While ITERATION% < 20

                'IF ITERATION% >= 20 THEN
                If ITERATION% >= 20 And (VRANGE! <> 0!) Then
                        Print Spc(50);
                        Print Tab(10); "SETDAC main loop."
                        Print Tab(10); "Problem setting main input DAC."
                        Print Tab(10); "Check for faulty test head connection or"
                        Print Tab(10); "current-input module not installed in test"
                        Print Tab(10); "socket. Otherwise, please notify engineering."
                        Call CONTINUE
                        Call FINISHSUB
                        End
                End If

                ITERATION% = 0
                LIMIT = 0
        
                'CALL PAUSE(.01)
                VMEAS! = READDVM!(0!)
           
                Do
                        ITERATION% = ITERATION% + 1
                        ADJUST! = VMEAS! - VOLTAGE!

                        'Control how the DAC tolerance is calculated. If VRANGE! is zero, use the
                        'passed voltage times the desired accuracy (as it was before), otherwise
                        'use the passed voltage range times the desired accuracy (PWR: 2014-10-29).
                        If (VRANGE! <> 0!) Then
                                DACTOL! = Abs(ACCURAY! * VOLTAGE!)
                        Else
                                DACTOL! = Abs(ACCURAY! * VRANGE!)
                        End If
                        If Abs(ADJUST!) > DACTOL! Then
                        'IF ABS(ADJUST!) > ABS(ACCURAY! * VOLTAGE!) THEN    'Original statement.
                                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% >= 20 THEN
                If ITERATION% >= 20 And (VRANGE! <> 0!) Then
                        Beep
                        Print Spc(50);
                        Print Tab(10); "SETDAC vernier loop."
                        Print Tab(10); "Unable to find required voltage."
                        Print Tab(10); "Error = "; ADJUST!
                        Print Tab(10); "Limit = "; DACTOL!
                        Print Tab(10); "Please notify engineering."
                        Call CONTINUE
                        Call FINISHSUB
                        End
                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 &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%, VRANGE!, VSENATTEN!)
        'Sub to set DAC for module input. Similar to SETDAC routine but with controlbank values
        'for voltage and current output module testheads.
        '   VOLTAGE!:   Voltage to set, and returned measured voltage.
        '   CH%:        Measurement channel.
        '   VRANGE!:    Voltage range. Also used in calculating set/meas. servo loop tolerance.
        '               When VRANGE! = 0, loop exit on maximum count is ignored.
        '   VSENATTEN!: Used to set type of DUT input (voltage, current, source of current).
        '
        'NOTES:
        'Main DAC = 12 bits,  vernier DAC = 12 bits, vernier overlap is approximately 4 bits,
        'total DAC effective resolution is approx. 20 bits (+/-10V / 2^20 = 19uV).
        '
        'For voltages greater than DAC range, use an external high voltage power supply (Kepco DPS 125-0.5M)
        '
        'IF ABS(VOLTAGE!) <= 10.1 THEN                   'Check if within DAC range
        If Abs(VOLTAGE!) <= 10! 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.
                        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%)
                 
                ACCURAY! = 0.001

                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! + 0.1) / ATTEN!
                ElseIf MAINBIT% < 0 Then
                        MAINBIT% = 0
                        VOLTAGE! = (MAINMAX! - 0.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!
                        Else
                                Exit Do
                        End If
                'LOOP WHILE ABS(ATTENERR!) > ABS(VERNMIN! / ATTEN!) AND ITERATION% < 20
                Loop While ITERATION% < 20
          
                'IF ITERATION% >= 20 THEN
                If ITERATION% >= 20 And (VRANGE! <> 0!) Then
                        Beep
                        Print Spc(50);
                        Print Tab(10); "SETDAC main loop."
                        Print Tab(10); "Problem setting main input DAC."
                        Print Tab(10); "Check for faulty test head connection or"
                        Print Tab(10); "current-input module not installed in test"
                        Print Tab(10); "socket. Otherwise, please notify engineering."
                        Call CONTINUE
                        Call FINISHSUB
                        End
                End If

                ITERATION% = 0
                LIMIT = 0
                Do
                        ITERATION% = ITERATION% + 1
                        'CALL PAUSE(.01)
                        VMEAS! = READDVM!(0!)
                        ADJUST! = VMEAS! - VOLTAGE!

                        'Control how the DAC tolerance is calculated. If VRANGE! is zero, use the
                        'passed voltage times the desired accuracy (as it was before), otherwise
                        'use the passed voltage range times the desired accuracy (PWR: 2014-10-29).
                        If (VRANGE! <> 0!) Then
                                DACTOL! = Abs(ACCURAY! * VOLTAGE!)
                        Else
                                DACTOL! = Abs(ACCURAY! * VRANGE!)
                        End If
                        If Abs(ADJUST!) > DACTOL! Then
                        'IF ABS(ADJUST!) > ABS(ACCURAY! * VOLTAGE!) THEN    'Original statement.
                                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% >= 20 THEN
                If ITERATION% >= 20 And (VRANGE! <> 0!) Then
                        Beep
                        Print Spc(50);
                        Print Tab(10); "SETDAC2 vernier loop."
                        Print Tab(10); "Unable to find required voltage."
                        Print Tab(10); "Error = "; ADJUST!
                        Print Tab(10); "Limit = "; DACTOL!
                        Print Tab(10); "Please notify engineering."
                        Call CONTINUE
                        Call FINISHSUB
                        End
                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, zeroes 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, 0.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(0.2)                       '200ms over-current protection. 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, 0.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 protection 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!) <= 0.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(0.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(0.01)                        'Test head would not process command 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(0.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(0.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

'********************************************
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

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! < 0.042919 Then
                        RESTORE INVJ2
                Else
                        RESTORE INVJ3
                End If
        ElseIf UCase$(Left$(SENTYPE$, 1)) = "K" Then
                If TCV! < 0 Then
                        RESTORE INVK1
                ElseIf TCV! < 0.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! < 0.001923 Then
                        RESTORE INVR1
                ElseIf TCV! < 0.011361 Then
                        RESTORE INVR2
                ElseIf TCV! < 0.019739 Then
                        RESTORE INVR3
                Else
                        RESTORE INVR4
                End If
        ElseIf UCase$(Left$(SENTYPE$, 1)) = "S" Then
                If TCV! < 0.001874 Then
                        RESTORE INVS1
                ElseIf TCV! < 0.010332 Then
                        RESTORE INVS2
                ElseIf TCV! < 0.017536 Then
                        RESTORE INVS3
                Else
                        RESTORE INVS4
                End If
        ElseIf UCase$(Left$(SENTYPE$, 1)) = "B" Then
                If TCV! < 0.00000228 Then
                        RESTORE INVB0
                ElseIf TCV! < 0.0000332 Then
                        RESTORE INVB1
                ElseIf TCV! < 0.00009206 Then
                        RESTORE INVB2
                ElseIf TCV! < 0.00017826 Then
                        RESTORE INVB3
                ElseIf TCV! < 0.00029128 Then
                        RESTORE INVB4
                ElseIf TCV! < 0.002431 Then
                        RESTORE INVB5
                Else
                        RESTORE INVB6
                End If
   
        ElseIf UCase$(Left$(SENTYPE$, 1)) = "C" Then
           If TCV! < 0.009395 Then
                        RESTORE INVC1
                ElseIf TCV! < 0.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(-0.0001183432 * (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
        If (Val(DS$) < 99) Then
                DS$ = LTrim$(Str$(DSNV%))   'Make string of new dash number value
                UPSN$ = WO$ + "-" + DS$     'Set function return to next sequential module serial number
        Else
                'Next sequential number will be too high, get new dash number
                Color 28, 0, 0  'Flashing light red
                CLS
                LOCATE 10, 10: Print "NEXT SEQUENTIAL DASH NUMBER IS INVALID!"
                Color 12, 0, 0  'Light red
                LOCATE 11, 10: Print "Next dash number would be: "; DSNV%
                LOCATE 12, 10: Print "Must be number between 1 and 99"
                Color 15, 0, 0  'White on black
                LOCATE 14, 10: Print "Press any key to enter a valid dash number."
                Color 11, 0, 0  'Reset to cyan on black background

                a$ = KEYBDIN$   'Wait for keyboard entry (anything)

                Call CHANGEDN(SN$)      'Changes dash number only
                UPSN$ = SN$             'Set function return to new module serial number
        End If
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! = 0.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! <= 0.0001 Then
                value! = 0.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(0.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

