DG53754A.m

DG53754A ;ALB/TDM - Patch DG*5.3*754 Pre-Install Utility Routine ; 6/8/09 11:36am

 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 ;

 Q

START ;Entry point for field definition cleanup

 N X,DGFIL,DGFLD,MSG

 ;

 D BMES^XPDUTL(">> Starting field definition cleanup...")

 S DGFIL=2 D HEADER F DGFLD=.03,.152,.351 D DELETE(DGFIL,DGFLD)

 D BMES^XPDUTL(">> Field definition cleanup completed")

 Q

 ;

HEADER ;Display file name & #

 S MSG=">> "_$P($G(^DIC(DGFIL,0)),U,1)_" File (#"_DGFIL_")"

 D BMES^XPDUTL(MSG)

 Q

 ;

DELETE(DGFIL,DGFLD) ;The procedure will delete the field definition from the Data Dictionary

 ;    DGFIL  - DD File Number (Required)

 ;    DGFLD  - DD Field Number (Required)

 ;

 Q:($G(DGFIL)=""!$G(DGFLD)="")

 N DIK,DA,DGFLDNM

 ;

 S DIK="^DD("_DGFIL_","

 S DA=DGFLD,DA(1)=DGFIL

 S DGFLDNM=$P($G(^DD(DGFIL,DGFLD,0)),U,1)

 S MSG="   Updating the '"_DGFLDNM_"' field (#"_DGFLD_") definition"

 D MES^XPDUTL(MSG)

 D ^DIK

 Q

DG53754A  ;ALB/TDM - Patch DG*5.3*754 Pre-Install Utility Routine ; 6/8/09 11:36am

 +1       ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 +2       ;

 +3        QUIT 

START     ;Entry point for field definition cleanup

 +1        NEW X,DGFIL,DGFLD,MSG

 +2       ;

 +3        DO BMES^XPDUTL(">> Starting field definition cleanup...")

 +4        SET DGFIL=2

           DO HEADER

           FOR DGFLD=.03,.152,.351

               DO DELETE(DGFIL,DGFLD)

 +5        DO BMES^XPDUTL(">> Field definition cleanup completed")

 +6        QUIT 

 +7       ;

HEADER    ;Display file name & #

 +1        SET MSG=">> "_$PIECE($GET(^DIC(DGFIL,0)),U,1)_" File (#"_DGFIL_")"

 +2        DO BMES^XPDUTL(MSG)

 +3        QUIT 

 +4       ;

DELETE(DGFIL,DGFLD) ;The procedure will delete the field definition from the Data Dictionary

 +1       ;    DGFIL  - DD File Number (Required)

 +2       ;    DGFLD  - DD Field Number (Required)

 +3       ;

 +4        IF ($GET(DGFIL)=""!$GET(DGFLD)="")

               QUIT 

 +5        NEW DIK,DA,DGFLDNM

 +6       ;

 +7        SET DIK="^DD("_DGFIL_","

 +8        SET DA=DGFLD

           SET DA(1)=DGFIL

 +9        SET DGFLDNM=$PIECE($GET(^DD(DGFIL,DGFLD,0)),U,1)

 +10       SET MSG="   Updating the '"_DGFLDNM_"' field (#"_DGFLD_") definition"

 +11       DO MES^XPDUTL(MSG)

 +12       DO ^DIK

 +13       QUIT