AMQQATR1 ;IHS/CMI/THL - SAMPLES BY RESULTS AND RESULT DATES ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;-----
RUN S AMQQSER=-.1
I $D(^UTILITY("AMQQ",$J,"SQXQ",AMQQUATN)) S %=$O(^(AMQQUATN,"")) I %,$D(^UTILITY("AMQQ",$J,"SQ",%,"NULL")) G SET
S %=$P(AMQQQ,U,9)
I $P(%,";",6) G SET
I %="" G SET
I $P(%,";",4)="ALL" S Z=$P(AMQQQ,U,3),$P(%,";",4)=$S(Z="T":">:-888888888",Z="N":">:-888888888",Z="Z":"'<:NEGATIVE",Z="S":"'=:|||",1:"ALL"),$P(AMQQQ,U,9)=%
I '+%,$P(%,";",4)=">:-999999999"!($P(%,";",4)="") G SET
I +%,$P(%,";",4)=">:-999999999"!($P(%,";",4)="") D SETXY,DATE G SET
I $P(AMQQQ,U,3)="E"!($P(AMQQQ,U,3)="V") D:%["~" EN^AMQQATR4,PSET S %=$P(AMQQQ,U,9) G PRESET:+%,SET
I $P(^AMQQ(1,+AMQQQ,0),U,11)[";" D VFILE^AMQQATR2 G SET
S X=$P(%,";",4)
S Y=$P(X,":",2)
S A=$P(^AMQQ(1,+AMQQQ,0),U,5)
I A=20 G PS
I A,$D(^AMQQ(4,A,0)) S A=$P(^(0),U)
I $D(^AMQQ(1,+AMQQQ,0)),$P(^(0),U,10)="AUPNVLAB","ZSTQ"[A,AMQQQ'[";ALL",AMQQQ'["EXISTS",AMQQQ'["'=:|||" D @("LTR"_A_U_"AMQQATR3") G PS
I $P($G(^AMQQ(1,+AMQQQ,0)),U,10)="AUPNVLAB",AMQQQ["ALL"!(AMQQQ["EXISTS")!(AMQQQ["'=:|||") D ALLLAB G SET
I $P($G(^AMQQ(1,+AMQQQ,0)),U,10)="AUPNVXAM"!($P($G(^(0)),U,10)="AUPNVNTS") D LTRQ^AMQQATR3 G PS ;PATCH XXX
I Y'=+Y S AMQQSER=-.1 D SETXY G PRESET:+%,SET
PS I '+% D RESULT G SET
D RESULT
PRESET S AMQQSER(1)=AMQQSER
D DATE
I +AMQQSER<+AMQQSER(1) S AMQQSER=AMQQSER(1)
SET S $P(AMQQQ,U,11)=AMQQSER
EXIT K AMQQSER,P,AMQQRTXT,AMQQLTR,AMQQLTR1,AMQQLTR2,AMQQLTB1,AMQQLTB2
Q
;
RESULT I $P(^AMQQ(1,+AMQQQ,0),U,15)="" Q
D SETXY
S %=+AMQQQ
S %=$P(^AMQQ(1,%,0),U,3)
S %=^DIC(%,0,"GL")
S %=%_"""AQ"")"
I '$D(@%) Q
S %=AMQQY
S Y=$P(%,";",4)_$P(%,";",5)
S Z=$P(%,";",6)_$P(%,";",7)
PSET S T=$P(AMQQY,";",2)
S K=$P(AMQQY,";",3)
S P=$P(^DPT(0),U,4)
S (B,I,J)=0
S A=(P\50)+(P<50)
LVTEST ; S A=0 ; USED IN LOW VOLUME TESTS
S F=U_$P(AMQQY,";")
S G=F_"(""AA"")"
RINCI S I=I+1 W:'$D(AMQQHIDE) "." I I>50 G RSET
S B=B+A
S B=$O(@G@(B))
G RSET:'B
S D=0
S N=0
RINCD S D=$O(@G@(B,T,D))
G RINCI:'D
S C=-999999999
RINCC S C=$O(@G@(B,T,D,C))
G RINCD:'C
S N=N+1
I N>10 G RINCI
S R=$P(@F@(C,0),U,4)
I $D(AMQQLTR) X AMQQLTR S Y=AMQQLTB1_AMQQLTR1,Z=AMQQLTB2_AMQQLTR2
I $D(AMQQRTXT) X AMQQRTXT G INCJ
I Z="" S %="I R"_Y X % G INCJ
S %="I R"_Y_",R"_Z
X %
INCJ I S J=J+1 G RINCI
G RINCC
RSET S:'K K=1
S %=(J/I)
S:'% %=.01
S %=(1-%)/(%*K)
S %=$J(%,1,2)
S AMQQSER=%
D BSET
REXIT K %,A,B,C,D,E,F,G,H,I,J,K,M,N,R,S,T
Q
;
DATE I '$P(^AMQQ(1,+AMQQQ,0),U,7)!($P(^AMQQ(1,+AMQQQ,0),U,2)'=2) Q
I '$D(AMQQY) Q
S %=AMQQY
S P=$P(^DPT(0),U,4)
S (B,I,J)=0
S A=(P\50)+(P<50)
S T=$P(%,";",2)
S F=U_$P(AMQQY,";")
S G=F_"(""AA"")"
S X1=$P(%,";",9)
S X2=$P(%,";",8)
S S=9999999-X2
S E=9999999-X1
I X1'<9999999 S X1=DT+1
I X2=0 S X2=0010101
D ^%DTC
I X>100 S AMQQSER(1)=-999 D REXIT Q
DINCI S I=I+1
W:'$D(AMQQHIDE) "."
I I>50 G DSET
S B=B+A
S B=$O(@G@(B))
G DSET:'B
S D=0
DINCD S D=$O(@G@(B,T,D))
G DINCI:'D
I D'>S,D'<E S J=J+1 G DINCI
G DINCD
;
DSET S %=(J/I)
S:'% %=.01
S %=(1-%)/(%*4.2)
S %=$J(%,1,2)
S AMQQSER=%_":2"
D REXIT
Q
;
BSET I $P(^AMQQ(1,+AMQQQ,0),U,5)=20 S:AMQQQ'[";A;" AMQQSER=AMQQSER_":11" Q
S %=$P(^AMQQ(1,+AMQQQ,0),U,15)
S X=$P(^(0),U,10)
I %=""!(X="") Q
I X="AUPNVLAB"!(X="AUPNVXAM")!(X="AUPNVSK")!(X="AUPNVNTS") S %=%_";" ;PATCH XXX
S Y=U_X_"(""AQ"","""_%_""")"
S Z=$O(@Y)
I $E(Z,1,$L(%))=%,$E(Z,$L(%)+1)?1NP
E Q
I +AMQQQ=168!(+AMQQQ=170)!(+AMQQQ=171) S %=$P(AMQQQ,U,9),%=$P(%,"~",3) S AMQQSER=AMQQSER_$S(%="&":":3",%="!":":4",1:":1") Q
I $P(^AMQQ(1,+AMQQQ,0),U,10)="AUPNVXAM"!($P(^(0),U,10)="AUPNVNTS") S AMQQSER=AMQQSER_":"_81 Q ;PATCH XXX
I $P(^AMQQ(1,+AMQQQ,0),U,10)="AUPNVSK" S AMQQSER=AMQQSER_":"_51 Q
I Z[";",+Z,$G(X)="AUPNVDXP" S Y=$P(^AUTTDXPR(+Z,0),U,2),Y=$S(Y="N":5,Y="Z":6,Y="T":7,Y="Q":8,1:0) Q:'Y S Y=Y*100,AMQQSER=AMQQSER_":"_Y Q
I Z[";",+Z S Y=$O(^AMQQ(5,"AQ",+Z,"")),Y=$S(Y="N":5,Y="Z":6,Y="T":7,Y="Q":8,1:0) Q:'Y S AMQQSER=AMQQSER_":"_Y Q
S AMQQSER=AMQQSER_":1"
Q
;
SETXY S %=$P(AMQQQ,U,9)
S X=$P(^AMQQ(1,+AMQQQ,0),U,10)
S Y=+$P(^AMQQ(1,+AMQQQ,0),U,11)_";"_$P(^(0),U,12)
S Z=$P(%,";",4)
I X="AUPNVIMM" S AMQQY=X_";"_Y_";=;"_Z G SETXY1
S AMQQY=X_";"_Y_";"_$P(Z,":")_";"_$P(Z,":",2)_";"_$S($P(Z,":",3)="":"<999999999",1:($P(Z,":",3)_";"_$P(Z,":",4)))_";"_$P(%,";",1,2)
SETXY1 I '$D(AMQQHIDE) W !!,"Computing Search Efficiency Rating...."
Q
;
ALLLAB N X,Y,Z,N,%,I
I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
S (Z,%,I)=0
S N=$P($G(^AMQQ(1,+AMQQQ,0)),U,11)
I 'N Q
S X=$P(^DPT(0),U,4)
S Y=(X\100)+(X<100)
F I=1:1:100 S %=$O(^DPT(%)) S:'% %=$O(^DPT($R(Y))) S:$D(^AUPNVLAB("AA",%,N)) Z=Z+1 S %=%+Y I '$D(AMQQHIDE),I#2 W "."
S X=$P(^AUPNVLAB(0),U,4)
S Y=$P(^DPT(0),U,4)
S %=1
I X,Y S %=Y/X,%=$J(%,2,2)
S AMQQSER=+$J(((Z/100)*%),1,2)
Q
;
AMQQATR1 ;IHS/CMI/THL - SAMPLES BY RESULTS AND RESULT DATES ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;-----
RUN SET AMQQSER=-.1
+1 IF $DATA(^UTILITY("AMQQ",$JOB,"SQXQ",AMQQUATN))
SET %=$ORDER(^(AMQQUATN,""))
IF %
IF $DATA(^UTILITY("AMQQ",$JOB,"SQ",%,"NULL"))
GOTO SET
+2 SET %=$PIECE(AMQQQ,U,9)
+3 IF $PIECE(%,";",6)
GOTO SET
+4 IF %=""
GOTO SET
+5 IF $PIECE(%,";",4)="ALL"
SET Z=$PIECE(AMQQQ,U,3)
SET $PIECE(%,";",4)=$SELECT(Z="T":">:-888888888",Z="N":">:-888888888",Z="Z":"'<:NEGATIVE",Z="S":"'=:|||",1:"ALL")
SET $PIECE(AMQQQ,U,9)=%
+6 IF '+%
IF $PIECE(%,";",4)=">:-999999999"!($PIECE(%,";",4)="")
GOTO SET
+7 IF +%
IF $PIECE(%,";",4)=">:-999999999"!($PIECE(%,";",4)="")
DO SETXY
DO DATE
GOTO SET
+8 IF $PIECE(AMQQQ,U,3)="E"!($PIECE(AMQQQ,U,3)="V")
IF %["~"
DO EN^AMQQATR4
DO PSET
SET %=$PIECE(AMQQQ,U,9)
IF +%
GOTO PRESET
GOTO SET
+9 IF $PIECE(^AMQQ(1,+AMQQQ,0),U,11)[";"
DO VFILE^AMQQATR2
GOTO SET
+10 SET X=$PIECE(%,";",4)
+11 SET Y=$PIECE(X,":",2)
+12 SET A=$PIECE(^AMQQ(1,+AMQQQ,0),U,5)
+13 IF A=20
GOTO PS
+14 IF A
IF $DATA(^AMQQ(4,A,0))
SET A=$PIECE(^(0),U)
+15 IF $DATA(^AMQQ(1,+AMQQQ,0))
IF $PIECE(^(0),U,10)="AUPNVLAB"
IF "ZSTQ"[A
IF AMQQQ'[";ALL"
IF AMQQQ'["EXISTS"
IF AMQQQ'["'=:|||"
DO @("LTR"_A_U_"AMQQATR3")
GOTO PS
+16 IF $PIECE($GET(^AMQQ(1,+AMQQQ,0)),U,10)="AUPNVLAB"
IF AMQQQ["ALL"!(AMQQQ["EXISTS")!(AMQQQ["'=:|||")
DO ALLLAB
GOTO SET
+17 ;PATCH XXX
IF $PIECE($GET(^AMQQ(1,+AMQQQ,0)),U,10)="AUPNVXAM"!($PIECE($GET(^(0)),U,10)="AUPNVNTS")
DO LTRQ^AMQQATR3
GOTO PS
+18 IF Y'=+Y
SET AMQQSER=-.1
DO SETXY
IF +%
GOTO PRESET
GOTO SET
PS IF '+%
DO RESULT
GOTO SET
+1 DO RESULT
PRESET SET AMQQSER(1)=AMQQSER
+1 DO DATE
+2 IF +AMQQSER<+AMQQSER(1)
SET AMQQSER=AMQQSER(1)
SET SET $PIECE(AMQQQ,U,11)=AMQQSER
EXIT KILL AMQQSER,P,AMQQRTXT,AMQQLTR,AMQQLTR1,AMQQLTR2,AMQQLTB1,AMQQLTB2
+1 QUIT
+2 ;
RESULT IF $PIECE(^AMQQ(1,+AMQQQ,0),U,15)=""
QUIT
+1 DO SETXY
+2 SET %=+AMQQQ
+3 SET %=$PIECE(^AMQQ(1,%,0),U,3)
+4 SET %=^DIC(%,0,"GL")
+5 SET %=%_"""AQ"")"
+6 IF '$DATA(@%)
QUIT
+7 SET %=AMQQY
+8 SET Y=$PIECE(%,";",4)_$PIECE(%,";",5)
+9 SET Z=$PIECE(%,";",6)_$PIECE(%,";",7)
PSET SET T=$PIECE(AMQQY,";",2)
+1 SET K=$PIECE(AMQQY,";",3)
+2 SET P=$PIECE(^DPT(0),U,4)
+3 SET (B,I,J)=0
+4 SET A=(P\50)+(P<50)
LVTEST ; S A=0 ; USED IN LOW VOLUME TESTS
+1 SET F=U_$PIECE(AMQQY,";")
+2 SET G=F_"(""AA"")"
RINCI SET I=I+1
IF '$DATA(AMQQHIDE)
WRITE "."
IF I>50
GOTO RSET
+1 SET B=B+A
+2 SET B=$ORDER(@G@(B))
+3 IF 'B
GOTO RSET
+4 SET D=0
+5 SET N=0
RINCD SET D=$ORDER(@G@(B,T,D))
+1 IF 'D
GOTO RINCI
+2 SET C=-999999999
RINCC SET C=$ORDER(@G@(B,T,D,C))
+1 IF 'C
GOTO RINCD
+2 SET N=N+1
+3 IF N>10
GOTO RINCI
+4 SET R=$PIECE(@F@(C,0),U,4)
+5 IF $DATA(AMQQLTR)
XECUTE AMQQLTR
SET Y=AMQQLTB1_AMQQLTR1
SET Z=AMQQLTB2_AMQQLTR2
+6 IF $DATA(AMQQRTXT)
XECUTE AMQQRTXT
GOTO INCJ
+7 IF Z=""
SET %="I R"_Y
XECUTE %
GOTO INCJ
+8 SET %="I R"_Y_",R"_Z
+9 XECUTE %
INCJ IF $TEST
SET J=J+1
GOTO RINCI
+1 GOTO RINCC
RSET IF 'K
SET K=1
+1 SET %=(J/I)
+2 IF '%
SET %=.01
+3 SET %=(1-%)/(%*K)
+4 SET %=$JUSTIFY(%,1,2)
+5 SET AMQQSER=%
+6 DO BSET
REXIT KILL %,A,B,C,D,E,F,G,H,I,J,K,M,N,R,S,T
+1 QUIT
+2 ;
DATE IF '$PIECE(^AMQQ(1,+AMQQQ,0),U,7)!($PIECE(^AMQQ(1,+AMQQQ,0),U,2)'=2)
QUIT
+1 IF '$DATA(AMQQY)
QUIT
+2 SET %=AMQQY
+3 SET P=$PIECE(^DPT(0),U,4)
+4 SET (B,I,J)=0
+5 SET A=(P\50)+(P<50)
+6 SET T=$PIECE(%,";",2)
+7 SET F=U_$PIECE(AMQQY,";")
+8 SET G=F_"(""AA"")"
+9 SET X1=$PIECE(%,";",9)
+10 SET X2=$PIECE(%,";",8)
+11 SET S=9999999-X2
+12 SET E=9999999-X1
+13 IF X1'<9999999
SET X1=DT+1
+14 IF X2=0
SET X2=0010101
+15 DO ^%DTC
+16 IF X>100
SET AMQQSER(1)=-999
DO REXIT
QUIT
DINCI SET I=I+1
+1 IF '$DATA(AMQQHIDE)
WRITE "."
+2 IF I>50
GOTO DSET
+3 SET B=B+A
+4 SET B=$ORDER(@G@(B))
+5 IF 'B
GOTO DSET
+6 SET D=0
DINCD SET D=$ORDER(@G@(B,T,D))
+1 IF 'D
GOTO DINCI
+2 IF D'>S
IF D'<E
SET J=J+1
GOTO DINCI
+3 GOTO DINCD
+4 ;
DSET SET %=(J/I)
+1 IF '%
SET %=.01
+2 SET %=(1-%)/(%*4.2)
+3 SET %=$JUSTIFY(%,1,2)
+4 SET AMQQSER=%_":2"
+5 DO REXIT
+6 QUIT
+7 ;
BSET IF $PIECE(^AMQQ(1,+AMQQQ,0),U,5)=20
IF AMQQQ'[";A;"
SET AMQQSER=AMQQSER_":11"
QUIT
+1 SET %=$PIECE(^AMQQ(1,+AMQQQ,0),U,15)
+2 SET X=$PIECE(^(0),U,10)
+3 IF %=""!(X="")
QUIT
+4 ;PATCH XXX
IF X="AUPNVLAB"!(X="AUPNVXAM")!(X="AUPNVSK")!(X="AUPNVNTS")
SET %=%_";"
+5 SET Y=U_X_"(""AQ"","""_%_""")"
+6 SET Z=$ORDER(@Y)
+7 IF $EXTRACT(Z,1,$LENGTH(%))=%
IF $EXTRACT(Z,$LENGTH(%)+1)?1NP
+8 IF '$TEST
QUIT
+9 IF +AMQQQ=168!(+AMQQQ=170)!(+AMQQQ=171)
SET %=$PIECE(AMQQQ,U,9)
SET %=$PIECE(%,"~",3)
SET AMQQSER=AMQQSER_$SELECT(%="&":":3",%="!":":4",1:":1")
QUIT
+10 ;PATCH XXX
IF $PIECE(^AMQQ(1,+AMQQQ,0),U,10)="AUPNVXAM"!($PIECE(^(0),U,10)="AUPNVNTS")
SET AMQQSER=AMQQSER_":"_81
QUIT
+11 IF $PIECE(^AMQQ(1,+AMQQQ,0),U,10)="AUPNVSK"
SET AMQQSER=AMQQSER_":"_51
QUIT
+12 IF Z[";"
IF +Z
IF $GET(X)="AUPNVDXP"
SET Y=$PIECE(^AUTTDXPR(+Z,0),U,2)
SET Y=$SELECT(Y="N":5,Y="Z":6,Y="T":7,Y="Q":8,1:0)
IF 'Y
QUIT
SET Y=Y*100
SET AMQQSER=AMQQSER_":"_Y
QUIT
+13 IF Z[";"
IF +Z
SET Y=$ORDER(^AMQQ(5,"AQ",+Z,""))
SET Y=$SELECT(Y="N":5,Y="Z":6,Y="T":7,Y="Q":8,1:0)
IF 'Y
QUIT
SET AMQQSER=AMQQSER_":"_Y
QUIT
+14 SET AMQQSER=AMQQSER_":1"
+15 QUIT
+16 ;
SETXY SET %=$PIECE(AMQQQ,U,9)
+1 SET X=$PIECE(^AMQQ(1,+AMQQQ,0),U,10)
+2 SET Y=+$PIECE(^AMQQ(1,+AMQQQ,0),U,11)_";"_$PIECE(^(0),U,12)
+3 SET Z=$PIECE(%,";",4)
+4 IF X="AUPNVIMM"
SET AMQQY=X_";"_Y_";=;"_Z
GOTO SETXY1
+5 SET AMQQY=X_";"_Y_";"_$PIECE(Z,":")_";"_$PIECE(Z,":",2)_";"_$SELECT($PIECE(Z,":",3)="":"<999999999",1:($PIECE(Z,":",3)_";"_$PIECE(Z,":",4)))_";"_$PIECE(%,";",1,2)
SETXY1 IF '$DATA(AMQQHIDE)
WRITE !!,"Computing Search Efficiency Rating...."
+1 QUIT
+2 ;
ALLLAB NEW X,Y,Z,N,%,I
+1 IF '$DATA(AMQQHIDE)
WRITE !,"Computing Search Efficiency Rating...."
+2 SET (Z,%,I)=0
+3 SET N=$PIECE($GET(^AMQQ(1,+AMQQQ,0)),U,11)
+4 IF 'N
QUIT
+5 SET X=$PIECE(^DPT(0),U,4)
+6 SET Y=(X\100)+(X<100)
+7 FOR I=1:1:100
SET %=$ORDER(^DPT(%))
IF '%
SET %=$ORDER(^DPT($RANDOM(Y)))
IF $DATA(^AUPNVLAB("AA",%,N))
SET Z=Z+1
SET %=%+Y
IF '$DATA(AMQQHIDE)
IF I#2
WRITE "."
+8 SET X=$PIECE(^AUPNVLAB(0),U,4)
+9 SET Y=$PIECE(^DPT(0),U,4)
+10 SET %=1
+11 IF X
IF Y
SET %=Y/X
SET %=$JUSTIFY(%,2,2)
+12 SET AMQQSER=+$JUSTIFY(((Z/100)*%),1,2)
+13 QUIT
+14 ;
