AMHBHRU ; IHS/CMI/LAB - GUI V FILE VISIT CREATION ; 16 Dec 2010 11:54 AM
;;4.0;IHS BEHAVIORAL HEALTH;**1,5**;JUN 02, 2010;Build 18
;;
TEST ;
D EN(.RETVAL,24609)
Q
EN(AMHARRAY,AMHR,AMHGUIV) ;EP CALL
;N AMHZTQ
;I $G(ZTQUEUED)]"" S AMHZTQ=ZTQUEUED
;S ZTQUEUED="" ;cmi/anch/maw 5/19/2009 removed causing errors when running face sheet after call to create visit
S AMHBL=1 ;cmi/maw 5/19/2009 since ZTQUEUED
S AMHERR=""
;AMHR must be ien of MHSS RECORD that was added or updated
D
.D PRECHECK Q:AMHERR'=""
.D CHECKREC Q:AMHERR'=""
.D PCCLINK
I AMHERR="" D MSG("1") Q
I AMHERR'="" D ERROR(AMHERR)
D KILL
Q
;
CHECKREC ;
S AMHREC=^AMHREC(AMHR,0)
I $P($P(AMHREC,U,1),".")>DT S AMHERR="FUTURE VISIT DATE NOT ALLOWED!!!" Q
I $P(AMHREC,U,4)="" S AMHERR="LOCATION OF ENCOUNTER MISSING!" Q
I $P(AMHREC,U,5)="" S AMHERR="Community of Service Missing!" Q
I $P(AMHREC,U,6)="" S AMHERR="Activity Type Missing!" Q
I $P(AMHREC,U,7)="" S AMHERR="Type of Contact Missing!" Q
I $P(AMHREC,U,12)="" S AMHERR="Activity Time Missing!" Q
I $P(AMHREC,U,19)="" S AMHERR="Who entered record Missing!" Q
I $P(AMHREC,U,21)="" S AMHERR="Date Last Modified Missing!" Q
I $P(AMHREC,U,22)="" S AMHERR="Extract Flag Missing!" Q
I $P(AMHREC,U,28)="" S AMHERR="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 AMHERR="No primary Provider!" Q ;IHS/CMI/LAB - UNCOMMENT LORI! *****
I Y>1 S AMHERR="ERROR: Multiple Primary Providers!" Q
I '$D(^AMHRPRO("AD",AMHR)) S AMHERR="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 AMHERR="No Provider Narrative on a POV!" Q
I $P(AMHREC,U,12)="" S AMHERR="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
.I $P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U,17)]"" 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 AMHERR 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 AMHERR="IEN OF MHSS RECORD NOT SET" Q
I '$D(^AMHREC(AMHR,0)) S AMHERR="IEN OF MHSS RECORD NOT VALID" Q
Q
;
KILL ;
D ^XBFMK
K DLAYGO,DIADD
K APCDALVR,AMHPARM,AMHERR,AMHVAL,AMHR ;,ZTQUEUED
I $G(AMHZTQ)]"" S ZTQUEUED=AMHZTQ
Q
;
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
+2 ;;
TEST ;
+1 DO EN(.RETVAL,24609)
+2 QUIT
EN(AMHARRAY,AMHR,AMHGUIV) ;EP CALL
+1 ;N AMHZTQ
+2 ;I $G(ZTQUEUED)]"" S AMHZTQ=ZTQUEUED
+3 ;S ZTQUEUED="" ;cmi/anch/maw 5/19/2009 removed causing errors when running face sheet after call to create visit
+4 ;cmi/maw 5/19/2009 since ZTQUEUED
SET AMHBL=1
+5 SET AMHERR=""
+6 ;AMHR must be ien of MHSS RECORD that was added or updated
+7 Begin DoDot:1
+8 DO PRECHECK
IF AMHERR'=""
QUIT
+9 DO CHECKREC
IF AMHERR'=""
QUIT
+10 DO PCCLINK
End DoDot:1
+11 IF AMHERR=""
DO MSG("1")
QUIT
+12 IF AMHERR'=""
DO ERROR(AMHERR)
+13 DO KILL
+14 QUIT
+15 ;
CHECKREC ;
+1 SET AMHREC=^AMHREC(AMHR,0)
+2 IF $PIECE($PIECE(AMHREC,U,1),".")>DT
SET AMHERR="FUTURE VISIT DATE NOT ALLOWED!!!"
QUIT
+3 IF $PIECE(AMHREC,U,4)=""
SET AMHERR="LOCATION OF ENCOUNTER MISSING!"
QUIT
+4 IF $PIECE(AMHREC,U,5)=""
SET AMHERR="Community of Service Missing!"
QUIT
+5 IF $PIECE(AMHREC,U,6)=""
SET AMHERR="Activity Type Missing!"
QUIT
+6 IF $PIECE(AMHREC,U,7)=""
SET AMHERR="Type of Contact Missing!"
QUIT
+7 IF $PIECE(AMHREC,U,12)=""
SET AMHERR="Activity Time Missing!"
QUIT
+8 IF $PIECE(AMHREC,U,19)=""
SET AMHERR="Who entered record Missing!"
QUIT
+9 IF $PIECE(AMHREC,U,21)=""
SET AMHERR="Date Last Modified Missing!"
QUIT
+10 IF $PIECE(AMHREC,U,22)=""
SET AMHERR="Extract Flag Missing!"
QUIT
+11 IF $PIECE(AMHREC,U,28)=""
SET AMHERR="User Last Update Missing!"
QUIT
+12 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
+13 ;IHS/CMI/LAB - UNCOMMENT LORI! *****
IF Y=0
SET AMHERR="No primary Provider!"
QUIT
+14 IF Y>1
SET AMHERR="ERROR: Multiple Primary Providers!"
QUIT
+15 IF '$DATA(^AMHRPRO("AD",AMHR))
SET AMHERR="ERROR: No POV entered!!"
QUIT
+16 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
+17 IF Z
SET AMHERR="No Provider Narrative on a POV!"
QUIT
+18 IF $PIECE(AMHREC,U,12)=""
SET AMHERR="ERROR: Activity Time Missing!"
QUIT
+19 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 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U,17)]""
SET AMHGOT=1
+18 QUIT
End DoDot:1
+19 IF AMHDNKA
QUIT
+20 IF $PIECE(^AMHREC(AMHR,0),U,6)=""
QUIT
+21 IF 'AMHGOT
QUIT
+22 ;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 AMHERR
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 AMHERR="IEN OF MHSS RECORD NOT SET"
QUIT
+2 IF '$DATA(^AMHREC(AMHR,0))
SET AMHERR="IEN OF MHSS RECORD NOT VALID"
QUIT
+3 QUIT
+4 ;
KILL ;
+1 DO ^XBFMK
+2 KILL DLAYGO,DIADD
+3 ;,ZTQUEUED
KILL APCDALVR,AMHPARM,AMHERR,AMHVAL,AMHR
+4 IF $GET(AMHZTQ)]""
SET ZTQUEUED=AMHZTQ
+5 QUIT
+6 ;
