ONCOTNMC ;WISC/MLH - HELP/VALIDATION for TNM CODES ;6/16/93 09:10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
VALID(TYP,COD) ; VALIDATE a T, N, or M code - COD should be a call by reference (.COD)
N VALID S VALID=0 ; flag - assume invalid
IF (TYP="T")!(TYP="N")!(TYP="M") X "S VALID=$$VALID"_TYP_"(.COD)"
QUIT VALID
;
VALIDT(TCOD) ; VALIDATE a T code - TCOD should be a call by reference (.TCOD)
N VALIDT S VALIDT=0 ; flag - assume invalid
S TCOD=$TR(TCOD,"abcdisvx","ABCDISVX") ; go to caps
I TCOD="IS" S VALIDT=1 ; in-situ
E I TCOD="X" S VALIDT=1 ; unknown
E S VALIDT=$$VALIDTN(.TCOD) ; numeric
Q VALIDT
;
VALIDTN(NTCOD) ; VALIDATE a NUMERIC T code - NTCOD should be a call by reference (.NTCOD)
N VALIDTN S VALIDTN=0 ; flag - assume invalid
N NUMVAL S NUMVAL=$E(NTCOD,1) ; numeric value of T code
IF NUMVAL?1N,"012345"[NUMVAL D ; good so far, continue
. I $E(NTCOD,2,$L(NTCOD))="" S VALIDTN=1 ; OK
. E S VALIDTN=$$VALIDTNA(.NTCOD)
. Q
;END IF
;
Q VALIDTN
;
VALIDTNA(ANTCOD) ; VALIDATE a NUMERIC T code with ALPHA suffix - ANTCOD should be a call by reference (.ANTCOD)
N VALIDTNA S VALIDTNA=0 ; flag - assume invalid
N ALPVAL S ALPVAL=$E(ANTCOD,2) ; alpha suffix
IF "ABCD"[ALPVAL D ; good so far, continue
. N ROMVAL S ROMVAL=$E(NTCOD,3,$L(ANTCOD)) ; roman numeral suffix
. I "^^I^II^III^IV^"[(U_ROMVAL_U) S VALIDTNA=1 ; OK
. Q
;END IF
;
Q VALIDTNA
;
VALIDN(NCOD) ; VALIDATE an N code - NCOD should be a call by reference (.NCOD)
N VALIDN S VALIDN=0 ; flag - assume invalid
S NCOD=$TR(NCOD,"abcdx","ABCDX") ; go to caps
I NCOD="X" S VALIDN=1 ; unknown
E S VALIDN=$$VALIDNN(.NCOD) ; numeric
Q VALIDN
;
VALIDNN(NNCOD) ; VALIDATE a NUMERIC N code - NNCOD should be a call by reference (.NNCOD)
N VALIDNN S VALIDNN=0 ; flag - assume invalid
N NUMVAL S NUMVAL=$E(NNCOD,1) ; numeric value of T code
IF NUMVAL?1N,"01234"[NUMVAL D ; good so far, continue
. IF $E(NNCOD,2,$L(NNCOD))="" S VALIDNN=1 ; OK
. ELSE D
.. N ALPVAL S ALPVAL=$E(NNCOD,2)
.. I "ABCD"[ALPVAL S VALIDNN=1
.. Q
. ;END IF
. ;
. Q
;END IF
;
Q VALIDNN
;
VALIDM(MCOD) ; VALIDATE an N code - MCOD should be a call by reference (.MCOD)
N VALIDM S VALIDM=0 ; flag - assume invalid
S MCOD=$TR(MCOD,"abcdx","ABCDX") ; go to caps
I MCOD="X" S VALIDM=1 ; unknown
E S VALIDM=$$VALIDMN(.MCOD) ; numeric
Q VALIDM
;
VALIDMN(NMCOD) ; VALIDATE a NUMERIC N code - NMCOD should be a call by reference (.NMCOD)
N VALIDMN S VALIDMN=0 ; flag - assume invalid
N NUMVAL S NUMVAL=$E(NMCOD,1) ; numeric value of T code
IF NUMVAL?1N,"012"[NUMVAL D ; good so far, continue
. IF $E(NMCOD,2,$L(NMCOD))="" S VALIDMN=1 ; OK
. ELSE D
.. N ALPVAL S ALPVAL=$E(NMCOD,2)
.. I "ABCD"[ALPVAL S VALIDMN=1
.. Q
. ;END IF
. ;
. Q
;END IF
;
Q VALIDMN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOTNMC 2989 printed Apr 09, 2024@21:27:31 Page 2
ONCOTNMC ;WISC/MLH - HELP/VALIDATION for TNM CODES ;6/16/93 09:10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
VALID(TYP,COD) ; VALIDATE a T, N, or M code - COD should be a call by reference (.COD)
+1 ; flag - assume invalid
NEW VALID
SET VALID=0
+2 IF (TYP="T")!(TYP="N")!(TYP="M")
XECUTE "S VALID=$$VALID"_TYP_"(.COD)"
+3 QUIT VALID
+4 ;
VALIDT(TCOD) ; VALIDATE a T code - TCOD should be a call by reference (.TCOD)
+1 ; flag - assume invalid
NEW VALIDT
SET VALIDT=0
+2 ; go to caps
SET TCOD=$TRANSLATE(TCOD,"abcdisvx","ABCDISVX")
+3 ; in-situ
IF TCOD="IS"
SET VALIDT=1
+4 ; unknown
IF '$TEST
IF TCOD="X"
SET VALIDT=1
+5 ; numeric
IF '$TEST
SET VALIDT=$$VALIDTN(.TCOD)
+6 QUIT VALIDT
+7 ;
VALIDTN(NTCOD) ; VALIDATE a NUMERIC T code - NTCOD should be a call by reference (.NTCOD)
+1 ; flag - assume invalid
NEW VALIDTN
SET VALIDTN=0
+2 ; numeric value of T code
NEW NUMVAL
SET NUMVAL=$EXTRACT(NTCOD,1)
+3 ; good so far, continue
IF NUMVAL?1N
IF "012345"[NUMVAL
Begin DoDot:1
+4 ; OK
IF $EXTRACT(NTCOD,2,$LENGTH(NTCOD))=""
SET VALIDTN=1
+5 IF '$TEST
SET VALIDTN=$$VALIDTNA(.NTCOD)
+6 QUIT
End DoDot:1
+7 ;END IF
+8 ;
+9 QUIT VALIDTN
+10 ;
VALIDTNA(ANTCOD) ; VALIDATE a NUMERIC T code with ALPHA suffix - ANTCOD should be a call by reference (.ANTCOD)
+1 ; flag - assume invalid
NEW VALIDTNA
SET VALIDTNA=0
+2 ; alpha suffix
NEW ALPVAL
SET ALPVAL=$EXTRACT(ANTCOD,2)
+3 ; good so far, continue
IF "ABCD"[ALPVAL
Begin DoDot:1
+4 ; roman numeral suffix
NEW ROMVAL
SET ROMVAL=$EXTRACT(NTCOD,3,$LENGTH(ANTCOD))
+5 ; OK
IF "^^I^II^III^IV^"[(U_ROMVAL_U)
SET VALIDTNA=1
+6 QUIT
End DoDot:1
+7 ;END IF
+8 ;
+9 QUIT VALIDTNA
+10 ;
VALIDN(NCOD) ; VALIDATE an N code - NCOD should be a call by reference (.NCOD)
+1 ; flag - assume invalid
NEW VALIDN
SET VALIDN=0
+2 ; go to caps
SET NCOD=$TRANSLATE(NCOD,"abcdx","ABCDX")
+3 ; unknown
IF NCOD="X"
SET VALIDN=1
+4 ; numeric
IF '$TEST
SET VALIDN=$$VALIDNN(.NCOD)
+5 QUIT VALIDN
+6 ;
VALIDNN(NNCOD) ; VALIDATE a NUMERIC N code - NNCOD should be a call by reference (.NNCOD)
+1 ; flag - assume invalid
NEW VALIDNN
SET VALIDNN=0
+2 ; numeric value of T code
NEW NUMVAL
SET NUMVAL=$EXTRACT(NNCOD,1)
+3 ; good so far, continue
IF NUMVAL?1N
IF "01234"[NUMVAL
Begin DoDot:1
+4 ; OK
IF $EXTRACT(NNCOD,2,$LENGTH(NNCOD))=""
SET VALIDNN=1
+5 IF '$TEST
Begin DoDot:2
+6 NEW ALPVAL
SET ALPVAL=$EXTRACT(NNCOD,2)
+7 IF "ABCD"[ALPVAL
SET VALIDNN=1
+8 QUIT
End DoDot:2
+9 ;END IF
+10 ;
+11 QUIT
End DoDot:1
+12 ;END IF
+13 ;
+14 QUIT VALIDNN
+15 ;
VALIDM(MCOD) ; VALIDATE an N code - MCOD should be a call by reference (.MCOD)
+1 ; flag - assume invalid
NEW VALIDM
SET VALIDM=0
+2 ; go to caps
SET MCOD=$TRANSLATE(MCOD,"abcdx","ABCDX")
+3 ; unknown
IF MCOD="X"
SET VALIDM=1
+4 ; numeric
IF '$TEST
SET VALIDM=$$VALIDMN(.MCOD)
+5 QUIT VALIDM
+6 ;
VALIDMN(NMCOD) ; VALIDATE a NUMERIC N code - NMCOD should be a call by reference (.NMCOD)
+1 ; flag - assume invalid
NEW VALIDMN
SET VALIDMN=0
+2 ; numeric value of T code
NEW NUMVAL
SET NUMVAL=$EXTRACT(NMCOD,1)
+3 ; good so far, continue
IF NUMVAL?1N
IF "012"[NUMVAL
Begin DoDot:1
+4 ; OK
IF $EXTRACT(NMCOD,2,$LENGTH(NMCOD))=""
SET VALIDMN=1
+5 IF '$TEST
Begin DoDot:2
+6 NEW ALPVAL
SET ALPVAL=$EXTRACT(NMCOD,2)
+7 IF "ABCD"[ALPVAL
SET VALIDMN=1
+8 QUIT
End DoDot:2
+9 ;END IF
+10 ;
+11 QUIT
End DoDot:1
+12 ;END IF
+13 ;
+14 QUIT VALIDMN
