TIUCCRP363 ;COG/PB - PATCH TIU*1.0*363 POST INSTALL ; 11/08/23 14:30
;;1.0;TEXT INTEGRATION UTILITIES;**363**;Nov 08, 2023;Build 69
;
;SAC EXEMPTION 202311211320-04 : TIU use of vendor specific code
;ICR 7205
;
Q
TIU ;
N MYREST,IEN1802,PINGRES,MYERR,$ETRAP,X,XOBSTAT,XOBREADR,XOBREAK,NEWRESPONSE,JSON,OLDIP,OLDPORT,SC,resource,RESPJSON,NEWIP,NEWPORT,LINK,TIEN870,FDA,CNT
S IEN1802=$O(^XOB(18.02,"B","CCRA WEB SERVICE",""))
I $G(IEN1802)'>0 D Q
. 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
;
D BMES^XPDUTL("******************************************************************")
D BMES^XPDUTL(" >>>> Updating the TIUCCRA HL7 Logical Link <<<< ")
D BMES^XPDUTL("******************************************************************")
;S XPDQUIT=1
S CNT=0
;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 TIEN870=$O(^HLCS(870,"B","TIUCCRA",""))
S OLDIP=$$GET1^DIQ(870,TIEN870_",",400.01,"E"),OLDPORT=$$GET1^DIQ(870,TIEN870_",",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 TIUCCRA 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("")
D BMES^XPDUTL(" Updating the TIUCCRA HL7 Logical Link ")
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(TIEN870,NEWIP,NEWPORT) Q
Q
UPDATELINK(IEN870,NEWIP,NEWPORT) ;
;updates the HL7 Logical Link File (#870) with the new ip and port addresses
;stop the link
N IENROOT,MSGROOT
S FDA(870,IEN870_",",.08)=NEWIP
S FDA(870,IEN870_",",400.01)=NEWIP
S FDA(870,IEN870_",",400.02)=NEWPORT
D UPDATE^DIE("E","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, TIUCCRA was not changed. <<<<")
D BMES^XPDUTL("******************************************************************")
S XPDQUIT=1 ; stop the install
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCCRP363 3586 printed Dec 13, 2024@02:39:13 Page 2
TIUCCRP363 ;COG/PB - PATCH TIU*1.0*363 POST INSTALL ; 11/08/23 14:30
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**363**;Nov 08, 2023;Build 69
+2 ;
+3 ;SAC EXEMPTION 202311211320-04 : TIU use of vendor specific code
+4 ;ICR 7205
+5 ;
+6 QUIT
TIU ;
+1 NEW MYREST,IEN1802,PINGRES,MYERR,$ETRAP,X,XOBSTAT,XOBREADR,XOBREAK,NEWRESPONSE,JSON,OLDIP,OLDPORT,SC,resource,RESPJSON,NEWIP,NEWPORT,LINK,TIEN870,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
QUIT
+9 ;
+10 DO BMES^XPDUTL("******************************************************************")
+11 DO BMES^XPDUTL(" >>>> Updating the TIUCCRA HL7 Logical Link <<<< ")
+12 DO BMES^XPDUTL("******************************************************************")
+13 ;S XPDQUIT=1
+14 SET CNT=0
+15 ;set error trap
+16 SET $ETRAP="DO PINGH^GMRCCCRP200"
+17 ;get client REST request object
+18 SET MYREST=$$GETREST^XOBWLIB("CCRA WEB SERVICE","CCRA WEB SERVER")
SET MYERR=""
+19 SET TIEN870=$ORDER(^HLCS(870,"B","TIUCCRA",""))
+20 SET OLDIP=$$GET1^DIQ(870,TIEN870_",",400.01,"E")
SET OLDPORT=$$GET1^DIQ(870,TIEN870_",",400.02,"E")
+21 SET resource="/address?oldip="_$GET(OLDIP)_"&oldport="_$GET(OLDPORT)
+22 SET SC=$$GET^XOBWLIB(MYREST,resource,.MYERR,0)
+23 IF 'SC
IF MYERR.code=404
Begin DoDot:1
+24 DO BMES^XPDUTL("The Web Service Query didn't return any data. The TIUCCRA link was not updated.")
+25 KILL DIR("A"),DIR(0)
+26 SET DIR("A")="Press ENTER or RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+27 KILL DIR("A"),DIR(0)
End DoDot:1
+28 IF 'SC
QUIT 1
+29 SET NEWRESPONSE=MYREST.HttpResponse
+30 SET JSON=NEWRESPONSE.Data
+31 SET RESPJSON=""
+32 FOR
if JSON.AtEnd
QUIT
SET RESPJSON=RESPJSON_JSON.ReadLine()
+33 SET NEWIP=$TRANSLATE($PIECE($PIECE(RESPJSON,",",1),":",2),"""","")
SET NEWPORT=$TRANSLATE($PIECE($PIECE(RESPJSON,",",2),":",2),"""","")
SET NEWPORT=$PIECE(NEWPORT,"}",1)
+34 DO BMES^XPDUTL("*******************************************************************")
+35 DO BMES^XPDUTL("")
+36 DO BMES^XPDUTL(" Updating the TIUCCRA HL7 Logical Link ")
+37 DO BMES^XPDUTL(" Current IP address: "_OLDIP_" Current Port: "_OLDPORT)
+38 DO BMES^XPDUTL(" New IP address: "_NEWIP_" New Port: "_NEWPORT)
+39 DO BMES^XPDUTL("")
+40 DO BMES^XPDUTL("*******************************************************************")
+41 KILL DIR("A"),DIR(0)
+42 SET DIR("A")="Press ENTER or RETURN to continue"
SET DIR(0)="E"
DO ^DIR
+43 KILL DIR("A"),DIR(0)
+44 DO UPDATELINK(TIEN870,NEWIP,NEWPORT)
QUIT
+45 QUIT
UPDATELINK(IEN870,NEWIP,NEWPORT) ;
+1 ;updates the HL7 Logical Link File (#870) with the new ip and port addresses
+2 ;stop the link
+3 NEW IENROOT,MSGROOT
+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("E","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, TIUCCRA was not changed. <<<<")
+9 DO BMES^XPDUTL("******************************************************************")
+10 ; stop the install
SET XPDQUIT=1
+11 QUIT
