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

AMHLE2.m

Go to the documentation of this file. 
  1. AMHLE2 ; IHS/CMI/LAB - DE CONT. ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1,4**;JUN 18, 2010;Build 28
  1.  ;
  1.  ;
  1. RECCHECK ;EP - check record for completeness
  1.  I '$D(^AMHREC(AMHR,0)) Q
  1.  S AMHREC=$G(^AMHREC(AMHR,0))
  1.  S (AMHERROR,AMHOKAY)=0
  1.  I $P(AMHREC,U,4)="" W !,"Location of Encounter Missing!" S (AMHOKAY,AMHERROR)=1
  1.  I $P(AMHREC,U,5)="" W !,"Community of Service Missing!" S (AMHOKAY,AMHERROR)=1
  1.  I $P(AMHREC,U,6)="" W !,"Activity Type Missing!" S (AMHOKAY,AMHERROR)=1
  1.  I $P(AMHREC,U,7)="" W !,"Type of Contact Missing!" S (AMHOKAY,AMHERROR)=1
  1.  S (X,Y)=0 F  S X=$O(^AMHRPROV("AD",AMHR,X)) Q:X'=+X  I $P(^AMHRPROV(X,0),U,4)="P" S Y=Y+1
  1.  I Y=0 W !,"No primary Provider!" S (AMHOKAY,AMHERROR)=1  ;,$C(7),$C(7) S AMHERROR=1 H 2
  1.  I Y>1 W !,"Multiple Primary Providers!" S (AMHOKAY,AMHERROR)=1  ;,$C(7),$C(7) W:'$G(AMHERROR) " PLEASE EDIT THIS RECORD" H 2
  1.  I '$D(^AMHRPRO("AD",AMHR)) W !,"No POV entered!!" S (AMHOKAY,AMHERROR)=1  ;,$C(7) W:'$G(AMHERROR) "  PLEASE EDIT THIS RECORD" H 2 Q
  1.  ;IF PAT ACTIVITY AND PATIENT MISSING - ERROR
  1.  I $P(AMHREC,U,12)="" W !,"Activity Time Missing!" S (AMHOKAY,AMHERROR)=1 ;W $C(7) S AMHERROR=1 H 2
  1.  I $G(AMHERROR) W !!,"Please EDIT this record." D PAUSE^AMHLEA
  1.  I AMHACTN=2&($P(^AMHREC(AMHR,0),U,8)="") D DELPT
  1.  Q
  1. DELPT ;delete .02 field of all record entries if not patient related
  1.  S AMHVFLE=9002011 F AMHVL=0:0 S AMHVFLE=$O(^DIC(AMHVFLE)) Q:AMHVFLE>9002011.49  D
  1.  .S AMHVDG=^DIC(AMHVFLE,0,"GL"),AMHVIGR=AMHVDG_"""AD"",AMHR,AMHVDFN)"
  1.  .S AMHVDFN="" F AMHVI=1:1 S AMHVDFN=$O(@AMHVIGR) Q:AMHVDFN=""  S AMHVIGL=AMHVDG_AMHVDFN_",0)" W:'$D(ZTQUEUED) "." I $P((@AMHVIGL),U,2)]"" S DA=AMHVDFN,DITC="",DR=".02///@",DIE=AMHVDG D CALLDIE^AMHLEIN
  1.  Q
  1. EP1(AMHPAT) ;EP called from protocol
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1.  S AMHDATE=DT
  1.  S AMHLOC=DUZ(2)
  1.  ;D EN^XBNEW("MHPL^AMHLE2","AMH*")
  1.  D MHPL^AMHLE2
  1.  Q
  1. EP ;EP = CALLED FROM SCREENMAN
  1.  W:$D(IOF) @IOF
  1.  D EN^XBNEW("MHPL^AMHLE2","AMH*")
  1.  Q
  1. MHPL ;EP - update mh/ss problem list
  1.  S APCDOVRR=""
  1.  K AMHX,AMHJ,AMHTEXT
  1.  I $G(AMHLOC)="" S AMHLOC=DUZ(2)
  1.  W !!,"Behavioral Health Patient Diagnosis List Update Menu",!
  1.  F AMHJ=1:1:11 S AMHX=$P($T(PROBMENU+AMHJ),";;",2) W !?11,AMHJ,")  ",AMHX
  1.  K AMHX,AMHJ,AMHTEXT
  1.  S DIR(0)="N^1:11:0",DIR("A")="Choose One",DIR("B")="11" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q:$D(DIRUT)
  1.  Q:Y=11
  1.  S AMHPLC=Y
  1.  I '$G(AMHAUTH),$G(AMHR) S AMHAUTH=$$PPNAME^AMHUTIL(AMHR)
  1.  I '$G(AMHAUTH) S AMHAUTH=$P(^VA(200,DUZ,0),U)
  1.  I AMHPLC=10 S DFN=AMHPAT D EN1^AMHPL Q
  1.  S DIE="^AUPNPAT(",DR="["_$P($T(PROBMENU+AMHPLC),";;",3)_"]",DA=AMHPAT,DIE("NO^")="" D CALLDIE^AMHLEIN K DR,DA,DIE
  1.  I $D(Y) W !!,"Error encountered in updating BH Diagnosis List for ",$P(^DPT(AMHPAT,0),U)
  1.  K Y,X,DIU,DIV
  1.  G MHPL
  1.  K X
  1.  I AMHACTN=4 G PCCLINK2
  1.  I '$D(^AMHREC(AMHR,0)) G PCCLINK2
  1.  I $G(AMHVDLT) G PCCLINK2
  1.  Q:'$P(^AMHREC(AMHR,0),U,8)  ;no pcc if not a patient encounter
  1.  S X=$$ESIG^AMHESIG(AMHR)
  1.  I '$P(X,U,2),AMHLPCC W !!,"No PCC Link...Note not signed." D PAUSE^AMHLEA Q
  1. PCCLINK1 ;
  1.  I 'AMHLPCC Q:'$$PRVLINK($$PPINT^AMHUTIL(AMHR))  ;quit if no pcc link
  1. PCCLINK2 ;
  1.  I $G(AMHVDLT)="",AMHACTN=4 Q
  1.  I $G(AMHVDLT),AMHACTN=4 D TASK Q
  1.  D VISIT
  1.  I 'AMHVISIT,$P(^AMHREC(AMHR,0),U,16)]"" D  Q
  1.  .S APCDVDLT=$P(^AMHREC(AMHR,0),U,16) D ^APCDVDLT
  1.  .S DIE="^AMHREC(",DA=AMHR,DR=".16///@" D CALLDIE^AMHLEIN
  1.  Q:AMHVISIT
  1.  Q
  1.  I '$G(P) Q 0
  1.  I '$D(^AMHSITE(DUZ(2),11,"B",P)) Q 0
  1.  NEW A
  1.  S A=$O(^AMHSITE(DUZ(2),11,"B",P,0))
  1.  I 'A Q 0
  1.  I $P(^AMHSITE(DUZ(2),11,A,0),U,1)=1 Q 0
  1.  Q 1
  1.  ;
  1. VISIT ;
  1.  K AMHDNKA
  1.  S AMHVISIT=0
  1.  Q:'$G(AMHR)
  1.  Q:'$P(^AMHREC(AMHR,0),U,8)  ;no pcc if not a patient encounter
  1.  ;do not pass residential type of visits to pcc
  1.  I $$VAL^XBDIQ1(9002011,AMHR,.07)="RESIDENTIAL" Q  ;if one record a day, don't want in PCC
  1.  ;do not pass visits with dnka problem code
  1.  ;check for at least one pov that is icd9 codable
  1.  S (AMHX,AMHGOT,AMHDNKA)=0 F  S AMHX=$O(^AMHRPRO("AD",AMHR,AMHX)) Q:AMHX'=+AMHX  D
  1.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8 S AMHDNKA=1 Q  ;do not pass dnka
  1.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.1 S AMHDNKA=1 Q  ;do not pass dnka
  1.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.11 S AMHDNKA=1 Q  ;do not pass dnka
  1.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.2 S AMHDNKA=1 Q  ;do not pass dnka
  1.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.21 S AMHDNKA=1 Q  ;do not pass dnka
  1.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.3 S AMHDNKA=1 Q  ;do not pass dnka
  1.  .S AMHIMP=$$IMP^AMHUTIL2($P($P(^AMHREC(AMHR,0),U,1),".",1))
  1.  .I AMHIMP=1,$P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U,5)]"" S AMHGOT=1
  1.  .I AMHIMP=30,$P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U,17)]"" S AMHGOT=1
  1.  .Q
  1.  Q:AMHDNKA
  1.  Q:$P(^AMHREC(AMHR,0),U,6)=""
  1.  Q:'AMHGOT
  1.  Q:'$P(^AMHTACT($P(^AMHREC(AMHR,0),U,6),0),U,4)  ;quit if not an activity that gets passed to PCC
  1. TASK ;
  1.  ;*****************************
  1.  I AMHACTN=4 G TASK1
  1.  I '$G(AMHIAIG),$$ESIG^AMHESIG(AMHR),$P($G(^AMHREC(AMHR,11)),U,12)="" D  Q  ;no esig
  1.  .W !!,"There is no electronic signature, this visit will not be passed to PCC." D PAUSE^AMHLEA
  1. TASK1 ;
  1.  D START^AMHPCCL S AMHVISIT=1 Q  ;************ FOR TESTING IN FOREGROUND
  1.  Q
  1.  ;
  1. PROBMENU ;;
  1.  ;;Add a Problem to BH Diagnosis List;;AMH ADD PROBLEM
  1.  ;;Modify a Problem on BH Diagnosis List;;AMH MODIFY PROBLEM
  1.  ;;Remove a Problem from BH Diagnosis List;;AMH REMOVE PROBLEM
  1.  ;;Inactivate an Active Problem on BH Diagnosis List;;AMH INACTIVATE PROBLEM
  1.  ;;Activate an Inactive Problem on BH Diagnosis List;;AMH ACTIVATE PROBLEM
  1.  ;;Add a Treatment Note to a BH Problem;;AMH ADD NOTE
  1.  ;;Modify a Treatment Note of BH Problem;;AMH MODIFY NOTE
  1.  ;;Remove a Treatment Note to BH Problem;;AMH REMOVE NOTE
  1.  ;;Display Patient's BH Diagnosis List;;AMH DISPLAY PROBLEM LIST
  1.  ;;Update the Patient's PCC Problem List
  1.  ;;Quit