TIUCOPSU ;SLC/TDP - Pasted Text Search Utilities ;03/12/19 13:26
;;1.0;TEXT INTEGRATION UTILITIES;**290**;JUN 20,1997;Build 548
;
; DBIA 10104 $$UP^XLFSTR
; DBIA 10018 ^DIE
;
EN ;
Q
;
SUB(SARY,PS) ;Determine next subscript in array
N X
;I SARY'="F",SARY'="S",SARY'="P",SARY'="T" Q "ERR"
I SARY'="T" Q "ERR"
S X=""
;I SARY="F" S X=$O(F(PS,X),-1)+1 Q X
;I SARY="S" S X=$O(S(X),-1)+1 Q X
;I SARY="P" S X=$O(P(X),-1)+1 Q X
I SARY="T" S X=$O(TMPARY(PS,X),-1)+1 Q $S(+X>0:X,1:1)
Q X
TRIM(T,PUNC) ;Trim leading and trailing spaces and leading punctuation from input
N BSPC,ESPC,TSPC
S T=$G(T)
I T="" Q T
S PUNC=+PUNC
I PUNC'=1 S PUNC=0
N X,DN,EX
S (BSPC,ESPC,TSPC,DN)=0
F X=$L(T):-1:1 D Q:DN=1
. S EX=$E(T,X)
. I EX=" " D Q:DN=1
.. S ESPC=ESPC+1
.. I X=1 S T="",DN=1 Q
.. I X>1 S T=$E(T,1,(X-1))
. I EX'=" " S DN=1
S DN=0
I PUNC=1 D
. F X=1:1:$L(T) D Q:DN=1
.. S EX=$E(T,1)
.. I (EX=" ")!("!.?"[EX) D Q:DN=1
... S BSPC=BSPC+1
... I 1=$L(T) S T="",DN=1 Q
... I 1<$L(T) S T=$E(T,2,$L(T))
.. I EX'=" ","!.?"'[EX S DN=1
I PUNC=0 D
. F X=1:1:$L(T) D Q:DN=1
.. S EX=$E(T,1)
.. I (EX=" ") D Q:DN=1
... S BSPC=BSPC+1
... I 1=$L(T) S T="",DN=1 Q
... I 1<$L(T) S T=$E(T,2,$L(T))
.. I EX'=" " S DN=1
S TSPC=BSPC+ESPC
Q T
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCOPSU 1318 printed Apr 09, 2024@21:47:25 Page 2
TIUCOPSU ;SLC/TDP - Pasted Text Search Utilities ;03/12/19 13:26
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**290**;JUN 20,1997;Build 548
+2 ;
+3 ; DBIA 10104 $$UP^XLFSTR
+4 ; DBIA 10018 ^DIE
+5 ;
EN ;
+1 QUIT
+2 ;
SUB(SARY,PS) ;Determine next subscript in array
+1 NEW X
+2 ;I SARY'="F",SARY'="S",SARY'="P",SARY'="T" Q "ERR"
+3 IF SARY'="T"
QUIT "ERR"
+4 SET X=""
+5 ;I SARY="F" S X=$O(F(PS,X),-1)+1 Q X
+6 ;I SARY="S" S X=$O(S(X),-1)+1 Q X
+7 ;I SARY="P" S X=$O(P(X),-1)+1 Q X
+8 IF SARY="T"
SET X=$ORDER(TMPARY(PS,X),-1)+1
QUIT $SELECT(+X>0:X,1:1)
+9 QUIT X
TRIM(T,PUNC) ;Trim leading and trailing spaces and leading punctuation from input
+1 NEW BSPC,ESPC,TSPC
+2 SET T=$GET(T)
+3 IF T=""
QUIT T
+4 SET PUNC=+PUNC
+5 IF PUNC'=1
SET PUNC=0
+6 NEW X,DN,EX
+7 SET (BSPC,ESPC,TSPC,DN)=0
+8 FOR X=$LENGTH(T):-1:1
Begin DoDot:1
+9 SET EX=$EXTRACT(T,X)
+10 IF EX=" "
Begin DoDot:2
+11 SET ESPC=ESPC+1
+12 IF X=1
SET T=""
SET DN=1
QUIT
+13 IF X>1
SET T=$EXTRACT(T,1,(X-1))
End DoDot:2
if DN=1
QUIT
+14 IF EX'=" "
SET DN=1
End DoDot:1
if DN=1
QUIT
+15 SET DN=0
+16 IF PUNC=1
Begin DoDot:1
+17 FOR X=1:1:$LENGTH(T)
Begin DoDot:2
+18 SET EX=$EXTRACT(T,1)
+19 IF (EX=" ")!("!.?"[EX)
Begin DoDot:3
+20 SET BSPC=BSPC+1
+21 IF 1=$LENGTH(T)
SET T=""
SET DN=1
QUIT
+22 IF 1<$LENGTH(T)
SET T=$EXTRACT(T,2,$LENGTH(T))
End DoDot:3
if DN=1
QUIT
+23 IF EX'=" "
IF "!.?"'[EX
SET DN=1
End DoDot:2
if DN=1
QUIT
End DoDot:1
+24 IF PUNC=0
Begin DoDot:1
+25 FOR X=1:1:$LENGTH(T)
Begin DoDot:2
+26 SET EX=$EXTRACT(T,1)
+27 IF (EX=" ")
Begin DoDot:3
+28 SET BSPC=BSPC+1
+29 IF 1=$LENGTH(T)
SET T=""
SET DN=1
QUIT
+30 IF 1<$LENGTH(T)
SET T=$EXTRACT(T,2,$LENGTH(T))
End DoDot:3
if DN=1
QUIT
+31 IF EX'=" "
SET DN=1
End DoDot:2
if DN=1
QUIT
End DoDot:1
+32 SET TSPC=BSPC+ESPC
+33 QUIT T
