DGBT1P2 ;ALB/MRY - Patch #2 Environment Check ; 4/23/02 10:04 AM
;;1.0;Beneficiary Travel;**2**;Septembr 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 that Bene Travel v1.0 exists, else Quit.
I $$VERSION^XPDUTL("DGBT")'="1.0" D G ABRT
. D BMES^XPDUTL("*****")
. D MES^XPDUTL("VERSION 1.0 OF BENEFICIARY TRAVEL HAS NOT BEEN LOADED.")
. D MES^XPDUTL("Installation aborted.")
W !!,">> Environment check complete and okay."
Q
;
ABRT ; Abort transport, but leave in ^XTMP.
S ^XPDABORT=2 Q
;
POST ; Post install - add #392.31 file to list of DGBT files in Package file.
N DGBTI,DGBTIEN,DGBTARRY,DIC,X,DA,DR
D BMES^XPDUTL(" ")
D MES^XPDUTL(" Updating PACKAGE File...")
;
PKG ; Retrieve 'DGBT' Package name
; Get Package IEN
D FIND^DIC(9.4,"","@;1","P","DGBT","","C","","","DGBTARRY")
S (DGBTI,DGBTIEN)=0
F S DGBTI=$O(DGBTARRY("DILIST",DGBTI)) Q:'DGBTI D
. Q:$P($G(DGBTARRY("DILIST",DGBTI,0)),"^",2)'="DGBT"
. S DGBTIEN=$P($G(DGBTARRY("DILIST",DGBTI,0)),"^",1)
I 'DGBTIEN D G EXIT
. D BMES^XPDUTL(" ")
. D MES^XPDUTL(" No PACKAGE entry defined - Cannot update!")
;
UPD ; - Update fields not updated by the KIDS install.
; fields:
; File (#6) ; multiple
; Fields ; multiple
;
FILE ; Add #392.31 to list of files under Bene Travel.
F X="392.31" D
. S DIC="^DIC(9.4,",DA(1)=DGBTIEN
. S DIC=DIC_DA(1)_",4,",DIC(0)="L",DIC("P")=$P(^DD(9.4,6,0),"^",2)
. D ^DIC
;
FLDS ; Add ASSIGN A VERSION NUMBER? entries to File entry #392.31
S DIC="^DIC(9.4,",DA(1)=DGBTIEN,DIC(0)="X"
S DIC=DIC_DA(1)_",4,",DIC("P")=$P(^DD(9.4,6,0),"^",2)
F X="392.31" D
. D ^DIC
. S DIE=DIC,DA=+Y
. I X[392 S DR="222.2///Y" D ^DIE
D BMES^XPDUTL(" ")
D MES^XPDUTL(" Updating PACKAGE file complete.")
;
DD ;Hardset IDENTIFIER routine into DD (DBIA #4093)
S ^DD(392.31,0,"ID","Z")="G START^DGBTID"
;
EXIT K DIC,DGBTARRY,DGBTI,DGBTIEN,X,DA,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBT1P2 2148 printed Nov 22, 2024@16:50:26 Page 2
DGBT1P2 ;ALB/MRY - Patch #2 Environment Check ; 4/23/02 10:04 AM
+1 ;;1.0;Beneficiary Travel;**2**;Septembr 25, 2001
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 that Bene Travel v1.0 exists, else Quit.
+7 IF $$VERSION^XPDUTL("DGBT")'="1.0"
Begin DoDot:1
+8 DO BMES^XPDUTL("*****")
+9 DO MES^XPDUTL("VERSION 1.0 OF BENEFICIARY TRAVEL HAS NOT BEEN LOADED.")
+10 DO MES^XPDUTL("Installation aborted.")
End DoDot:1
GOTO ABRT
+11 WRITE !!,">> Environment check complete and okay."
+12 QUIT
+13 ;
ABRT ; Abort transport, but leave in ^XTMP.
+1 SET ^XPDABORT=2
QUIT
+2 ;
POST ; Post install - add #392.31 file to list of DGBT files in Package file.
+1 NEW DGBTI,DGBTIEN,DGBTARRY,DIC,X,DA,DR
+2 DO BMES^XPDUTL(" ")
+3 DO MES^XPDUTL(" Updating PACKAGE File...")
+4 ;
PKG ; Retrieve 'DGBT' Package name
+1 ; Get Package IEN
+2 DO FIND^DIC(9.4,"","@;1","P","DGBT","","C","","","DGBTARRY")
+3 SET (DGBTI,DGBTIEN)=0
+4 FOR
SET DGBTI=$ORDER(DGBTARRY("DILIST",DGBTI))
if 'DGBTI
QUIT
Begin DoDot:1
+5 if $PIECE($GET(DGBTARRY("DILIST",DGBTI,0)),"^",2)'="DGBT"
QUIT
+6 SET DGBTIEN=$PIECE($GET(DGBTARRY("DILIST",DGBTI,0)),"^",1)
End DoDot:1
+7 IF 'DGBTIEN
Begin DoDot:1
+8 DO BMES^XPDUTL(" ")
+9 DO MES^XPDUTL(" No PACKAGE entry defined - Cannot update!")
End DoDot:1
GOTO EXIT
+10 ;
UPD ; - Update fields not updated by the KIDS install.
+1 ; fields:
+2 ; File (#6) ; multiple
+3 ; Fields ; multiple
+4 ;
FILE ; Add #392.31 to list of files under Bene Travel.
+1 FOR X="392.31"
Begin DoDot:1
+2 SET DIC="^DIC(9.4,"
SET DA(1)=DGBTIEN
+3 SET DIC=DIC_DA(1)_",4,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9.4,6,0),"^",2)
+4 DO ^DIC
End DoDot:1
+5 ;
FLDS ; Add ASSIGN A VERSION NUMBER? entries to File entry #392.31
+1 SET DIC="^DIC(9.4,"
SET DA(1)=DGBTIEN
SET DIC(0)="X"
+2 SET DIC=DIC_DA(1)_",4,"
SET DIC("P")=$PIECE(^DD(9.4,6,0),"^",2)
+3 FOR X="392.31"
Begin DoDot:1
+4 DO ^DIC
+5 SET DIE=DIC
SET DA=+Y
+6 IF X[392
SET DR="222.2///Y"
DO ^DIE
End DoDot:1
+7 DO BMES^XPDUTL(" ")
+8 DO MES^XPDUTL(" Updating PACKAGE file complete.")
+9 ;
DD ;Hardset IDENTIFIER routine into DD (DBIA #4093)
+1 SET ^DD(392.31,0,"ID","Z")="G START^DGBTID"
+2 ;
EXIT KILL DIC,DGBTARRY,DGBTI,DGBTIEN,X,DA,DR
+1 QUIT
