Routine: APCLAUD0

APCLAUD0 ; IHS/CMI/LAB - more audit report ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

PROV K APCLSLCT

PROV00 D PROV01 G PROV11

PROV01 S APCLMSG="PROVIDER Selection" W:$D(IOF) @IOF D APCLMSGO

PROV02 D ICDB1^APCLAUD

 I $D(APCLSLCT) W !

 S APCLPRV=0 F APCLI=0:0 S APCLPRV=$O(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV",APCLPRV)) Q:APCLPRV'=+APCLPRV  W !,"Provider: ",$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLPRV,0),U),1:$P(^DIC(16,$P(^DIC(6,APCLPRV,0),"^"),0),"^"))

 I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","NOSORT")) W !!,"No Primary Provider criteria selected."

 I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","ALL")) W !!,"ALL Providers Selected."

PROV11 I $D(APCLSLCT) G PROV1

 S DIR(0)="Y",DIR("A")="Do you want the Audit Search by Provider",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) S:APCLIRNG>1 APCLIRNG=APCLIRNG-1,APCLSLCT="" S APCLICDG=$S($D(APCLSLCT):"ICDE1^APCLAUD",1:"ICDB11^APCLAUD") G @APCLICDG

 I Y=1 G PROV111

 S ^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","NOSORT")="" G PROVN

PROV111 ;

 S DIR(0)="Y",DIR("A")="Do you want ALL Providers",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) PROV11

 I Y=1 S ^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","ALL")="" G PROVN

 W !!,"The Audit Search will include only Visits for which the Primary Provider",!,"matches the one(s) you select."

PROV1 W ! I $P(^DD(9000010.06,.01,0),U,2)[6 S DIC="^DIC(6,",DIC("A")="Select Provider: ",DIC(0)="AEMQ" D ^DIC

 I $P(^DD(9000010.06,.01,0),U,2)[200 S DIC="^VA(200,",DIC("A")="Select Provider: ",DIC(0)="AEMQ",D="AK.PROVIDER" D MIX^DIC1

PROV2 G:X["^" PROV11 I Y=-1,$D(APCLSLCT) G PROVN

 I Y=-1 G PROV1

 S (^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV",+Y),APCLSLCT)="" G PROV00

PROVN S APCLMSG="SEARCH Criteria" W:$D(IOF) @IOF D APCLMSGO

 D PROV02 W !!,"The Audit Search can report on all Visits that match the above criteria,",!,"or it can report on a randomized sampling of matching Visits."

 S DIR(0)="S^A:ALL Visits that match;R:Random sample of visits that match",DIR("A")="Which visit set",DIR("B")="A" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G PROV111

 I Y="A" S ^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND","ALL")="" G ZIS

 S DIR(0)="N^1:1000:0",DIR("A")="How many randomized visits do you want in the report" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G PROVN

 S ^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND",X)=""

 G ZIS

APCLMSGO W ?30,"*** Audit Search ***",!!

 W ?80-$L(APCLMSG)\2,APCLMSG,!! Q

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G PROV

 K APCLSLCT

 S XBNS="APCL",XBNS("^XTMP(""APCLAUD"",APCLJOB,APCLBT,")="",XBRC="^APCLAUD1",XBRP="^APCLAUD2",XBRX="QUIT^APCLAUD0"

 D ^XBDBQUE

QUIT D ^%ZISC K DIC,%DT,ZTSK,ZTQUEUED,IO("Q"),I,J,K,Y,II,IJ,JJ

 K APCLSITE,APCLQ,APCL80D,APCLDT,APCLDTP,APCLEDY,APCLPG,APCLBDY,APCLSLCT,APCL1,APCL11,APCL1SV,APCLALLP,APCLALLR,APCLALLI,APCLDSP,APCLI,APCLICDD,APCLICDG,APCLIDFN,APCLINM,APCLINO,APCLIRNG,APCLMSG,APCLPDFN,APCLPNO,APCLPN0,APCLPNM,APCLJOB,APCLBT

 K APCL,APCLPNO1,APCLNOSP,APCLCNT,APCLCNTR,APCLGOT,APCLHRN,APCLICNO,APCLLIM,APCLPRV,APCLSKP,APCLCAR,APCLPPR,APCLPRNG,APCLPTNM,APCLVDFN,APCLVDT,APCLVNO,APCLVN0,APCL2,APCLED,APCLS,APCLBD,APCLHAG,APCLHAGE,APCLLAG,APCLLAGE,APCLPDYS

 K APCLPAT,DOB,APCLSC,APCLSCP,APCLTYPE,APCLTYPP,APCLCLN,APCLCLNP,APCLTABL,APCLSD,APCLLOC,APCLLOCP,APCLPOVD,APCLIJ,APCLPNUM

APCLAUD0  ; IHS/CMI/LAB - more audit report ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

PROV       KILL APCLSLCT

PROV00     DO PROV01

           GOTO PROV11

PROV01     SET APCLMSG="PROVIDER Selection"

           IF $DATA(IOF)

               WRITE @IOF

           DO APCLMSGO

PROV02     DO ICDB1^APCLAUD

 +1        IF $DATA(APCLSLCT)

               WRITE !

 +2        SET APCLPRV=0

           FOR APCLI=0:0

               SET APCLPRV=$ORDER(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV",APCLPRV))

               IF APCLPRV'=+APCLPRV

                   QUIT

               WRITE !,"Provider: ",$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLPRV,0),U),1:$PIECE(^DIC(16,$PIECE(^DIC(6,APCLPRV,0),"^"),0),"^"))

 +3        IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","NOSORT"))

               WRITE !!,"No Primary Provider criteria selected."

 +4        IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","ALL"))

               WRITE !!,"ALL Providers Selected."

 +5        QUIT

PROV11     IF $DATA(APCLSLCT)

               GOTO PROV1

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you want the Audit Search by Provider"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               IF APCLIRNG>1

                   SET APCLIRNG=APCLIRNG-1

                   SET APCLSLCT=""

               SET APCLICDG=$SELECT($DATA(APCLSLCT):"ICDE1^APCLAUD",1:"ICDB11^APCLAUD")

               GOTO @APCLICDG

 +3        IF Y=1

               GOTO PROV111

 +4        SET ^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","NOSORT")=""

           GOTO PROVN

PROV111   ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you want ALL Providers"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO PROV11

 +3        IF Y=1

               SET ^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV","ALL")=""

               GOTO PROVN

 +4        WRITE !!,"The Audit Search will include only Visits for which the Primary Provider",!,"matches the one(s) you select."

PROV1      WRITE !

           IF $PIECE(^DD(9000010.06,.01,0),U,2)[6

               SET DIC="^DIC(6,"

               SET DIC("A")="Select Provider: "

               SET DIC(0)="AEMQ"

               DO ^DIC

 +1        IF $PIECE(^DD(9000010.06,.01,0),U,2)[200

               SET DIC="^VA(200,"

               SET DIC("A")="Select Provider: "

               SET DIC(0)="AEMQ"

               SET D="AK.PROVIDER"

               DO MIX^DIC1

PROV2      IF X["^"

               GOTO PROV11

           IF Y=-1

               IF $DATA(APCLSLCT)

                   GOTO PROVN

 +1        IF Y=-1

               GOTO PROV1

 +2        SET (^XTMP("APCLAUD",APCLJOB,APCLBT,"PROV",+Y),APCLSLCT)=""

           GOTO PROV00

PROVN      SET APCLMSG="SEARCH Criteria"

           IF $DATA(IOF)

               WRITE @IOF

           DO APCLMSGO

 +1        DO PROV02

           WRITE !!,"The Audit Search can report on all Visits that match the above criteria,",!,"or it can report on a randomized sampling of matching Visits."

 +2        SET DIR(0)="S^A:ALL Visits that match;R:Random sample of visits that match"

           SET DIR("A")="Which visit set"

           SET DIR("B")="A"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO PROV111

 +4        IF Y="A"

               SET ^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND","ALL")=""

               GOTO ZIS

 +5        SET DIR(0)="N^1:1000:0"

           SET DIR("A")="How many randomized visits do you want in the report"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +6        IF $DATA(DIRUT)

               GOTO PROVN

 +7        SET ^XTMP("APCLAUD",APCLJOB,APCLBT,"RAND",X)=""

 +8        GOTO ZIS

APCLMSGO   WRITE ?30,"*** Audit Search ***",!!

 +1        WRITE ?80-$LENGTH(APCLMSG)\2,APCLMSG,!!

           QUIT

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO PROV

 +3        KILL APCLSLCT

 +4        SET XBNS="APCL"

           SET XBNS("^XTMP(""APCLAUD"",APCLJOB,APCLBT,")=""

           SET XBRC="^APCLAUD1"

           SET XBRP="^APCLAUD2"

           SET XBRX="QUIT^APCLAUD0"

 +5        DO ^XBDBQUE

QUIT       DO ^%ZISC

           KILL DIC,%DT,ZTSK,ZTQUEUED,IO("Q"),I,J,K,Y,II,IJ,JJ

 +1        KILL APCLSITE,APCLQ,APCL80D,APCLDT,APCLDTP,APCLEDY,APCLPG,APCLBDY,APCLSLCT,APCL1,APCL11,APCL1SV,APCLALLP,APCLALLR,APCLALLI,APCLDSP,APCLI,APCLICDD,APCLICDG,APCLIDFN,APCLINM,APCLINO,APCLIRNG,APCLMSG,APCLPDFN,APCLPNO,APCLPN0,APCLPNM,APCLJOB,APCLBT

 +2        KILL APCL,APCLPNO1,APCLNOSP,APCLCNT,APCLCNTR,APCLGOT,APCLHRN,APCLICNO,APCLLIM,APCLPRV,APCLSKP,APCLCAR,APCLPPR,APCLPRNG,APCLPTNM,APCLVDFN,APCLVDT,APCLVNO,APCLVN0,APCL2,APCLED,APCLS,APCLBD,APCLHAG,APCLHAGE,APCLLAG,APCLLAGE,APCLPDYS

 +3        KILL APCLPAT,DOB,APCLSC,APCLSCP,APCLTYPE,APCLTYPP,APCLCLN,APCLCLNP,APCLTABL,APCLSD,APCLLOC,APCLLOCP,APCLPOVD,APCLIJ,APCLPNUM

 +4        QUIT

APCLAUD0.m