GMRCIERR ;SLC/JFR - process IFC message error alert ;07/08/03 11:16
;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,35,58,167**;DEC 27, 1997;Build 22
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
EN(GMRCLOG,GMRCDA,GMRCACT,GMRCRPT) ;start here
;Build ^TMP array for processing alert
;
K ^TMP("GMRCIERR",$J)
N GMRCPNM,GMRCACTV,GMRCERR,GMRCRP,GMRCEP,GMRCACTM,GMRCCOM,GMRCSS
N GMRCPROC,GMRCSITE,GMRCFCN,GMRCPT,GMRCSSN,VAHOW,VAROOT
I '$D(^GMR(123.6,GMRCLOG,0)) D Q
. S ^TMP("GMRCIERR",$J,1,0)="Message log entry no longer exists"
I $P(^GMR(123.6,GMRCLOG,0),U,4)'=GMRCDA D Q
. S ^TMP("GMRCIERR",$J,1,0)="Message log entry and Consult# don't match"
I $P(^GMR(123.6,GMRCLOG,0),U,5)'=GMRCACT D Q
. S ^TMP("GMRCIERR",$J,1,0)="Message log entry & activity# don't match"
S DFN=$P(^GMR(123,GMRCDA,0),U,2),VAROOT="GMRCPT",VAHOW=1
D DEM^VADPT
S GMRCPNM=GMRCPT("NM")
S GMRCSSN=$P(GMRCPT("SS"),U,2)
S GMRCACTV=$G(^GMR(123,GMRCDA,40,GMRCACT,0))
S GMRCRP=$$GET1^DIQ(200,+$P(GMRCACTV,U,4),.01)
S GMRCEP=$$GET1^DIQ(200,+$P(GMRCACTV,U,5),.01)
S GMRCACTM=$$FMTE^XLFDT($P(GMRCACTV,U,3))
S GMRCACTV=$$GET1^DIQ(123.1,$P(GMRCACTV,U,2),.01)
S GMRCCOM=$O(^GMR(123,GMRCDA,40,GMRCACT,1,0))
S GMRCSS=$$GET1^DIQ(123.5,+$P(^GMR(123,GMRCDA,0),U,5),.01)
S GMRCPROC=$$GET1^DIQ(123.3,+$P(^GMR(123,GMRCDA,0),U,8),.01)
S GMRCFCN=$P(^GMR(123,GMRCDA,0),U,22)
D F4^XUAF4($$STA^XUAF4($P(^GMR(123,GMRCDA,0),U,23)),.GMRCSITE)
N LN S LN=1
S ^TMP("GMRCIERR",$J,LN,0)="An error occurred transmitting the following inter-facility consult ",LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="activity to "_GMRCSITE("NAME")_":",LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="Consult #: "_GMRCDA,LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="Remote Consult #: "_GMRCFCN,LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="Patient Name: "_GMRCPNM,LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="SSN: "_GMRCSSN,LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="To Service: "_GMRCSS,LN=LN+1
I $L(GMRCPROC) S ^TMP("GMRCIERR",$J,LN,0)="Procedure: "_GMRCPROC,LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
I '$D(GMRCRPT) D ACTLG(GMRCDA,GMRCACT,GMRCLOG,.LN)
Q
ACTLG(GMRCDA,GMRCACT,LOG,LN) ;build activity log entry
N GMRCCT,TAB,GMRCERR,GMRCDIF
S TAB="",$P(TAB," ",30)=""
S GMRCERR=$T(@("ERR"_$P(^GMR(123.6,LOG,0),U,8)_"^GMRCIUTL"))
S GMRCERR=$S($L(GMRCERR):$P(GMRCERR,";",2),1:"Technical error")
S ^TMP("GMRCIERR",$J,LN,0)="Activity #: "_GMRCACT,LN=LN+1
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
S GMRCCT=LN
D BLDALN^GMRCSLM4(GMRCDA,GMRCACT)
S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
S ^TMP("GMRCIERR",$J,LN,0)="The error was: "_GMRCERR
M ^TMP("GMRCIERR",$J)=^TMP("GMRCR",$J,"DT")
K ^TMP("GMRCR",$J,"DT")
Q
;
DIALOG(GMRCDATA) ;ask user what to do based on error and activity
;Input:
; GMRCDATA = XQADATA from alert handler
; in form: IFC_msg_log#|consult#|activity#
;
;Output:
; value to set XQAKILL to
N DIR,X,Y,LN,DUOUT,DTOUT
D EN($P(GMRCDATA,"|"),$P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3))
W @IOF
S LN=0 F S LN=$O(^TMP("GMRCIERR",$J,LN)) Q:'LN W !,^(LN,0)
W !
I $O(^TMP("GMRCIERR",$J," "),-1)<2 Q 0 ;some problem so delete alert
S DIR(0)="E" D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q "@"
W !
I $O(^GMR(123.6,"AC",$P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3)),-1) D Q "@"
. W !,"There is at least one earlier incomplete transaction for this"
. W !,"consult, all incomplete transactions should be processed in "
. W !,"order.",!
. W !,"You can use the List incomplete IFC transactions option to"
. W !,"locate and process the incomplete transactions for this consult."
. S DIR(0)="E" D ^DIR
S DIR(0)="YA",DIR("B")="N"
S DIR("A",1)="If you have corrected this problem you may resend this activity!"
S DIR("A",2)=" "
S DIR("A")="Do you want to retransmit this? " D ^DIR
I $G(Y)=1 D Q 0
. D TRIGR^GMRCIEVT($P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3)) ; re-transmit
K DIR
W !
S DIR(0)="YA",DIR("B")="N"
S DIR("A")="Do you want to delete this alert for all recipients? "
D ^DIR
I $G(Y)=1 Q 0
W !
S DIR(0)="YA",DIR("B")="N"
S DIR("A")="Do you want to delete this alert for yourself only? "
D ^DIR
I $G(Y)=1 Q 1
Q "@"
;
FOLLUP ;action to take from alert
S XQAKILL=$$DIALOG(XQADATA)
I XQAKILL="@" K XQAKILL
K ^TMP("GMRCIERR",$J)
Q
;
SNDALRT(GMRCLOG,TYPE,XQAMSG) ; send an alert on some errors
;Input:
; GMRCLOG = IFC MESSAGE LOG entry
; TYPE = "C" for a clinical error, "T" for a technical error
;
N XQA,XQAROU,XQADATA,XQAID,GROUP,GMRCACT,GMRCDA,GMRCLOG0
S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0)) Q:'$L(GMRCLOG0)
S GMRCDA=$P(GMRCLOG0,U,4) Q:'GMRCDA
S GMRCACT=$P(GMRCLOG0,U,5) Q:'GMRCACT
S GROUP=$S(TYPE="C":"G.IFC CLIN ERRORS",1:"G.IFC TECH ERRORS")
S XQA(GROUP)=""
I '$D(XQAMSG) S XQAMSG="Failed IFC transaction"
S XQAROU="FOLLUP^GMRCIERR"
S XQAID="GMRCIFC,trans error,"_GMRCLOG
S XQADATA=GMRCLOG_"|"_GMRCDA_"|"_GMRCACT
D SETUP^XQALERT
Q
PTERRMSG(GMRCPID,GMRCSTA,GMRCDOM,GMRCOBR,GMRCCRNR,GMRCMSGI) ;send IFC pt err to mail group ;MKN 167 Added GMRCCRNR,GMRCMSGI parameters
;Input:
; GMRCPID = PID seg from IFC message
; GMRCSTA = station # of site where message originated
; GMRCDOM = domain to send the message to, if defined (optional)
; GMRCOBR = OBR segment from IFC msg (optional)
; GMRCCRNR = Set to 1 if IFC consult from Cerner
; GMRCMSGI = Present if IFC consult from Cerner
;
;Output:
; mail message containing patient demographics
;
N GMRCGRP,GMRCMSG,GMRCNM,GMRCNAM,GMRCDOB
N XMERR,GMRCSUB,GMRCSITE,GMRCERR,GMRCICN
N XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
S GMRCCRNR=$G(GMRCCRNR),GMRCMSGI=$G(GMRCMSGI) ;MKN 167
S GMRCNAM=$P(GMRCPID,"|",5)
S GMRCNM("FAMILY")=$P(GMRCNAM,U),GMRCNM("GIVEN")=$P(GMRCNAM,U,2)
S GMRCNM("MIDDLE")=$P(GMRCNAM,U,3),GMRCNM("SUFFIX")=$P(GMRCNAM,U,4)
S GMRCNAM=$$NAMEFMT^XLFNAME(.GMRCNM,"F","CL56Xc")
S GMRCDOB=$$HL7TFM^XLFDT($P(GMRCPID,"|",7))
S GMRCDOB=$$FMTE^XLFDT(GMRCDOB)
S GMRCICN=+$P(GMRCPID,"|",2)
D F4^XUAF4(GMRCSTA,.GMRCSITE)
S GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
S GMRCMSG(2,0)="The patient has either never been registered at your facility or the national"
S GMRCMSG(3,0)="MPI ICN for this patient at your site does not match that from the requesting"
S GMRCMSG(4,0)="site. Please refer to the Master Patient Index/Patient Demographics (MPI/PD)"
S GMRCMSG(5,0)="User Manual and Master Patient Index/Patient Demographics Exception"
S GMRCMSG(6,0)="Handling Manuals to resolve this error so the request may be processed."
S GMRCMSG(7,0)=" ",GMRCMSG(8,0)=" "
S GMRCMSG(9,0)="Patient demographics from "_GMRCSITE("NAME")
S GMRCMSG(10,0)=" Patient name: "_GMRCNAM
S GMRCMSG(11,0)=" SSN: "_$P(GMRCPID,"|",19)
S GMRCMSG(12,0)=" Date of birth: "_GMRCDOB
S GMRCMSG(13,0)=" Sex: "_$P(GMRCPID,"|",8)
S GMRCMSG(14,0)=" Remote ICN: "_GMRCICN
S GMRCMSG(15,0)=" "
;
S XMSUB="Incoming IFC patient error, "_GMRCNAM
S XMDUZ="Consult/Request Tracking Package"
D XMZ^XMA2
I $L($G(GMRCOBR)) D
. N GMRCITM
. S GMRCITM=$P(GMRCOBR,"|",4)
. I $P(GMRCITM,U,2)["SUICIDE HOTLINE" D
.. N DIE,DA,DR
.. S DIE=3.9,DA=XMZ,DR="1.7////P" D ^DIE K DIE,DA,DR
. I GMRCITM["VA1235" S GMRCITM="Ordered service: "_$P(GMRCITM,U,2)
. I GMRCITM["VA1233" S GMRCITM=" Ordered proc.: "_$P(GMRCITM,U,2)
. S GMRCMSG(16,0)=GMRCITM
S GMRCMSG(17,0)=" "
S GMRCMSG(18,0)="The error is: Unknown Patient (201)"
D ; set XMY to local group or remote group
. I $D(GMRCDOM) S XMY("G.IFC CLIN ERRORS@"_GMRCDOM)="" Q
. S XMY("G.IFC PATIENT ERROR MESSAGES")=""
S XMTEXT="GMRCMSG("
D EN1^XMD
;MKN 167 If consult was from Cerner, send message to GMRC TIER II CRNR IFC ERRORS without PII (Goes through Outlook)
Q:'GMRCCRNR
K GMRCMSG,XMY
S GMRCMSG(1,0)="An Inter-facility consult has been received from Cerner with"
S GMRCMSG(2,0)="message ID "_$S(GMRCMSGI]"":$P(GMRCMSGI,U)_" "_$P(GMRCMSGI,U,2),1:"Not known")
S GMRCMSG(3,0)=" "
S GMRCMSG(4,0)="The error is: Unknown Patient (201)"
S XMSUB="Incoming IFC patient error"
S XMDUZ="Consult/Request Tracking Package"
D XMZ^XMA2
D ; set XMY to local group or remote group
. I $D(GMRCDOM) S XMY("G.IFC CLIN ERRORS@"_GMRCDOM)="" Q
. S XMY("G.GMRC TIER II CRNR IFC ERRORS")=""
S XMTEXT="GMRCMSG("
D EN1^XMD
;MKN 167 End of GMRC TIER II CRNR IFC ERRORS message
Q
;
PTMPIER(GMRCDFN) ;send IFC local MPI error to MAS mail group
;Input:
; GMRCDFN = DFN from file 2 of patient with MPI problem
;
;Output:
; mail message containing patient demographics
;
N DFN,GMRCPT,GMRCMSG,VAHOW,VAROOT
N XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
S DFN=GMRCDFN,VAHOW=1,VAROOT="GMRCPT"
D DEM^VADPT
S GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
S GMRCMSG(2,0)="The PATIENT file is either missing an ICN or contains a local ICN."
S GMRCMSG(3,0)="Please refer to the Master Patient Index/Patient Demographics(MPI/PD) User"
S GMRCMSG(4,0)="and Master Patient Index/Patient Demographics Exception Handling Manuals"
S GMRCMSG(5,0)="to resolve this error so request may be processed."
S GMRCMSG(6,0)=" "
S GMRCMSG(7,0)=" Patient name: "_GMRCPT("NM")
S GMRCMSG(8,0)=" SSN: "_$P(GMRCPT("SS"),U,2)
S GMRCMSG(9,0)=" Date of birth: "_$P(GMRCPT("DB"),U,2)
S GMRCMSG(10,0)=" Sex: "_$P(GMRCPT("SX"),U,2)
S GMRCMSG(11,0)=" "
S GMRCMSG(12,0)=" The error is: Local or unknown MPI identifiers (202)"
S XMY("G.IFC PATIENT ERROR MESSAGES")=""
S XMSUB="Outgoing IFC patient error, "_GMRCPT("NM")
S XMDUZ="Consult/Request Tracking Package"
S XMTEXT="GMRCMSG("
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCIERR 9831 printed Apr 09, 2024@20:50:37 Page 2
GMRCIERR ;SLC/JFR - process IFC message error alert ;07/08/03 11:16
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,35,58,167**;DEC 27, 1997;Build 22
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
EN(GMRCLOG,GMRCDA,GMRCACT,GMRCRPT) ;start here
+1 ;Build ^TMP array for processing alert
+2 ;
+3 KILL ^TMP("GMRCIERR",$JOB)
+4 NEW GMRCPNM,GMRCACTV,GMRCERR,GMRCRP,GMRCEP,GMRCACTM,GMRCCOM,GMRCSS
+5 NEW GMRCPROC,GMRCSITE,GMRCFCN,GMRCPT,GMRCSSN,VAHOW,VAROOT
+6 IF '$DATA(^GMR(123.6,GMRCLOG,0))
Begin DoDot:1
+7 SET ^TMP("GMRCIERR",$JOB,1,0)="Message log entry no longer exists"
End DoDot:1
QUIT
+8 IF $PIECE(^GMR(123.6,GMRCLOG,0),U,4)'=GMRCDA
Begin DoDot:1
+9 SET ^TMP("GMRCIERR",$JOB,1,0)="Message log entry and Consult# don't match"
End DoDot:1
QUIT
+10 IF $PIECE(^GMR(123.6,GMRCLOG,0),U,5)'=GMRCACT
Begin DoDot:1
+11 SET ^TMP("GMRCIERR",$JOB,1,0)="Message log entry & activity# don't match"
End DoDot:1
QUIT
+12 SET DFN=$PIECE(^GMR(123,GMRCDA,0),U,2)
SET VAROOT="GMRCPT"
SET VAHOW=1
+13 DO DEM^VADPT
+14 SET GMRCPNM=GMRCPT("NM")
+15 SET GMRCSSN=$PIECE(GMRCPT("SS"),U,2)
+16 SET GMRCACTV=$GET(^GMR(123,GMRCDA,40,GMRCACT,0))
+17 SET GMRCRP=$$GET1^DIQ(200,+$PIECE(GMRCACTV,U,4),.01)
+18 SET GMRCEP=$$GET1^DIQ(200,+$PIECE(GMRCACTV,U,5),.01)
+19 SET GMRCACTM=$$FMTE^XLFDT($PIECE(GMRCACTV,U,3))
+20 SET GMRCACTV=$$GET1^DIQ(123.1,$PIECE(GMRCACTV,U,2),.01)
+21 SET GMRCCOM=$ORDER(^GMR(123,GMRCDA,40,GMRCACT,1,0))
+22 SET GMRCSS=$$GET1^DIQ(123.5,+$PIECE(^GMR(123,GMRCDA,0),U,5),.01)
+23 SET GMRCPROC=$$GET1^DIQ(123.3,+$PIECE(^GMR(123,GMRCDA,0),U,8),.01)
+24 SET GMRCFCN=$PIECE(^GMR(123,GMRCDA,0),U,22)
+25 DO F4^XUAF4($$STA^XUAF4($PIECE(^GMR(123,GMRCDA,0),U,23)),.GMRCSITE)
+26 NEW LN
SET LN=1
+27 SET ^TMP("GMRCIERR",$JOB,LN,0)="An error occurred transmitting the following inter-facility consult "
SET LN=LN+1
+28 SET ^TMP("GMRCIERR",$JOB,LN,0)="activity to "_GMRCSITE("NAME")_":"
SET LN=LN+1
+29 SET ^TMP("GMRCIERR",$JOB,LN,0)=""
SET LN=LN+1
+30 SET ^TMP("GMRCIERR",$JOB,LN,0)="Consult #: "_GMRCDA
SET LN=LN+1
+31 SET ^TMP("GMRCIERR",$JOB,LN,0)="Remote Consult #: "_GMRCFCN
SET LN=LN+1
+32 SET ^TMP("GMRCIERR",$JOB,LN,0)="Patient Name: "_GMRCPNM
SET LN=LN+1
+33 SET ^TMP("GMRCIERR",$JOB,LN,0)="SSN: "_GMRCSSN
SET LN=LN+1
+34 SET ^TMP("GMRCIERR",$JOB,LN,0)="To Service: "_GMRCSS
SET LN=LN+1
+35 IF $LENGTH(GMRCPROC)
SET ^TMP("GMRCIERR",$JOB,LN,0)="Procedure: "_GMRCPROC
SET LN=LN+1
+36 SET ^TMP("GMRCIERR",$JOB,LN,0)=""
SET LN=LN+1
+37 IF '$DATA(GMRCRPT)
DO ACTLG(GMRCDA,GMRCACT,GMRCLOG,.LN)
+38 QUIT
ACTLG(GMRCDA,GMRCACT,LOG,LN) ;build activity log entry
+1 NEW GMRCCT,TAB,GMRCERR,GMRCDIF
+2 SET TAB=""
SET $PIECE(TAB," ",30)=""
+3 SET GMRCERR=$TEXT(@("ERR"_$PIECE(^GMR(123.6,LOG,0),U,8)_"^GMRCIUTL"))
+4 SET GMRCERR=$SELECT($LENGTH(GMRCERR):$PIECE(GMRCERR,";",2),1:"Technical error")
+5 SET ^TMP("GMRCIERR",$JOB,LN,0)="Activity #: "_GMRCACT
SET LN=LN+1
+6 SET ^TMP("GMRCIERR",$JOB,LN,0)="Activity"_$EXTRACT(TAB,1,17)_"Date/Time/Zone"_$EXTRACT(TAB,1,6)_"Responsible Person"_$EXTRACT(TAB,1,2)_"Entered By"
SET LN=LN+1
+7 SET GMRCCT=LN
+8 DO BLDALN^GMRCSLM4(GMRCDA,GMRCACT)
+9 SET ^TMP("GMRCIERR",$JOB,LN,0)=""
SET LN=LN+1
+10 SET ^TMP("GMRCIERR",$JOB,LN,0)=""
SET LN=LN+1
+11 SET ^TMP("GMRCIERR",$JOB,LN,0)="The error was: "_GMRCERR
+12 MERGE ^TMP("GMRCIERR",$JOB)=^TMP("GMRCR",$JOB,"DT")
+13 KILL ^TMP("GMRCR",$JOB,"DT")
+14 QUIT
+15 ;
DIALOG(GMRCDATA) ;ask user what to do based on error and activity
+1 ;Input:
+2 ; GMRCDATA = XQADATA from alert handler
+3 ; in form: IFC_msg_log#|consult#|activity#
+4 ;
+5 ;Output:
+6 ; value to set XQAKILL to
+7 NEW DIR,X,Y,LN,DUOUT,DTOUT
+8 DO EN($PIECE(GMRCDATA,"|"),$PIECE(GMRCDATA,"|",2),$PIECE(GMRCDATA,"|",3))
+9 WRITE @IOF
+10 SET LN=0
FOR
SET LN=$ORDER(^TMP("GMRCIERR",$JOB,LN))
if 'LN
QUIT
WRITE !,^(LN,0)
+11 WRITE !
+12 ;some problem so delete alert
IF $ORDER(^TMP("GMRCIERR",$JOB," "),-1)<2
QUIT 0
+13 SET DIR(0)="E"
DO ^DIR
+14 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT "@"
+15 WRITE !
+16 IF $ORDER(^GMR(123.6,"AC",$PIECE(GMRCDATA,"|",2),$PIECE(GMRCDATA,"|",3)),-1)
Begin DoDot:1
+17 WRITE !,"There is at least one earlier incomplete transaction for this"
+18 WRITE !,"consult, all incomplete transactions should be processed in "
+19 WRITE !,"order.",!
+20 WRITE !,"You can use the List incomplete IFC transactions option to"
+21 WRITE !,"locate and process the incomplete transactions for this consult."
+22 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT "@"
+23 SET DIR(0)="YA"
SET DIR("B")="N"
+24 SET DIR("A",1)="If you have corrected this problem you may resend this activity!"
+25 SET DIR("A",2)=" "
+26 SET DIR("A")="Do you want to retransmit this? "
DO ^DIR
+27 IF $GET(Y)=1
Begin DoDot:1
+28 ; re-transmit
DO TRIGR^GMRCIEVT($PIECE(GMRCDATA,"|",2),$PIECE(GMRCDATA,"|",3))
End DoDot:1
QUIT 0
+29 KILL DIR
+30 WRITE !
+31 SET DIR(0)="YA"
SET DIR("B")="N"
+32 SET DIR("A")="Do you want to delete this alert for all recipients? "
+33 DO ^DIR
+34 IF $GET(Y)=1
QUIT 0
+35 WRITE !
+36 SET DIR(0)="YA"
SET DIR("B")="N"
+37 SET DIR("A")="Do you want to delete this alert for yourself only? "
+38 DO ^DIR
+39 IF $GET(Y)=1
QUIT 1
+40 QUIT "@"
+41 ;
FOLLUP ;action to take from alert
+1 SET XQAKILL=$$DIALOG(XQADATA)
+2 IF XQAKILL="@"
KILL XQAKILL
+3 KILL ^TMP("GMRCIERR",$JOB)
+4 QUIT
+5 ;
SNDALRT(GMRCLOG,TYPE,XQAMSG) ; send an alert on some errors
+1 ;Input:
+2 ; GMRCLOG = IFC MESSAGE LOG entry
+3 ; TYPE = "C" for a clinical error, "T" for a technical error
+4 ;
+5 NEW XQA,XQAROU,XQADATA,XQAID,GROUP,GMRCACT,GMRCDA,GMRCLOG0
+6 SET GMRCLOG0=$GET(^GMR(123.6,GMRCLOG,0))
if '$LENGTH(GMRCLOG0)
QUIT
+7 SET GMRCDA=$PIECE(GMRCLOG0,U,4)
if 'GMRCDA
QUIT
+8 SET GMRCACT=$PIECE(GMRCLOG0,U,5)
if 'GMRCACT
QUIT
+9 SET GROUP=$SELECT(TYPE="C":"G.IFC CLIN ERRORS",1:"G.IFC TECH ERRORS")
+10 SET XQA(GROUP)=""
+11 IF '$DATA(XQAMSG)
SET XQAMSG="Failed IFC transaction"
+12 SET XQAROU="FOLLUP^GMRCIERR"
+13 SET XQAID="GMRCIFC,trans error,"_GMRCLOG
+14 SET XQADATA=GMRCLOG_"|"_GMRCDA_"|"_GMRCACT
+15 DO SETUP^XQALERT
+16 QUIT
PTERRMSG(GMRCPID,GMRCSTA,GMRCDOM,GMRCOBR,GMRCCRNR,GMRCMSGI) ;send IFC pt err to mail group ;MKN 167 Added GMRCCRNR,GMRCMSGI parameters
+1 ;Input:
+2 ; GMRCPID = PID seg from IFC message
+3 ; GMRCSTA = station # of site where message originated
+4 ; GMRCDOM = domain to send the message to, if defined (optional)
+5 ; GMRCOBR = OBR segment from IFC msg (optional)
+6 ; GMRCCRNR = Set to 1 if IFC consult from Cerner
+7 ; GMRCMSGI = Present if IFC consult from Cerner
+8 ;
+9 ;Output:
+10 ; mail message containing patient demographics
+11 ;
+12 NEW GMRCGRP,GMRCMSG,GMRCNM,GMRCNAM,GMRCDOB
+13 NEW XMERR,GMRCSUB,GMRCSITE,GMRCERR,GMRCICN
+14 NEW XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
+15 ;MKN 167
SET GMRCCRNR=$GET(GMRCCRNR)
SET GMRCMSGI=$GET(GMRCMSGI)
+16 SET GMRCNAM=$PIECE(GMRCPID,"|",5)
+17 SET GMRCNM("FAMILY")=$PIECE(GMRCNAM,U)
SET GMRCNM("GIVEN")=$PIECE(GMRCNAM,U,2)
+18 SET GMRCNM("MIDDLE")=$PIECE(GMRCNAM,U,3)
SET GMRCNM("SUFFIX")=$PIECE(GMRCNAM,U,4)
+19 SET GMRCNAM=$$NAMEFMT^XLFNAME(.GMRCNM,"F","CL56Xc")
+20 SET GMRCDOB=$$HL7TFM^XLFDT($PIECE(GMRCPID,"|",7))
+21 SET GMRCDOB=$$FMTE^XLFDT(GMRCDOB)
+22 SET GMRCICN=+$PIECE(GMRCPID,"|",2)
+23 DO F4^XUAF4(GMRCSTA,.GMRCSITE)
+24 SET GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
+25 SET GMRCMSG(2,0)="The patient has either never been registered at your facility or the national"
+26 SET GMRCMSG(3,0)="MPI ICN for this patient at your site does not match that from the requesting"
+27 SET GMRCMSG(4,0)="site. Please refer to the Master Patient Index/Patient Demographics (MPI/PD)"
+28 SET GMRCMSG(5,0)="User Manual and Master Patient Index/Patient Demographics Exception"
+29 SET GMRCMSG(6,0)="Handling Manuals to resolve this error so the request may be processed."
+30 SET GMRCMSG(7,0)=" "
SET GMRCMSG(8,0)=" "
+31 SET GMRCMSG(9,0)="Patient demographics from "_GMRCSITE("NAME")
+32 SET GMRCMSG(10,0)=" Patient name: "_GMRCNAM
+33 SET GMRCMSG(11,0)=" SSN: "_$PIECE(GMRCPID,"|",19)
+34 SET GMRCMSG(12,0)=" Date of birth: "_GMRCDOB
+35 SET GMRCMSG(13,0)=" Sex: "_$PIECE(GMRCPID,"|",8)
+36 SET GMRCMSG(14,0)=" Remote ICN: "_GMRCICN
+37 SET GMRCMSG(15,0)=" "
+38 ;
+39 SET XMSUB="Incoming IFC patient error, "_GMRCNAM
+40 SET XMDUZ="Consult/Request Tracking Package"
+41 DO XMZ^XMA2
+42 IF $LENGTH($GET(GMRCOBR))
Begin DoDot:1
+43 NEW GMRCITM
+44 SET GMRCITM=$PIECE(GMRCOBR,"|",4)
+45 IF $PIECE(GMRCITM,U,2)["SUICIDE HOTLINE"
Begin DoDot:2
+46 NEW DIE,DA,DR
+47 SET DIE=3.9
SET DA=XMZ
SET DR="1.7////P"
DO ^DIE
KILL DIE,DA,DR
End DoDot:2
+48 IF GMRCITM["VA1235"
SET GMRCITM="Ordered service: "_$PIECE(GMRCITM,U,2)
+49 IF GMRCITM["VA1233"
SET GMRCITM=" Ordered proc.: "_$PIECE(GMRCITM,U,2)
+50 SET GMRCMSG(16,0)=GMRCITM
End DoDot:1
+51 SET GMRCMSG(17,0)=" "
+52 SET GMRCMSG(18,0)="The error is: Unknown Patient (201)"
+53 ; set XMY to local group or remote group
Begin DoDot:1
+54 IF $DATA(GMRCDOM)
SET XMY("G.IFC CLIN ERRORS@"_GMRCDOM)=""
QUIT
+55 SET XMY("G.IFC PATIENT ERROR MESSAGES")=""
End DoDot:1
+56 SET XMTEXT="GMRCMSG("
+57 DO EN1^XMD
+58 ;MKN 167 If consult was from Cerner, send message to GMRC TIER II CRNR IFC ERRORS without PII (Goes through Outlook)
+59 if 'GMRCCRNR
QUIT
+60 KILL GMRCMSG,XMY
+61 SET GMRCMSG(1,0)="An Inter-facility consult has been received from Cerner with"
+62 SET GMRCMSG(2,0)="message ID "_$SELECT(GMRCMSGI]"":$PIECE(GMRCMSGI,U)_" "_$PIECE(GMRCMSGI,U,2),1:"Not known")
+63 SET GMRCMSG(3,0)=" "
+64 SET GMRCMSG(4,0)="The error is: Unknown Patient (201)"
+65 SET XMSUB="Incoming IFC patient error"
+66 SET XMDUZ="Consult/Request Tracking Package"
+67 DO XMZ^XMA2
+68 ; set XMY to local group or remote group
Begin DoDot:1
+69 IF $DATA(GMRCDOM)
SET XMY("G.IFC CLIN ERRORS@"_GMRCDOM)=""
QUIT
+70 SET XMY("G.GMRC TIER II CRNR IFC ERRORS")=""
End DoDot:1
+71 SET XMTEXT="GMRCMSG("
+72 DO EN1^XMD
+73 ;MKN 167 End of GMRC TIER II CRNR IFC ERRORS message
+74 QUIT
+75 ;
PTMPIER(GMRCDFN) ;send IFC local MPI error to MAS mail group
+1 ;Input:
+2 ; GMRCDFN = DFN from file 2 of patient with MPI problem
+3 ;
+4 ;Output:
+5 ; mail message containing patient demographics
+6 ;
+7 NEW DFN,GMRCPT,GMRCMSG,VAHOW,VAROOT
+8 NEW XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
+9 SET DFN=GMRCDFN
SET VAHOW=1
SET VAROOT="GMRCPT"
+10 DO DEM^VADPT
+11 SET GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
+12 SET GMRCMSG(2,0)="The PATIENT file is either missing an ICN or contains a local ICN."
+13 SET GMRCMSG(3,0)="Please refer to the Master Patient Index/Patient Demographics(MPI/PD) User"
+14 SET GMRCMSG(4,0)="and Master Patient Index/Patient Demographics Exception Handling Manuals"
+15 SET GMRCMSG(5,0)="to resolve this error so request may be processed."
+16 SET GMRCMSG(6,0)=" "
+17 SET GMRCMSG(7,0)=" Patient name: "_GMRCPT("NM")
+18 SET GMRCMSG(8,0)=" SSN: "_$PIECE(GMRCPT("SS"),U,2)
+19 SET GMRCMSG(9,0)=" Date of birth: "_$PIECE(GMRCPT("DB"),U,2)
+20 SET GMRCMSG(10,0)=" Sex: "_$PIECE(GMRCPT("SX"),U,2)
+21 SET GMRCMSG(11,0)=" "
+22 SET GMRCMSG(12,0)=" The error is: Local or unknown MPI identifiers (202)"
+23 SET XMY("G.IFC PATIENT ERROR MESSAGES")=""
+24 SET XMSUB="Outgoing IFC patient error, "_GMRCPT("NM")
+25 SET XMDUZ="Consult/Request Tracking Package"
+26 SET XMTEXT="GMRCMSG("
+27 DO ^XMD
+28 ;
+29 QUIT
