AMHRP7 ; IHS/CMI/LAB - VISIT COUNTS BY PROVIDER 03 Jun 2009 11:56 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;Designated Provider List
;
W:$D(IOF) @IOF W !!?20,"DESIGNATED PROVIDER LIST",!!
D DBHUSRP^AMHUTIL
I '$D(^AMHSITE(DUZ(2),16,"B",DUZ)) W !!,"You will only see a list of patients for which you are the designated",!,"provider, regardless of how you answer the questions below.",!!
PROG ;select program to run report for
S AMHPROG=""
S DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER;T:OTHER NON-RPMS",DIR("A")="Which DESIGNATED PROVIDER",DIR("B")="M" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D END Q
S AMHPROG=Y,AMHPROGN=Y(0)
PRV ;
S DIR(0)="S^1:ONE PROVIDER;2:ALL PROVIDERS",DIR("A")="Run Report for",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G PROG
S AMHS=Y
S AMHPRV="" I '$D(^AMHSITE(DUZ(2),16,"B",DUZ)) D G DEMO
.S AMHPRV=DUZ
.W !!,"Reporting on your provider list only.",!!
I AMHS=1 D
.I AMHPROG="T" D FT Q
.S DIC=200,DIC(0)="AEQMZ" D ^DIC Q:Y<0 S AMHPRV=+Y
I AMHS=1,AMHPRV="" G PROG
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G PRV
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 END
I $G(Y)="B" D BROWSE,END Q
S XBRC="M^AMHRP7",XBRP="PRINT^AMHRP7",XBNS="AMH",XBRX="END^AMHRP7"
D ^XBDBQUE
END K ZTSK,Y,AMHBD,AMHED,AMHCL,AMHS,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPN,AMHPROG,AMHPROGN,AMHPRV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D
Q
;
FT ;
S AMHPRV=""
S DIR(0)="F^1:30",DIR("A")="Enter the OTHER NON-RPMS Designated Provider's Name" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S AMHPRV=Y
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^AMHRP7"")"
S XBNS="AMH",XBRC="M^AMHRP7",XBRX="END^AMHRP7",XBIOP=0 D ^XBDBQUE
Q
M ;
S AMHJOB=$J,AMHBTH=$H
D XTMP^AMHUTIL("AMHRP7","BH - DESIGNATED PROV LIST")
S DFN=0 F S DFN=$O(^AMHPATR(DFN)) Q:DFN'=+DFN D
.Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)
.Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))
.S AMHX=$S(AMHPROG="M":$P(^AMHPATR(DFN,0),U,2),AMHPROG="S":$P(^AMHPATR(DFN,0),U,3),AMHPROG="C":$P(^AMHPATR(DFN,0),U,4),AMHPROG="O":$P(^AMHPATR(DFN,0),U,12),AMHPROG="T":$P(^AMHPATR(DFN,0),U,13),1:"") I AMHX]"" D PROC
.I AMHPROG="T" S AMHX=$P(^AMHPATR(DFN,0),U,14) I AMHX]"" D PROC
Q
PROC ;
I AMHPRV]"",AMHPRV'=AMHX Q
S ^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHX,$P(^DPT(DFN,0),U),DFN)=""
Q
PRINT ;
START ;
K AMHX
S AMH80D="-------------------------------------------------------------------------------"
S AMHPG=0 D HEAD
I '$D(^XTMP("AMHRP7",AMHJOB,AMHBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
S AMHPN="" K AMHQ
F S AMHPN=$O(^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHPN)) Q:AMHPN=""!($D(AMHQ)) D DFN
G:$D(AMHQ) DONE
DONE D DONE^AMHLEIN,^AMHEKL
K ^XTMP("AMHRP7",AMHJOB,AMHBTH)
Q
DFN ;
I $Y>(IOSL-4) D HEAD Q:$D(AMHQ)
S AMHPCNT=0
I AMHPROG'="T" W !!,"PROVIDER: ",$P(^VA(200,AMHPN,0),U),!
I AMHPROG="T" W !!,"PROVIDER: ",AMHPN
S AMHNAME="" F S AMHNAME=$O(^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHPN,AMHNAME)) Q:AMHNAME=""!($D(AMHQ)) D
.S DFN="" F S DFN=$O(^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHPN,AMHNAME,DFN)) Q:DFN=""!($D(AMHQ)) D PROCP
Q:$D(AMHQ)
I $Y>(IOSL-4) D HEAD Q:$D(AMHQ)
W !?57,"SUB-TOTAL: ",AMHPCNT
Q
PROCP ;
S AMHPCNT=AMHPCNT+1
I $Y>(IOSL-4) D HEAD Q:$D(AMHQ)
W !,$P(^DPT(DFN,0),U)
S AMHHRCN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"")
W ?26,AMHHRCN
W ?37,$P(^DPT(DFN,0),U,2)
S Y=$P(^DPT(DFN,0),U,3) W ?41,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
W ?52,$E($P($G(^AUPNPAT(DFN,11)),U,18),1,11)
;S D=$O(^AMHREC("AE",DFN,"")) I D]"" S D=9999999-$P(D,".") W ?65,$E(D,4,5),"/",$E(D,6,7),"/",$E(D,2,3)
S D=$$LVD^AMHDPEE(DFN,"D") W ?65,D
Q
HEAD I 'AMHPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!
W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
S AMHLENG=$L(AMHPROGN)+25 W ?((80-AMHLENG)/2),"DESIGNATED ",AMHPROGN," PROVIDER LIST"
S AMHLENG=$S(AMHPRV:$L($P(^VA(200,AMHPRV,0),U)),1:3)+10
W !?((80-AMHLENG)/2),"PROVIDER: ",$S('AMHPRV:"ALL",1:$P(^VA(200,AMHPRV,0),U)),!
PIH W !,"PATIENT NAME",?25,"CHART #",?37,"SEX",?43,"DOB",?52,"COMMUNITY",?64,"LAST VISIT",!,AMH80D
Q
AMHRP7 ; IHS/CMI/LAB - VISIT COUNTS BY PROVIDER 03 Jun 2009 11:56 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;Designated Provider List
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
WRITE !!?20,"DESIGNATED PROVIDER LIST",!!
+5 DO DBHUSRP^AMHUTIL
+6 IF '$DATA(^AMHSITE(DUZ(2),16,"B",DUZ))
WRITE !!,"You will only see a list of patients for which you are the designated",!,"provider, regardless of how you answer the questions below.",!!
PROG ;select program to run report for
+1 SET AMHPROG=""
+2 SET DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER;T:OTHER NON-RPMS"
SET DIR("A")="Which DESIGNATED PROVIDER"
SET DIR("B")="M"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
DO END
QUIT
+4 SET AMHPROG=Y
SET AMHPROGN=Y(0)
PRV ;
+1 SET DIR(0)="S^1:ONE PROVIDER;2:ALL PROVIDERS"
SET DIR("A")="Run Report for"
SET DIR("B")="1"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO PROG
+3 SET AMHS=Y
+4 SET AMHPRV=""
IF '$DATA(^AMHSITE(DUZ(2),16,"B",DUZ))
Begin DoDot:1
+5 SET AMHPRV=DUZ
+6 WRITE !!,"Reporting on your provider list only.",!!
End DoDot:1
GOTO DEMO
+7 IF AMHS=1
Begin DoDot:1
+8 IF AMHPROG="T"
DO FT
QUIT
+9 SET DIC=200
SET DIC(0)="AEQMZ"
DO ^DIC
IF Y<0
QUIT
SET AMHPRV=+Y
End DoDot:1
+10 IF AMHS=1
IF AMHPRV=""
GOTO PROG
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO PRV
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 END
+3 IF $GET(Y)="B"
DO BROWSE
DO END
QUIT
+4 SET XBRC="M^AMHRP7"
SET XBRP="PRINT^AMHRP7"
SET XBNS="AMH"
SET XBRX="END^AMHRP7"
+5 DO ^XBDBQUE
END KILL ZTSK,Y,AMHBD,AMHED,AMHCL,AMHS,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPN,AMHPROG,AMHPROGN,AMHPRV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D
+1 QUIT
+2 ;
FT ;
+1 SET AMHPRV=""
+2 SET DIR(0)="F^1:30"
SET DIR("A")="Enter the OTHER NON-RPMS Designated Provider's Name"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET AMHPRV=Y
+5 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^AMHRP7"")"
+2 SET XBNS="AMH"
SET XBRC="M^AMHRP7"
SET XBRX="END^AMHRP7"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
M ;
+1 SET AMHJOB=$JOB
SET AMHBTH=$HOROLOG
+2 DO XTMP^AMHUTIL("AMHRP7","BH - DESIGNATED PROV LIST")
+3 SET DFN=0
FOR
SET DFN=$ORDER(^AMHPATR(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+4 IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+5 IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+6 SET AMHX=$SELECT(AMHPROG="M":$PIECE(^AMHPATR(DFN,0),U,2),AMHPROG="S":$PIECE(^AMHPATR(DFN,0),U,3),AMHPROG="C":$PIECE(^AMHPATR(DFN,0),U,4),AMHPROG="O":$PIECE(^AMHPATR(DFN,0),U,12),AMHPROG="T":$PIECE(^AMHPATR(DFN,0),U,13),1:"")
IF AMHX]""
DO PROC
+7 IF AMHPROG="T"
SET AMHX=$PIECE(^AMHPATR(DFN,0),U,14)
IF AMHX]""
DO PROC
End DoDot:1
+8 QUIT
PROC ;
+1 IF AMHPRV]""
IF AMHPRV'=AMHX
QUIT
+2 SET ^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHX,$PIECE(^DPT(DFN,0),U),DFN)=""
+3 QUIT
PRINT ;
START ;
+1 KILL AMHX
+2 SET AMH80D="-------------------------------------------------------------------------------"
+3 SET AMHPG=0
DO HEAD
+4 IF '$DATA(^XTMP("AMHRP7",AMHJOB,AMHBTH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO DONE
+5 SET AMHPN=""
KILL AMHQ
+6 FOR
SET AMHPN=$ORDER(^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHPN))
IF AMHPN=""!($DATA(AMHQ))
QUIT
DO DFN
+7 IF $DATA(AMHQ)
GOTO DONE
DONE DO DONE^AMHLEIN
DO ^AMHEKL
+1 KILL ^XTMP("AMHRP7",AMHJOB,AMHBTH)
+2 QUIT
DFN ;
+1 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQ)
QUIT
+2 SET AMHPCNT=0
+3 IF AMHPROG'="T"
WRITE !!,"PROVIDER: ",$PIECE(^VA(200,AMHPN,0),U),!
+4 IF AMHPROG="T"
WRITE !!,"PROVIDER: ",AMHPN
+5 SET AMHNAME=""
FOR
SET AMHNAME=$ORDER(^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHPN,AMHNAME))
IF AMHNAME=""!($DATA(AMHQ))
QUIT
Begin DoDot:1
+6 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("AMHRP7",AMHJOB,AMHBTH,AMHPN,AMHNAME,DFN))
IF DFN=""!($DATA(AMHQ))
QUIT
DO PROCP
End DoDot:1
+7 IF $DATA(AMHQ)
QUIT
+8 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQ)
QUIT
+9 WRITE !?57,"SUB-TOTAL: ",AMHPCNT
+10 QUIT
PROCP ;
+1 SET AMHPCNT=AMHPCNT+1
+2 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQ)
QUIT
+3 WRITE !,$PIECE(^DPT(DFN,0),U)
+4 SET AMHHRCN=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"")
+5 WRITE ?26,AMHHRCN
+6 WRITE ?37,$PIECE(^DPT(DFN,0),U,2)
+7 SET Y=$PIECE(^DPT(DFN,0),U,3)
WRITE ?41,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+8 WRITE ?52,$EXTRACT($PIECE($GET(^AUPNPAT(DFN,11)),U,18),1,11)
+9 ;S D=$O(^AMHREC("AE",DFN,"")) I D]"" S D=9999999-$P(D,".") W ?65,$E(D,4,5),"/",$E(D,6,7),"/",$E(D,2,3)
+10 SET D=$$LVD^AMHDPEE(DFN,"D")
WRITE ?65,D
+11 QUIT
HEAD IF 'AMHPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET AMHQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!
+4 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!
+5 SET AMHLENG=$LENGTH(AMHPROGN)+25
WRITE ?((80-AMHLENG)/2),"DESIGNATED ",AMHPROGN," PROVIDER LIST"
+6 SET AMHLENG=$SELECT(AMHPRV:$LENGTH($PIECE(^VA(200,AMHPRV,0),U)),1:3)+10
+7 WRITE !?((80-AMHLENG)/2),"PROVIDER: ",$SELECT('AMHPRV:"ALL",1:$PIECE(^VA(200,AMHPRV,0),U)),!
PIH WRITE !,"PATIENT NAME",?25,"CHART #",?37,"SEX",?43,"DOB",?52,"COMMUNITY",?64,"LAST VISIT",!,AMH80D
+1 QUIT
