- 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 Feb 18, 2025@23:08:19 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