AMQQAT.m

AMQQAT ; IHS/CMI/THL - GETS ATTRIBUTE ;

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

VAR D EXIT

 S AMQQQ=""

 K AMQQMULT

 I '$D(AMQQNOET),$$VERSION^%ZOSV(1)["Cache" S AMQQETRP=$ZT,X="*ATERR^AMQQAT",@^%ZOSF("TRAP")

 I '$D(AMQQNOET),$$VERSION^%ZOSV(1)'["Cache" S AMQQETRP=$ZT,X="ATERR^AMQQAT",@^%ZOSF("TRAP")

RUN D GET

EXIT ; ENTRY POINT FROM MULTIPLE ROUTINES

 I $G(AMQQETRP)]"" S $ZT=AMQQETRP K AMQQETRP

 K AMQQLINK,AMQQATNM,AMQQFTYP,AMQQCOMP,AMQQCOND,AMQQCONM,AMQQCTXS,AMQQNOCO,AMQQSYMB,AMQQVCL,I,X,Y,Z,%,Q,AMQQSQRC,AMQQNATF,AMQQLCOF

 K AMQQATN,AMQQNAR,AMQQSBCT,AMQQSQFR,AMQQCCHK,AMQQNOT,AMQQDNOT,AMQQTAX,AMQQSNOT,AMQQDICB,AMQQPRST,AMQQNVAR,AMQQFRED

 Q

 ;

GET D ^AMQQATA

 I $D(AMQQQUIT) Q

 I $D(AMQQVPF) K AMQQVPF D SET Q

 I $G(AMQQLINK)=758 D CND S AMQQATN=758

 I $G(AMQQCTXS) D CTXS Q

 I $D(AMQQSCPF) W !! Q

 I $D(AMQQRNDF) K AMQQRNDF W !! G GET

 I $D(AMQQTAX) D SETTAX Q

 I X="",$D(AMQQKONG) D KONGCK G GET

 I X="" Q

 I AMQQATNM="KONGLOMERATOR" S AMQQCOND=265,AMQQSYMB="=" S:'$D(AMQQKGNO) AMQQKGNO=0 S AMQQKGNO=AMQQKGNO+1,AMQQKONG="" W !!,"OK, I'll collect queries for OR GROUP #",AMQQKGNO,! G GET

CND K AMQQCOND

 D ^AMQQAC

 I $D(AMQQQUIT) Q

 I ($D(AMQQNULL)+$D(AMQQANYF)+$D(AMQQEXST)+$D(AMQQSVFL)) K AMQQEXST Q

 I $D(AMQQONE),'$D(AMQQMULT) Q

 I '$D(AMQQCOND) G CND

 K AMQQCOMP

 D ^AMQQAV

 I $D(AMQQQUIT) Q

 I '$D(AMQQCOMP) G CND

 D SET

 Q

 ;

CTXS ; ENTRY POINT FROM AMQQATG

 S AMQQSQAA=AMQQUATN,AMQQSQAN=AMQQATNM,AMQQSQSN=AMQQATN,AMQQSQST=AMQQFTYP

 D:$G(AMQQLINK)'=763 ^AMQQSQ

 I '$D(AMQQQUIT),'$D(AMQQXSQF) D SET

 Q

 ;

SET ; ENTRY POINT FROM AMQQSQA1 AND OTHERS

 ; SET "Q" VARIABLE FOR ^UTILITY("AMQQ",$J,"Q"...

 I AMQQCTXS S:'$D(AMQQMULX) AMQQMULX="" S AMQQMULX=AMQQMULX_AMQQUATN_U

 S Y=0

 F Z=0:0 S Z=$O(^AMQQ(1,AMQQLINK,4,Z)) Q:Z'=+Z  S Y=Y+1

 S AMQQNVAR=Y

 I $D(AMQQTAX) S %=$P($G(AMQQNATF),";",2) S:% AMQQCOMP=";;;"_% S %=$P(AMQQCOMP,";",5) I %="NULL"!(%="EXISTS") S AMQQNVAR=1

 E  I $G(AMQQSQFR)>4 S AMQQNVAR=1

 I AMQQCOMP[";NULL" S AMQQNVAR=1

 I $D(AMQQNOT),'$G(AMQQCTXS) S AMQQSYMB="'"_AMQQSYMB,AMQQCONM=$S(AMQQCONM="IS":"IS NOT",1:("NOT "_AMQQCONM))

 S AMQQSNOT=$D(AMQQNOT)+(2*$D(AMQQDNOT))

 S %="",X="LINK^ATNM^FTYP^CTXS^COND^NOCO^CONM^SYMB^COMP^VCL^SER^ORTX^FRED^NVAR^FILT^SNOT^TAX"

 F I=1:1:17 S Y="AMQQ"_$P(X,U,I) I $D(@Y) S $P(%,U,I)=@Y

DEBUG S AMQQQ=%

 I $D(AMQQKONG) S ^UTILITY("AMQQ OR",$J,1,AMQQKGNO,AMQQUATN)=""

 Q

 ;

SETTAX S (AMQQSYMB,AMQQCONM)=""

 D SET

 I $D(AMQQONE),'AMQQCTXS D ^AMQQAC

 I AMQQCTXS S:'$D(AMQQMULX) AMQQMULX="" S AMQQMULX=AMQQMULX_AMQQUATN_U

 I $D(AMQQONE),'$D(AMQQPRST) S AMQQTXMT=""

 Q

 ;

ATERR I '$D(AMQQNOET) X "I $P($ZE,"">"")=""<INTERRUPT""!($ZE[""-CTRAP"")" I  W !!,"Attribute Session terminated...",!! H 2 S AMQQQUIT="" G EXIT       ;TASSC/MFD added line for Cache, added attribute to see level you're at

 W !!,"WHOOPS!!!!!!!!!!!!!"

 W !,"Something just happened which caused me to come to a grinding halt."

 W !,"Try to enter the ATTRIBUTE again, but if this problem persists you must"

 W !,"take a different approach."

 W !!!,*7

 D EXIT

 G VAR

 ;

KONGCK S I=0

 F X=0:0 S X=$O(^UTILITY("AMQQ OR",$J,1,AMQQKGNO,X)) Q:'X  I X S I=I+1 Q:I=2

 K AMQQKONG I I>1 Q

 K ^UTILITY("AMQQ OR",$J,1,AMQQKGNO)

 S AMQQKGNO=AMQQKGNO-1

 I 'I W !,"OR GROUP #",(AMQQKGNO+1)," Cancelled",*7,! Q

 W !,"Since the OR GROUP has only 1 member, I will treat it as an ordinary attribute.",*7,!

 S %=^UTILITY("AMQQ",$J,"LIST",AMQQILIN)

 S X="[OR #"_(AMQQKGNO+1)_"] "

 S %=$P(%,X)_$P(%,X,2)

 S ^UTILITY("AMQQ",$J,"LIST",AMQQILIN)=%

 Q

 ;

VIEW ; DEBUGGING UTILITY

 N X,Y,Z,I,%

 S X="LINK^ATNM^FTYP^CTXS^COND^NOCO^CONM^SYMB^COMP^VCL^SER^ORTX^FRED^NVAR^FILT^SNOT^TAX"

 S Y="LINK IEN^ATTRIBUTE NAME^DATA TYPE^SUBQUERY^CONDITION (TERM) IEN^NO. OF CONDITIONS^CONDITION NAME^BOOLEAN SYMBOL^COMPARISON VALUE^VALIDITY CODE LOCATION^SEARCH EFFICIENCY^XXX^SINGULARITY^NO. OF VARIABLES^YYY^INVERTED SUBQUERY FLAG^TAXONOMY"

 F I=1:1 S %=$P(X,U,I) Q:%=""  S Z="AMQQ"_% I $G(@Z)]"" W !,I,?4,$P(Y,U,I),": ",$S(((I=4)!(I=16)):$S(@Z:"YES",1:"NO"),1:@Z)

 Q

AMQQAT    ; IHS/CMI/THL - GETS ATTRIBUTE ;

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

VAR        DO EXIT

 +1        SET AMQQQ=""

 +2        KILL AMQQMULT

 +3        IF '$DATA(AMQQNOET)

               IF $$VERSION^%ZOSV(1)["Cache"

                   SET AMQQETRP=$ZT

                   SET X="*ATERR^AMQQAT"

                   SET @^%ZOSF("TRAP")

 +4        IF '$DATA(AMQQNOET)

               IF $$VERSION^%ZOSV(1)'["Cache"

                   SET AMQQETRP=$ZT

                   SET X="ATERR^AMQQAT"

                   SET @^%ZOSF("TRAP")

RUN        DO GET

EXIT      ; ENTRY POINT FROM MULTIPLE ROUTINES

 +1        IF $GET(AMQQETRP)]""

               SET $ZT=AMQQETRP

               KILL AMQQETRP

 +2        KILL AMQQLINK,AMQQATNM,AMQQFTYP,AMQQCOMP,AMQQCOND,AMQQCONM,AMQQCTXS,AMQQNOCO,AMQQSYMB,AMQQVCL,I,X,Y,Z,%,Q,AMQQSQRC,AMQQNATF,AMQQLCOF

 +3        KILL AMQQATN,AMQQNAR,AMQQSBCT,AMQQSQFR,AMQQCCHK,AMQQNOT,AMQQDNOT,AMQQTAX,AMQQSNOT,AMQQDICB,AMQQPRST,AMQQNVAR,AMQQFRED

 +4        QUIT 

 +5       ;

GET        DO ^AMQQATA

 +1        IF $DATA(AMQQQUIT)

               QUIT 

 +2        IF $DATA(AMQQVPF)

               KILL AMQQVPF

               DO SET

               QUIT 

 +3        IF $GET(AMQQLINK)=758

               DO CND

               SET AMQQATN=758

 +4        IF $GET(AMQQCTXS)

               DO CTXS

               QUIT 

 +5        IF $DATA(AMQQSCPF)

               WRITE !!

               QUIT 

 +6        IF $DATA(AMQQRNDF)

               KILL AMQQRNDF

               WRITE !!

               GOTO GET

 +7        IF $DATA(AMQQTAX)

               DO SETTAX

               QUIT 

 +8        IF X=""

               IF $DATA(AMQQKONG)

                   DO KONGCK

                   GOTO GET

 +9        IF X=""

               QUIT 

 +10       IF AMQQATNM="KONGLOMERATOR"

               SET AMQQCOND=265

               SET AMQQSYMB="="

               IF '$DATA(AMQQKGNO)

                   SET AMQQKGNO=0

               SET AMQQKGNO=AMQQKGNO+1

               SET AMQQKONG=""

               WRITE !!,"OK, I'll collect queries for OR GROUP #",AMQQKGNO,!

               GOTO GET

CND        KILL AMQQCOND

 +1        DO ^AMQQAC

 +2        IF $DATA(AMQQQUIT)

               QUIT 

 +3        IF ($DATA(AMQQNULL)+$DATA(AMQQANYF)+$DATA(AMQQEXST)+$DATA(AMQQSVFL))

               KILL AMQQEXST

               QUIT 

 +4        IF $DATA(AMQQONE)

               IF '$DATA(AMQQMULT)

                   QUIT 

 +5        IF '$DATA(AMQQCOND)

               GOTO CND

 +6        KILL AMQQCOMP

 +7        DO ^AMQQAV

 +8        IF $DATA(AMQQQUIT)

               QUIT 

 +9        IF '$DATA(AMQQCOMP)

               GOTO CND

 +10       DO SET

 +11       QUIT 

 +12      ;

CTXS      ; ENTRY POINT FROM AMQQATG

 +1        SET AMQQSQAA=AMQQUATN

           SET AMQQSQAN=AMQQATNM

           SET AMQQSQSN=AMQQATN

           SET AMQQSQST=AMQQFTYP

 +2        IF $GET(AMQQLINK)'=763

               DO ^AMQQSQ

 +3        IF '$DATA(AMQQQUIT)

               IF '$DATA(AMQQXSQF)

                   DO SET

 +4        QUIT 

 +5       ;

SET       ; ENTRY POINT FROM AMQQSQA1 AND OTHERS

 +1       ; SET "Q" VARIABLE FOR ^UTILITY("AMQQ",$J,"Q"...

 +2        IF AMQQCTXS

               IF '$DATA(AMQQMULX)

                   SET AMQQMULX=""

               SET AMQQMULX=AMQQMULX_AMQQUATN_U

 +3        SET Y=0

 +4        FOR Z=0:0

               SET Z=$ORDER(^AMQQ(1,AMQQLINK,4,Z))

               IF Z'=+Z

                   QUIT 

               SET Y=Y+1

 +5        SET AMQQNVAR=Y

 +6        IF $DATA(AMQQTAX)

               SET %=$PIECE($GET(AMQQNATF),";",2)

               IF %

                   SET AMQQCOMP=";;;"_%

               SET %=$PIECE(AMQQCOMP,";",5)

               IF %="NULL"!(%="EXISTS")

                   SET AMQQNVAR=1

 +7       IF '$TEST

               IF $GET(AMQQSQFR)>4

                   SET AMQQNVAR=1

 +8        IF AMQQCOMP[";NULL"

               SET AMQQNVAR=1

 +9        IF $DATA(AMQQNOT)

               IF '$GET(AMQQCTXS)

                   SET AMQQSYMB="'"_AMQQSYMB

                   SET AMQQCONM=$SELECT(AMQQCONM="IS":"IS NOT",1:("NOT "_AMQQCONM))

 +10       SET AMQQSNOT=$DATA(AMQQNOT)+(2*$DATA(AMQQDNOT))

 +11       SET %=""

           SET X="LINK^ATNM^FTYP^CTXS^COND^NOCO^CONM^SYMB^COMP^VCL^SER^ORTX^FRED^NVAR^FILT^SNOT^TAX"

 +12       FOR I=1:1:17

               SET Y="AMQQ"_$PIECE(X,U,I)

               IF $DATA(@Y)

                   SET $PIECE(%,U,I)=@Y

DEBUG      SET AMQQQ=%

 +1        IF $DATA(AMQQKONG)

               SET ^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO,AMQQUATN)=""

 +2        QUIT 

 +3       ;

SETTAX     SET (AMQQSYMB,AMQQCONM)=""

 +1        DO SET

 +2        IF $DATA(AMQQONE)

               IF 'AMQQCTXS

                   DO ^AMQQAC

 +3        IF AMQQCTXS

               IF '$DATA(AMQQMULX)

                   SET AMQQMULX=""

               SET AMQQMULX=AMQQMULX_AMQQUATN_U

 +4        IF $DATA(AMQQONE)

               IF '$DATA(AMQQPRST)

                   SET AMQQTXMT=""

 +5        QUIT 

 +6       ;

ATERR     ;TASSC/MFD added line for Cache, added attribute to see level you're at

           IF '$DATA(AMQQNOET)

               XECUTE "I $P($ZE,"">"")=""<INTERRUPT""!($ZE[""-CTRAP"")"

              IF $TEST

                   WRITE !!,"Attribute Session terminated...",!!

                   HANG 2

                   SET AMQQQUIT=""

                   GOTO EXIT

 +1        WRITE !!,"WHOOPS!!!!!!!!!!!!!"

 +2        WRITE !,"Something just happened which caused me to come to a grinding halt."

 +3        WRITE !,"Try to enter the ATTRIBUTE again, but if this problem persists you must"

 +4        WRITE !,"take a different approach."

 +5        WRITE !!!,*7

 +6        DO EXIT

 +7        GOTO VAR

 +8       ;

KONGCK     SET I=0

 +1        FOR X=0:0

               SET X=$ORDER(^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO,X))

               IF 'X

                   QUIT 

               IF X

                   SET I=I+1

                   IF I=2

                       QUIT 

 +2        KILL AMQQKONG

           IF I>1

               QUIT 

 +3        KILL ^UTILITY("AMQQ OR",$JOB,1,AMQQKGNO)

 +4        SET AMQQKGNO=AMQQKGNO-1

 +5        IF 'I

               WRITE !,"OR GROUP #",(AMQQKGNO+1)," Cancelled",*7,!

               QUIT 

 +6        WRITE !,"Since the OR GROUP has only 1 member, I will treat it as an ordinary attribute.",*7,!

 +7        SET %=^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)

 +8        SET X="[OR #"_(AMQQKGNO+1)_"] "

 +9        SET %=$PIECE(%,X)_$PIECE(%,X,2)

 +10       SET ^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)=%

 +11       QUIT 

 +12      ;

VIEW      ; DEBUGGING UTILITY

 +1        NEW X,Y,Z,I,%

 +2        SET X="LINK^ATNM^FTYP^CTXS^COND^NOCO^CONM^SYMB^COMP^VCL^SER^ORTX^FRED^NVAR^FILT^SNOT^TAX"

 +3        SET Y="LINK IEN^ATTRIBUTE NAME^DATA TYPE^SUBQUERY^CONDITION (TERM) IEN^NO. OF CONDITIONS^CONDITION NAME^BOOLEAN SYMBOL^COMPARISON VALUE^VALIDITY CODE LOCATION^SEARCH EFFICIENCY^XXX^SINGULARITY^NO. OF VARIABLES^YYY^INVERTED SUBQUERY FLAG^TAXONOM

Y"

 +4        FOR I=1:1

               SET %=$PIECE(X,U,I)

               IF %=""

                   QUIT 

               SET Z="AMQQ"_%

               IF $GET(@Z)]""

                   WRITE !,I,?4,$PIECE(Y,U,I),": ",$SELECT(((I=4)!(I=16)):$SELECT(@Z:"YES",1:"NO"),1:@Z)

 +5        QUIT