COMMON sgcode$, atten$, sgen$, ch$, ctr$, nn$

CLS
SCREEN 9
COLOR 14, 1

file$ = "c:\qb\gpr4200\res\"
DIM z$(900)
DIM fr(36)
DIM fm(50)
DIM fm$(50)
DIM md(50)
DIM gprdata$(900)
DIM gprsn(900)

nn$ = "file"
ctr$ = "2"


freq:
FOR f = 1 TO 9
  READ fr(f)
NEXT f
DATA 68,90,110,130,150,170,190,210,230
'dATA 20,50,105,120,210,240,325,390,451,610,720,910,999
'DATA 27,75,95,130,170,220,250,350,440,610,700,999


CLOSE
main:
nn$ = "FILE"

filedata:
CLOSE
CLS
LOCATE 10, 10
PRINT "Retrieving Data From  -   ";
PRINT file$ + nn$

OPEN file$ + nn$ FOR INPUT AS #1
COLOR 10
LOCATE 14, 30
PRINT "Please Wait"


zz = 1
 WHILE NOT EOF(1)
  INPUT #1, z$(zz)
  zl$ = LCASE$(z$(zz))

  IF zl$ = "info" THEN info = zz
  IF zl$ = "info end" THEN infend = zz

  IF zl$ = "noise floor" THEN nf = zz
  IF zl$ = "noise end" THEN nfend = zz

  IF zl$ = "level accuracy" THEN la = zz
  IF zl$ = "la end" THEN laend = zz

  IF zl$ = "bandwidth level accuracy" THEN bla = zz
  IF zl$ = "bla end" THEN blaend = zz

  IF zl$ = "linearity" THEN lin = zz
  IF zl$ = "overload" THEN ovl = zz
  IF zl$ = "lin end" THEN linend = zz

  IF zl$ = "attenutors" THEN ats = zz
  IF zl$ = "att end" THEN atsend = zz

  IF zl$ = "am modulation" THEN am = zz
  IF zl$ = "am end" THEN amend = zz

  IF zl$ = "fm deviation" THEN fm = zz
  IF zl$ = "fm end" THEN fmend = zz

  IF zl$ = "adj channel" THEN adj = zz
  IF zl$ = "adj end" THEN adjend = zz

  IF zl$ = "image channel" THEN img = zz
  IF zl$ = "image end" THEN imgend = zz

  IF zl$ = "if. channel" THEN ifc = zz
  IF zl$ = "if end" THEN ifcend = zz

  IF zl$ = "blocking" THEN blk = zz
  IF zl$ = "block end" THEN blkend = zz

  IF zl$ = "intermod" THEN imod = zz
  IF zl$ = "inter end" THEN imodend = zz


  zz = zz + 1
WEND

CLS
SCREEN 9
bw$(1) = "7.5 kHz"
bw$(2) = "15 kHz"
bw$(3) = "20 kHz"
bw$(4) = "120 kHz"

pgloop = 1
DO
   IF pgloop = 1 THEN GOSUB info
   SCREEN 0
   COLOR 1, 1

  IF pgloop = 2 THEN GOSUB Noise
  IF pgloop = 3 THEN GOSUB level
  IF pgloop = 4 THEN GOSUB bandwidth
  IF pgloop = 5 THEN GOSUB linearity
  IF pgloop = 6 THEN GOSUB attenuators
  IF pgloop = 7 THEN GOSUB modulation
  IF pgloop = 8 THEN GOSUB deviation
  IF pgloop = 9 THEN GOSUB adjacent
  IF pgloop = 10 THEN GOSUB image
  IF pgloop = 11 THEN GOSUB ifrej
  IF pgloop = 12 THEN GOSUB block
  IF pgloop = 13 THEN GOSUB intermod
 
  pgloop = pgloop + 1

LOOP UNTIL pgloop = 14
GOTO choice

pge1:
info:
IF info = 0 OR infend - info <> 5 THEN RETURN

sd = info
rec$ = z$(info + 1)
sn$ = z$(info + 2)
fw$ = z$(info + 3)
dd$ = z$(info + 4)



SCREEN 8
CLS
COLOR 1, 1
bl = 6
GOSUB blank
COLOR 11
PRINT TAB(15); "Receiver Type ";
COLOR 14
PRINT TAB(40); rec$
COLOR 11
PRINT
PRINT TAB(15); "Serial No.";
COLOR 14
PRINT TAB(40); sn$
PRINT
COLOR 11
PRINT TAB(15); "Firmware Version";
PRINT TAB(40); fw$
COLOR 10
PRINT
PRINT
PRINT TAB(15); "Date of Calibration";
COLOR 11
PRINT TAB(40); dd$
PRINT
PRINT
LINE (80, 30)-(480, 130), 11, B
LINE (82, 32)-(478, 128), 14, B
page = 1
GOSUB nextlast
RETURN



Noise:
IF nf = 0 OR nfend - nf <> 109 THEN RETURN

CLS
' Noise floor
COLOR 15
PRINT "Noise Floor";
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$
PRINT
COLOR 11
PRINT TAB(8); "Frequency";
FOR x = 1 TO 4
  PRINT TAB(12 + (12 * x)); bw$(x);
NEXT x
PRINT
PRINT

sd = nf
x = 1
DO

f = 1
fx = 1
  COLOR 11
  PRINT TAB(10); fr(x);
  
  DO
    IF z$(sd + fx) = "----" THEN
      COLOR 7
      PRINT TAB(13 + (12 * f)); z$(sd + fx);
    ELSE
      COLOR 10
      IF z$(sd + fx + 2) = "!" THEN COLOR 12
      z = VAL(z$(sd + fx))
      PRINT TAB(12 + (12 * f)); USING "###.#"; z;
      COLOR 13
      PRINT z$(sd + fx + 1); " "; z$(sd + fx + 2);
    END IF
    
    fx = fx + 3
    f = f + 1
  LOOP UNTIL f = 5

  x = x + 1
  sd = sd + 12
LOOP UNTIL x = 10
PRINT
PRINT
PRINT TAB(22);
COLOR 13
PRINT "*  'birdy' present at this test."
page = 2

GOSUB nextlast
RETURN

level:
IF la = 0 OR laend - la <> 28 THEN RETURN

CLS
COLOR 15
PRINT "Level Accuracy"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

COLOR 14
PRINT
PRINT TAB(12); "Frequency";
PRINT TAB(39); "Level At"
PRINT TAB(30); "20 dBæV"; TAB(48); "80 dBæV"
PRINT
sd = la
lp = 1
DO
  
  fr$ = LEFT$(z$(sd + lp), 4)
  l80$ = RIGHT$(z$(sd + lp), 8)
  l20$ = MID$(z$(sd + lp), 12, 8)
  fail$(1) = z$(sd + lp + 1)
  fail$(2) = z$(sd + lp + 2)
  IF fail$(1) = "!" THEN rcol1 = 12 ELSE rcol1 = 10
  IF fail$(2) = "!" THEN rcol2 = 12 ELSE rcol2 = 10

  COLOR 11
  PRINT TAB(12); fr$; "MHz";
  IF l20$ = "  ----  " THEN
    COLOR 7
    PRINT TAB(30); l20$; TAB(48); l80$
  ELSE
    l20 = VAL(l20$)
    l80 = VAL(l80$)
    COLOR rcol1
    PRINT TAB(30); USING "###.#"; l20;
    PRINT " dBæV  "; fail$(1);
    COLOR rcol2
    PRINT TAB(48); USING "###.#"; l80;
    PRINT " dBæV  "; fail$(2)
   END IF
  lp = lp + 3
LOOP UNTIL lp > 27
page = 3
GOSUB nextlast
RETURN


bandwidth:
CLS
IF bla = 0 OR blaend - bla <> 29 THEN RETURN

sd = bla
COLOR 15
PRINT z$(bla)
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

PRINT
COLOR 14
PRINT TAB(8); "Frequency"; TAB(36); "Bandwidth"; TAB(64); "Detector"
PRINT TAB(20); "7.5 kHz";
PRINT TAB(30); "15 kHz";
PRINT TAB(40); "25 kHz";
PRINT TAB(50); "120 kHz";
PRINT TAB(62); "AV 1s"; TAB(72); "PK 1s"
PRINT

f = 0
DO
  x = 10
  lp = 2
  COLOR 11
  PRINT TAB(8); z$(sd + 1 + f); " MHz";
  DO
    d = sd + lp + f
    IF LEFT$(z$(d), 1) <> "D" THEN
      x = x + 10
      IF z$(d) = "----" THEN
        COLOR 7
        PRINT TAB(x); z$(d);
      ELSE
        IF z$(d + 1) = "!" THEN rcol = 12 ELSE rcol = 10
        lev = VAL(z$(d))
        COLOR rcol
        PRINT TAB(x); USING "###.#"; lev;
        PRINT z$(d + 1);
      END IF
    ELSE lp = lp - 1

    END IF
    lp = lp + 2
 
  LOOP UNTIL lp > 14
  f = f + 14
LOOP UNTIL f > 16

GOSUB nextlast
RETURN

linearity:
IF lin = 0 OR linend - lin <> 13 THEN RETURN

CLS
sd = lin
COLOR 15
PRINT z$(sd)
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

COLOR 14
PRINT
PRINT TAB(12); "Actual";
PRINT TAB(36); "Measured"
PRINT TAB(12); "dBæV";
PRINT TAB(36); "dBæV"
PRINT
lp = 1
faillev = 11.5

DO
COLOR 11
atl = (lp * 10) - 30
IF atl = 60 THEN atl = 59
PRINT TAB(12); atl;
COLOR 10
lev = VAL(z$(sd + lp))
fail = ABS(atl - lev)
IF fail > faillev THEN rcol = 12 ELSE rcol = 10
COLOR rcol
PRINT TAB(36); USING "###.#"; lev;
PRINT " dBæV"
lp = lp + 1
faillev = 1.5
LOOP UNTIL lp = 10

bd$ = z$(sd + 10)
IF bd$ = "*" THEN
  COLOR 13
  PRINT
  PRINT TAB(20); "*   'birdy' at this test"
END IF

COLOR 15
PRINT "Overload Threshold"
PRINT
ol = VAL(z$(ovl + 1))
COLOR 14
PRINT TAB(12); "Nominal";
PRINT TAB(36); "Measured"
PRINT TAB(12); "dBæV"; TAB(36); "dBæV"
COLOR 11
PRINT TAB(12); "100.0";
fail = ABS(100 - ol)
IF fail > 1.5 THEN rcol = 12 ELSE rcol = 10
COLOR rcol
PRINT TAB(36); USING "###.#"; ol

GOSUB nextlast
RETURN

attenuators:
IF ats = 0 OR atsend - ats <> 3 THEN RETURN

CLS
COLOR 15
PRINT "Attenuators"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

PRINT
COLOR 14
PRINT TAB(38); "Test Frequency"
PRINT TAB(30); "100 MHz"; TAB(50); "200 MHz "
PRINT TAB(12); "Setting"; TAB(30); "Measured"; TAB(50); "Measured"
PRINT TAB(15); "dB"; TAB(34); "dB"; TAB(54); "dB"

sd = ats
lp = 1
'DO
  COLOR 11
  atvl = VAL(LEFT$(z$(sd + lp), 5))
  PRINT TAB(14); atvl;

  att(1) = VAL(RIGHT$(z$(sd + lp), 4))
  att(2) = VAL(RIGHT$(z$(sd + lp + 1), 4))
  IF att(1) - atvl > 1.5 OR att(1) - atvl < -1.5 THEN col(1) = 12 ELSE col(1) = 10
  IF att(2) - atvl > 1.5 OR att(2) - atvl < -1.5 THEN col(2) = 12 ELSE col(2) = 10
 
  COLOR col(1)
  PRINT USING "##.#"; TAB(32); att(1);
  COLOR col(2)
  PRINT USING "##.#"; TAB(52); att(2)

  lp = lp + 1
'LOOP UNTIL lp =
COLOR 11
PRINT
'PRINT TAB(12); "Fix @ 70 dBæV";
COLOR 10
'PRINT TAB(30); z$(sd + 12)

GOSUB nextlast
RETURN


modulation:
IF am = 0 OR amend - am <> 13 THEN RETURN
CLS
sd = am

COLOR 15
PRINT "A. M. Modulation"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

PRINT
COLOR 14
PRINT TAB(12); "Actual"; TAB(36); "Measured"
PRINT TAB(12); "% Mod"; TAB(39); "% Mod"
PRINT
lp = 1
DO
  COLOR 11
  amd = (lp - 1) * 10
  IF amd = 100 THEN amd = 99.9
  PRINT TAB(12); amd;
  md = VAL(z$(lp + sd))
  COLOR 10
  PRINT TAB(39); USING "###.#"; md
  lp = lp + 1
LOOP UNTIL lp = 12
bd$ = z$(sd + 12)
PRINT
IF bd$ = "*" THEN
  COLOR 13
  PRINT TAB(20); "*   'birdy' at this test"
ELSE
  PRINT
END IF

GOSUB nextlast
RETURN


deviation:
IF fm = 0 OR fmend - fm <> 46 THEN RETURN
sd = fm
bd$ = z$(sd + 45)

CLS
COLOR 15
PRINT "F.M. Deviation"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

PRINT
COLOR 13
IF bd$ = "*" THEN PRINT "*   'birdy at this test"

COLOR 14
PRINT "Bandwidth"
PRINT "7.5 kHz"; TAB(20); "15 kHz"; TAB(38); "20/25 kHz"; TAB(60); "120 kHz"
COLOR 11
lp = 0

DO
  PRINT TAB((lp * 20) + 1);
  PRINT "Actual  Measured";
  lp = lp + 1
LOOP UNTIL lp = 4
lp = 0

DO
  COLOR 11
  PRINT TAB((lp * 20) + 1);
  PRINT "kHz      kHz";
  lp = lp + 1
LOOP UNTIL lp = 4
PRINT


lp = 1
DO
  md(lp) = VAL(LEFT$(z$(sd + lp), 4))
  fm$(lp) = RIGHT$(z$(sd + lp), 5)
  fm(lp) = VAL(fm$(lp))
  lp = lp + 1
LOOP UNTIL lp = 45

lp = 0
DO
  COLOR 11
  PRINT USING "##.#"; md(1 + lp);
  COLOR 10
  PRINT TAB(8); USING "##.##"; fm(1 + lp);
  COLOR 11
  PRINT TAB(20); md(10 + lp);
  COLOR 10
  PRINT TAB(28); USING "##.##"; fm(10 + lp);
 
  IF fm$(19 + lp) = "----" THEN
    COLOR 7
    PRINT TAB(48); fm$(19 + lp);
  ELSE
    COLOR 11
    PRINT TAB(40); md(19 + lp);
    COLOR 10
    PRINT TAB(48); USING "##.#"; (fm(19 + lp));
  END IF
 
  IF fm$(36 + lp) = "----" THEN
    COLOR 7
    PRINT TAB(68); fm$(36 + lp)
  ELSE
    COLOR 11
    PRINT TAB(60); md(36 + lp);
    COLOR 10
    PRINT TAB(68); USING "##.#"; fm(36 + lp)
  END IF

  lp = lp + 1
LOOP UNTIL lp = 9
lp = 1
DO
  IF fm$(27 + lp) = "----" THEN
    COLOR 7
    PRINT TAB(48); fm$(27 + lp);
  ELSE
    COLOR 11
    PRINT TAB(40); md(27 + lp);
    COLOR 10
    PRINT TAB(48); USING "##.#"; (fm(27 + lp));
  END IF
 
  lp = lp + 1
LOOP UNTIL lp = 9

GOSUB nextlast
RETURN


adjacent:

IF adj = 0 OR adjend - adj <> 37 THEN RETURN

CLS
COLOR 15
PRINT "Adjacent Channel Selectivity"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

sd = adj
PRINT TAB(12);
COLOR 14
PRINT "Frequency"; TAB(40); "Bandwidth"
PRINT TAB(30); "7.5 kHz"; TAB(48); "15 kHz"
PRINT TAB(12); "MHz"; TAB(32); "dB"; TAB(50); "dB"
lp = 1
lp2 = 1
DO
  COLOR 11
  PRINT TAB(12); fr(lp);
 
  IF z$(lp2 + sd) = "----" THEN
    COLOR 7
    PRINT TAB(32); "----"; TAB(50); "----"
  ELSE
    COLOR 10
    adj2 = VAL(z$(lp2 + sd + 18))
    adj1 = VAL(z$(lp2 + sd))
    IF adj1 > 50 THEN rcol1 = 10 ELSE rcol1 = 12
    IF adj2 > 60 THEN rcol2 = 10 ELSE rcol2 = 12
    COLOR rcol1
    PRINT TAB(32); USING "###.#"; adj1;
    COLOR 13
    PRINT "  "; z$(lp2 + sd + 1);
    COLOR rcol2
    PRINT TAB(50); USING "###.#"; adj2;
    COLOR 13
    PRINT "  "; z$(lp2 + sd + 19)
  END IF
  lp = lp + 1
  lp2 = lp2 + 2
LOOP UNTIL lp = 10
PRINT
COLOR 13
PRINT TAB(20); "*   'birdy' at this test"

GOSUB nextlast
RETURN


image:
CLS

IF img = 0 OR imgend - img <> 9 THEN RETURN
COLOR 14
PRINT "Image Rejection"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

COLOR 15
PRINT TAB(12); "Frequency"; TAB(24); "Image"; TAB(36); "Measured"
PRINT TAB(14); "MHz"; TAB(24); "MHz"; TAB(40); "dB"
sd = img
lp = 1
DO
  f = VAL(z$(sd + lp))
  imf = VAL(z$(sd + lp + 1))
  im$ = (z$(sd + lp + 2))
  bd$ = (z$(sd + lp + 3))

  COLOR 11
  PRINT TAB(12); f;
  PRINT TAB(24); imf;
  IF im$ = "----" THEN
    COLOR 7
    PRINT TAB(40); im$

  ELSE
    IF VAL(im$) > 55 THEN rcol = 10 ELSE rcol = 12
    COLOR rcol
    PRINT TAB(40); USING "##.#"; VAL(im$);
    COLOR 13
    PRINT TAB(47); bd$
  END IF
 
  lp = lp + 4
LOOP UNTIL lp > 8
COLOR 13
PRINT
PRINT TAB(20); "*   'birdy' at this freq"
                                  

COLOR 14
GOSUB nextlast
RETURN

ifrej:

IF ifc = 0 OR ifcend - ifc <> 4 THEN RETURN
CLS

COLOR 15
PRINT "I.F. Rejection"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

COLOR 14
PRINT TAB(12); "Frequency"; TAB(24); "I.F."; TAB(36); "Measured"
PRINT TAB(14); "MHz"; TAB(24); "MHz"; TAB(40); "dB"

sd = ifc
lp = 1
'DO
  ifr(lp) = VAL(z$(sd + lp + 2))

  IF ifr(lp) <> 0 OR z$(sd + lp + 2) = "> 100" THEN

    COLOR 11
    PRINT TAB(12); USING "###.#"; VAL(z$(sd + lp));
    PRINT TAB(24); USING "####.#"; VAL(z$(sd + lp + 1));
    IF z$(sd + lp + 2) = "----" THEN
      COLOR 7
      PRINT TAB(40); "----"
    ELSE
      COLOR 10
        IF z$(sd + lp + 2) = "> 100" THEN
          PRINT TAB(40); "> 100"
        ELSE
          IF ifr(lp) < 55 THEN rcol = 12 ELSE rcol = 10
          COLOR rcol
          PRINT TAB(40); USING "###.#"; ifr(lp)
        END IF
    END IF
  ELSE
      PRINT
  END IF
  lp = lp + 3
'LOOP UNTIL lp = 10
GOSUB nextlast
RETURN

block:
CLS
IF blk = 0 OR blkend - blk <> 5 THEN RETURN

sd = blk
COLOR 15
PRINT "Blocking"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

PRINT
COLOR 14
PRINT TAB(12); "Frequency";
PRINT TAB(40); "Measured"
PRINT TAB(12); "   MHz"; TAB(40); "  dBæV"
PRINT
lp = 1
DO
  fr$ = LEFT$(z$(sd + lp), 4)
  lev$ = RIGHT$(z$(sd + lp), 5)
  bdy$ = z$(sd + lp + 1)
  COLOR 11
  PRINT TAB(12); fr$;

  IF lev$ = " ----" THEN
    COLOR 7
    PRINT TAB(40); lev$
  ELSE
    lev = VAL(lev$)
    IF lev > 80 THEN rcol = 10 ELSE rcol = 12
    COLOR rcol
    PRINT TAB(40); USING "###.#"; lev;
    COLOR 13
    PRINT TAB(48); bdy$
  END IF

  lp = lp + 2
LOOP UNTIL lp = 5
PRINT
COLOR 13
PRINT TAB(20); "*   'birdy' at this test"

GOSUB nextlast
RETURN

intermod:
CLS
IF imod = 0 OR imodend - imod <> 5 THEN RETURN

sd = imod
COLOR 15
PRINT "Intermodulation"
LOCATE 1, 60
PRINT "GPR "; rec$; "      "; sn$

PRINT
COLOR 14
PRINT TAB(12); "Frequency";
PRINT TAB(36); "level";
PRINT TAB(48); "Measured"
PRINT TAB(12); "  MHz";
PRINT TAB(36); "dBæV";
PRINT TAB(48); "dBæV";
PRINT
PRINT

lp = 1
DO
  fr$ = LEFT$(z$(sd + lp), 3)
  lev1$ = MID$(z$(sd + lp), 14, 5)
  lev2$ = RIGHT$(z$(sd + lp), 4)
  bd$ = z$(sd + lp + 1)
  COLOR 11
  PRINT TAB(14); fr$;
  COLOR 13
  PRINT TAB(20); bd$;
 
  IF lev2$ = "----" THEN
    COLOR 7
    PRINT TAB(36); lev1$;
    PRINT TAB(48); lev2$
  ELSE
    lev1 = VAL(lev1$)
    lev2 = VAL(lev2$)
    IF lev2 >= 60 THEN rcol = 10 ELSE rcol = 12
    COLOR rcol
    PRINT TAB(36); USING "###.#"; lev1;
    PRINT TAB(48); USING "###.#"; lev2
  END IF

  lp = lp + 2
LOOP UNTIL lp = 5
   PRINT
   COLOR 13
   PRINT TAB(20); "*   'birdy' at this test"
GOSUB nextlast
RETURN

CLOSE

choice:

CLS : COLOR 15: PRINT "                         42xx series results program"

PRINT
COLOR 14: PRINT "Do you wish to"
PRINT

COLOR 11: PRINT "         1 ... View The Last Set Of Results"
PRINT "         2 ... View Another Set of Results"
PRINT "         3 ... Save These Results"
PRINT "         4 ... Print These results"
PRINT "         5 ... Change to 43xx series results program"
PRINT "         6 ... Run Another Test"

PRINT : COLOR 12: PRINT "         9 ... Quit"

PRINT
COLOR 10
INPUT ch$
ch = VAL(RIGHT$(ch$, 1))

IF ch = 9 THEN
  CLS
  END
END IF

IF ch < 1 OR ch > 6 THEN GOTO choice

IF ch = 1 THEN GOTO main

IF ch = 3 THEN
  filen$ = "F" + sn$
  CLS
  LOCATE 19, 10
  COLOR 14
  GOSUB filenos
  ow$ = ""
  ow = 0
  lp = 1
  DO
    sn = VAL(sn$)
    IF sn < 1000 OR sn > 9999 THEN GOTO choice

    IF sn = gprsn(lp) THEN
      ow = 1
      gprsave$ = gprdata$(lp)
    END IF
    lp = lp + 1
  LOOP UNTIL lp = gprdat
 
  IF ow = 1 THEN
    CLS
    COLOR 10
    LOCATE 8, 10
    PRINT "File Exists..."
    COLOR 11
    LOCATE 11, 14
    PRINT "Serial No.    GPR type      Date of cal."
    COLOR 14
    LOCATE 12, 14
    PRINT gprsave$
    LOCATE 16, 20
    COLOR 10
    PRINT "Overwrite     ( Y / N )";
    INPUT ow$
  ELSE
    ow$ = "y"
  END IF

  IF ow$ = "y" OR ex$ = "Y" THEN
save:
    OPEN file$ + "filenos" FOR APPEND AS #6
    PRINT #6, sn$, rec$, dd$
    OPEN file$ + filen$ FOR OUTPUT AS #5
    COLOR 14
    LOCATE 20, 10
    PRINT "Saving Data to File         "; file$ + filen$
   
    lp = 1
    DO
      PRINT #5, z$(lp)
      lp = lp + 1
    LOOP UNTIL lp = zz
    CLOSE
    SLEEP 5
  END IF
END IF

printdata:
IF ch = 4 THEN
  CHAIN "c:\qb\gpr4200\prinres"
  END
END IF


viewanother:
IF ch = 2 THEN
  ssn$ = ""
  GOSUB filenos
  GOSUB displist
  LOCATE 20, 10
  COLOR 14
  INPUT "Enter Required Serial no."; ssn$
  IF u = 1 THEN
    IF ssn$ = "u" OR ssn$ = "U" THEN GOTO viewanother
  END IF
  ssn = VAL(ssn$)
  IF ssn < 1000 OR ssn > 9999 THEN GOTO viewanother

  nn$ = "F" + ssn$
  GOTO filedata
  END
END IF

IF ch = 5 THEN CHAIN "c:\qb\gpr\results"

IF ch = 6 THEN CHAIN "c:\qb\gpr4200\menu"

GOTO choice
END


filenos:
  CLS
  COLOR 14
  LOCATE 5, 10
  PRINT "Please Wait"
  OPEN file$ + "filenos" FOR INPUT AS #6
  gprdat = 1
  LOCATE 3, 1
  WHILE NOT EOF(6)
    INPUT #6, gprdata$(gprdat)
     gprsn(gprdat) = VAL(LEFT$(gprdata$(gprdat), 4))
    gprdat = gprdat + 1
  WEND
  CLOSE

sort:
  slp = 1
  DO
  lp = 1
  DO
    IF gprsn(lp) < gprsn(lp - 1) THEN
      SWAP gprsn(lp), gprsn(lp - 1)
      SWAP gprdata$(lp), gprdata$(lp - 1)
    END IF
    lp = lp + 1
  LOOP UNTIL lp = gprdat
  slp = slp + 1
  LOOP UNTIL slp = gprdat
 
  dup = 1
  DO
    IF gprsn(dup) = gprsn(dup + 1) THEN gprdata$(dup) = "x"
  dup = dup + 1
  LOOP UNTIL dup = gprdat
RETURN

displist:
CLS
 OPEN file$ + "filenos" FOR OUTPUT AS #6
xl = 1
  COLOR 11
  PRINT TAB(10); "Serial No      Type            Date of Cal"
  PRINT
  u = 0
  lp = 1
  lp1 = 1
 
  DO
    IF gprdata$(lp) <> "x" THEN
      COLOR 10
      PRINT TAB(10); gprdata$(lp)
      PRINT #6, gprdata$(lp)
      lp1 = lp1 + 1
    END IF
   lp = lp + 1
   xx = lp1 / 18
  
   IF xx = xl THEN
     PRINT
     COLOR 15
     PRINT TAB(40); "more ....."
     GOSUB space
     CLS
     COLOR 11
     PRINT TAB(10); "Serial no.       Type            Date of Cal"
     LOCATE 3, 10
     COLOR 10
     u = 1
     xl = xl + 1
   END IF
 LOOP UNTIL lp = gprdat
 CLOSE

  RETURN

space:
SLEEP 2
LOCATE 23, 15
COLOR 14
PRINT "Press ";
COLOR 11
PRINT " SPACE BAR";
COLOR 14
PRINT " To Continue"

DO
  sp$ = INKEY$
LOOP UNTIL sp$ = " "

LOCATE 23, 15
PRINT "                              "
RETURN


nextlast:
 
SLEEP 1
LOCATE 23, 5
COLOR 14
PRINT "Press  ";
IF pgloop = 1 THEN
  COLOR 11
  PRINT "> ";
  COLOR 14
  PRINT "To Go Forward     ";
ELSE
  COLOR 11
  PRINT " < ";
  COLOR 14
  PRINT "To Go Back    ";
  COLOR 11
  PRINT "> ";
  COLOR 14
  PRINT "To Go Forward     ";
  COLOR 10
  PRINT " T ";
  COLOR 14
  PRINT "To Repeat This Test"
END IF


kpress:
 DO
  sp$ = INKEY$
  sp = 0
   IF sp$ = "<" OR sp$ = "," THEN
     pgloop = pgloop - 2
     sp = 1
   END IF
   IF sp$ = ">" OR sp$ = "." THEN
     pgloop = pgloop
     sp = 1
   END IF
   IF sp$ = "t" OR sp$ = "T" THEN
     pgloop = pgloop
     GOTO retest
   END IF
 LOOP UNTIL sp = 1

 LOCATE 23, 15
 PRINT "                                                    "
RETURN

blank:
FOR B = 1 TO bl
  PRINT
NEXT B
RETURN

retest:
'repeat test of results page selected
CLOSE
ch = pgloop - 1
IF ch = 12 THEN ch = 11:                'intermod - do blocking
ch$ = STR$(ch)
'PRINT ch$
ctr$ = "2"
IF ch < 1 THEN GOTO nextlast


'chain relevent program
  IF ch >= 2 AND ch <= 10 THEN
    ch = ch - 1
    ch$ = STR$(ch)
    CHAIN "c:\qb\gpr4200\conn2"
  END IF
  IF ch = 1 THEN
    ch$ = "10"
    CHAIN "c:\qb\gpr4200\conn1"
  END IF
  IF ch = 11 THEN CHAIN "c:\qb\gpr4200\block"

GOTO nextlast:          ' if no test
END

