- 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 Feb 18, 2025@23:52:29 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