AMQQCMP2 ; IHS/CMI/THL - NON "OR" SEARCH CRITERIA COMPILATATION ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;-----
RUN F S AMQQSER=$O(@AMQQ@(AMQQSER)) Q:AMQQSER="" F AMQQUATN=0:0 S AMQQUATN=$O(@AMQQ@(AMQQSER,AMQQUATN)) Q:'AMQQUATN S (Q,AMQQQ)=^UTILITY("AMQQ",$J,"Q",AMQQUATN) D TEMPLATE
D ^AMQQCMP4
D ^AMQQCMP6
I $D(^UTILITY("AMQQ",$J,"SQ",0)) D EN1^AMQQCMP3
S AMQV(AMQQLINO)="D ^AMQQDO"
I $D(AMQQFFF) S AMQV(AMQQLINO)="D OUTPUT^AMQQRMFF"
I $D(AMQQYY(0)) S AMQV(AMQQLINO)="D OUTPUT^AMQQCMPS"
I '$D(AMQQCNAM),AMQQCCLS="P" S AMQQCNAM="PATIENTS"
S AMQV(0)="K AMQQQUIT S AMQQTOT=0,AMQQCCLS="""_AMQQCCLS_""",AMQQCNAM="""_AMQQCNAM_""" D LOG^AMQQMGR2 X AMQV(1) D TIME^AMQQMGR2"
EXIT K AMQQ,AMQQCOMP,AMQQFVAR,AMQQHOLD,AMQQINDX,AMQQLINK,AMQQNVAR,AMQQSER,AMQQSF,AMQQVALU,AMQQVAR,%,Y,Z,A,B,C,D,E,I,Q,AMQQZLIN,AMQQZNN,AMQQQ,AMQQUSQN,AMQQI,AMQQIQ
Q
;
TEMPLATE ; ENTRY POINT FROM AMQQCMPK
S AMQQLINK=+Q
S Z=""
S AMQQNVAR=$P(Q,U,14)
I $P(Q,U,9)[";NULL",$D(^AMQQ(1,+Q,5)),^(5)'="" S AMQQSBSC=5 G T1
I $P(Q,U,9)[";ANY",$D(^AMQQ(1,+Q,7)),^(7)'="" S AMQQSBSC=7 G T1
I $P(Q,U,9)[";INVERSE",$D(^AMQQ(1,+Q,8)),^(8)'="" S AMQQSBSC=8 G T1
S AMQQSBSC=$S(AMQQLINO>1:2,$D(AMQQKGNO):2,1:1)
I AMQQLINO>1,AMQQLINK[455!(AMQQLINK[681),Q'[(";ANY"),Q'[";ALL",Q'[";NULL" S AMQQSBSC=1
S %=$P(Q,U,11)
S %=$P(%,":",2)
I %=2 S AMQQSBSC=2
S %=$P(Q,U,9)
I %[";NULL"!(%["EXIST")!(%[";INVERSE") S:+Q'=758 AMQQNVAR=1
T1 F AMQQCSC=AMQQSBSC:.1 Q:'$D(^AMQQ(1,AMQQLINK,AMQQCSC)) I ^(AMQQCSC)'="" S AMQV(AMQQLINO)=$S($G(AMQV(1))'["DIBT("&($G(AMQV(2))'["DPT(""B""")!(AMQQCSC'=1.1):^(AMQQCSC),'$D(^(1.11)):^(AMQQCSC),1:^(1.11)) D TSET K AMQQTFLG
S %=0
F AMQQI=1:1:AMQQNVAR S %=$O(^AMQQ(1,AMQQLINK,4,%)) Q:'% I '$D(AMQQKGNO) D GROUP I $D(AMQQIQ) K AMQQIQ Q
S AMQQVAR=AMQQVAR+AMQQNVAR
I $P(Q,U,17),$P(Q,U,4) S %=$P(Q,U,9),%=$P(%,";",5) I %'="" S AMQV(AMQQLINO-1,%)=""
I $P(Q,U,3)="I" S %=$P(Q,U,9),%=$P(%,";",5) I %'="" S AMQV(AMQQLINO-1,%)=""
K AMQQSBSC,AMQQCSC
Q
;
TSET S Y=$P(Q,U,15)
S X=AMQQLINO
K AMQQUSQN
S %=$P(AMQQQ,U,9)
S Z="|13|;|14|"
I $D(AMQQTFLG) K AMQQTFLG S $P(AMQV(X),";",15)=2 ; S AMQV(X)=$P(AMQV(X),"|6|")_"|6|;;;2"_$P(AMQV(X),"|6|",2,9)
I $P(%,";",5)="NULL",AMQV(X)[Z S AMQV(X)=$P(AMQV(X),Z)_$P(Y,";",4)_"~~"_$P(Y,";",4)_";NULL"_$P(AMQV(X),Z,2,99) G TSET1
S %=$P(%,";",4)
I %'="",";SAVE;NULL;EXISTS;ANY;"[(";"_%),AMQV(X)[Z S AMQV(X)=$P(AMQV(X),Z)_$P(Y,";",4)_"~~"_$P(Y,";",5)_";"_%_$P(AMQV(X),Z,2,99)
I AMQV(X)'["~~",AMQV(X)[Z,$P($P(AMQQQ,U,9),";",6)="NULL" S AMQV(X)=$P(AMQV(X),Z)_$P(Y,";",4)_"~~"_$P(Y,";",5)_";NULL"_$P(AMQV(X),Z,2,99)
TSET1 F I=1:1:10 S Z=$P(Y,";",I) Q:$P(Y,";",I,99)="" S %="|"_(I+9)_"|" F Q:AMQV(X)'[% S AMQV(X)=$P(AMQV(X),%,1)_Z_$P(AMQV(X),%,2,99)
S %="|20|"
F Q:AMQV(X)'[% S AMQV(X)=$P(AMQV(X),%)_X_$P(AMQV(X),%,2,99)
S %="|23|"
S A=$P(Q,U,8)
S B=(A'="'="&(A'="'><"))
F Q:AMQV(X)'[% S AMQV(X)=$P(AMQV(X),%)_$S(B:"*",1:"+")_$P(AMQV(X),%,2,99)
I '$D(AMQQKGNO) S %="|30|",AMQV(X)=$P(AMQV(X),%)_"X:AMQT("_X_") AMQV("_(X+1)_")" I +AMQQQ=681.1 S AMQV(X)=AMQV(X)_" Q"
S %="|7|"
S Z=$P(Q,U,14)
S:Z="" Z=1
F Q:AMQV(X)'[% S AMQV(X)=$P(AMQV(X),%)_Z_$P(AMQV(X),%,2,99)
S %=AMQV(X)
S A="|6|"
S B="|5|"
F I=1:1 Q:%'[A D CKER
S AMQV(X)=%
I $D(AMQQMULL),AMQQMULL=AMQQUATN,%["AMQQX=" D ADDMULL
I $D(^UTILITY("AMQQ",$J,"SQXQ",AMQQUATN)),%["AMQQX=" S AMQQUSQN=$O(^(AMQQUATN,"")) D ^AMQQCMP3
S AMQQLINO=AMQQLINO+1
S Q=AMQQQ
K A,B,C,D,E,%
Q
;
CKER S C=$P(%,A)
S D=$P(%,A,2)
S E=$E(%,4+$L(C)+$L(D),255)
F Q:D'[B S D=$P(D,B)_(AMQQVAR+I)_$P(D,B,2,99)
S %=C_(AMQQVAR+I)_D_E
Q
;
GROUP I +Q=33,Q[";;;NULL" Q
I +Q=133 Q
N X,Z
S X=AMQQLINK_U_%
I AMQQI=1,'$P(Q,U,17),$D(^AMQQ(1,+X,4,1,0)),$P(^(0),U,8) S $P(X,U,4)=+$P(Q,U,14)
I $P(Q,U,17) S Z=$P(Q,U,9),Z=$P(Z,";",5) I Z'="",Z'=+Z S $P(X,U,5)=Z
I AMQQI=1,$D(AMQQRED) S:$P(AMQQRED,U,3) AMQQRED=$P(AMQQRED,U,1,2),AMQQIQ="" S X=X_U_AMQQRED
S ^UTILITY("AMQQ",$J,"VAR NAME",AMQQVAR+AMQQI)=X
K AMQQRED
Q
;
ADDMULL N X,Y,Z,%
S %=AMQV(AMQQLINO)
S X=$P(%,"AMQQX=")
S Y=$P(%,"AMQQX=",2)
S Z=$P(Y,""" D ^AMQQ",2)
S Y=$P(Y,""" D ^AMQQ")
I X["S AMQQB=" S $P(Y,";",8)=AMQQMULL
S $P(Y,";",18)=AMQQMULL
S AMQV(AMQQLINO)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
K AMQQMULL
Q
;
AMQQCMP2 ; IHS/CMI/THL - NON "OR" SEARCH CRITERIA COMPILATATION ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;-----
RUN FOR
SET AMQQSER=$ORDER(@AMQQ@(AMQQSER))
IF AMQQSER=""
QUIT
FOR AMQQUATN=0:0
SET AMQQUATN=$ORDER(@AMQQ@(AMQQSER,AMQQUATN))
IF 'AMQQUATN
QUIT
SET (Q,AMQQQ)=^UTILITY("AMQQ",$JOB,"Q",AMQQUATN)
DO TEMPLATE
+1 DO ^AMQQCMP4
+2 DO ^AMQQCMP6
+3 IF $DATA(^UTILITY("AMQQ",$JOB,"SQ",0))
DO EN1^AMQQCMP3
+4 SET AMQV(AMQQLINO)="D ^AMQQDO"
+5 IF $DATA(AMQQFFF)
SET AMQV(AMQQLINO)="D OUTPUT^AMQQRMFF"
+6 IF $DATA(AMQQYY(0))
SET AMQV(AMQQLINO)="D OUTPUT^AMQQCMPS"
+7 IF '$DATA(AMQQCNAM)
IF AMQQCCLS="P"
SET AMQQCNAM="PATIENTS"
+8 SET AMQV(0)="K AMQQQUIT S AMQQTOT=0,AMQQCCLS="""_AMQQCCLS_""",AMQQCNAM="""_AMQQCNAM_""" D LOG^AMQQMGR2 X AMQV(1) D TIME^AMQQMGR2"
EXIT KILL AMQQ,AMQQCOMP,AMQQFVAR,AMQQHOLD,AMQQINDX,AMQQLINK,AMQQNVAR,AMQQSER,AMQQSF,AMQQVALU,AMQQVAR,%,Y,Z,A,B,C,D,E,I,Q,AMQQZLIN,AMQQZNN,AMQQQ,AMQQUSQN,AMQQI,AMQQIQ
+1 QUIT
+2 ;
TEMPLATE ; ENTRY POINT FROM AMQQCMPK
+1 SET AMQQLINK=+Q
+2 SET Z=""
+3 SET AMQQNVAR=$PIECE(Q,U,14)
+4 IF $PIECE(Q,U,9)[";NULL"
IF $DATA(^AMQQ(1,+Q,5))
IF ^(5)'=""
SET AMQQSBSC=5
GOTO T1
+5 IF $PIECE(Q,U,9)[";ANY"
IF $DATA(^AMQQ(1,+Q,7))
IF ^(7)'=""
SET AMQQSBSC=7
GOTO T1
+6 IF $PIECE(Q,U,9)[";INVERSE"
IF $DATA(^AMQQ(1,+Q,8))
IF ^(8)'=""
SET AMQQSBSC=8
GOTO T1
+7 SET AMQQSBSC=$SELECT(AMQQLINO>1:2,$DATA(AMQQKGNO):2,1:1)
+8 IF AMQQLINO>1
IF AMQQLINK[455!(AMQQLINK[681)
IF Q'[(";ANY")
IF Q'[";ALL"
IF Q'[";NULL"
SET AMQQSBSC=1
+9 SET %=$PIECE(Q,U,11)
+10 SET %=$PIECE(%,":",2)
+11 IF %=2
SET AMQQSBSC=2
+12 SET %=$PIECE(Q,U,9)
+13 IF %[";NULL"!(%["EXIST")!(%[";INVERSE")
IF +Q'=758
SET AMQQNVAR=1
T1 FOR AMQQCSC=AMQQSBSC:.1
IF '$DATA(^AMQQ(1,AMQQLINK,AMQQCSC))
QUIT
IF ^(AMQQCSC)'=""
SET AMQV(AMQQLINO)=$SELECT($GET(AMQV(1))'["DIBT("&($GET(AMQV(2))'["DPT(""B""")!(AMQQCSC'=1.1):^(AMQQCSC),'$DATA(^(1.11)):^(AMQQCSC),1:^(1.11))
DO TSET
KILL AMQQTFLG
+1 SET %=0
+2 FOR AMQQI=1:1:AMQQNVAR
SET %=$ORDER(^AMQQ(1,AMQQLINK,4,%))
IF '%
QUIT
IF '$DATA(AMQQKGNO)
DO GROUP
IF $DATA(AMQQIQ)
KILL AMQQIQ
QUIT
+3 SET AMQQVAR=AMQQVAR+AMQQNVAR
+4 IF $PIECE(Q,U,17)
IF $PIECE(Q,U,4)
SET %=$PIECE(Q,U,9)
SET %=$PIECE(%,";",5)
IF %'=""
SET AMQV(AMQQLINO-1,%)=""
+5 IF $PIECE(Q,U,3)="I"
SET %=$PIECE(Q,U,9)
SET %=$PIECE(%,";",5)
IF %'=""
SET AMQV(AMQQLINO-1,%)=""
+6 KILL AMQQSBSC,AMQQCSC
+7 QUIT
+8 ;
TSET SET Y=$PIECE(Q,U,15)
+1 SET X=AMQQLINO
+2 KILL AMQQUSQN
+3 SET %=$PIECE(AMQQQ,U,9)
+4 SET Z="|13|;|14|"
+5 ; S AMQV(X)=$P(AMQV(X),"|6|")_"|6|;;;2"_$P(AMQV(X),"|6|",2,9)
IF $DATA(AMQQTFLG)
KILL AMQQTFLG
SET $PIECE(AMQV(X),";",15)=2
+6 IF $PIECE(%,";",5)="NULL"
IF AMQV(X)[Z
SET AMQV(X)=$PIECE(AMQV(X),Z)_$PIECE(Y,";",4)_"~~"_$PIECE(Y,";",4)_";NULL"_$PIECE(AMQV(X),Z,2,99)
GOTO TSET1
+7 SET %=$PIECE(%,";",4)
+8 IF %'=""
IF ";SAVE;NULL;EXISTS;ANY;"[(";"_%)
IF AMQV(X)[Z
SET AMQV(X)=$PIECE(AMQV(X),Z)_$PIECE(Y,";",4)_"~~"_$PIECE(Y,";",5)_";"_%_$PIECE(AMQV(X),Z,2,99)
+9 IF AMQV(X)'["~~"
IF AMQV(X)[Z
IF $PIECE($PIECE(AMQQQ,U,9),";",6)="NULL"
SET AMQV(X)=$PIECE(AMQV(X),Z)_$PIECE(Y,";",4)_"~~"_$PIECE(Y,";",5)_";NULL"_$PIECE(AMQV(X),Z,2,99)
TSET1 FOR I=1:1:10
SET Z=$PIECE(Y,";",I)
IF $PIECE(Y,";",I,99)=""
QUIT
SET %="|"_(I+9)_"|"
FOR
IF AMQV(X)'[%
QUIT
SET AMQV(X)=$PIECE(AMQV(X),%,1)_Z_$PIECE(AMQV(X),%,2,99)
+1 SET %="|20|"
+2 FOR
IF AMQV(X)'[%
QUIT
SET AMQV(X)=$PIECE(AMQV(X),%)_X_$PIECE(AMQV(X),%,2,99)
+3 SET %="|23|"
+4 SET A=$PIECE(Q,U,8)
+5 SET B=(A'="'="&(A'="'><"))
+6 FOR
IF AMQV(X)'[%
QUIT
SET AMQV(X)=$PIECE(AMQV(X),%)_$SELECT(B:"*",1:"+")_$PIECE(AMQV(X),%,2,99)
+7 IF '$DATA(AMQQKGNO)
SET %="|30|"
SET AMQV(X)=$PIECE(AMQV(X),%)_"X:AMQT("_X_") AMQV("_(X+1)_")"
IF +AMQQQ=681.1
SET AMQV(X)=AMQV(X)_" Q"
+8 SET %="|7|"
+9 SET Z=$PIECE(Q,U,14)
+10 IF Z=""
SET Z=1
+11 FOR
IF AMQV(X)'[%
QUIT
SET AMQV(X)=$PIECE(AMQV(X),%)_Z_$PIECE(AMQV(X),%,2,99)
+12 SET %=AMQV(X)
+13 SET A="|6|"
+14 SET B="|5|"
+15 FOR I=1:1
IF %'[A
QUIT
DO CKER
+16 SET AMQV(X)=%
+17 IF $DATA(AMQQMULL)
IF AMQQMULL=AMQQUATN
IF %["AMQQX="
DO ADDMULL
+18 IF $DATA(^UTILITY("AMQQ",$JOB,"SQXQ",AMQQUATN))
IF %["AMQQX="
SET AMQQUSQN=$ORDER(^(AMQQUATN,""))
DO ^AMQQCMP3
+19 SET AMQQLINO=AMQQLINO+1
+20 SET Q=AMQQQ
+21 KILL A,B,C,D,E,%
+22 QUIT
+23 ;
CKER SET C=$PIECE(%,A)
+1 SET D=$PIECE(%,A,2)
+2 SET E=$EXTRACT(%,4+$LENGTH(C)+$LENGTH(D),255)
+3 FOR
IF D'[B
QUIT
SET D=$PIECE(D,B)_(AMQQVAR+I)_$PIECE(D,B,2,99)
+4 SET %=C_(AMQQVAR+I)_D_E
+5 QUIT
+6 ;
GROUP IF +Q=33
IF Q[";;;NULL"
QUIT
+1 IF +Q=133
QUIT
+2 NEW X,Z
+3 SET X=AMQQLINK_U_%
+4 IF AMQQI=1
IF '$PIECE(Q,U,17)
IF $DATA(^AMQQ(1,+X,4,1,0))
IF $PIECE(^(0),U,8)
SET $PIECE(X,U,4)=+$PIECE(Q,U,14)
+5 IF $PIECE(Q,U,17)
SET Z=$PIECE(Q,U,9)
SET Z=$PIECE(Z,";",5)
IF Z'=""
IF Z'=+Z
SET $PIECE(X,U,5)=Z
+6 IF AMQQI=1
IF $DATA(AMQQRED)
IF $PIECE(AMQQRED,U,3)
SET AMQQRED=$PIECE(AMQQRED,U,1,2)
SET AMQQIQ=""
SET X=X_U_AMQQRED
+7 SET ^UTILITY("AMQQ",$JOB,"VAR NAME",AMQQVAR+AMQQI)=X
+8 KILL AMQQRED
+9 QUIT
+10 ;
ADDMULL NEW X,Y,Z,%
+1 SET %=AMQV(AMQQLINO)
+2 SET X=$PIECE(%,"AMQQX=")
+3 SET Y=$PIECE(%,"AMQQX=",2)
+4 SET Z=$PIECE(Y,""" D ^AMQQ",2)
+5 SET Y=$PIECE(Y,""" D ^AMQQ")
+6 IF X["S AMQQB="
SET $PIECE(Y,";",8)=AMQQMULL
+7 SET $PIECE(Y,";",18)=AMQQMULL
+8 SET AMQV(AMQQLINO)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
+9 KILL AMQQMULL
+10 QUIT
+11 ;
