LEX2073H ;ISL/KER - LEX*2.0*73 Post-Install - Missing 1 ;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 ; Inactivate code 5295
N ACT,AF,EX,EXP,INA,LD,LH,LN,MC,PF,PM,SA,SI,SO
S SI=3421,EX=12249,SO=5295,SA=17,MC=2525,PF=1,AF=1,PM=1,EXP="Back Strain",ACT=3020701,INA=3030926
S LD=$O(^LEX(757.02,SI,4,"B"," "),-1),LH=$O(^LEX(757.02,SI,4,"B",+LD," "),-1),LN=$G(^LEX(757.02,SI,4,+LH,0))
I $P(LN,U,2)>0,$P(LN,U,1)<+INA D
. N DA,DIK,HN,NH,SN S NH=LH+1 Q:NH'>1 S SN=EX_U_SO_U_SA_U_MC_U_PF_U_AF_U_PM,HN=INA_U_"0"
. S ^LEX(757.02,SI,0)=SN,^LEX(757.02,SI,4,NH,0)=HN,DA=SI,DIK="^LEX(757.02," D IX1^DIK
Q
C2 ; 6100 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=3587 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXSI=38197 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304635
S LEXMC=164265
S LEXSO=6100
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="0% 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
C3 ; 6101 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=38198 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304636
S LEXMC=164266
S LEXSO=6101
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="10% 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
C4 ; 6102 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=38199 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304637
S LEXMC=164267
S LEXSO=6102
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="20% 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
C5 ; 6103 30% 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=38200 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304638
S LEXMC=164268
S LEXSO=6103
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="30% 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
C6 ; 6104 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=38201 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304639
S LEXMC=164269
S LEXSO=6104
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="40% 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
C7 ; 6105 50% 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=38202 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304640
S LEXMC=164270
S LEXSO=6105
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="50% 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
C8 ; 6106 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=38203 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304641
S LEXMC=164271
S LEXSO=6106
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="60% 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
C9 ; 6107 70% 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=38204 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304642
S LEXMC=164272
S LEXSO=6107
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="70% 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
C10 ; 6108 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=38205 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304643
S LEXMC=164273
S LEXSO=6108
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="80% 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
C11 ; 6109 90% 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=38206 I $D(^LEX(757.02,+LEXSI,0)) S DA=LEXSI,DIK="^LEX(757.02," D ^DIK
S LEXEX=304644
S LEXMC=164274
S LEXSO=6109
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="90% 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2073H 10033 printed Apr 09, 2024@21:14:13 Page 2
LEX2073H ;ISL/KER - LEX*2.0*73 Post-Install - Missing 1 ;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 ; Inactivate code 5295
+1 NEW ACT,AF,EX,EXP,INA,LD,LH,LN,MC,PF,PM,SA,SI,SO
+2 SET SI=3421
SET EX=12249
SET SO=5295
SET SA=17
SET MC=2525
SET PF=1
SET AF=1
SET PM=1
SET EXP="Back Strain"
SET ACT=3020701
SET INA=3030926
+3 SET LD=$ORDER(^LEX(757.02,SI,4,"B"," "),-1)
SET LH=$ORDER(^LEX(757.02,SI,4,"B",+LD," "),-1)
SET LN=$GET(^LEX(757.02,SI,4,+LH,0))
+4 IF $PIECE(LN,U,2)>0
IF $PIECE(LN,U,1)<+INA
Begin DoDot:1
+5 NEW DA,DIK,HN,NH,SN
SET NH=LH+1
if NH'>1
QUIT
SET SN=EX_U_SO_U_SA_U_MC_U_PF_U_AF_U_PM
SET HN=INA_U_"0"
+6 SET ^LEX(757.02,SI,0)=SN
SET ^LEX(757.02,SI,4,NH,0)=HN
SET DA=SI
SET DIK="^LEX(757.02,"
DO IX1^DIK
End DoDot:1
+7 QUIT
C2 ; 6100 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=3587
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXSI=38197
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+4 SET LEXEX=304635
+5 SET LEXMC=164265
+6 SET LEXSO=6100
+7 SET LEXSA=17
+8 SET LEXPF=1
+9 SET LEXAF=1
+10 SET LEXPM=1
+11 SET LEXSN=LEXEX_U_LEXSO_U_LEXSA_U_LEXMC_U_LEXPF_U_LEXAF_U_LEXPM
+12 SET LEXHI="^757.28D^2^2"
+13 SET LEXAC=2871218
+14 SET LEXH1=LEXAC_U_"1"
+15 SET LEXIN=2990610
+16 SET LEXH2=LEXIN_U_"0"
+17 SET LEXEP="0% Impairment of Auditory Acuity"
+18 SET LEXSR=497
+19 SET LEXCA=4
+20 SET ^LEX(757.02,LEXSI,0)=LEXSN
+21 SET ^LEX(757.02,LEXSI,4,0)=LEXHI
+22 SET ^LEX(757.02,LEXSI,4,1,0)=LEXH1
+23 SET ^LEX(757.02,LEXSI,4,2,0)=LEXH2
+24 SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO IX1^DIK
+25 KILL LEXFD
SET LEXIS=LEXEX_","
SET LEXFD(757.01,LEXIS,.01)=$GET(LEXEP)
+26 DO FILE^DIE("","LEXFD")
SET DA=LEXEX
SET DIK="^LEX(757.01,"
DO IX1^DIK
+27 QUIT
C3 ; 6101 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=38198
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=6101
+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="10% 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
C4 ; 6102 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=38199
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=6102
+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="20% 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
C5 ; 6103 30% 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=38200
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304638
+4 SET LEXMC=164268
+5 SET LEXSO=6103
+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="30% 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
C6 ; 6104 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=38201
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=6104
+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="40% 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
C7 ; 6105 50% 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=38202
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304640
+4 SET LEXMC=164270
+5 SET LEXSO=6105
+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="50% 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
C8 ; 6106 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=38203
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=6106
+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="60% 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
C9 ; 6107 70% 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=38204
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304642
+4 SET LEXMC=164272
+5 SET LEXSO=6107
+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="70% 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
C10 ; 6108 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=38205
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=6108
+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="80% 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
C11 ; 6109 90% 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=38206
IF $DATA(^LEX(757.02,+LEXSI,0))
SET DA=LEXSI
SET DIK="^LEX(757.02,"
DO ^DIK
+3 SET LEXEX=304644
+4 SET LEXMC=164274
+5 SET LEXSO=6109
+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="90% 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
