BADEHL2 ;IHS/MSC/MGH/PLS/VAC - Dentrix HL7 interface ;16-Jul-2009 10:54;PLS
;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
;; Modified - IHS/MSC/AMF - 11/23/10 - More descriptive alert messages
Q
; Build Outbound Master File Updates for the provider file
NEWMSG(IEN,MFNTYP) ;EP
N HLPM,HLST,ARY,HLQ,TODAY,NODE,NODE1,NODE11,NODE13,WHO,ERR
N LN,HL1,APPARMS,HLPM,HLFS,HLECH,NPI
S LN=0
S HLPM("MESSAGE TYPE")="MFN"
S HLPM("EVENT")="M02"
S HLPM("VERSION")=2.4
I '$$NEWMSG^HLOAPI(.HLPM,.HLST,.ERR) D Q
.D NOTIF(IEN,"Unable to build HL7 message. "_$G(ERR)) ;IHS/MSC/AMF 11/23/10 More descriptive alert
S HLFS=HLPM("FIELD SEPARATOR")
S HLECH=HLPM("ENCODING CHARACTERS")
S HL1("ECH")=HLECH
S HL1("FS")=HLFS
S HL1("Q")=""
S HL1("VER")=HLPM("VERSION")
;Create segments
;
D MFI
I '$D(ERR) D MFE(IEN)
I '$D(ERR) D STF(IEN)
I '$D(ERR) D PRA(IEN)
Q:$D(ERR)>0
; Define sending and receiving parameters
I '$D(ERR) D
.S APPARMS("SENDING APPLICATION")="RPMS-DEN"
.S APPARMS("ACCEPT ACK TYPE")="AL" ;Commit ACK type
.S APPARMS("APP ACK RESPONSE")="AACK^BADEHL1" ;Callback when 'application ACK' is received
.S APPARMS("ACCEPT ACK RESPONSE")="CACK^BADEHL1" ;Callback when 'commit ACK' is received
.S APPARMS("APP ACK TYPE")="AL" ;Application ACK type
.S APPARMS("QUEUE")="DENT MFE" ;Incoming QUEUE
.S WHO("RECEIVING APPLICATION")="DENTRIX"
.S WHO("FACILITY LINK NAME")="DENTRIX"
.I '$$SENDONE^HLOAPI1(.HLST,.APPARMS,.WHO,.ERR) D
..D NOTIF(IEN,"Unable to send HL7 message. "_$G(ERR)) ;IHS/MSC/AMF 11/23/10 More descriptive alert
Q
;
ERR ;
Q
;
MFI ;Create the MFI segment
N NOW,FLD
S NOW=$$NOW^XLFDT()
S NOW=$$HLDATE^HLFNC(NOW,"TS")
D SET(.ARY,"MFI",0)
D SET(.ARY,"PRA",1)
D SET(.ARY,"RPMS",2)
D SET(.ARY,"UPD",3)
D SET(.ARY,NOW,4)
D SET(.ARY,NOW,5)
D SET(.ARY,"NE",6)
S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
I $D(ERR) D NOTIF(IEN,"Can't create MFI. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
Q
; Create MFE segment
MFE(IEN) ;EP
Q:'$G(IEN)
N PID,SGM,X,LP,VAL,HLQ
S HLQ=HL1("Q")
D SET(.ARY,"MFE",0)
D SET(.ARY,MFNTYP,1)
D SET(.ARY,1,2)
D SET(.ARY,$$HLDATE^HLFNC($$DT^XLFDT()),3)
D SET(.ARY,IEN,4)
D SET(.ARY,"CE",5)
S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
I $D(ERR) D NOTIF(IEN,"Can't create MFE. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
Q
; Create segment
STF(IEN) ;Create the STF segment
Q:'$G(IEN)
N ADDR,PHONE,DGNAME,FLD,K,CNT,SHIP,REL,FLD,VAL,LP,X
N AC,PN,EX
S HLQ=HL1("Q")
S NODE=$G(^VA(200,IEN,0)),NODE13=$G(^VA(200,IEN,.13))
S NODE1=$G(^VA(200,IEN,1))
S NODE11=$G(^VA(200,IEN,.11))
Q:NODE=""
D SET(.ARY,"STF",0)
S NPI=""
S NPI=$$NPI^XUSNPI("Individual_ID",IEN)
I NPI<1 S ERR="No NPI. Can't create STF." D NOTIF(IEN,ERR) Q ;IHS/MSC/AMF 11/23/10 More descriptive alert
D SET(.ARY,+IEN,1) ;Primary Key
D SET(.ARY,+NPI,2) ;NPI
S DGNAME("FILE")=200,DGNAME("IENS")=IEN
S DGNAME("FIELD")=.01
;Name of provider
S FLD=$$HLNAME^XLFNAME(.DGNAME,"","^")
I FLD="" S ERR="No provider name. Can't create STF." D NOTIF(IEN,ERR) Q ;IHS/MSC/AMF 11/23/10 More descriptive alert
; More descriptive alert message
F LP=1:1:$L(FLD,$E(HLECH)) S VAL=$P(FLD,$E(HLECH),LP) D
.D SET(.ARY,VAL,3,LP)
D SET(.ARY,"N",4) ; Staff type
;D SET(.ARY,$P(NODE1,U,2),5) ;Gender
;D SET(.ARY,$$HLDATE^HLFNC($P(NODE1,U,3)),6) ;DOB
D SET(.ARY,$S(MFNTYP="MDC":"I",1:"A"),7) ;Active/Inactive flag
S PHONE=$$HLPHONE^HLFNC($P(NODE13,U,2))
I $L(PHONE) D
.D SET(.ARY,PHONE,10,1) ;Work phone
.D SET(.ARY,"WPH",10,2)
.I $L($P(PHONE,")")) D
..S AC=+$P($P(PHONE,")"),"(",2)
..D:AC SET(.ARY,AC,10,3)
.I $P(PHONE,")",2) D
..S PN=$E($P($P(PHONE,")",2),"X"),1,8) ;extract the phone number
..D:PN SET(.ARY,PN,10,4)
.S EX=$P(PHONE,"X",2)
.D:$L(EX) SET(.ARY,EX,10,5)
S ADDR=$$ADDR^VAFHLFNC($P(NODE11,U,1,6))
F LP=1:1:$L(ADDR,$E(HLECH)) S VAL=$P(ADDR,$E(HLECH),LP) D
.D SET(.ARY,VAL,11,LP) ;Address
;D SET(.ARY,TODAY,12) ;Activation Date
S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
I $D(ERR) D NOTIF(IEN,"Can't create STF. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
Q
PRA(IEN) ;Create the PRA segment
Q:'$G(IEN)
N I,SSN,MEDICAID,DATA,RP,X,LP,FLD,VAL,VAL1,DEA,VA
D SET(.ARY,"PRA",0)
D SET(.ARY,IEN,1)
D SET(.ARY,"Dental General Practice",5)
S SSN=$P(NODE1,U,9)
S MEDICAID=$P($G(^VA(200,IEN,9999999)),U,7)
S DEA=$P($G(^VA(200,IEN,"PS")),U,2)
S VA=$P($G(^VA(200,IEN,"PS")),U,3)
;Only include items which have values
S FLD=1
;S FLD=""
I $L(NPI) D
.D SET(.ARY,+NPI,6,1,1,FLD)
.D SET(.ARY,"NPI",6,2,1,FLD)
.S FLD=FLD+1
I $L(SSN) D
.D SET(.ARY,SSN,6,1,1,FLD)
.D SET(.ARY,"SSN",6,2,1,FLD)
.S FLD=FLD+1
I $L(DEA) D
.D SET(.ARY,DEA,6,1,1,FLD)
.D SET(.ARY,"DEA",6,2,1,FLD)
.S FLD=FLD+1
I $L(VA) D
.D SET(.ARY,VA,6,1,1,FLD)
.D SET(.ARY,"VA",6,2,1,FLD)
.S FLD=FLD+1
I $L(MEDICAID) D
.D SET(.ARY,MEDICAID,6,1,1,FLD)
.D SET(.ARY,"MEDICAIDID",6,2,1,FLD)
.S FLD=FLD+1
;S:NPI'="" FLD=NPI_"^NPI"
;S:SSN'="" FLD=FLD_$S($L(FLD):"~",1:"")_SSN_"^SSN"
;S:DEA'="" FLD=FLD_$S($L(FLD):"~",1:"")_DEA_"^DEA"
;S:VA'="" FLD=FLD_$S($L(FLD):"~",1:"")_VA_"^VA"
;S:MEDICAID'="" FLD=FLD_$S($L(FLD):"~",1:"")_MEDICAID_"^MEDICAID"
;F RP=1:1:$L(FLD,$E(HLECH,2,2)) S VAL1=$P(FLD,$E(HLECH,2,2),RP) D
;.F LP=1:1:$L(VAL1,$E(HLECH)) S VAL=$P(VAL1,$E(HLECH),LP) D
;..D SET(.ARY,VAL,6,LP,,RP)
S X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
I $D(ERR) D NOTIF(IEN,"Can't create PRA. "_ERR) ;IHS/MSC/AMF 11/23/10 More descriptive alert
Q
SET(ARY,V,F,C,S,R) ;EP
D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
Q
NOTIF(IEN,MSG) ;EP ------- IHS/MSC/AMF 11/23/10 More descriptive alert
N PVDIEN,RET,X,SAVE,STR,LEN
N XQA,XQAID,XQDATA,XQAMSG
S LEN=$L("Provider: ["_IEN_"]. "_$G(MSG))
S STR=""
I $L(IEN) S STR=$P($G(^VA(200,IEN,0)),U,1) I ($L(STR)+LEN)>70 S STR=$E(STR,1,(67-LEN))_"..."
S XQAMSG="Provider: "_STR_" ["_IEN_"]. "_$G(MSG)
; -------- end IHS/MSC/AMF 11/23/10
S XQAID="ADEN,"_IEN_","_50
S XQDATA="IEN="_IEN
S XQA("G.RPMS DENTAL")=""
D SETUP^XQALERT
;Save the IEN in a parameter for correction
S X=$$GET^XPAR("ALL","BADE EDR TOTAL PROVIDER ERRORS",1,"E")
S X=X+1
S SAVE=IEN_" "_MSG
D EN^XPAR("SYS","BADE EDR TOTAL PROVIDER ERRORS",1,X)
D EN^XPAR("SYS","BADE EDR PROVIDER ERRORS",X,SAVE)
Q
FINDTYP(IEN) ;Find out if a new or update message should be sent
;If MFNTYP exists, no need to do the lookup
N TD,ENTER,ACTIVE,RES
Q:$D(MFNTYP) MFNTYP
S TD=$$DT^XLFDT()
S ENTER=$P($G(^VA(200,IEN,1)),U,7) ; Date Entered
I TD>ENTER S RES="MUP1"
I ENTER=TD D
.I $P($G(^VA(200,IEN,1.1)),U,1)'="" S RES="MUP1"
.I $P($G(^VA(200,IEN,1.1)),U,1)="" S RES="MAD"
I $P($G(^VA(200,IEN,0)),U,11)!($P($G(^VA(200,IEN,"PS")),U,4)) S RES="MDC"
Q RES
BADEHL2 ;IHS/MSC/MGH/PLS/VAC - Dentrix HL7 interface ;16-Jul-2009 10:54;PLS
+1 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011
+2 ;; Modified - IHS/MSC/AMF - 11/23/10 - More descriptive alert messages
+3 QUIT
+4 ; Build Outbound Master File Updates for the provider file
NEWMSG(IEN,MFNTYP) ;EP
+1 NEW HLPM,HLST,ARY,HLQ,TODAY,NODE,NODE1,NODE11,NODE13,WHO,ERR
+2 NEW LN,HL1,APPARMS,HLPM,HLFS,HLECH,NPI
+3 SET LN=0
+4 SET HLPM("MESSAGE TYPE")="MFN"
+5 SET HLPM("EVENT")="M02"
+6 SET HLPM("VERSION")=2.4
+7 IF '$$NEWMSG^HLOAPI(.HLPM,.HLST,.ERR)
Begin DoDot:1
+8 ;IHS/MSC/AMF 11/23/10 More descriptive alert
DO NOTIF(IEN,"Unable to build HL7 message. "_$GET(ERR))
End DoDot:1
QUIT
+9 SET HLFS=HLPM("FIELD SEPARATOR")
+10 SET HLECH=HLPM("ENCODING CHARACTERS")
+11 SET HL1("ECH")=HLECH
+12 SET HL1("FS")=HLFS
+13 SET HL1("Q")=""
+14 SET HL1("VER")=HLPM("VERSION")
+15 ;Create segments
+16 ;
+17 DO MFI
+18 IF '$DATA(ERR)
DO MFE(IEN)
+19 IF '$DATA(ERR)
DO STF(IEN)
+20 IF '$DATA(ERR)
DO PRA(IEN)
+21 IF $DATA(ERR)>0
QUIT
+22 ; Define sending and receiving parameters
+23 IF '$DATA(ERR)
Begin DoDot:1
+24 SET APPARMS("SENDING APPLICATION")="RPMS-DEN"
+25 ;Commit ACK type
SET APPARMS("ACCEPT ACK TYPE")="AL"
+26 ;Callback when 'application ACK' is received
SET APPARMS("APP ACK RESPONSE")="AACK^BADEHL1"
+27 ;Callback when 'commit ACK' is received
SET APPARMS("ACCEPT ACK RESPONSE")="CACK^BADEHL1"
+28 ;Application ACK type
SET APPARMS("APP ACK TYPE")="AL"
+29 ;Incoming QUEUE
SET APPARMS("QUEUE")="DENT MFE"
+30 SET WHO("RECEIVING APPLICATION")="DENTRIX"
+31 SET WHO("FACILITY LINK NAME")="DENTRIX"
+32 IF '$$SENDONE^HLOAPI1(.HLST,.APPARMS,.WHO,.ERR)
Begin DoDot:2
+33 ;IHS/MSC/AMF 11/23/10 More descriptive alert
DO NOTIF(IEN,"Unable to send HL7 message. "_$GET(ERR))
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
ERR ;
+1 QUIT
+2 ;
MFI ;Create the MFI segment
+1 NEW NOW,FLD
+2 SET NOW=$$NOW^XLFDT()
+3 SET NOW=$$HLDATE^HLFNC(NOW,"TS")
+4 DO SET(.ARY,"MFI",0)
+5 DO SET(.ARY,"PRA",1)
+6 DO SET(.ARY,"RPMS",2)
+7 DO SET(.ARY,"UPD",3)
+8 DO SET(.ARY,NOW,4)
+9 DO SET(.ARY,NOW,5)
+10 DO SET(.ARY,"NE",6)
+11 SET X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
+12 ;IHS/MSC/AMF 11/23/10 More descriptive alert
IF $DATA(ERR)
DO NOTIF(IEN,"Can't create MFI. "_ERR)
+13 QUIT
+14 ; Create MFE segment
MFE(IEN) ;EP
+1 IF '$GET(IEN)
QUIT
+2 NEW PID,SGM,X,LP,VAL,HLQ
+3 SET HLQ=HL1("Q")
+4 DO SET(.ARY,"MFE",0)
+5 DO SET(.ARY,MFNTYP,1)
+6 DO SET(.ARY,1,2)
+7 DO SET(.ARY,$$HLDATE^HLFNC($$DT^XLFDT()),3)
+8 DO SET(.ARY,IEN,4)
+9 DO SET(.ARY,"CE",5)
+10 SET X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
+11 ;IHS/MSC/AMF 11/23/10 More descriptive alert
IF $DATA(ERR)
DO NOTIF(IEN,"Can't create MFE. "_ERR)
+12 QUIT
+13 ; Create segment
STF(IEN) ;Create the STF segment
+1 IF '$GET(IEN)
QUIT
+2 NEW ADDR,PHONE,DGNAME,FLD,K,CNT,SHIP,REL,FLD,VAL,LP,X
+3 NEW AC,PN,EX
+4 SET HLQ=HL1("Q")
+5 SET NODE=$GET(^VA(200,IEN,0))
SET NODE13=$GET(^VA(200,IEN,.13))
+6 SET NODE1=$GET(^VA(200,IEN,1))
+7 SET NODE11=$GET(^VA(200,IEN,.11))
+8 IF NODE=""
QUIT
+9 DO SET(.ARY,"STF",0)
+10 SET NPI=""
+11 SET NPI=$$NPI^XUSNPI("Individual_ID",IEN)
+12 ;IHS/MSC/AMF 11/23/10 More descriptive alert
IF NPI<1
SET ERR="No NPI. Can't create STF."
DO NOTIF(IEN,ERR)
QUIT
+13 ;Primary Key
DO SET(.ARY,+IEN,1)
+14 ;NPI
DO SET(.ARY,+NPI,2)
+15 SET DGNAME("FILE")=200
SET DGNAME("IENS")=IEN
+16 SET DGNAME("FIELD")=.01
+17 ;Name of provider
+18 SET FLD=$$HLNAME^XLFNAME(.DGNAME,"","^")
+19 ;IHS/MSC/AMF 11/23/10 More descriptive alert
IF FLD=""
SET ERR="No provider name. Can't create STF."
DO NOTIF(IEN,ERR)
QUIT
+20 ; More descriptive alert message
+21 FOR LP=1:1:$LENGTH(FLD,$EXTRACT(HLECH))
SET VAL=$PIECE(FLD,$EXTRACT(HLECH),LP)
Begin DoDot:1
+22 DO SET(.ARY,VAL,3,LP)
End DoDot:1
+23 ; Staff type
DO SET(.ARY,"N",4)
+24 ;D SET(.ARY,$P(NODE1,U,2),5) ;Gender
+25 ;D SET(.ARY,$$HLDATE^HLFNC($P(NODE1,U,3)),6) ;DOB
+26 ;Active/Inactive flag
DO SET(.ARY,$SELECT(MFNTYP="MDC":"I",1:"A"),7)
+27 SET PHONE=$$HLPHONE^HLFNC($PIECE(NODE13,U,2))
+28 IF $LENGTH(PHONE)
Begin DoDot:1
+29 ;Work phone
DO SET(.ARY,PHONE,10,1)
+30 DO SET(.ARY,"WPH",10,2)
+31 IF $LENGTH($PIECE(PHONE,")"))
Begin DoDot:2
+32 SET AC=+$PIECE($PIECE(PHONE,")"),"(",2)
+33 IF AC
DO SET(.ARY,AC,10,3)
End DoDot:2
+34 IF $PIECE(PHONE,")",2)
Begin DoDot:2
+35 ;extract the phone number
SET PN=$EXTRACT($PIECE($PIECE(PHONE,")",2),"X"),1,8)
+36 IF PN
DO SET(.ARY,PN,10,4)
End DoDot:2
+37 SET EX=$PIECE(PHONE,"X",2)
+38 IF $LENGTH(EX)
DO SET(.ARY,EX,10,5)
End DoDot:1
+39 SET ADDR=$$ADDR^VAFHLFNC($PIECE(NODE11,U,1,6))
+40 FOR LP=1:1:$LENGTH(ADDR,$EXTRACT(HLECH))
SET VAL=$PIECE(ADDR,$EXTRACT(HLECH),LP)
Begin DoDot:1
+41 ;Address
DO SET(.ARY,VAL,11,LP)
End DoDot:1
+42 ;D SET(.ARY,TODAY,12) ;Activation Date
+43 SET X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
+44 ;IHS/MSC/AMF 11/23/10 More descriptive alert
IF $DATA(ERR)
DO NOTIF(IEN,"Can't create STF. "_ERR)
+45 QUIT
PRA(IEN) ;Create the PRA segment
+1 IF '$GET(IEN)
QUIT
+2 NEW I,SSN,MEDICAID,DATA,RP,X,LP,FLD,VAL,VAL1,DEA,VA
+3 DO SET(.ARY,"PRA",0)
+4 DO SET(.ARY,IEN,1)
+5 DO SET(.ARY,"Dental General Practice",5)
+6 SET SSN=$PIECE(NODE1,U,9)
+7 SET MEDICAID=$PIECE($GET(^VA(200,IEN,9999999)),U,7)
+8 SET DEA=$PIECE($GET(^VA(200,IEN,"PS")),U,2)
+9 SET VA=$PIECE($GET(^VA(200,IEN,"PS")),U,3)
+10 ;Only include items which have values
+11 SET FLD=1
+12 ;S FLD=""
+13 IF $LENGTH(NPI)
Begin DoDot:1
+14 DO SET(.ARY,+NPI,6,1,1,FLD)
+15 DO SET(.ARY,"NPI",6,2,1,FLD)
+16 SET FLD=FLD+1
End DoDot:1
+17 IF $LENGTH(SSN)
Begin DoDot:1
+18 DO SET(.ARY,SSN,6,1,1,FLD)
+19 DO SET(.ARY,"SSN",6,2,1,FLD)
+20 SET FLD=FLD+1
End DoDot:1
+21 IF $LENGTH(DEA)
Begin DoDot:1
+22 DO SET(.ARY,DEA,6,1,1,FLD)
+23 DO SET(.ARY,"DEA",6,2,1,FLD)
+24 SET FLD=FLD+1
End DoDot:1
+25 IF $LENGTH(VA)
Begin DoDot:1
+26 DO SET(.ARY,VA,6,1,1,FLD)
+27 DO SET(.ARY,"VA",6,2,1,FLD)
+28 SET FLD=FLD+1
End DoDot:1
+29 IF $LENGTH(MEDICAID)
Begin DoDot:1
+30 DO SET(.ARY,MEDICAID,6,1,1,FLD)
+31 DO SET(.ARY,"MEDICAIDID",6,2,1,FLD)
+32 SET FLD=FLD+1
End DoDot:1
+33 ;S:NPI'="" FLD=NPI_"^NPI"
+34 ;S:SSN'="" FLD=FLD_$S($L(FLD):"~",1:"")_SSN_"^SSN"
+35 ;S:DEA'="" FLD=FLD_$S($L(FLD):"~",1:"")_DEA_"^DEA"
+36 ;S:VA'="" FLD=FLD_$S($L(FLD):"~",1:"")_VA_"^VA"
+37 ;S:MEDICAID'="" FLD=FLD_$S($L(FLD):"~",1:"")_MEDICAID_"^MEDICAID"
+38 ;F RP=1:1:$L(FLD,$E(HLECH,2,2)) S VAL1=$P(FLD,$E(HLECH,2,2),RP) D
+39 ;.F LP=1:1:$L(VAL1,$E(HLECH)) S VAL=$P(VAL1,$E(HLECH),LP) D
+40 ;..D SET(.ARY,VAL,6,LP,,RP)
+41 SET X=$$ADDSEG^HLOAPI(.HLST,.ARY,.ERR)
+42 ;IHS/MSC/AMF 11/23/10 More descriptive alert
IF $DATA(ERR)
DO NOTIF(IEN,"Can't create PRA. "_ERR)
+43 QUIT
SET(ARY,V,F,C,S,R) ;EP
+1 DO SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)
+2 QUIT
NOTIF(IEN,MSG) ;EP ------- IHS/MSC/AMF 11/23/10 More descriptive alert
+1 NEW PVDIEN,RET,X,SAVE,STR,LEN
+2 NEW XQA,XQAID,XQDATA,XQAMSG
+3 SET LEN=$LENGTH("Provider: ["_IEN_"]. "_$GET(MSG))
+4 SET STR=""
+5 IF $LENGTH(IEN)
SET STR=$PIECE($GET(^VA(200,IEN,0)),U,1)
IF ($LENGTH(STR)+LEN)>70
SET STR=$EXTRACT(STR,1,(67-LEN))_"..."
+6 SET XQAMSG="Provider: "_STR_" ["_IEN_"]. "_$GET(MSG)
+7 ; -------- end IHS/MSC/AMF 11/23/10
+8 SET XQAID="ADEN,"_IEN_","_50
+9 SET XQDATA="IEN="_IEN
+10 SET XQA("G.RPMS DENTAL")=""
+11 DO SETUP^XQALERT
+12 ;Save the IEN in a parameter for correction
+13 SET X=$$GET^XPAR("ALL","BADE EDR TOTAL PROVIDER ERRORS",1,"E")
+14 SET X=X+1
+15 SET SAVE=IEN_" "_MSG
+16 DO EN^XPAR("SYS","BADE EDR TOTAL PROVIDER ERRORS",1,X)
+17 DO EN^XPAR("SYS","BADE EDR PROVIDER ERRORS",X,SAVE)
+18 QUIT
FINDTYP(IEN) ;Find out if a new or update message should be sent
+1 ;If MFNTYP exists, no need to do the lookup
+2 NEW TD,ENTER,ACTIVE,RES
+3 IF $DATA(MFNTYP)
QUIT MFNTYP
+4 SET TD=$$DT^XLFDT()
+5 ; Date Entered
SET ENTER=$PIECE($GET(^VA(200,IEN,1)),U,7)
+6 IF TD>ENTER
SET RES="MUP1"
+7 IF ENTER=TD
Begin DoDot:1
+8 IF $PIECE($GET(^VA(200,IEN,1.1)),U,1)'=""
SET RES="MUP1"
+9 IF $PIECE($GET(^VA(200,IEN,1.1)),U,1)=""
SET RES="MAD"
End DoDot:1
+10 IF $PIECE($GET(^VA(200,IEN,0)),U,11)!($PIECE($GET(^VA(200,IEN,"PS")),U,4))
SET RES="MDC"
+11 QUIT RES
