ICD1849L.m

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 ---ICD1849L   745     printed  Apr 09, 2024@20:54:55                                                                                                                                                                                                     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