DGBT1POS.m

DGBT1POS ;ALB/LEB - Post-install of DGBT v1.0 ;[ 11/21/01 13:20 pm]

 ;;1.0;Beneficiary Travel;;Jun 25,  2001

 ;

 ; Update PACKAGE (#2) File fields not updated by the KIDS install.

 ; Used for documentation purposes.

 ;

 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:

 ;       Short Description (#2); required field

 ;       Description (#3)      ; word processing field

 ;       File (#6)             ; multiple

 ;         Fields              ; multiple

 ;

 ; - Replace Short Description (#2) field.

 K FDATA S FDATA(9.4,DGBTIEN_",",2)="Beneficiary Travel"

 D FILE^DIE("E","FDATA","ERR")

 D BMES^XPDUTL(" ")

 D MES^XPDUTL("     SHORT DESCRIPTION field complete.")

 K FDATA,ERR

 ;

 ; - Replace Description (#3) field. Leave blank.

 D WP^DIE(9.4,DGBTIEN_",",3,"K","")

 D BMES^XPDUTL(" ")

 D MES^XPDUTL("     DESCRIPTION field complete.")

 ;

FILE ; - Replace File (#9.44) field.

 ;   first remove (delete) existing fields.

 N DIC K DGBTARRY

 D LIST^DIC(9.44,","_DGBTIEN_",","@;.01","P","","","","","","","DGBTARRY")

 S (DGBTII,DGBTFIL)=0

 F  S DGBTII=$O(DGBTARRY("DILIST",DGBTII)) Q:'DGBTII  D

 . S DGBTFIEN=$P(DGBTARRY("DILIST",DGBTII,0),"^",1)

 . S DIE="^DIC(9.4,",DA(1)=DGBTIEN,DIE=DIE_DA(1)_",4,"

 . S DA=+DGBTFIEN,DR=".01///@" D ^DIE

 ;   after old entries deleted, add current File entries

 F X="43","43.1","392","392.1","392.2","392.3","392.4" 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

 D BMES^XPDUTL(" ")

 D MES^XPDUTL("     FILE field complete.")

 ; - Add fields.

FLDS ; Add FIELD entries to File entries #43, #43.1

 ; Add ASSIGN A VERSION NUMBER? entries to File entries #392-392.4

 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="43","43.1","392","392.1","392.2","392.3","392.4" D

 . D ^DIC

 . S DIE=DIC,DA=+Y

 . I X=43 F FLD=720,721,722 S DR="2///"_FLD D ^DIE

 . I X=43.1 F FLD=30.01,30.02,30.03,30.04,30.05 S DR="2///"_FLD D ^DIE

 . I X[392 S DR="222.2///Y" D ^DIE

 D BMES^XPDUTL(" ")

 D MES^XPDUTL("     FIELD field complete.")

 ;

XPREF ; Add 'DGBTZ' entry to the EXCLUDED NAME SPACE (#919) field.

 S DIC="^DIC(9.4,",DA(1)=DGBTIEN

 S DIC=DIC_DA(1)_",""EX"",",DIC(0)="L",DIC("P")=$P(^DD(9.4,919,0),"^",2)

 S X="DGBTZ" D ^DIC

 ;

EXIT K DIC,DIE,DGBTII,DGBTFIL,DGBTFIEN,DGBTIEN,X,DA,DGBTARRY

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGBT1POS   2900     printed  Apr 23, 2025@17:54:47                                                                                                                                                                                                    Page 2

DGBT1POS  ;ALB/LEB - Post-install of DGBT v1.0 ;[ 11/21/01 13:20 pm]

 +1       ;;1.0;Beneficiary Travel;;Jun 25,  2001

 +2       ;

 +3       ; Update PACKAGE (#2) File fields not updated by the KIDS install.

 +4       ; Used for documentation purposes.

 +5       ;

 +6        DO BMES^XPDUTL(" ")

 +7        DO MES^XPDUTL("   Updating PACKAGE File...")

 +8       ;

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       ;       Short Description (#2); required field

 +3       ;       Description (#3)      ; word processing field

 +4       ;       File (#6)             ; multiple

 +5       ;         Fields              ; multiple

 +6       ;

 +7       ; - Replace Short Description (#2) field.

 +8        KILL FDATA

           SET FDATA(9.4,DGBTIEN_",",2)="Beneficiary Travel"

 +9        DO FILE^DIE("E","FDATA","ERR")

 +10       DO BMES^XPDUTL(" ")

 +11       DO MES^XPDUTL("     SHORT DESCRIPTION field complete.")

 +12       KILL FDATA,ERR

 +13      ;

 +14      ; - Replace Description (#3) field. Leave blank.

 +15       DO WP^DIE(9.4,DGBTIEN_",",3,"K","")

 +16       DO BMES^XPDUTL(" ")

 +17       DO MES^XPDUTL("     DESCRIPTION field complete.")

 +18      ;

FILE      ; - Replace File (#9.44) field.

 +1       ;   first remove (delete) existing fields.

 +2        NEW DIC

           KILL DGBTARRY

 +3        DO LIST^DIC(9.44,","_DGBTIEN_",","@;.01","P","","","","","","","DGBTARRY")

 +4        SET (DGBTII,DGBTFIL)=0

 +5        FOR 

               SET DGBTII=$ORDER(DGBTARRY("DILIST",DGBTII))

               if 'DGBTII

                   QUIT 

               Begin DoDot:1

 +6                SET DGBTFIEN=$PIECE(DGBTARRY("DILIST",DGBTII,0),"^",1)

 +7                SET DIE="^DIC(9.4,"

                   SET DA(1)=DGBTIEN

                   SET DIE=DIE_DA(1)_",4,"

 +8                SET DA=+DGBTFIEN

                   SET DR=".01///@"

                   DO ^DIE

               End DoDot:1

 +9       ;   after old entries deleted, add current File entries

 +10       FOR X="43","43.1","392","392.1","392.2","392.3","392.4"

               Begin DoDot:1

 +11               SET DIC="^DIC(9.4,"

                   SET DA(1)=DGBTIEN

 +12               SET DIC=DIC_DA(1)_",4,"

                   SET DIC(0)="L"

                   SET DIC("P")=$PIECE(^DD(9.4,6,0),"^",2)

 +13               DO ^DIC

               End DoDot:1

 +14       DO BMES^XPDUTL(" ")

 +15       DO MES^XPDUTL("     FILE field complete.")

 +16      ; - Add fields.

FLDS      ; Add FIELD entries to File entries #43, #43.1

 +1       ; Add ASSIGN A VERSION NUMBER? entries to File entries #392-392.4

 +2        SET DIC="^DIC(9.4,"

           SET DA(1)=DGBTIEN

           SET DIC(0)="X"

 +3        SET DIC=DIC_DA(1)_",4,"

           SET DIC("P")=$PIECE(^DD(9.4,6,0),"^",2)

 +4        FOR X="43","43.1","392","392.1","392.2","392.3","392.4"

               Begin DoDot:1

 +5                DO ^DIC

 +6                SET DIE=DIC

                   SET DA=+Y

 +7                IF X=43

                       FOR FLD=720,721,722

                           SET DR="2///"_FLD

                           DO ^DIE

 +8                IF X=43.1

                       FOR FLD=30.01,30.02,30.03,30.04,30.05

                           SET DR="2///"_FLD

                           DO ^DIE

 +9                IF X[392

                       SET DR="222.2///Y"

                       DO ^DIE

               End DoDot:1

 +10       DO BMES^XPDUTL(" ")

 +11       DO MES^XPDUTL("     FIELD field complete.")

 +12      ;

XPREF     ; Add 'DGBTZ' entry to the EXCLUDED NAME SPACE (#919) field.

 +1        SET DIC="^DIC(9.4,"

           SET DA(1)=DGBTIEN

 +2        SET DIC=DIC_DA(1)_",""EX"","

           SET DIC(0)="L"

           SET DIC("P")=$PIECE(^DD(9.4,919,0),"^",2)

 +3        SET X="DGBTZ"

           DO ^DIC

 +4       ;

EXIT       KILL DIC,DIE,DGBTII,DGBTFIL,DGBTFIEN,DGBTIEN,X,DA,DGBTARRY

 +1        QUIT