AMHRC2 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N ZIS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
W "******* TALLY OF CASES OPENED, ADMITTED, CLOSED IN A TIME FRAME *******",!!
W "This report will produce a tally of the case open, admit and closed dates",!
W "in a time period.",!
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
;
GETDATES ;
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning of Time Period" 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 end of Time Period" 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
;
PROG ;
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) GETDATES
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:Any Provider;O:One Provider",DIR("A")="Include cases opened by",DIR("B")="A" K DA D ^DIR K DIR
G:$D(DIRUT) GETDATES
I Y="A" G ZIS
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC
K DIC,DA
I Y=-1 G PROV
S AMHPROV=+Y
ZIS ;
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G PROV
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^AMHRC2",XBRP="^AMHRC2P",XBNS="AMH",XBRX="XIT^AMHRC2"
D ^XBDBQUE
XIT ;
K AMHCASE,AMHBD,AMHSD,AMHED,AMHOPEN,AMHADMIT,AMHCLOSE,AMHPG,AMH80D,AMHDISP,AMHBT,AMHPROV,AMHX
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRC2P"")"
S XBNS="AMH",XBRC="PROC^AMHRC2",XBRX="XIT^AMHRC2",XBIOP=0 D ^XBDBQUE
Q
PROC ;EP - entry point for processing
S AMHBT=$H,AMHOPEN=0,AMHADMIT=0,AMHCLOSE=0 K AMHDISP
S AMHCASE=0
F S AMHCASE=$O(^AMHPCASE(AMHCASE)) Q:AMHCASE'=+AMHCASE D PROC1
S AMHET=$H
K AMHCASE
Q
PROC1 ;
Q:'$$ALLOWCD^AMHLCD(DUZ,AMHCASE)
I AMHPROG]"",$P(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG Q
I AMHPROV,AMHPROV'=$P(^AMHPCASE(AMHCASE,0),U,8) Q
S AMHR=^AMHPCASE(AMHCASE,0)
Q:'$$ALLOWP^AMHUTIL(DUZ,$P(AMHR,U,2))
Q:$$DEMO^AMHUTIL1($P(AMHR,U,2),$G(AMHDEMO))
I $P(AMHR,U)]"",$P(AMHR,U)'<AMHBD,$P(AMHR,U)'>AMHED S AMHOPEN=AMHOPEN+1
I $P(AMHR,U,4)]"",$P(AMHR,U,4)'<AMHBD,$P(AMHR,U,4)'>AMHED S AMHADMIT=AMHADMIT+1
I $P(AMHR,U,5)]"",$P(AMHR,U,5)'<AMHBD,$P(AMHR,U,5)'>AMHED S AMHCLOSE=AMHCLOSE+1 D
.I $P(AMHR,U,6)]"" S X=$P(^AMHPOCM($P(AMHR,U,6),0),U) S:'$D(AMHDISP(X)) AMHDISP(X)="" S AMHDISP(X)=AMHDISP(X)+1
Q
AMHRC2 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N ZIS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE @(IOF),!!
+3 WRITE "******* TALLY OF CASES OPENED, ADMITTED, CLOSED IN A TIME FRAME *******",!!
+4 WRITE "This report will produce a tally of the case open, admit and closed dates",!
+5 WRITE "in a time period.",!
+6 IF '$DATA(^AMHSITE(DUZ(2),16,DUZ))
Begin DoDot:1
+7 WRITE !,"This report will only include Cases on which you are the documented"
+8 WRITE !,"provider.",!!
End DoDot:1
+9 DO DBHUSRP^AMHUTIL
+10 ;
GETDATES ;
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning of Time Period"
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 end of Time Period"
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
+5 ;
PROG ;
+1 SET AMHPROG=""
+2 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
+3 IF $DATA(DIRUT)
GOTO GETDATES
+4 IF Y="A"
GOTO PROV
+5 SET DIR(0)="9002011.58,.03"
SET DIR("A")="Which PROGRAM"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO PROG
+7 IF X=""
GOTO PROG
+8 SET AMHPROG=Y
PROV ;
+1 SET AMHPROV=""
+2 SET DIR(0)="S^A:Any Provider;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 GETDATES
+4 IF Y="A"
GOTO ZIS
+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
ZIS ;
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO PROV
+3 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
+4 IF $DATA(DIRUT)
GOTO XIT
+5 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+6 SET XBRC="PROC^AMHRC2"
SET XBRP="^AMHRC2P"
SET XBNS="AMH"
SET XBRX="XIT^AMHRC2"
+7 DO ^XBDBQUE
XIT ;
+1 KILL AMHCASE,AMHBD,AMHSD,AMHED,AMHOPEN,AMHADMIT,AMHCLOSE,AMHPG,AMH80D,AMHDISP,AMHBT,AMHPROV,AMHX
+2 QUIT
+3 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRC2P"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRC2"
SET XBRX="XIT^AMHRC2"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PROC ;EP - entry point for processing
+1 SET AMHBT=$HOROLOG
SET AMHOPEN=0
SET AMHADMIT=0
SET AMHCLOSE=0
KILL AMHDISP
+2 SET AMHCASE=0
+3 FOR
SET AMHCASE=$ORDER(^AMHPCASE(AMHCASE))
IF AMHCASE'=+AMHCASE
QUIT
DO PROC1
+4 SET AMHET=$HOROLOG
+5 KILL AMHCASE
+6 QUIT
PROC1 ;
+1 IF '$$ALLOWCD^AMHLCD(DUZ,AMHCASE)
QUIT
+2 IF AMHPROG]""
IF $PIECE(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG
QUIT
+3 IF AMHPROV
IF AMHPROV'=$PIECE(^AMHPCASE(AMHCASE,0),U,8)
QUIT
+4 SET AMHR=^AMHPCASE(AMHCASE,0)
+5 IF '$$ALLOWP^AMHUTIL(DUZ,$PIECE(AMHR,U,2))
QUIT
+6 IF $$DEMO^AMHUTIL1($PIECE(AMHR,U,2),$GET(AMHDEMO))
QUIT
+7 IF $PIECE(AMHR,U)]""
IF $PIECE(AMHR,U)'<AMHBD
IF $PIECE(AMHR,U)'>AMHED
SET AMHOPEN=AMHOPEN+1
+8 IF $PIECE(AMHR,U,4)]""
IF $PIECE(AMHR,U,4)'<AMHBD
IF $PIECE(AMHR,U,4)'>AMHED
SET AMHADMIT=AMHADMIT+1
+9 IF $PIECE(AMHR,U,5)]""
IF $PIECE(AMHR,U,5)'<AMHBD
IF $PIECE(AMHR,U,5)'>AMHED
SET AMHCLOSE=AMHCLOSE+1
Begin DoDot:1
+10 IF $PIECE(AMHR,U,6)]""
SET X=$PIECE(^AMHPOCM($PIECE(AMHR,U,6),0),U)
IF '$DATA(AMHDISP(X))
SET AMHDISP(X)=""
SET AMHDISP(X)=AMHDISP(X)+1
End DoDot:1
+11 QUIT
