AMQQSQA0.m

AMQQSQA0 ; IHS/CMI/THL - AMQQSQA SUBROUTINE...GETS ATTRIBUTE ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

FUNQ W !,AMQQSQQQ

 R X:DTIME E  S X=U

 K AMQQSVAL

 I $E(X)="\" S X=$E(X,2,999),AMQQLCOF=""

 I X="",AMQQSQFN=1,"ILG"'[AMQQSQST D WHAT

 I X="AGAIN" W ! G FUNQ

 I X="ALL",AMQQSQFN=1,AMQQSQST="I" S X=""

 I X="" S AMQQSQQT="QUIT" Q

 I $E(X)=U S AMQQQUIT="" Q

 I X?1."?",AMQQSQSN=378 S X="AF^29" D EN1^AMQQHELP G FUNQ

 I $D(AMQQSQDV),X?1."?" D EN2^AMQQHEL2 G FUNQ

 I $D(AMQQGVF)!($G(AMQQSQSN)=226),X?1."?" S X="AF^17" D ^AMQQHELP G FUNQ

 I X="?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQHELP","")) D EN1^XQH G FUNQ

 I X?4."?" N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQANAL","")) D EN1^XQH G FUNQ

 I X?2.3"?",$D(AMQQSQCF) N %A,%B S XQH=$O(^DIC(9.2,"B","AMQQBOOL","")) D EN1^XQH G FUNQ

 I X="??" D EN1^AMQQHEL2 G FUNQ

TEMPLOOK I X="????",AMQQCCLS="P" D ITEM^AMQQHELP G FUNQ

 I X[" ",$E(X,$L(X))?1N S AMQQSVAL=$P(X," ",$L(X," ")),X=$P(X," ",1,$L(X," ")-1)

 I "><="[$E(X) S X=$TR(X," ","") I +$E(X,2,9) S AMQQSVAL=$E(X,2,99),X=$E(X)

EN1 ; ENTRY POINT FROM AMQQQ1

 I X["NOT"!(X["'") D NOT I X="" G FUNQ

 I X="VISIT" W !!,"Enter a specific VISIT characteristic like: LOCATION, CLINIC, PROVIDER etc.",!! G FUNQ

ADIC S DIC="^AMQQ(5,"

 S DIC(0)="ES"

 S D="C"

 S DIC("S")="I +Y<1000"

 I $D(AMQQXX),$D(AMQQNECO) S DIC(0)=""

 D ^AMQQSQAC

 D IX^DIC

 K DIC

SY I +Y=315!(+Y=35) D ^AMQQSQP Q:$D(AMQQQUIT)  G FUNQ

 I Y'=-1,AMQQCCLS="V",'$D(AMQQXX),$P(^AMQQ(5,+Y,0),U,20)="M" D NOVM G FUNQ

 I $D(AMQQSQNT),"EV"[AMQQSQST,$P(^AMQQ(5,+Y,0),U,20)="B",Y["BETWEEN" S X="",Y=-1,AMQQSQFN=1 K AMQQSQNT

 I Y=-1 D SPEC I '$D(Y) Q

 I Y=-1,$D(AMQQXX) S AMQQFAIL=10 Q

 I Y=-1 W "  ??",*7,! K AMQQSQNT G FUNQ

 I $P(Y,U,2)="VALUE" W !,"OK, enter the logical condition to be applied to the attribue ""VALUE""...",! G FUNQ

 I $P(^AMQQ(5,+Y,0),U,4)=99 W !,"Enter the specific name of the ",$P($P(Y,U,2),",") W !! G FUNQ

 I $P(^AMQQ(5,+Y,0),U,5)=9 D EN1^AMQQATAL I $D(AMQQNOL) K AMQQNOL S Y=-1 K AMQQSQNT G FUNQ

 S %=^AMQQ(5,+Y,0),%=$P(%,U,5) I % S:%=9 %=+Y+($J/100000) S %=^AMQQ(1,%,0),%=$P(%,U,5) I %=7 S AMQQSQRD=""

 I $D(AMQQZSQL),+Y S %=AMQQZSQL K AMQQSQZL S ^UTILITY("AMQQ",$J,"SQXL",+%,$P(%,U,2),$P(%,U,3))=""

 I AMQQSQST="V",$P(^AMQQ(5,+Y,0),U,20)="B" D ^AMQQSQVS G:('$D(AMQQQUIT)&($G(AMQQSQCV)="")) FUNQ Q

 I AMQQSQST="E",$P(^AMQQ(5,+Y,0),U,20)="B" S AMQQDISV=$P(Y,U,2) D ^AMQQSQBP G:('$D(AMQQQUIT)&($G(AMQQSQCV)="")) FUNQ Q

 Q

 ;

NOT I $E(X,1,4)="NOT " S X=$E(X,5,99),AMQQSQNT="" Q

 I $E(X)="'" S X=$E(X,2,99),AMQQSQNT="" Q

 S %=$L(X)

 I $E(X,%-3,%)=" NOT" S X=$E(X,1,%-4),AMQQSQNT=""

 Q

 ;

SPEC I X="*" W "  (All values)"

 I X="@" W "  (Null)"

SCK ; ENTRY POINT FROM AMQQSQA

 S Z="ANY;*;ALL;EXISTS;BLANK;EMPTY;NULL;@"

 F I=1:1 S %=$P(Z,";",I) Q:%=""  I X=$E(%,1,$L(X)) W $E(%,$L(X)+1,99) S X=% D S1 G SCKEXIT

 I $G(AMQQSQST)="Q",$L(X)>2 S %=$E(X,1,3) F I=1:1 S Z=$P("POS^ABN^NEG^NML^NOR",U,I) Q:Z=""  I Z=% S AMQQSVAL=$S($E(Z)="N":"NEG",1:"POS"),Y="72^IS" G SCKEXIT

 I $G(AMQQSQST)="S",$L(X)>2 D SET^AMQQSQA1 G SCKEXIT

SCKEXIT I $D(AMQQRECV),$G(AMQQCOMP)'="" S $P(AMQQRECV,U,11)=$P(AMQQCOMP,";",4)

 Q

 ;

S1 S X=$S(I=1:"ANY",I<5:"ALL",1:"NULL")

 K Y

 I AMQQSQST="I" S $P(AMQQCOMP,";",5)=X,AMQQSQQT="" Q

 I X'="NULL",$G(AMQQCOMP)'=";;"!($G(AMQQSQFN)>1) S Y=-1 Q

 I $D(AMQQSQNT),X="NULL" S X="EXISTS" K AMQQSQNT W " = ",X

 I $D(AMQQSQNT),X="EXISTS" S X="NULL" K AMQQSQNT W " = ",X

 I $D(AMQQNMAS),X'="NULL" S Y=-1 Q

 I $G(AMQQCOMP)?1.";",'$D(^UTILITY("AMQQ",$J,"SQ",$S($D(AMQQSQNN):AMQQSQNN,1:"ZZZ"))) S $P(AMQQCOMP,";",4)=X,AMQQSQCV=AMQQCOMP,AMQQSQQT="" Q

 S AMQQSQCV=AMQQCOMP

 S AMQQSQQT=""

 S AMQQSQNN=+$G(AMQQSQNN)

 S:$D(AMQQFSQN) ^UTILITY("AMQQ",$J,"SQ",AMQQSQNN,X)=""

 I X="NULL",'$D(AMQQFSQN) S AMQQFSQX=""

 I X="NULL",$G(AMQQSQAA),$D(AMQQSQGF) S ^UTILITY("AMQQ",$J,$S(AMQQUSQL>1:"SQXS",1:"SQXQ"),AMQQSQAA,AMQQSQNN)=""

 I $D(AMQQYYMI) S AMQQYYMS="" Q

 I '$D(AMQQXX) D ^AMQQSQL

 Q

 ;

NOVM W !!,"Sorry, """,$P(Y,U,2),""" should be entered as a new attribute of VISIT"

 W !,"and not a subquery of """,AMQQATNM,""""

 W !!,*7

 Q

 ;

WHAT S DIR(0)="SO^1:WHOOPS...let me try again;2:"_$S($G(AMQQONE)="":("FIND ALL "_AMQQCNAM_" who have a "_AMQQSQAN_" recorded"),1:("SHOW every "_AMQQSQAN_" for "_AMQQONE))_";3:EXIT"

 S DIR("A")=$C(10)_"     What do you want to do"

 S DIR("B")=1,DIR("?")=""

 D ^DIR

 K DIR

 I $D(DUOUT)+$D(DTOUT)+$D(DIRUT) K DTOUT,DIRUT,DTOUT S X="" Q

 S X=$S(Y=1:"AGAIN",Y=2:"ALL",Y=3:"^",1:"")

 Q

 ;

AMQQSQA0  ; IHS/CMI/THL - AMQQSQA SUBROUTINE...GETS ATTRIBUTE ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

FUNQ       WRITE !,AMQQSQQQ

 +1        READ X:DTIME

          IF '$TEST

               SET X=U

 +2        KILL AMQQSVAL

 +3        IF $EXTRACT(X)="\"

               SET X=$EXTRACT(X,2,999)

               SET AMQQLCOF=""

 +4        IF X=""

               IF AMQQSQFN=1

                   IF "ILG"'[AMQQSQST

                       DO WHAT

 +5        IF X="AGAIN"

               WRITE !

               GOTO FUNQ

 +6        IF X="ALL"

               IF AMQQSQFN=1

                   IF AMQQSQST="I"

                       SET X=""

 +7        IF X=""

               SET AMQQSQQT="QUIT"

               QUIT 

 +8        IF $EXTRACT(X)=U

               SET AMQQQUIT=""

               QUIT 

 +9        IF X?1."?"

               IF AMQQSQSN=378

                   SET X="AF^29"

                   DO EN1^AMQQHELP

                   GOTO FUNQ

 +10       IF $DATA(AMQQSQDV)

               IF X?1."?"

                   DO EN2^AMQQHEL2

                   GOTO FUNQ

 +11       IF $DATA(AMQQGVF)!($GET(AMQQSQSN)=226)

               IF X?1."?"

                   SET X="AF^17"

                   DO ^AMQQHELP

                   GOTO FUNQ

 +12       IF X="?"

               NEW %A,%B

               SET XQH=$ORDER(^DIC(9.2,"B","AMQQHELP",""))

               DO EN1^XQH

               GOTO FUNQ

 +13       IF X?4."?"

               NEW %A,%B

               SET XQH=$ORDER(^DIC(9.2,"B","AMQQANAL",""))

               DO EN1^XQH

               GOTO FUNQ

 +14       IF X?2.3"?"

               IF $DATA(AMQQSQCF)

                   NEW %A,%B

                   SET XQH=$ORDER(^DIC(9.2,"B","AMQQBOOL",""))

                   DO EN1^XQH

                   GOTO FUNQ

 +15       IF X="??"

               DO EN1^AMQQHEL2

               GOTO FUNQ

TEMPLOOK   IF X="????"

               IF AMQQCCLS="P"

                   DO ITEM^AMQQHELP

                   GOTO FUNQ

 +1        IF X[" "

               IF $EXTRACT(X,$LENGTH(X))?1N

                   SET AMQQSVAL=$PIECE(X," ",$LENGTH(X," "))

                   SET X=$PIECE(X," ",1,$LENGTH(X," ")-1)

 +2        IF "><="[$EXTRACT(X)

               SET X=$TRANSLATE(X," ","")

               IF +$EXTRACT(X,2,9)

                   SET AMQQSVAL=$EXTRACT(X,2,99)

                   SET X=$EXTRACT(X)

EN1       ; ENTRY POINT FROM AMQQQ1

 +1        IF X["NOT"!(X["'")

               DO NOT

               IF X=""

                   GOTO FUNQ

 +2        IF X="VISIT"

               WRITE !!,"Enter a specific VISIT characteristic like: LOCATION, CLINIC, PROVIDER etc.",!!

               GOTO FUNQ

ADIC       SET DIC="^AMQQ(5,"

 +1        SET DIC(0)="ES"

 +2        SET D="C"

 +3        SET DIC("S")="I +Y<1000"

 +4        IF $DATA(AMQQXX)

               IF $DATA(AMQQNECO)

                   SET DIC(0)=""

 +5        DO ^AMQQSQAC

 +6        DO IX^DIC

 +7        KILL DIC

SY         IF +Y=315!(+Y=35)

               DO ^AMQQSQP

               IF $DATA(AMQQQUIT)

                   QUIT 

               GOTO FUNQ

 +1        IF Y'=-1

               IF AMQQCCLS="V"

                   IF '$DATA(AMQQXX)

                       IF $PIECE(^AMQQ(5,+Y,0),U,20)="M"

                           DO NOVM

                           GOTO FUNQ

 +2        IF $DATA(AMQQSQNT)

               IF "EV"[AMQQSQST

                   IF $PIECE(^AMQQ(5,+Y,0),U,20)="B"

                       IF Y["BETWEEN"

                           SET X=""

                           SET Y=-1

                           SET AMQQSQFN=1

                           KILL AMQQSQNT

 +3        IF Y=-1

               DO SPEC

               IF '$DATA(Y)

                   QUIT 

 +4        IF Y=-1

               IF $DATA(AMQQXX)

                   SET AMQQFAIL=10

                   QUIT 

 +5        IF Y=-1

               WRITE "  ??",*7,!

               KILL AMQQSQNT

               GOTO FUNQ

 +6        IF $PIECE(Y,U,2)="VALUE"

               WRITE !,"OK, enter the logical condition to be applied to the attribue ""VALUE""...",!

               GOTO FUNQ

 +7        IF $PIECE(^AMQQ(5,+Y,0),U,4)=99

               WRITE !,"Enter the specific name of the ",$PIECE($PIECE(Y,U,2),",")

               WRITE !!

               GOTO FUNQ

 +8        IF $PIECE(^AMQQ(5,+Y,0),U,5)=9

               DO EN1^AMQQATAL

               IF $DATA(AMQQNOL)

                   KILL AMQQNOL

                   SET Y=-1

                   KILL AMQQSQNT

                   GOTO FUNQ

 +9        SET %=^AMQQ(5,+Y,0)

           SET %=$PIECE(%,U,5)

           IF %

               IF %=9

                   SET %=+Y+($JOB/100000)

               SET %=^AMQQ(1,%,0)

               SET %=$PIECE(%,U,5)

               IF %=7

                   SET AMQQSQRD=""

 +10       IF $DATA(AMQQZSQL)

               IF +Y

                   SET %=AMQQZSQL

                   KILL AMQQSQZL

                   SET ^UTILITY("AMQQ",$JOB,"SQXL",+%,$PIECE(%,U,2),$PIECE(%,U,3))=""

 +11       IF AMQQSQST="V"

               IF $PIECE(^AMQQ(5,+Y,0),U,20)="B"

                   DO ^AMQQSQVS

                   IF ('$DATA(AMQQQUIT)&($GET(AMQQSQCV)=""))

                       GOTO FUNQ

                   QUIT 

 +12       IF AMQQSQST="E"

               IF $PIECE(^AMQQ(5,+Y,0),U,20)="B"

                   SET AMQQDISV=$PIECE(Y,U,2)

                   DO ^AMQQSQBP

                   IF ('$DATA(AMQQQUIT)&($GET(AMQQSQCV)=""))

                       GOTO FUNQ

                   QUIT 

 +13       QUIT 

 +14      ;

NOT        IF $EXTRACT(X,1,4)="NOT "

               SET X=$EXTRACT(X,5,99)

               SET AMQQSQNT=""

               QUIT 

 +1        IF $EXTRACT(X)="'"

               SET X=$EXTRACT(X,2,99)

               SET AMQQSQNT=""

               QUIT 

 +2        SET %=$LENGTH(X)

 +3        IF $EXTRACT(X,%-3,%)=" NOT"

               SET X=$EXTRACT(X,1,%-4)

               SET AMQQSQNT=""

 +4        QUIT 

 +5       ;

SPEC       IF X="*"

               WRITE "  (All values)"

 +1        IF X="@"

               WRITE "  (Null)"

SCK       ; ENTRY POINT FROM AMQQSQA

 +1        SET Z="ANY;*;ALL;EXISTS;BLANK;EMPTY;NULL;@"

 +2        FOR I=1:1

               SET %=$PIECE(Z,";",I)

               IF %=""

                   QUIT 

               IF X=$EXTRACT(%,1,$LENGTH(X))

                   WRITE $EXTRACT(%,$LENGTH(X)+1,99)

                   SET X=%

                   DO S1

                   GOTO SCKEXIT

 +3        IF $GET(AMQQSQST)="Q"

               IF $LENGTH(X)>2

                   SET %=$EXTRACT(X,1,3)

                   FOR I=1:1

                       SET Z=$PIECE("POS^ABN^NEG^NML^NOR",U,I)

                       IF Z=""

                           QUIT 

                       IF Z=%

                           SET AMQQSVAL=$SELECT($EXTRACT(Z)="N":"NEG",1:"POS")

                           SET Y="72^IS"

                           GOTO SCKEXIT

 +4        IF $GET(AMQQSQST)="S"

               IF $LENGTH(X)>2

                   DO SET^AMQQSQA1

                   GOTO SCKEXIT

SCKEXIT    IF $DATA(AMQQRECV)

               IF $GET(AMQQCOMP)'=""

                   SET $PIECE(AMQQRECV,U,11)=$PIECE(AMQQCOMP,";",4)

 +1        QUIT 

 +2       ;

S1         SET X=$SELECT(I=1:"ANY",I<5:"ALL",1:"NULL")

 +1        KILL Y

 +2        IF AMQQSQST="I"

               SET $PIECE(AMQQCOMP,";",5)=X

               SET AMQQSQQT=""

               QUIT 

 +3        IF X'="NULL"

               IF $GET(AMQQCOMP)'=";;"!($GET(AMQQSQFN)>1)

                   SET Y=-1

                   QUIT 

 +4        IF $DATA(AMQQSQNT)

               IF X="NULL"

                   SET X="EXISTS"

                   KILL AMQQSQNT

                   WRITE " = ",X

 +5        IF $DATA(AMQQSQNT)

               IF X="EXISTS"

                   SET X="NULL"

                   KILL AMQQSQNT

                   WRITE " = ",X

 +6        IF $DATA(AMQQNMAS)

               IF X'="NULL"

                   SET Y=-1

                   QUIT 

 +7        IF $GET(AMQQCOMP)?1.";"

               IF '$DATA(^UTILITY("AMQQ",$JOB,"SQ",$SELECT($DATA(AMQQSQNN):AMQQSQNN,1:"ZZZ")))

                   SET $PIECE(AMQQCOMP,";",4)=X

                   SET AMQQSQCV=AMQQCOMP

                   SET AMQQSQQT=""

                   QUIT 

 +8        SET AMQQSQCV=AMQQCOMP

 +9        SET AMQQSQQT=""

 +10       SET AMQQSQNN=+$GET(AMQQSQNN)

 +11       IF $DATA(AMQQFSQN)

               SET ^UTILITY("AMQQ",$JOB,"SQ",AMQQSQNN,X)=""

 +12       IF X="NULL"

               IF '$DATA(AMQQFSQN)

                   SET AMQQFSQX=""

 +13       IF X="NULL"

               IF $GET(AMQQSQAA)

                   IF $DATA(AMQQSQGF)

                       SET ^UTILITY("AMQQ",$JOB,$SELECT(AMQQUSQL>1:"SQXS",1:"SQXQ"),AMQQSQAA,AMQQSQNN)=""

 +14       IF $DATA(AMQQYYMI)

               SET AMQQYYMS=""

               QUIT 

 +15       IF '$DATA(AMQQXX)

               DO ^AMQQSQL

 +16       QUIT 

 +17      ;

NOVM       WRITE !!,"Sorry, """,$PIECE(Y,U,2),""" should be entered as a new attribute of VISIT"

 +1        WRITE !,"and not a subquery of """,AMQQATNM,""""

 +2        WRITE !!,*7

 +3        QUIT 

 +4       ;

WHAT       SET DIR(0)="SO^1:WHOOPS...let me try again;2:"_$SELECT($GET(AMQQONE)="":("FIND ALL "_AMQQCNAM_" who have a "_AMQQSQAN_" recorded"),1:("SHOW every "_AMQQSQAN_" for "_AMQQONE))_";3:EXIT"

 +1        SET DIR("A")=$CHAR(10)_"     What do you want to do"

 +2        SET DIR("B")=1

           SET DIR("?")=""

 +3        DO ^DIR

 +4        KILL DIR

 +5        IF $DATA(DUOUT)+$DATA(DTOUT)+$DATA(DIRUT)

               KILL DTOUT,DIRUT,DTOUT

               SET X=""

               QUIT 

 +6        SET X=$SELECT(Y=1:"AGAIN",Y=2:"ALL",Y=3:"^",1:"")

 +7        QUIT 

 +8       ;