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

ICDEXD.m

Go to the documentation of this file. 
  1. ICDEXD ;SLC/KER - ICD Extractor - DRG APIs ;04/21/2014
  1.  ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^ICD0(              N/A
  1.  ;    ^ICD9(              N/A
  1.  ;    ^ICD9("ACC"         N/A
  1.  ;               
  1.  ; External References
  1.  ;    ^%DT                ICR  10003
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;               
  1.  Q
  1. GETDRG(FILE,IEN,CDT,MDC) ; DRGs for an Fiscal Year (FY)
  1.  ;
  1.  ; Input
  1.  ; 
  1.  ;    FILE   ICD file number to used to retrieve 
  1.  ;       
  1.  ;    IEN    Internal Entry Number (IEN) (Required)
  1.  ;           
  1.  ;    CDT    This is the Code Set Versioning date 
  1.  ;           (Fileman format, optional, default TODAY)
  1.  ;           
  1.  ;    MDC    Major Diagnostic Category (pointer to
  1.  ;           file 80.1) used as a screen to limit 
  1.  ;           the DRGs to a MDC.  This input parameter
  1.  ;           only applies to the OPERATIONS/PROCEDURE 
  1.  ;           file 80.1 which has multiple MDCs, each
  1.  ;           with a possibility of multiple DRGs.
  1.  ;
  1.  ; Output
  1.  ;
  1.  ;    3 piece semi-colon delimited string
  1.  ;
  1.  ;        1  DRGs delimited by ^
  1.  ;        2  Fiscal Year
  1.  ;        3  Status flag
  1.  ;             0 inactive
  1.  ;             1 active
  1.  ;
  1.  ;        Example output:
  1.  ;        
  1.  ;           907^908^909^;3071001;1
  1.  ;        
  1.  ;        On Error:
  1.  ;        
  1.  ;           -1;No DRG level;0
  1.  ;           
  1.  N FY,MD,OUT S OUT="",FILE=$G(FILE),IEN=$G(IEN)
  1.  S FILE=$S(FILE="9":80,FILE="0":80.1,1:FILE)
  1.  S FILE=$$FILE^ICDEX(FILE)
  1.  Q:"^80^80.1^"'[("^"_$G(FILE)_"^") "-1;Invalid file specified;0"
  1.  Q:$G(IEN)'?1N.N "-1;Invalid IEN specified;0"
  1.  D MD^ICDEXD2(FILE,IEN,CDT,.MD)
  1.  S FY=$O(MD(""))
  1.  Q:FY'?7N "-1;No DRG level;0"
  1.  I FILE=80.1,$L($G(MDC)) D  Q OUT
  1.  . S OUT=$G(MD(FY,MDC))
  1.  . S:+($P($G(OUT),";",1))'>0 OUT="-1;No DRG level;0"
  1.  I FILE=80.1,'$L($G(MDC)) D  Q OUT
  1.  . N MDC S MDC=$O(MD(FY,"")) I $L(MDC),MDC=$O(MD(FY," "),-1) S OUT=$G(MD(FY,MDC))
  1.  . S:+($P($G(OUT),";",1))'>0 OUT="-1;No DRG level;0"
  1.  I FILE=80 D  Q OUT
  1.  . N MDC S MDC=$O(MD(FY,"")) I $L(MDC),MDC=$O(MD(FY," "),-1) S OUT=$G(MD(FY,MDC))
  1.  . S:+($P($G(OUT),";",1))'>0 OUT="-1;No DRG level;0"
  1.  Q $S($L(OUT):OUT,1:"-1;No DRG level;0")
  1. GETPRE(IEN,MDC) ; Get MDC for Op/Pro ICD for Previous Years
  1.  ;
  1.  ; Input
  1.  ;
  1.  ;    IEN   Internal Entry Number (80.1) (required)
  1.  ;    MDC   Major Diagnostic Category (required)
  1.  ;
  1.  ; Output
  1.  ;
  1.  ;   2 piece "^" delimited string
  1.  ;
  1.  ;          1  Internal entry number for fiscal year
  1.  ;          2  Internal entry number for MDC
  1.  ;
  1.  ;   OR -1 if not found
  1.  ;
  1.  N ICDF,ICDFI,ICDI,MDCIEN S ICDI=+($G(IEN)),MDC=$G(MDC) Q:+ICDI'>0!('$L(MDC)) -1  S (ICDFI,MDCIEN)=0,ICDF=""
  1.  F  S ICDF=$O(^ICD0(ICDI,2,"B",ICDF),-1) Q:'ICDF!(MDCIEN>0)  D  Q:MDCIEN>0
  1.  . S ICDFI=$O(^ICD0(ICDI,2,"B",+$G(ICDF),0))
  1.  . S MDCIEN=$O(^ICD0(ICDI,2,+ICDFI,1,"B",MDC,0))
  1.  Q:+ICDFI'>0!(+MDCIEN'>0) -1
  1.  Q (ICDFI_"^"_MDCIEN)
  1.  ;
  1. LEMDC(FILE,IEN,CDT,MDC) ; Last Effective MDC
  1.  ;
  1.  ; Input
  1.  ;    FILE   File 80 or 80.1
  1.  ;    IEN    Internal Entry Number in FILE
  1.  ;    CDT    Code Set Versioning Date
  1.  ;    MDC    Major Diagnostic Category (file 80.1 only)
  1.  ;           If the file is 80.1, and MDC is not provided,
  1.  ;           then the first MDC is returned.
  1.  ;
  1.  ; Output
  1.  ;
  1.  ;    2 piece "^" delimited string
  1.  ;           1   Fiscal Year (Fileman Format)
  1.  ;           2   MDC (pointer to file 80.3
  1.  ;
  1.  ;    or    -1^error message    on error
  1.  ;
  1.  N OUT,ROOT S FILE=$G(FILE) S:FILE=9!(FILE["ICD9") FILE=80  S:FILE=0!(FILE["ICD0") FILE=80.1
  1.  Q:"^80^80.1^"'[("^"_FILE_"^") "-1;Invalid file selected"
  1.  S IEN=+($G(IEN)),CDT=$P($G(CDT),".",1)
  1.  S ROOT=$$ROOT^ICDEX(FILE) S:CDT'?7N CDT=$$DT^XLFDT
  1.  Q:'$L(ROOT) "-1;Invalid file selected"
  1.  Q:'$D(@(ROOT_+IEN_",0)")) "-1;No such entry"
  1.  S OUT="" I FILE=80.1 D
  1.  . N TMDC,FY,FYIEN S FY=$O(^ICD0(+IEN,2,"B",(CDT+.001)),-1)
  1.  . ; get previous from today
  1.  . S:FY'?7N FY=$O(^ICD0(+IEN,2,"B"," "),-1)
  1.  . S:FY'?7N OUT="-1^FY not found" Q:FY'?7N
  1.  . S FYIEN=$O(^ICD0(IEN,2,"B",FY,0))
  1.  . S:FYIEN'>0 OUT="-1^FY not found" Q:+FYIEN'>0
  1.  . S TMDC=+($G(MDC))
  1.  . I TMDC'>0!('$D(^ICD0(IEN,2,FYIEN,1,"B",TMDC))) D  Q
  1.  . . S OUT="-1^MDC not specified"
  1.  . S OUT=FY_"^"_TMDC
  1.  Q:$L($G(OUT)) OUT
  1.  I FILE=80 D
  1.  . N TMDC,FY,FYIEN S FY=$O(^ICD9(+IEN,4,"B",(CDT+.001)),-1)
  1.  . S:FY'?7N FY=$O(^ICD9(+IEN,4,"B"," "),-1)
  1.  . S:FY'?7N OUT="-1^FY not found" Q:FY'?7N
  1.  . S FYIEN=$O(^ICD9(IEN,4,"B",FY,0))
  1.  . S:FYIEN'>0 OUT="-1^FY not found" Q:+FYIEN'>0
  1.  . S TMDC=$P($G(^ICD9(IEN,4,FYIEN,0)),"^",2)
  1.  . S:TMDC'>0 OUT="-1^MDC not found" Q:+TMDC'>0
  1.  . S OUT=FY_"^"_TMDC
  1.  Q:$L($G(OUT)) OUT
  1.  Q "-1^Last Effective MDC not found"
  1. EXIST(IEN,FIELD) ; Does a condition Exist
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   IEN    Internal Entry to file 80
  1.  ;   FIELD  Type of condition to check
  1.  ;
  1.  ;           20   Code Not Used With
  1.  ;           30   Code Required With
  1.  ;           40   Code Not Considered CC With
  1.  ;           
  1.  ; Output:
  1.  ;
  1.  ;   $$EXIST  Boolean value
  1.  ;
  1.  ;          1   Yes/True
  1.  ;          0   No/False
  1.  ;
  1.  ;    Field   Answers the Question
  1.  ;    -----   -------------------------------------------------        
  1.  ;    20      Are there any codes required with this code (IEN)
  1.  ;    30      Are there any codes that should not be used
  1.  ;            with this code (IEN)
  1.  ;    40      Are there any codes that are not considered
  1.  ;            Complication/Comorbidity (CC) with this code
  1.  ;            (IEN)
  1.  ;
  1.  N ICDI,ICDF,ICDT,ICDO S ICDI=$G(IEN),ICDF=$G(FIELD) Q:+ICDI'>0 0  Q:+ICDF'>0 0
  1.  S ICDT=$S(ICDF=20:"N",ICDF=30:"R",ICDF=40:2,1:"") Q:'$L(ICDT) 0
  1.  S ICDI=+($O(^ICD9(ICDI,ICDT," "),-1))
  1.  Q $S(ICDI>0:1,1:0)
  1. ISA(IEN1,IEN2,FIELD) ; Is Code 1 a condition of Code 2 (this code)
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   IEN1   This is the internal entry number (IEN) of a
  1.  ;          code in file 80 that has a relationship with 
  1.  ;          the code at IEN2  IEN1 is equivalent to 
  1.  ;          Fileman's DA and identifies a code stored in
  1.  ;          a multiple in field 20, 30, 40 or pointed to
  1.  ;          by field 1.11.
  1.  ;
  1.  ;   IEN2   This is the internal entry number (IEN) of a
  1.  ;          code in file 80 that may have other codes (IEN1)
  1.  ;          associated with it.  IEN2 is equivalent to 
  1.  ;          Fileman's DA(1) and identifies the code in 
  1.  ;          the .01 field.
  1.  ;
  1.  ;   FIELD  This is a field number in file 80 that contains 
  1.  ;          one or more ICD codes that have a relationship to
  1.  ;          the main entry.   Acceptable field numbers and
  1.  ;          the type of relationships to check include:
  1.  ;
  1.  ;           Field       Relationship
  1.  ;           20          Code 1 Not Used With Code 2
  1.  ;           30          Code 1 Required With Code 2
  1.  ;           40 or 1.11  Code 1 Not Considered CC With Code 2
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$ISA  Boolean value
  1.  ;
  1.  ;          1   Yes/The relationship is True
  1.  ;          0   No/The relationship is False
  1.  ;
  1.  ;    Field        Answers the Question
  1.  ;    -----        ---------------------------------------------
  1.  ;    20           Code 1 (identified by IEN1) is not used with
  1.  ;                 Code 2 (identified by IEN2)
  1.  ;
  1.  ;    30           Code 1 (identified by IEN1) is required with
  1.  ;                 Code 2 (identified by IEN2)
  1.  ;
  1.  ;    40 or 1.11   Code 1 (identified by IEN1) is not considered
  1.  ;                 Complication/Comorbidity (CC) with Code 2
  1.  ;                 (identified by IEN2)
  1.  ; 
  1.  N ICD1,ICD2,ICDF,ICDT,ICDO,ICDCS S ICDO=0,ICD1=+($G(IEN1)),ICD2=+($G(IEN2)),ICDF=$G(FIELD)
  1.  Q:+ICDF'>0 ICDO  S ICDT=$S(ICDF=20:"N",ICDF=30:"R",ICDF=40:1,ICDF=1.11:1,1:"")
  1.  Q:'$L(ICDT) 0  Q:'$D(^ICD9(ICD2,ICDT)) 0
  1.  S ICDCS=$P($G(^ICD9(ICD2,1)),"^",1)
  1.  I ICDF=20!(ICDF=30) D  Q ICDO
  1.  . S ICDO=$S($D(^ICD9(ICD2,ICDT,"B",ICD1)):1,1:0)
  1.  I ICDF=40!(ICDF=1.11) D  Q ICDO
  1.  . N ICDPDXE S ICD0=0 S ICDPDXE=$$PDXE^ICDEX(ICD2) I ICDPDXE>0 D  Q
  1.  . . S:$D(^ICDCCEX(ICDPDXE,1,"B",ICD1)) ICDO=1
  1.  . I ICDCS=1!(ICDCS=2) S:$D(^ICD9("ACC",ICD2,ICD1)) ICDO=1
  1.  Q ICDO
  1. DRGMDC(X) ; DRG MDC
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   X      Internal Entry Number DRG file 80.2
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$X    Internal Entry Number MDC file 80.3
  1.  ;          -1 on error
  1.  ;
  1.  N MDC S MDC=$P($G(^ICD(+($G(X)),0)),"^",5) S X=$S(MDC>0:MDC,1:-1)
  1.  Q X