- LEXXFI7 ;ISL/KER - File Info - Prompts and Header ;04/21/2014
- ;;2.0;LEXICON UTILITY;**32,49,80**;Sep 23, 1996;Build 10
- ;
- ; 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,299)
- 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")
- LEXXFI7 ;ISL/KER - File Info - Prompts and Header ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**32,49,80**;Sep 23, 1996;Build 10
- +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,299)
- +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")
