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