Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHLETP1

AMHLETP1.m

Go to the documentation of this file. 
  1. AMHLETP1 ; IHS/CMI/LAB - treatment plan update ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
  1.  ;
  1. HS ;EP - Display Patient Profile
  1.  S AMHPAT=DFN
  1.  I 'AMHPAT W !,"NO Patient selected!",! D PAUSE Q
  1.  D ^AMHDPP
  1.  D PAUSE
  1.  D EXIT
  1.  Q
  1. ADD ;EP
  1.  D FULL^VALM1
  1.  I '$D(DFN) W !!,"Patient not entered." H 5 Q
  1.  S AMHQUIT=0
  1.  D HEADER
  1.  W !,"Creating new Treatment Plan..."
  1.  K DIR
  1.  S DIR(0)="D^:"_":EP",DIR("A")="Enter Date Established" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) K DIR,AMHQUIT Q
  1.  S X=Y
  1.  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
  1.  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
  1.  S AMHTP=+Y
  1.  S AMHINADD=1
  1.  D EDITTP
  1.  S DFN=$P(^AMHPTXP(AMHTP,0),U,2)
  1.  D EXIT
  1.  Q
  1. PART ;
  1.  W !!?3,"Participants in the development of this plan:"
  1.  I '$O(^AMHPTXP(AMHTP,17,0)) S AMHC=0 W "  None recorded" G FM12
  1.  D EN^DDIOL($$REPEAT^XLFSTR("-",75),"","!?3")
  1.  K AMHCM S X=0,AMHC=0 F  S X=$O(^AMHPTXP(AMHTP,17,X)) Q:X'=+X  D
  1.  .S AMHC=AMHC+1,AMHCM(AMHC)=X
  1.  .W !?2,AMHC,")  ",$P(^AMHPTXP(AMHTP,17,X,0),U,1),?40,$P(^AMHPTXP(AMHTP,17,X,0),U,2)
  1. FM12 ;
  1.  D EN^DDIOL("","","!")
  1.  K DIR
  1.  S DIR(0)="S^A:Add a Participant"_$S(AMHC:";E:Edit an Existing Participant;D:Delete a Participant",1:"")_";N:No Change"
  1.  S DIR("A")="Which action",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G FM13
  1.  I Y="N" S AMHDONE=1 G FM13
  1.  S Y="FM"_Y
  1.  D @Y
  1.  G PART
  1. FM13 ; 
  1.  K Y
  1.  Q
  1.  ;
  1. FME ;
  1.  D EN^DDIOL("","","!")
  1.  K DIR
  1.  S DIR(0)="N^1:"_AMHC_":0",DIR("A")="Edit Which One" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  K DIC,DA,DR
  1.  S DA=AMHCM(Y)
  1.  S DA(1)=AMHTP,DIE="^AMHPTXP("_DA(1)_",17,",DR=".01;.02" D ^DIE K DIE,DA,DR
  1.  Q
  1. FMD ;
  1.  D EN^DDIOL("","","!")
  1.  K DIR
  1.  S DIR(0)="N^1:"_AMHC_":0",DIR("A")="Delete Which One" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  S DA=AMHCM(Y)
  1.  S DA(1)=AMHTP,DIE="^AMHPTXP("_DA(1)_",17,",DR=".01///@" D ^DIE K DIE,DA,DR
  1.  K DIC,DA,DR
  1.  Q
  1. FMA ;
  1.  ;ADDING NEW
  1.  S (AMHPTN,AMHPTREL)=""
  1.  S DIR(0)="FO^3:30",DIR("A")="Enter the Participant Name" KILL DA D ^DIR KILL DIR
  1.  I X="" Q
  1.  I $D(DIRUT) Q
  1.  S AMHPTN=Y
  1.  S DIR(0)="FO^2:30",DIR("A")="Enter the Relationship to the Client" KILL DA D ^DIR KILL DIR
  1.  I X="" Q
  1.  I $D(DIRUT) Q
  1.  S AMHPTREL=Y
  1.  S DIE="^AMHPTXP("
  1.  S DA=AMHTP
  1.  S DR="1701///"_AMHPTN
  1.  S DR(2,9002011.561701)=".02///"_AMHPTREL
  1.  D ^DIE
  1.  K DIE,DA,DR
  1.  Q
  1. EDITTP ;
  1.  S AMHTXPF=$P(^AMHPTXP(AMHTP,0),U,22)
  1.  S AMHDSMVD=$$DSMVDT^AMHUTIL1(DUZ(2))
  1.  S AMHCS=$$DSMCS^AMHUTIL1(DUZ(2),DT)
  1.  I 'AMHTXPF S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH ADD TX PLAN DSMV]" D CALLDIE^AMHLEIN
  1.  I AMHTXPF D  ;edit mode
  1.  .;if DSM IV, REGARDLESS OF DATE ESTABLISHED USE OLD TEMPLATE
  1.  .W !!,"NOTE:  It is recommended you close out treatment plans using DSM-IV"
  1.  .W !,"diagnoses and create a new treatment plan using DSM-5 diagnoses."
  1.  .W !
  1.  .S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH EDIT TX PLAN]" D CALLDIE^AMHLEIN
  1.  .;S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="1800Treatment Plan Narrative (Problems/Goals/Objectives/Methods)" D CALLDIE^AMHLEIN Q
  1.  .;EDIT IN DSM V
  1.  .;S DIE("NO^")=1,DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH ADD TX PLAN DSMV]" D CALLDIE^AMHLEIN Q
  1.  ;I $D(Y),'$P($G(^AMHPTXP(AMHTP,0)),U,4) W !!,"Treatment Plan is NOT COMPLETE!!  Deleting Plan...",! D DEL Q
  1. NRD ;
  1.  W ! S DA=AMHTP,DR=".09Review Date..............",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
  1.  S X=$P(^AMHPTXP(AMHTP,0),U,9)
  1.  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
  1. SC ;
  1.  W ! S DA=AMHTP,DR=".05Concurring Supervisor....",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
  1.  I $P(^AMHPTXP(AMHTP,0),U,5)="" G DC
  1. SCD ;
  1.  S DA=AMHTP,DR=".06Date Concurred...........",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
  1.  S X=$P(^AMHPTXP(AMHTP,0),U,6)
  1.  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
  1. DC ;
  1.  D PART
  1.  W ! S DA=AMHTP,DR=".12Date Closed..............",DIE="^AMHPTXP(" D CALLDIE^AMHLEIN
  1.  S X=$P(^AMHPTXP(AMHTP,0),U,12)
  1.  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
  1.  ;D EXIT
  1.  Q
  1. SHARE ;EP
  1.  D EP^AMHLETPS
  1.  D EXIT
  1.  Q
  1. EDITR ;EP
  1.  K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
  1.  I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1. EDIT ;
  1.  W:$D(IOF) @IOF
  1.  D EDITTP
  1.  S DFN=$P(^AMHPTXP(AMHTP,0),U,2)
  1.  D EXIT
  1.  Q
  1. DISP ;EP
  1.  K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
  1.  I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1. REVCH ;
  1.  S AMHPREV=""
  1.  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
  1.  I $D(DIRUT) D PAUSE,EXIT Q
  1.  S AMHPREV=Y
  1.  I AMHPREV="T" G PB
  1.  K AMHREVS,AMHREVP
  1.  I AMHPREV="R",'$O(^AMHPTXP(AMHTP,41,0)) W !!,"There are no reviews on file to print." D PAUSE G REVCH
  1.  ;display all reviews and have user choose
  1.  S (X,AMHC)=0 F  S X=$O(^AMHPTXP(AMHTP,41,X)) Q:X'=+X  D
  1.  .S AMHC=AMHC+1,AMHREVS(AMHC)=X
  1.  .W !,?4,AMHC,")  ",$$FMTE^XLFDT($P(^AMHPTXP(AMHTP,41,X,0),U))
  1.  .Q
  1.  S AMHC=AMHC+1 W !?4,AMHC,")  ALL Reviews"
  1.  K DIR
  1.  S DIR(0)="L^1:"_AMHC,DIR("A")="Which Reviews would you like to Print",DIR("B")=AMHC KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G REVCH
  1.  I Y[AMHC D   K AMHREVS G PB
  1.  .F I=1:1:(AMHC-1) S AMHREVP(AMHREVS(I))=""
  1.  S A=Y,C="" F I=1:1 S C=$P(A,",",I) Q:C=""  S J=AMHREVS(C) S AMHREVP(AMHREVS(C))=""
  1.  K AMHREVS
  1. PB ;print or browse
  1.  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
  1.  I $D(DIRUT) D PAUSE,EXIT Q
  1.  I $G(Y)="B" D BROWSE D EXIT Q
  1.  D EN1^AMHLETPU
  1.  D EXIT
  1.  Q
  1. BROWSE ;
  1.  S AMHBROW=1 D VIEWR^XBLM("PRINT^AMHLETPP","Display of Treatment Plan") K AMHBROW
  1.  Q
  1. REV ;EP
  1.  K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
  1.  I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1.  S AMHTXPF=$P(^AMHPTXP(AMHTP,0),U,22)
  1.  I AMHTXPF D  D PAUSE
  1.  .W !!,"NOTE:  It is recommended you close out treatment plans using DSM-IV"
  1.  .W !,"diagnoses and create a new treatment plan using DSM-5 diagnoses."
  1.  .W !
  1.  W:$D(IOF) @IOF
  1.  S DA=AMHTP,DIE="^AMHPTXP(",DR="[AMH TP REVIEW]" D CALLDIE^AMHLEIN
  1.  D EXIT
  1.  Q
  1. DELETE ;EP
  1.  ;add code to not allow delete unless they have the key
  1.  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
  1.  K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Select BH Treatment Plan" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No treatment plan selected." G EXIT
  1.  S AMHTPN=+Y I 'AMHTPN K AMHTP,VALMY,XQORNOD W !,"No treatment plan selected." G EXIT
  1.  S AMHTP=$O(AMHPTP("IDX",AMHTPN,0)) I 'AMHTP K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  S AMHTP=AMHPTP("IDX",AMHTPN,AMHTP) I 'AMHTP K AMHTP D PAUSE,EXIT Q
  1.  I '$D(^AMHPTXP(AMHTP,0)) W !,"Not a valid TREATMENT PLAN." K AMHTPDEL,AMHTP D PAUSE,EXIT Q
  1.  D FULL^VALM1
  1. DEL ;
  1.  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
  1.  Q:$D(DIRUT)
  1.  Q:'Y
  1.  S DA=AMHTP,DIK="^AMHPTPP(" D ^DIK
  1.  W !,"Deleting Treatment Plan..." S DA=AMHTP,DIK="^AMHPTXP(" D ^DIK K DA,DIK
  1.  W !!,"Treatment Plan for ",$P(^DPT(DFN,0),U)," DELETED." D PAUSE
  1.  D EXIT
  1.  Q
  1. PAUSE ;EP
  1.  S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1.  W:$D(IOF) @IOF
  1.  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)," ","-")
  1.  Q
  1. EXIT ;
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D GATHER^AMHLETP
  1.  S VALMCNT=AMHLINE
  1.  D HDR^AMHLETP
  1.  K AMHX,AMHQUIT,AMHTP,AMHNODE,AMHG,AMHDA,AMHFILE,AMHC,AMHGIEN,AMHLEC,AMHLETP,AMHLETXT,AMHPCNT,AMHPRNM,AMHTP,AMHRMETH,AMHMETH0
  1.  K AMHINADD,AMHCS,AMHTXDT,AMHDSMVD,AMHTXPF
  1.  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
  1.  K X,Y,Z,I
  1.  Q