1000 ! RE-SAVE "SELFTEST"
1001 !*************************************************
1002 !*
1003 !* FILE       :  SELFTEST
1004 !* DESCRIPTION:  Agilent E5250A Self Test Utility Program
1005 !* AUTHOR     :  Tomohiko Matsui
1006 !* CREATED    :  10/27/1995
1007 !* MODIFIED   :  11/09/2000
1008 !* PRODUCT    :  Agilent E5250A
1009 !* REVISION   :  Rev.A.02.02
1010 !*
1011 !*   (c) Copyright 1995,2000 Agilent Technologies Co,
1012 !*              All rights reserved.
1013 !*
1014 !*************************************************
1015  OPTION BASE 1
1016  !==========================================================
1017  COM /Err/ Err_num(1:6),Err_message$(1:6)[60]
1018  COM /Sys_info/ Sys_os$[10],Hp5250id$[10],Hp415xid$[10],Card_type$(1:5)[10],Inst_type$(1:5)[10]
1019  COM /Card_info/ Card_info$(1:4,1:2)[6]
1020  COM /Hp5250/ @Hp5250,INTEGER Addr5250
1021  COM /Instrument/ @Hp415x,Hp415x_type$[10],INTEGER Addr415x
1022  COM /Mas/ Mas$[30]
1023  COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(1:6),Hold_time,Fvolt,Icomp,Range,I_name$[10]
1024  COM /Meas_check/ Meas_max_min(1:8,1:2)
1025  COM /Meas_data/ Meas_data$(1:4)[500]
1026  !
1027  !==========================================================
1028  !
1029  CALL Com_init                                    ! Initialize
1030  GOSUB Softkey_clear
1031  CALL Input_hpib_addr(Addr5250,"Input E5250A GPIB Address ")    ! E5250A GPIB Address Setting
1032  CALL Init_check_5250(Err)                        ! E5250A Check & Initialize
1033  IF Err<>0 THEN Err_disp                          ! Error exit
1034  GOSUB Set_main_fkey                              ! Main Menu Softkey Setup
1035  CALL Main_menu                                   ! Main Menu Display
1036  LOOP                                             ! -- Main Loop --
1037  END LOOP                                         !
1038  GOTO Prog_end
1039  !----------------------------------------------------------
1040 Set_main_fkey:                                    ! Main Menu Softkey Setup
1041  ON KEY 1 LABEL " SELF   TEST  " CALL Self_test
1042  ON KEY 2 LABEL " LEAK   TEST  " CALL Leak_test
1043  ON KEY 7 LABEL " QUIT         " GOTO Prog_end
1044  RETURN 
1045 Softkey_clear:!
1046  FOR Key_no=1 TO 8
1047    ON KEY Key_no LABEL "" GOSUB Key_null          ! Softkey reset
1048  NEXT Key_no
1049  RETURN 
1050 Key_null:                                         !
1051  RETURN 
1052  !----------------------------------------------------------
1053 Err_disp:                                         ! Error display
1054  LOOP
1055  EXIT IF FNError_disp(1,1)=0
1056  END LOOP
1057 Prog_end:                                         ! Program end process
1058  ASSIGN @Hp5250 TO *
1059  ASSIGN @Hp415x TO *
1060  BEEP 
1061  DISP "Self Test Utility End "
1062  END                                              !! PROGRAM END !!
1063  !=================== MAIN Routine End =====================
1064  !
1065  !==========================================================
1066  !===============        SUB ROUTINE         ===============
1067  !==========================================================
1068 Com_init:SUB Com_init
1069  !==========================================================
1070  !           Self Test COMMON Initialize routine
1071  !----------------------------------------------------------
1072    COM /Err/ Err_num(*),Err_message$(*)
1073    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1074    COM /Card_info/ Card_info$(*)
1075    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1076    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
1077    COM /Mas/ Mas$
1078    COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(*),Hold_time,Fvolt,Icomp,Range,I_name$
1079    COM /Meas_check/ Meas_max_min(*)
1080    COM /Meas_data/ Meas_data$(*)
1081  !----------------------------------------------------------
1082  !
1083                                        !
1084    CLEAR SCREEN                        ! CRT clear
1085    GINIT                               ! Graphics initiarize
1086    GCLEAR                              ! Graphics clear
1087                                        !
1088    SELECT SYSTEM$("SYSTEM ID")         ! BASIC Type Check
1089    CASE "HP 4155A"                     ! 4155A controler
1090      Sys_os$="IBASIC"                  !   IBASIC
1091    CASE "HP 4156A"                     ! 4156A controler
1092      Sys_os$="IBASIC"                  !   IBASIC
1093    CASE "HP 4155B"                     ! 4155B controler
1094      Sys_os$="IBASIC"                  !   IBASIC
1095    CASE "HP 4156B"                     ! 4156B controler
1096      Sys_os$="IBASIC"                  !   IBASIC
1097    CASE "HP 4155C"                     ! 4155C controler
1098      Sys_os$="IBASIC"                  !   IBASIC
1099    CASE "HP 4156C"                     ! 4156C controler
1100      Sys_os$="IBASIC"                  !   IBASIC
1101    CASE ELSE                           ! Other controler
1102      Sys_os$="HP-BASIC"                !   BASIC
1103    END SELECT                          !
1104                                        !
1105    GOSUB Array_init                    ! Dimension clear
1106                                        !
1107    Hp5250id$="E5250"                   ! SYSTEM ID key word
1108                                        !
1109 Card_type_set:                         ! Card ID List setting
1110    DATA "E5252","E5255","","",""       !
1111    RESTORE Card_type_set               !
1112    READ Card_type$(*)                  !
1113                                        !
1114    IF Sys_os$="IBASIC" THEN            ! Mass strage setup
1115      Mas$=":INTERNAL,4"                ! 4155/4156
1116    ELSE                                !
1117      Mas$=""                           ! BASIC
1118    END IF                              !
1119                                        !
1120    Addr5250=722                        ! Default E5250A Address set
1121                                        !
1122 Inst_type_set:                         ! Measurement Instrument type
1123    DATA "4155","4156","","",""         !     list setting
1124    RESTORE Inst_type_set               !
1125    READ Inst_type$(*)                  !
1126                                        !
1127    IF Sys_os$="IBASIC" THEN            !
1128      Addr415x=817                      ! Default 415X Address setting
1129    ELSE                                !                      for IBASIC
1130      Addr415x=717                      ! Default 415X Address setting
1131    END IF                              !                      for BASIC
1132                                        !
1133                                        !
1134 Mes_maxmin_data:                       ! Measurement check data
1135    ! ------ Max --+--- Min ---         !
1136    DATA  +4.12E-12, -4.12E-12          ! 1, 4155,E5252,IV1~2
1137    DATA  +1.01E-9,  -1.01E-9           ! 2, 4155,E5252,IV3~6
1138    DATA  +1.14E-12, -1.14E-12          ! 3, 4156,E5252,IV1~2,Non Kelvin
1139    DATA  +1.01E-9,  -1.01E-9           ! 4, 4156,E5252,IV3~6,Non Kelvin
1140    DATA  +2.24E-12, -2.24E-12          ! 5, 4156,E5252,IV1~2,Kelvin
1141    DATA  +2.02E-9,  -2.02E-9           ! 6, 4156,E5252,IV3~6,Kelvin
1142    DATA  +4.12E-12, -4.12E-12          ! 7, 4155,E5255
1143    DATA  +1.14E-12, -1.14E-12          ! 8, 4156,E5255
1144    RESTORE Mes_maxmin_data             !
1145    READ Meas_max_min(*)                !
1146                                        !
1147    SUBEXIT                             !
1148  !----------------------------------------------------------
1149 Array_init:                            !
1150    MAT Err_num= (0)
1151    MAT Err_message$= ("")
1152    MAT Card_info$= ("")
1153    RETURN 
1154  !----------------------------------------------------------
1155  SUBEND
1156  !==========================================================
1157 Init_check_5250:SUB Init_check_5250(Err_stat)
1158  !==========================================================
1159  !           E5250 Check & Initiarize
1160  !..........................................................
1161  ! PARAMETER : Err_stat   : Error status return
1162  !----------------------------------------------------------
1163    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1164    COM /Card_info/ Card_info$(*)
1165    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1166  !----------------------------------------------------------
1167    Err_stat=0
1168  !----------------------------------------------------------
1169  !
1170    ON ERROR GOTO Assign_error
1171    ASSIGN @Hp5250 TO Addr5250                     ! E5250 I/O path assign
1172    OFF ERROR                                      !
1173    IF FNReset_5250(@Hp5250,Addr5250)<>0 THEN Reset_error                   ! E5250 Reset
1174    IF FNCheck_5250id(@Hp5250,Hp5250id$,Addr5250)<>0 THEN Id_check_error    ! E5250 ID Check
1175    IF FNCard_info(@Hp5250,Addr5250,Card_info$(*))<>0 THEN Card_info_error  ! Card Information Read
1176    GOTO End_sub                                   !
1177  !----------------------------------------------------------
1178 Assign_error:                                     ! I/O path ASSIGN Error
1179    Err_stat=1
1180    Err_n=FNError_set(ERRN,"*** "&ERRM$)
1181    OFF ERROR 
1182    GOTO End_sub
1183 Reset_error:                                      ! E5250A RESET Error
1184    Err_stat=2
1185    GOTO End_sub
1186 Id_check_error:                                   ! Instrument ID Check Error
1187    Err_stat=3
1188    GOTO End_sub
1189 Card_info_error:                                  ! Get E5250A Card type/config data Error
1190    Err_stat=4
1191    GOTO End_sub
1192 End_sub:                                          ! SUB Routine END
1193  SUBEND
1194  !==========================================================
1195 Reset_5250:DEF FNReset_5250(@Hp5250,INTEGER Addr5250)
1196  !==========================================================
1197  !           E5250 Reset
1198  !..........................................................
1199  ! PARAMETER : @Hp5250  : E5250A I/O Path name
1200  !           : Addr5250 : E5250A GPIB Address
1201  !..........................................................
1202  ! RETURN    : Error Status
1203  !----------------------------------------------------------
1204    Err_stat=0
1205    T_out=5                                        ! TIMEOUT set time
1206  !----------------------------------------------------------
1207  !
1208    Hpib_sc=Addr5250 DIV 100                       ! Get GPIB select code
1209    ON ERROR GOTO Io_error
1210    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
1211    CLEAR @Hp5250                                  ! I/O Device Clear
1212    OFF ERROR 
1213    LOCAL Hpib_sc                                  !
1214    OUTPUT @Hp5250;"*RST"                          ! E5250 Reset
1215    OUTPUT @Hp5250;"*CLS"                          ! E5250 Clear Status
1216                                                   !
1217  ! OUTPUT @Hp5250;":DIAG:TEST:FRAME:CLE CONT"     ! E5250A Test result & status clear
1218  ! OUTPUT @Hp5250;":DIAG:TEST:FRAME:CLE FPAN"     ! E5250A Test result & status clear
1219  ! OUTPUT @Hp5250;":DIAG:TEST:CARD:CLE ALL"       ! E5250A Test result & status clear
1220    GOTO End_sub
1221  !----------------------------------------------------------
1222 Io_error:                                         ! Device Clear Error
1223    Err_n=FNError_set(ERRN,"*** "&ERRM$)
1224    Err_stat=2
1225    OFF ERROR 
1226    GOTO End_sub
1227 Time_out:                                         ! Timeout Error
1228    Err_n=FNError_set(10002,"E5250A GPIB address,connection or firmware is bad.")
1229    Err_stat=3
1230 End_sub:                                          ! SUB Routine END
1231    OFF TIMEOUT 
1232    OFF ERROR 
1233    RETURN Err_stat
1234  FNEND
1235  !==========================================================
1236 Check_5250id:DEF FNCheck_5250id(@Hp5250,Hp5250id$,INTEGER Addr5250)
1237  !==========================================================
1238  !           E5250 ID Check
1239  !..........................................................
1240  ! PARAMETER : @Hp5250   : E5250A I/O Path name
1241  !           : Hp5250id$ : E5250A ID keyword
1242  !           : Addr5250  : E5250A GPIB Address
1243  !..........................................................
1244  ! RETURN    : Error status
1245  !----------------------------------------------------------
1246    DIM Idstr$[50],Err_mesg$[50]
1247  !----------------------------------------------------------
1248    Err_stat=0
1249    T_out=5                                        ! TIMEOUT set time
1250  !----------------------------------------------------------
1251  !
1252    Hpib_sc=Addr5250 DIV 100                       ! Get GPIB select code
1253    ON ERROR GOTO Io_error
1254    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
1255    OUTPUT @Hp5250;"*IDN?"                         ! E5250 ID Query
1256    ENTER @Hp5250;Idstr$                           ! E5250 ID Read
1257    IF POS(Idstr$,Hp5250id$)=0 THEN Inst_diff_err  ! Instrument ID Check
1258  ! DISP Idstr$                                    ! Display ID string
1259    GOTO End_sub
1260  !----------------------------------------------------------
1261 Io_error:                                         !
1262    Err_n=FNError_set(ERRN,"*** "&ERRM$)
1263    Err_stat=2
1264    GOTO End_sub
1265 Inst_diff_err:                                    ! Instrument ID different
1266    Err_n=FNError_set(10003,"Instrument at address "&VAL$(Hpib_addr)&" is not E5250A !")
1267    Err_stat=2
1268    GOTO End_sub
1269 Time_out:                                         ! Timeout Error
1270    Err_n=FNError_set(10002,"E5250A GPIB address,connection or firmware is bad.")
1271    Err_stat=3
1272 End_sub:                                          !
1273    OFF TIMEOUT 
1274    OFF ERROR 
1275    RETURN Err_stat
1276  FNEND
1277  !==========================================================
1278 Card_info:DEF FNCard_info(@Hp5250,INTEGER Addr5250,Card_info$(*))
1279  !==========================================================
1280  !           E5250 CARD Information Read
1281  !..........................................................
1282  ! PARAMETER : @Hp5250    : E5250A I/O Path name
1283  !           : Addr5250   : E5250A GPIB Address
1284  !           : Card_info$ : Card information data
1285  !..........................................................
1286  ! RETURN    : Error status
1287  !----------------------------------------------------------
1288    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1289  !----------------------------------------------------------
1290    DIM C_type$[50],Corp_id$[30],C_model$[10],C_sn$[10],C_rev$[10],C_tmp$[10]
1291  !----------------------------------------------------------
1292    Err_stat=0
1293    T_out=3                                        ! TIMEOUT set time
1294    Max_slot=(SIZE(Card_info$,1))                  ! Max Slot Number
1295  !----------------------------------------------------------
1296  !
1297    Hpib_sc=Addr5250 DIV 100                       ! Get GPIB Select code
1298    ON ERROR GOTO Io_error
1299    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
1300    FOR Slot=1 TO Max_slot
1301      OUTPUT @Hp5250;":SYST:CTYP? "&VAL$(Slot)     ! E5250A Card Type Query
1302      ENTER @Hp5250;C_type$                        ! E5250A Card Type Read
1303                                                   !
1304      Corp_id$=C_type$[1;(POS(C_type$,",")-1)]     ! Get Corp. ID
1305      C_type$=C_type$[(POS(C_type$,",")+1);(LEN(C_type$)-POS(C_type$,","))]
1306      C_model$=C_type$[1;(POS(C_type$,",")-1)]     ! Get Card Model name
1307      C_type$=C_type$[(POS(C_type$,",")+1);(LEN(C_type$)-POS(C_type$,","))]
1308      C_sn$=C_type$[1;(POS(C_type$,",")-1)]        ! Get Card Serial number
1309      C_rev$=C_type$[(POS(C_type$,",")+1);(LEN(C_type$)-POS(C_type$,","))] ! Get Card Revision
1310      I=1
1311      LOOP
1312        Exit_fg=0
1313      EXIT IF Card_type$(I)=""
1314        IF POS(C_model$,Card_type$(I)) THEN        ! Card type check
1315          Exit_fg=1
1316        END IF
1317      EXIT IF Exit_fg=1
1318        I=I+1
1319      END LOOP
1320      IF Exit_fg=1 THEN 
1321        Card_info$(Slot,1)=Card_type$(I)           ! Card Type set
1322      ELSE
1323        Card_info$(Slot,1)=""                      ! No Card
1324      END IF
1325                                                   !
1326      SELECT Card_info$(Slot,1)                    ! Card type check
1327      CASE Card_type$(2)                           ! Card type E5255
1328        OUTPUT @Hp5250;":SYST:CCON? "&VAL$(Slot)   ! E5255 Card Configuration Data Query
1329        ENTER @Hp5250;C_tmp$                       ! E5255 Card Configuration Data Read
1330        Tmp_str$=""
1331        Blen=FNBlock_data_conv(C_tmp$)             !
1332        FOR I=1 TO Blen
1333          Tmp_str$=Tmp_str$&(VAL$(NUM(C_tmp$[I;1])))
1334        NEXT I
1335        Card_info$(Slot,2)=Tmp_str$                !
1336      CASE ELSE                                    ! Other card type
1337        Card_info$(Slot,2)=""                      !
1338      END SELECT
1339    NEXT Slot
1340    GOTO End_sub
1341  !----------------------------------------------------------
1342 Io_error:                                         !
1343    Err_n=FNError_set(ERRN,"*** "&ERRM$)
1344    Err_stat=1
1345    GOTO End_sub
1346 Time_out:                                         ! Timeout Error
1347    Err_n=FNError_set(10002,"E5250A GPIB address,connection or firmware is bad.")
1348    Err_stat=2
1349 End_sub:                                          !
1350    OFF ERROR 
1351    OFF TIMEOUT 
1352    RETURN Err_stat
1353  FNEND
1354  !==========================================================
1355 Input_hpib_addr:SUB Input_hpib_addr(INTEGER Hpib_addr,Message$)
1356  !==========================================================
1357  !           GPIB Address Setting routine
1358  !..........................................................
1359  ! PARAMETER : Hpib_addr  : GPIB data (default data & return val.)
1360  !           : Message$   : Input Message
1361  !----------------------------------------------------------
1362    DIM Mesg$[100]
1363  !----------------------------------------------------------
1364    Max_hpib_addr=30                               ! Max Value of GPIB Address for Check
1365    Min_hpib_addr=0                                ! Max Value of GPIB Address for Check
1366    Max_hpib_sc=14                                 ! Max Value of GPIB Select code for Check
1367    Min_hpib_sc=7                                  ! Max Value of GPIB Select code for Check
1368    Def_hpib_addr=Hpib_addr                        ! Default GPIB data set
1369  !----------------------------------------------------------
1370  !
1371 Input_address:                                    !
1372    ON ERROR GOTO Hpib_addr_err
1373    IF Def_hpib_addr=0 THEN 
1374      DISP Message$;                                           ! Display Message
1375    ELSE
1376      DISP Message$&" (default "&VAL$(Def_hpib_addr)&") : ";   ! Display Message
1377    END IF
1378    INPUT Tmp_addr_str$                            ! Input data
1379    IF Tmp_addr_str$="" THEN 
1380      Tmp_addr=Def_hpib_addr                       ! Default address set
1381    ELSE
1382      Tmp_addr=VAL(Tmp_addr_str$)
1383    END IF
1384    OFF ERROR 
1385    GOSUB Hpib_addr_check                          ! Input address check
1386    DISP "Input GPIB Address. : "&VAL$(Tmp_addr)
1387    Hpib_addr=Tmp_addr
1388    GOTO End_sub
1389  !----------------------------------------------------------
1390 Hpib_addr_check:                                  ! Input Address Check
1391    IF FRACT(Tmp_addr)>0 THEN                      ! Decimal Point Check
1392      BEEP 
1393      DISP "GPIB Address is wrong"
1394      GOTO Hpib_addr_err
1395    END IF
1396    Tmp_hpib_sc=INT(Tmp_addr/100)
1397    Tmp_hpib_addr=Tmp_addr-Tmp_hpib_sc*100
1398    IF Tmp_hpib_sc<Min_hpib_sc OR Tmp_hpib_sc>Max_hpib_sc THEN          ! Select code check
1399      DISP "GPIB Select Code is wrong"
1400      BEEP 
1401      GOTO Hpib_addr_err
1402    END IF
1403    IF Tmp_hpib_addr<Min_hpib_addr OR Tmp_hpib_addr>Max_hpib_addr THEN  ! Address Check
1404      DISP "GPIB Address is wrong"
1405      BEEP 
1406      GOTO Hpib_addr_err
1407    END IF
1408    Hpib_addr=Tmp_hpib_addr
1409    RETURN 
1410  !----------------------------------------------------------
1411 Hpib_addr_err:                                    ! Input Data illegal
1412    BEEP 
1413    Tmp_addr_str$=""
1414    GOTO Input_address
1415 End_sub:                                          !
1416  SUBEND
1417  !==========================================================
1418 Main_menu:SUB Main_menu
1419  !==========================================================
1420  !           Main Menu Display
1421  !----------------------------------------------------------
1422    Xp=2                                           ! Menu display pos offset
1423    Yp=1                                           ! Menu display pos offset
1424  !----------------------------------------------------------
1425    CLEAR SCREEN
1426    PRINT TABXY(Xp,Yp);"Agilent E5250A Test Utility"
1427    PRINT TABXY(Xp,Yp+2);"** MAIN MENU **"
1428    PRINT TABXY(Xp+2,Yp+4);"SELF TEST    ...  Enter the SELF-TEST MENU   "
1429    PRINT TABXY(Xp+2,Yp+5);"LEAK TEST    ...  Enter the LEAK TEST MENU  "
1430    PRINT TABXY(Xp+2,Yp+6);"QUIT         ...  Quit This Program        "
1431    DISP "Select desired softkey."
1432  SUBEND
1433  !==========================================================
1434 Error_disp:DEF FNError_disp(Pfg,Bfg)
1435  !==========================================================
1436  !           Error Display
1437  !..........................................................
1438  ! PARAMETER : Pfg   : Display type select flag 0-> DISP,     1-> PRINT
1439  !           : Bfg   : BEEP ON/OFF select flag  0-> Non BEEP, 1-> BEEP
1440  !..........................................................
1441  ! RETURN    : Number of remain error
1442  !----------------------------------------------------------
1443    COM /Err/ Err_num(*),Err_message$(*)
1444  !----------------------------------------------------------
1445  !
1446    Max_err=(SIZE(Err_num,1))                      ! Max Error buffer size
1447    Err_cnt=0
1448    IF Err_num(1)=0 THEN End_fn
1449    IF Pfg=0 THEN 
1450      DISP Err_message$(1)                         ! Error Message Display
1451    ELSE
1452      PRINT Err_message$(1)
1453    END IF
1454    FOR N=1 TO Max_err-1                           ! Sift error buffer
1455      Err_num(N)=Err_num(N+1)
1456      Err_message$(N)=Err_masage$(N+1)
1457      IF Err_num(N)<>0 THEN 
1458        Err_cnt=Err_cnt+1
1459      END IF
1460    NEXT N
1461    IF Bfg=1 THEN BEEP 400,1
1462 End_fn:                                           !
1463    RETURN Err_cnt
1464  FNEND
1465  !==========================================================
1466 Error_set:DEF FNError_set(Error_num,Error_mesg$)
1467  !==========================================================
1468  !           Error Data set
1469  !..........................................................
1470  ! PARAMETER : Error_num   : Error number
1471  !           : Error_mesg$ : Error Message
1472  !..........................................................
1473  ! RETURN    : Numbrt of set error
1474  !----------------------------------------------------------
1475    COM /Err/ Err_num(*),Err_message$(*)
1476  !----------------------------------------------------------
1477  !
1478    Max_err=(SIZE(Err_num,1))                      ! Max Error buffer size
1479    Err_cnt=0
1480    FOR N=Max_err TO 2 STEP -1                     ! Sift error buffer
1481      Err_num(N)=Err_num(N-1)
1482      Err_message$(N)=Err_masage$(N-1)
1483      IF Err_num(N)<>0 THEN 
1484        Err_cnt=Err_cnt+1
1485      END IF
1486    NEXT N
1487    Err_num(1)=Error_num                           ! Error number set
1488    Err_message$(1)=Error_mesg$                    ! Error message set
1489                                                   !
1490    RETURN Err_cnt
1491  FNEND
1492  !==========================================================
1493 Error_clear:DEF FNError_clear(Clear_num)
1494  !==========================================================
1495  !           Error Data All clear
1496  !..........................................................
1497  ! PARAMETER : Clear_num : Number of Clear error
1498  !..........................................................
1499  ! RETURN    : Numbrt of clear error
1500  !----------------------------------------------------------
1501    COM /Err/ Err_num(*),Err_message$(*)
1502  !----------------------------------------------------------
1503  !
1504    Max_err=(SIZE(Err_num,1))                      ! Max Error buffer size
1505    Err_cnt=0
1506    IF Clear_num>Max_err THEN Clear_num=Max_err
1507    FOR N=Max_err TO Clear_num                     ! Sift error buffer
1508      IF Err_num(N)<>0 THEN 
1509        Err_cnt=Err_cnt+1
1510      END IF
1511      Err_num(N)=0                                 ! Error number clear
1512      Err_message$(N)=""                           ! Error message clear
1513    NEXT N
1514                                                   !
1515    RETURN Err_cnt
1516  FNEND
1517  !==========================================================
1518 Block_data_conv:DEF FNBlock_data_conv(B_data$)
1519  !==========================================================
1520  !           Block Format data convert
1521  !..........................................................
1522  ! PARAMETER : B_data$ : Block data : (ex.) #16123456
1523  !..........................................................
1524  ! RETURN    : Number of data byte
1525  !----------------------------------------------------------
1526    IF B_data$[1;1]="#" THEN 
1527      Clen=VAL(B_data$[2;1])
1528      IF Clen>0 THEN 
1529        Blen=VAL(B_data$[3;Clen])
1530        B_data$=B_data$[2+Clen+1;(LEN(B_data$)-(2+Clen))]
1531      ELSE
1532        Blen=0
1533      END IF
1534    ELSE
1535      Blen=0
1536    END IF
1537    RETURN Blen
1538  FNEND
1539  !==========================================================
1540 Card_in_out_que:DEF FNCard_in_out_que(Card$,Max_in,Max_out)
1541  !==========================================================
1542  !           Card IN/OUT information query
1543  !..........................................................
1544  ! PARAMETER : Card$     : Card type name
1545  !           : Max_in    : Number of INPUT
1546  !           : Max_out   : Number of OUTPUT
1547  !..........................................................
1548  ! RETURN    : Card type number 1 -> Card type E5252
1549  !           :                  2 -> Card type E5255
1550  !           :                  0 -> Card type not exist
1551  !----------------------------------------------------------
1552    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1553  !----------------------------------------------------------
1554  !
1555    SELECT Card$
1556    CASE Card_type$(1)                             ! Card type E5252
1557      Max_in=10
1558      Max_out=12
1559      Card_exist=1
1560    CASE Card_type$(2)                             ! Card type E5255
1561      Max_in=6
1562      Max_out=8
1563      Card_exist=2
1564    CASE ELSE                                      ! No Card or Not support
1565      Max_in=0
1566      Max_out=0
1567      Card_exist=0
1568    END SELECT
1569                                                   !
1570    RETURN Card_exist
1571  FNEND
1572  !==========================================================
1573  !==========================================================
1574 Self_test:SUB Self_test
1575  !==========================================================
1576  !           SELF TEST main routine
1577  !----------------------------------------------------------
1578    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1579    COM /Card_info/ Card_info$(*)
1580  !----------------------------------------------------------
1581  !
1582    GOSUB Set_fkey                                 ! Softkey set
1583    CALL Self_menu(0)                              ! Self test menu display
1584    LOOP                                           ! -- loop --
1585    END LOOP                                       !
1586    SUBEXIT
1587  !----------------------------------------------------------
1588 Set_fkey:                                         ! SELT TEST softkey setup
1589    FOR Key_no=1 TO 8
1590      ON KEY Key_no LABEL "",2 GOSUB Key_null! Softkey reset
1591    NEXT Key_no
1592    IF Card_info$(1,1)<>"" THEN                    ! Card1 exist check
1593      ON KEY 1 LABEL " CARD1  RELAY ",2 GOSUB Card1_test
1594    END IF
1595    IF Card_info$(2,1)<>"" THEN                    ! Card2 exist check
1596      ON KEY 2 LABEL " CARD2  RELAY ",2 GOSUB Card2_test
1597    END IF
1598    IF Card_info$(3,1)<>"" THEN                    ! Card3 exist check
1599      ON KEY 3 LABEL " CARD3  RELAY ",2 GOSUB Card3_test
1600    END IF
1601    IF Card_info$(4,1)<>"" THEN                    ! Card4 exist check
1602      ON KEY 4 LABEL " CARD4  RELAY ",2 GOSUB Card4_test
1603    END IF
1604    ON KEY 5 LABEL " CONTR- OLLER ",2 GOSUB Controller_test
1605    ON KEY 6 LABEL " FRONT  PANEL ",2 GOSUB Front_pan_test
1606    ON KEY 7 LABEL " MAIN   MENU  ",2 GOTO Self_test_end
1607    RETURN 
1608 Key_null:                                         !
1609                                                   !
1610    RETURN 
1611  !----------------------------------------------------------
1612 Card1_test:                                       ! Card1 test
1613    CALL Card_relay_test(1)
1614    RETURN 
1615 Card2_test:                                       ! Card2 test
1616    CALL Card_relay_test(2)
1617    RETURN 
1618 Card3_test:                                       ! Card3 test
1619    CALL Card_relay_test(3)
1620    RETURN 
1621 Card4_test:                                       ! Card4 test
1622    CALL Card_relay_test(4)
1623    RETURN 
1624 Controller_test:                                  ! Controller test
1625    CALL Frame_test(0)
1626    RETURN 
1627 Front_pan_test:                                   ! Front Panel test
1628    CALL Frame_test(1)
1629    RETURN 
1630 Self_test_end:                                    !
1631    CALL Main_menu
1632  SUBEND
1633  !==========================================================
1634  !
1635 Self_menu:SUB Self_menu(Draw_fg)
1636  !==========================================================
1637  !           SELF TEST Menu Display
1638  !..........................................................
1639  ! PARAMETER : Draw_fg   : Display Item select flag
1640  !           :           :       0 -> All menu drawing
1641  !           :           :   1 - 4 -> Card item drawing
1642  !           :           :       5 -> Control item drawing
1643  !           :           :       6 -> Front panel item drawing
1644  !----------------------------------------------------------
1645    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1646    COM /Card_info/ Card_info$(*)
1647  !----------------------------------------------------------
1648    DIM Tstr$[100],Dstr$[150]
1649  !----------------------------------------------------------
1650    Xp=2                                           ! Menu display pos offset
1651    Yp=1                                           ! Menu display pos offset
1652  !----------------------------------------------------------
1653    IF Draw_fg=0 THEN 
1654      CLEAR SCREEN
1655      PRINT TABXY(Xp,Yp);"Agilent E5250A Test Utility"
1656      PRINT TABXY(Xp,Yp+2);"** SELF-TEST MENU **"
1657    END IF
1658                                                   !
1659    FOR Slot=1 TO (SIZE(Card_info$,1))
1660      IF Draw_fg=0 OR Draw_fg=Slot THEN 
1661        Card$=Card_info$(Slot,1)
1662        SELECT Card$
1663        CASE Card_type$(1)                         ! Card type E5252
1664          Ts$=FNGet_test_stat$(Slot)               ! Test state check
1665          Tstr$="Start Slot"&VAL$(Slot)&" E5252A Relay Test     ["&Ts$&"]"
1666        CASE Card_type$(2)                         ! Card type E5250
1667          Ts$=FNGet_test_stat$(Slot)               ! Test state check
1668          Tstr$="Start Slot"&VAL$(Slot)&" E5255A Relay Test     ["&Ts$&"]"
1669        CASE ELSE                                  ! Other type
1670          Tstr$="Not Installed"
1671        END SELECT
1672        OUTPUT Dstr$ USING "12A,4A,K";"CARD"&VAL$(Slot)&" RELAY","...",Tstr$
1673        PRINT TABXY(Xp+3,Yp+Slot+3);Dstr$
1674      END IF
1675    NEXT Slot
1676                                                   !
1677    IF Draw_fg=0 OR Draw_fg=5 THEN                 !
1678      Ts$=FNGet_test_stat$(-1)
1679      Tstr$="Start E5250A Controller Test      ["&Ts$&"]"
1680      OUTPUT Dstr$ USING "12A,4A,K";"CONTROLLER","...",Tstr$
1681      PRINT TABXY(Xp+3,Yp+8);Dstr$
1682    END IF
1683                                                   !
1684    IF Draw_fg=0 OR Draw_fg=6 THEN                 !
1685      Ts$=FNGet_test_stat$(0)
1686      Tstr$="Start E5250A Front Panel UIF Test ["&Ts$&"]"
1687      OUTPUT Dstr$ USING "12A,4A,K";"FRONT PANEL","...",Tstr$
1688      PRINT TABXY(Xp+3,Yp+9);Dstr$
1689    END IF
1690                                                   !
1691    IF Draw_fg=0 THEN                              !
1692      OUTPUT Dstr$ USING "12A,4A,K";"MAIN MENU","...","Return to MAIN MENU"
1693      PRINT TABXY(Xp+3,Yp+10);Dstr$
1694      PRINT TABXY(Xp+3,Yp+12);"[P] indicates test was passed."
1695      PRINT TABXY(Xp+3,Yp+13);"[F] indicates test was failed."
1696      PRINT TABXY(Xp+3,Yp+14);"[N] indicates test was not executed."
1697                                                   !
1698      PRINT TABXY(Xp+3,Yp+16);"Prepare the relay test adapters"
1699      PRINT TABXY(Xp+3,Yp+17);"before you select ""CARDn RELAY"" key."
1700    END IF
1701                                                   !
1702    DISP "Select desired softkey."
1703  SUBEND
1704  !==========================================================
1705 Get_test_stat:DEF FNGet_test_stat$(Test_type)
1706  !==========================================================
1707  !           Get TEST State data
1708  !..........................................................
1709  ! PARAMETER : Test_type : Test type number -1  -> Controller test
1710  !           :           :                   0  -> Front Panel test
1711  !           :           :                  1-4 -> #1 - #4 Card test
1712  !..........................................................
1713  ! RETURN    : Test state string "P" -> Test Pass
1714  !           :                   "F" -> Test Fail
1715  !           :                   "N" -> Not tested
1716  !----------------------------------------------------------
1717    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1718    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1719  !----------------------------------------------------------
1720  !
1721    SELECT Test_type
1722    CASE -1
1723      OUTPUT @Hp5250;":DIAG:TEST:FRAM:STAT? CONT"  ! Get Controller test state
1724      ENTER @Hp5250;S
1725                                                   !
1726    CASE 0
1727      OUTPUT @Hp5250;":DIAG:TEST:FRAM:STAT? FPAN"  ! Get Front Panel test state
1728      ENTER @Hp5250;S
1729    CASE 1,2,3,4
1730      OUTPUT @Hp5250;":DIAG:TEST:CARD:STAT? "&VAL$(Test_type)  ! Get Card test state
1731      ENTER @Hp5250;S
1732    CASE ELSE
1733      S=10                                         ! Error case -> return "E"
1734    END SELECT
1735                                                   !
1736    SELECT S                                       ! Return val. set
1737    CASE -1
1738      Test_stat$="N"
1739    CASE 0
1740      Test_stat$="P"
1741    CASE 1
1742      Test_stat$="F"
1743    CASE ELSE
1744      Test_stat$="E"
1745    END SELECT
1746                                                   !
1747    RETURN Test_stat$
1748  FNEND
1749  !==========================================================
1750  !
1751 Card_relay_test:SUB Card_relay_test(Card_number)
1752  !==========================================================
1753  !           CARD Relay Test
1754  !..........................................................
1755  ! PARAMETER : Card_number : Card number
1756  !----------------------------------------------------------
1757    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1758    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1759    COM /Card_info/ Card_info$(*)
1760  !----------------------------------------------------------
1761    Dxp=1                                          ! Message display origin col
1762    Dyp=20                                         ! Message display origin row
1763    Max_col=58                                     ! Max display column
1764                                                   !
1765    Adapt$="E5250-60002"                           ! E5252 Test adapter type
1766    Scap$="1250-0929"                              ! E5255 Short cap type
1767  !----------------------------------------------------------
1768  !
1769    GOSUB Clear_disp                               ! Clear Display
1770                                                   !
1771    SELECT Card_info$(Card_number,1)
1772    CASE Card_type$(1)                             ! Card type E5252
1773      PRINT TABXY(Dxp,Dyp);"Attach the relay test adapter on input terminal and"
1774      PRINT TABXY(Dxp,Dyp+1);"open all output of slot "&VAL$(Card_number)&"."
1775    CASE Card_type$(2)                             ! Card type E5255
1776      PRINT TABXY(Dxp,Dyp);"Attach the relay test adapter and the BNC short cap to"
1777      PRINT TABXY(Dxp,Dyp+1);"E5250A/E5255A input. And open all output of slot "&VAL$(Card_number)&"."
1778    END SELECT
1779                                                   !
1780    GOSUB Select_cont                              !
1781    GOSUB Clear_disp                                 !
1782                                                   !
1783    PRINT TABXY(Dxp,Dyp+1);"Now executing the slot "&VAL$(Card_number)&" card relay test."
1784    GOSUB Softkey_clear
1785    Stat$=FNCard_test_exec$(Card_number)           ! Card test execute
1786    GOSUB Clear_disp                               !
1787    SELECT Stat$                                   ! Test state display
1788    CASE "P"                                       ! Test Passed
1789      CALL Self_menu(Card_number)                  ! Menu redraw
1790      PRINT TABXY(Dxp,Dyp+1);"Slot "&VAL$(Card_number)&" relay test passed."
1791    CASE "F"                                       ! Test Failed
1792      CALL Self_menu(Card_number)                  ! Menu redraw
1793      PRINT TABXY(Dxp,Dyp+1);"Slot "&VAL$(Card_number)&" relay test failed."
1794    CASE ELSE                                      ! Other result
1795      CALL Self_menu(Card_number)                  !
1796    END SELECT
1797    GOTO Card_test_end
1798  !----------------------------------------------------------
1799 Select_cont:                                      ! CONT/CANCEL select
1800    GOSUB Softkey_clear                            ! Softkey reset
1801    ON KEY 1 LABEL " CONT-  INUE  ",3 GOTO Cont_test
1802    ON KEY 7 LABEL "CANCEL        ",3 GOTO Cancel_test
1803    LOOP                                           ! Wait select softkey
1804    END LOOP                                       !
1805 Cont_test:                                        ! Test continue
1806    RETURN 
1807 Softkey_clear:                                    ! Softkey clear
1808    FOR Key_no=1 TO 8
1809      ON KEY Key_no LABEL "",3 GOSUB Key_null        ! Softkey reset
1810    NEXT Key_no
1811    RETURN 
1812 Key_null:                                         !
1813    RETURN 
1814  !----------------------------------------------------------
1815 Clear_disp:                                       ! Clear display line
1816    DISP 
1817    PRINT TABXY(Dxp,Dyp);RPT$(" ",Max_col)
1818    PRINT TABXY(Dxp,Dyp+1);RPT$(" ",Max_col)
1819    RETURN 
1820 Cancel_test:                                      ! Test Cancel
1821    GOSUB Clear_disp
1822    GOTO Card_test_end
1823 Card_test_end:                                    ! End
1824  SUBEND
1825  !==========================================================
1826 Card_test_exec:DEF FNCard_test_exec$(Card_number)
1827  !==========================================================
1828  !           Card relay test execut
1829  !..........................................................
1830  ! PARAMETER : Card_number : Card number
1831  !..........................................................
1832  ! RETURN    : Test state string "P" -> Test Pass
1833  !           :                   "F" -> Test Fail
1834  !           :                   "N" -> Not tested
1835  !----------------------------------------------------------
1836    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1837    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1838    COM /Test3/ Stat_dat                           !** TEST
1839  !----------------------------------------------------------
1840  !
1841    OUTPUT @Hp5250;":DIAG:TEST:CARD:EXEC? "&VAL$(Card_number) ! Card test execute
1842    ENTER @Hp5250;S
1843    SELECT S
1844    CASE -1                                        ! No test
1845      Test_stat$="N"
1846    CASE 0                                         ! Test passed
1847      Test_stat$="P"
1848    CASE 1                                         ! Test failed
1849      Test_stat$="F"
1850    CASE ELSE                                      ! ????
1851      Test_stat$="E"
1852    END SELECT
1853                                                   !
1854    RETURN Test_stat$
1855  FNEND
1856  !==========================================================
1857 Frame_test:SUB Frame_test(Test_obj)
1858  !==========================================================
1859  !           Frame selftest
1860  !..........................................................
1861  ! PARAMETER : Test_obj : Test object 0 -> Controller, 1 -> Front panel
1862  !----------------------------------------------------------
1863    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1864    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1865    COM /Card_info/ Card_info$(*)
1866  !----------------------------------------------------------
1867    DIM Rstr$[30]
1868  !----------------------------------------------------------
1869    Dxp=1                                          ! Message display origin col
1870    Dyp=20                                         ! Message display origin row
1871    Max_col=58                                     ! Max display column
1872  !----------------------------------------------------------
1873  !
1874    GOSUB Clear_disp                               ! Clear Display
1875    SELECT Test_obj
1876    CASE 0                                         ! Controller test
1877      PRINT TABXY(Dxp,Dyp+1);"Now executing the Frame Controller self-test."
1878      Rstr$="Frame Controller"
1879      Dl=5
1880    CASE 1                                         ! Front Panel test
1881      PRINT TABXY(Dxp,Dyp);"Confirm that 4 LEDs are blinking,"
1882      PRINT TABXY(Dxp,Dyp+1);"then press TEST key on front panel ( within 10sec )."
1883      Rstr$="Front Panel UIF"
1884      Dl=6
1885    CASE ELSE                                      ! ????
1886      GOTO Frame_test_end
1887    END SELECT
1888                                                   !
1889    GOSUB Softkey_clear                            ! Softkey clear
1890    Stat$=FNFrame_test_exec$(Test_obj)             ! Fram test execue
1891    GOSUB Clear_disp                               !
1892    SELECT Stat$                                   ! Test state display
1893    CASE "P"                                       ! Test Passed
1894      CALL Self_menu(Dl)                           ! Status display redraw
1895      PRINT TABXY(Dxp,Dyp+1);Rstr$&" self-test passed."
1896    CASE "F"                                       ! Test failed
1897      CALL Self_menu(Dl)                           ! Status display redraw
1898      PRINT TABXY(Dxp,Dyp+1);Rstr$&" self-test failed."
1899    CASE ELSE                                      ! Other result
1900      CALL Self_menu(Dl)                           !
1901    END SELECT
1902    GOTO Card_test_end
1903  !----------------------------------------------------------
1904 Softkey_clear:                                    ! Softkey clear
1905    FOR Key_no=1 TO 8
1906      ON KEY Key_no LABEL "",3 GOSUB Key_null        ! Softkey reset
1907    NEXT Key_no
1908    RETURN 
1909 Key_null:                                         !
1910    RETURN 
1911  !----------------------------------------------------------
1912 Clear_disp:                                       ! Clear display line
1913    DISP 
1914    PRINT TABXY(Dxp,Dyp);RPT$(" ",Max_col)
1915    PRINT TABXY(Dxp,Dyp+1);RPT$(" ",Max_col)
1916    RETURN 
1917 Card_test_end:                                    !
1918  SUBEND
1919  !==========================================================
1920 Frame_test_exec:DEF FNFrame_test_exec$(Test_obj)
1921  !==========================================================
1922  !           Frame selftest execut
1923  !..........................................................
1924  ! PARAMETER : Test_obj  : Test Object  0 -> Controller, 1 -> Front Panel
1925  !..........................................................
1926  ! RETURN    : Test state string "P" -> Test Pass
1927  !           :                   "F" -> Test Fail
1928  !           :                   "N" -> Not tested
1929  !----------------------------------------------------------
1930    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1931    COM /Hp5250/ @Hp5250,INTEGER Addr5250
1932  !----------------------------------------------------------
1933  !
1934    IF Test_obj=0 THEN 
1935      OUTPUT @Hp5250;":DIAG:TEST:FRAM:EXEC? CONT" ! Card test execute
1936    ELSE
1937      OUTPUT @Hp5250;":DIAG:TEST:FRAM:EXEC? FPAN" ! Card test execute
1938    END IF
1939    ENTER @Hp5250;S
1940                                                   !
1941    SELECT S
1942    CASE -1                                        ! No test
1943      Test_stat$="N"
1944    CASE 0                                         ! Test passed
1945      Test_stat$="P"
1946    CASE 1                                         ! Test failed
1947      Test_stat$="F"
1948    CASE ELSE                                      ! ????
1949      Test_stat$="E"
1950    END SELECT
1951                                                   !
1952    RETURN Test_stat$
1953  FNEND
1954  !==========================================================
1955  !==========================================================
1956 Leak_test:SUB Leak_test
1957  !==========================================================
1958  !           LEAK TEST main routine
1959  !----------------------------------------------------------
1960    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
1961    COM /Card_info/ Card_info$(*)
1962    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
1963    INTEGER Tmp_addr
1964  !----------------------------------------------------------
1965    Dxp=1                                     ! Message display origin col
1966    Dyp=20                                    ! Message display origin row
1967    Max_col=58                                ! Max display column
1968  !----------------------------------------------------------
1969    CLEAR SCREEN
1970    GOSUB Softkey_clear                       ! Softkey clear
1971    Tmp_addr=Addr415x                         ! Backup Address
1972    CALL Input_hpib_addr(Addr415x,"Input 4155/4156 GPIB Address ")
1973    DISP "Initializing."                      !
1974                                              !
1975    CALL Init_check_5250(Err)                 ! E5250 Check & Initialize
1976    IF Err<>0 THEN Error_exit                 !
1977    CALL Init_check_415x(Err)                 ! 415X Check & Initialize
1978    IF Err<>0 THEN Error_exit                 !
1979    DISP                                      !
1980                                              !
1981    CALL Leak_main_menu                       ! Leak test main menu display
1982    Key_redraw=1                              !
1983    LOOP                                      ! -- Loop --
1984      IF Key_redraw=1 THEN                    !
1985        GOSUB Set_fkey                        ! Leak test softkey setup
1986      END IF                                  !
1987    END LOOP                                  !
1988    SUBEXIT
1989  !----------------------------------------------------------
1990 Set_fkey:                                    ! Softkey setup
1991    GOSUB Softkey_clear                       ! Softkey clear
1992    Key_redraw=0
1993    ON KEY 1 LABEL " START  TEST  ",2 GOSUB Test_start
1994    ON KEY 7 LABEL " MAIN   MENU  ",2 GOTO Leak_test_end
1995    RETURN 
1996 Softkey_clear:                               ! Softkey clear
1997    Key_redraw=1
1998    FOR Key_no=1 TO 8
1999      ON KEY Key_no LABEL "",2 GOSUB Key_null
2000    NEXT Key_no
2001    RETURN 
2002 Key_null:                                    ! Dummy key
2003    RETURN 
2004  !----------------------------------------------------------
2005 Test_start:                                  ! Leak Test start
2006    GOSUB Softkey_clear
2007    CALL Leak_test_start
2008    CALL Leak_main_menu
2009    RETURN 
2010 Error_exit:                                  ! Error exit
2011    CALL Stat_mesg_disp(-1)                   ! Error status display
2012    LOOP
2013    EXIT IF FNError_disp(0,1)=0               ! Error Message display
2014    END LOOP
2015    Addr415x=Tmp_addr                         ! Address restore
2016    PRINT TABXY(Dxp,Dyp+1);"MAIN MENU  ... Return to MAIN MENU"
2017    GOSUB Softkey_clear                       ! Softkey clear
2018    ON KEY 7 LABEL " MAIN   MENU  ",2 GOTO Leak_test_end
2019    LOOP                                      ! -- Loop --
2020    END LOOP                                  !
2021 Leak_test_end:                               ! Test End
2022    CALL Main_menu
2023  SUBEND
2024  !==========================================================
2025  !
2026 Leak_main_menu: SUB Leak_main_menu
2027  !==========================================================
2028  !           LEAK TEST Main Menu Display
2029  !----------------------------------------------------------
2030    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2031    COM /Card_info/ Card_info$(*)
2032    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2033  !----------------------------------------------------------
2034    DIM Tstr$[100],Dstr$[150]
2035  !----------------------------------------------------------
2036    Xp=2                                      ! Menu display pos offset
2037    Yp=1                                      ! Menu display pos offset
2038  !----------------------------------------------------------
2039    CLEAR SCREEN
2040    PRINT TABXY(Xp,Yp);"Agilent E5250A Test Utility"
2041    PRINT TABXY(Xp,Yp+2);"** LEAK TEST MENU **"
2042                                              !
2043    PRINT TABXY(Xp+2,Yp+4);"START TEST   ...  Start Leak Test           "
2044    PRINT TABXY(Xp+2,Yp+5);"MAIN MENU    ...  Return to MAIN MENU       "
2045                                              !
2046    PRINT TABXY(Xp+1,Yp+7);"CURRENT INSTRUMENT SETTING"
2047    PRINT TABXY(Xp+2,Yp+8);"INSTRUMENT TYPE     =  "&Hp415x_type$
2048    PRINT TABXY(Xp+2,Yp+9);"INSTRUMENT ADDRESS  =  "&VAL$(Addr415x)
2049                                              !
2050    PRINT TABXY(Xp+2,Yp+11);"Prepare the instrument before you select"
2051    PRINT TABXY(Xp+2,Yp+12);"""START TEST"" key."
2052                                              !
2053    DISP "Select desired softkey."
2054  SUBEND
2055  !==========================================================
2056 Leak_test_start: SUB Leak_test_start
2057  !==========================================================
2058  !           LEAK TEST start
2059  !----------------------------------------------------------
2060    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2061    COM /Hp5250/ @Hp5250,INTEGER Addr5250
2062    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2063    COM /Card_info/ Card_info$(*)
2064    COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(*),Hold_time,Fvolt,Icomp,Range,I_name$
2065  !----------------------------------------------------------
2066    Dxp=1                                     ! Message display origin col
2067    Dyp=20                                    ! Message display origin row
2068    Max_col=58                                ! Max display column
2069  !----------------------------------------------------------
2070  !
2071    CLEAR SCREEN                              !
2072    CALL Leak_exec_menu(0,0)                  ! Menu Dispaly
2073    GOSUB Clear_disp                          ! Clear Display
2074    PRINT TABXY(Dxp,Dyp+1);"Select IV Port of Leak Test by softkey."
2075    GOSUB Select_iv                           ! Select IV port
2076    GOSUB Clear_disp                          !
2077                                              !
2078    CALL Leak_exec_menu(Ivp,1)                ! IV port number display
2079                                              ! Kelvin cnnection check
2080    IF Hp415x_type$=FNInst_name$(2) THEN      ! Inst. type = 4156 ?
2081      Exist_fg=0
2082      FOR Slot=1 TO (SIZE(Card_info$,1))
2083        IF Card_info$(Slot,1)=Card_type$(1) THEN   ! E5252 card check
2084          Exist_fg=Exist_fg+1
2085        END IF
2086      NEXT Slot
2087      IF Exist_fg>0 THEN                      ! E5252 card exist ?
2088        SELECT Ivp
2089        CASE 1,3,5                            ! IV=1,3,5 ?
2090          PRINT TABXY(Dxp,Dyp+1);"Is IV"&VAL$(Ivp)&" Port a Kelvin connection?"
2091          GOSUB Select_kelvin                 ! Kelvin connection select
2092          GOSUB Clear_disp
2093        CASE ELSE
2094          Kvc=0                               ! Kelvin connection not selected
2095        END SELECT
2096      ELSE
2097        Kvc=0                                 ! Kelvin connection not selected
2098      END IF
2099    ELSE                                      ! Inst. type <> 4156
2100      Kvc=0                                   ! Kelvin connection not selected
2101    END IF
2102                                              !
2103    CALL Smu_check(Smu_list(*))               ! SMU exist list
2104    PRINT TABXY(Dxp,Dyp+1);"Select SMU channel for IV"&VAL$(Ivp)&" leak measurement by softkey."
2105    GOSUB Select_smu                          ! Select SMU
2106    GOSUB Clear_disp                          !
2107                                              !
2108    GOSUB Softkey_clear
2109    CALL Leak_test_exec(Stat)                 ! Leak Test execute
2110    IF Stat<0 THEN Error_exit
2111                                              !
2112    Err_=FNReset_415x(@Hp415x,Hp415x_type$,Addr415x) ! 415x Reset
2113    GOSUB Rep_out_select                      ! Test result report
2114                                              !
2115    GOTO Leak_test_end
2116  !----------------------------------------------------------
2117 Select_iv:                                   ! IV port selecting
2118    Ivp=-1
2119    GOSUB Softkey_clear                       ! Softkey reset
2120    IF FNAvail_ivp(1)=1 THEN ON KEY 1 LABEL "  IV1         ",3 GOSUB Iv1
2121    IF FNAvail_ivp(2)=1 THEN ON KEY 2 LABEL "  IV2         ",3 GOSUB Iv2
2122    IF FNAvail_ivp(3)=1 THEN ON KEY 3 LABEL "  IV3         ",3 GOSUB Iv3
2123    IF FNAvail_ivp(4)=1 THEN ON KEY 4 LABEL "  IV4         ",3 GOSUB Iv4
2124    IF FNAvail_ivp(5)=1 THEN ON KEY 5 LABEL "  IV5         ",3 GOSUB Iv5
2125    IF FNAvail_ivp(6)=1 THEN ON KEY 6 LABEL "  IV6         ",3 GOSUB Iv6
2126    ON KEY 7 LABEL "CANCEL        ",3 GOTO Cancel_test
2127    LOOP                                      ! Wait select softkey
2128      IF Ivp<>-1 THEN RETURN 
2129    END LOOP                                  !
2130                                              !
2131 Iv1: GOSUB Softkey_clear
2132    Ivp=1                                     ! Selet IV1 port
2133    RETURN 
2134 Iv2: GOSUB Softkey_clear
2135    Ivp=2                                     ! Selet IV2 port
2136    RETURN 
2137 Iv3: GOSUB Softkey_clear
2138    Ivp=3                                     ! Selet IV3 port
2139    RETURN 
2140 Iv4: GOSUB Softkey_clear
2141    Ivp=4                                     ! Selet IV4 port
2142    RETURN 
2143 Iv5: GOSUB Softkey_clear
2144    Ivp=5                                     ! Selet IV5 port
2145    RETURN 
2146 Iv6: GOSUB Softkey_clear
2147    Ivp=6                                     ! Selet IV6 port
2148    RETURN 
2149  !----------------------------------------------------------
2150 Select_kelvin:                               ! Kelvin connection select
2151    Kvc=-1
2152    GOSUB Softkey_clear                       ! Softkey reset
2153    ON KEY 1 LABEL " YES          ",3 GOSUB Yes_select
2154    ON KEY 2 LABEL " NO           ",3 GOSUB No_select
2155    ON KEY 7 LABEL "CANCEL        ",3 GOTO Cancel_test
2156    LOOP                                      ! Wait select softkey
2157      IF Kvc<>-1 THEN RETURN 
2158    END LOOP                                  !
2159                                              !
2160 Yes_select: GOSUB Softkey_clear              ! Kelvin connection selected
2161    Kvc=1
2162    RETURN 
2163 No_select: GOSUB Softkey_clear               !
2164    Kvc=0
2165    RETURN 
2166  !----------------------------------------------------------
2167 Select_smu:                                  ! SMU select
2168    Smu=-1
2169    GOSUB Softkey_clear                       ! Softkey reset
2170    IF Smu_list(1)=1 THEN ON KEY 1 LABEL " SMU1         ",3 GOSUB Smu1
2171    IF Smu_list(2)=1 THEN ON KEY 2 LABEL " SMU2         ",3 GOSUB Smu2
2172    IF Smu_list(3)=1 THEN ON KEY 3 LABEL " SMU3         ",3 GOSUB Smu3
2173    IF Smu_list(4)=1 THEN ON KEY 4 LABEL " SMU4         ",3 GOSUB Smu4
2174    IF Smu_list(5)=1 THEN ON KEY 5 LABEL " SMU5         ",3 GOSUB Smu5
2175    IF Smu_list(6)=1 THEN ON KEY 6 LABEL " SMU6         ",3 GOSUB Smu6
2176    ON KEY 7 LABEL "CANCEL        ",3 GOTO Cancel_test
2177    LOOP                                      ! -- Loop --
2178      IF Smu<>-1 THEN RETURN 
2179    END LOOP                                  !
2180                                              !
2181 Smu1: GOSUB Softkey_clear
2182    Smu=1                                     ! Selet SMU1
2183    RETURN 
2184 Smu2: GOSUB Softkey_clear
2185    Smu=2                                     ! Selet SMU2
2186    RETURN 
2187 Smu3: GOSUB Softkey_clear
2188    Smu=3                                     ! Selet SMU3
2189    RETURN 
2190 Smu4: GOSUB Softkey_clear
2191    Smu=4                                     ! Selet SMU4
2192    RETURN 
2193 Smu5: GOSUB Softkey_clear
2194    Smu=5                                     ! Selet SMU5
2195    RETURN 
2196 Smu6: GOSUB Softkey_clear
2197    Smu=6                                     ! Selet SMU6
2198    RETURN 
2199  !----------------------------------------------------------
2200 Select_cont:                                 ! CONT/CANCEL select
2201    Ret_flag=-1
2202    GOSUB Softkey_clear                       ! Softkey clear
2203    ON KEY 1 LABEL " CONT-  INUE  ",3 GOSUB Cont_test
2204    ON KEY 7 LABEL "CANCEL        ",3 GOTO Cancel_test
2205    LOOP                                      ! -- Loop --
2206      IF Ret_flag<>-1 THEN RETURN 
2207    END LOOP                                  !
2208 Cont_test: GOSUB Softkey_clear               ! Test continue
2209    Ret_flag=1
2210    RETURN 
2211  !----------------------------------------------------------
2212 Softkey_clear:                               ! Softkey clear
2213    FOR Key_no=1 TO 8
2214      ON KEY Key_no LABEL "",3 GOSUB Key_null
2215    NEXT Key_no
2216    RETURN 
2217 Key_null:                                    ! Dummy key
2218    RETURN 
2219  !----------------------------------------------------------
2220 Clear_disp:                                  ! Clear display line
2221    DISP 
2222    PRINT TABXY(Dxp,Dyp);RPT$(" ",Max_col)
2223    PRINT TABXY(Dxp,Dyp+1);RPT$(" ",Max_col)
2224    RETURN 
2225  !----------------------------------------------------------
2226 Rep_out_select:                              ! Report output select
2227    GOSUB Pass_fail_disp
2228    GOSUB Softkey_clear                       ! Softkey clear
2229    ON KEY 1 LABEL "REPORT   CRT  ",3 GOSUB Crt_out
2230 !
2231 !++++++++  Comment out REPORT FILE function  ++++++++++
2232 !++++ ON KEY 2 LABEL "REPORT  FILE  ",3 GOSUB File_out
2233 !++++++++++++++++++++++++++++++++++++++++++++++++++++++
2234 !
2235    ON KEY 7 LABEL " LEAK   TEST  ",3 GOTO Cancel_test
2236    LOOP                                      ! -- Loop --
2237    END LOOP
2238 Crt_out:                                     ! Report CRT output
2239    CALL Report_out(0)                        !
2240    CLEAR SCREEN
2241    GOSUB Pass_fail_disp
2242    RETURN 
2243 File_out:                                    ! Report File output
2244    CALL Report_out(1)                        !
2245    CLEAR SCREEN
2246    GOSUB Pass_fail_disp
2247    RETURN 
2248 Pass_fail_disp:                              ! Pass/Fail status dispaly
2249    CALL Leak_exec_menu(Ivp,1)                ! IV port number display
2250    CALL Stat_mesg_disp(Stat)                 ! Status display
2251    PRINT TABXY(Dxp,Dyp);"REPORT CRT  ... Send report to CRT       "
2252 !
2253 !++++++++  Comment out REPORT FILE function  ++++++++++
2254 !+ PRINT TABXY(Dxp,Dyp);"REPORT FILE ... Send report to File       "
2255 !++++++++  Comment out REPORT FILE function  ++++++++++
2256 !
2257    PRINT TABXY(Dxp,Dyp+1);"LEAK TEST   ... Return to LEAK TEST MENU"
2258    RETURN 
2259  !----------------------------------------------------------
2260 Error_exit:                                  ! Error exit
2261    IF Stat=-1 THEN 
2262      CALL Stat_mesg_disp(-1)                 ! Error status display
2263      LOOP
2264      EXIT IF FNError_disp(0,1)=0             ! Error Message display
2265      END LOOP
2266    ELSE
2267      GOTO Cancel_test ! PRINT TABXY(Dxp,Dyp);"Cancel Test "
2268    END IF
2269    PRINT TABXY(Dxp,Dyp+1);"LEAK TEST  ... Return to LEAK TEST MENU"
2270    GOSUB Softkey_clear                       ! Softkey clear
2271    ON KEY 7 LABEL " LEAK   TEST  ",3 GOTO Cancel_test
2272    LOOP                                      ! -- Loop --
2273    END LOOP                                  !
2274  !----------------------------------------------------------
2275 Cancel_test:                                 ! Test Cancel
2276    GOSUB Softkey_clear
2277    GOSUB Clear_disp
2278    GOTO Leak_test_end
2279 Leak_test_end:                               !
2280  SUBEND
2281  !==========================================================
2282 Leak_test_exec: SUB Leak_test_exec(Fail_stat)
2283  !==========================================================
2284  !           LEAK TEST Execute
2285  !..........................................................
2286  ! PARAMETER : Fail_stat : Pass/Fail result
2287  !----------------------------------------------------------
2288    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2289    COM /Hp5250/ @Hp5250,INTEGER Addr5250
2290    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2291    COM /Card_info/ Card_info$(*)
2292    COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(*),Hold_time,Fvolt,Icomp,Range,I_name$
2293    COM /Meas_data/ Meas_data$(*)
2294  !----------------------------------------------------------
2295    Error_stat=0
2296    Sp1$=","                                  ! Measurement data separater
2297    Sp2$=":"                                  ! Measurement data separater
2298  !----------------------------------------------------------
2299  !
2300    DISP Hp415x_type$;" Measurement Setup."   !
2301                                              !
2302    Hold_time=1.0                             ! Sampling Hold Time
2303    Fvolt=10.0                                ! Force voltage
2304    I_name$="ILdata"                          ! INAME
2305                                              !
2306    SELECT Hp415x_type$
2307    CASE FNInst_name$(1)                      ! 4155 setup data
2308      Icomp=1.E-6                             !   I Compliance
2309      Range=1.E-9                             !   Meas. Range
2310    CASE FNInst_name$(2)                      ! 4156 setup data
2311      Icomp=1.E-6                             !   I Compliance
2312      Range=1.E-10                            !   Meas. Range
2313    CASE ELSE
2314      Err_n=FNError_set(10030,"Instrument type is unknown")
2315      Err_stat=6
2316      GOTO Error_exit
2317    END SELECT
2318                                              !
2319    CALL Meas_set_415x(Err_stat)              ! 415x Measurement setting
2320    IF Err_stat<>0 THEN Error_exit
2321                                              !
2322    CALL Set_cpl_port(@Hp5250,Kvc,Ivp,Addr5250) ! E5250 Couple port set & Couple all on
2323                                              !
2324    MAT Meas_data$= ("")                      ! Meas_data clear
2325    FOR Slot=1 TO (SIZE(Card_info$,1))
2326      IF Card_info$(Slot,1)<>"" THEN 
2327        C_type_n=FNCard_in_out_que(Card_info$(Slot,1),Max_in,Max_out)
2328        SELECT Card_info$(Slot,1)
2329        CASE Card_type$(1)                    ! Card type E5252
2330          Meas_data$(Slot)=Card_type$(1)&Sp1$
2331          IF Kvc=1 THEN                       ! Kelvin connection for only E5252
2332            FOR Out=1 TO Max_out STEP 2
2333              DISP "Measurement : CARD";Slot;" (";Card_info$(Slot,1);") : OUT";Out
2334              OUTPUT Chanel$ USING "2A,1D,2Z,2Z,A";"(@",Slot,Ivp,Out,")"
2335              OUTPUT @Hp5250;":ROUT:CLOS "&Chanel$
2336              OUTPUT @Hp5250;"*OPC?"
2337              ENTER @Hp5250;Cp
2338              OUTPUT @Hp415x;":PAGE:SCON:SING"
2339              OUTPUT @Hp415x;"*OPC?"
2340              ENTER @Hp415x;Cp
2341              OUTPUT @Hp415x;":TRAC? '"&I_name$&"'"
2342              ENTER @Hp415x;Idata$
2343              OUTPUT @Hp5250;":ROUT:OPEN "&Chanel$
2344              Meas_data$(Slot)=Meas_data$(Slot)&VAL$(Out)&Sp2$&Idata$&Sp1$
2345            NEXT Out
2346          ELSE                                ! Non Kelvin connection E5252
2347            FOR Out=1 TO Max_out
2348              DISP "Measurement : CARD";Slot;" (";Card_info$(Slot,1);") : OUT";Out
2349              OUTPUT Chanel$ USING "2A,1D,2Z,2Z,A";"(@",Slot,Ivp,Out,")"
2350              OUTPUT @Hp5250;":ROUT:CLOS "&Chanel$
2351              OUTPUT @Hp5250;"*OPC?"
2352              ENTER @Hp5250;Cp
2353              OUTPUT @Hp415x;":PAGE:SCON:SING"
2354              OUTPUT @Hp415x;"*OPC?"
2355              ENTER @Hp415x;Cp
2356              OUTPUT @Hp415x;":TRAC? '"&I_name$&"'"
2357              ENTER @Hp415x;Idata$
2358              OUTPUT @Hp5250;":ROUT:OPEN "&Chanel$
2359              Meas_data$(Slot)=Meas_data$(Slot)&VAL$(Out)&Sp2$&Idata$&Sp1$
2360            NEXT Out
2361          END IF
2362        CASE Card_type$(2)                    ! Card type E5255
2363          IF Kvc<>1 THEN                      ! Not Kelvin connection
2364            Pfg=0
2365            FOR Block=1 TO 3
2366              IF VAL(Card_info$(Slot,2)[(Block-1)*2+1;1])=Ivp THEN ! Input Port = IVport ?
2367                IF Pfg=0 THEN 
2368                  Meas_data$(Slot)=Card_type$(2)&Sp1$
2369                  Pfg=1
2370                END IF
2371                FOR Out=1 TO Max_out
2372                  DISP "Measurement : CARD";Slot;" (";Card_info$(Slot,1);") : Block";Block;" : OUT";Out
2373                  OUTPUT Chanel$ USING "2A,1D,2Z,2Z,A";"(@",Slot,Block,Out,")"
2374                  OUTPUT @Hp5250;":ROUT:CLOS "&Chanel$
2375                  OUTPUT @Hp5250;"*OPC?"
2376                  ENTER @Hp5250;Cp
2377                  OUTPUT @Hp415x;":PAGE:SCON:SING"
2378                  OUTPUT @Hp415x;"*OPC?"
2379                  ENTER @Hp415x;Cp
2380                  OUTPUT @Hp415x;":TRAC? '"&I_name$&"'"
2381                  ENTER @Hp415x;Idata$
2382                  OUTPUT @Hp5250;":ROUT:OPEN "&Chanel$
2383                  Meas_data$(Slot)=Meas_data$(Slot)&VAL$(Block)&Sp2$&VAL$(Out)&Sp2$&Idata$&Sp1$
2384                NEXT Out
2385              END IF
2386            NEXT Block
2387          END IF
2388        CASE ELSE
2389        END SELECT
2390      END IF
2391    NEXT Slot
2392    WAIT 1
2393    DISP "Measurement Completed."
2394    WAIT .5
2395    DISP 
2396    CALL Meas_data_check(Fail_stat)
2397    SUBEXIT
2398  !----------------------------------------------------------
2399 Error_exit:                                  ! Error exit
2400    IF Err_stat=5 THEN 
2401      Fail_stat=-2                            ! Select Cancel key
2402    ELSE
2403      Fail_stat=-1                            ! Error
2404    END IF
2405  SUBEND
2406  !==========================================================
2407  !
2408 Init_check_415x: SUB Init_check_415x(Err_stat)
2409  !==========================================================
2410  !           4155/4156 Check & Initiarize
2411  !..........................................................
2412  ! PARAMETER : Err_stat   : Error status return
2413  !----------------------------------------------------------
2414    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2415    COM /Card_info/ Card_info$(*)
2416    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2417  !----------------------------------------------------------
2418    Err_stat=0
2419  !----------------------------------------------------------
2420  !
2421    ON ERROR GOTO Assign_error
2422    ASSIGN @Hp415x TO Addr415x                ! 415x I/O path assign
2423                                              !
2424    IF FNReset_415x(@Hp415x,Hp415x_type$,Addr415x)<>0 THEN Reset_error                   ! 415x Reset
2425    IF FNGet_415xid(@Hp415x,Hp415x_type$,Inst_type$(*),Addr415x) THEN Id_check_error     ! 415x ID get
2426    GOTO End_sub                              !
2427  !----------------------------------------------------------
2428 Assign_error:                                ! I/O path ASSIGN Error
2429    Err_stat=1
2430    Err_n=FNError_set(ERRN,"*** "&ERRM$)
2431    GOTO End_sub
2432 Reset_error:                                 ! 415x RESET Error
2433    Err_stat=2
2434    GOTO End_sub
2435 Id_check_error:                              ! Instrument ID Check Error
2436    Err_stat=3
2437    GOTO End_sub
2438 End_sub:                                     !
2439    OFF ERROR 
2440  SUBEND
2441  !==========================================================
2442 Reset_415x: DEF FNReset_415x(@Hp415x,Hp415x_type$,INTEGER Addr415x)
2443  !==========================================================
2444  !           4155/4156 Reset
2445  !..........................................................
2446  ! PARAMETER : @Hp415x      : 4155/4156 I/O Path name
2447  !           : Hp415x_TYPE$ : 4155/4156 type string
2448  !           : Addr415x     : 4155/4156 GPIB Address
2449  !..........................................................
2450  ! RETURN    : Error Status
2451  !----------------------------------------------------------
2452    Err_stat=0
2453    T_out=5                                   ! TIMEOUT set time
2454  !----------------------------------------------------------
2455  !
2456    Hpib_sc=Addr415x DIV 100                  ! Get GPIB slect code
2457    ON ERROR GOTO Io_error
2458    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
2459    CLEAR @Hp415x                             ! I/O Device Clear
2460    LOCAL Hpib_sc
2461    OUTPUT @Hp415x;"*RST"                     ! 415X Reset
2462    OUTPUT @Hp415x;"*CLS"                     ! 415X Clear Status
2463    OFF ERROR 
2464    GOTO End_sub
2465  !----------------------------------------------------------
2466 Io_error:                                    ! Device Clear Error
2467    Err_n=FNError_set(ERRN,"*** "&ERRM$)
2468    Err_stat=2
2469    GOTO End_sub
2470 Time_out:                                    ! Timeout Error
2471    Err_n=FNError_set(10012,"4155/4156 GPIB address,connection or firmware is bad.")
2472    Err_stat=3
2473 End_sub:                                     !
2474    OFF ERROR 
2475    OFF TIMEOUT 
2476    RETURN Err_stat
2477  FNEND
2478  !==========================================================
2479 Check_415xid: DEF FNCheck_415xid(@Hp415x,Hp415xid$,Hp415x_type$,INTEGER Addr415x)
2480  !==========================================================
2481  !           4155/4156 ID Check
2482  !..........................................................
2483  ! PARAMETER : @Hp415x      : 4155/4156 I/O Path name
2484  !           : Hp415xid$    : 4155/4156 ID keyword
2485  !           : Hp415x_TYPE$ : 4155/4156 type string
2486  !           : Addr415x     : 4155/4156 GPIB Address
2487  !..........................................................
2488  ! RETURN    : Error status
2489  !----------------------------------------------------------
2490    DIM Idstr$[50],Err_mesg$[50],Tmp_str$[50]
2491  !----------------------------------------------------------
2492    Err_stat=0
2493    T_out=5                                   ! TIMEOUT set time
2494  !----------------------------------------------------------
2495  !
2496    Hpib_sc=Addr415x DIV 100                  ! Get GPIB select code
2497    ON ERROR GOTO Io_error
2498    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
2499    OUTPUT @Hp415x;"*IDN?"                    ! 415X ID Query
2500    ENTER @Hp415x;Idstr$                      ! 415X ID Read
2501    IF POS(Idstr$,Hp415xid$)=0 THEN Inst_diff_err  ! Instrument ID Check
2502    GOTO End_sub
2503  !----------------------------------------------------------
2504 Io_error:                                    ! Device Clear Error
2505    Err_n=FNError_set(ERRN,"*** "&ERRM$)
2506    Err_stat=1
2507    GOTO End_sub
2508 Inst_diff_err:                               ! Instrument ID different
2509    Err_n=FNError_set(10013,"Instrument at address "&VAL$(Addr415x)&" is not 4155/4156 !")
2510    Err_stat=2
2511    GOTO End_sub
2512 Time_out:                                    ! Timeout Error
2513    Err_n=FNError_set(10012,"4155/4156 GPIB address,connection or firmware is bad.")
2514    Err_stat=3
2515 End_sub:                                     !
2516    OFF ERROR 
2517    OFF TIMEOUT 
2518    RETURN Err_stat
2519  FNEND
2520  !==========================================================
2521 Smu_check: SUB Smu_check(Smu_list(*))
2522  !==========================================================
2523  !           415X SMU exist check
2524  !..........................................................
2525  ! PARAMETER : Smu_list  : SMU Exist List
2526  !----------------------------------------------------------
2527    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2528  !----------------------------------------------------------
2529    DIM Option$[50],Err_mesg$[50]
2530  !----------------------------------------------------------
2531    Err_stat=0
2532    T_out=5                                   ! TIMEOUT set time
2533  !----------------------------------------------------------
2534  !
2535    Hpib_sc=Addr415x DIV 100                  ! Get GPIB select code
2536    ON ERROR GOTO Io_error
2537    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
2538    OUTPUT @Hp415x;"*OPT?"                    ! 415x OPTION Check
2539    ENTER @Hp415x;Option$                     ! 415x OPTION string enter
2540    Op1$=Option$[1;(POS(Option$,",")-1)]
2541    Option$=Option$[(POS(Option$,",")+1);(LEN(Option$)-POS(Option$,","))]
2542    Smu5$=Option$[1;(POS(Option$,",")-1)]     ! Get SMU5 Option string
2543    Option$=Option$[(POS(Option$,",")+1);(LEN(Option$)-POS(Option$,","))]
2544    Smu6$=Option$[1;(POS(Option$,",")-1)]     ! Get SMU6 Option string
2545                                              !
2546    FOR I=1 TO 4
2547      Smu_list(I)=1                           ! SMU1 - SMU4 Exist
2548    NEXT I
2549    IF Smu5$="0" THEN                         ! SMU5 set
2550      Smu_list(5)=0
2551    ELSE
2552      Smu_list(5)=1
2553    END IF
2554    IF Smu6$="0" THEN                         ! SMU6 set
2555      Smu_list(6)=0
2556    ELSE
2557      Smu_list(6)=1
2558    END IF
2559    GOTO End_sub
2560  !----------------------------------------------------------
2561 Io_error:                                    ! Device Clear Error
2562    Err_n=FNError_set(ERRN,"*** "&ERRM$)
2563    Err_stat=2
2564    OFF ERROR 
2565    GOTO End_sub
2566 Time_out:                                    ! Timeout Error
2567    Err_n=FNError_set(10012,"4155/4156 GPIB address,connection or firmware is bad.")
2568    Err_stat=3
2569 End_sub:                                     !
2570    OFF ERROR 
2571    OFF TIMEOUT 
2572  SUBEND
2573  !==========================================================
2574 Leak_exec_menu: SUB Leak_exec_menu(Iv_port,Fg)
2575  !==========================================================
2576  !           LEAK TEST Execute Menu Display
2577  !..........................................................
2578  ! PARAMETER : Iv_PORT  : IV port number
2579  !           : Fg       : IV port display flag
2580  !----------------------------------------------------------
2581    Xp=2                                      ! Menu display pos offset
2582    Yp=1                                      ! Menu display pos offset
2583  !----------------------------------------------------------
2584    PRINT TABXY(Xp,Yp);"Agilent E5250A Test Utility"
2585    IF Fg=1 THEN 
2586      PRINT TABXY(Xp,Yp+2);"** IV"&VAL$(Iv_port)&" LEAK TEST STATUS **"
2587    END IF
2588  SUBEND
2589  !==========================================================
2590 Stat_mesg_disp: SUB Stat_mesg_disp(Stat)
2591  !==========================================================
2592  !           Test Status Message Display
2593  !..........................................................
2594  ! PARAMETER : Stat :  Test status    0 -> Passed
2595  !           :      :                 1 -> Failed
2596  !           :      :                -1 -> Other Error
2597  !----------------------------------------------------------
2598    Xp=2                                      ! Menu display pos offset
2599    Yp=5                                      ! Menu display pos offset
2600  !----------------------------------------------------------
2601    SELECT Stat
2602    CASE 0
2603      PRINT TABXY(Xp+2,Yp+1);"######                                     "
2604      PRINT TABXY(Xp+2,Yp+2);"#     #    ##      ####      ####          "
2605      PRINT TABXY(Xp+2,Yp+3);"#     #   #  #    #    #    #    #         "
2606      PRINT TABXY(Xp+2,Yp+4);"######   #    #    #         #             "
2607      PRINT TABXY(Xp+2,Yp+5);"#        ######      #         #           "
2608      PRINT TABXY(Xp+2,Yp+6);"#        #    #   #    #    #    #         "
2609      PRINT TABXY(Xp+2,Yp+7);"#        #    #    ####      ####          "
2610    CASE 1
2611      PRINT TABXY(Xp+2,Yp+1);"#######                                    "
2612      PRINT TABXY(Xp+2,Yp+2);"#          ##       #     #                "
2613      PRINT TABXY(Xp+2,Yp+3);"#         #  #      #     #                "
2614      PRINT TABXY(Xp+2,Yp+4);"######   #    #     #     #                "
2615      PRINT TABXY(Xp+2,Yp+5);"#        ######     #     #                "
2616      PRINT TABXY(Xp+2,Yp+6);"#        #    #     #     #                "
2617      PRINT TABXY(Xp+2,Yp+7);"#        #    #     #     ######           "
2618    CASE -1
2619      PRINT TABXY(Xp+2,Yp+1);"#######                                    "
2620      PRINT TABXY(Xp+2,Yp+2);"#        #####    #####     ####    #####  "
2621      PRINT TABXY(Xp+2,Yp+3);"#        #    #   #    #   #    #   #    # "
2622      PRINT TABXY(Xp+2,Yp+4);"#####    #    #   #    #   #    #   #    # "
2623      PRINT TABXY(Xp+2,Yp+5);"#        #####    #####    #    #   #####  "
2624      PRINT TABXY(Xp+2,Yp+6);"#        #    #   #    #   #    #   #    # "
2625      PRINT TABXY(Xp+2,Yp+7);"#######  #     #  #     #   ####    #     #"
2626    END SELECT
2627  SUBEND
2628  !==========================================================
2629 Meas_set_415x: SUB Meas_set_415x(Err_stat)
2630  !==========================================================
2631  !           4155/4156 Measurement Condition setting
2632  !..........................................................
2633  ! RETURN    : Error status
2634  !----------------------------------------------------------
2635    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2636    COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(*),Hold_time,Fvolt,Icomp,Range,I_name$
2637  !----------------------------------------------------------
2638    INTEGER T_out,Hpib_sc
2639    REAL Err_no
2640    DIM Error_str$[100]
2641    !
2642    Err_stat=0
2643    T_out=5                                   ! TIMEOUT set time
2644    Dxp=1
2645    Dyp=20
2646    Max_col=58
2647  !----------------------------------------------------------
2648  !
2649    Hpib_sc=Addr415x DIV 100                  ! Get GPIB select code
2650    ON ERROR GOTO Io_error
2651    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
2652    !
2653    OUTPUT @Hp415x;":PAGE:CHAN:ALL:DIS"       ! All channel disable
2654    OUTPUT @Hp415x;":PAGE:CHAN:SMU"&VAL$(Smu)&":VNAME 'V"&VAL$(Smu)&"'"       ! SMU Vname set
2655    OUTPUT @Hp415x;":PAGE:CHAN:SMU"&VAL$(Smu)&":FUNC CONS"  ! SMU FCTN set
2656    !
2657    OUTPUT @Hp415x;":PAGE:CHAN:SMU"&VAL$(Smu)&":MODE V"                       ! SMU voltage output mode set
2658    OUTPUT @Hp415x;":PAGE:CHAN:SMU"&VAL$(Smu)&":INAME '"&I_name$&"'"          ! SMU Iname set
2659    OUTPUT @Hp415x;":PAGE:CHAN:MODE SAMP"     ! Sampling mode set
2660    !
2661    OUTPUT @Hp415x;":PAGE:MEAS:SAMP:MODE LIN" ! Liner sampling mode set
2662    OUTPUT @Hp415x;":PAGE:MEAS:SAMP:HTIM "&VAL$(Hold_time)                    ! Hold Time set
2663    OUTPUT @Hp415x;":PAGE:MEAS:SAMP:POIN 1"   ! Number of sampling set
2664    OUTPUT @Hp415x;":PAGE:DISP:LIST '"&I_name$&"'"                            ! Iname List display set
2665    OUTPUT @Hp415x;":PAGE:MEAS:MSET:SMU"&VAL$(Smu)&":RANG:MODE LIM"           ! SMU measurement range set
2666    OUTPUT @Hp415x;":PAGE:MEAS:MSET:SMU"&VAL$(Smu)&":RANG "&VAL$(Range)       ! SMU measurement range set
2667    OUTPUT @Hp415x;":PAGE:MEAS:SAMP:CONS:SMU"&VAL$(Smu)&" "&VAL$(Fvolt)       ! SMU measurement range set
2668    OUTPUT @Hp415x;":PAGE:MEAS:SAMP:CONS:SMU"&VAL$(Smu)&":COMP "&VAL$(Icomp)  ! SMU measurement range set
2669    OUTPUT @Hp415x;":FORM ASC"                ! Data format set ascii
2670                                              !
2671    OUTPUT @Hp415x;"*OPC?"
2672    ENTER @Hp415x;A
2673                                              !
2674    OUTPUT @Hp415x;":SYST:ERR?"               ! Error Check
2675    ENTER @Hp415x;Err_no,Error_str$
2676    IF Err_no<>0 THEN Set_error
2677    !
2678 Offset_cancel: !
2679    OUTPUT @Hp415x;":PAGE:MEAS:MSET:ZCAN ON"  ! 4155/4156 Offset Cancel ON
2680    DISP 
2681    IF Kvc=1 THEN 
2682      PRINT TABXY(Dxp,Dyp);"Disconnect Kelvin cable from IV"&VAL$(Ivp)&" terminal."
2683    ELSE
2684      PRINT TABXY(Dxp,Dyp);"Disconnect cable from IV"&VAL$(Ivp)&" terminal."
2685    END IF
2686    PRINT TABXY(Dxp,Dyp+1);"And disconnect all cables from output terminals."
2687    GOSUB Select_cont                         ! CONT/CANCEL select
2688    GOSUB Softkey_clear                       ! Softkey clear
2689    PRINT TABXY(Dxp,Dyp);RPT$(" ",Max_col)
2690    PRINT TABXY(Dxp,Dyp+1);RPT$(" ",Max_col)
2691                                              !
2692    OUTPUT @Hp415x;":PAGE:SCON:ZERO"          ! 4155/4156 Offset Cancel data get
2693    OUTPUT @Hp415x;"*OPC?"
2694    ENTER @Hp415x;A
2695                                              !
2696    OUTPUT @Hp415x;":SYST:ERR?"               ! Error Check
2697    ENTER @Hp415x;Err_no,Error_str$
2698    IF Err_no<>0 THEN Set_error
2699                                              !
2700    IF Kvc=1 THEN 
2701      PRINT TABXY(Dxp,Dyp+1);"Connect SMU"&VAL$(Smu)&" to IV"&VAL$(Ivp)&" by Kelvin cable."
2702    ELSE
2703      PRINT TABXY(Dxp,Dyp+1);"Connect SMU"&VAL$(Smu)&" to IV"&VAL$(Ivp)&" by cable."
2704    END IF
2705    GOSUB Select_cont                         ! CONT/CANCEL select
2706    GOSUB Softkey_clear                       ! Softkey clear
2707    PRINT TABXY(Dxp,Dyp);RPT$(" ",Max_col)
2708    PRINT TABXY(Dxp,Dyp+1);RPT$(" ",Max_col)
2709                                              !
2710    GOTO End_sub
2711  !----------------------------------------------------------
2712 Select_cont:                                 ! CONT/CANCEL select
2713    Ret_flag=-1
2714    GOSUB Softkey_clear                       ! Softkey clear
2715    ON KEY 1 LABEL " CONT-  INUE  ",4 GOSUB Cont_test
2716    ON KEY 7 LABEL "CANCEL        ",4 GOTO Cancel_test
2717    LOOP                                      ! -- Loop --
2718      IF Ret_flag<>-1 THEN RETURN 
2719    END LOOP                                  !
2720 Cont_test: GOSUB Softkey_clear               ! Test continue
2721    Ret_flag=1
2722    RETURN 
2723 Softkey_clear: !
2724    FOR I=1 TO 8
2725      ON KEY I LABEL "",4 GOSUB Key_null
2726    NEXT I
2727    RETURN 
2728 Key_null: !
2729    RETURN 
2730  !----------------------------------------------------------
2731 Io_error:                                    ! Device Clear Error
2732    Err_n=FNError_set(ERRN,"*** "&ERRM$)
2733    Err_stat=2
2734    GOTO End_sub
2735 Time_out:                                    ! Timeout Error
2736    Err_n=FNError_set(10012,"4155/4156 GPIB address,connection or firmware is bad.")
2737    Err_stat=3
2738 Set_error: !
2739    Err_n=FNError_set(Err_no,"*** "&Error_str$)
2740    Err_stat=4
2741    GOTO End_sub
2742 Cancel_test: !
2743    Err_stat=5
2744 End_sub:                                          !
2745    OFF ERROR 
2746    OFF TIMEOUT 
2747  SUBEND
2748  !==========================================================
2749 Set_cpl_port: SUB Set_cpl_port(@Hp5250,Kvc,Ivport,INTEGER Addr5250)
2750  !==========================================================
2751  !           4155/4156 Measurement Condition setting
2752  !..........................................................
2753  ! PARAMETER : @Hp5250      : E5250 I/O Path name
2754  !           : Kvc          : Kelvine Status
2755  !           : Ivport       : IV poart number
2756  !           : Addr5250     : E5250 GPIB Address
2757  !----------------------------------------------------------
2758    Err_stat=0
2759    T_out=5                                   ! TIMEOUT set time
2760  !----------------------------------------------------------
2761  !
2762    Hpib_sc=Addr5250 DIV 100                  ! Get GPIB select code
2763    ON ERROR GOTO Io_error
2764    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
2765    IF Kvc=1 THEN 
2766    OUTPUT @Hp5250;":ROUT:COUP:PORT ALL,'"&VAL$(Ivport)&"'"
2767    OUTPUT @Hp5250;":ROUT:COUP:STAT ALL,ON"   ! Couple Mode ON
2768    ELSE
2769    OUTPUT @Hp5250;":ROUT:COUP:STAT ALL,OFF"  ! Couple Mode OFF
2770    END IF
2771                                              !
2772    GOTO End_sub
2773  !----------------------------------------------------------
2774 Io_error:                                    ! Device Clear Error
2775    Err_n=FNError_set(ERRN,"*** "&ERRM$)
2776    Err_stat=2
2777    GOTO End_sub
2778 Time_out:                                    ! Timeout Error
2779    Err_n=FNError_set(10012,"4155/4156 GPIB address,connection or firmware is bad.")
2780    Err_stat=3
2781 End_sub:                                     !
2782    OFF ERROR 
2783    OFF TIMEOUT 
2784  SUBEND
2785  !==========================================================
2786 Meas_data_check: SUB Meas_data_check(Fail_stat)
2787  !==========================================================
2788  !           Measurement Data check
2789  !..........................................................
2790  ! PARAMETER : Fail_stat : Pass/Fail status return
2791  !----------------------------------------------------------
2792    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2793    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2794    COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(*),Hold_time,Fvolt,Icomp,Range,I_name$
2795    COM /Meas_data/ Meas_data$(*)
2796  !----------------------------------------------------------
2797    DIM C_data$[500]
2798  !----------------------------------------------------------
2799    Sp1$=","                                  ! Measurement Data separater
2800    Sp2$=":"                                  ! Measurement Data separater
2801  !----------------------------------------------------------
2802  !
2803    Fail_stat=0
2804    FOR Slot=1 TO (SIZE(Meas_data$,1))
2805      C_data$=Meas_data$(Slot)
2806      IF LEN(C_data$)>0 THEN 
2807        Go_ng=0
2808        C_type$=C_data$[1;(POS(C_data$,Sp1$)-1)]   ! Get card type
2809        C_data$=C_data$[(POS(C_data$,Sp1$)+1);(LEN(C_data$)-POS(C_data$,Sp1$))]
2810        LOOP
2811          Sps=POS(C_data$,Sp1$)
2812        EXIT IF Sps=0
2813          T_str$=C_data$[1;Sps-1]
2814          SELECT C_type$
2815          CASE Card_type$(1)                  ! Card type E5252
2816            Dps=POS(T_str$,Sp2$)
2817            Out_n=VAL(T_str$[1;Dps-1])
2818            Mdata=VAL(T_str$[Dps+1;(LEN(T_str$)-Dps)])     ! Meas. result
2819            Go_ng=FNMeas_val_check(Mdata,C_type$,Hp415x_type$,Ivp,Kvc)  ! G0-NG Check
2820          CASE Card_type$(2)                  ! Card type E5255
2821            Dps=POS(T_str$,Sp2$)
2822            Blk_n=VAL(T_str$[1;Dps-1])
2823            T_str$=T_str$[Dps+1;(LEN(T_str$)-Dps)]
2824            Dps=POS(T_str$,Sp2$)
2825            Out_n=VAL(T_str$[1;Dps-1])
2826            Mdata=VAL(T_str$[Dps+1;(LEN(T_str$)-Dps)])     ! Meas. result
2827            Go_ng=FNMeas_val_check(Mdata,C_type$,Hp415x_type$,Ivp,Kvc)  ! GO-NG Check
2828          CASE ELSE
2829            Go_ng=0
2830          END SELECT
2831          C_data$=C_data$[Sps+1;(LEN(C_data$)-Sps)]
2832          IF Go_ng<>0 THEN 
2833            Fail_stat=1                       ! Fail status set
2834          END IF
2835        END LOOP
2836      END IF
2837    NEXT Slot
2838  SUBEND
2839  !==========================================================
2840 Meas_val_check: DEF FNMeas_val_check(Meas_data,C_type$,I_type$,Iv_port,Kvc)
2841  !==========================================================
2842  !           Measurement data check
2843  !..........................................................
2844  ! PARAMETER : Meas_data    : Measurement data
2845  !           : C_type$      : Card type
2846  !           : I_type$      : Instrument type
2847  !           : Iv_port      : IV Port Number
2848  !           : Kvc          : Kelvin Connect flag
2849  !..........................................................
2850  ! RETURN    : Judgment    0 -> OK, 1 -> Big, -1 -> Small
2851  !----------------------------------------------------------
2852    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2853    COM /Meas_check/ Meas_max_min(*)
2854  !----------------------------------------------------------
2855    DIM Idstr$[50],Err_mesg$[50]
2856  !----------------------------------------------------------
2857  !
2858    IF FNGet_limit_data(Max_lim,Min_lim,C_type$,I_type$,Iv_port,Kvc)>0 THEN 
2859      IF Meas_data>Max_lim THEN 
2860        RETURN 1                              ! Upper
2861      ELSE
2862        IF Meas_data<Min_lim THEN 
2863          RETURN -1                           ! Lower
2864        ELSE
2865          RETURN 0                            ! OK
2866        END IF
2867      END IF
2868    ELSE
2869      RETURN 2                                ! Error
2870    END IF
2871  FNEND
2872  !==========================================================
2873 Report_out: SUB Report_out(Dest)
2874  !==========================================================
2875  !           Measurement Result Report output
2876  !..........................................................
2877  ! PARAMETER : Dest : Output Destination
2878  !----------------------------------------------------------
2879    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
2880    COM /Instrument/ @Hp415x,Hp415x_type$,INTEGER Addr415x
2881    COM /Meas_init/ Ivp,Kvc,Smu,Smu_list(*),Hold_time,Fvolt,Icomp,Tange,I_name$
2882    COM /Meas_data/ Meas_data$(*)
2883    COM /Meas_check/ Meas_max_min(*)
2884    COM /Mas/ Mas$
2885  !----------------------------------------------------------
2886    DIM C_data$[500],Filename$[100],Dstr$[200]
2887    DIM Out_data$(1:150)[60]
2888  !----------------------------------------------------------
2889    Sp1$=","                                  ! Measurement Data separater
2890    Sp2$=":"                                  ! Measurement Data separater
2891    Max_line=21                               ! Max display row
2892    Ncl=5                                     !
2893    Ufg=0                                     !
2894  !----------------------------------------------------------
2895  !
2896    IF Kvc=1 THEN                             ! Kelvin conection
2897      OUTPUT Dstr$ USING Img001;Ivp
2898    ELSE                                      ! Non Kelvin connection
2899      OUTPUT Dstr$ USING Img002;Ivp
2900    END IF
2901    Lc=1
2902    OUTPUT Out_data$(Lc) USING "K";Dstr$
2903    Lc=Lc+1
2904    OUTPUT Out_data$(Lc) USING "K";" "
2905    Lc=Lc+1
2906    OUTPUT Out_data$(Lc) USING "K";" "
2907    Lc=Lc+1
2908                                              !
2909    FOR Slot=1 TO (SIZE(Meas_data$,1))
2910      C_data$=Meas_data$(Slot)
2911      IF LEN(C_data$)>0 THEN 
2912        C_type$=C_data$[1;(POS(C_data$,Sp1$)-1)]   ! Get card type
2913        C_data$=C_data$[(POS(C_data$,Sp1$)+1);(LEN(C_data$)-POS(C_data$,Sp1$))]
2914        SELECT C_type$
2915        CASE Card_type$(1)                    ! Card type E5252
2916          OUTPUT Out_data$(Lc) USING Img003;Slot,C_type$
2917          Lc=Lc+1
2918          OUTPUT Out_data$(Lc) USING "K";" "
2919          Lc=Lc+1
2920          OUTPUT Out_data$(Lc) USING Img004
2921          Lc=Lc+1
2922          OUTPUT Out_data$(Lc) USING "K";RPT$("=",56)
2923          Lc=Lc+1
2924        CASE Card_type$(2)                    ! Card type E5255
2925          OUTPUT Out_data$(Lc) USING Img003;Slot,C_type$
2926          Lc=Lc+1
2927          OUTPUT Out_data$(Lc) USING "K";" "
2928          Lc=Lc+1
2929          OUTPUT Out_data$(Lc) USING Img005
2930          Lc=Lc+1
2931          OUTPUT Out_data$(Lc) USING "K";RPT$("=",56)
2932          Lc=Lc+1
2933        CASE ELSE
2934        END SELECT
2935                                                   !
2936        IF FNGet_limit_data(Max_d,Min_d,C_type$,Hp415x_type$,Ivp,Kvc)<=0 THEN Err_exit
2937        Out_cnt=0
2938        LOOP
2939          Sps=POS(C_data$,Sp1$)
2940        EXIT IF Sps=0
2941          T_str$=C_data$[1;Sps-1]
2942          C_num=FNCard_in_out_que(C_type$,Max_in,Max_out)
2943          SELECT C_type$
2944          CASE Card_type$(1)                       ! Card type E5252
2945            Dps=POS(T_str$,Sp2$)
2946            Out_n=VAL(T_str$[1;Dps-1])
2947            Mdata=VAL(T_str$[Dps+1;(LEN(T_str$)-Dps)])
2948            SELECT FNMeas_val_check(Mdata,C_type$,Hp415x_type$,Ivp,Kvc)
2949            CASE -1                                ! Data fail <- small
2950              Fail$="<<<"
2951            CASE 1                                 ! Data fail <- big
2952              Fail$=">>>"
2953            CASE ELSE
2954              Fail$="   "
2955            END SELECT
2956            Mind=FNE_f(Min_d,U1$,Ufg)
2957            Maxd=FNE_f(Max_d,U2$,Ufg)
2958            Mdat=FNE_f(Mdata,U3$,Ufg)
2959            OUTPUT Out_data$(Lc) USING Img006;Out_n,Mind,U1$,Mdat,U3$,Maxd,U2$,Fail$
2960            Lc=Lc+1
2961          CASE Card_type$(2)                       ! Card type E5255
2962            Out_cnt=Out_cnt+1
2963            Dps=POS(T_str$,Sp2$)
2964            Blk_n=VAL(T_str$[1;Dps-1])
2965            T_str$=T_str$[Dps+1;(LEN(T_str$)-Dps)]
2966            Dps=POS(T_str$,Sp2$)
2967            Out_n=VAL(T_str$[1;Dps-1])
2968            Mdata=VAL(T_str$[Dps+1;(LEN(T_str$)-Dps)])
2969            SELECT FNMeas_val_check(Mdata,C_type$,Hp415x_type$,Ivp,Kvc)
2970            CASE -1                                ! Data fail <- small
2971              Fail$="<<<"
2972            CASE 1                                 ! Data fail <- big
2973              Fail$=">>>"
2974            CASE ELSE
2975              Fail$="   "
2976            END SELECT
2977            Mind=FNE_f(Min_d,U1$,Ufg)
2978            Maxd=FNE_f(Max_d,U2$,Ufg)
2979            Mdat=FNE_f(Mdata,U3$,Ufg)
2980            OUTPUT Out_data$(Lc) USING Img007;Blk_n,Out_n,Mind,U1$,Mdat,U3$,Maxd,U2$,Fail$
2981            Lc=Lc+1
2982            IF Out_cnt=Max_out THEN 
2983              OUTPUT Out_data$(Lc) USING "K";RPT$("-",56)
2984              Lc=Lc+1
2985              Out_cnt=0
2986            END IF
2987          CASE ELSE
2988            Go_ng=0
2989          END SELECT
2990          C_data$=C_data$[Sps+1;(LEN(C_data$)-Sps)]
2991        END LOOP
2992        OUTPUT Out_data$(Lc) USING "K";" "
2993        Lc=Lc+1
2994        OUTPUT Out_data$(Lc) USING "K";" "
2995        Lc=Lc+1
2996      END IF
2997    NEXT Slot
2998                                                   !
2999    IF Dest=1 THEN                                 ! Output File
3000 Input_file_name:                                  !
3001      DISP 
3002      REDIM Out_data$(Lc)
3003      Tbyte=Lc*60+2
3004      IF (Tbyte MOD 2)=1 THEN Tbyte=Tbyte+1
3005      Rec=(Tbyte DIV 256)+1
3006      GOTO File_name_set
3007 Set_file_name: !
3008      ON ERROR GOTO File_name_reset
3009      Filename$=Filename$&Mas$
3010 Save_file:                                        !
3011      CREATE Filename$,Rec*256                     ! HP-UX File
3012      ASSIGN @F TO Filename$
3013      OUTPUT @F;Out_data$(*)
3014      ASSIGN @F TO *
3015      OFF ERROR 
3016    ELSE                                           ! Output CRT
3017      CLEAR SCREEN
3018      Fst_fg=1
3019      I=1
3020      LOOP
3021      EXIT IF I>=Lc
3022        IF POS(Out_data$(I),Card_type$(1))>0 THEN 
3023          IF Fst_fg=0 THEN 
3024            GOSUB More_disp
3025            CLEAR SCREEN
3026          ELSE
3027            Fst_fg=0
3028          END IF
3029        END IF
3030        IF POS(Out_data$(I),Card_type$(2))>0 THEN 
3031          IF Fst_fg=0 THEN 
3032            GOSUB More_disp
3033            CLEAR SCREEN
3034          ELSE
3035            Fst_fg=0
3036          END IF
3037        END IF
3038        IF POS(Out_data$(I),RPT$("-",56))>0 THEN 
3039          IF Fst_fg=0 THEN 
3040            PRINT USING "#,K";Out_data$(I)
3041            GOSUB More_disp
3042            CLEAR SCREEN
3043            IF LEN(Out_data$(I+1))<=3 THEN 
3044              I=I+1
3045              LOOP
3046              EXIT IF LEN(Out_data$(I))>3
3047                I=I+1
3048              EXIT IF I>=Lc
3049              END LOOP
3050            END IF
3051            IF I>=Lc THEN End_sub
3052          ELSE
3053            Fst_fg=0
3054          END IF
3055        END IF
3056        PRINT USING "#,K";Out_data$(I)
3057        I=I+1
3058      END LOOP
3059      GOSUB More_disp
3060    END IF
3061    GOTO End_sub
3062  !----------------------------------------------------------
3063 File_name_reset:                                  ! File name error
3064    BEEP 
3065    IF ERRN=54 THEN Over_write
3066    DISP "*** ";ERRM$
3067    WAIT 1
3068    GOTO Input_file_name
3069 File_name_set:                                    ! File name set
3070    GOSUB Softkey_clear                            ! Softkey clear
3071    ON KEY 1 LABEL "CATALOG       ",4 GOSUB Catalog_file
3072    ON KEY 3 LABEL " INPUT   FILE ",4 GOTO Input_file
3073    ON KEY 7 LABEL "CANCEL        ",4 GOTO End_sub
3074    LOOP                                           ! -- Loop --
3075    END LOOP                                       !
3076 Catalog_file:                                     ! File catlog display
3077    CALL Cat_file(Mas$)
3078    RETURN 
3079 Input_file:                                       ! File name input
3080    GOSUB Softkey_clear                            ! Softkey clear
3081    Filename$=FNInput_file_name$("Enter File name to save the report ",8)
3082    GOTO Set_file_name
3083 Over_write:                                       ! File over write
3084    DISP "File [";Filename$;"] exists. Overwrite OK?"
3085    GOSUB Softkey_clear
3086    ON KEY 1 LABEL " OVER   WRITE ",4 GOTO Overwrite_file
3087    ON KEY 7 LABEL " CANCEL       ",4 GOTO Input_file_name
3088    LOOP
3089    END LOOP
3090    RETURN 
3091 Overwrite_file:                                   !
3092    DISP "PURGE ";Filename$
3093    PURGE Filename$
3094    GOTO Save_file
3095  !----------------------------------------------------------
3096 More_disp:                                        ! More display
3097    DISP "Press MORE to next page"
3098    GOSUB Softkey_clear                            ! Softkey clear
3099    Ret_flag=-1
3100    ON KEY 1 LABEL " MORE         ",4 GOSUB Cont_disp
3101    ON KEY 7 LABEL " CANCEL       ",4 GOTO End_sub
3102    LOOP                                           ! -- Loop --
3103      IF Ret_flag<>-1 THEN RETURN 
3104    END LOOP                                       !
3105 Cont_disp: GOSUB Softkey_clear                    ! More disp
3106    Ret_flag=1
3107    RETURN 
3108  !----------------------------------------------------------
3109 Softkey_clear:                                    ! Softkey clear
3110    FOR Key_no=1 TO 8
3111      ON KEY Key_no LABEL "",4 GOSUB Key_null        !
3112    NEXT Key_no
3113    RETURN 
3114 Key_null:                                         !
3115    RETURN 
3116  !----------------------------------------------------------
3117 Img001: IMAGE #,"IV",D," Leak Current Test Result ( Kelvin Connection )"
3118 Img002: IMAGE #,"IV",D," Leak Current Test Result"
3119 Img003: IMAGE "CARD ",D," : ",10A
3120 Img004: IMAGE 7X,"Out | Minimum  | Results  | Maximum  | Fail"
3121 Img005: IMAGE 3X,"Blk| Out | Minimum  | Results  | Maximum  | Fail"
3122 Img006: IMAGE 7X,3D," |",M4D.2D,A,"A","|",M4D.2D,A,"A","|",M4D.2D,A,"A","| ",K
3123 Img007: IMAGE 3X,2D," | ",3D," |",M4D.2D,A,"A|",M4D.2D,A,"A|",M4D.2D,A,"A| ",K
3124  !----------------------------------------------------------
3125 End_sub:                                          !
3126  GOSUB Softkey_clear
3127  SUBEND
3128  !==========================================================
3129 Cat_file: SUB Cat_file(Masstrage$)
3130  !==========================================================
3131  !           File catalog display
3132  !..........................................................
3133  ! Parameter : Masstrage$ : Masstrage name
3134  !----------------------------------------------------------
3135    ON ERROR GOTO Cat_error
3136    CLEAR SCREEN
3137    IF Masstrage$<>"" THEN 
3138      CAT Masstrage$
3139    ELSE
3140      CAT 
3141    END IF
3142    OFF ERROR 
3143    GOTO Cat_end
3144 Cat_error:                                        ! CAT Error
3145    BEEP 
3146    DISP "*** ";ERRM$
3147 Cat_end:                                          !
3148  SUBEND
3149  !==========================================================
3150 Input_file_name: DEF FNInput_file_name$(Message$,Max_name_len)
3151  !==========================================================
3152  !           Input file name
3153  !..........................................................
3154  ! Parameter : Message$     : Input Message
3155  !           : Max_name_len : Max File name length
3156  !..........................................................
3157  ! Return : File name
3158  !----------------------------------------------------------
3159    DIM File_name$[50]
3160  !----------------------------------------------------------
3161 Input_name:                                        !
3162    ON ERROR GOTO Input_error
3163    DISP Message$;
3164    INPUT File_name$
3165    IF TRIM$(File_name$)<>"" THEN                   ! File name length check
3166      IF LEN(TRIM$(File_name$))>Max_name_len THEN 
3167        BEEP 
3168        DISP "File name is too long."
3169        GOTO Input_error
3170      END IF
3171      IF POS(TRIM$(File_name$)," ")>0 THEN 
3172        BEEP 
3173        DISP "File name is wrong"
3174        GOTO Input_error
3175      END IF
3176    END IF
3177    GOTO Input_end
3178  !----------------------------------------------------------
3179 Input_error:                                       !  Input error
3180    WAIT 1
3181    File_name$=""
3182    GOTO Input_name
3183 Input_end:                                         !
3184    OFF ERROR 
3185    RETURN TRIM$(File_name$)
3186  FNEND
3187  !==========================================================
3188 E_f: DEF FNE_f(X,M$,Flag)
3189  !==========================================================
3190  !           Value Unit Change
3191  !..........................................................
3192  ! Parameter : X    : Origin value
3193  !           : M$   : Unit
3194  !           : Flag : Flag
3195  !..........................................................
3196  ! Return    : Changed value
3197  !----------------------------------------------------------
3198    DIM Muls$[15]
3199  !----------------------------------------------------------
3200    M$=""
3201    Muls$="afpnum kMGTPE*"
3202  !
3203    IF ABS(X)<1.E-18 OR 1<=ABS(X) AND ABS(X)<1000 THEN RETURN X
3204    IF Flag=1 AND .1<ABS(X) AND ABS(X)<1 THEN RETURN X
3205    Mul=INT((LGT(ABS(X)))/3)
3206    IF Flag=1 AND 1.000E-9<=ABS(X) AND ABS(X)<2.000E-9 THEN Mul=-4
3207    IF Flag=1 AND 1.00E-13<=ABS(X) AND Mul=-5 THEN Mul=-4
3208    M$=Muls$[MIN(7+Mul,LEN(Muls$));1]
3209    RETURN X*10^(-Mul*3)
3210  FNEND
3211  !=========================================================================
3212 Get_415xid: DEF FNGet_415xid(@Hp415x,Hp415x_type$,Inst_type$(*),INTEGER Addr415x)
3213  !==========================================================
3214  !           4155/4156 ID Check
3215  !..........................................................
3216  ! PARAMETER : @Hp415x      : 4155/4156 I/O Path name
3217  !           : Hp415x_type$ : 4155/4156 type string
3218  !           : Inst_type$(*): Instrument Type list
3219  !           : Addr415x     : 4155/4156 GPIB Address
3220  !..........................................................
3221  ! RETURN    : Error status
3222  !----------------------------------------------------------
3223    DIM Idstr$[50],Err_mesg$[50],Tmp_str$[50]
3224  !----------------------------------------------------------
3225    Err_stat=0
3226    T_out=5                                        ! TIMEOUT set time
3227  !----------------------------------------------------------
3228  !
3229    Hpib_sc=Addr415x DIV 100                       ! Get GPIB select code
3230    ON ERROR GOTO Io_error
3231    ON TIMEOUT Hpib_sc,T_out GOTO Time_out
3232    OUTPUT @Hp415x;"*IDN?"                         ! 415X ID Query
3233    ENTER @Hp415x;Idstr$                           ! 415X ID Read
3234    Idstr$=Idstr$[POS(Idstr$,",")+1]
3235    Idstr$=Idstr$[1,POS(Idstr$,",")-2]
3236    !
3237    SELECT Idstr$
3238    CASE Inst_type$(1)
3239      Hp415x_type$=FNInst_name$(1)
3240    CASE Inst_type$(2)
3241      Hp415x_type$=FNInst_name$(2)
3242    CASE ELSE
3243      GOTO Inst_diff_err
3244    END SELECT
3245    !
3246    GOTO End_sub
3247  !----------------------------------------------------------
3248 Io_error:                                         ! Device Clear Error
3249    Err_n=FNError_set(ERRN,"*** "&ERRM$)
3250    Err_stat=1
3251    GOTO End_sub
3252 Inst_diff_err:                                    ! Instrument ID different
3253    Err_n=FNError_set(10013,"Instrument at address "&VAL$(Addr415x)&" is not 4155/4156 !")
3254    Err_stat=2
3255    GOTO End_sub
3256 Time_out:                                         ! Timeout Error
3257    Err_n=FNError_set(10012,"4155/4156 GPIB address,connection or firmware is bad.")
3258    Err_stat=3
3259 End_sub:                                          !
3260    OFF ERROR 
3261    OFF TIMEOUT 
3262    RETURN Err_stat
3263  FNEND
3264  !==========================================================
3265 Inst_name: DEF FNInst_name$(Type_num)
3266  !==========================================================
3267  !           Instrument name get
3268  !..........................................................
3269  ! Parameter : Type_num : Instrument type number
3270  !..........................................................
3271  ! Return    : Instrumanet name
3272  !----------------------------------------------------------
3273    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
3274    !
3275    RETURN Inst_type$(Type_num)
3276  FNEND
3277  !=========================================================================
3278 Get_limit_data: DEF FNGet_limit_data(Max_lim,Min_lim,C_type$,I_type$,Iv_port,Kvc)
3279  !==========================================================
3280  !           Measurement data check
3281  !..........................................................
3282  ! PARAMETER : Max_lim      : Maximun Limit data
3283  !           : Min_lim      : Minimun Limit data
3284  !           : C_type$      : Card type
3285  !           : I_type$      : Instrument type
3286  !           : Iv_port      : IV Port Number
3287  !           : Kvc          : Kelvin Connect flag
3288  !..........................................................
3289  ! RETURN    : Array number
3290  !----------------------------------------------------------
3291    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
3292    COM /Meas_check/ Meas_max_min(*)
3293  !----------------------------------------------------------
3294    DIM Idstr$[50],Err_mesg$[50]
3295  !----------------------------------------------------------
3296  !
3297    SELECT TRIM$(C_type$)
3298    CASE Card_type$(1)                        ! E5252
3299      SELECT I_type$
3300      CASE FNInst_name$(1)                    ! 4155
3301        IF Iv_port<3 THEN 
3302          Tn=1
3303        ELSE
3304          Tn=2
3305        END IF
3306      CASE FNInst_name$(2)                    ! 4156
3307        IF Kvc=0 THEN 
3308          IF Iv_port<3 THEN 
3309            Tn=3
3310          ELSE
3311            Tn=4
3312          END IF
3313        ELSE
3314          IF Iv_port<3 THEN 
3315            Tn=5
3316          ELSE
3317            Tn=6
3318          END IF
3319        END IF
3320      CASE ELSE
3321        Tn=0
3322      END SELECT
3323    CASE Card_type$(2)                        ! E5255
3324      SELECT I_type$
3325      CASE FNInst_name$(1)                    ! 4155
3326        Tn=7
3327      CASE FNInst_name$(2)                    ! 4156
3328        Tn=8
3329      CASE ELSE
3330        Tn=0
3331      END SELECT
3332    CASE ELSE
3333      Tn=0
3334    END SELECT
3335                                              !
3336    IF Tn=0 THEN                              ! Instrument type Error
3337      Max_lim=0
3338      Min_lim=0
3339    ELSE
3340      Max_lim=Meas_max_min(Tn,1)
3341      Min_lim=Meas_max_min(Tn,2)
3342    END IF
3343    RETURN Tn
3344                                              !
3345  FNEND
3346  !==========================================================
3347 Avail_ivp: DEF FNAvail_ivp(Iv_port)
3348  !==========================================================
3349  !           Leak Test Available IV Port Check
3350  !..........................................................
3351  ! PARAMETER : Iv_port      : IV Port Number
3352  !..........................................................
3353  ! RETURN    : 0 = Not Available
3354  !             1 = Available
3355  !----------------------------------------------------------
3356    COM /Sys_info/ Sys_os$,Hp5250id$,Hp415xid$,Card_type$(*),Inst_type$(*)
3357    COM /Card_info/ Card_info$(*)
3358  !----------------------------------------------------------
3359    FOR Slot=1 TO (SIZE(Card_info$,1))
3360      IF Card_info$(Slot,1)<>"" THEN 
3361        SELECT Card_info$(Slot,1)
3362        CASE Card_type$(1)                    ! Card type E5252
3363          RETURN 1
3364        CASE Card_type$(2)                    ! Card type E5255
3365          FOR Block=1 TO 3
3366            IF VAL(Card_info$(Slot,2)[(Block-1)*2+1;1])=Iv_port THEN RETURN 1
3367          NEXT Block
3368        CASE ELSE
3369        END SELECT
3370      END IF
3371    NEXT Slot
3372    RETURN 0
3373  FNEND
3374  !==========================================================
