LEX2073I.m

LEX2073I ;ISL/KER - LEX*2.0*73 Post-Install - Missing 2 ;01/03/2011

 ;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10

 ;               

 ; External Global Variables

 ;    None

 ;               

 ; External References

 ;    FILE^DIE            ICR   2053

 ;    ^DIK                ICR  10013

 ;    IX1^DIK             ICR  10013

 ;    MES^XPDUTL          ICR  10141

 ;               

 Q

EN ; Main Entry Point

 D C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11

 Q

C1 ; 6110  100% Impairment of Auditory Acuity

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38207 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=304645

 S LEXMC=164275

 S LEXSO=6110

 S LEXSA=17

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871218

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2990610

 S LEXH2=LEXIN_U_"0"

 S LEXEP="100% Impairment of Auditory Acuity"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C2 ; 6206  Mastoiditis

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38208 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=74475

 S LEXSO=6206

 S LEXSA=17

 S LEXMC=15067

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2781001

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2990610

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Mastoiditis"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C3 ; 6250  Hearing Impaired

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38209 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=54601

 S LEXSO=6250

 S LEXSA=17

 S LEXMC=11225

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2781001

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2990610

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Hearing Impaired"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C4 ; 6521  Injuries to the Pharynx

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSM,LEXSO,LEXSR

 S DA=186736,DIK="^LEX(757," D:$D(^LEX(757,DA)) IX2^DIK

 S DA=336407,DIK="^LEX(757.01," D:$D(^LEX(757.01,DA)) IX2^DIK

 S DA=332225,DIK="^LEX(757.02," D:$D(^LEX(757.02,DA)) IX2^DIK

 S DA=263907,DIK="^LEX(757.1," D:$D(^LEX(757.1,DA)) IX2^DIK

 S ^LEX(757,186736,0)="336407^"

 S DA=186736,DIK="^LEX(757," D IX1^DIK

 S ^LEX(757.01,336407,0)="AJCC Breast Cancer Stage 0, Documented (ONC)"

 S ^LEX(757.01,336407,1)="186736^1^D^1"

 S DA=336407,DIK="^LEX(757.01," D IX1^DIK

 S ^LEX(757.02,332225,0)="336407^3370F^3^186736^1^^1"

 S ^LEX(757.02,332225,4,0)="^757.28D^1^1"

 S ^LEX(757.02,332225,4,1,0)="3081001^1"

 S DA=332225,DIK="^LEX(757.02," D IX1^DIK

 S ^LEX(757.1,263907,0)="186736^1^58"

 S DA=263907,DIK="^LEX(757.1," D IX1^DIK

 S LEXMC=187463

 S LEXEX=62862

 S LEXEP="Injuries to the Pharynx"

 S LEXSI=38210 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXSM=86570

 S DA=LEXMC,DIK="^LEX(757," D IX2^DIK

 S DA=LEXSM,DIK="^LEX(757.1," D IX2^DIK

 S DA=LEXMC,DIK="^LEX(757.001," D IX2^DIK

 S DA=LEXEX,DIK="^LEX(757.01," D IX2^DIK

 S ^LEX(757,LEXMC,0)=LEXEX_"^"

 S ^LEX(757.001,LEXMC,0)=LEXMC_"^1^1"

 S ^LEX(757.01,LEXEX,0)=LEXEP

 S ^LEX(757.01,LEXEX,1)=LEXMC_"^1^D^1"

 S ^LEX(757.1,LEXSM,0)=LEXMC_"^6^37"

 S DA=LEXMC,DIK="^LEX(757," D IX1^DIK

 S DA=LEXSM,DIK="^LEX(757.1," D IX1^DIK

 S DA=LEXMC,DIK="^LEX(757.001," D IX1^DIK

 S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 S LEXEX=62862

 S LEXSO=6521

 S LEXSA=17

 S LEXPF=1

 S LEXAF=""

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^1^1"

 S LEXAC=2961007

 S LEXH1=LEXAC_U_"1"

 S LEXSR=497

 S LEXCA=4

 S DA=LEXSI,DIK="^LEX(757.02," D IX2^DIK

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C5 ; 6801  Silicosis

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38211 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=110599

 S LEXSO=6801

 S LEXSA=17

 S LEXMC=22758

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871217

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2961007

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Silicosis"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C6 ; 6802  Pneumoconiosis

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38212 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=95539

 S LEXSO=6802

 S LEXSA=17

 S LEXMC=19707

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871217

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2961007

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Pneumoconiosis"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C7 ; 6803  Actinomycosis of the Lung

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38213 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=304682

 S LEXSO=6803

 S LEXSA=17

 S LEXMC=131074

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871217

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2961007

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Actinomycosis of the Lung"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C8 ; 6806  Sporotrichosis of the Lung

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38214 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=304685

 S LEXSO=6806

 S LEXSA=17

 S LEXMC=164297

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871217

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2961007

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Sporotrichosis of the Lung"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C9 ; 7810  Pinta

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38215 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=94491

 S LEXSO=7810

 S LEXSA=17

 S LEXMC=19487

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871217

 S LEXH1=LEXAC_U_"1"

 S LEXIN=3020517

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Pinta"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C10 ; 7916  Hyperpituitarism

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSM,LEXSO,LEXSR

 S LEXSI=38216 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=60242

 S LEXSO=7916

 S LEXSA=17

 S LEXMC=12310

 S LEXPF=1

 S LEXAF=""

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^1^1"

 S LEXAC=2960609

 S LEXH1=LEXAC_U_"1"

 S LEXEP="Hyperpituitarism"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

C11 ; 9206  Bipolar Psychosis

 N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 S LEXSI=38217 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK

 S LEXEX=14797

 S LEXSO=9206

 S LEXSA=17

 S LEXMC=3103

 S LEXPF=1

 S LEXAF=1

 S LEXPM=1

 S LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 S LEXHI="^757.28D^2^2"

 S LEXAC=2871217

 S LEXH1=LEXAC_U_"1"

 S LEXIN=2961107

 S LEXH2=LEXIN_U_"0"

 S LEXEP="Bipolar Psychosis"

 S LEXSR=497

 S LEXCA=4

 S ^LEX(757.02,LEXSI,0)=LEXSN

 S ^LEX(757.02,LEXSI,4,0)=LEXHI

 S ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 S ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 S DA=LEXSI,DIK="^LEX(757.02," D IX1^DIK

 K LEXFD S LEXIS=LEXEX_",",LEXFD(757.01,LEXIS,.01)=$G(LEXEP)

 D FILE^DIE("","LEXFD") S DA=LEXEX,DIK="^LEX(757.01," D IX1^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LEX2073I   11184     printed  Feb 18, 2025@23:30:51                                                                                                                                                                                                   Page 2

LEX2073I  ;ISL/KER - LEX*2.0*73 Post-Install - Missing 2 ;01/03/2011

 +1       ;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10

 +2       ;               

 +3       ; External Global Variables

 +4       ;    None

 +5       ;               

 +6       ; External References

 +7       ;    FILE^DIE            ICR   2053

 +8       ;    ^DIK                ICR  10013

 +9       ;    IX1^DIK             ICR  10013

 +10      ;    MES^XPDUTL          ICR  10141

 +11      ;               

 +12       QUIT 

EN        ; Main Entry Point

 +1        DO C1

           DO C2

           DO C3

           DO C4

           DO C5

           DO C6

           DO C7

           DO C8

           DO C9

           DO C10

           DO C11

 +2        QUIT 

C1        ; 6110  100% Impairment of Auditory Acuity

 +1        NEW DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 +2        SET LEXSI=38207

           IF $DATA(^LEX(757.02,+LEXSI,0))

               SET DA=LEXSI

               SET DIK="^LEX(757.02,"

               DO ^DIK

 +3        SET LEXEX=304645

 +4        SET LEXMC=164275

 +5        SET LEXSO=6110

 +6        SET LEXSA=17

 +7        SET LEXPF=1

 +8        SET LEXAF=1

 +9        SET LEXPM=1

 +10       SET LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 +11       SET LEXHI="^757.28D^2^2"

 +12       SET LEXAC=2871218

 +13       SET LEXH1=LEXAC_U_"1"

 +14       SET LEXIN=2990610

 +15       SET LEXH2=LEXIN_U_"0"

 +16       SET LEXEP="100% Impairment of Auditory Acuity"

 +17       SET LEXSR=497

 +18       SET LEXCA=4

 +19       SET ^LEX(757.02,LEXSI,0)=LEXSN

 +20       SET ^LEX(757.02,LEXSI,4,0)=LEXHI

 +21       SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 +22       SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 +23       SET DA=LEXSI

           SET DIK="^LEX(757.02,"

           DO IX1^DIK

 +24       KILL LEXFD

           SET LEXIS=LEXEX_","

           SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)

 +25       DO FILE^DIE("","LEXFD")

           SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +26       QUIT 

C2        ; 6206  Mastoiditis

 +1        NEW DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 +2        SET LEXSI=38208

           IF $DATA(^LEX(757.02,+LEXSI,0))

               SET DA=LEXSI

               SET DIK="^LEX(757.02,"

               DO ^DIK

 +3        SET LEXEX=74475

 +4        SET LEXSO=6206

 +5        SET LEXSA=17

 +6        SET LEXMC=15067

 +7        SET LEXPF=1

 +8        SET LEXAF=1

 +9        SET LEXPM=1

 +10       SET LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 +11       SET LEXHI="^757.28D^2^2"

 +12       SET LEXAC=2781001

 +13       SET LEXH1=LEXAC_U_"1"

 +14       SET LEXIN=2990610

 +15       SET LEXH2=LEXIN_U_"0"

 +16       SET LEXEP="Mastoiditis"

 +17       SET LEXSR=497

 +18       SET LEXCA=4

 +19       SET ^LEX(757.02,LEXSI,0)=LEXSN

 +20       SET ^LEX(757.02,LEXSI,4,0)=LEXHI

 +21       SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 +22       SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 +23       SET DA=LEXSI

           SET DIK="^LEX(757.02,"

           DO IX1^DIK

 +24       KILL LEXFD

           SET LEXIS=LEXEX_","

           SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)

 +25       DO FILE^DIE("","LEXFD")

           SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +26       QUIT 

C3        ; 6250  Hearing Impaired

 +1        NEW DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 +2        SET LEXSI=38209

           IF $DATA(^LEX(757.02,+LEXSI,0))

               SET DA=LEXSI

               SET DIK="^LEX(757.02,"

               DO ^DIK

 +3        SET LEXEX=54601

 +4        SET LEXSO=6250

 +5        SET LEXSA=17

 +6        SET LEXMC=11225

 +7        SET LEXPF=1

 +8        SET LEXAF=1

 +9        SET LEXPM=1

 +10       SET LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 +11       SET LEXHI="^757.28D^2^2"

 +12       SET LEXAC=2781001

 +13       SET LEXH1=LEXAC_U_"1"

 +14       SET LEXIN=2990610

 +15       SET LEXH2=LEXIN_U_"0"

 +16       SET LEXEP="Hearing Impaired"

 +17       SET LEXSR=497

 +18       SET LEXCA=4

 +19       SET ^LEX(757.02,LEXSI,0)=LEXSN

 +20       SET ^LEX(757.02,LEXSI,4,0)=LEXHI

 +21       SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 +22       SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 +23       SET DA=LEXSI

           SET DIK="^LEX(757.02,"

           DO IX1^DIK

 +24       KILL LEXFD

           SET LEXIS=LEXEX_","

           SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)

 +25       DO FILE^DIE("","LEXFD")

           SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +26       QUIT 

C4        ; 6521  Injuries to the Pharynx

 +1        NEW DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSM,LEXSO,LEXSR

 +2        SET DA=186736

           SET DIK="^LEX(757,"

           if $DATA(^LEX(757,DA))

               DO IX2^DIK

 +3        SET DA=336407

           SET DIK="^LEX(757.01,"

           if $DATA(^LEX(757.01,DA))

               DO IX2^DIK

 +4        SET DA=332225

           SET DIK="^LEX(757.02,"

           if $DATA(^LEX(757.02,DA))

               DO IX2^DIK

 +5        SET DA=263907

           SET DIK="^LEX(757.1,"

           if $DATA(^LEX(757.1,DA))

               DO IX2^DIK

 +6        SET ^LEX(757,186736,0)="336407^"

 +7        SET DA=186736

           SET DIK="^LEX(757,"

           DO IX1^DIK

 +8        SET ^LEX(757.01,336407,0)="AJCC Breast Cancer Stage 0, Documented (ONC)"

 +9        SET ^LEX(757.01,336407,1)="186736^1^D^1"

 +10       SET DA=336407

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +11       SET ^LEX(757.02,332225,0)="336407^3370F^3^186736^1^^1"

 +12       SET ^LEX(757.02,332225,4,0)="^757.28D^1^1"

 +13       SET ^LEX(757.02,332225,4,1,0)="3081001^1"

 +14       SET DA=332225

           SET DIK="^LEX(757.02,"

           DO IX1^DIK

 +15       SET ^LEX(757.1,263907,0)="186736^1^58"

 +16       SET DA=263907

           SET DIK="^LEX(757.1,"

           DO IX1^DIK

 +17       SET LEXMC=187463

 +18       SET LEXEX=62862

 +19       SET LEXEP="Injuries to the Pharynx"

 +20       SET LEXSI=38210

           IF $DATA(^LEX(757.02,+LEXSI,0))

               SET DA=LEXSI

               SET DIK="^LEX(757.02,"

               DO ^DIK

 +21       SET LEXSM=86570

 +22       SET DA=LEXMC

           SET DIK="^LEX(757,"

           DO IX2^DIK

 +23       SET DA=LEXSM

           SET DIK="^LEX(757.1,"

           DO IX2^DIK

 +24       SET DA=LEXMC

           SET DIK="^LEX(757.001,"

           DO IX2^DIK

 +25       SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX2^DIK

 +26       SET ^LEX(757,LEXMC,0)=LEXEX_"^"

 +27       SET ^LEX(757.001,LEXMC,0)=LEXMC_"^1^1"

 +28       SET ^LEX(757.01,LEXEX,0)=LEXEP

 +29       SET ^LEX(757.01,LEXEX,1)=LEXMC_"^1^D^1"

 +30       SET ^LEX(757.1,LEXSM,0)=LEXMC_"^6^37"

 +31       SET DA=LEXMC

           SET DIK="^LEX(757,"

           DO IX1^DIK

 +32       SET DA=LEXSM

           SET DIK="^LEX(757.1,"

           DO IX1^DIK

 +33       SET DA=LEXMC

           SET DIK="^LEX(757.001,"

           DO IX1^DIK

 +34       SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +35       SET LEXEX=62862

 +36       SET LEXSO=6521

 +37       SET LEXSA=17

 +38       SET LEXPF=1

 +39       SET LEXAF=""

 +40       SET LEXPM=1

 +41       SET LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 +42       SET LEXHI="^757.28D^1^1"

 +43       SET LEXAC=2961007

 +44       SET LEXH1=LEXAC_U_"1"

 +45       SET LEXSR=497

 +46       SET LEXCA=4

 +47       SET DA=LEXSI

           SET DIK="^LEX(757.02,"

           DO IX2^DIK

 +48       SET ^LEX(757.02,LEXSI,0)=LEXSN

 +49       SET ^LEX(757.02,LEXSI,4,0)=LEXHI

 +50       SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 +51       SET DA=LEXSI

           SET DIK="^LEX(757.02,"

           DO IX1^DIK

 +52       KILL LEXFD

           SET LEXIS=LEXEX_","

           SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)

 +53       DO FILE^DIE("","LEXFD")

           SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +54       QUIT 

C5        ; 6801  Silicosis

 +1        NEW DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 +2        SET LEXSI=38211

           IF $DATA(^LEX(757.02,+LEXSI,0))

               SET DA=LEXSI

               SET DIK="^LEX(757.02,"

               DO ^DIK

 +3        SET LEXEX=110599

 +4        SET LEXSO=6801

 +5        SET LEXSA=17

 +6        SET LEXMC=22758

 +7        SET LEXPF=1

 +8        SET LEXAF=1

 +9        SET LEXPM=1

 +10       SET LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM

 +11       SET LEXHI="^757.28D^2^2"

 +12       SET LEXAC=2871217

 +13       SET LEXH1=LEXAC_U_"1"

 +14       SET LEXIN=2961007

 +15       SET LEXH2=LEXIN_U_"0"

 +16       SET LEXEP="Silicosis"

 +17       SET LEXSR=497

 +18       SET LEXCA=4

 +19       SET ^LEX(757.02,LEXSI,0)=LEXSN

 +20       SET ^LEX(757.02,LEXSI,4,0)=LEXHI

 +21       SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1

 +22       SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2

 +23       SET DA=LEXSI

           SET DIK="^LEX(757.02,"

           DO IX1^DIK

 +24       KILL LEXFD

           SET LEXIS=LEXEX_","

           SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)

 +25       DO FILE^DIE("","LEXFD")

           SET DA=LEXEX

           SET DIK="^LEX(757.01,"

           DO IX1^DIK

 +26       QUIT 

C6        ; 6802  Pneumoconiosis

 +1        NEW DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR

 +2        SET LEXSI=38212

           IF $DATA(^LEX(757.02,+LEXSI,0))

               SET DA=LEXSI

               SET DIK="^LEX(757.02,"

               DO ^DIK

 +3        SET LEXEX=95539