source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCIERR.m@ 1144

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1GMRCIERR ;SLC/JFR - process IFC message error alert ;07/08/03 11:16
2 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,35**;DEC 27, 1997
3 Q
4EN(GMRCLOG,GMRCDA,GMRCACT,GMRCRPT) ;start here
5 ;Build ^TMP array for processing alert
6 ;
7 K ^TMP("GMRCIERR",$J)
8 N GMRCPNM,GMRCACTV,GMRCERR,GMRCRP,GMRCEP,GMRCACTM,GMRCCOM,GMRCSS
9 N GMRCPROC,GMRCSITE,GMRCFCN,GMRCPT,GMRCSSN,VAHOW,VAROOT
10 I '$D(^GMR(123.6,GMRCLOG,0)) D Q
11 . S ^TMP("GMRCIERR",$J,1,0)="Message log entry no longer exists"
12 I $P(^GMR(123.6,GMRCLOG,0),U,4)'=GMRCDA D Q
13 . S ^TMP("GMRCIERR",$J,1,0)="Message log entry and Consult# don't match"
14 I $P(^GMR(123.6,GMRCLOG,0),U,5)'=GMRCACT D Q
15 . S ^TMP("GMRCIERR",$J,1,0)="Message log entry & activity# don't match"
16 S DFN=$P(^GMR(123,GMRCDA,0),U,2),VAROOT="GMRCPT",VAHOW=1
17 D DEM^VADPT
18 S GMRCPNM=GMRCPT("NM")
19 S GMRCSSN=$P(GMRCPT("SS"),U,2)
20 S GMRCACTV=$G(^GMR(123,GMRCDA,40,GMRCACT,0))
21 S GMRCRP=$$GET1^DIQ(200,+$P(GMRCACTV,U,4),.01)
22 S GMRCEP=$$GET1^DIQ(200,+$P(GMRCACTV,U,5),.01)
23 S GMRCACTM=$$FMTE^XLFDT($P(GMRCACTV,U,3))
24 S GMRCACTV=$$GET1^DIQ(123.1,$P(GMRCACTV,U,2),.01)
25 S GMRCCOM=$O(^GMR(123,GMRCDA,40,GMRCACT,1,0))
26 S GMRCSS=$$GET1^DIQ(123.5,+$P(^GMR(123,GMRCDA,0),U,5),.01)
27 S GMRCPROC=$$GET1^DIQ(123.3,+$P(^GMR(123,GMRCDA,0),U,8),.01)
28 S GMRCFCN=$P(^GMR(123,GMRCDA,0),U,22)
29 D F4^XUAF4($$STA^XUAF4($P(^GMR(123,GMRCDA,0),U,23)),.GMRCSITE)
30 N LN S LN=1
31 S ^TMP("GMRCIERR",$J,LN,0)="An error occurred transmitting the following inter-facility consult ",LN=LN+1
32 S ^TMP("GMRCIERR",$J,LN,0)="activity to "_GMRCSITE("NAME")_":",LN=LN+1
33 S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
34 S ^TMP("GMRCIERR",$J,LN,0)="Consult #: "_GMRCDA,LN=LN+1
35 S ^TMP("GMRCIERR",$J,LN,0)="Remote Consult #: "_GMRCFCN,LN=LN+1
36 S ^TMP("GMRCIERR",$J,LN,0)="Patient Name: "_GMRCPNM,LN=LN+1
37 S ^TMP("GMRCIERR",$J,LN,0)="SSN: "_GMRCSSN,LN=LN+1
38 S ^TMP("GMRCIERR",$J,LN,0)="To Service: "_GMRCSS,LN=LN+1
39 I $L(GMRCPROC) S ^TMP("GMRCIERR",$J,LN,0)="Procedure: "_GMRCPROC,LN=LN+1
40 S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
41 I '$D(GMRCRPT) D ACTLG(GMRCDA,GMRCACT,GMRCLOG,.LN)
42 Q
43ACTLG(GMRCDA,GMRCACT,LOG,LN) ;build activity log entry
44 N GMRCCT,TAB,GMRCERR,GMRCDIF
45 S TAB="",$P(TAB," ",30)=""
46 S GMRCERR=$T(@("ERR"_$P(^GMR(123.6,LOG,0),U,8)_"^GMRCIUTL"))
47 S GMRCERR=$S($L(GMRCERR):$P(GMRCERR,";",2),1:"Technical error")
48 S ^TMP("GMRCIERR",$J,LN,0)="Activity #: "_GMRCACT,LN=LN+1
49 S ^TMP("GMRCIERR",$J,LN,0)="Activity"_$E(TAB,1,17)_"Date/Time/Zone"_$E(TAB,1,6)_"Responsible Person"_$E(TAB,1,2)_"Entered By",LN=LN+1
50 S GMRCCT=LN
51 D BLDALN^GMRCSLM4(GMRCDA,GMRCACT)
52 S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
53 S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
54 S ^TMP("GMRCIERR",$J,LN,0)="The error was: "_GMRCERR
55 M ^TMP("GMRCIERR",$J)=^TMP("GMRCR",$J,"DT")
56 K ^TMP("GMRCR",$J,"DT")
57 Q
58 ;
59DIALOG(GMRCDATA) ;ask user what to do based on error and activity
60 ;Input:
61 ; GMRCDATA = XQADATA from alert handler
62 ; in form: IFC_msg_log#|consult#|activity#
63 ;
64 ;Output:
65 ; value to set XQAKILL to
66 N DIR,X,Y,LN,DUOUT,DTOUT
67 D EN($P(GMRCDATA,"|"),$P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3))
68 W @IOF
69 S LN=0 F S LN=$O(^TMP("GMRCIERR",$J,LN)) Q:'LN W !,^(LN,0)
70 W !
71 I $O(^TMP("GMRCIERR",$J," "),-1)<2 Q 0 ;some problem so delete alert
72 S DIR(0)="E" D ^DIR
73 I $D(DTOUT)!($D(DUOUT)) Q "@"
74 W !
75 I $O(^GMR(123.6,"AC",$P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3)),-1) D Q "@"
76 . W !,"There is at least one earlier incomplete transaction for this"
77 . W !,"consult, all incomplete transactions should be processed in "
78 . W !,"order.",!
79 . W !,"You can use the List incomplete IFC transactions option to"
80 . W !,"locate and process the incomplete transactions for this consult."
81 . S DIR(0)="E" D ^DIR
82 S DIR(0)="YA",DIR("B")="N"
83 S DIR("A",1)="If you have corrected this problem you may resend this activity!"
84 S DIR("A",2)=" "
85 S DIR("A")="Do you want to retransmit this? " D ^DIR
86 I $G(Y)=1 D Q 0
87 . D TRIGR^GMRCIEVT($P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3)) ; re-transmit
88 K DIR
89 W !
90 S DIR(0)="YA",DIR("B")="N"
91 S DIR("A")="Do you want to delete this alert for all recipients? "
92 D ^DIR
93 I $G(Y)=1 Q 0
94 W !
95 S DIR(0)="YA",DIR("B")="N"
96 S DIR("A")="Do you want to delete this alert for yourself only? "
97 D ^DIR
98 I $G(Y)=1 Q 1
99 Q "@"
100 ;
101FOLLUP ;action to take from alert
102 S XQAKILL=$$DIALOG(XQADATA)
103 I XQAKILL="@" K XQAKILL
104 K ^TMP("GMRCIERR",$J)
105 Q
106 ;
107SNDALRT(GMRCLOG,TYPE,XQAMSG) ; send an alert on some errors
108 ;Input:
109 ; GMRCLOG = IFC MESSAGE LOG entry
110 ; TYPE = "C" for a clinical error, "T" for a technical error
111 ;
112 N XQA,XQAROU,XQADATA,XQAID,GROUP,GMRCACT,GMRCDA,GMRCLOG0
113 S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0)) Q:'$L(GMRCLOG0)
114 S GMRCDA=$P(GMRCLOG0,U,4) Q:'GMRCDA
115 S GMRCACT=$P(GMRCLOG0,U,5) Q:'GMRCACT
116 S GROUP=$S(TYPE="C":"G.IFC CLIN ERRORS",1:"G.IFC TECH ERRORS")
117 S XQA(GROUP)=""
118 I '$D(XQAMSG) S XQAMSG="Failed IFC transaction"
119 S XQAROU="FOLLUP^GMRCIERR"
120 S XQAID="GMRCIFC,trans error,"_GMRCLOG
121 S XQADATA=GMRCLOG_"|"_GMRCDA_"|"_GMRCACT
122 D SETUP^XQALERT
123 Q
124PTERRMSG(GMRCPID,GMRCSTA,GMRCDOM,GMRCOBR) ;send IFC pt err to mail group
125 ;Input:
126 ; GMRCPID = PID seg from IFC message
127 ; GMRCSTA = station # of site where message originated
128 ; GMRCDOM = domain to send the message to, if defined (optional)
129 ; GMRCOBR = OBR segment from IFC msg (optional)
130 ;
131 ;Output:
132 ; mail message containing patient demographics
133 ;
134 N GMRCGRP,GMRCMSG,GMRCNM,GMRCNAM,GMRCDOB
135 N XMERR,GMRCSUB,GMRCSITE,GMRCERR,GMRCICN
136 N XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
137 S GMRCNAM=$P(GMRCPID,"|",5)
138 S GMRCNM("FAMILY")=$P(GMRCNAM,U),GMRCNM("GIVEN")=$P(GMRCNAM,U,2)
139 S GMRCNM("MIDDLE")=$P(GMRCNAM,U,3),GMRCNM("SUFFIX")=$P(GMRCNAM,U,4)
140 S GMRCNAM=$$NAMEFMT^XLFNAME(.GMRCNM,"F","CL56Xc")
141 S GMRCDOB=$$HL7TFM^XLFDT($P(GMRCPID,"|",7))
142 S GMRCDOB=$$FMTE^XLFDT(GMRCDOB)
143 S GMRCICN=+$P(GMRCPID,"|",2)
144 D F4^XUAF4(GMRCSTA,.GMRCSITE)
145 S GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
146 S GMRCMSG(2,0)="The patient has either never been registered at your facility or the national"
147 S GMRCMSG(3,0)="MPI ICN for this patient at your site does not match that from the requesting"
148 S GMRCMSG(4,0)="site. Please refer to the Master Patient Index/Patient Demographics (MPI/PD)"
149 S GMRCMSG(5,0)="User Manual and Master Patient Index/Patient Demographics Exception"
150 S GMRCMSG(6,0)="Handling Manuals to resolve this error so the request may be processed."
151 S GMRCMSG(7,0)=" ",GMRCMSG(8,0)=" "
152 S GMRCMSG(9,0)="Patient demographics from "_GMRCSITE("NAME")
153 S GMRCMSG(10,0)=" Patient name: "_GMRCNAM
154 S GMRCMSG(11,0)=" SSN: "_$P(GMRCPID,"|",19)
155 S GMRCMSG(12,0)=" Date of birth: "_GMRCDOB
156 S GMRCMSG(13,0)=" Sex: "_$P(GMRCPID,"|",8)
157 S GMRCMSG(14,0)=" Remote ICN: "_GMRCICN
158 S GMRCMSG(15,0)=" "
159 I $L($G(GMRCOBR)) D
160 . N GMRCITM
161 . S GMRCITM=$P(GMRCOBR,"|",4)
162 . I GMRCITM["VA1235" S GMRCITM="Ordered service: "_$P(GMRCITM,U,2)
163 . I GMRCITM["VA1233" S GMRCITM=" Ordered proc.: "_$P(GMRCITM,U,2)
164 . S GMRCMSG(16,0)=GMRCITM
165 S GMRCMSG(17,0)=" "
166 S GMRCMSG(18,0)=" The error is: Unknown Patient (201)"
167 ;
168 D ; set XMY to local group or remote group
169 . I $D(GMRCDOM) S XMY("G.IFC CLIN ERRORS@"_GMRCDOM)="" Q
170 . S XMY("G.IFC PATIENT ERROR MESSAGES")=""
171 S XMSUB="Incoming IFC patient error, "_GMRCNAM
172 S XMDUZ="Consult/Request Tracking Package"
173 S XMTEXT="GMRCMSG("
174 D ^XMD
175 Q
176 ;
177PTMPIER(GMRCDFN) ;send IFC local MPI error to MAS mail group
178 ;Input:
179 ; GMRCDFN = DFN from file 2 of patient with MPI problem
180 ;
181 ;Output:
182 ; mail message containing patient demographics
183 ;
184 N DFN,GMRCPT,GMRCMSG,VAHOW,VAROOT
185 N XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
186 S DFN=GMRCDFN,VAHOW=1,VAROOT="GMRCPT"
187 D DEM^VADPT
188 S GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
189 S GMRCMSG(2,0)="The PATIENT file is either missing an ICN or contains a local ICN."
190 S GMRCMSG(3,0)="Please refer to the Master Patient Index/Patient Demographics(MPI/PD) User"
191 S GMRCMSG(4,0)="and Master Patient Index/Patient Demographics Exception Handling Manuals"
192 S GMRCMSG(5,0)="to resolve this error so request may be processed."
193 S GMRCMSG(6,0)=" "
194 S GMRCMSG(7,0)=" Patient name: "_GMRCPT("NM")
195 S GMRCMSG(8,0)=" SSN: "_$P(GMRCPT("SS"),U,2)
196 S GMRCMSG(9,0)=" Date of birth: "_$P(GMRCPT("DB"),U,2)
197 S GMRCMSG(10,0)=" Sex: "_$P(GMRCPT("SX"),U,2)
198 S GMRCMSG(11,0)=" "
199 S GMRCMSG(12,0)=" The error is: Local or unknown MPI identifiers (202)"
200 ;
201 S XMY("G.IFC PATIENT ERROR MESSAGES")=""
202 S XMSUB="Outgoing IFC patient error, "_GMRCPT("NM")
203 S XMDUZ="Consult/Request Tracking Package"
204 S XMTEXT="GMRCMSG("
205 D ^XMD
206 Q
Note: See TracBrowser for help on using the repository browser.