LEXHLP2 ;ISL/KER - Look-up Response (Help Text) ;05/23/2017
;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
;
; Global Variables
; None
;
; External References
; $$FMTE^XLFDT ICR 10103
;
; Local Variables NEWed or KILLed Elsewhere
; LEX Help Array KILLed in LEXAR3
; LEX2 Example Text NEWed in LEXAR3
; LEX3 Example Text NEWed in LEXAR3
; LEX4 Example Text NEWed in LEXAR3
; LEXCT Counter NEWed in LEXAR3
; LEXEX Expression NEWed in LEXAR3
; LEXFIL Search Filter NEWed in LEXAR3
; LEXHDT Search Date NEWed in LEXAR3
; LEXIDT Implementation Date NEWed in LEXAR3
; LEXOK Text OK NEWed in LEXAR3
; LEXY Help System NEWed in LEXAR3
;
HICD ; ICD-9 Dx Help
S LEXC="V18.0",LEXS="ICD-9-CM",LEX2="DIABETES MELL"
S LEX3="HIST DIAB MELL",LEX4="FAM HIST DIAB MELL" S LEXOK=1
S LEXEX="Family History of Diabetes Mellitus"
N ICD10 S ICD10=$$IMPDATE^LEXU("10D")
I +($G(LEXHDT))>0&($G(LEXHDT)?7N)&(+($G(LEXHDT))'<ICD10) D
. D:$G(LEXFIL)["$$DX^LEXU" H10D
Q
N10D ; No ICD-10 Dx
N LEXSD,LEXED,LEXSP S LEXSP=" "
S LEXSD=$TR($$FMTE^XLFDT($G(LEXHDT),"5DZ"),"@"," ") Q:$L(LEXSD)'=10
S LEXED=$TR($$FMTE^XLFDT($G(LEXIDT),"5DZ"),"@"," ") Q:$L(LEXED)'=10
K LEXP S LEXP(1)="This is not a valid search. You are searching "
S LEXP(1)=LEXP(1)_"for terminology that is linked to an ICD-10 "
S LEXP(1)=LEXP(1)_"diagnosis code on "_LEXSD_". There are no "
S LEXP(1)=LEXP(1)_"ICD-10-CM codes active before "_LEXED_"."
K LEX("HLP") D PR^LEXU(.LEXP,70) S LEXCT=$O(LEX("HLP"," "),-1),LEXI=0
F S LEXI=$O(LEXP(LEXI)) Q:+LEXI'>0 D
. N LEXT S LEXT=$G(LEXP(LEXI)),LEXCT=LEXCT+1
. S LEX("HLP",LEXCT)=LEXSP_LEXT
. S LEX("HLP",0)=LEXCT,LEXOK=1
Q
N10P ; No ICD-10 Pr
N LEXSD,LEXED,LEXSP S LEXSP=" "
S LEXSD=$TR($$FMTE^XLFDT($G(LEXHDT),"5DZ"),"@"," ") Q:$L(LEXSD)'=10
S LEXED=$TR($$FMTE^XLFDT($G(LEXIDT),"5DZ"),"@"," ") Q:$L(LEXED)'=10
K LEXP S LEXP(1)="This is not a valid search. You are searching "
S LEXP(1)=LEXP(1)_"for terminology that is linked to an ICD-10 "
S LEXP(1)=LEXP(1)_"procedure code on "_LEXSD_". There are no "
S LEXP(1)=LEXP(1)_"ICD-10-PCS codes active before "_LEXED_"."
K LEX("HLP") D PR^LEXU(.LEXP,70) S LEXCT=$O(LEX("HLP"," "),-1),LEXI=0
F S LEXI=$O(LEXP(LEXI)) Q:+LEXI'>0 D
. N LEXT S LEXT=$G(LEXP(LEXI)),LEXCT=LEXCT+1
. S LEX("HLP",LEXCT)=LEXSP_LEXT
. S LEX("HLP",0)=LEXCT,LEXOK=1
Q
N10 ; No ICD-10 Dx/Pr
N LEXSD,LEXED,LEXSP S LEXSP=" "
S LEXSD=$TR($$FMTE^XLFDT($G(LEXHDT),"5DZ"),"@"," ") Q:$L(LEXSD)'=10
S LEXED=$TR($$FMTE^XLFDT($G(LEXIDT),"5DZ"),"@"," ") Q:$L(LEXED)'=10
K LEXP S LEXP(1)="This is not a valid search. You are searching "
S LEXP(1)=LEXP(1)_"for terminology that is linked to an ICD-10 "
S LEXP(1)=LEXP(1)_"diagnosis or procedure code on "_LEXSD_". "
S LEXP(1)=LEXP(1)_"There are no ICD-10-CM or ICD-10-PCS codes "
S LEXP(1)=LEXP(1)_"active before "_LEXED_"."
K LEX("HLP") D PR^LEXU(.LEXP,70) S LEXCT=$O(LEX("HLP"," "),-1),LEXI=0
F S LEXI=$O(LEXP(LEXI)) Q:+LEXI'>0 D
. N LEXT S LEXT=$G(LEXP(LEXI)),LEXCT=LEXCT+1
. S LEX("HLP",LEXCT)=LEXSP_LEXT
. S LEX("HLP",0)=LEXCT,LEXOK=1
Q
; P70.2 NEONATAL DIABETES MELLITUS
H10D ; ICD-10 Dx Help
S LEXC="P70.2",LEXS="ICD-10-CM",LEX2="NEO DIAB MELL"
S LEX3="DIABE MELL NEO",LEX4="NEONATAL DIAB" S LEXOK=1
S LEXEX="Neonatal diabetes mellitus"
Q
HCPT ; CPT-4 Help
S LEXC="49560",LEXS="CPT-4",LEX2="REPAIR HERNIA"
S LEX3="REP VENT HERNIA",LEX4="REP VENT HERNIA REDUC" S LEXOK=1
S LEXEX="Repair Reducible Incisional or Ventral Hernia"
Q
HCPC ; HCPCS Help
S LEXC="L2680",LEXS="HCPCS",LEX2="THORAC CONTROL"
S LEX3="THORA CONTROL LAT",LEX4="THORA CONTROL LAT SUPP" S LEXOK=1
S LEXEX="Lateral Support Uprights for Thoracic Control"
Q
H10P ; ICD-10 Pr Help
S LEXC="6A550ZT",LEXS="ICD-10-PCS",LEX2="STEM CELL"
S LEX3="CORD STEM CELL",LEX4="PHERESIS CORD STEM CELL" S LEXOK=1
S LEXEX="Pheresis of Cord Blood Stem Cells, single"
Q
HDS4 ; DSM-IV Dx Help
S LEXC="296.32",LEXS="DSM-IV",LEX2="MAJOR DEPRESSION"
S LEX3="MAJ DEPRESS RECCUR",LEX4="MAJ DEP RECCUR MOD" S LEXOK=1
S LEXEX="Major Depressive Disorder, Recurrent, Moderate"
Q
HNAN ; Nanda
S LEXC="1.2.2.1",LEXS="NANDA",LEX2="BODY TEMPERATURE"
S LEX3="BODY TEMP ALT",LEX4="BODY TEMP POT ALTER" S LEXOK=1
S LEXEX="Body Temperature, Potential Altered"
Q
HSCC ; Title 38
S LEXC="7914",LEXS="Title 38",LEX2="MALIGANT GROW"
S LEX3="MALIG NEW GROW",LEX4="MALIG NEW GROW ENDOCRINE" S LEXOK=1
S LEXEX="Malignant new Growth of the Endocrine System"
Q
HOMA ; Omaha
S LEXC="H36.02",LEXS="Omaha Diagnosis",LEX2="SLEEP PATTERN"
S LEX3="SLEEP REST PATTERN",LEX4="SLEEP REST PATTERN IMPAIR" S LEXOK=1
S LEXEX="Sleep and Rest Patterns, Impairment"
Q
HSYS(X,Y) ; Help System
N LEXF,LEXD,ICD10 S LEXF=$G(X),LEXD=$G(Y),ICD10=$$IMPDATE^LEXU("10D")
Q:'$L(LEXF) "" I LEXF["$$SC^LEXU" D
. S LEXY=$TR($P($P(LEXF,",",2),";",3),"""","")
. S:LEXF["BEH" LEXY=LEXY_"/DS4" S:LEXF["DIS" LEXY=LEXY_"/SCC"
I LEXF["$$",LEXF["ONE^" D
. S LEXY="" S:LEXF["$$ICDONE" LEXY=LEXY_"/ICD"
. S:LEXF["$$10DO" LEXY=LEXY_"/10D" S:LEXF["$$10PO" LEXY=LEXY_"/10P"
. S:LEXF["$$CPTO" LEXY=LEXY_"/CPT" S:LEXF["$$CPCO" LEXY=LEXY_"/CPC"
. S:LEXF["$$DSMO" LEXY=LEXY_"/DS4"
S:LEXF["$$DX^LEXU"&(+LEXD<ICD10) LEXY="ICD"
S:LEXF["$$DX^LEXU"&(+LEXD'<ICD10) LEXY="10D"
S:LEXF["$$SO^LEXU" LEXY=$TR($P(LEXF,",",2),"""","")
S LEXT="" I $L($G(LEXY)) F LEXI=1:1:$L(LEXY,"/") D
. N LEXS,LEXO S LEXS=$P(LEXY,"/",LEXI) Q:'$L(LEXS) Q:$L(LEXS)'=3
. S:LEXS="ICD" LEXO="ICD-9"
. S:LEXS="10D"&(LEXY'["10P") LEXO="ICD-10"
. S:LEXS="10D"&(LEXY["10P") LEXO="ICD-10-CM"
. S:LEXS="10D"&($L(LEXY,"/")=1) LEXO="ICD-10-CM"
. S:LEXS="10P"&(LEXY'["10D") LEXO="ICD-10"
. S:LEXS="10P"&(LEXY["10D") LEXO="ICD-10-PCS"
. S:LEXS="10P"&($L(LEXY,"/")=1) LEXO="ICD-10-PCS"
. S:LEXS="CPT" LEXO="CPT-4" S:LEXS="CPC" LEXO="HCPCS"
. S:LEXS="SCC" LEXO="Title 38" S:LEXS="SCT" LEXO="SNOMED CT"
. S:LEXS="DS4" LEXO="DSM-IV" S:LEXS="NAN"!(LEXS="OMA") LEXO="Nursing"
. Q:'$L($G(LEXO)) S:LEXT'[LEXO LEXT=LEXT_"/"_LEXO
S LEXT=$$TM(LEXT,"/") S X="" S:$L(LEXT) X=LEXT
Q X
Q
;
; Miscellaneous
TM(X,Y) ; Trim Character Y - Default " "
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXHLP2 6546 printed Nov 22, 2024@17:18:10 Page 2
LEXHLP2 ;ISL/KER - Look-up Response (Help Text) ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**80,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$FMTE^XLFDT ICR 10103
+8 ;
+9 ; Local Variables NEWed or KILLed Elsewhere
+10 ; LEX Help Array KILLed in LEXAR3
+11 ; LEX2 Example Text NEWed in LEXAR3
+12 ; LEX3 Example Text NEWed in LEXAR3
+13 ; LEX4 Example Text NEWed in LEXAR3
+14 ; LEXCT Counter NEWed in LEXAR3
+15 ; LEXEX Expression NEWed in LEXAR3
+16 ; LEXFIL Search Filter NEWed in LEXAR3
+17 ; LEXHDT Search Date NEWed in LEXAR3
+18 ; LEXIDT Implementation Date NEWed in LEXAR3
+19 ; LEXOK Text OK NEWed in LEXAR3
+20 ; LEXY Help System NEWed in LEXAR3
+21 ;
HICD ; ICD-9 Dx Help
+1 SET LEXC="V18.0"
SET LEXS="ICD-9-CM"
SET LEX2="DIABETES MELL"
+2 SET LEX3="HIST DIAB MELL"
SET LEX4="FAM HIST DIAB MELL"
SET LEXOK=1
+3 SET LEXEX="Family History of Diabetes Mellitus"
+4 NEW ICD10
SET ICD10=$$IMPDATE^LEXU("10D")
+5 IF +($GET(LEXHDT))>0&($GET(LEXHDT)?7N)&(+($GET(LEXHDT))'<ICD10)
Begin DoDot:1
+6 if $GET(LEXFIL)["$$DX^LEXU"
DO H10D
End DoDot:1
+7 QUIT
N10D ; No ICD-10 Dx
+1 NEW LEXSD,LEXED,LEXSP
SET LEXSP=" "
+2 SET LEXSD=$TRANSLATE($$FMTE^XLFDT($GET(LEXHDT),"5DZ"),"@"," ")
if $LENGTH(LEXSD)'=10
QUIT
+3 SET LEXED=$TRANSLATE($$FMTE^XLFDT($GET(LEXIDT),"5DZ"),"@"," ")
if $LENGTH(LEXED)'=10
QUIT
+4 KILL LEXP
SET LEXP(1)="This is not a valid search. You are searching "
+5 SET LEXP(1)=LEXP(1)_"for terminology that is linked to an ICD-10 "
+6 SET LEXP(1)=LEXP(1)_"diagnosis code on "_LEXSD_". There are no "
+7 SET LEXP(1)=LEXP(1)_"ICD-10-CM codes active before "_LEXED_"."
+8 KILL LEX("HLP")
DO PR^LEXU(.LEXP,70)
SET LEXCT=$ORDER(LEX("HLP"," "),-1)
SET LEXI=0
+9 FOR
SET LEXI=$ORDER(LEXP(LEXI))
if +LEXI'>0
QUIT
Begin DoDot:1
+10 NEW LEXT
SET LEXT=$GET(LEXP(LEXI))
SET LEXCT=LEXCT+1
+11 SET LEX("HLP",LEXCT)=LEXSP_LEXT
+12 SET LEX("HLP",0)=LEXCT
SET LEXOK=1
End DoDot:1
+13 QUIT
N10P ; No ICD-10 Pr
+1 NEW LEXSD,LEXED,LEXSP
SET LEXSP=" "
+2 SET LEXSD=$TRANSLATE($$FMTE^XLFDT($GET(LEXHDT),"5DZ"),"@"," ")
if $LENGTH(LEXSD)'=10
QUIT
+3 SET LEXED=$TRANSLATE($$FMTE^XLFDT($GET(LEXIDT),"5DZ"),"@"," ")
if $LENGTH(LEXED)'=10
QUIT
+4 KILL LEXP
SET LEXP(1)="This is not a valid search. You are searching "
+5 SET LEXP(1)=LEXP(1)_"for terminology that is linked to an ICD-10 "
+6 SET LEXP(1)=LEXP(1)_"procedure code on "_LEXSD_". There are no "
+7 SET LEXP(1)=LEXP(1)_"ICD-10-PCS codes active before "_LEXED_"."
+8 KILL LEX("HLP")
DO PR^LEXU(.LEXP,70)
SET LEXCT=$ORDER(LEX("HLP"," "),-1)
SET LEXI=0
+9 FOR
SET LEXI=$ORDER(LEXP(LEXI))
if +LEXI'>0
QUIT
Begin DoDot:1
+10 NEW LEXT
SET LEXT=$GET(LEXP(LEXI))
SET LEXCT=LEXCT+1
+11 SET LEX("HLP",LEXCT)=LEXSP_LEXT
+12 SET LEX("HLP",0)=LEXCT
SET LEXOK=1
End DoDot:1
+13 QUIT
N10 ; No ICD-10 Dx/Pr
+1 NEW LEXSD,LEXED,LEXSP
SET LEXSP=" "
+2 SET LEXSD=$TRANSLATE($$FMTE^XLFDT($GET(LEXHDT),"5DZ"),"@"," ")
if $LENGTH(LEXSD)'=10
QUIT
+3 SET LEXED=$TRANSLATE($$FMTE^XLFDT($GET(LEXIDT),"5DZ"),"@"," ")
if $LENGTH(LEXED)'=10
QUIT
+4 KILL LEXP
SET LEXP(1)="This is not a valid search. You are searching "
+5 SET LEXP(1)=LEXP(1)_"for terminology that is linked to an ICD-10 "
+6 SET LEXP(1)=LEXP(1)_"diagnosis or procedure code on "_LEXSD_". "
+7 SET LEXP(1)=LEXP(1)_"There are no ICD-10-CM or ICD-10-PCS codes "
+8 SET LEXP(1)=LEXP(1)_"active before "_LEXED_"."
+9 KILL LEX("HLP")
DO PR^LEXU(.LEXP,70)
SET LEXCT=$ORDER(LEX("HLP"," "),-1)
SET LEXI=0
+10 FOR
SET LEXI=$ORDER(LEXP(LEXI))
if +LEXI'>0
QUIT
Begin DoDot:1
+11 NEW LEXT
SET LEXT=$GET(LEXP(LEXI))
SET LEXCT=LEXCT+1
+12 SET LEX("HLP",LEXCT)=LEXSP_LEXT
+13 SET LEX("HLP",0)=LEXCT
SET LEXOK=1
End DoDot:1
+14 QUIT
+15 ; P70.2 NEONATAL DIABETES MELLITUS
H10D ; ICD-10 Dx Help
+1 SET LEXC="P70.2"
SET LEXS="ICD-10-CM"
SET LEX2="NEO DIAB MELL"
+2 SET LEX3="DIABE MELL NEO"
SET LEX4="NEONATAL DIAB"
SET LEXOK=1
+3 SET LEXEX="Neonatal diabetes mellitus"
+4 QUIT
HCPT ; CPT-4 Help
+1 SET LEXC="49560"
SET LEXS="CPT-4"
SET LEX2="REPAIR HERNIA"
+2 SET LEX3="REP VENT HERNIA"
SET LEX4="REP VENT HERNIA REDUC"
SET LEXOK=1
+3 SET LEXEX="Repair Reducible Incisional or Ventral Hernia"
+4 QUIT
HCPC ; HCPCS Help
+1 SET LEXC="L2680"
SET LEXS="HCPCS"
SET LEX2="THORAC CONTROL"
+2 SET LEX3="THORA CONTROL LAT"
SET LEX4="THORA CONTROL LAT SUPP"
SET LEXOK=1
+3 SET LEXEX="Lateral Support Uprights for Thoracic Control"
+4 QUIT
H10P ; ICD-10 Pr Help
+1 SET LEXC="6A550ZT"
SET LEXS="ICD-10-PCS"
SET LEX2="STEM CELL"
+2 SET LEX3="CORD STEM CELL"
SET LEX4="PHERESIS CORD STEM CELL"
SET LEXOK=1
+3 SET LEXEX="Pheresis of Cord Blood Stem Cells, single"
+4 QUIT
HDS4 ; DSM-IV Dx Help
+1 SET LEXC="296.32"
SET LEXS="DSM-IV"
SET LEX2="MAJOR DEPRESSION"
+2 SET LEX3="MAJ DEPRESS RECCUR"
SET LEX4="MAJ DEP RECCUR MOD"
SET LEXOK=1
+3 SET LEXEX="Major Depressive Disorder, Recurrent, Moderate"
+4 QUIT
HNAN ; Nanda
+1 SET LEXC="1.2.2.1"
SET LEXS="NANDA"
SET LEX2="BODY TEMPERATURE"
+2 SET LEX3="BODY TEMP ALT"
SET LEX4="BODY TEMP POT ALTER"
SET LEXOK=1
+3 SET LEXEX="Body Temperature, Potential Altered"
+4 QUIT
HSCC ; Title 38
+1 SET LEXC="7914"
SET LEXS="Title 38"
SET LEX2="MALIGANT GROW"
+2 SET LEX3="MALIG NEW GROW"
SET LEX4="MALIG NEW GROW ENDOCRINE"
SET LEXOK=1
+3 SET LEXEX="Malignant new Growth of the Endocrine System"
+4 QUIT
HOMA ; Omaha
+1 SET LEXC="H36.02"
SET LEXS="Omaha Diagnosis"
SET LEX2="SLEEP PATTERN"
+2 SET LEX3="SLEEP REST PATTERN"
SET LEX4="SLEEP REST PATTERN IMPAIR"
SET LEXOK=1
+3 SET LEXEX="Sleep and Rest Patterns, Impairment"
+4 QUIT
HSYS(X,Y) ; Help System
+1 NEW LEXF,LEXD,ICD10
SET LEXF=$GET(X)
SET LEXD=$GET(Y)
SET ICD10=$$IMPDATE^LEXU("10D")
+2 if '$LENGTH(LEXF)
QUIT ""
IF LEXF["$$SC^LEXU"
Begin DoDot:1
+3 SET LEXY=$TRANSLATE($PIECE($PIECE(LEXF,",",2),";",3),"""","")
+4 if LEXF["BEH"
SET LEXY=LEXY_"/DS4"
if LEXF["DIS"
SET LEXY=LEXY_"/SCC"
End DoDot:1
+5 IF LEXF["$$"
IF LEXF["ONE^"
Begin DoDot:1
+6 SET LEXY=""
if LEXF["$$ICDONE"
SET LEXY=LEXY_"/ICD"
+7 if LEXF["$$10DO"
SET LEXY=LEXY_"/10D"
if LEXF["$$10PO"
SET LEXY=LEXY_"/10P"
+8 if LEXF["$$CPTO"
SET LEXY=LEXY_"/CPT"
if LEXF["$$CPCO"
SET LEXY=LEXY_"/CPC"
+9 if LEXF["$$DSMO"
SET LEXY=LEXY_"/DS4"
End DoDot:1
+10 if LEXF["$$DX^LEXU"&(+LEXD<ICD10)
SET LEXY="ICD"
+11 if LEXF["$$DX^LEXU"&(+LEXD'<ICD10)
SET LEXY="10D"
+12 if LEXF["$$SO^LEXU"
SET LEXY=$TRANSLATE($PIECE(LEXF,",",2),"""","")
+13 SET LEXT=""
IF $LENGTH($GET(LEXY))
FOR LEXI=1:1:$LENGTH(LEXY,"/")
Begin DoDot:1
+14 NEW LEXS,LEXO
SET LEXS=$PIECE(LEXY,"/",LEXI)
if '$LENGTH(LEXS)
QUIT
if $LENGTH(LEXS)'=3
QUIT
+15 if LEXS="ICD"
SET LEXO="ICD-9"
+16 if LEXS="10D"&(LEXY'["10P")
SET LEXO="ICD-10"
+17 if LEXS="10D"&(LEXY["10P")
SET LEXO="ICD-10-CM"
+18 if LEXS="10D"&($LENGTH(LEXY,"/")=1)
SET LEXO="ICD-10-CM"
+19 if LEXS="10P"&(LEXY'["10D")
SET LEXO="ICD-10"
+20 if LEXS="10P"&(LEXY["10D")
SET LEXO="ICD-10-PCS"
+21 if LEXS="10P"&($LENGTH(LEXY,"/")=1)
SET LEXO="ICD-10-PCS"
+22 if LEXS="CPT"
SET LEXO="CPT-4"
if LEXS="CPC"
SET LEXO="HCPCS"
+23 if LEXS="SCC"
SET LEXO="Title 38"
if LEXS="SCT"
SET LEXO="SNOMED CT"
+24 if LEXS="DS4"
SET LEXO="DSM-IV"
if LEXS="NAN"!(LEXS="OMA")
SET LEXO="Nursing"
+25 if '$LENGTH($GET(LEXO))
QUIT
if LEXT'[LEXO
SET LEXT=LEXT_"/"_LEXO
End DoDot:1
+26 SET LEXT=$$TM(LEXT,"/")
SET X=""
if $LENGTH(LEXT)
SET X=LEXT
+27 QUIT X
+28 QUIT
+29 ;
+30 ; Miscellaneous
TM(X,Y) ; Trim Character Y - Default " "
+1 SET X=$GET(X)
if X=""
QUIT X
SET Y=$GET(Y)
if '$LENGTH(Y)
SET Y=" "
+2 FOR
if $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
if $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 QUIT X
