APCDFOA ; IHS/CMI/LAB - QA AUDIT ON ICD PROCEDURE CODES ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
START ;
S APCDSITE="" S:$D(DUZ(2)) APCDSITE=DUZ(2)
I '$D(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! K APCDSITE Q
I 'DUZ(2) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER",!! K APCDSITE Q
W:$D(IOF) @IOF
S APCDLHDR="ICD OPERATION/PROCEDURE CODING AUDIT"
W !?((80-$L(APCDLHDR))/2),APCDLHDR
W !!,"This report will list visits (by POSTING date with an option of random",!,"samples) for a selected data entry operator. Purpose of Visit ",!,"ICD OPERATION/PROCEDURE Code and Provider Narrative will also be listed.",!!
S APCDJOB=$J,APCDBT=$H
K ^XTMP("APCDFOA",APCDJOB,APCDBT)
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning POSTING Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G XIT
S APCDBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter Ending POSTING Date: " S Y=APCDBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S APCDED=Y
S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
;
PROV S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Enter DATA ENTRY OPERATOR: " D ^DIC K DIC
I $D(DTOUT)!(Y=-1) G BD
S APCDPROV=+Y
CLN S APCDCLN="",DIR(0)="YO",DIR("A")="Want to limit search by CLINIC TYPE",DIR("B")="NO",DIR("?")="" D ^DIR K DIR
I $E(X)=U!($D(DTOUT)) G PROV
I $E(X)="N" G ICD
S DIC="^DIC(40.7,",DIC(0)="AEQM",DIC("A")="Clinic: "
D ^DIC K DIC,DA
G:Y=-1 CLN
S APCDCLN=+Y
;
ICD ;
K ^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV"),DA,DIR,DTOUT,DIRUT,Y,X,DIC
S DIR(0)="Y",DIR("A")="Do you wish to include only a subset of ICD OPERATION/PROCEDURE Codes",DIR("B")="NO",DIR("?")="If you wish to limit the search of POV's to a subset of ICD OPERATION/PROCEDURE Codes, enter Y" D ^DIR K DIR
G:$D(DIRUT) CLN
I Y=0 S ^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV","ALL")="" G RAND
K APCDTABL D ^APCDFOA3
I '$D(APCDTABL) G ICD
RAND ;
S APCDMAX="",DIR(0)="Y",DIR("A")="Do you want ALL Visits Selected",DIR("B")="N",DIR("?")="If you want ALL Visits in this date range displayed Answer Y, if you want a random sample answer NO." D ^DIR K DIR
I $D(DTOUT)!(X="^") G ICD
I Y=1 S APCDRSM=0 G ZIS
S DIR(0)="N^1:100:",DIR("A")="How many randomized visits do you want" D ^DIR K DIR
I $D(DIRUT) G RAND
S APCDMAX=Y,APCDRSM=1
ZIS W !! S %ZIS="PQM" D ^%ZIS
I POP G XIT
I $D(IO("Q")) G TSKMN
DRIVER ; entry point for taskman
ZTSK ;
D ^APCDFOA1
S APCDDT=$$FMTE^XLFDT(DT)
U IO
D ^APCDFOAP
I $D(ZTQUEUED) S ZTREQ="@"
K ^XTMP("APCDFOA",APCDJOB,APCDBT)
D XIT
Q
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
TSKMN ;
S ZTIO=""
S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
K ZTSAVE F %="APCDMAX","APCDBD","APCDED","APCDSD","APCDPROV","APCDCLN","APCDJOB","APCDBT","APCDLHDR","^XTMP(""APCDFOA"",APCDJOB,APCDBT," S ZTSAVE(%)=""
S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCDFOA",ZTDTH="",ZTDESC="PCC DE QA" D ^%ZTLOAD D XIT Q
;
;
XIT ;
D ^%ZISC
I '$D(ZTSK) S IOP="HOME" D ^%ZIS U IO(0)
K DIC,%DT,IO("Q"),X,Y,POP,DIRUT,ZTSK,ZTIO
K APCD1,APCD2,APCD80D,APCDBD,APCDBDD,APCDBT,APCDCLN,APCDDATE,APCDDT,APCDED,APCDEDD,APCDHRN,APCDLENG,APCDMAX,APCDNQ,APCDQUIT,APCDC,APCDDFN,APCDSLCT,APCDIRNG,APCD1SV,APCD1,APCDI,APCDDLT,APCD2,APCD11,APCDQ,APCDMSG,APCDDSP,APCDICDD,APCDLHDR
K APCDODAT,APCDPAT,APCDPG,APCDPOV,APCDPOVA,APCDPOVC,APCDPOVD,APCDPOVN,APCDPROV,APCDSD,APCDSITE,APCDVCNT,APCDVDFN,APCDVREC,APCDGOT,APCDX,APCDJOB,APCDBT,APCDICDP,APCDTABL,APCDRSM
Q
APCDFOA ; IHS/CMI/LAB - QA AUDIT ON ICD PROCEDURE CODES ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
START ;
+1 SET APCDSITE=""
IF $DATA(DUZ(2))
SET APCDSITE=DUZ(2)
+2 IF '$DATA(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
KILL APCDSITE
QUIT
+3 IF 'DUZ(2)
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER",!!
KILL APCDSITE
QUIT
+4 IF $DATA(IOF)
WRITE @IOF
+5 SET APCDLHDR="ICD OPERATION/PROCEDURE CODING AUDIT"
+6 WRITE !?((80-$LENGTH(APCDLHDR))/2),APCDLHDR
+7 WRITE !!,"This report will list visits (by POSTING date with an option of random",!,"samples) for a selected data entry operator. Purpose of Visit ",!,"ICD OPERATION/PROCEDURE Code and Provider Narrative will also be listed.",!!
+8 SET APCDJOB=$JOB
SET APCDBT=$HOROLOG
+9 KILL ^XTMP("APCDFOA",APCDJOB,APCDBT)
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter Beginning POSTING Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET APCDBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCDBD_":DT:EP"
SET DIR("A")="Enter Ending POSTING Date: "
SET Y=APCDBD
DO DD^%DT
SET DIR("B")=Y
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCDED=Y
+4 SET X1=APCDBD
SET X2=-1
DO C^%DTC
SET APCDSD=X
+5 ;
PROV SET DIC="^VA(200,"
SET DIC(0)="AEQM"
SET DIC("A")="Enter DATA ENTRY OPERATOR: "
DO ^DIC
KILL DIC
+1 IF $DATA(DTOUT)!(Y=-1)
GOTO BD
+2 SET APCDPROV=+Y
CLN SET APCDCLN=""
SET DIR(0)="YO"
SET DIR("A")="Want to limit search by CLINIC TYPE"
SET DIR("B")="NO"
SET DIR("?")=""
DO ^DIR
KILL DIR
+1 IF $EXTRACT(X)=U!($DATA(DTOUT))
GOTO PROV
+2 IF $EXTRACT(X)="N"
GOTO ICD
+3 SET DIC="^DIC(40.7,"
SET DIC(0)="AEQM"
SET DIC("A")="Clinic: "
+4 DO ^DIC
KILL DIC,DA
+5 IF Y=-1
GOTO CLN
+6 SET APCDCLN=+Y
+7 ;
ICD ;
+1 KILL ^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV"),DA,DIR,DTOUT,DIRUT,Y,X,DIC
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to include only a subset of ICD OPERATION/PROCEDURE Codes"
SET DIR("B")="NO"
SET DIR("?")="If you wish to limit the search of POV's to a subset of ICD OPERATION/PROCEDURE Codes, enter Y"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO CLN
+4 IF Y=0
SET ^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV","ALL")=""
GOTO RAND
+5 KILL APCDTABL
DO ^APCDFOA3
+6 IF '$DATA(APCDTABL)
GOTO ICD
RAND ;
+1 SET APCDMAX=""
SET DIR(0)="Y"
SET DIR("A")="Do you want ALL Visits Selected"
SET DIR("B")="N"
SET DIR("?")="If you want ALL Visits in this date range displayed Answer Y, if you want a random sample answer NO."
DO ^DIR
KILL DIR
+2 IF $DATA(DTOUT)!(X="^")
GOTO ICD
+3 IF Y=1
SET APCDRSM=0
GOTO ZIS
+4 SET DIR(0)="N^1:100:"
SET DIR("A")="How many randomized visits do you want"
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO RAND
+6 SET APCDMAX=Y
SET APCDRSM=1
ZIS WRITE !!
SET %ZIS="PQM"
DO ^%ZIS
+1 IF POP
GOTO XIT
+2 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ; entry point for taskman
ZTSK ;
+1 DO ^APCDFOA1
+2 SET APCDDT=$$FMTE^XLFDT(DT)
+3 USE IO
+4 DO ^APCDFOAP
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 KILL ^XTMP("APCDFOA",APCDJOB,APCDBT)
+7 DO XIT
+8 QUIT
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
TSKMN ;
+1 SET ZTIO=""
+2 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
IF $DATA(IOST)#2
IF IOST]""
SET ZTIO=ZTIO_";"_IOST
+3 IF $GET(IO("DOC"))]""
SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
+4 IF $DATA(IOM)#2
IF IOM
SET ZTIO=ZTIO_";"_IOM
IF $DATA(IOSL)#2
IF IOSL
SET ZTIO=ZTIO_";"_IOSL
+5 KILL ZTSAVE
FOR %="APCDMAX","APCDBD","APCDED","APCDSD","APCDPROV","APCDCLN","APCDJOB","APCDBT","APCDLHDR","^XTMP(""APCDFOA"",APCDJOB,APCDBT,"
SET ZTSAVE(%)=""
+6 SET ZTCPU=$GET(IOCPU)
SET ZTRTN="DRIVER^APCDFOA"
SET ZTDTH=""
SET ZTDESC="PCC DE QA"
DO ^%ZTLOAD
DO XIT
QUIT
+7 ;
+8 ;
XIT ;
+1 DO ^%ZISC
+2 IF '$DATA(ZTSK)
SET IOP="HOME"
DO ^%ZIS
USE IO(0)
+3 KILL DIC,%DT,IO("Q"),X,Y,POP,DIRUT,ZTSK,ZTIO
+4 KILL APCD1,APCD2,APCD80D,APCDBD,APCDBDD,APCDBT,APCDCLN,APCDDATE,APCDDT,APCDED,APCDEDD,APCDHRN,APCDLENG,APCDMAX,APCDNQ,APCDQUIT,APCDC,APCDDFN,APCDSLCT,APCDIRNG,APCD1SV,APCD1,APCDI,APCDDLT,APCD2,APCD11,APCDQ,APCDMSG,APCDDSP,APCDICDD,APCDLHDR
+5 KILL APCDODAT,APCDPAT,APCDPG,APCDPOV,APCDPOVA,APCDPOVC,APCDPOVD,APCDPOVN,APCDPROV,APCDSD,APCDSITE,APCDVCNT,APCDVDFN,APCDVREC,APCDGOT,APCDX,APCDJOB,APCDBT,APCDICDP,APCDTABL,APCDRSM
+6 QUIT
