AMHRP4 ; IHS/CMI/LAB - ACTIVE CLIENT LIST ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
W "********** ACTIVE CLIENT LIST (USING CASE OPEN DATE) **********",!!
W "This report will produce a list of patients who have a case open date without a",!,"case closed date.",!
I '$D(^AMHSITE(DUZ(2),16,DUZ)) D
.W !,"This report will only include Cases on which you are the documented"
.W !,"provider.",!!
D DBHUSRP^AMHUTIL
;
PROG ;
D XIT
S AMHPROG=""
S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) XIT
I Y="A" G PROV
S DIR(0)="9002011.58,.03",DIR("A")="Which PROGRAM" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) PROG
I X="" G PROG
S AMHPROG=Y
PROV ;
S AMHPROV=""
S DIR(0)="S^A:All Providers;O:One Provider",DIR("A")="Include cases opened by",DIR("B")="A" K DA D ^DIR K DIR
G:$D(DIRUT) XIT
I Y="A" G DEMO
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC
K DIC,DA
I Y=-1 G PROV
S AMHPROV=+Y
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G PROV
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
S XBRC="PROC^AMHRP4",XBRP="^AMHRP4P",XBNS="AMH",XBRX="XIT^AMHRP4"
D ^XBDBQUE
XIT ;
K ZTSK,Y,AMHBD,AMHED,IO("Q")
D EN^XBVK("AMH")
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRP4P"")"
S XBNS="AMH",XBRC="PROC^AMHRP4",XBRX="XIT^AMHRP4",XBIOP=0 D ^XBDBQUE
Q
PROC ;EP - entry point for processing
S AMHPCNT=0
S AMHJOB=$J,AMHBTH=$H,AMHTOT=0,AMHCASE=0,AMHBT=$H,AMHCCNT=0
D XTMP^AMHUTIL("AMHRP4","BH - ACTIVE CLIENT REPORT")
F S AMHCASE=$O(^AMHPCASE(AMHCASE)) Q:AMHCASE'=+AMHCASE D PROC1
S AMHET=$H
K AMHCASE
Q
PROC1 ;
I '$$ALLOWCD^AMHLCD(DUZ,AMHCASE) Q
Q:$P(^AMHPCASE(AMHCASE,0),U,5)]"" ;closed
I AMHPROG]"",$P(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG Q
I AMHPROV,$P(^AMHPCASE(AMHCASE,0),U,8)'=AMHPROV Q
S DFN=$P(^AMHPCASE(AMHCASE,0),U,2)
Q:'DFN
Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
I '$D(^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN)) S AMHPCNT=AMHPCNT+1,^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN)=""
S ^XTMP("AMHRP4",AMHJOB,AMHBTH,"CASES",$P(^DPT(DFN,0),U),DFN,AMHCASE)=AMHCASE,AMHCCNT=AMHCCNT+1
Q
;
AMHRP4 ; IHS/CMI/LAB - ACTIVE CLIENT LIST ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE @(IOF),!!
+3 WRITE "********** ACTIVE CLIENT LIST (USING CASE OPEN DATE) **********",!!
+4 WRITE "This report will produce a list of patients who have a case open date without a",!,"case closed date.",!
+5 IF '$DATA(^AMHSITE(DUZ(2),16,DUZ))
Begin DoDot:1
+6 WRITE !,"This report will only include Cases on which you are the documented"
+7 WRITE !,"provider.",!!
End DoDot:1
+8 DO DBHUSRP^AMHUTIL
+9 ;
PROG ;
+1 DO XIT
+2 SET AMHPROG=""
+3 SET DIR(0)="S^O:ONE Program;A:ALL Programs"
SET DIR("A")="Run the Report for which PROGRAM"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO XIT
+5 IF Y="A"
GOTO PROV
+6 SET DIR(0)="9002011.58,.03"
SET DIR("A")="Which PROGRAM"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
GOTO PROG
+8 IF X=""
GOTO PROG
+9 SET AMHPROG=Y
PROV ;
+1 SET AMHPROV=""
+2 SET DIR(0)="S^A:All Providers;O:One Provider"
SET DIR("A")="Include cases opened by"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO XIT
+4 IF Y="A"
GOTO DEMO
+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
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO PROV
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 SET XBRC="PROC^AMHRP4"
SET XBRP="^AMHRP4P"
SET XBNS="AMH"
SET XBRX="XIT^AMHRP4"
+5 DO ^XBDBQUE
XIT ;
+1 KILL ZTSK,Y,AMHBD,AMHED,IO("Q")
+2 DO EN^XBVK("AMH")
+3 QUIT
+4 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRP4P"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRP4"
SET XBRX="XIT^AMHRP4"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PROC ;EP - entry point for processing
+1 SET AMHPCNT=0
+2 SET AMHJOB=$JOB
SET AMHBTH=$HOROLOG
SET AMHTOT=0
SET AMHCASE=0
SET AMHBT=$HOROLOG
SET AMHCCNT=0
+3 DO XTMP^AMHUTIL("AMHRP4","BH - ACTIVE CLIENT REPORT")
+4 FOR
SET AMHCASE=$ORDER(^AMHPCASE(AMHCASE))
IF AMHCASE'=+AMHCASE
QUIT
DO PROC1
+5 SET AMHET=$HOROLOG
+6 KILL AMHCASE
+7 QUIT
PROC1 ;
+1 IF '$$ALLOWCD^AMHLCD(DUZ,AMHCASE)
QUIT
+2 ;closed
IF $PIECE(^AMHPCASE(AMHCASE,0),U,5)]""
QUIT
+3 IF AMHPROG]""
IF $PIECE(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG
QUIT
+4 IF AMHPROV
IF $PIECE(^AMHPCASE(AMHCASE,0),U,8)'=AMHPROV
QUIT
+5 SET DFN=$PIECE(^AMHPCASE(AMHCASE,0),U,2)
+6 IF 'DFN
QUIT
+7 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+8 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+9 IF '$DATA(^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN))
SET AMHPCNT=AMHPCNT+1
SET ^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN)=""
+10 SET ^XTMP("AMHRP4",AMHJOB,AMHBTH,"CASES",$PIECE(^DPT(DFN,0),U),DFN,AMHCASE)=AMHCASE
SET AMHCCNT=AMHCCNT+1
+11 QUIT
+12 ;
