DGBT1PRE ;ALB/MRY - Env/Pre/Post-install of DGBT V1.0 ; 9/25/01 10:10 AM
;;1.0;Beneficiary Travel;;September 25, 2001
;
EN ;
S XPDABORT=""
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D G ABRT
. D BMES^XPDUTL("*****")
. D MES^XPDUTL("Your programming variables are not set up properly.")
. D MES^XPDUTL("Installation aborted.")
; Verify Registration v5.3 exists, else Quit.
I $$VERSION^XPDUTL("DG")'=5.3 D G ABRT
. W !!,"VERSION 5.3 OF REGISTRATION HAS NOT BEEN LOADED."
W !!,">> Environment check complete and okay."
Q
;
PRE ; Pre-init
; If previous beta version with different name, then correct name.
D FIND^DIC(9.4,"","@;1;.01","P","DGBT","","C","","","DGBTARRY")
S DGBTI=0
F S DGBTI=$O(DGBTARRY("DILIST",DGBTI)) Q:'DGBTI D
. S X=$G(DGBTARRY("DILIST",DGBTI,0)),DGBTIEN=$P(X,"^",1)
. I $P(X,"^",2)="DGBT",$P(X,"^",3)'="BENEFICIARY TRAVEL" D
. . ; Correct old name to this version name.
. . S FDATA(9.4,DGBTIEN_",",.01)="BENEFICIARY TRAVEL"
. . D FILE^DIE("E","FDATA","ERR")
K DGBTI,DGBTIEN,X,FDATA,ERR,DGBTARRY
;
; Remove 'DGBT' from ADDITIONAL PREFIXES of the Registration Package.
N DIC
S DIC="^DIC(9.4,",DIC(0)="X",X="REGISTRATION"
D ^DIC I Y<0 D G ABRT
. D BMES^XPDUTL("REGISTRATION PACKAGE HAS NOT BEEN FOUND")
. D MES^XPDUTL("CONTACT - PIMS National VISTA Support Team for assistance!")
APREF ; Delete 'DGBT' from ADDITIONAL PREFIXES Field (#14).
S (DA(1),DGBTY)=+Y,DIC=DIC_DA(1)_",14,"
S DIC(0)="X",DIC("P")=$P(^DD(9.4,14,0),"^",2),X="DGBT"
D ^DIC I Y<0 K DIC,X G XPREF
S DIE=DIC K DIC
S DA=+Y,DR=".01///@" D ^DIE
K DIE,DR,DA,Y
XPREF ; Add 'DGBT' entry to the EXCLUDED NAME SPACE (#919) field.
S DIC="^DIC(9.4,",DA(1)=+DGBTY
S DIC=DIC_DA(1)_",""EX"",",DIC(0)="L",DIC("P")=$P(^DD(9.4,919,0),"^",2)
S X="DGBT" D ^DIC
K DIC,DA,Y,X,DGBT Q
;
POST ; - Run Post-init to update PACKAGE entry for 'DGBT'.
D ^DGBT1POS
Q
;
ABRT S XPDABORT=2 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBT1PRE 1949 printed Oct 16, 2024@17:41:13 Page 2
DGBT1PRE ;ALB/MRY - Env/Pre/Post-install of DGBT V1.0 ; 9/25/01 10:10 AM
+1 ;;1.0;Beneficiary Travel;;September 25, 2001
+2 ;
EN ;
+1 SET XPDABORT=""
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("*****")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
End DoDot:1
GOTO ABRT
+6 ; Verify Registration v5.3 exists, else Quit.
+7 IF $$VERSION^XPDUTL("DG")'=5.3
Begin DoDot:1
+8 WRITE !!,"VERSION 5.3 OF REGISTRATION HAS NOT BEEN LOADED."
End DoDot:1
GOTO ABRT
+9 WRITE !!,">> Environment check complete and okay."
+10 QUIT
+11 ;
PRE ; Pre-init
+1 ; If previous beta version with different name, then correct name.
+2 DO FIND^DIC(9.4,"","@;1;.01","P","DGBT","","C","","","DGBTARRY")
+3 SET DGBTI=0
+4 FOR
SET DGBTI=$ORDER(DGBTARRY("DILIST",DGBTI))
if 'DGBTI
QUIT
Begin DoDot:1
+5 SET X=$GET(DGBTARRY("DILIST",DGBTI,0))
SET DGBTIEN=$PIECE(X,"^",1)
+6 IF $PIECE(X,"^",2)="DGBT"
IF $PIECE(X,"^",3)'="BENEFICIARY TRAVEL"
Begin DoDot:2
+7 ; Correct old name to this version name.
+8 SET FDATA(9.4,DGBTIEN_",",.01)="BENEFICIARY TRAVEL"
+9 DO FILE^DIE("E","FDATA","ERR")
End DoDot:2
End DoDot:1
+10 KILL DGBTI,DGBTIEN,X,FDATA,ERR,DGBTARRY
+11 ;
+12 ; Remove 'DGBT' from ADDITIONAL PREFIXES of the Registration Package.
+13 NEW DIC
+14 SET DIC="^DIC(9.4,"
SET DIC(0)="X"
SET X="REGISTRATION"
+15 DO ^DIC
IF Y<0
Begin DoDot:1
+16 DO BMES^XPDUTL("REGISTRATION PACKAGE HAS NOT BEEN FOUND")
+17 DO MES^XPDUTL("CONTACT - PIMS National VISTA Support Team for assistance!")
End DoDot:1
GOTO ABRT
APREF ; Delete 'DGBT' from ADDITIONAL PREFIXES Field (#14).
+1 SET (DA(1),DGBTY)=+Y
SET DIC=DIC_DA(1)_",14,"
+2 SET DIC(0)="X"
SET DIC("P")=$PIECE(^DD(9.4,14,0),"^",2)
SET X="DGBT"
+3 DO ^DIC
IF Y<0
KILL DIC,X
GOTO XPREF
+4 SET DIE=DIC
KILL DIC
+5 SET DA=+Y
SET DR=".01///@"
DO ^DIE
+6 KILL DIE,DR,DA,Y
XPREF ; Add 'DGBT' entry to the EXCLUDED NAME SPACE (#919) field.
+1 SET DIC="^DIC(9.4,"
SET DA(1)=+DGBTY
+2 SET DIC=DIC_DA(1)_",""EX"","
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9.4,919,0),"^",2)
+3 SET X="DGBT"
DO ^DIC
+4 KILL DIC,DA,Y,X,DGBT
QUIT
+5 ;
POST ; - Run Post-init to update PACKAGE entry for 'DGBT'.
+1 DO ^DGBT1POS
+2 QUIT
+3 ;
ABRT SET XPDABORT=2
QUIT
