AMQQATR2 ; IHS/CMI/THL - DSO FOR TAX ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
I '$D(AMQQHIDE) W !,"Computing Search Efficiency Rating...."
S Q=AMQQQ
S S=^AMQQ(1,+Q,3)
K AMQQOK
S %=$P(Q,U,9)
I $P(%,";",5)="ANY" S AMQQSER=-1 G EXIT
S AMQQSERF="^AUPNPAT"
S AMQQDSCF=1
I $P(^AMQQ(1,+Q,0),U,12) S AMQQDSCF=$P(^(0),U,12)
I AMQQCCLS="V" D VISIT
I AMQQCCLS="H" D PROV
S AMQQTAX=$P(Q,U,17)
S %=$P(Q,U,9)
S N=9999999.999999
S X=N-$P(%,";",2)
S AMQQD1=X-.0000001
S AMQQD2=N-(+%)
S AMQQTDFN=1
S AMQQENUM=0
S X=$P(@AMQQSERF@(0),U,4)
S AMQQEINC=$S(X<50:0,1:(X\50))
S AMQQECNT=0
SAMPLE F AMQQEDEN=0:1 S AMQQTDFN=$O(@AMQQSERF@(AMQQTDFN)) Q:AMQQTDFN'=+AMQQTDFN S AMQQECMP=$G(AMQQECMP) X S S AMQQTDFN=AMQQTDFN+AMQQEINC,AMQQECNT=AMQQECNT+1 W:'$D(AMQQHIDE) "." I AMQQECNT>50 Q
SER S X=AMQQENUM/AMQQEDEN
I X=0 S X=.01
I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"NULL")) S X=1-X G SETSER
S X=(1-X)/$S($P(^AMQQ(1,+Q,0),U,8):X,1:1)
S X=X/AMQQDSCF
SETSER S X=$J(X,1,2)
I $P(AMQQQ,U,3)="G",+AMQQQ>689.9999,+AMQQQ<706 S X=X_":900" G SS1
SS1 S AMQQSER=X
S $P(AMQQQ,U,11)=X
EXIT K AMQQTAX,AMQQTPFN,%,X,Y,Z,A,B,C,D,N,I,AMQQD1,AMQQD2,AMQQTDFN,S,AMQQDSCF,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQECNT,AMQQETGB,AMQQETAX,AMQQSERF
Q
;
MTEST F X=AMQQD1:0 S X=$O(@AMQQETGB@(X)) Q:'X Q:X>AMQQD2 F AMQQTPFN=0:0 S AMQQTPFN=$O(@AMQQETGB@(X,AMQQTPFN)) Q:'AMQQTPFN I (($D(^UTILITY("AMQQ TAX",$J,AMQQURGN,+$G(@AMQQETAX)))=10)+($P(Q,U,18)=3))=1 S AMQQENUM=AMQQENUM+1 G MEXIT
MEXIT Q
;
TTEST I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"*")),AMQQETGB'="" S AMQQENUM=AMQQENUM+1 Q
I $D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"-")),AMQQETGB="" S AMQQENUM=AMQQENUM+1 Q
I AMQQETGB'="",$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQETGB)),'$D(^("--")) S AMQQENUM=AMQQENUM+1 Q
I '$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,"--")) Q
I AMQQETGB="" S AMQQENUM=AMQQENUM+1 Q
I AMQQETGB'="",'$D(^UTILITY("AMQQ TAX",$J,AMQQURGN,AMQQETGB)) S AMQQENUM=AMQQENUM+1
Q
;
VFILE ; ENTRY POINT FROM AMMQATR1
D VSET
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
RINCD S D=$O(@G@(B,D))
G RINCI:'D
S C=-999999999
RINCC S C=$O(@G@(B,D,C))
G RINCD:'C
S R=$P(@F@(C,S),U,T)
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=%
REXIT K %,A,B,C,D,E,F,G,H,I,J,K,M,N,P,R,S,T
Q
;
VSET S %=^AMQQ(1,+AMQQQ,0)
S F=U_$P(%,U,10)
S G=F_"(""AA"")"
S P=$P(^DPT(0),U,4)
S (B,I,J)=0
S A=(P\50)+(P<50)
S S=$P(%,U,11)
S T=$P(S,";",2)
S S=+S
S K=$P(%,U,12)
S %=$P(AMQQQ,U,9)
S Y=$P(%,";",4)
S Y=$P(Y,":")_$P(Y,":",2)
S Z=$P(%,";",5)
S Z=$P(Z,":")_$P(Z,":",2)
Q
;
VISIT N %,X,Y
S AMQQSERF="^AUPNVSIT"
S %=^AMQQ(1,+Q,0)
S %=$P(%,U,3)
I %=9000010 Q
S %=^DIC(%,0,"GL")
S X=$E(%,$L(%))
S Y=$E(%,1,$L(%)-1)
S AMQQSERF=Y_$S(X=",":")",1:"")
S X=$P(^AUPNVSIT(0),U,4)
S Y=$P(@AMQQSERF@(0),U,4)
I X,Y S AMQQDSCF=(X/Y)*AMQQDSCF
Q
;
PROV S AMQQSERF=AMQQ200(6)
Q
;
AMQQATR2 ; IHS/CMI/THL - DSO FOR TAX ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 IF '$DATA(AMQQHIDE)
WRITE !,"Computing Search Efficiency Rating...."
+4 SET Q=AMQQQ
+5 SET S=^AMQQ(1,+Q,3)
+6 KILL AMQQOK
+7 SET %=$PIECE(Q,U,9)
+8 IF $PIECE(%,";",5)="ANY"
SET AMQQSER=-1
GOTO EXIT
+9 SET AMQQSERF="^AUPNPAT"
+10 SET AMQQDSCF=1
+11 IF $PIECE(^AMQQ(1,+Q,0),U,12)
SET AMQQDSCF=$PIECE(^(0),U,12)
+12 IF AMQQCCLS="V"
DO VISIT
+13 IF AMQQCCLS="H"
DO PROV
+14 SET AMQQTAX=$PIECE(Q,U,17)
+15 SET %=$PIECE(Q,U,9)
+16 SET N=9999999.999999
+17 SET X=N-$PIECE(%,";",2)
+18 SET AMQQD1=X-.0000001
+19 SET AMQQD2=N-(+%)
+20 SET AMQQTDFN=1
+21 SET AMQQENUM=0
+22 SET X=$PIECE(@AMQQSERF@(0),U,4)
+23 SET AMQQEINC=$SELECT(X<50:0,1:(X\50))
+24 SET AMQQECNT=0
SAMPLE FOR AMQQEDEN=0:1
SET AMQQTDFN=$ORDER(@AMQQSERF@(AMQQTDFN))
IF AMQQTDFN'=+AMQQTDFN
QUIT
SET AMQQECMP=$GET(AMQQECMP)
XECUTE S
SET AMQQTDFN=AMQQTDFN+AMQQEINC
SET AMQQECNT=AMQQECNT+1
IF '$DATA(AMQQHIDE)
WRITE "."
IF AMQQECNT>50
QUIT
SER SET X=AMQQENUM/AMQQEDEN
+1 IF X=0
SET X=.01
+2 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"NULL"))
SET X=1-X
GOTO SETSER
+3 SET X=(1-X)/$SELECT($PIECE(^AMQQ(1,+Q,0),U,8):X,1:1)
+4 SET X=X/AMQQDSCF
SETSER SET X=$JUSTIFY(X,1,2)
+1 IF $PIECE(AMQQQ,U,3)="G"
IF +AMQQQ>689.9999
IF +AMQQQ<706
SET X=X_":900"
GOTO SS1
SS1 SET AMQQSER=X
+1 SET $PIECE(AMQQQ,U,11)=X
EXIT KILL AMQQTAX,AMQQTPFN,%,X,Y,Z,A,B,C,D,N,I,AMQQD1,AMQQD2,AMQQTDFN,S,AMQQDSCF,AMQQENUM,AMQQEDEN,AMQQEINC,AMQQECNT,AMQQETGB,AMQQETAX,AMQQSERF
+1 QUIT
+2 ;
MTEST FOR X=AMQQD1:0
SET X=$ORDER(@AMQQETGB@(X))
IF 'X
QUIT
IF X>AMQQD2
QUIT
FOR AMQQTPFN=0:0
SET AMQQTPFN=$ORDER(@AMQQETGB@(X,AMQQTPFN))
IF 'AMQQTPFN
QUIT
IF (($DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,+$GET(@AMQQETAX)))=10)+($PIECE(Q,U,18)=3))=1
SET AMQQENUM=AMQQENUM+1
GOTO MEXIT
MEXIT QUIT
+1 ;
TTEST IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"*"))
IF AMQQETGB'=""
SET AMQQENUM=AMQQENUM+1
QUIT
+1 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"-"))
IF AMQQETGB=""
SET AMQQENUM=AMQQENUM+1
QUIT
+2 IF AMQQETGB'=""
IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,AMQQETGB))
IF '$DATA(^("--"))
SET AMQQENUM=AMQQENUM+1
QUIT
+3 IF '$DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,"--"))
QUIT
+4 IF AMQQETGB=""
SET AMQQENUM=AMQQENUM+1
QUIT
+5 IF AMQQETGB'=""
IF '$DATA(^UTILITY("AMQQ TAX",$JOB,AMQQURGN,AMQQETGB))
SET AMQQENUM=AMQQENUM+1
+6 QUIT
+7 ;
VFILE ; ENTRY POINT FROM AMMQATR1
+1 DO VSET
RINCI SET I=I+1
+1 IF '$DATA(AMQQHIDE)
WRITE "."
+2 IF I>50
GOTO RSET
+3 SET B=B+A
+4 SET B=$ORDER(@G@(B))
+5 IF 'B
GOTO RSET
+6 SET D=0
RINCD SET D=$ORDER(@G@(B,D))
+1 IF 'D
GOTO RINCI
+2 SET C=-999999999
RINCC SET C=$ORDER(@G@(B,D,C))
+1 IF 'C
GOTO RINCD
+2 SET R=$PIECE(@F@(C,S),U,T)
+3 IF $DATA(AMQQLTR)
XECUTE AMQQLTR
SET Y=AMQQLTB1_AMQQLTR1
SET Z=AMQQLTB2_AMQQLTR2
+4 IF $DATA(AMQQRTXT)
XECUTE AMQQRTXT
GOTO INCJ
+5 IF Z=""
SET %="I R"_Y
XECUTE %
GOTO INCJ
+6 SET %="I R"_Y_",R"_Z
+7 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=%
REXIT KILL %,A,B,C,D,E,F,G,H,I,J,K,M,N,P,R,S,T
+1 QUIT
+2 ;
VSET SET %=^AMQQ(1,+AMQQQ,0)
+1 SET F=U_$PIECE(%,U,10)
+2 SET G=F_"(""AA"")"
+3 SET P=$PIECE(^DPT(0),U,4)
+4 SET (B,I,J)=0
+5 SET A=(P\50)+(P<50)
+6 SET S=$PIECE(%,U,11)
+7 SET T=$PIECE(S,";",2)
+8 SET S=+S
+9 SET K=$PIECE(%,U,12)
+10 SET %=$PIECE(AMQQQ,U,9)
+11 SET Y=$PIECE(%,";",4)
+12 SET Y=$PIECE(Y,":")_$PIECE(Y,":",2)
+13 SET Z=$PIECE(%,";",5)
+14 SET Z=$PIECE(Z,":")_$PIECE(Z,":",2)
+15 QUIT
+16 ;
VISIT NEW %,X,Y
+1 SET AMQQSERF="^AUPNVSIT"
+2 SET %=^AMQQ(1,+Q,0)
+3 SET %=$PIECE(%,U,3)
+4 IF %=9000010
QUIT
+5 SET %=^DIC(%,0,"GL")
+6 SET X=$EXTRACT(%,$LENGTH(%))
+7 SET Y=$EXTRACT(%,1,$LENGTH(%)-1)
+8 SET AMQQSERF=Y_$SELECT(X=",":")",1:"")
+9 SET X=$PIECE(^AUPNVSIT(0),U,4)
+10 SET Y=$PIECE(@AMQQSERF@(0),U,4)
+11 IF X
IF Y
SET AMQQDSCF=(X/Y)*AMQQDSCF
+12 QUIT
+13 ;
PROV SET AMQQSERF=AMQQ200(6)
+1 QUIT
+2 ;
