source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCEDIT2.m@ 1456

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1ONCEDIT2 ;Hines OIFO/GWB - ONCOLOGY INTERFIELD EDITS (continued);09/29/00
2 ;;2.11;ONCOLOGY;**27,28,32,33,44,47**;Mar 07, 1995;Build 19
3 ;
4IF1213 I BCOD=2,SSTI'=0 D D ERRMSG
5 .S MSG(1)="BEHAVIOR CODE = 2 (In situ)"
6 .S MSG(2)="SUMMARY STAGE = "_SSTI_" ("_SSTE_")"
7 .S MSG(3)="BEHAVIOR CODE and SUMMARY STAGE confict"
8 I BCOD=3,SSTI=0 D D ERRMSG
9 .S MSG(1)="BEHAVIOR CODE = 3 (Malignant)"
10 .S MSG(2)="SUMMARY STAGE = 0 (In situ)"
11 .S MSG(3)="BEHAVIOR CODE and SUMMARY STAGE confict"
12 K MSG
13 ;
14IF14 I $$LEUKEMIA^ONCOAIP2(PRM),TRSI'=7,SSTI'=7 D D ERRMSG
15 .S MSG(1)="HISTOLOGY = "_HSTE
16 .S MSG(2)="TYPE OF REPORTING SOURCE = "_TRSI_" ("_TRSE_")"
17 .S MSG(3)="SUMMARY STAGE must be 7 (Distant Mets/systemic disease)"
18 K MSG
19 ;
20IF1718 S HST4=$E(HSTI,1,4)
21 S GRDI=$$GET1^DIQ(165.5,PRM,24,"I") ;GRADE/DIFF/CELL TYPE
22 S GRDE=$$GET1^DIQ(165.5,PRM,24,"E")
23 I ((HST4=8331)!(HST4=8851)!(HST4=9511)!(HST4=9693)),GRDI'=1 D D ERRMSG
24 .S MSG(1)="HISTOLOGY = "_HSTE
25 .S MSG(2)="GRADE/DIFF/CELL TYPE must be 1 (Grade I)"
26 I HST4=9083,GRDI'=2 D D ERRMSG
27 .S MSG(1)="HISTOLOGY = "_HSTE
28 .S MSG(2)="GRADE/DIFF/CELL TYPE must be 2 (Grade II)"
29 I ((HST4=8020)!(HST4=8021)!(HST4=9062)!(HST4=9082)!(HST4=9390)!(HST4=9401)!(HST4=9451)!(HST4=9512)),GRDI'=4 D D ERRMSG
30 .S MSG(1)="HISTOLOGY = "_HSTE
31 .S MSG(2)="GRADE/DIFF/CELL TYPE must be 4 (Grade IV)"
32 I (((DDXI<3010000)&(HST4=9696))!((DDXI>3001231)&(HST4=9695))),((GRDI'=3)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)) D D ERRMSG
33 .S MSG(1)="HISTOLOGY = "_HSTE
34 .S MSG(2)="GRADE/DIFF/CELL TYPE must be: 3 (Grade III)"
35 .S MSG(3)=" 5 (T-cell)"
36 .S MSG(4)=" 6 (B-cell)"
37 .S MSG(5)=" 7 (Null cell)"
38 I (((DDXI<3010000)&(HST4=9694))!((DDXI>3001231)&(HST4=9591))),((GRDI'=2)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)&(GRDI'=9)) D D ERRMSG
39 .S MSG(1)="HISTOLOGY = "_HSTE
40 .S MSG(2)="GRADE/DIFF/CELL TYPE must be: 2 (Grade II)"
41 .S MSG(3)=" 5 (T-cell)"
42 .S MSG(4)=" 6 (B-cell)"
43 .S MSG(5)=" 7 (Null cell)"
44 .S MSG(6)=" 9 (Unknown)"
45 I (((DDXI<3010000)&(HST4=9683))!((DDXI>3001231)&(HST4=9680))),((GRDI'=4)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)) D D ERRMSG
46 .S MSG(1)="HISTOLOGY = "_HSTE
47 .S MSG(2)="GRADE/DIFF/CELL TYPE must be: 4 (Grade IV)"
48 .S MSG(3)=" 5 (T-cell)"
49 .S MSG(4)=" 6 (B-cell)"
50 .S MSG(5)=" 7 (Null cell)"
51IF19 I ((GRDI=5)!(GRDI=6)!(GRDI=7)!(GRDI=8)),((HST4<9590)!(HST4>9948)) D D ERRMSG
52 .S MSG(1)="GRADE/DIFF/CELL TYPE = "_GRDI_" ("_GRDE_")"
53 .S MSG(2)="HISTOLOGY must be leukemia or lymphoma (9590-9948)"
54 K MSG,HST4,GRDI,GRDE
55 ;
56IF20 I ($E(HSTI,1,3)>958)&($E(HSTI,1,3)<973),SSTI="" D D ERRMSG
57 .S MSG(1)="No TNM classification is available for LYMPHOMA"
58 .S MSG(2)="SUMMARY STAGE cannot be blank"
59 I HSTI=91403,SSTI="" D D ERRMSG
60 .S MSG(1)="No TNM classification is available for KAPOSI'S SAROMA"
61 .S MSG(2)="SUMMARY STAGE cannot be blank"
62 K MSG
63 ;
64IF21 S EXTE=$$GET1^DIQ(165.5,PRM,30,"E") ;EXTENSION
65 I BCOD=3,$E(EXTE,1,2)="00" D D ERRMSG
66 .S MSG(1)="BEHAVIOR CODE = 3 (Malignant)"
67 .S MSG(2)="EXTENSION may not be 00 (In situ)"
68 K MSG,EXTE
69 ;
70IF22 S PEXI=$$GET1^DIQ(165.5,PRM,30.1,"I") ;PATHOLOGIC EXTENSION
71 S PEXE=$$GET1^DIQ(165.5,PRM,30.1,"E")
72 I PEXI'="",PEXI'=99,TOPI'=67619 D D ERRMSG
73 .S MSG(1)="PRIMARY SITE = "_TOPE
74 .S MSG(2)="PATHOLGIC EXTENSION = "_PEXE
75 .S MSG(3)="PATHOLOGIC EXTENSION may only be coded for PROSTATE (C61.9) cases"
76 K MSG,PEXI,PEXE
77 ;
78IF24 S LYMP=$$GET1^DIQ(165.5,PRM,31,"I") ;LYMPH NODES
79 S NPRI=$$GET1^DIQ(165.5,PRM,32,"I") ;REGIONAL NODES POSITIVE
80 S NPRE=$$GET1^DIQ(165.5,PRM,32,"E")
81 I ((NPRI>0)&(NPRI<98)),LYMP=0 D D ERRMSG
82 .S MSG(1)="REGIONAL NODES POSITIVE = "_NPRE
83 .S MSG(2)="LYMPH NODES may not be 0 (No lymph nodes)"
84 K MSG,LYMP,NPRI,NPRE
85IF2A S NERI=$$GET1^DIQ(165.5,PRM,33,"I") ;REGIONAL NODES EXAMINED
86 S NPRI=$$GET1^DIQ(165.5,PRM,32,"I") ;REGIONAL NODES POSITIVE
87 S NERE=$$GET1^DIQ(165.5,PRM,33,"E")
88 I ((NERI=99)&(NPRI'=99)) D D ERRMSG
89 .S MSG(1)="REGIONAL NODES EXAMINED = 99 ("_NERE_")"
90 .S MSG(2)="REGIONAL NODES POSITIVE must be 99 (Unk if nodes + or -, NA)"
91 K MSG,NERI,NPRI,NERE
92 ;
93IF25 S HORI=$$GET1^DIQ(165.5,PRM,54.2,"I") ;HORMONE THERAPY
94 S HORE=$$GET1^DIQ(165.5,PRM,54.2,"E")
95 I ((HORI=2)!(HORI=3)),((TOPI'=67619)&($E(TOPI,3,4)'=50)) D D ERRMSG
96 .S MSG(1)="PRIMARY SITE = "_TOPE
97 .S MSG(2)="HORMONE THERAPY = "_HORI_" ("_HORE_")"
98 .S MSG(3)="Only BREAST and PROSTATE cases may be coded as receiving"
99 .S MSG(4)="endocrine surgery or endocrine radiation"
100 K MSG,HORI,HORE
101 ;
102IF2627 S CDTH=$$GET1^DIQ(160,PTN,19) ;CAUSE OF DEATH
103 S SDC=$$GET1^DIQ(160,PTN,19.1) ;STATE DEATH CERT
104 S PDTH=$$GET1^DIQ(160,PTN,21) ;PLACE OF DEATH
105 I STAT="Dead",PDTH="" D D ERRMSG
106 .S MSG(1)="STATUS = "_STAT
107 .S MSG(2)="PLACE OF DEATH may not be blank"
108 I STAT="Dead",((CDTH="")&(SDC="")) D D ERRMSG
109 .S MSG(1)="STATUS = "_STAT
110 .S MSG(2)="CAUSE OF DEATH and STATE DEATH CERT may not both be blank"
111 K MSG,CDTH,SDC,PDTH
112 ;
113RACE S RACE1=$$GET1^DIQ(160,PTN,8) ;RACE 1
114 S RACE2=$$GET1^DIQ(160,PTN,8.1) ;RACE 2
115 S RACE3=$$GET1^DIQ(160,PTN,8.2) ;RACE 3
116 S RACE4=$$GET1^DIQ(160,PTN,8.3) ;RACE 4
117 S RACE5=$$GET1^DIQ(160,PTN,8.4) ;RACE 5
118 I RACE1="White",((RACE2'="NA")&(RACE2'="Unknown")&(RACE2'="")) D D ERRMSG
119 .S MSG(1)="RACE 1 = "_RACE1
120 .S MSG(2)="RACE 2 = "_RACE2
121 .S MSG(3)="RACE 3 = "_RACE3
122 .S MSG(4)="RACE 4 = "_RACE4
123 .S MSG(5)="RACE 5 = "_RACE5
124 .S MSG(6)="For race combinations RACE 1 may not be 'White'"
125 I (RACE1="")!(RACE2="")!(RACE3="")!(RACE4="")!(RACE5="") G RACEX
126 S RACE(RACE1)="" I ((RACE2'="NA")&(RACE2'="Unknown")),$D(RACE(RACE2)) D DUPRACE
127 S RACE(RACE2)="" I ((RACE3'="NA")&(RACE3'="Unknown")),$D(RACE(RACE3)) D DUPRACE
128 S RACE(RACE3)="" I ((RACE4'="NA")&(RACE4'="Unknown")),$D(RACE(RACE4)) D DUPRACE
129 S RACE(RACE4)="" I ((RACE5'="NA")&(RACE5'="Unknown")),$D(RACE(RACE5)) D DUPRACE
130 K MSG,RACE,RACE1,RACE2,RACE3,RACE4,RACE5
131 ;
132RACEX K BCOD,COCI,COCE,DDXI,DDXE,HSTI,HSTE,SSTI,SSTE,STAT,TOPI,TOPE,TRSI,TRSE
133 Q
134 ;
135DUPRACE S MSG(1)="RACE 1 = "_RACE1
136 S MSG(2)="RACE 2 = "_RACE2
137 S MSG(3)="RACE 3 = "_RACE3
138 S MSG(4)="RACE 4 = "_RACE4
139 S MSG(5)="RACE 5 = "_RACE5
140 S MSG(6)="A specific race code may not occur more than once"
141 D ERRMSG
142 Q
143 ;
144ERRMSG ;Error message
145 S CMPLT=0
146 W !," WARNING: "
147 S MSGSUB=0 F S MSGSUB=$O(MSG(MSGSUB)) Q:MSGSUB'>0 W ?10,MSG(MSGSUB),!
148 R Z:10
149 Q
Note: See TracBrowser for help on using the repository browser.