AMHRP7.m

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