- AMQQCMP6 ; IHS/CMI/THL - COMPILES SUBQUERIES ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;-----
- VAR N Q,AMQQSBSC,AMQQCSC
- RUN F AMQQUQQN=0:0 S AMQQUQQN=$O(^UTILITY("AMQQ",$J,"QQ",AMQQUQQN)) Q:'AMQQUQQN S Q=^(AMQQUQQN) D SET,TSET,SUBSET
- EXIT K Q,AMQQUQQN
- Q
- ;
- SET S AMQQSBSC=2
- I $P(Q,U,9)[";NULL",$D(^AMQQ(1,+Q,5)) S AMQQSBSC=5
- I $P(Q,U,9)[";ANY",$D(^AMQQ(1,+Q,7)) S AMQQSBSC=7
- I $P(Q,U,9)[";INVERSE",$D(^AMQQ(1,+Q,8)) S AMQQSBSC=8
- Q
- ;
- TSET S Y=$P(Q,U,15)
- S T=^AMQQ(1,+Q,AMQQSBSC)
- S %=$P(Q,U,9)
- S Z="|13|;|14|"
- I $P(%,";",5)="NULL",T[Z S T=$P(T,Z)_$P(Y,";",4)_"~~"_$P(Y,";",4)_";NULL"_$P(T,Z,2,99) G TSET1
- S %=$P(%,";",4)
- I %'="",";SAVE;NULL;EXISTS;ANY;"[(";"_%),T[Z S T=$P(T,Z)_$P(Y,";",4)_"~~"_$P(Y,";",5)_";"_%_$P(T,Z,2,99)
- I T'["~~",T[Z,$P($P(AMQQQ,U,9),";",6)="NULL" S T=$P(T,Z)_$P(Y,";",4)_"~~"_$P(Y,";",5)_";NULL"_$P(T,Z,2,99)
- TSET1 F I=1:1:10 S Z=$P(Y,";",I) Q:$P(Y,";",I,99)="" S %="|"_(I+9)_"|" F Q:T'[% S T=$P(T,%,1)_Z_$P(T,%,2,99)
- I Q["INVERSE" S %="|12|" I T[% S T=$P(T,%)_"INVERSE"_$P(T,%,2)
- S %="|12|"
- I T[% S T=$P(T,%)_$P(T,%,2)
- S %="|23|"
- S A=$P(Q,U,8)
- S B=(A'="'="&(A'="'><"))
- F Q:T'[% S T=$P(T,%)_$S(B:"*",1:"+")_$P(T,%,2,99)
- S T=$P(T,"|30|")_"I 'AMQT("_AMQQUQQN_")"
- S %="|7|"
- S Z=$P(Q,U,14)
- S:Z="" Z=1
- F Q:T'[% S T=$P(T,%)_Z_$P(T,%,2,99)
- S %="|20|"
- F Q:T'[% S T=$P(T,%)_AMQQUQQN_$P(T,%,2,99)
- S %=T
- S A="|6|"
- S B="|5|"
- F I=1:1 Q:%'[A D CKER
- S AMQV("QQ",AMQQUQQN,1)=%
- K A,B,C,D,E,%,T,Z,Y,F,I
- Q
- ;
- SUBSET N A,X,Y,Z,%
- S A=$O(^UTILITY("AMQQ",$J,"SQXX",AMQQUQQN,""))
- I 'A Q
- S %=AMQV("QQ",AMQQUQQN,1)
- S X=$P(%,"AMQQX=")
- S Y=$P(%,"AMQQX=",2)
- S Z=$P(Y,""" D ^AMQQ",2)
- S Y=$P(Y,""" D ^AMQQ")
- S $P(Y,";",19)=A
- S AMQV("QQ",AMQQUQQN,1)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
- 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
- ;
- AMQQCMP6 ; IHS/CMI/THL - COMPILES SUBQUERIES ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;-----
- VAR NEW Q,AMQQSBSC,AMQQCSC
- RUN FOR AMQQUQQN=0:0
- SET AMQQUQQN=$ORDER(^UTILITY("AMQQ",$JOB,"QQ",AMQQUQQN))
- IF 'AMQQUQQN
- QUIT
- SET Q=^(AMQQUQQN)
- DO SET
- DO TSET
- DO SUBSET
- EXIT KILL Q,AMQQUQQN
- +1 QUIT
- +2 ;
- SET SET AMQQSBSC=2
- +1 IF $PIECE(Q,U,9)[";NULL"
- IF $DATA(^AMQQ(1,+Q,5))
- SET AMQQSBSC=5
- +2 IF $PIECE(Q,U,9)[";ANY"
- IF $DATA(^AMQQ(1,+Q,7))
- SET AMQQSBSC=7
- +3 IF $PIECE(Q,U,9)[";INVERSE"
- IF $DATA(^AMQQ(1,+Q,8))
- SET AMQQSBSC=8
- +4 QUIT
- +5 ;
- TSET SET Y=$PIECE(Q,U,15)
- +1 SET T=^AMQQ(1,+Q,AMQQSBSC)
- +2 SET %=$PIECE(Q,U,9)
- +3 SET Z="|13|;|14|"
- +4 IF $PIECE(%,";",5)="NULL"
- IF T[Z
- SET T=$PIECE(T,Z)_$PIECE(Y,";",4)_"~~"_$PIECE(Y,";",4)_";NULL"_$PIECE(T,Z,2,99)
- GOTO TSET1
- +5 SET %=$PIECE(%,";",4)
- +6 IF %'=""
- IF ";SAVE;NULL;EXISTS;ANY;"[(";"_%)
- IF T[Z
- SET T=$PIECE(T,Z)_$PIECE(Y,";",4)_"~~"_$PIECE(Y,";",5)_";"_%_$PIECE(T,Z,2,99)
- +7 IF T'["~~"
- IF T[Z
- IF $PIECE($PIECE(AMQQQ,U,9),";",6)="NULL"
- SET T=$PIECE(T,Z)_$PIECE(Y,";",4)_"~~"_$PIECE(Y,";",5)_";NULL"_$PIECE(T,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 T'[%
- QUIT
- SET T=$PIECE(T,%,1)_Z_$PIECE(T,%,2,99)
- +1 IF Q["INVERSE"
- SET %="|12|"
- IF T[%
- SET T=$PIECE(T,%)_"INVERSE"_$PIECE(T,%,2)
- +2 SET %="|12|"
- +3 IF T[%
- SET T=$PIECE(T,%)_$PIECE(T,%,2)
- +4 SET %="|23|"
- +5 SET A=$PIECE(Q,U,8)
- +6 SET B=(A'="'="&(A'="'><"))
- +7 FOR
- IF T'[%
- QUIT
- SET T=$PIECE(T,%)_$SELECT(B:"*",1:"+")_$PIECE(T,%,2,99)
- +8 SET T=$PIECE(T,"|30|")_"I 'AMQT("_AMQQUQQN_")"
- +9 SET %="|7|"
- +10 SET Z=$PIECE(Q,U,14)
- +11 IF Z=""
- SET Z=1
- +12 FOR
- IF T'[%
- QUIT
- SET T=$PIECE(T,%)_Z_$PIECE(T,%,2,99)
- +13 SET %="|20|"
- +14 FOR
- IF T'[%
- QUIT
- SET T=$PIECE(T,%)_AMQQUQQN_$PIECE(T,%,2,99)
- +15 SET %=T
- +16 SET A="|6|"
- +17 SET B="|5|"
- +18 FOR I=1:1
- IF %'[A
- QUIT
- DO CKER
- +19 SET AMQV("QQ",AMQQUQQN,1)=%
- +20 KILL A,B,C,D,E,%,T,Z,Y,F,I
- +21 QUIT
- +22 ;
- SUBSET NEW A,X,Y,Z,%
- +1 SET A=$ORDER(^UTILITY("AMQQ",$JOB,"SQXX",AMQQUQQN,""))
- +2 IF 'A
- QUIT
- +3 SET %=AMQV("QQ",AMQQUQQN,1)
- +4 SET X=$PIECE(%,"AMQQX=")
- +5 SET Y=$PIECE(%,"AMQQX=",2)
- +6 SET Z=$PIECE(Y,""" D ^AMQQ",2)
- +7 SET Y=$PIECE(Y,""" D ^AMQQ")
- +8 SET $PIECE(Y,";",19)=A
- +9 SET AMQV("QQ",AMQQUQQN,1)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
- +10 QUIT
- +11 ;
- 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 ;
