AMHLETP1 ; IHS/CMI/LAB - treatment plan update ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
;
HS ;EP - Display Patient Profile
S AMHPAT=DFN
I 'AMHPAT W !,"NO Patient selected!",! D PAUSE Q
D ^AMHDPP
D PAUSE
D EXIT
Q
ADD ;EP
D FULL^VALM1
I '$D(DFN) W !!,"Patient not entered." H 5 Q
S AMHQUIT=0
D HEADER
W !,"Creating new Treatment Plan..."
K DIR
S DIR(0)="D^:"_":EP",DIR("A")="Enter Date Established" KILL DA D ^DIR KILL DIR
I $D(DIRUT) K DIR,AMHQUIT Q
S X=Y
K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EALMQ",DIC="^AMHPTXP(",DLAYGO=9002011.56,DIADD=1,DIC("DR")=".02////"_DFN D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1,'$P($G(^AMHPTXP(AMHTP,0)),U,4),'$P($G(^AMHPTXP(AMHTP,0)),U,11) W !!,$C(7),$C(7),"Behavioral Health Treatment Plan is NOT complete!! Deleting Record.",! D DEL Q
S AMHTP=+Y
S AMHINADD=1
D EDITTP
S DFN=$P(^AMHPTXP(AMHTP,0),U,2)
D EXIT
Q
PART ;
W !!?3,"Participants in the development of this plan:"
I '$O(^AMHPTXP(AMHTP,17,0)) S AMHC=0 W " None recorded" G FM12
D EN^DDIOL($$REPEAT^XLFSTR("-",75),"","!?3")
K AMHCM S X=0,AMHC=0 F S X=$O(^AMHPTXP(AMHTP,17,X)) Q:X'=+X D
.S AMHC=AMHC+1,AMHCM(AMHC)=X
.W !?2,AMHC,") ",$P(^AMHPTXP(AMHTP,17,X,0),U,1),?40,$P(^AMHPTXP(AMHTP,17,X,0),U,2)
FM12 ;
D EN^DDIOL("","","!")
K DIR
S DIR(0)="S^A:Add a Participant"_$S(AMHC:";E:Edit an Existing Participant;D:Delete a Participant",1:"")_";N:No Change"
S DIR("A")="Which action",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G FM13
I Y="N" S AMHDONE=1 G FM13
S Y="FM"_Y
D @Y
G PART
FM13 ;
K Y
Q
;
FME ;
D EN^DDIOL("","","!")
K DIR
S DIR(0)="N^1:"_AMHC_":0",DIR("A")="Edit Which One" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
K DIC,DA,DR
S DA=AMHCM(Y)
S DA(1)=AMHTP,DIE="^AMHPTXP("_DA(1)_",17,",DR=".01;.02" D ^DIE K DIE,DA,DR
Q
FMD ;
D EN^DDIOL("","","!")
K DIR
S DIR(0)="N^1:"_AMHC_":0",DIR("A")="Delete Which One" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S DA=AMHCM(Y)
S DA(1)=AMHTP,DIE="^AMHPTXP("_DA(1)_",17,",DR=".01///@" D ^DIE K DIE,DA,DR
K DIC,DA,DR
Q
FMA ;
;ADDING NEW
S (AMHPTN,AMHPTREL)=""
S DIR(0)="FO^3:30",DIR("A")="Enter the Participant Name" KILL DA D ^DIR KILL DIR
I X="" Q
I $D(DIRUT) Q
S AMHPTN=Y
S DIR(0)="FO^2:30",DIR("A")="Enter the Relationship to the Client" KILL DA D ^DIR KILL DIR
I X="" Q
I $D(DIRUT) Q
S AMHPTREL=Y
S DIE="^AMHPTXP("
S DA=AMHTP
S DR="1701///"_AMHPTN
S DR(2,9002011.561701)=".02///"_AMHPTREL
D ^DIE
K DIE,DA,DR
Q
EDITTP ;
S AMHTXPF=$P(^AMHPTXP(AMHTP,0),U,22)
S AMHDSMVD=$$DSMVDT^AMHUTIL1(DUZ(2))
S AMHCS=$$DSMCS^AMHUTIL1(DUZ(2),DT)
I 'AMHTXPF S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH ADD TX PLAN DSMV]" D CALLDIE^AMHLEIN
I AMHTXPF D ;edit mode
.;if DSM IV, REGARDLESS OF DATE ESTABLISHED USE OLD TEMPLATE
.W !!,"NOTE: It is recommended you close out treatment plans using DSM-IV"
.W !,"diagnoses and create a new treatment plan using DSM-5 diagnoses."
.W !
.S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH EDIT TX PLAN]" D CALLDIE^AMHLEIN
.;S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="1800Treatment Plan Narrative (Problems/Goals/Objectives/Methods)" D CALLDIE^AMHLEIN Q
.;EDIT IN DSM V
.;S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH ADD TX PLAN DSMV]" D CALLDIE^AMHLEIN Q
;I $D(Y),'$P($G(^AMHPTXP(AMHTP,0)),U,4) W !!,"Treatment Plan is NOT COMPLETE!! Deleting Plan...",! D DEL Q
NRD ;
W ! S DA=AMHTP,DR=".09Review Date..............",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
S X=$P(^AMHPTXP(AMHTP,0),U,9)
I X,X<$P(^AMHPTXP(AMHTP,0),U,1) W !!,"Next Review Date cannot be earlier than the date established." S DA=AMHTP,DR=".09///@",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN G NRD
SC ;
W ! S DA=AMHTP,DR=".05Concurring Supervisor....",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
I $P(^AMHPTXP(AMHTP,0),U,5)="" G DC
SCD ;
S DA=AMHTP,DR=".06Date Concurred...........",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
S X=$P(^AMHPTXP(AMHTP,0),U,6)
I X,X<$P(^AMHPTXP(AMHTP,0),U,1) W !!,"Date Concurred cannot be earlier than the date established." S DA=AMHTP,DR=".06///@",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN G SCD
DC ;
D PART
W ! S DA=AMHTP,DR=".12Date Closed..............",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
S X=$P(^AMHPTXP(AMHTP,0),U,12)
I X,X<$P(^AMHPTXP(AMHTP,0),U,1) W !!,"Date Completed/Closed cannot be earlier than the date established." S DA=AMHTP,DR=".12///@",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN G DC
;D EXIT
Q
SHARE ;EP
D EP^AMHLETPS
D EXIT
Q
EDITR ;EP
K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
D FULL^VALM1
EDIT ;
W:$D(IOF) @IOF
D EDITTP
S DFN=$P(^AMHPTXP(AMHTP,0),U,2)
D EXIT
Q
DISP ;EP
K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
D FULL^VALM1
W:$D(IOF) @IOF
REVCH ;
S AMHPREV=""
S DIR(0)="S^T:Treatment Plan Only;R:Treatment Plan REVIEWS Only;B:Both the Treatment Plan and Reviews",DIR("A")="What would you like to print",DIR("B")="T" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D PAUSE,EXIT Q
S AMHPREV=Y
I AMHPREV="T" G PB
K AMHREVS,AMHREVP
I AMHPREV="R",'$O(^AMHPTXP(AMHTP,41,0)) W !!,"There are no reviews on file to print." D PAUSE G REVCH
;display all reviews and have user choose
S (X,AMHC)=0 F S X=$O(^AMHPTXP(AMHTP,41,X)) Q:X'=+X D
.S AMHC=AMHC+1,AMHREVS(AMHC)=X
.W !,?4,AMHC,") ",$$FMTE^XLFDT($P(^AMHPTXP(AMHTP,41,X,0),U))
.Q
S AMHC=AMHC+1 W !?4,AMHC,") ALL Reviews"
K DIR
S DIR(0)="L^1:"_AMHC,DIR("A")="Which Reviews would you like to Print",DIR("B")=AMHC KILL DA D ^DIR KILL DIR
I $D(DIRUT) G REVCH
I Y[AMHC D K AMHREVS G PB
.F I=1:1:(AMHC-1) S AMHREVP(AMHREVS(I))=""
S A=Y,C="" F I=1:1 S C=$P(A,",",I) Q:C="" S J=AMHREVS(C) S AMHREVP(AMHREVS(C))=""
K AMHREVS
PB ;print or browse
W ! S DIR(0)="S^P:PRINT Output on Paper;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D PAUSE,EXIT Q
I $G(Y)="B" D BROWSE D EXIT Q
D EN1^AMHLETPU
D EXIT
Q
BROWSE ;
S AMHBROW=1 D VIEWR^XBLM("PRINT^AMHLETPP","Display of Treatment Plan") K AMHBROW
Q
REV ;EP
K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
D FULL^VALM1
S AMHTXPF=$P(^AMHPTXP(AMHTP,0),U,22)
I AMHTXPF D D PAUSE
.W !!,"NOTE: It is recommended you close out treatment plans using DSM-IV"
.W !,"diagnoses and create a new treatment plan using DSM-5 diagnoses."
.W !
W:$D(IOF) @IOF
S DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH TP REVIEW]" D CALLDIE^AMHLEIN
D EXIT
Q
DELETE ;EP
;add code to not allow delete unless they have the key
I '$D(^XUSEC("AMHZ DELETE RECORD",DUZ)) W !!,"You do not have the security access to delete a Treatment Plan.",!,"Please see your supervisor or program manager.",! D PAUSE,EXIT Q
K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"No treatment plan selected." G EXIT
S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
D FULL^VALM1
DEL ;
W !! S DIR(0)="Y",DIR("A")="Are you sure you want to DELETE this Treatment Plan",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:'Y
S DA=AMHTP,DIK="^AMHPTPP(" D ^DIK
W !,"Deleting Treatment Plan..." S DA=AMHTP,DIK="^AMHPTXP(" D ^DIK K DA,DIK
W !!,"Treatment Plan for ",$P(^DPT(DFN,0),U)," DELETED." D PAUSE
D EXIT
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
W:$D(IOF) @IOF
W !,$TR($J(" ",80)," ","-"),!,"Patient Name: ",$P(^DPT(DFN,0),U)," DOB: ",$$FTIME^VALM1($P(^DPT(DFN,0),U,3))," Sex: ",$$VAL^XBDIQ1(2,DFN,.02),!,$TR($J(" ",80)," ","-")
Q
EXIT ;
D TERM^VALM0
S VALMBCK="R"
D GATHER^AMHLETP
S VALMCNT=AMHLINE
D HDR^AMHLETP
K AMHX,AMHQUIT,AMHTP,AMHNODE,AMHG,AMHDA,AMHFILE,AMHC,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHPCNT,AMHPRNM,AMHTP,AMHRMETH,AMHMETH0
K AMHINADD,AMHCS,AMHTXDT,AMHDSMVD,AMHTXPF
K D,D0,DA,DD,DIADD,DIC,DICR,DIE,DIG,DIH,DIK,DINUM,DIR,DIRUT,DIU,DIV,DIW,DIWF,DIWL,DIWR,DIY,DLAYGO,DO,DQ,DR,DTOUT,DUOUT
K X,Y,Z,I
Q
AMHLETP1 ; IHS/CMI/LAB - treatment plan update ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
+2 ;
HS ;EP - Display Patient Profile
+1 SET AMHPAT=DFN
+2 IF 'AMHPAT
WRITE !,"NO Patient selected!",!
DO PAUSE
QUIT
+3 DO ^AMHDPP
+4 DO PAUSE
+5 DO EXIT
+6 QUIT
ADD ;EP
+1 DO FULL^VALM1
+2 IF '$DATA(DFN)
WRITE !!,"Patient not entered."
HANG 5
QUIT
+3 SET AMHQUIT=0
+4 DO HEADER
+5 WRITE !,"Creating new Treatment Plan..."
+6 KILL DIR
+7 SET DIR(0)="D^:"_":EP"
SET DIR("A")="Enter Date Established"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
KILL DIR,AMHQUIT
QUIT
+9 SET X=Y
+10 KILL DD,D0,DO,DINUM,DIC,DA,DR
SET DIC(0)="EALMQ"
SET DIC="^AMHPTXP("
SET DLAYGO=9002011.56
SET DIADD=1
SET DIC("DR")=".02////"_DFN
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+11 IF Y=-1
IF '$PIECE($GET(^AMHPTXP(AMHTP,0)),U,4)
IF '$PIECE($GET(^AMHPTXP(AMHTP,0)),U,11)
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Treatment Plan is NOT complete!! Deleting Record.",!
DO DEL
QUIT
+12 SET AMHTP=+Y
+13 SET AMHINADD=1
+14 DO EDITTP
+15 SET DFN=$PIECE(^AMHPTXP(AMHTP,0),U,2)
+16 DO EXIT
+17 QUIT
PART ;
+1 WRITE !!?3,"Participants in the development of this plan:"
+2 IF '$ORDER(^AMHPTXP(AMHTP,17,0))
SET AMHC=0
WRITE " None recorded"
GOTO FM12
+3 DO EN^DDIOL($$REPEAT^XLFSTR("-",75),"","!?3")
+4 KILL AMHCM
SET X=0
SET AMHC=0
FOR
SET X=$ORDER(^AMHPTXP(AMHTP,17,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 SET AMHC=AMHC+1
SET AMHCM(AMHC)=X
+6 WRITE !?2,AMHC,") ",$PIECE(^AMHPTXP(AMHTP,17,X,0),U,1),?40,$PIECE(^AMHPTXP(AMHTP,17,X,0),U,2)
End DoDot:1
FM12 ;
+1 DO EN^DDIOL("","","!")
+2 KILL DIR
+3 SET DIR(0)="S^A:Add a Participant"_$SELECT(AMHC:";E:Edit an Existing Participant;D:Delete a Participant",1:"")_";N:No Change"
+4 SET DIR("A")="Which action"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO FM13
+6 IF Y="N"
SET AMHDONE=1
GOTO FM13
+7 SET Y="FM"_Y
+8 DO @Y
+9 GOTO PART
FM13 ;
+1 KILL Y
+2 QUIT
+3 ;
FME ;
+1 DO EN^DDIOL("","","!")
+2 KILL DIR
+3 SET DIR(0)="N^1:"_AMHC_":0"
SET DIR("A")="Edit Which One"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 KILL DIC,DA,DR
+6 SET DA=AMHCM(Y)
+7 SET DA(1)=AMHTP
SET DIE="^AMHPTXP("_DA(1)_",17,"
SET DR=".01;.02"
DO ^DIE
KILL DIE,DA,DR
+8 QUIT
FMD ;
+1 DO EN^DDIOL("","","!")
+2 KILL DIR
+3 SET DIR(0)="N^1:"_AMHC_":0"
SET DIR("A")="Delete Which One"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET DA=AMHCM(Y)
+6 SET DA(1)=AMHTP
SET DIE="^AMHPTXP("_DA(1)_",17,"
SET DR=".01///@"
DO ^DIE
KILL DIE,DA,DR
+7 KILL DIC,DA,DR
+8 QUIT
FMA ;
+1 ;ADDING NEW
+2 SET (AMHPTN,AMHPTREL)=""
+3 SET DIR(0)="FO^3:30"
SET DIR("A")="Enter the Participant Name"
KILL DA
DO ^DIR
KILL DIR
+4 IF X=""
QUIT
+5 IF $DATA(DIRUT)
QUIT
+6 SET AMHPTN=Y
+7 SET DIR(0)="FO^2:30"
SET DIR("A")="Enter the Relationship to the Client"
KILL DA
DO ^DIR
KILL DIR
+8 IF X=""
QUIT
+9 IF $DATA(DIRUT)
QUIT
+10 SET AMHPTREL=Y
+11 SET DIE="^AMHPTXP("
+12 SET DA=AMHTP
+13 SET DR="1701///"_AMHPTN
+14 SET DR(2,9002011.561701)=".02///"_AMHPTREL
+15 DO ^DIE
+16 KILL DIE,DA,DR
+17 QUIT
EDITTP ;
+1 SET AMHTXPF=$PIECE(^AMHPTXP(AMHTP,0),U,22)
+2 SET AMHDSMVD=$$DSMVDT^AMHUTIL1(DUZ(2))
+3 SET AMHCS=$$DSMCS^AMHUTIL1(DUZ(2),DT)
+4 IF 'AMHTXPF
SET DIE("NO^")=1
SET DA=AMHTP
SET DIE="^AMHPTXP("
SET DR="[AMH ADD TX PLAN DSMV]"
DO CALLDIE^AMHLEIN
+5 ;edit mode
IF AMHTXPF
Begin DoDot:1
+6 ;if DSM IV, REGARDLESS OF DATE ESTABLISHED USE OLD TEMPLATE
+7 WRITE !!,"NOTE: It is recommended you close out treatment plans using DSM-IV"
+8 WRITE !,"diagnoses and create a new treatment plan using DSM-5 diagnoses."
+9 WRITE !
+10 SET DIE("NO^")=1
SET DA=AMHTP
SET DIE="^AMHPTXP("
SET DR="[AMH EDIT TX PLAN]"
DO CALLDIE^AMHLEIN
+11 ;S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="1800Treatment Plan Narrative (Problems/Goals/Objectives/Methods)" D CALLDIE^AMHLEIN Q
+12 ;EDIT IN DSM V
+13 ;S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH ADD TX PLAN DSMV]" D CALLDIE^AMHLEIN Q
End DoDot:1
+14 ;I $D(Y),'$P($G(^AMHPTXP(AMHTP,0)),U,4) W !!,"Treatment Plan is NOT COMPLETE!! Deleting Plan...",! D DEL Q
NRD ;
+1 WRITE !
SET DA=AMHTP
SET DR=".09Review Date.............."
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
+2 SET X=$PIECE(^AMHPTXP(AMHTP,0),U,9)
+3 IF X
IF X<$PIECE(^AMHPTXP(AMHTP,0),U,1)
WRITE !!,"Next Review Date cannot be earlier than the date established."
SET DA=AMHTP
SET DR=".09///@"
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
GOTO NRD
SC ;
+1 WRITE !
SET DA=AMHTP
SET DR=".05Concurring Supervisor...."
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
+2 IF $PIECE(^AMHPTXP(AMHTP,0),U,5)=""
GOTO DC
SCD ;
+1 SET DA=AMHTP
SET DR=".06Date Concurred..........."
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
+2 SET X=$PIECE(^AMHPTXP(AMHTP,0),U,6)
+3 IF X
IF X<$PIECE(^AMHPTXP(AMHTP,0),U,1)
WRITE !!,"Date Concurred cannot be earlier than the date established."
SET DA=AMHTP
SET DR=".06///@"
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
GOTO SCD
DC ;
+1 DO PART
+2 WRITE !
SET DA=AMHTP
SET DR=".12Date Closed.............."
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
+3 SET X=$PIECE(^AMHPTXP(AMHTP,0),U,12)
+4 IF X
IF X<$PIECE(^AMHPTXP(AMHTP,0),U,1)
WRITE !!,"Date Completed/Closed cannot be earlier than the date established."
SET DA=AMHTP
SET DR=".12///@"
SET DIE="^AMHPTXP("
DO CALLDIE^AMHLEIN
GOTO DC
+5 ;D EXIT
+6 QUIT
SHARE ;EP
+1 DO EP^AMHLETPS
+2 DO EXIT
+3 QUIT
EDITR ;EP
+1 KILL DIR
SET DIR(0)="N^1:"_AMHRCNT_":0"
SET DIR("A")="Select BH Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+3 SET AMHTPN=+Y
IF 'AMHTPN
KILL AMHTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET AMHTP=$ORDER(AMHPTP("IDX",AMHTPN,0))
IF 'AMHTP
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+5 SET AMHTP=AMHPTP("IDX",AMHTPN,AMHTP)
IF 'AMHTP
KILL AMHTP
DO PAUSE
DO EXIT
QUIT
+6 IF '$DATA(^AMHPTXP(AMHTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+7 DO FULL^VALM1
EDIT ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 DO EDITTP
+3 SET DFN=$PIECE(^AMHPTXP(AMHTP,0),U,2)
+4 DO EXIT
+5 QUIT
DISP ;EP
+1 KILL DIR
SET DIR(0)="N^1:"_AMHRCNT_":0"
SET DIR("A")="Select BH Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+3 SET AMHTPN=+Y
IF 'AMHTPN
KILL AMHTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET AMHTP=$ORDER(AMHPTP("IDX",AMHTPN,0))
IF 'AMHTP
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+5 SET AMHTP=AMHPTP("IDX",AMHTPN,AMHTP)
IF 'AMHTP
KILL AMHTP
DO PAUSE
DO EXIT
QUIT
+6 IF '$DATA(^AMHPTXP(AMHTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+7 DO FULL^VALM1
+8 IF $DATA(IOF)
WRITE @IOF
REVCH ;
+1 SET AMHPREV=""
+2 SET DIR(0)="S^T:Treatment Plan Only;R:Treatment Plan REVIEWS Only;B:Both the Treatment Plan and Reviews"
SET DIR("A")="What would you like to print"
SET DIR("B")="T"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO PAUSE
DO EXIT
QUIT
+4 SET AMHPREV=Y
+5 IF AMHPREV="T"
GOTO PB
+6 KILL AMHREVS,AMHREVP
+7 IF AMHPREV="R"
IF '$ORDER(^AMHPTXP(AMHTP,41,0))
WRITE !!,"There are no reviews on file to print."
DO PAUSE
GOTO REVCH
+8 ;display all reviews and have user choose
+9 SET (X,AMHC)=0
FOR
SET X=$ORDER(^AMHPTXP(AMHTP,41,X))
IF X'=+X
QUIT
Begin DoDot:1
+10 SET AMHC=AMHC+1
SET AMHREVS(AMHC)=X
+11 WRITE !,?4,AMHC,") ",$$FMTE^XLFDT($PIECE(^AMHPTXP(AMHTP,41,X,0),U))
+12 QUIT
End DoDot:1
+13 SET AMHC=AMHC+1
WRITE !?4,AMHC,") ALL Reviews"
+14 KILL DIR
+15 SET DIR(0)="L^1:"_AMHC
SET DIR("A")="Which Reviews would you like to Print"
SET DIR("B")=AMHC
KILL DA
DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
GOTO REVCH
+17 IF Y[AMHC
Begin DoDot:1
+18 FOR I=1:1:(AMHC-1)
SET AMHREVP(AMHREVS(I))=""
End DoDot:1
KILL AMHREVS
GOTO PB
+19 SET A=Y
SET C=""
FOR I=1:1
SET C=$PIECE(A,",",I)
IF C=""
QUIT
SET J=AMHREVS(C)
SET AMHREVP(AMHREVS(C))=""
+20 KILL AMHREVS
PB ;print or browse
+1 WRITE !
SET DIR(0)="S^P:PRINT Output on Paper;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO PAUSE
DO EXIT
QUIT
+3 IF $GET(Y)="B"
DO BROWSE
DO EXIT
QUIT
+4 DO EN1^AMHLETPU
+5 DO EXIT
+6 QUIT
BROWSE ;
+1 SET AMHBROW=1
DO VIEWR^XBLM("PRINT^AMHLETPP","Display of Treatment Plan")
KILL AMHBROW
+2 QUIT
REV ;EP
+1 KILL DIR
SET DIR(0)="N^1:"_AMHRCNT_":0"
SET DIR("A")="Select BH Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+3 SET AMHTPN=+Y
IF 'AMHTPN
KILL AMHTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+4 SET AMHTP=$ORDER(AMHPTP("IDX",AMHTPN,0))
IF 'AMHTP
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+5 SET AMHTP=AMHPTP("IDX",AMHTPN,AMHTP)
IF 'AMHTP
KILL AMHTP
DO PAUSE
DO EXIT
QUIT
+6 IF '$DATA(^AMHPTXP(AMHTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+7 DO FULL^VALM1
+8 SET AMHTXPF=$PIECE(^AMHPTXP(AMHTP,0),U,22)
+9 IF AMHTXPF
Begin DoDot:1
+10 WRITE !!,"NOTE: It is recommended you close out treatment plans using DSM-IV"
+11 WRITE !,"diagnoses and create a new treatment plan using DSM-5 diagnoses."
+12 WRITE !
End DoDot:1
DO PAUSE
+13 IF $DATA(IOF)
WRITE @IOF
+14 SET DA=AMHTP
SET DIE="^AMHPTXP("
SET DR="[AMH TP REVIEW]"
DO CALLDIE^AMHLEIN
+15 DO EXIT
+16 QUIT
DELETE ;EP
+1 ;add code to not allow delete unless they have the key
+2 IF '$DATA(^XUSEC("AMHZ DELETE RECORD",DUZ))
WRITE !!,"You do not have the security access to delete a Treatment Plan.",!,"Please see your supervisor or program manager.",!
DO PAUSE
DO EXIT
QUIT
+3 KILL DIR
SET DIR(0)="N^1:"_AMHRCNT_":0"
SET DIR("A")="Select BH Treatment Plan"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
WRITE !,"No treatment plan selected."
GOTO EXIT
+5 SET AMHTPN=+Y
IF 'AMHTPN
KILL AMHTP,VALMY,XQORNOD
WRITE !,"No treatment plan selected."
GOTO EXIT
+6 SET AMHTP=$ORDER(AMHPTP("IDX",AMHTPN,0))
IF 'AMHTP
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+7 SET AMHTP=AMHPTP("IDX",AMHTPN,AMHTP)
IF 'AMHTP
KILL AMHTP
DO PAUSE
DO EXIT
QUIT
+8 IF '$DATA(^AMHPTXP(AMHTP,0))
WRITE !,"Not a valid TREATMENT PLAN."
KILL AMHTPDEL,AMHTP
DO PAUSE
DO EXIT
QUIT
+9 DO FULL^VALM1
DEL ;
+1 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to DELETE this Treatment Plan"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF 'Y
QUIT
+4 SET DA=AMHTP
SET DIK="^AMHPTPP("
DO ^DIK
+5 WRITE !,"Deleting Treatment Plan..."
SET DA=AMHTP
SET DIK="^AMHPTXP("
DO ^DIK
KILL DA,DIK
+6 WRITE !!,"Treatment Plan for ",$PIECE(^DPT(DFN,0),U)," DELETED."
DO PAUSE
+7 DO EXIT
+8 QUIT
PAUSE ;EP
+1 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-"),!,"Patient Name: ",$PIECE(^DPT(DFN,0),U)," DOB: ",$$FTIME^VALM1($PIECE(^DPT(DFN,0),U,3))," Sex: ",$$VAL^XBDIQ1(2,DFN,.02),!,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+3 QUIT
EXIT ;
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO GATHER^AMHLETP
+4 SET VALMCNT=AMHLINE
+5 DO HDR^AMHLETP
+6 KILL AMHX,AMHQUIT,AMHTP,AMHNODE,AMHG,AMHDA,AMHFILE,AMHC,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHPCNT,AMHPRNM,AMHTP,AMHRMETH,AMHMETH0
+7 KILL AMHINADD,AMHCS,AMHTXDT,AMHDSMVD,AMHTXPF
+8 KILL D,D0,DA,DD,DIADD,DIC,DICR,DIE,DIG,DIH,DIK,DINUM,DIR,DIRUT,DIU,DIV,DIW,DIWF,DIWL,DIWR,DIY,DLAYGO,DO,DQ,DR,DTOUT,DUOUT
+9 KILL X,Y,Z,I
+10 QUIT
