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

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1RGHLLOG1 ;ALB/CJM-SEND EXCEPTION TO MPI EXCEPTION HANDLER ;11/25/2000
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**13,18**;30 Apr 99
3 ;
4 ;Reference to file 870 supported by IA #3335
5 ;Reference to file 391.72 supported by IA #3037
6 ;References to file 773 supported by IA #3244 and 3273
7 ;
8SENDMPI(RGEXC,RGERR,RGDFN,MSGID,STATNUM) ;
9 ;Description: Sends the exception to the MPI Exception Handler.
10 ;Input: Required
11 ; RGEXC - Exception type in File #991.11
12 ; RGERR - Supplemental text
13 ; Optional
14 ; RGDFN - IEN in the PATIENT file (#2)
15 ; MSGID - message id of message being processed when the exception occurred (optional), uses RGLOG(3) or HL("MID") if not defined
16 ; STATNUM - station # of site that encountered the error (optional)
17 ; If not defined then local site is assumed, using $$SITE^VASITE
18 ;Output: none
19 ;
20 ;Variables:
21 ; @RGMSG is the location for the message text
22 ;
23 N RGMSG
24 S RGMSG="^TMP($J,""RG MPI SERVER EXCEPTION"")"
25 K @RGMSG
26 ;
27 D ADDLINE("**MPI/PD EXCEPTION**")
28 D ADDDATA("EXCEPTION TYPE",$G(RGEXC))
29 D ADDDATA("OPTIONAL TEXT",$G(RGERR))
30 D ADDDATA("SITE OF OCCURRENCE",$S($D(STATNUM):STATNUM,1:$P($$SITE^VASITE(),"^",3)))
31 D ADDDATA("SITE REPORTING",$P($$SITE^VASITE(),"^",3))
32 D ADDDATA("DATE/TIME REPORTED",$$NOW^XLFDT)
33 I $G(RGDFN) D
34 .N OUT,SITE
35 .D GETALL^RGFIU(RGDFN,.OUT)
36 .D ADDLINE("**PATIENT DATA**")
37 .D ADDDATA("ICN",OUT("ICN"))
38 .D ADDDATA("NAME",$$NAME^RGFIU(RGDFN))
39 .D ADDDATA("SSN",$$SSN^RGFIU(RGDFN))
40 .D ADDDATA("CMOR",OUT("CMOR"))
41 .S SITE=""
42 .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")))
43 K OUT
44 I $$GETMSG($G(MSGID),.OUT) D
45 .N SUB
46 .D ADDLINE("**HL7 MESSAGE**")
47 .S SUB=""
48 .F S SUB=$O(OUT(SUB)) Q:(SUB="") D ADDDATA(SUB,OUT(SUB))
49 D ADDLINE("**END**")
50 I $$MAIL
51 K @RGMSG
52 ;
53 Q
54 ;
55SERVER() ;
56 ;Description: Returns the <server name>@<server domain>. This entry
57 ;returns the Servers location either at the test MPI or Production MPI.
58 ;If a null is returned the MAIL subroutine will default to the MPIF
59 ;EXCEPTIONS mail group
60 ;
61 ;Input: none
62 ;Output: Where to send the exception.Returns the <server name>@<server domain> or Null
63 ;
64 N TO,IEN
65 S TO=""
66 ; get MPI logical link
67 D LINK^HLUTIL3("200M",.HLL,"I")
68 ; get MPI domain DBIA 3335
69 S IEN=$O(HLL(0)) I +IEN>0 S TO=$$GET1^DIQ(870,+IEN_",",.03) I TO'="" S TO="S.MPI EXCEPTION SERVER@"_TO
70 Q TO
71 ;
72ADDDATA(LABEL,DATA) ;
73 ;Description: Adds one formated line to the message text containing the label and data value
74 ;Input:
75 ; LABEL - text label that identifies the type of data
76 ; DATA - data value
77 ;Output:none
78 ;
79 D ADDLINE(LABEL_":"_DATA)
80 Q
81ADDLINE(LINE) ;
82 ;Description: adds one one to the message text
83 ;Inputs:
84 ; LINE - the line of text to be added
85 ; RGMSG - @RGMSG is the location for the message text
86 ;Output: none
87 S @RGMSG@(($O(@RGMSG@(9999),-1)+1))=LINE
88 Q
89MAIL() ;
90 ;Description: Sends the message located at @RGMSG to the MPI Exception Handler
91 ;Input: message at @RGMSG
92 ;Output: If succssful, the function returns the mailman message number, otherwise, "" is returned
93 ;
94 N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM,SERVER
95 Q:'$D(@RGMSG) ""
96 S SERVER=$$SERVER
97 ;if the MPI server isn't returned default to the old MPIF EXCEPTIONS mail group
98 I SERVER="" S SERVER="MPIF EXCEPTIONS"
99 S XMDUZ="MPI/PD at "_$P($$SITE^VASITE(),"^",2)
100 S XMY(.5)=""
101 S XMY(SERVER)=""
102 S XMTEXT=$P(RGMSG,")")_","
103 S XMSUB="MPI/PD EXCEPTION"
104 D ^XMD
105 Q $G(XMZ)
106 ;
107GETMSG(MSGID,MSGARRAY) ;
108 ;Description: Retrieves data from the HL7 Message Administration file (#773) related to the message
109 ;Input:
110 ; MSGID - the message id (optional)
111 ; RGLOG(3) - if MSGID is not passed then RGLOG(3) is used to determine the message
112 ; HL("MID") - if MSGID and RGLOG(3) are not defined then HL("MID") is used to determine the message
113 ;
114 ;Output:
115 ; Function Value - 1 on success, 0 on failure
116 ; MSGARRAY() - (pass by reference) - returns the data
117 ; ("MESSAGE ID") - the HL7 message id
118 ; ("MESSAGE TYPE") - the HL7 message type
119 ; ("EVENT TYPE") - the HL7 event type
120 ; ("SENDING APPLICATION") - the name of the sending application
121 ; ("LOGICAL LINK") - the name of the HL Logical Link overwhich the message was received
122 ;
123 N MSGIEN
124 K MSGARRAY
125 I '$G(MSGID) D
126 .I $G(RGLOG(3)) S MSGID=$$GETFIELD^RGFIU(773,2,RGLOG(3)) Q:MSGID
127 .S MSGID=$G(HL("MID"))
128 Q:'MSGID 0
129 ;
130 S MSGIEN=$$IEN773^RGHLLOG(MSGID)
131 ;
132 S MSGARRAY("MESSAGE ID")=MSGID
133 S MSGARRAY("LOGICAL LINK")=$$GETFIELD^RGFIU(773,7,MSGIEN,,1)
134 S MSGARRAY("SENDING APPLICATION")=$$GETFIELD^RGFIU(773,13,MSGIEN,,1)
135 S MSGARRAY("MESSAGE TYPE")=$$GETFIELD^RGFIU(773,15,MSGIEN,,1)
136 S MSGARRAY("EVENT TYPE")=$$GETFIELD^RGFIU(773,16,MSGIEN,,1)
137 ;
138 ;this compensates for a bug in the HL7 package - the external form rather than the pointer values are being stored in file 773
139 I MSGID,'$L(MSGARRAY("MESSAGE TYPE")) S MSGARRAY("MESSAGE TYPE")=$$GETFIELD^RGFIU(773,15,MSGIEN)
140 I MSGID,'$L(MSGARRAY("EVENT TYPE")) S MSGARRAY("EVENT TYPE")=$$GETFIELD^RGFIU(773,16,MSGIEN)
141 ;
142 Q 1
Note: See TracBrowser for help on using the repository browser.