LEXHLP2 ;ISL/KER - Look-up Response (Help Text) ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
;
; Global Variables
; ^UTILITY($J ICR 10011
;
; External References
; ^DIWP ICR 10011
; $$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(.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(.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(.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
PR(LEXA,X) ; Parse Array
N DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC
K ^UTILITY($J,"W") Q:'$D(LEXA) S LEXLEN=+($G(X))
S:+LEXLEN'>0 LEXLEN=79 S LEXC=$O(LEXA(" "),-1) Q:+LEXC'>0
S DIWL=1,DIWF="C"_+LEXLEN S LEXI=0
F S LEXI=$O(LEXA(LEXI)) Q:+LEXI=0 S X=$G(LEXA(LEXI)) D ^DIWP
K LEXA S (LEXC,LEXI)=0
F S LEXI=$O(^UTILITY($J,"W",1,LEXI)) Q:+LEXI=0 D
. S LEXA(LEXI)=$$TM($G(^UTILITY($J,"W",1,LEXI,0))," ")
. S LEXC=LEXC+1
S:$L(LEXC) LEXA=LEXC K ^UTILITY($J,"W")
Q
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
LEXHLP2 ;ISL/KER - Look-up Response (Help Text) ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^UTILITY($J ICR 10011
+5 ;
+6 ; External References
+7 ; ^DIWP ICR 10011
+8 ; $$FMTE^XLFDT ICR 10103
+9 ;
+10 ; Local Variables NEWed or KILLed Elsewhere
+11 ; LEX Help Array KILLed in LEXAR3
+12 ; LEX2 Example Text NEWed in LEXAR3
+13 ; LEX3 Example Text NEWed in LEXAR3
+14 ; LEX4 Example Text NEWed in LEXAR3
+15 ; LEXCT Counter NEWed in LEXAR3
+16 ; LEXEX Expression NEWed in LEXAR3
+17 ; LEXFIL Search Filter NEWed in LEXAR3
+18 ; LEXHDT Search Date NEWed in LEXAR3
+19 ; LEXIDT Implementation Date NEWed in LEXAR3
+20 ; LEXOK Text OK NEWed in LEXAR3
+21 ; LEXY Help System NEWed in LEXAR3
+22 ;
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(.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(.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(.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
PR(LEXA,X) ; Parse Array
+1 NEW DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,LEXI,LEXLEN,LEXC
+2 KILL ^UTILITY($JOB,"W")
IF '$DATA(LEXA)
QUIT
SET LEXLEN=+($GET(X))
+3 IF +LEXLEN'>0
SET LEXLEN=79
SET LEXC=$ORDER(LEXA(" "),-1)
IF +LEXC'>0
QUIT
+4 SET DIWL=1
SET DIWF="C"_+LEXLEN
SET LEXI=0
+5 FOR
SET LEXI=$ORDER(LEXA(LEXI))
IF +LEXI=0
QUIT
SET X=$GET(LEXA(LEXI))
DO ^DIWP
+6 KILL LEXA
SET (LEXC,LEXI)=0
+7 FOR
SET LEXI=$ORDER(^UTILITY($JOB,"W",1,LEXI))
IF +LEXI=0
QUIT
Begin DoDot:1
+8 SET LEXA(LEXI)=$$TM($GET(^UTILITY($JOB,"W",1,LEXI,0))," ")
+9 SET LEXC=LEXC+1
End DoDot:1
+10 IF $LENGTH(LEXC)
SET LEXA=LEXC
KILL ^UTILITY($JOB,"W")
+11 QUIT
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
