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 ---[H[J[2J[HLEX2073I 11184 printed Oct 16, 2024@18:05:30 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
+4 SET LEXSO=6802
+5 SET LEXSA=17
+6 SET LEXMC=19707
+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="Pneumoconiosis"
+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
C7 ; 6803 Actinomycosis of the Lung
+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=38213
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304682
+4 SET LEXSO=6803
+5 SET LEXSA=17
+6 SET LEXMC=131074
+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="Actinomycosis of the Lung"
+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
C8 ; 6806 Sporotrichosis of the Lung
+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=38214
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304685
+4 SET LEXSO=6806
+5 SET LEXSA=17
+6 SET LEXMC=164297
+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="Sporotrichosis of the Lung"
+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
C9 ; 7810 Pinta
+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=38215
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=94491
+4 SET LEXSO=7810
+5 SET LEXSA=17
+6 SET LEXMC=19487
+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=3020517
+15 SET LEXH2=LEXIN_U_"0"
+16 SET LEXEP="Pinta"
+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
C10 ; 7916 Hyperpituitarism
+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 LEXSI=38216
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=60242
+4 SET LEXSO=7916
+5 SET LEXSA=17
+6 SET LEXMC=12310
+7 SET LEXPF=1
+8 SET LEXAF=""
+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^1^1"
+12 SET LEXAC=2960609
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXEP="Hyperpituitarism"
+15 SET LEXSR=497
+16 SET LEXCA=4
+17 SET ^LEX(757.02,LEXSI,0)=LEXSN
+18 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+19 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 KILL LEXFD
SET LEXIS=LEXEX_","
SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)
+22 DO FILE^DIE("","LEXFD")
SET DA=LEXEX
SET DIK="^LEX(757.01,"
DO IX1^DIK
+23 QUIT
C11 ; 9206 Bipolar Psychosis
+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=38217
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=14797
+4 SET LEXSO=9206
+5 SET LEXSA=17
+6 SET LEXMC=3103
+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=2961107
+15 SET LEXH2=LEXIN_U_"0"
+16 SET LEXEP="Bipolar Psychosis"
+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
