- 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 Mar 13, 2025@20:52:56 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
