ONCSGA8H.m

ONCSGA8H ;HINES OIFO/RTK - AJCC 8th Ed Automatic Staging Tables ;01/23/19

 ;;2.2;ONCOLOGY;**10,12,17,20**;Jul 31, 2013;Build 5

 ;

 ;STAGE GROUP HELP CODE AND INPUT TRANSFORM

INP ;

 D HELP I ONCODLST'[X K X,ONCSHLST Q

 K ONCSHLST Q

HELP ;

 S ONCODLST=""

 D GTAJIEN^ONCSCHMG I '$D(ONCAJCHP) Q

 I ONCAJCHP="" Q

 N ONCHP 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

 I ONCHP=6 S ONCODLST="3^4A^4B^4C^99"

 I (ONCHP=7)!(ONCHP=8)!(ONCHP=111)!(ONCHP=112)!(ONCHP=121)!(ONCHP=122)!(ONCHP=131)!(ONCHP=132)!(ONCHP=133) S ONCODLST="0^1^2^3^4A^4B^4C^99"

 I ONCHP=9 S ONCODLST="0^1^2^3^4A^4B^99"

 I (ONCHP=10)!(ONCHP=29)!(ONCHP=30)!(ONCHP=31)!(ONCHP=32)!(ONCHP=34) S ONCODLST="1^2^3^4^99"

 I (ONCHP=14)!(ONCHP=163)!(ONCHP=182)!(ONCHP=382)!(ONCHP=383)!(ONCHP=40)!(ONCHP=42)!(ONCHP=45)!(ONCHP=65)!(ONCHP=66)!(ONCHP=671)!(ONCHP=69)!(ONCHP=70)!(ONCHP=71)!(ONCHP=72)!(ONCHP=75)!(ONCHP=795) S ONCODLST="88"

 I ONCHP=15 S ONCODLST="0^1^2^3^4^99"

 I ONCHP=161,STGIND="C" S ONCODLST="0^1^2^3^4A^4B^99"

 I ONCHP=161,STGIND="P" S ONCODLST="0^1A^1B^2A^2B^3A^3B^4A^4B^99"

 I ONCHP=161,STGIND="PT" S ONCODLST="1^2^3A^3B^4A^4B^99"

 I ONCHP=162,STGIND="C" S ONCODLST="0^1^2A^2B^3^4A^4B^99"

 I ONCHP=162,STGIND="P" S ONCODLST="0^1A^1B^1C^2A^2B^3A^3B^4A^4B^99"

 I ONCHP=162,STGIND="PT" S ONCODLST="1^2^3A^3B^4A^4B^99"

 I ONCHP=17,STGIND="C" S ONCODLST="0^1^2A^2B^3^4A^4B^99"

 I ONCHP=17,STGIND="P" S ONCODLST="0^1A^1B^2A^2B^3A^3B^3C^4^4A^4B^99"

 I ONCHP=17,STGIND="PT" S ONCODLST="1^2^3^4^99"

 I ONCHP=181 S ONCODLST="0^1^2A^2B^3A^3B^4^99"

 I ONCHP=182 S ONCODLST="88"

 I (ONCHP=19)!(ONCHP=20) S ONCODLST="0^1^2A^2B^2C^3A^3B^3C^4A^4B^4C^99"

 I ONCHP=21 D

 .I $P($G(^ONCO(165.5,D0,0)),"^",16)>3221231 S ONCODLST="1^2A^2B^3A^3B^3C^4^99" Q

 .S ONCODLST="0^1^2A^2B^3A^3B^3C^4^99" Q

 I ONCHP=22 S ONCODLST="1A^1B^2^3A^3B^4A^4B^99"

 I ONCHP=23 S ONCODLST="0^1A^1B^2^3A^3B^4^99"

 I ONCHP=24 S ONCODLST="0^1^2A^2B^3A^3B^4A^4B^4C^99"

 I ONCHP=25 S ONCODLST="0^1^2^3A^3B^3C^4A^4B^99"

 I ONCHP=26 S ONCODLST="0^1^2A^2B^3A^3B^4^99"

 I ONCHP=27 S ONCODLST="0^1A^1B^2A^2B^3A^3B^4^99"

 I ONCHP=28 S ONCODLST="0^1A^1B^2A^2B^3^4^99"

 I ONCHP=33 S ONCODLST="1^2A^2B^3A^3B^4^99"

 I ONCHP=35 S ONCODLST="1^2^3A^3B^4A^4B^99"

 I ONCHP=36 S ONCODLST="OccultCarcinoma^0^1A1^1A2^1A3^1B^2A^2B^3A^3B^3C^4A^4B^99"

 I (ONCHP=37)!(ONCHP=41)!(ONCHP=431)!(ONCHP=44) S ONCODLST="1A^1B^2^3A^3B^4^99"

 I ONCHP=381 S ONCODLST="1A^1B^2A^2B^3^4A^4B^99"

 I ONCHP=432 S ONCODLST="1^2^3A^3B^4^99"

 I ONCHP=45 S ONCODLST="3^4A^4B^4C^88^99"

 I (ONCHP=46)&(STGIND="C") S ONCODLST="0^1^2A^2B^3^4^88^99"

 I (ONCHP=46)&(STGIND'="C") S ONCODLST="0^1^2A^2B^3A^3B^4^88^99"

 I (ONCHP=47)&((STGIND="C")!(STGIND="PT")) S ONCODLST="0^1A^1B^2A^2B^2C^3^4^99"

 I ONCHP=47,STGIND="P" S ONCODLST="0^1A^1B^2A^2B^2C^3A^3B^3C^3D^4^99"

 I ONCHP=48 S ONCODLST="0^1A^1B^2A^2B^3A^3B^3C^4^88^99"

 I ONCHP=50 S ONCODLST="1^1A^1B^2^3^3A^3B^3C^4^4A^4B^99"

 I ONCHP=51 S ONCODLST="1A^1B^2A^2B^3^4A^4B^99"

 I ONCHP=52 D

 .I $P($G(^ONCO(165.5,D0,0)),"^",16)>3201231 S ONCODLST="1^1A^1A1^1A2^1B^1B1^1B2^1B3^2^2A^2A1^2A2^2B^3^3A^3B^3C1^3C2^4A^4B^99" Q

 .S ONCODLST="1^1A^1A1^1A2^1B^1B1^1B2^2^2A^2A1^2A2^2B^3^3A^3B^4A^4B^99" Q

 I ONCHP=53 S ONCODLST="1^1A^1B^2^3^3A^3B^3C1^3C2^4A^4B^99"

 I ONCHP=541 S ONCODLST="1^1A^1B^2^3A^3B^3C^4A^4B^99"

 I ONCHP=542 S ONCODLST="1^1A^1B^1C^2^3A^3B^3C^4A^4B^99"

 I ONCHP=55 S ONCODLST="1^1A^1B^1C^2^2A^2B^3A1^3A2^3B^3C^4^4A^4B^99"

 I (ONCHP=56)!(ONCHP=60)!(ONCHP=68)!(ONCHP=76)!(ONCHP=77) S ONCODLST="1^2^3^4^99"

 I ONCHP=57 S ONCODLST="0is^0a^1^2A^2B^3A^3B^4^99"

 I ONCHP=58 S ONCODLST="1^2A^2B^2C^3A^3B^3C^4A^4B^99"

 I ONCHP=59 S ONCODLST="0^1^1A^1B^1S^2^2A^2B^2C^3^3A^3B^3C^99"

 I (ONCHP=611)!(ONCHP=612)!(ONCHP=631)!(ONCHP=632)!(ONCHP=633)!(ONCHP=634) S ONCODLST="0a^0is^1^2^3^4^99"

 I (ONCHP=621)!(ONCHP=622) S ONCODLST="0a^0is^1^2^3A^3B^4A^4B^99"

 I ONCHP=64 S ONCODLST="0^1A^1B^2A^2B^3A^3B^4^99"

 I ONCHP=672 S ONCODLST="1^2A^2B^3A^3B^3C^4^99"

 I ONCHP=731 S ONCODLST="1^2^3^4A^4B^99"

 I ONCHP=732 S ONCODLST="4A^4B^4C^99"

 I ONCHP=74 S ONCODLST="1^2^3^4A^4B^4C^99"

 I (ONCHP=79)!(ONCHP=790)!(ONCHP=791)!(ONCHP=792)!(ONCHP=793)!(ONCHP=794)!(ONCHP=795)!(ONCHP=796)!(ONCHP=797)!(ONCHP=801) S ONCODLST="1^1E^2^2E^2 bulky^3^4^99"

 I ONCHP=802 S ONCODLST="1^2^3^4^88^99"

 I ONCHP=811 S ONCODLST="1A^1B^2A^2B^3^3A^3B^4A1^4A2^4B^99"

 I ($E(ONCHP,1,2)=82)!($E(ONCHP,1,2)=83) S ONCODLST="1^2^3^88^99"

 I (ONCHP=812) S ONCODLST="88"

 D SHLIST

 Q

SHLIST ;

 I $G(ONCSHLST)="NO" Q  ;for input transform don't show list

 I ONCODLST="" W !?4,"No Stage Group Codes for this AJCC ID",!?4,"See AJCC Cancer Staging Manual, Eighth Edition",! Q

 W !?4,"Select Stage Group from the list:",!

 I ONCHP=56 N NNN D  K ONCSHLST Q

 .F NNN=0:1:25 W !?4,"1:",NNN,?12,"2:",NNN,?20,"3:",NNN,?28,"4:",NNN

 N NNN F NNN=1:1:25 W !?4,$P(ONCODLST,"^",NNN) Q:$P(ONCODLST,"^",NNN)=""

 K ONCSHLST Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ONCSGA8H   4950     printed  Dec 13, 2024@02:28:30                                                                                                                                                                                                    Page 2

ONCSGA8H  ;HINES OIFO/RTK - AJCC 8th Ed Automatic Staging Tables ;01/23/19

 +1       ;;2.2;ONCOLOGY;**10,12,17,20**;Jul 31, 2013;Build 5

 +2       ;

 +3       ;STAGE GROUP HELP CODE AND INPUT TRANSFORM

INP       ;

 +1        DO HELP

           IF ONCODLST'[X

               KILL X,ONCSHLST

               QUIT 

 +2        KILL ONCSHLST

           QUIT 

HELP      ;

 +1        SET ONCODLST=""

 +2        DO GTAJIEN^ONCSCHMG

           IF '$DATA(ONCAJCHP)

               QUIT 

 +3        IF ONCAJCHP=""

               QUIT 

 +4        NEW ONCHP

           SET ONCHP=$PIECE(ONCAJCHP,".",1)_$PIECE(ONCAJCHP,".",2)

 +5        IF ONCHP=181

               IF $PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,1)="18.2"

                   SET ONCHP=182

 +6        IF ONCHP=6

               SET ONCODLST="3^4A^4B^4C^99"

 +7        IF (ONCHP=7)!(ONCHP=8)!(ONCHP=111)!(ONCHP=112)!(ONCHP=121)!(ONCHP=122)!(ONCHP=131)!(ONCHP=132)!(ONCHP=133)

               SET ONCODLST="0^1^2^3^4A^4B^4C^99"

 +8        IF ONCHP=9

               SET ONCODLST="0^1^2^3^4A^4B^99"

 +9        IF (ONCHP=10)!(ONCHP=29)!(ONCHP=30)!(ONCHP=31)!(ONCHP=32)!(ONCHP=34)

               SET ONCODLST="1^2^3^4^99"

 +10       IF (ONCHP=14)!(ONCHP=163)!(ONCHP=182)!(ONCHP=382)!(ONCHP=383)!(ONCHP=40)!(ONCHP=42)!(ONCHP=45)!(ONCHP=65)!(ONCHP=66)!(ONCHP=671)!(ONCHP=69)!(ONCHP=70)!(ONCHP=71)!(ONCHP=72)!(ONCHP=75)!(ONCHP=795)

               SET ONCODLST="88"

 +11       IF ONCHP=15

               SET ONCODLST="0^1^2^3^4^99"

 +12       IF ONCHP=161

               IF STGIND="C"

                   SET ONCODLST="0^1^2^3^4A^4B^99"

 +13       IF ONCHP=161

               IF STGIND="P"

                   SET ONCODLST="0^1A^1B^2A^2B^3A^3B^4A^4B^99"

 +14       IF ONCHP=161

               IF STGIND="PT"

                   SET ONCODLST="1^2^3A^3B^4A^4B^99"

 +15       IF ONCHP=162

               IF STGIND="C"

                   SET ONCODLST="0^1^2A^2B^3^4A^4B^99"

 +16       IF ONCHP=162

               IF STGIND="P"

                   SET ONCODLST="0^1A^1B^1C^2A^2B^3A^3B^4A^4B^99"

 +17       IF ONCHP=162

               IF STGIND="PT"

                   SET ONCODLST="1^2^3A^3B^4A^4B^99"

 +18       IF ONCHP=17

               IF STGIND="C"

                   SET ONCODLST="0^1^2A^2B^3^4A^4B^99"

 +19       IF ONCHP=17

               IF STGIND="P"

                   SET ONCODLST="0^1A^1B^2A^2B^3A^3B^3C^4^4A^4B^99"

 +20       IF ONCHP=17

               IF STGIND="PT"

                   SET ONCODLST="1^2^3^4^99"

 +21       IF ONCHP=181

               SET ONCODLST="0^1^2A^2B^3A^3B^4^99"

 +22       IF ONCHP=182

               SET ONCODLST="88"

 +23       IF (ONCHP=19)!(ONCHP=20)

               SET ONCODLST="0^1^2A^2B^2C^3A^3B^3C^4A^4B^4C^99"

 +24       IF ONCHP=21

               Begin DoDot:1

 +25               IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3221231

                       SET ONCODLST="1^2A^2B^3A^3B^3C^4^99"

                       QUIT 

 +26               SET ONCODLST="0^1^2A^2B^3A^3B^3C^4^99"

                   QUIT 

               End DoDot:1

 +27       IF ONCHP=22

               SET ONCODLST="1A^1B^2^3A^3B^4A^4B^99"

 +28       IF ONCHP=23

               SET ONCODLST="0^1A^1B^2^3A^3B^4^99"

 +29       IF ONCHP=24

               SET ONCODLST="0^1^2A^2B^3A^3B^4A^4B^4C^99"

 +30       IF ONCHP=25

               SET ONCODLST="0^1^2^3A^3B^3C^4A^4B^99"

 +31       IF ONCHP=26

               SET ONCODLST="0^1^2A^2B^3A^3B^4^99"

 +32       IF ONCHP=27

               SET ONCODLST="0^1A^1B^2A^2B^3A^3B^4^99"

 +33       IF ONCHP=28

               SET ONCODLST="0^1A^1B^2A^2B^3^4^99"

 +34       IF ONCHP=33

               SET ONCODLST="1^2A^2B^3A^3B^4^99"

 +35       IF ONCHP=35

               SET ONCODLST="1^2^3A^3B^4A^4B^99"

 +36       IF ONCHP=36

               SET ONCODLST="OccultCarcinoma^0^1A1^1A2^1A3^1B^2A^2B^3A^3B^3C^4A^4B^99"

 +37       IF (ONCHP=37)!(ONCHP=41)!(ONCHP=431)!(ONCHP=44)

               SET ONCODLST="1A^1B^2^3A^3B^4^99"

 +38       IF ONCHP=381

               SET ONCODLST="1A^1B^2A^2B^3^4A^4B^99"

 +39       IF ONCHP=432

               SET ONCODLST="1^2^3A^3B^4^99"

 +40       IF ONCHP=45

               SET ONCODLST="3^4A^4B^4C^88^99"

 +41       IF (ONCHP=46)&(STGIND="C")

               SET ONCODLST="0^1^2A^2B^3^4^88^99"

 +42       IF (ONCHP=46)&(STGIND'="C")

               SET ONCODLST="0^1^2A^2B^3A^3B^4^88^99"

 +43       IF (ONCHP=47)&((STGIND="C")!(STGIND="PT"))

               SET ONCODLST="0^1A^1B^2A^2B^2C^3^4^99"

 +44       IF ONCHP=47

               IF STGIND="P"

                   SET ONCODLST="0^1A^1B^2A^2B^2C^3A^3B^3C^3D^4^99"

 +45       IF ONCHP=48

               SET ONCODLST="0^1A^1B^2A^2B^3A^3B^3C^4^88^99"

 +46       IF ONCHP=50

               SET ONCODLST="1^1A^1B^2^3^3A^3B^3C^4^4A^4B^99"

 +47       IF ONCHP=51

               SET ONCODLST="1A^1B^2A^2B^3^4A^4B^99"

 +48       IF ONCHP=52

               Begin DoDot:1

 +49               IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3201231

                       SET ONCODLST="1^1A^1A1^1A2^1B^1B1^1B2^1B3^2^2A^2A1^2A2^2B^3^3A^3B^3C1^3C2^4A^4B^99"

                       QUIT 

 +50               SET ONCODLST="1^1A^1A1^1A2^1B^1B1^1B2^2^2A^2A1^2A2^2B^3^3A^3B^4A^4B^99"

                   QUIT 

               End DoDot:1

 +51       IF ONCHP=53

               SET ONCODLST="1^1A^1B^2^3^3A^3B^3C1^3C2^4A^4B^99"

 +52       IF ONCHP=541

               SET ONCODLST="1^1A^1B^2^3A^3B^3C^4A^4B^99"

 +53       IF ONCHP=542

               SET ONCODLST="1^1A^1B^1C^2^3A^3B^3C^4A^4B^99"

 +54       IF ONCHP=55

               SET ONCODLST="1^1A^1B^1C^2^2A^2B^3A1^3A2^3B^3C^4^4A^4B^99"

 +55       IF (ONCHP=56)!(ONCHP=60)!(ONCHP=68)!(ONCHP=76)!(ONCHP=77)

               SET ONCODLST="1^2^3^4^99"

 +56       IF ONCHP=57

               SET ONCODLST="0is^0a^1^2A^2B^3A^3B^4^99"

 +57       IF ONCHP=58

               SET ONCODLST="1^2A^2B^2C^3A^3B^3C^4A^4B^99"

 +58       IF ONCHP=59

               SET ONCODLST="0^1^1A^1B^1S^2^2A^2B^2C^3^3A^3B^3C^99"

 +59       IF (ONCHP=611)!(ONCHP=612)!(ONCHP=631)!(ONCHP=632)!(ONCHP=633)!(ONCHP=634)

               SET ONCODLST="0a^0is^1^2^3^4^99"

 +60       IF (ONCHP=621)!(ONCHP=622)

               SET ONCODLST="0a^0is^1^2^3A^3B^4A^4B^99"

 +61       IF ONCHP=64

               SET ONCODLST="0^1A^1B^2A^2B^3A^3B^4^99"

 +62       IF ONCHP=672

               SET ONCODLST="1^2A^2B^3A^3B^3C^4^99"

 +63       IF ONCHP=731

               SET ONCODLST="1^2^3^4A^4B^99"

 +64       IF ONCHP=732

               SET ONCODLST="4A^4B^4C^99"

 +65       IF ONCHP=74

               SET ONCODLST="1^2^3^4A^4B^4C^99"

 +66       IF (ONCHP=79)!(ONCHP=790)!(ONCHP=791)!(ONCHP=792)!(ONCHP=793)!(ONCHP=794)!(ONCHP=795)!(ONCHP=796)!(ONCHP=797)!(ONCHP=801)

               SET ONCODLST="1^1E^2^2E^2 bulky^3^4^99"

 +67       IF ONCHP=802

               SET ONCODLST="1^2^3^4^88^99"

 +68       IF ONCHP=811

               SET ONCODLST="1A^1B^2A^2B^3^3A^3B^4A1^4A2^4B^99"

 +69       IF ($EXTRACT(ONCHP,1,2)=82)!($EXTRACT(ONCHP,1,2)=83)

               SET ONCODLST="1^2^3^88^99"

 +70       IF (ONCHP=812)

               SET ONCODLST="88"

 +71       DO SHLIST

 +72       QUIT 

SHLIST    ;

 +1       ;for input transform don't show list

           IF $GET(ONCSHLST)="NO"

               QUIT 

 +2        IF ONCODLST=""

               WRITE !?4,"No Stage Group Codes for this AJCC ID",!?4,"See AJCC Cancer Staging Manual, Eighth Edition",!

               QUIT 

 +3        WRITE !?4,"Select Stage Group from the list:",!

 +4        IF ONCHP=56

               NEW NNN

               Begin DoDot:1

 +5                FOR NNN=0:1:25

                       WRITE !?4,"1:",NNN,?12,"2:",NNN,?20,"3:",NNN,?28,"4:",NNN

               End DoDot:1

               KILL ONCSHLST

               QUIT 

 +6        NEW NNN

           FOR NNN=1:1:25

               WRITE !?4,$PIECE(ONCODLST,"^",NNN)

               if $PIECE(ONCODLST,"^",NNN)=""

                   QUIT 

 +7        KILL ONCSHLST

           QUIT