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

LEXHLP2.m

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