DG53765P.m

DG53765P ;ALB/LBD - Patch DG*5.3*765 Post-Install Routine ; 7/25/07 12:53pm

 ;;5.3;Registration;**765**;AUG 13, 1993;Build 3

 Q

 ;

EN ; This routine will update the USE FOR Z07 CHECK field #6

 ; in the INCONSISTENT DATA ELEMENTS file #38.6 for CC 72, 74 and 81

 N RULE,DA,DIE,DR

 F RULE=72,74,81 D

 .D BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")

 .S DIE=38.6,DA=$$FIND1^DIC(DIE,"","X",RULE)

 .I 'DA D  Q

 ..D MES^XPDUTL("    *** Entry not found! Nothing Updated!! ***") Q

 .S DR="6////0" D ^DIE

 .D MES^XPDUTL("    *** Update Complete ***")

 D BMES^XPDUTL("")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53765P   594     printed  Sep 23, 2025@20:14:36                                                                                                                                                                                                     Page 2

DG53765P  ;ALB/LBD - Patch DG*5.3*765 Post-Install Routine ; 7/25/07 12:53pm

 +1       ;;5.3;Registration;**765**;AUG 13, 1993;Build 3

 +2        QUIT 

 +3       ;

EN        ; This routine will update the USE FOR Z07 CHECK field #6

 +1       ; in the INCONSISTENT DATA ELEMENTS file #38.6 for CC 72, 74 and 81

 +2        NEW RULE,DA,DIE,DR

 +3        FOR RULE=72,74,81

               Begin DoDot:1

 +4                DO BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")

 +5                SET DIE=38.6

                   SET DA=$$FIND1^DIC(DIE,"","X",RULE)

 +6                IF 'DA

                       Begin DoDot:2

 +7                        DO MES^XPDUTL("    *** Entry not found! Nothing Updated!! ***")

                           QUIT 

                       End DoDot:2

                       QUIT 

 +8                SET DR="6////0"

                   DO ^DIE

 +9                DO MES^XPDUTL("    *** Update Complete ***")

               End DoDot:1

 +10       DO BMES^XPDUTL("")

 +11       QUIT 

 +12      ;