- DG53688B ;ALB/TDM - Patch DG*5.3*688 Pre-Install Utility Routine ; 8/18/08 10:46am
- ;;5.3;Registration;**688**;AUG 13, 1993;Build 29
- ;
- 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=.119,.32102,.322013 D DELETE(DGFIL,DGFLD)
- S DGFIL=408.22 D HEADER S DGFLD=.11 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[HDG53688B 1028 printed Feb 19, 2025@00:04:27 Page 2
- DG53688B ;ALB/TDM - Patch DG*5.3*688 Pre-Install Utility Routine ; 8/18/08 10:46am
- +1 ;;5.3;Registration;**688**;AUG 13, 1993;Build 29
- +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=.119,.32102,.322013
- DO DELETE(DGFIL,DGFLD)
- +5 SET DGFIL=408.22
- DO HEADER
- SET DGFLD=.11
- DO DELETE(DGFIL,DGFLD)
- +6 DO BMES^XPDUTL(">> Field definition cleanup completed")
- +7 QUIT
- +8 ;
- +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