LEXDDT2 ;ISL/KER - Display Defaults - Concatenate Text ;04/21/2014
;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
;
; Global Variables
; None
;
; External References
; None
;
CONCAT ; Concatenation of Data Elements
N LEXTI,LEXTL,LEXTP
PHRASE ; Get Phrase and Parse into Words
I $D(LEX(LEXT,"H")) S LEXTP=LEX(LEXT,"H"),LEXTI=0 D WORD
F LEXTI=1:1:LEX(LEXT,0) D
. S LEXTP=LEX(LEXT,LEXTI)
. S:LEXTP["/" LEXTP=$P(LEXTP,"/",1)_" or "_$P(LEXTP,"/",2),LEXTP=$$TRIM(LEXTP)
. I LEXTI=LEX(LEXT,0),LEX(LEXT,0)>1 D
. . S LEXTP="and "_LEXTP_"."
. . S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
. I LEXTI=LEX(LEXT,0),LEX(LEXT,0)'>1 D
. . S LEXTP=LEXTP_"."
. . S:$E(LEXTSTR,$L(LEXTSTR))["," LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1))
. D WORD I $L(LEXTSTR)>LEXSTLN D SET S LEXTSTR=""
I $D(LEX(LEXT,"T")) D
. F Q:$E(LEXTSTR,$L(LEXTSTR))'?1P S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1)) Q:$E(LEXTSTR,$L(LEXTSTR))'?1P
. S LEXTP=LEX(LEXT,"T"),LEXTI=0 D WORD
S LEXTSTR=$$TRIM(LEXTSTR)
Q
WORD ; Concatenate Word
N LEXTW,LEXTD F LEXTD=1:1:$L(LEXTP," ") D
. S LEXTW=$P(LEXTP," ",LEXTD),LEXTW=$$TRIM(LEXTW)
. I LEXTD=$L(LEXTP," "),LEXTI>0 S LEXTW=LEXTW_","
. I ($L(LEXTSTR)+$L(LEXTW)+1)'>LEXSTLN D Q
. . S LEXTSTR=LEXTSTR_" "_LEXTW
. I ($L(LEXTSTR)+$L(LEXTW)+1)>LEXSTLN D
. . D SET S LEXTSTR=LEXTW
Q
EOC ; End of Concatenation
F Q:$E(LEXTSTR,$L(LEXTSTR))'="," S LEXTSTR=$E(LEXTSTR,1,($L(LEXTSTR)-1)) Q:$E(LEXTSTR,$L(LEXTSTR))'=","
D SET
Q
SET ; Set Array Node
S LEXTCTR=LEXTCTR+1 S LEX(LEXTCTR)=$$TRIM(LEXTSTR),LEX(0)=LEXTCTR
Q
TRIM(X) ; Remove Spaces
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1)) Q:$E(X,$L(X))'=" "
F Q:$E(X,1)'=" " S X=$E(X,2,$L(X)) Q:$E(X,1)'=" "
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXDDT2 1809 printed Oct 16, 2024@18:08:12 Page 2
LEXDDT2 ;ISL/KER - Display Defaults - Concatenate Text ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; None
+8 ;
CONCAT ; Concatenation of Data Elements
+1 NEW LEXTI,LEXTL,LEXTP
PHRASE ; Get Phrase and Parse into Words
+1 IF $DATA(LEX(LEXT,"H"))
SET LEXTP=LEX(LEXT,"H")
SET LEXTI=0
DO WORD
+2 FOR LEXTI=1:1:LEX(LEXT,0)
Begin DoDot:1
+3 SET LEXTP=LEX(LEXT,LEXTI)
+4 if LEXTP["/"
SET LEXTP=$PIECE(LEXTP,"/",1)_" or "_$PIECE(LEXTP,"/",2)
SET LEXTP=$$TRIM(LEXTP)
+5 IF LEXTI=LEX(LEXT,0)
IF LEX(LEXT,0)>1
Begin DoDot:2
+6 SET LEXTP="and "_LEXTP_"."
+7 if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))[","
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
End DoDot:2
+8 IF LEXTI=LEX(LEXT,0)
IF LEX(LEXT,0)'>1
Begin DoDot:2
+9 SET LEXTP=LEXTP_"."
+10 if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))[","
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
End DoDot:2
+11 DO WORD
IF $LENGTH(LEXTSTR)>LEXSTLN
DO SET
SET LEXTSTR=""
End DoDot:1
+12 IF $DATA(LEX(LEXT,"T"))
Begin DoDot:1
+13 FOR
if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))'?1P
QUIT
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))'?1P
QUIT
+14 SET LEXTP=LEX(LEXT,"T")
SET LEXTI=0
DO WORD
End DoDot:1
+15 SET LEXTSTR=$$TRIM(LEXTSTR)
+16 QUIT
WORD ; Concatenate Word
+1 NEW LEXTW,LEXTD
FOR LEXTD=1:1:$LENGTH(LEXTP," ")
Begin DoDot:1
+2 SET LEXTW=$PIECE(LEXTP," ",LEXTD)
SET LEXTW=$$TRIM(LEXTW)
+3 IF LEXTD=$LENGTH(LEXTP," ")
IF LEXTI>0
SET LEXTW=LEXTW_","
+4 IF ($LENGTH(LEXTSTR)+$LENGTH(LEXTW)+1)'>LEXSTLN
Begin DoDot:2
+5 SET LEXTSTR=LEXTSTR_" "_LEXTW
End DoDot:2
QUIT
+6 IF ($LENGTH(LEXTSTR)+$LENGTH(LEXTW)+1)>LEXSTLN
Begin DoDot:2
+7 DO SET
SET LEXTSTR=LEXTW
End DoDot:2
End DoDot:1
+8 QUIT
EOC ; End of Concatenation
+1 FOR
if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))'=","
QUIT
SET LEXTSTR=$EXTRACT(LEXTSTR,1,($LENGTH(LEXTSTR)-1))
if $EXTRACT(LEXTSTR,$LENGTH(LEXTSTR))'=","
QUIT
+2 DO SET
+3 QUIT
SET ; Set Array Node
+1 SET LEXTCTR=LEXTCTR+1
SET LEX(LEXTCTR)=$$TRIM(LEXTSTR)
SET LEX(0)=LEXTCTR
+2 QUIT
TRIM(X) ; Remove Spaces
+1 FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
+2 FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
if $EXTRACT(X,1)'=" "
QUIT
+3 QUIT X
