- 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
