Routine: AMQQAC

AMQQAC ; IHS/CMI/THL - GETS CONDITIONS ; [ 07/26/2011  3:56 PM ]

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

 ;-----

CONDP I $D(AMQQONE) D ^AMQQAC1 S AMQQUATN=AMQQUATN+1 Q

 I AMQQATNM="ALIVE" S AMQQCOND=7,AMQQNOT="",AMQQSYMB="<",AMQQNOCO=1,AMQQCONM="BEFORE" Q

 I AMQQATNM="COHORT" S AMQQCOND=238,AMQQSYMB="=",AMQQNOCO=1,AMQQCONM="IS A MEMBER OF" Q

 I AMQQATNM="FILE ENTRY" S AMQQCOND=264,AMQQSYMB="=",AMQQNOCO=1,AMQQCONM="IS ENTERED IN" Q

COND K AMQQSVAL

 D GETCOND

 I $E($G(X))=U K Y Q

Y I Y=-1 D SPEC I '$D(Y) Q

 I Y=-1 W "  ??",*7 G COND

 I $D(AMQQLINK) S %=^AMQQ(1,AMQQLINK,0) I $P(%,U,5)=13,$D(AMQQNOT),+Y>106,+Y<109 S Y=-1 W "  ??",*7 G COND

EN1 ; ENTRY POINT FROM AMQQQ2

 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)

GETCOND ; ENTRY POINT FORM AMQQSQA1

 I AMQQATN=783 S I=5 D S1 S Y=11,AMQQFTYP="S" Q  ;PATCH XXX

 I AMQQATN=368!(AMQQATN=415)!(AMQQATN=454) S X="ALL" G AUTO

 I $D(AMQQNATF),$P(AMQQNATF,";")'="" S Y=$P(AMQQNATF,";") Q

 S %=AMQQATN

 I "^59^316^317^318^"[(U_%_U) S %=$S(%=316:"AFTER",%=317:"BEFORE",1:"BETWEEN") G CONDIC

 I AMQQFTYP="S" D SET G CONDIC

 I AMQQFTYP="F",'$D(AMQQFIFL),'$D(AMQQSQTP) S AMQQDICB="ANY"

 I "Q"[AMQQFTYP,$D(AMQQFIFL) S AMQQDICB="IS"

 K AMQQNOT

 I AMQQLINK>764,AMQQLINK<768 D STARSTOP Q

 I AMQQLINK=699 D STARSTOP Q

 W !,"Condition: "

 W:$D(AMQQDICB) AMQQDICB,"// "

 R X:DTIME E  S X=U

 I $E(X)=U S AMQQQUIT="" Q

 I X="",$D(AMQQDICB) S X=AMQQDICB

 K AMQQDICB,AMQQFIFL

 I X="" D ACA Q:X=4  I X="~~~COND"[X G GETCOND

 I X="" W !! K AMQQCOND Q

 I X="??" S X="AD^"_$O(^AMQQ(4,"B",AMQQFTYP,"")) D ^AMQQHELP G GETCOND

 I X?1."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQCONDITION","")) D EN1^XQH G GETCOND

 I X[" ",$E(X,$L(X))?1N S AMQQSVAL=$P(X," ",$L(X," ")),X=$P(X," ",1,$L(X," ")-1)

AUTO ; ENTRY POINT FROM AMQQQ

 I X["NOT"!(X["'") D NOT

CONDIC ; ENTRY POINT FROM AMQQ1

 S DIC="^AMQQ(5,"

 S DIC(0)="ES"

 S DIC("S")="I $P(^(0),U,3)="_$O(^AMQQ(4,"B",AMQQFTYP,""))

 S D="C"

 I AMQQFTYP="S"!($D(AMQQXX)) S DIC(0)=""

 I $D(AMQQSQRD) S DIC("S")=DIC("S")_"!(Y=363)"

 D IX^DIC

 K DIC

 I +Y'=363 K AMQQSQRD

STARSTOP ;SET CONDITION FOR FORMULA/SOLIDS STARTED AND BREAST STOPPED ATTRIBUTES

 I AMQQLINK=766!(AMQQLINK=767) S X="ON OR AFTER",Y="16^ON OR AFTER"

 I AMQQLINK=765 S X="ON OR BEFORE",Y="17^ON OR BEFORE"

 I AMQQLINK=699 S X="CONTAINS",Y="13^CONTAINS"

SPEC I X="*" S X="ALL" W "  (List all values)"

 S Z="ANY;SAVE;ALL;EXISTS;BLANK;EMPTY;NULL;@"

 F I=1:1 S %=$P(Z,";",I) Q:%=""  I X=$E(%,1,$L(X)) W $E(%,$L(X)+1,99) S X=% D S1 Q

S1 I $D(AMQQMULT) Q

 I I>2,$D(AMQQNOT) S I=$S(I>4:4,1:5) K AMQQNOT

 S X=$S(I>4:"NULL",I>2:"EXISTS",I=1:"ANY",1:"SAVE")

 S AMQQCOMP=X

 I I>2 S AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^'=^;;;"_X_"^^^^^1",AMQQEXST="" K Y Q

 I I=2 S AMQQSVFL="" D ^AMQQAC1 S AMQQUATN=AMQQUATN+1 K Y Q

ANY ; ENTRY POINT FROM AMQQAV0

 S Y=" (ANY VALUE INCLUDING 'NULL')"

 S AMQQILIN=AMQQILIN+1

 S ^UTILITY("AMQQ",$J,"LIST",AMQQILIN)="W ?6,"""_AMQQATNM_Y_""""

 S ^UTILITY("AMQQ",$J,"WEIGHT",9,AMQQUATN)=""

 S AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^=^;;;ANY^^9^W ?6,"""_AMQQATNM_"""^1^1^1"

 S ^UTILITY("AMQQ",$J,"Q",AMQQUATN)=AMQQQ

 S AMQQUATN=AMQQUATN+1

 S AMQQANYF=""

K Y

ACA ; ENTRY POINT FROM AMQQAV0 AND THE AMQQTAX* ROUTINES

 I $D(AMQQSQTP) S X="" Q

 I '$D(AMQQATNM) S X="" Q

 I "^DX^RX^PROC^"[(U_AMQQATNM_U),'$D(AMQQONE) S X="" Q

 W !!,"Since you did not specify a condition, select one of the following =>",!

 W !,?5,"1) Whoops...Let me try again"

 W !,?5,"2) List every ",AMQQATNM

 W !,?5,"3) List any ",AMQQATNM," including 'NULL'"

 W !,?5,"4) Exit",!

ACAR R !,"YOUR CHOICE (1-4): 1// ",X:DTIME E  S X=U

 I X=U S AMQQQUIT="",X="" Q

 I X=4 S AMQQQUIT="" Q

 I X?1."?" W !!,"Enter a number from 1 to 4 or '^' to exit",!! G ACAR

 I X="" S X=1 W "  (1)"

 I X,X<4 G ACAA

 W "  ??",*7 G ACAR

ACAA S X=$P("^ALL^ANY",U,X)

SET N A,Y,Z,%,I

 S X=$P(^AMQQ(1,AMQQLINK,0),U,6)

 S Y=+X

 S Z=$P(X,",",2)

 S %=";"_$P(^DD(Y,Z,0),U,3)

 W !,"CHOOSE FROM: "

 F I=2:1 S A=$P(%,";",I) Q:A=""  W !,?7,$P(A,":"),?15,$P(A,":",2)

 S X="IS"

NOT S Y="AMQQNOT"

 G NOTX

DNOT S Y="AMQQDNOT"

NOTX I $E(X,1,4)="NOT " S X=$E(X,5,99),@Y="" Q

 I $E(X)="'" S X=$E(X,2,99),@Y="" Q

 S %=$L(X)

 I $E(X,%-3,%)=" NOT" S X=$E(X,1,%-4),@Y=""

 ;-----

AMQQAC    ; IHS/CMI/THL - GETS CONDITIONS ; [ 07/26/2011  3:56 PM ]

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

 +2       ;-----

CONDP      IF $DATA(AMQQONE)

               DO ^AMQQAC1

               SET AMQQUATN=AMQQUATN+1

               QUIT

 +1        IF AMQQATNM="ALIVE"

               SET AMQQCOND=7

               SET AMQQNOT=""

               SET AMQQSYMB="<"

               SET AMQQNOCO=1

               SET AMQQCONM="BEFORE"

               QUIT

 +2        IF AMQQATNM="COHORT"

               SET AMQQCOND=238

               SET AMQQSYMB="="

               SET AMQQNOCO=1

               SET AMQQCONM="IS A MEMBER OF"

               QUIT

 +3        IF AMQQATNM="FILE ENTRY"

               SET AMQQCOND=264

               SET AMQQSYMB="="

               SET AMQQNOCO=1

               SET AMQQCONM="IS ENTERED IN"

               QUIT

COND       KILL AMQQSVAL

 +1        DO GETCOND

 +2        IF $EXTRACT($GET(X))=U

               KILL Y

               QUIT

Y          IF Y=-1

               DO SPEC

               IF '$DATA(Y)

                   QUIT

 +1        IF Y=-1

               WRITE "  ??",*7

               GOTO COND

 +2        IF $DATA(AMQQLINK)

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

               IF $PIECE(%,U,5)=13

                   IF $DATA(AMQQNOT)

                       IF +Y>106

                           IF +Y<109

                               SET Y=-1

                               WRITE "  ??",*7

                               GOTO COND

EN1       ; ENTRY POINT FROM AMQQQ2

 +1        SET AMQQCOND=+Y

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

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

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

 +5        QUIT

 +6       ;

GETCOND   ; ENTRY POINT FORM AMQQSQA1

 +1       ;PATCH XXX

           IF AMQQATN=783

               SET I=5

               DO S1

               SET Y=11

               SET AMQQFTYP="S"

               QUIT

 +2        IF AMQQATN=368!(AMQQATN=415)!(AMQQATN=454)

               SET X="ALL"

               GOTO AUTO

 +3        IF $DATA(AMQQNATF)

               IF $PIECE(AMQQNATF,";")'=""

                   SET Y=$PIECE(AMQQNATF,";")

                   QUIT

 +4        SET %=AMQQATN

 +5        IF "^59^316^317^318^"[(U_%_U)

               SET %=$SELECT(%=316:"AFTER",%=317:"BEFORE",1:"BETWEEN")

               GOTO CONDIC

 +6        IF AMQQFTYP="S"

               DO SET

               GOTO CONDIC

 +7        IF AMQQFTYP="F"

               IF '$DATA(AMQQFIFL)

                   IF '$DATA(AMQQSQTP)

                       SET AMQQDICB="ANY"

 +8        IF "Q"[AMQQFTYP

               IF $DATA(AMQQFIFL)

                   SET AMQQDICB="IS"

 +9        KILL AMQQNOT

 +10       IF AMQQLINK>764

               IF AMQQLINK<768

                   DO STARSTOP

                   QUIT

 +11       IF AMQQLINK=699

               DO STARSTOP

               QUIT

 +12       WRITE !,"Condition: "

 +13       IF $DATA(AMQQDICB)

               WRITE AMQQDICB,"// "

 +14       READ X:DTIME

          IF '$TEST

               SET X=U

 +15       IF $EXTRACT(X)=U

               SET AMQQQUIT=""

               QUIT

 +16       IF X=""

               IF $DATA(AMQQDICB)

                   SET X=AMQQDICB

 +17       KILL AMQQDICB,AMQQFIFL

 +18       IF X=""

               DO ACA

               IF X=4

                   QUIT

               IF X="~~~COND"[X

                   GOTO GETCOND

 +19       IF X=""

               WRITE !!

               KILL AMQQCOND

               QUIT

 +20       IF X="??"

               SET X="AD^"_$ORDER(^AMQQ(4,"B",AMQQFTYP,""))

               DO ^AMQQHELP

               GOTO GETCOND

 +21       IF X?1."?"

               NEW %A,%B

               SET XQH=$ORDER(^DIC(9.2,"B","AMQQCONDITION",""))

               DO EN1^XQH

               GOTO GETCOND

 +22       IF X[" "

               IF $EXTRACT(X,$LENGTH(X))?1N

                   SET AMQQSVAL=$PIECE(X," ",$LENGTH(X," "))

                   SET X=$PIECE(X," ",1,$LENGTH(X," ")-1)

AUTO      ; ENTRY POINT FROM AMQQQ

 +1        IF X["NOT"!(X["'")

               DO NOT

CONDIC    ; ENTRY POINT FROM AMQQ1

 +1        SET DIC="^AMQQ(5,"

 +2        SET DIC(0)="ES"

 +3        SET DIC("S")="I $P(^(0),U,3)="_$ORDER(^AMQQ(4,"B",AMQQFTYP,""))

 +4        SET D="C"

 +5        IF AMQQFTYP="S"!($DATA(AMQQXX))

               SET DIC(0)=""

 +6        IF $DATA(AMQQSQRD)

               SET DIC("S")=DIC("S")_"!(Y=363)"

 +7        DO IX^DIC

 +8        KILL DIC

 +9        IF +Y'=363

               KILL AMQQSQRD

STARSTOP  ;SET CONDITION FOR FORMULA/SOLIDS STARTED AND BREAST STOPPED ATTRIBUTES

 +1        IF AMQQLINK=766!(AMQQLINK=767)

               SET X="ON OR AFTER"

               SET Y="16^ON OR AFTER"

 +2        IF AMQQLINK=765

               SET X="ON OR BEFORE"

               SET Y="17^ON OR BEFORE"

 +3        IF AMQQLINK=699

               SET X="CONTAINS"

               SET Y="13^CONTAINS"

 +4        QUIT

 +5       ;

SPEC       IF X="*"

               SET X="ALL"

               WRITE "  (List all values)"

 +1        SET Z="ANY;SAVE;ALL;EXISTS;BLANK;EMPTY;NULL;@"

 +2        FOR I=1:1

               SET %=$PIECE(Z,";",I)

               IF %=""

                   QUIT

               IF X=$EXTRACT(%,1,$LENGTH(X))

                   WRITE $EXTRACT(%,$LENGTH(X)+1,99)

                   SET X=%

                   DO S1

                   QUIT

 +3        QUIT

 +4       ;

S1         IF $DATA(AMQQMULT)

               QUIT

 +1        IF I>2

               IF $DATA(AMQQNOT)

                   SET I=$SELECT(I>4:4,1:5)

                   KILL AMQQNOT

 +2        SET X=$SELECT(I>4:"NULL",I>2:"EXISTS",I=1:"ANY",1:"SAVE")

 +3        SET AMQQCOMP=X

 +4        IF I>2

               SET AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^'=^;;;"_X_"^^^^^1"

               SET AMQQEXST=""

               KILL Y

               QUIT

 +5        IF I=2

               SET AMQQSVFL=""

               DO ^AMQQAC1

               SET AMQQUATN=AMQQUATN+1

               KILL Y

               QUIT

ANY       ; ENTRY POINT FROM AMQQAV0

 +1        SET Y=" (ANY VALUE INCLUDING 'NULL')"

 +2        SET AMQQILIN=AMQQILIN+1

 +3        SET ^UTILITY("AMQQ",$JOB,"LIST",AMQQILIN)="W ?6,"""_AMQQATNM_Y_""""

 +4        SET ^UTILITY("AMQQ",$JOB,"WEIGHT",9,AMQQUATN)=""

 +5        SET AMQQQ=AMQQLINK_U_AMQQATNM_U_AMQQFTYP_"^^^^^=^;;;ANY^^9^W ?6,"""_AMQQATNM_"""^1^1^1"

 +6        SET ^UTILITY("AMQQ",$JOB,"Q",AMQQUATN)=AMQQQ

 +7        SET AMQQUATN=AMQQUATN+1

 +8        SET AMQQANYF=""

 +9        KILL Y

 +10       QUIT

 +11      ;

ACA       ; ENTRY POINT FROM AMQQAV0 AND THE AMQQTAX* ROUTINES

 +1        IF $DATA(AMQQSQTP)

               SET X=""

               QUIT

 +2        IF '$DATA(AMQQATNM)

               SET X=""

               QUIT

 +3        IF "^DX^RX^PROC^"[(U_AMQQATNM_U)

               IF '$DATA(AMQQONE)

                   SET X=""

                   QUIT

 +4        WRITE !!,"Since you did not specify a condition, select one of the following =>",!

 +5        WRITE !,?5,"1) Whoops...Let me try again"

 +6        WRITE !,?5,"2) List every ",AMQQATNM

 +7        WRITE !,?5,"3) List any ",AMQQATNM," including 'NULL'"

 +8        WRITE !,?5,"4) Exit",!

ACAR       READ !,"YOUR CHOICE (1-4): 1// ",X:DTIME

          IF '$TEST

               SET X=U

 +1        IF X=U

               SET AMQQQUIT=""

               SET X=""

               QUIT

 +2        IF X=4

               SET AMQQQUIT=""

               QUIT

 +3        IF X?1."?"

               WRITE !!,"Enter a number from 1 to 4 or '^' to exit",!!

               GOTO ACAR

 +4        IF X=""

               SET X=1

               WRITE "  (1)"

 +5        IF X

               IF X<4

                   GOTO ACAA

 +6        WRITE "  ??",*7

           GOTO ACAR

ACAA       SET X=$PIECE("^ALL^ANY",U,X)

 +1        QUIT

 +2       ;

SET        NEW A,Y,Z,%,I

 +1        SET X=$PIECE(^AMQQ(1,AMQQLINK,0),U,6)

 +2        SET Y=+X

 +3        SET Z=$PIECE(X,",",2)

 +4        SET %=";"_$PIECE(^DD(Y,Z,0),U,3)

 +5        WRITE !,"CHOOSE FROM: "

 +6        FOR I=2:1

               SET A=$PIECE(%,";",I)

               IF A=""

                   QUIT

               WRITE !,?7,$PIECE(A,":"),?15,$PIECE(A,":",2)

 +7        SET X="IS"

 +8        QUIT

 +9       ;

NOT        SET Y="AMQQNOT"

 +1        GOTO NOTX

DNOT       SET Y="AMQQDNOT"

NOTX       IF $EXTRACT(X,1,4)="NOT "

               SET X=$EXTRACT(X,5,99)

               SET @Y=""

               QUIT

 +1        IF $EXTRACT(X)="'"

               SET X=$EXTRACT(X,2,99)

               SET @Y=""

               QUIT

 +2        SET %=$LENGTH(X)

 +3        IF $EXTRACT(X,%-3,%)=" NOT"

               SET X=$EXTRACT(X,1,%-4)

               SET @Y=""

 +4        QUIT

 +5       ;-----

AMQQAC.m