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