LEXXFI7 ;ISL/KER - File Info - Prompts and Header ;05/23/2017
;;2.0;LEXICON UTILITY;**32,49,80,103**;Sep 23, 1996;Build 2
;
; Global Variables
; ^%ZOSF("UCI") ICR 10096
;
; External References
; $$FMTE^XLFDT ICR 10103
; $$GET1^DIQ ICR 2056
; $$NOW^XLFDT ICR 10103
; ^DIR ICR 10026
; $$PROD^XUPROD ICR 4440
;
Q
MT(X) ; Method - One or All Files
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="SAO^O:Checksum for ONE file;A:Checksum for ALL files (LEX/ICD/CPT)"
S DIR("A",1)=" Compute Checksum for:",DIR("A",2)=" "
S DIR("A",3)=" One Lexicon, ICD or CPT file"
S DIR("A",4)=" All Lexicon, ICD or CPT files (757*/80*/81*)"
S DIR("A",5)=" ",DIR("A")=" Select One or All: (O/A) "
S DIR("B")="O",(DIR("?"),DIR("??"))="^D MTH^LEXXFI7"
W ! D ^DIR S X=$S(Y="O":"ONE",Y="A":"ALL",1:"")
Q X
MTH ; Method Help
W !," Do you wish to compute the checksum for a single Lexicon, ICD"
W !," or CPT file or all Lexicon, ICD and CPT files (757*/80*/81*)"
W:$G(X)["??" !," Answer either 'O'ne or 'A'll or '^' to exit"
Q
;
CC(X) ; Checksum AND Count
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="YAO",DIR("A")=" Include a Record Count with the Checksum? (Y/N) "
S DIR("B")="N",(DIR("?"),DIR("??"))="^D CCH^LEXXFI7"
W ! D ^DIR S X=$S(+Y>0:1,1:0)
Q X
CCH ; Checksum AND Count Help
W !," Answer 'Yes' to include a count of the total the number of records"
W !," in the file/sub-file along with the checksum"
Q
;
FI(X) ; Select Lexicon/ICD File
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="FAO^1:45"
S DIR("A")=" Select File: "
S (DIR("?"),DIR("??"))="^D FIH^LEXXFI7" D ^DIR S X=$$FOT(Y)
Q X
FIH ; File Help
W !," Select either a Lexicon, ICD or CPT file:"
W !!," Lexicon ICD CPT"
W !," ---------------------------------------- ---- ----"
W !," 757 757.03 757.12 757.31 80 81"
W !," 757.001 757.03 757.13 757.4 80.1 81.1"
W !," 757.01 757.05 757.14 757.41 80.3 81.2"
W !," 757.011 757.06 757.2 81.3"
W !," 757.014 757.1 757.21"
W !," 757.02 757.11 757.3 "
Q
FOT(X) ; File Output Transform
N LEX,LEXX
S LEXX=$G(X) Q:'$L(X) "^" D ARY(LEXX,.LEX)
S:+($G(LEX(0)))=1 LEXX=$$ONE(X,.LEX)
S:+($G(LEX(0)))>1 LEXX=$$MULT(X,.LEX)
S X=$S(+LEXX>0:+LEXX,1:"^")
Q X
ONE(X,LEX) ; One Entry
S X=+($G(LEX(1)))
I $L($P($G(LEX(1)),"^",2)),+X>0 D
. W " ",$P($G(LEX(1)),"^",2)," (#",+X,")"
Q:+X'>0 "^" Q X
MULT(X,LEX) ; Multiple Entries
N LEXE,LEXEX,LEXFI,LEXI,LEXM,LEXMAX,LEXNAM,LEXS
S LEXMAX=$G(LEX(0)) Q:+LEXMAX'>1 W ! W !," ",LEXMAX," matches found"
S LEXS=0,LEXEX=0 F LEXI=1:1:LEXMAX Q:((LEXS>0)&(LEXS<LEXI+1)) Q:LEXEX D Q:LEXEX
. S LEXE=$G(LEX(LEXI)),LEXNAM=$P(LEXE,"^",2),LEXFI=+LEXE Q:'$L(LEXNAM) Q:+LEXFI'>0 S LEXM=LEXI
. W:LEXI#5=1 ! W !," ",$J(LEXI,4),". ",LEXNAM," (#",+LEXFI,")"
. W:LEXI#5=0 ! S:LEXI#5=0 LEXS=$$SEL(LEXM,.LEX) S:LEXS["^" LEXEX=1
I LEXI#5'=0,+LEXS=0 W ! S LEXS=$$SEL(LEXM,.LEX) S:LEXS["^" LEXEX=1
S X="^" S:'LEXEX&(+LEXS>0) X=+LEXS S:+X'>0 X="^"
Q X
SEL(X,LEX) ; Select Multiple
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEXM,Y S LEXM=+($G(X)) Q:LEXM=0 -1
S:+($O(LEX(+($G(LEXI)))))>0 DIR("A")=" Select 1-"_LEXM_" or '^' to exit: "
S:+($O(LEX(+($G(LEXI)))))'>0 DIR("A")=" Select 1-"_LEXM_": "
S (DIR("?"),DIR("??"))="Answer must be from 1 to "_LEXM_", or <Return> to continue "
S DIR(0)="NAO^1:"_LEXM_":0" D ^DIR S X="" S:$D(DTOUT)!(X[U) X=U
I $L($P($G(LEX(+Y)),"^",2)),+($G(LEX(+Y)))>0 D
. W " ",$P($G(LEX(+Y)),"^",2)," (#",+($G(LEX(+Y))),")"
. S X=+($G(LEX(+Y)))
Q X
ARY(X,LEX) ; Build Array of Files
N LEXF,LEXNM,LEXO,LEXX,Y
S LEXX=$TR($G(X),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") N X,Y
Q:'$L(LEXX) "" I +LEXX=LEXX D Q
. N LEXO,LEXN,LEXC S LEXO=LEXX-.00000001
. F S LEXO=$O(@("^DIC("_LEXO_")")) Q:+LEXO=0!($E(LEXO,1,$L(LEXX))'=LEXX) D
. . N LEXNM S LEXNM=$$FN^LEXXFI8(LEXO) Q:'$L(LEXNM) S LEX(0)=($O(LEX(" "),-1)+1),LEX(+LEX(0))=+LEXO_"^"_LEXNM
S LEXO=$E(LEXX,1,($L(LEXX)-1))_$C($A($E(LEXX,$L(LEXX)))-1)_"~"
F S LEXO=$O(@("^DIC(""B"","_LEXO_")")) Q:LEXO="" Q:$E(LEXO,1,$L(LEXX))'[LEXX D
. S LEXF=0 F S LEXF=$O(@("^DIC(""B"","_LEXO_","_LEXF_")")) Q:+LEXF'>0 D
. . Q:+($$LEX^LEXXFI8(LEXF))'>0&(+($$IC^LEXXFI8(LEXF))'>0) N LEXNM S LEXNM=$$FN^LEXXFI8(LEXF)
. . Q:'$L(LEXNM) S LEX(0)=($O(LEX(" "),-1)+1),LEX(+LEX(0))=+LEXF_"^"_LEXNM
Q
;
; Miscellaneous
U(X) ; UCI where Lexicon is installed
N LEXU,LEXP,LEXT,Y X ^%ZOSF("UCI") S LEXU=Y,LEXP=""
S:LEXU[","&($L($P(LEXU,",",1))>3) LEXU=$P(LEXU,",",1)
S LEXP=$S($$PROD^XUPROD(1):" (Production)",1:" (Test)")
S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
Q X
A(X) ; As of date/time
N LEXX S LEXX=$$NOW^XLFDT,LEXX=$$FMTE^XLFDT(LEXX,"1")
S:LEXX["@" LEXX=$P(LEXX,"@",1)_" "_$P(LEXX,"@",2,4000)
S X=LEXX
Q X
P(X) ; Person
N LEXDUZ,LEXPH,LEXNM
S LEXDUZ=+($G(DUZ)),LEXNM=$$GET1^DIQ(200,+($G(LEXDUZ)),.01) Q:'$L(LEXNM) "UNKNOWN^"
S LEXDUZ=+($G(DUZ)) S LEXPH=$$GET1^DIQ(200,+($G(LEXDUZ)),.132)
S:LEXPH="" LEXPH=$$GET1^DIQ(200,+($G(LEXDUZ)),.133)
S:LEXPH="" LEXPH=$$GET1^DIQ(200,+($G(LEXDUZ)),.134)
S:LEXPH="" LEXPH=$$GET1^DIQ(200,+($G(LEXDUZ)),.135)
S LEXDUZ=$$PM(LEXNM)
S X=LEXDUZ_"^"_LEXPH
Q X
PM(X) ; Person, Mixed Case
N LEXF,LEXL,LEXP S LEXP=$G(X),LEXL=$$MX($P(LEXP,",",1)),LEXF=$P(LEXP,",",2)
S LEXL(1)=$$MX($P(LEXL,"-",1)),LEXL(2)=$$MX($P(LEXL(1)," ",2,2)),LEXL(1)=$$MX($P(LEXL(1)," ",1))
S:$L(LEXL(1))&($L(LEXL(2))) LEXL(1)=LEXL(1)_" "_LEXL(2)
S LEXL(3)=$$MX($P(LEXL,"-",2)),LEXL(4)=$$MX($P(LEXL(3)," ",2,2)),LEXL(3)=$$MX($P(LEXL(3)," ",1))
S:$L(LEXL(3))&($L(LEXL(4))) LEXL(3)=LEXL(3)_" "_LEXL(4)
S LEXL=LEXL(1) S:$L(LEXL(1))&($L(LEXL(3))) LEXL=LEXL(1)_"-"_LEXL(3)
S LEXF=$$MX($P(LEXP,",",1)),LEXF=$P(LEXP,",",2)
S LEXF(1)=$$MX($P(LEXF,"-",1)),LEXF(2)=$$MX($P(LEXF(1)," ",2,2)),LEXF(1)=$$MX($P(LEXF(1)," ",1))
S:$L(LEXF(1))&($L(LEXF(2))) LEXF(1)=LEXF(1)_" "_LEXF(2)
S LEXF(3)=$$MX($P(LEXF,"-",2)),LEXF(4)=$$MX($P(LEXF(3)," ",2,2)),LEXF(3)=$$MX($P(LEXF(3)," ",1))
S:$L(LEXF(3))&($L(LEXF(4))) LEXF(3)=LEXF(3)_" "_LEXF(4)
S LEXF=LEXF(1) S:$L(LEXF(1))&($L(LEXF(3))) LEXF=LEXF(1)_"-"_LEXF(3)
S LEXP=LEXL_", "_LEXF,X=LEXP
Q X
MX(X) ; Mix Case
Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXFI7 6784 printed Apr 09, 2024@21:10:47 Page 2
LEXXFI7 ;ISL/KER - File Info - Prompts and Header ;05/23/2017
+1 ;;2.0;LEXICON UTILITY;**32,49,80,103**;Sep 23, 1996;Build 2
+2 ;
+3 ; Global Variables
+4 ; ^%ZOSF("UCI") ICR 10096
+5 ;
+6 ; External References
+7 ; $$FMTE^XLFDT ICR 10103
+8 ; $$GET1^DIQ ICR 2056
+9 ; $$NOW^XLFDT ICR 10103
+10 ; ^DIR ICR 10026
+11 ; $$PROD^XUPROD ICR 4440
+12 ;
+13 QUIT
MT(X) ; Method - One or All Files
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+2 SET DIR(0)="SAO^O:Checksum for ONE file;A:Checksum for ALL files (LEX/ICD/CPT)"
+3 SET DIR("A",1)=" Compute Checksum for:"
SET DIR("A",2)=" "
+4 SET DIR("A",3)=" One Lexicon, ICD or CPT file"
+5 SET DIR("A",4)=" All Lexicon, ICD or CPT files (757*/80*/81*)"
+6 SET DIR("A",5)=" "
SET DIR("A")=" Select One or All: (O/A) "
+7 SET DIR("B")="O"
SET (DIR("?"),DIR("??"))="^D MTH^LEXXFI7"
+8 WRITE !
DO ^DIR
SET X=$SELECT(Y="O":"ONE",Y="A":"ALL",1:"")
+9 QUIT X
MTH ; Method Help
+1 WRITE !," Do you wish to compute the checksum for a single Lexicon, ICD"
+2 WRITE !," or CPT file or all Lexicon, ICD and CPT files (757*/80*/81*)"
+3 if $GET(X)["??"
WRITE !," Answer either 'O'ne or 'A'll or '^' to exit"
+4 QUIT
+5 ;
CC(X) ; Checksum AND Count
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+2 SET DIR(0)="YAO"
SET DIR("A")=" Include a Record Count with the Checksum? (Y/N) "
+3 SET DIR("B")="N"
SET (DIR("?"),DIR("??"))="^D CCH^LEXXFI7"
+4 WRITE !
DO ^DIR
SET X=$SELECT(+Y>0:1,1:0)
+5 QUIT X
CCH ; Checksum AND Count Help
+1 WRITE !," Answer 'Yes' to include a count of the total the number of records"
+2 WRITE !," in the file/sub-file along with the checksum"
+3 QUIT
+4 ;
FI(X) ; Select Lexicon/ICD File
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+2 SET DIR(0)="FAO^1:45"
+3 SET DIR("A")=" Select File: "
+4 SET (DIR("?"),DIR("??"))="^D FIH^LEXXFI7"
DO ^DIR
SET X=$$FOT(Y)
+5 QUIT X
FIH ; File Help
+1 WRITE !," Select either a Lexicon, ICD or CPT file:"
+2 WRITE !!," Lexicon ICD CPT"
+3 WRITE !," ---------------------------------------- ---- ----"
+4 WRITE !," 757 757.03 757.12 757.31 80 81"
+5 WRITE !," 757.001 757.03 757.13 757.4 80.1 81.1"
+6 WRITE !," 757.01 757.05 757.14 757.41 80.3 81.2"
+7 WRITE !," 757.011 757.06 757.2 81.3"
+8 WRITE !," 757.014 757.1 757.21"
+9 WRITE !," 757.02 757.11 757.3 "
+10 QUIT
FOT(X) ; File Output Transform
+1 NEW LEX,LEXX
+2 SET LEXX=$GET(X)
if '$LENGTH(X)
QUIT "^"
DO ARY(LEXX,.LEX)
+3 if +($GET(LEX(0)))=1
SET LEXX=$$ONE(X,.LEX)
+4 if +($GET(LEX(0)))>1
SET LEXX=$$MULT(X,.LEX)
+5 SET X=$SELECT(+LEXX>0:+LEXX,1:"^")
+6 QUIT X
ONE(X,LEX) ; One Entry
+1 SET X=+($GET(LEX(1)))
+2 IF $LENGTH($PIECE($GET(LEX(1)),"^",2))
IF +X>0
Begin DoDot:1
+3 WRITE " ",$PIECE($GET(LEX(1)),"^",2)," (#",+X,")"
End DoDot:1
+4 if +X'>0
QUIT "^"
QUIT X
MULT(X,LEX) ; Multiple Entries
+1 NEW LEXE,LEXEX,LEXFI,LEXI,LEXM,LEXMAX,LEXNAM,LEXS
+2 SET LEXMAX=$GET(LEX(0))
if +LEXMAX'>1
QUIT
WRITE !
WRITE !," ",LEXMAX," matches found"
+3 SET LEXS=0
SET LEXEX=0
FOR LEXI=1:1:LEXMAX
if ((LEXS>0)&(LEXS<LEXI+1))
QUIT
if LEXEX
QUIT
Begin DoDot:1
+4 SET LEXE=$GET(LEX(LEXI))
SET LEXNAM=$PIECE(LEXE,"^",2)
SET LEXFI=+LEXE
if '$LENGTH(LEXNAM)
QUIT
if +LEXFI'>0
QUIT
SET LEXM=LEXI
+5 if LEXI#5=1
WRITE !
WRITE !," ",$JUSTIFY(LEXI,4),". ",LEXNAM," (#",+LEXFI,")"
+6 if LEXI#5=0
WRITE !
if LEXI#5=0
SET LEXS=$$SEL(LEXM,.LEX)
if LEXS["^"
SET LEXEX=1
End DoDot:1
if LEXEX
QUIT
+7 IF LEXI#5'=0
IF +LEXS=0
WRITE !
SET LEXS=$$SEL(LEXM,.LEX)
if LEXS["^"
SET LEXEX=1
+8 SET X="^"
if 'LEXEX&(+LEXS>0)
SET X=+LEXS
if +X'>0
SET X="^"
+9 QUIT X
SEL(X,LEX) ; Select Multiple
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,LEXM,Y
SET LEXM=+($GET(X))
if LEXM=0
QUIT -1
+2 if +($ORDER(LEX(+($GET(LEXI)))))>0
SET DIR("A")=" Select 1-"_LEXM_" or '^' to exit: "
+3 if +($ORDER(LEX(+($GET(LEXI)))))'>0
SET DIR("A")=" Select 1-"_LEXM_": "
+4 SET (DIR("?"),DIR("??"))="Answer must be from 1 to "_LEXM_", or <Return> to continue "
+5 SET DIR(0)="NAO^1:"_LEXM_":0"
DO ^DIR
SET X=""
if $DATA(DTOUT)!(X[U)
SET X=U
+6 IF $LENGTH($PIECE($GET(LEX(+Y)),"^",2))
IF +($GET(LEX(+Y)))>0
Begin DoDot:1
+7 WRITE " ",$PIECE($GET(LEX(+Y)),"^",2)," (#",+($GET(LEX(+Y))),")"
+8 SET X=+($GET(LEX(+Y)))
End DoDot:1
+9 QUIT X
ARY(X,LEX) ; Build Array of Files
+1 NEW LEXF,LEXNM,LEXO,LEXX,Y
+2 SET LEXX=$TRANSLATE($GET(X),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
NEW X,Y
+3 if '$LENGTH(LEXX)
QUIT ""
IF +LEXX=LEXX
Begin DoDot:1
+4 NEW LEXO,LEXN,LEXC
SET LEXO=LEXX-.00000001
+5 FOR
SET LEXO=$ORDER(@("^DIC("_LEXO_")"))
if +LEXO=0!($EXTRACT(LEXO,1,$LENGTH(LEXX))'=LEXX)
QUIT
Begin DoDot:2
+6 NEW LEXNM
SET LEXNM=$$FN^LEXXFI8(LEXO)
if '$LENGTH(LEXNM)
QUIT
SET LEX(0)=($ORDER(LEX(" "),-1)+1)
SET LEX(+LEX(0))=+LEXO_"^"_LEXNM
End DoDot:2
End DoDot:1
QUIT
+7 SET LEXO=$EXTRACT(LEXX,1,($LENGTH(LEXX)-1))_$CHAR($ASCII($EXTRACT(LEXX,$LENGTH(LEXX)))-1)_"~"
+8 FOR
SET LEXO=$ORDER(@("^DIC(""B"","_LEXO_")"))
if LEXO=""
QUIT
if $EXTRACT(LEXO,1,$LENGTH(LEXX))'[LEXX
QUIT
Begin DoDot:1
+9 SET LEXF=0
FOR
SET LEXF=$ORDER(@("^DIC(""B"","_LEXO_","_LEXF_")"))
if +LEXF'>0
QUIT
Begin DoDot:2
+10 if +($$LEX^LEXXFI8(LEXF))'>0&(+($$IC^LEXXFI8(LEXF))'>0)
QUIT
NEW LEXNM
SET LEXNM=$$FN^LEXXFI8(LEXF)
+11 if '$LENGTH(LEXNM)
QUIT
SET LEX(0)=($ORDER(LEX(" "),-1)+1)
SET LEX(+LEX(0))=+LEXF_"^"_LEXNM
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ; Miscellaneous
U(X) ; UCI where Lexicon is installed
+1 NEW LEXU,LEXP,LEXT,Y
XECUTE ^%ZOSF("UCI")
SET LEXU=Y
SET LEXP=""
+2 if LEXU[","&($LENGTH($PIECE(LEXU,",",1))>3)
SET LEXU=$PIECE(LEXU,",",1)
+3 SET LEXP=$SELECT($$PROD^XUPROD(1):" (Production)",1:" (Test)")
+4 SET X=""
SET $PIECE(X,"^",1)=LEXU
SET $PIECE(X,"^",2)=LEXP
+5 QUIT X
A(X) ; As of date/time
+1 NEW LEXX
SET LEXX=$$NOW^XLFDT
SET LEXX=$$FMTE^XLFDT(LEXX,"1")
+2 if LEXX["@"
SET LEXX=$PIECE(LEXX,"@",1)_" "_$PIECE(LEXX,"@",2,4000)
+3 SET X=LEXX
+4 QUIT X
P(X) ; Person
+1 NEW LEXDUZ,LEXPH,LEXNM
+2 SET LEXDUZ=+($GET(DUZ))
SET LEXNM=$$GET1^DIQ(200,+($GET(LEXDUZ)),.01)
if '$LENGTH(LEXNM)
QUIT "UNKNOWN^"
+3 SET LEXDUZ=+($GET(DUZ))
SET LEXPH=$$GET1^DIQ(200,+($GET(LEXDUZ)),.132)
+4 if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+($GET(LEXDUZ)),.133)
+5 if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+($GET(LEXDUZ)),.134)
+6 if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+($GET(LEXDUZ)),.135)
+7 SET LEXDUZ=$$PM(LEXNM)
+8 SET X=LEXDUZ_"^"_LEXPH
+9 QUIT X
PM(X) ; Person, Mixed Case
+1 NEW LEXF,LEXL,LEXP
SET LEXP=$GET(X)
SET LEXL=$$MX($PIECE(LEXP,",",1))
SET LEXF=$PIECE(LEXP,",",2)
+2 SET LEXL(1)=$$MX($PIECE(LEXL,"-",1))
SET LEXL(2)=$$MX($PIECE(LEXL(1)," ",2,2))
SET LEXL(1)=$$MX($PIECE(LEXL(1)," ",1))
+3 if $LENGTH(LEXL(1))&($LENGTH(LEXL(2)))
SET LEXL(1)=LEXL(1)_" "_LEXL(2)
+4 SET LEXL(3)=$$MX($PIECE(LEXL,"-",2))
SET LEXL(4)=$$MX($PIECE(LEXL(3)," ",2,2))
SET LEXL(3)=$$MX($PIECE(LEXL(3)," ",1))
+5 if $LENGTH(LEXL(3))&($LENGTH(LEXL(4)))
SET LEXL(3)=LEXL(3)_" "_LEXL(4)
+6 SET LEXL=LEXL(1)
if $LENGTH(LEXL(1))&($LENGTH(LEXL(3)))
SET LEXL=LEXL(1)_"-"_LEXL(3)
+7 SET LEXF=$$MX($PIECE(LEXP,",",1))
SET LEXF=$PIECE(LEXP,",",2)
+8 SET LEXF(1)=$$MX($PIECE(LEXF,"-",1))
SET LEXF(2)=$$MX($PIECE(LEXF(1)," ",2,2))
SET LEXF(1)=$$MX($PIECE(LEXF(1)," ",1))
+9 if $LENGTH(LEXF(1))&($LENGTH(LEXF(2)))
SET LEXF(1)=LEXF(1)_" "_LEXF(2)
+10 SET LEXF(3)=$$MX($PIECE(LEXF,"-",2))
SET LEXF(4)=$$MX($PIECE(LEXF(3)," ",2,2))
SET LEXF(3)=$$MX($PIECE(LEXF(3)," ",1))
+11 if $LENGTH(LEXF(3))&($LENGTH(LEXF(4)))
SET LEXF(3)=LEXF(3)_" "_LEXF(4)
+12 SET LEXF=LEXF(1)
if $LENGTH(LEXF(1))&($LENGTH(LEXF(3)))
SET LEXF=LEXF(1)_"-"_LEXF(3)
+13 SET LEXP=LEXL_", "_LEXF
SET X=LEXP
+14 QUIT X
MX(X) ; Mix Case
+1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
