Routine: APCDFQA

APCDFQA ; IHS/CMI/LAB - QA AUDIT ON ICD CODING ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

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 DIAGNOSIS 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 DIAGNOSIS Code and Provider Narrative will also be listed.",!!

 W "NOTE:  This report is based on forms tracking which would assign the coding"

 W !,"to the first operator who accessd the visit.  There is a new report:"

 W !,"DXV - DX Coding Audit for Selected Set of Visits which may better"

 W !,"reflect the user who coded the Purpose of Visit.  It uses the"

 W !,"user who last marked the visit as reviewed/complete and the user last"

 W !,"modified field for the Purpose of Visit.",!

 S APCDJOB=$J,APCDBT=$H

 K ^XTMP("APCDFQA",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

SC ;

 K APCDSCT

 K APCDSC,APCDSCT W ! S DIR(0)="YO",DIR("A")="Include ALL Visit Service Categories",DIR("B")="Yes"

 S DIR("?")="If you wish to include all visit service categories (Ambulatory,Hospitalization,etc) answer Yes.  If you wish to list visits for only one service category enter NO." D ^DIR K DIR

 G:$D(DIRUT) BD

 I Y=1 G CLN

SC1 ;enter sc

 S X="SERVICE CATEGORY",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT

 D PEP^AMQQGTX0(+Y,"APCDSCT(")

 I '$D(APCDSCT) G SC

 I $D(APCDSCT("*")) K APCDSCT

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("APCDFQA",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 Diagnoses",DIR("B")="NO",DIR("?")="If you wish to limit the search of POV's to a subset of ICD Codes, enter Y" D ^DIR K DIR

 G:$D(DIRUT) CLN

 I Y=0 S ^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ALL")="" G RAND

 K APCDTABL D ^APCDFQA3

 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 ^APCDFQA1

 S APCDDT=$$FMTE^XLFDT(DT)

 U IO

 D ^APCDFQAP

 I $D(ZTQUEUED) S ZTREQ="@"

 K ^XTMP("APCDFQA",APCDJOB,APCDBT)

 D XIT

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(""APCDFQA"",APCDJOB,APCDBT," S ZTSAVE(%)=""

 S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCDFQA",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

 K APCDODAT,APCDPAT,APCDPG,APCDPOV,APCDPOVA,APCDPOVC,APCDPOVD,APCDPOVN,APCDPROV,APCDSD,APCDSITE,APCDVCNT,APCDVDFN,APCDVREC,APCDGOT,APCDX,APCDJOB,APCDBT,APCDICDP,APCDTABL,APCDRSM,APCDLHDR

APCDFQA   ; IHS/CMI/LAB - QA AUDIT ON ICD CODING ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +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 DIAGNOSIS 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 DIAGNOSIS Code and Provider Narrative will also be listed.",!!

 +8        WRITE "NOTE:  This report is based on forms tracking which would assign the coding"

 +9        WRITE !,"to the first operator who accessd the visit.  There is a new report:"

 +10       WRITE !,"DXV - DX Coding Audit for Selected Set of Visits which may better"

 +11       WRITE !,"reflect the user who coded the Purpose of Visit.  It uses the"

 +12       WRITE !,"user who last marked the visit as reviewed/complete and the user last"

 +13       WRITE !,"modified field for the Purpose of Visit.",!

 +14       SET APCDJOB=$JOB

           SET APCDBT=$HOROLOG

 +15       KILL ^XTMP("APCDFQA",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

SC        ;

 +1        KILL APCDSCT

 +2        KILL APCDSC,APCDSCT

           WRITE !

           SET DIR(0)="YO"

           SET DIR("A")="Include ALL Visit Service Categories"

           SET DIR("B")="Yes"

 +3        SET DIR("?")="If you wish to include all visit service categories (Ambulatory,Hospitalization,etc) answer Yes.  If you wish to list visits for only one service category enter NO."

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO BD

 +5        IF Y=1

               GOTO CLN

SC1       ;enter sc

 +1        SET X="SERVICE CATEGORY"

           SET DIC="^AMQQ(5,"

           SET DIC(0)="FM"

           SET DIC("S")="I $P(^(0),U,14)"

           DO ^DIC

           KILL DIC,DA

           IF Y=-1

               WRITE "OOPS - QMAN NOT CURRENT - QUITTING"

               GOTO XIT

 +2        DO PEP^AMQQGTX0(+Y,"APCDSCT(")

 +3        IF '$DATA(APCDSCT)

               GOTO SC

 +4        IF $DATA(APCDSCT("*"))

               KILL APCDSCT

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("APCDFQA",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 Diagnoses"

           SET DIR("B")="NO"

           SET DIR("?")="If you wish to limit the search of POV's to a subset of ICD Codes, enter Y"

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO CLN

 +4        IF Y=0

               SET ^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ALL")=""

               GOTO RAND

 +5        KILL APCDTABL

           DO ^APCDFQA3

 +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 ^APCDFQA1

 +2        SET APCDDT=$$FMTE^XLFDT(DT)

 +3        USE IO

 +4        DO ^APCDFQAP

 +5        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +6        KILL ^XTMP("APCDFQA",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(""APCDFQA"",APCDJOB,APCDBT,"

               SET ZTSAVE(%)=""

 +6        SET ZTCPU=$GET(IOCPU)

           SET ZTRTN="DRIVER^APCDFQA"

           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

 +5        KILL APCDODAT,APCDPAT,APCDPG,APCDPOV,APCDPOVA,APCDPOVC,APCDPOVD,APCDPOVN,APCDPROV,APCDSD,APCDSITE,APCDVCNT,APCDVDFN,APCDVREC,APCDGOT,APCDX,APCDJOB,APCDBT,APCDICDP,APCDTABL,APCDRSM,APCDLHDR

 +6        QUIT

 +7       ;

 +8       ;

APCDFQA.m