AMQQF ; IHS/CMI/THL - STORES ANALYTIC FUNCTIONS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
TEST N T
S T=$T
I '$D(AMQQNOT)=T K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)
EXIT Q
;
AVE N Y,Z,I
S Y=0
S Z=0
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I I +^(I) S Y=Y+1,Z=+^(I)+Z
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
I Y S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)=$J((Z/Y),1,1)
Q
;
SPAN N A,B,I,N,%,X S I=0
F X=0:0 S X=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,X)) Q:'X S %=+^(X) S:'$D(A) (A,B)=% S:%<A A=% S:%>B B=% S I=I+1
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
I I>1 S ^(AMQQUATN,1)=B-A
Q
;
EXIST I $D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) K ^(AMQQUATN) S ^(AMQQUATN,1)="+"
Q
;
NULL I '$D(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)) S ^(AMQQUATN,1)="NULL"
Q
;
GRT N I
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D GRT1,TEST
K AMQQNOT
Q
;
GRT1 I +^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)'>AMQQCOMP
Q
;
LESS N I
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D LESS1,TEST
K AMQQNOT
Q
;
LESS1 I +^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)'<AMQQCOMP
Q
;
EQUAL N I
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D EQUAL1,TEST
K AMQQNOT
Q
;
EQUAL1 I $E(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I))?1N S $P(^(I),U,1)=+^(I)
I $P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I),U)'=AMQQCOMP
Q
;
STARTW N X,Y,Z,I
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D STARTW1,TEST
K AMQQNOT
Q
;
STARTW1 S X=$P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I),U)
I $E(X,1,$L(AMQQCOMP))'=AMQQCOMP
Q
;
ENDW S X=$P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I),U)
Q:'I
D ENDW1,TEST
Q
;
ENDW1 S X=$P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I),U)
I $E(X,$L(X)-$L(AMQQCOMP)+1,255)'=AMQQCOMP
Q
;
BET N I,X,Y
S X=$P(AMQQCOMP,";")
S Y=$P(AMQQCOMP,";",2)
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D BET1,TEST
K AMQQNOT
Q
;
BET1 I +^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)<X!(+^(I)>Y)
Q
;
ALL ;
SAVE ;
Q
;
LEAST N I,Y S Y=0
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=Y+1
I AMQQCOMP>Y K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
Q
;
MOST N I,Y
S Y=0
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=Y+1
I AMQQCOMP<Y K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
Q
;
TOTAL N X,Y,Z,I
S Y=0,Z=0
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I I ^(I)'="" S Y=Y+1
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN),AMQQTOTF(AMQQFVAR)
I Y S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)=Y,AMQQTOTF(AMQQFVAR)=""
Q
;
CONTX N I
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D CONTX1,TEST
K AMQQNOT
Q
;
CONTX1 I $P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I),U)'[AMQQCOMP
Q
;
FOLTX N I
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D FOLTX1,TEST
K AMQQNOT
Q
;
FOLTX1 I $P(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I),U)']AMQQCOMP
D TEST
Q
;
PATTERN N I,X,Y,Z
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I D PAT1,TEST
K AMQQNOT
Q
;
PAT1 S X="I $P(^UTILITY(""AMQQ"",$J,AMQQAG,AMQQUATN,I),U)'?"_AMQQCOMP
X X
Q
;
BETD N I,X,Y,Z
S Z=$P(AMQQCOMP,";",2)
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D BETD1,TEST
K AMQQNOT
Q
;
BETD1 I Y<+AMQQCOMP!(Y>Z)
Q
;
AFTER N I,X,Y
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D AFT1,TEST
K AMQQNOT
Q
;
AFT1 I Y'>AMQQCOMP
Q
;
ON N I,X,Y
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D ON1,TEST
K AMQQNOT
Q
;
ON1 I Y\1'=+AMQQCOMP\1
Q
;
BEFORE N I,X,Y
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D BEF1,TEST
K AMQQNOT
Q
;
BEF1 I Y'<AMQQCOMP
Q
;
AMQQF ; IHS/CMI/THL - STORES ANALYTIC FUNCTIONS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
TEST NEW T
+1 SET T=$TEST
+2 IF '$DATA(AMQQNOT)=T
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I)
EXIT QUIT
+1 ;
AVE NEW Y,Z,I
+1 SET Y=0
+2 SET Z=0
+3 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
IF +^(I)
SET Y=Y+1
SET Z=+^(I)+Z
+4 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+5 IF Y
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)=$JUSTIFY((Z/Y),1,1)
+6 QUIT
+7 ;
SPAN NEW A,B,I,N,%,X
SET I=0
+1 FOR X=0:0
SET X=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,X))
IF 'X
QUIT
SET %=+^(X)
IF '$DATA(A)
SET (A,B)=%
IF %<A
SET A=%
IF %>B
SET B=%
SET I=I+1
+2 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+3 IF I>1
SET ^(AMQQUATN,1)=B-A
+4 QUIT
+5 ;
EXIST IF $DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
KILL ^(AMQQUATN)
SET ^(AMQQUATN,1)="+"
+1 QUIT
+2 ;
NULL IF '$DATA(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN))
SET ^(AMQQUATN,1)="NULL"
+1 QUIT
+2 ;
GRT NEW I
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO GRT1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
GRT1 IF +^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I)'>AMQQCOMP
+1 QUIT
+2 ;
LESS NEW I
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO LESS1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
LESS1 IF +^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I)'<AMQQCOMP
+1 QUIT
+2 ;
EQUAL NEW I
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO EQUAL1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
EQUAL1 IF $EXTRACT(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))?1N
SET $PIECE(^(I),U,1)=+^(I)
+1 IF $PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I),U)'=AMQQCOMP
+2 QUIT
+3 ;
STARTW NEW X,Y,Z,I
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO STARTW1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
STARTW1 SET X=$PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I),U)
+1 IF $EXTRACT(X,1,$LENGTH(AMQQCOMP))'=AMQQCOMP
+2 QUIT
+3 ;
ENDW SET X=$PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I),U)
+1 IF 'I
QUIT
+2 DO ENDW1
DO TEST
+3 QUIT
+4 ;
ENDW1 SET X=$PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I),U)
+1 IF $EXTRACT(X,$LENGTH(X)-$LENGTH(AMQQCOMP)+1,255)'=AMQQCOMP
+2 QUIT
+3 ;
BET NEW I,X,Y
+1 SET X=$PIECE(AMQQCOMP,";")
+2 SET Y=$PIECE(AMQQCOMP,";",2)
+3 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO BET1
DO TEST
+4 KILL AMQQNOT
+5 QUIT
+6 ;
BET1 IF +^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I)<X!(+^(I)>Y)
+1 QUIT
+2 ;
ALL ;
SAVE ;
+1 QUIT
+2 ;
LEAST NEW I,Y
SET Y=0
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=Y+1
+2 IF AMQQCOMP>Y
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+3 QUIT
+4 ;
MOST NEW I,Y
+1 SET Y=0
+2 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=Y+1
+3 IF AMQQCOMP<Y
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+4 QUIT
+5 ;
TOTAL NEW X,Y,Z,I
+1 SET Y=0
SET Z=0
+2 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
IF ^(I)'=""
SET Y=Y+1
+3 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN),AMQQTOTF(AMQQFVAR)
+4 IF Y
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)=Y
SET AMQQTOTF(AMQQFVAR)=""
+5 QUIT
+6 ;
CONTX NEW I
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO CONTX1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
CONTX1 IF $PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I),U)'[AMQQCOMP
+1 QUIT
+2 ;
FOLTX NEW I
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO FOLTX1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
FOLTX1 IF $PIECE(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I),U)']AMQQCOMP
+1 DO TEST
+2 QUIT
+3 ;
PATTERN NEW I,X,Y,Z
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
DO PAT1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
PAT1 SET X="I $P(^UTILITY(""AMQQ"",$J,AMQQAG,AMQQUATN,I),U)'?"_AMQQCOMP
+1 XECUTE X
+2 QUIT
+3 ;
BETD NEW I,X,Y,Z
+1 SET Z=$PIECE(AMQQCOMP,";",2)
+2 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO BETD1
DO TEST
+3 KILL AMQQNOT
+4 QUIT
+5 ;
BETD1 IF Y<+AMQQCOMP!(Y>Z)
+1 QUIT
+2 ;
AFTER NEW I,X,Y
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO AFT1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
AFT1 IF Y'>AMQQCOMP
+1 QUIT
+2 ;
ON NEW I,X,Y
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO ON1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
ON1 IF Y\1'=+AMQQCOMP\1
+1 QUIT
+2 ;
BEFORE NEW I,X,Y
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO BEF1
DO TEST
+2 KILL AMQQNOT
+3 QUIT
+4 ;
BEF1 IF Y'<AMQQCOMP
+1 QUIT
+2 ;