MCAR7X.m

MCAR7X ; HIRMFO/REL-Generate HL7 Error Message ;3/31/00  09:10

 ;;2.3;Medicine;**24**;09/13/1996

 D BULL,GENACK Q

BULL ; Generate error message

 S INST=$O(^MCAR(690.7,"B",MCAPP,0)) Q:'INST

 S MG=$P($G(^MCAR(690.7,INST,0)),"^",2) Q:'MG

 S MG=$P($G(^XMB(3.8,+MG,0)),"^",1) Q:MG=""

 S XMTO="G."_MG_"@"_^XMB("NETNAME"),XMDUZ=.5

 S TXT(1)=ERRTX,TXT(2)=X,TXT(3)=" "

 S N=3 F X="MSH","PID","OBR","OBX" I $D(SEG(X)) S N=N+1,TXT(N)=SEG(X)

 S XMSUBJ="A Clinical Instrument HL7 Error has occurred."

 S XMBODY="TXT"

 D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,XMTO)

 K TXT Q

GENACK ; Generate an HL7 ACK message

 S HLA("HLA",1)="MSA"_HL("FS")_$S($D(ERRTX):"AR",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")

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

 K ERRTX Q

MCAR7X    ; HIRMFO/REL-Generate HL7 Error Message ;3/31/00  09:10

 +1       ;;2.3;Medicine;**24**;09/13/1996

 +2        DO BULL

           DO GENACK

           QUIT 

BULL      ; Generate error message

 +1        SET INST=$ORDER(^MCAR(690.7,"B",MCAPP,0))

           IF 'INST

               QUIT 

 +2        SET MG=$PIECE($GET(^MCAR(690.7,INST,0)),"^",2)

           IF 'MG

               QUIT 

 +3        SET MG=$PIECE($GET(^XMB(3.8,+MG,0)),"^",1)

           IF MG=""

               QUIT 

 +4        SET XMTO="G."_MG_"@"_^XMB("NETNAME")

           SET XMDUZ=.5

 +5        SET TXT(1)=ERRTX

           SET TXT(2)=X

           SET TXT(3)=" "

 +6        SET N=3

           FOR X="MSH","PID","OBR","OBX"

               IF $DATA(SEG(X))

                   SET N=N+1

                   SET TXT(N)=SEG(X)

 +7        SET XMSUBJ="A Clinical Instrument HL7 Error has occurred."

 +8        SET XMBODY="TXT"

 +9        DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,XMTO)

 +10       KILL TXT

           QUIT 

GENACK    ; Generate an HL7 ACK message

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

 +2        SET HLEID=HL("EID")

           SET HLEIDS=HL("EIDS")

           SET HLARYTYP="LM"

           SET HLFORMAT=1

           SET HLRESLTA=HL("MID")

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

 +4        KILL ERRTX

           QUIT