AMHRC1.m

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