AMQQSQBP ; IHS/CMI/THL - GETS CONDITIONS AND VALUES FOR SBP AND DPB ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
N AMQQLINK,AMQQQ,AMQQATNM,AMQQCONM,AMQQCOMP,AMQQNOCO,AMQQNOT,AMQQTMPC
RUN D SBP
I $D(AMQQQUIT) G EXIT
S AMQQNOCO=+AMQQQ_"~"_AMQQNOCO
S AMQQTMPC=$P(AMQQQ,U,2)_"~"_AMQQTMPC
D AND
EXIT K AMQQTMPC,X,AMQQDISV,%,%A,%B
Q
;
SBP W !!!,@AMQQRV,"SYSTOLIC BP",@AMQQNV
S AMQQLINK=10
S AMQQATNM="SYSTOLIC B/P"
D V1
I $D(AMQQQUIT) Q
I '$D(AMQQCONM) Q
S AMQQQ=AMQQNOCO_U_AMQQTMPC
DBP W !!!,@AMQQRV,"DIASTOLIC BP",@AMQQNV
S AMQQLINK=11
S AMQQATNM="DIASTOLIC BP"
D V1
I $D(AMQQQUIT) Q
Q
;
AND W !!!,"When I analyze the result =>",!
W !?5,"1) Both systolic ",@AMQQRV,"and",@AMQQNV," diastolic BPs must meet your criteria"
W !?5,"2) Either systolic ",@AMQQRV,"or",@AMQQNV," diastolic BP must meet your criteria",!
ANDQ W !,"Your choice (1-2): 1// "
R X:DTIME E S X=U
I $E(X)=U S AMQQQUIT="" Q
I X="" S X=1 W " (1)"
I X?1."?" W !!,"Choose between ""and"" logic and ""or"" logic" G AND
I X=1 S AMQQSQCV=AMQQTMPC_"~&" Q
I X=2 S AMQQSQCV=AMQQTMPC_"~!" Q
W " ??",*7
G ANDQ
;
V1 W !,"Value limiting condition for ",AMQQSQAN,": "
W:$D(AMQQDISV) AMQQDISV,"// "
R X:DTIME
I X?1."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQBOOL","")) D EN1^XQH G V1
I X=U S AMQQQUIT="" Q
I X="",$D(AMQQDISV) S X=AMQQDISV K AMQQDISV
I X["NOT"!(X["'") D NOT
I X="" S AMQQSQQT="" Q
S DIC="^AMQQ(5,"
S DIC(0)="ES"
S DIC("S")="I $P(^(0),U,21)=17"
S D="C"
D IX^DIC
K DIC
I Y=-1 W " ??",*7 G V1
VA S AMQQCOND=+Y
S AMQQNOCO=$P(^AMQQ(5,+Y,0),U,8)
S (AMQQCONM,AMQQDISV)=$P(Y,U,2)
S AMQQSQCT="B"
S AMQQSQVV=""
I AMQQNOCO=2,$D(AMQQNOT) K AMQQDISV,AMQQNOT W " ??",*7 G V1
I $D(AMQQNOT) S AMQQDISV="NOT "_AMQQDISV
S AMQQSYMB=$P(^AMQQ(5,+Y,0),U,6)
I $D(AMQQNOT) S AMQQSYMB="'"_AMQQSYMB K AMQQNOT
D COMPN^AMQQAV0
I $D(AMQQQUIT) Q
I AMQQNOCO=2 G V2
I '$D(AMQQCOMP) G V1
I AMQQCOMP="" G V1
I $D(AMQQQUIT) Q
S AMQQTMPC=AMQQSYMB_":"_AMQQCOMP
Q
V2 I AMQQCOMP="" G V1
S AMQQTMPC="'<:"_$P(AMQQCOMP,";")_":'>:"_$P(AMQQCOMP,";",2)
Q
;
NOT I $E(X,1,4)="NOT " S X=$E(X,5,99),AMQQNOT="" Q
I $E(X)="'" S X=$E(X,2,99),AMQQNOT="" Q
S %=$L(X)
I $E(X,%-3,%)=" NOT" S X=$E(X,1,%-4),AMQQNOT=""
Q
;
AMQQSQBP ; IHS/CMI/THL - GETS CONDITIONS AND VALUES FOR SBP AND DPB ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 NEW AMQQLINK,AMQQQ,AMQQATNM,AMQQCONM,AMQQCOMP,AMQQNOCO,AMQQNOT,AMQQTMPC
RUN DO SBP
+1 IF $DATA(AMQQQUIT)
GOTO EXIT
+2 SET AMQQNOCO=+AMQQQ_"~"_AMQQNOCO
+3 SET AMQQTMPC=$PIECE(AMQQQ,U,2)_"~"_AMQQTMPC
+4 DO AND
EXIT KILL AMQQTMPC,X,AMQQDISV,%,%A,%B
+1 QUIT
+2 ;
SBP WRITE !!!,@AMQQRV,"SYSTOLIC BP",@AMQQNV
+1 SET AMQQLINK=10
+2 SET AMQQATNM="SYSTOLIC B/P"
+3 DO V1
+4 IF $DATA(AMQQQUIT)
QUIT
+5 IF '$DATA(AMQQCONM)
QUIT
+6 SET AMQQQ=AMQQNOCO_U_AMQQTMPC
DBP WRITE !!!,@AMQQRV,"DIASTOLIC BP",@AMQQNV
+1 SET AMQQLINK=11
+2 SET AMQQATNM="DIASTOLIC BP"
+3 DO V1
+4 IF $DATA(AMQQQUIT)
QUIT
+5 QUIT
+6 ;
AND WRITE !!!,"When I analyze the result =>",!
+1 WRITE !?5,"1) Both systolic ",@AMQQRV,"and",@AMQQNV," diastolic BPs must meet your criteria"
+2 WRITE !?5,"2) Either systolic ",@AMQQRV,"or",@AMQQNV," diastolic BP must meet your criteria",!
ANDQ WRITE !,"Your choice (1-2): 1// "
+1 READ X:DTIME
IF '$TEST
SET X=U
+2 IF $EXTRACT(X)=U
SET AMQQQUIT=""
QUIT
+3 IF X=""
SET X=1
WRITE " (1)"
+4 IF X?1."?"
WRITE !!,"Choose between ""and"" logic and ""or"" logic"
GOTO AND
+5 IF X=1
SET AMQQSQCV=AMQQTMPC_"~&"
QUIT
+6 IF X=2
SET AMQQSQCV=AMQQTMPC_"~!"
QUIT
+7 WRITE " ??",*7
+8 GOTO ANDQ
+9 ;
V1 WRITE !,"Value limiting condition for ",AMQQSQAN,": "
+1 IF $DATA(AMQQDISV)
WRITE AMQQDISV,"// "
+2 READ X:DTIME
+3 IF X?1."?"
NEW %A,%B
SET XQH=$ORDER(^DIC(9.2,"B","AMQQBOOL",""))
DO EN1^XQH
GOTO V1
+4 IF X=U
SET AMQQQUIT=""
QUIT
+5 IF X=""
IF $DATA(AMQQDISV)
SET X=AMQQDISV
KILL AMQQDISV
+6 IF X["NOT"!(X["'")
DO NOT
+7 IF X=""
SET AMQQSQQT=""
QUIT
+8 SET DIC="^AMQQ(5,"
+9 SET DIC(0)="ES"
+10 SET DIC("S")="I $P(^(0),U,21)=17"
+11 SET D="C"
+12 DO IX^DIC
+13 KILL DIC
+14 IF Y=-1
WRITE " ??",*7
GOTO V1
VA SET AMQQCOND=+Y
+1 SET AMQQNOCO=$PIECE(^AMQQ(5,+Y,0),U,8)
+2 SET (AMQQCONM,AMQQDISV)=$PIECE(Y,U,2)
+3 SET AMQQSQCT="B"
+4 SET AMQQSQVV=""
+5 IF AMQQNOCO=2
IF $DATA(AMQQNOT)
KILL AMQQDISV,AMQQNOT
WRITE " ??",*7
GOTO V1
+6 IF $DATA(AMQQNOT)
SET AMQQDISV="NOT "_AMQQDISV
+7 SET AMQQSYMB=$PIECE(^AMQQ(5,+Y,0),U,6)
+8 IF $DATA(AMQQNOT)
SET AMQQSYMB="'"_AMQQSYMB
KILL AMQQNOT
+9 DO COMPN^AMQQAV0
+10 IF $DATA(AMQQQUIT)
QUIT
+11 IF AMQQNOCO=2
GOTO V2
+12 IF '$DATA(AMQQCOMP)
GOTO V1
+13 IF AMQQCOMP=""
GOTO V1
+14 IF $DATA(AMQQQUIT)
QUIT
+15 SET AMQQTMPC=AMQQSYMB_":"_AMQQCOMP
+16 QUIT
V2 IF AMQQCOMP=""
GOTO V1
+1 SET AMQQTMPC="'<:"_$PIECE(AMQQCOMP,";")_":'>:"_$PIECE(AMQQCOMP,";",2)
+2 QUIT
+3 ;
NOT IF $EXTRACT(X,1,4)="NOT "
SET X=$EXTRACT(X,5,99)
SET AMQQNOT=""
QUIT
+1 IF $EXTRACT(X)="'"
SET X=$EXTRACT(X,2,99)
SET AMQQNOT=""
QUIT
+2 SET %=$LENGTH(X)
+3 IF $EXTRACT(X,%-3,%)=" NOT"
SET X=$EXTRACT(X,1,%-4)
SET AMQQNOT=""
+4 QUIT
+5 ;
