AMHEHR.m

AMHEHR ; IHS/CMI/LAB - ADD NEW MHSS ACTIVITY RECORDS 13 Aug 2007 4:21 PM 03 Jun 2009 10:50 AM ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,4,6,8**;JUN 02, 2010;Build 7

 ;

EN ;PEP - ADD NEW OR EDIT EXISTING BH RECORD CREATED BY EHR

 S AMHVSIT=AUPNVSIT

 S AMHEHR=1

 S AMHR=$O(^AMHREC("AVISIT",AUPNVSIT,0))

 I AMHR,$P($G(^AMHREC(AMHR,11)),U,11) Q

 I AMHR D EDITREC Q

 Q:$P($G(^AMHSITE(DUZ(2),18)),U,5)

 S AMHDATE=$P(^AUPNVSIT(AMHVSIT,0),U)

 S (AMHPAT,DFN)=$P(^AUPNVSIT(AMHVSIT,0),U,5)

 ;create record

 K DIC S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE

 S DIC("DR")=".03///^S X=DT;.08////"_DFN_";.19////"_DUZ_";.33////R;.28////"_DUZ_";.22///A;.21////"_DT_";.16////"_AMHVSIT_";1110////1"

 K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0

 I Y=-1 Q

 S AMHR=+Y

 D EV

 D RFILES

 D EXIT

 Q

ALERT ;

 I $P(^AMHREC(AMHR,0),U,12)=""!($P(^AMHREC(AMHR,0),U,12)=0) D

 .;send alert to user only if one never sent

 .S (G,X)=0 F  S X=$O(^AMHREC(AMHR,97,X)) Q:X'=+X!(G)  D

 ..Q:$P(^AMHREC(AMHR,97,X,0),U,1)'=DT

 ..Q:$P(^AMHREC(AMHR,97,X,0),U,2)'=DUZ

 ..S G=1

 .Q:G

 .NEW %,P

 .S %=0 F  S %=$O(^AMHRPROV("AD",AMHR,%)) Q:%'=+%  S P=$P($G(^AMHRPROV(%,0)),U)

 .S XQA(P)=""

 .S XQAOPT=""

 .S XQAROU=""

 .S XQAFLG="D"

 .S AMHTEXT(1)=" "

 .S AMHTEXT(2)=" "

 .S AMHTEXT(3)="This Behavioral Health visit is missing an activity time.  The activity"

 .S AMHTEXT(4)="time can be entered through EHR or with PCC data entry using the AT"

 .S AMHTEXT(5)="mnemonic."

 .S XQATEXT="AMHTEXT"

 .S XQAMSG="HRN: "_$$HRN^AUPNPAT($P(^AUPNVSIT(AUPNVSIT,0),U,5),DUZ(2))_"  Date: "_$$VAL^XBDIQ1(9000010,AUPNVSIT,.01)_" is missing an activity time."

 .S XQAID="OR,"_$P(^AMHREC(AMHR,0),U,8)_",46"

 .D SETUP^XQALERT

 .S (G,X)=0 F  S X=$O(^AMHREC(AMHR,97,X)) Q:X'=+X  S G=X

 .S G=G+1

 .S ^AMHREC(AMHR,97,G,0)=DT_"^"_DUZ,^AMHREC(AMHR,97,"B",DT,G)=""

 .S ^AMHREC(AMHR,97,0)="^9002011.97DA^"_G_"^"_G

 Q

EV ;

 ;now update other fields

 S AMHCLN=$$CLINIC^APCLV(AMHVSIT,"C")

 S AMH02=$S(AMHCLN="14":"M",AMHCLN=48:"S",AMHCLN="43":"C",AMHCLN="C4":"O",1:"O")

 ;location

 S AMH04=$P(^AUPNVSIT(AMHVSIT,0),U,6)

 ;community

 S AMH05=$P($G(^AMHSITE(DUZ(2),18)),U,4)

 I AMH05="" S AMH05=$P($G(^AMHSITE(DUZ(2),0)),U,6)

 I AMH05="" S AMH05=$P($G(^AMHSITE(DUZ(2),0)),U,21)

 I AMH05="" S AMH05=$P($G(^AMHSITE(DUZ(2),0)),U,29)

 ;activity code

 S AMH06=$P(^AMHREC(AMHR,0),U,6)

 I AMH06="" S AMH06=$O(^AMHTACT("B",99,0))

 ;TOC

 S AMH07=$$TOC($P(^AUPNVSIT(AMHVSIT,0),U,7))

 ;#SERVED

 S AMH09=1

 ;appt/walkin

 S AMH11=$P(^AUPNVSIT(AMHVSIT,0),U,16) I AMH11="" D

 .I $P(^AUPNVSIT(AMHVSIT,0),U,26)]"" S AMH11="A" Q

 .S AMH11="U"

 .Q

 ;activity time

 S AMH12=$$TIME(AMHVSIT)

 ;

 S AMH25=$P(^AUPNVSIT(AMHVSIT,0),U,8)

 S AMH26=$P($G(^AUPNVSIT(AMHVSIT,21)),U)

 ;SCREENS

 S (AMH1401,AMH1402,AMH1403,AMH1404,AMH1405,AMH1406,AMH1407,AMH1408,AMH1501,AMH1601,AMH1701,AMH1901)=""

 S AMHX=0 F  S AMHX=$O(^AUPNVXAM("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S X=$P($G(^AUPNVXAM(AMHX,0)),U)

 .Q:'X

 .S X=$P($G(^AUTTEXAM(X,0)),U,2)

 .I X=34 D  Q

 ..S R=$P(^AUPNVXAM(AMHX,0),U,4)

 ..Q:R=""

 ..S AMH1401=R

 ..S AMH1402=$P($G(^AUPNVXAM(AMHX,12)),U,4)

 ..I AMH1402="" S AMH1402=$$PRIMPROV^APCLV(AMHVSIT,"I")

 ..S AMH1501=$P($G(^AUPNVXAM(AMHX,811)),U)

 .I X=35 D  Q

 ..S R=$P(^AUPNVXAM(AMHX,0),U,4)

 ..Q:R=""

 ..S AMH1403=R S:R="PO" AMH1403="P"

 ..S AMH1404=$P($G(^AUPNVXAM(AMHX,12)),U,4)

 ..I AMH1404="" S AMH1404=$$PRIMPROV^APCLV(AMHVSIT,"I")

 ..S AMH1601=$P($G(^AUPNVXAM(AMHX,811)),U)

 .I X=36 D  Q

 ..S R=$P(^AUPNVXAM(AMHX,0),U,4)

 ..Q:R=""

 ..S AMH1405=R S:R="PO" AMH1405="P"

 ..S AMH1406=$P($G(^AUPNVXAM(AMHX,12)),U,4)

 ..I AMH1406="" S AMH1406=$$PRIMPROV^APCLV(AMHVSIT,"I")

 ..S AMH1701=$P($G(^AUPNVXAM(AMHX,811)),U)

 .I X=43 D  Q

 ..S R=$P(^AUPNVXAM(AMHX,0),U,4)

 ..Q:R=""

 ..S AMH1407=R

 ..S AMH1408=$P($G(^AUPNVXAM(AMHX,12)),U,4)

 ..I AMH1408="" S AMH1408=$$PRIMPROV^APCLV(AMHVSIT,"I")

 ..S AMH1901=$P($G(^AUPNVXAM(AMHX,811)),U)

 S AMH1108="" S AMHX=$O(^AUPNVNOT("AD",AMHVSIT,0)) I AMHX S AMH1108=$P(^AUPNVNOT(AMHX,0),U)

 S AMH1117=$P(^AUPNVSIT(AMHVSIT,0),U,22)  ;PATCH 8 CMI/LAB - HOSP LOC

FILE ;

 D SETARRAY^AMHEHR1

 D FILE^DIE("K","AMHFDA","AMHERR(1)")

 I $G(AMHERR(1)) D  Q

 .S AMHERROR="Could not create a MHSS Record entry.",AMHVFILE="9002011-MHSS RECORD"

 .D LBULL

 .Q

 ;

 ;update user last update/date edited

 S DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR

 ;update TIU

TIUN ;

 ;

 ;get rid of all in multiple and rebuild

 K ^AMHREC(AMHR,54)

 S AMHX=0 F  S AMHX=$O(^AUPNVNOT("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHDOC=$P($G(^AUPNVNOT(AMHX,0)),U)

 .I 'AMHDOC Q

 .I '$D(^TIU(8925,AMHDOC)) Q

 .S DIE="^AMHREC(",DA=AMHR,DR="5400///`"_AMHDOC D ^DIE K DIE,DA,DR

 ;

 Q

EDITREC ;

 S (DFN,AMHPAT)=$P(^AMHREC(AMHR,0),U,8)

 S DIE="^AMHREC(",DA=AMHR,DR=".21////"_DT_";.28////"_DUZ D ^DIE

 D EV

 ;now delete all v files

 S AMHX=0 F  S AMHX=$O(^AMHRPRO("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D

 .S DA=AMHX,DIK="^AMHRPRO(" D ^DIK

 S AMHX=0 F  S AMHX=$O(^AMHRPROV("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D

 .S DA=AMHX,DIK="^AMHRPROV(" D ^DIK

 S AMHX=0 F  S AMHX=$O(^AMHRPROC("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D

 .S DA=AMHX,DIK="^AMHRPROC(" D ^DIK

 S AMHX=0 F  S AMHX=$O(^AMHREDU("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D

 .S DA=AMHX,DIK="^AMHREDU(" D ^DIK

 S AMHX=0 F  S AMHX=$O(^AMHRHF("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D

 .S DA=AMHX,DIK="^AMHRHF(" D ^DIK

 S AMHX=0 F  S AMHX=$O(^AMHRMSR("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D

 .S DA=AMHX,DIK="^AMHRMSR(" D ^DIK

 D ^XBFMK

 D RFILES

 D EXIT

 Q

 ;

GETDSM ;

 D GETDSM^AMHEHR1

 Q

RFILES ;

VPOV ;

 S AMHX=0 F  S AMHX=$O(^AUPNVPOV("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHCIEN=$P($G(^AUPNVPOV(AMHX,0)),U)

 .Q:AMHCIEN=""

 .S AMHCODE=$$VAL^XBDIQ1(9000010.07,AMHX,.01)

 .Q:AMHCODE=""

 .S AMHIMP=$$CS^AMHUTIL2(AMHCIEN)  ;what is the coding system?  1=ICD9, 30=ICD10

 .S AMH45=$$DSMCS^AMHUTIL1(DUZ(2),$P($P(^AMHREC(AMHR,0),U),"."))

 .;S AMHDSM=$O(^AMHPROB("B",AMHCODE,0))

 .S AMHDSM="" D GETDSM

 .I AMHDSM="" D  ;LAYGO INTO AMHPROB

 ..D ^XBFMK

 ..K AMHICNA

 ..S AMHPC=$O(^AMHPROBC("B",99.9,0))

 ..S X=AMHCODE,DLAYGO=9001012.2,DIADD=1,DIC="^AMHPROB("

 ..I AMHIMP=1 S AMHICNA=$$ICDD^ICDCODE(AMHCODE,"AMHICNA")

 ..I AMHIMP=30 S AMHICNA(1)=$P($$ICDDX^ICDEX(AMHCODE,$$VD^APCLV(AMHVSIT)),U,4)

 ..S DIC(0)="L",DIC("DR")=".02////"_$E($G(AMHICNA(1)),1,160)_";.03////"_AMHPC_";.1///"_$S(AMHIMP=1:9,1:0)_$S(AMHIMP=1:";.05////",1:";.17////")_AMHCODE

 ..K DD,D0,DO D FILE^DICN K DIADD,DLAYGO,DD,DIC,D0,DO

 ..I Y=-1 S AMHERROR="Could not Create POV: "_AMHCODE,AMHVFILE="MHSS RECORD PROBLEMS" D LBULL Q

 ..S AMHDSM=+Y

 .I AMHDSM="" S AMHERROR="Could not Create POV: "_AMHCODE,AMHVFILE="MHSS RECORD PROBLEMS" D LBULL Q

 .S AMH04=$P(^AUPNVPOV(AMHX,0),U,4)

 .D ^XBFMK

 .S X=AMHDSM,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04////"_AMH04

 .S DIC="^AMHRPRO(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.01 K DD,DO D FILE^DICN

 .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 .I Y=-1 S AMHERROR="Could not Create POV: "_AMHCODE,AMHVFILE="MHSS RECORD PROBLEMS" D LBULL Q

 .Q

VPROV ;

 S AMHX=0 F  S AMHX=$O(^AUPNVPRV("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHPROV=$P($G(^AUPNVPRV(AMHX,0)),U)

 .Q:AMHPROV=""

 .S AMHPS=$P(^AUPNVPRV(AMHX,0),U,4)

 .I AMHPS="" S AMHPS="S"

 .S DIC="^AMHRPROV(",X=AMHPROV,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04////"_AMHPS,DIC="^AMHRPROV("

 .S DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02 K DD,DO D FILE^DICN

 .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 .I Y=-1 S AMHERROR="Could not Create PROVIDER: "_$P(^VA(200,AMHPROV,0),U),AMHVFILE="MHSS RECORD PROVIDERS" D LBULL Q  ;D SENDBUL

 .Q

VCPT ;

 S AMHX=0 F  S AMHX=$O(^AUPNVCPT("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHCPT=$P($G(^AUPNVCPT(AMHX,0)),U)

 .Q:AMHCPT=""

 .S X=AMHCPT,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.08////"_$P(^AUPNVCPT(AMHX,0),U,8)_";.09////"_$P(^AUPNVCPT(AMHX,0),U,9)_";.16////"_$P(^AUPNVCPT(AMHX,0),U,16)

 .S DIC="^AMHRPROC(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.04 K DD,DO D FILE^DICN

 .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 .I Y=-1 S AMHERROR="Could not Create CPT: "_$P(^ICPT(AMHCPT,0),U),AMHVFILE="MHSS RECORD PROCEDURES" D LBULL Q

 .Q

VPED ;

 S AMHX=0 F  S AMHX=$O(^AUPNVPED("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHPED=$P($G(^AUPNVPED(AMHX,0)),U)

 .Q:AMHPED=""

 .S AMHP0=^AUPNVPED(AMHX,0)

 .S X=AMHPED

 .S DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(AMHP0,U,5)_";.05////"_$P(AMHP0,U,7)_";.06////"_$P(AMHP0,U,8)_";.07////"_$P(AMHP0,U,9)

 .S DIC("DR")=DIC("DR")_";.08////"_$P(AMHP0,U,6)_";.11////"_$P(AMHP0,U,13)_";1102////"_$P($G(^AUPNVPED(AMHX,11)),U,2)

 .S DIC="^AMHREDU(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.05 K DD,DO D FILE^DICN

 .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 .I Y=-1 S AMHERROR="Could not Create EDUCATION: "_$P(^AUTTEDT(AMHPED,0),U),AMHVFILE="MHSS RECORD PATIENT EDUCATION" D LBULL Q  ;D SENDBUL

 .I $P(AMHP0,U,11)]"" S $P(^AMHREDU(+Y,11),U)=$P(AMHP0,U,11)  ;directly set due to ;

 .I $P(AMHP0,U,14)]"" S $P(^AMHREDU(+Y,0),U,9)=$P(AMHP0,U,14)  ;due to ;

 .Q

VHF ;

 S AMHX=0 F  S AMHX=$O(^AUPNVHF("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHHF=$P($G(^AUPNVHF(AMHX,0)),U)

 .Q:AMHHF=""

 .S AMHP0=^AUPNVHF(AMHX,0)

 .S X=AMHHF,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(AMHP0,U,4)_";.05////"_$P(AMHP0,U,5)_";.06////"_$P(AMHP0,U,6)

 .S DIC="^AMHRHF(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.08 K DD,DO D FILE^DICN

 .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 .I Y=-1 S AMHERROR="Could not Create Health Factor: "_$P(^AUTTHF(AMHHF,0),U),AMHVFILE="MHSS RECORD HEALTH FACTORS" D LBULL Q  ;D SENDBUL

 .I $P($G(^AUPNVHF(AMHX,811)),U,1)]"" S $P(^AMHRHF(+Y,811),U)=$P(^AUPNVHF(AMHX,811),U)  ;directly set due to ;

 .Q

 ;

VMSR ;

 S AMHX=0 F  S AMHX=$O(^AUPNVMSR("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX  D

 .S AMHMSR=$P($G(^AUPNVMSR(AMHX,0)),U)

 .Q:AMHMSR=""

 .Q:$P($G(^AUPNVMSR(AMHX,2)),U,1)  ;entered in error

 .S AMHP0=^AUPNVMSR(AMHX,0)

 .S X=AMHMSR,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(AMHP0,U,4)

 .S DIC="^AMHRMSR(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.12 K DD,DO,D0 D FILE^DICN

 .K DIC,DA,DO,D0,DD,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 .I Y=-1 S AMHERROR="Could not Create MEASUREMENT: "_AMHCODE,AMHVFILE="MHSS RECORD MEASUREMENTS" D LBULL Q  ;D SENDBUL

 ;D ALERT

SCRREF ;are there any screening refusals?

 D SCRREF^AMHEHR1

 Q

EXIT ;

 D EN^XBVK("AMH")

 D ^XBFMK

 Q

TIME(V) ;

 NEW X,T

 S X=0,T=""

 F  S X=$O(^AUPNVTM("AD",V,X)) Q:X'=+X  S T=T+$P(^AUPNVTM(X,0),U)

 I T Q T

 Q ""

 ;

TOC(S) ;

 I S="A" Q 2

 I S="C" Q 7

 I S="H" Q 3

 I S="I" Q 10

 I S="N" Q 4

 I S="R" Q 4

 I S="T" Q 8

 Q 2

 ;

EDITEHR ;EP - called from option

 W !!,"This option is used to edit the BH related fields of a visit"

 W !,"that was entered via EHR.",!

EEHR1 ;

 D EDITEHRX

 F  S AMHPAT="" D GETPAT Q:AMHPAT=""  D EDIT

 Q

 D GETPAT

 I AMHPAT="" D EDITEHRX Q

 D GETDATE

 I AMHDATE="" D EDITEHRX Q

 D EDIT

 Q

 ;

EDIT ;

 D GETDATE

 Q:AMHDATE=""

 ;display all EHR visits and allow user to select one

 I '$D(^AMHREC("AF",AMHPAT,AMHDATE)) W !!,"There are no EHR created visits for ",$P(^DPT(AMHPAT,0),U)," on ",$$FMTE^XLFDT(AMHDATE) Q

 S (AMHV,AMHC)=0

 F  S AMHV=$O(^AMHREC("AF",AMHPAT,AMHDATE,AMHV)) Q:AMHV'=+AMHV  D

 .I '$P($G(^AMHREC(AMHV,11)),U,10) Q

 .Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHV)

 .S AMHC=AMHC+1,AMHV(AMHC)=AMHV

 .Q

 I AMHC=0 W !!,"There are no EHR created visits for ",$P(^DPT(AMHPAT,0),U)," on ",$$FMTE^XLFDT(AMHDATE) Q

 I AMHC=1 S AMHR=AMHV(1) G SCR

 S AMHC=0 F  S AMHC=$O(AMHV(AMHC)) Q:AMHC'=+AMHC  D

 .S AMHX=^AMHREC(AMHV(AMHC),0)

 .W !,AMHC,")  TIME: ",$P($$FMTE^XLFDT($P(AMHX,U),"2P")," ",2,3)," TOC: ",$E($$VAL^XBDIQ1(9002011,AMHV(AMHC),.07),1,12)," CLINIC: ",$E($$VAL^XBDIQ1(9002011,AMHV(AMHC),.25),1,15)

 .W !?3,"Provider on Visit: ",$$PPNAME^AMHUTIL(AMHV(AMHC))

 .W !?3,"Primary POV: ",$$PRIMPOV^AMHUTIL1(AMHV(AMHC),"C"),"  ",$E($$PRIMPOV^AMHUTIL1(AMHV(AMHC),"N"),1,50)

 .Q

 K DIR

 S DIR(0)="N^1:"_AMHC,DIR("A")="Select" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 S AMHR=AMHV(+Y)

 ;

SCR ;EP

 S DA=AMHR,DDSFILE=9002011,DR=$S($$DSMCS^AMHUTIL1(DUZ(2),$P($P(^AMHREC(AMHR,0),U),"."))=4:"[AMH EHR EDIT RECORD]",1:"[AMHEH EHR EDIT RECORD") D ^DDS

 I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" D PAUSE^AMHLEA K DIMSG Q

 Q

GETPAT ;

 D EDITEHRX

 S AMHPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD

 I Y<0 Q

 S AMHPAT=+Y

 S X=AMHPAT D ^AMHPEDIT I '$D(X) G GETPAT

 W !?25,"Ok" S %=1 D YN^DICN I %'=1 S AMHPAT="" K AMHC Q

 I AMHPAT,'$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G GETPAT

 Q

 ;

GETDATE ;EP - GET DATE OF ENCOUNTER

 W !!

 S AMHDATE="",DIR(0)="DO^:"_DT_":EPTX",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 S AMHDATE=Y

 Q

EDITEHRX ;

 D EN^XBVK("AMH")

 D KILL^AUPNPAT

 D ^XBFMK

 Q

 ;

TIU ;EP

 NEW AMHSTR,AMHC,AMHTIUD,AMHTIU,AMHGBL,AMHHLF,AMHX,AMHX1

 I '$O(^AMHREC(AMHR,54,0)) W !!,"There is no TIU document associated with this visit." D PAUSE^AMHLEA K AMHTIU Q

 ;D BROWS1^TIURA2("TIU BROWSE FOR READ ONLY",AMHTIU)

 D TIUDISP

 K AMHTIU

 Q

TIUDISP ;

 K AMHTIUD S AMHC=0

 S X="" D S(X) D S("TIU DOCUMENTS") D S("-------------")

 S AMHDOC=0 F  S AMHDOC=$O(^AMHREC(AMHR,54,"B",AMHDOC)) Q:AMHDOC'=+AMHDOC  D

 .K AMHTIU,AMHERR

 .K ^TMP("AMHOENPS",$J)

 .D TIUDSP

 .K ^TMP("AMHEONPS",$J)

 .K AMHTIU

 .Q

 D ARRAY^XBLM("AMHTIUD(","TIU Document Display")

 Q

TIUDSP ;

 D TIUDSP^AMHEHR1

 Q

 ;

S(Y,F,C,T) ;EP - set up array

 I '$G(F) S F=0

 I '$G(T) S T=0

 ;blank lines

 F F=1:1:F S X="" D S1

 S X=Y

 I $G(C) S L=$L(Y),T=(80-L)/2 D  D S1 Q

 .F %=1:1:(T-1) S X=" "_X

 F %=1:1:T S X=" "_Y

 D S1

 Q

S1 ;

 S AMHC=AMHC+1

 S AMHTIUD(AMHC,0)=X

 Q

EHRE ;EP

 W !,"This visit was created through EHR.  Certain data fields can be edited using",!,"the EH action on the PDE screen.  All other fields must be edited"

 W !,"through EHR.",!

 Q

 ;

LBULL ;

 K XMB

 S XMDUZ="EHR TO BH"

 S XMB(1)=AMHVSIT,XMB(2)=$P(^DPT(AMHPAT,0),U)_" (DFN "_AMHPAT_")",Y=$P($P(^AUPNVSIT(AMHVSIT,0),U),".") D DD^%DT S XMB(3)=Y,XMB(4)="EHR TO PCC LINK FAILURE: "_AMHERROR,XMB(5)=$G(AMHVFILE),XMB="AMH EHR-PCC LINK FAIL " ;,AMHDUZ=DUZ,DUZ=.5

 D ^XMB K XMB,AMHERROR,AMHBN,AMHVFILE,XMDUZ

 Q

AMHEHR    ; IHS/CMI/LAB - ADD NEW MHSS ACTIVITY RECORDS 13 Aug 2007 4:21 PM 03 Jun 2009 10:50 AM ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,4,6,8**;JUN 02, 2010;Build 7

 +2       ;

EN        ;PEP - ADD NEW OR EDIT EXISTING BH RECORD CREATED BY EHR

 +1        SET AMHVSIT=AUPNVSIT

 +2        SET AMHEHR=1

 +3        SET AMHR=$ORDER(^AMHREC("AVISIT",AUPNVSIT,0))

 +4        IF AMHR

               IF $PIECE($GET(^AMHREC(AMHR,11)),U,11)

                   QUIT 

 +5        IF AMHR

               DO EDITREC

               QUIT 

 +6        IF $PIECE($GET(^AMHSITE(DUZ(2),18)),U,5)

               QUIT 

 +7        SET AMHDATE=$PIECE(^AUPNVSIT(AMHVSIT,0),U)

 +8        SET (AMHPAT,DFN)=$PIECE(^AUPNVSIT(AMHVSIT,0),U,5)

 +9       ;create record

 +10       KILL DIC

           SET DIC(0)="EL"

           SET DIC="^AMHREC("

           SET DLAYGO=9002011

           SET DIADD=1

           SET X=AMHDATE

 +11       SET DIC("DR")=".03///^S X=DT;.08////"_DFN_";.19////"_DUZ_";.33////R;.28////"_DUZ_";.22///A;.21////"_DT_";.16////"_AMHVSIT_";1110////1"

 +12       KILL DD,DO,D0

           DO FILE^DICN

           KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0

 +13       IF Y=-1

               QUIT 

 +14       SET AMHR=+Y

 +15       DO EV

 +16       DO RFILES

 +17       DO EXIT

 +18       QUIT 

ALERT     ;

 +1        IF $PIECE(^AMHREC(AMHR,0),U,12)=""!($PIECE(^AMHREC(AMHR,0),U,12)=0)

               Begin DoDot:1

 +2       ;send alert to user only if one never sent

 +3                SET (G,X)=0

                   FOR 

                       SET X=$ORDER(^AMHREC(AMHR,97,X))

                       IF X'=+X!(G)

                           QUIT 

                       Begin DoDot:2

 +4                        IF $PIECE(^AMHREC(AMHR,97,X,0),U,1)'=DT

                               QUIT 

 +5                        IF $PIECE(^AMHREC(AMHR,97,X,0),U,2)'=DUZ

                               QUIT 

 +6                        SET G=1

                       End DoDot:2

 +7                IF G

                       QUIT 

 +8                NEW %,P

 +9                SET %=0

                   FOR 

                       SET %=$ORDER(^AMHRPROV("AD",AMHR,%))

                       IF %'=+%

                           QUIT 

                       SET P=$PIECE($GET(^AMHRPROV(%,0)),U)

 +10               SET XQA(P)=""

 +11               SET XQAOPT=""

 +12               SET XQAROU=""

 +13               SET XQAFLG="D"

 +14               SET AMHTEXT(1)=" "

 +15               SET AMHTEXT(2)=" "

 +16               SET AMHTEXT(3)="This Behavioral Health visit is missing an activity time.  The activity"

 +17               SET AMHTEXT(4)="time can be entered through EHR or with PCC data entry using the AT"

 +18               SET AMHTEXT(5)="mnemonic."

 +19               SET XQATEXT="AMHTEXT"

 +20               SET XQAMSG="HRN: "_$$HRN^AUPNPAT($PIECE(^AUPNVSIT(AUPNVSIT,0),U,5),DUZ(2))_"  Date: "_$$VAL^XBDIQ1(9000010,AUPNVSIT,.01)_" is missing an activity time."

 +21               SET XQAID="OR,"_$PIECE(^AMHREC(AMHR,0),U,8)_",46"

 +22               DO SETUP^XQALERT

 +23               SET (G,X)=0

                   FOR 

                       SET X=$ORDER(^AMHREC(AMHR,97,X))

                       IF X'=+X

                           QUIT 

                       SET G=X

 +24               SET G=G+1

 +25               SET ^AMHREC(AMHR,97,G,0)=DT_"^"_DUZ

                   SET ^AMHREC(AMHR,97,"B",DT,G)=""

 +26               SET ^AMHREC(AMHR,97,0)="^9002011.97DA^"_G_"^"_G

               End DoDot:1

 +27       QUIT 

EV        ;

 +1       ;now update other fields

 +2        SET AMHCLN=$$CLINIC^APCLV(AMHVSIT,"C")

 +3        SET AMH02=$SELECT(AMHCLN="14":"M",AMHCLN=48:"S",AMHCLN="43":"C",AMHCLN="C4":"O",1:"O")

 +4       ;location

 +5        SET AMH04=$PIECE(^AUPNVSIT(AMHVSIT,0),U,6)

 +6       ;community

 +7        SET AMH05=$PIECE($GET(^AMHSITE(DUZ(2),18)),U,4)

 +8        IF AMH05=""

               SET AMH05=$PIECE($GET(^AMHSITE(DUZ(2),0)),U,6)

 +9        IF AMH05=""

               SET AMH05=$PIECE($GET(^AMHSITE(DUZ(2),0)),U,21)

 +10       IF AMH05=""

               SET AMH05=$PIECE($GET(^AMHSITE(DUZ(2),0)),U,29)

 +11      ;activity code

 +12       SET AMH06=$PIECE(^AMHREC(AMHR,0),U,6)

 +13       IF AMH06=""

               SET AMH06=$ORDER(^AMHTACT("B",99,0))

 +14      ;TOC

 +15       SET AMH07=$$TOC($PIECE(^AUPNVSIT(AMHVSIT,0),U,7))

 +16      ;#SERVED

 +17       SET AMH09=1

 +18      ;appt/walkin

 +19       SET AMH11=$PIECE(^AUPNVSIT(AMHVSIT,0),U,16)

           IF AMH11=""

               Begin DoDot:1

 +20               IF $PIECE(^AUPNVSIT(AMHVSIT,0),U,26)]""

                       SET AMH11="A"

                       QUIT 

 +21               SET AMH11="U"

 +22               QUIT 

               End DoDot:1

 +23      ;activity time

 +24       SET AMH12=$$TIME(AMHVSIT)

 +25      ;

 +26       SET AMH25=$PIECE(^AUPNVSIT(AMHVSIT,0),U,8)

 +27       SET AMH26=$PIECE($GET(^AUPNVSIT(AMHVSIT,21)),U)

 +28      ;SCREENS

 +29       SET (AMH1401,AMH1402,AMH1403,AMH1404,AMH1405,AMH1406,AMH1407,AMH1408,AMH1501,AMH1601,AMH1701,AMH1901)=""

 +30       SET AMHX=0

           FOR 

               SET AMHX=$ORDER(^AUPNVXAM("AD",AMHVSIT,AMHX))