Routine: DGBT1P2

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."

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBT1P2   2148     printed  Mar 13, 2025@20:44:53                                                                                                                                                                                                     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

DGBT1P2.m