AMQQATR ; IHS/CMI/THL - AMQQAT SUBROUTINE...COMPUTES DYNAMIC SEARCH RATING ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
RUN N AMQQHIDE
I +AMQQQ=33,AMQQQ[";;;NULL" S AMQQHIDE=""
I $D(AMQQXX) S AMQQHIDE=""
I $D(AMQQONE),AMQQONE'="" S $P(AMQQQ,U,11)=-.1 Q
I +AMQQQ=3,$P(AMQQQ,U,8)="=" S $P(AMQQQ,U,11)=99 Q
CHECK I $P(^AMQQ(1,+AMQQQ,0),U,7),AMQQQ'[";ANY^",AMQQQ'[";NULL^",$P(AMQQQ,U,17)="" D ^AMQQATR1 G EXIT
I '$D(^AMQQ(1,+AMQQQ,3)) S $P(AMQQQ,U,11)=-.1 Q
S %=$P(AMQQQ,U,2)
I %="DIAGNOSIS"!(%="RX") D DX Q
I $P(AMQQQ,U,17)'=""!(+AMQQQ=212) D ^AMQQATR2 G EXIT
I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
S Q=AMQQQ
I $P(Q,U,2)="FILE ENTRY" D FILE S AMQQECPR=% D SAMPLE G EXIT
S AMQQEXCD=^AMQQ(1,+Q,3)
S AMQQENCO=$P(Q,U,6)
S AMQQECPR=$P(Q,U,9)
S AMQQESBL=$P(Q,U,8)
S AMQQEVAL=""
I $P(AMQQECPR,";",4)["EXIST"!($P(AMQQECPR,";",4)["NULL") S AMQQECMP="I AMQQEVAL'=""""" D SAMPLE G EXIT
D @("FILTER"_$P(Q,U,3)_"^AMQQATR0")
D SAMPLE
EXIT K %,Q,AMQQSER,X,Y,Z,AMQQY,AMQQEVAL,AMQQECMP,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQESBL,AMQQEXCD,AMQQECNT,AMQQECPR,AMQQENCO,AMQQHIDE
Q
;
SAMPLE D @("SAMPLE"_AMQQCCLS)
S X=AMQQENUM/AMQQEDEN
I 'X S X=.01
I AMQQECPR["NULL" G SETSER
S X=(1-X)/$S($D(AMQQKONG):1,$P(^AMQQ(1,+Q,0),U,8):X,+Q=40:X,+Q=176:X,1:1)
SETSER S AMQQSER=$J(X,1,2)
S %=$P(^AMQQ(1,+AMQQQ,0),U,15)
I %'="" S AMQQSER=AMQQSER_":"_%
S $P(AMQQQ,U,11)=AMQQSER
Q
;
SAMPLEH S %=1
S AMQQENUM=0
S X=$P(@AMQQ200(16)@(0),U,4)
S AMQQEINC=$S(X<50:0,1:(X\50))
S AMQQECNT=0
F AMQQEDEN=0:1 S %=$O(@AMQQ200(16)@(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
Q
;
SAMPLEP S %=1
S AMQQENUM=0
S X=$P(^DPT(0),U,4)
S AMQQEINC=$S(X<50:0,1:(X\50))
S AMQQECNT=0
F AMQQEDEN=0:1 S %=$O(^DPT(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
Q
;
SAMPLEV S %=1
S AMQQENUM=0
S X=$P(^AUPNVSIT(0),U,4)
S AMQQEINC=$S(X<50:0,1:(X\50))
S AMQQECNT=0
F AMQQEDEN=0:1 S %=$O(^AUPNVSIT(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
Q
;
SAMPLED S %=1,AMQQENUM=0
S X=$P(^AUPNVPOV(0),U,4)
S AMQQEINC=$S(X<50:0,1:(X\50))
S AMQQECNT=0
F AMQQEDEN=0:1 S %=$O(^AUPNVPOV(%)) Q:%'=+% X AMQQEXCD S:$T AMQQENUM=AMQQENUM+1 S %=%+AMQQEINC W:'$D(AMQQHIDE) "." S AMQQECNT=AMQQECNT+1 I AMQQECNT>50 Q
Q
;
DX I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) S $P(AMQQQ,U,11)=-1 Q
I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
S %=0
F I=0:1 S %=$O(^UTILITY("AMQQ TAX",$J,AMQQURGN,%)) Q:'% W:'$D(AMQQHIDE) "."
S %=.99/((.01)*(4+(I/16)))
S %=$J(%,1,2)
S $P(AMQQQ,U,11)=%
I $G(AMQQUSQN),'$D(^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,"NULL")) S $P(AMQQQ,U,11)=%_":"_20
Q
;
FILE I +Q<178 S %=$P(Q,U,9),AMQQEXCD="I "_$S(+Q=177:"'",1:"")_"$D(^"_$P(%,";")_""""_$P(%,";",2)_""",%))" Q
S %=$P(Q,U,9)
S AMQQEXCD="I $D(^UTILITY(""AMQQ FRAND"","_$P(%,";",3)_","_$P(%,";",6)_",%))"
Q
;
KONG ; ENTRY POINT FROM AMQQCMPK
I $D(AMQQXX) S AMQQHIDE=""
D @("SAMPLE"_AMQQCCLS)
S X=AMQQENUM/AMQQEDEN
I 'X S X=.01
S X=1-X,X=$J(X,1,2)
K AMQQHIDE
Q
;
AMQQATR ; IHS/CMI/THL - AMQQAT SUBROUTINE...COMPUTES DYNAMIC SEARCH RATING ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
RUN NEW AMQQHIDE
+1 IF +AMQQQ=33
IF AMQQQ[";;;NULL"
SET AMQQHIDE=""
+2 IF $DATA(AMQQXX)
SET AMQQHIDE=""
+3 IF $DATA(AMQQONE)
IF AMQQONE'=""
SET $PIECE(AMQQQ,U,11)=-.1
QUIT
+4 IF +AMQQQ=3
IF $PIECE(AMQQQ,U,8)="="
SET $PIECE(AMQQQ,U,11)=99
QUIT
CHECK IF $PIECE(^AMQQ(1,+AMQQQ,0),U,7)
IF AMQQQ'[";ANY^"
IF AMQQQ'[";NULL^"
IF $PIECE(AMQQQ,U,17)=""
DO ^AMQQATR1
GOTO EXIT
+1 IF '$DATA(^AMQQ(1,+AMQQQ,3))
SET $PIECE(AMQQQ,U,11)=-.1
QUIT
+2 SET %=$PIECE(AMQQQ,U,2)
+3 IF %="DIAGNOSIS"!(%="RX")
DO DX
QUIT
+4 IF $PIECE(AMQQQ,U,17)'=""!(+AMQQQ=212)
DO ^AMQQATR2
GOTO EXIT
+5 IF '$DATA(AMQQHIDE)
WRITE !,"Computing Search Efficiency Rating...."
+6 SET Q=AMQQQ
+7 IF $PIECE(Q,U,2)="FILE ENTRY"
DO FILE
SET AMQQECPR=%
DO SAMPLE
GOTO EXIT
+8 SET AMQQEXCD=^AMQQ(1,+Q,3)
+9 SET AMQQENCO=$PIECE(Q,U,6)
+10 SET AMQQECPR=$PIECE(Q,U,9)
+11 SET AMQQESBL=$PIECE(Q,U,8)
+12 SET AMQQEVAL=""
+13 IF $PIECE(AMQQECPR,";",4)["EXIST"!($PIECE(AMQQECPR,";",4)["NULL")
SET AMQQECMP="I AMQQEVAL'="""""
DO SAMPLE
GOTO EXIT
+14 DO @("FILTER"_$PIECE(Q,U,3)_"^AMQQATR0")
+15 DO SAMPLE
EXIT KILL %,Q,AMQQSER,X,Y,Z,AMQQY,AMQQEVAL,AMQQECMP,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQESBL,AMQQEXCD,AMQQECNT,AMQQECPR,AMQQENCO,AMQQHIDE
+1 QUIT
+2 ;
SAMPLE DO @("SAMPLE"_AMQQCCLS)
+1 SET X=AMQQENUM/AMQQEDEN
+2 IF 'X
SET X=.01
+3 IF AMQQECPR["NULL"
GOTO SETSER
+4 SET X=(1-X)/$SELECT($DATA(AMQQKONG):1,$PIECE(^AMQQ(1,+Q,0),U,8):X,+Q=40:X,+Q=176:X,1:1)
SETSER SET AMQQSER=$JUSTIFY(X,1,2)
+1 SET %=$PIECE(^AMQQ(1,+AMQQQ,0),U,15)
+2 IF %'=""
SET AMQQSER=AMQQSER_":"_%
+3 SET $PIECE(AMQQQ,U,11)=AMQQSER
+4 QUIT
+5 ;
SAMPLEH SET %=1
+1 SET AMQQENUM=0
+2 SET X=$PIECE(@AMQQ200(16)@(0),U,4)
+3 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
+4 SET AMQQECNT=0
+5 FOR AMQQEDEN=0:1
SET %=$ORDER(@AMQQ200(16)@(%))
IF %'=+%
QUIT
XECUTE AMQQEXCD
IF $TEST
SET AMQQENUM=AMQQENUM+1
SET %=%+AMQQEINC
IF '$DATA(AMQQHIDE)
WRITE "."
SET AMQQECNT=AMQQECNT+1
IF AMQQECNT>50
QUIT
+6 QUIT
+7 ;
SAMPLEP SET %=1
+1 SET AMQQENUM=0
+2 SET X=$PIECE(^DPT(0),U,4)
+3 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
+4 SET AMQQECNT=0
+5 FOR AMQQEDEN=0:1
SET %=$ORDER(^DPT(%))
IF %'=+%
QUIT
XECUTE AMQQEXCD
IF $TEST
SET AMQQENUM=AMQQENUM+1
SET %=%+AMQQEINC
IF '$DATA(AMQQHIDE)
WRITE "."
SET AMQQECNT=AMQQECNT+1
IF AMQQECNT>50
QUIT
+6 QUIT
+7 ;
SAMPLEV SET %=1
+1 SET AMQQENUM=0
+2 SET X=$PIECE(^AUPNVSIT(0),U,4)
+3 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
+4 SET AMQQECNT=0
+5 FOR AMQQEDEN=0:1
SET %=$ORDER(^AUPNVSIT(%))
IF %'=+%
QUIT
XECUTE AMQQEXCD
IF $TEST
SET AMQQENUM=AMQQENUM+1
SET %=%+AMQQEINC
IF '$DATA(AMQQHIDE)
WRITE "."
SET AMQQECNT=AMQQECNT+1
IF AMQQECNT>50
QUIT
+6 QUIT
+7 ;
SAMPLED SET %=1
SET AMQQENUM=0
+1 SET X=$PIECE(^AUPNVPOV(0),U,4)
+2 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
+3 SET AMQQECNT=0
+4 FOR AMQQEDEN=0:1
SET %=$ORDER(^AUPNVPOV(%))
IF %'=+%
QUIT
XECUTE AMQQEXCD
IF $TEST
SET AMQQENUM=AMQQENUM+1
SET %=%+AMQQEINC
IF '$DATA(AMQQHIDE)
WRITE "."
SET AMQQECNT=AMQQECNT+1
IF AMQQECNT>50
QUIT
+5 QUIT
+6 ;
DX IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"--"))
SET $PIECE(AMQQQ,U,11)=-1
QUIT
+1 IF '$DATA(AMQQHIDE)
WRITE !,"Computing Search Efficiency Rating...."
+2 SET %=0
+3 FOR I=0:1
SET %=$ORDER(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,%))
IF '%
QUIT
IF '$DATA(AMQQHIDE)
WRITE "."
+4 SET %=.99/((.01)*(4+(I/16)))
+5 SET %=$JUSTIFY(%,1,2)
+6 SET $PIECE(AMQQQ,U,11)=%
+7 IF $GET(AMQQUSQN)
IF '$DATA(^UTILITY("AMQQ",$JOB,"SQ",AMQQUSQN,"NULL"))
SET $PIECE(AMQQQ,U,11)=%_":"_20
+8 QUIT
+9 ;
FILE IF +Q<178
SET %=$PIECE(Q,U,9)
SET AMQQEXCD="I "_$SELECT(+Q=177:"'",1:"")_"$D(^"_$PIECE(%,";")_""""_$PIECE(%,";",2)_""",%))"
QUIT
+1 SET %=$PIECE(Q,U,9)
+2 SET AMQQEXCD="I $D(^UTILITY(""AMQQ FRAND"","_$PIECE(%,";",3)_","_$PIECE(%,";",6)_",%))"
+3 QUIT
+4 ;
KONG ; ENTRY POINT FROM AMQQCMPK
+1 IF $DATA(AMQQXX)
SET AMQQHIDE=""
+2 DO @("SAMPLE"_AMQQCCLS)
+3 SET X=AMQQENUM/AMQQEDEN
+4 IF 'X
SET X=.01
+5 SET X=1-X
SET X=$JUSTIFY(X,1,2)
+6 KILL AMQQHIDE
+7 QUIT
+8 ;
