ICD1848L.m

ICD1848L ;ALB/MJB - NEW DIAGNOSIS CODES;7/27/05 14:50;

 ;;18.0;DRG Grouper;**48**;Oct 13,2000;Build 7

 ;

 ;3 line tags are in this routine. See ICD18XXP to find which tag 

 ;is being called. Not all are used for each patch.

 ;These tags are for any needed corrections to DRG Groupings.

 ;DRG - is for any changes being made to specific DRG(s) due to an

 ;issue reported in a Remedy ticket.

 ;PX - add major OR identifier

 ;ADDID - Add identifier to diagnosis code(fields are stored at DXID)

 Q

DRG ;

 N FDA,DA,DIE,DR,MAJOR

 ;

 ; HD233286

 ; 

 ; next line in case patch being re-installed

 ;I $P(^ICD9(14197,3,1,1,0),U,4)=7 G NEXT

 ;S FDA(1820,80,"?1,",.01)="`14197"

 ;S FDA(1820,80.071,"?2,?1,",.01)=3071001

 ;S FDA(1820,80.711,"+3,?2,?1,",.01)=826

 ;S FDA(1820,80.711,"+4,?2,?1,",.01)=827

 ;S FDA(1820,80.711,"+5,?2,?1,",.01)=828

 ;S FDA(1820,80.711,"+6,?2,?1,",.01)=829

 ;S FDA(1820,80.711,"+7,?2,?1,",.01)=830

 ;D UPDATE^DIE("","FDA(1820)") K FDA(1820)

 ;S FDA(1820,80,"?1,",.01)="`14198"

 ;S FDA(1820,80.071,"?2,?1,",.01)=3071001

 ;S FDA(1820,80.711,"+3,?2,?1,",.01)=826

 ;S FDA(1820,80.711,"+4,?2,?1,",.01)=827

 ;S FDA(1820,80.711,"+5,?2,?1,",.01)=828

 ;S FDA(1820,80.711,"+6,?2,?1,",.01)=829

 ;S FDA(1820,80.711,"+7,?2,?1,",.01)=830

 ;D UPDATE^DIE("","FDA(1820)") K FDA(1820)

 ;

NEXT ;UPDATE PX

 ;

 ;HD397928

 ; 

 S DA=4236

 S DIE="^ICD0("

 S MAJOR="@"

 S DR="20////^S X=MAJOR"

 D ^DIE

 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 ;

 ;;238.79^L

 ;;425.4^XCV

 ;;041.4^k

 ;;EXIT

ICD1848L  ;ALB/MJB - NEW DIAGNOSIS CODES;7/27/05 14:50;

 +1       ;;18.0;DRG Grouper;**48**;Oct 13,2000;Build 7

 +2       ;

 +3       ;3 line tags are in this routine. See ICD18XXP to find which tag 

 +4       ;is being called. Not all are used for each patch.

 +5       ;These tags are for any needed corrections to DRG Groupings.

 +6       ;DRG - is for any changes being made to specific DRG(s) due to an

 +7       ;issue reported in a Remedy ticket.

 +8       ;PX - add major OR identifier

 +9       ;ADDID - Add identifier to diagnosis code(fields are stored at DXID)

 +10       QUIT 

DRG       ;

 +1        NEW FDA,DA,DIE,DR,MAJOR

 +2       ;

 +3       ; HD233286

 +4       ; 

 +5       ; next line in case patch being re-installed

 +6       ;I $P(^ICD9(14197,3,1,1,0),U,4)=7 G NEXT

 +7       ;S FDA(1820,80,"?1,",.01)="`14197"

 +8       ;S FDA(1820,80.071,"?2,?1,",.01)=3071001

 +9       ;S FDA(1820,80.711,"+3,?2,?1,",.01)=826

 +10      ;S FDA(1820,80.711,"+4,?2,?1,",.01)=827

 +11      ;S FDA(1820,80.711,"+5,?2,?1,",.01)=828

 +12      ;S FDA(1820,80.711,"+6,?2,?1,",.01)=829

 +13      ;S FDA(1820,80.711,"+7,?2,?1,",.01)=830

 +14      ;D UPDATE^DIE("","FDA(1820)") K FDA(1820)

 +15      ;S FDA(1820,80,"?1,",.01)="`14198"

 +16      ;S FDA(1820,80.071,"?2,?1,",.01)=3071001

 +17      ;S FDA(1820,80.711,"+3,?2,?1,",.01)=826

 +18      ;S FDA(1820,80.711,"+4,?2,?1,",.01)=827

 +19      ;S FDA(1820,80.711,"+5,?2,?1,",.01)=828

 +20      ;S FDA(1820,80.711,"+6,?2,?1,",.01)=829

 +21      ;S FDA(1820,80.711,"+7,?2,?1,",.01)=830

 +22      ;D UPDATE^DIE("","FDA(1820)") K FDA(1820)

 +23      ;

NEXT      ;UPDATE PX

 +1       ;

 +2       ;HD397928

 +3       ; 

 +4        SET DA=4236

 +5        SET DIE="^ICD0("

 +6        SET MAJOR="@"

 +7        SET DR="20////^S X=MAJOR"

 +8        DO ^DIE

 +9        QUIT 

 +10      ;

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       ;;238.79^L

 +2       ;;425.4^XCV

 +3       ;;041.4^k

 +4       ;;EXIT