BEHODC8.m

BEHODC8 ;MSC/IND/MGH -  TIU Dictation Support ;20-Mar-2007 13:48;DKM

 ;;1.1;BEH COMPONENTS;**001001**;Mar 20, 2007

 ;================================================================

 ;Routine generates an error message to be sent to a mail group and

 ;an acknowledgement message with the appropriate error

 ;==================================================================

BOTH(DFN,EVNDT,ERRTEXT) ;EP - Generate an error and the acknowledgement

 D GENACK,BULL(DFN,EVNDT,ERRTEXT)

 Q

BULL(DFN,EVNDT,ERRTEXT) ; Generate error message and send to the assigned mail group

 S XMB="DICT HL7 ERRORS"

 D NOW^%DTC S XMDT=X K X

 S XMB(1)=$S(+DFN:$P($G(^DPT(DFN,0)),"^"),1:"UNKNOWN")

 I XMB(1)="" S XMB(1)="UNKNOWN"

 S XMB(2)=ERRTEXT

 S XMDUZ=$S($D(DUZ):DUZ,1:.5)

 ;D ^XMB

 K XMB,XMDT,XMDUZ

 ;Send alert as well

 N XQAMSG,XQAID,GROUP,XQA

 S XQAMSG=ERRTEXT,XQAID="HL7"

 S XQA("G.DICT HL7 ERRORS")=""

 D SETUP^XQALERT

 K XMB,XMY,XMM,XMDT Q

GENACK ;EP - Generate an HL7 ACK message

 I $D(HLMG) D

 .S HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HLMG

 E  D

 .S HLA("HLA",1)="MSA"_HL("FS")_$S($G(ERRTX)'="":"AE",1:"AA")_HL("FS")_HL("MID")_$S($D(ERRTX):HL("FS")_ERRTX,1:"")

 S HLEID=HL("EID"),HLEIDS=HL("EIDS"),HLARYTYP="LM",HLFORMAT=1,HLRESLTA=HL("MID")

 S HLTCP=1

 D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESTLA)

 Q

BEHODC8   ;MSC/IND/MGH -  TIU Dictation Support ;20-Mar-2007 13:48;DKM

 +1       ;;1.1;BEH COMPONENTS;**001001**;Mar 20, 2007

 +2       ;================================================================

 +3       ;Routine generates an error message to be sent to a mail group and

 +4       ;an acknowledgement message with the appropriate error

 +5       ;==================================================================

BOTH(DFN,EVNDT,ERRTEXT) ;EP - Generate an error and the acknowledgement

 +1        DO GENACK

           DO BULL(DFN,EVNDT,ERRTEXT)

 +2        QUIT 

BULL(DFN,EVNDT,ERRTEXT) ; Generate error message and send to the assigned mail group

 +1        SET XMB="DICT HL7 ERRORS"

 +2        DO NOW^%DTC

           SET XMDT=X

           KILL X

 +3        SET XMB(1)=$SELECT(+DFN:$PIECE($GET(^DPT(DFN,0)),"^"),1:"UNKNOWN")

 +4        IF XMB(1)=""

               SET XMB(1)="UNKNOWN"

 +5        SET XMB(2)=ERRTEXT

 +6        SET XMDUZ=$SELECT($DATA(DUZ):DUZ,1:.5)

 +7       ;D ^XMB

 +8        KILL XMB,XMDT,XMDUZ

 +9       ;Send alert as well

 +10       NEW XQAMSG,XQAID,GROUP,XQA

 +11       SET XQAMSG=ERRTEXT

           SET XQAID="HL7"

 +12       SET XQA("G.DICT HL7 ERRORS")=""

 +13       DO SETUP^XQALERT

 +14       KILL XMB,XMY,XMM,XMDT

           QUIT 

GENACK    ;EP - Generate an HL7 ACK message

 +1        IF $DATA(HLMG)

               Begin DoDot:1

 +2                SET HLA("HLA",1)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HLMG

               End DoDot:1

 +3       IF '$TEST

               Begin DoDot:1

 +4                SET HLA("HLA",1)="MSA"_HL("FS")_$SELECT($GET(ERRTX)'="":"AE",1:"AA")_HL("FS")_HL("MID")_$SELECT($DATA(ERRTX):HL("FS")_ERRTX,1:"")

               End DoDot:1

 +5        SET HLEID=HL("EID")

           SET HLEIDS=HL("EIDS")

           SET HLARYTYP="LM"

           SET HLFORMAT=1

           SET HLRESLTA=HL("MID")

 +6        SET HLTCP=1

 +7        DO GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT,.HLRESTLA)

 +8        QUIT