XOBUPRE ;; mjk,ld/alb - Foundations Pre-Init ; 07/27/2002 13:00
;;1.6;Foundations;;May 08, 2009;Build 15
;Per VHA directive 2004-038, this routine should not be modified.
QUIT
;
EN ; -- pre-init code
;
; -- change package file name entry from XOBS VISTALINK SECURITY to VISTALINK SECURITY
DO PKGCHG
;
; -- delete obsolete SYSTEM file (18) if it exists
DO DEL(18,"SYSTEM")
;
; -- delete VISTALINK PERSON file (18.09) if it exists (interim file used in early developers' previews)
DO DEL(18.09,"VISTALINK PERSON")
;
IF $$CHK() QUIT
;
; -- delete FOUNDATIONS SITE PARAMETERS file (18.01)
DO DEL(18.01,"FOUNDATIONS SITE PARAMETERS")
;
; -- delete FOUNDATIONS SECURITY PROVIDER file (18.02)
DO DEL(18.02,"FOUNDATIONS SECURITY PROVIDER")
;
QUIT
;
PKGCHG ; -- change package file name
;
; -- change package file name entry to VISTALINK SECURITY
; (should only affect VistALink v1.0 test sites)
NEW DA,DIC,DIE,DR,X,Y
SET DIC="^DIC(9.4,",DIC(0)="X",X="XOBS VISTALINK SECURITY" DO ^DIC
IF +Y>0 SET DIE=DIC,DA=+Y,DR=".01///VISTALINK SECURITY" DO ^DIE
;
; -- change package PREFIX for entry FOUNDATIONS
; (should only affect VistALink v1.0 test sites)
NEW DA,DIC,DIE,DR,X,Y
SET DIC="^DIC(9.4,",DIC(0)="X",X="FOUNDATIONS",DIC("S")="IF $P(^(0),U,2)=""XOB""" DO ^DIC
IF +Y>0 SET DIE=DIC,DA=+Y,DR="1///XOBU" DO ^DIE
;
QUIT
;
CHK() ; -- is newer version present
NEW XOBRES
;
; -- check if new configuration file is present
DO FILE^DID(18.03,"","NAME","XOBRES")
;
; -- if config file present than newer version installed
QUIT $GET(XOBRES("NAME"))="VISTALINK LISTENER CONFIGURATION"
;
DEL(XOBFILE,XOBNAME) ; -- delete file
NEW DIU,XOBRES
;
DO FILE^DID(XOBFILE,"","NAME","XOBRES")
;
; -- if file present then delete
IF $GET(XOBRES("NAME"))=XOBNAME DO
. ; -- delete file and data
. SET DIU=XOBFILE,DIU(0)="TD" DO EN^DIU2
;
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXOBUPRE 1935 printed Dec 13, 2024@01:55:05 Page 2
XOBUPRE ;; mjk,ld/alb - Foundations Pre-Init ; 07/27/2002 13:00
+1 ;;1.6;Foundations;;May 08, 2009;Build 15
+2 ;Per VHA directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
EN ; -- pre-init code
+1 ;
+2 ; -- change package file name entry from XOBS VISTALINK SECURITY to VISTALINK SECURITY
+3 DO PKGCHG
+4 ;
+5 ; -- delete obsolete SYSTEM file (18) if it exists
+6 DO DEL(18,"SYSTEM")
+7 ;
+8 ; -- delete VISTALINK PERSON file (18.09) if it exists (interim file used in early developers' previews)
+9 DO DEL(18.09,"VISTALINK PERSON")
+10 ;
+11 IF $$CHK()
QUIT
+12 ;
+13 ; -- delete FOUNDATIONS SITE PARAMETERS file (18.01)
+14 DO DEL(18.01,"FOUNDATIONS SITE PARAMETERS")
+15 ;
+16 ; -- delete FOUNDATIONS SECURITY PROVIDER file (18.02)
+17 DO DEL(18.02,"FOUNDATIONS SECURITY PROVIDER")
+18 ;
+19 QUIT
+20 ;
PKGCHG ; -- change package file name
+1 ;
+2 ; -- change package file name entry to VISTALINK SECURITY
+3 ; (should only affect VistALink v1.0 test sites)
+4 NEW DA,DIC,DIE,DR,X,Y
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="X"
SET X="XOBS VISTALINK SECURITY"
DO ^DIC
+6 IF +Y>0
SET DIE=DIC
SET DA=+Y
SET DR=".01///VISTALINK SECURITY"
DO ^DIE
+7 ;
+8 ; -- change package PREFIX for entry FOUNDATIONS
+9 ; (should only affect VistALink v1.0 test sites)
+10 NEW DA,DIC,DIE,DR,X,Y
+11 SET DIC="^DIC(9.4,"
SET DIC(0)="X"
SET X="FOUNDATIONS"
SET DIC("S")="IF $P(^(0),U,2)=""XOB"""
DO ^DIC
+12 IF +Y>0
SET DIE=DIC
SET DA=+Y
SET DR="1///XOBU"
DO ^DIE
+13 ;
+14 QUIT
+15 ;
CHK() ; -- is newer version present
+1 NEW XOBRES
+2 ;
+3 ; -- check if new configuration file is present
+4 DO FILE^DID(18.03,"","NAME","XOBRES")
+5 ;
+6 ; -- if config file present than newer version installed
+7 QUIT $GET(XOBRES("NAME"))="VISTALINK LISTENER CONFIGURATION"
+8 ;
DEL(XOBFILE,XOBNAME) ; -- delete file
+1 NEW DIU,XOBRES
+2 ;
+3 DO FILE^DID(XOBFILE,"","NAME","XOBRES")
+4 ;
+5 ; -- if file present then delete
+6 IF $GET(XOBRES("NAME"))=XOBNAME
Begin DoDot:1
+7 ; -- delete file and data
+8 SET DIU=XOBFILE
SET DIU(0)="TD"
DO EN^DIU2
End DoDot:1
+9 ;
+10 QUIT
+11 ;
