- 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
