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