BADEUTIL ;IHS/MSC/PLS - Dentrix HL7 inbound interface ;12-Feb-2010 09:35;PLS
;;1.0;DENTAL/EDR INTERFACE;**5**;FEB 22, 2010;Build 23
; Returns patient corresponding to 12 digit facility/hrn code
;; Modified - IHS/OIT/GAB 03/2016 **5** Check & Add POV's (ICD10 code) coming from Dentrix
HRCNF(HRCN12) ; EP
N DFN,ASUFAC,HRN,Y
S DFN=-1
S ASUFAC=+$E(HRCN12,1,6),HRN=+$E(HRCN12,7,12)
Q:'ASUFAC!'HRN DFN
S ASUFAC=$$FIND1^DIC(9999999.06,,,ASUFAC,"C")
Q:'ASUFAC DFN
S Y=0 F S Y=$O(^AUPNPAT("D",HRN,Y)) Q:'Y Q:$D(^(Y,ASUFAC))
S:Y DFN=Y
Q DFN
;
; Enable/Disable a protocol
; Input: P-Protocol
; T-Text - Null or not passed removes text.
EDPROT(P,T,ERR) ;EP
N IENARY,PIEN,AIEN,FDA
S T=$G(T,"")
D
.I '$L(P) S ERR="Missing input parameter" Q
.S IENARY(1)=$$FIND1^DIC(101,"","",P)
.I 'IENARY(1) S ERR="Unknown protocol name" Q
.S FDA(101,IENARY(1)_",",2)=$S($L(T):T,1:"@")
.D UPDATE^DIE("S","FDA","IENARY","ERR")
Q
; Returns default user based on Location
DUSER(LOC) ;EP
N RET
S RET=$$GET^XPAR("DIV.`"_LOC_"^SYS","BADE EDR DEFAULT USER")
Q RET
; Returns MERGED TO DFN, when present, traversing the chain
MRGTODFN(DFN) ;EP
N RES
S RES=DFN
Q:'$D(^DPT(DFN,-9)) RES ;DFN has not been merged
F S DFN=$P($G(^DPT(DFN,-9)),U) Q:'DFN S RES=DFN Q:'$D(^DPT(DFN,-9))
Q RES
GETPOV ;IHS/OIT/GAB 03/2016 **5** ADDED THIS SEGMENT - GET THE POV FROM THE FT1 SEGMENT & ADD TO THE VISIT
S CNT=1,NOPOV="",FIRST=""
K CODE
F CNT=1:1:4 D
.Q:$G(SEGFT1(20,CNT,1,1))=""
.S CODE(CNT)=(SEGFT1(20,CNT,1,1))
.S POV=CODE(CNT)
.I CNT=1 S FIRST=CODE(CNT)
.Q:FIRST="V72.2"
.D VALIDPOV^BADEUTIL(POV)
.I YES=1 D
..I '$$HASPOV(APCDVSIT,POV) S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]" D EN^APCDALVR
I (FIRST="V72.2")&&('$$HASPOV(APCDVSIT,"ZZZ.999")) S APCDALVR("APCDTPOV")="ZZZ.999" S APCDALVR("APCDTEXK")=APCDTEXK S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]" D EN^APCDALVR
I FIRST="" S NOPOV=1
Q
VALIDPOV(POV) ; IHS/OIT/GAB **5** ADD A CHECK FOR A VALID POV COMING FROM DENTRIX
N STR,IEN
S YES=""
S STR=$$ICDDATA^ICDXCODE(30,POV,VISDT,"E")
S IEN=$P(STR,"^") S:IEN<0 IEN=""
I IEN="" S YES="" Q ;SET DEFAULT CODE IF IEN DOESN'T EXIST ; Not a valid code
S YES=1
S APCDALVR("APCDTPOV")=POV
S APCDALVR("APCDTEXK")=APCDTEXK ; add the EXKEY for the POV entry to associate with the procedure
Q
HASPOV(V,Y) ;EP IHS/OIT/GAB **5** ADD A CHECK FOR DUPLICATE POV's
;V is visit ien
;Y is value of icd code, e.g. Z98.810
I '$G(V) Q "" ;not a valid visit ien
I '$D(^AUPNVSIT(V,0)) Q "" ;not a valid visit ien
NEW X,G,I
S (X,G)=0
F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(G) D
.S I=$$VAL^XBDIQ1(9000010.07,X,.01) ;external value of .01 of V POV
.I I=Y S G=X ;if it equals Y quit on ien of the V POV, yes, we already have that V POV
.Q
Q G
BADEUTIL ;IHS/MSC/PLS - Dentrix HL7 inbound interface ;12-Feb-2010 09:35;PLS
+1 ;;1.0;DENTAL/EDR INTERFACE;**5**;FEB 22, 2010;Build 23
+2 ; Returns patient corresponding to 12 digit facility/hrn code
+3 ;; Modified - IHS/OIT/GAB 03/2016 **5** Check & Add POV's (ICD10 code) coming from Dentrix
HRCNF(HRCN12) ; EP
+1 NEW DFN,ASUFAC,HRN,Y
+2 SET DFN=-1
+3 SET ASUFAC=+$EXTRACT(HRCN12,1,6)
SET HRN=+$EXTRACT(HRCN12,7,12)
+4 IF 'ASUFAC!'HRN
QUIT DFN
+5 SET ASUFAC=$$FIND1^DIC(9999999.06,,,ASUFAC,"C")
+6 IF 'ASUFAC
QUIT DFN
+7 SET Y=0
FOR
SET Y=$ORDER(^AUPNPAT("D",HRN,Y))
IF 'Y
QUIT
IF $DATA(^(Y,ASUFAC))
QUIT
+8 IF Y
SET DFN=Y
+9 QUIT DFN
+10 ;
+11 ; Enable/Disable a protocol
+12 ; Input: P-Protocol
+13 ; T-Text - Null or not passed removes text.
EDPROT(P,T,ERR) ;EP
+1 NEW IENARY,PIEN,AIEN,FDA
+2 SET T=$GET(T,"")
+3 Begin DoDot:1
+4 IF '$LENGTH(P)
SET ERR="Missing input parameter"
QUIT
+5 SET IENARY(1)=$$FIND1^DIC(101,"","",P)
+6 IF 'IENARY(1)
SET ERR="Unknown protocol name"
QUIT
+7 SET FDA(101,IENARY(1)_",",2)=$SELECT($LENGTH(T):T,1:"@")
+8 DO UPDATE^DIE("S","FDA","IENARY","ERR")
End DoDot:1
+9 QUIT
+10 ; Returns default user based on Location
DUSER(LOC) ;EP
+1 NEW RET
+2 SET RET=$$GET^XPAR("DIV.`"_LOC_"^SYS","BADE EDR DEFAULT USER")
+3 QUIT RET
+4 ; Returns MERGED TO DFN, when present, traversing the chain
MRGTODFN(DFN) ;EP
+1 NEW RES
+2 SET RES=DFN
+3 ;DFN has not been merged
IF '$DATA(^DPT(DFN,-9))
QUIT RES
+4 FOR
SET DFN=$PIECE($GET(^DPT(DFN,-9)),U)
IF 'DFN
QUIT
SET RES=DFN
IF '$DATA(^DPT(DFN,-9))
QUIT
+5 QUIT RES
GETPOV ;IHS/OIT/GAB 03/2016 **5** ADDED THIS SEGMENT - GET THE POV FROM THE FT1 SEGMENT & ADD TO THE VISIT
+1 SET CNT=1
SET NOPOV=""
SET FIRST=""
+2 KILL CODE
+3 FOR CNT=1:1:4
Begin DoDot:1
+4 IF $GET(SEGFT1(20,CNT,1,1))=""
QUIT
+5 SET CODE(CNT)=(SEGFT1(20,CNT,1,1))
+6 SET POV=CODE(CNT)
+7 IF CNT=1
SET FIRST=CODE(CNT)
+8 IF FIRST="V72.2"
QUIT
+9 DO VALIDPOV^BADEUTIL(POV)
+10 IF YES=1
Begin DoDot:2
+11 IF '$$HASPOV(APCDVSIT,POV)
SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
DO EN^APCDALVR
End DoDot:2
End DoDot:1
+12 IF (FIRST="V72.2")&&('$$HASPOV(APCDVSIT,"ZZZ.999"))
SET APCDALVR("APCDTPOV")="ZZZ.999"
SET APCDALVR("APCDTEXK")=APCDTEXK
SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
DO EN^APCDALVR
+13 IF FIRST=""
SET NOPOV=1
+14 QUIT
VALIDPOV(POV) ; IHS/OIT/GAB **5** ADD A CHECK FOR A VALID POV COMING FROM DENTRIX
+1 NEW STR,IEN
+2 SET YES=""
+3 SET STR=$$ICDDATA^ICDXCODE(30,POV,VISDT,"E")
+4 SET IEN=$PIECE(STR,"^")
IF IEN<0
SET IEN=""
+5 ;SET DEFAULT CODE IF IEN DOESN'T EXIST ; Not a valid code
IF IEN=""
SET YES=""
QUIT
+6 SET YES=1
+7 SET APCDALVR("APCDTPOV")=POV
+8 ; add the EXKEY for the POV entry to associate with the procedure
SET APCDALVR("APCDTEXK")=APCDTEXK
+9 QUIT
HASPOV(V,Y) ;EP IHS/OIT/GAB **5** ADD A CHECK FOR DUPLICATE POV's
+1 ;V is visit ien
+2 ;Y is value of icd code, e.g. Z98.810
+3 ;not a valid visit ien
IF '$GET(V)
QUIT ""
+4 ;not a valid visit ien
IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+5 NEW X,G,I
+6 SET (X,G)=0
+7 FOR
SET X=$ORDER(^AUPNVPOV("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+8 ;external value of .01 of V POV
SET I=$$VAL^XBDIQ1(9000010.07,X,.01)
+9 ;if it equals Y quit on ien of the V POV, yes, we already have that V POV
IF I=Y
SET G=X
+10 QUIT
End DoDot:1
+11 QUIT G
