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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGHLLOG1 5309 printed Dec 13, 2024@01:41:56 Page 2
RGHLLOG1 ;ALB/CJM-SEND EXCEPTION TO MPI EXCEPTION HANDLER ;11/25/2000
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**13,18**;30 Apr 99
+2 ;
+3 ;Reference to file 870 supported by IA #3335
+4 ;Reference to file 391.72 supported by IA #3037
+5 ;References to file 773 supported by IA #3244 and 3273
+6 ;
SENDMPI(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ;
+1 ;Description: Sends the exception to the MPI Exception Handler.
+2 ;Input: Required
+3 ; RGEXC - Exception type in File #991.11
+4 ; RGERR - Supplemental text
+5 ; Optional
+6 ; RGDFN - IEN in the PATIENT file (#2)
+7 ; MSGID - message id of message being processed when the exception occurred (optional), uses RGLOG(3) or HL("MID") if not defined
+8 ; STATNUM - station # of site that encountered the error (optional)
+9 ; If not defined then local site is assumed, using $$SITE^VASITE
+10 ;Output: none
+11 ;
+12 ;Variables:
+13 ; @RGMSG is the location for the message text
+14 ;
+15 NEW RGMSG
+16 SET RGMSG="^TMP($J,""RG MPI SERVER EXCEPTION"")"
+17 KILL @RGMSG
+18 ;
+19 DO ADDLINE("**MPI/PD EXCEPTION**")
+20 DO ADDDATA("EXCEPTION TYPE",$GET(RGEXC))
+21 DO ADDDATA("OPTIONAL TEXT",$GET(RGERR))
+22 DO ADDDATA("SITE OF OCCURRENCE",$SELECT($DATA(STATNUM):STATNUM,1:$PIECE($$SITE^VASITE(),"^",3)))
+23 DO ADDDATA("SITE REPORTING",$PIECE($$SITE^VASITE(),"^",3))
+24 DO ADDDATA("DATE/TIME REPORTED",$$NOW^XLFDT)
+25 IF $GET(RGDFN)
Begin DoDot:1
+26 NEW OUT,SITE
+27 DO GETALL^RGFIU(RGDFN,.OUT)
+28 DO ADDLINE("**PATIENT DATA**")
+29 DO ADDDATA("ICN",OUT("ICN"))
+30 DO ADDDATA("NAME",$$NAME^RGFIU(RGDFN))
+31 DO ADDDATA("SSN",$$SSN^RGFIU(RGDFN))
+32 DO ADDDATA("CMOR",OUT("CMOR"))
+33 SET SITE=""
+34 FOR
SET SITE=$ORDER(OUT("TF",SITE))
if (SITE="")
QUIT
DO ADDLINE("**")
DO ADDDATA("TREATING FACILITY",SITE)
DO ADDDATA("DATE LAST TREATED",OUT("TF",SITE,"LASTDATE"))
DO ADDDATA("EVENT REASON",$$GETFIELD^RGFIU(391.72,.01,OUT("TF",SITE,"EVENT")))
End DoDot:1
+35 KILL OUT
+36 IF $$GETMSG($GET(MSGID),.OUT)
Begin DoDot:1
+37 NEW SUB
+38 DO ADDLINE("**HL7 MESSAGE**")
+39 SET SUB=""
+40 FOR
SET SUB=$ORDER(OUT(SUB))
if (SUB="")
QUIT
DO ADDDATA(SUB,OUT(SUB))
End DoDot:1
+41 DO ADDLINE("**END**")
+42 IF $$MAIL
+43 KILL @RGMSG
+44 ;
+45 QUIT
+46 ;
SERVER() ;
+1 ;Description: Returns the <server name>@<server domain>. This entry
+2 ;returns the Servers location either at the test MPI or Production MPI.
+3 ;If a null is returned the MAIL subroutine will default to the MPIF
+4 ;EXCEPTIONS mail group
+5 ;
+6 ;Input: none
+7 ;Output: Where to send the exception.Returns the <server name>@<server domain> or Null
+8 ;
+9 NEW TO,IEN
+10 SET TO=""
+11 ; get MPI logical link
+12 DO LINK^HLUTIL3("200M",.HLL,"I")
+13 ; get MPI domain DBIA 3335
+14 SET IEN=$ORDER(HLL(0))
IF +IEN>0
SET TO=$$GET1^DIQ(870,+IEN_",",.03)
IF TO'=""
SET TO="S.MPI EXCEPTION SERVER@"_TO
+15 QUIT TO
+16 ;
ADDDATA(LABEL,DATA) ;
+1 ;Description: Adds one formated line to the message text containing the label and data value
+2 ;Input:
+3 ; LABEL - text label that identifies the type of data
+4 ; DATA - data value
+5 ;Output:none
+6 ;
+7 DO ADDLINE(LABEL_":"_DATA)
+8 QUIT
ADDLINE(LINE) ;
+1 ;Description: adds one one to the message text
+2 ;Inputs:
+3 ; LINE - the line of text to be added
+4 ; RGMSG - @RGMSG is the location for the message text
+5 ;Output: none
+6 SET @RGMSG@(($ORDER(@RGMSG@(9999),-1)+1))=LINE
+7 QUIT
MAIL() ;
+1 ;Description: Sends the message located at @RGMSG to the MPI Exception Handler
+2 ;Input: message at @RGMSG
+3 ;Output: If succssful, the function returns the mailman message number, otherwise, "" is returned
+4 ;
+5 NEW XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM,SERVER
+6 if '$DATA(@RGMSG)
QUIT ""
+7 SET SERVER=$$SERVER
+8 ;if the MPI server isn't returned default to the old MPIF EXCEPTIONS mail group
+9 IF SERVER=""
SET SERVER="MPIF EXCEPTIONS"
+10 SET XMDUZ="MPI/PD at "_$PIECE($$SITE^VASITE(),"^",2)
+11 SET XMY(.5)=""
+12 SET XMY(SERVER)=""
+13 SET XMTEXT=$PIECE(RGMSG,")")_","
+14 SET XMSUB="MPI/PD EXCEPTION"
+15 DO ^XMD
+16 QUIT $GET(XMZ)
+17 ;
GETMSG(MSGID,MSGARRAY) ;
+1 ;Description: Retrieves data from the HL7 Message Administration file (#773) related to the message
+2 ;Input:
+3 ; MSGID - the message id (optional)
+4 ; RGLOG(3) - if MSGID is not passed then RGLOG(3) is used to determine the message
+5 ; HL("MID") - if MSGID and RGLOG(3) are not defined then HL("MID") is used to determine the message
+6 ;
+7 ;Output:
+8 ; Function Value - 1 on success, 0 on failure
+9 ; MSGARRAY() - (pass by reference) - returns the data
+10 ; ("MESSAGE ID") - the HL7 message id
+11 ; ("MESSAGE TYPE") - the HL7 message type
+12 ; ("EVENT TYPE") - the HL7 event type
+13 ; ("SENDING APPLICATION") - the name of the sending application
+14 ; ("LOGICAL LINK") - the name of the HL Logical Link overwhich the message was received
+15 ;
+16 NEW MSGIEN
+17 KILL MSGARRAY
+18 IF '$GET(MSGID)
Begin DoDot:1
+19 IF $GET(RGLOG(3))
SET MSGID=$$GETFIELD^RGFIU(773,2,RGLOG(3))
if MSGID
QUIT
+20 SET MSGID=$GET(HL("MID"))
End DoDot:1
+21 if 'MSGID
QUIT 0
+22 ;
+23 SET MSGIEN=$$IEN773^RGHLLOG(MSGID)
+24 ;
+25 SET MSGARRAY("MESSAGE ID")=MSGID
+26 SET MSGARRAY("LOGICAL LINK")=$$GETFIELD^RGFIU(773,7,MSGIEN,,1)
+27 SET MSGARRAY("SENDING APPLICATION")=$$GETFIELD^RGFIU(773,13,MSGIEN,,1)
+28 SET MSGARRAY("MESSAGE TYPE")=$$GETFIELD^RGFIU(773,15,MSGIEN,,1)
+29 SET MSGARRAY("EVENT TYPE")=$$GETFIELD^RGFIU(773,16,MSGIEN,,1)
+30 ;
+31 ;this compensates for a bug in the HL7 package - the external form rather than the pointer values are being stored in file 773
+32 IF MSGID
IF '$LENGTH(MSGARRAY("MESSAGE TYPE"))
SET MSGARRAY("MESSAGE TYPE")=$$GETFIELD^RGFIU(773,15,MSGIEN)
+33 IF MSGID
IF '$LENGTH(MSGARRAY("EVENT TYPE"))
SET MSGARRAY("EVENT TYPE")=$$GETFIELD^RGFIU(773,16,MSGIEN)
+34 ;
+35 QUIT 1
