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

BPCBHRU.m

Go to the documentation of this file. 
  1. BPCBHRU ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ; [ 08/22/2007  8:47 AM ]
  1.  ;;1.5;BPC;**4**;FEB 16, 2005
  1.  ;;
  1. TEST ;
  1.  D EN(.RETVAL,24609)
  1.  Q
  1. EN(BPCARRAY,AMHR,AMHGUIV) ;EP CALL
  1.  S ZTQUEUED=""
  1.  S BPCERR=""
  1.  ;AMHR must be ien of MHSS RECORD that was added or updated
  1.  D
  1.  .D PRECHECK Q:BPCERR'=""
  1.  .D CHECKREC Q:BPCERR'=""
  1.  .D PCCLINK
  1.  I BPCERR="" D MSG("1") Q
  1.  I BPCERR'="" D ERROR(BPCERR)
  1.  D KILL
  1.  Q
  1.  ;
  1. CHECKREC ;
  1.  S AMHREC=^AMHREC(AMHR,0)
  1.  I $P($P(AMHREC,U,1),".")>DT S BPCERR="FUTURE VISIT DATE NOT ALLOWED!!!" Q
  1.  I $P(AMHREC,U,4)="" S BPCERR="LOCATION OF ENCOUNTER MISSING!" Q
  1.  I $P(AMHREC,U,5)="" S BPCERR="Community of Service Missing!" Q
  1.  I $P(AMHREC,U,6)="" S BPCERR="Activity Type Missing!" Q
  1.  I $P(AMHREC,U,7)="" S BPCERR="Type of Contact Missing!" Q
  1.  I $P(AMHREC,U,12)="" S BPCERR="Activity Time Missing!" Q
  1.  I $P(AMHREC,U,19)="" S BPCERR="Who entered record Missing!" Q
  1.  I $P(AMHREC,U,21)="" S BPCERR="Date Last Modified Missing!" Q
  1.  I $P(AMHREC,U,22)="" S BPCERR="Extract Flag Missing!" Q
  1.  I $P(AMHREC,U,28)="" S BPCERR="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 BPCERR="No primary Provider!" Q  ;IHS/CMI/LAB - UNCOMMENT LORI! *****
  1.  I Y>1 S BPCERR="ERROR: Multiple Primary Providers!" Q
  1.  I '$D(^AMHRPRO("AD",AMHR)) S BPCERR="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 BPCERR="No Provider Narrative on a POV!" Q
  1.  I $P(AMHREC,U,12)="" S BPCERR="ERROR:  Activity Time Missing!" Q
  1.  Q
  1.  D PCCCHECK
  1.  Q:'AMHLPCC  ;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 ;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.  I $$DOD^AUPNPAT($P(^AMHREC(AMHR,0),U,8))]"",$$DOD^AUPNPAT($P(^AMHREC(AMHR,0),U,8))<$P($P(^AMHREC(AMHR,0),U),".") Q  ;if visit date after dod then don't go to pcc
  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.  .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.  D START^AMHPCCL S AMHVISIT=1 Q  ;************ FOR TESTING IN FOREGROUND
  1.  Q
  1. ERROR(BPCX) ;
  1.  D MSG("-1"_$C(30)_BPCX)
  1.  Q
  1.  ;
  1. MSG(BPCX) ;
  1.  S BPCARRAY=BPCX
  1.  Q
  1.  ;
  1. PRECHECK ;
  1.  I $G(AMHR)="" S BPCERR="IEN OF MHSS RECORD NOT SET" Q
  1.  I '$D(^AMHREC(AMHR,0)) S BPCERR="IEN OF MHSS RECORD NOT VALID" Q
  1.  Q
  1.  ;
  1. KILL ;
  1.  D ^XBFMK
  1.  K DLAYGO,DIADD
  1.  K APCDALVR,BPCPARM,BPCERR,BPCVAL,AMHR,ZTQUEUED
  1.  Q
  1.  Q