AMHRP8 ; 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 **********",!!
W "This report will produce a list of patients who have been seen in a date range",!,"specified by the user.",!
D DBHUSRP^AMHUTIL
D DBHUSR^AMHUTIL
GETDATES ;
BD ;get beginning date
W !,"Please enter the date range during which the patient should be seen in",!,"order to be considered active.",!
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
;
PROV ;limit by provider
S AMHPROV=""
S DIR(0)="Y",DIR("A")="Limit the list to those patients who have seen a particular provider",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) GETDATES
G:'Y DEMO
I Y=1 S DIC("A")="Enter PROVIDER Name: ",DIC=200,DIC(0)="AEQMZ" D ^DIC G PROV:Y<0 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^AMHRP8",XBRP="^AMHRP8P",XBNS="AMH",XBRX="XIT^AMHRP8"
D ^XBDBQUE
XIT ;EP
K ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHTOT
K AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRP8P"")"
S XBNS="AMH",XBRC="PROC^AMHRP8",XBRX="XIT^AMHRP8",XBIOP=0 D ^XBDBQUE
Q
PROC ;EP - entry point for processing
S AMHJOB=$J,AMHBTH=$H,AMHTOT=0,DFN=0,AMHBT=$H
D XTMP^AMHUTIL("AMHRP8","BH - ACTIVE CLIENT LIST")
F S DFN=$O(^AMHREC("AE",DFN)) Q:DFN'=+DFN I $$ALLOWP^AMHUTIL(DUZ,DFN) D PROC1
S AMHET=$H
K DFN
Q
PROC1 ;
Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
S (AMHID,AMHFOUND)=0 F S AMHID=$O(^AMHREC("AE",DFN,AMHID)) Q:AMHID'=+AMHID!(AMHFOUND) D CHK
Q
CHK ;check to see if patient meets criteria
S D=9999999-$P(AMHID,".")
Q:D<AMHBD
Q:D>AMHED
S V=0 F S V=$O(^AMHREC("AE",DFN,AMHID,V)) Q:V'=+V!(AMHFOUND) D
.Q:'$$ALLOWVI^AMHUTIL(DUZ,V)
.I AMHPROV S AMHHIT="" D CHKPROV Q:'AMHHIT
.S ^XTMP("AMHRP8",AMHJOB,AMHBTH,$P(^DPT(DFN,0),U),DFN)="",AMHTOT=AMHTOT+1,AMHFOUND=1
Q
;
CHKPROV ;if 1 provider selected check for that provider
NEW X,R
S R=0 F S R=$O(^AMHREC("AE",DFN,AMHID,R)) Q:R'=+R!(AMHHIT) D
.S P=0 F S P=$O(^AMHRPROV("AD",R,P)) Q:P'=+P I $P(^AMHRPROV(P,0),U)=AMHPROV S AMHHIT=1
.Q
Q
AMHRP8 ; 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 **********",!!
+4 WRITE "This report will produce a list of patients who have been seen in a date range",!,"specified by the user.",!
+5 DO DBHUSRP^AMHUTIL
+6 DO DBHUSR^AMHUTIL
GETDATES ;
BD ;get beginning date
+1 WRITE !,"Please enter the date range during which the patient should be seen in",!,"order to be considered active.",!
+2 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO XIT
+4 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
+5 ;
PROV ;limit by provider
+1 SET AMHPROV=""
+2 SET DIR(0)="Y"
SET DIR("A")="Limit the list to those patients who have seen a particular provider"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO GETDATES
+4 IF 'Y
GOTO DEMO
+5 IF Y=1
SET DIC("A")="Enter PROVIDER Name: "
SET DIC=200
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
GOTO PROV
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^AMHRP8"
SET XBRP="^AMHRP8P"
SET XBNS="AMH"
SET XBRX="XIT^AMHRP8"
+5 DO ^XBDBQUE
XIT ;EP
+1 KILL ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHTOT
+2 KILL AMHPRNM,AMHPRNT,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP
+3 QUIT
+4 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRP8P"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRP8"
SET XBRX="XIT^AMHRP8"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PROC ;EP - entry point for processing
+1 SET AMHJOB=$JOB
SET AMHBTH=$HOROLOG
SET AMHTOT=0
SET DFN=0
SET AMHBT=$HOROLOG
+2 DO XTMP^AMHUTIL("AMHRP8","BH - ACTIVE CLIENT LIST")
+3 FOR
SET DFN=$ORDER(^AMHREC("AE",DFN))
IF DFN'=+DFN
QUIT
IF $$ALLOWP^AMHUTIL(DUZ,DFN)
DO PROC1
+4 SET AMHET=$HOROLOG
+5 KILL DFN
+6 QUIT
PROC1 ;
+1 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+2 SET (AMHID,AMHFOUND)=0
FOR
SET AMHID=$ORDER(^AMHREC("AE",DFN,AMHID))
IF AMHID'=+AMHID!(AMHFOUND)
QUIT
DO CHK
+3 QUIT
CHK ;check to see if patient meets criteria
+1 SET D=9999999-$PIECE(AMHID,".")
+2 IF D<AMHBD
QUIT
+3 IF D>AMHED
QUIT
+4 SET V=0
FOR
SET V=$ORDER(^AMHREC("AE",DFN,AMHID,V))
IF V'=+V!(AMHFOUND)
QUIT
Begin DoDot:1
+5 IF '$$ALLOWVI^AMHUTIL(DUZ,V)
QUIT
+6 IF AMHPROV
SET AMHHIT=""
DO CHKPROV
IF 'AMHHIT
QUIT
+7 SET ^XTMP("AMHRP8",AMHJOB,AMHBTH,$PIECE(^DPT(DFN,0),U),DFN)=""
SET AMHTOT=AMHTOT+1
SET AMHFOUND=1
End DoDot:1
+8 QUIT
+9 ;
CHKPROV ;if 1 provider selected check for that provider
+1 NEW X,R
+2 SET R=0
FOR
SET R=$ORDER(^AMHREC("AE",DFN,AMHID,R))
IF R'=+R!(AMHHIT)
QUIT
Begin DoDot:1
+3 SET P=0
FOR
SET P=$ORDER(^AMHRPROV("AD",R,P))
IF P'=+P
QUIT
IF $PIECE(^AMHRPROV(P,0),U)=AMHPROV
SET AMHHIT=1
+4 QUIT
End DoDot:1
+5 QUIT
