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
;----------
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
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 ;----------
+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
+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
