source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOTNMC.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1ONCOTNMC ;WISC/MLH - HELP/VALIDATION for TNM CODES ;6/16/93 09:10
2 ;;2.11;ONCOLOGY;;Mar 07, 1995
3 ;
4VALID(TYP,COD) ; VALIDATE a T, N, or M code - COD should be a call by reference (.COD)
5 N VALID S VALID=0 ; flag - assume invalid
6 IF (TYP="T")!(TYP="N")!(TYP="M") X "S VALID=$$VALID"_TYP_"(.COD)"
7 QUIT VALID
8 ;
9VALIDT(TCOD) ; VALIDATE a T code - TCOD should be a call by reference (.TCOD)
10 N VALIDT S VALIDT=0 ; flag - assume invalid
11 S TCOD=$TR(TCOD,"abcdisvx","ABCDISVX") ; go to caps
12 I TCOD="IS" S VALIDT=1 ; in-situ
13 E I TCOD="X" S VALIDT=1 ; unknown
14 E S VALIDT=$$VALIDTN(.TCOD) ; numeric
15 Q VALIDT
16 ;
17VALIDTN(NTCOD) ; VALIDATE a NUMERIC T code - NTCOD should be a call by reference (.NTCOD)
18 N VALIDTN S VALIDTN=0 ; flag - assume invalid
19 N NUMVAL S NUMVAL=$E(NTCOD,1) ; numeric value of T code
20 IF NUMVAL?1N,"012345"[NUMVAL D ; good so far, continue
21 . I $E(NTCOD,2,$L(NTCOD))="" S VALIDTN=1 ; OK
22 . E S VALIDTN=$$VALIDTNA(.NTCOD)
23 . Q
24 ;END IF
25 ;
26 Q VALIDTN
27 ;
28VALIDTNA(ANTCOD) ; VALIDATE a NUMERIC T code with ALPHA suffix - ANTCOD should be a call by reference (.ANTCOD)
29 N VALIDTNA S VALIDTNA=0 ; flag - assume invalid
30 N ALPVAL S ALPVAL=$E(ANTCOD,2) ; alpha suffix
31 IF "ABCD"[ALPVAL D ; good so far, continue
32 . N ROMVAL S ROMVAL=$E(NTCOD,3,$L(ANTCOD)) ; roman numeral suffix
33 . I "^^I^II^III^IV^"[(U_ROMVAL_U) S VALIDTNA=1 ; OK
34 . Q
35 ;END IF
36 ;
37 Q VALIDTNA
38 ;
39VALIDN(NCOD) ; VALIDATE an N code - NCOD should be a call by reference (.NCOD)
40 N VALIDN S VALIDN=0 ; flag - assume invalid
41 S NCOD=$TR(NCOD,"abcdx","ABCDX") ; go to caps
42 I NCOD="X" S VALIDN=1 ; unknown
43 E S VALIDN=$$VALIDNN(.NCOD) ; numeric
44 Q VALIDN
45 ;
46VALIDNN(NNCOD) ; VALIDATE a NUMERIC N code - NNCOD should be a call by reference (.NNCOD)
47 N VALIDNN S VALIDNN=0 ; flag - assume invalid
48 N NUMVAL S NUMVAL=$E(NNCOD,1) ; numeric value of T code
49 IF NUMVAL?1N,"01234"[NUMVAL D ; good so far, continue
50 . IF $E(NNCOD,2,$L(NNCOD))="" S VALIDNN=1 ; OK
51 . ELSE D
52 .. N ALPVAL S ALPVAL=$E(NNCOD,2)
53 .. I "ABCD"[ALPVAL S VALIDNN=1
54 .. Q
55 . ;END IF
56 . ;
57 . Q
58 ;END IF
59 ;
60 Q VALIDNN
61 ;
62VALIDM(MCOD) ; VALIDATE an N code - MCOD should be a call by reference (.MCOD)
63 N VALIDM S VALIDM=0 ; flag - assume invalid
64 S MCOD=$TR(MCOD,"abcdx","ABCDX") ; go to caps
65 I MCOD="X" S VALIDM=1 ; unknown
66 E S VALIDM=$$VALIDMN(.MCOD) ; numeric
67 Q VALIDM
68 ;
69VALIDMN(NMCOD) ; VALIDATE a NUMERIC N code - NMCOD should be a call by reference (.NMCOD)
70 N VALIDMN S VALIDMN=0 ; flag - assume invalid
71 N NUMVAL S NUMVAL=$E(NMCOD,1) ; numeric value of T code
72 IF NUMVAL?1N,"012"[NUMVAL D ; good so far, continue
73 . IF $E(NMCOD,2,$L(NMCOD))="" S VALIDMN=1 ; OK
74 . ELSE D
75 .. N ALPVAL S ALPVAL=$E(NMCOD,2)
76 .. I "ABCD"[ALPVAL S VALIDMN=1
77 .. Q
78 . ;END IF
79 . ;
80 . Q
81 ;END IF
82 ;
83 Q VALIDMN
Note: See TracBrowser for help on using the repository browser.