- 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 Jan 18, 2025@03:24:02 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