WEBGY00 ;SLC/SRM - Post-init for patch WEBG*1.0*0 ;11/18/19 09:39
;;1.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**0**;Jun 24, 2019;Build 15
;
POST ; initiate post-init processes
;
N RESULT,APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT
S APCODE="Dy5IYz(uTC|tYq|iJf2"
S APNAME="WEBVRAM"
S APCBT="S"
S APIP=""
S APPORT=-1
S APPATH=""
S APCONTEXT="WEBG WEBVRAM GUI"
S RESULT=$$BSESETUP(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT)
I '+RESULT D SHOWMSGB("***"_APNAME_" BSE SETUP FAILED: POST INSTALL *NOT* COMPLETED SUCCESSFULLY***") Q
D SHOWMSGB("=== POST INSTALL COMPLETED SUCCESSFULLY ===")
Q
;
BSESETUP(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT) ;
D SHOWMSG("REMOVING OLD "_APNAME_" ENTRY FROM 8994.5")
I +$$DELBSE(APCODE,APNAME) D Q $$SAVEBSE(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT)
. D SHOWMSG("ADDING NEW "_APNAME_" ENTRY TO 8994.5")
D SHOWMSG(APNAME_" SETUP *NOT* COMPLETED SUCCESSFULLY")
Q 0
;
DELBSE(NAME,APNAME) ;
D SHOWMSG("LOOKING FOR DUPLICATE "_APNAME_" ENTRY")
N ERR,LIST
D FIND^DIC(8994.5,"","@","X",NAME,"*","ACODE","","","LIST","ERR")
I '+$D(LIST("DILIST",0)) D Q 0
. D SHOWMSG("ERROR LOOKING UP OLD "_APNAME_" ENTRY")
. D SHOWMSG(ERR)
I '+$P(LIST("DILIST",0),"^",1) D Q 1
. D SHOWMSG("NO OLD "_APNAME_" ENTRIES FOUND")
N I,FDA S I=0
F S I=$O(LIST("DILIST",2,I)) Q:'I D
. K FDA S FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
. D FILE^DIE("","FDA","ERR")
. D SHOWMSG("REMOVED OLD "_APNAME_" ENTRY FROM 8994.5 ("_LIST("DILIST",2,I)_")")
. I $D(ERR) D
.. D SHOWMSG("ERROR DELETING OLD "_APNAME_" ENTRY")
.. D SHOWMSG(ERR)
Q 1
;
SAVEBSE(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT) ;
N FDA,ERR,INDEX
S FDA(8994.5,"+1,",.01)=APNAME
S INDEX=$$OPTINDEX(APCONTEXT)
I +$G(INDEX)'>0 D Q 0
. D SHOWMSG("COULD NOT FIND '"_APCONTEXT_"' OPTION:"_INDEX)
S FDA(8994.5,"+1,",.02)=INDEX
S FDA(8994.5,"+1,",.03)=APCODE
S FDA(8994.51,"+2,+1,",.01)=APCBT
S FDA(8994.51,"+2,+1,",.02)=APPORT
S FDA(8994.51,"+2,+1,",.03)=APIP
S FDA(8994.51,"+2,+1,",.04)=APPATH
D SHOWMSG("WRITING TO REMOTE APPLICATION FILE (8994.5)")
D UPDATE^DIE("","FDA","","ERR")
I +$D(ERR) D Q 0
. D SHOWMSG(ERR)
D SHOWMSG("REMOTE APPLICATION ENTRY SUCCESSFULLY ADDED")
Q 1
;
OPTINDEX(ACONTEXT) ; Finds the IEN of the option for a context
D SHOWMSG("LOOKING FOR '"_ACONTEXT_"':")
N INDEX,ERR S INDEX=$$FIND1^DIC(19,"","X",ACONTEXT,"B","","ERR")
I +$D(ERR) D Q 0
. D SHOWMSG("ERROR TRYING TO FIND OPTION")
. D SHOWMSG(ERR)
D SHOWMSG("FOUND OPTION")
Q INDEX
;
SHOWMSG(MSG) ; Displays messages to the patch log and the user
N TMSG
S TMSG=MSG
D MES^XPDUTL(.TMSG)
Q
;
SHOWMSGB(MSG) ; Displays message with an extra blank line
N TMSG
S TMSG=MSG
D BMES^XPDUTL(.TMSG)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWEBGY00 2821 printed Sep 23, 2025@20:22:36 Page 2
WEBGY00 ;SLC/SRM - Post-init for patch WEBG*1.0*0 ;11/18/19 09:39
+1 ;;1.0;WEB VISTA REMOTE ACCESS MANAGEMENT;**0**;Jun 24, 2019;Build 15
+2 ;
POST ; initiate post-init processes
+1 ;
+2 NEW RESULT,APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT
+3 SET APCODE="Dy5IYz(uTC|tYq|iJf2"
+4 SET APNAME="WEBVRAM"
+5 SET APCBT="S"
+6 SET APIP=""
+7 SET APPORT=-1
+8 SET APPATH=""
+9 SET APCONTEXT="WEBG WEBVRAM GUI"
+10 SET RESULT=$$BSESETUP(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT)
+11 IF '+RESULT
DO SHOWMSGB("***"_APNAME_" BSE SETUP FAILED: POST INSTALL *NOT* COMPLETED SUCCESSFULLY***")
QUIT
+12 DO SHOWMSGB("=== POST INSTALL COMPLETED SUCCESSFULLY ===")
+13 QUIT
+14 ;
BSESETUP(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT) ;
+1 DO SHOWMSG("REMOVING OLD "_APNAME_" ENTRY FROM 8994.5")
+2 IF +$$DELBSE(APCODE,APNAME)
Begin DoDot:1
+3 DO SHOWMSG("ADDING NEW "_APNAME_" ENTRY TO 8994.5")
End DoDot:1
QUIT $$SAVEBSE(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT)
+4 DO SHOWMSG(APNAME_" SETUP *NOT* COMPLETED SUCCESSFULLY")
+5 QUIT 0
+6 ;
DELBSE(NAME,APNAME) ;
+1 DO SHOWMSG("LOOKING FOR DUPLICATE "_APNAME_" ENTRY")
+2 NEW ERR,LIST
+3 DO FIND^DIC(8994.5,"","@","X",NAME,"*","ACODE","","","LIST","ERR")
+4 IF '+$DATA(LIST("DILIST",0))
Begin DoDot:1
+5 DO SHOWMSG("ERROR LOOKING UP OLD "_APNAME_" ENTRY")
+6 DO SHOWMSG(ERR)
End DoDot:1
QUIT 0
+7 IF '+$PIECE(LIST("DILIST",0),"^",1)
Begin DoDot:1
+8 DO SHOWMSG("NO OLD "_APNAME_" ENTRIES FOUND")
End DoDot:1
QUIT 1
+9 NEW I,FDA
SET I=0
+10 FOR
SET I=$ORDER(LIST("DILIST",2,I))
if 'I
QUIT
Begin DoDot:1
+11 KILL FDA
SET FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
+12 DO FILE^DIE("","FDA","ERR")
+13 DO SHOWMSG("REMOVED OLD "_APNAME_" ENTRY FROM 8994.5 ("_LIST("DILIST",2,I)_")")
+14 IF $DATA(ERR)
Begin DoDot:2
+15 DO SHOWMSG("ERROR DELETING OLD "_APNAME_" ENTRY")
+16 DO SHOWMSG(ERR)
End DoDot:2
End DoDot:1
+17 QUIT 1
+18 ;
SAVEBSE(APCODE,APNAME,APCBT,APIP,APPORT,APPATH,APCONTEXT) ;
+1 NEW FDA,ERR,INDEX
+2 SET FDA(8994.5,"+1,",.01)=APNAME
+3 SET INDEX=$$OPTINDEX(APCONTEXT)
+4 IF +$GET(INDEX)'>0
Begin DoDot:1
+5 DO SHOWMSG("COULD NOT FIND '"_APCONTEXT_"' OPTION:"_INDEX)
End DoDot:1
QUIT 0
+6 SET FDA(8994.5,"+1,",.02)=INDEX
+7 SET FDA(8994.5,"+1,",.03)=APCODE
+8 SET FDA(8994.51,"+2,+1,",.01)=APCBT
+9 SET FDA(8994.51,"+2,+1,",.02)=APPORT
+10 SET FDA(8994.51,"+2,+1,",.03)=APIP
+11 SET FDA(8994.51,"+2,+1,",.04)=APPATH
+12 DO SHOWMSG("WRITING TO REMOTE APPLICATION FILE (8994.5)")
+13 DO UPDATE^DIE("","FDA","","ERR")
+14 IF +$DATA(ERR)
Begin DoDot:1
+15 DO SHOWMSG(ERR)
End DoDot:1
QUIT 0
+16 DO SHOWMSG("REMOTE APPLICATION ENTRY SUCCESSFULLY ADDED")
+17 QUIT 1
+18 ;
OPTINDEX(ACONTEXT) ; Finds the IEN of the option for a context
+1 DO SHOWMSG("LOOKING FOR '"_ACONTEXT_"':")
+2 NEW INDEX,ERR
SET INDEX=$$FIND1^DIC(19,"","X",ACONTEXT,"B","","ERR")
+3 IF +$DATA(ERR)
Begin DoDot:1
+4 DO SHOWMSG("ERROR TRYING TO FIND OPTION")
+5 DO SHOWMSG(ERR)
End DoDot:1
QUIT 0
+6 DO SHOWMSG("FOUND OPTION")
+7 QUIT INDEX
+8 ;
SHOWMSG(MSG) ; Displays messages to the patch log and the user
+1 NEW TMSG
+2 SET TMSG=MSG
+3 DO MES^XPDUTL(.TMSG)
+4 QUIT
+5 ;
SHOWMSGB(MSG) ; Displays message with an extra blank line
+1 NEW TMSG
+2 SET TMSG=MSG
+3 DO BMES^XPDUTL(.TMSG)
+4 QUIT
+5 ;
