AMQQ1 ; IHS/CMI/THL - AMQQ SUBROUTINE...GETS GOAL OF QUERY; ; 26 Oct 2010 9:07 AM
;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
;IHS/CMI/LAB - added ability to choose a CMS register
;-----
GOAL I '$D(AMQQOPT) S AMQQOPT="SEARCH"
I $D(AMQQEN31),AMQQEN31=+AMQQEN31 D SWAP Q
G1 W !,$S(AMQQOPT="FAST":"Tell me what you want: ",1:"What is the subject of your search? LIVING PATIENTS // ")
R X:DTIME E S AMQQQUIT=1 Q
I X[" " W " ??",*7 G GOAL
I $L(X," ")>4 S AMQQQSTG=X D ^AMQQN S AMQQQUIT="" K AMQQXX G EXIT
I $G(AMQQOPT)="FAST",$E(X)'="?" S:"^"[X AMQQQUIT=1 G:"^"[X EXIT S AMQQQSTG=X D ^AMQQN S AMQQQUIT="" K AMQQXX G EXIT
I X="",AMQQOPT="QUICK" S X=U
I X="HELP" S X="?"
I X="??" D LISTG^AMQQHELP G GOAL
I $E(X)=U S AMQQQUIT=1 G EXIT
I X?1."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQSUBJECT","")) D EN1^XQH G GOAL
I X="" S X="LIVING PATIENTS"
I $E(X)'?1UN W " ??",*7 G GOAL
;I X="LIVING PATIENTS"!(X="REGISTER") D QAPT^AMQQAPT W !! S X="LIVING PATIENTS"
D AUTO
I Y'=-1 D Q
.NEW AMQQLLLL S AMQQLLLL=""
.I $P(^AMQQ(5,+Y,0),U,9)="P" S AMQQLLLL=Y D QAPT^AMQQAPT W !! S Y=AMQQLLLL
.D NEW Q
D ^AMQQ2
AUTO1 ; ENTRY POINT FOR DFN SUBJECT
N X
I $D(AMQQFAIL) K AMQQFAIL G GOAL
D PERSON
Q
;
EXIT K X,%,I
Q
;
AUTO ; ENTRY POINT FROM AMQQQ
S DIC(0)="E"
S DIC="^AMQQ(5,"
S DIC("S")="I $P(^(0),U,9)'="""""
S D="C"
I $D(AMQQNECO) S DIC(0)=""
E I $D(AMQQXX) S DIC(0)="ES"
D IX^DIC
K DIC
Q
;
LISTG S DIC="^AMQQ(5,"
S DIC(0)="E"
S D="GOAL"
S DZ="??"
D DQ^DICQ
K DIC,DZ,D,DIX,DIY,DD,%H,%,DO,X,Y
Q
;
PERSON ; ENTRY POINT FROM AMQQN1 THE NATURAL LANGUAGE ROUTINE
S X=$P(Y,U,3)
S Y=$P(Y,U,4)
S Y=$P(Y,",",2)_" "_$P(Y,",")
S AMQQQ="8^NAME^L^^9^1^EQUAL TO^=^"_X_"^^100^W ?6,""NAME = "","""_Y_"""^1^0^=;"_X_";"
S ^UTILITY("AMQQ",$J,"Q",1)=AMQQQ
S AMQQUATN=2
S AMQQUNBC=1
I '$D(AMQQXX) S ^UTILITY("AMQQ",$J,"LIST",2)="W ?6,""NAME = "_Y_""""
S ^UTILITY("AMQQ",$J,"WEIGHT",-99,1)=""
S AMQQONE=Y
S Y="1^PATIENT"
D NEW
I $D(AMQQXX) Q
S AMQQILIN=2
D LIST^AMQQ
Q
;
NEW ; ENTRY POINT FROM AMQQN1
I $D(^AMQQ(5,+Y,2)) S AMQQATN=+Y,AMQQCCLS=$P(^AMQQ(5,+Y,0),U,9) D SCRIPT Q
N1 S AMQQCNAM=$P(Y,U,2)
S (X,AMQQCCLS)=$P(^AMQQ(5,+Y,0),U,9)
I AMQQCNAM["RANDOM" S AMQQRSAF=""
I $D(AMQQXX) Q
I AMQQCNAM="REGISTER" D ^AMQQREG Q
S AMQQILIN=1
S X=$S(X="P":"PATIENTS",X="H":"PROVIDER",X="V":"VISIT",1:"CLINICAL DATA")
I $D(AMQQONE),AMQQONE'="" S X=AMQQONE
S %="W ?3"
S %=%_",@AMQQRV,""Subject of search: "_X_""",@AMQQNV" G SETNG
S %=%_","""_X_""""
SETNG S ^UTILITY("AMQQ",$J,"LIST",.1)=%
Q
;
SCRIPT ; ENTRY POINT FROM AMQQATA
S Z=0
I ^AMQQ(5,AMQQATN,2,1,0)?1U S X=^(0),Z=1 D N1
SCR1 ; ENTRY POINT FROM AMQQATA
S AMQQI=Z
F S AMQQI=$O(^AMQQ(5,AMQQATN,2,AMQQI)) Q:'AMQQI S AMQQQ=^(AMQQI,0) D:$P(AMQQQ,U,3)="D" SCRDT D ^AMQQATR,^AMQQATL,^AMQQATS S AMQQUATN=AMQQUATN+1,AMQQUNBC=AMQQUNBC+1
K AMQQATN,Z,AMQQI
D LIST^AMQQ
Q
;
SCRDT N %,X,Y,Z,A,B S %=$P(AMQQQ,U,9)
I %["NULL"!(%["ANY")!(%["ALL")!(%["EXIST") Q
S Y=$P(%,";"),Z=$P(%,";",2)
D SCRDT1
I B'="" S A=A_";"_B
S $P(AMQQQ,U,9)=A
Q
;
SCRDT1 S A=Y
S B=Z
I 'Y S X=Y D ^%DT S A=Y
I Z=""!(+Z) Q
S X=Z
D ^%DT
S B=Y
Q
;
SWAP S AMQQCCLS="P"
S AMQQCNAM="PATIENTS"
S AMQQUATN=2
S AMQQILIN=0
S ^UTILITY("AMQQ",$J,"LIST",.1)="W ?3,@AMQQRV,""Subject of search: PATIENTS in the COHORT"",@AMQQNV"
S ^UTILITY("AMQQ",$J,"WEIGHT",-99,1)=""
S %=AMQQEN31
S ^UTILITY("AMQQ",$J,"Q",1)="40^COHORT^C^0^238^1^^^"_%_"^^99^^^0^"_%_";;^0"
W !!,"You will now enter criteria for conducting a search on a preexisting cohort"
W !,"of patients."
W !!
Q
;
AMQQ1 ; IHS/CMI/THL - AMQQ SUBROUTINE...GETS GOAL OF QUERY; ; 26 Oct 2010 9:07 AM
+1 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
+2 ;IHS/CMI/LAB - added ability to choose a CMS register
+3 ;-----
GOAL IF '$DATA(AMQQOPT)
SET AMQQOPT="SEARCH"
+1 IF $DATA(AMQQEN31)
IF AMQQEN31=+AMQQEN31
DO SWAP
QUIT
G1 WRITE !,$SELECT(AMQQOPT="FAST":"Tell me what you want: ",1:"What is the subject of your search? LIVING PATIENTS // ")
+1 READ X:DTIME
IF '$TEST
SET AMQQQUIT=1
QUIT
+2 IF X[" "
WRITE " ??",*7
GOTO GOAL
+3 IF $LENGTH(X," ")>4
SET AMQQQSTG=X
DO ^AMQQN
SET AMQQQUIT=""
KILL AMQQXX
GOTO EXIT
+4 IF $GET(AMQQOPT)="FAST"
IF $EXTRACT(X)'="?"
IF "^"[X
SET AMQQQUIT=1
IF "^"[X
GOTO EXIT
SET AMQQQSTG=X
DO ^AMQQN
SET AMQQQUIT=""
KILL AMQQXX
GOTO EXIT
+5 IF X=""
IF AMQQOPT="QUICK"
SET X=U
+6 IF X="HELP"
SET X="?"
+7 IF X="??"
DO LISTG^AMQQHELP
GOTO GOAL
+8 IF $EXTRACT(X)=U
SET AMQQQUIT=1
GOTO EXIT
+9 IF X?1."?"
NEW %A,%B
SET XQH=$ORDER(^DIC(9.2,"B","AMQQSUBJECT",""))
DO EN1^XQH
GOTO GOAL
+10 IF X=""
SET X="LIVING PATIENTS"
+11 IF $EXTRACT(X)'?1UN
WRITE " ??",*7
GOTO GOAL
+12 ;I X="LIVING PATIENTS"!(X="REGISTER") D QAPT^AMQQAPT W !! S X="LIVING PATIENTS"
+13 DO AUTO
+14 IF Y'=-1
Begin DoDot:1
+15 NEW AMQQLLLL
SET AMQQLLLL=""
+16 IF $PIECE(^AMQQ(5,+Y,0),U,9)="P"
SET AMQQLLLL=Y
DO QAPT^AMQQAPT
WRITE !!
SET Y=AMQQLLLL
+17 DO NEW
QUIT
End DoDot:1
QUIT
+18 DO ^AMQQ2
AUTO1 ; ENTRY POINT FOR DFN SUBJECT
+1 NEW X
+2 IF $DATA(AMQQFAIL)
KILL AMQQFAIL
GOTO GOAL
+3 DO PERSON
+4 QUIT
+5 ;
EXIT KILL X,%,I
+1 QUIT
+2 ;
AUTO ; ENTRY POINT FROM AMQQQ
+1 SET DIC(0)="E"
+2 SET DIC="^AMQQ(5,"
+3 SET DIC("S")="I $P(^(0),U,9)'="""""
+4 SET D="C"
+5 IF $DATA(AMQQNECO)
SET DIC(0)=""
+6 IF '$TEST
IF $DATA(AMQQXX)
SET DIC(0)="ES"
+7 DO IX^DIC
+8 KILL DIC
+9 QUIT
+10 ;
LISTG SET DIC="^AMQQ(5,"
+1 SET DIC(0)="E"
+2 SET D="GOAL"
+3 SET DZ="??"
+4 DO DQ^DICQ
+5 KILL DIC,DZ,D,DIX,DIY,DD,%H,%,DO,X,Y
+6 QUIT
+7 ;
PERSON ; ENTRY POINT FROM AMQQN1 THE NATURAL LANGUAGE ROUTINE
+1 SET X=$PIECE(Y,U,3)
+2 SET Y=$PIECE(Y,U,4)
+3 SET Y=$PIECE(Y,",",2)_" "_$PIECE(Y,",")
+4 SET AMQQQ="8^NAME^L^^9^1^EQUAL TO^=^"_X_"^^100^W ?6,""NAME = "","""_Y_"""^1^0^=;"_X_";"
+5 SET ^UTILITY("AMQQ",$JOB,"Q",1)=AMQQQ
+6 SET AMQQUATN=2
+7 SET AMQQUNBC=1
+8 IF '$DATA(AMQQXX)
SET ^UTILITY("AMQQ",$JOB,"LIST",2)="W ?6,""NAME = "_Y_""""
+9 SET ^UTILITY("AMQQ",$JOB,"WEIGHT",-99,1)=""
+10 SET AMQQONE=Y
+11 SET Y="1^PATIENT"
+12 DO NEW
+13 IF $DATA(AMQQXX)
QUIT
+14 SET AMQQILIN=2
+15 DO LIST^AMQQ
+16 QUIT
+17 ;
NEW ; ENTRY POINT FROM AMQQN1
+1 IF $DATA(^AMQQ(5,+Y,2))
SET AMQQATN=+Y
SET AMQQCCLS=$PIECE(^AMQQ(5,+Y,0),U,9)
DO SCRIPT
QUIT
N1 SET AMQQCNAM=$PIECE(Y,U,2)
+1 SET (X,AMQQCCLS)=$PIECE(^AMQQ(5,+Y,0),U,9)
+2 IF AMQQCNAM["RANDOM"
SET AMQQRSAF=""
+3 IF $DATA(AMQQXX)
QUIT
+4 IF AMQQCNAM="REGISTER"
DO ^AMQQREG
QUIT
+5 SET AMQQILIN=1
+6 SET X=$SELECT(X="P":"PATIENTS",X="H":"PROVIDER",X="V":"VISIT",1:"CLINICAL DATA")
+7 IF $DATA(AMQQONE)
IF AMQQONE'=""
SET X=AMQQONE
+8 SET %="W ?3"
+9 SET %=%_",@AMQQRV,""Subject of search: "_X_""",@AMQQNV"
GOTO SETNG
+10 SET %=%_","""_X_""""
SETNG SET ^UTILITY("AMQQ",$JOB,"LIST",.1)=%
+1 QUIT
+2 ;
SCRIPT ; ENTRY POINT FROM AMQQATA
+1 SET Z=0
+2 IF ^AMQQ(5,AMQQATN,2,1,0)?1U
SET X=^(0)
SET Z=1
DO N1
SCR1 ; ENTRY POINT FROM AMQQATA
+1 SET AMQQI=Z
+2 FOR
SET AMQQI=$ORDER(^AMQQ(5,AMQQATN,2,AMQQI))
IF 'AMQQI
QUIT
SET AMQQQ=^(AMQQI,0)
IF $PIECE(AMQQQ,U,3)="D"
DO SCRDT
DO ^AMQQATR
DO ^AMQQATL
DO ^AMQQATS
SET AMQQUATN=AMQQUATN+1
SET AMQQUNBC=AMQQUNBC+1
+3 KILL AMQQATN,Z,AMQQI
+4 DO LIST^AMQQ
+5 QUIT
+6 ;
SCRDT NEW %,X,Y,Z,A,B
SET %=$PIECE(AMQQQ,U,9)
+1 IF %["NULL"!(%["ANY")!(%["ALL")!(%["EXIST")
QUIT
+2 SET Y=$PIECE(%,";")
SET Z=$PIECE(%,";",2)
+3 DO SCRDT1
+4 IF B'=""
SET A=A_";"_B
+5 SET $PIECE(AMQQQ,U,9)=A
+6 QUIT
+7 ;
SCRDT1 SET A=Y
+1 SET B=Z
+2 IF 'Y
SET X=Y
DO ^%DT
SET A=Y
+3 IF Z=""!(+Z)
QUIT
+4 SET X=Z
+5 DO ^%DT
+6 SET B=Y
+7 QUIT
+8 ;
SWAP SET AMQQCCLS="P"
+1 SET AMQQCNAM="PATIENTS"
+2 SET AMQQUATN=2
+3 SET AMQQILIN=0
+4 SET ^UTILITY("AMQQ",$JOB,"LIST",.1)="W ?3,@AMQQRV,""Subject of search: PATIENTS in the COHORT"",@AMQQNV"
+5 SET ^UTILITY("AMQQ",$JOB,"WEIGHT",-99,1)=""
+6 SET %=AMQQEN31
+7 SET ^UTILITY("AMQQ",$JOB,"Q",1)="40^COHORT^C^0^238^1^^^"_%_"^^99^^^0^"_%_";;^0"
+8 WRITE !!,"You will now enter criteria for conducting a search on a preexisting cohort"
+9 WRITE !,"of patients."
+10 WRITE !!
+11 QUIT
+12 ;
