- ONCSCHMP ;HINES OIFO/RTK - PROGNOSTIC STAGE GROUP CALCULATIONS ;01/09/19
- ;;2.2;ONCOLOGY;**10,12,13,20**;Jul 31, 2013;Build 5
- ;
- 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 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 7530 printed Apr 23, 2025@18:42:34 Page 2
- ONCSCHMP ;HINES OIFO/RTK - PROGNOSTIC STAGE GROUP CALCULATIONS ;01/09/19
- +1 ;;2.2;ONCOLOGY;**10,12,13,20**;Jul 31, 2013;Build 5
- +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 STGIND="P"
- IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,13)'=""
- SET SG=""
- +32 IF STGIND="PT"
- IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,9)'=""
- SET SG=""
- End DoDot:1
- +33 IF SG=88
- Begin DoDot:1
- +34 IF STGIND="P"
- IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,13)'=""
- SET SG=""
- +35 IF STGIND="PT"
- IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,9)'=""
- SET SG=""
- End DoDot:1
- +36 IF STGIND="C"
- IF $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=SG
- QUIT
- +37 IF STGIND="P"
- IF $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=SG
- QUIT
- +38 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
