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."
Q
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
Q
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
