- 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 Mar 13, 2025@20:59:43 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 ;
