- 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 ;
