AMHLEA ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,2,8**;JUN 02, 2010;Build 7
;
;add new records
;get all items for a record, check record, file record
;if not complete record, issue warning and delete record
ADDR ;EP
D FULL^VALM1
I '$D(AMHDATE) W !!,"Date not entered." H 5 Q
S AMHQUIT=0,AMHACTN=1
I '$G(AMHADPTV) K AMHPAT
I AMHDET="S" D ADDSCR Q
;I $G(AMHADPTV) D GETVTYP
;I '$G(AMHADPTV) S AMHVTYPE="R"
S AMHVTYPE="R"
;I AMHVTYPE="B" S AMHVTYPE="R"
;I AMHVTYPE="" K AMHVTYPE W !,"Visit type is required!" G EXIT
;I AMHVTYPE="C" D IC^AMHLEIC D EXIT Q
;I AMHVTYPE="N" D NS^AMHLENS1 D EXIT Q
D HEADER
S APCDOVRR=""
I '$D(AMHPATCE) K AMHPAT
W !,"Creating new record..." K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")="1111////1" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!! Deleting Record.",! D PAUSE Q
S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
S DA=AMHR,DIE="^AMHREC(",DR=$S(AMHVTYPE="A":"[AMHASA ADD RECORD]",$G(AMHADPTV):"[AMH ADD RECORD]",1:"[AMH ADD NON-PATIENT RECORD]") D CALLDIE^AMHLEIN
I $D(Y)!('$D(^AMHRPROV("AD",AMHR))) W !!,"Incomplete record!! Deleting record!!" D DEL G EXIT
D ^AMHLEPOV
I '$D(^AMHRPRO("AD",AMHR))!('$D(^AMHRPROV("AD",AMHR))) W !!,"Incomplete record!! Deleting record!!" D DEL G EXIT
S DA=AMHR,DIE="^AMHREC(",DR=$S(AMHVTYPE="A":"[AMH ADD RECORD 2 ASA]",1:"[AMH ADD RECORD 2]") D CALLDIE^AMHLEIN
I $D(Y) W !!,"Incomplete record!! Deleting record!!" D DEL G EXIT
S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !,"Incomplete record!! Deleting record!!" D DEL G EXIT
W ! S DIE="^AMHREC(",DR="8101",DA=AMHR D CALLDIE^AMHLEIN
I $G(AMHADPTV),AMHVTYPE="R" D REGULAR^AMHLEP2
;I $P(^AMHREC(AMHR,0),U,2)="C"!($P($G(^AMHREC(AMHR,91)),U)="Y") D CDST
I $P(^AMHREC(AMHR,0),U,8)]"" D SUIC,OTHER
I $P(^AMHREC(AMHR,0),U,8) D ESIG^AMHESIG(AMHR)
D PCCLINK
D EXIT
Q
ADDNS ;EP
D FULL^VALM1
I '$D(AMHDATE) W !!,"Date not entered." H 5 Q
S AMHQUIT=0,AMHACTN=1
S APCDOVRR=1
D ADDR^AMHLENS
D EXIT
Q
ADDSCR ;screenman mode
S APCDOVRR=""
I '$D(AMHPATCE) K AMHPAT
D FULL^VALM1
I '$D(AMHDATE) W !!,"Date not entered." H 5 Q
S AMHQUIT=0,AMHACTN=1
;I $G(AMHADPTV) D GETVTYP
;I '$G(AMHADPTV) S AMHVTYPE="R"
;I AMHVTYPE="" K AMHVTYPE W !,"Visit type is required!" G EXIT
;I AMHVTYPE="N" D ADDR^AMHLENS D EXIT Q
S AMHVTYPE="R"
K DIC S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")=".02///"_AMHPTYPE_";.03///^S X=DT;.19////"_DUZ_";.33////"_AMHVTYPE_";.28////"_DUZ_";.22///A;.21///^S X=DT"_";1111////1"
K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!! Deleting Record.",! D PAUSE Q
;update multiple of user last update/date edited
S AMHR=+Y
S DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
I $G(AMHADPTV)=1 D:'$D(AMHPATCE) GETPAT D:'$G(AMHPAT) DEL,EXIT Q:'$G(AMHPAT) S DA=AMHR,DR=".08////"_AMHPAT,DIE="^AMHREC(" D CALLDIE^AMHLEIN
S DA=AMHR,DIE="^AMHREC("
S DR=".02///"_AMHPTYPE_$S($$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE):";.04///`"_$$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE),1:"")_$S($$GETCOMM^AMHLEIN(DUZ(2),AMHPTYPE):";.05///`"_$$GETCOMM^AMHLEIN(DUZ(2),AMHPTYPE),1:"")_";1117////"_$$HL^AMHUTIL2(AMHPTYPE)
S DR=DR_$S($$GETCLN^AMHLEIN(DUZ(2),AMHPTYPE):";.25///`"_$$GETCLN^AMHLEIN(DUZ(2),AMHPTYPE),1:"")
S DR=DR_";.11///"_$$GETAWI^AMHLEIN(DUZ(2))_$S($$GETTOC^AMHLEIN(DUZ(2)):";.07///`"_$$GETTOC^AMHLEIN(DUZ(2)),1:"")
D ^DIE I $D(Y) W !!,"Error updating record......" H 5
K DR,DA,DIE
D GETPROV I '$$PPINT^AMHUTIL(AMHR) W !,"No PRIMARY PROVIDER entered!! - Required element" D DEL,EXIT Q
;
ADD1 ;
I AMHVTYPE="R" S DA=AMHR,DDSFILE=9002011,DR=$S($G(AMHADPTV):"[AMH ADD RECORD]",1:"[AMH ADD NON-PAT RECORD]") D ^DDS
;I AMHVTYPE="A" S DA=AMHR,DDSFILE=9002011,DR="[AMHASA ADD RECORD]" D ^DDS
;I AMHVTYPE="B" S AMHVTYPE="R",DA=AMHR,DDSFILE=9002011,DR=$S($G(AMHADPTV):"[AMHB ADD RECORD]",1:"[AMH ADD NON-PAT RECORD]") D ^DDS
;I AMHVTYPE="I"!(AMHVTYPE="P") S DA=AMHR,DDSFILE=9002011,DR="[AMHVT ADD RECORD]" D ^DDS
;I AMHVTYPE="C" S DA=AMHR,DDSFILE=9002011,DR="[AMH ADD CASE TRACKING REC]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
S DA=AMHR,DIE="^AMHREC(",DR="1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02)) D ^DIE K DA,DR,DIE ;IHS/CMI/LAB - PATCH 8 Hosp location
;CHECK RECORD
D CHECK
I AMHZDEL D EXIT Q
I AMHZED G ADD1
;I $G(AMHADPTV),(AMHVTYPE="I"!(AMHVTYPE="P")) D INTAKE^AMHLEP4
I $G(AMHADPTV),AMHVTYPE="R" D REGULAR^AMHLEP2
;I $G(AMHADPTV),AMHVTYPE="C" D REGULAR^AMHLEP2
I $G(AMHERROR) W !!,$C(7),$C(7),"PLEASE EDIT THIS RECORD!!",!!
;I $P(^AMHREC(AMHR,0),U,2)="C"!($P($G(^AMHREC(AMHR,91)),U)="Y") D CDST
I $G(AMHADPTV) D SUIC,OTHER
I $G(AMHADPTV) D PCCLINK
;I '$G(AMHADPTV) D ESIG^AMHESIG(AMHR)
D EXIT
Q
;
INDS(R) ;is this a initial or a discharge
I '$G(R) Q 0
I $P(^AMHREC(R,0),U,32)]"" Q 1
Q 0
PRIMPROB(R) ;EP
I '$G(R) Q ""
NEW X S X=$O(^AMHRPRO("AD",R,0))
I 'X Q ""
Q $P(^AMHRPRO(X,0),U)
GETVTYP ;
I AMHDET="S" S DIR(0)="S^R:Regular Visit;B:Abbreviated Version of Regular Visit;C:Info/Contact;N:No Show;A:A/SA Encounter"
I AMHDET="R" S DIR(0)="S^R:Regular Visit;C:Info/Contact;N:No Show;A:A/SA Encounter"
S DIR("A")="Enter Visit Type",DIR("B")="R" KILL DA
D ^DIR KILL DIR
I $D(DIRUT) S AMHVTYPE="" Q
S AMHVTYPE=Y,AMHVT=Y(0)
Q
CDST ;EP
;create record in CDMIS Staging file
;I '$$INDS(AMHR),$D(^AMHRCDST("B",AMHR)) D CDSTDEL Q
I $P($G(^AMHREC(AMHR,91)),U)'="Y" Q
I $D(^AMHRCDST("B",AMHR)) W !!,"There is already a initial/discharge entry for this visit.",!,"Editing existing data...." H 2 S AMHCDR=$O(^AMHRCDST("B",AMHR,0)) G CDST1
W !!,"Creating Initial Chemical Dependency data record..." H 1
D ^XBFMK S DIC="^AMHRCDST(",DIC(0)="AEMQ",DIADD=1,DLAYGO=9002011.06,X=AMHR K DD,DO D FILE^DICN K DIADD,DLAYGO,DD,DO,D0,DIC
I Y=-1 W !!,$C(7),$C(7),"Notify supervisor....error in creating Initial Staging record.." D PAUSE Q
S AMHCDR=+Y
CDST1 K DIADD,DLAYGO D ^XBFMK
S DA=AMHCDR,DIE="^AMHRCDST(",DR=".02////"_AMHPAT_";.03////"_$$PRIMPROB(AMHR)_";.04////"_DT_";.05////"_DUZ_";.19////"_$P(^AMHREC(AMHR,0),U,32) D ^DIE
I $D(Y) W !!,$C(7),$C(7),"Notify supervisor....error in creating Initial Staging record.." D PAUSE D ^XBFMK Q
S DA=AMHCDR,DDSFILE=9002011.06,DR="[AMH ENTER/EDIT STAGING TOOL]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
D ^XBFMK
Q
CDSTDEL ;
W !!,"There is a staging tool entry for this visit and this visit",!,"is not an INITIAL, REOPEN, TRAN/DISC/CLOSE or FOLLOW UP.",!
S DIR(0)="Y",DIR("A")="Do you want to delete this staging tool entry",DIR("B")="N" KILL DA D ^DIR KILL DIR
Q:$D(DIRUT)
Q:'Y
S DA=$O(^AMHRCDST("B",AMHR,0)),DIK="^AMHRCDST(" D ^DIK
Q
SUIC ;EP - is this a suicide visit? IF so, pop into suicide form
Q:'$G(AMHPAT)
NEW X,G,Y S (X,Y,G)=0 F S X=$O(^AMHRPRO("AD",AMHR,X)) Q:X'=+X S Y=$P(^AMHRPRO(X,0),U),Y=$P(^AMHPROB(Y,0),U) I Y=39!(Y=40)!(Y=41)!(Y="V62.84") S G=1
Q:'G
W !!,"You have entered a diagnosis relating to Suicide. ",!
W !,"IHS Suicide Forms should be filled out for all Suicide Ideations with Plan",!,"and Intent, for all Suicide Attempts and for all Completed Suicides.",!
S DIR(0)="Y",DIR("A")="Would you like to add/review the IHS Suicide forms for this patient",DIR("B")="Y" KILL DA D ^DIR KILL DIR
Q:$D(DIRUT)
Q:'Y
S (DFN,AMHLEAP)=AMHPAT
;D EN^XBNEW("EN^AMHLESF","DFN;AMHPAT")
D EN^AMHLESF
S AMHPAT=AMHLEAP
S DFN=AMHLEAP
Q
OTHER ;EP - collect other data if patient related
S AMHFIRST=0
D FULL^VALM1
OTHERN ;
I AMHFIRST G OTHERO
K AMHXX
S AMHANS=""
S AMHXX=$$ESIG^AMHESIG(AMHR)
I '$G(AMHXX) D I $P(AMHXX,U,4),AMHANS G OTHER
.W !!,$P(AMHXX,U,3),!
.I '$P(AMHXX,U,4) D PAUSE Q
.S DIR(0)="Y",DIR("A")="Do you wish to enter a SOAP/Progress Note",DIR("B")="Y" KILL DA D ^DIR KILL DIR
.Q:$D(DIRUT)
.S AMHANS=Y Q:'Y
.S DIE="^AMHREC(",DR=3101,DA=AMHR D ^DIE K DA,DIE,DR
I AMHXX D ESIGGFI^AMHESIG(AMHR)
S AMHFIRST=AMHFIRST+1
OTHERO ;
W @IOF,!!!?20,"******* OTHER INFORMATION *******",!!
D RMENU
S DIR("B")=10,DIR(0)="NO^1:10",DIR("A")="Choose one of the above" D ^DIR K DIR ;S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=10
S AMHSELE=+Y D OTHER1
G OTHERN
OTHER1 ;
I AMHSELE'=6,'$G(AMHPAT) W $C(7),"You MUST Identify the Patient first!!" S AMHPAT="" D GETPAT Q:'AMHPAT
W !
D @AMHSELE
Q
GETPROV ;get providers
I '$G(AMHADPTV) W:$D(IOF) @IOF W !!!!!!!
E W !!!
K DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR("B")=$P(^VA(200,DUZ,0),U),DIR(0)="9002011.02,.01O",DIR("A")=" Enter PRIMARY PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=""
S X=+Y,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY",DIC="^AMHRPROV(",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 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2
Q
GETPAT ;EP
D ^XBFMK
S AMHC=0
GETPAT1 I $G(AMHDET)="S" W:$D(IOF)&(AMHC=0) @IOF W !!!!!!!!?20,"TYPE THE PATIENT'S HRN, NAME, SSN OR DOB" S DIC("A")=" Patient: "
S AMHPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
I Y<0 K AMHC Q
S AMHPAT=+Y
S X=AMHPAT D ^AMHPEDIT I '$D(X) S AMHC=AMHC+1 G GETPAT1
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 G GETPAT
K AMHC
Q
DEL ;EP
I $$IINTAKE^AMHLEDEL(AMHR) W !!,"This visit has an Initial Intake with Updates, it can not be deleted",!,"until the update documents have been deleted." D PAUSE Q
S AMHVDLT=$P(^AMHREC(AMHR,0),U,16)
S AMHRDEL=AMHR
D EN^AMHLEDEL
W !,"Record deleted." D PAUSE
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
W:AMHACTN'=1 !
W !,"Update, add or append any of the following data"
W !!,?5,"1). Update any of the following information:"
W !,?10,"Designated Providers, Patient Flag"
W !,?5,"2). Patient Case Open/Admit/Closed Data"
W !,?5,"3). Personal History Information"
W !?5,"4). Appointments (Scheduling System)"
W !?5,"5). Treatment Plan Update"
W !?5,"6). Print an Encounter Form"
W !?5,"7). Add/Update/Print Intake Document"
W !?5,"8). Add/Update Suicide Forms"
W !,?5,"9). Problem List Update"
W !?5,"10). None of the Above (Quit)"
Q
W:$D(IOF) @IOF
W !,AMHDASH
W !,"Date of Service: ",$$FTIME^VALM1(AMHDATE),!,AMHDASH
Q
PCCLINK ;EP -PCC LINK
D PCCLINK^AMHLE2
Q
;
EXIT ;CLEAN UP AND EXIT
D TERM^VALM0
S VALMBCK="R"
D GATHER^AMHLEL
S VALMCNT=AMHRCNT
D HDR^AMHLE
K AMHV,AMHF,AMHDR,AMHR,AMHQUIT,AMHRDEL,AMHV,AMHVDLT,AMHNAME,AMHPTSV,AMHX,AMHERROR,AMHR0,APCDPKG,APCDV,AMHNONE,AMHOKAY,AMHOTH,AMHSHIGH
K X,Y,Z,I
Q
1 ;EP
D CLEAR^VALM1
D FULL^VALM1
I '$D(^AMHPATR(AMHPAT)) S DIC="^AMHPATR(",DIC(0)="L",DLAYGO=9002011.55,X="`"_AMHPAT D ^DIC I Y=-1 D ^XBFMK W !!,"FAILED TO ADD PATIENT TO BH PATIENT DATA FILE" Q
S DA=AMHPAT,DDSFILE=9002011.55,DR="[AMH PATIENT RELATED DATA]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
Q
2 ;
D EP^AMHLCD
D FULL^VALM1
Q
3 ;
D PHX^AMHLE3
Q
6 ;print encounter form
I $G(AMHR) S %=AMHR,%1=$G(AMHPAT) D EN^XBNEW("PEF^AMHLE3","%;%1") Q
S AMHNOLOG=1
D ^AMHLEFP
K AMHNOLOG
Q
4 ;scheduling system
D APPT^AMHVRL2(AMHPAT)
Q
5 ;treatment Plan
D EP1^AMHLETP(AMHPAT)
Q
7 ;intake
I $G(AMHR),$P(^AMHREC(AMHR,0),U,8)="" W !!,"This is not a patient related encounter. Use ID to update an Intake document." D PAUSE^AMHLEA Q
I $G(AMHR) D
.I $P(^AMHREC(AMHR,0),U,34) W !!,"You cannot add/update an intake on a visit created in a group.",! D PAUSE^AMHLEA Q
.D EP1^AMHLEIV(AMHR,AMHPAT)
Q
8 ;suicide forms
I $G(AMHR),$P(^AMHREC(AMHR,0),U,8)="" W !!,"This is not a patient related encounter. Use SFR to update suicide forms." D PAUSE^AMHLEA Q
I $G(AMHR) D
.I $P(^AMHREC(AMHR,0),U,34) W !!,"You cannot add/update a suicide form on a visit created in a group.",! D PAUSE^AMHLEA Q
.S DFN=$P(^AMHREC(AMHR,0),U,8) D EN^AMHLESF
.Q
Q
9 ;problem list
D START^AMHBPL(AMHR)
Q
CHECK ;EP
S AMHZDEL=0,AMHZED=0
S AMHOKAY=0 D RECCHECK^AMHLE2 Q:'AMHOKAY
W !!,"Incomplete record!!"
S DIR(0)="Y",DIR("A")="Do you wish to edit this record",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I Y S AMHZED=1 Q
Q:$G(AMHACTN)'=1
W !!,"Deleting record." D DEL
S AMHZDEL=1
Q
AMHLEA ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,8**;JUN 02, 2010;Build 7
+2 ;
+3 ;add new records
+4 ;get all items for a record, check record, file record
+5 ;if not complete record, issue warning and delete record
ADDR ;EP
+1 DO FULL^VALM1
+2 IF '$DATA(AMHDATE)
WRITE !!,"Date not entered."
HANG 5
QUIT
+3 SET AMHQUIT=0
SET AMHACTN=1
+4 IF '$GET(AMHADPTV)
KILL AMHPAT
+5 IF AMHDET="S"
DO ADDSCR
QUIT
+6 ;I $G(AMHADPTV) D GETVTYP
+7 ;I '$G(AMHADPTV) S AMHVTYPE="R"
+8 SET AMHVTYPE="R"
+9 ;I AMHVTYPE="B" S AMHVTYPE="R"
+10 ;I AMHVTYPE="" K AMHVTYPE W !,"Visit type is required!" G EXIT
+11 ;I AMHVTYPE="C" D IC^AMHLEIC D EXIT Q
+12 ;I AMHVTYPE="N" D NS^AMHLENS1 D EXIT Q
+13 DO HEADER
+14 SET APCDOVRR=""
+15 IF '$DATA(AMHPATCE)
KILL AMHPAT
+16 WRITE !,"Creating new record..."
KILL DD,D0,DO,DINUM,DIC,DA,DR
SET DIC(0)="EL"
SET DIC="^AMHREC("
SET DLAYGO=9002011
SET DIADD=1
SET X=AMHDATE
SET DIC("DR")="1111////1"
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+17 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!! Deleting Record.",!
DO PAUSE
QUIT
+18 SET AMHR=+Y
SET DIE="^AMHREC("
SET DA=AMHR
SET DR="5100///NOW"
SET DR(2,9002011.5101)=".02////^S X=DUZ"
DO ^DIE
KILL DIE,DA,DR
+19 SET DA=AMHR
SET DIE="^AMHREC("
SET DR=$SELECT(AMHVTYPE="A":"[AMHASA ADD RECORD]",$GET(AMHADPTV):"[AMH ADD RECORD]",1:"[AMH ADD NON-PATIENT RECORD]")
DO CALLDIE^AMHLEIN
+20 IF $DATA(Y)!('$DATA(^AMHRPROV("AD",AMHR)))
WRITE !!,"Incomplete record!! Deleting record!!"
DO DEL
GOTO EXIT
+21 DO ^AMHLEPOV
+22 IF '$DATA(^AMHRPRO("AD",AMHR))!('$DATA(^AMHRPROV("AD",AMHR)))
WRITE !!,"Incomplete record!! Deleting record!!"
DO DEL
GOTO EXIT
+23 SET DA=AMHR
SET DIE="^AMHREC("
SET DR=$SELECT(AMHVTYPE="A":"[AMH ADD RECORD 2 ASA]",1:"[AMH ADD RECORD 2]")
DO CALLDIE^AMHLEIN
+24 IF $DATA(Y)
WRITE !!,"Incomplete record!! Deleting record!!"
DO DEL
GOTO EXIT
+25 SET AMHOKAY=0
DO RECCHECK^AMHLE2
IF AMHOKAY
WRITE !,"Incomplete record!! Deleting record!!"
DO DEL
GOTO EXIT
+26 WRITE !
SET DIE="^AMHREC("
SET DR="8101"
SET DA=AMHR
DO CALLDIE^AMHLEIN
+27 IF $GET(AMHADPTV)
IF AMHVTYPE="R"
DO REGULAR^AMHLEP2
+28 ;I $P(^AMHREC(AMHR,0),U,2)="C"!($P($G(^AMHREC(AMHR,91)),U)="Y") D CDST
+29 IF $PIECE(^AMHREC(AMHR,0),U,8)]""
DO SUIC
DO OTHER
+30 IF $PIECE(^AMHREC(AMHR,0),U,8)
DO ESIG^AMHESIG(AMHR)
+31 DO PCCLINK
+32 DO EXIT
+33 QUIT
ADDNS ;EP
+1 DO FULL^VALM1
+2 IF '$DATA(AMHDATE)
WRITE !!,"Date not entered."
HANG 5
QUIT
+3 SET AMHQUIT=0
SET AMHACTN=1
+4 SET APCDOVRR=1
+5 DO ADDR^AMHLENS
+6 DO EXIT
+7 QUIT
ADDSCR ;screenman mode
+1 SET APCDOVRR=""
+2 IF '$DATA(AMHPATCE)
KILL AMHPAT
+3 DO FULL^VALM1
+4 IF '$DATA(AMHDATE)
WRITE !!,"Date not entered."
HANG 5
QUIT
+5 SET AMHQUIT=0
SET AMHACTN=1
+6 ;I $G(AMHADPTV) D GETVTYP
+7 ;I '$G(AMHADPTV) S AMHVTYPE="R"
+8 ;I AMHVTYPE="" K AMHVTYPE W !,"Visit type is required!" G EXIT
+9 ;I AMHVTYPE="N" D ADDR^AMHLENS D EXIT Q
+10 SET AMHVTYPE="R"
+11 KILL DIC
SET DIC(0)="EL"
SET DIC="^AMHREC("
SET DLAYGO=9002011
SET DIADD=1
SET X=AMHDATE
SET DIC("DR")=".02///"_AMHPTYPE_";.03///^S X=DT;.19////"_DUZ_";.33////"_AMHVTYPE_";.28////"_DUZ_";.22///A;.21///^S X=DT"_";1111////1"
+12 KILL DD,DO,D0
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+13 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!! Deleting Record.",!
DO PAUSE
QUIT
+14 ;update multiple of user last update/date edited
+15 SET AMHR=+Y
+16 SET DIE="^AMHREC("
SET DA=AMHR
SET DR="5100///NOW"
SET DR(2,9002011.5101)=".02////^S X=DUZ"
DO ^DIE
KILL DIE,DA,DR
+17 IF $GET(AMHADPTV)=1
IF '$DATA(AMHPATCE)
DO GETPAT
IF '$GET(AMHPAT)
DO DEL
DO EXIT
IF '$GET(AMHPAT)
QUIT
SET DA=AMHR
SET DR=".08////"_AMHPAT
SET DIE="^AMHREC("
DO CALLDIE^AMHLEIN
+18 SET DA=AMHR
SET DIE="^AMHREC("
+19 SET DR=".02///"_AMHPTYPE_$SELECT($$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE):";.04///`"_$$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE),1:"")_$SELECT($$GETCOMM^AMHLEIN(DUZ(2),AMHPTYPE):";.05///`"_$$GETCOMM^AMHLEIN(DUZ(2),AMHPTYPE),1:"")_";1117////"_$$HL^AMHUTIL2(AMHPT
YPE)
+20 SET DR=DR_$SELECT($$GETCLN^AMHLEIN(DUZ(2),AMHPTYPE):";.25///`"_$$GETCLN^AMHLEIN(DUZ(2),AMHPTYPE),1:"")
+21 SET DR=DR_";.11///"_$$GETAWI^AMHLEIN(DUZ(2))_$SELECT($$GETTOC^AMHLEIN(DUZ(2)):";.07///`"_$$GETTOC^AMHLEIN(DUZ(2)),1:"")
+22 DO ^DIE
IF $DATA(Y)
WRITE !!,"Error updating record......"
HANG 5
+23 KILL DR,DA,DIE
+24 DO GETPROV
IF '$$PPINT^AMHUTIL(AMHR)
WRITE !,"No PRIMARY PROVIDER entered!! - Required element"
DO DEL
DO EXIT
QUIT
+25 ;
ADD1 ;
+1 IF AMHVTYPE="R"
SET DA=AMHR
SET DDSFILE=9002011
SET DR=$SELECT($GET(AMHADPTV):"[AMH ADD RECORD]",1:"[AMH ADD NON-PAT RECORD]")
DO ^DDS
+2 ;I AMHVTYPE="A" S DA=AMHR,DDSFILE=9002011,DR="[AMHASA ADD RECORD]" D ^DDS
+3 ;I AMHVTYPE="B" S AMHVTYPE="R",DA=AMHR,DDSFILE=9002011,DR=$S($G(AMHADPTV):"[AMHB ADD RECORD]",1:"[AMH ADD NON-PAT RECORD]") D ^DDS
+4 ;I AMHVTYPE="I"!(AMHVTYPE="P") S DA=AMHR,DDSFILE=9002011,DR="[AMHVT ADD RECORD]" D ^DDS
+5 ;I AMHVTYPE="C" S DA=AMHR,DDSFILE=9002011,DR="[AMH ADD CASE TRACKING REC]" D ^DDS
+6 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET AMHQUIT=1
KILL DIMSG
QUIT
+7 ;IHS/CMI/LAB - PATCH 8 Hosp location
SET DA=AMHR
SET DIE="^AMHREC("
SET DR="1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02))
DO ^DIE
KILL DA,DR,DIE
+8 ;CHECK RECORD
+9 DO CHECK
+10 IF AMHZDEL
DO EXIT
QUIT
+11 IF AMHZED
GOTO ADD1
+12 ;I $G(AMHADPTV),(AMHVTYPE="I"!(AMHVTYPE="P")) D INTAKE^AMHLEP4
+13 IF $GET(AMHADPTV)
IF AMHVTYPE="R"
DO REGULAR^AMHLEP2
+14 ;I $G(AMHADPTV),AMHVTYPE="C" D REGULAR^AMHLEP2
+15 IF $GET(AMHERROR)
WRITE !!,$CHAR(7),$CHAR(7),"PLEASE EDIT THIS RECORD!!",!!
+16 ;I $P(^AMHREC(AMHR,0),U,2)="C"!($P($G(^AMHREC(AMHR,91)),U)="Y") D CDST
+17 IF $GET(AMHADPTV)
DO SUIC
DO OTHER
+18 IF $GET(AMHADPTV)
DO PCCLINK
+19 ;I '$G(AMHADPTV) D ESIG^AMHESIG(AMHR)
+20 DO EXIT
+21 QUIT
+22 ;
INDS(R) ;is this a initial or a discharge
+1 IF '$GET(R)
QUIT 0
+2 IF $PIECE(^AMHREC(R,0),U,32)]""
QUIT 1
+3 QUIT 0
PRIMPROB(R) ;EP
+1 IF '$GET(R)
QUIT ""
+2 NEW X
SET X=$ORDER(^AMHRPRO("AD",R,0))
+3 IF 'X
QUIT ""
+4 QUIT $PIECE(^AMHRPRO(X,0),U)
GETVTYP ;
+1 IF AMHDET="S"
SET DIR(0)="S^R:Regular Visit;B:Abbreviated Version of Regular Visit;C:Info/Contact;N:No Show;A:A/SA Encounter"
+2 IF AMHDET="R"
SET DIR(0)="S^R:Regular Visit;C:Info/Contact;N:No Show;A:A/SA Encounter"
+3 SET DIR("A")="Enter Visit Type"
SET DIR("B")="R"
KILL DA
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
SET AMHVTYPE=""
QUIT
+6 SET AMHVTYPE=Y
SET AMHVT=Y(0)
+7 QUIT
CDST ;EP
+1 ;create record in CDMIS Staging file
+2 ;I '$$INDS(AMHR),$D(^AMHRCDST("B",AMHR)) D CDSTDEL Q
+3 IF $PIECE($GET(^AMHREC(AMHR,91)),U)'="Y"
QUIT
+4 IF $DATA(^AMHRCDST("B",AMHR))
WRITE !!,"There is already a initial/discharge entry for this visit.",!,"Editing existing data...."
HANG 2
SET AMHCDR=$ORDER(^AMHRCDST("B",AMHR,0))
GOTO CDST1
+5 WRITE !!,"Creating Initial Chemical Dependency data record..."
HANG 1
+6 DO ^XBFMK
SET DIC="^AMHRCDST("
SET DIC(0)="AEMQ"
SET DIADD=1
SET DLAYGO=9002011.06
SET X=AMHR
KILL DD,DO
DO FILE^DICN
KILL DIADD,DLAYGO,DD,DO,D0,DIC
+7 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Notify supervisor....error in creating Initial Staging record.."
DO PAUSE
QUIT
+8 SET AMHCDR=+Y
CDST1 KILL DIADD,DLAYGO
DO ^XBFMK
+1 SET DA=AMHCDR
SET DIE="^AMHRCDST("
SET DR=".02////"_AMHPAT_";.03////"_$$PRIMPROB(AMHR)_";.04////"_DT_";.05////"_DUZ_";.19////"_$PIECE(^AMHREC(AMHR,0),U,32)
DO ^DIE
+2 IF $DATA(Y)
WRITE !!,$CHAR(7),$CHAR(7),"Notify supervisor....error in creating Initial Staging record.."
DO PAUSE
DO ^XBFMK
QUIT
+3 SET DA=AMHCDR
SET DDSFILE=9002011.06
SET DR="[AMH ENTER/EDIT STAGING TOOL]"
DO ^DDS
+4 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET AMHQUIT=1
KILL DIMSG
QUIT
+5 DO ^XBFMK
+6 QUIT
CDSTDEL ;
+1 WRITE !!,"There is a staging tool entry for this visit and this visit",!,"is not an INITIAL, REOPEN, TRAN/DISC/CLOSE or FOLLOW UP.",!
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to delete this staging tool entry"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF 'Y
QUIT
+5 SET DA=$ORDER(^AMHRCDST("B",AMHR,0))
SET DIK="^AMHRCDST("
DO ^DIK
+6 QUIT
SUIC ;EP - is this a suicide visit? IF so, pop into suicide form
+1 IF '$GET(AMHPAT)
QUIT
+2 NEW X,G,Y
SET (X,Y,G)=0
FOR
SET X=$ORDER(^AMHRPRO("AD",AMHR,X))
IF X'=+X
QUIT
SET Y=$PIECE(^AMHRPRO(X,0),U)
SET Y=$PIECE(^AMHPROB(Y,0),U)
IF Y=39!(Y=40)!(Y=41)!(Y="V62.84")
SET G=1
+3 IF 'G
QUIT
+4 WRITE !!,"You have entered a diagnosis relating to Suicide. ",!
+5 WRITE !,"IHS Suicide Forms should be filled out for all Suicide Ideations with Plan",!,"and Intent, for all Suicide Attempts and for all Completed Suicides.",!
+6 SET DIR(0)="Y"
SET DIR("A")="Would you like to add/review the IHS Suicide forms for this patient"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF 'Y
QUIT
+9 SET (DFN,AMHLEAP)=AMHPAT
+10 ;D EN^XBNEW("EN^AMHLESF","DFN;AMHPAT")
+11 DO EN^AMHLESF
+12 SET AMHPAT=AMHLEAP
+13 SET DFN=AMHLEAP
+14 QUIT
OTHER ;EP - collect other data if patient related
+1 SET AMHFIRST=0
+2 DO FULL^VALM1
OTHERN ;
+1 IF AMHFIRST
GOTO OTHERO
+2 KILL AMHXX
+3 SET AMHANS=""
+4 SET AMHXX=$$ESIG^AMHESIG(AMHR)
+5 IF '$GET(AMHXX)
Begin DoDot:1
+6 WRITE !!,$PIECE(AMHXX,U,3),!
+7 IF '$PIECE(AMHXX,U,4)
DO PAUSE
QUIT
+8 SET DIR(0)="Y"
SET DIR("A")="Do you wish to enter a SOAP/Progress Note"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
QUIT
+10 SET AMHANS=Y
IF 'Y
QUIT
+11 SET DIE="^AMHREC("
SET DR=3101
SET DA=AMHR
DO ^DIE
KILL DA,DIE,DR
End DoDot:1
IF $PIECE(AMHXX,U,4)
IF AMHANS
GOTO OTHER
+12 IF AMHXX
DO ESIGGFI^AMHESIG(AMHR)
+13 SET AMHFIRST=AMHFIRST+1
OTHERO ;
+1 WRITE @IOF,!!!?20,"******* OTHER INFORMATION *******",!!
+2 DO RMENU
+3 ;S:$D(DUOUT) DIRUT=1
SET DIR("B")=10
SET DIR(0)="NO^1:10"
SET DIR("A")="Choose one of the above"
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y=10
QUIT
+6 SET AMHSELE=+Y
DO OTHER1
+7 GOTO OTHERN
OTHER1 ;
+1 IF AMHSELE'=6
IF '$GET(AMHPAT)
WRITE $CHAR(7),"You MUST Identify the Patient first!!"
SET AMHPAT=""
DO GETPAT
IF 'AMHPAT
QUIT
+2 WRITE !
+3 DO @AMHSELE
+4 QUIT
GETPROV ;get providers
+1 IF '$GET(AMHADPTV)
IF $DATA(IOF)
WRITE @IOF
WRITE !!!!!!!
+2 IF '$TEST
WRITE !!!
+3 KILL DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR("B")=$PIECE(^VA(200,DUZ,0),U)
SET DIR(0)="9002011.02,.01O"
SET DIR("A")=" Enter PRIMARY PROVIDER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y=""
QUIT
+6 SET X=+Y
SET DIC("DR")=".02////"_$GET(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY"
SET DIC="^AMHRPROV("
SET DIC(0)="MLQ"
SET DIADD=1
SET DLAYGO=9002011.02
KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
+7 IF Y=-1
WRITE !!,"Creating Primary Provider entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+8 QUIT
GETPAT ;EP
+1 DO ^XBFMK
+2 SET AMHC=0
GETPAT1 IF $GET(AMHDET)="S"
IF $DATA(IOF)&(AMHC=0)
WRITE @IOF
WRITE !!!!!!!!?20,"TYPE THE PATIENT'S HRN, NAME, SSN OR DOB"
SET DIC("A")=" Patient: "
+1 SET AMHPAT=""
+2 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DLAYGO,DIADD
+3 IF Y<0
KILL AMHC
QUIT
+4 SET AMHPAT=+Y
+5 SET X=AMHPAT
DO ^AMHPEDIT
IF '$DATA(X)
SET AMHC=AMHC+1
GOTO GETPAT1
+6 WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
SET AMHPAT=""
KILL AMHC
QUIT
+7 IF AMHPAT
IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)
DO NALLOWP^AMHUTIL
DO PAUSE
GOTO GETPAT
+8 KILL AMHC
+9 QUIT
DEL ;EP
+1 IF $$IINTAKE^AMHLEDEL(AMHR)
WRITE !!,"This visit has an Initial Intake with Updates, it can not be deleted",!,"until the update documents have been deleted."
DO PAUSE
QUIT
+2 SET AMHVDLT=$PIECE(^AMHREC(AMHR,0),U,16)
+3 SET AMHRDEL=AMHR
+4 DO EN^AMHLEDEL
+5 WRITE !,"Record deleted."
DO PAUSE
+6 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 AMHACTN'=1
WRITE !
+2 WRITE !,"Update, add or append any of the following data"
+3 WRITE !!,?5,"1). Update any of the following information:"
+4 WRITE !,?10,"Designated Providers, Patient Flag"
+5 WRITE !,?5,"2). Patient Case Open/Admit/Closed Data"
+6 WRITE !,?5,"3). Personal History Information"
+7 WRITE !?5,"4). Appointments (Scheduling System)"
+8 WRITE !?5,"5). Treatment Plan Update"
+9 WRITE !?5,"6). Print an Encounter Form"
+10 WRITE !?5,"7). Add/Update/Print Intake Document"
+11 WRITE !?5,"8). Add/Update Suicide Forms"
+12 WRITE !,?5,"9). Problem List Update"
+13 WRITE !?5,"10). None of the Above (Quit)"
+14 QUIT
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,AMHDASH
+3 WRITE !,"Date of Service: ",$$FTIME^VALM1(AMHDATE),!,AMHDASH
+4 QUIT
PCCLINK ;EP -PCC LINK
+1 DO PCCLINK^AMHLE2
+2 QUIT
+3 ;
EXIT ;CLEAN UP AND EXIT
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO GATHER^AMHLEL
+4 SET VALMCNT=AMHRCNT
+5 DO HDR^AMHLE
+6 KILL AMHV,AMHF,AMHDR,AMHR,AMHQUIT,AMHRDEL,AMHV,AMHVDLT,AMHNAME,AMHPTSV,AMHX,AMHERROR,AMHR0,APCDPKG,APCDV,AMHNONE,AMHOKAY,AMHOTH,AMHSHIGH
+7 KILL X,Y,Z,I
+8 QUIT
1 ;EP
+1 DO CLEAR^VALM1
+2 DO FULL^VALM1
+3 IF '$DATA(^AMHPATR(AMHPAT))
SET DIC="^AMHPATR("
SET DIC(0)="L"
SET DLAYGO=9002011.55
SET X="`"_AMHPAT
DO ^DIC
IF Y=-1
DO ^XBFMK
WRITE !!,"FAILED TO ADD PATIENT TO BH PATIENT DATA FILE"
QUIT
+4 SET DA=AMHPAT
SET DDSFILE=9002011.55
SET DR="[AMH PATIENT RELATED DATA]"
DO ^DDS
+5 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET AMHQUIT=1
KILL DIMSG
QUIT
+6 QUIT
2 ;
+1 DO EP^AMHLCD
+2 DO FULL^VALM1
+3 QUIT
3 ;
+1 DO PHX^AMHLE3
+2 QUIT
6 ;print encounter form
+1 IF $GET(AMHR)
SET %=AMHR
SET %1=$GET(AMHPAT)
DO EN^XBNEW("PEF^AMHLE3","%;%1")
QUIT
+2 SET AMHNOLOG=1
+3 DO ^AMHLEFP
+4 KILL AMHNOLOG
+5 QUIT
4 ;scheduling system
+1 DO APPT^AMHVRL2(AMHPAT)
+2 QUIT
5 ;treatment Plan
+1 DO EP1^AMHLETP(AMHPAT)
+2 QUIT
7 ;intake
+1 IF $GET(AMHR)
IF $PIECE(^AMHREC(AMHR,0),U,8)=""
WRITE !!,"This is not a patient related encounter. Use ID to update an Intake document."
DO PAUSE^AMHLEA
QUIT
+2 IF $GET(AMHR)
Begin DoDot:1
+3 IF $PIECE(^AMHREC(AMHR,0),U,34)
WRITE !!,"You cannot add/update an intake on a visit created in a group.",!
DO PAUSE^AMHLEA
QUIT
+4 DO EP1^AMHLEIV(AMHR,AMHPAT)
End DoDot:1
+5 QUIT
8 ;suicide forms
+1 IF $GET(AMHR)
IF $PIECE(^AMHREC(AMHR,0),U,8)=""
WRITE !!,"This is not a patient related encounter. Use SFR to update suicide forms."
DO PAUSE^AMHLEA
QUIT
+2 IF $GET(AMHR)
Begin DoDot:1
+3 IF $PIECE(^AMHREC(AMHR,0),U,34)
WRITE !!,"You cannot add/update a suicide form on a visit created in a group.",!
DO PAUSE^AMHLEA
QUIT
+4 SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)
DO EN^AMHLESF
+5 QUIT
End DoDot:1
+6 QUIT
9 ;problem list
+1 DO START^AMHBPL(AMHR)
+2 QUIT
CHECK ;EP
+1 SET AMHZDEL=0
SET AMHZED=0
+2 SET AMHOKAY=0
DO RECCHECK^AMHLE2
IF 'AMHOKAY
QUIT
+3 WRITE !!,"Incomplete record!!"
+4 SET DIR(0)="Y"
SET DIR("A")="Do you wish to edit this record"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+5 IF Y
SET AMHZED=1
QUIT
+6 IF $GET(AMHACTN)'=1
QUIT
+7 WRITE !!,"Deleting record."
DO DEL
+8 SET AMHZDEL=1
+9 QUIT
