AMQQ1.m

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      ;