AMHRNS.m

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

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;

START ;EP - called from option

 D XIT

 W:$D(IOF) @IOF

 W !!,"This option will print a list of one patient's no show visits.",!

 D DBHUSR^AMHUTIL

GETPAT ;

 S DFN=""

 W !

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC

 I Y<0 D XIT Q

 S (DFN,AMHPAT)=+Y

 I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2

 I AMHPAT,'$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G GETPAT

GETDATES ;

 W !!,"Please enter the range of dates for the No Show visits"

BD ;get beginning date

 W ! 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

PROG ;select program to run report for

 S AMHPROG=""

 S DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER;A:ALL",DIR("A")="List No Show for which Program",DIR("B")="M" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) BD

 S AMHPROG=Y,AMHPROG=$S(AMHPROG="A":"",1:AMHPROG)

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^AMHRNS",XBRC="PROC^AMHRNS",XBNS="AMH*",XBRX="XIT^AMHRNS"

 D ^XBDBQUE

 D XIT

 Q

BROWSE ;

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

 S XBNS="AMH",XBRC="PROC^AMHRNS",XBRX="XIT^AMHRNS",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

 D XTMP^AMHUTIL("AMHRNS","BH - NO SHOW FOR PATIENT")

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

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

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

 ..I AMHPROG]"",$P(^AMHREC(AMHR,0),U,2)'=AMHPROG Q

 ..;if any dx is 8 then do set and q

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

 ..Q:'$$ALLOWP^AMHUTIL(DUZ,$P(^AMHREC(AMHR,0),U,8))

 ..S (AMHX,AMHDNKA)=0 F  S AMHX=$O(^AMHRPRO("AD",AMHR,AMHX)) Q:AMHX'=+AMHX!(AMHDNKA)  D

 ...I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8 S AMHDNKA=1 D SET Q  ;do not pass dnka

 ...I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.1 S AMHDNKA=1 D SET Q  ;do not pass dnka

 ...I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.11 S AMHDNKA=1 D SET Q  ;do not pass dnka

 ...I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.2 S AMHDNKA=1 D SET Q  ;do not pass dnka

 ...I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.21 S AMHDNKA=1 D SET Q

 ...I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.3 S AMHDNKA=1 D SET Q  ;do not pass dnka

 ...I $P(^AMHREC(AMHR,0),U,33)="N" D SET Q

 ...Q

 ..Q

 .Q

 Q

SET ;

 S ^XTMP("AMHRNS",AMHJOB,AMHBT,"NO SHOWS",AMHR)="",AMHTOT=AMHTOT+1

 Q

PRINT ;EP - called from xbdbque

 K AMHQ S AMHPG=0

 I '$D(^XTMP("AMHRNS",AMHJOB,AMHBT,"NO SHOWS")) D HEADER W !!,"There were no NO SHOW visits for this patient during the time period.",! Q

 D HEADER

 S AMHR=0 F  S AMHR=$O(^XTMP("AMHRNS",AMHJOB,AMHBT,"NO SHOWS",AMHR)) Q:AMHR'=+AMHR!($D(AMHQ))  D

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

 .W !!,$$FMTE^XLFDT($P(^AMHREC(AMHR,0),U)),?25,$E($$PPNAME^AMHUTIL(AMHR),1,20),?45,$E($$VAL^XBDIQ1(9002011,AMHR,.02),1,7)

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

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

 .Q

 W !!,"Total # of No Show Visits: ",AMHTOT,!

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

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="BEHAVIORAL HEALTH NO SHOW REPORT FOR "_$P(^DPT(AMHPAT,0),U)

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

 S AMHTEXT="Appointment Dates:  "_AMHBDD_" and "_AMHEDD

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

 ;S X=$P(^DPT(AMHPAT,0),U) W !,$$CTR(X,80),!

 W $TR($J(" ",80)," ","=")

 W !," DATE",?25,"PROVIDER",?45,"PROGRAM",?53,"POV"

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

 Q

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

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

START     ;EP - called from option

 +1        DO XIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This option will print a list of one patient's no show visits.",!

 +4        DO DBHUSR^AMHUTIL

GETPAT    ;

 +1        SET DFN=""

 +2        WRITE !

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +4        IF Y<0

               DO XIT

               QUIT 

 +5        SET (DFN,AMHPAT)=+Y

 +6        IF $GET(AUPNDOD)]""

               WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!

               HANG 2

 +7        IF AMHPAT

               IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)

                   DO NALLOWP^AMHUTIL

                   DO PAUSE^AMHLEA

                   GOTO GETPAT

GETDATES  ;

 +1        WRITE !!,"Please enter the range of dates for the No Show visits"

BD        ;get beginning date

 +1        WRITE !

           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

PROG      ;select program to run report for

 +1        SET AMHPROG=""

 +2        SET DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER;A:ALL"

           SET DIR("A")="List No Show for which Program"

           SET DIR("B")="M"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO BD

 +4        SET AMHPROG=Y

           SET AMHPROG=$SELECT(AMHPROG="A":"",1:AMHPROG)

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^AMHRNS"

           SET XBRC="PROC^AMHRNS"

           SET XBNS="AMH*"

           SET XBRX="XIT^AMHRNS"

 +5        DO ^XBDBQUE

 +6        DO XIT

 +7        QUIT 

BROWSE    ;

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

 +2        SET XBNS="AMH"

           SET XBRC="PROC^AMHRNS"

           SET XBRX="XIT^AMHRNS"

           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

 +3        DO XTMP^AMHUTIL("AMHRNS","BH - NO SHOW FOR PATIENT")

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

 +5        SET AMHODAT=AMHSD_".9999"

           FOR 

               SET AMHODAT=$ORDER(^AMHREC("AF",AMHPAT,AMHODAT))

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

                   QUIT 

               Begin DoDot:1

 +6                SET AMHR=0

                   FOR 

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

                       IF AMHR'=+AMHR

                           QUIT 

                       Begin DoDot:2

 +7                        IF AMHPROG]""

                               IF $PIECE(^AMHREC(AMHR,0),U,2)'=AMHPROG

                                   QUIT 

 +8       ;if any dx is 8 then do set and q

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

                               QUIT 

 +10                       IF '$$ALLOWP^AMHUTIL(DUZ,$PIECE(^AMHREC(AMHR,0),U,8))

                               QUIT 

 +11                       SET (AMHX,AMHDNKA)=0

                           FOR 

                               SET AMHX=$ORDER(^AMHRPRO("AD",AMHR,AMHX))

                               IF AMHX'=+AMHX!(AMHDNKA)

                                   QUIT 

                               Begin DoDot:3

 +12      ;do not pass dnka

                                   IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8

                                       SET AMHDNKA=1

                                       DO SET

                                       QUIT 

 +13      ;do not pass dnka

                                   IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.1

                                       SET AMHDNKA=1

                                       DO SET

                                       QUIT 

 +14      ;do not pass dnka

                                   IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.11

                                       SET AMHDNKA=1

                                       DO SET

                                       QUIT 

 +15      ;do not pass dnka

                                   IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.2

                                       SET AMHDNKA=1

                                       DO SET

                                       QUIT 

 +16                               IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.21

                                       SET AMHDNKA=1

                                       DO SET

                                       QUIT 

 +17      ;do not pass dnka

                                   IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.3

                                       SET AMHDNKA=1

                                       DO SET

                                       QUIT 

 +18                               IF $PIECE(^AMHREC(AMHR,0),U,33)="N"

                                       DO SET

                                       QUIT 

 +19                               QUIT 

                               End DoDot:3

 +20                       QUIT 

                       End DoDot:2

 +21               QUIT 

               End DoDot:1

 +22       QUIT 

SET       ;

 +1        SET ^XTMP("AMHRNS",AMHJOB,AMHBT,"NO SHOWS",AMHR)=""

           SET AMHTOT=AMHTOT+1

 +2        QUIT 

PRINT     ;EP - called from xbdbque

 +1        KILL AMHQ

           SET AMHPG=0

 +2        IF '$DATA(^XTMP("AMHRNS",AMHJOB,AMHBT,"NO SHOWS"))

               DO HEADER

               WRITE !!,"There were no NO SHOW visits for this patient during the time period.",!

               QUIT 

 +3        DO HEADER

 +4        SET AMHR=0

           FOR 

               SET AMHR=$ORDER(^XTMP("AMHRNS",AMHJOB,AMHBT,"NO SHOWS",AMHR))

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

                   QUIT 

               Begin DoDot:1

 +5                IF $Y>(IOSL-4)

                       DO HEADER

                       IF $DATA(AMHQ)

                           QUIT 

 +6                WRITE !!,$$FMTE^XLFDT($PIECE(^AMHREC(AMHR,0),U)),?25,$EXTRACT($$PPNAME^AMHUTIL(AMHR),1,20),?45,$EXTRACT($$VAL^XBDIQ1(9002011,AMHR,.02),1,7)

 +7                WRITE ?53,$$PRIMPOV^AMHUTIL1(AMHR,"C"),"-"

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

                   IF X

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

 +9                QUIT 

               End DoDot:1

 +10       WRITE !!,"Total # of No Show Visits: ",AMHTOT,!

 +11       KILL ^XTMP("AMHRNS",AMHJOB,AMHBT)

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="BEHAVIORAL HEALTH NO SHOW REPORT FOR "_$PIECE(^DPT(AMHPAT,0),U)

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

 +6        SET AMHTEXT="Appointment Dates:  "_AMHBDD_" and "_AMHEDD

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

 +8       ;S X=$P(^DPT(AMHPAT,0),U) W !,$$CTR(X,80),!

 +9        WRITE $TRANSLATE($JUSTIFY(" ",80)," ","=")

 +10       WRITE !," DATE",?25,"PROVIDER",?45,"PROGRAM",?53,"POV"

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

 +12       QUIT