Routine: AMHLETR

AMHLETR ; IHS/CMI/LAB - print report of tps needing resolved ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;fixed potential undef

 I '$D(IOF) D HOME^%ZIS

 W @(IOF),!!

 W "**********  LIST TREATMENT PLANS BY RESOLVED BY DATE  **********",!!

 W "This report will list all patients who have a treatment plan with an anticipated"

 W !,"completion date within a date range specified by the user."

 D DBHUSRP^AMHUTIL

GETDATES ;

BD ;get beginning date

 K DIR

 W !,"Please enter the desired date range.",!

 W ! S DIR(0)="D^::EP",DIR("A")="Enter BEGINNING Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S AMHBD=Y

ED ;get ending date

 W ! K DIR S DIR(0)="D^"_AMHBD_"::E",DIR("A")="Enter ENDING Date" 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 S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

PROG ;

 S AMHPROG=""

 K DIR 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 THER

 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

THER ;

 W !!,"You can limit the report output to treatment plans for one or all Providers",!

 K AMHTHER W ! S DIR(0)="S^O:One Provider;A:All Providers",DIR("A")="List treatment plans for",DIR("B")="O" K DA D ^DIR K DIR

 G:$D(DIRUT) BD

 G:Y="A" DEMO

 S DIC("A")="Which Designated Provider: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA

 I X="" G THER

 I Y<0 G THER

 S AMHTHER=+Y

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G THER

ZIS ;

 S XBRC="PROC^AMHLETR",XBRP="PRINT^AMHLETR",XBNS="AMH",XBRX="XIT^AMHLETR"

 D ^XBDBQUE

XIT ;EP

 K AMHTP,AMHED,AMHBD,AMHBDD,AMHEDD,AMHBTH,AMHJOB,AMHTPR,AMHET,AMH80D,AMHTHER

PROC ;EP - entry point for processing

 S AMHJOB=$J,AMHBTH=$H,AMHTOT=0,AMHTP=0,AMHBT=$H

 F  S AMHTP=$O(^AMHPTXP(AMHTP)) Q:AMHTP'=+AMHTP  D PROC1

 S AMHET=$H

 K AMHTP

PROC1 ;

 S X=$G(^AMHPTXP(AMHTP,0))

 Q:$P(X,U,2)=""  ;no patient

 Q:'$$ALLOWP^AMHUTIL(DUZ,$P(X,U,2))

 Q:$$DEMO^AMHUTIL1($P(X,U,2),$G(AMHDEMO))

 Q:'$$ALLOWTP^AMHLETP(DUZ,AMHTP)

 I $G(AMHTHER),$P(X,U,4)'=AMHTHER Q

 I AMHPROG]"",$P(X,U,17)'=AMHPROG Q

 I $P(X,U,3)]"",$P(X,U,3)'<AMHBD,$P(X,U,3)'>AMHED S ^XTMP("AMHLETR",AMHJOB,AMHBTH,AMHTP)=""

PRINT ;EP

 S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

 S AMH80D="-------------------------------------------------------------------------------",AMHQUIT=0,AMHPG=0

 D HEAD

 I '$D(^XTMP("AMHLETR",AMHJOB,AMHBTH)) W !!,"NO DATA TO REPORT" G DONE

 S AMHTP=0 F  S AMHTP=$O(^XTMP("AMHLETR",AMHJOB,AMHBTH,AMHTP)) Q:AMHTP'=+AMHTP!(AMHQUIT)  D

 .I $Y>(IOSL-4) D HEAD Q:AMHQUIT

 .S AMHTPR=^AMHPTXP(AMHTP,0)

 .Q:$P(AMHTPR,U,2)=""

 .S Y=$P(AMHTPR,U,2) I Y D ^AUPNPAT

 .W !,$S($P(AMHTPR,U,2):$P(^DPT($P(AMHTPR,U,2),0),U),1:"????"),?23,$$FMTE^XLFDT(AUPNDOB,"2D"),?33,$S($P($G(^AUPNPAT($P(AMHTPR,U,2),41,DUZ(2),0)),U,2):$P(^AUPNPAT($P(AMHTPR,U,2),41,DUZ(2),0),U,2),1:"???")

 .W ?41,$$FMTE^XLFDT($P(AMHTPR,U,1)),?54,$$FMTE^XLFDT($P(AMHTPR,U,9)),?68,$$FMTE^XLFDT($P(AMHTPR,U,3))

 .W !?3,"Program: ",$$VAL^XBDIQ1(9002011.56,AMHTP,.17),?33,"Responsible Provider: ",$S($P(AMHTPR,U,4):$P(^VA(200,$P(AMHTPR,U,4),0),U),1:"????")

DONE D DONE^AMHLEIN,^AMHEKL

 K ^XTMP("AMHLETR",AMHJOB,AMHBTH),AMHJOB,AMHBTH

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

HEAD ;

 I 'AMHPG G HEAD1

 NEW X

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT=1 Q

HEAD1 ;EP

 S AMHPG=AMHPG+1

 W:$D(IOF) @IOF

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !,$P(^VA(200,DUZ,0),U,2),?72,"Page 1 ",!

 W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!

 W ?13,"LISTING OF TREATMENT PLANS DUE TO BE RESOLVED",!

 W ?20,"Date Range: ",AMHBDD," to ",AMHEDD,!

 I AMHPROG]"" S X="Program: "_$$EXTSET^XBFUNC(9002011.56,.17,AMHPROG) W $$CTR(X),!

 I $G(AMHTHER) S X="Responsible Provider:  "_$P(^VA(200,AMHTHER,0),U) W $$CTR(X),!

 W !,"PATIENT NAME",?23,"DOB",?33,"CHART #",?41,"DATE",?54,"REVIEW DATE",?68,"ANTICIPATED"

 W !?41,"ESTABLISHED",?68,"COMPLETION",!?68,"DATE"

W !

 W AMH80D,!

AMHLETR   ; IHS/CMI/LAB - print report of tps needing resolved ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;fixed potential undef

 +4       ;

 +5       ;

 +6        IF '$DATA(IOF)

               DO HOME^%ZIS

 +7        WRITE @(IOF),!!

 +8        WRITE "**********  LIST TREATMENT PLANS BY RESOLVED BY DATE  **********",!!

 +9        WRITE "This report will list all patients who have a treatment plan with an anticipated"

 +10       WRITE !,"completion date within a date range specified by the user."

 +11       DO DBHUSRP^AMHUTIL

GETDATES  ;

BD        ;get beginning date

 +1        KILL DIR

 +2        WRITE !,"Please enter the desired date range.",!

 +3        WRITE !

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter BEGINNING Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO XIT

 +5        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           KILL DIR

           SET DIR(0)="D^"_AMHBD_"::E"

           SET DIR("A")="Enter ENDING Date"

           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

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

PROG      ;

 +1        SET AMHPROG=""

 +2        KILL DIR

           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 THER

 +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

THER      ;

 +1        WRITE !!,"You can limit the report output to treatment plans for one or all Providers",!

 +2        KILL AMHTHER

           WRITE !

           SET DIR(0)="S^O:One Provider;A:All Providers"

           SET DIR("A")="List treatment plans for"

           SET DIR("B")="O"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO BD

 +4        IF Y="A"

               GOTO DEMO

 +5        SET DIC("A")="Which Designated Provider: "

           SET DIC="^VA(200,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

 +6        IF X=""

               GOTO THER

 +7        IF Y<0

               GOTO THER

 +8        SET AMHTHER=+Y

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO THER

ZIS       ;

 +1        SET XBRC="PROC^AMHLETR"

           SET XBRP="PRINT^AMHLETR"

           SET XBNS="AMH"

           SET XBRX="XIT^AMHLETR"

 +2        DO ^XBDBQUE

XIT       ;EP

 +1        KILL AMHTP,AMHED,AMHBD,AMHBDD,AMHEDD,AMHBTH,AMHJOB,AMHTPR,AMHET,AMH80D,AMHTHER

 +2        QUIT

 +3       ;

PROC      ;EP - entry point for processing

 +1        SET AMHJOB=$JOB

           SET AMHBTH=$HOROLOG

           SET AMHTOT=0

           SET AMHTP=0

           SET AMHBT=$HOROLOG

 +2        FOR

               SET AMHTP=$ORDER(^AMHPTXP(AMHTP))

               IF AMHTP'=+AMHTP

                   QUIT

               DO PROC1

 +3        SET AMHET=$HOROLOG

 +4        KILL AMHTP

 +5        QUIT

PROC1     ;

 +1        SET X=$GET(^AMHPTXP(AMHTP,0))

 +2       ;no patient

           IF $PIECE(X,U,2)=""

               QUIT

 +3        IF '$$ALLOWP^AMHUTIL(DUZ,$PIECE(X,U,2))

               QUIT

 +4        IF $$DEMO^AMHUTIL1($PIECE(X,U,2),$GET(AMHDEMO))

               QUIT

 +5        IF '$$ALLOWTP^AMHLETP(DUZ,AMHTP)

               QUIT

 +6        IF $GET(AMHTHER)

               IF $PIECE(X,U,4)'=AMHTHER

                   QUIT

 +7        IF AMHPROG]""

               IF $PIECE(X,U,17)'=AMHPROG

                   QUIT

 +8        IF $PIECE(X,U,3)]""

               IF $PIECE(X,U,3)'<AMHBD

                   IF $PIECE(X,U,3)'>AMHED

                       SET ^XTMP("AMHLETR",AMHJOB,AMHBTH,AMHTP)=""

 +9        QUIT

PRINT     ;EP

 +1        SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +2        SET AMH80D="-------------------------------------------------------------------------------"

           SET AMHQUIT=0

           SET AMHPG=0

 +3        DO HEAD

 +4        IF '$DATA(^XTMP("AMHLETR",AMHJOB,AMHBTH))

               WRITE !!,"NO DATA TO REPORT"

               GOTO DONE

 +5        SET AMHTP=0

FOR

               SET AMHTP=$ORDER(^XTMP("AMHLETR",AMHJOB,AMHBTH,AMHTP))

               IF AMHTP'=+AMHTP!(AMHQUIT)

                   QUIT

               Begin DoDot:1

 +6                IF $Y>(IOSL-4)

                       DO HEAD

                       IF AMHQUIT

                           QUIT

 +7                SET AMHTPR=^AMHPTXP(AMHTP,0)

 +8                IF $PIECE(AMHTPR,U,2)=""

                       QUIT

 +9                SET Y=$PIECE(AMHTPR,U,2)

                   IF Y

                       DO ^AUPNPAT

 +10               WRITE !,$SELECT($PIECE(AMHTPR,U,2):$PIECE(^DPT($PIECE(AMHTPR,U,2),0),U),1:"????"),?23,$$FMTE^XLFDT(AUPNDOB,"2D"),?33,$SELECT($PIECE($GET(^AUPNPAT($PIECE(AMHTPR,U,2),41,DUZ(2),0)),U,2):$PIECE(^AUPNPAT($PIECE(AMHTPR,U,2),41,DUZ(2),0),U,2)

,1:"???")

 +11               WRITE ?41,$$FMTE^XLFDT($PIECE(AMHTPR,U,1)),?54,$$FMTE^XLFDT($PIECE(AMHTPR,U,9)),?68,$$FMTE^XLFDT($PIECE(AMHTPR,U,3))

 +12               WRITE !?3,"Program: ",$$VAL^XBDIQ1(9002011.56,AMHTP,.17),?33,"Responsible Provider: ",$SELECT($PIECE(AMHTPR,U,4):$PIECE(^VA(200,$PIECE(AMHTPR,U,4),0),U),1:"????")

               End DoDot:1

DONE       DO DONE^AMHLEIN

           DO ^AMHEKL

 +1        KILL ^XTMP("AMHLETR",AMHJOB,AMHBTH),AMHJOB,AMHBTH

 +2        QUIT

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

HEAD      ;

 +1        IF 'AMHPG

               GOTO HEAD1

 +2        NEW X

 +3        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET AMHQUIT=1

                       QUIT

HEAD1     ;EP

 +1        SET AMHPG=AMHPG+1

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +4        WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page 1 ",!

 +5        WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!

 +6        WRITE ?13,"LISTING OF TREATMENT PLANS DUE TO BE RESOLVED",!

 +7        WRITE ?20,"Date Range: ",AMHBDD," to ",AMHEDD,!

 +8        IF AMHPROG]""

               SET X="Program: "_$$EXTSET^XBFUNC(9002011.56,.17,AMHPROG)

               WRITE $$CTR(X),!

 +9        IF $GET(AMHTHER)

               SET X="Responsible Provider:  "_$PIECE(^VA(200,AMHTHER,0),U)

               WRITE $$CTR(X),!

 +10       WRITE !,"PATIENT NAME",?23,"DOB",?33,"CHART #",?41,"DATE",?54,"REVIEW DATE",?68,"ANTICIPATED"

 +11       WRITE !?41,"ESTABLISHED",?68,"COMPLETION",!?68,"DATE"

 +12       WRITE !

 +13       WRITE AMH80D,!

 +14       QUIT

AMHLETR.m