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

GMRCIUT1.m

Go to the documentation of this file. 
  1. GMRCIUT1 ;SLC/JFR - UTILITIES FOR INTER-FACILITY CONSULTS ; Jul 31, 2024@05:39:44
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**189**;DEC 27, 1997;Build 54
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  Q  ;don't start at the top
  1.  ;
  1. CHKPROXY(GMRCDA,GMRCDFN,STA,DONOTLOG) ;
  1.  ;
  1.  ;  GMRCDA   = Consult, pointer to #123
  1.  ;  GMRCDFN  = Patient, pointer to #2
  1.  ;  STA      = Routing station number
  1.  ;  DONOTLOG = Flag to prevent logging in IFC Message Log (#123.6).  1=DO NOT LOG. [OPTIONAL]
  1.  ;
  1.  ;  Checks success/failure of proxy add.  Returns 1 if all is OK and IFC can be sent, 0^REASON if not.
  1.  ;
  1.  ;pull patient Correlation list
  1.  ;
  1.  N DGKEY,DGOUT,CNT,IDS,CERNERID,CONSULTDFN,RTNCODE,EDIPI ;
  1.  ;
  1.  S DGKEY=GMRCDFN_U_"PI"_U_"USVHA"_U_$P($$SITE^VASITE,"^",3)
  1.  D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1.  ; 
  1.  S CONSULTDFN="",CERNERID="" ;
  1.  S CNT=0 F  S CNT=$O(DGOUT(CNT)) Q:'CNT  S IDS=$G(DGOUT(CNT)) D  ;
  1.  .I $P(IDS,"^",4)="200CRNR" I $P(IDS,"^",2)="PI" S CERNERID=IDS ;
  1.  .I $P(IDS,"^",4)=STA I $P(IDS,"^",2)="PI" I $P(IDS,"^",5)="A"!($P(IDS,"^",5)="C") S CONSULTDFN=IDS ;
  1.  ;
  1.  ;  Destination site is converted.
  1.  ;
  1.  I $$CRNRSITE^VAFCCRNR(STA)=1 D  Q RTNCODE ;
  1.  . I CERNERID'="",CONSULTDFN'="" S RTNCODE=1 Q  ;
  1.  . ;
  1.  . I CERNERID="" S RTNCODE="0^CERNER INCOMPLETE" Q  ;
  1.  . ;
  1.  . I CONSULTDFN="" D  Q  ;
  1.  .. ;
  1.  .. ;  Call proxy add for converted VistA.
  1.  .. ;
  1.  .. S EDIPI=$$EDIPI^GMRCIUTL(GMRCDFN) ;
  1.  .. S RTNCODE=$$ADD^DGPROSAD(EDIPI_"~USDOD~NI~200DOD",STA) ;  ICR 7421
  1.  .. I RTNCODE<0 D  ;  Proxy add failed.
  1.  ... I '$G(DONOTLOG) D LOGMSG^GMRCIUTL(GMRCDA,1,"",205) ;
  1.  ... D FAILPRXY("",EDIPI,GMRCDA,"","","",STA,$P(RTNCODE,U,2)) ; P189 WTC 6/24/24
  1.  ... S RTNCODE="0^CONVERTED VISTA INCOMPLETE" ;
  1.  .. Q:$G(DONOTLOG)  ;
  1.  .. ;
  1.  .. ;  Suppress 201 error if IFC already has a 203 error in the message log.  wtc 11.22.23 p189
  1.  .. ;
  1.  .. N ACTIEN,SUPPRESS,LOGIEN S SUPPRESS=0,ACTIEN=0 F  S ACTIEN=$O(^GMR(123.6,"AC",GMRCDA,ACTIEN)) Q:'ACTIEN  D  Q:SUPPRESS  ;
  1.  ... S LOGIEN=0 F  S LOGIEN=$O(^GMR(123.6,"AC",GMRCDA,ACTIEN,1,LOGIEN)) Q:'LOGIEN  I $P($G(^GMR(123.6,LOGIEN,0)),U,8)=203 S SUPPRESS=1 Q  ;
  1.  .. ;
  1.  .. I 'SUPPRESS D LOGMSG^GMRCIUTL(GMRCDA,1,"",201) ;
  1.  ;
  1.  ;  Destination site is non-converted.
  1.  ;
  1.  I $$CRNRSITE^VAFCCRNR(STA)'=1 D  Q RTNCODE ;
  1.  . I CONSULTDFN'="" S RTNCODE=1 Q  ;
  1.  . ;
  1.  . S RTNCODE="0^NON-CONVERTED VISTA INCOMPLETE" ;
  1.  . D LOGMSG^GMRCIUTL(GMRCDA,1,"",201) ;
  1.  ;
  1.  Q "0^UNKNOWN" ;
  1.  ;
  1. FAILPRXY(MSGID,EDIPI,GMRCDA,CRNRORDR,ORDRDESC,ORDRDATE,STA,REASON) ;
  1.  ;
  1.  ;  Send MailMan message when proxy add fails.
  1.  ;
  1.  ;  MSGID    = HL7 Message ID (MSH-10) [OPTIONAL]
  1.  ;  EDIPI    = Patient's EDIPI [OPTIONAL]
  1.  ;  GMRCDA   = Consult IEN (pointer to #123) [OPTIONAL]
  1.  ;  CRNRORDR = Cerner order number [OPTIONAL]
  1.  ;  ORDRDESC = Ordering description [OPTIONAL]
  1.  ;  ORDRDATE = Ordering date in HL7 format [OPTIONAL]
  1.  ;  STA      = Station where proxy add attempted [OPTIONAL]
  1.  ;  REASON   = Proxy add failure reason [REQUIRED]
  1.  ;
  1.  Q:$G(REASON)=""  ;
  1.  ;
  1.  N XMSUB,XMDUZ,XMTEXT,XMY,GRPIEN,MEM,GRP,N ;
  1.  S GRP="IFC PATIENT ERROR MESSAGES" ;
  1.  S XMSUB="Failed IFC transaction: Proxy Add Failed",XMTEXT="XMTEXT(" ;
  1.  S N=0 ;
  1.  I $G(MSGID)'="" S N=N+1,XMTEXT(N)="Message ID: "_MSGID ;
  1.  I $G(EDIPI)'="" S N=N+1,XMTEXT(N)="EDIPI: "_EDIPI ;
  1.  I $G(GMRCDA)'="" S N=N+1,XMTEXT(N)="Consult Number: "_GMRCDA ;
  1.  I $G(CRNRORDR)'="" S N=N+1,XMTEXT(N)="Cerner Order Number: "_CRNRORDR ;
  1.  I $G(ORDRDESC)'="" S N=N+1,XMTEXT(N)="Order Description: "_ORDRDESC ;
  1.  I $G(ORDRDATE)'="" S N=N+1,XMTEXT(N)="Order Date: "_$$FMTE^XLFDT($$HL7TFM^XLFDT(ORDRDATE)) ;
  1.  I $G(STA)'="" S N=N+1,XMTEXT(N)="Station where proxy add attempted: "_STA ;
  1.  S N=N+1,XMTEXT(N)="Failure Reason: "_REASON ;
  1.  S GRPIEN=$O(^XMB(3.8,"B",GRP,"")) Q:'GRPIEN
  1.  ;Set up XMY for MEMBERS
  1.  S MEM=0 F  S MEM=$O(^XMB(3.8,GRPIEN,1,MEM)) Q:'MEM  S XMY($P(^XMB(3.8,GRPIEN,1,MEM,0),U))=""
  1.  ;Set up XMY for MEMBERS REMOTE
  1.  S MEM=0 F  S MEM=$O(^XMB(3.8,GRPIEN,6,MEM)) Q:'MEM  S XMY($P(^XMB(3.8,GRPIEN,6,MEM,0),U))=""
  1.  Q:'$D(XMY)
  1.  S XMDUZ=GRP
  1.  D XMZ^XMA2 ; call Create Message Module
  1.  D EN1^XMD
  1.  Q  ;
  1.  ;
  1. ROUTE(GMRCDA)  ; determine correct routing for IFC msg  <<<<<<<<<============OLD CODE FROM GMRCIEVT.  NOT USED.
  1.  ; Input:
  1.  ; GMRCDA = ien from file 123
  1.  ;
  1.  ; Output:
  1.  ; the logical link to send the message to in format
  1.  ; "GMRC IFC SUBSC^VHAHIN^STATION"
  1.  ;need to understanding their queuing
  1.  N SITE,GMRCLINK,STA
  1.  N DGKEY,DGOUT,CNT,IDS,CERNERID,CONSULTDFN,GMRCDFN,MPIDATA,RETURN,PATARR,X
  1.  S (RETURN,CERNERID,CONSULTDFN)=""
  1.  S SITE=$P(^GMR(123,GMRCDA,0),U,23) I 'SITE Q "" ;no ROUTING FACILITY
  1.  S STA=$$STA^XUAF4(SITE) I '$L(STA) Q "" ;can't find station num for that site
  1.  ;
  1.  D LINK^HLUTIL3(STA,.GMRCLINK,"I")
  1.  ;
  1.  ;WCJ; if no patient - should not happen
  1.  S GMRCDFN=$P(^GMR(123,GMRCDA,0),U,2) I 'GMRCDFN Q ""
  1.  ;
  1.  ;pull patient Correlation list
  1.  S DGKEY=GMRCDFN_U_"PI"_U_"USVHA"_U_$P($$SITE^VASITE,"^",3)
  1.  D TFL^VAFCTFU2(.DGOUT,DGKEY)
  1.  ;
  1.  S CNT=0 F  S CNT=$O(DGOUT(CNT)) Q:'CNT  S IDS=$G(DGOUT(CNT)) D
  1.  .I $P(IDS,"^",4)="200CRNR" I $P(IDS,"^",2)="PI" S CERNERID=IDS
  1.  .I $P(IDS,"^",4)=STA I $P(IDS,"^",2)="PI" I $P(IDS,"^",5)="A"!($P(IDS,"^",5)="C") S CONSULTDFN=IDS
  1.  ;
  1.  ;is consulting site known in the list and if site is Cerner enabled but not known
  1.  I CONSULTDFN'="" D
  1.  . ; if consulting site is known and it is NOT a Cerner enabled site
  1.  . I $P(CONSULTDFN,"^",5)'="C" D  Q
  1.  .. S GMRCLINK=$O(GMRCLINK(0)) I 'GMRCLINK Q  ; no link for that site
  1.  .. S GMRCLINK=GMRCLINK(GMRCLINK) I '$L(GMRCLINK) Q  ;no link name
  1.  .. S RETURN="GMRC IFC SUBSC^"_GMRCLINK_U_STA Q  ;MKN GMRC*3*154 added STA to RETURN
  1.  . ;
  1.  . ; if consulting site is known and it is a Cerner enabled site but patient unknown to Cerner
  1.  . I $P(CONSULTDFN,"^",5)="C",(CERNERID="") S RETURN=$$GETLINK(STA) Q
  1.  . ; if consulting site is known and it is a Cerner enabled site
  1.  . I $P(CONSULTDFN,"^",5)="C",(CERNERID'="") D
  1.  .. ; if Cerner enabled site AND Cerner knows patient set route to VDIF regional router
  1.  .. S RETURN=$$GETLINK(STA) ;MKN GMRC*3*154 added STA to RETURN
  1.  I CONSULTDFN="" D
  1.  . ;
  1.  . ;  If patient not found on converted VistA, call proxy add.  p189 wtc 4/13/2023
  1.  . ;
  1.  . I CERNERID'="" N RTNCODE D  Q:RTNCODE>0  ; WTC 9.8.23
  1.  .. ;
  1.  .. ;  Call proxy add.  If successful, get link name.  Otherwise, allow 201 error to be generated.
  1.  .. ;
  1.  .. N EDIPI ;
  1.  .. S EDIPI=$$EDIPI^GMRCIUTL($$GET1^DIQ(123,GMRCDA,.02,"I")) ;
  1.  .. S RTNCODE=$$ADD^DGPROSAD(EDIPI_"~USDOD~NI~200DOD",STA) ;  ICR 7421
  1.  .. Q:RTNCODE<0  ;  Proxy add failed.  wtc 4/13/2023, 9/26/23
  1.  .. S RETURN=$$GETLINK(STA) ;
  1.  . ;
  1.  . ;  Suppress 201 error if IFC already has a 203 error in the message log.  wtc 11.22.23 p189
  1.  . ;
  1.  . N ACTIEN,SUPPRESS,LOGIEN S SUPPRESS=0,ACTIEN=0 F  S ACTIEN=$O(^GMR(123.6,"AC",GMRCDA,ACTIEN)) Q:'ACTIEN  D  Q:SUPPRESS  ;
  1.  .. S LOGIEN=0 F  S LOGIEN=$O(^GMR(123.6,"AC",GMRCDA,ACTIEN,1,LOGIEN)) Q:'LOGIEN  I $P($G(^GMR(123.6,LOGIEN,0)),U,8)=203 S SUPPRESS=1 Q  ;
  1.  . ;
  1.  . I 'SUPPRESS D LOGMSG^GMRCIUTL(GMRCDA,1,"",201)
  1.  . S RETURN=""
  1.  ;
  1.  Q RETURN
  1.  ;
  1.  N GMRCLINK
  1.  D LINK^HLUTIL3(STA,.GMRCLINK,"I")
  1.  S GMRCLINK(1)=$$GET^XPAR("SYS","GMRC IFC REGIONAL ROUTER",1)
  1.  S GMRCLINK=$O(GMRCLINK(0)) I 'GMRCLINK Q "" ; no link for that site
  1.  S GMRCLINK=GMRCLINK(GMRCLINK) I '$L(GMRCLINK) Q "" ;no link name
  1.  Q "GMRC IFC SUBSC^"_GMRCLINK(1)_U_STA
  1.  ;