AMQQCMPM ; IHS/CMI/THL - RESOLVES DISPLAY OF MULTIPLE MULTIPLES ; 12 Mar 2015 1:09 PM
;;2.0;IHS PCC SUITE;**4,5,11**;MAY 14, 2009;Build 58
MM N N,X,Y,Z,%,DIC,A,B,I
K AMQQDVQU
D ALL
I $D(AMQQQUIT) G EXIT
F I=1:1:($L(AMQQMULX,U)-2) S N=$P(AMQQMULX,U,I) D MM1
EXIT K AMQQMULX
Q
;
MM1 ;
I $D(^UTILITY("AMQQ",$J,"Q",N))=1 D Q
.S %=$P(^UTILITY("AMQQ",$J,"Q",N),U,9)
.S:+^UTILITY("AMQQ",$J,"Q",N)'=758 $P(^UTILITY("AMQQ",$J,"Q",N),U,14)=1
.Q:%["NULL"!(%["INVERSE")
.S $P(%,";",4)="EXISTS",$P(^UTILITY("AMQQ",$J,"Q",N),U,9)=%
F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"Q",N,%)) Q:'% S Z=%
S ^UTILITY("AMQQ",$J,"Q",N,Z+1)=Y_"^U^EXIST^AMQQF^3^^0^0",$P(^UTILITY("AMQQ",$J,"Q",N),U,14)=1
Q
;
ALL S %=$L(AMQQMULX,U)
S %=$P(AMQQMULX,U,%-1)
S AMQQMULN=%
S AMQQOBJ=$P(^UTILITY("AMQQ",$J,"Q",%),U,2)
S AMQQOBJS=AMQQOBJ_$S($E(AMQQOBJ,$L(AMQQOBJ))?1P!($E(AMQQOBJ,$L(AMQQOBJ))="S"):"",1:"S")
S AMQQMULL=AMQQMULN
I AMQQCCLS="V" G ALLEXIT
F %="NULL","INVERSE" I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,9)[% D SPEC G ALLEXIT
I $D(AMQQXX) S X=$S($D(AMQQXX("FORMAT")):AMQQXX("FORMAT"),1:2) G X1
S %=$G(AMQV("OPTION"))
S %=$S(%="MAIL":2,%="HSUM":2,%="WORK":1,%="WORK":1,%="TIME":1,%="MONTH":1,1:0)
I % S X=% G @("X"_X)
I $D(^UTILITY("AMQQ",$J,"SQXQ",AMQQMULN)) S Z=$O(^(AMQQMULN,"")) I Z F %="NULL","ALL","EXISTS","ANY","INVERSE" I $D(^UTILITY("AMQQ",$J,"SQ",Z,%)) S X=2 S:Z'="ALL"&(Z'="ANY") $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,14)=1 G ALLEXIT
I $D(^UTILITY("AMQQ",$J,"Q",AMQQMULN,1)),$P(^(1),U,2)="NULL" G ALLEXIT
I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,9)["ANY" G ALLEXIT
I $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,3)="I" S %=$P(^(AMQQMULN),U,9) I $P(%,";",5)=2 G ALLEXIT
S %=$P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,13)
I %,%'=4 G ALLEXIT
S X=+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULN))
I X,$D(^AMQQ(1,X,9)),$P(^(9),U)'="" S AMQQN=^(9) D MULT G ALLEXIT
I $D(AMQQONE) S X=1 G X1
I AMQV("OPTION")="COHORT" S X=2 G X2
S A="@AMQQRV,""PATIENTS"",@AMQQNV"
S B="@AMQQRV,"""_AMQQOBJS_""",@AMQQNV"
S %="list"
I $G(AMQV("OPTION"))="COUNT" S %="count"
W !!,"You have 2 options for ",%,"ing ",AMQQOBJS," =>",!
W !?5,"1) For ea. patient, ",%," all ",@B," which match your",!?8,"criteria"
W !?5,"2) ",$S(AMQV("OPTION")="COUNT":"Count",1:"List")," all ",@A," with ",AMQQOBJS," meeting your criteria,",!?8,"but do not ",%," the individual values of ea. ",AMQQOBJ,!
ALLQ W !,"Your choice (1 or 2): 1// "
R X:DTIME E S X=U
I $E(X)=U S AMQQQUIT="" G ALLEXIT
I X="" S X=1 W " (1)"
I X?1."?" D HELP G ALL
X1 I X=1 D:$D(^UTILITY("AMQQ",$J,"Q",AMQQMULN)) X11 G ALLEXIT
X2 I X=2 S AMQQMULX=AMQQMULX_AMQQMULN_U G ALLEXIT
W " ??",*7
G ALLQ
ALLEXIT K AMQQMULN,AMQQOBJ,AMQQOBJS,A,B,AMQQN,AMQQNO3
Q
;
CD W !!,"You have 2 options for counting ",AMQQN(1)," =>",!
W !?5,"1) Count all specified ",AMQQN(2)," for all patients"
S AMQQI=0
F S AMQQI=$O(^UTILITY("AMQQ",$J,"LIST",AMQQI)) Q:'AMQQI!($D(AMQQSTP)) I ^(AMQQI)[$E(AMQQN(1),1,($L(AMQQN(1))-2)) S:$D(AMQQHIT) AMQQSTP="" S AMQQHIT=""
W !?5,"2) Count PATIENTS with at least one of the ",$S('$D(AMQQSTP):AMQQN(1),1:AMQQN(1)_" in each query"),!,?7," you specified",!
K AMQQSTP,AMQQHIT
CDQ W !,"Your choice (1-2): 1// "
R X:DTIME E S X=U
I X=2 S X=3 Q
I X="" Q
I X=1 Q
I X?1."?" D HELP G CD
I $E(X)=U Q
W " ??",*7
G CDQ
;
HELP N %A,%B
S XQH=$O(^DIC(9.2,"B","AMQQLIST",""))
D EN1^XQH
Q
;
MULT F I=1:1:3 S AMQQN(I)=$P(AMQQN,U,I)
I AMQV("OPTION")="COHORT" S X=3 G X3
S %=$P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,15)
S %=$P(%,";",4)
I %,$D(^UTILITY("AMQQ TAX",$J,%,"--"))!$D(^UTILITY("AMQQ TAX",$J,%,"-")) Q
I AMQV("OPTION")="COUNT" D CD G DXQA
I $D(AMQQONE) S X=2 G DXQA
W !!,"You have ",$S('$D(AMQQNO3):3,1:2)," options for listing ",AMQQN(1)," =>",!
W !?5,"1) List every ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," meeting search criteria."
W !?5,"2) List every ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," and ",$S(AMQQN(3)="PROVIDER NARRATIVES":"PROVIDER NARRATIVE",1:AMQQN(3))," meeting search criteria." I $D(AMQQNO3) W !
I '$D(AMQQNO3) W !?5,"3) List all PATIENTS with ",$S(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," you specified, but DO NOT list",!?8,"individual ",$S(AMQQN(2)="ICD9 CODES":"ICD CODES",1:AMQQN(2))," or ",AMQQN(3)," (FASTEST OPTION!!)",!
W ?8,"(Displays UNDUPLICATED list of PATIENTS)",!
DXQ W !,"Your choice (1-",(3-$D(AMQQNO3)),"): 1// "
R X:DTIME E S X=U
DXQA I $E(X)=U S AMQQQUIT="" G DXEXIT
I X="" S X=1 W " (1)"
I X?1."?" D HELP G MULT
DXQA1 I X=2 S %=+^UTILITY("AMQQ",$J,"Q",AMQQMULN) D Q
.I %>999 D EXP Q
.S:$D(^AMQQ(1,%+.1)) $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,1)=%+.1 S $P(^(AMQQMULN),U,18)=1,$P(^(AMQQMULN),U,14)=3
.Q
X11 ;IHS/CMI/LAB - addded question about qualifiers
;I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1 Q ;,$P(^(AMQQMULN),U,14)=2 Q
K AMQQDVQU
I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1
I $P(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULL)),0),U,3)=9000010.01 D
.NEW X
.K DIR,AMQQDVQU
.S DIR(0)="Y",DIR("A")="Do you want to display associated measurement qualifiers with each "_AMQQOBJS,DIR("B")="N",DIR("?")="If you want to display the qualifiers (e.g. Oral, Left Arm, etc) enter Y for Yes." KILL DA D ^DIR KILL DIR
.I $D(DIRUT) K AMQQDVQU Q
.I 'Y K AMQQDVQU Q
.S AMQQDVQU=1
.Q
I X=1 Q
X3 I '$D(AMQQNO3),X=3 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=2,AMQQMULX=AMQQMULX_AMQQMULN_U Q
W " ??",*7
G DXQ
DXEXIT K X
Q
;
SPEC I $G(AMQV("OPTION"))'="COHORT",%="ALL"!(%="ANY"),$D(^AMQQ(1,+$G(^UTILITY("AMQQ",$J,"Q",AMQQMULN)),9)) S:%="ANY" AMQQNO3="" S AMQQN=^(9) D MULT Q
S X=2-((%="ALL")!(%="ANY"))
D DXQA1
Q
;
EXP ; EXPANDED LAB OUTPUT
N X,Y,Z
S $P(^AMQQ(1,%,4,1,0),U,5,6)="30^30",^(1)="D EXP^AMQQDO"
Q
;
AMQQCMPM ; IHS/CMI/THL - RESOLVES DISPLAY OF MULTIPLE MULTIPLES ; 12 Mar 2015 1:09 PM
+1 ;;2.0;IHS PCC SUITE;**4,5,11**;MAY 14, 2009;Build 58
MM NEW N,X,Y,Z,%,DIC,A,B,I
+1 KILL AMQQDVQU
+2 DO ALL
+3 IF $DATA(AMQQQUIT)
GOTO EXIT
+4 FOR I=1:1:($LENGTH(AMQQMULX,U)-2)
SET N=$PIECE(AMQQMULX,U,I)
DO MM1
EXIT KILL AMQQMULX
+1 QUIT
+2 ;
MM1 ;
+1 IF $DATA(^UTILITY("AMQQ",$JOB,"Q",N))=1
Begin DoDot:1
+2 SET %=$PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,9)
+3 IF +^UTILITY("AMQQ",$JOB,"Q",N)'=758
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,14)=1
+4 IF %["NULL"!(%["INVERSE")
QUIT
+5 SET $PIECE(%,";",4)="EXISTS"
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,9)=%
End DoDot:1
QUIT
+6 FOR %=0:0
SET %=$ORDER(^UTILITY("AMQQ",$JOB,"Q",N,%))
IF '%
QUIT
SET Z=%
+7 SET ^UTILITY("AMQQ",$JOB,"Q",N,Z+1)=Y_"^U^EXIST^AMQQF^3^^0^0"
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",N),U,14)=1
+8 QUIT
+9 ;
ALL SET %=$LENGTH(AMQQMULX,U)
+1 SET %=$PIECE(AMQQMULX,U,%-1)
+2 SET AMQQMULN=%
+3 SET AMQQOBJ=$PIECE(^UTILITY("AMQQ",$JOB,"Q",%),U,2)
+4 SET AMQQOBJS=AMQQOBJ_$SELECT($EXTRACT(AMQQOBJ,$LENGTH(AMQQOBJ))?1P!($EXTRACT(AMQQOBJ,$LENGTH(AMQQOBJ))="S"):"",1:"S")
+5 SET AMQQMULL=AMQQMULN
+6 IF AMQQCCLS="V"
GOTO ALLEXIT
+7 FOR %="NULL","INVERSE"
IF $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,9)[%
DO SPEC
GOTO ALLEXIT
+8 IF $DATA(AMQQXX)
SET X=$SELECT($DATA(AMQQXX("FORMAT")):AMQQXX("FORMAT"),1:2)
GOTO X1
+9 SET %=$GET(AMQV("OPTION"))
+10 SET %=$SELECT(%="MAIL":2,%="HSUM":2,%="WORK":1,%="WORK":1,%="TIME":1,%="MONTH":1,1:0)
+11 IF %
SET X=%
GOTO @("X"_X)
+12 IF $DATA(^UTILITY("AMQQ",$JOB,"SQXQ",AMQQMULN))
SET Z=$ORDER(^(AMQQMULN,""))
IF Z
FOR %="NULL","ALL","EXISTS","ANY","INVERSE"
IF $DATA(^UTILITY("AMQQ",$JOB,"SQ",Z,%))
SET X=2
IF Z'="ALL"&(Z'="ANY")
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,14)=1
GOTO ALLEXIT
+13 IF $DATA(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN,1))
IF $PIECE(^(1),U,2)="NULL"
GOTO ALLEXIT
+14 IF $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,9)["ANY"
GOTO ALLEXIT
+15 IF $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,3)="I"
SET %=$PIECE(^(AMQQMULN),U,9)
IF $PIECE(%,";",5)=2
GOTO ALLEXIT
+16 SET %=$PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,13)
+17 IF %
IF %'=4
GOTO ALLEXIT
+18 SET X=+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN))
+19 IF X
IF $DATA(^AMQQ(1,X,9))
IF $PIECE(^(9),U)'=""
SET AMQQN=^(9)
DO MULT
GOTO ALLEXIT
+20 IF $DATA(AMQQONE)
SET X=1
GOTO X1
+21 IF AMQV("OPTION")="COHORT"
SET X=2
GOTO X2
+22 SET A="@AMQQRV,""PATIENTS"",@AMQQNV"
+23 SET B="@AMQQRV,"""_AMQQOBJS_""",@AMQQNV"
+24 SET %="list"
+25 IF $GET(AMQV("OPTION"))="COUNT"
SET %="count"
+26 WRITE !!,"You have 2 options for ",%,"ing ",AMQQOBJS," =>",!
+27 WRITE !?5,"1) For ea. patient, ",%," all ",@B," which match your",!?8,"criteria"
+28 WRITE !?5,"2) ",$SELECT(AMQV("OPTION")="COUNT":"Count",1:"List")," all ",@A," with ",AMQQOBJS," meeting your criteria,",!?8,"but do not ",%," the individual values of ea. ",AMQQOBJ,!
ALLQ WRITE !,"Your choice (1 or 2): 1// "
+1 READ X:DTIME
IF '$TEST
SET X=U
+2 IF $EXTRACT(X)=U
SET AMQQQUIT=""
GOTO ALLEXIT
+3 IF X=""
SET X=1
WRITE " (1)"
+4 IF X?1."?"
DO HELP
GOTO ALL
X1 IF X=1
IF $DATA(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN))
DO X11
GOTO ALLEXIT
X2 IF X=2
SET AMQQMULX=AMQQMULX_AMQQMULN_U
GOTO ALLEXIT
+1 WRITE " ??",*7
+2 GOTO ALLQ
ALLEXIT KILL AMQQMULN,AMQQOBJ,AMQQOBJS,A,B,AMQQN,AMQQNO3
+1 QUIT
+2 ;
CD WRITE !!,"You have 2 options for counting ",AMQQN(1)," =>",!
+1 WRITE !?5,"1) Count all specified ",AMQQN(2)," for all patients"
+2 SET AMQQI=0
+3 FOR
SET AMQQI=$ORDER(^UTILITY("AMQQ",$JOB,"LIST",AMQQI))
IF 'AMQQI!($DATA(AMQQSTP))
QUIT
IF ^(AMQQI)[$EXTRACT(AMQQN(1),1,($LENGTH(AMQQN(1))-2))
IF $DATA(AMQQHIT)
SET AMQQSTP=""
SET AMQQHIT=""
+4 WRITE !?5,"2) Count PATIENTS with at least one of the ",$SELECT('$DATA(AMQQSTP):AMQQN(1),1:AMQQN(1)_" in each query"),!,?7," you specified",!
+5 KILL AMQQSTP,AMQQHIT
CDQ WRITE !,"Your choice (1-2): 1// "
+1 READ X:DTIME
IF '$TEST
SET X=U
+2 IF X=2
SET X=3
QUIT
+3 IF X=""
QUIT
+4 IF X=1
QUIT
+5 IF X?1."?"
DO HELP
GOTO CD
+6 IF $EXTRACT(X)=U
QUIT
+7 WRITE " ??",*7
+8 GOTO CDQ
+9 ;
HELP NEW %A,%B
+1 SET XQH=$ORDER(^DIC(9.2,"B","AMQQLIST",""))
+2 DO EN1^XQH
+3 QUIT
+4 ;
MULT FOR I=1:1:3
SET AMQQN(I)=$PIECE(AMQQN,U,I)
+1 IF AMQV("OPTION")="COHORT"
SET X=3
GOTO X3
+2 SET %=$PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,15)
+3 SET %=$PIECE(%,";",4)
+4 IF %
IF $DATA(^UTILITY("AMQQ TAX",$JOB,%,"--"))!$DATA(^UTILITY("AMQQ TAX",$JOB,%,"-"))
QUIT
+5 IF AMQV("OPTION")="COUNT"
DO CD
GOTO DXQA
+6 IF $DATA(AMQQONE)
SET X=2
GOTO DXQA
+7 WRITE !!,"You have ",$SELECT('$DATA(AMQQNO3):3,1:2)," options for listing ",AMQQN(1)," =>",!
+8 WRITE !?5,"1) List every ",$SELECT(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," meeting search criteria."
+9 WRITE !?5,"2) List every ",$SELECT(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",AMQQN(2)="ICD CODES":"ICD CODE",1:AMQQN(2))," and ",$SELECT(AMQQN(3)="PROVIDER NARRATIVES":"PROVIDER NARRATIVE",1:AMQQN(3))," meeting search criteria."
IF $DATA(AMQQNO3)
WRITE !
+10 IF '$DATA(AMQQNO3)
WRITE !?5,"3) List all PATIENTS with ",$SELECT(AMQQN(2)="ICD9 CODES":"DIAGNOSIS",1:AMQQN(2))," you specified, but DO NOT list",!?8,"individual ",$SELECT(AMQQN(2)="ICD9 CODES":"ICD CODES",1:AMQQN(2))," or ",AMQQN(3)," (FASTEST OPTION!!)",!
+11 WRITE ?8,"(Displays UNDUPLICATED list of PATIENTS)",!
DXQ WRITE !,"Your choice (1-",(3-$DATA(AMQQNO3)),"): 1// "
+1 READ X:DTIME
IF '$TEST
SET X=U
DXQA IF $EXTRACT(X)=U
SET AMQQQUIT=""
GOTO DXEXIT
+1 IF X=""
SET X=1
WRITE " (1)"
+2 IF X?1."?"
DO HELP
GOTO MULT
DXQA1 IF X=2
SET %=+^UTILITY("AMQQ",$JOB,"Q",AMQQMULN)
Begin DoDot:1
+1 IF %>999
DO EXP
QUIT
+2 IF $DATA(^AMQQ(1,%+.1))
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,1)=%+.1
SET $PIECE(^(AMQQMULN),U,18)=1
SET $PIECE(^(AMQQMULN),U,14)=3
+3 QUIT
End DoDot:1
QUIT
X11 ;IHS/CMI/LAB - addded question about qualifiers
+1 ;I X=1 S $P(^UTILITY("AMQQ",$J,"Q",AMQQMULN),U,18)=1 Q ;,$P(^(AMQQMULN),U,14)=2 Q
+2 KILL AMQQDVQU
+3 IF X=1
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,18)=1
+4 IF $PIECE(^AMQQ(1,+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULL)),0),U,3)=9000010.01
Begin DoDot:1
+5 NEW X
+6 KILL DIR,AMQQDVQU
+7 SET DIR(0)="Y"
SET DIR("A")="Do you want to display associated measurement qualifiers with each "_AMQQOBJS
SET DIR("B")="N"
SET DIR("?")="If you want to display the qualifiers (e.g. Oral, Left Arm, etc) enter Y for Yes."
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
KILL AMQQDVQU
QUIT
+9 IF 'Y
KILL AMQQDVQU
QUIT
+10 SET AMQQDVQU=1
+11 QUIT
End DoDot:1
+12 IF X=1
QUIT
X3 IF '$DATA(AMQQNO3)
IF X=3
SET $PIECE(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN),U,18)=2
SET AMQQMULX=AMQQMULX_AMQQMULN_U
QUIT
+1 WRITE " ??",*7
+2 GOTO DXQ
DXEXIT KILL X
+1 QUIT
+2 ;
SPEC IF $GET(AMQV("OPTION"))'="COHORT"
IF %="ALL"!(%="ANY")
IF $DATA(^AMQQ(1,+$GET(^UTILITY("AMQQ",$JOB,"Q",AMQQMULN)),9))
IF %="ANY"
SET AMQQNO3=""
SET AMQQN=^(9)
DO MULT
QUIT
+1 SET X=2-((%="ALL")!(%="ANY"))
+2 DO DXQA1
+3 QUIT
+4 ;
EXP ; EXPANDED LAB OUTPUT
+1 NEW X,Y,Z
+2 SET $PIECE(^AMQQ(1,%,4,1,0),U,5,6)="30^30"
SET ^(1)="D EXP^AMQQDO"
+3 QUIT
+4 ;
