source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGHLLOG1.m@ 1769

RGHLLOG1 ;ALB/CJM-SEND EXCEPTION TO MPI EXCEPTION HANDLER ;11/25/2000

 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**13,18**;30 Apr 99

 ;

 ;Reference to file 870 supported by IA #3335

 ;Reference to file 391.72 supported by IA #3037

 ;References to file 773 supported by IA #3244 and 3273

 ;

SENDMPI(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ;

 ;Description: Sends the exception to the MPI Exception Handler.

 ;Input: Required

 ;  RGEXC - Exception type in File #991.11

 ;  RGERR - Supplemental text

 ;       Optional

 ;  RGDFN - IEN in the PATIENT file (#2)

 ;  MSGID - message id of message being processed when the exception occurred (optional), uses RGLOG(3) or HL("MID") if not defined

 ;  STATNUM - station # of site that encountered the error (optional)

 ;         If not defined then local site is assumed, using $$SITE^VASITE

 ;Output: none

 ;

 ;Variables:

 ;  @RGMSG is the location for the message text

 ;

 N RGMSG

 S RGMSG="^TMP($J,""RG MPI SERVER EXCEPTION"")"

 K @RGMSG

 ;

 D ADDLINE("**MPI/PD EXCEPTION**")

 D ADDDATA("EXCEPTION TYPE",$G(RGEXC))

 D ADDDATA("OPTIONAL TEXT",$G(RGERR))

 D ADDDATA("SITE OF OCCURRENCE",$S($D(STATNUM):STATNUM,1:$P($$SITE^VASITE(),"^",3)))

 D ADDDATA("SITE REPORTING",$P($$SITE^VASITE(),"^",3))

 D ADDDATA("DATE/TIME REPORTED",$$NOW^XLFDT)

 I $G(RGDFN) D

 .N OUT,SITE

 .D GETALL^RGFIU(RGDFN,.OUT)

 .D ADDLINE("**PATIENT DATA**")

 .D ADDDATA("ICN",OUT("ICN"))

 .D ADDDATA("NAME",$$NAME^RGFIU(RGDFN))

 .D ADDDATA("SSN",$$SSN^RGFIU(RGDFN))

 .D ADDDATA("CMOR",OUT("CMOR"))

 .S SITE=""

 .F  S SITE=$O(OUT("TF",SITE)) Q:(SITE="")  D ADDLINE("**"),ADDDATA("TREATING FACILITY",SITE),ADDDATA("DATE LAST TREATED",OUT("TF",SITE,"LASTDATE")),ADDDATA("EVENT REASON",$$GETFIELD^RGFIU(391.72,.01,OUT("TF",SITE,"EVENT")))

 K OUT

 I $$GETMSG($G(MSGID),.OUT) D

 .N SUB

 .D ADDLINE("**HL7 MESSAGE**")

 .S SUB=""

 .F  S SUB=$O(OUT(SUB)) Q:(SUB="")  D ADDDATA(SUB,OUT(SUB))

 D ADDLINE("**END**")

 I $$MAIL

 K @RGMSG

 ;

 Q

 ;

SERVER() ;

 ;Description: Returns the <server name>@<server domain>. This entry

 ;returns the Servers location either at the test MPI or Production MPI.

 ;If a null is returned the MAIL subroutine will default to the MPIF

 ;EXCEPTIONS mail group

 ;

 ;Input: none

 ;Output: Where to send the exception.Returns the <server name>@<server domain> or Null

 ;

 N TO,IEN

 S TO=""

 ; get MPI logical link

 D LINK^HLUTIL3("200M",.HLL,"I")

 ; get MPI domain DBIA 3335

 S IEN=$O(HLL(0)) I +IEN>0 S TO=$$GET1^DIQ(870,+IEN_",",.03) I TO'="" S TO="S.MPI EXCEPTION SERVER@"_TO

 Q TO

 ;

ADDDATA(LABEL,DATA) ;

 ;Description: Adds one formated line to the message text containing the label and data value

 ;Input:

 ;  LABEL - text label that identifies the type of data

 ;  DATA - data value

 ;Output:none

 ; 

 D ADDLINE(LABEL_":"_DATA)

 Q

ADDLINE(LINE) ;

 ;Description: adds one one to the message text

 ;Inputs:

 ;  LINE - the line of text to be added

 ;  RGMSG - @RGMSG is the location for the message text

 ;Output: none

 S @RGMSG@(($O(@RGMSG@(9999),-1)+1))=LINE

 Q

MAIL() ;

 ;Description: Sends the message located at @RGMSG to the MPI Exception Handler

 ;Input: message at @RGMSG

 ;Output: If succssful, the function returns the mailman message number, otherwise, "" is returned

 ;

 N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM,SERVER

 Q:'$D(@RGMSG) ""

 S SERVER=$$SERVER

 ;if the MPI server isn't returned default to the old MPIF EXCEPTIONS mail group

 I SERVER="" S SERVER="MPIF EXCEPTIONS"

 S XMDUZ="MPI/PD at "_$P($$SITE^VASITE(),"^",2)

 S XMY(.5)=""

 S XMY(SERVER)=""

 S XMTEXT=$P(RGMSG,")")_","

 S XMSUB="MPI/PD EXCEPTION"

 D ^XMD

 Q $G(XMZ)

 ;

GETMSG(MSGID,MSGARRAY) ;

 ;Description: Retrieves data from the HL7 Message Administration file (#773) related to the message

 ;Input:

 ;  MSGID - the message id (optional)

 ;  RGLOG(3) - if MSGID is not passed then RGLOG(3) is used to determine the message

 ;  HL("MID") - if MSGID and RGLOG(3) are not defined then HL("MID") is used to determine the message

 ;

 ;Output:

 ;  Function Value - 1 on success, 0 on failure

 ;  MSGARRAY() - (pass by reference) - returns the data

 ;          ("MESSAGE ID") - the HL7 message id

 ;          ("MESSAGE TYPE") - the HL7 message type

 ;          ("EVENT TYPE") - the HL7 event type

 ;          ("SENDING APPLICATION") - the name of the sending application

 ;          ("LOGICAL LINK") - the name of the HL Logical Link overwhich the message was received

 ;

 N MSGIEN

 K MSGARRAY

 I '$G(MSGID) D

 .I $G(RGLOG(3)) S MSGID=$$GETFIELD^RGFIU(773,2,RGLOG(3)) Q:MSGID

 .S MSGID=$G(HL("MID"))

 Q:'MSGID 0

 ;

 S MSGIEN=$$IEN773^RGHLLOG(MSGID)

 ;

 S MSGARRAY("MESSAGE ID")=MSGID

 S MSGARRAY("LOGICAL LINK")=$$GETFIELD^RGFIU(773,7,MSGIEN,,1)

 S MSGARRAY("SENDING APPLICATION")=$$GETFIELD^RGFIU(773,13,MSGIEN,,1)

 S MSGARRAY("MESSAGE TYPE")=$$GETFIELD^RGFIU(773,15,MSGIEN,,1)

 S MSGARRAY("EVENT TYPE")=$$GETFIELD^RGFIU(773,16,MSGIEN,,1)

 ;

 ;this compensates for a bug in the HL7 package - the external form rather than the pointer values are being stored in file 773

 I MSGID,'$L(MSGARRAY("MESSAGE TYPE")) S MSGARRAY("MESSAGE TYPE")=$$GETFIELD^RGFIU(773,15,MSGIEN)

 I MSGID,'$L(MSGARRAY("EVENT TYPE")) S MSGARRAY("EVENT TYPE")=$$GETFIELD^RGFIU(773,16,MSGIEN)

 ;

 Q 1