AMHLETR2.m

AMHLETR2 ; 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  **********",!!

 W "This report will list all patients who have a treatment plan on file."

 D DBHUSRP^AMHUTIL

GETDATES ;

BD ;get beginning date

 W !,"Please enter the date range during which the treatment plan was established.",!

 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 ! 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=""

 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.56,.17",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) XIT

 G:Y="A" SORT

 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

SORT ;

 S AMHSORT=""

 S DIR(0)="S^P:Responsible Provider;N:Patient Name;D:Date Established",DIR("A")="Sort list by",DIR("B")="P" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G THER

 S AMHSORT=Y

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G THER

ZIS ;

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

 D ^XBDBQUE

XIT ;

 D EN^XBVK("AMH")

 Q

 ;

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

 Q

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

 D @AMHSORT

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

 Q

P ;

 S AMHSORTV=$P(X,U,4)

 I AMHSORTV S AMHSORTV=$P(^VA(200,AMHSORTV,0),U) Q

 S AMHSORTV="--"

 Q

N ;

 S P=$P(^AMHPTXP(AMHTP,0),U,2)

 I P="" S AMHSORVT="--" Q

 S AMHSORTV=$P(^DPT(P,0),U)

 I AMHSORTV="" S AMHSORTV="--"

 Q

D ;

 S AMHSORTV=$P(^AMHPTXP(AMHTP,0),U,1)

 I AMHSORTV="" S AMHSORTV="--" Q

 Q

PRINT ;EP

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

 D HEAD

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

 S AMHSORTV="" F  S AMHSORTV=$O(^XTMP("AMHLETR2",AMHJOB,AMHBTH,AMHSORTV)) Q:AMHSORTV=""!(AMHQUIT)  D PRT2

 D DONE

 Q

PRT2 ;

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

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

 .S AMHTPR=^AMHPTXP(AMHTP,0)

 .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:"????")

 Q

DONE D DONE^AMHLEIN,^AMHEKL

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

 Q

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),!

 S X="LISTING OF TREATMENT PLANS" W $$CTR(X),!

 W ?20,"Date Established: ",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,!

 Q

AMHLETR2  ; 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  **********",!!

 +9        WRITE "This report will list all patients who have a treatment plan on file."

 +10       DO DBHUSRP^AMHUTIL

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !,"Please enter the date range during which the treatment plan was established.",!

 +2        WRITE !

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

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

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           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        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.56,.17"

           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 XIT

 +4        IF Y="A"

               GOTO SORT

 +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

SORT      ;

 +1        SET AMHSORT=""

 +2        SET DIR(0)="S^P:Responsible Provider;N:Patient Name;D:Date Established"

           SET DIR("A")="Sort list by"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO THER

 +4        SET AMHSORT=Y

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO THER

ZIS       ;

 +1        SET XBRC="PROC^AMHLETR2"

           SET XBRP="PRINT^AMHLETR2"

           SET XBNS="AMH"

           SET XBRX="XIT^AMHLETR2"

 +2        DO ^XBDBQUE

XIT       ;

 +1        DO EN^XBVK("AMH")

 +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        DO @AMHSORT

 +9        IF $PIECE(X,U,1)]""

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

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

                       SET ^XTMP("AMHLETR2",AMHJOB,AMHBTH,AMHSORTV,AMHTP)=""

 +10       QUIT 

P         ;

 +1        SET AMHSORTV=$PIECE(X,U,4)

 +2        IF AMHSORTV

               SET AMHSORTV=$PIECE(^VA(200,AMHSORTV,0),U)

               QUIT 

 +3        SET AMHSORTV="--"

 +4        QUIT 

N         ;

 +1        SET P=$PIECE(^AMHPTXP(AMHTP,0),U,2)

 +2        IF P=""

               SET AMHSORVT="--"

               QUIT 

 +3        SET AMHSORTV=$PIECE(^DPT(P,0),U)

 +4        IF AMHSORTV=""

               SET AMHSORTV="--"

 +5        QUIT 

D         ;

 +1        SET AMHSORTV=$PIECE(^AMHPTXP(AMHTP,0),U,1)

 +2        IF AMHSORTV=""

               SET AMHSORTV="--"

               QUIT 

 +3        QUIT 

PRINT     ;EP

 +1        SET AMH80D="-------------------------------------------------------------------------------"

           SET AMHQUIT=0

           SET AMHPG=0

 +2        DO HEAD

 +3        IF '$DATA(^XTMP("AMHLETR2",AMHJOB,AMHBTH))

               WRITE !!,"NO DATA TO REPORT"

               GOTO DONE

 +4        SET AMHSORTV=""

           FOR 

               SET AMHSORTV=$ORDER(^XTMP("AMHLETR2",AMHJOB,AMHBTH,AMHSORTV))

               IF AMHSORTV=""!(AMHQUIT)

                   QUIT 

               DO PRT2

 +5        DO DONE

 +6        QUIT 

PRT2      ;

 +1        SET AMHTP=0

           FOR 

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

               IF AMHTP'=+AMHTP!(AMHQUIT)

                   QUIT 

               Begin DoDot:1

 +2                IF $Y>(IOSL-4)

                       DO HEAD

                       IF AMHQUIT

                           QUIT 

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

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

                   IF Y

                       DO ^AUPNPAT

 +5                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:"???")

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

 +7                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

 +8        QUIT 

DONE       DO DONE^AMHLEIN

           DO ^AMHEKL

 +1        KILL ^XTMP("AMHLETR2",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        SET X="LISTING OF TREATMENT PLANS"

           WRITE $$CTR(X),!

 +7        WRITE ?20,"Date Established: ",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