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

AMHBHRU.m

Go to the documentation of this file. 
  1. AMHBHRU ; IHS/CMI/LAB - GUI V FILE VISIT CREATION ; 16 Dec 2010  11:54 AM
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1,5**;JUN 02, 2010;Build 18
  1.  ;;
  1. TEST ;
  1.  D EN(.RETVAL,24609)
  1.  Q
  1. EN(AMHARRAY,AMHR,AMHGUIV) ;EP CALL
  1.  ;N AMHZTQ
  1.  ;I $G(ZTQUEUED)]"" S AMHZTQ=ZTQUEUED
  1.  ;S ZTQUEUED=""  ;cmi/anch/maw 5/19/2009 removed causing errors when running face sheet after call to create visit
  1.  S AMHBL=1  ;cmi/maw 5/19/2009 since ZTQUEUED
  1.  S AMHERR=""
  1.  ;AMHR must be ien of MHSS RECORD that was added or updated
  1.  D
  1.  .D PRECHECK Q:AMHERR'=""
  1.  .D CHECKREC Q:AMHERR'=""
  1.  .D PCCLINK
  1.  I AMHERR="" D MSG("1") Q
  1.  I AMHERR'="" D ERROR(AMHERR)
  1.  D KILL
  1.  Q
  1.  ;
  1. CHECKREC ;
  1.  S AMHREC=^AMHREC(AMHR,0)
  1.  I $P($P(AMHREC,U,1),".")>DT S AMHERR="FUTURE VISIT DATE NOT ALLOWED!!!" Q
  1.  I $P(AMHREC,U,4)="" S AMHERR="LOCATION OF ENCOUNTER MISSING!" Q
  1.  I $P(AMHREC,U,5)="" S AMHERR="Community of Service Missing!" Q
  1.  I $P(AMHREC,U,6)="" S AMHERR="Activity Type Missing!" Q
  1.  I $P(AMHREC,U,7)="" S AMHERR="Type of Contact Missing!" Q
  1.  I $P(AMHREC,U,12)="" S AMHERR="Activity Time Missing!" Q
  1.  I $P(AMHREC,U,19)="" S AMHERR="Who entered record Missing!" Q
  1.  I $P(AMHREC,U,21)="" S AMHERR="Date Last Modified Missing!" Q
  1.  I $P(AMHREC,U,22)="" S AMHERR="Extract Flag Missing!" Q
  1.  I $P(AMHREC,U,28)="" S AMHERR="User Last Update Missing!" Q
  1.  S (X,Y,Z)=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 S AMHERR="No primary Provider!" Q  ;IHS/CMI/LAB - UNCOMMENT LORI! *****
  1.  I Y>1 S AMHERR="ERROR: Multiple Primary Providers!" Q
  1.  I '$D(^AMHRPRO("AD",AMHR)) S AMHERR="ERROR: No POV entered!!" Q
  1.  S (X,Y,Z)=0 F  S X=$O(^AMHRPRO("AD",AMHR,X)) Q:X'=+X  I $P(^AMHRPRO(X,0),U,4)="" S Z=1
  1.  I Z S AMHERR="No Provider Narrative on a POV!" Q
  1.  I $P(AMHREC,U,12)="" S AMHERR="ERROR:  Activity Time Missing!" Q
  1.  Q
  1.  D PCCCHECK
  1.  I 'AMHLPCC Q:'$$PRVLINK^AMHLE2($$PPINT^AMHUTIL(AMHR))  ;quit if no pcc link
  1.  S AMHPTYPE=$P(^AMHREC(AMHR,0),U,2)
  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.  ;
  1. PCCCHECK ;EP - check to see if link to pcc active, set AMHLPCC IF SO
  1.  K AMHLPCC
  1.  S (AMHLPCC,AMHLPCCT)=$P(^AMHSITE(DUZ(2),0),U,12) I AMHLPCC S AMHLPCC=AMHLPCC-1
  1.  I AMHLPCC="" S AMHLPCC=0 Q
  1.  Q:'AMHLPCC
  1.  I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",'$D(^APCCCTRL(DUZ(2),0))#2 S AMHLPCC=0 Q
  1.  S AMHPKG=$O(^DIC(9.4,"C","AMH",""))
  1.  I '$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2 S AMHLPCC=0 Q
  1.  I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",$D(^APCCCTRL(DUZ(2),0))#2,$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2,$P(^(0),U,2) S AMHLPCC=AMHLPCC
  1.  E  S AMHLPCC=0
  1.  K AMHPKG
  1.  Q
  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.  .I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U,5)]"" S AMHGOT=1
  1.  .I $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.  S AMHBL=1,AMHACTN=2
  1.  NEW AMHERR D START^AMHPCCL S AMHVISIT=1 Q  ;************ FOR TESTING IN FOREGROUND
  1.  Q
  1. ERROR(AMHX) ;
  1.  D MSG("-1"_$C(30)_AMHX)
  1.  Q
  1.  ;
  1. MSG(AMHX) ;
  1.  S AMHARRAY=AMHX
  1.  Q
  1.  ;
  1. PRECHECK ;
  1.  I $G(AMHR)="" S AMHERR="IEN OF MHSS RECORD NOT SET" Q
  1.  I '$D(^AMHREC(AMHR,0)) S AMHERR="IEN OF MHSS RECORD NOT VALID" Q
  1.  Q
  1.  ;
  1. KILL ;
  1.  D ^XBFMK
  1.  K DLAYGO,DIADD
  1.  K APCDALVR,AMHPARM,AMHERR,AMHVAL,AMHR  ;,ZTQUEUED
  1.  I $G(AMHZTQ)]"" S ZTQUEUED=AMHZTQ
  1.  Q
  1.  ;