AMQQMULN ; IHS/CMI/THL - AMQQMULT SUBROUTINE...SPECIAL EVALUATION OF VALUES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
RUN I AMQQVALU="" X "I 0" Q
I AMQQVAL1=-999999999,AMQQVAL2=999999999 Q
D NN2:AMQQNNA=2
D NN3:AMQQNNA=3
D NN4:AMQQNNA=4
D NN5:AMQQNNA=5
D NN6:AMQQNNA=6
D NN7:AMQQNNA=7
EXIT ;
Q
;
NN2 ; ENTRY POINT FROM AMQQMULT
S %=AMQQVALU
S AMQQVALU=$S($E(%)="N":0,$E(%)="T":1,1:(+%+1))
I AMQQVAL1'>AMQQVAL2,AMQQVALU'<AMQQVAL1,AMQQVALU'>AMQQVAL2 Q
I AMQQVAL1>AMQQVAL2,AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1)
Q
;
NN3 ; ENTRY POINT FROM AMQQMULT ; POS/NEG
S AMQQVALU='($E(AMQQVALU)="N")
I AMQQVALU'<AMQQVAL1,AMQQVALU'>AMQQVAL2
Q
;
NN4 ; ENTRY POINT FROM AMQQMULT ; TITRE
S AMQQVALU=$S($E(AMQQVALU)="N":0,$E(AMQQVALU)="P":.1,1:+$P(AMQQVALU,":",2))
I AMQQVALU'="" S AMQQVALU=+AMQQVALU
I AMQQVAL1'>AMQQVAL2,AMQQVALU'<AMQQVAL1,AMQQVALU'>AMQQVAL2 Q
I AMQQVAL1>AMQQVAL2,AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1) Q
Q
;
NN5 ; IMMUNIZATIONS ; ENTRY POINT FROM AMQQMULT
N %
S %=$P(^AUTTIMM(AMQQIDX,0),U,2),AMQQVALU=% I 1 Q
I AMQQVAL1="U",AMQQVALU="" S AMQQVALU=%_"(?)" Q
I AMQQVAL1="A",AMQQVALU'="" S AMQQVALU=%_"("_AMQQVALU_")" Q
I AMQQVALU=AMQQVAL1 S AMQQVALU=%_"("_AMQQVAL1_")" Q
Q
;
BP ; - EP -
N T,X,A,B,C
S X=1
S A=AMQQVAL1
S B=AMQQVAL2
S C=$P(AMQQVALU,"/")
D BOOLEAN
S X=2
S A=AMQQVAL3
S B=AMQQVAL4
S C=$P(AMQQVALU,"/",2)
D BOOLEAN
S X="I "_X(1)_AMQQBOOL_"("_X(2)_")"
X X
Q
;
BOOLEAN S X(X)=0
I A>B,C<B!(C>A) S X(X)=1 Q
I C=A,C=B S X(X)=1 Q
I C>A,C<B S X(X)=1
Q
;
NN6 ; SET OF CODES
I AMQQVAL1="=",AMQQVALU=AMQQVAL2 Q
I AMQQVAL1="'=",AMQQVALU'=AMQQVAL2 Q
I AMQQVAL1="EXISTS"!(AMQQVAL1)="ALL" S AMQQSPEC="EXISTS" Q
I $E(AMQQVAL1,1,3)="ANY" S AMQQSPEC="ANY" Q
Q
;
NN7 ; TAXONOMY
I $D(^UTILITY("AMQQ TAX",$J,AMQQVAL1,AMQQVALU))+$D(^("*"))='$D(^("--"))
Q
;
AMQQMULN ; IHS/CMI/THL - AMQQMULT SUBROUTINE...SPECIAL EVALUATION OF VALUES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
RUN IF AMQQVALU=""
XECUTE "I 0"
QUIT
+1 IF AMQQVAL1=-999999999
IF AMQQVAL2=999999999
QUIT
+2 IF AMQQNNA=2
DO NN2
+3 IF AMQQNNA=3
DO NN3
+4 IF AMQQNNA=4
DO NN4
+5 IF AMQQNNA=5
DO NN5
+6 IF AMQQNNA=6
DO NN6
+7 IF AMQQNNA=7
DO NN7
EXIT ;
+1 QUIT
+2 ;
NN2 ; ENTRY POINT FROM AMQQMULT
+1 SET %=AMQQVALU
+2 SET AMQQVALU=$SELECT($EXTRACT(%)="N":0,$EXTRACT(%)="T":1,1:(+%+1))
+3 IF AMQQVAL1'>AMQQVAL2
IF AMQQVALU'<AMQQVAL1
IF AMQQVALU'>AMQQVAL2
QUIT
+4 IF AMQQVAL1>AMQQVAL2
IF AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1)
+5 QUIT
+6 ;
NN3 ; ENTRY POINT FROM AMQQMULT ; POS/NEG
+1 SET AMQQVALU='($EXTRACT(AMQQVALU)="N")
+2 IF AMQQVALU'<AMQQVAL1
IF AMQQVALU'>AMQQVAL2
+3 QUIT
+4 ;
NN4 ; ENTRY POINT FROM AMQQMULT ; TITRE
+1 SET AMQQVALU=$SELECT($EXTRACT(AMQQVALU)="N":0,$EXTRACT(AMQQVALU)="P":.1,1:+$PIECE(AMQQVALU,":",2))
+2 IF AMQQVALU'=""
SET AMQQVALU=+AMQQVALU
+3 IF AMQQVAL1'>AMQQVAL2
IF AMQQVALU'<AMQQVAL1
IF AMQQVALU'>AMQQVAL2
QUIT
+4 IF AMQQVAL1>AMQQVAL2
IF AMQQVALU<AMQQVAL2!(AMQQVALU>AMQQVAL1)
QUIT
+5 QUIT
+6 ;
NN5 ; IMMUNIZATIONS ; ENTRY POINT FROM AMQQMULT
+1 NEW %
+2 SET %=$PIECE(^AUTTIMM(AMQQIDX,0),U,2)
SET AMQQVALU=%
IF 1
QUIT
+3 IF AMQQVAL1="U"
IF AMQQVALU=""
SET AMQQVALU=%_"(?)"
QUIT
+4 IF AMQQVAL1="A"
IF AMQQVALU'=""
SET AMQQVALU=%_"("_AMQQVALU_")"
QUIT
+5 IF AMQQVALU=AMQQVAL1
SET AMQQVALU=%_"("_AMQQVAL1_")"
QUIT
+6 QUIT
+7 ;
BP ; - EP -
+1 NEW T,X,A,B,C
+2 SET X=1
+3 SET A=AMQQVAL1
+4 SET B=AMQQVAL2
+5 SET C=$PIECE(AMQQVALU,"/")
+6 DO BOOLEAN
+7 SET X=2
+8 SET A=AMQQVAL3
+9 SET B=AMQQVAL4
+10 SET C=$PIECE(AMQQVALU,"/",2)
+11 DO BOOLEAN
+12 SET X="I "_X(1)_AMQQBOOL_"("_X(2)_")"
+13 XECUTE X
+14 QUIT
+15 ;
BOOLEAN SET X(X)=0
+1 IF A>B
IF C<B!(C>A)
SET X(X)=1
QUIT
+2 IF C=A
IF C=B
SET X(X)=1
QUIT
+3 IF C>A
IF C<B
SET X(X)=1
+4 QUIT
+5 ;
NN6 ; SET OF CODES
+1 IF AMQQVAL1="="
IF AMQQVALU=AMQQVAL2
QUIT
+2 IF AMQQVAL1="'="
IF AMQQVALU'=AMQQVAL2
QUIT
+3 IF AMQQVAL1="EXISTS"!(AMQQVAL1)="ALL"
SET AMQQSPEC="EXISTS"
QUIT
+4 IF $EXTRACT(AMQQVAL1,1,3)="ANY"
SET AMQQSPEC="ANY"
QUIT
+5 QUIT
+6 ;
NN7 ; TAXONOMY
+1 IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQVAL1,AMQQVALU))+$DATA(^("*"))='$DATA(^("--"))
+2 QUIT
+3 ;
