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