ICD1824G ;;ALB/JAT - FY 2007 UPDATE; 7/27/05 14:50
;;18.0;DRG Grouper;**24**;Oct 13,2000;Build 5
;
Q
;
GI ; update diagnoses with new identifier
; g = major gastrointestinal condition
; DRG 567 and 569
N LINE,X,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
F LINE=1:1 S X=$T(DXID+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=$P($G(^ICD9(ENTRY,0)),U,2)
..; check if already done in case patch is being re-installed
..I IDENT["g" Q
..S IDENT=IDENT_"g"
..S DA=ENTRY,DIE="^ICD9("
..S DR="2///^S X=IDENT"
..D ^DIE
Q
DXID ;
;;008.41^
;;008.42^
;;008.43^
;;008.45^
;;008.46^
;;008.49^
;;014.04^
;;098.86^
;;456.0^
;;456.20^
;;530.21^
;;530.4^
;;530.7^
;;530.84^
;;531.00^
;;531.21^
;;531.40^
;;531.41^
;;531.50^
;;531.60^
;;531.91^
;;532.00^
;;532.10^
;;532.11^
;;532.20^
;;532.31^
;;532.40^
;;532.41^
;;532.50^
;;532.60^
;;533.00^
;;533.10^
;;533.21^
;;533.40^
;;533.41^
;;533.50^
;;533.51^
;;533.60^
;;533.91^
;;534.00^
;;534.40^
;;534.41^
;;534.50^
;;534.51^
;;534.91^
;;535.01^
;;535.11^
;;535.21^
;;535.31^
;;535.41^
;;535.51^
;;535.61^
;;537.3^
;;537.83^
;;540.0^
;;540.1^
;;550.00^
;;550.01^
;;550.02^
;;551.00^
;;551.1^
;;551.20^
;;551.21^
;;551.29^
;;551.3^
;;551.8^
;;551.9^
;;557.0^
;;557.1^
;;557.9^
;;560.0^
;;560.2^
;;560.31^
;;560.81^
;;560.89^
;;560.9^
;;562.02^
;;562.03^
;;562.12^
;;562.13^
;;564.7^
;;567.0^
;;567.1^
;;567.21^
;;567.22^
;;567.23^
;;567.29^
;;567.31^
;;567.38^
;;567.39^
;;567.81^
;;567.9^
;;568.81^
;;569.5^
;;569.83^
;;569.85^
;;578.0^
;;750.3^
;;863.30^
;;863.31^
;;863.39^
;;863.50^
;;863.51^
;;863.52^
;;863.53^
;;863.54^
;;863.55^
;;863.59^
;;863.90^
;;863.95^
;;863.99^
;;868.13^
;;947.3^
;;EXIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1824G 2073 printed Sep 23, 2025@19:24:11 Page 2
ICD1824G ;;ALB/JAT - FY 2007 UPDATE; 7/27/05 14:50
+1 ;;18.0;DRG Grouper;**24**;Oct 13,2000;Build 5
+2 ;
+3 QUIT
+4 ;
GI ; update diagnoses with new identifier
+1 ; g = major gastrointestinal condition
+2 ; DRG 567 and 569
+3 NEW LINE,X,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
+4 FOR LINE=1:1
SET X=$TEXT(DXID+LINE)
SET ICDDIAG=$PIECE(X,";;",2)
if ICDDIAG="EXIT"
QUIT
Begin DoDot:1
+5 SET ENTRY=+$ORDER(^ICD9("BA",$PIECE(ICDDIAG,U)_" ",0))
IF ENTRY
Begin DoDot:2
+6 ; check for any dupe (there are some in MNTVBB)
+7 SET DUPE=+$ORDER(^ICD9("BA",$PIECE(ICDDIAG,U)_" ",ENTRY))
IF DUPE
QUIT
+8 SET IDENT=$PIECE($GET(^ICD9(ENTRY,0)),U,2)
+9 ; check if already done in case patch is being re-installed
+10 IF IDENT["g"
QUIT
+11 SET IDENT=IDENT_"g"
+12 SET DA=ENTRY
SET DIE="^ICD9("
+13 SET DR="2///^S X=IDENT"
+14 DO ^DIE
End DoDot:2
End DoDot:1
+15 QUIT
DXID ;
+1 ;;008.41^
+2 ;;008.42^
+3 ;;008.43^
+4 ;;008.45^
+5 ;;008.46^
+6 ;;008.49^
+7 ;;014.04^
+8 ;;098.86^
+9 ;;456.0^
+10 ;;456.20^
+11 ;;530.21^
+12 ;;530.4^
+13 ;;530.7^
+14 ;;530.84^
+15 ;;531.00^
+16 ;;531.21^
+17 ;;531.40^
+18 ;;531.41^
+19 ;;531.50^
+20 ;;531.60^
+21 ;;531.91^
+22 ;;532.00^
+23 ;;532.10^
+24 ;;532.11^
+25 ;;532.20^
+26 ;;532.31^
+27 ;;532.40^
+28 ;;532.41^
+29 ;;532.50^
+30 ;;532.60^
+31 ;;533.00^
+32 ;;533.10^
+33 ;;533.21^
+34 ;;533.40^
+35 ;;533.41^
+36 ;;533.50^
+37 ;;533.51^
+38 ;;533.60^
+39 ;;533.91^
+40 ;;534.00^
+41 ;;534.40^
+42 ;;534.41^
+43 ;;534.50^
+44 ;;534.51^
+45 ;;534.91^
+46 ;;535.01^
+47 ;;535.11^
+48 ;;535.21^
+49 ;;535.31^
+50 ;;535.41^
+51 ;;535.51^
+52 ;;535.61^
+53 ;;537.3^
+54 ;;537.83^
+55 ;;540.0^
+56 ;;540.1^
+57 ;;550.00^
+58 ;;550.01^
+59 ;;550.02^
+60 ;;551.00^
+61 ;;551.1^
+62 ;;551.20^
+63 ;;551.21^
+64 ;;551.29^
+65 ;;551.3^
+66 ;;551.8^
+67 ;;551.9^
+68 ;;557.0^
+69 ;;557.1^
+70 ;;557.9^
+71 ;;560.0^
+72 ;;560.2^
+73 ;;560.31^
+74 ;;560.81^
+75 ;;560.89^
+76 ;;560.9^
+77 ;;562.02^
+78 ;;562.03^
+79 ;;562.12^
+80 ;;562.13^
+81 ;;564.7^
+82 ;;567.0^
+83 ;;567.1^
+84 ;;567.21^
+85 ;;567.22^
+86 ;;567.23^
+87 ;;567.29^
+88 ;;567.31^
+89 ;;567.38^
+90 ;;567.39^
+91 ;;567.81^
+92 ;;567.9^
+93 ;;568.81^
+94 ;;569.5^
+95 ;;569.83^
+96 ;;569.85^
+97 ;;578.0^
+98 ;;750.3^
+99 ;;863.30^
+100 ;;863.31^
+101 ;;863.39^
+102 ;;863.50^
+103 ;;863.51^
+104 ;;863.52^
+105 ;;863.53^
+106 ;;863.54^
+107 ;;863.55^
+108 ;;863.59^
+109 ;;863.90^
+110 ;;863.95^
+111 ;;863.99^
+112 ;;868.13^
+113 ;;947.3^
+114 ;;EXIT
+115 QUIT
