Mike Swanson
45083f4735
Extends the Test Datasheet Pipeline on AD2:C:\Shares\testdatadb to
generate web-published datasheets for the SCMVAS-Mxxx (obsolete) and
SCMHVAS-Mxxxx (replacement) High Voltage Input Module product lines.
Both are tested either with the existing TESTHV3 software (production
VASLOG .DAT logs) or in Engineering with plain .txt output.
Key changes on AD2 (all deployed 2026-04-12 with dated backups):
- parsers/spec-reader.js: getSpecs() returns a `{_family:'SCMVAS',
_noSpecs:true}` sentinel for SCMVAS/SCMHVAS/VAS-M/HVAS-M model prefixes
so the export pipeline does not silently skip them for missing specs.
- templates/datasheet-exact.js: new Accuracy-only template branch
(generateSCMVASDatasheet + helpers) that mirrors the existing shipped
format byte-for-byte. Extraction regex covers both QuickBASIC STR$()
output formats: scientific-with-trailing-status-digit (98.4% of
records) and plain-decimal (1.6% of records above QB's threshold).
- parsers/vaslog-engtxt.js (new): parses the Engineering-Tested .txt
files in TS-3R\LOGS\VASLOG\VASLOG - Engineering Tested\. Filename SN
regex strips optional trailing 14-digit timestamp; in-file "SN:"
header is the authoritative source when the filename is malformed.
- database/import.js: LOG_TYPES grows a VASLOG_ENG entry with
subfolder + recursive flags. Pre-existing 7 log types keep their
implicit recursive=true behaviour (config.recursive !== false).
importFiles() routes VASLOG_ENG paths before the generic loop so a
VASLOG - Engineering Tested/*.txt path does not mis-dispatch to the
multiline parser.
- database/export-datasheets.js: VASLOG_ENG records are written
verbatim via fs.copyFileSync(source_file, For_Web/<SN>.TXT) for true
byte-level pass-through, with a graceful raw_data fallback when the
source file is no longer on disk.
Deploy outcome:
- 27,503 SCMVAS/SCMHVAS datasheets rendered (27,065 from scientific +
438 from plain-decimal PASS lines, post-patch rerun)
- 434 Engineering-Tested .txt files pass-through-copied to For_Web
- 0 errors across both batches
Repo layout added here:
- scmvas-hvas-research/: discovery artifacts (source .BAS, hvin.dat,
sample .DAT + .txt, binary-format notes, IMPLEMENTATION_PLAN.md)
- implementation/: staged final code + deploy helpers + local test
harness + per-step verification scripts
- backups/pre-deploy-20260412/: independent local snapshot of the 4
AD2 files replaced, pulled byte-for-byte before deploy
All helper scripts fetch the AD2 password at runtime from the SOPS
vault (clients/dataforth/ad2.sops.yaml). None of the committed files
contain the plaintext credential. Known vault-entry hygiene issue
(stale shell-escape backslash before the `!`) is documented in the
fetcher comments and stripped at read-time; flagged separately for
cleanup.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1411 lines
57 KiB
QBasic
1411 lines
57 KiB
QBasic
'**************************** 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
|
|
|