MC44PST0.m

MC44PST0 ;ALB/JAM - MEDICAL DIAGNOSES UPDATE WITH ICD10 CODES ;3/26/12  15:45

 ;;2.3;Medicine;**44**;09/13/1996;Build 9

 ;

 ;This post install routine(s) contain ICD10 codes that will be mapped to medical diagnosis text in file #697.5

 ;

EN ;Patch entry point

 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSAVE

 D MES^XPDUTL(" ")

 D BMES^XPDUTL("This patch updates entries in the MEDICAL DIAGNOSIS/ICD CODES File (#697.5) with")

 D MES^XPDUTL("ICD10 codes.")

 D MES^XPDUTL(" ")

 D MES^XPDUTL("A MailMan message will be generated after the update is done and a report will")

 D MES^XPDUTL("be sent to the installer.")

 D MES^XPDUTL(" ")

 ;

 S ZTRTN="RPT^MC44PST0",ZTDESC="Medical Diagnosis ICD10 update MC*2.3*44",ZTIO=""

 S ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")="" D ^%ZTLOAD

 Q

 ;

RPT ;Queue entry point for Medical Diagnosis ICD10 update 

 N COU,MCRTN,CNT,CNTD,TXT

 K ^TMP($J,"MCP44")

 L +^MCAR(697.5):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T D  Q

 .S TXT="The MEDICAL DIAGNOSIS/ICD CODES File (#697.5) is Being Edited by Another User" D LINE(TXT)

 .S TXT="Try installing the patch later." D LINE(TXT) D MAIL K ^TMP($J,"MCP44")

 D DEL

 S (CNT,CNTD)=0

 S TXT="" D LINE(TXT)

 S TXT="Medical Diagnosis                    ICD10 Code  Error Message" D LINE(TXT)

 S TXT="-----------------                    ----------  -------------" D LINE(TXT)

 F COU=0:1:9 S MCRTN="^MC44PST"_COU D ADDX W "."

 F COU=10:1:22 S MCRTN="^MC44PS"_COU D ADDX W "."

 S TXT="" D LINE(TXT)

 S TXT="Total Number of Errors: "_(CNT-4) D LINE(TXT)

 S TXT="" D LINE(TXT)

 S TXT="Total ICD10 Codes mapped: "_CNTD D LINE(TXT)

 D MAIL

 L -^MCAR(697.5)

 K ^TMP($J,"MCP44")

 Q

 ;

DEL ;Remove ICD-10 codes that are no longer valid, if patch was installed before

 N XX,YY,STR,ARY,DEL,RESLT

 ; Check if patch was installed before and delete all ICD-10 codes

 S DEL=$$INSTALDT^XPDUTL("MC*2.3*44",.RESLT)

 I '+DEL Q

 S XX=$O(RESLT("")) I XX="" Q

 S STR=RESLT(XX) I STR>3 Q

 ; if test version is less than or up to 3, remove ICD-10 codes

 S XX="" F  S XX=$O(^MCAR(697.5,XX)) Q:XX=""  D

 .S YY=0 F  S YY=$O(^MCAR(697.5,XX,2,YY)) Q:'YY  D

 ..S DX=+$G(^MCAR(697.5,XX,2,YY,0)) Q:'DX

 ..I $$CSI^ICDEX(80,DX)'=30 Q

 ..S DA(1)=XX,DA=YY

 ..S DIK="^MCAR(697.5,"_DA(1)_",2,"

 ..D ^DIK

 ; remove invalid codes T40.1X5A and T40.8X5A

 S ARY("ADV EFF MEDICAL/BIOLOGICAL SUBSTANCES NOS")="",ARY("DRUG RELATED LUPUS ERYTHEMATOSUS")=""

 S ARY("DRUG RELATED RHEUMATIC SYNDROMES")=""

 S XX="" F  S XX=$O(^MCAR(697.5,XX)) Q:XX=""  D

 .S STR=$P($G(^MCAR(697.5,XX,0)),"^") Q:STR=""

 .Q:'$D(ARY(STR))

 .S YY=0 F  S YY=$O(^MCAR(697.5,XX,2,YY)) Q:'YY  D

 ..S DX=+$G(^MCAR(697.5,XX,2,YY,0)) Q:'DX

 ..I +$$CODEC^ICDEX(80,DX)'=-1 Q

 ..S DA(1)=XX,DA=YY

 ..S DIK="^MCAR(697.5,"_DA(1)_",2,"

 ..D ^DIK

 Q

 ;

ADDX ;* add ICD10 diagnosis code

 N MCX,MCTAG,MCXY,MCXX,MCDXT,ERRTXT,DX,SPACE

 S $P(SPACE," ",60)=""

 F MCX=1:1 S MCTAG="CODES+"_MCX_MCRTN,MCXY=$P($T(@MCTAG),";;",2) Q:MCXY=""  D

 .S MCXX=$P(MCXY,"^"),DX=$$UP^XLFSTR($P(MCXY,"^",2))

 .S MCDXT=$$FIND1^DIC(697.5,"","X",MCXX) I +MCDXT<1 D  Q

 ..S ERRTXT="Medical Diagnosis not on File" D ERRSET(ERRTXT)

 .D FILICD

 Q

 ;

FILICD ;File ICD10 codes in File 697.5

 N DXIEN,MCFDA,MCERR,ERRTXT

 I DX="" D  Q

 .S ERRTXT="Missing ICD10 code" D ERRSET(ERRTXT)

 I $$CODECS^ICDEX(DX,80)'["ICD-10" D  Q

 .S ERRTXT="Invalid ICD-10 code" D ERRSET(ERRTXT)

 S DXIEN=+$$CODEN^ICDEX(DX)

 ;check if ICD10 code already on file

 I $D(^MCAR(697.5,MCDXT,2,"B",DXIEN)) Q

 S MCFDA(697.51,"+2,"_MCDXT_",",.01)=DXIEN

 D UPDATE^DIE("","MCFDA","","MCERR")

 I $D(MCERR) S ERRTXT="Error while attempting to file ICD10 code" D ERRSET(ERRTXT) Q

 S CNTD=CNTD+1

 Q

ERRSET(ERRMSG) ; set string with error

 N STR

 S STR=$E(MCXX,1,38)_$E(SPACE,1,38-$L(MCXX))_DX_$E(SPACE,1,11-$L(DX))_ERRMSG

 D LINE(STR)

 Q

LINE(TEXT) ; Add line to message global

 S CNT=CNT+1,^TMP($J,"MCP44",CNT)=TEXT

 Q

 ;

MAIL ; Send message

 N XMDUZ,XMY,XMTEXT,XMSUB

 S XMY(DUZ)="",XMDUZ=.5

 S XMSUB="Medical Diagnoses ICD10 Codes Mapping Report"

 S XMTEXT="^TMP($J,""MCP44"","

 D ^XMD

 Q 

 ;

CODES ;

 ;;MYOCARDIAL INFARCTION - TRANSMURAL Q WAVE^I25.2

 ;;SUSPECTED CAD^I25.3

 ;;SUSPECTED CAD^R94.31

 ;;SUSPECTED CAD^I20.8

 ;;SUSPECTED CAD^I20.8

 ;;SUSPECTED CAD^I20.9

 ;;SUSPECTED CAD^I25.111

 ;;SUSPECTED CAD^I25.118

 ;;SUSPECTED CAD^I25.119

 ;;SUSPECTED CAD^I25.701

 ;;SUSPECTED CAD^I25.708

 ;;SUSPECTED CAD^I25.709

 ;;SUSPECTED CAD^I25.711

 ;;SUSPECTED CAD^I25.718

 ;;SUSPECTED CAD^I25.719

 ;;SUSPECTED CAD^I25.721

 ;;SUSPECTED CAD^I25.728

 ;;SUSPECTED CAD^I25.729

 ;;SUSPECTED CAD^I25.731

 ;;SUSPECTED CAD^I25.738

 ;;SUSPECTED CAD^I25.739

 ;;SUSPECTED CAD^I25.751

 ;;SUSPECTED CAD^I25.758

 ;;SUSPECTED CAD^I25.759

 ;;SUSPECTED CAD^I25.761

 ;;SUSPECTED CAD^I25.768

 ;;SUSPECTED CAD^I25.769

 ;;SUSPECTED CAD^I25.791

 ;;SUSPECTED CAD^I25.798

 ;;SUSPECTED CAD^I25.799

 ;;SUSPECTED CAD^I25.2

 ;;SUSPECTED CAD^I25.10

 ;;SUSPECTED CAD^I70.8

 ;;SUSPECTED CAD^I24.1

 ;;SUSPECTED CAD^R07.82

 ;;SUSPECTED CAD^R07.89

 ;;SUSPECTED CAD^R07.9

 ;;SUSPECTED CAD^I25.5

 ;;SUSPECTED CAD^I25.6

 ;;SUSPECTED CAD^I25.89

 ;;SUSPECTED CAD^I25.9

 ;;SUSPECTED CAD^I51.9

 ;;SUSPECTED CAD^I52.

 ;;SUSPECTED CAD^I51.89

 ;;SUSPECTED CAD^I51.5

 ;;SUSPECTED CAD^I72.8

 ;;SUSPECTED CAD^I72.9

 ;;SUSPECTED CAD^I46.2

 ;;SUSPECTED CAD^I46.8

 ;;SUSPECTED CAD^I46.9

 ;;SUSPECTED CAD^R57.0

 ;;SUSPECTED CAD^I50.1

 ;;SUSPECTED CAD^I23.4

 ;;SUSPECTED CAD^I51.1

 ;;ANGINA PECTORIS - STABLE^I20.8

 ;;ANGINA PECTORIS - STABLE^I20.9

 ;;ANGINA PECTORIS - STABLE^I25.111

 ;;ANGINA PECTORIS - STABLE^I25.118

 ;;ANGINA PECTORIS - STABLE^I25.119

 ;;ANGINA PECTORIS - STABLE^I25.701

 ;;ANGINA PECTORIS - STABLE^I25.708

 ;;ANGINA PECTORIS - STABLE^I25.709

 ;;ANGINA PECTORIS - STABLE^I25.711

 ;;ANGINA PECTORIS - STABLE^I25.718

 ;;ANGINA PECTORIS - STABLE^I25.719

 ;;ANGINA PECTORIS - STABLE^I25.721

 ;;ANGINA PECTORIS - STABLE^I25.728

 ;;ANGINA PECTORIS - STABLE^I25.729

 ;;ANGINA PECTORIS - STABLE^I25.731

 ;;ANGINA PECTORIS - STABLE^I25.738

 ;;ANGINA PECTORIS - STABLE^I25.739

 ;;ANGINA PECTORIS - STABLE^I25.751

 ;;ANGINA PECTORIS - STABLE^I25.758

 ;;ANGINA PECTORIS - STABLE^I25.759

 ;;ANGINA PECTORIS - STABLE^I25.761

 ;;ANGINA PECTORIS - STABLE^I25.768

 ;;ANGINA PECTORIS - STABLE^I25.769

 ;;ANGINA PECTORIS - STABLE^I25.791

 ;;ANGINA PECTORIS - STABLE^I25.798

 ;;ANGINA PECTORIS - STABLE^I25.799

 ;;ANGINA PECTORIS - STABLE^I20.1

 ;;ANGINA PECTORIS - STABLE^I20.8

 ;;ANGINA PECTORIS - STABLE^R07.9

 ;;ANGINA PECTORIS - STABLE^I25.9

 ;;ANGINA PECTORIS - STABLE^I25.5

 ;;ANGINA PECTORIS - STABLE^I25.6

 ;;ANGINA PECTORIS - STABLE^I25.89

 ;;ANGINA PECTORIS - UNSTABLE^I20.8

 ;;ANGINA PECTORIS - UNSTABLE^I20.9

 ;;ANGINA PECTORIS - UNSTABLE^I25.111

 ;;ANGINA PECTORIS - UNSTABLE^I25.118

 ;;ANGINA PECTORIS - UNSTABLE^I25.119

 ;;ANGINA PECTORIS - UNSTABLE^I25.701

 ;;ANGINA PECTORIS - UNSTABLE^I25.708

 ;;ANGINA PECTORIS - UNSTABLE^I25.709

 ;;ANGINA PECTORIS - UNSTABLE^I25.711

 ;;ANGINA PECTORIS - UNSTABLE^I25.718

 ;;ANGINA PECTORIS - UNSTABLE^I25.719

 ;;ANGINA PECTORIS - UNSTABLE^I25.721

 ;;ANGINA PECTORIS - UNSTABLE^I25.728

 ;;ANGINA PECTORIS - UNSTABLE^I25.729

 ;;ANGINA PECTORIS - UNSTABLE^I25.731

 ;;ANGINA PECTORIS - UNSTABLE^I25.738

 ;;ANGINA PECTORIS - UNSTABLE^I25.739

 ;;ANGINA PECTORIS - UNSTABLE^I25.751

 ;;ANGINA PECTORIS - UNSTABLE^I25.758

 ;;ANGINA PECTORIS - UNSTABLE^I25.759

 ;;ANGINA PECTORIS - UNSTABLE^I25.761

 ;;ANGINA PECTORIS - UNSTABLE^I25.768

 ;;ANGINA PECTORIS - UNSTABLE^I25.769

 ;;ANGINA PECTORIS - UNSTABLE^I25.791

 ;;ANGINA PECTORIS - UNSTABLE^I25.798

 ;;ANGINA PECTORIS - UNSTABLE^I25.799

 ;;ANGINA PECTORIS - UNSTABLE^I20.1

 ;;ANGINA PECTORIS - UNSTABLE^I20.8

 ;;ANGINA PECTORIS - UNSTABLE^R07.9

 ;;ANGINA PECTORIS - UNSTABLE^I25.5

 ;;ANGINA PECTORIS - UNSTABLE^I25.6

 ;;ANGINA PECTORIS - UNSTABLE^I25.89

 ;;ANGINA PECTORIS - UNSTABLE^I25.9

 ;;MYOCARDITIS^I40.0

 ;;MYOCARDITIS^I40.1

 ;;MYOCARDITIS^I40.8

 ;;MYOCARDITIS^I40.9

 ;;MYOCARDITIS^A36.81

 ;;MYOCARDITIS^B33.22

 ;;MYOCARDITIS^A39.52

 ;;MYOCARDITIS^I09.0

 ;;MYOCARDITIS^I40.0

 ;;MYOCARDITIS^A52.06

 ;;MYOCARDITIS^I40.8

 ;;HYPERTENSIVE HEART DISEASE^A18.84

 ;;HYPERTENSIVE HEART DISEASE^D15.1

 ;;HYPERTENSIVE HEART DISEASE^I10.

 ;;HYPERTENSIVE HEART DISEASE^I11.0

 ;;HYPERTENSIVE HEART DISEASE^I11.9

 ;;HYPERTENSIVE HEART DISEASE^I15.0

 ;;HYPERTENSIVE HEART DISEASE^I15.1

 ;;HYPERTENSIVE HEART DISEASE^I15.2

 ;;HYPERTENSIVE HEART DISEASE^I15.8

 ;;HYPERTENSIVE HEART DISEASE^I15.9

 ;;HYPERTENSIVE HEART DISEASE^I43.

 ;;HYPERTENSIVE HEART DISEASE^N26.2

 ;;HCM - OBSTRUCTIVE^A18.84

 ;;HCM - OBSTRUCTIVE^I43.

 ;;HCM - NON-OBSTRUCTIVE^A18.84

 ;;HCM - NON-OBSTRUCTIVE^I43.

 ;;HCM - PROVOCABLE OBSTRUCTION^A18.84

 ;;HCM - PROVOCABLE OBSTRUCTION^I43.

 ;;CARDIOMYOPATHY - DILATED^A18.84

 ;;CARDIOMYOPATHY - DILATED^I43.

 ;;CARDIOMYOPATHY - DILATED^I42.6

 ;;CARDIOMYOPATHY - DILATED^I51.7

 ;;CARDIOMYOPATHY - INFILTRATIVE/RESTRICTIVE^A18.84

 ;;CARDIOMYOPATHY - INFILTRATIVE/RESTRICTIVE^I43.

 ;;MITRAL STENOSIS^I05.0

 ;;MITRAL STENOSIS^Q23.2

 ;;MITRAL STENOSIS^I08.0

 ;;MITRAL STENOSIS^I08.0

 ;;MITRAL STENOSIS^I05.2

 ;;MITRAL STENOSIS^I05.8

 ;;MITRAL STENOSIS^I05.9

 ;;MITRAL STENOSIS^I34.0

 ;;MITRAL STENOSIS^I34.1

 ;;MITRAL STENOSIS^I34.2

 ;;MITRAL STENOSIS^I34.8

 ;;MITRAL STENOSIS^I34.9

 ;;MITRAL STENOSIS^I08.9

 ;;MITRAL STENOSIS^I09.9

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MC44PST0   9471     printed  Apr 23, 2025@18:26:09                                                                                                                                                                                                    Page 2

MC44PST0  ;ALB/JAM - MEDICAL DIAGNOSES UPDATE WITH ICD10 CODES ;3/26/12  15:45

 +1       ;;2.3;Medicine;**44**;09/13/1996;Build 9

 +2       ;

 +3       ;This post install routine(s) contain ICD10 codes that will be mapped to medical diagnosis text in file #697.5

 +4       ;

EN        ;Patch entry point

 +1        NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTREQ,ZTSAVE

 +2        DO MES^XPDUTL(" ")

 +3        DO BMES^XPDUTL("This patch updates entries in the MEDICAL DIAGNOSIS/ICD CODES File (#697.5) with")

 +4        DO MES^XPDUTL("ICD10 codes.")

 +5        DO MES^XPDUTL(" ")

 +6        DO MES^XPDUTL("A MailMan message will be generated after the update is done and a report will")

 +7        DO MES^XPDUTL("be sent to the installer.")

 +8        DO MES^XPDUTL(" ")

 +9       ;

 +10       SET ZTRTN="RPT^MC44PST0"

           SET ZTDESC="Medical Diagnosis ICD10 update MC*2.3*44"

           SET ZTIO=""

 +11       SET ZTDTH=$HOROLOG

           SET ZTREQ="@"

           SET ZTSAVE("ZTREQ")=""

           DO ^%ZTLOAD

 +12       QUIT 

 +13      ;

RPT       ;Queue entry point for Medical Diagnosis ICD10 update 

 +1        NEW COU,MCRTN,CNT,CNTD,TXT

 +2        KILL ^TMP($JOB,"MCP44")

 +3        LOCK +^MCAR(697.5):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)

           IF '$TEST

               Begin DoDot:1

 +4                SET TXT="The MEDICAL DIAGNOSIS/ICD CODES File (#697.5) is Being Edited by Another User"

                   DO LINE(TXT)

 +5                SET TXT="Try installing the patch later."

                   DO LINE(TXT)

                   DO MAIL

                   KILL ^TMP($JOB,"MCP44")

               End DoDot:1

               QUIT 

 +6        DO DEL

 +7        SET (CNT,CNTD)=0

 +8        SET TXT=""

           DO LINE(TXT)

 +9        SET TXT="Medical Diagnosis                    ICD10 Code  Error Message"

           DO LINE(TXT)

 +10       SET TXT="-----------------                    ----------  -------------"

           DO LINE(TXT)

 +11       FOR COU=0:1:9

               SET MCRTN="^MC44PST"_COU

               DO ADDX

               WRITE "."

 +12       FOR COU=10:1:22

               SET MCRTN="^MC44PS"_COU

               DO ADDX

               WRITE "."

 +13       SET TXT=""

           DO LINE(TXT)

 +14       SET TXT="Total Number of Errors: "_(CNT-4)

           DO LINE(TXT)

 +15       SET TXT=""

           DO LINE(TXT)

 +16       SET TXT="Total ICD10 Codes mapped: "_CNTD

           DO LINE(TXT)

 +17       DO MAIL

 +18       LOCK -^MCAR(697.5)

 +19       KILL ^TMP($JOB,"MCP44")

 +20       QUIT 

 +21      ;

DEL       ;Remove ICD-10 codes that are no longer valid, if patch was installed before

 +1        NEW XX,YY,STR,ARY,DEL,RESLT

 +2       ; Check if patch was installed before and delete all ICD-10 codes

 +3        SET DEL=$$INSTALDT^XPDUTL("MC*2.3*44",.RESLT)

 +4        IF '+DEL

               QUIT 

 +5        SET XX=$ORDER(RESLT(""))

           IF XX=""

               QUIT 

 +6        SET STR=RESLT(XX)

           IF STR>3

               QUIT 

 +7       ; if test version is less than or up to 3, remove ICD-10 codes

 +8        SET XX=""

           FOR 

               SET XX=$ORDER(^MCAR(697.5,XX))

               if XX=""

                   QUIT 

               Begin DoDot:1

 +9                SET YY=0

                   FOR 

                       SET YY=$ORDER(^MCAR(697.5,XX,2,YY))

                       if 'YY

                           QUIT 

                       Begin DoDot:2

 +10                       SET DX=+$GET(^MCAR(697.5,XX,2,YY,0))

                           if 'DX

                               QUIT 

 +11                       IF $$CSI^ICDEX(80,DX)'=30

                               QUIT 

 +12                       SET DA(1)=XX

                           SET DA=YY

 +13                       SET DIK="^MCAR(697.5,"_DA(1)_",2,"

 +14                       DO ^DIK

                       End DoDot:2

               End DoDot:1

 +15      ; remove invalid codes T40.1X5A and T40.8X5A

 +16       SET ARY("ADV EFF MEDICAL/BIOLOGICAL SUBSTANCES NOS")=""

           SET ARY("DRUG RELATED LUPUS ERYTHEMATOSUS")=""

 +17       SET ARY("DRUG RELATED RHEUMATIC SYNDROMES")=""

 +18       SET XX=""

           FOR 

               SET XX=$ORDER(^MCAR(697.5,XX))

               if XX=""

                   QUIT 

               Begin DoDot:1

 +19               SET STR=$PIECE($GET(^MCAR(697.5,XX,0)),"^")

                   if STR=""

                       QUIT 

 +20               if '$DATA(ARY(STR))

                       QUIT 

 +21               SET YY=0

                   FOR 

                       SET YY=$ORDER(^MCAR(697.5,XX,2,YY))

                       if 'YY

                           QUIT 

                       Begin DoDot:2

 +22                       SET DX=+$GET(^MCAR(697.5,XX,2,YY,0))

                           if 'DX

                               QUIT 

 +23                       IF +$$CODEC^ICDEX(80,DX)'=-1

                               QUIT 

 +24                       SET DA(1)=XX

                           SET DA=YY

 +25                       SET DIK="^MCAR(697.5,"_DA(1)_",2,"

 +26                       DO ^DIK

                       End DoDot:2

               End DoDot:1

 +27       QUIT 

 +28      ;

ADDX      ;* add ICD10 diagnosis code

 +1        NEW MCX,MCTAG,MCXY,MCXX,MCDXT,ERRTXT,DX,SPACE

 +2        SET $PIECE(SPACE," ",60)=""

 +3        FOR MCX=1:1

               SET MCTAG="CODES+"_MCX_MCRTN

               SET MCXY=$PIECE($TEXT(@MCTAG),";;",2)

               if MCXY=""

                   QUIT 

               Begin DoDot:1

 +4                SET MCXX=$PIECE(MCXY,"^")

                   SET DX=$$UP^XLFSTR($PIECE(MCXY,"^",2))

 +5                SET MCDXT=$$FIND1^DIC(697.5,"","X",MCXX)

                   IF +MCDXT<1

                       Begin DoDot:2

 +6                        SET ERRTXT="Medical Diagnosis not on File"

                           DO ERRSET(ERRTXT)

                       End DoDot:2

                       QUIT 

 +7                DO FILICD

               End DoDot:1

 +8        QUIT 

 +9       ;

FILICD    ;File ICD10 codes in File 697.5

 +1        NEW DXIEN,MCFDA,MCERR,ERRTXT

 +2        IF DX=""

               Begin DoDot:1

 +3                SET ERRTXT="Missing ICD10 code"

                   DO ERRSET(ERRTXT)

               End DoDot:1

               QUIT 

 +4        IF $$CODECS^ICDEX(DX,80)'["ICD-10"

               Begin DoDot:1

 +5                SET ERRTXT="Invalid ICD-10 code"

                   DO ERRSET(ERRTXT)

               End DoDot:1

               QUIT 

 +6        SET DXIEN=+$$CODEN^ICDEX(DX)

 +7       ;check if ICD10 code already on file

 +8        IF $DATA(^MCAR(697.5,MCDXT,2,"B",DXIEN))

               QUIT 

 +9        SET MCFDA(697.51,"+2,"_MCDXT_",",.01)=DXIEN

 +10       DO UPDATE^DIE("","MCFDA","","MCERR")

 +11       IF $DATA(MCERR)

               SET ERRTXT="Error while attempting to file ICD10 code"

               DO ERRSET(ERRTXT)

               QUIT 

 +12       SET CNTD=CNTD+1

 +13       QUIT 

ERRSET(ERRMSG) ; set string with error

 +1        NEW STR

 +2        SET STR=$EXTRACT(MCXX,1,38)_$EXTRACT(SPACE,1,38-$LENGTH(MCXX))_DX_$EXTRACT(SPACE,1,11-$LENGTH(DX))_ERRMSG

 +3        DO LINE(STR)

 +4        QUIT 

LINE(TEXT) ; Add line to message global

 +1        SET CNT=CNT+1

           SET ^TMP($JOB,"MCP44",CNT)=TEXT

 +2        QUIT 

 +3       ;

MAIL      ; Send message

 +1        NEW XMDUZ,XMY,XMTEXT,XMSUB

 +2        SET XMY(DUZ)=""

           SET XMDUZ=.5

 +3        SET XMSUB="Medical Diagnoses ICD10 Codes Mapping Report"

 +4        SET XMTEXT="^TMP($J,""MCP44"","

 +5        DO ^XMD

 +6        QUIT 

 +7       ;

CODES     ;

 +1       ;;MYOCARDIAL INFARCTION - TRANSMURAL Q WAVE^I25.2

 +2       ;;SUSPECTED CAD^I25.3

 +3       ;;SUSPECTED CAD^R94.31

 +4       ;;SUSPECTED CAD^I20.8

 +5       ;;SUSPECTED CAD^I20.8

 +6       ;;SUSPECTED CAD^I20.9

 +7       ;;SUSPECTED CAD^I25.111

 +8       ;;SUSPECTED CAD^I25.118

 +9       ;;SUSPECTED CAD^I25.119

 +10      ;;SUSPECTED CAD^I25.701

 +11      ;;SUSPECTED CAD^I25.708

 +12      ;;SUSPECTED CAD^I25.709

 +13      ;;SUSPECTED CAD^I25.711

 +14      ;;SUSPECTED CAD^I25.718

 +15      ;;SUSPECTED CAD^I25.719

 +16      ;;SUSPECTED CAD^I25.721

 +17      ;;SUSPECTED CAD^I25.728

 +18      ;;SUSPECTED CAD^I25.729

 +19      ;;SUSPECTED CAD^I25.731

 +20      ;;SUSPECTED CAD^I25.738

 +21      ;;SUSPECTED CAD^I25.739

 +22      ;;SUSPECTED CAD^I25.751

 +23      ;;SUSPECTED CAD^I25.758

 +24      ;;SUSPECTED CAD^I25.759

 +25      ;;SUSPECTED CAD^I25.761

 +26      ;;SUSPECTED CAD^I25.768

 +27      ;;SUSPECTED CAD^I25.769

 +28      ;;SUSPECTED CAD^I25.791

 +29      ;;SUSPECTED CAD^I25.798

 +30      ;;SUSPECTED CAD^I25.799

 +31      ;;SUSPECTED CAD^I25.2

 +32      ;;SUSPECTED CAD^I25.10

 +33      ;;SUSPECTED CAD^I70.8

 +34      ;;SUSPECTED CAD^I24.1

 +35      ;;SUSPECTED CAD^R07.82

 +36      ;;SUSPECTED CAD^R07.89

 +37      ;;SUSPECTED CAD^R07.9

 +38      ;;SUSPECTED CAD^I25.5

 +39      ;;SUSPECTED CAD^I25.6

 +40      ;;SUSPECTED CAD^I25.89

 +41      ;;SUSPECTED CAD^I25.9

 +42      ;;SUSPECTED CAD^I51.9

 +43      ;;SUSPECTED CAD^I52.

 +44      ;;SUSPECTED CAD^I51.89

 +45      ;;SUSPECTED CAD^I51.5

 +46      ;;SUSPECTED CAD^I72.8

 +47      ;;SUSPECTED CAD^I72.9

 +48      ;;SUSPECTED CAD^I46.2

 +49      ;;SUSPECTED CAD^I46.8

 +50      ;;SUSPECTED CAD^I46.9

 +51      ;;SUSPECTED CAD^R57.0

 +52      ;;SUSPECTED CAD^I50.1

 +53      ;;SUSPECTED CAD^I23.4

 +54      ;;SUSPECTED CAD^I51.1

 +55      ;;ANGINA PECTORIS - STABLE^I20.8

 +56      ;;ANGINA PECTORIS - STABLE^I20.9

 +57      ;;ANGINA PECTORIS - STABLE^I25.111

 +58      ;;ANGINA PECTORIS - STABLE^I25.118

 +59      ;;ANGINA PECTORIS - STABLE^I25.119

 +60      ;;ANGINA PECTORIS - STABLE^I25.701

 +61      ;;ANGINA PECTORIS - STABLE^I25.708

 +62      ;;ANGINA PECTORIS - STABLE^I25.709

 +63      ;;ANGINA PECTORIS - STABLE^I25.711

 +64      ;;ANGINA PECTORIS - STABLE^I25.718

 +65      ;;ANGINA PECTORIS - STABLE^I25.719

 +66      ;;ANGINA PECTORIS - STABLE^I25.721

 +67      ;;ANGINA PECTORIS - STABLE^I25.728

 +68      ;;ANGINA PECTORIS - STABLE^I25.729

 +69      ;;ANGINA PECTORIS - STABLE^I25.731

 +70      ;;ANGINA PECTORIS - STABLE^I25.738

 +71      ;;ANGINA PECTORIS - STABLE^I25.739

 +72      ;;ANGINA PECTORIS - STABLE^I25.751

 +73      ;;ANGINA PECTORIS - STABLE^I25.758

 +74      ;;ANGINA PECTORIS - STABLE^I25.759

 +75      ;;ANGINA PECTORIS - STABLE^I25.761

 +76      ;;ANGINA PECTORIS - STABLE^I25.768

 +77      ;;ANGINA PECTORIS - STABLE^I25.769

 +78      ;;ANGINA PECTORIS - STABLE^I25.791

 +79      ;;ANGINA PECTORIS - STABLE^I25.798

 +80      ;;ANGINA PECTORIS - STABLE^I25.799

 +81      ;;ANGINA PECTORIS - STABLE^I20.1

 +82      ;;ANGINA PECTORIS - STABLE^I20.8

 +83      ;;ANGINA PECTORIS - STABLE^R07.9

 +84      ;;ANGINA PECTORIS - STABLE^I25.9

 +85      ;;ANGINA PECTORIS - STABLE^I25.5

 +86      ;;ANGINA PECTORIS - STABLE^I25.6

 +87      ;;ANGINA PECTORIS - STABLE^I25.89

 +88      ;;ANGINA PECTORIS - UNSTABLE^I20.8

 +89      ;;ANGINA PECTORIS - UNSTABLE^I20.9

 +90      ;;ANGINA PECTORIS - UNSTABLE^I25.111

 +91      ;;ANGINA PECTORIS - UNSTABLE^I25.118

 +92      ;;ANGINA PECTORIS - UNSTABLE^I25.119

 +93      ;;ANGINA PECTORIS - UNSTABLE^I25.701

 +94      ;;ANGINA PECTORIS - UNSTABLE^I25.708

 +95      ;;ANGINA PECTORIS - UNSTABLE^I25.709

 +96      ;;ANGINA PECTORIS - UNSTABLE^I25.711

 +97      ;;ANGINA PECTORIS - UNSTABLE^I25.718

 +98      ;;ANGINA PECTORIS - UNSTABLE^I25.719

 +99      ;;ANGINA PECTORIS - UNSTABLE^I25.721

 +100     ;;ANGINA PECTORIS - UNSTABLE^I25.728

 +101     ;;ANGINA PECTORIS - UNSTABLE^I25.729

 +102     ;;ANGINA PECTORIS - UNSTABLE^I25.731

 +103     ;;ANGINA PECTORIS - UNSTABLE^I25.738

 +104     ;;ANGINA PECTORIS - UNSTABLE^I25.739

 +105     ;;ANGINA PECTORIS - UNSTABLE^I25.751

 +106     ;;ANGINA PECTORIS - UNSTABLE^I25.758

 +107     ;;ANGINA PECTORIS - UNSTABLE^I25.759

 +108     ;;ANGINA PECTORIS - UNSTABLE^I25.761

 +109     ;;ANGINA PECTORIS - UNSTABLE^I25.768

 +110     ;;ANGINA PECTORIS - UNSTABLE^I25.769

 +111     ;;ANGINA PECTORIS - UNSTABLE^I25.791

 +112     ;;ANGINA PECTORIS - UNSTABLE^I25.798

 +113     ;;ANGINA PECTORIS - UNSTABLE^I25.799

 +114     ;;ANGINA PECTORIS - UNSTABLE^I20.1

 +115     ;;ANGINA PECTORIS - UNSTABLE^I20.8

 +116     ;;ANGINA PECTORIS - UNSTABLE^R07.9

 +117     ;;ANGINA PECTORIS - UNSTABLE^I25.5

 +118     ;;ANGINA PECTORIS - UNSTABLE^I25.6

 +119     ;;ANGINA PECTORIS - UNSTABLE^I25.89

 +120     ;;ANGINA PECTORIS - UNSTABLE^I25.9

 +121     ;;MYOCARDITIS^I40.0

 +122     ;;MYOCARDITIS^I40.1

 +123     ;;MYOCARDITIS^I40.8

 +124     ;;MYOCARDITIS^I40.9

 +125     ;;MYOCARDITIS^A36.81

 +126     ;;MYOCARDITIS^B33.22

 +127     ;;MYOCARDITIS^A39.52

 +128     ;;MYOCARDITIS^I09.0

 +129     ;;MYOCARDITIS^I40.0

 +130     ;;MYOCARDITIS^A52.06

 +131     ;;MYOCARDITIS^I40.8

 +132     ;;HYPERTENSIVE HEART DISEASE^A18.84

 +133     ;;HYPERTENSIVE HEART DISEASE^D15.1

 +134     ;;HYPERTENSIVE HEART DISEASE^I10.

 +135     ;;HYPERTENSIVE HEART DISEASE^I11.0

 +136     ;;HYPERTENSIVE HEART DISEASE^I11.9

 +137     ;;HYPERTENSIVE HEART DISEASE^I15.0

 +138     ;;HYPERTENSIVE HEART DISEASE^I15.1

 +139     ;;HYPERTENSIVE HEART DISEASE^I15.2

 +140     ;;HYPERTENSIVE HEART DISEASE^I15.8

 +141     ;;HYPERTENSIVE HEART DISEASE^I15.9

 +142     ;;HYPERTENSIVE HEART DISEASE^I43.

 +143     ;;HYPERTENSIVE HEART DISEASE^N26.2

 +144     ;;HCM - OBSTRUCTIVE^A18.84

 +145     ;;HCM - OBSTRUCTIVE^I43.

 +146     ;;HCM - NON-OBSTRUCTIVE^A18.84

 +147     ;;HCM - NON-OBSTRUCTIVE^I43.

 +148     ;;HCM - PROVOCABLE OBSTRUCTION^A18.84

 +149     ;;HCM - PROVOCABLE OBSTRUCTION^I43.

 +150     ;;CARDIOMYOPATHY - DILATED^A18.84

 +151     ;;CARDIOMYOPATHY - DILATED^I43.

 +152     ;;CARDIOMYOPATHY - DILATED^I42.6

 +153     ;;CARDIOMYOPATHY - DILATED^I51.7

 +154     ;;CARDIOMYOPATHY - INFILTRATIVE/RESTRICTIVE^A18.84

 +155     ;;CARDIOMYOPATHY - INFILTRATIVE/RESTRICTIVE^I43.

 +156     ;;MITRAL STENOSIS^I05.0

 +157     ;;MITRAL STENOSIS^Q23.2

 +158     ;;MITRAL STENOSIS^I08.0

 +159     ;;MITRAL STENOSIS^I08.0

 +160     ;;MITRAL STENOSIS^I05.2

 +161     ;;MITRAL STENOSIS^I05.8

 +162     ;;MITRAL STENOSIS^I05.9

 +163     ;;MITRAL STENOSIS^I34.0

 +164     ;;MITRAL STENOSIS^I34.1

 +165     ;;MITRAL STENOSIS^I34.2

 +166     ;;MITRAL STENOSIS^I34.8

 +167     ;;MITRAL STENOSIS^I34.9

 +168     ;;MITRAL STENOSIS^I08.9

 +169     ;;MITRAL STENOSIS^I09.9