BPCBHRU ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ; [ 08/22/2007 8:47 AM ]
;;1.5;BPC;**4**;FEB 16, 2005
;;
TEST ;
D EN(.RETVAL,24609)
Q
EN(BPCARRAY,AMHR,AMHGUIV) ;EP CALL
S ZTQUEUED=""
S BPCERR=""
;AMHR must be ien of MHSS RECORD that was added or updated
D
.D PRECHECK Q:BPCERR'=""
.D CHECKREC Q:BPCERR'=""
.D PCCLINK
I BPCERR="" D MSG("1") Q
I BPCERR'="" D ERROR(BPCERR)
D KILL
Q
;
CHECKREC ;
S AMHREC=^AMHREC(AMHR,0)
I $P($P(AMHREC,U,1),".")>DT S BPCERR="FUTURE VISIT DATE NOT ALLOWED!!!" Q
I $P(AMHREC,U,4)="" S BPCERR="LOCATION OF ENCOUNTER MISSING!" Q
I $P(AMHREC,U,5)="" S BPCERR="Community of Service Missing!" Q
I $P(AMHREC,U,6)="" S BPCERR="Activity Type Missing!" Q
I $P(AMHREC,U,7)="" S BPCERR="Type of Contact Missing!" Q
I $P(AMHREC,U,12)="" S BPCERR="Activity Time Missing!" Q
I $P(AMHREC,U,19)="" S BPCERR="Who entered record Missing!" Q
I $P(AMHREC,U,21)="" S BPCERR="Date Last Modified Missing!" Q
I $P(AMHREC,U,22)="" S BPCERR="Extract Flag Missing!" Q
I $P(AMHREC,U,28)="" S BPCERR="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 BPCERR="No primary Provider!" Q ;IHS/CMI/LAB - UNCOMMENT LORI! *****
I Y>1 S BPCERR="ERROR: Multiple Primary Providers!" Q
I '$D(^AMHRPRO("AD",AMHR)) S BPCERR="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 BPCERR="No Provider Narrative on a POV!" Q
I $P(AMHREC,U,12)="" S BPCERR="ERROR: Activity Time Missing!" Q
Q
PCCLINK ;
D PCCCHECK
Q:'AMHLPCC ;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 ;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
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
;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
D START^AMHPCCL S AMHVISIT=1 Q ;************ FOR TESTING IN FOREGROUND
Q
ERROR(BPCX) ;
D MSG("-1"_$C(30)_BPCX)
Q
;
MSG(BPCX) ;
S BPCARRAY=BPCX
Q
;
PRECHECK ;
I $G(AMHR)="" S BPCERR="IEN OF MHSS RECORD NOT SET" Q
I '$D(^AMHREC(AMHR,0)) S BPCERR="IEN OF MHSS RECORD NOT VALID" Q
Q
;
KILL ;
D ^XBFMK
K DLAYGO,DIADD
K APCDALVR,BPCPARM,BPCERR,BPCVAL,AMHR,ZTQUEUED
Q
Q
BPCBHRU ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ; [ 08/22/2007 8:47 AM ]
+1 ;;1.5;BPC;**4**;FEB 16, 2005
+2 ;;
TEST ;
+1 DO EN(.RETVAL,24609)
+2 QUIT
EN(BPCARRAY,AMHR,AMHGUIV) ;EP CALL
+1 SET ZTQUEUED=""
+2 SET BPCERR=""
+3 ;AMHR must be ien of MHSS RECORD that was added or updated
+4 Begin DoDot:1
+5 DO PRECHECK
IF BPCERR'=""
QUIT
+6 DO CHECKREC
IF BPCERR'=""
QUIT
+7 DO PCCLINK
End DoDot:1
+8 IF BPCERR=""
DO MSG("1")
QUIT
+9 IF BPCERR'=""
DO ERROR(BPCERR)
+10 DO KILL
+11 QUIT
+12 ;
CHECKREC ;
+1 SET AMHREC=^AMHREC(AMHR,0)
+2 IF $PIECE($PIECE(AMHREC,U,1),".")>DT
SET BPCERR="FUTURE VISIT DATE NOT ALLOWED!!!"
QUIT
+3 IF $PIECE(AMHREC,U,4)=""
SET BPCERR="LOCATION OF ENCOUNTER MISSING!"
QUIT
+4 IF $PIECE(AMHREC,U,5)=""
SET BPCERR="Community of Service Missing!"
QUIT
+5 IF $PIECE(AMHREC,U,6)=""
SET BPCERR="Activity Type Missing!"
QUIT
+6 IF $PIECE(AMHREC,U,7)=""
SET BPCERR="Type of Contact Missing!"
QUIT
+7 IF $PIECE(AMHREC,U,12)=""
SET BPCERR="Activity Time Missing!"
QUIT
+8 IF $PIECE(AMHREC,U,19)=""
SET BPCERR="Who entered record Missing!"
QUIT
+9 IF $PIECE(AMHREC,U,21)=""
SET BPCERR="Date Last Modified Missing!"
QUIT
+10 IF $PIECE(AMHREC,U,22)=""
SET BPCERR="Extract Flag Missing!"
QUIT
+11 IF $PIECE(AMHREC,U,28)=""
SET BPCERR="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 BPCERR="No primary Provider!"
QUIT
+14 IF Y>1
SET BPCERR="ERROR: Multiple Primary Providers!"
QUIT
+15 IF '$DATA(^AMHRPRO("AD",AMHR))
SET BPCERR="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 BPCERR="No Provider Narrative on a POV!"
QUIT
+18 IF $PIECE(AMHREC,U,12)=""
SET BPCERR="ERROR: Activity Time Missing!"
QUIT
+19 QUIT
PCCLINK ;
+1 DO PCCCHECK
+2 ;quit if no pcc link
IF 'AMHLPCC
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 ;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 ;if visit date after dod then don't go to pcc
IF $$DOD^AUPNPAT($PIECE(^AMHREC(AMHR,0),U,8))]""
IF $$DOD^AUPNPAT($PIECE(^AMHREC(AMHR,0),U,8))<$PIECE($PIECE(^AMHREC(AMHR,0),U),".")
QUIT
+6 ;do not pass residential type of visits to pcc
+7 ;if one record a day, don't want in PCC
IF $$VAL^XBDIQ1(9002011,AMHR,.07)="RESIDENTIAL"
QUIT
+8 ;do not pass visits with dnka problem code
+9 ;check for at least one pov that is icd9 codable
+10 SET (AMHX,AMHGOT,AMHDNKA)=0
FOR
SET AMHX=$ORDER(^AMHRPRO("AD",AMHR,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+11 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8
SET AMHDNKA=1
QUIT
+12 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.1
SET AMHDNKA=1
QUIT
+13 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.11
SET AMHDNKA=1
QUIT
+14 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.2
SET AMHDNKA=1
QUIT
+15 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.21
SET AMHDNKA=1
QUIT
+16 ;do not pass dnka
IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U)=8.3
SET AMHDNKA=1
QUIT
+17 IF $PIECE(^AMHPROB($PIECE(^AMHRPRO(AMHX,0),U),0),U,5)]""
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
DO START^AMHPCCL
SET AMHVISIT=1
QUIT
+4 QUIT
ERROR(BPCX) ;
+1 DO MSG("-1"_$CHAR(30)_BPCX)
+2 QUIT
+3 ;
MSG(BPCX) ;
+1 SET BPCARRAY=BPCX
+2 QUIT
+3 ;
PRECHECK ;
+1 IF $GET(AMHR)=""
SET BPCERR="IEN OF MHSS RECORD NOT SET"
QUIT
+2 IF '$DATA(^AMHREC(AMHR,0))
SET BPCERR="IEN OF MHSS RECORD NOT VALID"
QUIT
+3 QUIT
+4 ;
KILL ;
+1 DO ^XBFMK
+2 KILL DLAYGO,DIADD
+3 KILL APCDALVR,BPCPARM,BPCERR,BPCVAL,AMHR,ZTQUEUED
+4 QUIT
+5 QUIT
