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

LEX2073I.m

Go to the documentation of this file.
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