ICD1897P.m

ICD1897P ;ALB/JDG - CLUSTER UPDATE PRE-INIT;8/9/2019

 ;;18.0;DRG Grouper;**97**;Oct 20, 2000;Build 5

 ;

 Q

 ;

EN ; start update

 D PREINIT

 Q

 ;

PREINIT ; Patch Pre-Init: Delete DD and Data of DRG PROCEDURE GROUPS Subfile PROCEDURES (#83.61, 10)

 ; The Cluster Procedures are being moved from Node 10 to Node 20 of file #83.61.  

 ; The Cluster Attributes will be added at Node 10. The patch will load the new Attribute Data and DD at node 10.

 ; During the Pre-Init both the Data and the DD for node 10 must be deleted for clean-up.  

 ;

 D BMES^XPDUTL("Pre-Installation Updates: PREINIT^ICD1897P")

 D BMES^XPDUTL(">>> Delete DRG MDC CATEGORY (#83) file.")

 ;

 D DELDA

 ;

 D MES^XPDUTL(" Deletion of file complete. Will be updated during install.")

 ;

 D BMES^XPDUTL(">>> Delete DRG PROCEDURE GROUPS Subfile PROCEDURES (#83.61, 10).")

 ;

 D DELDD

 ;

 D MES^XPDUTL("    Deletion of sub-file complete. Will be updated during install.")

 D BMES^XPDUTL("Pre-Installation Updates Complete.")

 Q 

 ;

DELDD ; Delete DD and Data of DRG PROCEDURE GROUPS Subfile PROCEDURES (#83.61, 10)

 ;

 N DIU S DIU=83.6101,DIU(0)="DST" D EN^DIU2 K DIU

 Q

 ;

DELDA ; Delete Data in DRG MDC CATEGORY (#83) file

 ;

 S DIK="^ICDD(83," S DA=0 F  S DA=$O(^ICDD(83,DA)) Q:DA=0  D ^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICD1897P   1298     printed  Feb 18, 2025@23:16:10                                                                                                                                                                                                    Page 2

ICD1897P  ;ALB/JDG - CLUSTER UPDATE PRE-INIT;8/9/2019

 +1       ;;18.0;DRG Grouper;**97**;Oct 20, 2000;Build 5

 +2       ;

 +3        QUIT 

 +4       ;

EN        ; start update

 +1        DO PREINIT

 +2        QUIT 

 +3       ;

PREINIT   ; Patch Pre-Init: Delete DD and Data of DRG PROCEDURE GROUPS Subfile PROCEDURES (#83.61, 10)

 +1       ; The Cluster Procedures are being moved from Node 10 to Node 20 of file #83.61.  

 +2       ; The Cluster Attributes will be added at Node 10. The patch will load the new Attribute Data and DD at node 10.

 +3       ; During the Pre-Init both the Data and the DD for node 10 must be deleted for clean-up.  

 +4       ;

 +5        DO BMES^XPDUTL("Pre-Installation Updates: PREINIT^ICD1897P")

 +6        DO BMES^XPDUTL(">>> Delete DRG MDC CATEGORY (#83) file.")

 +7       ;

 +8        DO DELDA

 +9       ;

 +10       DO MES^XPDUTL(" Deletion of file complete. Will be updated during install.")

 +11      ;

 +12       DO BMES^XPDUTL(">>> Delete DRG PROCEDURE GROUPS Subfile PROCEDURES (#83.61, 10).")

 +13      ;

 +14       DO DELDD

 +15      ;

 +16       DO MES^XPDUTL("    Deletion of sub-file complete. Will be updated during install.")

 +17       DO BMES^XPDUTL("Pre-Installation Updates Complete.")

 +18       QUIT 

 +19      ;

DELDD     ; Delete DD and Data of DRG PROCEDURE GROUPS Subfile PROCEDURES (#83.61, 10)

 +1       ;

 +2        NEW DIU

           SET DIU=83.6101

           SET DIU(0)="DST"

           DO EN^DIU2

           KILL DIU

 +3        QUIT 

 +4       ;

DELDA     ; Delete Data in DRG MDC CATEGORY (#83) file

 +1       ;

 +2        SET DIK="^ICDD(83,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +3        QUIT