AMHRC1 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N DAYS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
START ;
I '$D(IOF) D HOME^%ZIS
W @(IOF),!!
W "******* CLIENTS WITH CASE OPEN DATE BUT NOT SEEN IN N DAYS) *******",!!
W "This report will produce a list of patients who have a case open date,",!,"no closed date, and have not been seen in N days.",!
W "The user will determine the number of days to use.",!
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,DBHUSR^AMHUTIL,PAUSE^AMHLEA
;
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:Any Provider;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 DAYS
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC
K DIC,DA
I Y=-1 G PROV
S AMHPROV=+Y
DAYS ;
S AMHDAYS=0
S DIR(0)="N^1:99999:0",DIR("A")="Enter the number of days since the patient has been seen" K DA D ^DIR K DIR
I $D(DIRUT) W !,"Bye..." D XIT Q
I Y="" D XIT Q
S AMHDAYS=Y
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G DAYS
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^AMHRC1",XBRP="^AMHRC1P",XBNS="AMH",XBRX="XIT^AMHRC1"
D ^XBDBQUE
XIT ;
D EN^XBVK("AMH")
D KILL^AUPNPAT
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRC1P"")"
S XBNS="AMH",XBRC="PROC^AMHRC1",XBRX="XIT^AMHRC1",XBIOP=0 D ^XBDBQUE
Q
PROC ;EP - entry point for processing
S AMHPCNT=0,AMHCCNT=0
S AMHJOB=$J,AMHBTH=$H,AMHCASE=0,AMHBT=$H,AMHCASE=0
D XTMP^AMHUTIL("AMHRC1","BH - REPORT - OPEN NOT SEEN")
F S AMHCASE=$O(^AMHPCASE(AMHCASE)) Q:AMHCASE'=+AMHCASE D PROC1
S AMHET=$H
K AMHCASE
Q
PROC1 ;
Q:'$$ALLOWCD^AMHLCD(DUZ,AMHCASE)
Q:$P(^AMHPCASE(AMHCASE,0),U)=""
I $P(^AMHPCASE(AMHCASE,0),U,2)="" Q
I AMHPROG]"",$P(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG Q ;not right program
Q:$P(^AMHPCASE(AMHCASE,0),U,5)]"" ;closed date
S DFN=$P(^AMHPCASE(AMHCASE,0),U,2)
Q:'DFN
Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
I AMHPROV,AMHPROV'=$P(^AMHPCASE(AMHCASE,0),U,8) Q
S AMHSEEN=0 D CHKVISIT Q:AMHSEEN
I '$D(^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN)) S AMHPCNT=AMHPCNT+1,^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN)=""
S ^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",$P(^DPT(DFN,0),U),DFN,AMHCASE)=AMHD,AMHCCNT=AMHCCNT+1
Q
;
CHKVISIT ;chk for last visit date less than amhdays - set amhseen if seen
S AMHD=""
S AMHD=$$GETV(DFN)
Q:AMHD=""
I $$FMDIFF^XLFDT(DT,AMHD)>(AMHDAYS-1) Q
S AMHSEEN=1
Q
GETV(P) ;return null or patients last visit date
NEW AMHR,D S AMHR="",G=""
I '$D(^AMHREC("AE",P)) Q AMHR
;S D=$O(^AMHREC("AE",P,"")),AMHR=$O(^AMHREC("AE",P,D,"")) I AMHR]"" S AMHR=$P($P(^AMHREC(AMHR,0),U),".")
S D=0 F S D=$O(^AMHREC("AE",P,D)) Q:'D!(G) D
.S AMHR=0 F S AMHR=$O(^AMHREC("AE",P,D,AMHR)) Q:AMHR'=+AMHR!(G) D
..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
..S G=$P($P(^AMHREC(AMHR,0),U),".")
Q G
AMHRC1 ; IHS/CMI/LAB - ACTIVE CLIENT LIST - OPEN NOT SEEN IN N DAYS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
START ;
+1 IF '$DATA(IOF)
DO HOME^%ZIS
+2 WRITE @(IOF),!!
+3 WRITE "******* CLIENTS WITH CASE OPEN DATE BUT NOT SEEN IN N DAYS) *******",!!
+4 WRITE "This report will produce a list of patients who have a case open date,",!,"no closed date, and have not been seen in N days.",!
+5 WRITE "The user will determine the number of days to use.",!
+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
DO DBHUSR^AMHUTIL
DO PAUSE^AMHLEA
+10 ;
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: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 XIT
+4 IF Y="A"
GOTO DAYS
+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
DAYS ;
+1 SET AMHDAYS=0
+2 SET DIR(0)="N^1:99999:0"
SET DIR("A")="Enter the number of days since the patient has been seen"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
WRITE !,"Bye..."
DO XIT
QUIT
+4 IF Y=""
DO XIT
QUIT
+5 SET AMHDAYS=Y
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO DAYS
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^AMHRC1"
SET XBRP="^AMHRC1P"
SET XBNS="AMH"
SET XBRX="XIT^AMHRC1"
+5 DO ^XBDBQUE
XIT ;
+1 DO EN^XBVK("AMH")
+2 DO KILL^AUPNPAT
+3 QUIT
+4 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRC1P"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRC1"
SET XBRX="XIT^AMHRC1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PROC ;EP - entry point for processing
+1 SET AMHPCNT=0
SET AMHCCNT=0
+2 SET AMHJOB=$JOB
SET AMHBTH=$HOROLOG
SET AMHCASE=0
SET AMHBT=$HOROLOG
SET AMHCASE=0
+3 DO XTMP^AMHUTIL("AMHRC1","BH - REPORT - OPEN NOT SEEN")
+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 IF $PIECE(^AMHPCASE(AMHCASE,0),U)=""
QUIT
+3 IF $PIECE(^AMHPCASE(AMHCASE,0),U,2)=""
QUIT
+4 ;not right program
IF AMHPROG]""
IF $PIECE(^AMHPCASE(AMHCASE,0),U,3)'=AMHPROG
QUIT
+5 ;closed date
IF $PIECE(^AMHPCASE(AMHCASE,0),U,5)]""
QUIT
+6 SET DFN=$PIECE(^AMHPCASE(AMHCASE,0),U,2)
+7 IF 'DFN
QUIT
+8 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+9 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+10 IF AMHPROV
IF AMHPROV'=$PIECE(^AMHPCASE(AMHCASE,0),U,8)
QUIT
+11 SET AMHSEEN=0
DO CHKVISIT
IF AMHSEEN
QUIT
+12 IF '$DATA(^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN))
SET AMHPCNT=AMHPCNT+1
SET ^XTMP("AMHRP4",AMHJOB,AMHBTH,"PATIENTS",DFN)=""
+13 SET ^XTMP("AMHRC1",AMHJOB,AMHBTH,"CASES",$PIECE(^DPT(DFN,0),U),DFN,AMHCASE)=AMHD
SET AMHCCNT=AMHCCNT+1
+14 QUIT
+15 ;
CHKVISIT ;chk for last visit date less than amhdays - set amhseen if seen
+1 SET AMHD=""
+2 SET AMHD=$$GETV(DFN)
+3 IF AMHD=""
QUIT
+4 IF $$FMDIFF^XLFDT(DT,AMHD)>(AMHDAYS-1)
QUIT
+5 SET AMHSEEN=1
+6 QUIT
GETV(P) ;return null or patients last visit date
+1 NEW AMHR,D
SET AMHR=""
SET G=""
+2 IF '$DATA(^AMHREC("AE",P))
QUIT AMHR
+3 ;S D=$O(^AMHREC("AE",P,"")),AMHR=$O(^AMHREC("AE",P,D,"")) I AMHR]"" S AMHR=$P($P(^AMHREC(AMHR,0),U),".")
+4 SET D=0
FOR
SET D=$ORDER(^AMHREC("AE",P,D))
IF 'D!(G)
QUIT
Begin DoDot:1
+5 SET AMHR=0
FOR
SET AMHR=$ORDER(^AMHREC("AE",P,D,AMHR))
IF AMHR'=+AMHR!(G)
QUIT
Begin DoDot:2
+6 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)
QUIT
+7 SET G=$PIECE($PIECE(^AMHREC(AMHR,0),U),".")
End DoDot:2
End DoDot:1
+8 QUIT G
