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