- 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 Feb 18, 2025@23:16:19 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 ;