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