TIUCCRP363.m

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 ---TIUCCRP363   3586     printed  Feb 19, 2025@00:05:41                                                                                                                                                                                                  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