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 ---[H[J[2J[HICD18P36   1053     printed  Sep 23, 2025@19:25:59                                                                                                                                                                                                    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       ;