AMHRNOAT.m

AMHRNOAT ; IHS/CMI/LAB - report of a patient's no show visits ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28

 ;

 ;

START ;EP - called from option

 D XIT

 W:$D(IOF) @IOF

 S X="LISTING OF EHR VISITS WITH NO ACTIVITY TIME" W !,$$CTR^AMHLEIN(X,80)

 W !!,"This option will print a list of visits created through EHR/PCC "

 W !,"that do not have an Activity time. The user will be able to specify "

 W !,"the date range and whether to include all visits or just those visits"

 W !,"for one provider.",!

 D DBHUSR^AMHUTIL

GETDATES ;

 W !!,"Please enter the date range."

BD ;get beginning date

 S DIR(0)="D^:DT:EP",DIR("A")="Enter Beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S AMHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter Ending Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S AMHED=Y

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

PROV ;

 S AMHPROV=""

 S DIR(0)="S^A:All Providers;O:One Provider",DIR("A")="Include visits for",DIR("B")="A" K DA D ^DIR K DIR

 G:$D(DIRUT) GETDATES

 I Y="A" G SORT

 S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC

 K DIC,DA

 I Y=-1 G PROV

 S AMHPROV=+Y

SORT ;

 S AMHSORT=""

 S DIR(0)="S^P:Patient Name;D:Date of Visit",DIR("A")="How would you like the report sorted",DIR("B")="P" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) PROV

 S AMHSORT=Y

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G SORT

ZIS ;

 S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) G XIT

 I $G(Y)="B" D BROWSE,XIT Q

 W !! S XBRP="PRINT^AMHRNOAT",XBRC="PROC^AMHRNOAT",XBNS="AMH*",XBRX="XIT^AMHRNOAT"

 D ^XBDBQUE

 D XIT

 Q

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^AMHRNOAT"")"

 S XBNS="AMH",XBRC="PROC^AMHRNOAT",XBRX="XIT^AMHRNOAT",XBIOP=0 D ^XBDBQUE

 Q

 ;

PROC ;EP - called from xbdbque

 ;loop through all visits in date range and look for problem 8-8.9 or visit type of N

 S AMHJOB=$J,AMHTOT=0,AMHBT=$H,AMHPTOT=0

 D XTMP^AMHUTIL("AMHRNOAT","BH - NO ACTIVITY TIME VISITS")

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X

 S AMHODAT=AMHSD_".9999" F  S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED)  D

 .S AMHR=0 F  S AMHR=$O(^AMHREC("B",AMHODAT,AMHR)) Q:AMHR'=+AMHR  D

 ..I AMHPROV,$$PPINT^AMHUTIL(AMHR)'=AMHPROV Q

 ..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)

 ..S DFN=$P(^AMHREC(AMHR,0),U,8) Q:'DFN

 ..Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)

 ..Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))

 ..I $P(^AMHREC(AMHR,0),U,12) Q

 ..D SET

 ..Q

 .Q

 Q

SET ;

 S ^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT",$S(AMHSORT="P":$P(^DPT(DFN,0),U),1:(9999999-$P(AMHODAT,"."))),AMHR)="",AMHTOT=AMHTOT+1

 I $D(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"PATIENTS",DFN)) Q

 S AMHPTOT=AMHPTOT+1

 S ^XTMP("AMHRNOAT",AMHJOB,AMHBT,"PATIENTS",DFN)=""

 Q

PRINT ;EP - called from xbdbque

 D PRINT1

 I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  PRESS RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 K ^XTMP("AMHRNOAT",AMHJOB,AMHBT),AMHJOB,AMHBT

 Q

PRINT1 ;

 K AMHQ S AMHPG=0

 I '$D(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT")) D HEADER W !!,"There were no visits without an activity time during the time period.",! Q

 D HEADER

 S AMHSORT="" F  S AMHSORT=$O(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT",AMHSORT)) Q:AMHSORT=""!($D(AMHQ))  D

 .S AMHR=0 F  S AMHR=$O(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT",AMHSORT,AMHR)) Q:AMHR'=+AMHR!($D(AMHQ))  D

 ..I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)

 ..S DFN=$P(^AMHREC(AMHR,0),U,8)

 ..W !,$E($P(^DPT(DFN,0),U),1,18),?20,$$HRN^AUPNPAT(DFN,DUZ(2)),?27,$$FMTE^XLFDT($P(^AMHREC(AMHR,0),U)),?46,$E($$PPNAME^AMHUTIL(AMHR),1,12)

 ..W ?59,$$PRIMPOV^AMHUTIL1(AMHR,"C")_"-"

 ..S X=$$PRIMPOV^AMHUTIL1(AMHR,"I") I X W $E($P(^AMHPROB(X,0),U,2),1,12)

 .Q

 Q:$D(AMHQ)

 I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)

 W !!,"Total # of Patients: ",AMHPTOT,"     Total # of Visits: ",AMHTOT,!

 Q

XIT ;

 D EN^XBVK("AMH")

 D KILL^AUPNPAT

 Q

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

HEADER ;EP

 I 'AMHPG G HEADER1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q

HEADER1 ;

 W:$D(IOF) @IOF S AMHPG=AMHPG+1

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?($S(80=132:120,1:72)),"Page ",AMHPG,!

 S AMHTEXT="Behaviorial Health Visits with No Activity Time"

 W !?(80-$L(AMHTEXT)/2),AMHTEXT,!

 S AMHTEXT="Visit Dates:  "_AMHBDD_" - "_AMHEDD

 W ?(80-$L(AMHTEXT)/2),AMHTEXT,!

 I AMHPROV S X="Provider: "_$P(^VA(200,AMHPROV,0),U) W $$CTR^AMHLEIN(X,80),!

 W !,"PATIENT NAME",?20,"HRN",?27,"DATE/TIME",?46,"PROVIDER",?59,"POV"

 W !,$TR($J(" ",80)," ","-")

 Q

AMHRNOAT  ; IHS/CMI/LAB - report of a patient's no show visits ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28

 +2       ;

 +3       ;

START     ;EP - called from option

 +1        DO XIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        SET X="LISTING OF EHR VISITS WITH NO ACTIVITY TIME"

           WRITE !,$$CTR^AMHLEIN(X,80)

 +4        WRITE !!,"This option will print a list of visits created through EHR/PCC "

 +5        WRITE !,"that do not have an Activity time. The user will be able to specify "

 +6        WRITE !,"the date range and whether to include all visits or just those visits"

 +7        WRITE !,"for one provider.",!

 +8        DO DBHUSR^AMHUTIL

GETDATES  ;

 +1        WRITE !!,"Please enter the date range."

BD        ;get beginning date

 +1        SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter Beginning Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_AMHBD_":DT:EP"

           SET DIR("A")="Enter Ending Date"

           SET Y=AMHBD

           DO DD^%DT

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET AMHED=Y

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

PROV      ;

 +1        SET AMHPROV=""

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

           SET DIR("A")="Include visits for"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO GETDATES

 +4        IF Y="A"

               GOTO SORT

 +5        SET DIC="^VA(200,"

           SET DIC(0)="AEMQ"

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

           DO ^DIC

 +6        KILL DIC,DA

 +7        IF Y=-1

               GOTO PROV

 +8        SET AMHPROV=+Y

SORT      ;

 +1        SET AMHSORT=""

 +2        SET DIR(0)="S^P:Patient Name;D:Date of Visit"

           SET DIR("A")="How would you like the report sorted"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO PROV

 +4        SET AMHSORT=Y

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO SORT

ZIS       ;

 +1        SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to "

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        IF $GET(Y)="B"

               DO BROWSE

               DO XIT

               QUIT 

 +4        WRITE !!

           SET XBRP="PRINT^AMHRNOAT"

           SET XBRC="PROC^AMHRNOAT"

           SET XBNS="AMH*"

           SET XBRX="XIT^AMHRNOAT"

 +5        DO ^XBDBQUE

 +6        DO XIT

 +7        QUIT 

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^AMHRNOAT"")"

 +2        SET XBNS="AMH"

           SET XBRC="PROC^AMHRNOAT"

           SET XBRX="XIT^AMHRNOAT"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

 +4       ;

PROC      ;EP - called from xbdbque

 +1       ;loop through all visits in date range and look for problem 8-8.9 or visit type of N

 +2        SET AMHJOB=$JOB

           SET AMHTOT=0

           SET AMHBT=$HOROLOG

           SET AMHPTOT=0

 +3        DO XTMP^AMHUTIL("AMHRNOAT","BH - NO ACTIVITY TIME VISITS")

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

 +5        SET AMHODAT=AMHSD_".9999"

           FOR 

               SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))

               IF AMHODAT=""!((AMHODAT\1)>AMHED)

                   QUIT 

               Begin DoDot:1

 +6                SET AMHR=0

                   FOR 

                       SET AMHR=$ORDER(^AMHREC("B",AMHODAT,AMHR))

                       IF AMHR'=+AMHR

                           QUIT 

                       Begin DoDot:2

 +7                        IF AMHPROV

                               IF $$PPINT^AMHUTIL(AMHR)'=AMHPROV

                                   QUIT 

 +8                        IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)

                               QUIT 

 +9                        SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)

                           IF 'DFN

                               QUIT 

 +10                       IF '$$ALLOWP^AMHUTIL(DUZ,DFN)

                               QUIT 

 +11                       IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))

                               QUIT 

 +12                       IF $PIECE(^AMHREC(AMHR,0),U,12)

                               QUIT 

 +13                       DO SET

 +14                       QUIT 

                       End DoDot:2

 +15               QUIT 

               End DoDot:1

 +16       QUIT 

SET       ;

 +1        SET ^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT",$SELECT(AMHSORT="P":$PIECE(^DPT(DFN,0),U),1:(9999999-$PIECE(AMHODAT,"."))),AMHR)=""

           SET AMHTOT=AMHTOT+1

 +2        IF $DATA(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"PATIENTS",DFN))

               QUIT 

 +3        SET AMHPTOT=AMHPTOT+1

 +4        SET ^XTMP("AMHRNOAT",AMHJOB,AMHBT,"PATIENTS",DFN)=""

 +5        QUIT 

PRINT     ;EP - called from xbdbque

 +1        DO PRINT1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   SET DIR(0)="EO"

                   SET DIR("A")="End of report.  PRESS RETURN"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +3        KILL ^XTMP("AMHRNOAT",AMHJOB,AMHBT),AMHJOB,AMHBT

 +4        QUIT 

PRINT1    ;

 +1        KILL AMHQ

           SET AMHPG=0

 +2        IF '$DATA(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT"))

               DO HEADER

               WRITE !!,"There were no visits without an activity time during the time period.",!

               QUIT 

 +3        DO HEADER

 +4        SET AMHSORT=""

           FOR 

               SET AMHSORT=$ORDER(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT",AMHSORT))

               IF AMHSORT=""!($DATA(AMHQ))

                   QUIT 

               Begin DoDot:1

 +5                SET AMHR=0

                   FOR 

                       SET AMHR=$ORDER(^XTMP("AMHRNOAT",AMHJOB,AMHBT,"NO AT",AMHSORT,AMHR))

                       IF AMHR'=+AMHR!($DATA(AMHQ))

                           QUIT 

                       Begin DoDot:2

 +6                        IF $Y>(IOSL-4)

                               DO HEADER

                               IF $DATA(AMHQ)

                                   QUIT 

 +7                        SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)

 +8                        WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,18),?20,$$HRN^AUPNPAT(DFN,DUZ(2)),?27,$$FMTE^XLFDT($PIECE(^AMHREC(AMHR,0),U)),?46,$EXTRACT($$PPNAME^AMHUTIL(AMHR),1,12)

 +9                        WRITE ?59,$$PRIMPOV^AMHUTIL1(AMHR,"C")_"-"

 +10                       SET X=$$PRIMPOV^AMHUTIL1(AMHR,"I")

                           IF X

                               WRITE $EXTRACT($PIECE(^AMHPROB(X,0),U,2),1,12)

                       End DoDot:2

 +11               QUIT 

               End DoDot:1

 +12       IF $DATA(AMHQ)

               QUIT 

 +13       IF $Y>(IOSL-4)

               DO HEADER

               IF $DATA(AMHQ)

                   QUIT 

 +14       WRITE !!,"Total # of Patients: ",AMHPTOT,"     Total # of Visits: ",AMHTOT,!

 +15       QUIT 

XIT       ;

 +1        DO EN^XBVK("AMH")

 +2        DO KILL^AUPNPAT

 +3        QUIT 

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

HEADER    ;EP

 +1        IF 'AMHPG

               GOTO HEADER1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET AMHQ=""

                       QUIT 

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET AMHPG=AMHPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?($SELECT(80=132:120,1:72)),"Page ",AMHPG,!

 +4        SET AMHTEXT="Behaviorial Health Visits with No Activity Time"

 +5        WRITE !?(80-$LENGTH(AMHTEXT)/2),AMHTEXT,!

 +6        SET AMHTEXT="Visit Dates:  "_AMHBDD_" - "_AMHEDD

 +7        WRITE ?(80-$LENGTH(AMHTEXT)/2),AMHTEXT,!

 +8        IF AMHPROV

               SET X="Provider: "_$PIECE(^VA(200,AMHPROV,0),U)

               WRITE $$CTR^AMHLEIN(X,80),!

 +9        WRITE !,"PATIENT NAME",?20,"HRN",?27,"DATE/TIME",?46,"PROVIDER",?59,"POV"

 +10       WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +11       QUIT