AMQQF1 ; IHS/CMI/THL - MORE 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
;
COMP S X1=Z
S X2=$P(AMQQCOMP,";")
D C^%DTC
S A=X
S X1=Z
S X2=$P(AMQQCOMP,";",2)
D C^%DTC
S B=X
Q
;
CDOB N X,Y,Z,%,I,A,B
S Z=$P(^DPT(AMQP(0),0),U,3)
I Z D COMP
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D CDOB1,TEST
K AMQQNOT
Q
;
CDOB1 I Z="" Q
I Y<A!(Y>B)
Q
;
CDOD N X,Y,Z,%,I,A,B
S Z=""
I $D(^DPT(AMQP(0),.35)) S Z=+^(.35) I Z D COMP
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D CDOD1,TEST
K AMQQNOT
Q
;
CDOD1 I Z="" Q
I Y<B!(Y>A)
Q
;
CAGE N X,Y,Z,%,I,A,B
S X1=$P(^DPT(AMQP(0),0),U,3)
I X1="" K X1 S Z="" G CAGET
S X2=$P(AMQQCOMP,";",4)
D C^%DTC
S Z=X
D COMP
CAGET F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S Y=$P(^(I),U,2) D CAGE1,TEST
K AMQQNOT
Q
;
CAGE1 I Z="" Q
I Y<A!(Y>B)
Q
;
SUB N AMQQSQFS,AMQQSQFN,AMQQSQFP,I
S AMQQSQFS=$P(AMQQCOMP,";")
S AMQQSQFN=$P(AMQQCOMP,";",2)
S AMQQSQFP=$P(AMQQCOMP,";",3)
N AMQQCOMP
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S AMQQHIT=^(I) D SUB1,TEST
K AMQQNOT
Q
;
SUB1 N I
I AMQQSQFN N AMQP,AMQT S AMQP(AMQQSQFN)=$P(AMQQHIT,U,AMQQSQFP) G SUBX
S AMQQDPT=AMQP(0)
N AMQQ,AMQQGR,AMQQID,AMQQST,AMQQFIN,AMQQLAST,AMQQVAL,AMQQMLT,AMQQT,AMQQIDX,AMQQIDN,AMQQIDT,AMQQX,AMQQITR,AMQQAFNO,AMQQVDAT,AMQQVNO,AMQQLCNT,AMQQVAL1,AMQQVAL2,AMQQMULZ,AMQQLCOF
N AMQQTAX,AMQQNNA,AMQQCPG1,AMQQVAL3,AMQQVAL4,AMQQBOOL,AMQQB,AMQQMSS,AMQQMPC,AMQQSTRT,AMQQFVAR,AMQQAG,AMQQSQVS,AMQQUATN,AMQQNVAR,AMQQT,AMQQUSQN,AMQT,AMQP,AMQQSQVN,AMQQSPEC
S AMQQAG="SAG"
S AMQP(0)=AMQQDPT
S AMQQSQVS=$P(AMQQHIT,U,3)
I AMQV("QQ",AMQQSQFS,1)[";+0;+0;" S AMQQSQVN=AMQQSQVS
SUBX K AMQQDPT,AMQQHIT
X AMQV("QQ",AMQQSQFS,1)
Q
;
BP N %,I,Z,A,B,C,D,E
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,AMQQAG,AMQQUATN,I)) Q:'I S %=$P(^(I),U) D BP1,TEST
Q
;
BP1 S A=+$P(%,"/")
S B=+$P(%,"/",2)
S %=AMQQCOMP
S C=$P(%,"~")
S D=$P(%,"~",2)
S E=$P(%,"~",3)
S Z="I "_A_$P(C,":")_$P(C,":",2)_E_"("_B_$P(D,":")_$P(D,":",2)_")"
X Z
I '$T
Q
;
AMQQF1 ; IHS/CMI/THL - MORE 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 ;
COMP SET X1=Z
+1 SET X2=$PIECE(AMQQCOMP,";")
+2 DO C^%DTC
+3 SET A=X
+4 SET X1=Z
+5 SET X2=$PIECE(AMQQCOMP,";",2)
+6 DO C^%DTC
+7 SET B=X
+8 QUIT
+9 ;
CDOB NEW X,Y,Z,%,I,A,B
+1 SET Z=$PIECE(^DPT(AMQP(0),0),U,3)
+2 IF Z
DO COMP
+3 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO CDOB1
DO TEST
+4 KILL AMQQNOT
+5 QUIT
+6 ;
CDOB1 IF Z=""
QUIT
+1 IF Y<A!(Y>B)
+2 QUIT
+3 ;
CDOD NEW X,Y,Z,%,I,A,B
+1 SET Z=""
+2 IF $DATA(^DPT(AMQP(0),.35))
SET Z=+^(.35)
IF Z
DO COMP
+3 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO CDOD1
DO TEST
+4 KILL AMQQNOT
+5 QUIT
+6 ;
CDOD1 IF Z=""
QUIT
+1 IF Y<B!(Y>A)
+2 QUIT
+3 ;
CAGE NEW X,Y,Z,%,I,A,B
+1 SET X1=$PIECE(^DPT(AMQP(0),0),U,3)
+2 IF X1=""
KILL X1
SET Z=""
GOTO CAGET
+3 SET X2=$PIECE(AMQQCOMP,";",4)
+4 DO C^%DTC
+5 SET Z=X
+6 DO COMP
CAGET FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET Y=$PIECE(^(I),U,2)
DO CAGE1
DO TEST
+1 KILL AMQQNOT
+2 QUIT
+3 ;
CAGE1 IF Z=""
QUIT
+1 IF Y<A!(Y>B)
+2 QUIT
+3 ;
SUB NEW AMQQSQFS,AMQQSQFN,AMQQSQFP,I
+1 SET AMQQSQFS=$PIECE(AMQQCOMP,";")
+2 SET AMQQSQFN=$PIECE(AMQQCOMP,";",2)
+3 SET AMQQSQFP=$PIECE(AMQQCOMP,";",3)
+4 NEW AMQQCOMP
+5 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET AMQQHIT=^(I)
DO SUB1
DO TEST
+6 KILL AMQQNOT
+7 QUIT
+8 ;
SUB1 NEW I
+1 IF AMQQSQFN
NEW AMQP,AMQT
SET AMQP(AMQQSQFN)=$PIECE(AMQQHIT,U,AMQQSQFP)
GOTO SUBX
+2 SET AMQQDPT=AMQP(0)
+3 NEW AMQQ,AMQQGR,AMQQID,AMQQST,AMQQFIN,AMQQLAST,AMQQVAL,AMQQMLT,AMQQT,AMQQIDX,AMQQIDN,AMQQIDT,AMQQX,AMQQITR,AMQQAFNO,AMQQVDAT,AMQQVNO,AMQQLCNT,AMQQVAL1,AMQQVAL2,AMQQMULZ,AMQQLCOF
+4 NEW AMQQTAX,AMQQNNA,AMQQCPG1,AMQQVAL3,AMQQVAL4,AMQQBOOL,AMQQB,AMQQMSS,AMQQMPC,AMQQSTRT,AMQQFVAR,AMQQAG,AMQQSQVS,AMQQUATN,AMQQNVAR,AMQQT,AMQQUSQN,AMQT,AMQP,AMQQSQVN,AMQQSPEC
+5 SET AMQQAG="SAG"
+6 SET AMQP(0)=AMQQDPT
+7 SET AMQQSQVS=$PIECE(AMQQHIT,U,3)
+8 IF AMQV("QQ",AMQQSQFS,1)[";+0;+0;"
SET AMQQSQVN=AMQQSQVS
SUBX KILL AMQQDPT,AMQQHIT
+1 XECUTE AMQV("QQ",AMQQSQFS,1)
+2 QUIT
+3 ;
BP NEW %,I,Z,A,B,C,D,E
+1 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,AMQQAG,AMQQUATN,I))
IF 'I
QUIT
SET %=$PIECE(^(I),U)
DO BP1
DO TEST
+2 QUIT
+3 ;
BP1 SET A=+$PIECE(%,"/")
+1 SET B=+$PIECE(%,"/",2)
+2 SET %=AMQQCOMP
+3 SET C=$PIECE(%,"~")
+4 SET D=$PIECE(%,"~",2)
+5 SET E=$PIECE(%,"~",3)
+6 SET Z="I "_A_$PIECE(C,":")_$PIECE(C,":",2)_E_"("_B_$PIECE(D,":")_$PIECE(D,":",2)_")"
+7 XECUTE Z
+8 IF '$TEST
+9 QUIT
+10 ;
