AMQQCMP3 ; IHS/CMI/THL - SUBQUERY ANALYTIC STACK COMPILER ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
VAR S (AMQQAFNO,AMQQAFNN)=0
S AMQQSQLV=1
K AMQQRED
RUN S AMQQAFNO=$O(^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,AMQQAFNO))
I 'AMQQAFNO D:AMQQUSQN SET G EXIT
S AMQQSQ1=AMQQUSQN
S AMQQSQFN=AMQQAFNO
D FSET
S AMQQSQLV=AMQQSQLV+1
D RUN1
G RUN
EXIT K AMQQAFNO,AMQQSQLV,%,A,Q
Q
;
FSET S AMQQAFNN=AMQQAFNN+1
S A=^UTILITY("AMQQ",$J,"SQ",AMQQSQ1,AMQQSQFN)
S %=$P(A,U,3)
S %=$P(^AMQQ(4,%,0),U)
I %'="","ZQT"[% S X=$P(A,U,7) D @("NN"_%) S $P(A,U,7)=X G FS1
I $D(^AMQQ(1,+A,6)) S X=$P(A,U,7) X ^(6) S $P(A,U,7)=X ; INPUT TRANSFORM
FS1 ; CHECK FOR TERMINATOR FUNCTIONS LIKE NULL
I '$O(^UTILITY("AMQQ",$J,"SQ",AMQQSQ1,AMQQSQFN)) S AMQV("SQ",AMQQSQ1,AMQQAFNN+1)="Q"
I "MVL"'[$P(A,U,6) S Z=$P(A,U,7) G VSET
S %=+^UTILITY("AMQQ",$J,"QQ",$P(A,U,7))
I $P(^AMQQ(1,%,0),";")="VISIT" S %=1 G FS11
I $P(^AMQQ(1,%,0),";")="PROVIDER" S %=5 G FS11
S %=^AMQQ(1,%,2)
S %=+$P(%,"AMQP(",2)
FS11 S Z=$P(A,U,7)
I $P(A,U,6)'="M" S Z=Z_";"_%_";"_$S($P(A,U,6)="V":3,1:4)
VSET S %="S "
I $P(A,U,8) S %="S AMQQNOT="""","
S %=%_"AMQQCOMP="""_Z_""" D "_$P(A,U,4,5)_" S AMQT(""SQ"","_AMQQSQ1_","_AMQQAFNN_")=$D(^UTILITY(""AMQQ"",$J,""AG"","
S %=%_$S('AMQQUSQN:"AMQQUATN",1:AMQQUATN)_")) X:AMQT(""SQ"","_AMQQSQ1_","_AMQQAFNN_") AMQV(""SQ"","_AMQQSQ1_","_(AMQQAFNN+1)_")"
S AMQV("SQ",AMQQSQ1,AMQQAFNN)=%
I "CO"[$P(A,U,6),'$D(AMQQRED),AMQQSQLV=1 D RED
Q
;
SET 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")
S $P(Y,";",19)=AMQQUSQN
S AMQV(AMQQLINO)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
NULL I $D(^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,"NULL")) S AMQV("SQ",AMQQUSQN,"NULL")=""
Q
;
RED I $P(A,U,6)="O",$P(A,U,7)>1 Q
S %=$P(^AMQQ(5,+A,0),U,11)
S AMQQRED=%_$S(%="TOT #":"\",1:" ")_$P(^AMQQ(1,+Q,4,1,0),U,4)_$S(%="TOT #":"S",1:"")
S Y=$P(AMQQRED,"\")
S Z=$P(AMQQRED,"\",2)
S %=$S($L(Y)>$L(Z):$L(Y),1:$L(Z))
S Y=$P(^AMQQ(1,+Q,4,1,0),U,6)
S:(%>Y) Y=%
S AMQQRED=AMQQRED_U_Y
I $P(A,U,6)="C" S $P(AMQQRED,U,3)=1,$P(AMQV(AMQQLINO),";",11)=1
Q
;
NNZ I X'[";" S X=$S($E(X)="N":0,$E(X)="T":1,1:(+X+1)) Q
N A,%
S %=$P(X,";")
D NNZ1
S A=%,%=$P(X,";",2)
D NNZ1
S X=A_";"_%
Q
NNZ1 S %=$S($E(%)="N":0,$E(%)="T":1,1:(+%+1))
Q
;
;
NNQ S X='($E(X)="N")
Q
;
RUN1 S X=AMQQSQ1
START N AMQQSQ1,AMQQSQ2,AMQQAFNN,AMQQSQFN
S AMQQSQ1=X
S (AMQQSQ2,AMQQAFNN)=0
INC S AMQQSQ2=$O(^UTILITY("AMQQ",$J,"SQXS",AMQQSQ1,AMQQSQ2))
I 'AMQQSQ2 S AMQQSQLV=AMQQSQLV-1 N AMQQUSQN S AMQQUSQN=AMQQSQ1 D NULL Q
I $D(^UTILITY("AMQQ",$J,"SQXS",AMQQSQ2)) S AMQQSQLV=AMQQSQLV+1,X=AMQQSQ2 D START
S AMQQSQFN=0
INC1 S AMQQSQFN=$O(^UTILITY("AMQQ",$J,"SQ",AMQQSQ2,AMQQSQFN))
I 'AMQQSQFN G INC
S AMQQSQ1=AMQQSQ2
D FSET
G INC1
;
EN1 ; ENTRY POINT FROM AMQQCMP2 FOR GENERIC VISIT CONDITIONS
N AMQQUSQN S AMQQUSQN=0
D VAR
Q
;
AMQQCMP3 ; IHS/CMI/THL - SUBQUERY ANALYTIC STACK COMPILER ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
VAR SET (AMQQAFNO,AMQQAFNN)=0
+1 SET AMQQSQLV=1
+2 KILL AMQQRED
RUN SET AMQQAFNO=$ORDER(^UTILITY("AMQQ",$JOB,"SQ",AMQQUSQN,AMQQAFNO))
+1 IF 'AMQQAFNO
IF AMQQUSQN
DO SET
GOTO EXIT
+2 SET AMQQSQ1=AMQQUSQN
+3 SET AMQQSQFN=AMQQAFNO
+4 DO FSET
+5 SET AMQQSQLV=AMQQSQLV+1
+6 DO RUN1
+7 GOTO RUN
EXIT KILL AMQQAFNO,AMQQSQLV,%,A,Q
+1 QUIT
+2 ;
FSET SET AMQQAFNN=AMQQAFNN+1
+1 SET A=^UTILITY("AMQQ",$JOB,"SQ",AMQQSQ1,AMQQSQFN)
+2 SET %=$PIECE(A,U,3)
+3 SET %=$PIECE(^AMQQ(4,%,0),U)
+4 IF %'=""
IF "ZQT"[%
SET X=$PIECE(A,U,7)
DO @("NN"_%)
SET $PIECE(A,U,7)=X
GOTO FS1
+5 ; INPUT TRANSFORM
IF $DATA(^AMQQ(1,+A,6))
SET X=$PIECE(A,U,7)
XECUTE ^(6)
SET $PIECE(A,U,7)=X
FS1 ; CHECK FOR TERMINATOR FUNCTIONS LIKE NULL
+1 IF '$ORDER(^UTILITY("AMQQ",$JOB,"SQ",AMQQSQ1,AMQQSQFN))
SET AMQV("SQ",AMQQSQ1,AMQQAFNN+1)="Q"
+2 IF "MVL"'[$PIECE(A,U,6)
SET Z=$PIECE(A,U,7)
GOTO VSET
+3 SET %=+^UTILITY("AMQQ",$JOB,"QQ",$PIECE(A,U,7))
+4 IF $PIECE(^AMQQ(1,%,0),";")="VISIT"
SET %=1
GOTO FS11
+5 IF $PIECE(^AMQQ(1,%,0),";")="PROVIDER"
SET %=5
GOTO FS11
+6 SET %=^AMQQ(1,%,2)
+7 SET %=+$PIECE(%,"AMQP(",2)
FS11 SET Z=$PIECE(A,U,7)
+1 IF $PIECE(A,U,6)'="M"
SET Z=Z_";"_%_";"_$SELECT($PIECE(A,U,6)="V":3,1:4)
VSET SET %="S "
+1 IF $PIECE(A,U,8)
SET %="S AMQQNOT="""","
+2 SET %=%_"AMQQCOMP="""_Z_""" D "_$PIECE(A,U,4,5)_" S AMQT(""SQ"","_AMQQSQ1_","_AMQQAFNN_")=$D(^UTILITY(""AMQQ"",$J,""AG"","
+3 SET %=%_$SELECT('AMQQUSQN:"AMQQUATN",1:AMQQUATN)_")) X:AMQT(""SQ"","_AMQQSQ1_","_AMQQAFNN_") AMQV(""SQ"","_AMQQSQ1_","_(AMQQAFNN+1)_")"
+4 SET AMQV("SQ",AMQQSQ1,AMQQAFNN)=%
+5 IF "CO"[$PIECE(A,U,6)
IF '$DATA(AMQQRED)
IF AMQQSQLV=1
DO RED
+6 QUIT
+7 ;
SET NEW X,Y,Z,%
SET %=AMQV(AMQQLINO)
+1 SET X=$PIECE(%,"AMQQX=")
+2 SET Y=$PIECE(%,"AMQQX=",2)
+3 SET Z=$PIECE(Y,""" D ^AMQQ",2)
+4 SET Y=$PIECE(Y,""" D ^AMQQ")
+5 SET $PIECE(Y,";",19)=AMQQUSQN
+6 SET AMQV(AMQQLINO)=X_"AMQQX="_Y_""" D ^AMQQ"_Z
NULL IF $DATA(^UTILITY("AMQQ",$JOB,"SQ",AMQQUSQN,"NULL"))
SET AMQV("SQ",AMQQUSQN,"NULL")=""
+1 QUIT
+2 ;
RED IF $PIECE(A,U,6)="O"
IF $PIECE(A,U,7)>1
QUIT
+1 SET %=$PIECE(^AMQQ(5,+A,0),U,11)
+2 SET AMQQRED=%_$SELECT(%="TOT #":"\",1:" ")_$PIECE(^AMQQ(1,+Q,4,1,0),U,4)_$SELECT(%="TOT #":"S",1:"")
+3 SET Y=$PIECE(AMQQRED,"\")
+4 SET Z=$PIECE(AMQQRED,"\",2)
+5 SET %=$SELECT($LENGTH(Y)>$LENGTH(Z):$LENGTH(Y),1:$LENGTH(Z))
+6 SET Y=$PIECE(^AMQQ(1,+Q,4,1,0),U,6)
+7 IF (%>Y)
SET Y=%
+8 SET AMQQRED=AMQQRED_U_Y
+9 IF $PIECE(A,U,6)="C"
SET $PIECE(AMQQRED,U,3)=1
SET $PIECE(AMQV(AMQQLINO),";",11)=1
+10 QUIT
+11 ;
NNZ IF X'[";"
SET X=$SELECT($EXTRACT(X)="N":0,$EXTRACT(X)="T":1,1:(+X+1))
QUIT
+1 NEW A,%
+2 SET %=$PIECE(X,";")
+3 DO NNZ1
+4 SET A=%
SET %=$PIECE(X,";",2)
+5 DO NNZ1
+6 SET X=A_";"_%
+7 QUIT
NNZ1 SET %=$SELECT($EXTRACT(%)="N":0,$EXTRACT(%)="T":1,1:(+%+1))
+1 QUIT
+2 ;
+3 ;
NNQ SET X='($EXTRACT(X)="N")
+1 QUIT
+2 ;
RUN1 SET X=AMQQSQ1
START NEW AMQQSQ1,AMQQSQ2,AMQQAFNN,AMQQSQFN
+1 SET AMQQSQ1=X
+2 SET (AMQQSQ2,AMQQAFNN)=0
INC SET AMQQSQ2=$ORDER(^UTILITY("AMQQ",$JOB,"SQXS",AMQQSQ1,AMQQSQ2))
+1 IF 'AMQQSQ2
SET AMQQSQLV=AMQQSQLV-1
NEW AMQQUSQN
SET AMQQUSQN=AMQQSQ1
DO NULL
QUIT
+2 IF $DATA(^UTILITY("AMQQ",$JOB,"SQXS",AMQQSQ2))
SET AMQQSQLV=AMQQSQLV+1
SET X=AMQQSQ2
DO START
+3 SET AMQQSQFN=0
INC1 SET AMQQSQFN=$ORDER(^UTILITY("AMQQ",$JOB,"SQ",AMQQSQ2,AMQQSQFN))
+1 IF 'AMQQSQFN
GOTO INC
+2 SET AMQQSQ1=AMQQSQ2
+3 DO FSET
+4 GOTO INC1
+5 ;
EN1 ; ENTRY POINT FROM AMQQCMP2 FOR GENERIC VISIT CONDITIONS
+1 NEW AMQQUSQN
SET AMQQUSQN=0
+2 DO VAR
+3 QUIT
+4 ;
