AMHPOST1 ; IHS/CMI/LAB - DISPLAY A TREATMENT PLAN ;
;;3.0;IHS BEHAVIORAL HEALTH;;JAN 27, 2003
;
GATHER ;gather up and display all problems/goals/methods
S AMHA=0,AMHRCNT=0 F S AMHA=$O(^AMHPTPP("AD",AMHXX,AMHA)) Q:AMHA'=+AMHA D GATHER1
Q
GATHER1 ;
S AMHRCNT=AMHRCNT+1
S AMHLINE=0,AMH0=^AMHPTPP(AMHA,0)
S AMHZ1=AMHRCNT_". Problem: "_$P(AMH0,U)
W !!,AMHZ1
W !,?5,"DESCRIPTION:"
K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=11,AMHDA=AMHA,AMHFILE=9002011.62 D WP^AMHLETP4
I $D(AMHPRNM) S AMHZ1=0 F S AMHZ1=$O(AMHPRNM(AMHZ1)) Q:AMHZ1'=+AMHZ1 W !?5,AMHPRNM(AMHZ1)
S AMHZ1="Date Established: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08),$E(AMHZ1,42)="By: "_$E($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25)
W !!?5,AMHZ1
S AMHZ1="Date Last Modified: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08),$E(AMHZ1,42)="By: "_$E($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25)
W !?5,AMHZ1
G ;get goals
S AMHZ1="GOALS:"
W !!?8,AMHZ1
S (AMHB,AMHB1)=0 F S AMHB=$O(^AMHPTPGL("AD",AMHA,AMHB)) Q:AMHB'=+AMHB S AMHB1=AMHB1+1 D
.K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=11,AMHCOL=10,AMHDA=AMHB,AMHFILE=9002011.63 D WP^AMHLETP4
.I $D(AMHPRNM) W ! S AMHZ=0 F S AMHZ=$O(AMHPRNM(AMHZ)) Q:AMHZ'=+AMHZ S AMHZ1="" S:AMHZ=1 AMHZ1="Goal #"_AMHB1_" "_AMHPRNM(AMHZ) S:AMHZ'=1 AMHZ1=AMHPRNM(AMHZ) W !?8,AMHZ1
.S AMHZ1="",AMHZ1="Date Established: "_$$VAL^XBDIQ1(9002011.63,AMHB,.08),$E(AMHZ1,44)="By: "_$E($$VAL^XBDIQ1(9002011.63,AMHB,.06),1,25)
.W !?8,AMHZ1
.S AMHZ1="",AMHZ1="Date Last Modified: "_$$VAL^XBDIQ1(9002011.63,AMHB,.04),$E(AMHZ1,44)="By: "_$E($$VAL^XBDIQ1(9002011.63,AMHB,.05),1,25)
.W !?8,AMHZ1
.S AMHZ1="Status: "_$$VAL^XBDIQ1(9002011.63,AMHB,.12)
.W !?8,AMHZ1
.;comments for this goal
.S AMHZ1="COMMENTS:"
.W !?8,AMHZ1
.S AMHD=0 F S AMHD=$O(^AMHPTPGL(AMHB,12,AMHD)) Q:AMHD'=+AMHD D
..S AMHZ=^AMHPTPGL(AMHB,12,AMHD,0)
..S AMHZ1="Comments made by "_$S($P(AMHZ,U,2):$P(^VA(200,$P(AMHZ,U,2),0),U),1:"")_" on "_$$FMTE^XLFDT($P(AMHZ,U))
..W !?8,AMHZ1
..K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHCOL=10,AMHNODE=11,AMHDA=AMHD,AMHG="^AMHPTPGL("_AMHB_",12," D WP^AMHLETP4
..I $D(AMHPRNM) S AMHZ=0 F S AMHZ=$O(AMHPRNM(AMHZ)) Q:AMHZ'=+AMHZ S AMHZ1="" S:AMHZ=1 AMHZ1=AMHB1_") "_AMHPRNM(AMHZ) S:AMHZ'=1 AMHZ1=AMHPRNM(AMHZ) W !?10,AMHZ1
.S AMHZ1="TREATMENT METHODS:"
.W !!?10,AMHZ1
M .;
.S (AMHC,AMHC1)=0 F S AMHC=$O(^AMHPTPM("AD",AMHB,AMHC)) Q:AMHC'=+AMHC S AMHC1=AMHC1+1 D
..K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=11,AMHCOL=15,AMHDA=AMHC,AMHFILE=9002011.64 D WP^AMHLETP4
..I $D(AMHPRNM) W ! S AMHZ=0 F S AMHZ=$O(AMHPRNM(AMHZ)) Q:AMHZ'=+AMHZ S AMHZ1="" S:AMHZ=1 AMHZ1=AMHC1_") "_AMHPRNM(AMHZ) S:AMHZ'=1 AMHZ1=AMHPRNM(AMHZ) W !?10,AMHZ1
..S AMHZ1="Date Established: "_$$VAL^XBDIQ1(9002011.64,AMHC,.04),$E(AMHZ1,44)="By: "_$E($$VAL^XBDIQ1(9002011.64,AMHC,.09),1,25)
..W !?10,AMHZ1
..S AMHZ1="Frequency: "_$$VAL^XBDIQ1(9002011.64,AMHC,.07),$E(AMHZ1,42)="By: "_$$VAL^XBDIQ1(9002011.64,AMHC,.05)
..W !?10,AMHZ1
Q
METHOD ;EP called from amhletpp
I '$D(^AMHPTXPG("AD",AMHTP)) Q
W !!?2,"METHODS:"
DISPMETH ;
K AMHRMETH S (AMHGIEN,AMHC)=0 F S AMHGIEN=$O(^AMHPTXPG("AD",AMHTP,AMHGIEN)) Q:AMHGIEN'=+AMHGIEN S AMHC=AMHC+1 D
.S AMHMETH0=^AMHPTXPG(AMHGIEN,0)
.S AMHRMETH(AMHC)=AMHGIEN
.W !?2,AMHC,") Date Method Established: ",$$FTIME^VALM1($P(AMHMETH0,U,4))," Therapist: " W:$P(AMHMETH0,U,5) $E($P(^VA(200,$P(AMHMETH0,U,5),0),U),1,25) W !
.K AMHPCNT,AMHPRNM S AMHPCNT=0,AMHNODE=11,AMHDA=AMHGIEN,AMHFILE=9002011.57 D WP^AMHLETP4
.I $D(AMHPRNM) S X=0 F S X=$O(AMHPRNM(X)) Q:X'=+X W ?6,AMHPRNM(X),!
.K AMHLETXT S AMHLETP("ICL")=0,AMHLETP("NRQ")="Method: "_$G(^AMHPTXPG(AMHGIEN,12)),AMHLETP("TXT")="",AMHLEC=0
.D GETTXT^AMHLETP
.S X=0 F S X=$O(AMHLETXT(X)) Q:X'=+X W !?6,AMHLETXT(X)
.K AMHLETXT S AMHLETP("ICL")=0,AMHLETP("NRQ")="Duration: "_$G(^AMHPTXPG(AMHGIEN,13)),AMHLETP("TXT")="",AMHLEC=0
.D GETTXT^AMHLETP
.S X=0 F S X=$O(AMHLETXT(X)) Q:X'=+X W !?6,AMHLETXT(X)
.W !?6,"Target Date: ",$$FTIME^VALM1($P(AMHMETH0,U,7)),!?6,"Status: " W:$P(AMHMETH0,U,8)]"" $$EXTSET^XBFUNC(9002011.57,.08,$P(AMHMETH0,U,8))
.W !?6,"Date Reviewed w/client: ",$$FTIME^VALM1($P(AMHMETH0,U,6)),!
.Q
Q
AMHPOST1 ; IHS/CMI/LAB - DISPLAY A TREATMENT PLAN ;
+1 ;;3.0;IHS BEHAVIORAL HEALTH;;JAN 27, 2003
+2 ;
GATHER ;gather up and display all problems/goals/methods
+1 SET AMHA=0
SET AMHRCNT=0
FOR
SET AMHA=$ORDER(^AMHPTPP("AD",AMHXX,AMHA))
IF AMHA'=+AMHA
QUIT
DO GATHER1
+2 QUIT
GATHER1 ;
+1 SET AMHRCNT=AMHRCNT+1
+2 SET AMHLINE=0
SET AMH0=^AMHPTPP(AMHA,0)
+3 SET AMHZ1=AMHRCNT_". Problem: "_$PIECE(AMH0,U)
+4 WRITE !!,AMHZ1
+5 WRITE !,?5,"DESCRIPTION:"
+6 KILL AMHPCNT,AMHPRNM
SET AMHPCNT=0
SET AMHNODE=11
SET AMHDA=AMHA
SET AMHFILE=9002011.62
DO WP^AMHLETP4
+7 IF $DATA(AMHPRNM)
SET AMHZ1=0
FOR
SET AMHZ1=$ORDER(AMHPRNM(AMHZ1))
IF AMHZ1'=+AMHZ1
QUIT
WRITE !?5,AMHPRNM(AMHZ1)
+8 SET AMHZ1="Date Established: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08)
SET $EXTRACT(AMHZ1,42)="By: "_$EXTRACT($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25)
+9 WRITE !!?5,AMHZ1
+10 SET AMHZ1="Date Last Modified: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08)
SET $EXTRACT(AMHZ1,42)="By: "_$EXTRACT($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25)
+11 WRITE !?5,AMHZ1
G ;get goals
+1 SET AMHZ1="GOALS:"
+2 WRITE !!?8,AMHZ1
+3 SET (AMHB,AMHB1)=0
FOR
SET AMHB=$ORDER(^AMHPTPGL("AD",AMHA,AMHB))
IF AMHB'=+AMHB
QUIT
SET AMHB1=AMHB1+1
Begin DoDot:1
+4 KILL AMHPCNT,AMHPRNM
SET AMHPCNT=0
SET AMHNODE=11
SET AMHCOL=10
SET AMHDA=AMHB
SET AMHFILE=9002011.63
DO WP^AMHLETP4
+5 IF $DATA(AMHPRNM)
WRITE !
SET AMHZ=0
FOR
SET AMHZ=$ORDER(AMHPRNM(AMHZ))
IF AMHZ'=+AMHZ
QUIT
SET AMHZ1=""
IF AMHZ=1
SET AMHZ1="Goal #"_AMHB1_" "_AMHPRNM(AMHZ)
IF AMHZ'=1
SET AMHZ1=AMHPRNM(AMHZ)
WRITE !?8,AMHZ1
+6 SET AMHZ1=""
SET AMHZ1="Date Established: "_$$VAL^XBDIQ1(9002011.63,AMHB,.08)
SET $EXTRACT(AMHZ1,44)="By: "_$EXTRACT($$VAL^XBDIQ1(9002011.63,AMHB,.06),1,25)
+7 WRITE !?8,AMHZ1
+8 SET AMHZ1=""
SET AMHZ1="Date Last Modified: "_$$VAL^XBDIQ1(9002011.63,AMHB,.04)
SET $EXTRACT(AMHZ1,44)="By: "_$EXTRACT($$VAL^XBDIQ1(9002011.63,AMHB,.05),1,25)
+9 WRITE !?8,AMHZ1
+10 SET AMHZ1="Status: "_$$VAL^XBDIQ1(9002011.63,AMHB,.12)
+11 WRITE !?8,AMHZ1
+12 ;comments for this goal
+13 SET AMHZ1="COMMENTS:"
+14 WRITE !?8,AMHZ1
+15 SET AMHD=0
FOR
SET AMHD=$ORDER(^AMHPTPGL(AMHB,12,AMHD))
IF AMHD'=+AMHD
QUIT
Begin DoDot:2
+16 SET AMHZ=^AMHPTPGL(AMHB,12,AMHD,0)
+17 SET AMHZ1="Comments made by "_$SELECT($PIECE(AMHZ,U,2):$PIECE(^VA(200,$PIECE(AMHZ,U,2),0),U),1:"")_" on "_$$FMTE^XLFDT($PIECE(AMHZ,U))
+18 WRITE !?8,AMHZ1
+19 KILL AMHPCNT,AMHPRNM
SET AMHPCNT=0
SET AMHCOL=10
SET AMHNODE=11
SET AMHDA=AMHD
SET AMHG="^AMHPTPGL("_AMHB_",12,"
DO WP^AMHLETP4
+20 IF $DATA(AMHPRNM)
SET AMHZ=0
FOR
SET AMHZ=$ORDER(AMHPRNM(AMHZ))
IF AMHZ'=+AMHZ
QUIT
SET AMHZ1=""
IF AMHZ=1
SET AMHZ1=AMHB1_") "_AMHPRNM(AMHZ)
IF AMHZ'=1
SET AMHZ1=AMHPRNM(AMHZ)
WRITE !?10,AMHZ1
End DoDot:2
+21 SET AMHZ1="TREATMENT METHODS:"
+22 WRITE !!?10,AMHZ1
M ;
+1 SET (AMHC,AMHC1)=0
FOR
SET AMHC=$ORDER(^AMHPTPM("AD",AMHB,AMHC))
IF AMHC'=+AMHC
QUIT
SET AMHC1=AMHC1+1
Begin DoDot:2
+2 KILL AMHPCNT,AMHPRNM
SET AMHPCNT=0
SET AMHNODE=11
SET AMHCOL=15
SET AMHDA=AMHC
SET AMHFILE=9002011.64
DO WP^AMHLETP4
+3 IF $DATA(AMHPRNM)
WRITE !
SET AMHZ=0
FOR
SET AMHZ=$ORDER(AMHPRNM(AMHZ))
IF AMHZ'=+AMHZ
QUIT
SET AMHZ1=""
IF AMHZ=1
SET AMHZ1=AMHC1_") "_AMHPRNM(AMHZ)
IF AMHZ'=1
SET AMHZ1=AMHPRNM(AMHZ)
WRITE !?10,AMHZ1
+4 SET AMHZ1="Date Established: "_$$VAL^XBDIQ1(9002011.64,AMHC,.04)
SET $EXTRACT(AMHZ1,44)="By: "_$EXTRACT($$VAL^XBDIQ1(9002011.64,AMHC,.09),1,25)
+5 WRITE !?10,AMHZ1
+6 SET AMHZ1="Frequency: "_$$VAL^XBDIQ1(9002011.64,AMHC,.07)
SET $EXTRACT(AMHZ1,42)="By: "_$$VAL^XBDIQ1(9002011.64,AMHC,.05)
+7 WRITE !?10,AMHZ1
End DoDot:2
End DoDot:1
+8 QUIT
METHOD ;EP called from amhletpp
+1 IF '$DATA(^AMHPTXPG("AD",AMHTP))
QUIT
+2 WRITE !!?2,"METHODS:"
DISPMETH ;
+1 KILL AMHRMETH
SET (AMHGIEN,AMHC)=0
FOR
SET AMHGIEN=$ORDER(^AMHPTXPG("AD",AMHTP,AMHGIEN))
IF AMHGIEN'=+AMHGIEN
QUIT
SET AMHC=AMHC+1
Begin DoDot:1
+2 SET AMHMETH0=^AMHPTXPG(AMHGIEN,0)
+3 SET AMHRMETH(AMHC)=AMHGIEN
+4 WRITE !?2,AMHC,") Date Method Established: ",$$FTIME^VALM1($PIECE(AMHMETH0,U,4))," Therapist: "
IF $PIECE(AMHMETH0,U,5)
WRITE $EXTRACT($PIECE(^VA(200,$PIECE(AMHMETH0,U,5),0),U),1,25)
WRITE !
+5 KILL AMHPCNT,AMHPRNM
SET AMHPCNT=0
SET AMHNODE=11
SET AMHDA=AMHGIEN
SET AMHFILE=9002011.57
DO WP^AMHLETP4
+6 IF $DATA(AMHPRNM)
SET X=0
FOR
SET X=$ORDER(AMHPRNM(X))
IF X'=+X
QUIT
WRITE ?6,AMHPRNM(X),!
+7 KILL AMHLETXT
SET AMHLETP("ICL")=0
SET AMHLETP("NRQ")="Method: "_$GET(^AMHPTXPG(AMHGIEN,12))
SET AMHLETP("TXT")=""
SET AMHLEC=0
+8 DO GETTXT^AMHLETP
+9 SET X=0
FOR
SET X=$ORDER(AMHLETXT(X))
IF X'=+X
QUIT
WRITE !?6,AMHLETXT(X)
+10 KILL AMHLETXT
SET AMHLETP("ICL")=0
SET AMHLETP("NRQ")="Duration: "_$GET(^AMHPTXPG(AMHGIEN,13))
SET AMHLETP("TXT")=""
SET AMHLEC=0
+11 DO GETTXT^AMHLETP
+12 SET X=0
FOR
SET X=$ORDER(AMHLETXT(X))
IF X'=+X
QUIT
WRITE !?6,AMHLETXT(X)
+13 WRITE !?6,"Target Date: ",$$FTIME^VALM1($PIECE(AMHMETH0,U,7)),!?6,"Status: "
IF $PIECE(AMHMETH0,U,8)]""
WRITE $$EXTSET^XBFUNC(9002011.57,.08,$PIECE(AMHMETH0,U,8))
+14 WRITE !?6,"Date Reviewed w/client: ",$$FTIME^VALM1($PIECE(AMHMETH0,U,6)),!
+15 QUIT
End DoDot:1
+16 QUIT
