DIOQ ;SFISC/GS,TKW-QUERY OPTIMIZER ;4/5/95 14:02
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
SER(F,DIOQGET,DIOQCHEK,C,X,%,W) ; COMPUTE SEARCH EFFICIENCY RATING
; F=FILE#, DIOQGET=GET CODE, DIOQCHEK=EVALUATION CODE,
; C=USEABLE INDEX? (1=YES, 0=NO)
; X=EFFICIENCY RATING, %=PREVALANCE OF HITS (PROBABILITY)
; W=WRITE PROGRESS MSG.TO USER
N Z S (X,%)=0,W=$G(W),Z=$G(^DIC(+$G(F),0,"GL")) Q:Z=""
N I,N,T,D0,DA,DITRUE,DIFIRST S DIFIRST=1
I W S W=$P($H,",",2)+.1
S (T,N)=0,I=$P(@(Z_"0)"),U,4)\100
F D0=0:I S D0=$O(@(Z_D0_")")) Q:'D0 Q:N>100 S DA=D0,N=N+1 D TEST I DITRUE S T=T+1
S %=$S(N=0:1,T=0:0,1:T/N),(X,%)=1-% I C S:%=1 X=100 S:%'=1 X=%/(1-%)
S X=$J(X,1,4),%=$J(%,1,4) Q
;
TEST ; GET VALUE AND EVALUATE IT
N I,L,N,T,Z,DIOQSVD0 S DIOQSVD0=D0 D S D0=DIOQSVD0
. N F,C,W,DIFIRST
. X DIOQGET,DIOQCHEK S DITRUE=$T Q
Q:'W Q:($P($H,",",2)-W)'>3 S W=$P($H,",",2)+.1
I DIFIRST S DIFIRST=0 W !,"Computing search efficiency..." Q
W "." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIOQ 1236 printed Nov 22, 2024@18:02:27 Page 2
DIOQ ;SFISC/GS,TKW-QUERY OPTIMIZER ;4/5/95 14:02
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
SER(F,DIOQGET,DIOQCHEK,C,X,%,W) ; COMPUTE SEARCH EFFICIENCY RATING
+1 ; F=FILE#, DIOQGET=GET CODE, DIOQCHEK=EVALUATION CODE,
+2 ; C=USEABLE INDEX? (1=YES, 0=NO)
+3 ; X=EFFICIENCY RATING, %=PREVALANCE OF HITS (PROBABILITY)
+4 ; W=WRITE PROGRESS MSG.TO USER
+5 NEW Z
SET (X,%)=0
SET W=$GET(W)
SET Z=$GET(^DIC(+$GET(F),0,"GL"))
if Z=""
QUIT
+6 NEW I,N,T,D0,DA,DITRUE,DIFIRST
SET DIFIRST=1
+7 IF W
SET W=$PIECE($HOROLOG,",",2)+.1
+8 SET (T,N)=0
SET I=$PIECE(@(Z_"0)"),U,4)\100
+9 FOR D0=0:I
SET D0=$ORDER(@(Z_D0_")"))
if 'D0
QUIT
if N>100
QUIT
SET DA=D0
SET N=N+1
DO TEST
IF DITRUE
SET T=T+1
+10 SET %=$SELECT(N=0:1,T=0:0,1:T/N)
SET (X,%)=1-%
IF C
if %=1
SET X=100
if %'=1
SET X=%/(1-%)
+11 SET X=$JUSTIFY(X,1,4)
SET %=$JUSTIFY(%,1,4)
QUIT
+12 ;
TEST ; GET VALUE AND EVALUATE IT
+1 NEW I,L,N,T,Z,DIOQSVD0
SET DIOQSVD0=D0
Begin DoDot:1
+2 NEW F,C,W,DIFIRST
+3 XECUTE DIOQGET
XECUTE DIOQCHEK
SET DITRUE=$TEST
QUIT
End DoDot:1
SET D0=DIOQSVD0
+4 if 'W
QUIT
if ($PIECE($HOROLOG,",",2)-W)'>3
QUIT
SET W=$PIECE($HOROLOG,",",2)+.1
+5 IF DIFIRST
SET DIFIRST=0
WRITE !,"Computing search efficiency..."
QUIT
+6 WRITE "."
QUIT
