Routine: ICD1839P

ICD1839P ;ALB/MJB - ADD NON CC CODE ; 06/11/08 4:07pm

 ;;18.0;DRG Grouper;**39**;Oct 20, 2000;Build 4

POST ;entry point to add CODE NOT CC WITH 428.0 to 428.21

 ; and code 428.0 to code 425.4

 N SDA,ICDFLG

 N SDA

 S SDA(1)="",SDA(2)=" Adding CODE NOT CC WITH(#80.03) in the "

 S SDA(3)=" ICD DIAGNOSIS file (# 80)for codes 428.21"  D ATADDQ

EN ;start update

 N ICDA

 S ICDA=0,ICDFLG=0

 F  S ICDA=$O(^ICD9("ACC",13637,ICDA)) Q:ICDFLG!(ICDA="")  D

 .I ICDA=9061 D ICDADDQ S ICDFLG=1 Q

 N DIC,X,DA

 S DIC="^ICD9(13637,"_"2,",DA(1)=2,X=9061,DIC(0)="X"

 I '$D(^ICD9("ACC",13637,X)) D

 . D FILE^DICN

 .S ^ICD9("ACC",13637,X)=""

 .N SDA

 .S SDA(1)="",SDA(2)="    CODE ADDED.....",SDA(3)="" D ATADDQ

.Q

ICDADDQ ;

 N SDA

 S SDA(1)="",SDA(2)=" DUPLICATE CODE - CODE NOT ADDED" D ATADDQ

ATADDQ ;

 D MES^XPDUTL(.SDA) K SDA

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1839P   863     printed  Apr 23, 2025@18:03:12                                                                                                                                                                                                     Page 2

ICD1839P  ;ALB/MJB - ADD NON CC CODE ; 06/11/08 4:07pm

 +1       ;;18.0;DRG Grouper;**39**;Oct 20, 2000;Build 4

 +2        QUIT

POST      ;entry point to add CODE NOT CC WITH 428.0 to 428.21

 +1       ; and code 428.0 to code 425.4

 +2        NEW SDA,ICDFLG

 +3        NEW SDA

 +4        SET SDA(1)=""

           SET SDA(2)=" Adding CODE NOT CC WITH(#80.03) in the "

 +5        SET SDA(3)=" ICD DIAGNOSIS file (# 80)for codes 428.21"

           DO ATADDQ

 +6       ;

EN        ;start update

 +1        NEW ICDA

 +2        SET ICDA=0

           SET ICDFLG=0

 +3        FOR

               SET ICDA=$ORDER(^ICD9("ACC",13637,ICDA))

               if ICDFLG!(ICDA="")

                   QUIT

               Begin DoDot:1

 +4                IF ICDA=9061

                       DO ICDADDQ

                       SET ICDFLG=1

                       QUIT

               End DoDot:1

 +5       ;

 +6        NEW DIC,X,DA

 +7        SET DIC="^ICD9(13637,"_"2,"

           SET DA(1)=2

           SET X=9061

           SET DIC(0)="X"

 +8        IF '$DATA(^ICD9("ACC",13637,X))

               Begin DoDot:1

 +9                DO FILE^DICN

 +10               SET ^ICD9("ACC",13637,X)=""

 +11               NEW SDA

 +12               SET SDA(1)=""

                   SET SDA(2)="    CODE ADDED....."

                   SET SDA(3)=""

                   DO ATADDQ

 +13               QUIT

               End DoDot:1

 +14       QUIT

ICDADDQ   ;

 +1        NEW SDA

 +2        SET SDA(1)=""

           SET SDA(2)=" DUPLICATE CODE - CODE NOT ADDED"

           DO ATADDQ

ATADDQ    ;

 +1        DO MES^XPDUTL(.SDA)

           KILL SDA

 +2        QUIT

 +3       ;

ICD1839P.m