ICDTOKN ;DLS/DEK - Parse Text ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
;
; Global Variables
; None
;
; External References
; $$UP^XLFSTR ICR 10104
;
Q
TOK(X) ; Parse Text into Tokens in array PARS()
K PARS D PAR($G(X),.PARS,1)
Q
TOKEN(X,ROOT,SYS,ARY) ; Parse Text into Tokens
;
; Input
;
; X Text (Required)
;
; ROOT Global Root/File # (Required)
;
; ^ICD9( or 80
; ^ICD0( or 80.1
;
; SYS Coding System (Required)
;
; 1 or ICD or ICD-9-CM
; 2 or ICP or ICD-9 Proc
; 30 or 10D or ICD-10-CM
; 31 or 10P or ICD-10-PCS
;
; .ARY Output array passed by reference (Required)
;
; This is an array of words parsed from the input
; string X arranged by frequency of use
;
; ARY(0)=# of words
; ARY(#)=word
;
; The least frequently used word will be ARY(1)
; and the most frequently used word will be
; ARY($O(ARY(" "),-1)). words not found in
; the file and coding system will not appear in
; the parsed array.
;
; D TOKEN^ICDTOKN($G(X),$G(ROOT),$G(SYS),.ARY) is called
; TOKEN^ICDEX to parse words in use order
;
N TMP,ORD,NUM,IEN,USAGE,ABBR,TOKEN K ARY,TMP,ORD S ROOT=$$ROOT^ICDEX($G(ROOT)),SYS=$$SYS^ICDEX($G(SYS)) D PAR($G(X),.TMP)
K ORD S IEN=0 F S IEN=$O(TMP(IEN)) Q:+IEN'>0 D
. N NUM,SEG S SEG=$G(TMP(IEN)) Q:$L(SEG)'>1
. S USAGE=$$CT(SEG,ROOT,SYS),ABBR=+($P(USAGE,"^",2)),USAGE=+USAGE
. S NUM=$O(ORD(+USAGE," "),-1)+1
. S ORD(+USAGE,NUM)=SEG
. S:ABBR>0 ORD(+USAGE,NUM,"A")=1
K ARY S USAGE="" F S USAGE=$O(ORD(USAGE)) Q:'$L(USAGE) D
. N NUM S NUM=0 F S NUM=$O(ORD(USAGE,NUM)) Q:+NUM'>0 D
. . N SEG,INC S SEG=$G(ORD(USAGE,NUM)) Q:'$L(SEG)
. . S INC=$O(ARY(" "),-1)+1,ARY(INC)=SEG
. . S:+($G(ORD(+USAGE,NUM,"A")))>0 ARY(INC,"A")=1
K TMP,ORD S IEN=0 F S IEN=$O(ARY(IEN)) Q:+IEN'>0 S ARY(0)=$G(ARY(0))+1
Q
CT(SEG,ROOT,SYS) ; Count Usage
S SEG=$G(SEG) Q:'$L(SEG) 0 S ROOT=$G(ROOT) Q:'$L(ROOT) 0 S SYS=+($G(SYS))
N EROOT,IEN,CNT,ABR S (ABR,CNT)=0
S EROOT=ROOT_"""D""," S:+SYS>0&($D(@(ROOT_"""AD"","_+SYS_")"))) EROOT=ROOT_"""AD"","_+SYS_","
I $D(@(EROOT_""""_SEG_""")")) D
. N IEN S IEN=0 F S IEN=$O(@(EROOT_""""_SEG_""","_+IEN_")")) Q:+IEN'>0 D
. . S CNT=CNT+1 N EFF S EFF="" F S EFF=$O(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""")")) Q:'$L(EFF)!(EFF'?7N) D
. . . N TIEN S TIEN=0 F S TIEN=$O(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""","_+TIEN_")")) Q:+TIEN'>0 D
. . . . S:$O(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""","_+TIEN_",0)"))>0 ABR=ABR+1
I '$D(@(EROOT_""""_SEG_""")")) D
. N ORD,IEN S ORD=$E(SEG,1,($L(SEG)-1))_$C(($A($E(SEG,$L(SEG)))-1))_"~"
. F S ORD=$O(@(EROOT_""""_ORD_""")")) Q:$E(ORD,1,$L(SEG))'=SEG D
. . S IEN=0 F S IEN=$O(@(EROOT_""""_ORD_""","_+IEN_")")) Q:+IEN'>0 D
. . . S CNT=CNT+1 N EFF S EFF="" F S EFF=$O(@(EROOT_""""_SEG_""","""_EFF_""")")) Q:'$L(EFF)!(EFF'?7N) D
. . . . N TIEN S TIEN=0 F S TIEN=$O(@(EROOT_""""_SEG_""","""_EFF_""","_+TIEN_")")) Q:+TIEN'>0 D
. . . . . S:$O(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""","_+TIEN_",0)"))>0 ABR=ABR+1
S ABR=$S(CNT>0&(CNT=ABR):1,1:0) S CNT=CNT_"^"_ABR
Q CNT
PAR(X,ARY,FLG) ; Parse
;
; Called by ICDIDX for indexing words
; D PAR^ICDTOKN($G(X),.ARY,0)
;
; Called by ICDEXLK3 for lookup of words
; D PAR^ICDTOKN($G(X),.PARS,1)
;
N BEG,END,CHR,I,NUM,TXT,PIE S TXT=$$UP^XLFSTR(X),TXT=$$SWAP(TXT)
K ARY S BEG=1 F END=1:1:$L(TXT)+1 D
. S CHR=$E(TXT,END) I "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[CHR D
. . S PIE=$E(TXT,BEG,END-1),BEG=END+1
. . I $L(PIE)>1,$L(PIE)<31,$$EXC(PIE) D
. . . Q:$D(ARY("B",PIE)) N I,NUM S NUM=(246-$L(PIE))
. . . I +($G(FLG))'>0 S I=$O(ARY(" "),-1)+1,ARY(I)=PIE,ARY("B",PIE)="" Q
. . . S I=$O(ARY(+($G(NUM))," "),-1)+1,ARY(+($G(NUM)),I)=PIE,ARY("B",PIE)=""
K ARY("B") S NUM=0 F S NUM=$O(ARY(NUM)) Q:+NUM'>0 D
. I +($G(FLG))'>0 S ARY(0)=$G(ARY(0))+1 Q
. N I S I=0 F S I=$O(ARY(NUM,I)) Q:+I'>0 S ARY(0)=$G(ARY(0))+1
Q
EXC(X) ; Exclusions
Q:$L($G(X))'>1 0
Q:"^ABOUT^AFTER^ALMOST^ALSO^ALTHOUGH^AND^ANOTHER^"[("^"_$G(X)_"^") 0
Q:"^ANY^ARE^AREA^AREAS^AT^BE^BEEN^BEFORE^BEST^BUT^"[("^"_$G(X)_"^") 0
Q:"^BY^CAN^COULD^DONE^EACH^EVEN^FAR^FOR^FORM^FORMS^"[("^"_$G(X)_"^") 0
Q:"^FROM^GIVEN^HAD^HAVE^HER^HERE^HERSELF^HIM^"[("^"_$G(X)_"^") 0
Q:"^HIMSELF^HIS^HOW^IN^INTO^IS^IT^IT'S^ITS^ITS'^"[("^"_$G(X)_"^") 0
Q:"^ITSELF^KIND^LIKE^LOST^MANY^MAY^MERE^MORE^MOST^"[("^"_$G(X)_"^") 0
Q:"^MUST^NEW^NOTE^NOW^OF^OFTEN^ON^ONESELF^ONLY^"[("^"_$G(X)_"^") 0
Q:"^OR^OUR^OURS^OUT^OWN^PUT^SAME^SET^SHOULD^SOME^"[("^"_$G(X)_"^") 0
Q:"^SUCH^STATED^SURE^THAN^THAT^THE^THEN^THERE^THEREBY^"[("^"_$G(X)_"^") 0
Q:"^THESE^THEY^THIS^THUS^TO^TOO^UPON^WAS^"[("^"_$G(X)_"^") 0
Q:"^WHAT^WHEN^WHERE^WHICH^WHO^WHOSE^WITHIN^"[("^"_$G(X)_"^") 0
Q:"^WOULD^"[("^"_$G(X)_"^") 0
Q 1
;
SWAP(X) ; Special Case Word Swap
;
; This sub-routine swaps one word for another
; This swap must apply to both Lookup and Indexing
; This swap only applies to uppercase text
; These words cannot be Replacement Words in file 757.05
;
N TXT S (X,TXT)=$G(X) Q:'$L(TXT) X
S (X,TXT)=$$UP^XLFSTR(X) N SEG
F SEG="X-RAY","X RAY" D
. I TXT[SEG S TXT=$$SW(TXT,SEG,"XRAY")
F SEG="E.COLI","E COLI","E. COLI" D
. I TXT[SEG S TXT=$$SW(TXT,SEG,"ECOLI")
S X=$G(TXT)
Q X
SW(X,SEG1,SEG2) ; Swap text SEG1 for SEG2 in X
;
; Input
;
; X Text string
; SEG1 Word to remove in string (replace)
; SEG2 Word to insert in string (with)
;
; Output
;
; X Text string without SEG1
;
N TXT,NOT,CHR,LEAD,TRAIL S (X,TXT)=$G(X) Q:'$L(TXT) X S SEG1=$G(SEG1)
Q:'$L(SEG1) X S SEG2=$G(SEG2) Q:'$L(SEG2) X Q:TXT'[SEG1 X
S NOT="~!@#$%^&*()_+`{}|[]\:;'<>?,./" I TXT=SEG1 S X=SEG2 Q X
I $E(TXT,1,$L(SEG1))=SEG1 D
. N CHR S CHR=$E(TXT,($L(SEG1)+1)) Q:CHR'=" "
. S TXT=SEG2_$E(TXT,($L(SEG1)+1),$L(TXT))
F LEAD=" ","-","(","<","{","[","," D
. N REP,WIT F TRAIL=" ","-",")",">","}","]","," D
. . N REP,WIT
. . S REP=LEAD_SEG1_TRAIL,WIT=LEAD_SEG2_TRAIL
. . Q:TXT'[REP
. . F Q:TXT'[REP S TXT=$P(TXT,REP,1)_WIT_$P(TXT,REP,2)
. S REP=LEAD_SEG1,WIT=LEAD_SEG2
. I TXT[REP,$L($P(TXT,REP,1)),'$L($P(TXT,REP,2)) D
. . S TXT=$P(TXT,REP,1)_WIT
S X=$G(TXT)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDTOKN 6549 printed Nov 22, 2024@17:02:55 Page 2
ICDTOKN ;DLS/DEK - Parse Text ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$UP^XLFSTR ICR 10104
+8 ;
+9 QUIT
TOK(X) ; Parse Text into Tokens in array PARS()
+1 KILL PARS
DO PAR($GET(X),.PARS,1)
+2 QUIT
TOKEN(X,ROOT,SYS,ARY) ; Parse Text into Tokens
+1 ;
+2 ; Input
+3 ;
+4 ; X Text (Required)
+5 ;
+6 ; ROOT Global Root/File # (Required)
+7 ;
+8 ; ^ICD9( or 80
+9 ; ^ICD0( or 80.1
+10 ;
+11 ; SYS Coding System (Required)
+12 ;
+13 ; 1 or ICD or ICD-9-CM
+14 ; 2 or ICP or ICD-9 Proc
+15 ; 30 or 10D or ICD-10-CM
+16 ; 31 or 10P or ICD-10-PCS
+17 ;
+18 ; .ARY Output array passed by reference (Required)
+19 ;
+20 ; This is an array of words parsed from the input
+21 ; string X arranged by frequency of use
+22 ;
+23 ; ARY(0)=# of words
+24 ; ARY(#)=word
+25 ;
+26 ; The least frequently used word will be ARY(1)
+27 ; and the most frequently used word will be
+28 ; ARY($O(ARY(" "),-1)). words not found in
+29 ; the file and coding system will not appear in
+30 ; the parsed array.
+31 ;
+32 ; D TOKEN^ICDTOKN($G(X),$G(ROOT),$G(SYS),.ARY) is called
+33 ; TOKEN^ICDEX to parse words in use order
+34 ;
+35 NEW TMP,ORD,NUM,IEN,USAGE,ABBR,TOKEN
KILL ARY,TMP,ORD
SET ROOT=$$ROOT^ICDEX($GET(ROOT))
SET SYS=$$SYS^ICDEX($GET(SYS))
DO PAR($GET(X),.TMP)
+36 KILL ORD
SET IEN=0
FOR
SET IEN=$ORDER(TMP(IEN))
if +IEN'>0
QUIT
Begin DoDot:1
+37 NEW NUM,SEG
SET SEG=$GET(TMP(IEN))
if $LENGTH(SEG)'>1
QUIT
+38 SET USAGE=$$CT(SEG,ROOT,SYS)
SET ABBR=+($PIECE(USAGE,"^",2))
SET USAGE=+USAGE
+39 SET NUM=$ORDER(ORD(+USAGE," "),-1)+1
+40 SET ORD(+USAGE,NUM)=SEG
+41 if ABBR>0
SET ORD(+USAGE,NUM,"A")=1
End DoDot:1
+42 KILL ARY
SET USAGE=""
FOR
SET USAGE=$ORDER(ORD(USAGE))
if '$LENGTH(USAGE)
QUIT
Begin DoDot:1
+43 NEW NUM
SET NUM=0
FOR
SET NUM=$ORDER(ORD(USAGE,NUM))
if +NUM'>0
QUIT
Begin DoDot:2
+44 NEW SEG,INC
SET SEG=$GET(ORD(USAGE,NUM))
if '$LENGTH(SEG)
QUIT
+45 SET INC=$ORDER(ARY(" "),-1)+1
SET ARY(INC)=SEG
+46 if +($GET(ORD(+USAGE,NUM,"A")))>0
SET ARY(INC,"A")=1
End DoDot:2
End DoDot:1
+47 KILL TMP,ORD
SET IEN=0
FOR
SET IEN=$ORDER(ARY(IEN))
if +IEN'>0
QUIT
SET ARY(0)=$GET(ARY(0))+1
+48 QUIT
CT(SEG,ROOT,SYS) ; Count Usage
+1 SET SEG=$GET(SEG)
if '$LENGTH(SEG)
QUIT 0
SET ROOT=$GET(ROOT)
if '$LENGTH(ROOT)
QUIT 0
SET SYS=+($GET(SYS))
+2 NEW EROOT,IEN,CNT,ABR
SET (ABR,CNT)=0
+3 SET EROOT=ROOT_"""D"","
if +SYS>0&($DATA(@(ROOT_"""AD"","_+SYS_")")))
SET EROOT=ROOT_"""AD"","_+SYS_","
+4 IF $DATA(@(EROOT_""""_SEG_""")"))
Begin DoDot:1
+5 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(@(EROOT_""""_SEG_""","_+IEN_")"))
if +IEN'>0
QUIT
Begin DoDot:2
+6 SET CNT=CNT+1
NEW EFF
SET EFF=""
FOR
SET EFF=$ORDER(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""")"))
if '$LENGTH(EFF)!(EFF'?7N)
QUIT
Begin DoDot:3
+7 NEW TIEN
SET TIEN=0
FOR
SET TIEN=$ORDER(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""","_+TIEN_")"))
if +TIEN'>0
QUIT
Begin DoDot:4
+8 if $ORDER(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""","_+TIEN_",0)"))>0
SET ABR=ABR+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 IF '$DATA(@(EROOT_""""_SEG_""")"))
Begin DoDot:1
+10 NEW ORD,IEN
SET ORD=$EXTRACT(SEG,1,($LENGTH(SEG)-1))_$CHAR(($ASCII($EXTRACT(SEG,$LENGTH(SEG)))-1))_"~"
+11 FOR
SET ORD=$ORDER(@(EROOT_""""_ORD_""")"))
if $EXTRACT(ORD,1,$LENGTH(SEG))'=SEG
QUIT
Begin DoDot:2
+12 SET IEN=0
FOR
SET IEN=$ORDER(@(EROOT_""""_ORD_""","_+IEN_")"))
if +IEN'>0
QUIT
Begin DoDot:3
+13 SET CNT=CNT+1
NEW EFF
SET EFF=""
FOR
SET EFF=$ORDER(@(EROOT_""""_SEG_""","""_EFF_""")"))
if '$LENGTH(EFF)!(EFF'?7N)
QUIT
Begin DoDot:4
+14 NEW TIEN
SET TIEN=0
FOR
SET TIEN=$ORDER(@(EROOT_""""_SEG_""","""_EFF_""","_+TIEN_")"))
if +TIEN'>0
QUIT
Begin DoDot:5
+15 if $ORDER(@(EROOT_""""_SEG_""","_+IEN_","""_EFF_""","_+TIEN_",0)"))>0
SET ABR=ABR+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET ABR=$SELECT(CNT>0&(CNT=ABR):1,1:0)
SET CNT=CNT_"^"_ABR
+17 QUIT CNT
PAR(X,ARY,FLG) ; Parse
+1 ;
+2 ; Called by ICDIDX for indexing words
+3 ; D PAR^ICDTOKN($G(X),.ARY,0)
+4 ;
+5 ; Called by ICDEXLK3 for lookup of words
+6 ; D PAR^ICDTOKN($G(X),.PARS,1)
+7 ;
+8 NEW BEG,END,CHR,I,NUM,TXT,PIE
SET TXT=$$UP^XLFSTR(X)
SET TXT=$$SWAP(TXT)
+9 KILL ARY
SET BEG=1
FOR END=1:1:$LENGTH(TXT)+1
Begin DoDot:1
+10 SET CHR=$EXTRACT(TXT,END)
IF "~!@#$%&*()_+`-=[]{};'\:|,./?<> """[CHR
Begin DoDot:2
+11 SET PIE=$EXTRACT(TXT,BEG,END-1)
SET BEG=END+1
+12 IF $LENGTH(PIE)>1
IF $LENGTH(PIE)<31
IF $$EXC(PIE)
Begin DoDot:3
+13 if $DATA(ARY("B",PIE))
QUIT
NEW I,NUM
SET NUM=(246-$LENGTH(PIE))
+14 IF +($GET(FLG))'>0
SET I=$ORDER(ARY(" "),-1)+1
SET ARY(I)=PIE
SET ARY("B",PIE)=""
QUIT
+15 SET I=$ORDER(ARY(+($GET(NUM))," "),-1)+1
SET ARY(+($GET(NUM)),I)=PIE
SET ARY("B",PIE)=""
End DoDot:3
End DoDot:2
End DoDot:1
+16 KILL ARY("B")
SET NUM=0
FOR
SET NUM=$ORDER(ARY(NUM))
if +NUM'>0
QUIT
Begin DoDot:1
+17 IF +($GET(FLG))'>0
SET ARY(0)=$GET(ARY(0))+1
QUIT
+18 NEW I
SET I=0
FOR
SET I=$ORDER(ARY(NUM,I))
if +I'>0
QUIT
SET ARY(0)=$GET(ARY(0))+1
End DoDot:1
+19 QUIT
EXC(X) ; Exclusions
+1 if $LENGTH($GET(X))'>1
QUIT 0
+2 if "^ABOUT^AFTER^ALMOST^ALSO^ALTHOUGH^AND^ANOTHER^"[("^"_$GET(X)_"^")
QUIT 0
+3 if "^ANY^ARE^AREA^AREAS^AT^BE^BEEN^BEFORE^BEST^BUT^"[("^"_$GET(X)_"^")
QUIT 0
+4 if "^BY^CAN^COULD^DONE^EACH^EVEN^FAR^FOR^FORM^FORMS^"[("^"_$GET(X)_"^")
QUIT 0
+5 if "^FROM^GIVEN^HAD^HAVE^HER^HERE^HERSELF^HIM^"[("^"_$GET(X)_"^")
QUIT 0
+6 if "^HIMSELF^HIS^HOW^IN^INTO^IS^IT^IT'S^ITS^ITS'^"[("^"_$GET(X)_"^")
QUIT 0
+7 if "^ITSELF^KIND^LIKE^LOST^MANY^MAY^MERE^MORE^MOST^"[("^"_$GET(X)_"^")
QUIT 0
+8 if "^MUST^NEW^NOTE^NOW^OF^OFTEN^ON^ONESELF^ONLY^"[("^"_$GET(X)_"^")
QUIT 0
+9 if "^OR^OUR^OURS^OUT^OWN^PUT^SAME^SET^SHOULD^SOME^"[("^"_$GET(X)_"^")
QUIT 0
+10 if "^SUCH^STATED^SURE^THAN^THAT^THE^THEN^THERE^THEREBY^"[("^"_$GET(X)_"^")
QUIT 0
+11 if "^THESE^THEY^THIS^THUS^TO^TOO^UPON^WAS^"[("^"_$GET(X)_"^")
QUIT 0
+12 if "^WHAT^WHEN^WHERE^WHICH^WHO^WHOSE^WITHIN^"[("^"_$GET(X)_"^")
QUIT 0
+13 if "^WOULD^"[("^"_$GET(X)_"^")
QUIT 0
+14 QUIT 1
+15 ;
SWAP(X) ; Special Case Word Swap
+1 ;
+2 ; This sub-routine swaps one word for another
+3 ; This swap must apply to both Lookup and Indexing
+4 ; This swap only applies to uppercase text
+5 ; These words cannot be Replacement Words in file 757.05
+6 ;
+7 NEW TXT
SET (X,TXT)=$GET(X)
if '$LENGTH(TXT)
QUIT X
+8 SET (X,TXT)=$$UP^XLFSTR(X)
NEW SEG
+9 FOR SEG="X-RAY","X RAY"
Begin DoDot:1
+10 IF TXT[SEG
SET TXT=$$SW(TXT,SEG,"XRAY")
End DoDot:1
+11 FOR SEG="E.COLI","E COLI","E. COLI"
Begin DoDot:1
+12 IF TXT[SEG
SET TXT=$$SW(TXT,SEG,"ECOLI")
End DoDot:1
+13 SET X=$GET(TXT)
+14 QUIT X
SW(X,SEG1,SEG2) ; Swap text SEG1 for SEG2 in X
+1 ;
+2 ; Input
+3 ;
+4 ; X Text string
+5 ; SEG1 Word to remove in string (replace)
+6 ; SEG2 Word to insert in string (with)
+7 ;
+8 ; Output
+9 ;
+10 ; X Text string without SEG1
+11 ;
+12 NEW TXT,NOT,CHR,LEAD,TRAIL
SET (X,TXT)=$GET(X)
if '$LENGTH(TXT)
QUIT X
SET SEG1=$GET(SEG1)
+13 if '$LENGTH(SEG1)
QUIT X
SET SEG2=$GET(SEG2)
if '$LENGTH(SEG2)
QUIT X
if TXT'[SEG1
QUIT X
+14 SET NOT="~!@#$%^&*()_+`{}|[]\:;'<>?,./"
IF TXT=SEG1
SET X=SEG2
QUIT X
+15 IF $EXTRACT(TXT,1,$LENGTH(SEG1))=SEG1
Begin DoDot:1
+16 NEW CHR
SET CHR=$EXTRACT(TXT,($LENGTH(SEG1)+1))
if CHR'=" "
QUIT
+17 SET TXT=SEG2_$EXTRACT(TXT,($LENGTH(SEG1)+1),$LENGTH(TXT))
End DoDot:1
+18 FOR LEAD=" ","-","(","<","{","[",","
Begin DoDot:1
+19 NEW REP,WIT
FOR TRAIL=" ","-",")",">","}","]",","
Begin DoDot:2
+20 NEW REP,WIT
+21 SET REP=LEAD_SEG1_TRAIL
SET WIT=LEAD_SEG2_TRAIL
+22 if TXT'[REP
QUIT
+23 FOR
if TXT'[REP
QUIT
SET TXT=$PIECE(TXT,REP,1)_WIT_$PIECE(TXT,REP,2)
End DoDot:2
+24 SET REP=LEAD_SEG1
SET WIT=LEAD_SEG2
+25 IF TXT[REP
IF $LENGTH($PIECE(TXT,REP,1))
IF '$LENGTH($PIECE(TXT,REP,2))
Begin DoDot:2
+26 SET TXT=$PIECE(TXT,REP,1)_WIT
End DoDot:2
End DoDot:1
+27 SET X=$GET(TXT)
+28 QUIT X
