Routine: AMQQCMP3

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

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

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")=""

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

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_";"_%

NNZ1 S %=$S($E(%)="N":0,$E(%)="T":1,1:(+%+1))

NNQ S X='($E(X)="N")

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

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       ;

AMQQCMP3.m