PXRRUTIL ;ISL/PKR - Utility routines for use by PXRR. ;3/20/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**12**;Aug 12, 1996
;
;=======================================================================
SORT(N,ARRAY,KEY) ;Sort an ARRAY with N elements into ascending order,
;return the number of unique elements. KEY is the piece of ARRAY on
;which to base the sort. The default is the first piece.
;
I (N'>0)!(N=1) Q N
N IC,IND
I '$D(KEY) S KEY=1
F IC=1:1:N S ^TMP($J,"SORT",$P(@ARRAY@(IC),U,KEY))=@ARRAY@(IC)
S IND=""
F IC=1:1 S IND=$O(^TMP($J,"SORT",IND)) Q:IND="" D
. S @ARRAY@(IC)=^TMP($J,"SORT",IND)
K ^TMP($J,"SORT")
Q IC-1
;
;=======================================================================
STRREP(STRING,TS,RS) ;Replace every occurence of the target string (TS)
;in STRING with the replacement string (RS).
;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
; F Q:STRING'[TS S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
;fails if any portion of the target string is contained in the with
;string. Therefore a more elaborate version is required.
;
N FROM,NPCS,STR
;
I STRING'[TS Q STRING
;Count the number of pieces using the target string as the delimiter.
S FROM=1
F NPCS=1:1 S FROM=$F(STRING,TS,FROM) Q:FROM=0
;Extract the pieces and concatenate RS
S STR=""
F FROM=1:1:NPCS-1 S STR=STR_$P(STRING,TS,FROM)_RS
S STR=STR_$P(STRING,TS,NPCS)
Q STR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRUTIL 1449 printed Dec 13, 2024@02:31:15 Page 2
PXRRUTIL ;ISL/PKR - Utility routines for use by PXRR. ;3/20/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**12**;Aug 12, 1996
+2 ;
+3 ;=======================================================================
SORT(N,ARRAY,KEY) ;Sort an ARRAY with N elements into ascending order,
+1 ;return the number of unique elements. KEY is the piece of ARRAY on
+2 ;which to base the sort. The default is the first piece.
+3 ;
+4 IF (N'>0)!(N=1)
QUIT N
+5 NEW IC,IND
+6 IF '$DATA(KEY)
SET KEY=1
+7 FOR IC=1:1:N
SET ^TMP($JOB,"SORT",$PIECE(@ARRAY@(IC),U,KEY))=@ARRAY@(IC)
+8 SET IND=""
+9 FOR IC=1:1
SET IND=$ORDER(^TMP($JOB,"SORT",IND))
if IND=""
QUIT
Begin DoDot:1
+10 SET @ARRAY@(IC)=^TMP($JOB,"SORT",IND)
End DoDot:1
+11 KILL ^TMP($JOB,"SORT")
+12 QUIT IC-1
+13 ;
+14 ;=======================================================================
STRREP(STRING,TS,RS) ;Replace every occurence of the target string (TS)
+1 ;in STRING with the replacement string (RS).
+2 ;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
+3 ; F Q:STRING'[TS S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
+4 ;fails if any portion of the target string is contained in the with
+5 ;string. Therefore a more elaborate version is required.
+6 ;
+7 NEW FROM,NPCS,STR
+8 ;
+9 IF STRING'[TS
QUIT STRING
+10 ;Count the number of pieces using the target string as the delimiter.
+11 SET FROM=1
+12 FOR NPCS=1:1
SET FROM=$FIND(STRING,TS,FROM)
if FROM=0
QUIT
+13 ;Extract the pieces and concatenate RS
+14 SET STR=""
+15 FOR FROM=1:1:NPCS-1
SET STR=STR_$PIECE(STRING,TS,FROM)_RS
+16 SET STR=STR_$PIECE(STRING,TS,NPCS)
+17 QUIT STR
+18 ;
