- 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 Feb 18, 2025@23:54:32 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