- 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 Jan 18, 2025@03:32: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 ;