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

AMHLEP1.m

Go to the documentation of this file. 
  1. AMHLEP1 ; IHS/CMI/LAB - DEMO/APPTS ACTION 08 Aug 2007 1:27 PM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**2,4,5**;JUN 02, 2010;Build 18
  1.  ;
  1.  Q
  1. OTHER ;EP
  1.  S (AMHPAT,AMHHDFN)=DFN
  1.  D OTHER^AMHLEP2
  1.  D RESET^AMHVRL K AMHHDFN
  1.  Q
  1. DUP ;EP called from protocol
  1.  S AMHHDFN=DFN,AMHPAT=DFN
  1.  D EP1^AMHLEDV
  1.  S (DFN,AMHPAT)=AMHHDFN
  1.  D RESET^AMHVRL K AMHHDFN
  1.  Q
  1. CONTACT(P,AMHY) ;EP; called by AMHV UPDATE CLIENT CONTACT protocol
  1.  NEW DFN
  1.  Q:'$G(P)
  1.  S (DFN,AMHPAT)=P
  1.  S AMHHDFN=AMHPAT
  1.  ;
  1.  D FULL^VALM1
  1.  D @AMHY
  1.  D RESET^AMHVRL K AMHHDFN
  1.  Q
  1.  ;
  1. 1 ; -- add visit
  1.  D ^AMHLEIN
  1.  S AMHPATCE=1
  1.  ;get defaults
  1.  S (DFN,AMHPAT)=AMHHDFN
  1.  D GETTYPE^AMHLE
  1.  I $G(AMHPTYPE)="" D XIT Q
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  ;D GETVTYP
  1.  S AMHVTYPE="R"
  1.  I $G(AMHVTYPE)="" D XIT Q
  1.  D ADD^AMHLEP2
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  Q
  1.  ;
  1. 2 ; -- edit visit
  1.  S AMHDET="S"
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  S AMHPATCE=1
  1.  ;get defaults
  1.  D GETTYPE^AMHLE
  1.  I $G(AMHPTYPE)="" D XIT Q
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  D EN^AMHRLKUP
  1.  I '$G(AMHR) D XIT Q
  1.  I $P(^AMHREC(AMHR,0),U,34) W !!,"This is a group encounter.  You must edit this group visit through the Group",!,"Form Data Entry menu option.",! D PAUSE^AMHLEA,XIT Q
  1.  I $$EHR^AMHUTIL(AMHR) D EHRE^AMHEHR D PAUSE^AMHLEA,XIT Q
  1.  I $P($G(^AMHREC(AMHR,11)),U,12)]"",$O(^AMHREC(AMHR,31,0)) D
  1.  .W !!,"The progress note has been electronically signed.  You will not be able to edit the note.",!,"You will be able to edit the other visit items when you press enter to continue.",! D PAUSE^AMHLEA
  1.  D EDIT^AMHLEE
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  Q
  1.  ;
  1. 3 ;EP -- display visit
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  S AMHPATCE=1
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  D EN^AMHRLKUP
  1.  I '$G(AMHR) D XIT Q
  1.  D ^AMHDVD
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D REGULAR^AMHLEP2
  1.  S AMHZDO=1
  1.  D OTHER^AMHLEP2
  1.  D EN2^AMHEKL
  1.  K AMHZDO
  1.  Q
  1.  ;
  1. 4 ; -- soap update
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  S AMHPATCE=1
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  D EN^AMHRLKUP
  1.  I '$G(AMHR) D XIT Q
  1.  I $P(^AMHREC(AMHR,0),U,34) W !!,"This is a group encounter.  You must edit this group visit through the Group",!,"Form Data Entry menu option.",! D PAUSE^AMHLEA,XIT Q
  1.  I $$EHR^AMHUTIL(AMHR) D EHRE^AMHEHR D PAUSE^AMHLEA,XIT Q
  1.  I $P($G(^AMHREC(AMHR,11)),U,12)]"",$O(^AMHREC(AMHR,31,0)) W !!,"You cannot edit this note, it has been electronically signed." D PAUSE^AMHLEA,XIT Q
  1.  S AMHACTN=2
  1.  S DA=AMHR,DR="[AMH EDIT SOAP/CC]",DIE="^AMHREC(" D CALLDIE^AMHLEIN
  1.  D REGULAR^AMHLEP2
  1.  D OTHER^AMHLEP2
  1.  D PCCLINK^AMHLEA
  1.  D EN2^AMHEKL
  1.  Q
  1. 5 ; -- delete visit
  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 Visit.",!,"Please see your supervisor or program manager.",! D PAUSE^AMHLEP2,XIT Q
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  S AMHPATCE=1
  1.  D FULL^VALM1 W:$D(IOF) @IOF
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  D EN^AMHRLKUP
  1.  I '$G(AMHR) D XIT Q
  1.  I $$EHR^AMHUTIL(AMHR) D EHRE^AMHEHR D PAUSE^AMHLEA,XIT Q
  1.  I $P($G(^AMHREC(AMHR,11)),U,12)]"",'$D(^XUSEC("AMHZ DELETE SIGNED NOTE",DUZ)),$O(^AMHREC(AMHR,31,0)) D  Q
  1.  .W !!,"You cannot delete this record, the note has been electronically signed.",!,"Please see your supervisor or program manager." D PAUSE^AMHLEP2,XIT Q
  1.  D DEL^AMHLEE
  1.  D EN2^AMHEKL
  1.  Q
  1. 6 ; -- print encounter form
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  S AMHPATCE=1
  1.  D FULL^VALM1 W:$D(IOF) @IOF
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  D EN^AMHRLKUP
  1.  I '$G(AMHR) D XIT Q
  1.  K AMHEFT
  1.  ;W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"
  1.  ;S DIR("A")="What type of form do you want to print"
  1.  ;S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B") K DA D ^DIR K DIR
  1.  D FORMDIR^AMHLEFP(AMHR)
  1.  I $D(DIRUT) D XIT Q
  1.  S AMHEFT=Y
  1.  S AMHACTN=5
  1.  S XBRC="COMP^AMHLEFP",XBRP="^AMHLEFP2",XBNS="AMH",XBRX="XIT^AMHLEFP"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  Q
  1.  ;
  1. 7 ; -- EHR visit
  1.  S AMHDET="S"
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  S AMHEHR=1 D EN^AMHRLKUP K AMHEHR
  1.  I '$G(AMHR) W !,"There are no EHR created visits on that date." D XIT Q
  1.  D EDITEHR^AMHLEE
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  K AMHEHR
  1.  Q
  1.  ;
  1. 8 ; -- TIU NOTE
  1.  S AMHDET="S"
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D GETDATE^AMHLE
  1.  I $G(AMHDATE)="" D XIT Q
  1.  S AMHPAT=DFN,AMHLOC=""
  1.  D EN^AMHRLKUP K AMHEHR
  1.  I '$G(AMHR) W !,"There are no EHR created visits on that date." D XIT Q
  1.  D TIU^AMHEHR
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  K AMHEHR
  1.  Q
  1.  ;
  1. 9 ;EP - called from protocol to sign visit
  1.  ;list visits for this patient since the esig start date
  1.  ;select visit
  1.  ;display visit
  1.  ;do you wish to edit?  if so, edit
  1.  ;d esig^amhesig
  1.  D FULL^VALM1
  1.  S AMHDET="S"
  1.  D ^AMHLEIN
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  S AMHPATCE=1
  1.  NEW D,AMHRRECS,X,V,AMHD
  1.  ;gather all visits w/o signature from D to DT
  1.  S AMHD=$$DATE^AMHESIG()
  1.  S AMHRCNT=0 F  S AMHD=$O(^AMHREC("AF",AMHPAT,AMHD)) Q:AMHD'=+AMHD  D
  1.  .S V=0 F  S V=$O(^AMHREC("AF",AMHPAT,AMHD,V)) Q:V'=+V  D
  1.  ..I $P($G(^AMHREC(V,11)),U,12)]"" Q  ;already signed
  1.  ..Q:$$EHR^AMHUTIL(V)  ;EHR VISIT
  1.  ..Q:$P(^AMHREC(V,0),U,34)  ;GROUP
  1.  ..S X=$$ESIG^AMHESIG(V)
  1.  ..I 'X Q  ;doesn't need signed
  1.  ..S AMHRCNT=AMHRCNT+1,AMHRRECS(AMHRCNT)=V
  1.  ..Q
  1.  I AMHRCNT=0 W !!,"There are no records with unsigned notes that need to be signed.",! D PAUSE^AMHLEP2,XIT Q
  1.  D DISPRECS
  1.  W ! S DIR(0)="NO^1:"_AMHRCNT_":0",DIR("A")="Which record do you want to display" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No Records selected to display." D PAUSE^AMHLEP2,XIT Q
  1.  I '$D(AMHRRECS(+Y)) W !,"Invalid selection!!" G SELECT
  1.  S AMHR=AMHRRECS(+Y)
  1.  ;display record
  1.  D ^AMHDVD
  1.  S (AMHPAT,DFN)=AMHHDFN
  1. E9 ;edit?
  1.  W !!
  1.  S DIR(0)="Y",DIR("A")="Do you wish to edit this record",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D ESIG9 Q
  1.  I 'Y D ESIG9 Q
  1.  ;edit record
  1.  S AMHDATE=$P($P(^AMHREC(AMHR,0),U),".")
  1.  D EDIT^AMHLEE
  1.  S (AMHPAT,DFN)=AMHHDFN
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  Q
  1. ESIG9 ;
  1.  S AMHACTN=2
  1.  D OTHER^AMHLEP2
  1.  D PCCLINK^AMHLEA
  1.  D XIT
  1.  D EN2^AMHEKL
  1.  Q
  1. GETVTYP ;
  1.  S DIR(0)="S^R:Regular Visit;I:Intake;B:Abbreviated Version of Regular Visit;C:Info/Contact;N:No Show;A:A/SA Encounter"
  1.  S DIR("A")="Enter Visit Type",DIR("B")="R" K DA D ^DIR K DIR
  1.  I $D(DIRUT) S AMHVTYPE="" Q
  1.  S AMHVTYPE=Y,AMHVT=Y(0)
  1.  Q
  1. XIT ;
  1.  K AMHR,AMHLOC,AMHPATCE,AMHDATE,AMHDET,AMHRCNT,AMHRRECS,D,V,AMHRIEN,AMHP,AMHR0,AMHRCTR,AMHPG
  1.  Q
  1.  I 'AMHPG G HEAD1
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT="" Q
  1. HEAD1 ;
  1.  S AMHPG=AMHPG+1
  1.  W:$D(IOF) @IOF
  1.  W !,AMHDASH
  1.  W !?13,"Behavioral Health visits for ",$P(^DPT(AMHPAT,0),U)
  1.  W !,AMHDASH
  1.  W !," #",?7,"PROVIDER",?18,"LOC",?23,"DATE",?33,"ACT",?37,"CONT",?42,"PATIENT",?55,"PROB",?64,"NARRATIVE",!,AMHDASH
  1.  Q
  1. SELECT ;
  1.  W ! S DIR(0)="NO^1:"_AMHRCNT_":0",DIR("A")="Which record do you want to display" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) W !,"No Records selected to display." D PAUSE^AMHLEIN Q
  1.  I '$D(AMHRRECS(+Y)) W !,"Invalid selection!!" G SELECT
  1.  S AMHR=AMHRRECS(+Y)
  1.  Q
  1.  ;
  1. DISPRECS ;display visits for selection by user
  1.  S (AMHPG,AMHRCTR,AMHRIEN)=0
  1.  D HEAD
  1.  S AMHRCTR="",AMHCNTR=0
  1.  F  S AMHRCTR=$O(AMHRRECS(AMHRCTR),-1) Q:AMHRCTR'=+AMHRCTR  S AMHRIEN=AMHRRECS(AMHRCTR),AMHR0=^AMHREC(AMHRIEN,0) D
  1.  .S AMHCNTR=AMHCNTR+1
  1.  .I $Y>(IOSL-1) D HEAD Q:$D(AMHQUIT)
  1.  .W !,AMHCNTR,?5,$E($$PPNAME^AMHUTIL(AMHRIEN),1,12)
  1.  .W:$P(AMHR0,U,4) ?18,$S($P(^AUTTLOC($P(AMHR0,U,4),0),U,7)]"":$P(^(0),U,7),1:$E($P(^AUTTLOC($P(AMHR0,U,4),0),U),1,4))
  1.  .;W:$P(AMHR0,U,5) ?23,$E($P(^AUTTCOM($P(AMHR0,U,5),0),U),1,10)
  1.  .W ?23,$$DATE^AMHVRL($P($P(AMHR0,U),"."))
  1.  .W ?34,$S($P(AMHR0,U,6)]"":$P(^AMHTACT($P(AMHR0,U,6),0),U),1:""),?37,$S($P(AMHR0,U,7)]"":$E($P(^AMHTSET($P(AMHR0,U,7),0),U),1,4),1:"")
  1.  .I $P(AMHR0,U,8)]""  D
  1.  ..I $P(AMHR0,U,4),$D(^AUPNPAT($P(AMHR0,U,8),41,$P(AMHR0,U,4))) W ?42,$P(^AUTTLOC($P(AMHR0,U,4),0),U,7)," ",$P(^AUPNPAT($P(AMHR0,U,8),41,$P(AMHR0,U,4),0),U,2) Q
  1.  ..I $D(^AUPNPAT($P(AMHR0,U,8),41,DUZ(2))) W ?42,$P(^AUTTLOC(DUZ(2),0),U,7)," ",$P(^AUPNPAT($P(AMHR0,U,8),41,DUZ(2),0),U,2)
  1.  .E  W ?42,"-----"
  1.  .S AMHP=$O(^AMHRPRO("AD",AMHRIEN,0)) I AMHP="" W ?55,"No Problems recorded." Q
  1.  .W ?55,$P(^AMHPROB($P(^AMHRPRO(AMHP,0),U),0),U) W ?64,$E($$GET1^DIQ(9002011.01,AMHP,.04),1,15)
  1.  .Q
  1.  Q
  1.  ;
  1. HDR ; -- print header
  1.  NEW X
  1.  S X=IOUON_$$PAD($$SP(10)_"PATIENT VISITS"_$$SP(8)_$$NOW,77)_IOUOFF
  1.  D MSG^AMHVU(X,1,0,0)
  1.  D MSG^AMHVU($$SP(10)_$$CONFID^AMHVU("Patient"),0,0,0)
  1.  D MSG^AMHVU($$NAME_$$SP(5)_$$HRCN,1,0,0)
  1.  D MSG^AMHVU($$REPEAT^XLFSTR("_",80),1,1,0)
  1.  Q
  1.  ;
  1. NOW() ; -- returns readable now
  1.  Q $$FMTE^XLFDT($$NOW^XLFDT,1)
  1.  ;
  1. NAME() ; -- returns printable name
  1.  Q $$VAL^XBDIQ1(9000001,DFN,.01)
  1.  ;
  1. HRCN() ; -- returns chart # for this facility
  1.  Q "#"_$P($G(^AUPNPAT(DFN,41,+DUZ(2),0)),U,2)
  1.  ;
  1. PAD(DATA,LENGTH) ; -- SUBRTN to pad length of data
  1.  Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)
  1.  ;
  1. SP(NUM) ; -- SUBRTN to pad spaces
  1.  Q $$PAD(" ",NUM)
  1.  ;
  1. CHOICE ;;
  1.  ;; 1. ADD PATIENT VISIT
  1.  ;; 2. EDIT PATIENT VISIT
  1.  ;; 3. DISPLAY PATIENT VISIT
  1.  ;; 4. EDIT SOAP ON A VISIT RECORD
  1.  ;; 5. DELETE PATIENT VISIT
  1.  ;; 6. PRINT ENCOUNTER FORM