ONCSCHMH ;HINES OIFO/RTK - TNM CODE CALLED FROM SCHMG ROUTINE ;05/19/20
;;2.2;ONCOLOGY;**12,13,20**;Jul 31, 2013;Build 5
;
CCODES ;IT code for PATH T/N to also accept CLIN T/N codes
I ($G(ONCTNMTP)="P")&((ONCNODE=1)!(ONCNODE=6)) S ONCTNMTP="C" D ADDN1CS S ONCTNMTP="P" Q ; reset ONCTNMTP when done
I ($G(ONCTNMTP)="P")&((ONCNODE=2)!(ONCNODE=7)) S ONCTNMTP="C" D ADDN2CS S ONCTNMTP="P" Q ; reset ONCTNMTP when done
Q
ADDN1CS ;code to add the Clin T codes from Node 1 to ONCAJVAL
F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCAJIEN,1,IEN)) Q:IEN'>0 D
.S ONCCODE=$P($G(^ONCO(165.8,ONCAJIEN,1,IEN,0)),U,1)
.D PRFX^ONCSCHMG S ONCAJVAL=ONCAJVAL_ONCPRFX_ONCCODE_"^"
Q
ADDN2CS ;code to add the Clin N codes from Node 2 to ONCAJVAL
F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCAJIEN,2,IEN)) Q:IEN'>0 D
.S ONCCODE=$P($G(^ONCO(165.8,ONCAJIEN,2,IEN,0)),U,1)
.D PRFX^ONCSCHMG S ONCAJVAL=ONCAJVAL_ONCPRFX_ONCCODE_"^"
Q
;
YPCHECK ;code for yp to match Path instead of Clin codes where there is 6/7 node
I ($G(ONCTNMTP)="Y")&((ONCAJIEN=62)!(ONCAJIEN=63)!(ONCAJIEN=75)!(ONCAJIEN=78)) D
.I ONCNODE=1 S ONCNODE=6
.Q
I ($G(ONCTNMTP)="Y")&((ONCAJIEN=1)!(ONCAJIEN=5)!(ONCAJIEN=6)!(ONCAJIEN=50)!(ONCAJIEN=52)!(ONCAJIEN=61)!(ONCAJIEN=63)!(ONCAJIEN=78)) D
.I ONCNODE=2 S ONCNODE=7
Q
;
CFORPATH ;HELP code for PATH T/N to also display CLIN T/N codes
; Set ONCTNMTP="C" to list Clin codes, then set back to "P" before exiting
I ($G(ONCTNMTP)="P")&((ONCNODE=1)!(ONCNODE=6)) S ONCTNMTP="C" D NODE1CS S ONCTNMTP="P" Q ; reset ONCTNMTP when done
I ($G(ONCTNMTP)="P")&((ONCNODE=2)!(ONCNODE=7)) S ONCTNMTP="C" D NODE2CS S ONCTNMTP="P" Q ; reset ONCTNMTP when done
Q
NODE1CS ;1 node
F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCAJIEN,1,IEN)) Q:IEN'>0 D
.S ONCDES=$P($G(^ONCO(165.8,ONCAJIEN,1,IEN,1)),U,1)
.S ONCCODE=$P($G(^ONCO(165.8,ONCAJIEN,1,IEN,0)),U,1)
.D PRFX^ONCSCHMG W !,ONCPRFX,ONCCODE D WORDWRP^ONCSCHMG
Q
NODE2CS ;2 node
F IEN=0:0 S IEN=$O(^ONCO(165.8,ONCAJIEN,2,IEN)) Q:IEN'>0 D
.S ONCDES=$P($G(^ONCO(165.8,ONCAJIEN,2,IEN,1)),U,1)
.S ONCCODE=$P($G(^ONCO(165.8,ONCAJIEN,2,IEN,0)),U,1)
.D PRFX^ONCSCHMG W !,ONCPRFX,ONCCODE D WORDWRP^ONCSCHMG
Q
;
NONXX9724 ;special code for Medulloblastoma schema 09724
S $P(^ONCO(165.5,D0,"AJCC8"),U,2)=88 ;5001 AJCC TNM CLIN T
S $P(^ONCO(165.5,D0,"AJCC8"),U,3)=88 ;5002 AJCC TNM CLIN N
W !!,"AJCC TNM CLIN T: 88"
W !,"AJCC TNM CLIN N: 88"
I ONCSCMA="09724" S Y=5003 Q
NONXX5003 ;
S $P(^ONCO(165.5,D0,"AJCC8"),U,5)=88 ;5004 AJCC TNM CLIN STAGE GROUP
S TMP=$G(X),X=88 D CSSG^ONCOCRC S X=TMP K TMP ;set "ASG" for field 38.5
S $P(^ONCO(165.5,D0,"AJCC8"),U,6)=88 ;5011 AJCC TNM PATH T
S $P(^ONCO(165.5,D0,"AJCC8"),U,7)=88 ;5012 AJCC TNM PATH N
W !,"AJCC TNM CLIN STAGE GROUP: 88"
W !!,"AJCC TNM PATH T: 88"
W !,"AJCC TNM PATH N: 88"
I ONCSCMA="09724" S Y=5013 Q
NONXX5013 ;
S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88 ;5014 AJCC TNM PATH STAGE GROUP
S TMP=$G(X),X=88 D PSSG^ONCOCRC S X=TMP K TMP ;set "ASG" for field 38.5
W !,"AJCC TNM PATH STAGE GROUP: 88"
S $P(^ONCO(165.5,D0,"AJCC8"),U,20)="" ;5025 AJCC TNM POST THERAPY (yc) T
S $P(^ONCO(165.5,D0,"AJCC8"),U,21)="" ;5026 AJCC TNM POST THERAPY (yc) N
S $P(^ONCO(165.5,D0,"AJCC8"),U,22)="" ;5027 AJCC TNM POST THERAPY (yc) M
;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) N/A
S $P(^ONCO(165.5,D0,"AJCC8"),U,10)="" ;5021 AJCC TNM POST THERAPY T
S $P(^ONCO(165.5,D0,"AJCC8"),U,11)="" ;5022 AJCC TNM POST THERAPY N
S $P(^ONCO(165.5,D0,"AJCC8"),U,12)="" ;5023 AJCC TNM POST THERAPY M
S $P(^ONCO(165.5,D0,"AJCC8"),U,13)="" ;5024 AJCC TNM PT STAGE GROUP
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !!,"AJCC TNM POST THERAPY (yc) T="
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) N="
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) M="
;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP=",!
W !!,"AJCC TNM POST THERAPY (yp) T="
W !,"AJCC TNM POST THERAPY (yp) N="
W !,"AJCC TNM POST THERAPY (yp) M="
W !,"AJCC TNM POST THERAPY (yp) STAGE GROUP=",!
S Y="@149" Q
;
STGVRCHK ;check the AJCC edition (version) and set correct node
I DATEDX<3210000 Q
I DATEDX>3201231 D ;2021 v9 update-Cervix
.I ONCAJIEN=55 D
..I (ONCNODE=1)!(ONCNODE=6) S ONCNODE="V9T"
..I (ONCNODE=2)!(ONCNODE=7) S ONCNODE="V9N"
..I ONCNODE=3 S ONCNODE="V9M"
I DATEDX>3221231 D ;2023 v9 update-Appendix, Anus, Brain & Spinal Cord
.I ONCAJIEN=21 D ; appendix
..I ONCNODE=3 S ONCNODE="V9M"
.I ONCAJIEN=23 D ; anus
..I (ONCNODE=1)!(ONCNODE=6) S ONCNODE="V9T"
.I ONCAJIEN=108 D ; medulloblastoma (new 72.9 chapter)
..I ONCNODE=3 S ONCNODE="V9M"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMH 4715 printed Nov 22, 2024@17:38:04 Page 2
ONCSCHMH ;HINES OIFO/RTK - TNM CODE CALLED FROM SCHMG ROUTINE ;05/19/20
+1 ;;2.2;ONCOLOGY;**12,13,20**;Jul 31, 2013;Build 5
+2 ;
CCODES ;IT code for PATH T/N to also accept CLIN T/N codes
+1 ; reset ONCTNMTP when done
IF ($GET(ONCTNMTP)="P")&((ONCNODE=1)!(ONCNODE=6))
SET ONCTNMTP="C"
DO ADDN1CS
SET ONCTNMTP="P"
QUIT
+2 ; reset ONCTNMTP when done
IF ($GET(ONCTNMTP)="P")&((ONCNODE=2)!(ONCNODE=7))
SET ONCTNMTP="C"
DO ADDN2CS
SET ONCTNMTP="P"
QUIT
+3 QUIT
ADDN1CS ;code to add the Clin T codes from Node 1 to ONCAJVAL
+1 FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.8,ONCAJIEN,1,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+2 SET ONCCODE=$PIECE($GET(^ONCO(165.8,ONCAJIEN,1,IEN,0)),U,1)
+3 DO PRFX^ONCSCHMG
SET ONCAJVAL=ONCAJVAL_ONCPRFX_ONCCODE_"^"
End DoDot:1
+4 QUIT
ADDN2CS ;code to add the Clin N codes from Node 2 to ONCAJVAL
+1 FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.8,ONCAJIEN,2,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+2 SET ONCCODE=$PIECE($GET(^ONCO(165.8,ONCAJIEN,2,IEN,0)),U,1)
+3 DO PRFX^ONCSCHMG
SET ONCAJVAL=ONCAJVAL_ONCPRFX_ONCCODE_"^"
End DoDot:1
+4 QUIT
+5 ;
YPCHECK ;code for yp to match Path instead of Clin codes where there is 6/7 node
+1 IF ($GET(ONCTNMTP)="Y")&((ONCAJIEN=62)!(ONCAJIEN=63)!(ONCAJIEN=75)!(ONCAJIEN=78))
Begin DoDot:1
+2 IF ONCNODE=1
SET ONCNODE=6
+3 QUIT
End DoDot:1
+4 IF ($GET(ONCTNMTP)="Y")&((ONCAJIEN=1)!(ONCAJIEN=5)!(ONCAJIEN=6)!(ONCAJIEN=50)!(ONCAJIEN=52)!(ONCAJIEN=61)!(ONCAJIEN=63)!(ONCAJIEN=78))
Begin DoDot:1
+5 IF ONCNODE=2
SET ONCNODE=7
End DoDot:1
+6 QUIT
+7 ;
CFORPATH ;HELP code for PATH T/N to also display CLIN T/N codes
+1 ; Set ONCTNMTP="C" to list Clin codes, then set back to "P" before exiting
+2 ; reset ONCTNMTP when done
IF ($GET(ONCTNMTP)="P")&((ONCNODE=1)!(ONCNODE=6))
SET ONCTNMTP="C"
DO NODE1CS
SET ONCTNMTP="P"
QUIT
+3 ; reset ONCTNMTP when done
IF ($GET(ONCTNMTP)="P")&((ONCNODE=2)!(ONCNODE=7))
SET ONCTNMTP="C"
DO NODE2CS
SET ONCTNMTP="P"
QUIT
+4 QUIT
NODE1CS ;1 node
+1 FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.8,ONCAJIEN,1,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+2 SET ONCDES=$PIECE($GET(^ONCO(165.8,ONCAJIEN,1,IEN,1)),U,1)
+3 SET ONCCODE=$PIECE($GET(^ONCO(165.8,ONCAJIEN,1,IEN,0)),U,1)
+4 DO PRFX^ONCSCHMG
WRITE !,ONCPRFX,ONCCODE
DO WORDWRP^ONCSCHMG
End DoDot:1
+5 QUIT
NODE2CS ;2 node
+1 FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.8,ONCAJIEN,2,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+2 SET ONCDES=$PIECE($GET(^ONCO(165.8,ONCAJIEN,2,IEN,1)),U,1)
+3 SET ONCCODE=$PIECE($GET(^ONCO(165.8,ONCAJIEN,2,IEN,0)),U,1)
+4 DO PRFX^ONCSCHMG
WRITE !,ONCPRFX,ONCCODE
DO WORDWRP^ONCSCHMG
End DoDot:1
+5 QUIT
+6 ;
NONXX9724 ;special code for Medulloblastoma schema 09724
+1 ;5001 AJCC TNM CLIN T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,2)=88
+2 ;5002 AJCC TNM CLIN N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,3)=88
+3 WRITE !!,"AJCC TNM CLIN T: 88"
+4 WRITE !,"AJCC TNM CLIN N: 88"
+5 IF ONCSCMA="09724"
SET Y=5003
QUIT
NONXX5003 ;
+1 ;5004 AJCC TNM CLIN STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=88
+2 ;set "ASG" for field 38.5
SET TMP=$GET(X)
SET X=88
DO CSSG^ONCOCRC
SET X=TMP
KILL TMP
+3 ;5011 AJCC TNM PATH T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,6)=88
+4 ;5012 AJCC TNM PATH N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,7)=88
+5 WRITE !,"AJCC TNM CLIN STAGE GROUP: 88"
+6 WRITE !!,"AJCC TNM PATH T: 88"
+7 WRITE !,"AJCC TNM PATH N: 88"
+8 IF ONCSCMA="09724"
SET Y=5013
QUIT
NONXX5013 ;
+1 ;5014 AJCC TNM PATH STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=88
+2 ;set "ASG" for field 38.5
SET TMP=$GET(X)
SET X=88
DO PSSG^ONCOCRC
SET X=TMP
KILL TMP
+3 WRITE !,"AJCC TNM PATH STAGE GROUP: 88"
+4 ;5025 AJCC TNM POST THERAPY (yc) T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,20)=""
+5 ;5026 AJCC TNM POST THERAPY (yc) N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,21)=""
+6 ;5027 AJCC TNM POST THERAPY (yc) M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,22)=""
+7 ;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) N/A
+8 ;5021 AJCC TNM POST THERAPY T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,10)=""
+9 ;5022 AJCC TNM POST THERAPY N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,11)=""
+10 ;5023 AJCC TNM POST THERAPY M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,12)=""
+11 ;5024 AJCC TNM PT STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,13)=""
+12 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !!,"AJCC TNM POST THERAPY (yc) T="
+13 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !,"AJCC TNM POST THERAPY (yc) N="
+14 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !,"AJCC TNM POST THERAPY (yc) M="
+15 ;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP=",!
+16 WRITE !!,"AJCC TNM POST THERAPY (yp) T="
+17 WRITE !,"AJCC TNM POST THERAPY (yp) N="
+18 WRITE !,"AJCC TNM POST THERAPY (yp) M="
+19 WRITE !,"AJCC TNM POST THERAPY (yp) STAGE GROUP=",!
+20 SET Y="@149"
QUIT
+21 ;
STGVRCHK ;check the AJCC edition (version) and set correct node
+1 IF DATEDX<3210000
QUIT
+2 ;2021 v9 update-Cervix
IF DATEDX>3201231
Begin DoDot:1
+3 IF ONCAJIEN=55
Begin DoDot:2
+4 IF (ONCNODE=1)!(ONCNODE=6)
SET ONCNODE="V9T"
+5 IF (ONCNODE=2)!(ONCNODE=7)
SET ONCNODE="V9N"
+6 IF ONCNODE=3
SET ONCNODE="V9M"
End DoDot:2
End DoDot:1
+7 ;2023 v9 update-Appendix, Anus, Brain & Spinal Cord
IF DATEDX>3221231
Begin DoDot:1
+8 ; appendix
IF ONCAJIEN=21
Begin DoDot:2
+9 IF ONCNODE=3
SET ONCNODE="V9M"
End DoDot:2
+10 ; anus
IF ONCAJIEN=23
Begin DoDot:2
+11 IF (ONCNODE=1)!(ONCNODE=6)
SET ONCNODE="V9T"
End DoDot:2
+12 ; medulloblastoma (new 72.9 chapter)
IF ONCAJIEN=108
Begin DoDot:2
+13 IF ONCNODE=3
SET ONCNODE="V9M"
End DoDot:2
End DoDot:1
+14 QUIT
