ICD15PR ;ALB/ABR - DRG GROUPER 15 PRE-INSTALL ; 07-JAN-98
;;15.0;DRG Grouper;;Feb 23, 1998
;
; This routine kills the ICD9 and ICD0 globals
; (files 80 and 80.1)
;
; These files must be reloaded upon completion of the
; patch installation.
;
EN ;
N I,XPDIDTOT,ICDX
S I=""
D BMES^XPDUTL("Deleting ICD OPERATION/PROCEDURE file.")
S XPDIDTOT=4140
F ICDX=1:1 S I=$O(^ICD0(I)) Q:I="" K ^(I) I '(ICDX#414) D UPDATE^XPDID(ICDX)
D BMES^XPDUTL("Deleting ICD DIAGNOSIS file.")
S XPDIDTOT=14000
F ICDX=1:1 S I=$O(^ICD9(I)) Q:I="" K ^(I) I '(ICDX#700) D UPDATE^XPDID(ICDX)
D BMES^XPDUTL(">>> File deletion complete! Please use the appropriate global loader")
D MES^XPDUTL(" to restore the files from ICD0_15.GBL and ICD9_15.GBL")
D MES^XPDUTL(" IMMEDIATELY after installing this package.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD15PR 836 printed Dec 13, 2024@01:47:38 Page 2
ICD15PR ;ALB/ABR - DRG GROUPER 15 PRE-INSTALL ; 07-JAN-98
+1 ;;15.0;DRG Grouper;;Feb 23, 1998
+2 ;
+3 ; This routine kills the ICD9 and ICD0 globals
+4 ; (files 80 and 80.1)
+5 ;
+6 ; These files must be reloaded upon completion of the
+7 ; patch installation.
+8 ;
EN ;
+1 NEW I,XPDIDTOT,ICDX
+2 SET I=""
+3 DO BMES^XPDUTL("Deleting ICD OPERATION/PROCEDURE file.")
+4 SET XPDIDTOT=4140
+5 FOR ICDX=1:1
SET I=$ORDER(^ICD0(I))
if I=""
QUIT
KILL ^(I)
IF '(ICDX#414)
DO UPDATE^XPDID(ICDX)
+6 DO BMES^XPDUTL("Deleting ICD DIAGNOSIS file.")
+7 SET XPDIDTOT=14000
+8 FOR ICDX=1:1
SET I=$ORDER(^ICD9(I))
if I=""
QUIT
KILL ^(I)
IF '(ICDX#700)
DO UPDATE^XPDID(ICDX)
+9 DO BMES^XPDUTL(">>> File deletion complete! Please use the appropriate global loader")
+10 DO MES^XPDUTL(" to restore the files from ICD0_15.GBL and ICD9_15.GBL")
+11 DO MES^XPDUTL(" IMMEDIATELY after installing this package.")
+12 QUIT
