Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCIERR

GMRCIERR.m

Go to the documentation of this file. 
  1. GMRCIERR ;SLC/JFR - process IFC message error alert ;15-Mar-2012 10:39;PLS
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**22,28,30,1001,35,58,1003**;DEC 27, 1997;Build 14
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;Modified - IHS/CIA/MGH  11/29/2005 - Added code to use HRCN instead of SSN
  1.  ;                                      Lines EN+5, EN+16, EN+35, PTMPIER+18
  1.  Q
  1. EN(GMRCLOG,GMRCDA,GMRCACT,GMRCRPT) ;start here
  1.  ;Build ^TMP array for processing alert
  1.  ;
  1.  K ^TMP("GMRCIERR",$J)
  1.  N GMRCPNM,GMRCACTV,GMRCERR,GMRCRP,GMRCEP,GMRCACTM,GMRCCOM,GMRCSS
  1.  N GMRCPROC,GMRCSITE,GMRCFCN,GMRCPT,GMRCSSN,GMRCHRCN,VAHOW,VAROOT
  1.  I '$D(^GMR(123.6,GMRCLOG,0)) D  Q
  1.  . S ^TMP("GMRCIERR",$J,1,0)="Message log entry no longer exists"
  1.  I $P(^GMR(123.6,GMRCLOG,0),U,4)'=GMRCDA D  Q
  1.  . S ^TMP("GMRCIERR",$J,1,0)="Message log entry and Consult# don't match"
  1.  I $P(^GMR(123.6,GMRCLOG,0),U,5)'=GMRCACT D  Q
  1.  . S ^TMP("GMRCIERR",$J,1,0)="Message log entry & activity# don't match"
  1.  S DFN=$P(^GMR(123,GMRCDA,0),U,2),VAROOT="GMRCPT",VAHOW=1
  1.  D DEM^VADPT
  1.  S GMRCPNM=GMRCPT("NM")
  1.  S GMRCSSN=$P(GMRCPT("SS"),U,2)
  1.  ;IHS/CIA/MGH Added variable for health record number
  1.  S GMRCHRCN=$$HRCN^GMRCMP(DFN,+$G(DUZ(2)))
  1.  S GMRCACTV=$G(^GMR(123,GMRCDA,40,GMRCACT,0))
  1.  S GMRCRP=$$GET1^DIQ(200,+$P(GMRCACTV,U,4),.01)
  1.  S GMRCEP=$$GET1^DIQ(200,+$P(GMRCACTV,U,5),.01)
  1.  S GMRCACTM=$$FMTE^XLFDT($P(GMRCACTV,U,3))
  1.  S GMRCACTV=$$GET1^DIQ(123.1,$P(GMRCACTV,U,2),.01)
  1.  S GMRCCOM=$O(^GMR(123,GMRCDA,40,GMRCACT,1,0))
  1.  S GMRCSS=$$GET1^DIQ(123.5,+$P(^GMR(123,GMRCDA,0),U,5),.01)
  1.  S GMRCPROC=$$GET1^DIQ(123.3,+$P(^GMR(123,GMRCDA,0),U,8),.01)
  1.  S GMRCFCN=$P(^GMR(123,GMRCDA,0),U,22)
  1.  D F4^XUAF4($$STA^XUAF4($P(^GMR(123,GMRCDA,0),U,23)),.GMRCSITE)
  1.  N LN S LN=1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="An error occurred transmitting the following inter-facility consult ",LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="activity to "_GMRCSITE("NAME")_":",LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="Consult #: "_GMRCDA,LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="Remote Consult #: "_GMRCFCN,LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="Patient Name: "_GMRCPNM,LN=LN+1
  1.  ;IHS/CIA/MGH  Added change to use hrcn instead of ssn
  1.  ;S ^TMP("GMRCIERR",$J,LN,0)="SSN: "_GMRCSSN,LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="HRCN: "_GMRCHRCN,LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="To Service: "_GMRCSS,LN=LN+1
  1.  I $L(GMRCPROC) S ^TMP("GMRCIERR",$J,LN,0)="Procedure: "_GMRCPROC,LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
  1.  I '$D(GMRCRPT) D ACTLG(GMRCDA,GMRCACT,GMRCLOG,.LN)
  1.  Q
  1. ACTLG(GMRCDA,GMRCACT,LOG,LN) ;build activity log entry
  1.  N GMRCCT,TAB,GMRCERR,GMRCDIF
  1.  S TAB="",$P(TAB," ",30)=""
  1.  S GMRCERR=$T(@("ERR"_$P(^GMR(123.6,LOG,0),U,8)_"^GMRCIUTL"))
  1.  S GMRCERR=$S($L(GMRCERR):$P(GMRCERR,";",2),1:"Technical error")
  1.  S ^TMP("GMRCIERR",$J,LN,0)="Activity #: "_GMRCACT,LN=LN+1
  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
  1.  S GMRCCT=LN
  1.  D BLDALN^GMRCSLM4(GMRCDA,GMRCACT)
  1.  S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="",LN=LN+1
  1.  S ^TMP("GMRCIERR",$J,LN,0)="The error was: "_GMRCERR
  1.  M ^TMP("GMRCIERR",$J)=^TMP("GMRCR",$J,"DT")
  1.  K ^TMP("GMRCR",$J,"DT")
  1.  Q
  1.  ;
  1. DIALOG(GMRCDATA) ;ask user what to do based on error and activity
  1.  ;Input:
  1.  ;  GMRCDATA  = XQADATA from alert handler
  1.  ;      in form:   IFC_msg_log#|consult#|activity#
  1.  ;
  1.  ;Output:
  1.  ;  value to set XQAKILL to
  1.  N DIR,X,Y,LN,DUOUT,DTOUT
  1.  D EN($P(GMRCDATA,"|"),$P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3))
  1.  W @IOF
  1.  S LN=0 F  S LN=$O(^TMP("GMRCIERR",$J,LN)) Q:'LN  W !,^(LN,0)
  1.  W !
  1.  I $O(^TMP("GMRCIERR",$J," "),-1)<2 Q 0 ;some problem so delete alert
  1.  S DIR(0)="E" D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT)) Q "@"
  1.  W !
  1.  I $O(^GMR(123.6,"AC",$P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3)),-1) D  Q "@"
  1.  . W !,"There is at least one earlier incomplete transaction for this"
  1.  . W !,"consult, all incomplete transactions should be processed in "
  1.  . W !,"order.",!
  1.  . W !,"You can use the List incomplete IFC transactions option to"
  1.  . W !,"locate and process the incomplete transactions for this consult."
  1.  . S DIR(0)="E" D ^DIR
  1.  S DIR(0)="YA",DIR("B")="N"
  1.  S DIR("A",1)="If you have corrected this problem you may resend this activity!"
  1.  S DIR("A",2)=" "
  1.  S DIR("A")="Do you want to retransmit this? " D ^DIR
  1.  I $G(Y)=1 D  Q 0
  1.  . D TRIGR^GMRCIEVT($P(GMRCDATA,"|",2),$P(GMRCDATA,"|",3)) ; re-transmit
  1.  K DIR
  1.  W !
  1.  S DIR(0)="YA",DIR("B")="N"
  1.  S DIR("A")="Do you want to delete this alert for all recipients? "
  1.  D ^DIR
  1.  I $G(Y)=1 Q 0
  1.  W !
  1.  S DIR(0)="YA",DIR("B")="N"
  1.  S DIR("A")="Do you want to delete this alert for yourself only? "
  1.  D ^DIR
  1.  I $G(Y)=1 Q 1
  1.  Q "@"
  1.  ;
  1. FOLLUP ;action to take from alert
  1.  S XQAKILL=$$DIALOG(XQADATA)
  1.  I XQAKILL="@" K XQAKILL
  1.  K ^TMP("GMRCIERR",$J)
  1.  Q
  1.  ;
  1. SNDALRT(GMRCLOG,TYPE,XQAMSG) ; send an alert on some errors
  1.  ;Input:
  1.  ; GMRCLOG = IFC MESSAGE LOG entry
  1.  ; TYPE    = "C" for a clinical error, "T" for a technical error
  1.  ;
  1.  N XQA,XQAROU,XQADATA,XQAID,GROUP,GMRCACT,GMRCDA,GMRCLOG0
  1.  S GMRCLOG0=$G(^GMR(123.6,GMRCLOG,0)) Q:'$L(GMRCLOG0)
  1.  S GMRCDA=$P(GMRCLOG0,U,4) Q:'GMRCDA
  1.  S GMRCACT=$P(GMRCLOG0,U,5) Q:'GMRCACT
  1.  S GROUP=$S(TYPE="C":"G.IFC CLIN ERRORS",1:"G.IFC TECH ERRORS")
  1.  S XQA(GROUP)=""
  1.  I '$D(XQAMSG) S XQAMSG="Failed IFC transaction"
  1.  S XQAROU="FOLLUP^GMRCIERR"
  1.  S XQAID="GMRCIFC,trans error,"_GMRCLOG
  1.  S XQADATA=GMRCLOG_"|"_GMRCDA_"|"_GMRCACT
  1.  D SETUP^XQALERT
  1.  Q
  1. PTERRMSG(GMRCPID,GMRCSTA,GMRCDOM,GMRCOBR) ;send IFC pt err to mail group
  1.  ;Input:
  1.  ;  GMRCPID = PID seg from IFC message
  1.  ;  GMRCSTA = station # of site where message originated
  1.  ;  GMRCDOM = domain to send the message to, if defined   (optional)
  1.  ;  GMRCOBR = OBR segment from IFC msg  (optional)
  1.  ;
  1.  ;Output:
  1.  ;  mail message containing patient demographics
  1.  ;
  1.  N GMRCGRP,GMRCMSG,GMRCNM,GMRCNAM,GMRCDOB
  1.  N XMERR,GMRCSUB,GMRCSITE,GMRCERR,GMRCICN
  1.  N XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
  1.  S GMRCNAM=$P(GMRCPID,"|",5)
  1.  S GMRCNM("FAMILY")=$P(GMRCNAM,U),GMRCNM("GIVEN")=$P(GMRCNAM,U,2)
  1.  S GMRCNM("MIDDLE")=$P(GMRCNAM,U,3),GMRCNM("SUFFIX")=$P(GMRCNAM,U,4)
  1.  S GMRCNAM=$$NAMEFMT^XLFNAME(.GMRCNM,"F","CL56Xc")
  1.  S GMRCDOB=$$HL7TFM^XLFDT($P(GMRCPID,"|",7))
  1.  S GMRCDOB=$$FMTE^XLFDT(GMRCDOB)
  1.  S GMRCICN=+$P(GMRCPID,"|",2)
  1.  D F4^XUAF4(GMRCSTA,.GMRCSITE)
  1.  S GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
  1.  S GMRCMSG(2,0)="The patient has either never been registered at your facility or the national"
  1.  S GMRCMSG(3,0)="MPI ICN for this patient at your site does not match that from the requesting"
  1.  S GMRCMSG(4,0)="site. Please refer to the Master Patient Index/Patient Demographics (MPI/PD)"
  1.  S GMRCMSG(5,0)="User Manual and Master Patient Index/Patient Demographics Exception"
  1.  S GMRCMSG(6,0)="Handling Manuals to resolve this error so the request may be processed."
  1.  S GMRCMSG(7,0)=" ",GMRCMSG(8,0)=" "
  1.  S GMRCMSG(9,0)="Patient demographics from "_GMRCSITE("NAME")
  1.  S GMRCMSG(10,0)="   Patient name: "_GMRCNAM
  1.  S GMRCMSG(11,0)="            SSN: "_$P(GMRCPID,"|",19)
  1.  S GMRCMSG(12,0)="  Date of birth: "_GMRCDOB
  1.  S GMRCMSG(13,0)="            Sex: "_$P(GMRCPID,"|",8)
  1.  S GMRCMSG(14,0)="     Remote ICN: "_GMRCICN
  1.  S GMRCMSG(15,0)=" "
  1.  ;
  1.  S XMSUB="Incoming IFC patient error, "_GMRCNAM
  1.  S XMDUZ="Consult/Request Tracking Package"
  1.  D XMZ^XMA2
  1.  I $L($G(GMRCOBR)) D
  1.  . N GMRCITM
  1.  . S GMRCITM=$P(GMRCOBR,"|",4)
  1.  . I $P(GMRCITM,U,2)["SUICIDE HOTLINE" D
  1.  .. N DIE,DA,DR
  1.  .. S DIE=3.9,DA=XMZ,DR="1.7////P" D ^DIE K DIE,DA,DR
  1.  . I GMRCITM["VA1235" S GMRCITM="Ordered service: "_$P(GMRCITM,U,2)
  1.  . I GMRCITM["VA1233" S GMRCITM="  Ordered proc.: "_$P(GMRCITM,U,2)
  1.  . S GMRCMSG(16,0)=GMRCITM
  1.  S GMRCMSG(17,0)=" "
  1.  S GMRCMSG(18,0)="   The error is: Unknown Patient (201)"
  1.  D  ; set XMY to local group or remote group
  1.  . I $D(GMRCDOM) S XMY("G.IFC CLIN ERRORS@"_GMRCDOM)="" Q
  1.  . S XMY("G.IFC PATIENT ERROR MESSAGES")=""
  1.  S XMTEXT="GMRCMSG("
  1.  D EN1^XMD
  1.  Q
  1.  ;
  1. PTMPIER(GMRCDFN) ;send IFC local MPI error to MAS mail group
  1.  ;Input:
  1.  ;  GMRCDFN = DFN from file 2 of patient with MPI problem
  1.  ;
  1.  ;Output:
  1.  ;  mail message containing patient demographics
  1.  ;
  1.  N DFN,GMRCPT,GMRCMSG,VAHOW,VAROOT
  1.  N XMTEXT,XMY,XMDUZ,XMSUB,XMZ,XMMG
  1.  S DFN=GMRCDFN,VAHOW=1,VAROOT="GMRCPT"
  1.  D DEM^VADPT
  1.  S GMRCMSG(1,0)="An Inter-facility Consult for the following patient has been requested."
  1.  S GMRCMSG(2,0)="The PATIENT file is either missing an ICN or contains a local ICN."
  1.  S GMRCMSG(3,0)="Please refer to the Master Patient Index/Patient Demographics(MPI/PD) User"
  1.  S GMRCMSG(4,0)="and Master Patient Index/Patient Demographics Exception Handling Manuals"
  1.  S GMRCMSG(5,0)="to resolve this error so request may be processed."
  1.  S GMRCMSG(6,0)=" "
  1.  S GMRCMSG(7,0)="   Patient name: "_GMRCPT("NM")
  1.  ;IHS/CIA/MGH added variable for HRCN instead of SSN
  1.  ;S GMRCMSG(8,0)="            SSN: "_$P(GMRCPT("SS"),U,2)
  1.  S GMRCMSG(8,0)="            HRCN: "_$$HRCN^GMRCMP(DFN,+$G(DUZ(2)))
  1.  S GMRCMSG(9,0)="  Date of birth: "_$P(GMRCPT("DB"),U,2)
  1.  S GMRCMSG(10,0)="            Sex: "_$P(GMRCPT("SX"),U,2)
  1.  S GMRCMSG(11,0)="  "
  1.  S GMRCMSG(12,0)="   The error is: Local or unknown MPI identifiers (202)"
  1.  ;
  1.  S XMY("G.IFC PATIENT ERROR MESSAGES")=""
  1.  S XMSUB="Outgoing IFC patient error, "_GMRCPT("NM")
  1.  S XMDUZ="Consult/Request Tracking Package"
  1.  S XMTEXT="GMRCMSG("
  1.  D ^XMD
  1.  Q