AMQQSQP.m

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       ;