WEBVY22 ;ALB/AS-Pre-install WEBV*1.0*22 ; 3/14/11 2:49pm
;;1.0;VISTAWEB;**22**;;Build 1
;
Q
PRE ; Initialize pre-init routine
;
N RESULT,APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT
S APCODE="U'J+:[nVLM3sM<0'JAyI"
S APNAME="VISTAWEB-PROD"
S APIP="vaww.context.vistaweb.domain.ext"
S APPORT=19989
S APPATH="/resolve.do"
S APCONTEXT="OR CPRS GUI CHART"
S RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
I '+RESULT D
.D BMES^XPDUTL("**WARNING: Record Not Saved**")
.D BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
.W !
;
S APCODE="B3oxJ;%PB+Rga-[5W0AX"
S APNAME="VISTAWEB-PROD2"
S APIP="vaww.context2.vistaweb.domain.ext"
S APPORT=19985
S RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
I '+RESULT D
.D BMES^XPDUTL("**WARNING: Record Not Saved**")
.D BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
.W !
;
S APCODE="#ak5D;`EYI[ZOLtUQ[%J"
S APNAME="VISTAWEB-UAT"
S APIP="vaww.context.uat.domain.ext"
S APPORT=12173
S RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
I '+RESULT D
.D BMES^XPDUTL("**WARNING: Record Not Saved**")
.D BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
.W !
;
S APCODE="DlYc;3Wjyths_],1|[d$"
S APNAME="VISTAWEB-UAT2"
S APIP="vaww.context.uat2.domain.ext"
S APPORT=12181
S RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
I '+RESULT D
.D BMES^XPDUTL("**WARNING: Record Not Saved**")
.D BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
.W !
;
D BMES^XPDUTL(" ***INSTALL COMPLETED*** ")
Q
;
BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
I +$$DELBSE(APCODE) D Q $$SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
.D BMES^XPDUTL("ADDING NEW V/W ENTRY TO FILE (#8994.5)")
D BMES^XPDUTL("V/W ENTRY WAS NOT SUCCESSFUL!!")
Q 0
;
DELBSE(NAME) ;
N ERR,LIST
D BMES^XPDUTL("CHECKING FOR DUPLICATE V/W ENTRY....")
D FIND^DIC(8994.5,"","@","X",NAME,"*","ACODE","","","LIST","ERR")
I '+$D(LIST("DILIST",0)) D Q 0
.D BMES^XPDUTL("ERROR CHECKING FOR OLD V/W ENTRY...")
.D BMES^XPDUTL(ERR("DIERR","1","TEXT",1))
.D BMES^XPDUTL("PLEASE SUBMIT A REMEDY TICKET")
I '+$P(LIST("DILIST",0),"^",1) D Q 1
.D BMES^XPDUTL("NO DUPLICATE V/W 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 BMES^XPDUTL("REMOVED OLD V/W ENTRY FROM (#8994.5) ("_LIST("DILIST",2,I)_")")
.I $D(ERR) D
..D BMES^XPDUTL("ERROR REMOVING OLD V/W ENTRY")
..D BMES^XPDUTL(ERR("DIERR","1","TEXT",1))
..D BMES^XPDUTL("PLEASE SUBMIT A REMEDY TICKET")
Q 1
;
SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) ;
N FDA,ERR,INDEX
S FDA(8994.5,"+1,",.01)=APNAME
S INDEX=$$CPRSOPT(APCONTEXT)
I +$G(INDEX)'>0 D Q 0
.D BMES^XPDUTL("COULD NOT FIND CPRS OPTION:"_""""_APCONTEXT_"""")
S FDA(8994.5,"+1,",.02)=INDEX
S FDA(8994.5,"+1,",.03)=APCODE
S FDA(8994.51,"+2,+1,",.01)="H"
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 BMES^XPDUTL("WRITING ENTRY TO THE REMOTE APPLICATION FILE(#8994.5)")
D UPDATE^DIE("","FDA","","ERR")
I +$D(ERR) D Q 0
.D BMES^XPDUTL("ERROR WRITING ENTRY TO FILE (#8994.5)")
.D BMES^XPDUTL(ERR("DIERR","1","TEXT",1))
.D BMES^XPDUTL("PLEASE SUBMIT A REMEDY TICKET")
.W !
D BMES^XPDUTL("VISTAWEB ENTRY SUCCESSFULLY ADDED")
Q 1
;
CPRSOPT(ACONTEXT) ; FINDS THE IEN OF THE OPTION FOR A CONTEXT
N INDEX,ERR S INDEX=$$FIND1^DIC(19,"","X",ACONTEXT,"B","","ERR")
D BMES^XPDUTL("CHECKING FOR """_ACONTEXT_"""")
I +$D(ERR) D Q 0
.D BMES^XPDUTL("ERROR CHECKING FOR OPTION!")
;I INDEX= D BMES^XPDUTL("OPTION """_ACONTEXT_""" FOUND")
Q INDEX
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWEBVY22 3783 printed Apr 09, 2024@21:47:40 Page 2
WEBVY22 ;ALB/AS-Pre-install WEBV*1.0*22 ; 3/14/11 2:49pm
+1 ;;1.0;VISTAWEB;**22**;;Build 1
+2 ;
+3 QUIT
PRE ; Initialize pre-init routine
+1 ;
+2 NEW RESULT,APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT
+3 SET APCODE="U'J+:[nVLM3sM<0'JAyI"
+4 SET APNAME="VISTAWEB-PROD"
+5 SET APIP="vaww.context.vistaweb.domain.ext"
+6 SET APPORT=19989
+7 SET APPATH="/resolve.do"
+8 SET APCONTEXT="OR CPRS GUI CHART"
+9 SET RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+10 IF '+RESULT
Begin DoDot:1
+11 DO BMES^XPDUTL("**WARNING: Record Not Saved**")
+12 DO BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
+13 WRITE !
End DoDot:1
+14 ;
+15 SET APCODE="B3oxJ;%PB+Rga-[5W0AX"
+16 SET APNAME="VISTAWEB-PROD2"
+17 SET APIP="vaww.context2.vistaweb.domain.ext"
+18 SET APPORT=19985
+19 SET RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+20 IF '+RESULT
Begin DoDot:1
+21 DO BMES^XPDUTL("**WARNING: Record Not Saved**")
+22 DO BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
+23 WRITE !
End DoDot:1
+24 ;
+25 SET APCODE="#ak5D;`EYI[ZOLtUQ[%J"
+26 SET APNAME="VISTAWEB-UAT"
+27 SET APIP="vaww.context.uat.domain.ext"
+28 SET APPORT=12173
+29 SET RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+30 IF '+RESULT
Begin DoDot:1
+31 DO BMES^XPDUTL("**WARNING: Record Not Saved**")
+32 DO BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
+33 WRITE !
End DoDot:1
+34 ;
+35 SET APCODE="DlYc;3Wjyths_],1|[d$"
+36 SET APNAME="VISTAWEB-UAT2"
+37 SET APIP="vaww.context.uat2.domain.ext"
+38 SET APPORT=12181
+39 SET RESULT=$$BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+40 IF '+RESULT
Begin DoDot:1
+41 DO BMES^XPDUTL("**WARNING: Record Not Saved**")
+42 DO BMES^XPDUTL("PLEASE VIEW THE INSTALL FILE FOR ERROR(S)")
+43 WRITE !
End DoDot:1
+44 ;
+45 DO BMES^XPDUTL(" ***INSTALL COMPLETED*** ")
+46 QUIT
+47 ;
BSESETUP(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) +1 IF +$$DELBSE(APCODE)
Begin DoDot:1
+2 DO BMES^XPDUTL("ADDING NEW V/W ENTRY TO FILE (#8994.5)")
End DoDot:1
QUIT $$SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT)
+3 DO BMES^XPDUTL("V/W ENTRY WAS NOT SUCCESSFUL!!")
+4 QUIT 0
+5 ;
DELBSE(NAME) ;
+1 NEW ERR,LIST
+2 DO BMES^XPDUTL("CHECKING FOR DUPLICATE V/W ENTRY....")
+3 DO FIND^DIC(8994.5,"","@","X",NAME,"*","ACODE","","","LIST","ERR")
+4 IF '+$DATA(LIST("DILIST",0))
Begin DoDot:1
+5 DO BMES^XPDUTL("ERROR CHECKING FOR OLD V/W ENTRY...")
+6 DO BMES^XPDUTL(ERR("DIERR","1","TEXT",1))
+7 DO BMES^XPDUTL("PLEASE SUBMIT A REMEDY TICKET")
End DoDot:1
QUIT 0
+8 IF '+$PIECE(LIST("DILIST",0),"^",1)
Begin DoDot:1
+9 DO BMES^XPDUTL("NO DUPLICATE V/W ENTRIES FOUND")
End DoDot:1
QUIT 1
+10 NEW I,FDA
SET I=0
+11 FOR
SET I=$ORDER(LIST("DILIST",2,I))
if 'I
QUIT
Begin DoDot:1
+12 KILL FDA
SET FDA(8994.5,LIST("DILIST",2,I)_",",.01)="@"
+13 DO FILE^DIE("","FDA","ERR")
+14 DO BMES^XPDUTL("REMOVED OLD V/W ENTRY FROM (#8994.5) ("_LIST("DILIST",2,I)_")")
+15 IF $DATA(ERR)
Begin DoDot:2
+16 DO BMES^XPDUTL("ERROR REMOVING OLD V/W ENTRY")
+17 DO BMES^XPDUTL(ERR("DIERR","1","TEXT",1))
+18 DO BMES^XPDUTL("PLEASE SUBMIT A REMEDY TICKET")
End DoDot:2
End DoDot:1
+19 QUIT 1
+20 ;
SAVEBSE(APCODE,APNAME,APIP,APPORT,APPATH,APCONTEXT) ;
+1 NEW FDA,ERR,INDEX
+2 SET FDA(8994.5,"+1,",.01)=APNAME
+3 SET INDEX=$$CPRSOPT(APCONTEXT)
+4 IF +$GET(INDEX)'>0
Begin DoDot:1
+5 DO BMES^XPDUTL("COULD NOT FIND CPRS OPTION:"_""""_APCONTEXT_"""")
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)="H"
+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 BMES^XPDUTL("WRITING ENTRY TO THE REMOTE APPLICATION FILE(#8994.5)")
+13 DO UPDATE^DIE("","FDA","","ERR")
+14 IF +$DATA(ERR)
Begin DoDot:1
+15 DO BMES^XPDUTL("ERROR WRITING ENTRY TO FILE (#8994.5)")
+16 DO BMES^XPDUTL(ERR("DIERR","1","TEXT",1))
+17 DO BMES^XPDUTL("PLEASE SUBMIT A REMEDY TICKET")
+18 WRITE !
End DoDot:1
QUIT 0
+19 DO BMES^XPDUTL("VISTAWEB ENTRY SUCCESSFULLY ADDED")
+20 QUIT 1
+21 ;
CPRSOPT(ACONTEXT) ; FINDS THE IEN OF THE OPTION FOR A CONTEXT
+1 NEW INDEX,ERR
SET INDEX=$$FIND1^DIC(19,"","X",ACONTEXT,"B","","ERR")
+2 DO BMES^XPDUTL("CHECKING FOR """_ACONTEXT_"""")
+3 IF +$DATA(ERR)
Begin DoDot:1
+4 DO BMES^XPDUTL("ERROR CHECKING FOR OPTION!")
End DoDot:1
QUIT 0
+5 ;I INDEX= D BMES^XPDUTL("OPTION """_ACONTEXT_""" FOUND")
+6 QUIT INDEX
+7 ;
