AMQQF.m

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       ;