%%HP: T(1)A(D)F(.);
DIR
  RP.
    « DUP2 -16 FS?C
3 DROPN V2 -16 SF
V -16 CF DUP
      IF 0 <
      THEN 360 +
      END DUP
      IF 360 >
      THEN 360 -
      END HMS azi
TAG SWAP dist TAG
    »
  PR.
    « DUP ROT HMS
DUP COS ROT * lat
TAG ROT ROT SIN *
dep TAG
    »
  INVERS.
    « MKPN. SWAP
MKPN. SWAP INVR.
    »
  OS.
    « Kogo DTAG DUP
      IF TYPE 0
SAME
      THEN 'OSD.'
STO
      END 0 DIST.
    »
  RAD.1
    «  r
      « r
        IF 0 ‹
        THEN
          IF BLRAD.
0 ‹
          THEN 25
SF 0 RAD. 25 CF
          END
        END r RAD.
      »
    »
  stp.
    « STP.
    »
  HI.
    « Kogo DTAG DUP
      IF TYPE 0 ==
      THEN DUP
'HI.' STO OCCG. -
'MU.' STO
        IF 16 FS?
        THEN
          IF 20 FS?
          THEN
SUNTE. NOTES. "MU="
MU. 2 RND + +
" HI=" HI. 2 RND +
10 CHR + + 'NOTES.'
STO
          END
        END RECSHT.
VSTR.
      ELSE
"Numeric data
required."
PROMPT
      END
    »
  HR.
    « Kogo DTAG DUP
      IF TYPE 0 ==
      THEN 'HR.'
STO
        IF 16 FS?
        THEN
          IF 20 FS?
          THEN
NOTES. "HR=" HR. 2
RND + 10 CHR + +
'NOTES.' STO
          END
        END RECSHT.
VSTR.
      ELSE
"Numeric data
required."
PROMPT
      END
    »
  TLEV.
    « DUP 'VD.' STO
HI. + HR. - "Elev"
TAG HI. "HI" TAG
SWAP HR. "HR" TAG
SWAP VD. "VD" TAG
SWAP
    »
  DLEV.
    « HI. SWAP -
    »
  JOB.
    «  a
      « JOBNAME.
JOBS. 0 SWAP EVAL
DUP
        IF TYPE 6
SAME
        THEN DUP
CRDIR EVAL
        END { MSPD.
R3A. R3B. R3C. R3H.
R3P. CRAP. ARSP.
TFS. TBS. TT. SUP.
OCCP. A. B. C. D.
P0 P00 R3MP1.
R3MP2. R3MPB1.
R3MPB2. R3TD.
R3TST. A B C D E F
G H I J K L M N O P
Q R S T U V W X Y Z
} PURGE UPDIR PATH
OBJ  b
        « a EVAL
PATH OBJ  c
          «
            IF b c
SAME
            THEN a
CRDIR UPDIR a
'JOBNAME.' STO 8
DROPN
"Using New Job"
            ELSE
UPDIR UPDIR a
'JOBNAME.' STO 8
DROPN
"Using Exist Job"
            END 1
DISP 1 FREEZE
          »
        »
      »
    »
  JOBS.
    DIR
      GREEN
        DIR
          P5004 {
912995.737032
685137.762051 254.67
TRAV }
          P424 {
912937.64898
685280.08421 0
PROPCOR }
          P427 {
912883.3937
685308.0371 0
PROPCOR }
          P426 {
912899.6902
685277.06253 0
PROPCOR }
          P482 {
912296.63648
684724.74944 246.74
CLPC }
        END
    END
  ABC.
    «  a
      « a DUP
        IF 0 SAME
        THEN 11 CF
DROP KILL
        END
        IF 11 FC?
        THEN 0 DUP
'COL1.' STO 'COL2.'
STO RCP. DUP 'PRE.'
STO 'BE.' STO DUP
'PRN.' STO 'BN.'
STO 11 SF a
Curr.Pnt TAG KILL
        END RCP.
DUP PRN. * 'COL2.'
STO+ SWAP DUP PRE.
* 'COL1.' STO+
'PRN.' STO 'PRE.'
STO BN. PRE. *
COL1. + 'FCOL1.'
STO BE. PRN. *
COL2. + 'FCOL2.'
STO FCOL1. FCOL2. -
ABS 2 / DUP sq.ft
TAG SWAP 43560 /
Acres TAG a
Curr.Pnt TAG ROT
ROT
      »
    »
  RCA.
    «  r c
      « r SQ 2 * c
SQ - r SQ 2 * /
ACOS  d
        « r SQ 2 /
d DR d SIN - *
'SqFt' TAG DUP
43560 / 'Ac' TAG c
r / 2 / ASIN 180 ‡
/ NUM / 2 * r *
'Arc' TAG d HMS
'Delta' TAG SWAP
        »
      »
    »
  BEAM.
    « rod TAG SWAP
beam TAG ROT dist
TAG DUP 100 / 3
PICK * 4 PICK - HI.
+ elev TAG
    »
  LEVL.
    « DUP rod TAG
SWAP HI. SWAP -
elev TAG
    »
  VSTR.
    « Kogo DUP DUP
'RECSHT.' STO
RECSHT. OBJ DROP
'LSSA.' STO SWAP
PR. 'HD.' STO
'VD.' STO DROP
      IF 12 FS?
      THEN 12 CF
BMP. DUP
        IF TYPE 6
SAME
        THEN GETZD.
DROP2 SPE.
        END HR. +
VD. NEG + 'HI.' STO
        IF 16 FS?
        THEN
          IF 20 FS?
          THEN
            IF 27
FC?
            THEN
SUNTE. NOTES. "HI="
HI. 2 RND + 10 CHR
+ + 'NOTES.' STO
            END
          END
        END
      END 2 FIX MU.
STR "/" + HI. STR
+ " R:" + HR. STR
+ 1 DISP 4 FIX OBJ
DROP "AR:" SWAP
      IF 9 FS?
      THEN DROP
FANG.
      END STR +
      IF 9 FS?
      THEN " " +
SANG. STR +
      END 3 DISP
" ZA:" SWAP STR +
6 DISP "V:" VD.
STR + VD. HI. +
HR. - STR " " SWAP
+ + 5 DISP "SD:"
SWAP STR + 7 DISP
" HD:" HD. STR +
      IF 9 FS?
      THEN MANG.
STR SWAP +
      END 27 CF 4
DISP DROP LCP.
".NP " PDESC. STR
+ + 2 DISP 1 FREEZE
2 FREEZE 3 FREEZE 4
FREEZE 5 FREEZE 6
FREEZE 7 FREEZE
    »
  RECRD.
    «
      IF 23 FS?
      THEN NXTP.
MKPN. OWPCHK.
      END
      IF 14 FS?
      THEN SGDAT.
      END DUP
      IF TYPE 5 ==
      THEN OBJ
DROP LCP.  a b c d
r
        « c b PR.
SWAP HI. + HR. -
'GELV.' STO d SWAP
13 SF
          IF 19 FS?
          THEN 28
SF
          END SS.
          IF 28 FS?
          THEN 28
CF 19 SF
          END 13 CF
r STP. GELV. r
STOEL. DROP PDESC.
DUP
          IF TYPE 2
==
          THEN OBJ
          END r
STOD. DROP 1
'NXTP.' STO+
        »
      END
      IF 16 FS?
      THEN RECNTE.
      END
      IF 29 FS?
      THEN 29 CF
KILL
      END
    »
  blref.
    « DUP
      IF TYPE 2 ==
      THEN SGDAT.
      END DUP
      IF TYPE 5 ==
      THEN OBJ
DROP  q r s
        « r q PR.
s BAZI. HMS+ DUP
          IF 360 >
          THEN 360
-
          END SWAP
PR. B. + SWAP A. +
SWAP
        »
      END DUP
      IF TYPE 6 ==
      THEN RCP.
      END DUP
      IF TYPE 0 ==
      THEN 0 'P' 4
LIST JOBS.
JOBNAME. 'P0' STO
Kogo 'P0'
      END BLO.
BLAZ. OCCP. DUP
'P0' INVERS.  otp
      « BBINX. 0
'P' 4 LIST JOBS.
JOBNAME. 'P00' STO
Kogo  b c
        « c otp -
DUP
          IF 0 <
          THEN ABS
'Come'
          ELSE 'Go'
          END TAG
 cg
          « 'BLO.'
'P0' INVERS.  bs
bsd
            « bs
BLAZ. HMS- DUP
              IF 0
<
              THEN
360 HMS+
              END
DUP
              IF
360 >
              THEN
360 HMS-
              END 
ra
              « ra
bsd PR. DTAG SWAP
DTAG  os sqlen
« sqlen Sta1. +
"@ Sta" TAG os
'OS' TAG b Sta1. +
"To Sta" TAG cg
»
              »
            »
          »
        »
      »
    »
  HIGET.
    « 12 SF 'BMP.'
STO SS.
    »
  RESCT.
    «
      IF 23 FS?
      THEN 23 CF 24
SF
      END  h i j k
l
      « h MKPN. i
MKPN. 22 SF
        IF 2 FS?
        THEN 2 CF
21 SF
        END
        IF 16 FS?
        THEN 16 CF
18 SF
        END 10000
10000 'TT.' STP.
10000 j + 10000
'TBS.' STP. 'TT.'
SWAP SETUP. k l SS.
'TFS.' STP. 'TBS.'
SWAP SETUP. 'CD.'
STO 'TT.' SO. 'WD.'
STO 'WA.' STO h
MKPN. i MKPN.
SETUP. WA. WD. SS.
CD. Measured TAG
ROT ROT
        IF 18 FS?
        THEN 18 CF
16 SF
        END
        IF 21 FS?
        THEN 21 CF
2 SF
        END
      » 22 CF
      IF 24 FS?
      THEN 24 CF 23
SF
      END
    »
  BBINX.
    « SWAP MKPN.
SWAP  y z
      « SWAP MKPN.
SWAP  w x
        « JOBS.
JOBNAME. w EVAL
GETNE. y EVAL
GETNE. w EVAL LIST
3 DROPN V2 Kogo
'BPI.' STO INVR.
'BASED.' STO
'BASEAZ.' STO
BASEAZ. x HMS- ABS
'ANG1.' STO BASEAZ.
z HMS- ABS 'ANG3.'
STO x z HMS- ABS
'ANG2.' STO BASED.
ANG2. HMS SIN DUP
          IF 0 ==
          THEN
1.E-15 +
          END /
ANG3. HMS SIN *
ABS 'DIST1.' STO
DIST1. ANG3. HMS
SIN DUP
          IF 0 ==
          THEN
1.E-15 +
          END /
ANG1. HMS SIN *
ABS 'DIST2.' STO x
DIST1. PR. V2
BPI. + 'INTXP.' STO
DIST1. "Dist 1"
TAG DIST2.
"Dist 2" TAG
INTXP. V
        »
      »
    »
  BDINX.
    « SWAP MKPN.
SWAP  y z
      « SWAP MKPN.
SWAP  w x
        « w y JOBS.
JOBNAME. w EVAL
GETNE. y EVAL
GETNE. y EVAL LIST
3 DROPN V2 w EVAL
GETNE. V2 Kogo
'BPI.' STO 'EPI.'
STO INVR. 'BASED.'
STO 'BASEAZ.' STO
BASEAZ. x HMS- DUP
          IF 0 >
          THEN 360
SWAP HMS-
          END ABS
'ANG1.' STO z DUP
          IF BASED.
<
          THEN NEG
          END ANG1.
HMS SIN / BASED.
SWAP / ASIN ANG1.
HMS + HMS BASEAZ.
HMS+ z DUP
          IF BASED.
<
          THEN NEG
          END PR.
V2 EPI. + 'INTXP.'
STO INTXP. V
        »
      »
    »
  NDDX.
    «  p c q b
      « p RCP.
'pe.' STO 'pn.' STO
p q INVERS. 'a.'
STO 'tazi.' STO a.
b c + + 2 / 's.'
STO s. b - s. c -
DUP 's.c' STO * b c
* / ƒ ASIN 2 *
'dda.' STO s. a. -
s.c * a. c * / ƒ
ASIN 2 * DUP 'ddb.'
STO dda. + 180 SWAP
- 'ddc.' STO CLEAR
c b tazi. HMS ddb.
+ HMS c PR. pe. +
SWAP pn. + SWAP
      »
    »
  TPRS.
    «
      IF 23 FS?
      THEN 23 CF 24
SF
      END  fa sa
      « fa sa HMS-
'RDIF.' STO RDIF.
        IF 0 <
        THEN fa
'Ra.' STO RDIF. ABS
'Rb.' STO RCP. R3B.
STP. DROP RCP. R3C.
STP. DROP RCP. R3A.
STP. DROP
        ELSE 360 fa
HMS- 'Rb.' STO fa
sa HMS- 'Ra.' STO
RCP. R3A. STP. DROP
RCP. R3C. STP. DROP
RCP. R3B. STP. DROP
        END R3A.
R3B. INVR.
'R3ABD.' STO
'R3AB.' STO R3AB.
Rb. HMS- 'R3AH.'
STO R3AB. 180 HMS+
Ra. HMS+ 'R3BH.'
STO R3A. R3AH. R3B.
R3BH. BBINX. R3H.
STP. R3H. R3C.
INVR. DROP
'R3HP.' STO R3BH.
180 HMS- R3HP. HMS-
ABS Rb. HMS+ 180
SWAP HMS- R3BH.
SWAP HMS- 'R3BP.'
STO R3B. R3BP. R3H.
R3HP. BBINX. R3P.
STP. DROP2 'R3TD.'
STO CLEAR R3A. RCP.
R3A. R3H. INVR. 2
/ 2 PICK 'R3MPB1.'
STO PR. 3 PICK +
SWAP 4 PICK + SWAP
'R3MP1.' STP. R3H.
RCP. R3H. R3B.
INVR. 2 / 2 PICK
'R3MPB2.' STO PR.
3 PICK + SWAP 4
PICK + SWAP R3MP2.
STP. R3MPB2. 90 +
R3MP1. R3MPB1. 90 +
BBINX. R3RP. STP.
R3H. INVR. R3RP.
R3C. INVR. 3 PICK
 t b
        « R3B. RCP.
R3BP. 180 + R3TD.
PR. 3 PICK + SWAP
4 PICK + SWAP
R3TST. STP. CLEAR b
t
          IF >
          THEN R3P.
          ELSE
R3TST.
          END RCP.
          IF 24 FS?
          THEN 23
SF 24 CF
          END
        »
      »
    »
  R3MPB2.
267.345299413
  R3MPB1.
236.460199416
  R3TD.
100.346362817
  R3BP.
363.261604976
  R3HP.
342.333004976
  R3BH.
447.345299414
  R3AH.
236.460199414
  R3AB.
257.384799414
  R3ABD.
53.2219879377
  Rb. 20.5246
  Ra. 9.5605
  RDIF. -20.5246
  BUPDIR.
    « PATH LIST 
a
      « a
        IF 2 ==
        THEN Kogo
        ELSE UPDIR
        END a DROPN
      »
    »
  MSPD. RP
  RAD.
    « Kogo DTAG DUP
      IF TYPE 0
SAME
      THEN DUP
        IF 0 SAME
        THEN
          IF BLRAD.
0 ‹
          THEN DAZ.
DEFL. HMS+ 'BLAZ.'
STO SOP. DUP 'BLB.'
STO 'BLP.' STO
          END
        END
'BLRAD.' STO 0 DUP
'DBLINT.' STO
'BLINT.' STO
      END 0 DIST.
    »
  MKPN.
    « DTAG DUP
      IF TYPE 0 ==
      THEN "P" SWAP
STR + DUP "." POS
1 - 1 SWAP SUB OBJ
      END
    »
  OCCG. 0
  ADIF. .00035
  RPNO. 87.5151
  MU. 433.27
  MUPR.
    « Kogo DTAG DUP
      IF TYPE 0 ==
      THEN 'MU.'
STO OCCG. MU. +
'HI.' STO
        IF 16 FS?
        THEN
          IF 20 FS?
          THEN
SUNTE. NOTES. "MU="
MU. 2 RND + +
" HI=" HI. 2 RND +
10 CHR + + 'NOTES.'
STO
          END
        END RECSHT.
VSTR.
      ELSE
"Numeric data
 required."
PROMPT
      END
    »
  ELO.
    «
      IF 20 FS?
      THEN 20 CF
"Elev is OFF"
      ELSE 20 SF
"Elev is ON"
      END 1 DISP 1
FREEZE
    »
  NOTES.
"Lilly 
Wall Check"
  NOTER.
    «
      IF 16 FS?
      THEN 16 CF
"Notes are OFF"
      ELSE 16 SF
"Notes are ON"
      END 1 DISP 1
FREEZE
    »
  SPCTN.
    « MKPN. DUP
JOBS. JOBNAME. EVAL
Kogo
      IF 16 FS?
      THEN DUP STR
DUP SIZE 1 - 2 SWAP
SUB ROT STR DUP
SIZE 1 - 3 SWAP SUB
"(" SWAP ")" + +
SWAP + 10 CHR +
NOTES. SWAP +
'NOTES.' STO
      END
    »
  SUNTE.
    « SUP. OBJ
DROP STR DUP SIZE
1 - 3 SWAP SUB SWAP
STR DUP SIZE 1 - 3
SWAP SUB "  T@ "
SWAP + 10 CHR SWAP
+ SWAP "   Bs "
SWAP + BAZI. 4 RND
STR "  Azi=" SWAP
+ SWAP + + 10 CHR +
NOTES. SWAP +
'NOTES.' STO
    »
  RECNTE.
    «
      IF 19 FS?
      THEN 19 CF
"S/O " ARSP. STR
DUP SIZE 1 - 3 SWAP
SUB "(" SWAP ")" +
+ +
        IF 20 FS?
        THEN " EL="
+ SPE. 2 RND + " "
        ELSE "   "
        END + SPD.
DUP
        IF 'P' SAME
        THEN DROP
        ELSE +
        END 10 CHR
+ " " + ANG. 4 RND
STR + " " + SOD. 2
RND + 10 CHR +
"Rec as " + LCP.
STR DUP SIZE 1 - 3
SWAP SUB "(" SWAP
")" + + +
        IF 20 FS?
        THEN
" Grd=" + GELV. 2
RND + " "
        ELSE "  "
        END +
PDESC. + 10 CHR +
" " + MHA. 4 RND
STR + " " + MHD. 2
RND +
        IF 20 FS?
        THEN " V="
+ VD. 2 RND + " " +
MCF.
        ELSE "   "
        END + 10
CHR +
      ELSE
        IF 17 FS?
        THEN 17 CF
LCP. STR DUP SIZE
1 - 3 SWAP SUB "("
SWAP ")" + + "SS "
SWAP +
          IF 20 FS?
          THEN
" Grd=" + GELV. 2
RND + " "
          ELSE "  "
          END +
PDESC. + 10 CHR +
"  1)" + FANG. 4
RND STR + 10 CHR +
"  2)" + SANG. 4
RND STR + 10 CHR +
          IF 0
THANG. <
          THEN
"  3)" + THANG. 4
RND STR + 10 CHR +
          END
          IF 0
FUANG. <
          THEN
"  4)" + FUANG. 4
RND STR + 10 CHR +
          END
"  M)" + MANG. 4
RND STR + " " +
HD. 2 RND +
          IF 20 FS?
          THEN
" V=" + VD. 2 RND
          ELSE " "
          END + 10
CHR +
        ELSE LCP.
STR DUP SIZE 1 - 3
SWAP SUB "(" SWAP
")" + + "SS " SWAP
+
          IF 20 FS?
          THEN
" Grd=" + GELV. 2
RND + " "
          ELSE "  "
          END +
PDESC. + 10 CHR +
" " + LSSA. 4 RND
STR + " " + HD. 2
RND +
          IF 20 FS?
          THEN
" V=" + VD. 2 RND
          ELSE " "
          END + 10
CHR +
        END
      END NOTES.
SWAP + 'NOTES.' STO
    »
  BLDEST. P412
  ATOLSET.
    « DUP
      IF TYPE 0
SAME
      THEN DUP
'ATOL.' STO
"Atol Set" TAG
      END
    »
  GOGO.
    «
      IF 2 FC?
      THEN 2 SF
"Gun Comm ON"
      ELSE 2 CF 14
CF "Gun Comm OFF"
      END 1 DISP 1
FREEZE
    »
  ddc. 59.776565117
  ddb.
59.7765651174
  dda.
60.4468697652
  s.c 10.0674681329
  s. 30.0674681329
  tazi.
203.512069324
  a. 20.1349362658
  pn. 4826.77849
  pe. 5559.59619
  INVR.
    « DUP
      IF TYPE 6
SAME
      THEN SWAP
RCP. ROT RCP.
      END  a b c d
      « c a - d b -
RP.
      »
    »
  MKPNSETUP.
    « MKPN. SWAP
MKPN. SWAP SETUP.
    »
  SETUP.
    « 14 CF DTAG
SWAP DTAG SWAP DUP2
2 LIST 'SUP.' STO
DUP
      IF TYPE 6
SAME
      THEN DUP
'ARSP.' STO PFILE.
Kogo
      END 'D.' STO
'C.' STO DTAG DUP
      IF TYPE 6
SAME
      THEN DUP
'OCCP.' STO PFILE.
Kogo
      END 'B.' STO
'A.' STO SUP. A. B.
C. D. INVR. 2 PICK
'BAZI.' STO DUP
'SOD.' STO 0 'ANG.'
STO OCCP. JOBS.
JOBNAME. EVAL Kogo
LIST DROP2 'OCCG.'
STO OCCG. MU. +
'HI.' STO DROP2
      IF 16 FS?
      THEN
        IF 20 FC?
        THEN SUNTE.
"Notes ON w/Elev OFF
Setup has been noted."
        ELSE
"Notes ON w/Elev ON
Set HI to note Setup."
        END 1 DISP
1 FREEZE
      ELSE
        IF 22 FC?
        THEN
"...Notes are OFF"
        ELSE
"Compare distances..."
        END 1 DISP
1 FREEZE
      END
    »
  MKPNSO.
    « MKPN. SO.
    »
  SO.
    « DTAG DUP
      IF TYPE 0
SAME
      THEN V2
'ARSP.' STO ARSP.
V DUP
      ELSE 'ARSP.'
STO ARSP. DUP
      END
      IF TYPE 6
SAME
      THEN PFILE.
Kogo ARSP. GETZD.
      END DUP
      IF TYPE 5
SAME
      THEN GETNE.
      END 'F.' STO
'E.' STO A. B. E.
F. INVR. 'SOD.' STO
DUP 'FAZI.' STO
BAZI. HMS- DUP
      IF 0 <
      THEN 360 HMS+
      END DUP
      IF 360 >
      THEN 360 -
      END 'ANG.'
STO CLEAR ARSP.
ANG. Ang.Rt TAG
SOD. Dist TAG
    »
  SS.
    « 9 CF 14 CF 19
CF Kogo 1 'AMC.'
STO 0 'THANG.' STO
0 'FUANG.' STO
      IF 2 FS?
      THEN
        IF 13 FC?
        THEN
TOPCO.48G
        END
      END
      IF 2 FS?
      THEN
        IF 13 FS?
        THEN
        ELSE
        END
      END DUP DUP
      IF TYPE 5 ‹
      THEN 'SSD.'
STO SWAP BAZI. HMS+
DUP
        IF 360 >
        THEN 360 -
        END DUP
'SSAZI.' STO SWAP
PR. B. + DUP 'FE.'
STO SWAP A. + DUP
'FN.' STO SWAP
      END
    »
  AOS.
    « TOPAMEAS.48G
OBJ DROP  a
      «
        IF 19 FC?
        THEN
RECSHT.
        ELSE SGDAT.
        END OBJ
DROP2 a 4 LIST
        IF 19 FC?
        THEN DUP
'RECSHT.' STO VSTR.
        ELSE
'SGDAT.' STO
SHOWD2.
        END
      »
    »
  FUANG. 0
  THANG. 0
  BL.
    « 0 'Sta1.' STO
0 'Sta2.' STO DTAG
DUP
      IF TYPE 6 ==
      THEN SWAP
MKPN. SWAP
      END 2 PICK
DTAG
      IF TYPE 6 ‹
      THEN
        IFERR 3
PICK DTAG
        THEN
        END
        IF
          IFERR
TYPE 6 ‹
          THEN
          END
        THEN
"Pnt number(s) need
to be prefixed..."
PROMPT KILL
        END
      END SWAP DTAG
Kogo  b a
      « 0 DUP DUP
DUP DUP 'TOTD.' STO
'DBLINT.' STO
'BLINT.' STO 'OSD.'
STO 'BLRAD.' STO b
        IF TYPE 6
SAME
        THEN a
'BLO.' STO a PFILE.
V2 DUP DUP Kogo
'BLB.' STO 'BLP.'
STO 'SOP.' STO b
'BLDEST.' STO a
PFILE. b EVAL
GETNE. Kogo INVR.
'BLD.' STO 'BLAZ.'
STO CLEAR a Bl.beg
TAG b Bl.dest TAG
BLAZ. Bl.az TAG
BLD. Bl.dist TAG
KILL
        END a
        IF TYPE 6
SAME
        THEN " "
'BLDEST.' STO " "
'BLD.' STO a 'BLO.'
STO a PFILE. V2
DUP DUP Kogo 'BLB.'
STO 'BLP.' STO
'SOP.' STO b
'BLAZ.' STO CLEAR a
Bl.beg TAG BLAZ.
Bl.az TAG KILL
        END DUP
DUP2
        IF TYPE 6
SAME
        THEN DUP
'BLO.' STO Bl.beg
TAG ROT PFILE. V2
DUP DUP Kogo 'BLB.'
STO 'BLP.' STO
'SOP.' STO
          IF b 2
SAME
          THEN 180
a HMS- 'BLAZ.' STO
          END
          IF b 3
SAME
          THEN 180
a HMS+ 'BLAZ.' STO
          END
          IF b 4
SAME
          THEN 360
a HMS- 'BLAZ.' STO
          END
          IF b 1
SAME
          THEN a
'BLAZ.' STO
          END BLAZ.
Bl.az TAG ROT DROP
" " 'BLDEST.' STO
" " 'BLD.' STO KILL
        END
      »
    »
  STA2.
    « DUP 'Sta2.'
STO Sta1. - TOTD. -
DIST.
    »
  Sta2. 1039.86
  STA1.
    « Sta2.
      IF 0 ‹
      THEN DUP
TOTD. - 'Sta1.' STO
'Sta2.' STO Sta1.
"Beg Sta" TAG
Sta2. "CurrSta"
TAG
      ELSE 'Sta1.'
STO 0 'Sta2.' STO
Sta1. "Beg Sta"
TAG
      END SHOWD.
    »
  Sta1. 1000
  DIST.
    « Kogo DUP
'TOTD.' STO+ TOTD.
Sta1. + 'Sta2.' STO
      IF BLRAD. 0
SAME
      THEN 'BLINT.'
STO BLAZ. BLINT.
DINV. DUP 'BLP.'
STO 'SOP.' STO SOP.
      ELSE DBLINT.
+ 'DBLINT.' STO
DBLINT. BLRAD. /
180 ‡ / NUM * 2 /
DUP HMS DUP
'DEFL.' STO BLAZ.
HMS+ 'DAZ.' STO SIN
BLRAD. * 2 * DAZ.
SWAP DINV. 'SOP.'
STO SOP.
      END
      IF OSD. 0 ‹
      THEN
        IF BLRAD. 0
‹
        THEN DAZ.
DEFL. HMS+ 90 HMS+
OSD. COINV. 'OSP.'
STO OSP.
        ELSE BLAZ.
90 HMS+ OSD. DINV.
'OSP.' STO OSP.
        END
      END V SO.
      IF BLRAD. 0 ‹
      THEN BLRAD.
radius TAG ROT ROT
      END
      IF OSD. 0 ‹
      THEN OSD.
offset TAG ROT ROT
      END NE.?
      IF 25 FC?
      THEN SHOWD.
      END
    »
  PNT.
    « Kogo MKPN.
      IF 23 FS?
      THEN OWPCHK.
      END DUP
      IF TYPE 6
SAME
      THEN DUP
        IF P0 SAME
        THEN LCP.
'GLCP.' STO
        END STR 2
" " REPL OBJ
      END DUP
'NXTP.' STO "P"
SWAP STR + DUP "."
POS 1 - 1 SWAP SUB
OBJ 'LCP.' STO
    »
  DESC.
    « Kogo 'PDESC.'
STO
    »
  CRAP. X
  TOPCO.48G
    « "P" NXTP.
STR + DUP "." POS
1 - 1 SWAP SUB OBJ
'LCP.' STO
      IFERR WORK
TOPSET.48G
        IF 26 FC?
        THEN
"Z32091"
        ELSE
"Z34093"
        END 3 CHR +
XMIT DROP 10 STIME
BUFLEN SWAP SRECV
DROP DROP DROP
"C067" 3 CHR + 13
CHR + 10 CHR + XMIT
DROP
        DO BUFLEN
DROP
        UNTIL 0 ‹
        END 1 WAIT
BUFLEN SWAP SRECV
DROP DROP DROP
        DO BUFLEN
DROP
        UNTIL 0 ‹
        END 1 WAIT
"006" 3 CHR + 13
CHR + 10 CHR + XMIT
DROP BUFLEN DROP
SRECV "Z10091" 3
CHR + XMIT DROP
DROP  OBS
        « OBS "?"
POS  STRT
          « OBS
STRT 2 + DUP 7 +
SUB OBJ 1000 / OBS
STRT 11 + DUP 6 +
SUB OBJ 10000 /
OBS STRT 19 + DUP 6
+ SUB OBJ 10000 /
OBS STRT 28 + DUP 7
+ SUB OBJ 1000 / 
SD ZD HZ HD
            « LCP.
SD ZD HZ 4 LIST
            »
          »
        »
      THEN
"Topcon Error"
DOERR
      END
      IF 14 FS?
      THEN DUP
'SGDAT.' STO
      END
      IF 14 FC?
      THEN VSTR.
      END
    »
  TOPHSET.48G
    «  H
      « DEPTH LIST
 OLDSTACK
        «
          IFERR
TOPSET.48G "J074" 3
CHR + 13 CHR + 10
CHR + XMIT DROP
"J+" H 10000 * 0
FIX STR DUP SIZE 1
- 1 SWAP SUB + "d"
+ DUP BCCGET.48G +
3 CHR + 13 CHR + 10
CHR + XMIT DROP
          THEN
          END CLEAR
OLDSTACK OBJ DROP
4 FIX
        »
      »
    »
  TOPAMEAS.48G
    «
      IFERR
TOPSET.48G "Z10091"
3 CHR + XMIT DROP
10 STIME BUFLEN
DROP SRECV DROP
DROP "C067" 3 CHR +
13 CHR + 10 CHR +
XMIT DROP 1 WAIT
"006" 3 CHR + 13
CHR + 10 CHR + XMIT
DROP BUFLEN DROP
SRECV BUFLEN SWAP
SRECV DROP DROP
DROP "Z10091" 3 CHR
+ XMIT DROP DROP
DUP "<" POS  OBS
STRT
        « OBS STRT
1 + DUP 6 + SUB
OBJ 10000 / OBS
STRT 9 + DUP 6 +
SUB OBJ 10000 / 
ZD HZ
          « 1 RPNO.
0 ZD HZ 5 LIST
          »
        »
      THEN
"Topcon Error"
DOERR
      END
    »
  TOPSET.48G
    « PATH HOME {
1200 2 0 0 1 1 }
'IOPAR' STO -33 CF
-34 SF EVAL
    »
  TOPCOSET.48G
    «  STN STNTYPE
      « DEPTH LIST
 OLDSTACK
        « WORK
          IFERR
TOPSET.48G
            CASE
STNTYPE 1 ==
              THEN
"Z10091" 3 CHR +
XMIT DROP STN 2 4
SUB OBJ DROP  SE
SN SEL
« 0 FIX "I+" SN
1000 * STR DUP
SIZE 1 - 1 SWAP SUB
1 8 SUB + "+" + SE
1000 * STR DUP
SIZE 1 - 1 SWAP SUB
1 8 SUB + "m" + DUP
BCCGET.48G + 3 CHR
+ 13 CHR + 10 CHR +
"I073" 3 CHR + XMIT
DROP 1 25
  FOR I
  NEXT XMIT DROP 1
WAIT "K" SEL NEG
1000 * STR DUP
SIZE 1 - 1 SWAP SUB
1 8 SUB + "m" + "z"
+ DUP BCCGET.48G +
3 CHR + "K075" 3
CHR + XMIT DROP 1
25
  FOR I
  NEXT XMIT DROP
»
              END
            END
          THEN
          END CLEAR
OLDSTACK OBJ DROP
        »
      »
    »
  Setup11.48G
    « WORK PATH
HOME { TOPCO.48G
TOPAMEAS.48G
TOPHSET.48G
TOPCOSET.48G
TOPSET.48G
      « DROP DROP
      »
      « DROP
      »
      «
      » } 'INSTPAR'
STO EVAL 1711 MENU
    »
  BCCGET.48G
    « CLLCD WORK 0
RB  DAT BCC
      « 1 DAT SIZE
        FOR I BCC
DAT I I SUB NUM RB
XOR 'BCC' STO
        NEXT BCC
BR 0 FIX STR DUP
SIZE 1 - 1 SWAP SUB
"00000" SWAP + DUP
SIZE DUP 2 - SWAP
SUB
      »
    »
  WORK
    « CLLCD
"  WORKING " 2 DISP
    »
  SANG. 150.3807
  MANG. 255.19035
  FANG. 255.19
  ATOL. .003
  ADBL.
    « 1 'AMC.' STO+
17 SF 9 SF RECSHT.
LIST DROP 'FANG.'
STO 'RPNO.' STO
TOPAMEAS.48G LIST
DROP DUP
      IF AMC. 2 ==
      THEN 'SANG.'
STO SANG. 360 +
      END DUP
      IF AMC. 3 ==
      THEN 'THANG.'
STO THANG. 720 +
      END DUP
      IF AMC. 4 ==
      THEN 'FUANG.'
STO FUANG. 1080 +
      END AMC.
HMSD. FANG.
      IF 180 <
      THEN 180 -
      END 'MANG.'
STO MANG. FANG.
HMS- ABS 'ADIF.'
STO RECSHT. LIST
DROP2 MANG.  a b c
d
      « LCP. b c d
4 LIST 'RECSHT.'
STO FANG. "1)" TAG
SANG. "2)" TAG
        IF AMC. 3
==
        THEN THANG.
"3)" TAG
        END
        IF AMC. 4
==
        THEN THANG.
"3)" TAG FUANG.
"4)" TAG
        END MANG.
"M)" TAG HD.
"Dist" TAG RECSHT.
ADIF.
        IF ATOL. >
        THEN 600 .1
BEEP 500 .1 BEEP
400 .1 BEEP
        END VSTR.
      »
    »
  AMC. 1
  BMP. P5
  NE.?
    «
      IF OSD. 0
SAME
      THEN SOP. V
      END
      IF OSD. 0 ‹
      THEN OSP. V
      END
    »
  INCRN.
    « 15 CF INCRSO.
    »
  INCRSO.
    « ARSP. STR
DUP SIZE 1 - 3 SWAP
SUB STR
      IF 15 FS?
      THEN 1 -
      ELSE 1 +
      END 0 FIX
STR "P" SWAP + DUP
SIZE 1 - 1 SWAP SUB
OBJ 4 FIX DUP
'ARSP.' STO SO.
    »
  INCRP.
    « 15 SF INCRSO.
    »
  RECSHT. { P8007
217.655 93.0344
6.44203556E-5 }
  HD. 217.344212592
  VD.
-2.24041795535
  $CONFIG 1
  SGDAT. { P8007
367.055 90.2059
96.0646 }
  MCF.
"Cut:426.200"
  SPE. 0
  SPD. TRAV
  GETZD.
    « JOBS.
JOBNAME. EVAL LIST
DROP UPDIR UPDIR
'SPD.' STO 'SPE.'
STO
    »
  MHA. 96.0646
  LSSA.
6.44203556E-5
  ADF. "Left:0.01"
  LCP. P8007
  GLCP. P9011
  CGD. "Go:0.025"
  MHD.
367.048162443
  SETSHOW.
    « JOBNAME. STR
"Setup " SUP. STR
+ "Gun "
      IF 2 FS?
      THEN "ON"
      ELSE "OFF"
      END +
"Notes "
      IF 16 FS?
      THEN "ON"
      ELSE "OFF"
      END +
"Note Elev "
      IF 20 FS?
      THEN "ON"
      ELSE "OFF"
      END +
"Mean Tolerance:"
ATOL. +
      IF 23 FS?
      THEN "OwP ON"
      ELSE
"OwP OFF"
      END CLLCD 7
DISP 6 DISP 5 DISP
4 DISP 3 DISP 2
DISP 1 DISP 7
FREEZE 6 FREEZE 5
FREEZE 4 FREEZE 3
FREEZE 2 FREEZE 1
FREEZE
    »
  SHOWD2.
    « S2M. 2 FIX
MU. STR "/" + HI.
STR + " R:" + HR.
STR + 1 DISP ARSP.
DUP
      IF TYPE 6 ==
      THEN " " + 2
FIX SPE. STR + " "
+ SPD. STR DUP
SIZE 1 - 2 SWAP SUB
+
      ELSE 3 FIX V
SWAP STR SWAP STR
" " SWAP + +
      END 2 DISP 4
FIX "AR:" ANG. STR
+ " " 3 FIX SOD.
STR + + 3 DISP 4
FIX "mA:" MHA. STR
+ " " 3 FIX MHD.
STR + + 4 DISP
ADF. " P" + 0 FIX
NXTP. STR + "NP" +
5 DISP 3 FIX CGD.
" V:" + VD. STR +
6 DISP MCF. STR
" " + GELV. STR +
4 FIX 7 DISP 1
FREEZE 2 FREEZE 3
FREEZE 4 FREEZE 5
FREEZE 6 FREEZE 7
FREEZE
    »
  SHOWD.
    « S2M. JOBNAME.
SUP. STR + 1 DISP
BLO. " " + BLDEST.
      IF " " SAME
      THEN BLAZ.
DUP
        IF 0 <
        THEN 360
HMS+
        END
      ELSE BLDEST.
+ " " + BLD. 3 FIX
STR
      END + 2 DISP
"Sta:" Sta1. 2 FIX
STR + " " + Sta2.
STR + 4 DISP
"Dist:" TOTD. STR
+ " LP:" + CRAP. +
5 DISP "R:" BLRAD.
3 FIX STR " "
"OS:" OSD. STR + +
+ + 3 DISP 3 FIX
ARSP. DUP
      IF TYPE 3
SAME
      THEN V SWAP
STR SWAP STR " "
SWAP + +
      ELSE STR DUP
SIZE 1 - 2 SWAP SUB
      END 6 DISP
"AR:" ANG. 4 FIX
STR " " SOD. 3 FIX
STR + + + 4 FIX 7
DISP 1 FREEZE 2
FREEZE 3 FREEZE 4
FREEZE 5 FREEZE 6
FREEZE 7 FREEZE
    »
  NXTP. 8007
  UKS. { S
    «
    » 11.2
    «
    » 11.3
    «
    » 12.2
    «
    » 12.3
    «
    » 13.2
    «
    » 13.3
    «
    » 14.2
    «
    » 14.3
    «
    » 15.2
    «
    » 15.3
    «
    » 16.2
    «
    » 16.3 RESCT.
21.1 TPRS. 21.2
BBINX. 21.3 RCP.
22.1 NDDX. 22.2
BDINX. 22.3 BL.
23.1 STA1. 23.2
S2M. 24.1 MUPR.
24.2 HR. 24.3
PNT. 25.2 DESC.
25.3 HIGET. 26.3
BUPDIR. 31.2 SPCTN.
31.3 STP. 32.1
STOEL. 32.2 STOD.
32.3 DIST. 33.1
STA2. 33.2
    « 22 CF
MKPNSETUP.
    » 34.1
TOPHSET.48G 34.2
AHD. 34.3 SHOWD.
35.2 SHOWD2. 35.3
    « 27 SF RECSHT.
VSTR.
    » 36.2 SETSHOW.
36.3 MSPD. 42.3
MKPNSO. 45.1 INCRN.
45.2 INCRP. 45.3 «
IF 2 FC? THEN 13 
CF END SS. » 46.1 
AOS. 46.2
ADBL. 46.3 HMS
51.2 HMS 51.3 HMS+
52.2 HMS- 52.3
MKPN. 53.1 HMSM.
53.2 HMSD. 53.3
SCD. 54.1 blref.
54.2 CLEAR 55.2
GOGO. 61.2 NOTER.
61.3 ELO. 62.2
OWPSET. 62.3
    « ATOLSET.
    » 63.2
    «
    » 63.3
    «
    » 64.2
    «
    » 64.3
    «
    » 83.2
    «
    » 83.3
    «
    » 84.2
    «
    » 84.3
    « ‡ NUM
    » 94.2 }
  S2M.
    « Kogo 2 MENU
    »
  HR. 4.83
  HI. 433.27
  FCOL1.
174174116.556
  FCOL2.
174243125.911
  COL1.
149211034.779
  COL2.
148910254.681
  JOBNAME. GREEN
  FAPN. P2
  BN. 5015.73993943
  BE. 4980.55122866
  PRN.
5086.35893244
  PRE.
4976.94898039
  GELV.
426.199582045
  PDESC. PROPCOR
  SSD. 216.05
  OCCP. P5004
  DDH
    « HMS
    »
  AHD.
    « MKPN. SUP.
LIST DROP2 SETUP.
    »
  STOD.
    « MKPN.  a b
      « a 'MSPD.'
STO JOBNAME. JOBS.
EVAL 'MSPD.' PURGE
b EVAL LIST DROP2
a DTAG 4 LIST b
STO Kogo b
      »
    »
  GETNE.
    « LIST 3 DROPN
    »
  STOEL.
    « MKPN.  a b
      « JOBNAME.
JOBS. EVAL b EVAL
LIST DROP SWAP
DROP a DTAG SWAP 4
LIST b STO Kogo b
      »
    »
  LCP. P45
  BLO. P463
  TOTD. 39.86
  COINV.
    « PR. SOP. V
3 PICK + SWAP 4
PICK + SWAP V2
    »
  INTXP.
[ 912948.742522 685312.691363 ]
  R.D. 500
  CO2. 0
  HDD
    « HMS
    »
  DIST2.
428.96964027
  ANG2.
250.49451801
  ANG3.
186.111627093
  ANG1.
64.382890917
  BASEAZ.
233.063101059
  BASED.
448.384932534
  BPI.
[ 912924.917801 685357.974752 ]
  EPI.
[ 4824.56036756 5539.71954141 ]
  SUP. { P5004
P2138 }
  ARSP. P2004
  SSAZI.
43.351545795
  CO1. 0
  DINV.
    « PR.
      IF BLRAD. 0 ‹
      THEN BLP.
      ELSE SOP.
      END V 3 PICK
+ SWAP 4 PICK +
SWAP V2
    »
  DIST1.
51.1683753164
  BLINT. 0
  DBLINT. 0
  SOD.
216.071267194
  SOP.
[ 913002.721245 685124.487234 ]
  BLP.
[ 913002.721245 685124.487234 ]
  BLB.
[ 913037.99686 685143.04661 ]
  PFILE.
    « JOBS.
JOBNAME. EVAL LIST
3 DROPN
    »
  PUTNE.
    « 0 P 4 LIST
    »
  STP.
    « JOBS.
JOBNAME. PATH
      IF { HOME
Kogo JOBS. } SAME
      THEN CRDIR
      END Kogo DUP
      IF TYPE 5 ==
      THEN 29 SF
RECRD.
      END  m n o
      « m DTAG n
DTAG o DTAG MKPN.
        IF 23 FS?
        THEN
OWPCHK.
        END  a
        « a 'CRAP.'
STO DTAG DUP
          IF TYPE 6
SAME
          THEN DUP
'MSPD.' STO ROT
DTAG ROT DTAG ROT 0
SWAP
          END DUP
          IF TYPE 2
SAME
          THEN ROT
DTAG ROT DTAG ROT 0
SWAP
          END DUP
          IF TYPE 0
SAME
          THEN SWAP
DTAG SWAP 0 PDESC.
          END 4
LIST JOBS.
JOBNAME. a STO Kogo
a
        »
      »
    »
  RCP.
    « MKPN. DUP
      IF TYPE 6
SAME
      THEN PFILE.
Kogo
      END
    »
  WD. 362.81
  WA. .515591646
  CD. 345.854347049
  BLD.
783.000007187
  BLAZ.
207.445991881
  OSD. -15
  FAZI.
43.3546660468
  BAZI.
202.085745795
  AZI. 315
  DIST.
3322.45637179
  ANG.
201.264920252
  DAZ.
275.343045572
  FE. 685286.720564
  FN. 913152.226533
  F. 685286.7589
  E. 913152.2194
  D. 684999.367729
  C. 912655.75233
  B. 685137.762051
  A. 912995.737032
  HMSM.
    « HMS SWAP
HMS * HMS
    »
  HMSD.
    « HMS SWAP
HMS SWAP / HMS
    »
  OSP.
[ 912995.737032 685137.762051 ]
  SCD.
    «
      IF 2 FS?
      THEN 14 SF 19
SF TOPCO.48G OBJ
DROP  a b c d
        « c b PR.
SWAP DUP 'VD.' STO
HI. + HR. - 'GELV.'
STO d DUP 'MHA.'
STO ANG. HMS- SWAP
DUP 'MHD.' STO PR.
DTAG DUP
          IF 0 <
          THEN ABS
"Left:"
          ELSE
"Right:"
          END SWAP
2 FIX STR + DUP
'ADF.' STO GELV.
SPE. - DUP
          IF 0 <
          THEN ABS
"Fill:"
          ELSE
"Cut:"
          END SWAP
3 FIX STR + 'MCF.'
STO
        » SWAP
      END SOD. -
DUP
      IF 0 <
      THEN ABS
"Go:"
      ELSE DTAG
"Come:"
      END SWAP 3
FIX STR + DUP
'CGD.' STO 4 FIX
      IF 2 FS?
      THEN SHOWD2.
      END
    »
  OWPSET.
    «
"Overwrite Protect"
      IF 23 FC?
      THEN 23 SF
" ON"
      ELSE 23 CF
" OFF"
      END + 1 DISP
1 FREEZE
    »
  OWPCHK.
    « DUP
      IFERR RCP.
      THEN DROP
UPDIR UPDIR
      ELSE DROP2
'Protected' TAG
KILL
      END
    »
  BLRAD. 0
  DEFL. 0
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
  IOPAR { 9600 0 0
0 3 1 }
END