LEX2073J ;ISL/KER - LEX*2.0*73 Post-Install - Missing 3 ;01/03/2011
;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10
;
; 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,C12
Q
C1 ; 9207 Major Depression with Psychotic Features
N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR
S LEXSI=38218 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=186652
S LEXSO=9207
S LEXSA=17
S LEXMC=63686
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="Major Depression with Psychotic Features"
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 ; 9402 Neurosis, Conversion Disorder
N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR
S LEXSI=38219 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=28140
S LEXSO=9402
S LEXSA=17
S LEXMC=5895
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="Neurosis, Conversion Disorder"
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 ; 9405 Neurosis, Dysthymic Disorder
N DA,DIK,LEXAC,LEXAF,LEXCA,LEXEX,LEXEP,LEXFD,LEXH1,LEXH2,LEXHI,LEXIN,LEXIS,LEXMC,LEXPF,LEXPM,LEXSA,LEXSI,LEXSN,LEXSO,LEXSR
S LEXSI=38220 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=32958
S LEXSO=9405
S LEXSA=17
S LEXMC=6869
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="Neurosis, Dysthymic Disorder"
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 ; 6277 80% 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=38221 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304643
S LEXMC=164273
S LEXSO=6277
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=2781001
S LEXH1=LEXAC_U_"1"
S LEXIN=2790101
S LEXH2=LEXIN_U_"0"
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
Q
C5 ; 6278 60% 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=38222 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304641
S LEXMC=164271
S LEXSO=6278
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=2781001
S LEXH1=LEXAC_U_"1"
S LEXIN=2790101
S LEXH2=LEXIN_U_"0"
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
Q
C6 ; 6284 40% 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=38223 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304639
S LEXMC=164269
S LEXSO=6284
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=2781001
S LEXH1=LEXAC_U_"1"
S LEXIN=2790101
S LEXH2=LEXIN_U_"0"
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
Q
C7 ; 6281 20% 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=38224 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304637
S LEXMC=164267
S LEXSO=6281
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=2781001
S LEXH1=LEXAC_U_"1"
S LEXIN=2790101
S LEXH2=LEXIN_U_"0"
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
Q
C8 ; 6282 10% 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=38225 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304636
S LEXMC=164266
S LEXSO=6282
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=2781001
S LEXH1=LEXAC_U_"1"
S LEXIN=2790101
S LEXH2=LEXIN_U_"0"
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
Q
C9 ; 6294 0% 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=38226 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304635
S LEXMC=164265
S LEXSO=6294
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=2781001
S LEXH1=LEXAC_U_"1"
S LEXIN=2790101
S LEXH2=LEXIN_U_"0"
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
Q
C10 ; 6288 40% 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=38227 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304639
S LEXMC=164269
S LEXSO=6288
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=2791001
S LEXH1=LEXAC_U_"1"
S LEXIN=2810101
S LEXH2=LEXIN_U_"0"
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
Q
C11 ; 6286 20% 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=38228 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304637
S LEXMC=164267
S LEXSO=6286
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=2791001
S LEXH1=LEXAC_U_"1"
S LEXIN=2810101
S LEXH2=LEXIN_U_"0"
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
Q
C12 ; 6287 10% 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=38229 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304636
S LEXMC=164266
S LEXSO=6287
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=2791001
S LEXH1=LEXAC_U_"1"
S LEXIN=2810101
S LEXH2=LEXIN_U_"0"
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2073J 9449 printed Oct 16, 2024@18:05:31 Page 2
LEX2073J ;ISL/KER - LEX*2.0*73 Post-Install - Missing 3 ;01/03/2011
+1 ;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10
+2 ;
+3 ; 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
DO C12
+2 QUIT
C1 ; 9207 Major Depression with Psychotic Features
+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=38218
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=186652
+4 SET LEXSO=9207
+5 SET LEXSA=17
+6 SET LEXMC=63686
+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="Major Depression with Psychotic Features"
+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 ; 9402 Neurosis, Conversion Disorder
+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=38219
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=28140
+4 SET LEXSO=9402
+5 SET LEXSA=17
+6 SET LEXMC=5895
+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="Neurosis, Conversion Disorder"
+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 ; 9405 Neurosis, Dysthymic Disorder
+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=38220
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=32958
+4 SET LEXSO=9405
+5 SET LEXSA=17
+6 SET LEXMC=6869
+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="Neurosis, Dysthymic Disorder"
+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 ; 6277 80% 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=38221
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304643
+4 SET LEXMC=164273
+5 SET LEXSO=6277
+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=2781001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2790101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C5 ; 6278 60% 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=38222
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304641
+4 SET LEXMC=164271
+5 SET LEXSO=6278
+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=2781001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2790101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C6 ; 6284 40% 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=38223
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304639
+4 SET LEXMC=164269
+5 SET LEXSO=6284
+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=2781001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2790101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C7 ; 6281 20% 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=38224
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304637
+4 SET LEXMC=164267
+5 SET LEXSO=6281
+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=2781001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2790101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C8 ; 6282 10% 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=38225
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304636
+4 SET LEXMC=164266
+5 SET LEXSO=6282
+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=2781001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2790101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C9 ; 6294 0% 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=38226
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304635
+4 SET LEXMC=164265
+5 SET LEXSO=6294
+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=2781001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2790101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C10 ; 6288 40% 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=38227
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304639
+4 SET LEXMC=164269
+5 SET LEXSO=6288
+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=2791001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2810101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C11 ; 6286 20% 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=38228
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304637
+4 SET LEXMC=164267
+5 SET LEXSO=6286
+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=2791001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2810101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
C12 ; 6287 10% 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=38229
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304636
+4 SET LEXMC=164266
+5 SET LEXSO=6287
+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=2791001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2810101
+15 SET LEXH2=LEXIN_U_"0"
+16 SET ^LEX(757.02,LEXSI,0)=LEXSN
+17 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+18 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+19 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+20 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+21 QUIT
