ICD18P36.m

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

 ;;18.0;DRG Grouper;**36**;Oct 20, 2000;Build 14

 Q

POST ;entry point to add code

 N SDA,ICDFLG

 S SDA(1)="",SDA(2)="    ICD*18.0*36 Post-Install starting.....",SDA(3)="" D ATADDQ

 N SDA

 S SDA(1)="",SDA(2)=" Adding code 427.31 to multiple CODE NOT CC WITH(#80.03) "

 S SDA(3)=" in the ICD DIAGNOSIS file (# 80)for code 427.32"  D ATADDQ

 ;

 N ICDA

 S ICDA=0,ICDFLG=0

 ;F  S ICDA=$O(^ICD9("ACC",2558,ICDA),-1) Q:ICDFLG!(ICDA="")  D

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

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

 ;

EN ;start update

 N DIC,X,DA

 S DIC="^ICD9(2558,"_"2,",DA(1)=2,X=2557,DIC(0)="X"

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

 . D FILE^DICN

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

 .N SDA

 .S SDA(1)="",SDA(2)="    ICD*18.0*36 Post-Install completed.....",SDA(3)="" D ATADDQ

 .Q

 Q

ICDADDQ ;

 N SDA

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

 S SDA(3)="    ICD*18.0*36 Post-Install completed....."  D ATADDQ

ATADDQ ;

 D MES^XPDUTL(.SDA) K SDA

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICD18P36   1053     printed  Sep 02, 2024@18:35:11                                                                                                                                                                                                    Page 2

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

 +1       ;;18.0;DRG Grouper;**36**;Oct 20, 2000;Build 14

 +2        QUIT 

POST      ;entry point to add code

 +1        NEW SDA,ICDFLG

 +2        SET SDA(1)=""

           SET SDA(2)="    ICD*18.0*36 Post-Install starting....."

           SET SDA(3)=""

           DO ATADDQ

 +3        NEW SDA

 +4        SET SDA(1)=""

           SET SDA(2)=" Adding code 427.31 to multiple CODE NOT CC WITH(#80.03) "

 +5        SET SDA(3)=" in the ICD DIAGNOSIS file (# 80)for code 427.32"

           DO ATADDQ

 +6       ;

 +7        NEW ICDA

 +8        SET ICDA=0

           SET ICDFLG=0

 +9       ;F  S ICDA=$O(^ICD9("ACC",2558,ICDA),-1) Q:ICDFLG!(ICDA="")  D

 +10       FOR 

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

               if ICDFLG!(ICDA="")

                   QUIT 

               Begin DoDot:1

 +11               IF ICDA=2557

                       DO ICDADDQ

                       SET ICDFLG=1

                       QUIT 

               End DoDot:1

 +12      ;

EN        ;start update

 +1        NEW DIC,X,DA

 +2        SET DIC="^ICD9(2558,"_"2,"

           SET DA(1)=2

           SET X=2557

           SET DIC(0)="X"

 +3        IF '$DATA(^ICD9("ACC",2558,X))

               Begin DoDot:1

 +4                DO FILE^DICN

 +5                SET ^ICD9("ACC",2558,X)=""

 +6                NEW SDA

 +7                SET SDA(1)=""

                   SET SDA(2)="    ICD*18.0*36 Post-Install completed....."

                   SET SDA(3)=""

                   DO ATADDQ

 +8                QUIT 

               End DoDot:1

 +9        QUIT 

ICDADDQ   ;

 +1        NEW SDA

 +2        SET SDA(1)=""

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

 +3        SET SDA(3)="    ICD*18.0*36 Post-Install completed....."

           DO ATADDQ

ATADDQ    ;

 +1        DO MES^XPDUTL(.SDA)

           KILL SDA

 +2        QUIT 

 +3       ;