APCLADX0 ; IHS/CMI/LAB - cont. apcladx ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
SEX S DIR(0)="YO",DIR("A")="Want to limit search by PATIENT SEX",DIR("B")="NO",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
G:Y=0 FAC
S DIR(0)="2,.02",DIR("A")="Select sex" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
I X="" G FAC
S APCLSEX=Y,APCLSEXP=Y(0)
FAC ;
S DIR(0)="YO",DIR("A")="Want to limit search by FACILITY",DIR("B")="NO",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
G:Y=0 PROV
S DIC="^AUTTLOC(",DIC(0)="AEQM",DIC("A")="Facility: "
I $D(DUZ(2)) S DIC("B")=$P(^DIC(4,DUZ(2),0),U)
D ^DIC K DIC
I Y=-1 S APCLQUIT=1 Q
S APCLFAC=+Y,APCLFACP=$P(^DIC(4,+Y,0),U)
PROV S DIR(0)="YO",DIR("A")="Want to limit the search by PRIMARY PROVIDER",DIR("B")="NO",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
G:Y=0 CLN
I $P(^DD(9000010.06,.01,0),U,2)[200 S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D MIX^DIC1 K DIC,D
I $P(^DD(9000010.06,.01,0),U,2)[6 S DIC="^DIC(6,",DIC(0)="AEMQ",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D ^DIC K DIC
I $D(DTOUT)!(Y=-1) S APCLQUIT=1 Q
S APCLPROV=+Y,APCLPRVP=$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,+Y,0),U),1:$P(^DIC(16,+Y,0),U))
CLN S DIR(0)="YO",DIR("A")="Want to limit search by CLINIC TYPE",DIR("B")="NO",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
G:Y=0 SC
S DIC="^DIC(40.7,",DIC(0)="AEQM",DIC("A")="Clinic: "
D ^DIC K DIC
I Y=-1 S APCLQUIT=1 Q
S APCLCLN=+Y,APCLCLNP=$P(Y,U,2)
SC ;
K DIR
S DIR(0)="YO",DIR("B")="NO",DIR("A")="Want to limit search by SERVICE CATEGORY",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
G:Y=0 TYPE
S DIR(0)="9000010,.07",DIR("A")="Which Service Category" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
S APCLSC=Y,APCLSCP=Y(0)
TYPE ;
K DIR
S DIR(0)="YO",DIR("B")="NO",DIR("A")="Want to limit search by VISIT TYPE",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
Q:Y=0
S DIR(0)="9000010,.03",DIR("A")="Which Visit Type" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
Q:$D(DIRUT)
S APCLTYPE=Y,APCLTYPP=Y(0)
Q
;
APCLADX0 ; IHS/CMI/LAB - cont. apcladx ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
SEX SET DIR(0)="YO"
SET DIR("A")="Want to limit search by PATIENT SEX"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+1 IF $DATA(DIRUT)
QUIT
+2 IF Y=0
GOTO FAC
+3 SET DIR(0)="2,.02"
SET DIR("A")="Select sex"
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF X=""
GOTO FAC
+6 SET APCLSEX=Y
SET APCLSEXP=Y(0)
FAC ;
+1 SET DIR(0)="YO"
SET DIR("A")="Want to limit search by FACILITY"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=0
GOTO PROV
+4 SET DIC="^AUTTLOC("
SET DIC(0)="AEQM"
SET DIC("A")="Facility: "
+5 IF $DATA(DUZ(2))
SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),U)
+6 DO ^DIC
KILL DIC
+7 IF Y=-1
SET APCLQUIT=1
QUIT
+8 SET APCLFAC=+Y
SET APCLFACP=$PIECE(^DIC(4,+Y,0),U)
PROV SET DIR(0)="YO"
SET DIR("A")="Want to limit the search by PRIMARY PROVIDER"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+1 IF $DATA(DIRUT)
QUIT
+2 IF Y=0
GOTO CLN
+3 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET D="AK.PROVIDER"
SET DIC("A")="Enter PROVIDER (Lastname,Firstname): "
DO MIX^DIC1
KILL DIC,D
+4 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
SET DIC="^DIC(6,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter PROVIDER (Lastname,Firstname): "
DO ^DIC
KILL DIC
+5 IF $DATA(DTOUT)!(Y=-1)
SET APCLQUIT=1
QUIT
+6 SET APCLPROV=+Y
SET APCLPRVP=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,+Y,0),U),1:$PIECE(^DIC(16,+Y,0),U))
CLN SET DIR(0)="YO"
SET DIR("A")="Want to limit search by CLINIC TYPE"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+1 IF $DATA(DIRUT)
QUIT
+2 IF Y=0
GOTO SC
+3 SET DIC="^DIC(40.7,"
SET DIC(0)="AEQM"
SET DIC("A")="Clinic: "
+4 DO ^DIC
KILL DIC
+5 IF Y=-1
SET APCLQUIT=1
QUIT
+6 SET APCLCLN=+Y
SET APCLCLNP=$PIECE(Y,U,2)
SC ;
+1 KILL DIR
+2 SET DIR(0)="YO"
SET DIR("B")="NO"
SET DIR("A")="Want to limit search by SERVICE CATEGORY"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y=0
GOTO TYPE
+5 SET DIR(0)="9000010,.07"
SET DIR("A")="Which Service Category"
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET APCLSC=Y
SET APCLSCP=Y(0)
TYPE ;
+1 KILL DIR
+2 SET DIR(0)="YO"
SET DIR("B")="NO"
SET DIR("A")="Want to limit search by VISIT TYPE"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y=0
QUIT
+5 SET DIR(0)="9000010,.03"
SET DIR("A")="Which Visit Type"
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET APCLTYPE=Y
SET APCLTYPP=Y(0)
+8 QUIT
+9 ;