- 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 ;
