ICD1849L ;ALB/MJB - REMEDY FIXES;12/1/2010
;;18.0;DRG Grouper;**49**;Oct 13,2000;Build 13
;
Q
ADDID ;
; update diagnoses with identifier
;
N LINE,ICDX,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
F LINE=1:1 S ICDX=$T(DXID+LINE) S ICDDIAG=$P(ICDX,";;",2) Q:ICDDIAG="EXIT" D
.S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
.S IDENT=$P($G(^ICD9(ENTRY,0)),U,2)
.; check if already done in case patch is being re-installed
.S IDENA=$P(ICDDIAG,U,2)
.I IDENT[IDENA D ICDMSG Q
.S IDENT=IDENT_IDENA D
.S DA=ENTRY,DIE="^ICD9("
.S DR="2///^S X=IDENT"
.D ^DIE
Q
ICDMSG ;
D BMES^XPDUTL(">>> IDENTIFIER ALREADY UPDATED - NO CHANGE HAS BEEN MADE")
D MES^XPDUTL(" TO DIAGNOSIS CODE: "_ICDDIAG) Q
DXID ;
;;659.61^D
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1849L 745 printed Dec 13, 2024@01:48:54 Page 2
ICD1849L ;ALB/MJB - REMEDY FIXES;12/1/2010
+1 ;;18.0;DRG Grouper;**49**;Oct 13,2000;Build 13
+2 ;
+3 QUIT
ADDID ;
+1 ; update diagnoses with identifier
+2 ;
+3 NEW LINE,ICDX,ICDDIAG,ENTRY,IDENT,DA,DIE,DR,DUPE
+4 FOR LINE=1:1
SET ICDX=$TEXT(DXID+LINE)
SET ICDDIAG=$PIECE(ICDX,";;",2)
if ICDDIAG="EXIT"
QUIT
Begin DoDot:1
+5 SET ENTRY=+$ORDER(^ICD9("BA",$PIECE(ICDDIAG,U)_" ",0))
+6 SET IDENT=$PIECE($GET(^ICD9(ENTRY,0)),U,2)
+7 ; check if already done in case patch is being re-installed
+8 SET IDENA=$PIECE(ICDDIAG,U,2)
+9 IF IDENT[IDENA
DO ICDMSG
QUIT
+10 SET IDENT=IDENT_IDENA
Begin DoDot:2
End DoDot:2
+11 SET DA=ENTRY
SET DIE="^ICD9("
+12 SET DR="2///^S X=IDENT"
+13 DO ^DIE
End DoDot:1
+14 QUIT
ICDMSG ;
+1 DO BMES^XPDUTL(">>> IDENTIFIER ALREADY UPDATED - NO CHANGE HAS BEEN MADE")
+2 DO MES^XPDUTL(" TO DIAGNOSIS CODE: "_ICDDIAG)
QUIT
DXID ;
+1 ;;659.61^D
+2 ;;EXIT
