AMQQSQP ; IHS/CMI/THL - SPECIAL SUBQUERY FOR PROVIDERS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
INTRO W @IOF,?17,"***** PROVIDER-RELATED CRITERIA *****"
W !!!,"You can either specify one or more providers by NAME, or.....",!
W "You can specify one or more PROVIDER ATTRIBUTES (affiliation, specialty, etc)"
W !,"to be used as selection criteria.",!!!
S DIR(0)="SO^1:NAME(S) of providers;2:ATTRIBUTE(S) of providers"
S DIR("A")=$C(10)_" Your choice"
S DIR("B")="NAME(S)"
D ^DIR
K DIR
I $D(DUOUT)+$D(DTOUT) K DUOUT,DIRUT,DTOUT S AMQQQUIT="" G EXIT
I Y="" Q
S AMQQSQPY=Y
RUN D @$P("NAME^ATT",U,Y)
I $D(AMQQQUIT) G EXIT
I $D(AMQQSQPQ) K AMQQSQPQ G EXIT
D PRIME
I $D(AMQQSQPQ)!($D(AMQQQUIT)) K AMQQSQPQ G EXIT
D @$P("SETN^SETA",U,AMQQSQPY)
I '$D(AMQQXX),AMQQSQFN>1 W !! F %=0:0 S %=$O(^UTILITY("AMQQ",$J,"SQL",AMQQUSQN,%)) Q:'% W ! X ^(%)
EXIT K X,Y,AMQQSQPH,AMQQSQPL,AMQQSQPY,%,Z,AMQQSQP
W !!
Q
;
NAME N AMQQTAX
S X=35
D EN1^AMQQTX
I '$D(AMQQTAX) S AMQQSQPQ="",AMQQQUIT="" Q
S AMQQSQP=AMQQTAX
S (AMQQSQP1,AMQQSQP2)=AMQQUQQN+1+('$D(AMQQVPF))
Q
;
PRIME W !!,"When I check the providers from each encounter, you can limit my analysis"
W !,"to the PRIMARY provider only, SECONDARY providers, or ALL providers.",!!
S DIR(0)="SO^1:PRIMARY provider only;2:SECONDARY providers only;3:ALL providers"
S DIR("A")=$C(10)_" Your choice"
S DIR("B")="ALL"
D ^DIR
K DIR
I $D(DUOUT)+$D(DTOUT) K DUOUT,DIRUT,DTOUT S (Y,AMQQQUIT)=""
I Y="" Q
S AMQQSQPS=Y
S AMQQSQPL=$S(AMQQSQPS=1:"PRIMARY",AMQQSQPS=2:"SECONDARY",1:"")
I AMQQSQPL'="" S AMQQSQPL=AMQQSQPL_" "
Q
;
SETA I $D(AMQQVPF) D SETVP G SETA1
D CHK
S ^UTILITY("AMQQ",$J,"SQL",AMQQUSQN,AMQQSQFN)="W ?"_$S($D(AMQQGVF):6,1:((3*AMQQUSQL)+6))_","""_AMQQSQPL_"PROVIDER ATTRIBUTES"""
S ^UTILITY("AMQQ",$J,"QQ",AMQQSQPH)="212^PROVIDER^Y^0^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_"^^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2
S ^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^V^"_AMQQSQPH
D SQIX
SETA1 S AMQQSQFN=AMQQSQFN+1
Q
;
SETN I $D(AMQQVPF) D SETVP G SETN1
D CHK
D SETZ
S Z=AMQQSQPL_"PROVIDERS "_Z
S ^UTILITY("AMQQ",$J,"SQL",AMQQUSQN,AMQQSQFN)="W ?"_$S($D(AMQQGVF):6,1:((3*AMQQUSQL)+6))_","""_Z_""""
S AMQQUQQN=AMQQUQQN+1
S ^UTILITY("AMQQ",$J,"QQ",AMQQUQQN)="212^PROVIDER^Y^0^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_"^^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2
S ^UTILITY("AMQQ",$J,"SQ",AMQQUSQN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^V^"_AMQQUQQN
D SQIX
S AMQQSQFN=AMQQSQFN+1
SETN1 S AMQQUQQN=AMQQUQQN+1
S ^UTILITY("AMQQ",$J,"QQ",AMQQUQQN)="203^PROVIDER^L^0^^^^^;;;"_AMQQSQP_"^^^^^1^"_AMQQSQP_";"_AMQQSQP_";^0^"_AMQQSQP
Q
;
SETZ N AMQQQ
S AMQQQ="203^^^^^^^^;;;"_AMQQSQP,Z="" I AMQQSQPY=1 D ZSET^AMQQATL1
Q
;
SETVP S AMQQLINK=212
S AMQQATNM="PROVIDER"
S AMQQCTXS=0
S AMQQCOMP=AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_";"_$G(AMQQSQP),AMQQNVAR=1,AMQQFTYP="Y",AMQQSQFN=0
I AMQQSQPY=2 S AMQQLINK=212.1
K AMQQTAX
Q
;
CHK I AMQQSQFN=1 D SET1^AMQQSQS S AMQQSQQQ="Next"_$S($D(AMQQGVF):" generic visit condition",1:(" condition of """_AMQQSQSJ_""""))_": "
Q
;
SQIX I '$D(AMQQGVF) S %=@$S(AMQQUSQL>1:"AMQQSQAA",1:"AMQQUATN"),X=$S(AMQQUSQL>1:"SQXS",1:"SQXQ") I '$D(^UTILITY("AMQQ",$J,X,%)) S ^(%,1)=""
Q
;
ATT N AMQQSQQF,AMQQCCLS,AMQQQ,AMQQLINK,AMQQFTYP,AMQQCTXS,AMQQCOND,AMQQNOCO,AMQQCONM,AMQQSYMB,AMQQCOMP,AMQQVCL,AMQQSER,AMQQORTX,AMQQFRED,AMQQNVAR,AMQQFILT,AMQQSNOT,AMQQTAX,AMQQUATN,AMQQATNM,AMQQCNAM
S AMQQSQPH=AMQQUQQN+('$D(AMQQVPF))
S AMQQCCLS="H"
S AMQQCNAM="PROVIDER"
S AMQQUATN=1
ATT1 S AMQQQ=""
W !!
D ATT2
I $G(AMQQQ)="" S AMQQSQP1=AMQQSQPH+1,AMQQSQP2=AMQQUQQN S:AMQQUQQN<AMQQSQPH AMQQSQPQ="" Q
I AMQQUQQN<AMQQSQPH S AMQQUQQN=AMQQUQQN+1
S (AMQQSQQF,AMQQUQQN)=AMQQUQQN+1
S AMQQUATN=AMQQUATN+1
D ^AMQQATS
I '$D(AMQQVPF) D ALIST
G ATT1
Q
;
ATT2 N AMQQVPF
D ^AMQQAT
Q
;
ALIST S %=AMQQSQFN
N AMQQSQLS,AMQQSQCT,AMQQSQFN,AMQQSQNN
S AMQQSQFN=+(%_"."_AMQQSQQF)
S AMQQSQLS="W ?"_$S($D(AMQQGVF):9,$D(AMQQUSQL):(3*AMQQUSQL+6),1:9)_","""
S AMQQSQNN=AMQQUSQN+1
S AMQQSQCT="V"
D EN1^AMQQSQL
Q
;
AMQQSQP ; IHS/CMI/THL - SPECIAL SUBQUERY FOR PROVIDERS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
INTRO WRITE @IOF,?17,"***** PROVIDER-RELATED CRITERIA *****"
+1 WRITE !!!,"You can either specify one or more providers by NAME, or.....",!
+2 WRITE "You can specify one or more PROVIDER ATTRIBUTES (affiliation, specialty, etc)"
+3 WRITE !,"to be used as selection criteria.",!!!
+4 SET DIR(0)="SO^1:NAME(S) of providers;2:ATTRIBUTE(S) of providers"
+5 SET DIR("A")=$CHAR(10)_" Your choice"
+6 SET DIR("B")="NAME(S)"
+7 DO ^DIR
+8 KILL DIR
+9 IF $DATA(DUOUT)+$DATA(DTOUT)
KILL DUOUT,DIRUT,DTOUT
SET AMQQQUIT=""
GOTO EXIT
+10 IF Y=""
QUIT
+11 SET AMQQSQPY=Y
RUN DO @$PIECE("NAME^ATT",U,Y)
+1 IF $DATA(AMQQQUIT)
GOTO EXIT
+2 IF $DATA(AMQQSQPQ)
KILL AMQQSQPQ
GOTO EXIT
+3 DO PRIME
+4 IF $DATA(AMQQSQPQ)!($DATA(AMQQQUIT))
KILL AMQQSQPQ
GOTO EXIT
+5 DO @$PIECE("SETN^SETA",U,AMQQSQPY)
+6 IF '$DATA(AMQQXX)
IF AMQQSQFN>1
WRITE !!
FOR %=0:0
SET %=$ORDER(^UTILITY("AMQQ",$JOB,"SQL",AMQQUSQN,%))
IF '%
QUIT
WRITE !
XECUTE ^(%)
EXIT KILL X,Y,AMQQSQPH,AMQQSQPL,AMQQSQPY,%,Z,AMQQSQP
+1 WRITE !!
+2 QUIT
+3 ;
NAME NEW AMQQTAX
+1 SET X=35
+2 DO EN1^AMQQTX
+3 IF '$DATA(AMQQTAX)
SET AMQQSQPQ=""
SET AMQQQUIT=""
QUIT
+4 SET AMQQSQP=AMQQTAX
+5 SET (AMQQSQP1,AMQQSQP2)=AMQQUQQN+1+('$DATA(AMQQVPF))
+6 QUIT
+7 ;
PRIME WRITE !!,"When I check the providers from each encounter, you can limit my analysis"
+1 WRITE !,"to the PRIMARY provider only, SECONDARY providers, or ALL providers.",!!
+2 SET DIR(0)="SO^1:PRIMARY provider only;2:SECONDARY providers only;3:ALL providers"
+3 SET DIR("A")=$CHAR(10)_" Your choice"
+4 SET DIR("B")="ALL"
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DUOUT)+$DATA(DTOUT)
KILL DUOUT,DIRUT,DTOUT
SET (Y,AMQQQUIT)=""
+8 IF Y=""
QUIT
+9 SET AMQQSQPS=Y
+10 SET AMQQSQPL=$SELECT(AMQQSQPS=1:"PRIMARY",AMQQSQPS=2:"SECONDARY",1:"")
+11 IF AMQQSQPL'=""
SET AMQQSQPL=AMQQSQPL_" "
+12 QUIT
+13 ;
SETA IF $DATA(AMQQVPF)
DO SETVP
GOTO SETA1
+1 DO CHK
+2 SET ^UTILITY("AMQQ",$JOB,"SQL",AMQQUSQN,AMQQSQFN)="W ?"_$SELECT($DATA(AMQQGVF):6,1:((3*AMQQUSQL)+6))_","""_AMQQSQPL_"PROVIDER ATTRIBUTES"""
+3 SET ^UTILITY("AMQQ",$JOB,"QQ",AMQQSQPH)="212^PROVIDER^Y^0^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_"^^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2
+4 SET ^UTILITY("AMQQ",$JOB,"SQ",AMQQUSQN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^V^"_AMQQSQPH
+5 DO SQIX
SETA1 SET AMQQSQFN=AMQQSQFN+1
+1 QUIT
+2 ;
SETN IF $DATA(AMQQVPF)
DO SETVP
GOTO SETN1
+1 DO CHK
+2 DO SETZ
+3 SET Z=AMQQSQPL_"PROVIDERS "_Z
+4 SET ^UTILITY("AMQQ",$JOB,"SQL",AMQQUSQN,AMQQSQFN)="W ?"_$SELECT($DATA(AMQQGVF):6,1:((3*AMQQUSQL)+6))_","""_Z_""""
+5 SET AMQQUQQN=AMQQUQQN+1
+6 SET ^UTILITY("AMQQ",$JOB,"QQ",AMQQUQQN)="212^PROVIDER^Y^0^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_"^^^^^^"_AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2
+7 SET ^UTILITY("AMQQ",$JOB,"SQ",AMQQUSQN,AMQQSQFN)="0^LINK^22^SUB^AMQQF1^V^"_AMQQUQQN
+8 DO SQIX
+9 SET AMQQSQFN=AMQQSQFN+1
SETN1 SET AMQQUQQN=AMQQUQQN+1
+1 SET ^UTILITY("AMQQ",$JOB,"QQ",AMQQUQQN)="203^PROVIDER^L^0^^^^^;;;"_AMQQSQP_"^^^^^1^"_AMQQSQP_";"_AMQQSQP_";^0^"_AMQQSQP
+2 QUIT
+3 ;
SETZ NEW AMQQQ
+1 SET AMQQQ="203^^^^^^^^;;;"_AMQQSQP
SET Z=""
IF AMQQSQPY=1
DO ZSET^AMQQATL1
+2 QUIT
+3 ;
SETVP SET AMQQLINK=212
+1 SET AMQQATNM="PROVIDER"
+2 SET AMQQCTXS=0
+3 SET AMQQCOMP=AMQQSQPS_";"_AMQQSQP1_";"_AMQQSQP2_";"_$GET(AMQQSQP)
SET AMQQNVAR=1
SET AMQQFTYP="Y"
SET AMQQSQFN=0
+4 IF AMQQSQPY=2
SET AMQQLINK=212.1
+5 KILL AMQQTAX
+6 QUIT
+7 ;
CHK IF AMQQSQFN=1
DO SET1^AMQQSQS
SET AMQQSQQQ="Next"_$SELECT($DATA(AMQQGVF):" generic visit condition",1:(" condition of """_AMQQSQSJ_""""))_": "
+1 QUIT
+2 ;
SQIX IF '$DATA(AMQQGVF)
SET %=@$SELECT(AMQQUSQL>1:"AMQQSQAA",1:"AMQQUATN")
SET X=$SELECT(AMQQUSQL>1:"SQXS",1:"SQXQ")
IF '$DATA(^UTILITY("AMQQ",$JOB,X,%))
SET ^(%,1)=""
+1 QUIT
+2 ;
ATT NEW AMQQSQQF,AMQQCCLS,AMQQQ,AMQQLINK,AMQQFTYP,AMQQCTXS,AMQQCOND,AMQQNOCO,AMQQCONM,AMQQSYMB,AMQQCOMP,AMQQVCL,AMQQSER,AMQQORTX,AMQQFRED,AMQQNVAR,AMQQFILT,AMQQSNOT,AMQQTAX,AMQQUATN,AMQQATNM,AMQQCNAM
+1 SET AMQQSQPH=AMQQUQQN+('$DATA(AMQQVPF))
+2 SET AMQQCCLS="H"
+3 SET AMQQCNAM="PROVIDER"
+4 SET AMQQUATN=1
ATT1 SET AMQQQ=""
+1 WRITE !!
+2 DO ATT2
+3 IF $GET(AMQQQ)=""
SET AMQQSQP1=AMQQSQPH+1
SET AMQQSQP2=AMQQUQQN
IF AMQQUQQN<AMQQSQPH
SET AMQQSQPQ=""
QUIT
+4 IF AMQQUQQN<AMQQSQPH
SET AMQQUQQN=AMQQUQQN+1
+5 SET (AMQQSQQF,AMQQUQQN)=AMQQUQQN+1
+6 SET AMQQUATN=AMQQUATN+1
+7 DO ^AMQQATS
+8 IF '$DATA(AMQQVPF)
DO ALIST
+9 GOTO ATT1
+10 QUIT
+11 ;
ATT2 NEW AMQQVPF
+1 DO ^AMQQAT
+2 QUIT
+3 ;
ALIST SET %=AMQQSQFN
+1 NEW AMQQSQLS,AMQQSQCT,AMQQSQFN,AMQQSQNN
+2 SET AMQQSQFN=+(%_"."_AMQQSQQF)
+3 SET AMQQSQLS="W ?"_$SELECT($DATA(AMQQGVF):9,$DATA(AMQQUSQL):(3*AMQQUSQL+6),1:9)_","""
+4 SET AMQQSQNN=AMQQUSQN+1
+5 SET AMQQSQCT="V"
+6 DO EN1^AMQQSQL
+7 QUIT
+8 ;
