XLFSTR ;ISC-SF/STAFF - String Functions ;04/18/12
;;8.0;KERNEL;**112,120,400,437,598**;Jul 10, 1995;Build 2
;Per VHA Directive 2004-038, this routine should not be modified
;
UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
LOW(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
;
STRIP(X,Y) Q $TR(X,$G(Y),"")
;
REPEAT(X,Y) ;
N % Q:'$D(X) "" I $L(X)*$G(Y)>245 Q ""
S %="",$P(%,X,$G(Y)+1)=""
Q %
;
SPLIT(%SRC,%DLM,%VLIST) ;split a string by delimiter vars in list
;returns number of vars in list
;usage - s %=$$split(src,dlm,"d1,d2,d3,..")
N I,V,DV
S DV=$$DVARS(%VLIST),%DLM=$G(%DLM,",")
F I=1:1:$L(%VLIST,DV) S V=$P(%VLIST,DV,I) S:V'="" @V=$P(%SRC,%DLM,I)
Q I
;
DVARS(LIST) ;return a delimiter for a list of variables
Q $S(%VLIST[$C(9):$C(9),%VLIST[";":";",1:",")
;
INVERT(X) ;
N %,%1 S %="" F %1=$L(X):-1:1 S %=%_$E(X,%1)
Q %
;
REPLACE(IN,SPEC) ;See $$REPLACE in MDC minutes.
Q:'$D(IN) "" Q:$D(SPEC)'>9 IN N %1,%2,%3,%4,%5,%6,%7,%8
S %1=$L(IN),%7=$J("",%1),%3="",%6=9999 F S %3=$O(SPEC(%3)) Q:%3="" S %6(%6)=%3,%6=%6-1
F %6=0:0 S %6=$O(%6(%6)) Q:%6'>0 S %3=%6(%6) D:$D(SPEC(%3))#2 RE1
S %8="" F %2=1:1:%1 D RE3
Q %8
;
RE1 S %4=$L(%3),%5=0 F S %5=$F(IN,%3,%5) Q:%5<1 D RE2
Q
RE2 Q:$E(%7,%5-%4,%5-1)["X" S %8(%5-%4)=SPEC(%3)
F %2=%5-%4:1:%5-1 S %7=$E(%7,1,%2-1)_"X"_$E(%7,%2+1,%1)
Q
RE3 I $E(%7,%2)=" " S %8=%8_$E(IN,%2) Q
S:$D(%8(%2)) %8=%8_%8(%2)
Q
;
RJ(%,%1,%2) ;Right justify
N %3
S:%1["T" %1=+%1,%=$E(%,1,%1)
S %3=$J("",%1-$L(%)) S:$D(%2) %3=$TR(%3," ",%2)
Q %3_%
;
LJ(%,%1,%2) ;Left justify
N %3
S:%1["T" %1=+%1,%=$E(%,1,%1)
S %3=$J("",%1-$L(%)) S:$G(%2)]"" %3=$TR(%3," ",%2)
Q %_%3
;
CJ(%,%1,%2) ;Center Justify
N %3,%4
S:%1["T" %1=+%1,%=$E(%,1,%1) S %3=%1-$L(%) Q:%3<1 %
S %3=%3\2,%4=$J("",%3+1) I $G(%2)]"" S %4=$TR(%4," ",%2)
Q $E(%4,1,%3)_%_$E(%4,1,%1-%3-$L(%))
;
QUOTE(%) ;Add quotes to value for concatenation
S %(%)=0,%=$Q(%)
Q $P($E(%,1,$L(%)-1),"(",2,999)
;
TRIM(%X,%F,%V) ;Trim spaces\char from front(left)/back(right) of string
N %R,%L
S %F=$$UP($G(%F,"LR")),%L=1,%R=$L(%X),%V=$G(%V," ")
;I %F["R" F %R=$L(%X):-1:1 Q:$E(%X,%R)'=%V ;take out BT
I %F["R" F %R=$L(%X):-1:0 Q:$E(%X,%R)'=%V ;598
;I %F["L" F %L=1:1:$L(%X) Q:$E(%X,%L)'=%V ;take out BT
I %F["L" F %L=1:1:$L(%X)+1 Q:$E(%X,%L)'=%V ;598
I (%L>%R)!(%X=%V) Q ""
Q $E(%X,%L,%R)
;
SENTENCE(%X) ;
; Converts a string into proper sentence case (first letter of each sentence
; upper case, all the others lower case)
; Example Usage:
; W $$SENTENCE^XLFSTR("HELLO WORLD!!! THIS IS A CAPITALIZED SENTENCE. (this isn't.)")
; produces
; Hello world!!! This is a capitalized sentence. This isn't.
;
; %S = string during conversion
; %P = state flag (1 = next letter should be caps)
; I = iteration index
; C = current character
;
N %I,%C,%S,%P
S %S=$$LOW(%X),%P=1
F %I=1:1:$L(%X) D
. S %C=$E(%S,%I)
. I %P,%C?1L S $E(%S,%I)=$$UP(%C),%P=0
. S:".!?"[%C %P=1
Q %S
;
TITLE(%X) ;
; Converts a string into TITLE CASE format (first letter of each word is uppercase)
; Example Usage:
; W $$TITLE^XLFSTR("THIS IS CAPITALIZED. (this isn't.)")
; produces
; This Is Capitalized. This Isn't.
;
; %S = string during conversion
; %P = state flag
; %I = iteration index
; %C = current character
;
N %I,%C,%S,%P
S %S=$$LOW(%X),%P=1
F %I=1:1:$L(%S) D
. S %C=$E(%S,%I)
. I %P,%C?1L S $E(%S,%I)=$$UP(%C),%P=0
. S:%C=" " %P=1
. Q
Q %S
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFSTR 3552 printed Oct 16, 2024@18:03:55 Page 2
XLFSTR ;ISC-SF/STAFF - String Functions ;04/18/12
+1 ;;8.0;KERNEL;**112,120,400,437,598**;Jul 10, 1995;Build 2
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
UP(X) QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+1 ;
LOW(X) QUIT $TRANSLATE(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+1 ;
STRIP(X,Y) QUIT $TRANSLATE(X,$GET(Y),"")
+1 ;
REPEAT(X,Y) ;
+1 NEW %
if '$DATA(X)
QUIT ""
IF $LENGTH(X)*$GET(Y)>245
QUIT ""
+2 SET %=""
SET $PIECE(%,X,$GET(Y)+1)=""
+3 QUIT %
+4 ;
SPLIT(%SRC,%DLM,%VLIST) ;split a string by delimiter vars in list
+1 ;returns number of vars in list
+2 ;usage - s %=$$split(src,dlm,"d1,d2,d3,..")
+3 NEW I,V,DV
+4 SET DV=$$DVARS(%VLIST)
SET %DLM=$GET(%DLM,",")
+5 FOR I=1:1:$LENGTH(%VLIST,DV)
SET V=$PIECE(%VLIST,DV,I)
if V'=""
SET @V=$PIECE(%SRC,%DLM,I)
+6 QUIT I
+7 ;
DVARS(LIST) ;return a delimiter for a list of variables
+1 QUIT $SELECT(%VLIST[$CHAR(9):$CHAR(9),%VLIST[";":";",1:",")
+2 ;
INVERT(X) ;
+1 NEW %,%1
SET %=""
FOR %1=$LENGTH(X):-1:1
SET %=%_$EXTRACT(X,%1)
+2 QUIT %
+3 ;
REPLACE(IN,SPEC) ;See $$REPLACE in MDC minutes.
+1 if '$DATA(IN)
QUIT ""
if $DATA(SPEC)'>9
QUIT IN
NEW %1,%2,%3,%4,%5,%6,%7,%8
+2 SET %1=$LENGTH(IN)
SET %7=$JUSTIFY("",%1)
SET %3=""
SET %6=9999
FOR
SET %3=$ORDER(SPEC(%3))
if %3=""
QUIT
SET %6(%6)=%3
SET %6=%6-1
+3 FOR %6=0:0
SET %6=$ORDER(%6(%6))
if %6'>0
QUIT
SET %3=%6(%6)
if $DATA(SPEC(%3))#2
DO RE1
+4 SET %8=""
FOR %2=1:1:%1
DO RE3
+5 QUIT %8
+6 ;
RE1 SET %4=$LENGTH(%3)
SET %5=0
FOR
SET %5=$FIND(IN,%3,%5)
if %5<1
QUIT
DO RE2
+1 QUIT
RE2 if $EXTRACT(%7,%5-%4,%5-1)["X"
QUIT
SET %8(%5-%4)=SPEC(%3)
+1 FOR %2=%5-%4:1:%5-1
SET %7=$EXTRACT(%7,1,%2-1)_"X"_$EXTRACT(%7,%2+1,%1)
+2 QUIT
RE3 IF $EXTRACT(%7,%2)=" "
SET %8=%8_$EXTRACT(IN,%2)
QUIT
+1 if $DATA(%8(%2))
SET %8=%8_%8(%2)
+2 QUIT
+3 ;
RJ(%,%1,%2) ;Right justify
+1 NEW %3
+2 if %1["T"
SET %1=+%1
SET %=$EXTRACT(%,1,%1)
+3 SET %3=$JUSTIFY("",%1-$LENGTH(%))
if $DATA(%2)
SET %3=$TRANSLATE(%3," ",%2)
+4 QUIT %3_%
+5 ;
LJ(%,%1,%2) ;Left justify
+1 NEW %3
+2 if %1["T"
SET %1=+%1
SET %=$EXTRACT(%,1,%1)
+3 SET %3=$JUSTIFY("",%1-$LENGTH(%))
if $GET(%2)]""
SET %3=$TRANSLATE(%3," ",%2)
+4 QUIT %_%3
+5 ;
CJ(%,%1,%2) ;Center Justify
+1 NEW %3,%4
+2 if %1["T"
SET %1=+%1
SET %=$EXTRACT(%,1,%1)
SET %3=%1-$LENGTH(%)
if %3<1
QUIT %
+3 SET %3=%3\2
SET %4=$JUSTIFY("",%3+1)
IF $GET(%2)]""
SET %4=$TRANSLATE(%4," ",%2)
+4 QUIT $EXTRACT(%4,1,%3)_%_$EXTRACT(%4,1,%1-%3-$LENGTH(%))
+5 ;
QUOTE(%) ;Add quotes to value for concatenation
+1 SET %(%)=0
SET %=$QUERY(%)
+2 QUIT $PIECE($EXTRACT(%,1,$LENGTH(%)-1),"(",2,999)
+3 ;
TRIM(%X,%F,%V) ;Trim spaces\char from front(left)/back(right) of string
+1 NEW %R,%L
+2 SET %F=$$UP($GET(%F,"LR"))
SET %L=1
SET %R=$LENGTH(%X)
SET %V=$GET(%V," ")
+3 ;I %F["R" F %R=$L(%X):-1:1 Q:$E(%X,%R)'=%V ;take out BT
+4 ;598
IF %F["R"
FOR %R=$LENGTH(%X):-1:0
if $EXTRACT(%X,%R)'=%V
QUIT
+5 ;I %F["L" F %L=1:1:$L(%X) Q:$E(%X,%L)'=%V ;take out BT
+6 ;598
IF %F["L"
FOR %L=1:1:$LENGTH(%X)+1
if $EXTRACT(%X,%L)'=%V
QUIT
+7 IF (%L>%R)!(%X=%V)
QUIT ""
+8 QUIT $EXTRACT(%X,%L,%R)
+9 ;
SENTENCE(%X) ;
+1 ; Converts a string into proper sentence case (first letter of each sentence
+2 ; upper case, all the others lower case)
+3 ; Example Usage:
+4 ; W $$SENTENCE^XLFSTR("HELLO WORLD!!! THIS IS A CAPITALIZED SENTENCE. (this isn't.)")
+5 ; produces
+6 ; Hello world!!! This is a capitalized sentence. This isn't.
+7 ;
+8 ; %S = string during conversion
+9 ; %P = state flag (1 = next letter should be caps)
+10 ; I = iteration index
+11 ; C = current character
+12 ;
+13 NEW %I,%C,%S,%P
+14 SET %S=$$LOW(%X)
SET %P=1
+15 FOR %I=1:1:$LENGTH(%X)
Begin DoDot:1
+16 SET %C=$EXTRACT(%S,%I)
+17 IF %P
IF %C?1L
SET $EXTRACT(%S,%I)=$$UP(%C)
SET %P=0
+18 if ".!?"[%C
SET %P=1
End DoDot:1
+19 QUIT %S
+20 ;
TITLE(%X) ;
+1 ; Converts a string into TITLE CASE format (first letter of each word is uppercase)
+2 ; Example Usage:
+3 ; W $$TITLE^XLFSTR("THIS IS CAPITALIZED. (this isn't.)")
+4 ; produces
+5 ; This Is Capitalized. This Isn't.
+6 ;
+7 ; %S = string during conversion
+8 ; %P = state flag
+9 ; %I = iteration index
+10 ; %C = current character
+11 ;
+12 NEW %I,%C,%S,%P
+13 SET %S=$$LOW(%X)
SET %P=1
+14 FOR %I=1:1:$LENGTH(%S)
Begin DoDot:1
+15 SET %C=$EXTRACT(%S,%I)
+16 IF %P
IF %C?1L
SET $EXTRACT(%S,%I)=$$UP(%C)
SET %P=0
+17 if %C=" "
SET %P=1
+18 QUIT
End DoDot:1
+19 QUIT %S
