'**************************** NLIBATE3  ***********************************
' NAME:     NLIBATE3.BAS
' PURPOSE:  LIBRARY OF FUNCTIONS FOR RMS INPUT AND
'           HIGH-VOLTAGE VOLTAG INPUT PRODUCT
'           TEST SOFTWARE
' COMPILER: Quick Basic 4.5
' AUTHOR:   John Lehman
' DATE:     06/21/99
'
'       REVISION RECORD
'
'DATE       REV     APPR    DESCRIPTION
'----       ---     ----    -----------
'06/21/99   1.00    JL      Initial Release
'...
'...                        See "Revs.txt" file for program update comments within this time interval.
'...
'06/09/2014 B.1     PWR     Renamed from LIBATE3.BAS to NLIBATE3.BAS. Code cleanup and updates
'                           for datasheet and work order status file generation, etc. All of the
'                           subs and functions for getting or setting the module serial number(s),
'                           including getting and setting the work order and dash numbers, are
'                           now in this library file, and implement work order number and dash
'                           number restrictions for the datasheet file naming convention.
'07/15/2014 B.2     PWR     Added references to DASERROR$ function and DASERRORS and SHOWDIO subs
'                           and added some debug code to the IO488 sub.
'2014/10/09 B.03    PWR     Updated HS1 and HS2 subroutines for counter exits and error messages.
'                           Only the changes to HS1 are currently implemented. Added common
'                           variable DEBUGFLAG% to control debug messages and pauses in various
'                           routines. Also added FINISHSUB declaration and call from the F10 trap.
'
CONST LIBVERSION$ = "B.03 2014.10.09 PWR"       'Version (Revision Date) and initials of engr.

DECLARE SUB CHANGEDN (SN$)                      'Allow user to change dash number
DECLARE SUB CONTINUE ()                         'Waits for a key press
DECLARE SUB GETNEXTSN (TIME2!, SERNO$(), NUMDUT%)   'Allows user the change the SN info for a new group of modules
DECLARE SUB GETSN (SN$)                         'Gets DUT serial number from user
DECLARE SUB INPUTSN (SN$, SERNO$(), NUMDUT%)        'Gathers the SN information for the unit in channel 1
DECLARE SUB HS1 ()                              'GPIB communications handshake
DECLARE SUB PAUSE (TIME!)                       'Pause for TIME

DECLARE FUNCTION BESTFIT! (SLOPE!, OFFSET1!, INSIM!(), NUMPTS%, ERROROUT!(), L%)    '** Calculates bestfit line and max error
DECLARE FUNCTION KEYBDIN$ ()                    '** Get keyboard input
DECLARE FUNCTION REPEAT$ (MN$, ELAP2!, TIME2!)  '** Ask if you would like to repeat test
DECLARE FUNCTION READDVM! (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!) '**
DECLARE FUNCTION STRINGVAL% (a$)                '**
DECLARE FUNCTION UPSN$ (OLDSN$)           '** Increments dash# of serial#
				'** Function called from main programs.
				'   Declare in programs which call this function.

'GPIB Communication routines for dataforth GPIB card
DECLARE SUB HS2 ()
DECLARE SUB HS1 ()
DECLARE SUB INIT488 (DEVADDR%)
DECLARE SUB IO488 (DDATA$, DEVADDR%, OPTYPE%)

'Kepco DPS 125-0.5M control routines via RS-232C
DECLARE SUB INITPS (DPSADDR%, OVERI!, OVERV!)   'initializes supply
DECLARE SUB SETDPS (DPSADDR%, VSUPPLY!)         'Sets Kepco DPS power supply
DECLARE FUNCTION POWERIO$ (DPSADDR%, CMD$)      '** Kepco DPS power supply I/O

'HP33120A (function generator) control routines via GPIB
DECLARE SUB FUNGEN33120A (CMD$, VALUE!)         'Write command to func. gen.

'HP34970A (data acquisition/switch unit) control routines via GPIB
DECLARE SUB DVMCONF (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!) 'Configure DVM
DECLARE SUB DVMSENS (CH%, FUNC1$, FUNC2$, SETTXT$, SETNUM!) 'Configure DVM
DECLARE SUB SETDAC3 (DACNUM%, VOLTAGE!)         'Set 34907 DACs
DECLARE SUB SETSWITCH (CH%, STATE%)             'Set switch on 34903A 20-ch actuator
DECLARE FUNCTION GETREADING! ()                 '** Send trigger & read DVM

'HP760A meter calibrator routines
DECLARE SUB HP760APANEL (VALUE!, UNITS%)        'Draw a display of instrument panel.

DECLARE SUB INSTALLDUT (NUMDUT%)

'******* Added Functions and Subs for Work Order Status File (etc.) version **********
DECLARE FUNCTION LIBVERVAL$ ()              'Function to return the library source file version
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 SUB GETDSFNAME (SN$, DSSNAME$, DSFNAME$)    'Gets datasheet search and file names from serial number
DECLARE SUB SNPARSE (SN$, WO$, DS$)
DECLARE FUNCTION GETWOSFNAME$ (SN$)             'Returns work order status file name from serial number
DECLARE FUNCTION WAITFORKEY$ (KEY$, TABPOS%, FORECOL%, BACKCOL%)
DECLARE SUB FINISHSUB ()                    'Subroutine to run at "FINISH" label (after F10 keypress).

'Define common variables.
COMMON SHARED IINSEN1.MEAS!
COMMON SHARED IOUTSEN1.MEAS!()
COMMON SHARED IOUTSEN2.MEAS!()
COMMON SHARED IOUTSEN11.MEAS!()
COMMON SHARED SERNO$()
COMMON SHARED SN$                   ' unit serial number
COMMON SHARED PSCOM$
COMMON SHARED PSPORT%
COMMON SHARED GENOUTMAX!
COMMON SHARED PCBNO$
COMMON SHARED BADDRS%
COMMON SHARED DPSADDR%
COMMON SHARED DASADDR%
COMMON SHARED GENADDR%
COMMON SHARED DIOCH01DATA%
COMMON SHARED DIOCH02DATA%
COMMON SHARED DEBUGFLAG%

CONST MTA% = &H40                       'GPIB talk address
CONST MLA% = &H20                       'GPIB listen address

'********************
'Assign constants to Kepco DPS power supply commands:
CONST PSVOLT$ = "STV="                  'Set terminal voltage
CONST SUPPLYON$ = "SOP=ON"              'Set output to ON
CONST ISTAT$ = "RCS"                    'Read Current protection status
CONST SETIMAX$ = "SOC="                 'Set overcurrent limit...4mA resolution.

'*******************
'Assign constants to HP freq. gen. commands
CONST FREQ$ = "FREQ"

'*******************
'Assign constants to HP DAS commands
CONST SETDAC$ = "SOUR:VOLT"

'******************
'Assign constants to HP DAS configuration
CONST DAC1.CH% = 304                    'DAC #1
CONST DAC2.CH% = 305                    'DAC #2

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

FUNCTION BESTFIT! (SLOPE!, OFFSET1!, INSIM!(), NUMPTS%, ERROROUT!(), L%)
	'Calculates Max error of data from bestfit line
	'
	MTERR! = 0
	MIN! = INSIM!(L%, 1)
	MAX! = INSIM!(L%, NUMPTS%)

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

		BVEC! = INSIM!(L%, INC%) * SLOPE! + OFFSET1!  'Calculates point on best fit line
		AVEC! = ERROROUT!(L%, 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 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 DVMCONF (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!)

'       Inputs:
'           CH% = channel to be measured
'           FUNC$ = parameter to be measured
'           RANGETXT$ = measurement range, specified in text
'                   If 'N/A', don't include in command.  Not needed for FUNC$
'                   If "", range specified in RANGENUM! or not specified
'           RANGENUM! = measurement range, specified numerically
'                   If 0, range specified in RANGETXT$ or not specified
'           RESOLTXT$ = indicate how resolution is specified.  0 = text, 1 = numerically
'                   If 'N/A', don't include in command.  Not needed for FUNC$
'                   IF "", resolution specified in RESOLNUM! or not specified
'           RESOLNUM! = measurement resolution
'                   0 = Resolution specified in RESOLTXT$ or not specified
'       Outputs:  None
'       Description - configures HP34970A to take a measurement
'
'       Reference;
'       MEAS and CONF use the following default instrument settings
'       Integration Time        1PLC
'       Input Resistance         10Mohm, fixed for all DCV ranges
'       AC Filter               20Hz (medium)
'       Scan List               Redefined when command executed
'       Scan Interval Source    Immediate
'       Scan Count              1 Scan Sweep
'       Channel Delay           Automatic Delay

	IF RANGETXT$ = "N/A" THEN               'String command only.
											'No range or resolution data.
		DDATA$ = "CONF:" + FUNC$ + " (@" + STR$(CH%) + ")"
	ELSE
		IF RANGENUM! <> 0 THEN              'Range specified numerically
			RG$ = STR$(RANGENUM!)
		ELSE                                'Range specified with text
			RG$ = " " + RANGETXT$
		END IF
		IF RESOLNUM! <> 0 THEN              'Resolution specified numerically
			RES$ = STR$(RESOLNUM!)
		ELSE                                'Resolution specified with text
			IF RESOLTXT$ <> "" THEN
				RES$ = RESOLTXT$
			ELSE
				RES$ = ""
			END IF
		END IF
		DDATA$ = "CONF:" + FUNC$ + RG$ + RES$ + ",(@" + STR$(CH%) + ")"
	END IF
  
	'Y% = CSRLIN
	'LOCATE 22
	'PRINT "DVMCONF a" + DDATA$ + "b";
	'PRINT SPC(10); : PRINT
	'LOCATE Y%
   
	CALL IO488(DDATA$, DASADDR%, 1)         'Write configuration

END SUB

SUB DVMSENS (CH%, FUNC1$, FUNC2$, SETTXT$, SETNUM!)

'       Inputs:
'           CH% = channel to be measured
'           FUNC1$ = parameter to be measured
'           FUNC2$ = parameter to be configured
'           SETTXT$ = configuration, specified in text
'                   If "", specified in SETNUM!
'           SETNUM! = configuration, specified numerically
'                   If 0, range specified in SETTXT$
'       Outputs:  None
'       Description - configures HP34970A to take a measurement
'
'       Reference;
'       DC Voltage and Current Readings
'       Integration Time    Resolution              Digits  Bits
'       0.02PLC             <0.0001 * Range         4 1/2   15
'       0.2PLC              <0.00001 * Range        5 1/2   18
'       1PLC                <0.000003 * Range       5 1/2   20
'       2PLC                <0.0000022 * Range      6 1/2   21
'       10PLC               <0.000001 * Range       6 1/2   24
'       20PLC               <0.0000008 * Range      6 1/2   25
'       100PLC              <0.0000003 * Range      6 1/2   26
'       200PLC              <0.00000022 * Range     6 1/2   26
'
'       AC Voltage and Current Readings
'       Filter          Readings/s      Settling Delay         Digits
'       3Hz                0.14             1.5s                6 1/2
'       20Hz               1                0.2s                6 1/2
'       200Hz              8                0.02s               6 1/2

	IF SETNUM! <> 0 THEN                    'specified numerically
		ST$ = STR$(SETNUM!)
	ELSE                                    'specified with text
		ST$ = " " + SETTXT$
	END IF
	DDATA$ = "SENS:" + FUNC1$ + ":" + FUNC2$ + ST$ + ",(@" + STR$(CH%) + ")"
  
	'Y% = CSRLIN
	'LOCATE 23
	'PRINT "DVMSENSE a" + DDATA$ + "b";
	'PRINT SPC(10); : PRINT
	'LOCATE Y%
   
	CALL IO488(DDATA$, DASADDR%, 1)         'Write configuration

END SUB

SUB FUNGEN33120A (CMD$, 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

	IF VALUE! = -99 THEN
		VALUE2$ = ""            'Command contains no numerical value
	ELSEIF CMD$ = FREQ$ AND ABS(VALUE!) < .0001 THEN
		VALUE! = .0001          'Func. gen. min output = 100uHz
		VALUE2$ = STR$(VALUE!)
	ELSEIF (LEFT$(CMD$, 3) = "FSK" OR LEFT$(CMD$, 7) = "FREQ:ST") AND VALUE! <= .0001 THEN
		VALUE! = .01            'Func. gen. min FSK value = 10mHz
		VALUE2$ = STR$(VALUE!)   'Func. gen. min sweep value = 10mHz
	ELSE
		VALUE2$ = STR$(VALUE!)
	END IF
	  
	DDATA$ = CMD$ + " " + VALUE2$

	'Y% = CSRLIN
	'LOCATE 20
	'PRINT "FUNGEN33120A a" + DDATA$ + "b";
	'PRINT SPC(10); : PRINT
	'LOCATE Y%
   
	CALL IO488(DDATA$, GENADDR%, 1)         'Write data to generator

END SUB

'********************************************
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
	LOCATE 5, 10: PRINT "For the Device Under Test in channel #1 (DUT#1):"
	CURLOC% = 7
	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 "Previous 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'";
		BEEP
	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
		BEEP
		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
		BEEP
		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
			BEEP
			DSFNAME$ = "BAD" + "-" + DS$ + ".TXT"   'Create "bad" datasheet file name.
			DSSNAME$ = "BAD"                        'Create "bad" datasheet search name.
		ELSE
			'Six character work order number with valid first two characters
			SELECT CASE VALLEFT2%
				CASE 10
					WO1$ = "A"  'Single alpha for the two-character value
				CASE 11
					WO1$ = "B"  'Single alpha for the two-character value
				CASE 12
					WO1$ = "C"  'Single alpha for the two-character value
				CASE 13
					WO1$ = "D"  'Single alpha for the two-character value
				CASE 14
					WO1$ = "E"  'Single alpha for the two-character value
				CASE 15
					WO1$ = "F"  'Single alpha for the two-character value
				CASE 16
					WO1$ = "G"  'Single alpha for the two-character value
				CASE 17
					WO1$ = "H"  'Single alpha for the two-character value
				CASE 18
					WO1$ = "I"  'Single alpha for the two-character value
				CASE ELSE
					'Value of "19" (already checked that value in "10" to "19" range)
					WO1$ = "J"  'Single alpha for the two-character value
			END SELECT
			WONXT4$ = RIGHT$(WO$, 4)    'Get the last for characters of the work order number
			'Create datasheet file name from the new 1st character and then the next 4 characters
			'of the six-character work order number, then using the dash number
			'Create "good" datasheet file and search names from modified work order#.
			DSFNAME$ = WO1$ + WONXT4$ + "-" + DS$ + ".TXT"
			DSSNAME$ = WO1$ + WONXT4$
		END IF
	ELSE    'Work order number is 5 characters of less (but not blank)
		'Create "good" datasheet file and search names from unmodified work order#.
		DSFNAME$ = WO$ + "-" + DS$ + ".TXT"
		DSSNAME$ = WO$
	END IF
END SUB

FUNCTION GETREADING!

'       Inputs: None
'       Outputs:  None
'       Description - configures HP34970A trigger source, sends a trigger
'                     command, reads the DVM and returns the reading.

	DDATA$ = "TRIG:SOUR BUS"                'Trigger source = bus
	CALL IO488(DDATA$, DASADDR%, 1)
   
	DDATA$ = "INIT"                         'set 'wait-for-trigger' state
	CALL IO488(DDATA$, DASADDR%, 1)

	DDATA$ = "*TRG"                         'send trigger
	CALL IO488(DDATA$, DASADDR%, 1)
   
	DDATA$ = "FETC?"                        'retrieve reading
	CALL IO488(DDATA$, DASADDR%, 1)
	CALL IO488(DDATA$, DASADDR%, 2)
	GETREADING! = VAL(DDATA$)

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
	LOCATE 5, 10: PRINT "For the Device Under Test in channel #1 (DUT#1):"
	CURLOC% = 7
	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
				BEEP
			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
					BEEP
				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
						BEEP
					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
							BEEP
						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
				BEEP
			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
				BEEP
				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
		BEEP
		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
		BEEP
		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 HP760APANEL (VALUE!, UNITS%)

	'Print a display of the HP760A front panel to show number setting.
	'Inputs;    VALUE! = Value of voltage or current to be set
	'           UNITS%  1 = Voltage
	'                   2 = Current
	'                   3 = None, FUNCTION = STD BY

'   5    10   15   20   25   30   35   40   45   50   55   60   65   70   75
'
	DIM DIG%(7)                         'Display digits
	TOPLOC% = 16
	  
	IF UNITS% = 1 THEN
		SCALE! = 1                      'Max voltage output is 1000V
		LEDTAB% = 34
	ELSEIF UNITS% = 2 THEN
		SCALE! = 100                    'Max current output is 10A
		LEDTAB% = 14
	ELSE
		LEDTAB% = 0
	END IF
   
										'Set meter for twice max D.U.T. input
										'Set only one digit.  Setting other digits
										'after most significant digit does not
										'always increase output signal magnitude.
	IF VALUE! * 2 >= 100 THEN
		SETVALUE! = CINT(VALUE! * 2 / 100) * 100 * SCALE!
	ELSEIF VALUE! * 2 >= 10 THEN
		SETVALUE! = CINT(VALUE! * 2 / 10) * 10 * SCALE!
	ELSEIF VALUE! * 2 >= 1 THEN
		SETVALUE! = CINT(VALUE! * 2) * SCALE!
	ELSEIF VALUE! * 2 >= .1 THEN
		SETVALUE! = CINT(VALUE! * 2 * 10) / 10 * SCALE!
	ELSEIF VALUE! * 2 >= .01 THEN
		SETVALUE! = CINT(VALUE! * 2 * 100) / 100 * SCALE!
	ELSEIF VALUE! * 2 >= .001 THEN
		SETVALUE! = CINT(VALUE! * 2 * 1000) / 1000 * SCALE!
	ELSEIF VALUE! * 2 >= .0001 THEN
		SETVALUE! = CINT(VALUE! * 2 * 10000) / 10000 * SCALE!
	END IF

	NUM$ = STR$(SETVALUE!)

	FOR L% = 1 TO 7
		DIG%(L%) = 0
	NEXT
   
	IF SETVALUE! >= 1000 THEN
		DIG%(7) = 9
	ELSEIF SETVALUE! >= 100 THEN
		DIG%(7) = VAL(MID$(NUM$, 2, 1))
	ELSEIF SETVALUE! >= 10 THEN
		DIG%(6) = VAL(MID$(NUM$, 2, 1))
	ELSEIF SETVALUE! >= 1 THEN
		DIG%(5) = VAL(MID$(NUM$, 2, 1))
	ELSEIF SETVALUE! >= .1 THEN
		DIG%(4) = VAL(MID$(NUM$, 3, 1))
	ELSEIF SETVALUE! >= .01 THEN
		DIG%(3) = VAL(MID$(NUM$, 4, 1))
	ELSEIF SETVALUE! >= .001 THEN
		DIG%(3) = VAL(MID$(NUM$, 5, 1))
	ELSEIF SETVALUE! >= .0001 THEN
		DIG%(3) = VAL(MID$(NUM$, 6, 1))
	END IF

	FOR L% = 1 TO 7
	   
		LOCATE TOPLOC%, (L% - 1) * 10 + 7       'top left corner
		PRINT CHR$(201)
	   
		FOR M% = 8 TO 10                        'top horizontal line
			LOCATE TOPLOC%, (L% - 1) * 10 + M%
			PRINT CHR$(205)
		NEXT M%

		LOCATE TOPLOC%, (L% - 1) * 10 + 11      'top right corner
		PRINT CHR$(187)

		FOR N% = TOPLOC% + 1 TO TOPLOC% + 3
			LOCATE N%, (L% - 1) * 10 + 7    'left vertical line
			PRINT CHR$(186)
			IF N% = TOPLOC% + 2 THEN        'print display digit
				LOCATE N%, ((L% - 1) * 10 + 8)
				PRINT DIG%(8 - L%)
			END IF
			LOCATE N%, (L% - 1) * 10 + 11   'right vertical line
			PRINT CHR$(186)
		NEXT N%

		LOCATE TOPLOC% + 4, (L% - 1) * 10 + 7   'bottom left corner
		PRINT CHR$(200)
	  
		FOR M% = 8 TO 10                     'bottom horizontal line
			LOCATE TOPLOC% + 4, (L% - 1) * 10 + M%
			PRINT CHR$(205)
		NEXT M%

		LOCATE TOPLOC% + 4, (L% - 1) * 10 + 11     'bottom right corner
		PRINT CHR$(188)
   
	NEXT L%

	IF LEDTAB% <> 0 THEN
		LOCATE TOPLOC% + 2, LEDTAB%             'print LED location
		PRINT CHR$(15)
	END IF

END SUB

SUB HS1
'   BYTE% = 0
'   WHILE (BYTE% AND 16) = 0
'       BYTE% = INP(BADDRS% + 0)
'   WEND
	'-----------------------------------------------------------------------------------
	' Module Name:  HS1 ("handshake 1")
	'
	' Inputs:       None
	' Outputs:      None
	' Description:  HS1 is a handshake subroutine for GPIB (IEEE488) communication.
	'               The subroutine reads the GPIB port and waits for bit #4 (decimal
	'               weight 16) to be true (a "1") before it exits the "while" loop.
	'               This indicates that the last instruction has been sent (or is
	'               it the last response from the instrument has been sent?).
	'
	'               In this version of the subroutine, a counter is incremented
	'               every time through the "while" loop, which also reads the
	'               value at the GPIB port. If the counter reaches the maximum
	'               count before bit #4 becomes "true", the subroutine displays an
	'               error message and exits the test program (for example, if
	'               GPIB communications hangs form some reason, including if
	'               and instrument being communicated with is not turned on or
	'               has a GPIB cable connection problem or has the wrong GPIB
	'               address set).
	'-----------------------------------------------------------------------------------
	'
	COUNTER& = 0    'Initialize counter (long integer)

	'Initialize maximum count (1000 is too little, causes supply communication routine
	'to display the error message and exit the test program).
	MAXCOUNT& = 50000 'long integer

	'Initialize the byte read back by the port (forces at least one pass through the "while" loop).
	BYTE% = 0

	'Loop while for bit #4 is not "true" (is not a value of "1", bit weight of "16")
	'WHILE NOT (BYTE% AND 16) = 1   'Bitwise "AND" with bit weight "16" (bit #4 of byte) is "1" (bit #4 is "true").
'   'WHILE ((BYTE% AND 16) = 0)
	WHILE (BYTE% AND 16) = 0
		BYTE% = INP(BADDRS% + 0)    'Get byte value from GPIB port.
	   
		PRINT TAB(0);   'ADDED DELAY

	   
		IF COUNTER& > MAXCOUNT& THEN
			'If the counter exceeds the maximum count (without bit #4 from the GPIB port
			'going "true"), display the following error message and exit the test program.
			CLS
			PRINT
			PRINT TAB(25); "COMMUNICATIONS FAILURE DETECTED BY HS1 ROUTINE."
			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     'End the test program.
		END IF
		COUNTER& = COUNTER& + 1 'Increment counter.
	WEND
END SUB

SUB HS2
'   BYTE% = 0
'   WHILE NOT BYTE% AND 32 AND BYTE% <> 40
'       BYTE% = INP(BADDRS% + 0)
'   WEND
	'-----------------------------------------------------------------------------------
	' Module Name:  HS2 ("handshake 2")
	'
	' Inputs:       None
	' Outputs:      None
	' Description:  HS2 is a handshake subroutine for GPIB (IEEE488) communication.
	'               It checks that "the serial poll active state has occurred with
	'               rsv set in the serial poll register". It "checks bit #5 for
	'               "true" (SPAS)".
	'
	'               In this version of the subroutine, a counter is incremented
	'               every time through the "while" loop, which also reads the
	'               value at the GPIB port. If the counter reaches the maximum
	'               count before bit #4 becomes "true", the subroutine displays an
	'               error message and exits the test program (for example, if
	'               GPIB communications hangs form some reason, including if
	'               and instrument being communicated with is not turned on or
	'               has a GPIB cable connection problem or has the wrong GPIB
	'               address set).
	'-----------------------------------------------------------------------------------
	'
	COUNTER& = 0    'Initialize counter (long integer)

	'Initialize maximum count (1000 is too little, causes supply communication routine
	'to display the error message and exit the test program).
	MAXCOUNT& = 50000 'long integer

	'Initialize the byte read back by the port (forces at least one pass through the "while" loop).
	BYTE% = 0

	'Loop while for bit #5 (bit weight "32" is not "true" and byte value
	'is not "40" (bit #5 and bit #3 are both "true"), using a bitwise "and".
	'WHILE NOT ((BYTE% AND 32) AND (BYTE% <> 40))
	WHILE NOT BYTE% AND 32 AND BYTE% <> 40
		BYTE% = INP(BADDRS% + 0)    'Get byte value from GPIB port.
'       IF COUNTER& > MAXCOUNT& THEN
'           'If the counter exceeds the maximum count (without bit #4 from the GPIB port
'           'going "true"), display the following error message and exit the test program.
'           CLS
'           PRINT
'           PRINT TAB(25); "COMMUNICATIONS FAILURE DETECTED BY HS2 ROUTINE."
'           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     'End the test program.
'       END IF
'       COUNTER& = COUNTER& + 1 'Increment counter.
	WEND
END SUB

SUB INIT488 (DEVADDR%)
'   Module Name - INIT488
'
'   Inputs - None
'   Outputs - None
'   Description - Initializes the IEEE 488 interface
	 
	OUT (BADDRS% + 8), &H0          'Configure PC4311 as controller
	OUT (BADDRS% + 3), &H80         'Release ACDS hold-off, set operation
	OUT (BADDRS% + 3), &H0          'Software reset, set operation
	OUT (BADDRS% + 4), DEVADDR%     '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 (DPSADDR%, OVERI!, OVERV!)

	'Initialize Kepco power supply
	PS$ = POWERIO$(DPSADDR%, "ZER")          'Clear errors if any
	PS$ = POWERIO$(DPSADDR%, "SMD=OC")       'Select over-current protection mode
						'Set over-current limit
	STLEN% = LEN(STR$(OVERI!))
	PS$ = POWERIO$(DPSADDR%, SETIMAX$ + RIGHT$(STR$(OVERI!), STLEN% - 1))
	STLEN% = LEN(STR$(OVERV!))
	PS$ = POWERIO$(DPSADDR%, "SOV=" + RIGHT$(STR$(OVERV!), STLEN% - 1))'Set over-voltage limit

END SUB

SUB IO488 (DDATA$, DEVADDR%, OPTYPE%)
	'Subroutine to write or read from the IEEE488 (GPIB) bus.
	'
	' Inputs:   DDATA$:     Data string to GPIB device.
	'           DEVADDR%:   GPIB device address.                                          *
	'           OPTYPE%:    Write (1) or Read (2) command.                                      *
	'
	' Output:   DDATA$:     Data string from GPIB device.                                       *
	'
	' Description:  Output and input to GPIB device using PC4311 GPIB card.
	'
	CALL INIT488(DEVADDR%)                  'Address GPIB card
 
	IO488DEBUG% = 0 'Debug flag ("1" to display debug messages).
 
	'Debug code.
	IF (IO488DEBUG% = 1) THEN
		PRINT "......................"
		PRINT "IO488: DDATA$ = "; DDATA$; " DVADDR% = "; DEVADDR%; " OPTYPE% = "; OPTYPE%
		PRINT "......................"
	END IF

	SELECT CASE OPTYPE%
		CASE 1
			'Write....
			BYTE% = MLA% OR DEVADDR%        'GPIB device address
			OUT (BADDRS% + 7), BYTE%        'Send out to GPIB card
			CALL HS1                        'Wait for received status
			OUT (BADDRS% + 3), &H8A         'Request control, clear operation
			OUT (BADDRS% + 3), &HB          'Remote enable, clear
			FOR X1 = 1 TO LEN(DDATA$)        'Create character and send out
				BYTE% = ASC(MID$(DDATA$, X1, 1))
				OUT (BADDRS% + 7), BYTE%
				CALL HS1
			NEXT
			OUT (BADDRS% + 7), &HD           'Send CR, tell device to execute command
			CALL HS1                         'Wait for received status
			OUT (BADDRS% + 7), &HA           'Send LF
			CALL HS1                         'Wait for received status
			OUT (BADDRS% + 3), &HC           'Remote enable, set operation
			OUT (BADDRS% + 3), &HA           'Clear talk only
			OUT (BADDRS% + 7), &H3F          'Un-listen
		CASE 2
			'Read....
			DDATA$ = ""
			BYTE% = MTA% OR DEVADDR%         'GPIB device address
			OUT (BADDRS% + 7), BYTE%         'Send out to GPIB card
			CALL HS1                         'Wait for received status
			OUT (BADDRS% + 3), &H89          'Request control, clear
			OUT (BADDRS% + 3), &HB           'Remote enable, clear
			DO
				CALL HS2
				DATABYTE = INP(BADDRS% + 7)
				IF DATABYTE <> &HA THEN
					DDATA$ = DDATA$ + CHR$(DATABYTE)
				END IF
			LOOP WHILE DATABYTE <> &HA
			OUT (BADDRS% + 3), &HC          'Remote enable, set command
			OUT (BADDRS% + 3), &H9          'Clear listen only
			OUT (BADDRS% + 7), &H5F         'Un-talk command
	END SELECT
	CALL HS1                                'Wait for received status

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$
	'Function that gets and returns input from keyboard.
	'
	DO
		X$ = INKEY$
	LOOP WHILE X$ = ""
	KEYBDIN$ = UCASE$(X$)
END FUNCTION

FUNCTION LIBVERVAL$
	'Function to return the library source file version
	LIBVERVAL$ = LIBVERSION$
END FUNCTION

SUB PAUSE (TIME!)
	'Sub that waits number of seconds passed by
	'the "TIME!" parameter (careful - does not
	'work correctly near midnight because "TIMER"
	'returns the number of seconds since midnight).
	'
	T1! = TIMER
	DO
		T2! = TIMER
	LOOP UNTIL (T2! - T1!) > TIME!

END SUB

FUNCTION POWERIO$ (DPSADDR%, 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
	PSCOM$ = "COM" + RIGHT$(STR$(PSPORT%), 1) + ":9600,N,8,1"
	OPEN PSCOM$ FOR RANDOM AS #1
	
	DEVSEL = DPSADDR% + &HE0
	RXOK = DPSADDR% + &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
									'print message if not successful
	 
	DO
		IF N > 5000 THEN
			PRINT "COM ERROR - INPUT BUFFER EMPTY"
			CLOSE #1                'close power supply communication channel
			END                     'exit program
		END IF
		N = N + 1
	LOOP WHILE (LOC(1) = 0)
									'RXOK is returned (without a <CR>) in
									'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

END FUNCTION

FUNCTION READDVM! (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!)
'       Inputs:
'           CH% = channel to be measured
'           FUNC$ = parameter to be measured
'           RANGETXT$ = indicate how range is specified.  0 = text, 1 = numerically
'                   If "", range specified in RANGENUM! or not specified
'           RANGENUM! = measurement range
'                   If 0, range specified in RANGETXT$ or not specified
'           RESOLTXT$ = indicate how resolution is specified.  0 = text, 1 = numerically
'                   IF "", resolution specified in RESOLNUM! or not specified
'           RESOLNUM! = measurement resolution
'                   0 = Resolution specified in RESOLTXT$ or not specified
'       Outputs:  None
'       Description - configures HP34970A to take a measurement, reads
'                       the DVM and returns the reading.
'
'       Reference;
'       MEAS and CONF use the following default instrument settings
'       Integration Time        1PLC (5 1/2 digits, 20 bits)
'       Input Resistance         10Mohm, fixed for all DCV ranges
'       AC Filter               20Hz (medium)
'       Scan List               Redefined when command executed
'       Scan Interval Source    Immediate
'       Scan Count              1 Scan Sweep
'       Channel Delay           Automatic Delay
'
'       DVM Accuracy;
'           The following specs use the 3Hz filter
'           ACV     +/-0.06% reading +/-0.04% range, 10Hz-20KHz, 0.1V - 100V, 1 year
'           ACV     +/-0.06% reading +/-0.04% range, 10Hz-20KHz, 0.1V - 100V, 1 year
'           ACV     +/-0.05% reading +/-0.08% range, 10Hz-20KHz, 300V, 90 day
'           ACV     +/-0.05% reading +/-0.08% range, 10Hz-20KHz, 300V, 90 day
'
'           If the 20Hz filter is used, add the following low frequency error
'                   +/-0.06% reading, 40Hz-100Hz
'                   +/-0.01% reading, 100Hz-200Hz
'                   +/-0.0% reading, 200Hz->1000Hz
   
	IF RANGENUM! <> 0 THEN                  'Range specified numerically
		RG$ = STR$(RANGENUM!) + ","
	ELSE                                    'Range specified with text
		RG$ = RANGETXT$ + ","
	END IF
	IF RESOLNUM! <> 0 THEN                  'Resolution specified numerically
		RES$ = STR$(RESOLNUM!) + ","
	ELSE                                    'Resolution specified with text
		IF RESOLTXT$ <> "" THEN
			RES$ = RESOLTXT$ + ","
		ELSE
			RES$ = ""
		END IF
	END IF
   
	DDATA$ = "MEAS:" + FUNC$ + "?" + RG$ + RES$ + "(@" + STR$(CH%) + ")"

	'Y% = CSRLIN
	'LOCATE 21
	'PRINT "READDVM a" + DDATA$ + "b";
	'PRINT SPC(10); : PRINT
	'LOCATE Y%
   
	CALL IO488(DDATA$, DASADDR%, 1)         'Write configuration
	CALL IO488(DDATA$, DASADDR%, 2)         'Read result

	READDVM! = VAL(DDATA$)

END FUNCTION

'**********************************
FUNCTION REPEAT$ (MN$, ELAP2!, TIME2!)
	'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 set of "; MN$; " modules?"
	LOCATE 11, 10: PRINT "Either the 'Y' or 'N' must be pressed."
	LOCATE 23, 49: PRINT USING "Test Time: ## Min. ## Sec."; INT(ELAP2! / 60); ELAP2! - INT(ELAP2! / 60) * 60

	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 set of modules, starting with channel 1."
		CALL CONTINUE
	END IF
	  
	TIME2! = TIMER
	REPEAT$ = a$

	COLOR 11, 0, 0  'Cyan on black background

END FUNCTION

'*********************************
SUB SETDAC3 (DACNUM%, VOLTAGE!)
	'Sets the HP34907 DACs
	'Both DACs are;
	'               +/-12V out
	'               10mA max
	'               1mV resolution
	'               ground referenced, cannot float
	'
	'DAC1 is on CH04, DAC2 is on CH05
	'Inputs;    DACNUM%  1 = DAC1, 2 = DAC2
	'           VOLTAGE!    Voltage to set

	SELECT CASE DACNUM%
		CASE 1
			CH% = DAC1.CH%
		CASE 2
			CH% = DAC2.CH%
	END SELECT

	DDATA$ = SETDAC$ + " " + STR$(VOLTAGE!) + ",(@" + STR$(CH%) + ")"
   
	'Y% = CSRLIN
	'LOCATE 21
	'PRINT "SETDAC3 a" + DDATA$ + "b";
	'PRINT SPC(10); : PRINT
	'LOCATE Y%
   
	CALL IO488(DDATA$, DASADDR%, 1)         'Write configuration

END SUB

SUB SETDPS (DPSADDR%, VSUPPLY!)

	'Set supply voltage
	SETP$ = POWERIO$(DPSADDR%, PSVOLT$ + RIGHT$(STR$(VSUPPLY!), LEN(STR$(VSUPPLY!)) - 1))
	SETP$ = POWERIO$(DPSADDR%, SUPPLYON$)           'enable power supply output
	CALL PAUSE(.02)                               '20ms over-current protection delay

	IF POWERIO$(DPSADDR%, ISTAT$) = "RCS=01" THEN    'Check for over-current
		SOUND 1000, .5
		PRINT
		PRINT TAB(10); "Module supply current has exceeded maximum value."
		PRINT TAB(10); "Power supply has been disabled."
		CALL PAUSE(1)
		'PRINT TAB(10); "Press any key to continue"
		'A$ = KEYBDIN$
	END IF

END SUB

SUB SETSWITCH (CH%, STATE%)
'       Inputs:
'           CH% = channel to be closed
'           STATE% = switch state, 1 = CLOSED, 0 = OPEN
'       Outputs:  None
'       Description - sets the specified switch on the HP34903A 20-channel
'                       actuator

	IF STATE% = 1 THEN                      'close switch
		DDATA$ = "ROUT:CLOS " + "(@" + STR$(CH%) + ")"
	ELSE                                    'String command only
		DDATA$ = "ROUT:OPEN " + "(@" + STR$(CH%) + ")"
	END IF

	'Y% = CSRLIN
	'LOCATE 22
	'PRINT "SETSWITCH a" + DDATA$ + "b";
	'PRINT SPC(10); : PRINT
	'LOCATE Y%
   
	CALL IO488(DDATA$, DASADDR%, 1)         'Write configuration

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 UPSN$ (OLDSN$)
	'Function that returns a new module serial number, with the dash number incremented
	'by one, from the passed "old" value of the module serial number
	'
	CALL SNPARSE(OLDSN$, WO$, DS$)  'Get current work order and dash numbers from module serial number
	DSNV% = VAL(DS$) + 1            'Increment value of old dash number for new dash number
	IF ((VAL(DS$) < 99) AND (VAL(DS$) >= 1)) THEN
		'Valid dash numbers are 1 to 99
		DS$ = LTRIM$(STR$(DSNV%))   'Make the new dash number value into a string
		SN$ = WO$ + "-" + DS$       'Create the new serial number from the work order and new dash numbers
	ELSE
		'Invalid new dash number. Display error message and get a valid new dash number.
		CLS
		COLOR 28, 0, 0  'Flashing light red
		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
		BEEP
		DUMKEY$ = WAITFORKEY("D", 10, 14, 0)    'Waits for "D" key press (display bright yellow on black)
		CALL CHANGEDN(SN$)  'Call sub that gets a new dash number and returns a new serial number
	END IF
	UPSN$ = SN$             'Set the function return to the new module serial number
END FUNCTION