BEHOXQPC ;MSC/IND/DKM - PCC-related notifications ;28-Jan-2008 13:08;DKM
;;1.1;BEH COMPONENTS;**002003**;Mar 20, 2007
;=================================================================
; RPC: Generate a missing POV alert
NOPOV(DATA,VSIT,PRI) ;EP
N DFN,PRV
S DATA=0,VSIT(0)=$G(^AUPNVSIT(+VSIT,0))
S DFN=+$P(VSIT(0),U,5)
I 'DFN S DATA="-1^Bad visit specifier" Q
I $D(^AUPNVPOV("AD",VSIT)) S DATA="-2^Visit has POV" Q
I '$D(^TIU(8925,"V",VSIT)) S DATA="-8^Visit has no note" Q
S PRV=$$PRIPRV(VSIT)
I PRV<0 S DATA=PRV Q
D SEND(.DATA,"VPOV","Visit is missing a purpose of visit.",99001,VSIT,PRV,.PRI)
Q
;EP - Returns true if POV notification is still valid
VALIDPOV(AID) ;
N VSIT,PRV,DEL,RET,PPRV
Q:$E(AID,1,4)'="VPOV" 0
S VSIT=+$P(AID,",",2),PRV=+$P(AID,",",3),PPRV=$$PRIPRV(VSIT)
I 'VSIT S RET=0,DEL=1
E I $D(^AUPNVPOV("AD",VSIT)) S RET=0,DEL=1
E I '$D(^TIU(8925,"V",VSIT)) S RET=0,DEL=1
E I PRV=PPRV!(PPRV<1) S RET=1,DEL=0
E D
.; If primary provider changed, forward to new primary provider
.D SEND(,"VPOV","Visit is missing a purpose of visit.",99001,VSIT,PPRV)
.S (RET,DEL)=1
D:DEL BEHDEL^BEHOXQ(AID,1)
Q RET
; RPC: Generate missing E&M code alert
NOEMC(DATA,VSIT,PRI) ;EP
N DFN,PRV,IEN,X
S DATA=0,VSIT(0)=$G(^AUPNVSIT(+VSIT,0))
S DFN=+$P(VSIT(0),U,5)
I 'DFN S DATA="-1^Bad visit specifier" Q
I '$D(^TIU(8925,"V",VSIT)) S DATA="-8^Visit has no note" Q
S PRV=$$PRIPRV(VSIT)
I PRV<0 S DATA=PRV Q
S DATA=$$NEEDSEMC(VSIT,PRV)
D:'DATA SEND(.DATA,"VEM","Visit is missing an E&M code.",99002,VSIT,PRV,.PRI)
Q
;EP - Returns true if E&M notification is still valid
VALIDEMC(AID) ;
N VSIT
Q:$E(AID,1,3)'="VEM" 0
S VSIT=+$P(AID,",",2)
I $D(^TIU(8925,"V",VSIT)),'$$NEEDSEMC(+$P(AID,",",2),+$P(AID,",",3)) Q 1
D BEHDEL^BEHOXQ(AID,1)
Q 0
; Returns 0 if E&M code required
NEEDSEMC(VSIT,DUZ) ;
N IEN,RTN,PAR,X
S X=$G(^AUPNVSIT(VSIT,0))
Q:"CTEDX"[$P(X,U,7) "-7^E&M code not required."
S RTN=0,PAR="BEHOXQPC REQUIRES E&M CODE"
F IEN=0:0 S IEN=$O(^AUPNVCPT("AD",VSIT,IEN)) Q:'IEN!RTN D
.S X=+$G(^AUPNVCPT(IEN,0))
.I X'<99200,X<99500 S RTN="-2^Visit has E&M code"
Q:RTN RTN
S:'$$GET^XPAR($$ENT^CIAVMRPC(PAR),PAR) RTN="-5^Provider does not require E&M code"
Q RTN
; Send the alert
SEND(DATA,AID,SUB,ORN,VSIT,PRV,PRI) ;
N PAR,X
I '$$ENABLED^BEHOXQ($G(ORN),PRV) S DATA="-6^Notification is disabled" Q
S AID=AID_","_VSIT_","_PRV,X=$O(^XTV(8992,"AXQA",AID))
I $P(X,";")=AID S DATA="-4^Notification exists" Q
S PAR("LOC")="SEND",PAR("XQA,"_PRV)="",PAR("XQAID")=AID
S PAR("XQADATA")="DFN="_DFN_"^PRI="_$G(PRI,3)_"^INF=0^VSIT="_VSIT
S PAR("XQAMSG")=SUB
D ENTRY^XQALGUI(,.PAR)
S DATA="0^Notification was delivered"
Q
; Get primary provider for a visit
PRIPRV(VSIT) ;
N PRV
D GETPRV2^BEHOENCX(.PRV,VSIT,1)
S PRV=$O(PRV(0))
S:'PRV PRV="-3^No primary provider"
Q PRV
BEHOXQPC ;MSC/IND/DKM - PCC-related notifications ;28-Jan-2008 13:08;DKM
+1 ;;1.1;BEH COMPONENTS;**002003**;Mar 20, 2007
+2 ;=================================================================
+3 ; RPC: Generate a missing POV alert
NOPOV(DATA,VSIT,PRI) ;EP
+1 NEW DFN,PRV
+2 SET DATA=0
SET VSIT(0)=$GET(^AUPNVSIT(+VSIT,0))
+3 SET DFN=+$PIECE(VSIT(0),U,5)
+4 IF 'DFN
SET DATA="-1^Bad visit specifier"
QUIT
+5 IF $DATA(^AUPNVPOV("AD",VSIT))
SET DATA="-2^Visit has POV"
QUIT
+6 IF '$DATA(^TIU(8925,"V",VSIT))
SET DATA="-8^Visit has no note"
QUIT
+7 SET PRV=$$PRIPRV(VSIT)
+8 IF PRV<0
SET DATA=PRV
QUIT
+9 DO SEND(.DATA,"VPOV","Visit is missing a purpose of visit.",99001,VSIT,PRV,.PRI)
+10 QUIT
+11 ;EP - Returns true if POV notification is still valid
VALIDPOV(AID) ;
+1 NEW VSIT,PRV,DEL,RET,PPRV
+2 IF $EXTRACT(AID,1,4)'="VPOV"
QUIT 0
+3 SET VSIT=+$PIECE(AID,",",2)
SET PRV=+$PIECE(AID,",",3)
SET PPRV=$$PRIPRV(VSIT)
+4 IF 'VSIT
SET RET=0
SET DEL=1
+5 IF '$TEST
IF $DATA(^AUPNVPOV("AD",VSIT))
SET RET=0
SET DEL=1
+6 IF '$TEST
IF '$DATA(^TIU(8925,"V",VSIT))
SET RET=0
SET DEL=1
+7 IF '$TEST
IF PRV=PPRV!(PPRV<1)
SET RET=1
SET DEL=0
+8 IF '$TEST
Begin DoDot:1
+9 ; If primary provider changed, forward to new primary provider
+10 DO SEND(,"VPOV","Visit is missing a purpose of visit.",99001,VSIT,PPRV)
+11 SET (RET,DEL)=1
End DoDot:1
+12 IF DEL
DO BEHDEL^BEHOXQ(AID,1)
+13 QUIT RET
+14 ; RPC: Generate missing E&M code alert
NOEMC(DATA,VSIT,PRI) ;EP
+1 NEW DFN,PRV,IEN,X
+2 SET DATA=0
SET VSIT(0)=$GET(^AUPNVSIT(+VSIT,0))
+3 SET DFN=+$PIECE(VSIT(0),U,5)
+4 IF 'DFN
SET DATA="-1^Bad visit specifier"
QUIT
+5 IF '$DATA(^TIU(8925,"V",VSIT))
SET DATA="-8^Visit has no note"
QUIT
+6 SET PRV=$$PRIPRV(VSIT)
+7 IF PRV<0
SET DATA=PRV
QUIT
+8 SET DATA=$$NEEDSEMC(VSIT,PRV)
+9 IF 'DATA
DO SEND(.DATA,"VEM","Visit is missing an E&M code.",99002,VSIT,PRV,.PRI)
+10 QUIT
+11 ;EP - Returns true if E&M notification is still valid
VALIDEMC(AID) ;
+1 NEW VSIT
+2 IF $EXTRACT(AID,1,3)'="VEM"
QUIT 0
+3 SET VSIT=+$PIECE(AID,",",2)
+4 IF $DATA(^TIU(8925,"V",VSIT))
IF '$$NEEDSEMC(+$PIECE(AID,",",2),+$PIECE(AID,",",3))
QUIT 1
+5 DO BEHDEL^BEHOXQ(AID,1)
+6 QUIT 0
+7 ; Returns 0 if E&M code required
NEEDSEMC(VSIT,DUZ) ;
+1 NEW IEN,RTN,PAR,X
+2 SET X=$GET(^AUPNVSIT(VSIT,0))
+3 IF "CTEDX"[$PIECE(X,U,7)
QUIT "-7^E&M code not required."
+4 SET RTN=0
SET PAR="BEHOXQPC REQUIRES E&M CODE"
+5 FOR IEN=0:0
SET IEN=$ORDER(^AUPNVCPT("AD",VSIT,IEN))
IF 'IEN!RTN
QUIT
Begin DoDot:1
+6 SET X=+$GET(^AUPNVCPT(IEN,0))
+7 IF X'<99200
IF X<99500
SET RTN="-2^Visit has E&M code"
End DoDot:1
+8 IF RTN
QUIT RTN
+9 IF '$$GET^XPAR($$ENT^CIAVMRPC(PAR),PAR)
SET RTN="-5^Provider does not require E&M code"
+10 QUIT RTN
+11 ; Send the alert
SEND(DATA,AID,SUB,ORN,VSIT,PRV,PRI) ;
+1 NEW PAR,X
+2 IF '$$ENABLED^BEHOXQ($GET(ORN),PRV)
SET DATA="-6^Notification is disabled"
QUIT
+3 SET AID=AID_","_VSIT_","_PRV
SET X=$ORDER(^XTV(8992,"AXQA",AID))
+4 IF $PIECE(X,";")=AID
SET DATA="-4^Notification exists"
QUIT
+5 SET PAR("LOC")="SEND"
SET PAR("XQA,"_PRV)=""
SET PAR("XQAID")=AID
+6 SET PAR("XQADATA")="DFN="_DFN_"^PRI="_$GET(PRI,3)_"^INF=0^VSIT="_VSIT
+7 SET PAR("XQAMSG")=SUB
+8 DO ENTRY^XQALGUI(,.PAR)
+9 SET DATA="0^Notification was delivered"
+10 QUIT
+11 ; Get primary provider for a visit
PRIPRV(VSIT) ;
+1 NEW PRV
+2 DO GETPRV2^BEHOENCX(.PRV,VSIT,1)
+3 SET PRV=$ORDER(PRV(0))
+4 IF 'PRV
SET PRV="-3^No primary provider"
+5 QUIT PRV
