APCLAUD3.m

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