Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCEDIT2

ONCEDIT2.m

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