Routine: AMQQQ0

AMQQQ0 ; IHS/CMI/THL - AMQQQ SUBROUTINE PARSES SCRIPTS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 S AMQQXXII=0

RUN F AMQQXXGN=0:0 S AMQQXXGN=$O(@AMQQXXGG) Q:'AMQQXXGN  S AMQQXXXX=@AMQQXXGI D ANAL,CHECK I  Q

EXIT K AMQQXXGN,^UTILITY("AMQQ",$J,"XXTAX"),%,A,I

ANAL S AMQQXXXX=$P(AMQQXXXX,"**")

 I "*+"[$E(AMQQXXXX) Q

 K AMQQXXAA,AMQQXXCC,AMQQXXVV

 I $E(AMQQXXXX)="-" S AMQQXXNN="",AMQQXXXX=$E(AMQQXXXX,2,999),A=AMQQXXXX D STRIP^AMQQQ S AMQQXXXX=A

 I AMQQXXXX["!" D KONG Q

 D ATT

 D CHECK

 I  Q

 I $D(AMQQXXNF) K AMQQXXNF G A1

 I AMQQCTXS D MULT Q

 I AMQQFTYP="G"!(AMQQFTYP="L") D TAX,CHECK Q:$T  S AMQQXXCC="TAX" G A1

 I $D(AMQQONE) S (AMQQXXVV,AMQQXXCC)="" D SET Q

 D COND

 D CHECK

 I  Q

 D VAL

 D CHECK

 I  Q

A1 D SET

ATT S X=$P(AMQQXXXX,";")

 D AUTO^AMQQATA

 I Y=-1,AMQQXXXX'[";" D NATL Q

 I Y'=-1 D ^AMQQSEC

 I Y=-1 K AMQQXXNN S AMQQFAIL=6 Q

SETATT S AMQQXXAA=Y

 S %=^AMQQ(5,+Y,0)

 S AMQQLINK=$P(%,U,5)

 S AMQQATN=+Y

 I AMQQLINK=9 S AMQQATNM=$P(Y,U,2) D ^AMQQATAL

 S %=^AMQQ(1,AMQQLINK,0)

 S AMQQCTXS=$P(%,U,7)

 S AMQQFTYP=$P(^AMQQ(4,$P(%,U,5),0),U)

COND S X=$P(AMQQXXXX,";",2)

 K AMQQCOND

 I X="" S (AMQQCOND,AMQQXXCC)="" Q

 I "^NULL^ALL^ANY^EXISTS^"[(U_X_U) S:X="ALL" X="EXISTS" S AMQQXXCC=X,AMQQCOND=";;;"_X Q

 D AUTO^AMQQAC

 I Y=-1 S AMQQFAIL=7 Q

SETCOND S AMQQCOND=+Y

 S AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8)

 S AMQQCONM=$P(Y,U,2)

 S AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6)

 S AMQQXXCC=Y

VAL S (AMQQXXVV,X)=$P(AMQQXXXX,";",3)

 K AMQQCOMP

 I X="",$G(AMQQCOND) S AMQQFAIL=8 Q

 D ^AMQQAV

 I '$D(AMQQCOMP) S AMQQFAIL=8 Q

 S AMQQXXVV=AMQQCOMP

SET S AMQQXXII=$G(AMQQXXII)+1

 S AMQQXX(AMQQXXII,1)=AMQQXXAA_";"_$G(AMQQXXCC)_";"_AMQQXXVV

TAX ; ENTRY POINT FROM AMQQ1

 I $P(AMQQXXXX,";",2)="=" G T1

 I $P(AMQQXXXX,";",2)="'=" S AMQQXXNT="INVERSE" G T1

 I $D(AMQQONE) G T2

 S AMQQFAIL=9 Q

T1 I $P(AMQQXXXX,";",3)="" S AMQQFAIL=8 Q

 D TGRP

 I $D(AMQQFAIL) Q

T2 K AMQQTAX

 S %=^AMQQ(5,AMQQATN,0)

 S AMQQTNAR=$P(%,U,15)

 S AMQQTDIC=U_$P(%,U,16)

 S AMQQTLOK=U_$P(%,U,18)

 S AMQQTTX=$G(^AMQQ(5,AMQQATN,3))

 S AMQQXXN=0

 D ^AMQQTX

 K AMQQXXTT,AMQQXXTN

 I '$D(AMQQTAX) S AMQQFAIL=8 Q

 I $D(AMQQXXNT) S AMQQSCMP=AMQQXXNT K AMQQXXNT D SCMP^AMQQTX S AMQQXXVV=AMQQCOMP I 1

 E  S AMQQXXVV=AMQQTAX

 K AMQQTAX

TGRP S %=$P(AMQQXXXX,";",3)

 I $E(%)="[" S X=$E(%,2,999),X=$P(X,"]") I $D(^UTILITY("AMQQ",$J,"XXTAX",X)) S AMQQXXTT=X Q

 S AMQQXXI=AMQQXXGN

 S AMQQXXX1=%

 D TG1

 K AMQQXXX1

TG1 N AMQQXXGN

 S AMQQXXGN=AMQQXXI

 S AMQQXXTT="XXTEMP"

 S AMQQXXTN=0

 K ^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT)

TG11 F I=1:1 S %=$P(AMQQXXX1,",",I) Q:%=""  S AMQQXXTN=AMQQXXTN+1,^UTILITY("AMQQ",$J,"XXTAX",AMQQXXTT,AMQQXXTN)=%

 S AMQQXXGN=$O(@AMQQXXGG)

 I 'AMQQXXGN Q

 S %=@AMQQXXGI

 I $E(%)="+" S AMQQXXX1=$E(%,2,999) G TG11

CHECK I $D(AMQQQUIT)!($D(AMQQFAIL))

KONG F AMQQXXXI=1:1 S AMQQXXX1=$P(AMQQXXXX,"!",AMQQXXXI) Q:AMQQXXX1=""  D OR,CHECK I  Q

 K AMQQXXX1,AMQQXXXI

OR N AMQQXXXX

 S AMQQXXXX=AMQQXXX1

 D ATT,CHECK

 I  Q

 I AMQQCTXS S AMQQFAIL=9 Q

 I AMQQFTYP="G"!(AMQQFTYP="L") D TAX G OR1

 D COND

 D CHECK

 I  Q

 D VAL

 D CHECK

 I  Q

OR1 I AMQQXXXI=1 S AMQQXXII=$G(AMQQXXII)+1

 S AMQQXX(AMQQXXII,AMQQXXXI)=AMQQXXAA_";"_$G(AMQQXXCC)_";"_AMQQXXVV

MULT S AMQQXXII=$G(AMQQXXII)+1

 S AMQQXX(AMQQXXII,1)=Y_";MULT"

 S AMQQXXLV=1

 S AMQQXXND="AMQQXX("_AMQQXXII_",1)"

 D ^AMQQQ1

NATL K AMQQTAX D ^AMQQN2

 I $D(AMQQFAIL) S Y=-1 K AMQQXXNN G NEXIT

 I $D(AMQQTAX) S AMQQXXAA=AMQQNATT,AMQQXXCC=AMQQNCND,AMQQXXVV=AMQQTAX,AMQQXXNF="" S:$D(^UTILITY("AMQQ TAX",$J,AMQQTAX,"--")) AMQQXXVV=AMQQXXVV_";INVERSE" G NEXIT

 S Y=AMQQNATT

 D SETATT

 S Y=AMQQNCND

 D SETCOND

 S AMQQXXVV=AMQQNVAL,AMQQXXNF=""

NEXIT K AMQQNATT,AMQQNCND,AMQQNVAL,AMQQNTYP,AMQQTNAR,AMQQTDIC,AMQQTAX,AMQQTLOK,AMQQTTX,AMQQXXN,AMQQXXNT

AMQQQ0    ; IHS/CMI/THL - AMQQQ SUBROUTINE PARSES SCRIPTS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2        SET AMQQXXII=0

RUN        FOR AMQQXXGN=0:0

               SET AMQQXXGN=$ORDER(@AMQQXXGG)

               IF 'AMQQXXGN

                   QUIT

               SET AMQQXXXX=@AMQQXXGI

               DO ANAL

               DO CHECK

              IF $TEST

                   QUIT

EXIT       KILL AMQQXXGN,^UTILITY("AMQQ",$JOB,"XXTAX"),%,A,I

 +1        QUIT

 +2       ;

ANAL       SET AMQQXXXX=$PIECE(AMQQXXXX,"**")

 +1        IF "*+"[$EXTRACT(AMQQXXXX)

               QUIT

 +2        KILL AMQQXXAA,AMQQXXCC,AMQQXXVV

 +3        IF $EXTRACT(AMQQXXXX)="-"

               SET AMQQXXNN=""

               SET AMQQXXXX=$EXTRACT(AMQQXXXX,2,999)

               SET A=AMQQXXXX

               DO STRIP^AMQQQ

               SET AMQQXXXX=A

 +4        IF AMQQXXXX["!"

               DO KONG

               QUIT

 +5        DO ATT

 +6        DO CHECK

 +7       IF $TEST

               QUIT

 +8        IF $DATA(AMQQXXNF)

               KILL AMQQXXNF

               GOTO A1

 +9        IF AMQQCTXS

               DO MULT

               QUIT

 +10       IF AMQQFTYP="G"!(AMQQFTYP="L")

               DO TAX

               DO CHECK

               IF $TEST

                   QUIT

               SET AMQQXXCC="TAX"

               GOTO A1

 +11       IF $DATA(AMQQONE)

               SET (AMQQXXVV,AMQQXXCC)=""

               DO SET

               QUIT

 +12       DO COND

 +13       DO CHECK

 +14      IF $TEST

               QUIT

 +15       DO VAL

 +16       DO CHECK

 +17      IF $TEST

               QUIT

A1         DO SET

 +1        QUIT

 +2       ;

ATT        SET X=$PIECE(AMQQXXXX,";")

 +1        DO AUTO^AMQQATA

 +2        IF Y=-1

               IF AMQQXXXX'[";"

                   DO NATL

                   QUIT

 +3        IF Y'=-1

               DO ^AMQQSEC

 +4        IF Y=-1

               KILL AMQQXXNN

               SET AMQQFAIL=6

               QUIT

SETATT     SET AMQQXXAA=Y

 +1        SET %=^AMQQ(5,+Y,0)

 +2        SET AMQQLINK=$PIECE(%,U,5)

 +3        SET AMQQATN=+Y

 +4        IF AMQQLINK=9

               SET AMQQATNM=$PIECE(Y,U,2)

               DO ^AMQQATAL

 +5        SET %=^AMQQ(1,AMQQLINK,0)

 +6        SET AMQQCTXS=$PIECE(%,U,7)

 +7        SET AMQQFTYP=$PIECE(^AMQQ(4,$PIECE(%,U,5),0),U)

 +8        QUIT

 +9       ;

COND       SET X=$PIECE(AMQQXXXX,";",2)

 +1        KILL AMQQCOND

 +2        IF X=""

               SET (AMQQCOND,AMQQXXCC)=""

               QUIT

 +3        IF "^NULL^ALL^ANY^EXISTS^"[(U_X_U)

               IF X="ALL"

                   SET X="EXISTS"

               SET AMQQXXCC=X

               SET AMQQCOND=";;;"_X

               QUIT

 +4        DO AUTO^AMQQAC

 +5        IF Y=-1

               SET AMQQFAIL=7

               QUIT

SETCOND    SET AMQQCOND=+Y

 +1        SET AMQQNOCO=$PIECE(^AMQQ(5,+Y,0),U,8)

 +2        SET AMQQCONM=$PIECE(Y,U,2)

 +3        SET AMQQSYMB=$PIECE(^AMQQ(5,+Y,0),U,6)

 +4        SET AMQQXXCC=Y

 +5        QUIT

 +6       ;

VAL        SET (AMQQXXVV,X)=$PIECE(AMQQXXXX,";",3)

 +1        KILL AMQQCOMP

 +2        IF X=""

               IF $GET(AMQQCOND)

                   SET AMQQFAIL=8

                   QUIT

 +3        DO ^AMQQAV

 +4        IF '$DATA(AMQQCOMP)

               SET AMQQFAIL=8

               QUIT

 +5        SET AMQQXXVV=AMQQCOMP

 +6        QUIT

 +7       ;

SET        SET AMQQXXII=$GET(AMQQXXII)+1

 +1        SET AMQQXX(AMQQXXII,1)=AMQQXXAA_";"_$GET(AMQQXXCC)_";"_AMQQXXVV

 +2        QUIT

 +3       ;

TAX       ; ENTRY POINT FROM AMQQ1

 +1        IF $PIECE(AMQQXXXX,";",2)="="

               GOTO T1

 +2        IF $PIECE(AMQQXXXX,";",2)="'="

               SET AMQQXXNT="INVERSE"

               GOTO T1

 +3        IF $DATA(AMQQONE)

               GOTO T2

 +4        SET AMQQFAIL=9

           QUIT

T1         IF $PIECE(AMQQXXXX,";",3)=""

               SET AMQQFAIL=8

               QUIT

 +1        DO TGRP

 +2        IF $DATA(AMQQFAIL)

               QUIT

T2         KILL AMQQTAX

 +1        SET %=^AMQQ(5,AMQQATN,0)

 +2        SET AMQQTNAR=$PIECE(%,U,15)

 +3        SET AMQQTDIC=U_$PIECE(%,U,16)

 +4        SET AMQQTLOK=U_$PIECE(%,U,18)

 +5        SET AMQQTTX=$GET(^AMQQ(5,AMQQATN,3))

 +6        SET AMQQXXN=0

 +7        DO ^AMQQTX

 +8        KILL AMQQXXTT,AMQQXXTN

 +9        IF '$DATA(AMQQTAX)

               SET AMQQFAIL=8

               QUIT

 +10       IF $DATA(AMQQXXNT)

               SET AMQQSCMP=AMQQXXNT

               KILL AMQQXXNT

               DO SCMP^AMQQTX

               SET AMQQXXVV=AMQQCOMP

               IF 1

 +11      IF '$TEST

               SET AMQQXXVV=AMQQTAX

 +12       KILL AMQQTAX

 +13       QUIT

 +14      ;

TGRP       SET %=$PIECE(AMQQXXXX,";",3)

 +1        IF $EXTRACT(%)="["

               SET X=$EXTRACT(%,2,999)

               SET X=$PIECE(X,"]")

               IF $DATA(^UTILITY("AMQQ",$JOB,"XXTAX",X))

                   SET AMQQXXTT=X

                   QUIT

 +2        SET AMQQXXI=AMQQXXGN

 +3        SET AMQQXXX1=%

 +4        DO TG1

 +5        KILL AMQQXXX1

 +6        QUIT

 +7       ;

TG1        NEW AMQQXXGN

 +1        SET AMQQXXGN=AMQQXXI

 +2        SET AMQQXXTT="XXTEMP"

 +3        SET AMQQXXTN=0

 +4        KILL ^UTILITY("AMQQ",$JOB,"XXTAX",AMQQXXTT)

TG11       FOR I=1:1

               SET %=$PIECE(AMQQXXX1,",",I)

               IF %=""

                   QUIT

               SET AMQQXXTN=AMQQXXTN+1

               SET ^UTILITY("AMQQ",$JOB,"XXTAX",AMQQXXTT,AMQQXXTN)=%

 +1        SET AMQQXXGN=$ORDER(@AMQQXXGG)

 +2        IF 'AMQQXXGN

               QUIT

 +3        SET %=@AMQQXXGI

 +4        IF $EXTRACT(%)="+"

               SET AMQQXXX1=$EXTRACT(%,2,999)

               GOTO TG11

 +5        QUIT

 +6       ;

CHECK      IF $DATA(AMQQQUIT)!($DATA(AMQQFAIL))

 +1        QUIT

 +2       ;

KONG       FOR AMQQXXXI=1:1

               SET AMQQXXX1=$PIECE(AMQQXXXX,"!",AMQQXXXI)

               IF AMQQXXX1=""

                   QUIT

               DO OR

               DO CHECK

              IF $TEST

                   QUIT

 +1        KILL AMQQXXX1,AMQQXXXI

 +2        QUIT

 +3       ;

OR         NEW AMQQXXXX

 +1        SET AMQQXXXX=AMQQXXX1

 +2        DO ATT

           DO CHECK

 +3       IF $TEST

               QUIT

 +4        IF AMQQCTXS

               SET AMQQFAIL=9

               QUIT

 +5        IF AMQQFTYP="G"!(AMQQFTYP="L")

               DO TAX

               GOTO OR1

 +6        DO COND

 +7        DO CHECK

 +8       IF $TEST

               QUIT

 +9        DO VAL

 +10       DO CHECK

 +11      IF $TEST

               QUIT

OR1        IF AMQQXXXI=1

               SET AMQQXXII=$GET(AMQQXXII)+1

 +1        SET AMQQXX(AMQQXXII,AMQQXXXI)=AMQQXXAA_";"_$GET(AMQQXXCC)_";"_AMQQXXVV

 +2        QUIT

 +3       ;

MULT       SET AMQQXXII=$GET(AMQQXXII)+1

 +1        SET AMQQXX(AMQQXXII,1)=Y_";MULT"

 +2        SET AMQQXXLV=1

 +3        SET AMQQXXND="AMQQXX("_AMQQXXII_",1)"

 +4        DO ^AMQQQ1

 +5        QUIT

 +6       ;

NATL       KILL AMQQTAX

           DO ^AMQQN2

 +1        IF $DATA(AMQQFAIL)

               SET Y=-1

               KILL AMQQXXNN

               GOTO NEXIT

 +2        IF $DATA(AMQQTAX)

               SET AMQQXXAA=AMQQNATT

               SET AMQQXXCC=AMQQNCND

               SET AMQQXXVV=AMQQTAX

               SET AMQQXXNF=""

               IF $DATA(^UTILITY("AMQQ TAX",$JOB,AMQQTAX,"--"))

                   SET AMQQXXVV=AMQQXXVV_";INVERSE"

               GOTO NEXIT

 +3        SET Y=AMQQNATT

 +4        DO SETATT

 +5        SET Y=AMQQNCND

 +6        DO SETCOND

 +7        SET AMQQXXVV=AMQQNVAL

           SET AMQQXXNF=""

NEXIT      KILL AMQQNATT,AMQQNCND,AMQQNVAL,AMQQNTYP,AMQQTNAR,AMQQTDIC,AMQQTAX,AMQQTLOK,AMQQTTX,AMQQXXN,AMQQXXNT

 +1        QUIT

 +2       ;

AMQQQ0.m