Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQATR1

AMQQATR1.m

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