Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICDEXA

ICDEXA.m

Go to the documentation of this file. 
  1. ICDEXA ;SLC/KER - ICD Extractor - APIs/Utilities ;04/21/2014
  1.  ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
  1.  ;               
  1.  ; Global Variables
  1.  ;    None
  1.  ;               
  1.  ; External References
  1.  ;    $$GET1^DIQ          ICR   2056
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;               
  1. DTBR(CDT,STD,SYS) ; Date Business Rules
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;   CDT   Code Date to check (FileMan format, default=Today)
  1.  ;   STD   Standard
  1.  ;   
  1.  ;           0 = ICD (Default)
  1.  ;           1 = CPT/HCPCS
  1.  ;           2 = DRG
  1.  ;           
  1.  ;   SYS   Coding System
  1.  ;   
  1.  ;           1 = ICD-9-CM
  1.  ;           2 = ICD-9-PCS
  1.  ;          30 = ICD-10-CM
  1.  ;          31 = ICD-10-PCS
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   If CDT < ICD-9 Date and STD=0, use ICD-9 Date
  1.  ;   If CDT < ICD-10 Date and STD=0 and SYS=30, use ICD-10 Date
  1.  ;   If CDT < ICD-10 Date and STD=0 and SYS=31, use ICD-10 Date
  1.  ;   If CDT < 2890101 and STD=1, use 2890101
  1.  ;   If CDT < 2821001 and STD=2, use 2821001
  1.  ;   If CDT is year only, use first of the year
  1.  ;   If CDT is year and month only, use first of the month
  1.  ;
  1.  S CDT=$G(CDT)
  1.  ;   Nothing Passed, use TODAY
  1.  Q:'$G(CDT) $$DT^XLFDT
  1.  ;   Invalid Date Format, use TODAY
  1.  Q:$L($P(CDT,"."))'=7 $$DT^XLFDT
  1.  N BRDAT ;   Business rule date
  1.  N ICD9,ICD10,ICDDS
  1.  S ICD9=$$IMP^ICDEX(1),ICD10=$$IMP^ICDEX(30)
  1.  S ICDDS=ICD9_"^2890101^2821001"
  1.  S STD=+$G(STD) S:STD>2!(STD<0) STD=0  S SYS=$G(SYS)
  1.  S BRDAT=+$P(ICDDS,"^",STD+1)
  1.  S:+($G(STD))'>0&("^30^31^"[("^"_SYS_"^")) BRDAT=ICD10
  1.  I CDT#10000=0 S CDT=CDT+101
  1.  S:CDT#100=0 CDT=CDT+1
  1.  Q $S(CDT<BRDAT:BRDAT,1:CDT)
  1.  ;
  1. IMP(SYS,CDT) ; Coding System Implementation Date
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;   SYS   Coding System
  1.  ;   
  1.  ;           1 = ICD-9-CM
  1.  ;           2 = ICD-9-PCS
  1.  ;          30 = ICD-10-CM
  1.  ;          31 = ICD-10-PCS
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   $$IMP  Date the Coding System was Implemented/Activated
  1.  ;   
  1.  N ICDD,ICDS,ICDN
  1.  S ICDD=$S($G(CDT)'?7N:$$DT^XLFDT,1:$G(CDT))
  1.  S ICDS=$$SYS^ICDEX($G(SYS),ICDD,"I") Q:+ICDS'>0 "-1^Coding system Unknown"
  1.  S ICDN=$P($G(^ICDS(+ICDS,0)),"^",4) Q:ICDN'?7N "-1^Implementation Date not found"
  1.  Q ICDN
  1.  ;
  1. MSG(CDT,STD,SYS) ; Inform of code text inaccuracy
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;   CDT   Code Date to check (FileMan format, Default = today)
  1.  ;   STD   Code System
  1.  ;    
  1.  ;            0   ICD (default)
  1.  ;            1   CPT/HCPCS
  1.  ;            2   DRG
  1.  ;            3   LEX
  1.  ;           
  1.  ;   SYS   Coding System
  1.  ;   
  1.  ;           1 = ICD-9-CM
  1.  ;           2 = ICD-9-PCS
  1.  ;          30 = ICD-10-CM
  1.  ;          31 = ICD-10-PCS
  1.  ;          
  1.  ; Output: 
  1.  ; 
  1.  ;   User Alert Message
  1.  ;
  1.  S STD=+$G(STD) S:STD>3!(STD<0) STD=0
  1.  S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT,STD,$G(SYS)))
  1.  N MSGTXT,MSGDAT S MSGDAT=3021001,MSGTXT="CODE TEXT MAY BE INACCURATE"
  1.  I STD<3 Q $S(CDT<MSGDAT:MSGTXT,1:"")
  1.  I STD=3,CDT'<3031001 Q ""
  1.  Q MSGTXT
  1.  ;
  1. STATCHK(CODE,CDT,SYS) ; Check Status of ICD Code
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;    CODE   ICD Code  REQUIRED
  1.  ;    CDT    Date to screen against (default = TODAY)
  1.  ;    SYS    Numeric Coding System (optional, however, if
  1.  ;           specified it must be correct)
  1.  ;    
  1.  ; Output:
  1.  ; 
  1.  ;    3-Piece String containing the code's status
  1.  ;    and the IEN if the code exists, else -1.
  1.  ;    The following are possible outputs:
  1.  ;    
  1.  ;         1^IEN^Effective Date     Active Code
  1.  ;         0^IEN^Effective Date     Inactive Code
  1.  ;         0^IEN^Null               Future Activation (pending)
  1.  ;         0^-1^Error Message       Code not Found or Error
  1.  ;
  1.  ; This API requires the ACT Cross-Reference
  1.  ;     ^ICD9("ACT",<code>,<status>,<date>,<ien>)
  1.  ;     ^ICD0("ACT",<code>,<status>,<date>,<ien>)
  1.  ;
  1.  N ICDC,ICDD,ICDIEN,ICDI,ICDA,ICDG,ICDR,ICDS,ICDY,ICDF,ICDEF,ICDBR,ICDTD,X
  1.  S ICDS="",ICDC=$G(CODE) Q:'$L(ICDC) "0^-1^No code specified"
  1.  S:$L($G(SYS)) ICDS=$$SYS^ICDEX($G(SYS),$G(CDT))
  1.  S:'$L($G(SYS))&($L(ICDC)) ICDS=$$SYS^ICDEX(ICDC)
  1.  Q:'$L($G(SYS))&(+ICDS'>0) "0^-1^No coding system specified"
  1.  Q:$L($G(SYS))&(+ICDS'>0) "0^-1^Invalid coding system specified"
  1.  ;    Case 1:  Not Valid                           0^-1
  1.  ;             Fails Pattern Match for Code
  1.  S ICDF=$$FILE^ICDEX(ICDS) S:ICDF'>0 ICDF=$$CODEFI^ICDEX(CODE)
  1.  S:+ICDF'>0 ICDF="" S CODE=$$CODEN^ICDEX(CODE,ICDF)
  1.  S:+ICDF>0&(+CODE>0) ICDC=$$CODEC^ICDEX(+ICDF,+CODE)
  1.  S ICDG=$P(CODE,"~",2),ICDIEN=+CODE
  1.  Q:ICDIEN<1 "0^-1^Code not found"
  1.  S ICDY=$P($G(@(ICDG_+ICDIEN_",1)")),"^",1)
  1.  Q:+ICDS>0&(ICDY>0)&(ICDS'=ICDY) "0^-1^Code not valid for Coding System"
  1.  ;    Case 2:  Never Active                        0^IEN
  1.  ;             No Active/Inactive Date
  1.  S ICDD=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR($G(CDT),,+ICDS)),ICDD=ICDD+.001
  1.  S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDD),ICDA=$O(@(ICDR_")"),-1)
  1.  I '$L(ICDA) D  Q X
  1.  . S ICDA=$O(@(ICDR_")")),X="0^-1" Q:'$L(ICDA)
  1.  . S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA)
  1.  . S ICDIEN=$O(@(ICDR_",0)")) S:+ICDIEN<1 ICDIEN=-1
  1.  . S X="0^"_ICDIEN_"^"
  1.  ;    Case 3:  Active, Never Inactive              1^IEN^Effective Date
  1.  ;             Has an Activation Date
  1.  ;             No Inactivation Date
  1.  S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDD),ICDI=$O(@(ICDR_")"),-1)
  1.  I $L(ICDA),'$L(ICDI) D  Q X
  1.  . S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA),ICDIEN=$O(@(ICDR_",0)"))
  1.  . S X=$S(+ICDIEN=0:"0^-1",1:"1^"_ICDIEN)
  1.  . S:X'["-1"&(ICDA?7N) X=X_"^"_ICDA
  1.  ;    Case 4:  Active, but later Inactivated       0^IEN^Effective Date
  1.  ;             Has an Activation Date
  1.  ;             Has an Inactivation Date
  1.  I $L(ICDA),$L(ICDI),ICDI>ICDA,ICDI<ICDD D  Q X
  1.  . S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI)
  1.  . S ICDIEN=$O(@(ICDR_",0)"))
  1.  . S X=$S(+ICDIEN=0:"0^-1",1:"0^"_ICDIEN)
  1.  . S:X'["-1"&(ICDI?7N) X=X_"^"_ICDI
  1.  ;    Case 5:  Active, and not later Inactivated   1^IEN^Effective Date
  1.  ;             Has an Activation Date
  1.  ;             Has an Inactivation Date
  1.  ;             Has a Newer Activation Date
  1.  I $L(ICDA),$L(ICDI),ICDI'>ICDA D  Q X
  1.  . S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI),ICDIEN=$O(@(ICDR_",1)"))
  1.  . S X=$S(+$O(@(ICDR_",0)"))=0:"0^-1",1:"1^"_ICDIEN)
  1.  . S:X'["-1"&(ICDA?7N) X=X_"^"_ICDA
  1.  ;    Case 6:  Fails Time Test                     0^-1
  1.  Q ("0^"_$S(+($G(ICDIEN))>0:+($G(ICDIEN)),1:"-1"))
  1.  ;
  1. ACTROOT(ICDG,ICDC,ICDS,ICDD)  ; Return "ACT" root
  1.  Q (ICDG_"""ACT"","""_ICDC_" "","_ICDS_","_ICDD)
  1.  ;
  1. SEL(FILE,IEN) ; Entry is Selectable
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;    FILE   File number 80 or 80.1 (required)
  1.  ;    IEN    Internal Entry Number (required)
  1.  ;
  1.  ; Output:  
  1.  ; 
  1.  ;    $$SEL  Boolean value
  1.  ;    
  1.  ;             1  Selectable
  1.  ;             0  Not Selectable
  1.  ;          
  1.  ;            -1  on error
  1.  ;           
  1.  N ICDF,ICDI,ICDR,ICDS
  1.  S ICDF=$G(FILE) Q:"^80^80.1^"'[("^"_$G(ICDF)_"^") -1
  1.  S ICDR=$$ROOT^ICDEX(ICDF) Q:'$L(ICDR) -1
  1.  S ICDI=+($G(IEN)) Q:ICDI'>0 -1
  1.  Q:'$D(@(ICDR_ICDI_",0)")) -1
  1.  S ICDS=+($$GET1^DIQ(ICDF,(+ICDI_","),1.8))
  1.  Q $S(ICDS>0:0,1:1)