XLFSTR.m

XLFSTR ;ISC-SF/STAFF - String Functions ;04/18/12

 ;;8.0;KERNEL;**112,120,400,437,598**;Jul 10, 1995;Build 3

 ;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

XLFSTR    ;ISC-SF/STAFF - String Functions ;04/18/12

 +1       ;;8.0;KERNEL;**112,120,400,437,598**;Jul 10, 1995;Build 3

 +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