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