- 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 Mar 13, 2025@21:12:01 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
