AMQQF0 ; IHS/CMI/THL - GETS OVERFLOW FROM AMQQF ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
REL N A,B,C,D,X,Y,Z,I,%,N,P,Q,R,AMQQD
S %=AMQQCOMP
S A=$P(%,";")
S B=$P(%,";",2)
S C=$P(%,";",3)
D @$S(C:"RAGE",A>B:"RDOD",1:"RDOB")
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S %=$P(^(I),U,2) I ('%)!(%<AMQQD(1))!(%>AMQQD(2)) K ^(I)
Q
;
RAGE D RDB
I 'X Q
S %=C
D RD
S AMQQD(0)=X
S %=A
D RD
S AMQQD(1)=X
S X=AMQQD(0)
S %=B
D RD
S AMQQD(2)=X
Q
;
RDOB D RDB
I 'X Q
S AMQQD(0)=X
S %=A
D RD
S AMQQD(1)=X
S X=AMQQD(0)
S %=B
D RD
S AMQQD(2)=X
Q
;
RDOD D RDD
I 'X Q
S AMQQD(0)=X
S %=A*-1
D RD
S AMQQD(1)=X
S X=AMQQD(0)
S %=B*-1
D RD
S AMQQD(2)=X
Q
;
RD S X1=X
S X2=%
D C^%DTC
K %H,%T
Q
;
RDB S X=$G(^DPT(AMQP(0),0))
S X=$P(X,U,3)
G RDCK
RDD S X=+$G(^DPT(AMQP(0),.35))
RDCK I 'X K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN)
Q
;
EARLY N I,X,Y,Z,%
S Y=9999999
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Z=$P(^(I),U,2) I Z'="",Z<Y S Y=Z,X=I
I Y<9999999 S %=^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,X) K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)=%
Q
;
LATEST N I,X,Y,Z,%
S Y=0
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Z=$P(^(I),U,2) I Z'="",Z>Y S Y=Z,X=I
I Y>0 S %=^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,X) K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,1)=%
Q
;
CHANGE N A,B,X,Y,Z,%,I
S I=0
F X=0:0 S X=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,X)) Q:'X S Y=+^(X),Z=$P(^(X),U,2),I=I+1 S:'$D(A) (A,B)=Z_U_Y S:+Z<A A=Z_U_Y S:+Z>B B=Z_U_Y
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) I I>1 S ^(AMQQUATN,1)=$P(B,U,2)-$P(A,U,2)
Q
;
SUM N Z,I
S Z=0
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I I +^(I)'="" S Z=+^(I)+Z
K ^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN) S ^(AMQQUATN,1)=Z
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
;
SQRD ; ENTRY POINT FROM METADICTIONARY
I $E(AMQQRDX)?1P D SQREL G SQRDEXIT
I $P(AMQQRDX,";",3)'>$P(AMQQRDX,";",2),$P(AMQQRDX,";",3)'<+AMQQRDX
SQRDEXIT K AMQQRDX,Y,X,X1,X2
Q
;
SQREL S X1=+^AUPNVSIT(AMQP(1),0)
S X2=$P(AMQQRDX,";")
I $E(X2)="+" S X2=+$E(X2,2,9)
D C^%DTC
I $P(AMQQRDX,";",3)>X X "I 0" Q
S X1=+^AUPNVSIT(AMQP(1),0)
S X2=$P(AMQQRDX,";",2)
D C^%DTC
I $P(AMQQRDX,";",3)<X X "I 0" Q
I 1
Q
;
AMQQF0 ; IHS/CMI/THL - GETS OVERFLOW FROM AMQQF ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
REL NEW A,B,C,D,X,Y,Z,I,%,N,P,Q,R,AMQQD
+1 SET %=AMQQCOMP
+2 SET A=$PIECE(%,";")
+3 SET B=$PIECE(%,";",2)
+4 SET C=$PIECE(%,";",3)
+5 DO @$SELECT(C:"RAGE",A>B:"RDOD",1:"RDOB")
+6 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET %=$PIECE(^(I),U,2)
IF ('%)!(%<AMQQD(1))!(%>AMQQD(2))
KILL ^(I)
+7 QUIT
+8 ;
RAGE DO RDB
+1 IF 'X
QUIT
+2 SET %=C
+3 DO RD
+4 SET AMQQD(0)=X
+5 SET %=A
+6 DO RD
+7 SET AMQQD(1)=X
+8 SET X=AMQQD(0)
+9 SET %=B
+10 DO RD
+11 SET AMQQD(2)=X
+12 QUIT
+13 ;
RDOB DO RDB
+1 IF 'X
QUIT
+2 SET AMQQD(0)=X
+3 SET %=A
+4 DO RD
+5 SET AMQQD(1)=X
+6 SET X=AMQQD(0)
+7 SET %=B
+8 DO RD
+9 SET AMQQD(2)=X
+10 QUIT
+11 ;
RDOD DO RDD
+1 IF 'X
QUIT
+2 SET AMQQD(0)=X
+3 SET %=A*-1
+4 DO RD
+5 SET AMQQD(1)=X
+6 SET X=AMQQD(0)
+7 SET %=B*-1
+8 DO RD
+9 SET AMQQD(2)=X
+10 QUIT
+11 ;
RD SET X1=X
+1 SET X2=%
+2 DO C^%DTC
+3 KILL %H,%T
+4 QUIT
+5 ;
RDB SET X=$GET(^DPT(AMQP(0),0))
+1 SET X=$PIECE(X,U,3)
+2 GOTO RDCK
RDD SET X=+$GET(^DPT(AMQP(0),.35))
RDCK IF 'X
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
+1 QUIT
+2 ;
EARLY NEW I,X,Y,Z,%
+1 SET Y=9999999
+2 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Z=$PIECE(^(I),U,2)
IF Z'=""
IF Z<Y
SET Y=Z
SET X=I
+3 IF Y<9999999
SET %=^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,X)
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)=%
+4 QUIT
+5 ;
LATEST NEW I,X,Y,Z,%
+1 SET Y=0
+2 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Z=$PIECE(^(I),U,2)
IF Z'=""
IF Z>Y
SET Y=Z
SET X=I
+3 IF Y>0
SET %=^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,X)
KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
SET ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,1)=%
+4 QUIT
+5 ;
CHANGE NEW A,B,X,Y,Z,%,I
+1 SET I=0
+2 FOR X=0:0
SET X=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,X))
IF 'X
QUIT
SET Y=+^(X)
SET Z=$PIECE(^(X),U,2)
SET I=I+1
IF '$DATA(A)
SET (A,B)=Z_U_Y
IF +Z<A
SET A=Z_U_Y
IF +Z>B
SET B=Z_U_Y
+3 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
IF I>1
SET ^(AMQQUATN,1)=$PIECE(B,U,2)-$PIECE(A,U,2)
+4 QUIT
+5 ;
SUM NEW Z,I
+1 SET Z=0
+2 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
IF +^(I)'=""
SET Z=+^(I)+Z
+3 KILL ^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN)
SET ^(AMQQUATN,1)=Z
+4 QUIT
+5 ;
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)
IF I>1
SET ^(AMQQUATN,1)=B-A
+3 QUIT
+4 ;
SQRD ; ENTRY POINT FROM METADICTIONARY
+1 IF $EXTRACT(AMQQRDX)?1P
DO SQREL
GOTO SQRDEXIT
+2 IF $PIECE(AMQQRDX,";",3)'>$PIECE(AMQQRDX,";",2)
IF $PIECE(AMQQRDX,";",3)'<+AMQQRDX
SQRDEXIT KILL AMQQRDX,Y,X,X1,X2
+1 QUIT
+2 ;
SQREL SET X1=+^AUPNVSIT(AMQP(1),0)
+1 SET X2=$PIECE(AMQQRDX,";")
+2 IF $EXTRACT(X2)="+"
SET X2=+$EXTRACT(X2,2,9)
+3 DO C^%DTC
+4 IF $PIECE(AMQQRDX,";",3)>X
XECUTE "I 0"
QUIT
+5 SET X1=+^AUPNVSIT(AMQP(1),0)
+6 SET X2=$PIECE(AMQQRDX,";",2)
+7 DO C^%DTC
+8 IF $PIECE(AMQQRDX,";",3)<X
XECUTE "I 0"
QUIT
+9 IF 1
+10 QUIT
+11 ;
