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 ;
