WEBG012P ; SLC/JAS - WEBG*3*12 Pre/Post Init Routine; Mar 31, 2023@3:15 PM
;;3.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**12**;Apr 06, 2021;Build 8
;;Per VHA Directive 6402, this routine should not be modified
;
; $$PKGVER^XPDIP - Covered by Supported ICR# 2067
; File #19.05 updates - Covered by Supported ICR# 10075
; YTQ VERSRV addition - Covered by ICR# 7418
;
Q
;
PRE ;Pre-Installation Process
;
;;; Update PACKAGE (#9.4) file
;
D MES^XPDUTL("")
D MES^XPDUTL(">>> Updating the WEBG Package Version to 3.0.")
D MES^XPDUTL("")
;
; Get Package IEN for WEBG
;
N WEBGIEN,WEBGPVER
S WEBGIEN=$O(^DIC(9.4,"B","WEB VISTA REMOTE ACCESS MANAGEMENT",0))
Q:'WEBGIEN
;
; Get current Version # for WEBG
;
S WEBGPVER=$$GET1^DIQ(9.4,WEBGIEN_",",13)
I WEBGPVER="3.0" D Q
. D MES^XPDUTL("")
. D MES^XPDUTL("** The WEBG Package is already at Version "_WEBGPVER)
;
; Update WEBG Package Version to 3.0
;
N NEWVER
S NEWVER=$$PKGVER^XPDIP(WEBGIEN,"3.0")
I NEWVER D
. D MES^XPDUTL("")
. D MES^XPDUTL(">> The WEBG Package has been successfully updated to 3.0")
Q
;
POST ; Post-Installation Process
;
;;; Update OPTION (#19) file
;
D MES^XPDUTL("")
D MES^XPDUTL("")
D MES^XPDUTL(">>> Updating the WEBG WEBVRAM GUI option.")
D MES^XPDUTL("")
;
; Verify that the WEBG WEBVRAM GUI option exists
;
N ADDERR,OPTIEN,RPCNAME,UPERR
S OPTIEN=$O(^DIC(19,"B","WEBG WEBVRAM GUI",0))
I 'OPTIEN D Q
. D MES^XPDUTL("")
. D MES^XPDUTL("** There has been an issue identifying the WEBG WEBVRAM GUI Option.")
. D MES^XPDUTL(" This patch may need to be re-installed at a later time.")
;
; Attempt to add RPC(s) to WEBG WEBVRAM GUI option
;
S UPERR=0
F RPCNAME="YTQ VERSRV" D ADDRPC(.ADDERR,OPTIEN,RPCNAME) I ADDERR S UPERR=1
;
I UPERR D Q
. D MES^XPDUTL("")
. D MES^XPDUTL("")
. D MES^XPDUTL(" *** The issues referenced above need to be addressed. ***")
;
D MES^XPDUTL("")
D MES^XPDUTL("")
D MES^XPDUTL(">>> Updates to the WEBG WEBVRAM GUI have completed successfully. <<<")
;
ADDRPC(ADDERR,OPTIEN,RPCNAME) ;Add RPC(s) to the WEBG WEBVRAM GUI Option
N FDA,FDAERR,RPCIEN
S ADDERR=0
;
; Verify that the RPC is valid
;
I '$D(^XWB(8994,"B",RPCNAME)) D Q
. S ADDERR=1
. D MES^XPDUTL("")
. D MES^XPDUTL("** RPC "_RPCNAME_" does not exist and cannot be added")
. D MES^XPDUTL(" to the WEBG WEBVRAM GUI Option.")
;
S RPCIEN=$O(^XWB(8994,"B",RPCNAME,0))
I 'RPCIEN D Q
. S ADDERR=1
. D MES^XPDUTL("")
. D MES^XPDUTL("** There has been an issue identifying the "_RPCNAME_" RPC.")
. D MES^XPDUTL(" This patch may need to be re-installed at a later time.")
;
; Attempt to register the RPC to the WEBG WEBVRAM GUI context
;
I $D(^DIC(19,OPTIEN,"RPC","B",RPCIEN)) D Q
. D MES^XPDUTL("")
. D MES^XPDUTL("** RPC "_RPCNAME_" is already registered to WEBG WEBVRAM GUI.")
;
S ADDERR=0
S FDA(19.05,"+1,"_OPTIEN_",",.01)=RPCIEN
D UPDATE^DIE(,"FDA",,"FDAERR") K FDA
;
I $D(FDAERR) D Q
. S ADDERR=1
. D MES^XPDUTL("")
. D MES^XPDUTL("** There was an issue adding RPC "_RPCNAME_" to")
. D MES^XPDUTL(" WEBG WEBVRAM GUI context. It may need to be added manually.")
;
D MES^XPDUTL("")
D MES^XPDUTL(">> RPC "_RPCNAME_" has been successfully registered to WEBG WEBVRAM GUI.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWEBG012P 3364 printed Apr 09, 2024@21:48:26 Page 2
WEBG012P ; SLC/JAS - WEBG*3*12 Pre/Post Init Routine; Mar 31, 2023@3:15 PM
+1 ;;3.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**12**;Apr 06, 2021;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; $$PKGVER^XPDIP - Covered by Supported ICR# 2067
+5 ; File #19.05 updates - Covered by Supported ICR# 10075
+6 ; YTQ VERSRV addition - Covered by ICR# 7418
+7 ;
+8 QUIT
+9 ;
PRE ;Pre-Installation Process
+1 ;
+2 ;;; Update PACKAGE (#9.4) file
+3 ;
+4 DO MES^XPDUTL("")
+5 DO MES^XPDUTL(">>> Updating the WEBG Package Version to 3.0.")
+6 DO MES^XPDUTL("")
+7 ;
+8 ; Get Package IEN for WEBG
+9 ;
+10 NEW WEBGIEN,WEBGPVER
+11 SET WEBGIEN=$ORDER(^DIC(9.4,"B","WEB VISTA REMOTE ACCESS MANAGEMENT",0))
+12 if 'WEBGIEN
QUIT
+13 ;
+14 ; Get current Version # for WEBG
+15 ;
+16 SET WEBGPVER=$$GET1^DIQ(9.4,WEBGIEN_",",13)
+17 IF WEBGPVER="3.0"
Begin DoDot:1
+18 DO MES^XPDUTL("")
+19 DO MES^XPDUTL("** The WEBG Package is already at Version "_WEBGPVER)
End DoDot:1
QUIT
+20 ;
+21 ; Update WEBG Package Version to 3.0
+22 ;
+23 NEW NEWVER
+24 SET NEWVER=$$PKGVER^XPDIP(WEBGIEN,"3.0")
+25 IF NEWVER
Begin DoDot:1
+26 DO MES^XPDUTL("")
+27 DO MES^XPDUTL(">> The WEBG Package has been successfully updated to 3.0")
End DoDot:1
+28 QUIT
+29 ;
POST ; Post-Installation Process
+1 ;
+2 ;;; Update OPTION (#19) file
+3 ;
+4 DO MES^XPDUTL("")
+5 DO MES^XPDUTL("")
+6 DO MES^XPDUTL(">>> Updating the WEBG WEBVRAM GUI option.")
+7 DO MES^XPDUTL("")
+8 ;
+9 ; Verify that the WEBG WEBVRAM GUI option exists
+10 ;
+11 NEW ADDERR,OPTIEN,RPCNAME,UPERR
+12 SET OPTIEN=$ORDER(^DIC(19,"B","WEBG WEBVRAM GUI",0))
+13 IF 'OPTIEN
Begin DoDot:1
+14 DO MES^XPDUTL("")
+15 DO MES^XPDUTL("** There has been an issue identifying the WEBG WEBVRAM GUI Option.")
+16 DO MES^XPDUTL(" This patch may need to be re-installed at a later time.")
End DoDot:1
QUIT
+17 ;
+18 ; Attempt to add RPC(s) to WEBG WEBVRAM GUI option
+19 ;
+20 SET UPERR=0
+21 FOR RPCNAME="YTQ VERSRV"
DO ADDRPC(.ADDERR,OPTIEN,RPCNAME)
IF ADDERR
SET UPERR=1
+22 ;
+23 IF UPERR
Begin DoDot:1
+24 DO MES^XPDUTL("")
+25 DO MES^XPDUTL("")
+26 DO MES^XPDUTL(" *** The issues referenced above need to be addressed. ***")
End DoDot:1
QUIT
+27 ;
+28 DO MES^XPDUTL("")
+29 DO MES^XPDUTL("")
+30 DO MES^XPDUTL(">>> Updates to the WEBG WEBVRAM GUI have completed successfully. <<<")
+31 ;
ADDRPC(ADDERR,OPTIEN,RPCNAME) ;Add RPC(s) to the WEBG WEBVRAM GUI Option
+1 NEW FDA,FDAERR,RPCIEN
+2 SET ADDERR=0
+3 ;
+4 ; Verify that the RPC is valid
+5 ;
+6 IF '$DATA(^XWB(8994,"B",RPCNAME))
Begin DoDot:1
+7 SET ADDERR=1
+8 DO MES^XPDUTL("")
+9 DO MES^XPDUTL("** RPC "_RPCNAME_" does not exist and cannot be added")
+10 DO MES^XPDUTL(" to the WEBG WEBVRAM GUI Option.")
End DoDot:1
QUIT
+11 ;
+12 SET RPCIEN=$ORDER(^XWB(8994,"B",RPCNAME,0))
+13 IF 'RPCIEN
Begin DoDot:1
+14 SET ADDERR=1
+15 DO MES^XPDUTL("")
+16 DO MES^XPDUTL("** There has been an issue identifying the "_RPCNAME_" RPC.")
+17 DO MES^XPDUTL(" This patch may need to be re-installed at a later time.")
End DoDot:1
QUIT
+18 ;
+19 ; Attempt to register the RPC to the WEBG WEBVRAM GUI context
+20 ;
+21 IF $DATA(^DIC(19,OPTIEN,"RPC","B",RPCIEN))
Begin DoDot:1
+22 DO MES^XPDUTL("")
+23 DO MES^XPDUTL("** RPC "_RPCNAME_" is already registered to WEBG WEBVRAM GUI.")
End DoDot:1
QUIT
+24 ;
+25 SET ADDERR=0
+26 SET FDA(19.05,"+1,"_OPTIEN_",",.01)=RPCIEN
+27 DO UPDATE^DIE(,"FDA",,"FDAERR")
KILL FDA
+28 ;
+29 IF $DATA(FDAERR)
Begin DoDot:1
+30 SET ADDERR=1
+31 DO MES^XPDUTL("")
+32 DO MES^XPDUTL("** There was an issue adding RPC "_RPCNAME_" to")
+33 DO MES^XPDUTL(" WEBG WEBVRAM GUI context. It may need to be added manually.")
End DoDot:1
QUIT
+34 ;
+35 DO MES^XPDUTL("")
+36 DO MES^XPDUTL(">> RPC "_RPCNAME_" has been successfully registered to WEBG WEBVRAM GUI.")
+37 QUIT
