ONCEDIT2 ;HINES OIFO/GWB - ONCOLOGY INTERFIELD EDITS (continued);11/30/10
;;2.2;ONCOLOGY;**1,10,12,19**;Jul 31, 2013;Build 4
;
IF1213 I BCOD=2,SSTI'=0 D D ERRMSG
.S MSG(1)="BEHAVIOR CODE = 2 (In situ)"
.S MSG(2)="SUMMARY STAGE = "_SSTI_" ("_SSTE_")"
.S MSG(3)="BEHAVIOR CODE and SUMMARY STAGE confict"
I BCOD=3,SSTI=0 D D ERRMSG
.S MSG(1)="BEHAVIOR CODE = 3 (Malignant)"
.S MSG(2)="SUMMARY STAGE = 0 (In situ)"
.S MSG(3)="BEHAVIOR CODE and SUMMARY STAGE confict"
K MSG
;
IF14 I DTDX<3180000 I $$LEUKEMIA^ONCOAIP2(PRM),TRSI'=7,SSTI'=7 D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="TYPE OF REPORTING SOURCE = "_TRSI_" ("_TRSE_")"
.S MSG(3)="SUMMARY STAGE must be 7 (Distant Mets/systemic disease)"
K MSG
;
IF1718 S HST4=$E(HSTI,1,4)
S GRDI=$$GET1^DIQ(165.5,PRM,24,"I") ;GRADE/DIFF/CELL TYPE
S GRDE=$$GET1^DIQ(165.5,PRM,24,"E")
I DTDX<3180000,((HST4=8331)!(HST4=8851)!(HST4=9511)!(HST4=9693)),GRDI'=1 D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="GRADE/DIFF/CELL TYPE must be 1 (Grade I)"
I DTDX<3180000,HST4=9083,GRDI'=2 D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="GRADE/DIFF/CELL TYPE must be 2 (Grade II)"
I DTDX<3180000,((HST4=8020)!(HST4=8021)!(HST4=9062)!(HST4=9082)!(HST4=9390)!(HST4=9401)!(HST4=9451)!(HST4=9512)),GRDI'=4 D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="GRADE/DIFF/CELL TYPE must be 4 (Grade IV)"
I DTDX<3180000,(((DDXI<3010000)&(HST4=9696))!((DDXI>3001231)&(HST4=9695))),((GRDI'=3)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)) D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="GRADE/DIFF/CELL TYPE must be: 3 (Grade III)"
.S MSG(3)=" 5 (T-cell)"
.S MSG(4)=" 6 (B-cell)"
.S MSG(5)=" 7 (Null cell)"
I DTDX<3180000,(((DDXI<3010000)&(HST4=9694))!((DDXI>3001231)&(HST4=9591))),((GRDI'=2)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)&(GRDI'=9)) D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="GRADE/DIFF/CELL TYPE must be: 2 (Grade II)"
.S MSG(3)=" 5 (T-cell)"
.S MSG(4)=" 6 (B-cell)"
.S MSG(5)=" 7 (Null cell)"
.S MSG(6)=" 9 (Unknown)"
I DTDX<3180000,(((DDXI<3010000)&(HST4=9683))!((DDXI>3001231)&(HST4=9680))),((GRDI'=4)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)) D D ERRMSG
.S MSG(1)="HISTOLOGY = "_HSTE
.S MSG(2)="GRADE/DIFF/CELL TYPE must be: 4 (Grade IV)"
.S MSG(3)=" 5 (T-cell)"
.S MSG(4)=" 6 (B-cell)"
.S MSG(5)=" 7 (Null cell)"
IF19 I DTDX<3180000,((GRDI=5)!(GRDI=6)!(GRDI=7)!(GRDI=8)),((HST4<9590)!(HST4>9948)) D D ERRMSG
.S MSG(1)="GRADE/DIFF/CELL TYPE = "_GRDI_" ("_GRDE_")"
.S MSG(2)="HISTOLOGY must be leukemia or lymphoma (9590-9948)"
K MSG,HST4,GRDI,GRDE
;
IF20 I ($E(HSTI,1,3)>958)&($E(HSTI,1,3)<973),SSTI="" D D ERRMSG
.S MSG(1)="No TNM classification is available for LYMPHOMA"
.S MSG(2)="SUMMARY STAGE cannot be blank"
I HSTI=91403,SSTI="" D D ERRMSG
.S MSG(1)="No TNM classification is available for KAPOSI'S SAROMA"
.S MSG(2)="SUMMARY STAGE cannot be blank"
K MSG
;
IF21 S EXTE=$$GET1^DIQ(165.5,PRM,30,"E") ;EXTENSION
I BCOD=3,$E(EXTE,1,2)="00" D D ERRMSG
.S MSG(1)="BEHAVIOR CODE = 3 (Malignant)"
.S MSG(2)="EXTENSION may not be 00 (In situ)"
K MSG,EXTE
;
IF22 S PEXI=$$GET1^DIQ(165.5,PRM,30.1,"I") ;PATHOLOGIC EXTENSION
S PEXE=$$GET1^DIQ(165.5,PRM,30.1,"E")
I PEXI'="",PEXI'=99,TOPI'=67619 D D ERRMSG
.S MSG(1)="PRIMARY SITE = "_TOPE
.S MSG(2)="PATHOLGIC EXTENSION = "_PEXE
.S MSG(3)="PATHOLOGIC EXTENSION may only be coded for PROSTATE (C61.9) cases"
K MSG,PEXI,PEXE
;
IF24 S LYMP=$$GET1^DIQ(165.5,PRM,31,"I") ;LYMPH NODES
S NPRI=$$GET1^DIQ(165.5,PRM,32,"I") ;REGIONAL NODES POSITIVE
S NPRE=$$GET1^DIQ(165.5,PRM,32,"E")
I DTDX<3180000,((NPRI>0)&(NPRI<98)),LYMP=0 D D ERRMSG
.S MSG(1)="REGIONAL NODES POSITIVE = "_NPRE
.S MSG(2)="LYMPH NODES may not be 0 (No lymph nodes)"
K MSG,LYMP,NPRI,NPRE
IF2A S NERI=$$GET1^DIQ(165.5,PRM,33,"I") ;REGIONAL NODES EXAMINED
S NPRI=$$GET1^DIQ(165.5,PRM,32,"I") ;REGIONAL NODES POSITIVE
S NERE=$$GET1^DIQ(165.5,PRM,33,"E")
I ((NERI=99)&(NPRI'=99)) D D ERRMSG
.S MSG(1)="REGIONAL NODES EXAMINED = 99 ("_NERE_")"
.S MSG(2)="REGIONAL NODES POSITIVE must be 99 (Unk if nodes + or -, NA)"
K MSG,NERI,NPRI,NERE
;
IF25 S HORI=$$GET1^DIQ(165.5,PRM,54.2,"I") ;HORMONE THERAPY
S HORE=$$GET1^DIQ(165.5,PRM,54.2,"E")
I ((HORI=2)!(HORI=3)),((TOPI'=67619)&($E(TOPI,3,4)'=50)) D D ERRMSG
.S MSG(1)="PRIMARY SITE = "_TOPE
.S MSG(2)="HORMONE THERAPY = "_HORI_" ("_HORE_")"
.S MSG(3)="Only BREAST and PROSTATE cases may be coded as receiving"
.S MSG(4)="endocrine surgery or endocrine radiation"
K MSG,HORI,HORE
;
IF2627 S PDTH=$$GET1^DIQ(160,PTN,21) ;PLACE OF DEATH
I STAT="Dead",PDTH="" D D ERRMSG
.S MSG(1)="STATUS = "_STAT
.S MSG(2)="PLACE OF DEATH may not be blank"
K MSG,PDTH
;
RACE ;RACE
S RACE1=$$GET1^DIQ(160,PTN,8) ;RACE 1
S RACE2=$$GET1^DIQ(160,PTN,8.1) ;RACE 2
S RACE3=$$GET1^DIQ(160,PTN,8.2) ;RACE 3
S RACE4=$$GET1^DIQ(160,PTN,8.3) ;RACE 4
S RACE5=$$GET1^DIQ(160,PTN,8.4) ;RACE 5
;I RACE1="White",((RACE2'="NA")&(RACE2'="Unknown")&(RACE2'="")) D D ERRMSG
;.S MSG(1)="RACE 1 = "_RACE1
;.S MSG(2)="RACE 2 = "_RACE2
;.S MSG(3)="RACE 3 = "_RACE3
;.S MSG(4)="RACE 4 = "_RACE4
;.S MSG(5)="RACE 5 = "_RACE5
;.S MSG(6)="For race combinations RACE 1 may not be 'White'"
;I (RACE1="")!(RACE2="")!(RACE3="")!(RACE4="")!(RACE5="") G RACEX
;S RACE(RACE1)="" I ((RACE2'="NA")&(RACE2'="Unknown")),$D(RACE(RACE2)) D DUPRACE
;S RACE(RACE2)="" I ((RACE3'="NA")&(RACE3'="Unknown")),$D(RACE(RACE3)) D DUPRACE
;S RACE(RACE3)="" I ((RACE4'="NA")&(RACE4'="Unknown")),$D(RACE(RACE4)) D DUPRACE
;S RACE(RACE4)="" I ((RACE5'="NA")&(RACE5'="Unknown")),$D(RACE(RACE5)) D DUPRACE
K MSG,RACE,RACE1,RACE2,RACE3,RACE4,RACE5
;
RACEX K BCOD,COCI,COCE,DDXI,DDXE,HSTI,HSTE,SSTI,SSTE,STAT,TOPI,TOPE,TRSI,TRSE
Q
;
DUPRACE ;DUPLICATE RACE
;S MSG(1)="RACE 1 = "_RACE1
;S MSG(2)="RACE 2 = "_RACE2
;S MSG(3)="RACE 3 = "_RACE3
;S MSG(4)="RACE 4 = "_RACE4
;S MSG(5)="RACE 5 = "_RACE5
;S MSG(6)="A specific race code may not occur more than once"
;D ERRMSG
Q
;
ERRMSG ;Error message
S CMPLT=0
W !," WARNING: "
S MSGSUB=0 F S MSGSUB=$O(MSG(MSGSUB)) Q:MSGSUB'>0 W ?10,MSG(MSGSUB),!
R Z:10
Q
;
CLEANUP ;Cleanup
K CMPLT,MSGSUB,PRM,PTN,Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCEDIT2 6570 printed Dec 13, 2024@02:22:52 Page 2
ONCEDIT2 ;HINES OIFO/GWB - ONCOLOGY INTERFIELD EDITS (continued);11/30/10
+1 ;;2.2;ONCOLOGY;**1,10,12,19**;Jul 31, 2013;Build 4
+2 ;
IF1213 IF BCOD=2
IF SSTI'=0
Begin DoDot:1
+1 SET MSG(1)="BEHAVIOR CODE = 2 (In situ)"
+2 SET MSG(2)="SUMMARY STAGE = "_SSTI_" ("_SSTE_")"
+3 SET MSG(3)="BEHAVIOR CODE and SUMMARY STAGE confict"
End DoDot:1
DO ERRMSG
+4 IF BCOD=3
IF SSTI=0
Begin DoDot:1
+5 SET MSG(1)="BEHAVIOR CODE = 3 (Malignant)"
+6 SET MSG(2)="SUMMARY STAGE = 0 (In situ)"
+7 SET MSG(3)="BEHAVIOR CODE and SUMMARY STAGE confict"
End DoDot:1
DO ERRMSG
+8 KILL MSG
+9 ;
IF14 IF DTDX<3180000
IF $$LEUKEMIA^ONCOAIP2(PRM)
IF TRSI'=7
IF SSTI'=7
Begin DoDot:1
+1 SET MSG(1)="HISTOLOGY = "_HSTE
+2 SET MSG(2)="TYPE OF REPORTING SOURCE = "_TRSI_" ("_TRSE_")"
+3 SET MSG(3)="SUMMARY STAGE must be 7 (Distant Mets/systemic disease)"
End DoDot:1
DO ERRMSG
+4 KILL MSG
+5 ;
IF1718 SET HST4=$EXTRACT(HSTI,1,4)
+1 ;GRADE/DIFF/CELL TYPE
SET GRDI=$$GET1^DIQ(165.5,PRM,24,"I")
+2 SET GRDE=$$GET1^DIQ(165.5,PRM,24,"E")
+3 IF DTDX<3180000
IF ((HST4=8331)!(HST4=8851)!(HST4=9511)!(HST4=9693))
IF GRDI'=1
Begin DoDot:1
+4 SET MSG(1)="HISTOLOGY = "_HSTE
+5 SET MSG(2)="GRADE/DIFF/CELL TYPE must be 1 (Grade I)"
End DoDot:1
DO ERRMSG
+6 IF DTDX<3180000
IF HST4=9083
IF GRDI'=2
Begin DoDot:1
+7 SET MSG(1)="HISTOLOGY = "_HSTE
+8 SET MSG(2)="GRADE/DIFF/CELL TYPE must be 2 (Grade II)"
End DoDot:1
DO ERRMSG
+9 IF DTDX<3180000
IF ((HST4=8020)!(HST4=8021)!(HST4=9062)!(HST4=9082)!(HST4=9390)!(HST4=9401)!(HST4=9451)!(HST4=9512))
IF GRDI'=4
Begin DoDot:1
+10 SET MSG(1)="HISTOLOGY = "_HSTE
+11 SET MSG(2)="GRADE/DIFF/CELL TYPE must be 4 (Grade IV)"
End DoDot:1
DO ERRMSG
+12 IF DTDX<3180000
IF (((DDXI<3010000)&(HST4=9696))!((DDXI>3001231)&(HST4=9695)))
IF ((GRDI'=3)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7))
Begin DoDot:1
+13 SET MSG(1)="HISTOLOGY = "_HSTE
+14 SET MSG(2)="GRADE/DIFF/CELL TYPE must be: 3 (Grade III)"
+15 SET MSG(3)=" 5 (T-cell)"
+16 SET MSG(4)=" 6 (B-cell)"
+17 SET MSG(5)=" 7 (Null cell)"
End DoDot:1
DO ERRMSG
+18 IF DTDX<3180000
IF (((DDXI<3010000)&(HST4=9694))!((DDXI>3001231)&(HST4=9591)))
IF ((GRDI'=2)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7)&(GRDI'=9))
Begin DoDot:1
+19 SET MSG(1)="HISTOLOGY = "_HSTE
+20 SET MSG(2)="GRADE/DIFF/CELL TYPE must be: 2 (Grade II)"
+21 SET MSG(3)=" 5 (T-cell)"
+22 SET MSG(4)=" 6 (B-cell)"
+23 SET MSG(5)=" 7 (Null cell)"
+24 SET MSG(6)=" 9 (Unknown)"
End DoDot:1
DO ERRMSG
+25 IF DTDX<3180000
IF (((DDXI<3010000)&(HST4=9683))!((DDXI>3001231)&(HST4=9680)))
IF ((GRDI'=4)&(GRDI'=5)&(GRDI'=6)&(GRDI'=7))
Begin DoDot:1
+26 SET MSG(1)="HISTOLOGY = "_HSTE
+27 SET MSG(2)="GRADE/DIFF/CELL TYPE must be: 4 (Grade IV)"
+28 SET MSG(3)=" 5 (T-cell)"
+29 SET MSG(4)=" 6 (B-cell)"
+30 SET MSG(5)=" 7 (Null cell)"
End DoDot:1
DO ERRMSG
IF19 IF DTDX<3180000
IF ((GRDI=5)!(GRDI=6)!(GRDI=7)!(GRDI=8))
IF ((HST4<9590)!(HST4>9948))
Begin DoDot:1
+1 SET MSG(1)="GRADE/DIFF/CELL TYPE = "_GRDI_" ("_GRDE_")"
+2 SET MSG(2)="HISTOLOGY must be leukemia or lymphoma (9590-9948)"
End DoDot:1
DO ERRMSG
+3 KILL MSG,HST4,GRDI,GRDE
+4 ;
IF20 IF ($EXTRACT(HSTI,1,3)>958)&($EXTRACT(HSTI,1,3)<973)
IF SSTI=""
Begin DoDot:1
+1 SET MSG(1)="No TNM classification is available for LYMPHOMA"
+2 SET MSG(2)="SUMMARY STAGE cannot be blank"
End DoDot:1
DO ERRMSG
+3 IF HSTI=91403
IF SSTI=""
Begin DoDot:1
+4 SET MSG(1)="No TNM classification is available for KAPOSI'S SAROMA"
+5 SET MSG(2)="SUMMARY STAGE cannot be blank"
End DoDot:1
DO ERRMSG
+6 KILL MSG
+7 ;
IF21 ;EXTENSION
SET EXTE=$$GET1^DIQ(165.5,PRM,30,"E")
+1 IF BCOD=3
IF $EXTRACT(EXTE,1,2)="00"
Begin DoDot:1
+2 SET MSG(1)="BEHAVIOR CODE = 3 (Malignant)"
+3 SET MSG(2)="EXTENSION may not be 00 (In situ)"
End DoDot:1
DO ERRMSG
+4 KILL MSG,EXTE
+5 ;
IF22 ;PATHOLOGIC EXTENSION
SET PEXI=$$GET1^DIQ(165.5,PRM,30.1,"I")
+1 SET PEXE=$$GET1^DIQ(165.5,PRM,30.1,"E")
+2 IF PEXI'=""
IF PEXI'=99
IF TOPI'=67619
Begin DoDot:1
+3 SET MSG(1)="PRIMARY SITE = "_TOPE
+4 SET MSG(2)="PATHOLGIC EXTENSION = "_PEXE
+5 SET MSG(3)="PATHOLOGIC EXTENSION may only be coded for PROSTATE (C61.9) cases"
End DoDot:1
DO ERRMSG
+6 KILL MSG,PEXI,PEXE
+7 ;
IF24 ;LYMPH NODES
SET LYMP=$$GET1^DIQ(165.5,PRM,31,"I")
+1 ;REGIONAL NODES POSITIVE
SET NPRI=$$GET1^DIQ(165.5,PRM,32,"I")
+2 SET NPRE=$$GET1^DIQ(165.5,PRM,32,"E")
+3 IF DTDX<3180000
IF ((NPRI>0)&(NPRI<98))
IF LYMP=0
Begin DoDot:1
+4 SET MSG(1)="REGIONAL NODES POSITIVE = "_NPRE
+5 SET MSG(2)="LYMPH NODES may not be 0 (No lymph nodes)"
End DoDot:1
DO ERRMSG
+6 KILL MSG,LYMP,NPRI,NPRE
IF2A ;REGIONAL NODES EXAMINED
SET NERI=$$GET1^DIQ(165.5,PRM,33,"I")
+1 ;REGIONAL NODES POSITIVE
SET NPRI=$$GET1^DIQ(165.5,PRM,32,"I")
+2 SET NERE=$$GET1^DIQ(165.5,PRM,33,"E")
+3 IF ((NERI=99)&(NPRI'=99))
Begin DoDot:1
+4 SET MSG(1)="REGIONAL NODES EXAMINED = 99 ("_NERE_")"
+5 SET MSG(2)="REGIONAL NODES POSITIVE must be 99 (Unk if nodes + or -, NA)"
End DoDot:1
DO ERRMSG
+6 KILL MSG,NERI,NPRI,NERE
+7 ;
IF25 ;HORMONE THERAPY
SET HORI=$$GET1^DIQ(165.5,PRM,54.2,"I")
+1 SET HORE=$$GET1^DIQ(165.5,PRM,54.2,"E")
+2 IF ((HORI=2)!(HORI=3))
IF ((TOPI'=67619)&($EXTRACT(TOPI,3,4)'=50))
Begin DoDot:1
+3 SET MSG(1)="PRIMARY SITE = "_TOPE
+4 SET MSG(2)="HORMONE THERAPY = "_HORI_" ("_HORE_")"
+5 SET MSG(3)="Only BREAST and PROSTATE cases may be coded as receiving"
+6 SET MSG(4)="endocrine surgery or endocrine radiation"
End DoDot:1
DO ERRMSG
+7 KILL MSG,HORI,HORE
+8 ;
IF2627 ;PLACE OF DEATH
SET PDTH=$$GET1^DIQ(160,PTN,21)
+1 IF STAT="Dead"
IF PDTH=""
Begin DoDot:1
+2 SET MSG(1)="STATUS = "_STAT
+3 SET MSG(2)="PLACE OF DEATH may not be blank"
End DoDot:1
DO ERRMSG
+4 KILL MSG,PDTH
+5 ;
RACE ;RACE
+1 ;RACE 1
SET RACE1=$$GET1^DIQ(160,PTN,8)
+2 ;RACE 2
SET RACE2=$$GET1^DIQ(160,PTN,8.1)
+3 ;RACE 3
SET RACE3=$$GET1^DIQ(160,PTN,8.2)
+4 ;RACE 4
SET RACE4=$$GET1^DIQ(160,PTN,8.3)
+5 ;RACE 5
SET RACE5=$$GET1^DIQ(160,PTN,8.4)
+6 ;I RACE1="White",((RACE2'="NA")&(RACE2'="Unknown")&(RACE2'="")) D D ERRMSG
+7 ;.S MSG(1)="RACE 1 = "_RACE1
+8 ;.S MSG(2)="RACE 2 = "_RACE2
+9 ;.S MSG(3)="RACE 3 = "_RACE3
+10 ;.S MSG(4)="RACE 4 = "_RACE4
+11 ;.S MSG(5)="RACE 5 = "_RACE5
+12 ;.S MSG(6)="For race combinations RACE 1 may not be 'White'"
+13 ;I (RACE1="")!(RACE2="")!(RACE3="")!(RACE4="")!(RACE5="") G RACEX
+14 ;S RACE(RACE1)="" I ((RACE2'="NA")&(RACE2'="Unknown")),$D(RACE(RACE2)) D DUPRACE
+15 ;S RACE(RACE2)="" I ((RACE3'="NA")&(RACE3'="Unknown")),$D(RACE(RACE3)) D DUPRACE
+16 ;S RACE(RACE3)="" I ((RACE4'="NA")&(RACE4'="Unknown")),$D(RACE(RACE4)) D DUPRACE
+17 ;S RACE(RACE4)="" I ((RACE5'="NA")&(RACE5'="Unknown")),$D(RACE(RACE5)) D DUPRACE
+18 KILL MSG,RACE,RACE1,RACE2,RACE3,RACE4,RACE5
+19 ;
RACEX KILL BCOD,COCI,COCE,DDXI,DDXE,HSTI,HSTE,SSTI,SSTE,STAT,TOPI,TOPE,TRSI,TRSE
+1 QUIT
+2 ;
DUPRACE ;DUPLICATE RACE
+1 ;S MSG(1)="RACE 1 = "_RACE1
+2 ;S MSG(2)="RACE 2 = "_RACE2
+3 ;S MSG(3)="RACE 3 = "_RACE3
+4 ;S MSG(4)="RACE 4 = "_RACE4
+5 ;S MSG(5)="RACE 5 = "_RACE5
+6 ;S MSG(6)="A specific race code may not occur more than once"
+7 ;D ERRMSG
+8 QUIT
+9 ;
ERRMSG ;Error message
+1 SET CMPLT=0
+2 WRITE !," WARNING: "
+3 SET MSGSUB=0
FOR
SET MSGSUB=$ORDER(MSG(MSGSUB))
if MSGSUB'>0
QUIT
WRITE ?10,MSG(MSGSUB),!
+4 READ Z:10
+5 QUIT
+6 ;
CLEANUP ;Cleanup
+1 KILL CMPLT,MSGSUB,PRM,PTN,Z
