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