- LEXXM4 ;ISL/KER - Convert Text to Mix Case (4) ;04/21/2014
- ;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; None
- ;
- ; Local Variables NEWed or KILLed Elsewhere
- ; LEXCTL,LEXIN,LEXNXT,LEXPRE,LEXUSE Newed in LEXXM
- ; Y set and returned to LEXXM
- ;
- T4 ; 4 Characters
- N XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2 S PRE=$G(LEXPRE),NXT=$G(LEXNXT),USE=$G(LEXUSE),UIN=$G(UIN),XU=$$UP(X),CHR=$E(XU,1)
- ; Exceptions
- S P1=$E(XU,1,($L(XU)-2)),P2=$E(XU,($L(XU)-1),$L(XU)) I "^CC^ML^GM^"[("^"_P2_"^"),$E(P1,$L(P1))?1N S Y=$$LO(XU) Q
- S NUM=$E(XU,1,2),TRL=$E(XU,3,4) I +NUM=NUM,((TRL="TH")!(TRL="ST")!(TRL="RD")) S Y=$$LO(XU) Q:$L($G(Y))
- S:$E(XU,1)?1U&($E(XU,4)?1N) Y=XU Q:$L($G(Y)) S:$E(XU,1)?1N&($E(XU,4)?1U) Y=XU Q:$L($G(Y))
- I "SIZE"=XU&(PRE="ANY") S Y=$$LO(X) Q
- I XU="MESA",$G(LEXCTL)["(MESA)" S Y=XU Q
- S:XU="TRAM"&((UIN["TRANSVERSE")!(UIN["BREAST")) Y=XU Q:$L($G(Y))
- S:XU="OPEN"&((UIN["OPEN HEART")) Y=$$MX(XU) Q:$L($G(Y))
- S:XU="DRIL"&(UIN["DISTAL REVASCULARIZATION")&(UIN["INTERVAL LIGATION") Y=$$UP(XU) Q:$L($G(Y))
- S:XU="TRAM"&((UIN["PROTEIN")!(UIN["GENE")!(UIN["ENDOPLASMIC RETICULUM"))&(UIN'["ACCIDENT")&(UIN'["VEHICLE") Y="TraM" Q:$L($G(Y))
- S:XU="TIPS"&($G(LEXIN)["(TIPS)") Y=XU S:XU="TIPS"&($G(LEXCTL)["(TIPS") Y=XU S:XU="TIPS"&($G(LEXCTL)["TIPS)") Y=XU Q:$L($G(Y))
- ; Special Case
- S:XU="APOA" Y="ApoA" S:XU="BBVI" Y="BbvI" S:XU="BPTH" Y="bPTH" Q:$L($G(Y))
- S:XU="BSUE" Y="BsuE" S:XU="PCO2" Y="pCO2" S:XU="CGMP" Y="cGMP" Q:$L($G(Y))
- S:XU="COTE" Y="CotE" S:XU="DATP" Y="dATP" S:XU="DCMP" Y="dCMP" Q:$L($G(Y))
- S:XU="DCTP" Y="dCTP" S:XU="DGMP" Y="dGMP" S:XU="DGTP" Y="dGTP" Q:$L($G(Y))
- S:XU="DSBA" Y="dsbA" S:XU="DTDP" Y="dTDP" S:XU="DTTP" Y="dTTP" Q:$L($G(Y))
- S:XU="DUMP" Y="dUMP" S:XU="DURD" Y="dUrd" S:XU="DUTP" Y="dUTP" Q:$L($G(Y))
- S:XU="ECAI" Y="EcaI" S:XU="ECOK" Y="EcoK" S:XU="ERBB" Y="erbB" Q:$L($G(Y))
- S:XU="FELV" Y="FeLV" S:XU="FMET" Y="fMet" S:XU="GNRH" Y="GnRH" Q:$L($G(Y))
- S:XU="GPII" Y="gpII" S:XU="HARG" Y="hArg" S:XU="HELA" Y="HeLa" Q:$L($G(Y))
- S:XU="HGRF" Y="hGRF" S:XU="HHAI" Y="HhaI" S:XU="HPAI" Y="HpaI" Q:$L($G(Y))
- S:XU="HPTH" Y="hPTH" S:XU="KPNI" Y="KpnI" S:XU="MCRB" Y="McrB" Q:$L($G(Y))
- S:XU="MESH" Y="MeSH" S:XU="MRNA" Y="mRNA" S:XU="NHET" Y="NHEt" Q:$L($G(Y))
- S:XU="NHME" Y="NHMe" S:XU="OBZL" Y="OBzl" S:XU="OTBU" Y="OtBu" Q:$L($G(Y))
- S:XU="PGLU" Y="pGlu" S:XU="PSTI" Y="PstI" S:XU="REGA" Y="regA" Q:$L($G(Y))
- S:XU="RRNA" Y="rRNA" S:XU="SCEI" Y="SceI" S:XU="TAQI" Y="TaqI" Q:$L($G(Y))
- S:XU="TRFA" Y="TrfA" S:XU="TRKA" Y="trkA" S:XU="TRKB" Y="trkB" Q:$L($G(Y))
- S:XU="TRNA" Y="tRNA" Q:$L($G(Y))
- ; Lower Case
- I "LESS"=XU&($E(NXT,1,4)="THAN") S Y=$$LO(X) Q
- I "^ALSO^AREA^BEEN^BEST^DONE^DTMN^EACH^EVEN^FIVE^FOUR^FROM^"[("^"_XU_"^") S Y=$$LO(X) Q
- I "^HAVE^HERE^HOUR^INTO^IT'S^KIND^LATE^LEFT^LESS^LIKE^LOST^"[("^"_XU_"^") S Y=$$LO(X) Q
- I "^MANY^MERE^MORE^MOST^MUST^NINE^NOTE^ONLY^OPEN^OURS^OVER^"[("^"_XU_"^") S Y=$$LO(X) Q
- I "^PART^PLUS^SAME^SEEN^SITE^SOME^SUCH^SURE^TAKE^THAN^THAN^"[("^"_XU_"^") S Y=$$LO(X) Q
- I "^THAT^THEN^THEY^THIS^THUS^UPON^USED^WERE^WHAT^WHEN^WHOM^"[("^"_XU_"^") S Y=$$LO(X) Q
- I "^WITH^"[("^"_XU_"^") S Y=$$LO(X) Q
- ; Mixed Case
- I "^BATH^CITH^CITY^EAST^ERIE^FORT^HOME^IOWA^IRON^JUAN^JULY^"[("^"_XU_"^") S Y=$$MX(X) Q
- I "^JUNE^KELL^LAKE^LOMA^LONG^LYON^PALM^PALO^PARK^RENO^ROCK^"[("^"_XU_"^") S Y=$$MX(X) Q
- I "^SALT^SIDE^TYPE^WACO^WEST^YORK^"[("^"_XU_"^") S Y=$$MX(X) Q
- ; Uppercase
- I CHR?1N!("^A^B^C^D^E^F^"[("^"_CHR_"^")) D Q:$L($G(Y))
- . I "^A1B5^A1BG^A4A7^A4A8^A6K7^ABL1^AICD^ABSV^ACKQ^ACTH^AIDS^AJCC^"[("^"_XU_"^") S Y=XU Q
- . I "^ALLA^AML1^ANCA^ANIT^ARPP^ASHD^ASPE^ATLV^BADR^BCL2^BDEM^"[("^"_XU_"^") S Y=XU Q
- . I "^BMIC^BMWD^BPDE^BPDE^BUSI^CABG^CAP1^CAP2^CAPD^CBFB^CCPD^"[("^"_XU_"^") S Y=XU Q
- . I "^CD34^CENP^CGRP^CHCT^COOH^COPD^CORF^CPAP^CPAP^CPEP^CPRS^"[("^"_XU_"^") S Y=XU Q
- . I "^CPT1^CPT2^CRNA^CROS^DENT^DEXA^DGGE^DGHI^DGPW^DGY1^DGY3^"[("^"_XU_"^") S Y=XU Q
- . I "^DGYA^DGYB^DGYC^DGYD^DGYF^DGYG^DGYJ^DGYK^DGYL^DGYN^DGYO^"[("^"_XU_"^") S Y=XU Q
- . I "^DGYP^DGYQ^DGYR^DGYS^DGYU^DGYV^DGYW^DGYX^DGYZ^DHEA^DIPK^"[("^"_XU_"^") S Y=XU Q
- . I "^DMAC^DMBA^DMBA^DMSO^DOPS^DSAP^DSIP^DTAP^DTPA^DVBA^DVBC^"[("^"_XU_"^") S Y=XU Q
- . I "^DVBQ^DVBT^DVBU^DVBW^DVBX^DVBY^EADT^EBNA^EBUS^ECMO^EDTA^"[("^"_XU_"^") S Y=XU Q
- . I "^EEOA^EEOP^ENXE^ENXF^ENXG^ENXI^ENXJ^ENXK^ERCC^ERCP^ERCP^"[("^"_XU_"^") S Y=XU Q
- . I "^ESRD^ESRD^ESWL^ETV1^ETV6^FANA^FBAA^FEV1^FITC^FKBP^FLI1^"[("^"_XU_"^") S Y=XU Q
- . I "^FP22^"[("^"_XU_"^") S Y=XU Q
- I "^G^H^I^J^K^L^"[("^"_CHR_"^") D Q:$L($G(Y))
- . I "^GABA^GATA^GECD^GECP^GECS^GERD^GHRH^GJB2^GLUT^GMAA^GMD1^"[("^"_XU_"^") S Y=XU Q
- . I "^GMN1^GMN2^GMN3^GMN4^GMN5^GMPL^GMPT^GMRA^GMRC^GMRD^GMRE^"[("^"_XU_"^") S Y=XU Q
- . I "^GMRG^GMRP^GMRQ^GMRR^GMRS^GMRV^GMRY^GP22^GRSA^GYKI^HBHC^"[("^"_XU_"^") S Y=XU Q
- . I "^HBIG^HCFA^HCMV^HCO2^HETE^HIAA^HIDA^HISA^HLPC^HMSN^HPLC^"[("^"_XU_"^") S Y=XU Q
- . I "^HPSA^HSAN^HTLV^IADL^IBDE^IBDP^IBQL^IBQY^IBY3^IBY4^IBY5^"[("^"_XU_"^") S Y=XU Q
- . I "^IBY6^IBY7^IBY8^IBY9^IBYA^IBYB^IBYC^IBYD^IBYE^IBYF^IBYG^"[("^"_XU_"^") S Y=XU Q
- . I "^IBYH^IBYK^IBYL^IBYN^ICPT^IDDM^IGIV^IIIA^IIIA^IIIB^IIIC^"[("^"_XU_"^") S Y=XU Q
- . I "^IIID^IIIE^IMRT^INTP^IPPB^IPPB^ISUP^KAFO^LATS^LBRN^LBRT^"[("^"_XU_"^") S Y=XU Q
- . I "^LBRY^LEXX^LHRH^LR00^LR01^LR03^LRAR^LRLS^LTCH^LVEF^"[("^"_XU_"^") S Y=XU Q
- I "^M^N^O^P^Q^"[("^"_CHR_"^") D Q:$L($G(Y))
- . I "^MAGE^MAGI^MCAD^MCXX^MEDA^MEDB^MEDC^MEDF^MESA^MESH^MHPE^"[("^"_XU_"^") S Y=XU Q
- . I "^MIBB^MLH1^MLH1^MLH2^MLH3^MLH4^MLH5^MLVP^MMPI^MMRV^MPTP^"[("^"_XU_"^") S Y=XU Q
- . I "^MPTP^MPTP^MQSA^MRCP^MRSA^MSH1^MSH2^MSH3^MSH4^MSH5^MSH6^"[("^"_XU_"^") S Y=XU Q
- . I "^MSLT^MTLU^MYCN^NADH^NADP^NAPS^NARP^NBDC^NETT^NETT^NGFI^"[("^"_XU_"^") S Y=XU Q
- . I "^NIST^NMES^NRDC^NSCL^NURA^NURC^NURE^NURQ^NURX^OERR^OHCS^"[("^"_XU_"^") S Y=XU Q
- . I "^ONCO^PABA^PAPP^PAPS^PAX3^PAX7^PDAC^PICC^PLA1^PLA2^PLA3^"[("^"_XU_"^") S Y=XU Q
- . I "^PMMA^POMC^PORP^PRCA^PRCP^PRMQ^PRPF^PRSX^PRX0^PRX1^PRX8^"[("^"_XU_"^") S Y=XU Q
- . I "^PRXB^PRXC^PRXE^PRXF^PRXG^PRXI^PRXJ^PRXK^PRXP^PRYA^PRYB^"[("^"_XU_"^") S Y=XU Q
- . I "^PRYC^PRYD^PRYF^PRYH^PRYJ^PRYL^PRYN^PRYP^PSA1^PSAP^PSD1^"[("^"_XU_"^") S Y=XU Q
- . I "^PSGW^PSIV^PSJ1^PSJ4^PSOA^PSOB^PSOC^PSOD^PSOE^PSOG^PSOH^"[("^"_XU_"^") S Y=XU Q
- . I "^PSOJ^PSOL^PSOY^PSW1^PSXC^PTCA^PTEN^PTSD^PUVA^PUVB^QAN1^"[("^"_XU_"^") S Y=XU Q
- . I "^QAR1^QAR2^QARF^QARY^"[("^"_XU_"^") S Y=XU Q
- I "^R^S^T^U^V^W^X^Y^Z^"[("^"_CHR_"^") D Q:$L($G(Y))
- . I "^RAAA^RAAB^RAAC^RAAE^RAAF^RARA^RAST^RMPC^RMPF^RMPJ^RMPR^RMPT^"[("^"_XU_"^") S Y=XU Q
- . I "^RTEM^RTYB^RTYC^RTYD^RVEF^RXIV^RXOP^RXUD^SARS^SACH^SBCE^SCAD^"[("^"_XU_"^") S Y=XU Q
- . I "^SCL1^SCL2^SDHB^SDHD^SDYA^SDYM^SDYN^SDYP^SEXA^SGOT^SGPT^"[("^"_XU_"^") S Y=XU Q
- . I "^SHBG^SIRS^SISI^SMAR^SNAP^SOWA^SOWC^SOWK^SRIF^SRIH^SROA^"[("^"_XU_"^") S Y=XU Q
- . I "^SRRS^SRRT^SSCP^SSX1^SSX2^TAPA^TATA^TCDD^TCDD^TCF3^TDAP^"[("^"_XU_"^") S Y=XU Q
- . I "^TENS^TFE3^THBR^TIMP^TIUJ^TIUW^TIUX^TLSO^TLSO^TORP^TP53^"[("^"_XU_"^") S Y=XU Q
- . I "^UDPG^UMLS^VALM^VAPR^VDDR^VEEM^VIIA^VIII^VLDL^VRSA^VSIT^"[("^"_XU_"^") S Y=XU Q
- . I "^WHFO^WMMT^XIII^XQOR^XUFI^XVII^XXII^YS01^ZIFT^"[("^"_XU_"^") S Y=XU Q
- Q
- ;
- LO(X) ; Lower Case
- Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- UP(X) ; Uppercase
- Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- MX(X) ; Mix Case
- Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- LD(X) ; Leading Character
- Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
- TRIM(X) ; Trim Spaces
- S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
- Q X
- LEXXM4 ;ISL/KER - Convert Text to Mix Case (4) ;04/21/2014
- +1 ;;2.0;General Lexicon Utilities;**80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; None
- +5 ;
- +6 ; External References
- +7 ; None
- +8 ;
- +9 ; Local Variables NEWed or KILLed Elsewhere
- +10 ; LEXCTL,LEXIN,LEXNXT,LEXPRE,LEXUSE Newed in LEXXM
- +11 ; Y set and returned to LEXXM
- +12 ;
- T4 ; 4 Characters
- +1 NEW XU,CHR,NUM,TRL,PRE,UIN,NXT,USE,P1,P2
- SET PRE=$GET(LEXPRE)
- SET NXT=$GET(LEXNXT)
- SET USE=$GET(LEXUSE)
- SET UIN=$GET(UIN)
- SET XU=$$UP(X)
- SET CHR=$EXTRACT(XU,1)
- +2 ; Exceptions
- +3 SET P1=$EXTRACT(XU,1,($LENGTH(XU)-2))
- SET P2=$EXTRACT(XU,($LENGTH(XU)-1),$LENGTH(XU))
- IF "^CC^ML^GM^"[("^"_P2_"^")
- IF $EXTRACT(P1,$LENGTH(P1))?1N
- SET Y=$$LO(XU)
- QUIT
- +4 SET NUM=$EXTRACT(XU,1,2)
- SET TRL=$EXTRACT(XU,3,4)
- IF +NUM=NUM
- IF ((TRL="TH")!(TRL="ST")!(TRL="RD"))
- SET Y=$$LO(XU)
- IF $LENGTH($GET(Y))
- QUIT
- +5 IF $EXTRACT(XU,1)?1U&($EXTRACT(XU,4)?1N)
- SET Y=XU
- IF $LENGTH($GET(Y))
- QUIT
- IF $EXTRACT(XU,1)?1N&($EXTRACT(XU,4)?1U)
- SET Y=XU
- IF $LENGTH($GET(Y))
- QUIT
- +6 IF "SIZE"=XU&(PRE="ANY")
- SET Y=$$LO(X)
- QUIT
- +7 IF XU="MESA"
- IF $GET(LEXCTL)["(MESA)"
- SET Y=XU
- QUIT
- +8 IF XU="TRAM"&((UIN["TRANSVERSE")!(UIN["BREAST"))
- SET Y=XU
- IF $LENGTH($GET(Y))
- QUIT
- +9 IF XU="OPEN"&((UIN["OPEN HEART"))
- SET Y=$$MX(XU)
- IF $LENGTH($GET(Y))
- QUIT
- +10 IF XU="DRIL"&(UIN["DISTAL REVASCULARIZATION")&(UIN["INTERVAL LIGATION")
- SET Y=$$UP(XU)
- IF $LENGTH($GET(Y))
- QUIT
- +11 IF XU="TRAM"&((UIN["PROTEIN")!(UIN["GENE")!(UIN["ENDOPLASMIC RETICULUM"))&(UIN'["ACCIDENT")&(UIN'["VEHICLE")
- SET Y="TraM"
- IF $LENGTH($GET(Y))
- QUIT
- +12 IF XU="TIPS"&($GET(LEXIN)["(TIPS)")
- SET Y=XU
- IF XU="TIPS"&($GET(LEXCTL)["(TIPS")
- SET Y=XU
- IF XU="TIPS"&($GET(LEXCTL)["TIPS)")
- SET Y=XU
- IF $LENGTH($GET(Y))
- QUIT
- +13 ; Special Case
- +14 IF XU="APOA"
- SET Y="ApoA"
- IF XU="BBVI"
- SET Y="BbvI"
- IF XU="BPTH"
- SET Y="bPTH"
- IF $LENGTH($GET(Y))
- QUIT
- +15 IF XU="BSUE"
- SET Y="BsuE"
- IF XU="PCO2"
- SET Y="pCO2"
- IF XU="CGMP"
- SET Y="cGMP"
- IF $LENGTH($GET(Y))
- QUIT
- +16 IF XU="COTE"
- SET Y="CotE"
- IF XU="DATP"
- SET Y="dATP"
- IF XU="DCMP"
- SET Y="dCMP"
- IF $LENGTH($GET(Y))
- QUIT
- +17 IF XU="DCTP"
- SET Y="dCTP"
- IF XU="DGMP"
- SET Y="dGMP"
- IF XU="DGTP"
- SET Y="dGTP"
- IF $LENGTH($GET(Y))
- QUIT
- +18 IF XU="DSBA"
- SET Y="dsbA"
- IF XU="DTDP"
- SET Y="dTDP"
- IF XU="DTTP"
- SET Y="dTTP"
- IF $LENGTH($GET(Y))
- QUIT
- +19 IF XU="DUMP"
- SET Y="dUMP"
- IF XU="DURD"
- SET Y="dUrd"
- IF XU="DUTP"
- SET Y="dUTP"
- IF $LENGTH($GET(Y))
- QUIT
- +20 IF XU="ECAI"
- SET Y="EcaI"
- IF XU="ECOK"
- SET Y="EcoK"
- IF XU="ERBB"
- SET Y="erbB"
- IF $LENGTH($GET(Y))
- QUIT
- +21 IF XU="FELV"
- SET Y="FeLV"
- IF XU="FMET"
- SET Y="fMet"
- IF XU="GNRH"
- SET Y="GnRH"
- IF $LENGTH($GET(Y))
- QUIT
- +22 IF XU="GPII"
- SET Y="gpII"
- IF XU="HARG"
- SET Y="hArg"
- IF XU="HELA"
- SET Y="HeLa"
- IF $LENGTH($GET(Y))
- QUIT
- +23 IF XU="HGRF"
- SET Y="hGRF"
- IF XU="HHAI"
- SET Y="HhaI"
- IF XU="HPAI"
- SET Y="HpaI"
- IF $LENGTH($GET(Y))
- QUIT
- +24 IF XU="HPTH"
- SET Y="hPTH"
- IF XU="KPNI"
- SET Y="KpnI"
- IF XU="MCRB"
- SET Y="McrB"
- IF $LENGTH($GET(Y))
- QUIT
- +25 IF XU="MESH"
- SET Y="MeSH"
- IF XU="MRNA"
- SET Y="mRNA"
- IF XU="NHET"
- SET Y="NHEt"
- IF $LENGTH($GET(Y))
- QUIT
- +26 IF XU="NHME"
- SET Y="NHMe"
- IF XU="OBZL"
- SET Y="OBzl"
- IF XU="OTBU"
- SET Y="OtBu"
- IF $LENGTH($GET(Y))
- QUIT
- +27 IF XU="PGLU"
- SET Y="pGlu"
- IF XU="PSTI"
- SET Y="PstI"
- IF XU="REGA"
- SET Y="regA"
- IF $LENGTH($GET(Y))
- QUIT
- +28 IF XU="RRNA"
- SET Y="rRNA"
- IF XU="SCEI"
- SET Y="SceI"
- IF XU="TAQI"
- SET Y="TaqI"
- IF $LENGTH($GET(Y))
- QUIT
- +29 IF XU="TRFA"
- SET Y="TrfA"
- IF XU="TRKA"
- SET Y="trkA"
- IF XU="TRKB"
- SET Y="trkB"
- IF $LENGTH($GET(Y))
- QUIT
- +30 IF XU="TRNA"
- SET Y="tRNA"
- IF $LENGTH($GET(Y))
- QUIT
- +31 ; Lower Case
- +32 IF "LESS"=XU&($EXTRACT(NXT,1,4)="THAN")
- SET Y=$$LO(X)
- QUIT
- +33 IF "^ALSO^AREA^BEEN^BEST^DONE^DTMN^EACH^EVEN^FIVE^FOUR^FROM^"[("^"_XU_"^")
- SET Y=$$LO(X)
- QUIT
- +34 IF "^HAVE^HERE^HOUR^INTO^IT'S^KIND^LATE^LEFT^LESS^LIKE^LOST^"[("^"_XU_"^")
- SET Y=$$LO(X)
- QUIT
- +35 IF "^MANY^MERE^MORE^MOST^MUST^NINE^NOTE^ONLY^OPEN^OURS^OVER^"[("^"_XU_"^")
- SET Y=$$LO(X)
- QUIT
- +36 IF "^PART^PLUS^SAME^SEEN^SITE^SOME^SUCH^SURE^TAKE^THAN^THAN^"[("^"_XU_"^")
- SET Y=$$LO(X)
- QUIT
- +37 IF "^THAT^THEN^THEY^THIS^THUS^UPON^USED^WERE^WHAT^WHEN^WHOM^"[("^"_XU_"^")
- SET Y=$$LO(X)
- QUIT
- +38 IF "^WITH^"[("^"_XU_"^")
- SET Y=$$LO(X)
- QUIT
- +39 ; Mixed Case
- +40 IF "^BATH^CITH^CITY^EAST^ERIE^FORT^HOME^IOWA^IRON^JUAN^JULY^"[("^"_XU_"^")
- SET Y=$$MX(X)
- QUIT
- +41 IF "^JUNE^KELL^LAKE^LOMA^LONG^LYON^PALM^PALO^PARK^RENO^ROCK^"[("^"_XU_"^")
- SET Y=$$MX(X)
- QUIT
- +42 IF "^SALT^SIDE^TYPE^WACO^WEST^YORK^"[("^"_XU_"^")
- SET Y=$$MX(X)
- QUIT
- +43 ; Uppercase
- +44 IF CHR?1N!("^A^B^C^D^E^F^"[("^"_CHR_"^"))
- Begin DoDot:1
- +45 IF "^A1B5^A1BG^A4A7^A4A8^A6K7^ABL1^AICD^ABSV^ACKQ^ACTH^AIDS^AJCC^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +46 IF "^ALLA^AML1^ANCA^ANIT^ARPP^ASHD^ASPE^ATLV^BADR^BCL2^BDEM^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +47 IF "^BMIC^BMWD^BPDE^BPDE^BUSI^CABG^CAP1^CAP2^CAPD^CBFB^CCPD^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +48 IF "^CD34^CENP^CGRP^CHCT^COOH^COPD^CORF^CPAP^CPAP^CPEP^CPRS^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +49 IF "^CPT1^CPT2^CRNA^CROS^DENT^DEXA^DGGE^DGHI^DGPW^DGY1^DGY3^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +50 IF "^DGYA^DGYB^DGYC^DGYD^DGYF^DGYG^DGYJ^DGYK^DGYL^DGYN^DGYO^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +51 IF "^DGYP^DGYQ^DGYR^DGYS^DGYU^DGYV^DGYW^DGYX^DGYZ^DHEA^DIPK^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +52 IF "^DMAC^DMBA^DMBA^DMSO^DOPS^DSAP^DSIP^DTAP^DTPA^DVBA^DVBC^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +53 IF "^DVBQ^DVBT^DVBU^DVBW^DVBX^DVBY^EADT^EBNA^EBUS^ECMO^EDTA^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +54 IF "^EEOA^EEOP^ENXE^ENXF^ENXG^ENXI^ENXJ^ENXK^ERCC^ERCP^ERCP^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +55 IF "^ESRD^ESRD^ESWL^ETV1^ETV6^FANA^FBAA^FEV1^FITC^FKBP^FLI1^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +56 IF "^FP22^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- End DoDot:1
- IF $LENGTH($GET(Y))
- QUIT
- +57 IF "^G^H^I^J^K^L^"[("^"_CHR_"^")
- Begin DoDot:1
- +58 IF "^GABA^GATA^GECD^GECP^GECS^GERD^GHRH^GJB2^GLUT^GMAA^GMD1^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +59 IF "^GMN1^GMN2^GMN3^GMN4^GMN5^GMPL^GMPT^GMRA^GMRC^GMRD^GMRE^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +60 IF "^GMRG^GMRP^GMRQ^GMRR^GMRS^GMRV^GMRY^GP22^GRSA^GYKI^HBHC^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +61 IF "^HBIG^HCFA^HCMV^HCO2^HETE^HIAA^HIDA^HISA^HLPC^HMSN^HPLC^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +62 IF "^HPSA^HSAN^HTLV^IADL^IBDE^IBDP^IBQL^IBQY^IBY3^IBY4^IBY5^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +63 IF "^IBY6^IBY7^IBY8^IBY9^IBYA^IBYB^IBYC^IBYD^IBYE^IBYF^IBYG^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +64 IF "^IBYH^IBYK^IBYL^IBYN^ICPT^IDDM^IGIV^IIIA^IIIA^IIIB^IIIC^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +65 IF "^IIID^IIIE^IMRT^INTP^IPPB^IPPB^ISUP^KAFO^LATS^LBRN^LBRT^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +66 IF "^LBRY^LEXX^LHRH^LR00^LR01^LR03^LRAR^LRLS^LTCH^LVEF^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- End DoDot:1
- IF $LENGTH($GET(Y))
- QUIT
- +67 IF "^M^N^O^P^Q^"[("^"_CHR_"^")
- Begin DoDot:1
- +68 IF "^MAGE^MAGI^MCAD^MCXX^MEDA^MEDB^MEDC^MEDF^MESA^MESH^MHPE^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +69 IF "^MIBB^MLH1^MLH1^MLH2^MLH3^MLH4^MLH5^MLVP^MMPI^MMRV^MPTP^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +70 IF "^MPTP^MPTP^MQSA^MRCP^MRSA^MSH1^MSH2^MSH3^MSH4^MSH5^MSH6^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +71 IF "^MSLT^MTLU^MYCN^NADH^NADP^NAPS^NARP^NBDC^NETT^NETT^NGFI^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +72 IF "^NIST^NMES^NRDC^NSCL^NURA^NURC^NURE^NURQ^NURX^OERR^OHCS^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +73 IF "^ONCO^PABA^PAPP^PAPS^PAX3^PAX7^PDAC^PICC^PLA1^PLA2^PLA3^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +74 IF "^PMMA^POMC^PORP^PRCA^PRCP^PRMQ^PRPF^PRSX^PRX0^PRX1^PRX8^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +75 IF "^PRXB^PRXC^PRXE^PRXF^PRXG^PRXI^PRXJ^PRXK^PRXP^PRYA^PRYB^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +76 IF "^PRYC^PRYD^PRYF^PRYH^PRYJ^PRYL^PRYN^PRYP^PSA1^PSAP^PSD1^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +77 IF "^PSGW^PSIV^PSJ1^PSJ4^PSOA^PSOB^PSOC^PSOD^PSOE^PSOG^PSOH^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +78 IF "^PSOJ^PSOL^PSOY^PSW1^PSXC^PTCA^PTEN^PTSD^PUVA^PUVB^QAN1^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +79 IF "^QAR1^QAR2^QARF^QARY^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- End DoDot:1
- IF $LENGTH($GET(Y))
- QUIT
- +80 IF "^R^S^T^U^V^W^X^Y^Z^"[("^"_CHR_"^")
- Begin DoDot:1
- +81 IF "^RAAA^RAAB^RAAC^RAAE^RAAF^RARA^RAST^RMPC^RMPF^RMPJ^RMPR^RMPT^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +82 IF "^RTEM^RTYB^RTYC^RTYD^RVEF^RXIV^RXOP^RXUD^SARS^SACH^SBCE^SCAD^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +83 IF "^SCL1^SCL2^SDHB^SDHD^SDYA^SDYM^SDYN^SDYP^SEXA^SGOT^SGPT^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +84 IF "^SHBG^SIRS^SISI^SMAR^SNAP^SOWA^SOWC^SOWK^SRIF^SRIH^SROA^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +85 IF "^SRRS^SRRT^SSCP^SSX1^SSX2^TAPA^TATA^TCDD^TCDD^TCF3^TDAP^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +86 IF "^TENS^TFE3^THBR^TIMP^TIUJ^TIUW^TIUX^TLSO^TLSO^TORP^TP53^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +87 IF "^UDPG^UMLS^VALM^VAPR^VDDR^VEEM^VIIA^VIII^VLDL^VRSA^VSIT^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- +88 IF "^WHFO^WMMT^XIII^XQOR^XUFI^XVII^XXII^YS01^ZIFT^"[("^"_XU_"^")
- SET Y=XU
- QUIT
- End DoDot:1
- IF $LENGTH($GET(Y))
- QUIT
- +89 QUIT
- +90 ;
- LO(X) ; Lower Case
- +1 QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- UP(X) ; Uppercase
- +1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- MX(X) ; Mix Case
- +1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
- LD(X) ; Leading Character
- +1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
- TRIM(X) ; Trim Spaces
- +1 SET X=$GET(X)
- FOR
- IF $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- IF $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 QUIT X
