GMRCCCRP200 ;COG/PB - PATCH GRMC*3*200 POST INSTALL ;3/21/18 09:00
;;3.0;CONSULT/REQUEST TRACKING;**200**;Jan 08, 2024;Build 69
;
;SAC EXEMPTION 202311211312-03 : GMRC use of vendor specific code
;ICR 7205
;
Q
EN ;
D GMRC
D CCRA
Q
GMRC ;
N MYREST,IEN1802,PINGRES,MYERR,$ETRAP,X,XOBSTAT,XOBREADR,XOBREAK,NEWRESPONSE,JSON,OLDIP,OLDPORT,SC,resource,RESPJSON,NEWIP,NEWPORT,LINK,GIEN870,FDA,CNT
S IEN1802=$O(^XOB(18.02,"B","CCRA WEB SERVICE",""))
I $G(IEN1802)'>0 D
. D BMES^XPDUTL("**************************************************************************")
. D BMES^XPDUTL(">>>> The CCRA WEB SERVICE has not been configured. <<<<")
. D BMES^XPDUTL(">>>> Install failed because the CCRA WEB SERVICE has not been set up. <<<<")
. D BMES^XPDUTL("**************************************************************************")
. Q
;
S XPDQUIT=1
Q:$G(IEN1802)'>0
S CNT=0,LINK="GMRCCCRA"
;set error trap
S $ETRAP="DO PINGH^GMRCCCRP200"
;get client REST request object
S MYREST=$$GETREST^XOBWLIB("CCRA WEB SERVICE","CCRA WEB SERVER"),MYERR=""
S GIEN870=$O(^HLCS(870,"B","GMRCCCRA","")),LINK="GMRCCCRA"
S OLDIP=$$GET1^DIQ(870,GIEN870_",",400.01,"E"),OLDPORT=$$GET1^DIQ(870,GIEN870_",",400.02,"E")
S resource="/address?oldip="_$G(OLDIP)_"&oldport="_$G(OLDPORT)
S SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
I 'SC I MYERR.code=404 D
.D BMES^XPDUTL("The Web Service Query didn't return any data. The GMRCCCRA link was not updated.")
.K DIR("A"),DIR(0)
.S DIR("A")="Press ENTER or RETURN to continue",DIR(0)="E" D ^DIR
.K DIR("A"),DIR(0)
I 'SC Q 1
;I 'SC Q
S NEWRESPONSE=MYREST.HttpResponse
S JSON=NEWRESPONSE.Data
S RESPJSON=""
F Q:JSON.AtEnd S RESPJSON=RESPJSON_JSON.ReadLine()
S NEWIP=$TR($P($P(RESPJSON,",",1),":",2),"""",""),NEWPORT=$TR($P($P(RESPJSON,",",2),":",2),"""",""),NEWPORT=$P(NEWPORT,"}",1)
D BMES^XPDUTL("******************************************************************")
D BMES^XPDUTL(" >>>> Updating the GMRCCCRA HL7 Logical Links <<<< ")
D BMES^XPDUTL("")
D BMES^XPDUTL(" Current IP address: "_OLDIP_" Current Port: "_OLDPORT)
D BMES^XPDUTL(" New IP address: "_NEWIP_" New Port: "_NEWPORT)
D BMES^XPDUTL("")
D BMES^XPDUTL("*******************************************************************")
K DIR("A"),DIR(0)
S DIR("A")="Press ENTER or RETURN to continue",DIR(0)="E" D ^DIR
K DIR("A"),DIR(0)
D UPDATELINK(GIEN870,NEWIP,NEWPORT,LINK) Q
Q
CCRA ;
N MYREST,PINGRES,MYERR,$ETRAP,X,XOBSTAT,XOBREADR,XOBREAK,NEWRESPONSE,JSON,OLDIP,OLDPORT,SC,resource,RESPJSON,NEWIP,NEWPORT,LINK,CIEN870,FDA,CNT
;set error trap
S CNT=0,LINK="CCRA-NAK"
S $ETRAP="DO PINGH^GMRCCCRP200"
;get client REST request object
SET MYREST=$$GETREST^XOBWLIB("CCRA WEB SERVICE","CCRA WEB SERVER"),MYERR=""
S CIEN870=$O(^HLCS(870,"B","CCRA-NAK","")),LINK="CCRA-NAK"
S OLDIP=$$GET1^DIQ(870,CIEN870_",",400.01,"E"),OLDPORT=$$GET1^DIQ(870,CIEN870_",",400.02,"E")
S resource="/address?oldip="_$G(OLDIP)_"&oldport="_$G(OLDPORT)
S SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
I 'SC I MYERR.code=404 D
.D BMES^XPDUTL("The Web Service Query didn't return any data. The CCRA-NAK link was not updated.")
.K DIR("A"),DIR(0)
.S DIR("A")="Press ENTER or RETURN to continue",DIR(0)="E" D ^DIR
.K DIR("A"),DIR(0)
I 'SC Q 1
S NEWRESPONSE=MYREST.HttpResponse
S JSON=NEWRESPONSE.Data
S RESPJSON=""
F Q:JSON.AtEnd S RESPJSON=RESPJSON_JSON.ReadLine()
S NEWIP=$TR($P($P(RESPJSON,",",1),":",2),"""",""),NEWPORT=$TR($P($P(RESPJSON,",",2),":",2),"""",""),NEWPORT=$P(NEWPORT,"}",1)
D BMES^XPDUTL("******************************************************************")
D BMES^XPDUTL(" <<<< Updating the CCRA-NAK HL7 Logical Link. >>>>")
D BMES^XPDUTL("")
D BMES^XPDUTL(" Current IP address: "_OLDIP_" Current Port: "_OLDPORT)
D BMES^XPDUTL(" New IP address: "_NEWIP_" New Port: "_NEWPORT)
D BMES^XPDUTL("")
D BMES^XPDUTL("*******************************************************************")
K DIR("A"),DIR(0)
S DIR("A")="Press ENTER or RETURN to continue",DIR(0)="E" D ^DIR
K DIR("A"),DIR(0)
D UPDATELINK(CIEN870,NEWIP,NEWPORT,LINK)
Q
UPDATELINK(IEN870,NEWIP,NEWPORT,LINK) ;
;updates the HL7 Logical Link File (#870) with the new ip and port addresses
;stop the link
N IENROOT,MSGROOT,FDA
S FDA(870,IEN870_",",.08)=NEWIP
S FDA(870,IEN870_",",400.01)=NEWIP
S FDA(870,IEN870_",",400.02)=NEWPORT
D UPDATE^DIE("","FDA","IENROOT","MSGROOT")
Q
PINGH ;
;this is where to put in the error trapping and capture the error and write out to the KIDS screen
D ERR2ARR^XOBWLIB(MYERR,.MYERR)
S CNT=CNT+1
Q:CNT>1
D BMES^XPDUTL("******************************************************************")
D BMES^XPDUTL(" >>>> The IP address, "_OLDIP_" and port number "_OLDPORT_" <<<< ")
D BMES^XPDUTL(" >>>> didn't return a new IP address or port. <<<< ")
D BMES^XPDUTL(" >>>> The logical link, "_$G(LINK)_" was not changed. <<<<")
D BMES^XPDUTL("******************************************************************")
S XPDQUIT=1 ; stop the install
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCCRP200 5181 printed Sep 15, 2024@21:09:33 Page 2
GMRCCCRP200 ;COG/PB - PATCH GRMC*3*200 POST INSTALL ;3/21/18 09:00
+1 ;;3.0;CONSULT/REQUEST TRACKING;**200**;Jan 08, 2024;Build 69
+2 ;
+3 ;SAC EXEMPTION 202311211312-03 : GMRC use of vendor specific code
+4 ;ICR 7205
+5 ;
+6 QUIT
EN ;
+1 DO GMRC
+2 DO CCRA
+3 QUIT
GMRC ;
+1 NEW MYREST,IEN1802,PINGRES,MYERR,$ETRAP,X,XOBSTAT,XOBREADR,XOBREAK,NEWRESPONSE,JSON,OLDIP,OLDPORT,SC,resource,RESPJSON,NEWIP,NEWPORT,LINK,GIEN870,FDA,CNT
+2 SET IEN1802=$ORDER(^XOB(18.02,"B","CCRA WEB SERVICE",""))
+3 IF $GET(IEN1802)'>0
Begin DoDot:1
+4 DO BMES^XPDUTL("**************************************************************************")
+5 DO BMES^XPDUTL(">>>> The CCRA WEB SERVICE has not been configured. <<<<")
+6 DO BMES^XPDUTL(">>>> Install failed because the CCRA WEB SERVICE has not been set up. <<<<")
+7 DO BMES^XPDUTL("**************************************************************************")
+8 QUIT
End DoDot:1
+9 ;
+10 SET XPDQUIT=1
+11 if $GET(IEN1802)'>0
QUIT
+12 SET CNT=0
SET LINK="GMRCCCRA"
+13 ;set error trap
+14 SET $ETRAP="DO PINGH^GMRCCCRP200"
+15 ;get client REST request object
+16 SET MYREST=$$GETREST^XOBWLIB("CCRA WEB SERVICE","CCRA WEB SERVER")
SET MYERR=""
+17 SET GIEN870=$ORDER(^HLCS(870,"B","GMRCCCRA",""))
SET LINK="GMRCCCRA"
+18 SET OLDIP=$$GET1^DIQ(870,GIEN870_",",400.01,"E")
SET OLDPORT=$$GET1^DIQ(870,GIEN870_",",400.02,"E")
+19 SET resource="/address?oldip="_$GET(OLDIP)_"&oldport="_$GET(OLDPORT)
+20 SET SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
+21 IF 'SC
IF MYERR.code=404
Begin DoDot:1
+22 DO BMES^XPDUTL("The Web Service Query didn't return any data. The GMRCCCRA link was not updated.")
+23 KILL DIR("A"),DIR(0)
+24 SET DIR("A")="Press ENTER or RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+25 KILL DIR("A"),DIR(0)
End DoDot:1
+26 IF 'SC
QUIT 1
+27 ;I 'SC Q
+28 SET NEWRESPONSE=MYREST.HttpResponse
+29 SET JSON=NEWRESPONSE.Data
+30 SET RESPJSON=""
+31 FOR
if JSON.AtEnd
QUIT
SET RESPJSON=RESPJSON_JSON.ReadLine()
+32 SET NEWIP=$TRANSLATE($PIECE($PIECE(RESPJSON,",",1),":",2),"""","")
SET NEWPORT=$TRANSLATE($PIECE($PIECE(RESPJSON,",",2),":",2),"""","")
SET NEWPORT=$PIECE(NEWPORT,"}",1)
+33 DO BMES^XPDUTL("******************************************************************")
+34 DO BMES^XPDUTL(" >>>> Updating the GMRCCCRA HL7 Logical Links <<<< ")
+35 DO BMES^XPDUTL("")
+36 DO BMES^XPDUTL(" Current IP address: "_OLDIP_" Current Port: "_OLDPORT)
+37 DO BMES^XPDUTL(" New IP address: "_NEWIP_" New Port: "_NEWPORT)
+38 DO BMES^XPDUTL("")
+39 DO BMES^XPDUTL("*******************************************************************")
+40 KILL DIR("A"),DIR(0)
+41 SET DIR("A")="Press ENTER or RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+42 KILL DIR("A"),DIR(0)
+43 DO UPDATELINK(GIEN870,NEWIP,NEWPORT,LINK)
QUIT
+44 QUIT
CCRA ;
+1 NEW MYREST,PINGRES,MYERR,$ETRAP,X,XOBSTAT,XOBREADR,XOBREAK,NEWRESPONSE,JSON,OLDIP,OLDPORT,SC,resource,RESPJSON,NEWIP,NEWPORT,LINK,CIEN870,FDA,CNT
+2 ;set error trap
+3 SET CNT=0
SET LINK="CCRA-NAK"
+4 SET $ETRAP="DO PINGH^GMRCCCRP200"
+5 ;get client REST request object
+6 SET MYREST=$$GETREST^XOBWLIB("CCRA WEB SERVICE","CCRA WEB SERVER")
SET MYERR=""
+7 SET CIEN870=$ORDER(^HLCS(870,"B","CCRA-NAK",""))
SET LINK="CCRA-NAK"
+8 SET OLDIP=$$GET1^DIQ(870,CIEN870_",",400.01,"E")
SET OLDPORT=$$GET1^DIQ(870,CIEN870_",",400.02,"E")
+9 SET resource="/address?oldip="_$GET(OLDIP)_"&oldport="_$GET(OLDPORT)
+10 SET SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
+11 IF 'SC
IF MYERR.code=404
Begin DoDot:1
+12 DO BMES^XPDUTL("The Web Service Query didn't return any data. The CCRA-NAK link was not updated.")
+13 KILL DIR("A"),DIR(0)
+14 SET DIR("A")="Press ENTER or RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+15 KILL DIR("A"),DIR(0)
End DoDot:1
+16 IF 'SC
QUIT 1
+17 SET NEWRESPONSE=MYREST.HttpResponse
+18 SET JSON=NEWRESPONSE.Data
+19 SET RESPJSON=""
+20 FOR
if JSON.AtEnd
QUIT
SET RESPJSON=RESPJSON_JSON.ReadLine()
+21 SET NEWIP=$TRANSLATE($PIECE($PIECE(RESPJSON,",",1),":",2),"""","")
SET NEWPORT=$TRANSLATE($PIECE($PIECE(RESPJSON,",",2),":",2),"""","")
SET NEWPORT=$PIECE(NEWPORT,"}",1)
+22 DO BMES^XPDUTL("******************************************************************")
+23 DO BMES^XPDUTL(" <<<< Updating the CCRA-NAK HL7 Logical Link. >>>>")
+24 DO BMES^XPDUTL("")
+25 DO BMES^XPDUTL(" Current IP address: "_OLDIP_" Current Port: "_OLDPORT)
+26 DO BMES^XPDUTL(" New IP address: "_NEWIP_" New Port: "_NEWPORT)
+27 DO BMES^XPDUTL("")
+28 DO BMES^XPDUTL("*******************************************************************")
+29 KILL DIR("A"),DIR(0)
+30 SET DIR("A")="Press ENTER or RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+31 KILL DIR("A"),DIR(0)
+32 DO UPDATELINK(CIEN870,NEWIP,NEWPORT,LINK)
+33 QUIT
UPDATELINK(IEN870,NEWIP,NEWPORT,LINK) ;
+1 ;updates the HL7 Logical Link File (#870) with the new ip and port addresses
+2 ;stop the link
+3 NEW IENROOT,MSGROOT,FDA
+4 SET FDA(870,IEN870_",",.08)=NEWIP
+5 SET FDA(870,IEN870_",",400.01)=NEWIP
+6 SET FDA(870,IEN870_",",400.02)=NEWPORT
+7 DO UPDATE^DIE("","FDA","IENROOT","MSGROOT")
+8 QUIT
PINGH ;
+1 ;this is where to put in the error trapping and capture the error and write out to the KIDS screen
+2 DO ERR2ARR^XOBWLIB(MYERR,.MYERR)
+3 SET CNT=CNT+1
+4 if CNT>1
QUIT
+5 DO BMES^XPDUTL("******************************************************************")
+6 DO BMES^XPDUTL(" >>>> The IP address, "_OLDIP_" and port number "_OLDPORT_" <<<< ")
+7 DO BMES^XPDUTL(" >>>> didn't return a new IP address or port. <<<< ")
+8 DO BMES^XPDUTL(" >>>> The logical link, "_$GET(LINK)_" was not changed. <<<<")
+9 DO BMES^XPDUTL("******************************************************************")
+10 ; stop the install
SET XPDQUIT=1
+11 QUIT
