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