ONCSCHMP ;HINES OIFO/RTK - PROGNOSTIC STAGE GROUP CALCULATIONS ;01/09/19
;;2.2;ONCOLOGY;**10,12,13,20,21**;Jul 31, 2013;Build 6
;
STAGE ;AJCC 8TH EDITION AUTO CALCULATION OF STAGE GROUPS
;
N T,N,M
;
I STGIND="C" D
.S T=$P($G(^ONCO(165.5,D0,"AJCC8")),U,2) ; Clin T
.S N=$P($G(^ONCO(165.5,D0,"AJCC8")),U,3) ; Clin N
.S M=$P($G(^ONCO(165.5,D0,"AJCC8")),U,4) ; Clin M
I STGIND="P" D
.S T=$P($G(^ONCO(165.5,D0,"AJCC8")),U,6) ; Path T
.S N=$P($G(^ONCO(165.5,D0,"AJCC8")),U,7) ; Path N
.S M=$P($G(^ONCO(165.5,D0,"AJCC8")),U,8) ; Path M
I STGIND="PT" D
.S T=$P($G(^ONCO(165.5,D0,"AJCC8")),U,10) ; Post Ther T
.S N=$P($G(^ONCO(165.5,D0,"AJCC8")),U,11) ; Post Ther N
.S M=$P($G(^ONCO(165.5,D0,"AJCC8")),U,12) ; Post Ther M
;
;
D STRPCPTN ;strip "c","p","yp" prefix from T and N codes
;
S ONCAJCHP="" D GTAJIEN^ONCSCHMG
S SG=""
I '$D(ONCAJCHP) Q
I ONCAJCHP="" Q
I ONCAJCHP<6 Q
I (ONCAJCHP>77)&(ONCAJCHP'=81.1) Q
S ONCHP=$P(ONCAJCHP,".",1)_$P(ONCAJCHP,".",2)
I ONCHP=181,$P($G(^ONCO(165.5,D0,"AJCC8")),U,1)="18.2" S ONCHP=182
D @ONCHP
I SG="" D
.S SG=99
.I $P($G(^ONCO(165.5,D0,"AJCC8")),U,1)=9004 S SG=88
.I STGIND="P",$P($G(^ONCO(165.5,D0,"AJCC8")),U,13)'="" S SG=""
.I STGIND="PT",$P($G(^ONCO(165.5,D0,"AJCC8")),U,9)'="" S SG=""
I SG=88 D
.I STGIND="P",$P($G(^ONCO(165.5,D0,"AJCC8")),U,13)'="" S SG=""
.I STGIND="PT",$P($G(^ONCO(165.5,D0,"AJCC8")),U,9)'="" S SG=""
I STGIND="C" I $P(^ONCO(165.5,D0,"AJCC8"),U,5)=SG Q
I STGIND="P" I $P(^ONCO(165.5,D0,"AJCC8"),U,9)=SG Q
I STGIND="PT" I $P(^ONCO(165.5,D0,"AJCC8"),U,13)=SG Q
READ W !,"*** ONCOTRAX Calculated Stage Group value = ",SG," ***"
N ONCTRX R " Accept? Y//",ONCTRX:DTIME
S ONCTRX=$TR(ONCTRX,"yesno","YESNO")
I (ONCTRX="?")!(ONCTRX="??")!(ONCTRX="???") W !,"Enter Y or N" D READ Q
I (ONCTRX="")!(ONCTRX="Y")!(ONCTRX="YES") D
.I STGIND="C" S $P(^ONCO(165.5,D0,"AJCC8"),U,5)=SG
.I STGIND="P" S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=SG
.I STGIND="PT" S $P(^ONCO(165.5,D0,"AJCC8"),U,13)=SG
;
Q
;
STRPCPTN ;
I $E(T,1)="c" S T=$E(T,2,99)
I $E(T,1)="p" S T=$E(T,2,99)
I $E(T,1,2)="yp" S T=$E(T,3,99)
I $E(N,1)="c" S N=$E(N,2,99)
I $E(N,1)="p" S N=$E(N,2,99)
I $E(N,1,2)="yp" S N=$E(N,3,99)
Q
;
;AJCC 8TH (and beyond) EDITION CHAPTERS
6 D 6^ONCSGA8A Q
7 D 7^ONCSGA8A Q
8 D 8^ONCSGA8A Q
9 D 9^ONCSGA8A Q
10 N SCDSP16
S SCDSP16=$P($G(^ONCO(165.5,D0,"SSD4")),U,22) ; Schema Discriminator 2
I SCDSP16'=2 Q
D 10^ONCSGA8A Q
111 N SCDSP16
S SCDSP16=$P($G(^ONCO(165.5,D0,"SSD4")),U,22) ; Schema Discriminator 2
I SCDSP16=2 Q
D 111^ONCSGA8A Q
112 D 112^ONCSGA8A Q
121 D 121^ONCSGA8A Q
122 D 122^ONCSGA8A Q
13 D 132^ONCSGA8A Q
131 D 131^ONCSGA8A Q
132 D 132^ONCSGA8A Q
133 D 133^ONCSGA8A Q
14 S SG=88 Q ;no stage grouping
15 D 15^ONCSGA8A Q
161 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
N EETE S EETE=$P($G(^ONCO(165.5,D0,"SSD1")),U,30) ; Esoph EJT T Epicntr
D 161^ONCSGA8A Q
162 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
D 162^ONCSGA8A Q
163 S SG=88 Q ;no stage grouping
17 D 17^ONCSGA8A Q
181 D 181^ONCSGA8A Q
182 S SG=88 Q ;no stage grouping
19 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
D 19^ONCSGA8A Q
20 D 20^ONCSGA8A Q
21 D 21^ONCSGA8A Q
22 D 22^ONCSGA8A Q
23 D 23^ONCSGA8A Q
24 D 24^ONCSGA8A Q
25 D 25^ONCSGA8A Q
26 D 26^ONCSGA8A Q
27 D 27^ONCSGA8A Q
28 D 28^ONCSGA8A Q
29 D 29^ONCSGA8A Q
;
30 D 30^ONCSGA8B Q
31 D 31^ONCSGA8B Q
32 D 32^ONCSGA8B Q
33 D 33^ONCSGA8B Q
34 D 34^ONCSGA8B Q
35 D 35^ONCSGA8B Q
;
36 D 36^ONCSGA8B Q
37 D 37^ONCSGA8B Q
381 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
D 381^ONCSGA8B Q
382 S SG=88 Q ;no stage grouping
383 S SG=88 Q ;no stage grouping
40 S SG=88 Q ;no stage grouping
41 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
D 41^ONCSGA8B Q
42 S SG=88 Q ;no stage grouping
431 N MTRT S MTRT=$P($G(^ONCO(165.5,D0,2.3)),U,9) ; Mitototic Rate
D 431^ONCSGA8B Q
432 N MTRT S MTRT=$P($G(^ONCO(165.5,D0,2.3)),U,9) ; Mitototic Rate
D 432^ONCSGA8B Q
44 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
D 44^ONCSGA8B Q
45 S SG=88 Q ;no TNM code or stage grouping
46 N PNSFX S PNSFX=$P($G(^ONCO(165.5,D0,"AJCC8")),U,17) ; Path N Suffix
D 46^ONCSGA8B Q
47 D 47^ONCSGA8B Q
;
48 N G,HER2,ER,PR,VAL
I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
S VAL=$P($G(^ONCO(165.5,D0,"SSD2")),U,21) ; HER2 Summary (3855)
S HER2=$S(VAL=0:"N",VAL=1:"P",1:"")
S VAL=$P($G(^ONCO(165.5,D0,"SSD1")),U,28) ; Estrogen Rec Summ (3827)
S ER=$S(VAL=0:"N",VAL=1:"P",1:"")
S VAL=$P($G(^ONCO(165.5,D0,"SSD4")),U,10) ; Progesterone Rec Summ (3915)
S PR=$S(VAL=0:"N",VAL=1:"P",1:"")
D 48^ONCSGA8B Q
50 D 50^ONCSGA8B Q
51 D 51^ONCSGA8B Q
52 D 52^ONCSGA8B Q
53 D 53^ONCSGA8B Q
541 D 541^ONCSGA8B Q
542 D 542^ONCSGA8B Q
55 D 55^ONCSGA8B Q
56 N RSCORE R "Enter the Risk Score (1-25): ",RSCORE:DTIME
I (RSCORE'?1.2N)!(RSCORE<1)!(RSCORE>25) W !!,"Risk Score must be 1 - 25 or NULL",! D 56 Q
D 56^ONCSGA8B Q
57 D 57^ONCSGA8B Q
58 N G I STGIND="C" S G=$P($G(^ONCO(165.5,D0,2.3)),U,12) ; Grade Clinical
I STGIND="P" S G=$P($G(^ONCO(165.5,D0,2.3)),U,13) ; Grade Pathologic
I STGIND="PT" S G=$P($G(^ONCO(165.5,D0,2.3)),U,14) ; Grade Post-Therapy
N PSA S PSA=$P($G(^ONCO(165.5,D0,"SSD4")),U,15) ; PSA Lab Value (3920)
D 58^ONCSGA8C Q
59 N SCAT
I STGIND="C" S SCAT=$P($G(^ONCO(165.5,D0,"SSD4")),U,18) ; S Category Clin
I STGIND="P" S SCAT=$P($G(^ONCO(165.5,D0,"SSD4")),U,19) ; S Category Path
I STGIND="PT" S SCAT=0 ; No post-therapy S Category field
D 59^ONCSGA8C Q
60 D 60^ONCSGA8C Q
611 D 611^ONCSGA8C Q
612 D 612^ONCSGA8C Q
621 D 621^ONCSGA8C Q
622 D 622^ONCSGA8C Q
631 D 631^ONCSGA8C Q
632 D 632^ONCSGA8C Q
633 D 633^ONCSGA8C Q
634 D 634^ONCSGA8C Q
64 D 64^ONCSGA8C Q
65 S SG=88 Q ;no stage grouping
66 S SG=88 Q ;no stage grouping
671 S SG=88 Q ;no stage grouping
672 D 672^ONCSGA8C Q
68 D 68^ONCSGA8C Q
69 S SG=88 Q ;no stage grouping
70 S SG=88 Q ;no stage grouping
71 S SG=88 Q ;no stage grouping
72 Q ;no TNM codes or stage grouping
729 Q ;no TN codes (does have M) and no stage grouping
731 D 731^ONCSGA8C Q
732 D 732^ONCSGA8C Q
74 D 74^ONCSGA8C Q
75 S SG=88 Q ;no stage grouping
76 D 76^ONCSGA8C Q
77 D 77^ONCSGA8C Q
811 N PBI18 S PBI18=$P($G(^ONCO(165.5,D0,"SSD4")),U,6) ;Prph Bl Inv (3910)
D 811^ONCSGA8C Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMP 7587 printed Sep 23, 2025@20:04:11 Page 2
ONCSCHMP ;HINES OIFO/RTK - PROGNOSTIC STAGE GROUP CALCULATIONS ;01/09/19
+1 ;;2.2;ONCOLOGY;**10,12,13,20,21**;Jul 31, 2013;Build 6
+2 ;
STAGE ;AJCC 8TH EDITION AUTO CALCULATION OF STAGE GROUPS
+1 ;
+2 NEW T,N,M
+3 ;
+4 IF STGIND="C"
Begin DoDot:1
+5 ; Clin T
SET T=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,2)
+6 ; Clin N
SET N=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,3)
+7 ; Clin M
SET M=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,4)
End DoDot:1
+8 IF STGIND="P"
Begin DoDot:1
+9 ; Path T
SET T=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,6)
+10 ; Path N
SET N=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,7)
+11 ; Path M
SET M=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,8)
End DoDot:1
+12 IF STGIND="PT"
Begin DoDot:1
+13 ; Post Ther T
SET T=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,10)
+14 ; Post Ther N
SET N=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,11)
+15 ; Post Ther M
SET M=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,12)
End DoDot:1
+16 ;
+17 ;
+18 ;strip "c","p","yp" prefix from T and N codes
DO STRPCPTN
+19 ;
+20 SET ONCAJCHP=""
DO GTAJIEN^ONCSCHMG
+21 SET SG=""
+22 IF '$DATA(ONCAJCHP)
QUIT
+23 IF ONCAJCHP=""
QUIT
+24 IF ONCAJCHP<6
QUIT
+25 IF (ONCAJCHP>77)&(ONCAJCHP'=81.1)
QUIT
+26 SET ONCHP=$PIECE(ONCAJCHP,".",1)_$PIECE(ONCAJCHP,".",2)
+27 IF ONCHP=181
IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,1)="18.2"
SET ONCHP=182
+28 DO @ONCHP
+29 IF SG=""
Begin DoDot:1
+30 SET SG=99
+31 IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,1)=9004
SET SG=88
+32 IF STGIND="P"
IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,13)'=""
SET SG=""
+33 IF STGIND="PT"
IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,9)'=""
SET SG=""
End DoDot:1
+34 IF SG=88
Begin DoDot:1
+35 IF STGIND="P"
IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,13)'=""
SET SG=""
+36 IF STGIND="PT"
IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,9)'=""
SET SG=""
End DoDot:1
+37 IF STGIND="C"
IF $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=SG
QUIT
+38 IF STGIND="P"
IF $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=SG
QUIT
+39 IF STGIND="PT"
IF $PIECE(^ONCO(165.5,D0,"AJCC8"),U,13)=SG
QUIT
READ WRITE !,"*** ONCOTRAX Calculated Stage Group value = ",SG," ***"
+1 NEW ONCTRX
READ " Accept? Y//",ONCTRX:DTIME
+2 SET ONCTRX=$TRANSLATE(ONCTRX,"yesno","YESNO")
+3 IF (ONCTRX="?")!(ONCTRX="??")!(ONCTRX="???")
WRITE !,"Enter Y or N"
DO READ
QUIT
+4 IF (ONCTRX="")!(ONCTRX="Y")!(ONCTRX="YES")
Begin DoDot:1
+5 IF STGIND="C"
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=SG
+6 IF STGIND="P"
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=SG
+7 IF STGIND="PT"
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,13)=SG
End DoDot:1
+8 ;
+9 QUIT
+10 ;
STRPCPTN ;
+1 IF $EXTRACT(T,1)="c"
SET T=$EXTRACT(T,2,99)
+2 IF $EXTRACT(T,1)="p"
SET T=$EXTRACT(T,2,99)
+3 IF $EXTRACT(T,1,2)="yp"
SET T=$EXTRACT(T,3,99)
+4 IF $EXTRACT(N,1)="c"
SET N=$EXTRACT(N,2,99)
+5 IF $EXTRACT(N,1)="p"
SET N=$EXTRACT(N,2,99)
+6 IF $EXTRACT(N,1,2)="yp"
SET N=$EXTRACT(N,3,99)
+7 QUIT
+8 ;
+9 ;AJCC 8TH (and beyond) EDITION CHAPTERS
6 DO 6^ONCSGA8A
QUIT
7 DO 7^ONCSGA8A
QUIT
8 DO 8^ONCSGA8A
QUIT
9 DO 9^ONCSGA8A
QUIT
10 NEW SCDSP16
+1 ; Schema Discriminator 2
SET SCDSP16=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,22)
+2 IF SCDSP16'=2
QUIT
+3 DO 10^ONCSGA8A
QUIT
111 NEW SCDSP16
+1 ; Schema Discriminator 2
SET SCDSP16=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,22)
+2 IF SCDSP16=2
QUIT
+3 DO 111^ONCSGA8A
QUIT
112 DO 112^ONCSGA8A
QUIT
121 DO 121^ONCSGA8A
QUIT
122 DO 122^ONCSGA8A
QUIT
13 DO 132^ONCSGA8A
QUIT
131 DO 131^ONCSGA8A
QUIT
132 DO 132^ONCSGA8A
QUIT
133 DO 133^ONCSGA8A
QUIT
14 ;no stage grouping
SET SG=88
QUIT
15 DO 15^ONCSGA8A
QUIT
161 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 ; Esoph EJT T Epicntr
NEW EETE
SET EETE=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,30)
+4 DO 161^ONCSGA8A
QUIT
162 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 DO 162^ONCSGA8A
QUIT
163 ;no stage grouping
SET SG=88
QUIT
17 DO 17^ONCSGA8A
QUIT
181 DO 181^ONCSGA8A
QUIT
182 ;no stage grouping
SET SG=88
QUIT
19 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 DO 19^ONCSGA8A
QUIT
20 DO 20^ONCSGA8A
QUIT
21 DO 21^ONCSGA8A
QUIT
22 DO 22^ONCSGA8A
QUIT
23 DO 23^ONCSGA8A
QUIT
24 DO 24^ONCSGA8A
QUIT
25 DO 25^ONCSGA8A
QUIT
26 DO 26^ONCSGA8A
QUIT
27 DO 27^ONCSGA8A
QUIT
28 DO 28^ONCSGA8A
QUIT
29 DO 29^ONCSGA8A
QUIT
+1 ;
30 DO 30^ONCSGA8B
QUIT
31 DO 31^ONCSGA8B
QUIT
32 DO 32^ONCSGA8B
QUIT
33 DO 33^ONCSGA8B
QUIT
34 DO 34^ONCSGA8B
QUIT
35 DO 35^ONCSGA8B
QUIT
+1 ;
36 DO 36^ONCSGA8B
QUIT
37 DO 37^ONCSGA8B
QUIT
381 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 DO 381^ONCSGA8B
QUIT
382 ;no stage grouping
SET SG=88
QUIT
383 ;no stage grouping
SET SG=88
QUIT
40 ;no stage grouping
SET SG=88
QUIT
41 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 DO 41^ONCSGA8B
QUIT
42 ;no stage grouping
SET SG=88
QUIT
431 ; Mitototic Rate
NEW MTRT
SET MTRT=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,9)
+1 DO 431^ONCSGA8B
QUIT
432 ; Mitototic Rate
NEW MTRT
SET MTRT=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,9)
+1 DO 432^ONCSGA8B
QUIT
44 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 DO 44^ONCSGA8B
QUIT
45 ;no TNM code or stage grouping
SET SG=88
QUIT
46 ; Path N Suffix
NEW PNSFX
SET PNSFX=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,17)
+1 DO 46^ONCSGA8B
QUIT
47 DO 47^ONCSGA8B
QUIT
+1 ;
48 NEW G,HER2,ER,PR,VAL
+1 ; Grade Clinical
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+2 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+3 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+4 ; HER2 Summary (3855)
SET VAL=$PIECE($GET(^ONCO(165.5,D0,"SSD2")),U,21)
+5 SET HER2=$SELECT(VAL=0:"N",VAL=1:"P",1:"")
+6 ; Estrogen Rec Summ (3827)
SET VAL=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,28)
+7 SET ER=$SELECT(VAL=0:"N",VAL=1:"P",1:"")
+8 ; Progesterone Rec Summ (3915)
SET VAL=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,10)
+9 SET PR=$SELECT(VAL=0:"N",VAL=1:"P",1:"")
+10 DO 48^ONCSGA8B
QUIT
50 DO 50^ONCSGA8B
QUIT
51 DO 51^ONCSGA8B
QUIT
52 DO 52^ONCSGA8B
QUIT
53 DO 53^ONCSGA8B
QUIT
541 DO 541^ONCSGA8B
QUIT
542 DO 542^ONCSGA8B
QUIT
55 DO 55^ONCSGA8B
QUIT
56 NEW RSCORE
READ "Enter the Risk Score (1-25): ",RSCORE:DTIME
+1 IF (RSCORE'?1.2N)!(RSCORE<1)!(RSCORE>25)
WRITE !!,"Risk Score must be 1 - 25 or NULL",!
DO 56
QUIT
+2 DO 56^ONCSGA8B
QUIT
57 DO 57^ONCSGA8B
QUIT
58 ; Grade Clinical
NEW G
IF STGIND="C"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,12)
+1 ; Grade Pathologic
IF STGIND="P"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,13)
+2 ; Grade Post-Therapy
IF STGIND="PT"
SET G=$PIECE($GET(^ONCO(165.5,D0,2.3)),U,14)
+3 ; PSA Lab Value (3920)
NEW PSA
SET PSA=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,15)
+4 DO 58^ONCSGA8C
QUIT
59 NEW SCAT
+1 ; S Category Clin
IF STGIND="C"
SET SCAT=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,18)
+2 ; S Category Path
IF STGIND="P"
SET SCAT=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,19)
+3 ; No post-therapy S Category field
IF STGIND="PT"
SET SCAT=0
+4 DO 59^ONCSGA8C
QUIT
60 DO 60^ONCSGA8C
QUIT
611 DO 611^ONCSGA8C
QUIT
612 DO 612^ONCSGA8C
QUIT
621 DO 621^ONCSGA8C
QUIT
622 DO 622^ONCSGA8C
QUIT
631 DO 631^ONCSGA8C
QUIT
632 DO 632^ONCSGA8C
QUIT
633 DO 633^ONCSGA8C
QUIT
634 DO 634^ONCSGA8C
QUIT
64 DO 64^ONCSGA8C
QUIT
65 ;no stage grouping
SET SG=88
QUIT
66 ;no stage grouping
SET SG=88
QUIT
671 ;no stage grouping
SET SG=88
QUIT
672 DO 672^ONCSGA8C
QUIT
68 DO 68^ONCSGA8C
QUIT
69 ;no stage grouping
SET SG=88
QUIT
70 ;no stage grouping
SET SG=88
QUIT
71 ;no stage grouping
SET SG=88
QUIT
72 ;no TNM codes or stage grouping
QUIT
729 ;no TN codes (does have M) and no stage grouping
QUIT
731 DO 731^ONCSGA8C
QUIT
732 DO 732^ONCSGA8C
QUIT
74 DO 74^ONCSGA8C
QUIT
75 ;no stage grouping
SET SG=88
QUIT
76 DO 76^ONCSGA8C
QUIT
77 DO 77^ONCSGA8C
QUIT
811 ;Prph Bl Inv (3910)
NEW PBI18
SET PBI18=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),U,6)
+1 DO 811^ONCSGA8C
QUIT
+2 QUIT
