WEBVY22.m

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 ---WEBVY22   3783     printed  Apr 23, 2025@19:00:05                                                                                                                                                                                                     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       ;