BADEHL2.m

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