APCLAUD3 ; IHS/CMI/LAB - MORE AUDIT SEARCH ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
AGE ;
S DIR(0)="YO",DIR("A")="Do you want to restrict the Audit Search to Patients within an Age Range",DIR("B")="NO",DIR("?")="" D ^DIR K DIR
I $D(DIRUT) G EXIT
I Y'=1 K APCLLAGE,APCLHAGE,APCLLAG,APCLHAG G SEX
AGEL ;
S DIR(0)="N^0:199:0",DIR("A")="Enter the lower limit for Age (in Years) at the time",DIR("B")="0" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G AGE
S APCLLAGE=Y
I APCLLAGE="" S (APCLLAGE,APCLLAG)=0 G AGEH
S APCLLAG=(APCLLAGE*365.25)\1
AGEH ;
S DIR(0)="N^0:199:0",DIR("A")="Enter the upper limit for Age (in Years) at the time" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G AGEL
S APCLHAGE=Y
S APCLHAG=(((APCLHAGE+1)*365.25)\1)-1
;
SEX ;Sex Screening
K DIR S:$D(DUOUT) DIRUT=1 K DIR,APCLSEX,APCLSEXP
W ! S DIR(0)="YO",DIR("B")="NO",DIR("A")="Want to restrict the Audit Search to Visits with a particular SEX",DIR("?")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) K APCLSEXP,APCLSEX Q
I $E(X)="N" G SC
S DIR(0)="2,.02",DIR("A")="Which SEX" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G SEX
S APCLSEX=Y,APCLSEXP=Y(0)
;
SC ;
K DIR S:$D(DUOUT) DIRUT=1 K DIR,APCLSC,APCLSCP
W ! S DIR(0)="YO",DIR("B")="NO",DIR("A")="Want to restrict the Audit Search to Visits with a particular SERVICE CATEGORY",DIR("?")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) K APCLSC,APCLSCP,APCLSEX,APCLSEXP Q
I $E(X)="N" G TYPE
S DIR(0)="9000010,.07",DIR("A")="Which Service Category" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G SC
S APCLSC=Y,APCLSCP=Y(0)
TYPE ;
K DIR S:$D(DUOUT) DIRUT=1 K DIR,APCLTYPE,APCLTYPP
W ! S DIR(0)="YO",DIR("B")="NO",DIR("A")="Want to restrict the audit search by VISIT TYPE",DIR("?")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) K APCLSC,APCLSCP,APCLTYPE,APCLTYPP,APCLSEX,APCLSEXP Q
I $E(X)="N" G CLN
S DIR(0)="9000010,.03",DIR("A")="Which Visit Type" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G TYPE
S APCLTYPE=Y,APCLTYPP=Y(0)
CLN ;
I $D(APCLTYPE),"CV"[APCLTYPE G LOC
I $D(APCLSC),"H"[APCLSC G LOC
W ! S DIR(0)="YO",DIR("A")="Want to restrict the audit search by CLINIC TYPE",DIR("B")="NO",DIR("?")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) K APCLCLN,APCLCLNP,APCLSC,APCLSCP,APCLTYPE,APCLTYPP,APCLSEX,APCLSEXP Q
I $E(X)="N" G LOC
S DIC="^DIC(40.7,",DIC(0)="AEQM",DIC("A")="Clinic:"
D ^DIC K DIC
I Y<0 G CLN
S APCLCLN=+Y,APCLCLNP=$P(^DIC(40.7,APCLCLN,0),U)
LOC ;
W ! S DIR(0)="YO",DIR("A")="Want to restrict the audit search by LOCATION of ENCOUNTER",DIR("B")="NO",DIR("?")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) K APCLLOC,APCLLOCP,APCLCLN,APCLCLNP,APCLLOCP,APCLSC,APCLSCP,APCLTYPE,APCLTYPP Q
I $E(X)="N" G EXIT
S DIC="^AUTTLOC(",DIC(0)="AEQM",DIC("A")="What Location: "
D ^DIC K DIC
I Y<0 G LOC
S APCLLOC=+Y,APCLLOCP=$P(^DIC(4,APCLLOC,0),U)
EXIT ;
Q
APCLAUD3 ; IHS/CMI/LAB - MORE AUDIT SEARCH ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
AGE ;
+1 SET DIR(0)="YO"
SET DIR("A")="Do you want to restrict the Audit Search to Patients within an Age Range"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO EXIT
+3 IF Y'=1
KILL APCLLAGE,APCLHAGE,APCLLAG,APCLHAG
GOTO SEX
AGEL ;
+1 SET DIR(0)="N^0:199:0"
SET DIR("A")="Enter the lower limit for Age (in Years) at the time"
SET DIR("B")="0"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO AGE
+3 SET APCLLAGE=Y
+4 IF APCLLAGE=""
SET (APCLLAGE,APCLLAG)=0
GOTO AGEH
+5 SET APCLLAG=(APCLLAGE*365.25)\1
AGEH ;
+1 SET DIR(0)="N^0:199:0"
SET DIR("A")="Enter the upper limit for Age (in Years) at the time"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO AGEL
+3 SET APCLHAGE=Y
+4 SET APCLHAG=(((APCLHAGE+1)*365.25)\1)-1
+5 ;
SEX ;Sex Screening
+1 KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR,APCLSEX,APCLSEXP
+2 WRITE !
SET DIR(0)="YO"
SET DIR("B")="NO"
SET DIR("A")="Want to restrict the Audit Search to Visits with a particular SEX"
SET DIR("?")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
KILL APCLSEXP,APCLSEX
QUIT
+4 IF $EXTRACT(X)="N"
GOTO SC
+5 SET DIR(0)="2,.02"
SET DIR("A")="Which SEX"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF $DATA(DIRUT)
GOTO SEX
+7 SET APCLSEX=Y
SET APCLSEXP=Y(0)
+8 ;
SC ;
+1 KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR,APCLSC,APCLSCP
+2 WRITE !
SET DIR(0)="YO"
SET DIR("B")="NO"
SET DIR("A")="Want to restrict the Audit Search to Visits with a particular SERVICE CATEGORY"
SET DIR("?")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
KILL APCLSC,APCLSCP,APCLSEX,APCLSEXP
QUIT
+4 IF $EXTRACT(X)="N"
GOTO TYPE
+5 SET DIR(0)="9000010,.07"
SET DIR("A")="Which Service Category"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF $DATA(DIRUT)
GOTO SC
+7 SET APCLSC=Y
SET APCLSCP=Y(0)
TYPE ;
+1 KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR,APCLTYPE,APCLTYPP
+2 WRITE !
SET DIR(0)="YO"
SET DIR("B")="NO"
SET DIR("A")="Want to restrict the audit search by VISIT TYPE"
SET DIR("?")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
KILL APCLSC,APCLSCP,APCLTYPE,APCLTYPP,APCLSEX,APCLSEXP
QUIT
+4 IF $EXTRACT(X)="N"
GOTO CLN
+5 SET DIR(0)="9000010,.03"
SET DIR("A")="Which Visit Type"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF $DATA(DIRUT)
GOTO TYPE
+7 SET APCLTYPE=Y
SET APCLTYPP=Y(0)
CLN ;
+1 IF $DATA(APCLTYPE)
IF "CV"[APCLTYPE
GOTO LOC
+2 IF $DATA(APCLSC)
IF "H"[APCLSC
GOTO LOC
+3 WRITE !
SET DIR(0)="YO"
SET DIR("A")="Want to restrict the audit search by CLINIC TYPE"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
KILL APCLCLN,APCLCLNP,APCLSC,APCLSCP,APCLTYPE,APCLTYPP,APCLSEX,APCLSEXP
QUIT
+5 IF $EXTRACT(X)="N"
GOTO LOC
+6 SET DIC="^DIC(40.7,"
SET DIC(0)="AEQM"
SET DIC("A")="Clinic:"
+7 DO ^DIC
KILL DIC
+8 IF Y<0
GOTO CLN
+9 SET APCLCLN=+Y
SET APCLCLNP=$PIECE(^DIC(40.7,APCLCLN,0),U)
LOC ;
+1 WRITE !
SET DIR(0)="YO"
SET DIR("A")="Want to restrict the audit search by LOCATION of ENCOUNTER"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
KILL APCLLOC,APCLLOCP,APCLCLN,APCLCLNP,APCLLOCP,APCLSC,APCLSCP,APCLTYPE,APCLTYPP
QUIT
+3 IF $EXTRACT(X)="N"
GOTO EXIT
+4 SET DIC="^AUTTLOC("
SET DIC(0)="AEQM"
SET DIC("A")="What Location: "
+5 DO ^DIC
KILL DIC
+6 IF Y<0
GOTO LOC
+7 SET APCLLOC=+Y
SET APCLLOCP=$PIECE(^DIC(4,APCLLOC,0),U)
EXIT ;
+1 QUIT
