ONCSCHMH ;Hines OIFO/RTK - TNM CODE CALLED FROM SCHMG ROUTINE ;05/19/20
;;2.2;ONCOLOGY;**12**;Jul 31, 2013;Build 8
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMH 2166 printed Apr 07, 2021@15:28:15 Page 2
ONCSCHMH ;Hines OIFO/RTK - TNM CODE CALLED FROM SCHMG ROUTINE ;05/19/20
+1 ;;2.2;ONCOLOGY;**12**;Jul 31, 2013;Build 8
+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