SROGMTS1 ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ]
;;3.0; Surgery ;**100**;24 Jun 93
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
1 I "^B^C^D^E^F^G^H^I^J^K^M^N^O^P^Q^S^T^U^V^X^Y^Z^"[X S Y=$$UP(X) Q
I "^W^L^R^"[X S Y=$$LO(X) Q
I "^MM^CM^IN^FT^CM^CC^"[X S Y=$$LO(X) Q
Q
2 ; 2 Characters
S J=$G(J)
I J'="",J'=" ","^OR^"[X S Y=$$UP(X) Q
S:X="DA" Y="dA" S:X="DC" Y="dC" S:X="DG" Y="dG" S:X="DT" Y="dT" S:X="DU" Y="dU" S:X="GB" Y="gB" S:X="GC" Y="gC" S:X="GH" Y="gH" S:X="KB" Y="kB" Q:$L($G(Y))
S:X="KD" Y="kD" S:X="PH" Y="pH" S:X="PX" Y="pX" Q:$L($G(Y))
I "^WO^W/^IN^IS^IT^AT^OR^TO^OF^ON^BE^BY^"[X S Y=$$LO(X) Q
I "^ST^"[X S Y=$$MX(X) Q
I "^DG^DI^DS^EC^EN^ES^FB^ID^FH^HL^IB^LA^LR^MD^MC^NS^OR^PX^RA^RG^RT^SD^SR^SW^VA^WV^XH^XM^XT^XU^YS^"[X S Y=$$UP(X) Q
I "^BA^BT^CD^CH^CM^CN^CP^CR^CY^BW^7S^OL^CA^MC^EP^II^RO^ZP^ZY^SH^ES^MF^GP^"[X S Y=$$UP(X) Q
I "^CW^DD^DI^DS^EM^HF^IM^LH^LO^OD^OE^PN^RI^RP^RS^SP^SR^ST^SW^TP^TR^TS^VS^"[X S Y=$$UP(X) Q
I "^EP^AA^AB^AC^AD^AF^AG^AH^AP^AR^AV^BA^BB^BC^BE^BG^BH^BK^BL^BM^BP^BR^BS^BW^CA^CB^CD^CE^CF^CG^CH^CI^CK^CL^CO^CP^CR^CS^CT^CV^DB^DD^DL^DM^DN^DP^DQ^DR^EA^EB^EC^EF^EM^EO^EP^ET^FA^FD^FK^FR^FU^GA^GI^GL^GP^GR^GS^GT^HA^HB^HC^"[X S Y=$$UP(X) Q
I "^HC^HL^HO^HP^HR^HS^HT^HU^HX^IA^IB^IE^IF^II^IL^IP^IV^IX^KO^KS^LA^LD^LE^LF^LH^LL^LR^LY^MA^MB^MC^ME^MF^MI^MK^MP^MR^MS^MT^NA^NB^NF^NG^NH^NK^NL^NP^NS^NT^OC^OD^OH^OP^OT^OX^PA^PC^PD^PE^PF^PG^PI^PK^PL^PM^PP^PR^PS^PT^PZ^RA^"[X S Y=$$UP(X) Q
I "^RA^RC^RF^RH^RI^RP^RR^RS^RX^SA^SB^SC^SD^SE^SF^SG^SH^SI^SK^SL^SM^SP^SR^SS^SV^TA^TB^TC^TF^TH^TI^TK^TL^TP^TT^UK^UD^UV^VA^VC^VH^VI^VO^VP^VZ^WB^WS^XI^YM^YY^"[X S Y=$$UP(X) Q
I "^AN^AS^AT^BY^CM^DE^IN^MG^NO^OF^ON^OR^SQ^TO^UP^YL^"[X S Y=$$LO(X) Q
Q
3 ; 3 Characters
S:X="BRZ" Y="BrZ" S:X="COA" Y="CoA" S:X="COM" Y="CoM" S:X="EIF" Y="eIF" S:X="HGH" Y="hGH" S:X="HPR" Y="HPr" S:X="IGA" Y="IgA" S:X="IGD" Y="IgD" S:X="IGE" Y="IgE" Q:$L($G(Y))
S:X="IGG" Y="IgG" S:X="IGM" Y="IgM" S:X="IIB" Y="IIb" S:X="KDA" Y="kDa" S:X="MEC" Y="MeC" S:X="MEO" Y="MeO" S:X="NAC" Y="NAc" S:X="NIA" Y="NIa" S:X="OET" Y="OEt" Q:$L($G(Y))
S:X="OME" Y="OMe" S:X="PNA" Y="pNA" S:X="PRP" Y="PrP" S:X="SMB" Y="SmB" S:X="VPG" Y="VPg" Q:$L($G(Y))
I "^DIR^MED^APR^AUG^BAY^FEB^HOT^JAN^JCT^JUL^JUN^LAS^LOS^MAR^FAC^MAY^MTN^NEW^NOV^OCT^OUT^SAN^SEP^SKY^"[X S Y=$$MX(X) Q
I "^ALL^AND^ARE^BUT^SET^NOW^ANY^HAD^DUE^MED^TOO^FAR^OWN^MIN^ITS^HIM^OUR^HIS^HER^NEW^LOW^ITS^MAY^HOW^OUT^WAS^W/O^FOR^NOT^THE^CAN^PUT^"[X S Y=$$LO(X) Q
I "^ADC^ADR^ADT^BDS^BLO^BPN^BSR^CRS^OER^OEX^CVF^CVP^DCS^DEM^EDL^"[X S Y=$$UP(X) Q
I "^MIC^NSR^NTM^OPC^ORC^PLA^PLI^PLL^PRC^SCD^SHF^SLT^SPN^SRI^SRO^"[X S Y=$$UP(X) Q
I "^CWT^IOL^SVS^VSO^EES^EPO^DVC^ASC^"[X S Y=$$UP(X) Q
I "^ICU^NOS^NEC^SLC^ISC^A3A^A3F^A7R^DPT^DVB^ECT^ECX^EDR^EEO^GEC^IBD^IBJ^CPT^ICD^IMR^IVM^LA7^LEX^LRS^LRX^MC2^MPR^NUR^PCE^ORA^"[X S Y=$$UP(X) Q
I "^NLM^DIC^DIR^DIK^XMB^ORB^PRC^PRS^PSA^PSD^PSG^PSJ^PSN^PSO^PSS^PSU^PSX^QAC^QAM^QAN^QAO^QAP^QAQ^QAR^QIE^QIP^RTY^SPN^TIU^USR^VAQ^VON^XPD^XUC^XWB^YSA^ZDG^"[X S Y=$$UP(X) Q
I "^ABA^ABC^ABO^ABP^ACE^ACP^ADA^ADH^ADV^ADP^AFO^AII^ALS^AMC^AMP^ANF^ANP^ASA^ATF^ATP^ATX^AVP^AVT^AZT^BAM^BCG^BCP^BDB^BDS^BIM^BLS^BMP^BNP^BOC^BPV^BRL^BSA^BSP^CAD^CAF^CAM^CAP^CAT^CAZ^CBC^CBZ^CCK^CDP^CDR^CEA^CEF^CFA^CGP^CGS^"[X S Y=$$UP(X) Q
I "^CGS^CHO^CMC^CMF^CMP^CMV^CNP^CNS^CPE^CPK^CRF^CRH^CSF^CTP^CYT^DAB^DAP^DAT^DBP^DDE^DDT^DFA^DHP^DIP^DJD^DME^DNA^DNP^DTP^EAP^EBP^EBV^ECE^ECG^EEE^EEG^EGF^EHV^EIA^EKG^EMD^EMG^EMS^ENA^ENK^FAD^FAP^FDA^FDP^FGF^FMN^FSH^"[X S Y=$$UP(X) Q
I "^FSH^FSP^FTC^GAP^GDP^GLP^GMP^GPC^GPD^GRF^GRP^GSH^GTH^GTP^GVP^HBP^HCG^HCL^HCO^HCT^HCV^HDL^HFO^HHV^HIB^HIV^HLA^HLH^HMG^HNF^HNP^HOE^HPA^HPC^HPV^HRP^HSA^HSV^IAA^ICI^ICP^IDA^IFN^IGF^IIA^III^IMP^ITF^IUD^JMV^KAP^KLH^LAI^"[X S Y=$$UP(X) Q
I "^LAI^LAP^LAV^LDH^LDL^LPH^LSD^LSO^MAA^MAM^MAP^MBP^MCA^MCP^MDL^MDP^MDV^MEA^MEN^MEP^MHC^MIF^MIP^MPA^MPS^MRA^MRC^MRI^MRP^MSA^MSH^MTP^NAD^NAG^NAP^NBD^NCA^NCS^NEC^NGF^NHE^NKA^NMN^NOS^NPY^NSC^NYU^OMP^OMT^ORF^OTF^PAF^PAL^"[X S Y=$$UP(X) Q
I "^PAL^PAP^PAS^PBP^PCA^PCP^PEG^PEP^PET^PHA^PIP^PIV^PKI^PLP^POC^PPD^PPP^PRV^PSA^PSP^PTB^PTC^PTH^PTT^PTX^RAB^RAG^RAP^RBC^RBP^RGD^RII^RMI^RNA^RNP^RSV^SAA^SAM^SAP^SCP^SDZ^SEO^SER^SFV^SHV^SIV^SKF^SKN^SMP^SOD^SOS^SPM^SRV^"[X S Y=$$UP(X) Q
I "^RAS^SRV^STP^TAG^TAP^TCF^TCP^TDP^TEF^TEM^TFA^TGF^TMV^TNF^TNP^TPA^TPN^TRH^TRP^TSA^TSH^TTP^TTR^UDP^UMP^URO^USF^UTP^VII^VIP^VLA^VSG^VZV^WBC^WGA^WHO^XII^"[X S Y=$$UP(X) Q
I "^MAA^MPP^NEC^NOS^ZTA^CPD^R/O^MDA^3MC^ACP^SFN^URR^SNF^SLC^ISC^III^ATP^CMP^AAF^APV^LSD^PCP^HTP^RNA^DNA^ISC^NLM^IMP^"[X S Y=$$UP(X) Q
I "^ONE^TWO^SIX^TEN^AND^ANY^BIS^BUT^CIS^DES^DUE^FOR^LPM^NON^NOT^OXO^PER^PRE^PRO^PSI^THE^USE^"[X S Y=$$LO(X) Q
Q
4 ; 4 Characters
S:X="APOA" Y="ApoA" S:X="BBVI" Y="BbvI" S:X="BPTH" Y="bPTH" S:X="BSUE" Y="BsuE" S:X="CAMP" Y="cAMP" S:X="CGMP" Y="cGMP" S:X="COTE" Y="CotE" S:X="DATP" Y="dATP" Q:$L($G(Y))
S:X="DCMP" Y="dCMP" S:X="DCTP" Y="dCTP" S:X="DGMP" Y="dGMP" S:X="DGTP" Y="dGTP" S:X="DSBA" Y="dsbA" S:X="DTDP" Y="dTDP" S:X="DTTP" Y="dTTP" S:X="DUMP" Y="dUMP" Q:$L($G(Y))
S:X="DURD" Y="dUrd" S:X="DUTP" Y="dUTP" S:X="ECAI" Y="EcaI" S:X="ECOK" Y="EcoK" S:X="ERBB" Y="erbB" S:X="FELV" Y="FeLV" S:X="FMET" Y="fMet" S:X="GNRH" Y="GnRH" Q:$L($G(Y))
S:X="GPII" Y="gpII" S:X="HARG" Y="hArg" S:X="HELA" Y="HeLa" S:X="HGRF" Y="hGRF" S:X="HHAI" Y="HhaI" S:X="HPAI" Y="HpaI" S:X="HPTH" Y="hPTH" S:X="IIIA" Y="IIIa" Q:$L($G(Y))
S:X="KPNI" Y="KpnI" S:X="MCRB" Y="McrB" S:X="MESH" Y="MeSH" S:X="MRNA" Y="mRNA" S:X="NHET" Y="NHEt" S:X="NHME" Y="NHMe" S:X="OBZL" Y="OBzl" S:X="OTBU" Y="OtBu" Q:$L($G(Y))
S:X="PGLU" Y="pGlu" S:X="PSTI" Y="PstI" S:X="REGA" Y="regA" S:X="RRNA" Y="rRNA" S:X="SCEI" Y="SceI" S:X="TAQI" Y="TaqI" S:X="TRFA" Y="TrfA" S:X="TRKA" Y="trkA" Q:$L($G(Y))
S:X="TRKB" Y="trkB" S:X="TRNA" Y="tRNA" Q:$L($G(Y))
I "^BATH^CITH^CITY^EAST^ERIE^FORT^HOME^IOWA^IRON^JUAN^JULY^JUNE^LAKE^LOMA^LONG^LYON^PALM^PALO^PARK^RENO^ROCK^SALT^SIDE^WACO^WEST^YORK^"[X S Y=$$MX(X) Q
I "^BADR^BDEM^BMIC^EADT^MAGI^MEDA^MEDB^MEDC^MEDF^MHPE^RXIV^RXOP^"[X S Y=$$UP(X) Q
I "^RXUD^SCL1^SCL2^HISA^HPSA^CRNA^HCFA^"[X S Y=$$UP(X) Q
;I "^^"[X S Y=$$UP(X) Q
I "^A1B5^A1BG^A4A7^A4A8^A6K7^ABSV^ACKQ^DENT^DGHI^DGPW^DGY1^DGY3^DGYA^DGYB^DGYC^DGYD^DGYF^DGYG^DGYJ^DGYK^DGYL^DGYN^DGYO^DGYP^DGYQ^DGYR^DGYS^"[X S Y=$$UP(X) Q
I "^DGYU^DGYV^DGYW^DGYX^DGYZ^DIPK^DVBA^DVBC^DVBQ^DVBT^DVBU^DVBW^DVBX^DVBY^EEOA^EEOP^ENXE^ENXF^ENXG^ENXI^"[X S Y=$$UP(X) Q
I "^ENXJ^ENXK^FBAA^GECD^GECP^GECS^GMAA^GMD1^GMN1^GMN2^GMN3^GMN4^GMN5^GMPL^GMPT^GMRA^GMRC^GMRD^GMRE^GMRG"[X S Y=$$UP(X) Q
I "^GMRP^GMRQ^GMRR^GMRS^GMRV^GMRY^GMTS^HBHC^IBDE^IBDP^IBQL^IBQY^IBY3^IBY4^IBY5^IBY6^IBY7^IBY8^IBY9^IBYA^"[X S Y=$$UP(X) Q
I "^IBYB^IBYC^IBYD^IBYE^IBYF^IBYG^IBYH^IBYK^IBYL^IBYN^ICPT^LBRN^LBRT^LBRY^LR00^LR01^LR03^LRAR^LRLS^MCXX^"[X S Y=$$UP(X) Q
I "^NURA^NURC^NURE^NURQ^NURX^ONCO^PRCA^PRCP^PRMQ^PRPF^PRSX^PRX0^PRX1^PRX8^PRXB^PRXC^PRXE^PRXF^PRXG^PRXI^PRXJ^"[X S Y=$$UP(X) Q
I "^PRXK^PRXP^PRYA^PRYB^PRYC^PRYD^PRYF^PRYH^PRYJ^PRYL^PRYN^PRYP^PSA1^PSD1^PSGW^PSIV^PSJ1^PSJ4^PSOA^PSOB^PSOC^PSOD^PSOE^PSOG^PSOH^PSOJ^PSOL^"[X S Y=$$UP(X) Q
I "^PSOY^PSW1^PSXC^QAN1^QAR1^QAR2^QARF^QARY^RAAA^RAAB^RAAC^RAAE^RAAF^RMPC^RMPF^RMPJ^RMPR^RMPT^RTYB^RTYC^RTYD^SDYA^SDYM^SDYN^SDYP^"[X S Y=$$UP(X) Q
I "^SOWA^SOWC^SOWK^SROA^SRRS^SRRT^TIUJ^TIUW^TIUX^VALM^VEEM^VSIT^XQOR^XUFI^YS01^"[X S Y=$$UP(X) Q
I "^AIDS^ANCA^ARPP^ATLV^BPDE^BUSI^CENP^CGRP^COOH^CPAP^CPEP^DHEA^DMBA^DSIP^DTPA^EBNA^EDTA^ERCC^ERCP^ESRD^FANA^FITC^FKBP^GABA^GATA^GHRH^GLUT^GYKI^HCMV^HIDA^HMSN^HSAN^HTLV^IDDM^INTP^IPPB^KAFO^LATS^LHRH^MAGE^MLVP^MPTP^"[X S Y=$$UP(X) Q
I "^ANIT^CAMP^DOPS^MPTP^HETE^OERR^GMPT^GMPL^MTLU^UMLS^BPDE^DMBA^PABA^"[X S Y=$$UP(X) Q
I "^MPTP^NADH^NADP^NAPS^NETT^NGFI^NRDC^NSCL^PAPS^POMC^PSAP^RTEM^SACH^SGOT^SNAP^SRIF^SRIH^TAPA^TATA^TCDD^TENS^TIMP^TLSO^UDPG^VIII^VLDL^WHFO^XIII^"[X S Y=$$UP(X) Q
I "^USED^EACH^DTMN,FOUR^FIVE^NINE^HOUR^INTO^LESS^LIKE^MORE^ONLY^OPEN^OVER^PART^SITE^THAN^TYPE^WITH^"[X S Y=$$LO(X) Q
I "^BEST^IT'S^LATE^SITE^FROM^SOME^WITH^UPON^THEY^THEN^INTO^MORE^THAN^THAT^THIS^THUS^HAVE^BEEN^NOTE^DONE^MUST^MERE^SURE^KIND^WHEN^WHAT^"[X S Y=$$LO(X) Q
I "^LOST^LIKE^OURS^ALSO^EACH^ONLY^HERE^SUCH^SEEN^SAME^LESS^AREA^MANY^EVEN^LEFT^MOST^"[X S Y=$$LO(X) Q
Q
;
LO(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MX(X) Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROGMTS1 8551 printed Apr 09, 2024@21:50:45 Page 2
SROGMTS1 ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a nationally
+4 ;** controlled procedure. Local modifications to this routine
+5 ;** are prohibited.
+6 ;
1 IF "^B^C^D^E^F^G^H^I^J^K^M^N^O^P^Q^S^T^U^V^X^Y^Z^"[X
SET Y=$$UP(X)
QUIT
+1 IF "^W^L^R^"[X
SET Y=$$LO(X)
QUIT
+2 IF "^MM^CM^IN^FT^CM^CC^"[X
SET Y=$$LO(X)
QUIT
+3 QUIT
2 ; 2 Characters
+1 SET J=$GET(J)
+2 IF J'=""
IF J'=" "
IF "^OR^"[X
SET Y=$$UP(X)
QUIT
+3 if X="DA"
SET Y="dA"
if X="DC"
SET Y="dC"
if X="DG"
SET Y="dG"
if X="DT"
SET Y="dT"
if X="DU"
SET Y="dU"
if X="GB"
SET Y="gB"
if X="GC"
SET Y="gC"
if X="GH"
SET Y="gH"
if X="KB"
SET Y="kB"
if $LENGTH($GET(Y))
QUIT
+4 if X="KD"
SET Y="kD"
if X="PH"
SET Y="pH"
if X="PX"
SET Y="pX"
if $LENGTH($GET(Y))
QUIT
+5 IF "^WO^W/^IN^IS^IT^AT^OR^TO^OF^ON^BE^BY^"[X
SET Y=$$LO(X)
QUIT
+6 IF "^ST^"[X
SET Y=$$MX(X)
QUIT
+7 IF "^DG^DI^DS^EC^EN^ES^FB^ID^FH^HL^IB^LA^LR^MD^MC^NS^OR^PX^RA^RG^RT^SD^SR^SW^VA^WV^XH^XM^XT^XU^YS^"[X
SET Y=$$UP(X)
QUIT
+8 IF "^BA^BT^CD^CH^CM^CN^CP^CR^CY^BW^7S^OL^CA^MC^EP^II^RO^ZP^ZY^SH^ES^MF^GP^"[X
SET Y=$$UP(X)
QUIT
+9 IF "^CW^DD^DI^DS^EM^HF^IM^LH^LO^OD^OE^PN^RI^RP^RS^SP^SR^ST^SW^TP^TR^TS^VS^"[X
SET Y=$$UP(X)
QUIT
+10 IF "^EP^AA^AB^AC^AD^AF^AG^AH^AP^AR^AV^BA^BB^BC^BE^BG^BH^BK^BL^BM^BP^BR^BS^BW^CA^CB^CD^CE^CF^CG^CH^CI^CK^CL^CO^CP^CR^CS^CT^CV^DB^DD^DL^DM^DN^DP^DQ^DR^EA^EB^EC^EF^EM^EO^EP^ET^FA^FD^FK^FR^FU^GA^GI^GL^GP^GR^GS^GT^HA^HB^HC^"[X
SET Y=$$UP(X)
QUIT
+11 IF "^HC^HL^HO^HP^HR^HS^HT^HU^HX^IA^IB^IE^IF^II^IL^IP^IV^IX^KO^KS^LA^LD^LE^LF^LH^LL^LR^LY^MA^MB^MC^ME^MF^MI^MK^MP^MR^MS^MT^NA^NB^NF^NG^NH^NK^NL^NP^NS^NT^OC^OD^OH^OP^OT^OX^PA^PC^PD^PE^PF^PG^PI^PK^PL^PM^PP^PR^PS^PT^PZ^RA^"[X
SET Y=$$UP(X)
QUIT
+12 IF "^RA^RC^RF^RH^RI^RP^RR^RS^RX^SA^SB^SC^SD^SE^SF^SG^SH^SI^SK^SL^SM^SP^SR^SS^SV^TA^TB^TC^TF^TH^TI^TK^TL^TP^TT^UK^UD^UV^VA^VC^VH^VI^VO^VP^VZ^WB^WS^XI^YM^YY^"[X
SET Y=$$UP(X)
QUIT
+13 IF "^AN^AS^AT^BY^CM^DE^IN^MG^NO^OF^ON^OR^SQ^TO^UP^YL^"[X
SET Y=$$LO(X)
QUIT
+14 QUIT
3 ; 3 Characters
+1 if X="BRZ"
SET Y="BrZ"
if X="COA"
SET Y="CoA"
if X="COM"
SET Y="CoM"
if X="EIF"
SET Y="eIF"
if X="HGH"
SET Y="hGH"
if X="HPR"
SET Y="HPr"
if X="IGA"
SET Y="IgA"
if X="IGD"
SET Y="IgD"
if X="IGE"
SET Y="IgE"
if $LENGTH($GET(Y))
QUIT
+2 if X="IGG"
SET Y="IgG"
if X="IGM"
SET Y="IgM"
if X="IIB"
SET Y="IIb"
if X="KDA"
SET Y="kDa"
if X="MEC"
SET Y="MeC"
if X="MEO"
SET Y="MeO"
if X="NAC"
SET Y="NAc"
if X="NIA"
SET Y="NIa"
if X="OET"
SET Y="OEt"
if $LENGTH($GET(Y))
QUIT
+3 if X="OME"
SET Y="OMe"
if X="PNA"
SET Y="pNA"
if X="PRP"
SET Y="PrP"
if X="SMB"
SET Y="SmB"
if X="VPG"
SET Y="VPg"
if $LENGTH($GET(Y))
QUIT
+4 IF "^DIR^MED^APR^AUG^BAY^FEB^HOT^JAN^JCT^JUL^JUN^LAS^LOS^MAR^FAC^MAY^MTN^NEW^NOV^OCT^OUT^SAN^SEP^SKY^"[X
SET Y=$$MX(X)
QUIT
+5 IF "^ALL^AND^ARE^BUT^SET^NOW^ANY^HAD^DUE^MED^TOO^FAR^OWN^MIN^ITS^HIM^OUR^HIS^HER^NEW^LOW^ITS^MAY^HOW^OUT^WAS^W/O^FOR^NOT^THE^CAN^PUT^"[X
SET Y=$$LO(X)
QUIT
+6 IF "^ADC^ADR^ADT^BDS^BLO^BPN^BSR^CRS^OER^OEX^CVF^CVP^DCS^DEM^EDL^"[X
SET Y=$$UP(X)
QUIT
+7 IF "^MIC^NSR^NTM^OPC^ORC^PLA^PLI^PLL^PRC^SCD^SHF^SLT^SPN^SRI^SRO^"[X
SET Y=$$UP(X)
QUIT
+8 IF "^CWT^IOL^SVS^VSO^EES^EPO^DVC^ASC^"[X
SET Y=$$UP(X)
QUIT
+9 IF "^ICU^NOS^NEC^SLC^ISC^A3A^A3F^A7R^DPT^DVB^ECT^ECX^EDR^EEO^GEC^IBD^IBJ^CPT^ICD^IMR^IVM^LA7^LEX^LRS^LRX^MC2^MPR^NUR^PCE^ORA^"[X
SET Y=$$UP(X)
QUIT
+10 IF "^NLM^DIC^DIR^DIK^XMB^ORB^PRC^PRS^PSA^PSD^PSG^PSJ^PSN^PSO^PSS^PSU^PSX^QAC^QAM^QAN^QAO^QAP^QAQ^QAR^QIE^QIP^RTY^SPN^TIU^USR^VAQ^VON^XPD^XUC^XWB^YSA^ZDG^"[X
SET Y=$$UP(X)
QUIT
+11 IF "^ABA^ABC^ABO^ABP^ACE^ACP^ADA^ADH^ADV^ADP^AFO^AII^ALS^AMC^AMP^ANF^ANP^ASA^ATF^ATP^ATX^AVP^AVT^AZT^BAM^BCG^BCP^BDB^BDS^BIM^BLS^BMP^BNP^BOC^BPV^BRL^BSA^BSP^CAD^CAF^CAM^CAP^CAT^CAZ^CBC^CBZ^CCK^CDP^CDR^CEA^CEF^CFA^CGP^CGS^"[X
SET Y=$$UP(X)
QUIT
+12 IF "^CGS^CHO^CMC^CMF^CMP^CMV^CNP^CNS^CPE^CPK^CRF^CRH^CSF^CTP^CYT^DAB^DAP^DAT^DBP^DDE^DDT^DFA^DHP^DIP^DJD^DME^DNA^DNP^DTP^EAP^EBP^EBV^ECE^ECG^EEE^EEG^EGF^EHV^EIA^EKG^EMD^EMG^EMS^ENA^ENK^FAD^FAP^FDA^FDP^FGF^FMN^FSH^"[X
SET Y=$$UP(X)
QUIT
+13 IF "^FSH^FSP^FTC^GAP^GDP^GLP^GMP^GPC^GPD^GRF^GRP^GSH^GTH^GTP^GVP^HBP^HCG^HCL^HCO^HCT^HCV^HDL^HFO^HHV^HIB^HIV^HLA^HLH^HMG^HNF^HNP^HOE^HPA^HPC^HPV^HRP^HSA^HSV^IAA^ICI^ICP^IDA^IFN^IGF^IIA^III^IMP^ITF^IUD^JMV^KAP^KLH^LAI^"[X
SET Y=$$UP(X)
QUIT
+14 IF "^LAI^LAP^LAV^LDH^LDL^LPH^LSD^LSO^MAA^MAM^MAP^MBP^MCA^MCP^MDL^MDP^MDV^MEA^MEN^MEP^MHC^MIF^MIP^MPA^MPS^MRA^MRC^MRI^MRP^MSA^MSH^MTP^NAD^NAG^NAP^NBD^NCA^NCS^NEC^NGF^NHE^NKA^NMN^NOS^NPY^NSC^NYU^OMP^OMT^ORF^OTF^PAF^PAL^"[X
SET Y=$$UP(X)
QUIT
+15 IF "^PAL^PAP^PAS^PBP^PCA^PCP^PEG^PEP^PET^PHA^PIP^PIV^PKI^PLP^POC^PPD^PPP^PRV^PSA^PSP^PTB^PTC^PTH^PTT^PTX^RAB^RAG^RAP^RBC^RBP^RGD^RII^RMI^RNA^RNP^RSV^SAA^SAM^SAP^SCP^SDZ^SEO^SER^SFV^SHV^SIV^SKF^SKN^SMP^SOD^SOS^SPM^SRV^"[X
SET Y=$$UP(X)
QUIT
+16 IF "^RAS^SRV^STP^TAG^TAP^TCF^TCP^TDP^TEF^TEM^TFA^TGF^TMV^TNF^TNP^TPA^TPN^TRH^TRP^TSA^TSH^TTP^TTR^UDP^UMP^URO^USF^UTP^VII^VIP^VLA^VSG^VZV^WBC^WGA^WHO^XII^"[X
SET Y=$$UP(X)
QUIT
+17 IF "^MAA^MPP^NEC^NOS^ZTA^CPD^R/O^MDA^3MC^ACP^SFN^URR^SNF^SLC^ISC^III^ATP^CMP^AAF^APV^LSD^PCP^HTP^RNA^DNA^ISC^NLM^IMP^"[X
SET Y=$$UP(X)
QUIT
+18 IF "^ONE^TWO^SIX^TEN^AND^ANY^BIS^BUT^CIS^DES^DUE^FOR^LPM^NON^NOT^OXO^PER^PRE^PRO^PSI^THE^USE^"[X
SET Y=$$LO(X)
QUIT
+19 QUIT
4 ; 4 Characters
+1 if X="APOA"
SET Y="ApoA"
if X="BBVI"
SET Y="BbvI"
if X="BPTH"
SET Y="bPTH"
if X="BSUE"
SET Y="BsuE"
if X="CAMP"
SET Y="cAMP"
if X="CGMP"
SET Y="cGMP"
if X="COTE"
SET Y="CotE"
if X="DATP"
SET Y="dATP"
if $LENGTH($GET(Y))
QUIT
+2 if X="DCMP"
SET Y="dCMP"
if X="DCTP"
SET Y="dCTP"
if X="DGMP"
SET Y="dGMP"
if X="DGTP"
SET Y="dGTP"
if X="DSBA"
SET Y="dsbA"
if X="DTDP"
SET Y="dTDP"
if X="DTTP"
SET Y="dTTP"
if X="DUMP"
SET Y="dUMP"
if $LENGTH($GET(Y))
QUIT
+3 if X="DURD"
SET Y="dUrd"
if X="DUTP"
SET Y="dUTP"
if X="ECAI"
SET Y="EcaI"
if X="ECOK"
SET Y="EcoK"
if X="ERBB"
SET Y="erbB"
if X="FELV"
SET Y="FeLV"
if X="FMET"
SET Y="fMet"
if X="GNRH"
SET Y="GnRH"
if $LENGTH($GET(Y))
QUIT
+4 if X="GPII"
SET Y="gpII"
if X="HARG"
SET Y="hArg"
if X="HELA"
SET Y="HeLa"
if X="HGRF"
SET Y="hGRF"
if X="HHAI"
SET Y="HhaI"
if X="HPAI"
SET Y="HpaI"
if X="HPTH"
SET Y="hPTH"
if X="IIIA"
SET Y="IIIa"
if $LENGTH($GET(Y))
QUIT
+5 if X="KPNI"
SET Y="KpnI"
if X="MCRB"
SET Y="McrB"
if X="MESH"
SET Y="MeSH"
if X="MRNA"
SET Y="mRNA"
if X="NHET"
SET Y="NHEt"
if X="NHME"
SET Y="NHMe"
if X="OBZL"
SET Y="OBzl"
if X="OTBU"
SET Y="OtBu"
if $LENGTH($GET(Y))
QUIT
+6 if X="PGLU"
SET Y="pGlu"
if X="PSTI"
SET Y="PstI"
if X="REGA"
SET Y="regA"
if X="RRNA"
SET Y="rRNA"
if X="SCEI"
SET Y="SceI"
if X="TAQI"
SET Y="TaqI"
if X="TRFA"
SET Y="TrfA"
if X="TRKA"
SET Y="trkA"
if $LENGTH($GET(Y))
QUIT
+7 if X="TRKB"
SET Y="trkB"
if X="TRNA"
SET Y="tRNA"
if $LENGTH($GET(Y))
QUIT
+8 IF "^BATH^CITH^CITY^EAST^ERIE^FORT^HOME^IOWA^IRON^JUAN^JULY^JUNE^LAKE^LOMA^LONG^LYON^PALM^PALO^PARK^RENO^ROCK^SALT^SIDE^WACO^WEST^YORK^"[X
SET Y=$$MX(X)
QUIT
+9 IF "^BADR^BDEM^BMIC^EADT^MAGI^MEDA^MEDB^MEDC^MEDF^MHPE^RXIV^RXOP^"[X
SET Y=$$UP(X)
QUIT
+10 IF "^RXUD^SCL1^SCL2^HISA^HPSA^CRNA^HCFA^"[X
SET Y=$$UP(X)
QUIT
+11 ;I "^^"[X S Y=$$UP(X) Q
+12 IF "^A1B5^A1BG^A4A7^A4A8^A6K7^ABSV^ACKQ^DENT^DGHI^DGPW^DGY1^DGY3^DGYA^DGYB^DGYC^DGYD^DGYF^DGYG^DGYJ^DGYK^DGYL^DGYN^DGYO^DGYP^DGYQ^DGYR^DGYS^"[X
SET Y=$$UP(X)
QUIT
+13 IF "^DGYU^DGYV^DGYW^DGYX^DGYZ^DIPK^DVBA^DVBC^DVBQ^DVBT^DVBU^DVBW^DVBX^DVBY^EEOA^EEOP^ENXE^ENXF^ENXG^ENXI^"[X
SET Y=$$UP(X)
QUIT
+14 IF "^ENXJ^ENXK^FBAA^GECD^GECP^GECS^GMAA^GMD1^GMN1^GMN2^GMN3^GMN4^GMN5^GMPL^GMPT^GMRA^GMRC^GMRD^GMRE^GMRG"[X
SET Y=$$UP(X)
QUIT
+15 IF "^GMRP^GMRQ^GMRR^GMRS^GMRV^GMRY^GMTS^HBHC^IBDE^IBDP^IBQL^IBQY^IBY3^IBY4^IBY5^IBY6^IBY7^IBY8^IBY9^IBYA^"[X
SET Y=$$UP(X)
QUIT
+16 IF "^IBYB^IBYC^IBYD^IBYE^IBYF^IBYG^IBYH^IBYK^IBYL^IBYN^ICPT^LBRN^LBRT^LBRY^LR00^LR01^LR03^LRAR^LRLS^MCXX^"[X
SET Y=$$UP(X)
QUIT
+17 IF "^NURA^NURC^NURE^NURQ^NURX^ONCO^PRCA^PRCP^PRMQ^PRPF^PRSX^PRX0^PRX1^PRX8^PRXB^PRXC^PRXE^PRXF^PRXG^PRXI^PRXJ^"[X
SET Y=$$UP(X)
QUIT
+18 IF "^PRXK^PRXP^PRYA^PRYB^PRYC^PRYD^PRYF^PRYH^PRYJ^PRYL^PRYN^PRYP^PSA1^PSD1^PSGW^PSIV^PSJ1^PSJ4^PSOA^PSOB^PSOC^PSOD^PSOE^PSOG^PSOH^PSOJ^PSOL^"[X
SET Y=$$UP(X)
QUIT
+19 IF "^PSOY^PSW1^PSXC^QAN1^QAR1^QAR2^QARF^QARY^RAAA^RAAB^RAAC^RAAE^RAAF^RMPC^RMPF^RMPJ^RMPR^RMPT^RTYB^RTYC^RTYD^SDYA^SDYM^SDYN^SDYP^"[X
SET Y=$$UP(X)
QUIT
+20 IF "^SOWA^SOWC^SOWK^SROA^SRRS^SRRT^TIUJ^TIUW^TIUX^VALM^VEEM^VSIT^XQOR^XUFI^YS01^"[X
SET Y=$$UP(X)
QUIT
+21 IF "^AIDS^ANCA^ARPP^ATLV^BPDE^BUSI^CENP^CGRP^COOH^CPAP^CPEP^DHEA^DMBA^DSIP^DTPA^EBNA^EDTA^ERCC^ERCP^ESRD^FANA^FITC^FKBP^GABA^GATA^GHRH^GLUT^GYKI^HCMV^HIDA^HMSN^HSAN^HTLV^IDDM^INTP^IPPB^KAFO^LATS^LHRH^MAGE^MLVP^MPTP^"[X
SET Y=$$UP(X)
QUIT
+22 IF "^ANIT^CAMP^DOPS^MPTP^HETE^OERR^GMPT^GMPL^MTLU^UMLS^BPDE^DMBA^PABA^"[X
SET Y=$$UP(X)
QUIT
+23 IF "^MPTP^NADH^NADP^NAPS^NETT^NGFI^NRDC^NSCL^PAPS^POMC^PSAP^RTEM^SACH^SGOT^SNAP^SRIF^SRIH^TAPA^TATA^TCDD^TENS^TIMP^TLSO^UDPG^VIII^VLDL^WHFO^XIII^"[X
SET Y=$$UP(X)
QUIT
+24 IF "^USED^EACH^DTMN,FOUR^FIVE^NINE^HOUR^INTO^LESS^LIKE^MORE^ONLY^OPEN^OVER^PART^SITE^THAN^TYPE^WITH^"[X
SET Y=$$LO(X)
QUIT
+25 IF "^BEST^IT'S^LATE^SITE^FROM^SOME^WITH^UPON^THEY^THEN^INTO^MORE^THAN^THAT^THIS^THUS^HAVE^BEEN^NOTE^DONE^MUST^MERE^SURE^KIND^WHEN^WHAT^"[X
SET Y=$$LO(X)
QUIT
+26 IF "^LOST^LIKE^OURS^ALSO^EACH^ONLY^HERE^SUCH^SEEN^SAME^LESS^AREA^MANY^EVEN^LEFT^MOST^"[X
SET Y=$$LO(X)
QUIT
+27 QUIT
+28 ;
LO(X) QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
UP(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
MX(X) QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TRANSLATE($EXTRACT(X,2,$LENGTH(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
