Routine: APCLAUD

APCLAUD ; IHS/CMI/LAB - audit report ;

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

 ;location of encounter 02/13/95

START ;

 S APCLJOB=$J,APCLBT=$H

 K ^XTMP("APCLAUD",APCLJOB,APCLBT),APCLTABL S APCLIRNG=0,APCLPRNG=1

 D XTMP^APCLOSUT("APCLAUD","PCC AUDIT REPORT")

 D XTMP^APCLOSUT("APCLAUD2","PCC AUDIT REPORT")

GO W:$D(IOF) @IOF

 S APCLMSG="VISIT DATE RANGE Selection" D APCLMSGO

GETDATES ;

BD ;get beginning date

 W ! S DIR(0)="DA^:DT:EP",DIR("A")="Enter beginning Visit Date for Search:  " D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G QUIT

 S APCLBD=Y

ED ;get ending date

 W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date for Search:  " S Y=APCLBD D DD^%DT S (APCLBDY)=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S APCLED=Y D DD^%DT S APCLEDY=Y

 S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X

MORE ;

 D ^APCLAUD3

 I $D(DIRUT) G GO

ICD S DIC(0)="AMEQZ",DIC="^ICD9("

ICDB S APCLMSG="ICD CODE RANGE Selection" W:$D(IOF) @IOF D APCLMSGO

 D ICDB1 G ICDB11

ICDB1  ;EP

 W !,"Visit Date Range: ",APCLBDY," through ",APCLEDY,"."

 I '$D(APCLLAGE) W !!,"No Age Range restrictions." G ICDB10

 W !!,"Age Range Selected: ",APCLLAGE," - ",APCLHAGE," Years."

ICDB10 I $D(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN","ALL")) W !!,"All ICD Coded Diagnoses will be included." G ICDB101

 I APCLIRNG>0 W ! F APCLI=1:1:APCLIRNG W !,"ICD Code Range ",APCLI,": ",^XTMP("APCLAUD",APCLJOB,APCLBT,APCLI,"ICDB")," through ",^XTMP("APCLAUD",APCLJOB,APCLBT,APCLI,"ICDE"),"."

ICDB101 ;

 W !!,"Sex Selected: ",$S($D(APCLSEX):APCLSEXP,1:"ALL")

 W !!,"Service Category Selected: ",$S($D(APCLSC):APCLSCP,1:"ALL")

 W !!,"Visit Type Selected: ",$S($D(APCLTYPE):APCLTYPP,1:"ALL")

 W !!,"Visit Location of Encounter:  ",$S($D(APCLLOC):APCLLOCP,1:"ALL")

 W !!,"Visit Clinic Type Selected: ",$S($D(APCLCLN):APCLCLNP,1:"ALL")

ICDB11 ;

 S DIR(0)="Y",DIR("A")="Do you want all ICD Coded diagnoses in the report",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

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

ICDB2 D ^APCLAUD5

ICDE1 W:$D(IOF) @IOF

 G ^APCLAUD0

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

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

QUIT ;

 K APCLBT,APCLJOB,DIR,APCLPOVD

APCLAUD   ; IHS/CMI/LAB - audit report ;

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

 +2       ;

 +3       ;location of encounter 02/13/95

START     ;

 +1        SET APCLJOB=$JOB

           SET APCLBT=$HOROLOG

 +2        KILL ^XTMP("APCLAUD",APCLJOB,APCLBT),APCLTABL

           SET APCLIRNG=0

           SET APCLPRNG=1

 +3        DO XTMP^APCLOSUT("APCLAUD","PCC AUDIT REPORT")

 +4        DO XTMP^APCLOSUT("APCLAUD2","PCC AUDIT REPORT")

GO         IF $DATA(IOF)

               WRITE @IOF

 +1        SET APCLMSG="VISIT DATE RANGE Selection"

           DO APCLMSGO

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="DA^:DT:EP"

           SET DIR("A")="Enter beginning Visit Date for Search:  "

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO QUIT

 +3        SET APCLBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="DA^"_APCLBD_":DT:EP"

           SET DIR("A")="Enter ending Visit Date for Search:  "

           SET Y=APCLBD

           DO DD^%DT

           SET (APCLBDY)=Y

           SET Y=""

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET APCLED=Y

           DO DD^%DT

           SET APCLEDY=Y

 +4        SET X1=APCLBD

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

 +5       ;

MORE      ;

 +1        DO ^APCLAUD3

 +2        IF $DATA(DIRUT)

               GOTO GO

ICD        SET DIC(0)="AMEQZ"

           SET DIC="^ICD9("

ICDB       SET APCLMSG="ICD CODE RANGE Selection"

           IF $DATA(IOF)

               WRITE @IOF

           DO APCLMSGO

 +1        DO ICDB1

           GOTO ICDB11

ICDB1     ;EP

 +1        WRITE !,"Visit Date Range: ",APCLBDY," through ",APCLEDY,"."

 +2        IF '$DATA(APCLLAGE)

               WRITE !!,"No Age Range restrictions."

               GOTO ICDB10

 +3        WRITE !!,"Age Range Selected: ",APCLLAGE," - ",APCLHAGE," Years."

ICDB10     IF $DATA(^XTMP("APCLAUD",APCLJOB,APCLBT,"ICDDFN","ALL"))

               WRITE !!,"All ICD Coded Diagnoses will be included."

               GOTO ICDB101

 +1        IF APCLIRNG>0

               WRITE !

               FOR APCLI=1:1:APCLIRNG

                   WRITE !,"ICD Code Range ",APCLI,": ",^XTMP("APCLAUD",APCLJOB,APCLBT,APCLI,"ICDB")," through ",^XTMP("APCLAUD",APCLJOB,APCLBT,APCLI,"ICDE"),"."

ICDB101   ;

 +1        WRITE !!,"Sex Selected: ",$SELECT($DATA(APCLSEX):APCLSEXP,1:"ALL")

 +2        WRITE !!,"Service Category Selected: ",$SELECT($DATA(APCLSC):APCLSCP,1:"ALL")

 +3        WRITE !!,"Visit Type Selected: ",$SELECT($DATA(APCLTYPE):APCLTYPP,1:"ALL")

 +4        WRITE !!,"Visit Location of Encounter:  ",$SELECT($DATA(APCLLOC):APCLLOCP,1:"ALL")

 +5        WRITE !!,"Visit Clinic Type Selected: ",$SELECT($DATA(APCLCLN):APCLCLNP,1:"ALL")

 +6        QUIT

ICDB11    ;

 +1        SET DIR(0)="Y"

           SET DIR("A")="Do you want all ICD Coded diagnoses in the report"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        IF Y=1

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

               GOTO ^APCLAUD0

ICDB2      DO ^APCLAUD5

ICDE1      IF $DATA(IOF)

               WRITE @IOF

 +1        GOTO ^APCLAUD0

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

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

           QUIT

QUIT      ;

 +1        KILL APCLBT,APCLJOB,DIR,APCLPOVD

 +2        QUIT

APCLAUD.m