LEX2073K ;ISL/KER - LEX*2.0*73 Post-Install - Categories ;01/03/2011
;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10
;
; External Global Variables
; None
;
; External References
; ^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
Q
C1 ; 6296 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=38230 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304635
S LEXMC=164265
S LEXSO=6296
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
C2 ; 6289 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=38231 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304637
S LEXMC=164267
S LEXSO=6289
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=2811001
S LEXH1=LEXAC_U_"1"
S LEXIN=2830101
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
C3 ; 6291 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=38232 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304636
S LEXMC=164266
S LEXSO=6291
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=2811001
S LEXH1=LEXAC_U_"1"
S LEXIN=2830101
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
C4 ; 6297 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=38233 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304635
S LEXMC=164265
S LEXSO=6297
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=2811001
S LEXH1=LEXAC_U_"1"
S LEXIN=2830101
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 ; 6290 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=38234 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304637
S LEXMC=164267
S LEXSO=6290
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=2831001
S LEXH1=LEXAC_U_"1"
S LEXIN=2850101
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 ; 6293 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=38235 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304636
S LEXMC=164266
S LEXSO=6293
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=2831001
S LEXH1=LEXAC_U_"1"
S LEXIN=2850101
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 ; 6292 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=38236 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304637
S LEXMC=164267
S LEXSO=6292
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=2831001
S LEXH1=LEXAC_U_"1"
S LEXIN=2850101
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 ; 6295 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=38237 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304636
S LEXMC=164266
S LEXSO=6295
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=2831001
S LEXH1=LEXAC_U_"1"
S LEXIN=2850101
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 ; Fix 202 Dates
S DA=3564,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,3564,0)="1044^8405^17^1161^1^^1"
S ^LEX(757.02,3564,4,0)="^757.28D^1^1",^LEX(757.02,3564,4,1,0)="3020818^1"
S DA=3564,DIK="^LEX(757.02," D IX1^DIK
S DA=3565,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,3565,0)="1046^8407^17^1162^1^^1"
S ^LEX(757.02,3565,4,0)="^757.28D^1^1",^LEX(757.02,3565,4,1,0)="3020818^1"
S DA=3565,DIK="^LEX(757.02," D IX1^DIK
Q
C10 ; Fix Title 38 8100
S DA=317887,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,317887,0)="55512^8100^17^11385^1^^0"
S ^LEX(757.02,317887,4,0)="^757.28D^1^1",^LEX(757.02,317887,4,1,0)="2960923^1"
S DA=317887,DIK="^LEX(757.02," D IX1^DIK
S DA=317923,DIK="^LEX(757.02," D ^DIK S ^LEX(757.02,317923,0)="55512^346.90^1^11385^0^^0"
S ^LEX(757.02,317923,4,0)="^757.28D^1^1",^LEX(757.02,317923,4,1,0)="2781001^1"
S DA=317923,DIK="^LEX(757.02," D IX1^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2073K 6922 printed Dec 13, 2024@02:04:50 Page 2
LEX2073K ;ISL/KER - LEX*2.0*73 Post-Install - Categories ;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 ; ^DIK ICR 10013
+8 ; IX1^DIK ICR 10013
+9 ; MES^XPDUTL ICR 10141
+10 ;
+11 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
+2 QUIT
C1 ; 6296 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=38230
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=6296
+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
C2 ; 6289 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=38231
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=6289
+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=2811001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2830101
+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
C3 ; 6291 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=38232
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=6291
+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=2811001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2830101
+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
C4 ; 6297 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=38233
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=6297
+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=2811001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2830101
+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 ; 6290 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=38234
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=6290
+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=2831001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2850101
+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 ; 6293 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=38235
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=6293
+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=2831001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2850101
+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 ; 6292 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=38236
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=6292
+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=2831001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2850101
+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 ; 6295 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=38237
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=6295
+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=2831001
+13 SET LEXH1=LEXAC_U_"1"
+14 SET LEXIN=2850101
+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 ; Fix 202 Dates
+1 SET DA=3564
SET DIK="^LEX(757.02,"
DO ^DIK
SET ^LEX(757.02,3564,0)="1044^8405^17^1161^1^^1"
+2 SET ^LEX(757.02,3564,4,0)="^757.28D^1^1"
SET ^LEX(757.02,3564,4,1,0)="3020818^1"
+3 SET DA=3564
SET DIK="^LEX(757.02,"
DO IX1^DIK
+4 SET DA=3565
SET DIK="^LEX(757.02,"
DO ^DIK
SET ^LEX(757.02,3565,0)="1046^8407^17^1162^1^^1"
+5 SET ^LEX(757.02,3565,4,0)="^757.28D^1^1"
SET ^LEX(757.02,3565,4,1,0)="3020818^1"
+6 SET DA=3565
SET DIK="^LEX(757.02,"
DO IX1^DIK
+7 QUIT
C10 ; Fix Title 38 8100
+1 SET DA=317887
SET DIK="^LEX(757.02,"
DO ^DIK
SET ^LEX(757.02,317887,0)="55512^8100^17^11385^1^^0"
+2 SET ^LEX(757.02,317887,4,0)="^757.28D^1^1"
SET ^LEX(757.02,317887,4,1,0)="2960923^1"
+3 SET DA=317887
SET DIK="^LEX(757.02,"
DO IX1^DIK
+4 SET DA=317923
SET DIK="^LEX(757.02,"
DO ^DIK
SET ^LEX(757.02,317923,0)="55512^346.90^1^11385^0^^0"
+5 SET ^LEX(757.02,317923,4,0)="^757.28D^1^1"
SET ^LEX(757.02,317923,4,1,0)="2781001^1"
+6 SET DA=317923
SET DIK="^LEX(757.02,"
DO IX1^DIK
+7 QUIT
