AMHLETP3 ; IHS/CMI/LAB - print goals on tp ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
SIG ;signature line
Q:AMHQUIT
I $Y>(AMHIOSL-17) D HEAD^AMHLETPP Q:AMHQUIT
I '$G(AMHBROW) S X=AMHIOSL-$Y-17 F I=1:1:X W !
I $G(AMHBROW) W !!
W !!!!?2,"__________________________________ ___________________________________"
W !?2,"Client's Signature Designated Provider's Signature"
W !!!?2,"___________________________________ ___________________________________"
W !?2,"Supervisor's Signature Physician's Signature",!
W !!!?2,"___________________________________ ___________________________________"
W !?2,"Other Other",!
W !!!?2,"___________________________________ ___________________________________"
W !?2,"Other Other",!
REV ;EP - review with client
I $G(AMHPREV)="T" Q
I '$D(^AMHPTXP(AMHTP,41)) Q
S AMHD=0 F S AMHD=$O(^AMHPTXP(AMHTP,41,AMHD)) Q:AMHD'=+AMHD!(AMHQUIT) D
.I $D(AMHREVP) Q:'$D(AMHREVP(AMHD))
.D HEAD Q:AMHQUIT
.W !!?2,"Date of Review: ",?27,$$FMTE^XLFDT(AMHD)
.I $Y>(AMHIOSL-3) D HEAD Q:AMHQUIT
.W !!?2,"Reviewing Provider: ",?27,$S($P(^AMHPTXP(AMHTP,41,AMHD,0),U,3):$P(^VA(200,$P(^AMHPTXP(AMHTP,41,AMHD,0),U,3),0),U),1:"<<not recorded>>")
.I $Y>(AMHIOSL-3) D HEAD Q:AMHQUIT
.W !!?2,"Reviewing Supervisor: ",?27,$S($P(^AMHPTXP(AMHTP,41,AMHD,0),U,4):$P(^VA(200,$P(^AMHPTXP(AMHTP,41,AMHD,0),U,4),0),U),1:"<<not recorded>>")
.I $Y>(AMHIOSL-3) D HEAD Q:AMHQUIT
.W !!?2,"Next Review Date: ",?27,$$FMTE^XLFDT($P(^AMHPTXP(AMHTP,41,AMHD,0),U,2))
.W !!?2,"Progress Summary: ",!
.K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=1,AMHDA=AMHD,AMHFILE=9002011.564101,AMHG="^AMHPTXP("_AMHTP_",41," D NWP^AMHLETP4
.;K AMHPCNT,AMHPRNM S AMHPCNT=0,X=0 F S X=$O(^AMHPTXP(AMHTP,41,AMHD,1,X)) Q:X'=+X S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=^AMHPTXP(AMHTP,41,AMHD,1,X,0)
.I $D(AMHPRNM) S X=0 F S X=$O(AMHPRNM(X)) Q:X'=+X!(AMHQUIT) D:$Y>(AMHIOSL-2) HEAD^AMHLETPP Q:AMHQUIT W ?6,$TR(AMHPRNM(X),$C(10)),!
.Q:AMHQUIT
.;participants
.I $Y>(AMHIOSL-5) D HEAD Q:AMHQUIT
PART .W !!?2,"Participants in Review:"
.W !!?2,"PARTICIPANT NAME",?35,"RELATIONSHIP TO CLIENT"
.I '$D(^AMHPTXP(AMHTP,41,AMHD,12)) D SIGREV Q
.S X=0 F S X=$O(^AMHPTXP(AMHTP,41,AMHD,12,X)) Q:X'=+X!(AMHQUIT) D
..D:$Y>(AMHIOSL-3) HEAD Q:AMHQUIT W !!?2,$P(^AMHPTXP(AMHTP,41,AMHD,12,X,0),U),?35,$P(^AMHPTXP(AMHTP,41,AMHD,12,X,0),U,2)
..Q
.Q:AMHQUIT
.D SIGREV
.Q
Q
SIGREV ;
I $Y>(AMHIOSL-17) D HEAD^AMHLETPP Q:AMHQUIT
I '$G(AMHBROW) S X=AMHIOSL-$Y-17 F I=1:1:X W !
I $G(AMHBROW) W !!
W !!!!?2,"__________________________________ ___________________________________"
W !?2,"Client's Signature Designated Provider's Signature"
W !!!?2,"___________________________________ ___________________________________"
W !?2,"Supervisor's Signature Physician's Signature",!
W !!!?2,"___________________________________ ___________________________________"
W !?2,"Other Other",!
W !!!?2,"___________________________________ ___________________________________"
W !?2,"Other Other",!
Q
HEAD ;ENTRY POINT
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
I AMHPG W:$D(IOF) @IOF
S AMHPG=AMHPG+1
W:$G(AMHGUI) "ZZZZZZZ",!
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$TR($J("",80)," ","*")
W !,"*",?79,"*"
W !,"* TREATMENT PLAN REVIEW",?45,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT),?79,"*"
W !,"* Name: ",$P(^DPT(DFN,0),U),?68,"Page ",AMHPG,?79,"*"
W !,"* ",$E($P(^DIC(4,DUZ(2),0),U),1,25),?30,"DOB: ",$$FMTE^XLFDT($P(^DPT(DFN,0),U,3),"2D"),?46,"Sex: ",$P(^DPT(DFN,0),U,2),?54," Chart #: ",$P(^AUTTLOC(DUZ(2),0),U,7),$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),?79,"*"
W !,"*",?79,"*"
W !,$TR($J("",80)," ","*"),!
Q
;
AMHLETP3 ; IHS/CMI/LAB - print goals on tp ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
SIG ;signature line
+1 IF AMHQUIT
QUIT
+2 IF $Y>(AMHIOSL-17)
DO HEAD^AMHLETPP
IF AMHQUIT
QUIT
+3 IF '$GET(AMHBROW)
SET X=AMHIOSL-$Y-17
FOR I=1:1:X
WRITE !
+4 IF $GET(AMHBROW)
WRITE !!
+5 WRITE !!!!?2,"__________________________________ ___________________________________"
+6 WRITE !?2,"Client's Signature Designated Provider's Signature"
+7 WRITE !!!?2,"___________________________________ ___________________________________"
+8 WRITE !?2,"Supervisor's Signature Physician's Signature",!
+9 WRITE !!!?2,"___________________________________ ___________________________________"
+10 WRITE !?2,"Other Other",!
+11 WRITE !!!?2,"___________________________________ ___________________________________"
+12 WRITE !?2,"Other Other",!
REV ;EP - review with client
+1 IF $GET(AMHPREV)="T"
QUIT
+2 IF '$DATA(^AMHPTXP(AMHTP,41))
QUIT
+3 SET AMHD=0
FOR
SET AMHD=$ORDER(^AMHPTXP(AMHTP,41,AMHD))
IF AMHD'=+AMHD!(AMHQUIT)
QUIT
Begin DoDot:1
+4 IF $DATA(AMHREVP)
IF '$DATA(AMHREVP(AMHD))
QUIT
+5 DO HEAD
IF AMHQUIT
QUIT
+6 WRITE !!?2,"Date of Review: ",?27,$$FMTE^XLFDT(AMHD)
+7 IF $Y>(AMHIOSL-3)
DO HEAD
IF AMHQUIT
QUIT
+8 WRITE !!?2,"Reviewing Provider: ",?27,$SELECT($PIECE(^AMHPTXP(AMHTP,41,AMHD,0),U,3):$PIECE(^VA(200,$PIECE(^AMHPTXP(AMHTP,41,AMHD,0),U,3),0),U),1:"<<not recorded>>")
+9 IF $Y>(AMHIOSL-3)
DO HEAD
IF AMHQUIT
QUIT
+10 WRITE !!?2,"Reviewing Supervisor: ",?27,$SELECT($PIECE(^AMHPTXP(AMHTP,41,AMHD,0),U,4):$PIECE(^VA(200,$PIECE(^AMHPTXP(AMHTP,41,AMHD,0),U,4),0),U),1:"<<not recorded>>")
+11 IF $Y>(AMHIOSL-3)
DO HEAD
IF AMHQUIT
QUIT
+12 WRITE !!?2,"Next Review Date: ",?27,$$FMTE^XLFDT($PIECE(^AMHPTXP(AMHTP,41,AMHD,0),U,2))
+13 WRITE !!?2,"Progress Summary: ",!
+14 KILL AMHPCNT,AMHPRNM
SET AMHPCNT=0
SET AMHNODE=1
SET AMHDA=AMHD
SET AMHFILE=9002011.564101
SET AMHG="^AMHPTXP("_AMHTP_",41,"
DO NWP^AMHLETP4
+15 ;K AMHPCNT,AMHPRNM S AMHPCNT=0,X=0 F S X=$O(^AMHPTXP(AMHTP,41,AMHD,1,X)) Q:X'=+X S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=^AMHPTXP(AMHTP,41,AMHD,1,X,0)
+16 IF $DATA(AMHPRNM)
SET X=0
FOR
SET X=$ORDER(AMHPRNM(X))
IF X'=+X!(AMHQUIT)
QUIT
IF $Y>(AMHIOSL-2)
DO HEAD^AMHLETPP
IF AMHQUIT
QUIT
WRITE ?6,$TRANSLATE(AMHPRNM(X),$CHAR(10)),!
+17 IF AMHQUIT
QUIT
+18 ;participants
+19 IF $Y>(AMHIOSL-5)
DO HEAD
IF AMHQUIT
QUIT
PART WRITE !!?2,"Participants in Review:"
+1 WRITE !!?2,"PARTICIPANT NAME",?35,"RELATIONSHIP TO CLIENT"
+2 IF '$DATA(^AMHPTXP(AMHTP,41,AMHD,12))
DO SIGREV
QUIT
+3 SET X=0
FOR
SET X=$ORDER(^AMHPTXP(AMHTP,41,AMHD,12,X))
IF X'=+X!(AMHQUIT)
QUIT
Begin DoDot:2
+4 IF $Y>(AMHIOSL-3)
DO HEAD
IF AMHQUIT
QUIT
WRITE !!?2,$PIECE(^AMHPTXP(AMHTP,41,AMHD,12,X,0),U),?35,$PIECE(^AMHPTXP(AMHTP,41,AMHD,12,X,0),U,2)
+5 QUIT
End DoDot:2
+6 IF AMHQUIT
QUIT
+7 DO SIGREV
+8 QUIT
End DoDot:1
+9 QUIT
SIGREV ;
+1 IF $Y>(AMHIOSL-17)
DO HEAD^AMHLETPP
IF AMHQUIT
QUIT
+2 IF '$GET(AMHBROW)
SET X=AMHIOSL-$Y-17
FOR I=1:1:X
WRITE !
+3 IF $GET(AMHBROW)
WRITE !!
+4 WRITE !!!!?2,"__________________________________ ___________________________________"
+5 WRITE !?2,"Client's Signature Designated Provider's Signature"
+6 WRITE !!!?2,"___________________________________ ___________________________________"
+7 WRITE !?2,"Supervisor's Signature Physician's Signature",!
+8 WRITE !!!?2,"___________________________________ ___________________________________"
+9 WRITE !?2,"Other Other",!
+10 WRITE !!!?2,"___________________________________ ___________________________________"
+11 WRITE !?2,"Other Other",!
+12 QUIT
HEAD ;ENTRY POINT
+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 IF AMHPG
IF $DATA(IOF)
WRITE @IOF
+2 SET AMHPG=AMHPG+1
+3 IF $GET(AMHGUI)
WRITE "ZZZZZZZ",!
+4 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+5 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*")
+6 WRITE !,"*",?79,"*"
+7 WRITE !,"* TREATMENT PLAN REVIEW",?45,"Printed: ",$$FMTE^XLFDT($$NOW^XLFDT),?79,"*"
+8 WRITE !,"* Name: ",$PIECE(^DPT(DFN,0),U),?68,"Page ",AMHPG,?79,"*"
+9 WRITE !,"* ",$EXTRACT($PIECE(^DIC(4,DUZ(2),0),U),1,25),?30,"DOB: ",$$FMTE^XLFDT($PIECE(^DPT(DFN,0),U,3),"2D"),?46,"Sex: ",$PIECE(^DPT(DFN,0),U,2),?54," Chart #: ",$PIECE(^AUTTLOC(DUZ(2),0),U,7),$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2),?
79,"*"
+10 WRITE !,"*",?79,"*"
+11 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*"),!
+12 QUIT
+13 ;
