PXRRUTIL.m

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

 ;

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      ;