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