ONCSCHMH ;HINES OIFO/RTK - TNM CODE CALLED FROM SCHMG ROUTINE ;05/19/20
;;2.2;ONCOLOGY;**12,13**;Jul 31, 2013;Build 7
;
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
STGVRCHK ;check the AJCC edition (version) and set correct node
I DATEDX<3210000 Q
I DATEDX>3201231 D
.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"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMH 2423 printed Apr 09, 2024@21:26:10 Page 2
ONCSCHMH ;HINES OIFO/RTK - TNM CODE CALLED FROM SCHMG ROUTINE ;05/19/20
+1 ;;2.2;ONCOLOGY;**12,13**;Jul 31, 2013;Build 7
+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
STGVRCHK ;check the AJCC edition (version) and set correct node
+1 IF DATEDX<3210000
QUIT
+2 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 QUIT
