AMHGPCCL ; IHS/CMI/MAW - AMHG Interactive PCC Link 5/19/2009 10:44:13 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("PCC^AMHGPCCL(.RETVAL,.AMHSTR)")
Q
;
PCC(RETVAL,AMHSTR) ;-- create/edit PCC visit from MHSS RECORD ENTRY
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHIEN,AMHVS,AMHER,AMHREC
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHIEN=$P(AMHSTR,P)
S AMHVS=$P(AMHSTR,P,2)
D EN(AMHIEN,AMHVS)
I $E($G(AMHARRAY),1,2)="-1" D
. S AMHER="0~"_$P(RET,$C(30),2)
I $G(AMHARRAY)=1 D
. S AMHREC=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:$G(AMHREC))_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
EN(AMHR,AMHGUIV) ;EP CALL
;S ZTQUEUED=""
S AMHERRR=""
;AMHR must be ien of MHSS RECORD that was added or updated
D PRECHECK I AMHERRR'="" D ERROR(AMHERRR) Q
D CHECKREC I AMHERRR'="" D ERROR(AMHERRR) Q
D PCCLINK
I AMHERRR="" D MSG("1") Q
I AMHERRR'="" D ERROR(AMHERRR)
D KILL
Q
;
CHECKREC ;
N AMHREC
S AMHREC=^AMHREC(AMHR,0)
I $P($P(AMHREC,U,1),".")>DT S AMHERRR="FUTURE VISIT DATE NOT ALLOWED!!!" Q
I $P(AMHREC,U,4)="" S AMHERRR="LOCATION OF ENCOUNTER MISSING!" Q
I $P(AMHREC,U,5)="" S AMHERRR="Community of Service Missing!" Q
I $P(AMHREC,U,6)="" S AMHERRR="Activity Type Missing!" Q
I $P(AMHREC,U,7)="" S AMHERRR="Type of Contact Missing!" Q
I $P(AMHREC,U,12)="" S AMHERRR="Activity Time Missing!" Q
I $P(AMHREC,U,19)="" S AMHERRR="Who entered record Missing!" Q
I $P(AMHREC,U,21)="" S AMHERRR="Date Last Modified Missing!" Q
I $P(AMHREC,U,22)="" S AMHERRR="Extract Flag Missing!" Q
I $P(AMHREC,U,28)="" S AMHERRR="User Last Update Missing!" Q
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
I Y=0 S AMHERRR="No primary Provider!" Q ;IHS/CMI/LAB - UNCOMMENT LORI! *****
I Y>1 S AMHERRR="ERROR: Multiple Primary Providers!" Q
I '$D(^AMHRPRO("AD",AMHR)) S AMHERRR="ERROR: No POV entered!!" Q
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
I Z S AMHERRR="No Provider Narrative on a POV!" Q
I $P(AMHREC,U,12)="" S AMHERRR="ERROR: Activity Time Missing!" Q
Q
PCCLINK ;
D PCCCHECK
I 'AMHLPCC Q:'$$PRVLINK^AMHLE2($$PPINT^AMHUTIL(AMHR)) ;quit if no pcc link
S AMHPTYPE=$P(^AMHREC(AMHR,0),U,2)
D VISIT
I 'AMHVISIT,$P(^AMHREC(AMHR,0),U,16)]"" D Q
.S APCDVDLT=$P(^AMHREC(AMHR,0),U,16) D ^APCDVDLT
.S DIE="^AMHREC(",DA=AMHR,DR=".16///@" D CALLDIE^AMHLEIN
Q:AMHVISIT
Q
;
PCCCHECK ;EP - check to see if link to pcc active, set AMHLPCC IF SO
K AMHLPCC
S (AMHLPCC,AMHLPCCT)=$P(^AMHSITE(DUZ(2),0),U,12) I AMHLPCC S AMHLPCC=AMHLPCC-1
I AMHLPCC="" S AMHLPCC=0 Q
Q:'AMHLPCC
I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",'$D(^APCCCTRL(DUZ(2),0))#2 S AMHLPCC=0 Q
S AMHPKG=$O(^DIC(9.4,"C","AMH",""))
I '$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2 S AMHLPCC=0 Q
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
E S AMHLPCC=0
K AMHPKG
Q
VISIT ;
K AMHDNKA
S AMHVISIT=0
Q:'$G(AMHR)
Q:'$P(^AMHREC(AMHR,0),U,8) ;no pcc if not a patient encounter
;do not pass residential type of visits to pcc
I $$VAL^XBDIQ1(9002011,AMHR,.07)="RESIDENTIAL" Q ;if one record a day, don't want in PCC
;do not pass visits with dnka problem code
;check for at least one pov that is icd9 codable
S (AMHX,AMHGOT,AMHDNKA)=0 F S AMHX=$O(^AMHRPRO("AD",AMHR,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8 S AMHDNKA=1 Q ;do not pass dnka
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.1 S AMHDNKA=1 Q ;do not pass dnka
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.11 S AMHDNKA=1 Q ;do not pass dnka
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.2 S AMHDNKA=1 Q ;do not pass dnka
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.21 S AMHDNKA=1 Q ;do not pass dnka
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U)=8.3 S AMHDNKA=1 Q ;do not pass dnka
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U,5)]"" S AMHGOT=1
.Q
Q:AMHDNKA
Q:$P(^AMHREC(AMHR,0),U,6)=""
Q:'AMHGOT
Q:'$P(^AMHTACT($P(^AMHREC(AMHR,0),U,6),0),U,4) ;quit if not an activity that gets passed to PCC
TASK ;
;*****************************
S AMHBL=1,AMHACTN=2
NEW AMHERRR D START^AMHPCCL S AMHVISIT=1 Q ;************ FOR TESTING IN FOREGROUND
Q
ERROR(AMHX) ;
D MSG("-1"_$C(30)_AMHX)
Q
;
MSG(AMHX) ;
S AMHARRAY=AMHX
Q
;
PRECHECK ;
I $G(AMHR)="" S AMHERRR="IEN OF MHSS RECORD NOT SET" Q
I '$D(^AMHREC(AMHR,0)) S AMHERRR="IEN OF MHSS RECORD NOT VALID" Q
Q
;
KILL ;
D ^XBFMK
K DLAYGO,DIADD
K APCDALVR,AMHPARM,AMHERRR,AMHVAL,AMHR,ZTQUEUED,AMHERR,AMHBL,AMHDNKA,AMHLPCC,AMHLPCCT,AMHPTYPE,AMHVISIT
Q
;
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
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("PCC^AMHGPCCL(.RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
PCC(RETVAL,AMHSTR) ;-- create/edit PCC visit from MHSS RECORD ENTRY
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHIEN,AMHVS,AMHER,AMHREC
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHIEN=$PIECE(AMHSTR,P)
+8 SET AMHVS=$PIECE(AMHSTR,P,2)
+9 DO EN(AMHIEN,AMHVS)
+10 IF $EXTRACT($GET(AMHARRAY),1,2)="-1"
Begin DoDot:1
+11 SET AMHER="0~"_$PIECE(RET,$CHAR(30),2)
End DoDot:1
+12 IF $GET(AMHARRAY)=1
Begin DoDot:1
+13 SET AMHREC=$$GET1^DIQ(9002011,AMHIEN,.16,"I")
End DoDot:1
+14 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+15 SET AMHI=AMHI+1
+16 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:$GET(AMHREC))_$CHAR(30)
+17 SET @RETVAL@(AMHI+1)=$CHAR(31)
+18 QUIT
+19 ;
EN(AMHR,AMHGUIV) ;EP CALL
+1 ;S ZTQUEUED=""
+2 SET AMHERRR=""
+3 ;AMHR must be ien of MHSS RECORD that was added or updated
+4 DO PRECHECK
IF AMHERRR'=""
DO ERROR(AMHERRR)
QUIT
+5 DO CHECKREC
IF AMHERRR'=""
DO ERROR(AMHERRR)
QUIT
+6 DO PCCLINK
+7 IF AMHERRR=""
DO MSG("1")
QUIT
+8 IF AMHERRR'=""
DO ERROR(AMHERRR)
+9 DO KILL
+10 QUIT
+11 ;
CHECKREC ;
+1 NEW AMHREC
+2 SET AMHREC=^AMHREC(AMHR,0)
+3 IF $PIECE($PIECE(AMHREC,U,1),".")>DT
SET AMHERRR="FUTURE VISIT DATE NOT ALLOWED!!!"
QUIT
+4 IF $PIECE(AMHREC,U,4)=""
SET AMHERRR="LOCATION OF ENCOUNTER MISSING!"
QUIT
+5 IF $PIECE(AMHREC,U,5)=""
SET AMHERRR="Community of Service Missing!"
QUIT
+6 IF $PIECE(AMHREC,U,6)=""
SET AMHERRR="Activity Type Missing!"
QUIT
+7 IF $PIECE(AMHREC,U,7)=""
SET AMHERRR="Type of Contact Missing!"
QUIT
+8 IF $PIECE(AMHREC,U,12)=""
SET AMHERRR="Activity Time Missing!"
QUIT
+9 IF $PIECE(AMHREC,U,19)=""
SET AMHERRR="Who entered record Missing!"
QUIT
+10 IF $PIECE(AMHREC,U,21)=""
SET AMHERRR="Date Last Modified Missing!"
QUIT
+11 IF $PIECE(AMHREC,U,22)=""
SET AMHERRR="Extract Flag Missing!"
QUIT
+12 IF $PIECE(AMHREC,U,28)=""
SET AMHERRR="User Last Update Missing!"
QUIT
+13 SET (X,Y,Z)=0
FOR
SET X=$ORDER(^AMHRPROV("AD",AMHR,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRPROV(X,0),U,4)="P"
SET Y=Y+1
+14 ;IHS/CMI/LAB - UNCOMMENT LORI! *****
IF Y=0
SET AMHERRR="No primary Provider!"
QUIT
+15 IF Y>1
SET AMHERRR="ERROR: Multiple Primary Providers!"
QUIT
+16 IF '$DATA(^AMHRPRO("AD",AMHR))
SET AMHERRR="ERROR: No POV entered!!"
QUIT
+17 SET (X,Y,Z)=0
FOR
SET X=$ORDER(^AMHRPRO("AD",AMHR,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRPRO(X,0),U,4)=""
SET Z=1
+18 IF Z
SET AMHERRR="No Provider Narrative on a POV!"
QUIT
+19 IF $PIECE(AMHREC,U,12)=""
SET AMHERRR="ERROR: Activity Time Missing!"
QUIT
+20 QUIT
PCCLINK ;
+1 DO PCCCHECK
+2 ;quit if no pcc link
IF 'AMHLPCC
IF '$$PRVLINK^AMHLE2($$PPINT^AMHUTIL(AMHR))
QUIT
+3 SET AMHPTYPE=$PIECE(^AMHREC(AMHR,0),U,2)
+4 DO VISIT
+5 IF 'AMHVISIT
IF $PIECE(^AMHREC(AMHR,0),U,16)]""
Begin DoDot:1
+6 SET APCDVDLT=$PIECE(^AMHREC(AMHR,0),U,16)
DO ^APCDVDLT
+7 SET DIE="^AMHREC("
SET DA=AMHR
SET DR=".16///@"
DO CALLDIE^AMHLEIN
End DoDot:1
QUIT
+8 IF AMHVISIT
QUIT
+9 QUIT
+10 ;
PCCCHECK ;EP - check to see if link to pcc active, set AMHLPCC IF SO
+1 KILL AMHLPCC
+2 SET (AMHLPCC,AMHLPCCT)=$PIECE(^AMHSITE(DUZ(2),0),U,12)
IF AMHLPCC
SET AMHLPCC=AMHLPCC-1
+3 IF AMHLPCC=""
SET AMHLPCC=0
QUIT
+4 IF 'AMHLPCC
QUIT
+5 IF $DATA(^AUTTSITE(1,0))
IF $PIECE(^(0),U,8)="Y"
IF '$DATA(^APCCCTRL(DUZ(2),0))#2
SET AMHLPCC=0
QUIT
+6 SET AMHPKG=$ORDER(^DIC(9.4,"C","AMH",""))
+7 IF '$DATA(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2
SET AMHLPCC=0
QUIT
+8 IF $DATA(^AUTTSITE(1,0))
IF $PIECE(^(0),U,8)="Y"
IF $DATA(^APCCCTRL(DUZ(2),0))#2
IF $DATA(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2
IF $PIECE(^(0),U,2)
SET AMHLPCC=AMHLPCC
+9 IF '$TEST
SET AMHLPCC=0
+10 KILL AMHPKG
+11 QUIT
VISIT ;
+1 KILL AMHDNKA
+2 SET AMHVISIT=0
+3 IF '$GET(AMHR)
QUIT
+4 ;no pcc if not a patient encounter
IF '$PIECE(^AMHREC(AMHR,0),U,8)
QUIT
+5 ;do not pass residential type of visits to pcc
+6 ;if one record a day, don't want in PCC
IF $$VAL^XBDIQ1(9002011,AMHR,.07)="RESIDENTIAL"
QUIT
+7 ;do not pass visits with dnka problem code
+8 ;check for at least one pov that is icd9 codable
+9 SET (AMHX,AMHGOT,AMHDNKA)=0
FOR
SET AMHX=$ORDER(^AMHRPRO("AD",AMHR,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+10 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8
SET AMHDNKA=1
QUIT
+11 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.1
SET AMHDNKA=1
QUIT
+12 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.11
SET AMHDNKA=1
QUIT
+13 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.2
SET AMHDNKA=1
QUIT
+14 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.21
SET AMHDNKA=1
QUIT
+15 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.3
SET AMHDNKA=1
QUIT
+16 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U,5)]""
SET AMHGOT=1
+17 QUIT
End DoDot:1
+18 IF AMHDNKA
QUIT
+19 IF $PIECE(^AMHREC(AMHR,0),U,6)=""
QUIT
+20 IF 'AMHGOT
QUIT
+21 ;quit if not an activity that gets passed to PCC
IF '$PIECE(^AMHTACT($PIECE(^AMHREC(AMHR,0),U,6),0),U,4)
QUIT
TASK ;
+1 ;*****************************
+2 SET AMHBL=1
SET AMHACTN=2
+3 ;************ FOR TESTING IN FOREGROUND
NEW AMHERRR
DO START^AMHPCCL
SET AMHVISIT=1
QUIT
+4 QUIT
ERROR(AMHX) ;
+1 DO MSG("-1"_$CHAR(30)_AMHX)
+2 QUIT
+3 ;
MSG(AMHX) ;
+1 SET AMHARRAY=AMHX
+2 QUIT
+3 ;
PRECHECK ;
+1 IF $GET(AMHR)=""
SET AMHERRR="IEN OF MHSS RECORD NOT SET"
QUIT
+2 IF '$DATA(^AMHREC(AMHR,0))
SET AMHERRR="IEN OF MHSS RECORD NOT VALID"
QUIT
+3 QUIT
+4 ;
KILL ;
+1 DO ^XBFMK
+2 KILL DLAYGO,DIADD
+3 KILL APCDALVR,AMHPARM,AMHERRR,AMHVAL,AMHR,ZTQUEUED,AMHERR,AMHBL,AMHDNKA,AMHLPCC,AMHLPCCT,AMHPTYPE,AMHVISIT
+4 QUIT
+5 ;
