WEBG021P ; SLC/PWC - WEBG*3*21 Post Init Routine; July 17 2024@12:00 PM
;;3.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**21**;Apr 06, 2021;Build 3
;;Per VHA Directive 6402, this routine should not be modified
;
; File #19.05 updates - Covered by Supported ICR# 10075
;
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="PSO EPCS PSDRPH FILER" 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[HWEBG021P 2528 printed Sep 23, 2025@20:22:33 Page 2
WEBG021P ; SLC/PWC - WEBG*3*21 Post Init Routine; July 17 2024@12:00 PM
+1 ;;3.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**21**;Apr 06, 2021;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; File #19.05 updates - Covered by Supported ICR# 10075
+5 ;
+6 QUIT
+7 ;
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="PSO EPCS PSDRPH FILER"
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
