Routine: APCLRT1

APCLRT1 ; IHS/CMI/LAB - APC visit counts by selected vars ;

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

START ;

 I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q

 S APCLSITE=DUZ(2)

 S APCLJOB=$J,APCLBTH=$H

 D INFORM

GETDATES ;

BD ;get beginning date

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

 I $D(DIRUT) G XIT

 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 Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S APCLED=Y

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

CLINIC ;

 S (APCLCLTY,APCLFCLN,APCLTCLN)=""

 S DIR(0)="S^S:Returns from one particular clinic to the same clinic;A:Returns from any clinic to any clinic;O:Returns from one particular clinic to any other clinic;P:Returns from any clinic to one particular clinic"

 S DIR("A")="Select which scenario",DIR("B")="O" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) GETDATES

 S APCLCLTY=Y

 I APCLCLTY="A" S APCLFCLN="",APCLTCLN="" G LOC

 I APCLCLTY="S" D SCLN I APCLFCLN="" G CLINIC

 I APCLCLTY="O" D FCLN I APCLFCLN="" G CLINIC

 I APCLCLTY="P" D TCLN I APCLTCLN="" G CLINIC

LOC ;get location

 K APCLLOC

 S DIR(0)="S^O:One Location;T:Taxonomy of Predefined Locations;A:All Locations"

 S DIR("A")="Include visits from which set of locations",DIR("B")="O" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) BD

 I Y="A" K APCLLOC G HR

 I Y="O" D O G:$D(APCLQ) LOC

 I Y="T" D T G:$D(APCLQ) LOC

HR ;48 or 72 hr

 S APCLHR=7

 ;S DIR(0)="S^7:72 HOURS;4:48 HOURS",DIR("A")="Run Report for returns w/in how many hours",DIR("B")="7" KILL DA D ^DIR KILL DIR

 ;I $D(DIRUT) G LOC

 ;S APCLHR=Y

DEF ;S X=30,DIC(0)="M",DIC="^DIC(40.7," D ^DIC K DIC,X I Y=-1 W !!,"CLINIC CODE 30 - EMERGENCY ROOM MISSING FROM FILE - NOTIFY YOUR SITE MANAGER!!" G XIT

 ;S APCLRTCL=+Y

PROV ;one provider or all

 S APCLPROV=""

 S DIR(0)="S^A:ANY Provider;O:One particular Provider",DIR("A")="Include Returns from Clinic Visits to",DIR("B")="A" K DA D ^DIR K DIR

 G:$D(DIRUT) GETDATES

 I Y="A" G DX

PRV ;get provider which the patient should have been seen prior

 ;to returning to ER

 W !!,"You must indicate in which provider the patient was to have seen seen prior",!,"to returning to the Emergency Room",!

 S DIC("A")="Which Provider: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:X="^" PROV K DIC,DA G:Y<0 PRV

 S APCLPROV=+Y

DX ;should other visit have the same diagnosis?

 S APCLSDX=""

 S DIR(0)="Y",DIR("A")="Should the visits have the same primary diagnosis",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G PROV

 S APCLSDX=Y

INC ;

 S APCLEINC=""

 S DIR(0)="Y",DIR("A")="Should Incomplete visits be excluded",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G DX

 S APCLEINC=Y

ZIS ;call to XBDBQUE

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G PROV

 S XBRP="^APCLRT1P",XBRC="^APCLRT11",XBRX="XIT^APCLRT1",XBNS="APCL"

 D ^XBDBQUE

 D XIT

XIT ;

 K APCL1,APCL2,APCL3D,APCLAGE,APCLAP,APCLBD,APCLBDD,APCLBT,APCLBTH,APCLCLIN,APCLCLN,APCLDATE,APCLDFN,APCLDISC,APCLDT,APCLED,APCLEDD,APCLRTCL,APCLET,APCLFAC,APCLFRST,APCLFVD,APCLHIGH,APCLHRCN,APCLIVD,APCLJOB,APCLLOC,APCLLOCC,APCLNAME

 K APCLODAT,APCLP,APCLPG,APLCPPOV,APCLQUIT,APCLSD,APCLSITE,APCLSKIP,APCLT1,APCLT2,APCLV,APCLVD,APCLVDFN,APCLVLOC,APCLVREC,APCLX,APCLY,APCLZ

 K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,DA,D0,DR,DIC,DIE,DIR,DTOUT,DUOUT,H,M,S

INFORM ;

 W:$D(IOF) @IOF

 W !!,"This report will produce a list of patient visits.  The visits are those",!,"for which the patient had a clinic visit and then returned within 72 hours  "

 W !,"of that visit to the same clinic or to another clinic."

 W !,"The user selects which clinic and which location of encounter.",!

 W "The user may limit the list to just visits to a particular provider."

TCLN ;get clinic at which the patient should have been seen prior

 S (APCLFCLN,APCLTCLN)=""

 W !!,"You must indicate in which clinic the patient returned to",!,"w/in 72 hours of another clinic visit."

 S DIC("A")="Which Clinic: ",DIC="^DIC(40.7,",DIC(0)="AEMQ" D ^DIC K DIC,DA

 Q:X="^"

 Q:Y<0

 S APCLTCLN=+Y,APCLFCLN=""

FCLN ;get clinic at which the patient should have been seen prior

 S (APCLFCLN,APCLTCLN)=""

 W !!,"You must indicate in which clinic the patient was seen and returned",!,"to any clinic w/in 72 hours.",!

 S DIC("A")="Which Clinic: ",DIC="^DIC(40.7,",DIC(0)="AEMQ" D ^DIC K DIC,DA

 Q:X="^"

 Q:Y<0

 S APCLFCLN=+Y,APCLTCLN=""

SCLN ;get clinic at which the patient should have been seen prior

 S (APCLFCLN,APCLTCLN)=""

 W !!,"You must indicate in which clinic the patient was seen and returned",!,"to w/in 72 hours.",!

 S DIC("A")="Which Clinic: ",DIC="^DIC(40.7,",DIC(0)="AEMQ" D ^DIC K DIC,DA

 Q:X="^"

 Q:Y<0

 S (APCLFCLN,APCLTCLN)=+Y

O ;EP one location

 K APCLQ

 S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC

 I Y=-1 S APCLQ="" Q

 S APCLLOC(+Y)=""

T ;

 K APCLQ

 S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=9999999.06" D ^DIC K DIC

 I Y=-1 S APCLQ="" Q

 S X=0 F  S X=$O(^ATXAX(+Y,21,"B",X)) Q:X=""  S APCLLOC(X)=""

APCLRT1   ; IHS/CMI/LAB - APC visit counts by selected vars ;

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

 +2       ;

START     ;

 +1        IF '$GET(DUZ(2))

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!

               QUIT

 +2        SET APCLSITE=DUZ(2)

 +3        SET APCLJOB=$JOB

           SET APCLBTH=$HOROLOG

 +4        DO INFORM

 +5       ;

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^: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 XIT

 +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 Y=""

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET APCLED=Y

 +4        SET X1=APCLBD

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

 +5       ;

CLINIC    ;

 +1        SET (APCLCLTY,APCLFCLN,APCLTCLN)=""

 +2        SET DIR(0)="S^S:Returns from one particular clinic to the same clinic;A:Returns from any clinic to any clinic;O:Returns from one particular clinic to any other clinic;P:Returns from any clinic to one particular clinic"

 +3        SET DIR("A")="Select which scenario"

           SET DIR("B")="O"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO GETDATES

 +5        SET APCLCLTY=Y

 +6        IF APCLCLTY="A"

               SET APCLFCLN=""

               SET APCLTCLN=""

               GOTO LOC

 +7        IF APCLCLTY="S"

               DO SCLN

               IF APCLFCLN=""

                   GOTO CLINIC

 +8        IF APCLCLTY="O"

               DO FCLN

               IF APCLFCLN=""

                   GOTO CLINIC

 +9        IF APCLCLTY="P"

               DO TCLN

               IF APCLTCLN=""

                   GOTO CLINIC

LOC       ;get location

 +1        KILL APCLLOC

 +2        SET DIR(0)="S^O:One Location;T:Taxonomy of Predefined Locations;A:All Locations"

 +3        SET DIR("A")="Include visits from which set of locations"

           SET DIR("B")="O"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO BD

 +5        IF Y="A"

               KILL APCLLOC

               GOTO HR

 +6        IF Y="O"

               DO O

               IF $DATA(APCLQ)

                   GOTO LOC

 +7        IF Y="T"

               DO T

               IF $DATA(APCLQ)

                   GOTO LOC

HR        ;48 or 72 hr

 +1        SET APCLHR=7

 +2       ;S DIR(0)="S^7:72 HOURS;4:48 HOURS",DIR("A")="Run Report for returns w/in how many hours",DIR("B")="7" KILL DA D ^DIR KILL DIR

 +3       ;I $D(DIRUT) G LOC

 +4       ;S APCLHR=Y

DEF       ;S X=30,DIC(0)="M",DIC="^DIC(40.7," D ^DIC K DIC,X I Y=-1 W !!,"CLINIC CODE 30 - EMERGENCY ROOM MISSING FROM FILE - NOTIFY YOUR SITE MANAGER!!" G XIT

 +1       ;S APCLRTCL=+Y

PROV      ;one provider or all

 +1        SET APCLPROV=""

 +2        SET DIR(0)="S^A:ANY Provider;O:One particular Provider"

           SET DIR("A")="Include Returns from Clinic Visits to"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO GETDATES

 +4        IF Y="A"

               GOTO DX

PRV       ;get provider which the patient should have been seen prior

 +1       ;to returning to ER

 +2        WRITE !!,"You must indicate in which provider the patient was to have seen seen prior",!,"to returning to the Emergency Room",!

 +3        SET DIC("A")="Which Provider: "

           SET DIC="^VA(200,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF X="^"

               GOTO PROV

           KILL DIC,DA

           IF Y<0

               GOTO PRV

 +4        SET APCLPROV=+Y

DX        ;should other visit have the same diagnosis?

 +1        SET APCLSDX=""

 +2        SET DIR(0)="Y"

           SET DIR("A")="Should the visits have the same primary diagnosis"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO PROV

 +4        SET APCLSDX=Y

INC       ;

 +1        SET APCLEINC=""

 +2        SET DIR(0)="Y"

           SET DIR("A")="Should Incomplete visits be excluded"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO DX

 +4        SET APCLEINC=Y

ZIS       ;call to XBDBQUE

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO PROV

 +3        SET XBRP="^APCLRT1P"

           SET XBRC="^APCLRT11"

           SET XBRX="XIT^APCLRT1"

           SET XBNS="APCL"

 +4        DO ^XBDBQUE

 +5        DO XIT

 +6        QUIT

XIT       ;

 +1        KILL APCL1,APCL2,APCL3D,APCLAGE,APCLAP,APCLBD,APCLBDD,APCLBT,APCLBTH,APCLCLIN,APCLCLN,APCLDATE,APCLDFN,APCLDISC,APCLDT,APCLED,APCLEDD,APCLRTCL,APCLET,APCLFAC,APCLFRST,APCLFVD,APCLHIGH,APCLHRCN,APCLIVD,APCLJOB,APCLLOC,APCLLOCC,APCLNAME

 +2        KILL APCLODAT,APCLP,APCLPG,APLCPPOV,APCLQUIT,APCLSD,APCLSITE,APCLSKIP,APCLT1,APCLT2,APCLV,APCLVD,APCLVDFN,APCLVLOC,APCLVREC,APCLX,APCLY,APCLZ

 +3        KILL X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,DA,D0,DR,DIC,DIE,DIR,DTOUT,DUOUT,H,M,S

 +4        QUIT

INFORM    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!,"This report will produce a list of patient visits.  The visits are those",!,"for which the patient had a clinic visit and then returned within 72 hours  "

 +3        WRITE !,"of that visit to the same clinic or to another clinic."

 +4        WRITE !,"The user selects which clinic and which location of encounter.",!

 +5        WRITE "The user may limit the list to just visits to a particular provider."

 +6        QUIT

 +7       ;

TCLN      ;get clinic at which the patient should have been seen prior

 +1        SET (APCLFCLN,APCLTCLN)=""

 +2        WRITE !!,"You must indicate in which clinic the patient returned to",!,"w/in 72 hours of another clinic visit."

 +3        SET DIC("A")="Which Clinic: "

           SET DIC="^DIC(40.7,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +4        IF X="^"

               QUIT

 +5        IF Y<0

               QUIT

 +6        SET APCLTCLN=+Y

           SET APCLFCLN=""

 +7        QUIT

FCLN      ;get clinic at which the patient should have been seen prior

 +1        SET (APCLFCLN,APCLTCLN)=""

 +2        WRITE !!,"You must indicate in which clinic the patient was seen and returned",!,"to any clinic w/in 72 hours.",!

 +3        SET DIC("A")="Which Clinic: "

           SET DIC="^DIC(40.7,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +4        IF X="^"

               QUIT

 +5        IF Y<0

               QUIT

 +6        SET APCLFCLN=+Y

           SET APCLTCLN=""

 +7        QUIT

SCLN      ;get clinic at which the patient should have been seen prior

 +1        SET (APCLFCLN,APCLTCLN)=""

 +2        WRITE !!,"You must indicate in which clinic the patient was seen and returned",!,"to w/in 72 hours.",!

 +3        SET DIC("A")="Which Clinic: "

           SET DIC="^DIC(40.7,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +4        IF X="^"

               QUIT

 +5        IF Y<0

               QUIT

 +6        SET (APCLFCLN,APCLTCLN)=+Y

 +7        QUIT

O         ;EP one location

 +1        KILL APCLQ

 +2        SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Which LOCATION: "

           DO ^DIC

           KILL DIC

 +3        IF Y=-1

               SET APCLQ=""

               QUIT

 +4        SET APCLLOC(+Y)=""

 +5        QUIT

T         ;

 +1        KILL APCLQ

 +2        SET DIC="^ATXAX("

           SET DIC(0)="AEMQ"

           SET DIC("A")="Which TAXONOMY: "

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

           DO ^DIC

           KILL DIC

 +3        IF Y=-1

               SET APCLQ=""

               QUIT

 +4        SET X=0

FOR

               SET X=$ORDER(^ATXAX(+Y,21,"B",X))

               IF X=""

                   QUIT

               SET APCLLOC(X)=""

 +5        QUIT

APCLRT1.m