RORXU004 ;HCIOFO/SG - REPORT UTILITIES (STATISTICS) ; 9/23/03 10:51am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** CALCULATES THE MEDIAN VALUE OF THE CROSS-REFERENCE
;
; XREFNODE Root node of the old-style cross-reference
; NUM Total number of elements in the array
;
; Return Values:
; "" Error (or an empty array)
; '="" Median Value
;
XREFMDNV(XREFNODE,NUM) ;
Q:NUM'>0 ""
N FLT,FLTL,I,MV,N,PI,VPOS
S FLTL=$L(XREFNODE)-1,FLT=$E(XREFNODE,1,FLTL)
S N=(NUM+1)\2,VPOS=$QL(XREFNODE)+1
;--- Find the median value
S PI=XREFNODE
F I=1:1:N S PI=$Q(@PI) Q:$E(PI,1,FLTL)'=FLT
Q:$E(PI,1,FLTL)'=FLT ""
;--- Calculate median value if NUM is even
S MV=$QS(PI,VPOS)
I '(NUM#2) D Q:I="" "" S MV=(MV+I)/2
. S PI=$Q(@PI),I=$S($E(PI,1,FLTL)=FLT:$QS(PI,VPOS),1:"")
Q MV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU004 850 printed Dec 13, 2024@01:45:07 Page 2
RORXU004 ;HCIOFO/SG - REPORT UTILITIES (STATISTICS) ; 9/23/03 10:51am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** CALCULATES THE MEDIAN VALUE OF THE CROSS-REFERENCE
+6 ;
+7 ; XREFNODE Root node of the old-style cross-reference
+8 ; NUM Total number of elements in the array
+9 ;
+10 ; Return Values:
+11 ; "" Error (or an empty array)
+12 ; '="" Median Value
+13 ;
XREFMDNV(XREFNODE,NUM) ;
+1 if NUM'>0
QUIT ""
+2 NEW FLT,FLTL,I,MV,N,PI,VPOS
+3 SET FLTL=$LENGTH(XREFNODE)-1
SET FLT=$EXTRACT(XREFNODE,1,FLTL)
+4 SET N=(NUM+1)\2
SET VPOS=$QLENGTH(XREFNODE)+1
+5 ;--- Find the median value
+6 SET PI=XREFNODE
+7 FOR I=1:1:N
SET PI=$QUERY(@PI)
if $EXTRACT(PI,1,FLTL)'=FLT
QUIT
+8 if $EXTRACT(PI,1,FLTL)'=FLT
QUIT ""
+9 ;--- Calculate median value if NUM is even
+10 SET MV=$QSUBSCRIPT(PI,VPOS)
+11 IF '(NUM#2)
Begin DoDot:1
+12 SET PI=$QUERY(@PI)
SET I=$SELECT($EXTRACT(PI,1,FLTL)=FLT:$QSUBSCRIPT(PI,VPOS),1:"")
End DoDot:1
if I=""
QUIT ""
SET MV=(MV+I)/2
+13 QUIT MV
