ICD125PT ;ALB/ABR - RESTORE NAME TO ICD (DRG) GLOBAL - AUG 9 1996
;;12.0;DRG GROUPER;**5**;APR 12, 1995
;This routine will restore the .01 name value in file 80.2
;
EN ;
N X,Y,DA,DR,DIE
D BMES^XPDUTL("Cleaning up DRG file.")
S DA=0
S DIE="^ICD("
F S DA=$O(^ICD(DA)) Q:'DA I $E(^(DA,0))="^" D
. S DR=".01///DRG"_DA D ^DIE
D MES^XPDUTL(">> DONE!")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD125PT 374 printed Oct 16, 2024@17:48:16 Page 2
ICD125PT ;ALB/ABR - RESTORE NAME TO ICD (DRG) GLOBAL - AUG 9 1996
+1 ;;12.0;DRG GROUPER;**5**;APR 12, 1995
+2 ;This routine will restore the .01 name value in file 80.2
+3 ;
EN ;
+1 NEW X,Y,DA,DR,DIE
+2 DO BMES^XPDUTL("Cleaning up DRG file.")
+3 SET DA=0
+4 SET DIE="^ICD("
+5 FOR
SET DA=$ORDER(^ICD(DA))
if 'DA
QUIT
IF $EXTRACT(^(DA,0))="^"
Begin DoDot:1
+6 SET DR=".01///DRG"_DA
DO ^DIE
End DoDot:1
+7 DO MES^XPDUTL(">> DONE!")
+8 QUIT
