DG53771P ;ALB/ERC - Patch DG53771P Post Install ;10/30/07
;;5.3;Registration;**771**;AUG 13, 1995;Build 5
;
Q
EN ; This routine will update the USE FOR Z07 CHECK field #6
; in the INCONSISTENT DATA ELEMENTS file #38.6 for CC
; 75, 76, 78, 306, 307 and 409
N RULE,DA,DIE,DR
F RULE=75,76,78,306,307,409 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 ---[H[J[2J[HDG53771P 604 printed Dec 13, 2024@02:38:46 Page 2
DG53771P ;ALB/ERC - Patch DG53771P Post Install ;10/30/07
+1 ;;5.3;Registration;**771**;AUG 13, 1995;Build 5
+2 ;
+3 QUIT
EN ; This routine will update the USE FOR Z07 CHECK field #6
+1 ; in the INCONSISTENT DATA ELEMENTS file #38.6 for CC
+2 ; 75, 76, 78, 306, 307 and 409
+3 NEW RULE,DA,DIE,DR
+4 FOR RULE=75,76,78,306,307,409
Begin DoDot:1
+5 DO BMES^XPDUTL("Modifying entry #"_RULE_" in 38.6 file.")
+6 SET DIE=38.6
SET DA=$$FIND1^DIC(DIE,"","X",RULE)
+7 IF 'DA
Begin DoDot:2
+8 DO MES^XPDUTL(" *** Entry not found! Nothing Updated!! ***")
QUIT
End DoDot:2
QUIT
+9 SET DR="6////0"
DO ^DIE
+10 DO MES^XPDUTL(" *** Update Complete ***")
End DoDot:1
+11 DO BMES^XPDUTL("")
+12 QUIT
