AMQQN1 ; IHS/CMI/THL - NATL LANGUAGE PRELIMINARY PASS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
RUN D SUBJ
W $C(13),?79,$C(13)
I '$D(AMQQFAIL),$D(AMQQNSBJ),$D(AMQQFEN2) W !!,"Sorry...You cannot change the subject of your search",!!,*7 H 3 S AMQQQUIT="",AMQQFAIL=-1 G EXIT
I '$D(AMQQNSBJ),$D(AMQQSAUT),'$D(AMQQFAIL) I $L(AMQQSAUT,U)>3 S (AMQQNSBJ,Y)=AMQQSAUT D AUTO1^AMQQ1
I $D(AMQQQUIT) G EXIT
I '$D(AMQQNSBJ) S AMQQFAIL=4 G EXIT
S AMQQSAUT=AMQQNSBJ
S AMQQCCLS="P"
EXIT ;
Q
;
SUBJ S %="LIVING PATIENTS^PATIENTS^INFANTS^FEMALES^MALES^BOYS^GIRLS^MEN^WOMEN"
F I=1:1 S A=$P(%,U,I) Q:A="" I X[A D PAT G SUBEXIT
I X'["OF " G SUBJ1
F Y=1:1 S Z=$P(X," ",Y) I Z="OF" Q
I $P(X," ",Y+3)'="" S Z=$P(X," ",Y+1,Y+3) D SB1 I $D(AMQQNSBJ) D SB2 Q
I $P(X," ",Y+2)'="" S Z=$P(X," ",Y+1,Y+2) D SB1 I $D(AMQQNSBJ) D SB2 Q
SUBJ1 I X'["'S",X'["S'" Q
F Y=1:1 S Z=$P(X," ",Y) I Z["S'"!(Z["'S") Q
I Y>2 S Z=$P(X," ",Y-2,Y) D SB1 I $D(AMQQNSBJ) D SB2 Q
S Z=$P(X," ",Y-1,Y) D SB1 I $D(AMQQNSBJ) D SB2
Q
;
SB1 S %=Z
I %["'S" S %=$P(%,"'S")_$P(%,"'S",2) G SB10
I %["S'" S %=$P(%,"S'")_"S"_$P(%,"S'",2)
SB10 W !
N X,Y,Z
S X=%,AMQQXX=""
D ^AMQQ2
I '$D(Y) W:'$D(AMQQNECO) !!,"Sorry, I'm unable to determine the SUBJECT of the query...The search is aborted",!!,*7 S AMQQFAIL=1 Q
S AMQQNSBJ=Y
D AUTO1^AMQQ1
SUBEXIT K %,A,Z
Q
;
SB2 S Z=Z_" "
S X=$P(X,Z)_$P(X,Z,2,99)
I X["OF " S X=$P(X,"OF ")
Q
;
PAT S X=$P(X,A)_" "_$P(X,A,2)
F Q:X'[" " S X=$P(X," ")_" "_$P(X," ",2,99)
I $E(X)=" " S X=$E(X,2,240)
I X[" OF " S X=$P(X," OF ",1)_" "_$P(X," OF ",2,99)
S AMQQNSBJ=A
S AMQQCCLS="P"
N X
S X=A
S AMQQXX=""
D AUTO^AMQQ1
Q
;
AMQQN1 ; IHS/CMI/THL - NATL LANGUAGE PRELIMINARY PASS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
RUN DO SUBJ
+1 WRITE $CHAR(13),?79,$CHAR(13)
+2 IF '$DATA(AMQQFAIL)
IF $DATA(AMQQNSBJ)
IF $DATA(AMQQFEN2)
WRITE !!,"Sorry...You cannot change the subject of your search",!!,*7
HANG 3
SET AMQQQUIT=""
SET AMQQFAIL=-1
GOTO EXIT
+3 IF '$DATA(AMQQNSBJ)
IF $DATA(AMQQSAUT)
IF '$DATA(AMQQFAIL)
IF $LENGTH(AMQQSAUT,U)>3
SET (AMQQNSBJ,Y)=AMQQSAUT
DO AUTO1^AMQQ1
+4 IF $DATA(AMQQQUIT)
GOTO EXIT
+5 IF '$DATA(AMQQNSBJ)
SET AMQQFAIL=4
GOTO EXIT
+6 SET AMQQSAUT=AMQQNSBJ
+7 SET AMQQCCLS="P"
EXIT ;
+1 QUIT
+2 ;
SUBJ SET %="LIVING PATIENTS^PATIENTS^INFANTS^FEMALES^MALES^BOYS^GIRLS^MEN^WOMEN"
+1 FOR I=1:1
SET A=$PIECE(%,U,I)
IF A=""
QUIT
IF X[A
DO PAT
GOTO SUBEXIT
+2 IF X'["OF "
GOTO SUBJ1
+3 FOR Y=1:1
SET Z=$PIECE(X," ",Y)
IF Z="OF"
QUIT
+4 IF $PIECE(X," ",Y+3)'=""
SET Z=$PIECE(X," ",Y+1,Y+3)
DO SB1
IF $DATA(AMQQNSBJ)
DO SB2
QUIT
+5 IF $PIECE(X," ",Y+2)'=""
SET Z=$PIECE(X," ",Y+1,Y+2)
DO SB1
IF $DATA(AMQQNSBJ)
DO SB2
QUIT
SUBJ1 IF X'["'S"
IF X'["S'"
QUIT
+1 FOR Y=1:1
SET Z=$PIECE(X," ",Y)
IF Z["S'"!(Z["'S")
QUIT
+2 IF Y>2
SET Z=$PIECE(X," ",Y-2,Y)
DO SB1
IF $DATA(AMQQNSBJ)
DO SB2
QUIT
+3 SET Z=$PIECE(X," ",Y-1,Y)
DO SB1
IF $DATA(AMQQNSBJ)
DO SB2
+4 QUIT
+5 ;
SB1 SET %=Z
+1 IF %["'S"
SET %=$PIECE(%,"'S")_$PIECE(%,"'S",2)
GOTO SB10
+2 IF %["S'"
SET %=$PIECE(%,"S'")_"S"_$PIECE(%,"S'",2)
SB10 WRITE !
+1 NEW X,Y,Z
+2 SET X=%
SET AMQQXX=""
+3 DO ^AMQQ2
+4 IF '$DATA(Y)
IF '$DATA(AMQQNECO)
WRITE !!,"Sorry, I'm unable to determine the SUBJECT of the query...The search is aborted",!!,*7
SET AMQQFAIL=1
QUIT
+5 SET AMQQNSBJ=Y
+6 DO AUTO1^AMQQ1
SUBEXIT KILL %,A,Z
+1 QUIT
+2 ;
SB2 SET Z=Z_" "
+1 SET X=$PIECE(X,Z)_$PIECE(X,Z,2,99)
+2 IF X["OF "
SET X=$PIECE(X,"OF ")
+3 QUIT
+4 ;
PAT SET X=$PIECE(X,A)_" "_$PIECE(X,A,2)
+1 FOR
IF X'[" "
QUIT
SET X=$PIECE(X," ")_" "_$PIECE(X," ",2,99)
+2 IF $EXTRACT(X)=" "
SET X=$EXTRACT(X,2,240)
+3 IF X[" OF "
SET X=$PIECE(X," OF ",1)_" "_$PIECE(X," OF ",2,99)
+4 SET AMQQNSBJ=A
+5 SET AMQQCCLS="P"
+6 NEW X
+7 SET X=A
+8 SET AMQQXX=""
+9 DO AUTO^AMQQ1
+10 QUIT
+11 ;
