- 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 Jan 18, 2025@03:47:22 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