10   !*************************************************
20   !*
30   !* FILE       :  GONOGO
40   !* DESCRIPTION:  GONOGO Sample Program
50   !*
120  !* PRODUCT    :  4155,4156
130  !* REVISION   :  Rev.A.01.11
140  !*
150  !*   (c) Copyright Agilent Technologies 1994
160  !*              All rights reserved.
170  !*
180  !*
190  !*  Customer shall have the personal, non-
200  !* transferable right to use, copy or modify
210  !* this SAMPLE PROGRAM for Customer's internal
220  !* operations.  Customer shall use the SAMPLE
230  !* PROGRAM solely and exclusively for its own
240  !* purpose and shall not license, lease, market
250  !* or distribute the SAMPLE PROGRAM or modification
260  !* or any part thereof.
270  !*
280  !*  Agilent shall not be liable for the quality,
290  !* performance or behavior of the SAMPLE PROGRAM.
300  !* Agilent especially disclaims that the operation
310  !* of the SAMPLE PROGRAM shall be uninterrupted or
320  !* error free.  This SAMPLE PROGRAM is provided
330  !* AS IS.
340  !*
350  !*  AGILENT DISCLAIMS THE IMPLIED WARRANTIES OF
360  !* MERCHANTABILITY AND FITNESS FOR A PARTICULAR
370  !* PURPOSE.
380  !*
390  !*  Agilent shall not be liable for any infringement
400  !* of any patent, trademark copyright or other
410  !* proprietary rights by the SAMPLE PROGRAM or
420  !* its use. Agilent does not warrant that the SAMPLE
430  !* PROGRAM is free from infringements or such
440  !* right of third parties. However, Agilent will not
450  !* knowingly infringe or deliver a software that
460  !* infringes the patent, trademark, copyright or
470  !* other proprietary right of a third party.
480  !*
490  !*************************************************
500    COM /Infd/ Oname$[16],Dname$[16],Cmmt$[30]
510    COM /Dut_flag/ INTEGER Dut_flag
520    COM @Hp415x
530    COM /Model_flag/ Model_id$[5]
540    ASSIGN @Hp415x TO 800
550   !
560    Check_id      ! CHECK PRODCUT NUMBER
570    Start_demo    ! Welcome screen
580    Suppl_info    ! Operater name etc input
590    Init_hp415x   ! Initializes 415x
600   !
610    LOOP
620      Init_com    ! initialize COM variables
630      Select_dut  ! Select DUT type
640    EXIT IF Dut_flag=1000
650      Draw_frame  ! Draw initial frame
660      Dut_spec    ! Get specification of DUT ...
670      Copy_mfile  ! Copy meas file to memory
680      Write_info  ! Write specification etc ...
690      Meas_main   ! Main Measurement routine
700      Make_dfile  ! Download to data base file
710    END LOOP 
720   !
730    END
740   !
750 Start_demo: SUB Start_demo
760      COM @Hp415x
770      COM /Model_flag/ Model_id$
780      GCLEAR
790      CLEAR SCREEN
800      FOR I=5 TO 11
810        Xc=235
820        Yc=234
830        Xi=20
840        IF Model_id$="4155A" OR Model_id$="4156A" THEN Yi=14
850        IF Model_id$="4155B" OR Model_id$="4156B" THEN Yi=14.3
860        Draw_rctnglr(Xc-Xi*I,Xc+Xi*I,Yc-Yi*I,Yc+Yi*I,5)
870      NEXT I
880     !
890      PRINT TABXY(1,13);"GO / NO-GO TEST PROGRAM"
900      PRINT TABXY(18,23);"Press [Continue] to START"
910      FOR I=1 TO 28
920        IF I<19 THEN
930          IF I>3 THEN
940            PRINT TABXY(70-I*2,11);"    "
950            SELECT Model_id$
960            CASE "4155A"
970            PRINT TABXY(60-I*2,11);"   4155A  "
980            CASE "4156A"
990            PRINT TABXY(60-I*2,11);"   4156A  "
1000           CASE "4155B"
1010           PRINT TABXY(60-I*2,11);"   4155B  "
1020           CASE "4156B"
1030           PRINT TABXY(60-I*2,11);"   4156B  "
1040           END SELECT 
1050         END IF 
1060         PRINT TABXY(I,13);" "
1070         PRINT TABXY(I+1,13);"GO / NO-GO TEST PROGRAM"
1080       END IF 
1090       IF I MOD 2 THEN
1100         PRINT TABXY(18,23);"                         "
1110       ELSE 
1120         PRINT TABXY(18,23);"Press [Continue] to START"
1130       END IF 
1140     NEXT I
1150     PAUSE
1160   SUBEND
1170  !
1180 Suppl_info:SUB Suppl_info
1190     COM /Infd/ Oname$,Dname$,Cmmt$
1200     COM /Dut_flag/ INTEGER Dut_flag
1210     GCLEAR
1220     CLEAR SCREEN
1230     Oname$="                "
1240     Cmmt$="                              "
1250     Draw_rctnglr(50,400,185,295,7)
1260     Draw_rctnglr(53,397,188,292,7)
1270     PRINT TABXY(14,12);"Enter OPERATOR name."
1280     INPUT Oname$
1290     PRINT TABXY(14,12);"                   "
1300     PRINT TABXY(14,12);"Enter any comment."
1310     INPUT Cmmt$
1320     CLEAR SCREEN
1330     GCLEAR
1340   SUBEND
1350  !
1360 Draw_frame:SUB Draw_frame
1370     COM /Model_flag/ Model_id$
1380     GCLEAR
1390     IF Model_id$="4155A" OR Model_id$="4156A" THEN Yoff=0
1400     IF Model_id$="4155B" OR Model_id$="4156B" THEN Yoff=3
1410     Draw_rctnglr(155,275,373+Yoff,390+Yoff,2)   ! top box : yellow
1420     Draw_rctnglr(153,277,371+Yoff,392+Yoff,2)   ! top box : yellow
1430     Draw_rctnglr(20,352,315,365,4)    ! suppl info box : green
1440     Draw_rctnglr(20,470,165,310,4)    ! meas data outer box : green
1450     Draw_rctnglr(20,470,110,160,4)    ! meas data outer box : green
1460     Draw_rctnglr(357,470,315,365,6)   ! date box : dark red
1470     !
1480     PEN 5         ! yellow green
1490     FOR I=1 TO 9  ! meas data inner box
1500       Draw_line(40,290-(14*(I-1)),450,290-(14*(I-1)))
1510     NEXT I
1520     !
1530     Draw_line(40,290,40,290-(14*(9-1)))
1540     Draw_line(120,290,120,290-(14*(9-1)))
1550     Draw_line(192,290-14,192,290-(14*(9-1)))
1560     Draw_line(272,290,272,290-(14*(9-1)))
1570     Draw_line(380,290,380,290-(14*(9-1)))
1580     Draw_line(450,290,450,290-(14*(9-1)))
1590     !
1600     J=149
1610     PEN 7
1620     FOR I=1 TO 3  ! result data inner box
1630       Draw_line(100,J-(14*(I-1)),400,J-(14*(I-1)))
1640     NEXT I
1650    !
1660     FOR I=1 TO 4
1670       Draw_line(100+(I-1)*100,J,100+(I-1)*100,J-14*2)
1680     NEXT I
1690   !
1700     PRINT TABXY(5,8);"CURRENT DUT"
1710     PRINT TABXY(5,19);"STATUS"
1720   SUBEND
1730  !
1740 Dut_spec:SUB Dut_spec
1750     OPTION BASE 1
1760     COM /Paraname/ Par$(7)[9]
1770     COM /M_file/ M_file$(7)[10]
1780     COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
1790     COM /Dut_flag/ INTEGER Dut_flag
1800  !
1810     SELECT Dut_flag
1820  !
1830     CASE 1           !  MOSFET (SD214DE)
1840       Par$(1)="VTH"  ! parameter names
1850       Par$(2)="BETA"
1860       Par$(3)="Rdson"
1870       Par$(4)="GM"
1880       Par$(5)=""
1890       Par$(6)=""
1900       Par$(7)=""
1910  !
1920       Par_lmx(1)=2.5      ! parameter spec max limit
1930       Par_lmx(2)=9.E+99
1940       Par_lmx(3)=70
1950       Par_lmx(4)=9.E+99
1960       Par_lmx(5)=0
1970       Par_lmx(6)=0
1980       Par_lmx(7)=0
1990      !
2000       Par_lmn(1)=.1     ! parameter spec min limit
2010       Par_lmn(2)=.001
2020       Par_lmn(3)=0
2030       Par_lmn(4)=.001
2040       Par_lmn(5)=0
2050       Par_lmn(6)=0
2060       Par_lmn(7)=0
2070      !
2080       Par_lu$(1)="V"
2090       Par_lu$(2)="S"
2100       Par_lu$(3)="o"
2110       Par_lu$(4)="S"
2120       Par_lu$(5)=" "
2130       Par_lu$(6)=" "
2140       Par_lu$(7)=" "
2150  !
2160       M_file$(1)="VTH.MES"
2170       M_file$(2)=""
2180       M_file$(3)="RDS.MES"
2190       M_file$(4)="GM.MES"
2200       M_file$(5)=""
2210       M_file$(6)=""
2220       M_file$(7)=""
2230  !
2240     CASE 2           ! Bipolar (NPN)
2250       Par$(1)="HFE"  ! parameter names
2260       Par$(2)="BVCEO"
2270       Par$(3)="Re"
2280       Par$(4)="Rc"
2290       Par$(5)="Vearly"
2300       Par$(6)=""
2310       Par$(7)=""
2320  !
2330       Par_lmx(1)=300    ! parameter spec max limit
2340       Par_lmx(2)=9.E+99
2350       Par_lmx(3)=100
2360       Par_lmx(4)=50000
2370       Par_lmx(5)=0
2380       Par_lmx(6)=0
2390       Par_lmx(7)=0
2400      !
2410       Par_lmn(1)=100    ! parameter spec min limit
2420       Par_lmn(2)=40
2430       Par_lmn(3)=0
2440       Par_lmn(4)=0
2450       Par_lmn(5)=-200
2460       Par_lmn(6)=0
2470       Par_lmn(7)=0
2480      !
2490       Par_lu$(1)=" "
2500       Par_lu$(2)="V"
2510       Par_lu$(3)="o"
2520       Par_lu$(4)="o"
2530       Par_lu$(5)="V"
2540       Par_lu$(6)=""
2550       Par_lu$(7)=""
2560  !
2570       M_file$(1)="HFE.MES"
2580       M_file$(2)="BVCEO.MES"
2590       M_file$(3)="RE.MES"
2600       M_file$(4)="ICVC.MES"
2610       M_file$(5)=""
2620       M_file$(6)=""
2630       M_file$(7)=""
2640  !
2650     CASE ELSE 
2660       PRINT "IMPOSSIBLE"
2670     END SELECT 
2680   SUBEND
2690  !
2700 Write_info:SUB Write_info
2710     OPTION BASE 1
2720     COM /Infd/ Oname$,Dname$,Cmmt$
2730     COM /Paraname/ Par$(7)[9]
2740     COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
2750    !
2760     PRINT TABXY(21,2);"GO/NO-GO  TEST"
2770     PRINT TABXY(5,4);"OPERATOR:                 "
2780     PRINT TABXY(5,4);"OPERATOR: ";Oname$
2790     PRINT TABXY(47,4);"Date:"
2800     PRINT TABXY(47,5);DATE$(TIMEDATE)
2810     PRINT TABXY(5,5);"DEVICE :                 "
2820     PRINT TABXY(5,5);"DEVICE : ";Dname$
2830     PRINT TABXY(5,6);"COMMENT :                               "
2840     PRINT TABXY(5,6);"COMMENT : ";Cmmt$
2850   !
2860     PRINT TABXY(7,9);"Parameter       Limits          Result     Status"
2870    !
2880     FOR I=1 TO 7
2890       PRINT TABXY(8,9+I);"         "
2900       PRINT TABXY(8,9+I);Par$(I)
2910       PRINT TABXY(17,9+I);"       "
2920       PRINT TABXY(17,9+I);Par_lmn(I)
2930       PRINT TABXY(25,9+I);"       "
2940       PRINT TABXY(25,9+I);Par_lmx(I)
2950       PRINT TABXY(34,9+I);Par_lu$(I)
2960     NEXT I
2970    !
2980     PRINT TABXY(14,19);"  Ttl #        Good         Bad              "
2990     Print_s_data(0,0)
3000   !
3010     PEN 3
3020     PRINT TABXY(2,22);"Insert next device, then press [Next]."
3030     PRINT TABXY(2,23);"Or select desired softkey."
3040     PEN 1
3050   SUBEND
3060  !
3070 Draw_rctnglr:SUB Draw_rctnglr(X1,X2,Y1,Y2,Clr)
3080     COM /Model_flag/ Model_id$
3090     IF Clr<1 OR Clr>7 THEN Clr=1  ! prevent unexpected error
3100     IF Model_id$="4155A" OR Model_id$="4156A" THEN
3110     Xratio=1
3120     Yratio=1
3130     END IF 
3140     IF Model_id$="4155B" OR Model_id$="4156B" THEN
3150     Xratio=1.125
3160     Yratio=1.18
3170     END IF 
3180     PEN Clr                       ! specify pen color
3190     MOVE Xratio*X1,Yratio*Y1                    ! move to the initial point
3200     DRAW Xratio*X1,Yratio*Y2
3210     DRAW Xratio*X2,Yratio*Y2
3220     DRAW Xratio*X2,Yratio*Y1
3230     DRAW Xratio*X1,Yratio*Y1
3240     PEN 1
3250   SUBEND
3260     !
3270 Print_s_data:SUB Print_s_data(INTEGER Ttln,Gdn)
3280     PRINT TABXY(18,20);"                                                 "
3290     PRINT TABXY(18,20);Ttln
3300     PRINT TABXY(32,20);Gdn
3310     PRINT TABXY(44,20);Ttln-Gdn
3320   SUBEND
3330  !
3340 Meas_main:SUB Meas_main
3350     OPTION BASE 1
3360     COM /Lock/ Lock_flag
3370     COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
3380     COM /M_file/ M_file$(7)[10]
3390     COM /Paraname/ Par$(7)[9]
3400     COM @Hp415x
3410     COM /Dbst/ Res(7),Stat(7)
3420     COM /Db/ Dbdata(7,100),INTEGER Ttln,Gdn,REAL Avgdbdata(7),Sumdbdata(7),Maxdbdata(7),Mindbdata(7),Stdbdata(7)
3430     INTEGER I
3440    !
3450    !----- Inintialize parameters ------------
3460     Lock_flag=1! lock/unlock display flag :  0:unlock   1:lock
3470     Ttln=0    ! total number of measured data
3480     Gdn=0     ! number of good data
3490     FOR I=1 TO 7
3500       Avgdbdata(I)=0
3510       Sumdbdata(I)=0
3520       Maxdbdata(I)=0
3530       Mindbdata(I)=0
3540     NEXT I
3550    !
3560     OUTPUT @Hp415x;":DISP:ALL BAS"    ! Set to ALL IBASIC screen
3570     OUTPUT @Hp415x;":DISP OFF"        ! display lock on
3580    !
3590    !----- Main Menu --------------------------
3600 Menu1:   !
3610     ON KEY 1 LABEL " NEXT   DEVICE" GOTO Next_device
3620     ON KEY 2 LABEL "              " CALL No_ope
3630     ON KEY 3 LABEL " Lock         " CALL Lock_scrn
3640     ON KEY 4 LABEL " Unlock       " CALL Unlock_scrn
3650     ON KEY 5 LABEL "              " CALL No_ope
3660     ON KEY 6 LABEL " MORE         " GOTO Menu2
3670     ON KEY 7 LABEL " EXIT         " GOTO Exit_demo
3680     GOTO Lp
3690    !
3700 Menu2:   !
3710     ON KEY 1 LABEL "Change   Limit" CALL Change_limit
3720     ON KEY 2 LABEL "Statis  -tics " CALL Statis
3730     ON KEY 3 LABEL "Monitor  Curve" GOTO Menu3
3740     ON KEY 4 LABEL "              " CALL No_ope
3750     ON KEY 5 LABEL "              " CALL No_ope
3760     ON KEY 6 LABEL " MORE         " GOTO Menu1
3770     ON KEY 7 LABEL " EXIT         " GOTO Exit_demo
3780     GOTO Lp
3790    !
3800 Menu3:   !
3810     ON KEY 1 LABEL "Curve  "&Par$(1) CALL Recurve1
3820     ON KEY 2 LABEL "Curve  "&Par$(2) CALL Recurve2
3830     ON KEY 3 LABEL "Curve  "&Par$(3) CALL Recurve3
3840     ON KEY 4 LABEL "Curve  "&Par$(4) CALL Recurve4
3850     ON KEY 5 LABEL "Curve  "&Par$(5) CALL Recurve5
3860     ON KEY 6 LABEL "More          " GOTO Menu4
3870     ON KEY 7 LABEL "EXIT          " GOTO Menu1
3880     GOTO Lp
3890    !
3900 Menu4:   !
3910     ON KEY 1 LABEL "Curve  "&Par$(6) CALL Recurve6
3920     ON KEY 2 LABEL "Curve  "&Par$(7) CALL Recurve7
3930     ON KEY 3 LABEL "              " CALL No_ope
3940     ON KEY 4 LABEL "              " CALL No_ope
3950     ON KEY 5 LABEL "              " CALL No_ope
3960     ON KEY 6 LABEL "More          " GOTO Menu3
3970     ON KEY 7 LABEL "EXIT          " GOTO Menu1
3980     GOTO Lp
3990    !
4000 Lp:!
4010     LOOP
4020     END LOOP 
4030    !
4040 Next_device: !
4050     Ttln=Ttln+1
4060     Gdn=Gdn+1
4070     FOR I=1 TO 7
4080       Stat(I)=0
4090     NEXT I
4100     PRINT TABXY(2,22);"                                      "
4110     PRINT TABXY(2,23);"                          "
4120    !
4130     I=1
4140     LOOP
4150     EXIT IF M_file$(I)="" AND Par$(I)="" OR I>7
4160       Ex_para(Res(I),I)
4170       I=I+1
4180     END LOOP 
4190    !
4200     OUTPUT @Hp415x;"DISP:ALL BAS"
4210    !
4220     Check_data(Res(*),Stat(*),Flag)
4230    !
4240     IF Flag=1 THEN Gdn=Gdn-1
4250     IF Flag=0 THEN
4260       FOR I=1 TO 7
4270         IF Gdn=1 THEN
4280           Maxdbdata(I)=Res(I)
4290           Mindbdata(I)=Res(I)
4300         END IF 
4310         Dbdata(I,Gdn)=Res(I)
4320         Sumdbdata(I)=Sumdbdata(I)+Res(I)
4330         Avgdbdata(I)=DROUND((Sumdbdata(I)/Gdn),6)
4340         IF Res(I)>Maxdbdata(I) THEN Maxdbdata(I)=Res(I)
4350         IF Res(I)<Mindbdata(I) THEN Mindbdata(I)=Res(I)
4360       NEXT I
4370     END IF 
4380    !
4390     Print_c_data(Res(*),Stat(*))   ! print current data
4400     Print_s_data(Ttln,Gdn)         ! print status
4410     DISP "                  "
4420     IF Flag=1 THEN
4430       BEEP 300,.1
4440       BEEP 250,.5
4450     ELSE 
4460       BEEP 1400,.2
4470     END IF 
4480     PRINT TABXY(2,23);"Or select desired softkey."
4490     PRINT TABXY(2,22);"Insert next device, then press [Next]."
4500     GOTO Lp
4510    !
4520 Exit_demo:   !
4530     PRINT TABXY(2,22);"                                      "
4540     PRINT TABXY(2,23);"                          "
4550     INPUT "Do you really exit? (y/n)",Ans$
4560     IF Ans$="n" OR Ans$="N" THEN GOTO Lp
4570   SUBEND
4580  !
4590 Print_c_data:SUB Print_c_data(Res(*),Stat(*))
4600     OPTION BASE 1
4610     FOR I=1 TO 7
4620       PRINT TABXY(36,I+9);"                   "
4630       PRINT TABXY(36,I+9);DROUND(Res(I),7)
4640       IF Stat(I)=1 THEN
4650         Stat$="BAD    "
4660         BEEP 200,.02
4670       ELSE 
4680         Stat$="GOOD   "
4690       END IF 
4700       PRINT TABXY(50,I+9);Stat$
4710     NEXT I
4720   SUBEND
4730  !
4740 Check_data:SUB Check_data(Data(*),Stat(*),Flag)
4750    !
4760    !    0: Good    1: Bad
4770    !    Flag : status of DUT
4780    !    Stat(*): status of each measured parameters
4790    !
4800     OPTION BASE 1
4810     COM /Dut_flag/ INTEGER Dut_flag
4820     COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
4830    !
4840     Flag=0
4850     FOR I=1 TO 7
4860       IF Data(I)>Par_lmx(I) OR Data(I)<Par_lmn(I) THEN
4870         Stat(I)=1
4880         Flag=1
4890       END IF 
4900     NEXT I
4910   SUBEND
4920  !
4930 Ex_para:SUB Ex_para(Para,INTEGER I)
4940     OPTION BASE 1
4950     COM /M_file/ M_file$(7)[10]
4960     COM /Paraname/ Par$(7)[9]
4970     COM /Lock/ Lock_flag
4980     COM @Hp415x
4990    !
5000     PRINT TABXY(1,23),"Now measuring "&Par$(I)&" ..."
5010     IF M_file$(I)<>"" THEN
5020       IF I<=4 THEN
5030         OUTPUT @Hp415x;":MMEM:LOAD:STAT 0,'MEM"&VAL$(I)&".MES','MEMORY'"
5040       ELSE 
5050         OUTPUT @Hp415x;":MMEM:LOAD:STAT 0,'"&M_file$(I)&".MES','DISK'"
5060       END IF 
5070     END IF 
5080    !
5090     IF Lock_flag=0 THEN
5100       OUTPUT @Hp415x;"DISP:ALL BST"
5110     ELSE 
5120       OUTPUT @Hp415x;"DISP:ALL BAS"
5130     END IF 
5140    !
5150     IF M_file$(I)<>"" THEN
5160       OUTPUT @Hp415x;":PAGE:SCON:SING"       ! trigger
5170       OUTPUT @Hp415x;"*OPC?"                 ! Wait OPC
5180       ENTER @Hp415x;A
5190     END IF 
5200     OUTPUT @Hp415x;"TRAC? '"&Par$(I)&"'"     ! extract parameter
5210     ENTER @Hp415x;Para
5220     PRINT TABXY(36,I+9);"                   "
5230     PRINT TABXY(36,I+9);DROUND(Para,7)
5240     PRINT TABXY(1,23),"                                 "
5250   SUBEND
5260  !
5270 Make_dfile:SUB Make_dfile
5280     OPTION BASE 1
5290     COM /Infd/ Oname$[16],Dname$[16],Cmmt$[30]
5300     COM /Paraname/ Par$(7)[9]
5310     COM /Db/ Dbdata(7,100),INTEGER Ttln,Gdn,REAL Avgdbdata(7),Sumdbdata(7),Maxdbdata(7),Mindbdata(7),Stdbdata(7)
5320     COM @Hp415x
5330    !
5340     D$=","         ! delimiter     (  ,  )
5350     L$=""          !               (     )
5360     M$=""","""     !               ( "," )
5370     N$=""""        !               (  "  )
5380     S$="Number"
5390    !
5400     PRINT TABXY(2,23);"Press [Download] to create LOTUS/EXEL data"
5410     ON KEY 1 LABEL " Down    load " GOTO Makedfile
5420     FOR I=2 TO 6
5430       ON KEY I LABEL "              " GOTO 5430
5440     NEXT I
5450     ON KEY 7 LABEL "Return to MAIN" GOTO Exit
5460 Lp: GOTO Lp
5470    !
5480 Makedfile:   !
5490     Dbname$=TIME$(TIMEDATE)
5500     Dbname$="DB"&Dbname$[1,2]&Dbname$[4,5]
5510     DISP "                                       "
5520     PRINT TABXY(2,23);"Type in file name [max 6 chr.]. (default= "&Dbname$&" )      "
5530     INPUT Dbname$
5540     Dbname$=Dbname$[1,6]
5550     CREATE Dbname$,1
5560     ASSIGN @File TO Dbname$;FORMAT ON
5570    !
5580     PRINT TABXY(2,23);"                                                    "
5590     PRINT TABXY(2,23);"Select database."
5600    !
5610     ON KEY 1 LABEL "LOTUS    1-2-3",2 GOTO Lotus
5620     ON KEY 2 LABEL "MS      Excel ",2 GOTO Excel
5630     FOR I=3 TO 6
5640       ON KEY I LABEL "              ",2 GOTO 5640
5650     NEXT I
5660     ON KEY 7 LABEL "Cancel        ",2 GOTO Exit
5670 Lp2:GOTO Lp2
5680    !
5690 Excel:   !
5700     GOTO Download
5710    !
5720 Lotus:!
5730     D$=M$
5740     L$=N$
5750     S$="""Number"""
5760     GOTO Download
5770    !
5780 Download:   !
5790     PRINT TABXY(2,23);"                                                    "
5800     DISP "Now downloading ..."
5810     OUTPUT @File;L$&"Date:"&D$&DATE$(TIMEDATE)&L$
5820     OUTPUT @File;L$&"Time:"&D$&TIME$(TIMEDATE)&L$
5830     OUTPUT @File;L$&"Operator:"&D$&Oname$&L$
5840     OUTPUT @File;L$&"Device :"&D$&Dname$&L$
5850     OUTPUT @File;L$&"Comment:"&D$&Cmmt$&L$
5860     DISP "Now downloading ....."
5870     OUTPUT @File
5880     OUTPUT @File;L$&"Total"&D$&"Good"&D$&"Bad"&L$
5890     OUTPUT @File;Ttln,Gdn,Ttln-Gdn
5900     OUTPUT @File
5910     OUTPUT @File;L$&"Good data"&L$
5920     OUTPUT @File;S$&D$&Par$(1)&D$&Par$(2)&D$&Par$(3)&D$&Par$(4)&D$&Par$(5)&D$&Par$(6)&D$&Par$(7)&L$
5930     DISP "Now downloading ......."
5940     FOR I=1 TO Gdn
5950       OUTPUT @File;I,Dbdata(1,I),Dbdata(2,I),Dbdata(3,I),Dbdata(4,I),Dbdata(5,I),Dbdata(6,I),Dbdata(7,I)
5960     NEXT I
5970     OUTPUT @File
5980     DISP "Now downloading ........."
5990    !
6000     OUTPUT @File;L$&"Average"&L$&",";Avgdbdata(1),Avgdbdata(2),Avgdbdata(3),Avgdbdata(4),Avgdbdata(5),Avgdbdata(6),Avgdbdata(7)
6010     OUTPUT @File;L$&"Max.   "&L$&",";Maxdbdata(1),Maxdbdata(2),Maxdbdata(3),Maxdbdata(4),Maxdbdata(5),Maxdbdata(6),Maxdbdata(7)
6020     OUTPUT @File;L$&"Min.   "&L$&",";Mindbdata(1),Mindbdata(2),Mindbdata(3),Mindbdata(4),Mindbdata(5),Mindbdata(6),Mindbdata(7)
6030     OUTPUT @File;L$&"St Dev."&L$&",";Stdbdata(1),Stdbdata(2),Stdbdata(3),Stdbdata(4),Stdbdata(5),Stdbdata(6),Stdbdata(7)
6040     GOTO Exit
6050    !
6060 Exit:   !
6070     DISP "                                   "
6080     ASSIGN @File TO *
6090     PRINT TABXY(2,23);"                                                    "
6100     GCLEAR
6110     CLEAR SCREEN
6120     OUTPUT @Hp415x;":DISP ON"  ! display lock off
6130   SUBEND
6140  !
6150 Lock_scrn:SUB Lock_scrn
6160     COM /Lock/ Lock_flag
6170     COM @Hp415x
6180     Lock_flag=1! lock
6190     OUTPUT @Hp415x;":DISP:ALL BAS" ! return to IBASIC screen
6200     OUTPUT @Hp415x;":DISP OFF"     ! display lock on
6210   SUBEND
6220   !
6230 Unlock_scrn:SUB Unlock_scrn
6240     COM /Lock/ Lock_flag
6250     COM @Hp415x
6260     Lock_flag=0! unlock
6270     OUTPUT @Hp415x;":DISP ON"  ! display lock off
6280   SUBEND
6290  !
6300 No_ope:SUB No_ope
6310   SUBEND
6320  !
6330 Copy_mfile:SUB Copy_mfile
6340     OPTION BASE 1
6350     COM @Hp415x
6360     COM /Paraname/ Par$(7)[9]
6370     COM /M_file/ M_file$(7)[10]
6380     DIM Dsp$[50]
6390    !
6400     Dsp$="Copying meas files into memories ..."
6410     C$="."
6420    !
6430     I=0
6440     LOOP
6450       I=I+1
6460     EXIT IF M_file$(I)="" AND Par$(I)=""
6470     EXIT IF I=5
6480    !
6490       Dsp$=Dsp$&C$
6500       DISP Dsp$
6510       OUTPUT @Hp415x;":MMEM:COPY '"&M_file$(I)&"','DISK','MEM"&VAL$(I)&".MES','MEMORY'"
6520     END LOOP 
6530     DISP "                                           "
6540   SUBEND
6550    !
6560 Re_curve:SUB Re_curve(INTEGER I)
6570     OPTION BASE 1
6580     COM @Hp415x
6590     COM /M_file/ M_file$(7)[10]
6600     OUTPUT @Hp415x;":DISP ON"  ! display lock off
6610     IF M_file$(I)="" THEN SUBEXIT
6620     DISP "Getting file ..."
6630     IF I<=4 THEN
6640       OUTPUT @Hp415x;":MMEM:LOAD:STAT 0,'MEM"&VAL$(I)&".MES','MEMORY'"
6650     ELSE 
6660       OUTPUT @Hp415x;":MMEM:LOAD:STAT 0,'"&M_file$(I)&".MES','DISK'"
6670     END IF 
6680     OUTPUT @Hp415x;":DISP:ALL BST" ! set IBASIC status screen
6690     OUTPUT @Hp415x;":PAGE:SCON:SING"         ! trigger
6700     OUTPUT @Hp415x;"*OPC?"                   ! Wait OPC
6710     ENTER @Hp415x;A
6720     DISP "press [Continue]"
6730     PAUSE
6740     DISP "                  "
6750     OUTPUT @Hp415x;":DISP:ALL BAS" ! return to IBASIC screen
6760     OUTPUT @Hp415x;":DISP OFF"     ! display lock on
6770   SUBEND
6780    !
6790 Recurve1:SUB Recurve1
6800     Re_curve(1)
6810   SUBEND
6820  !
6830 Recurve2:SUB Recurve2
6840     Re_curve(2)
6850   SUBEND
6860  !
6870 Recurve3:SUB Recurve3
6880     Re_curve(3)
6890   SUBEND
6900  !
6910 Recurve4:SUB Recurve4
6920     Re_curve(4)
6930   SUBEND
6940  !
6950 Recurve5:SUB Recurve5
6960     Re_curve(5)
6970   SUBEND
6980  !
6990 Recurve6:SUB Recurve6
7000     Re_curve(6)
7010   SUBEND
7020  !
7030 Recurve7:SUB Recurve7
7040     Re_curve(7)
7050   SUBEND
7060  !
7070 Change_limit:SUB Change_limit
7080     OPTION BASE 1
7090     COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
7100     COM /Paraname/ Par$(7)[9]
7110    !
7120     DISP "Which parameter?"
7130    !
7140 Menu1:   !
7150     ON KEY 1 LABEL "Min.   "&Par$(1),2 GOTO Minpar1
7160     ON KEY 2 LABEL "Max.   "&Par$(1),2 GOTO Maxpar1
7170     ON KEY 3 LABEL "Min.   "&Par$(2),2 GOTO Minpar2
7180     ON KEY 4 LABEL "Max.   "&Par$(2),2 GOTO Maxpar2
7190     ON KEY 5 LABEL "Min.   "&Par$(3),2 GOTO Minpar3
7200     ON KEY 6 LABEL "MORE     MENU ",2 GOTO Menu2
7210     ON KEY 7 LABEL "EXIT          ",2 GOTO Exit_ch
7220     GOTO Lp
7230    !
7240 Menu2:   !
7250     ON KEY 1 LABEL "Max.   "&Par$(3),2 GOTO Maxpar3
7260     ON KEY 2 LABEL "Min.   "&Par$(4),2 GOTO Minpar4
7270     ON KEY 3 LABEL "Max.   "&Par$(4),2 GOTO Maxpar4
7280     ON KEY 4 LABEL "Min.   "&Par$(5),2 GOTO Minpar5
7290     ON KEY 5 LABEL "Max.   "&Par$(5),2 GOTO Maxpar5
7300     ON KEY 6 LABEL "MORE     MENU ",2 GOTO Menu3
7310     ON KEY 7 LABEL "EXIT          ",2 GOTO Exit_ch
7320     GOTO Lp
7330    !
7340 Menu3:   !
7350     ON KEY 1 LABEL "Min.   "&Par$(6),2 GOTO Minpar6
7360     ON KEY 2 LABEL "Max.   "&Par$(6),2 GOTO Maxpar6
7370     ON KEY 3 LABEL "Min.   "&Par$(7),2 GOTO Minpar7
7380     ON KEY 4 LABEL "Max.   "&Par$(7),2 GOTO Maxpar7
7390     ON KEY 5 LABEL " ",2 CALL No_ope
7400     ON KEY 6 LABEL "MORE     MENU ",2 GOTO Menu1
7410     ON KEY 7 LABEL "EXIT          ",2 GOTO Exit_ch
7420     GOTO Lp
7430    !
7440 Lp:!
7450     DISP "Which parameter?                   "
7460     Write_limit
7470     LOOP
7480     END LOOP 
7490    !
7500 Maxpar1:   !
7510     DISP "Input new limit value.             "
7520     INPUT Par_lmx(1)
7530     GOTO Lp
7540    !
7550 Maxpar2:   !
7560     DISP "Input new limit value.             "
7570     INPUT Par_lmx(2)
7580     GOTO Lp
7590    !
7600 Maxpar3:   !
7610     DISP "Input new limit value.             "
7620     INPUT Par_lmx(3)
7630     GOTO Lp
7640    !
7650 Maxpar4:   !
7660     DISP "Input new limit value.             "
7670     INPUT Par_lmx(4)
7680     GOTO Lp
7690    !
7700 Maxpar5:   !
7710     DISP "Input new limit value.             "
7720     INPUT Par_lmx(5)
7730     GOTO Lp
7740    !
7750 Maxpar6:   !
7760     DISP "Input new limit value.             "
7770     INPUT Par_lmx(6)
7780     GOTO Lp
7790    !
7800 Maxpar7:   !
7810     DISP "Input new limit value.             "
7820     INPUT Par_lmx(7)
7830     GOTO Lp
7840    !
7850 Minpar1:   !
7860     DISP "Input new limit value.             "
7870     INPUT Par_lmn(1)
7880     GOTO Lp
7890    !
7900 Minpar2:   !
7910     DISP "Input new limit value.             "
7920     INPUT Par_lmn(2)
7930     GOTO Lp
7940    !
7950 Minpar3:   !
7960     DISP "Input new limit value.             "
7970     INPUT Par_lmn(3)
7980     GOTO Lp
7990    !
8000 Minpar4:   !
8010     DISP "Input new limit value.             "
8020     INPUT Par_lmn(4)
8030     GOTO Lp
8040    !
8050 Minpar5:   !
8060     DISP "Input new limit value.             "
8070     INPUT Par_lmn(5)
8080     GOTO Lp
8090    !
8100 Minpar6:   !
8110     DISP "Input new limit value.             "
8120     INPUT Par_lmn(6)
8130     GOTO Lp
8140    !
8150 Minpar7:   !
8160     DISP "Input new limit value.             "
8170     INPUT Par_lmn(7)
8180     GOTO Lp
8190    !
8200 Exit_ch:   !
8210     DISP "                                     "
8220   SUBEND
8230    !
8240 Write_limit:SUB Write_limit
8250     OPTION BASE 1
8260     COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
8270     COM /Paraname/ Par$(7)[9]
8280     COM @Hp415x
8290     DIM Par_lmx_d(7),Par_lmn_d(7)
8300    !
8310     FOR I=1 TO 7
8320       PRINT TABXY(8,9+I);Par$(I)
8330       PRINT TABXY(17,9+I);"         "
8340       PRINT TABXY(25,9+I);"         "
8350       Par_lmx_d(I)=DROUND(Par_lmx(I),3)
8360       Par_lmn_d(I)=DROUND(Par_lmn(I),3)
8370       PRINT TABXY(17,9+I);Par_lmn_d(I)
8380       PRINT TABXY(25,9+I);Par_lmx_d(I)
8390       PRINT TABXY(34,9+I);Par_lu$(I)
8400     NEXT I
8410    !
8420   SUBEND
8430  !
8440 Statis:SUB Statis
8450     OPTION BASE 1
8460     COM /Dbst/ Res(7),Stat(7)
8470     COM /Db/ Dbdata(7,100),INTEGER Ttln,Gdn,REAL Avgdbdata(7),Sumdbdata(7),Maxdbdata(7),Mindbdata(7),Stdbdata(7)
8480     DIM St$[7]
8490     REAL Sum,Dif
8500    !
8510     Sum=0
8520     Dif=0
8530    !
8540 Menu1:   !
8550     ON KEY 1 LABEL "Average       ",2 GOTO Average
8560     ON KEY 2 LABEL "Max.          ",2 GOTO Maxd
8570     ON KEY 3 LABEL "Min.          ",2 GOTO Mind
8580     ON KEY 4 LABEL "Stndrd Dev.   ",2 GOTO Stdev
8590     ON KEY 5 LABEL "              ",2 CALL No_ope
8600     ON KEY 6 LABEL "Current data  ",2 GOTO Current
8610     ON KEY 7 LABEL " EXIT   Stat  ",2 GOTO Exit
8620     GOTO Lp
8630    !
8640 Lp:!
8650     LOOP
8660     END LOOP 
8670    !
8680 Average:   !
8690     St$="average"
8700     Print_d_data(Avgdbdata(*),St$)
8710     GOTO Lp
8720    !
8730 Maxd:    !
8740     St$=" Max."
8750     Print_d_data(Maxdbdata(*),St$)
8760     GOTO Lp
8770    !
8780 Mind:   !
8790     St$=" Min. "
8800     Print_d_data(Mindbdata(*),St$)
8810     GOTO Lp
8820    !
8830 Stdev:   !
8840     FOR J=1 TO 7
8850       Sum=0
8860       Dif=0
8870       FOR I=1 TO Gdn
8880         Dif=(Dbdata(J,I)-Avgdbdata(J))
8890         Sum=Sum+Dif^2
8900       NEXT I
8910       Stdbdata(J)=DROUND(SQRT(Sum/Gdn),6)
8920     NEXT J
8930    !
8940     St$="St dev."
8950     Print_d_data(Stdbdata(*),St$)
8960     GOTO Lp
8970    !
8980 Current: !
8990     Print_c_data(Res(*),Stat(*))   ! print current data
9000     GOTO Lp
9010    !
9020 Exit:   !
9030     Print_c_data(Res(*),Stat(*))   ! print current data
9040   SUBEND
9050    !
9060 Print_d_data:SUB Print_d_data(REAL Res(*),St$)
9070     OPTION BASE 1
9080     FOR I=1 TO 7
9090       PRINT TABXY(36,I+9);"                   "
9100       PRINT TABXY(36,I+9);Res(I)
9110       PRINT TABXY(50,I+9);"       "
9120       PRINT TABXY(50,I+9);St$
9130     NEXT I
9140   SUBEND
9150  !
9160 Draw_line:SUB Draw_line(X1,Y1,X2,Y2)
9170     OPTION BASE 1
9180     COM /Model_flag/ Model_id$
9190     IF Model_id$="4155A" OR Model_id$="4156A" THEN
9200     Xratio=1
9210     Yratio=1
9220     END IF 
9230     IF Model_id$="4155B" OR Model_id$="4156B" THEN
9240     Xratio=1.125
9250     Yratio=1.18
9260     END IF 
9270     MOVE Xratio*X1,Yratio*Y1
9280     DRAW Xratio*X2,Yratio*Y2
9290   SUBEND
9300  !
9310 Select_dut:SUB Select_dut
9320     COM /Infd/ Oname$,Dname$,Cmmt$
9330     COM /Dut_flag/ INTEGER Dut_flag
9340     Draw_rctnglr(50,400,150,295,5)
9350     Draw_rctnglr(52,398,152,293,5)
9360     PRINT TABXY(10,10);"Select Device type"
9370     PRINT TABXY(13,12);"1 -- SD214DE (MOSFET (n-chan.))"
9380     PRINT TABXY(13,13);"2 -- 2N3904  (Bipolar (NPN))"
9390     PRINT TABXY(13,14);"3 -- *******"     ! for future enhance ###
9400     PRINT TABXY(13,15);"4 -- *******"     ! for future enhance ###
9410     PRINT TABXY(13,16);"5 -- *******"     ! for future enhance ###
9420     PRINT TABXY(13,17);"6 -- *******"     ! for future enhance ###
9430    !
9440    !
9450 Menu_dut:   !
9460     ON KEY 1 LABEL " (1)   SD214DE" GOTO Dut1
9470     ON KEY 2 LABEL " (2)   2N3904 " GOTO Dut2
9480     ON KEY 3 LABEL " (3)          " GOTO End
9490     ON KEY 4 LABEL " (4)          " GOTO End
9500     ON KEY 5 LABEL " (5)          " GOTO End
9510     ON KEY 6 LABEL " (6)          " GOTO End
9520     ON KEY 7 LABEL " END          " GOTO End
9530     GOTO Lp
9540    !
9550 Lp: !
9560     LOOP
9570     END LOOP 
9580    !
9590 Dut1:   !
9600     Dut_flag=1
9610     Dname$="SD214DE (MOSFET)"
9620     GOTO Exit
9630    !
9640 Dut2:   !
9650     Dut_flag=2
9660     Dname$="2N3904 (Bipolar)"
9670     GOTO Exit
9680    !
9690 Dut3:   !
9700     Dut_flag=3
9710     Dname$=""
9720     GOTO Exit
9730    !
9740 Dut4:   !
9750     Dut_flag=4
9760     Dname$=""
9770     GOTO Exit
9780    !
9790 Dut5:   !
9800     Dut_flag=5
9810     Dname$=""
9820     GOTO Exit
9830    !
9840 Dut6:   !
9850     Dut_flag=6
9860     Dname$=""
9870     GOTO Exit
9880    !
9890 End:   !
9900     Dut_flag=1000
9910     GOTO Exit
9920    !
9930 Exit:   !
9940     CLEAR SCREEN
9950     GCLEAR
9960   SUBEND
9970  !
9980 Init_com: SUB Init_com
9990     OPTION BASE 1
10000    COM /Dut_flag/ INTEGER Dut_flag
10010    COM /Dbst/ Res(7),Stat(7)
10020    COM /Paraname/ Par$(7)[9]
10030    COM /M_file/ M_file$(7)[10]
10040    COM /Dut_lim/ REAL Par_lmx(7),Par_lmn(7),Par_lu$(7)[1]
10050    COM /Db/ Dbdata(7,100),INTEGER Ttln,Gdn,REAL Avgdbdata(7),Sumdbdata(7),Maxdbdata(7),Mindbdata(7),Stdbdata(7)
10060   !
10070    Dut_flag=0
10080    FOR I=1 TO 7
10090      Res(I)=0
10100      Stat(I)=0
10110      Par$(I)="         "
10120      M_file$(I)="          "
10130      Par_lmx(I)=0
10140      Par_lmn(I)=0
10150      Par_lu$(I)=" "
10160      Ttln=0
10170      Gdn=0
10180      Avgdbdata(I)=0
10190      Sumdbdata(I)=0
10200      Maxdbdata(I)=0
10210      Stdbdata(I)=0
10220      FOR J=1 TO 100
10230        Dbdata(I,J)=0
10240      NEXT J
10250    NEXT I
10260  SUBEND
10270  !
10280 Init_hp415x:SUB Init_hp415x
10290    COM @Hp415x
10300    DISP "Initializing ....."
10310    OUTPUT @Hp415x;"*RST"
10320    OUTPUT @Hp415x;"*CLS"
10330    OUTPUT @Hp415x;":STAT:PRES"
10340    OUTPUT @Hp415x;"*ESE 60;*SRE 32;*OPC?"
10350    ENTER @Hp415x;A
10360    DISP "                     "
10370  SUBEND
10380 Check_id:SUB Check_id
10390    COM @Hp415x
10400    COM /Model_flag/ Model_id$
10410    DIM Prod_id$[50]
10420    OUTPUT @Hp415x;"*IDN?"
10430    ENTER @Hp415x;Prod_id$
10440    Model_id$=Prod_id$[17,21]
10450  SUBEND
