DG53754A ;ALB/TDM - Patch DG*5.3*754 Pre-Install Utility Routine ; 6/8/09 11:36am
;;5.3;Registration;**754**;AUG 13, 1993;Build 46
;
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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53754A 961 printed Dec 13, 2024@02:38:39 Page 2
DG53754A ;ALB/TDM - Patch DG*5.3*754 Pre-Install Utility Routine ; 6/8/09 11:36am
+1 ;;5.3;Registration;**754**;AUG 13, 1993;Build 46
+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 ;
+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
