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

AMHGPCCL.m

Go to the documentation of this file. 
  1. AMHGPCCL ; IHS/CMI/MAW - AMHG Interactive PCC Link 5/19/2009 10:44:13 AM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
  1.  ;
  1.  ;
  1.  ;
  1. DEBUG(RETVAL,AMHSTR) ;-- debug entry point
  1.  D DEBUG^%Serenji("PCC^AMHGPCCL(.RETVAL,.AMHSTR)")
  1.  Q
  1.  ;
  1. PCC(RETVAL,AMHSTR) ;-- create/edit PCC visit from MHSS RECORD ENTRY
  1.  S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
  1.  N AMHI,P,R,AMHIEN,AMHVS,AMHER,AMHREC
  1.  S P="|",R="~"
  1.  S RETVAL="^AMHTMP("_$J_")"
  1.  S AMHI=0
  1.  K ^AMHTMP($J)
  1.  S AMHIEN=$P(AMHSTR,P)
  1.  S AMHVS=$P(AMHSTR,P,2)
  1.  D EN(AMHIEN,AMHVS)
  1.  I $E($G(AMHARRAY),1,2)="-1" D
  1.  . S AMHER="0~"_$P(RET,$C(30),2)
  1.  I $G(AMHARRAY)=1 D
  1.  . S AMHREC=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
  1.  S @RETVAL@(AMHI)="T00030Result"_$C(30)
  1.  S AMHI=AMHI+1
  1.  S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:$G(AMHREC))_$C(30)
  1.  S @RETVAL@(AMHI+1)=$C(31)
  1.  Q
  1.  ;
  1. EN(AMHR,AMHGUIV) ;EP CALL
  1.  ;S ZTQUEUED=""
  1.  S AMHERRR=""
  1.  ;AMHR must be ien of MHSS RECORD that was added or updated
  1.  D PRECHECK I AMHERRR'="" D ERROR(AMHERRR) Q
  1.  D CHECKREC I AMHERRR'="" D ERROR(AMHERRR) Q
  1.  D PCCLINK
  1.  I AMHERRR="" D MSG("1") Q
  1.  I AMHERRR'="" D ERROR(AMHERRR)
  1.  D KILL
  1.  Q
  1.  ;
  1. CHECKREC ;
  1.  N AMHREC
  1.  S AMHREC=^AMHREC(AMHR,0)
  1.  I $P($P(AMHREC,U,1),".")>DT S AMHERRR="FUTURE VISIT DATE NOT ALLOWED!!!" Q
  1.  I $P(AMHREC,U,4)="" S AMHERRR="LOCATION OF ENCOUNTER MISSING!" Q
  1.  I $P(AMHREC,U,5)="" S AMHERRR="Community of Service Missing!" Q
  1.  I $P(AMHREC,U,6)="" S AMHERRR="Activity Type Missing!" Q
  1.  I $P(AMHREC,U,7)="" S AMHERRR="Type of Contact Missing!" Q
  1.  I $P(AMHREC,U,12)="" S AMHERRR="Activity Time Missing!" Q
  1.  I $P(AMHREC,U,19)="" S AMHERRR="Who entered record Missing!" Q
  1.  I $P(AMHREC,U,21)="" S AMHERRR="Date Last Modified Missing!" Q
  1.  I $P(AMHREC,U,22)="" S AMHERRR="Extract Flag Missing!" Q
  1.  I $P(AMHREC,U,28)="" S AMHERRR="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 AMHERRR="No primary Provider!" Q  ;IHS/CMI/LAB - UNCOMMENT LORI! *****
  1.  I Y>1 S AMHERRR="ERROR: Multiple Primary Providers!" Q
  1.  I '$D(^AMHRPRO("AD",AMHR)) S AMHERRR="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 AMHERRR="No Provider Narrative on a POV!" Q
  1.  I $P(AMHREC,U,12)="" S AMHERRR="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.  .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 AMHERRR 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 AMHERRR="IEN OF MHSS RECORD NOT SET" Q
  1.  I '$D(^AMHREC(AMHR,0)) S AMHERRR="IEN OF MHSS RECORD NOT VALID" Q
  1.  Q
  1.  ;
  1. KILL ;
  1.  D ^XBFMK
  1.  K DLAYGO,DIADD
  1.  K APCDALVR,AMHPARM,AMHERRR,AMHVAL,AMHR,ZTQUEUED,AMHERR,AMHBL,AMHDNKA,AMHLPCC,AMHLPCCT,AMHPTYPE,AMHVISIT
  1.  Q
  1.  ;