ICD1830G ;;BAY/JAT - FY 2007 UPDATE;
;;18.0;DRG Grouper;**30**;Oct 13,2000;Build 5
;
D CC
Q
CC ; update complications/comorbidities field in diag file
N LINE,X,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
F LINE=1:1 S X=$T(CCID+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
.S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0)) I ENTRY D
..; check for any dupe (there are some in MNTVBB)
..S DUPE=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I DUPE Q
..S IDENT=1
..S DA=ENTRY,DIE="^ICD9("
..S DR="70///^S X=IDENT"
..D ^DIE
Q
CCID ;
;;799.02^
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1830G 565 printed Dec 13, 2024@01:48:18 Page 2
ICD1830G ;;BAY/JAT - FY 2007 UPDATE;
+1 ;;18.0;DRG Grouper;**30**;Oct 13,2000;Build 5
+2 ;
+3 DO CC
+4 QUIT
CC ; update complications/comorbidities field in diag file
+1 NEW LINE,X,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
+2 FOR LINE=1:1
SET X=$TEXT(CCID+LINE)
SET ICDDIAG=$PIECE(X,";;",2)
if ICDDIAG="EXIT"
QUIT
Begin DoDot:1
+3 SET ENTRY=+$ORDER(^ICD9("BA",$PIECE(ICDDIAG,U)_" ",0))
IF ENTRY
Begin DoDot:2
+4 ; check for any dupe (there are some in MNTVBB)
+5 SET DUPE=+$ORDER(^ICD9("BA",$PIECE(ICDDIAG,U)_" ",ENTRY))
IF DUPE
QUIT
+6 SET IDENT=1
+7 SET DA=ENTRY
SET DIE="^ICD9("
+8 SET DR="70///^S X=IDENT"
+9 DO ^DIE
End DoDot:2
End DoDot:1
+10 QUIT
CCID ;
+1 ;;799.02^
+2 ;;EXIT
