- GMTSUMX ; SLC/KER - Convert Text to Mix Case ; 07/18/2000
- ;;2.7;Health Summary;**30,37**;Oct 20, 1995
- Q
- EN(X) ; Convert Case
- N Y,GMTSOK,GMTSOC,GMTSWORD,GMTSPC,GMTSLEAD,GMTSTLR,GMTSTR,GMTSCTR,GMTSPRE
- S (GMTSTR,GMTSWORD,GMTSPC)="",X=$$UP(X)
- ; Parse by Spaces
- F GMTSCTR=1:1:$L(X," ") D
- . S GMTSWORD=$P(X," ",GMTSCTR)
- . S (GMTSPC,GMTSLEAD,GMTSTLR)=""
- . I $E(GMTSWORD,1)="(" S GMTSWORD=$E(GMTSWORD,2,$L(GMTSWORD)),GMTSLEAD="("
- . I $E(GMTSWORD,$L(GMTSWORD))=")" S GMTSWORD=$E(GMTSWORD,1,($L(GMTSWORD)-1)),GMTSTLR=")"
- . ; String contains special characters
- . S GMTSOK=1 F GMTSOC="(",")","-","*","+","{","&","}","[","]","/","\","|",",","'" S:GMTSWORD[GMTSOC GMTSOK=0 Q:'GMTSOK
- . I 'GMTSOK D SP
- . I GMTSOK D GMTSWORD
- . S:GMTSLEAD'="" GMTSWORD=GMTSLEAD_GMTSWORD
- . S:GMTSTLR'="" GMTSWORD=GMTSWORD_GMTSTLR
- . S GMTSTR=GMTSTR_" "_GMTSWORD
- S X=$$TRIM(GMTSTR) Q X
- EN2(X) ; Convert Case 2
- S X=$$CK($$EN($G(X))) Q X
- SP ; Special Characters
- ; Special Cases of Special Characters
- I $$UP(GMTSWORD)="W/&W/O" S GMTSWORD="w/&w/o" Q
- I $$UP(GMTSWORD)="W&W/O" S GMTSWORD="w&w/o" Q
- I $$UP(GMTSWORD)="&/OR" S GMTSWORD="&/or" Q
- I GMTSWORD="W/O" S GMTSWORD="w/o" Q
- N GMTSOK,GMTSWD1,GMTSWD2,GMTSW,GMTSWCTR,GMTSCHR
- S GMTSWD1=GMTSWORD,GMTSWD2="",GMTSW=""
- F GMTSWCTR=1:1:$L(GMTSWD1) D
- . S GMTSCHR=$E(GMTSWD1,GMTSWCTR) I "()-*+{}'&[]/\|,"[GMTSCHR,$L(GMTSW) D Q
- . . S GMTSPRE=""
- . . S:$E(GMTSW,1,2)="ZZ"&($L(GMTSW)>2) GMTSPRE="ZZ",GMTSW=$E(GMTSW,3,$L(GMTSW))
- . . S GMTSW=GMTSPRE_$$CASE(GMTSW,GMTSCHR)
- . . S GMTSWD2=GMTSWD2_GMTSW_GMTSCHR,GMTSW=""
- . S GMTSW=GMTSW_GMTSCHR
- I $L(GMTSW) D
- . N GMTSPSN F GMTSPSN=1:1:$L(GMTSW) Q:"()-*+{}'&[]/\|,"'[$E(GMTSW,GMTSPSN)
- . N GMTSOW,GMTSLW S GMTSLW=$E(GMTSW,0,(GMTSPSN-1))
- . S GMTSOW=$E(GMTSW,GMTSPSN,$L(GMTSW))
- . S GMTSPRE="" S:$E(GMTSOW,1,2)="ZZ"&($L(GMTSOW)>2) GMTSPRE="ZZ",GMTSOW=$E(GMTSOW,3,$L(GMTSOW))
- . S GMTSOW=GMTSPRE_$$CASE(GMTSOW,$E($G(GMTSWD2),$L($G(GMTSWD2))))
- . S GMTSW=GMTSLW_GMTSOW
- . S GMTSWD2=GMTSWD2_GMTSW
- S GMTSWORD=GMTSWD2 S:GMTSCTR=1 GMTSWORD=$$LD(GMTSWORD)
- K GMTSWD1,GMTSWD2
- Q
- GMTSWORD ; Convert word
- S GMTSPRE="" S:$E(GMTSWORD,1,2)="ZZ"&($L(GMTSWORD)>2) GMTSPRE="ZZ",GMTSWORD=$E(GMTSWORD,3,$L(GMTSWORD))
- S GMTSWORD=GMTSPRE_$$CASE(GMTSWORD,"")
- Q
- CASE(X,J) ; Set to Mixed/lower/UPPER case
- N GMTSTAG,GMTSRTN,Y S X=$$UP($G(X)),Y="",GMTSTAG=$L(X),GMTSRTN="GMTSUMX2"
- S:+GMTSTAG>4 GMTSRTN="GMTSUMX3" S:+GMTSTAG>9 GMTSTAG="M"
- Q:+GMTSTAG=0&(GMTSTAG'="M") X
- S GMTSRTN=GMTSTAG_"^"_GMTSRTN D @GMTSRTN
- I $L(Y) S X=Y Q X
- S X=$$MX(X)
- Q X
- 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")
- LD(X) Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
- TRIM(X) 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
- CK(X) ;
- S X=$G(X)
- F Q:X'["(S)" S X=$P(X,"(S)",1)_"(s)"_$P(X,"(S)",2,299)
- F Q:X'[" A " S X=$P(X," A ",1)_" a "_$P(X," A ",2,229)
- I X["Class a" F Q:X'["Class a" S X=$P(X,"Class a",1)_"Class A"_$P(X,"Class a",2,229)
- I X["Type a" F Q:X'["Type a" S X=$P(X,"Type a",1)_"Type A"_$P(X,"Type a",2,229)
- F Q:X'["'S" S X=$P(X,"'S",1)_"'s"_$P(X,"'S",2,229)
- I X["mg Diet" F Q:X'["mg Diet" S X=$P(X,"mg Diet",1)_"MG Diet"_$P(X,"mg Diet",2,229)
- I X["LO-Fat" F Q:X'["LO-Fat" S X=$P(X,"LO-Fat",1)_"Lo-Fat"_$P(X,"LO-Fat",2,229)
- I $E(X,1)="'" S X="'"_$$LD($E(X,2,$L(X)))
- S X=$TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
- Q X
- TYPES ;
- N GMTSIEN S GMTSIEN=0 F S GMTSIEN=$O(^GMT(142,GMTSIEN)) Q:+GMTSIEN=0 D
- . N GMTSTXT S GMTSTXT=$P($G(^GMT(142,GMTSIEN,0)),"^",1)
- . I $L(GMTSTXT) W !!,GMTSTXT,!,$$EN^GMTSUMX(GMTSTXT)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSUMX 3953 printed Feb 18, 2025@23:26:56 Page 2
- GMTSUMX ; SLC/KER - Convert Text to Mix Case ; 07/18/2000
- +1 ;;2.7;Health Summary;**30,37**;Oct 20, 1995
- +2 QUIT
- EN(X) ; Convert Case
- +1 NEW Y,GMTSOK,GMTSOC,GMTSWORD,GMTSPC,GMTSLEAD,GMTSTLR,GMTSTR,GMTSCTR,GMTSPRE
- +2 SET (GMTSTR,GMTSWORD,GMTSPC)=""
- SET X=$$UP(X)
- +3 ; Parse by Spaces
- +4 FOR GMTSCTR=1:1:$LENGTH(X," ")
- Begin DoDot:1
- +5 SET GMTSWORD=$PIECE(X," ",GMTSCTR)
- +6 SET (GMTSPC,GMTSLEAD,GMTSTLR)=""
- +7 IF $EXTRACT(GMTSWORD,1)="("
- SET GMTSWORD=$EXTRACT(GMTSWORD,2,$LENGTH(GMTSWORD))
- SET GMTSLEAD="("
- +8 IF $EXTRACT(GMTSWORD,$LENGTH(GMTSWORD))=")"
- SET GMTSWORD=$EXTRACT(GMTSWORD,1,($LENGTH(GMTSWORD)-1))
- SET GMTSTLR=")"
- +9 ; String contains special characters
- +10 SET GMTSOK=1
- FOR GMTSOC="(",")","-","*","+","{","&","}","[","]","/","\","|",",","'"
- if GMTSWORD[GMTSOC
- SET GMTSOK=0
- if 'GMTSOK
- QUIT
- +11 IF 'GMTSOK
- DO SP
- +12 IF GMTSOK
- DO GMTSWORD
- +13 if GMTSLEAD'=""
- SET GMTSWORD=GMTSLEAD_GMTSWORD
- +14 if GMTSTLR'=""
- SET GMTSWORD=GMTSWORD_GMTSTLR
- +15 SET GMTSTR=GMTSTR_" "_GMTSWORD
- End DoDot:1
- +16 SET X=$$TRIM(GMTSTR)
- QUIT X
- EN2(X) ; Convert Case 2
- +1 SET X=$$CK($$EN($GET(X)))
- QUIT X
- SP ; Special Characters
- +1 ; Special Cases of Special Characters
- +2 IF $$UP(GMTSWORD)="W/&W/O"
- SET GMTSWORD="w/&w/o"
- QUIT
- +3 IF $$UP(GMTSWORD)="W&W/O"
- SET GMTSWORD="w&w/o"
- QUIT
- +4 IF $$UP(GMTSWORD)="&/OR"
- SET GMTSWORD="&/or"
- QUIT
- +5 IF GMTSWORD="W/O"
- SET GMTSWORD="w/o"
- QUIT
- +6 NEW GMTSOK,GMTSWD1,GMTSWD2,GMTSW,GMTSWCTR,GMTSCHR
- +7 SET GMTSWD1=GMTSWORD
- SET GMTSWD2=""
- SET GMTSW=""
- +8 FOR GMTSWCTR=1:1:$LENGTH(GMTSWD1)
- Begin DoDot:1
- +9 SET GMTSCHR=$EXTRACT(GMTSWD1,GMTSWCTR)
- IF "()-*+{}'&[]/\|,"[GMTSCHR
- IF $LENGTH(GMTSW)
- Begin DoDot:2
- +10 SET GMTSPRE=""
- +11 if $EXTRACT(GMTSW,1,2)="ZZ"&($LENGTH(GMTSW)>2)
- SET GMTSPRE="ZZ"
- SET GMTSW=$EXTRACT(GMTSW,3,$LENGTH(GMTSW))
- +12 SET GMTSW=GMTSPRE_$$CASE(GMTSW,GMTSCHR)
- +13 SET GMTSWD2=GMTSWD2_GMTSW_GMTSCHR
- SET GMTSW=""
- End DoDot:2
- QUIT
- +14 SET GMTSW=GMTSW_GMTSCHR
- End DoDot:1
- +15 IF $LENGTH(GMTSW)
- Begin DoDot:1
- +16 NEW GMTSPSN
- FOR GMTSPSN=1:1:$LENGTH(GMTSW)
- if "()-*+{}'&[]/\|,"'[$EXTRACT(GMTSW,GMTSPSN)
- QUIT
- +17 NEW GMTSOW,GMTSLW
- SET GMTSLW=$EXTRACT(GMTSW,0,(GMTSPSN-1))
- +18 SET GMTSOW=$EXTRACT(GMTSW,GMTSPSN,$LENGTH(GMTSW))
- +19 SET GMTSPRE=""
- if $EXTRACT(GMTSOW,1,2)="ZZ"&($LENGTH(GMTSOW)>2)
- SET GMTSPRE="ZZ"
- SET GMTSOW=$EXTRACT(GMTSOW,3,$LENGTH(GMTSOW))
- +20 SET GMTSOW=GMTSPRE_$$CASE(GMTSOW,$EXTRACT($GET(GMTSWD2),$LENGTH($GET(GMTSWD2))))
- +21 SET GMTSW=GMTSLW_GMTSOW
- +22 SET GMTSWD2=GMTSWD2_GMTSW
- End DoDot:1
- +23 SET GMTSWORD=GMTSWD2
- if GMTSCTR=1
- SET GMTSWORD=$$LD(GMTSWORD)
- +24 KILL GMTSWD1,GMTSWD2
- +25 QUIT
- GMTSWORD ; Convert word
- +1 SET GMTSPRE=""
- if $EXTRACT(GMTSWORD,1,2)="ZZ"&($LENGTH(GMTSWORD)>2)
- SET GMTSPRE="ZZ"
- SET GMTSWORD=$EXTRACT(GMTSWORD,3,$LENGTH(GMTSWORD))
- +2 SET GMTSWORD=GMTSPRE_$$CASE(GMTSWORD,"")
- +3 QUIT
- CASE(X,J) ; Set to Mixed/lower/UPPER case
- +1 NEW GMTSTAG,GMTSRTN,Y
- SET X=$$UP($GET(X))
- SET Y=""
- SET GMTSTAG=$LENGTH(X)
- SET GMTSRTN="GMTSUMX2"
- +2 if +GMTSTAG>4
- SET GMTSRTN="GMTSUMX3"
- if +GMTSTAG>9
- SET GMTSTAG="M"
- +3 if +GMTSTAG=0&(GMTSTAG'="M")
- QUIT X
- +4 SET GMTSRTN=GMTSTAG_"^"_GMTSRTN
- DO @GMTSRTN
- +5 IF $LENGTH(Y)
- SET X=Y
- QUIT X
- +6 SET X=$$MX(X)
- +7 QUIT X
- 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")
- LD(X) QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
- TRIM(X) SET X=$GET(X)
- FOR
- if $EXTRACT(X,1)'=" "
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +1 FOR
- if $EXTRACT(X,$LENGTH(X))'=" "
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +2 QUIT X
- CK(X) ;
- +1 SET X=$GET(X)
- +2 FOR
- if X'["(S)"
- QUIT
- SET X=$PIECE(X,"(S)",1)_"(s)"_$PIECE(X,"(S)",2,299)
- +3 FOR
- if X'[" A "
- QUIT
- SET X=$PIECE(X," A ",1)_" a "_$PIECE(X," A ",2,229)
- +4 IF X["Class a"
- FOR
- if X'["Class a"
- QUIT
- SET X=$PIECE(X,"Class a",1)_"Class A"_$PIECE(X,"Class a",2,229)
- +5 IF X["Type a"
- FOR
- if X'["Type a"
- QUIT
- SET X=$PIECE(X,"Type a",1)_"Type A"_$PIECE(X,"Type a",2,229)
- +6 FOR
- if X'["'S"
- QUIT
- SET X=$PIECE(X,"'S",1)_"'s"_$PIECE(X,"'S",2,229)
- +7 IF X["mg Diet"
- FOR
- if X'["mg Diet"
- QUIT
- SET X=$PIECE(X,"mg Diet",1)_"MG Diet"_$PIECE(X,"mg Diet",2,229)
- +8 IF X["LO-Fat"
- FOR
- if X'["LO-Fat"
- QUIT
- SET X=$PIECE(X,"LO-Fat",1)_"Lo-Fat"_$PIECE(X,"LO-Fat",2,229)
- +9 IF $EXTRACT(X,1)="'"
- SET X="'"_$$LD($EXTRACT(X,2,$LENGTH(X)))
- +10 SET X=$TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
- +11 QUIT X
- TYPES ;
- +1 NEW GMTSIEN
- SET GMTSIEN=0
- FOR
- SET GMTSIEN=$ORDER(^GMT(142,GMTSIEN))
- if +GMTSIEN=0
- QUIT
- Begin DoDot:1
- +2 NEW GMTSTXT
- SET GMTSTXT=$PIECE($GET(^GMT(142,GMTSIEN,0)),"^",1)
- +3 IF $LENGTH(GMTSTXT)
- WRITE !!,GMTSTXT,!,$$EN^GMTSUMX(GMTSTXT)
- End DoDot:1
- +4 QUIT