ICD1839P ;ALB/MJB - ADD NON CC CODE ; 06/11/08 4:07pm
;;18.0;DRG Grouper;**39**;Oct 20, 2000;Build 4
Q
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
Q
ICDADDQ ;
N SDA
S SDA(1)="",SDA(2)=" DUPLICATE CODE - CODE NOT ADDED" D ATADDQ
ATADDQ ;
D MES^XPDUTL(.SDA) K SDA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1839P 863 printed Dec 13, 2024@01:48:46 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 ;
