ICDEXA ;SLC/KER - ICD Extractor - APIs/Utilities ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
;
; Global Variables
; None
;
; External References
; $$GET1^DIQ ICR 2056
; $$DT^XLFDT ICR 10103
;
DTBR(CDT,STD,SYS) ; Date Business Rules
;
; Input:
;
; CDT Code Date to check (FileMan format, default=Today)
; STD Standard
;
; 0 = ICD (Default)
; 1 = CPT/HCPCS
; 2 = DRG
;
; SYS Coding System
;
; 1 = ICD-9-CM
; 2 = ICD-9-PCS
; 30 = ICD-10-CM
; 31 = ICD-10-PCS
;
; Output:
;
; If CDT < ICD-9 Date and STD=0, use ICD-9 Date
; If CDT < ICD-10 Date and STD=0 and SYS=30, use ICD-10 Date
; If CDT < ICD-10 Date and STD=0 and SYS=31, use ICD-10 Date
; If CDT < 2890101 and STD=1, use 2890101
; If CDT < 2821001 and STD=2, use 2821001
; If CDT is year only, use first of the year
; If CDT is year and month only, use first of the month
;
S CDT=$G(CDT)
; Nothing Passed, use TODAY
Q:'$G(CDT) $$DT^XLFDT
; Invalid Date Format, use TODAY
Q:$L($P(CDT,"."))'=7 $$DT^XLFDT
N BRDAT ; Business rule date
N ICD9,ICD10,ICDDS
S ICD9=$$IMP^ICDEX(1),ICD10=$$IMP^ICDEX(30)
S ICDDS=ICD9_"^2890101^2821001"
S STD=+$G(STD) S:STD>2!(STD<0) STD=0 S SYS=$G(SYS)
S BRDAT=+$P(ICDDS,"^",STD+1)
S:+($G(STD))'>0&("^30^31^"[("^"_SYS_"^")) BRDAT=ICD10
I CDT#10000=0 S CDT=CDT+101
S:CDT#100=0 CDT=CDT+1
Q $S(CDT<BRDAT:BRDAT,1:CDT)
;
IMP(SYS,CDT) ; Coding System Implementation Date
;
; Input:
;
; SYS Coding System
;
; 1 = ICD-9-CM
; 2 = ICD-9-PCS
; 30 = ICD-10-CM
; 31 = ICD-10-PCS
;
; Output:
;
; $$IMP Date the Coding System was Implemented/Activated
;
N ICDD,ICDS,ICDN
S ICDD=$S($G(CDT)'?7N:$$DT^XLFDT,1:$G(CDT))
S ICDS=$$SYS^ICDEX($G(SYS),ICDD,"I") Q:+ICDS'>0 "-1^Coding system Unknown"
S ICDN=$P($G(^ICDS(+ICDS,0)),"^",4) Q:ICDN'?7N "-1^Implementation Date not found"
Q ICDN
;
MSG(CDT,STD,SYS) ; Inform of code text inaccuracy
;
; Input:
;
; CDT Code Date to check (FileMan format, Default = today)
; STD Code System
;
; 0 ICD (default)
; 1 CPT/HCPCS
; 2 DRG
; 3 LEX
;
; SYS Coding System
;
; 1 = ICD-9-CM
; 2 = ICD-9-PCS
; 30 = ICD-10-CM
; 31 = ICD-10-PCS
;
; Output:
;
; User Alert Message
;
S STD=+$G(STD) S:STD>3!(STD<0) STD=0
S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT,STD,$G(SYS)))
N MSGTXT,MSGDAT S MSGDAT=3021001,MSGTXT="CODE TEXT MAY BE INACCURATE"
I STD<3 Q $S(CDT<MSGDAT:MSGTXT,1:"")
I STD=3,CDT'<3031001 Q ""
Q MSGTXT
;
STATCHK(CODE,CDT,SYS) ; Check Status of ICD Code
;
; Input:
;
; CODE ICD Code REQUIRED
; CDT Date to screen against (default = TODAY)
; SYS Numeric Coding System (optional, however, if
; specified it must be correct)
;
; Output:
;
; 3-Piece String containing the code's status
; and the IEN if the code exists, else -1.
; The following are possible outputs:
;
; 1^IEN^Effective Date Active Code
; 0^IEN^Effective Date Inactive Code
; 0^IEN^Null Future Activation (pending)
; 0^-1^Error Message Code not Found or Error
;
; This API requires the ACT Cross-Reference
; ^ICD9("ACT",<code>,<status>,<date>,<ien>)
; ^ICD0("ACT",<code>,<status>,<date>,<ien>)
;
N ICDC,ICDD,ICDIEN,ICDI,ICDA,ICDG,ICDR,ICDS,ICDY,ICDF,ICDEF,ICDBR,ICDTD,X
S ICDS="",ICDC=$G(CODE) Q:'$L(ICDC) "0^-1^No code specified"
S:$L($G(SYS)) ICDS=$$SYS^ICDEX($G(SYS),$G(CDT))
S:'$L($G(SYS))&($L(ICDC)) ICDS=$$SYS^ICDEX(ICDC)
Q:'$L($G(SYS))&(+ICDS'>0) "0^-1^No coding system specified"
Q:$L($G(SYS))&(+ICDS'>0) "0^-1^Invalid coding system specified"
; Case 1: Not Valid 0^-1
; Fails Pattern Match for Code
S ICDF=$$FILE^ICDEX(ICDS) S:ICDF'>0 ICDF=$$CODEFI^ICDEX(CODE)
S:+ICDF'>0 ICDF="" S CODE=$$CODEN^ICDEX(CODE,ICDF)
S:+ICDF>0&(+CODE>0) ICDC=$$CODEC^ICDEX(+ICDF,+CODE)
S ICDG=$P(CODE,"~",2),ICDIEN=+CODE
Q:ICDIEN<1 "0^-1^Code not found"
S ICDY=$P($G(@(ICDG_+ICDIEN_",1)")),"^",1)
Q:+ICDS>0&(ICDY>0)&(ICDS'=ICDY) "0^-1^Code not valid for Coding System"
; Case 2: Never Active 0^IEN
; No Active/Inactive Date
S ICDD=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR($G(CDT),,+ICDS)),ICDD=ICDD+.001
S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDD),ICDA=$O(@(ICDR_")"),-1)
I '$L(ICDA) D Q X
. S ICDA=$O(@(ICDR_")")),X="0^-1" Q:'$L(ICDA)
. S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA)
. S ICDIEN=$O(@(ICDR_",0)")) S:+ICDIEN<1 ICDIEN=-1
. S X="0^"_ICDIEN_"^"
; Case 3: Active, Never Inactive 1^IEN^Effective Date
; Has an Activation Date
; No Inactivation Date
S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDD),ICDI=$O(@(ICDR_")"),-1)
I $L(ICDA),'$L(ICDI) D Q X
. S ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA),ICDIEN=$O(@(ICDR_",0)"))
. S X=$S(+ICDIEN=0:"0^-1",1:"1^"_ICDIEN)
. S:X'["-1"&(ICDA?7N) X=X_"^"_ICDA
; Case 4: Active, but later Inactivated 0^IEN^Effective Date
; Has an Activation Date
; Has an Inactivation Date
I $L(ICDA),$L(ICDI),ICDI>ICDA,ICDI<ICDD D Q X
. S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI)
. S ICDIEN=$O(@(ICDR_",0)"))
. S X=$S(+ICDIEN=0:"0^-1",1:"0^"_ICDIEN)
. S:X'["-1"&(ICDI?7N) X=X_"^"_ICDI
; Case 5: Active, and not later Inactivated 1^IEN^Effective Date
; Has an Activation Date
; Has an Inactivation Date
; Has a Newer Activation Date
I $L(ICDA),$L(ICDI),ICDI'>ICDA D Q X
. S ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI),ICDIEN=$O(@(ICDR_",1)"))
. S X=$S(+$O(@(ICDR_",0)"))=0:"0^-1",1:"1^"_ICDIEN)
. S:X'["-1"&(ICDA?7N) X=X_"^"_ICDA
; Case 6: Fails Time Test 0^-1
Q ("0^"_$S(+($G(ICDIEN))>0:+($G(ICDIEN)),1:"-1"))
;
ACTROOT(ICDG,ICDC,ICDS,ICDD) ; Return "ACT" root
Q (ICDG_"""ACT"","""_ICDC_" "","_ICDS_","_ICDD)
;
SEL(FILE,IEN) ; Entry is Selectable
;
; Input:
;
; FILE File number 80 or 80.1 (required)
; IEN Internal Entry Number (required)
;
; Output:
;
; $$SEL Boolean value
;
; 1 Selectable
; 0 Not Selectable
;
; -1 on error
;
N ICDF,ICDI,ICDR,ICDS
S ICDF=$G(FILE) Q:"^80^80.1^"'[("^"_$G(ICDF)_"^") -1
S ICDR=$$ROOT^ICDEX(ICDF) Q:'$L(ICDR) -1
S ICDI=+($G(IEN)) Q:ICDI'>0 -1
Q:'$D(@(ICDR_ICDI_",0)")) -1
S ICDS=+($$GET1^DIQ(ICDF,(+ICDI_","),1.8))
Q $S(ICDS>0:0,1:1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDEXA 6900 printed Dec 13, 2024@01:50:29 Page 2
ICDEXA ;SLC/KER - ICD Extractor - APIs/Utilities ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$GET1^DIQ ICR 2056
+8 ; $$DT^XLFDT ICR 10103
+9 ;
DTBR(CDT,STD,SYS) ; Date Business Rules
+1 ;
+2 ; Input:
+3 ;
+4 ; CDT Code Date to check (FileMan format, default=Today)
+5 ; STD Standard
+6 ;
+7 ; 0 = ICD (Default)
+8 ; 1 = CPT/HCPCS
+9 ; 2 = DRG
+10 ;
+11 ; SYS Coding System
+12 ;
+13 ; 1 = ICD-9-CM
+14 ; 2 = ICD-9-PCS
+15 ; 30 = ICD-10-CM
+16 ; 31 = ICD-10-PCS
+17 ;
+18 ; Output:
+19 ;
+20 ; If CDT < ICD-9 Date and STD=0, use ICD-9 Date
+21 ; If CDT < ICD-10 Date and STD=0 and SYS=30, use ICD-10 Date
+22 ; If CDT < ICD-10 Date and STD=0 and SYS=31, use ICD-10 Date
+23 ; If CDT < 2890101 and STD=1, use 2890101
+24 ; If CDT < 2821001 and STD=2, use 2821001
+25 ; If CDT is year only, use first of the year
+26 ; If CDT is year and month only, use first of the month
+27 ;
+28 SET CDT=$GET(CDT)
+29 ; Nothing Passed, use TODAY
+30 if '$GET(CDT)
QUIT $$DT^XLFDT
+31 ; Invalid Date Format, use TODAY
+32 if $LENGTH($PIECE(CDT,"."))'=7
QUIT $$DT^XLFDT
+33 ; Business rule date
NEW BRDAT
+34 NEW ICD9,ICD10,ICDDS
+35 SET ICD9=$$IMP^ICDEX(1)
SET ICD10=$$IMP^ICDEX(30)
+36 SET ICDDS=ICD9_"^2890101^2821001"
+37 SET STD=+$GET(STD)
if STD>2!(STD<0)
SET STD=0
SET SYS=$GET(SYS)
+38 SET BRDAT=+$PIECE(ICDDS,"^",STD+1)
+39 if +($GET(STD))'>0&("^30^31^"[("^"_SYS_"^"))
SET BRDAT=ICD10
+40 IF CDT#10000=0
SET CDT=CDT+101
+41 if CDT#100=0
SET CDT=CDT+1
+42 QUIT $SELECT(CDT<BRDAT:BRDAT,1:CDT)
+43 ;
IMP(SYS,CDT) ; Coding System Implementation Date
+1 ;
+2 ; Input:
+3 ;
+4 ; SYS Coding System
+5 ;
+6 ; 1 = ICD-9-CM
+7 ; 2 = ICD-9-PCS
+8 ; 30 = ICD-10-CM
+9 ; 31 = ICD-10-PCS
+10 ;
+11 ; Output:
+12 ;
+13 ; $$IMP Date the Coding System was Implemented/Activated
+14 ;
+15 NEW ICDD,ICDS,ICDN
+16 SET ICDD=$SELECT($GET(CDT)'?7N:$$DT^XLFDT,1:$GET(CDT))
+17 SET ICDS=$$SYS^ICDEX($GET(SYS),ICDD,"I")
if +ICDS'>0
QUIT "-1^Coding system Unknown"
+18 SET ICDN=$PIECE($GET(^ICDS(+ICDS,0)),"^",4)
if ICDN'?7N
QUIT "-1^Implementation Date not found"
+19 QUIT ICDN
+20 ;
MSG(CDT,STD,SYS) ; Inform of code text inaccuracy
+1 ;
+2 ; Input:
+3 ;
+4 ; CDT Code Date to check (FileMan format, Default = today)
+5 ; STD Code System
+6 ;
+7 ; 0 ICD (default)
+8 ; 1 CPT/HCPCS
+9 ; 2 DRG
+10 ; 3 LEX
+11 ;
+12 ; SYS Coding System
+13 ;
+14 ; 1 = ICD-9-CM
+15 ; 2 = ICD-9-PCS
+16 ; 30 = ICD-10-CM
+17 ; 31 = ICD-10-PCS
+18 ;
+19 ; Output:
+20 ;
+21 ; User Alert Message
+22 ;
+23 SET STD=+$GET(STD)
if STD>3!(STD<0)
SET STD=0
+24 SET CDT=$SELECT($GET(CDT)="":$$DT^XLFDT,1:$$DTBR(CDT,STD,$GET(SYS)))
+25 NEW MSGTXT,MSGDAT
SET MSGDAT=3021001
SET MSGTXT="CODE TEXT MAY BE INACCURATE"
+26 IF STD<3
QUIT $SELECT(CDT<MSGDAT:MSGTXT,1:"")
+27 IF STD=3
IF CDT'<3031001
QUIT ""
+28 QUIT MSGTXT
+29 ;
STATCHK(CODE,CDT,SYS) ; Check Status of ICD Code
+1 ;
+2 ; Input:
+3 ;
+4 ; CODE ICD Code REQUIRED
+5 ; CDT Date to screen against (default = TODAY)
+6 ; SYS Numeric Coding System (optional, however, if
+7 ; specified it must be correct)
+8 ;
+9 ; Output:
+10 ;
+11 ; 3-Piece String containing the code's status
+12 ; and the IEN if the code exists, else -1.
+13 ; The following are possible outputs:
+14 ;
+15 ; 1^IEN^Effective Date Active Code
+16 ; 0^IEN^Effective Date Inactive Code
+17 ; 0^IEN^Null Future Activation (pending)
+18 ; 0^-1^Error Message Code not Found or Error
+19 ;
+20 ; This API requires the ACT Cross-Reference
+21 ; ^ICD9("ACT",<code>,<status>,<date>,<ien>)
+22 ; ^ICD0("ACT",<code>,<status>,<date>,<ien>)
+23 ;
+24 NEW ICDC,ICDD,ICDIEN,ICDI,ICDA,ICDG,ICDR,ICDS,ICDY,ICDF,ICDEF,ICDBR,ICDTD,X
+25 SET ICDS=""
SET ICDC=$GET(CODE)
if '$LENGTH(ICDC)
QUIT "0^-1^No code specified"
+26 if $LENGTH($GET(SYS))
SET ICDS=$$SYS^ICDEX($GET(SYS),$GET(CDT))
+27 if '$LENGTH($GET(SYS))&($LENGTH(ICDC))
SET ICDS=$$SYS^ICDEX(ICDC)
+28 if '$LENGTH($GET(SYS))&(+ICDS'>0)
QUIT "0^-1^No coding system specified"
+29 if $LENGTH($GET(SYS))&(+ICDS'>0)
QUIT "0^-1^Invalid coding system specified"
+30 ; Case 1: Not Valid 0^-1
+31 ; Fails Pattern Match for Code
+32 SET ICDF=$$FILE^ICDEX(ICDS)
if ICDF'>0
SET ICDF=$$CODEFI^ICDEX(CODE)
+33 if +ICDF'>0
SET ICDF=""
SET CODE=$$CODEN^ICDEX(CODE,ICDF)
+34 if +ICDF>0&(+CODE>0)
SET ICDC=$$CODEC^ICDEX(+ICDF,+CODE)
+35 SET ICDG=$PIECE(CODE,"~",2)
SET ICDIEN=+CODE
+36 if ICDIEN<1
QUIT "0^-1^Code not found"
+37 SET ICDY=$PIECE($GET(@(ICDG_+ICDIEN_",1)")),"^",1)
+38 if +ICDS>0&(ICDY>0)&(ICDS'=ICDY)
QUIT "0^-1^Code not valid for Coding System"
+39 ; Case 2: Never Active 0^IEN
+40 ; No Active/Inactive Date
+41 SET ICDD=$SELECT($GET(CDT)="":$$DT^XLFDT,1:$$DTBR($GET(CDT),,+ICDS))
SET ICDD=ICDD+.001
+42 SET ICDR=$$ACTROOT(ICDG,ICDC,1,ICDD)
SET ICDA=$ORDER(@(ICDR_")"),-1)
+43 IF '$LENGTH(ICDA)
Begin DoDot:1
+44 SET ICDA=$ORDER(@(ICDR_")"))
SET X="0^-1"
if '$LENGTH(ICDA)
QUIT
+45 SET ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA)
+46 SET ICDIEN=$ORDER(@(ICDR_",0)"))
if +ICDIEN<1
SET ICDIEN=-1
+47 SET X="0^"_ICDIEN_"^"
End DoDot:1
QUIT X
+48 ; Case 3: Active, Never Inactive 1^IEN^Effective Date
+49 ; Has an Activation Date
+50 ; No Inactivation Date
+51 SET ICDR=$$ACTROOT(ICDG,ICDC,0,ICDD)
SET ICDI=$ORDER(@(ICDR_")"),-1)
+52 IF $LENGTH(ICDA)
IF '$LENGTH(ICDI)
Begin DoDot:1
+53 SET ICDR=$$ACTROOT(ICDG,ICDC,1,ICDA)
SET ICDIEN=$ORDER(@(ICDR_",0)"))
+54 SET X=$SELECT(+ICDIEN=0:"0^-1",1:"1^"_ICDIEN)
+55 if X'["-1"&(ICDA?7N)
SET X=X_"^"_ICDA
End DoDot:1
QUIT X
+56 ; Case 4: Active, but later Inactivated 0^IEN^Effective Date
+57 ; Has an Activation Date
+58 ; Has an Inactivation Date
+59 IF $LENGTH(ICDA)
IF $LENGTH(ICDI)
IF ICDI>ICDA
IF ICDI<ICDD
Begin DoDot:1
+60 SET ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI)
+61 SET ICDIEN=$ORDER(@(ICDR_",0)"))
+62 SET X=$SELECT(+ICDIEN=0:"0^-1",1:"0^"_ICDIEN)
+63 if X'["-1"&(ICDI?7N)
SET X=X_"^"_ICDI
End DoDot:1
QUIT X
+64 ; Case 5: Active, and not later Inactivated 1^IEN^Effective Date
+65 ; Has an Activation Date
+66 ; Has an Inactivation Date
+67 ; Has a Newer Activation Date
+68 IF $LENGTH(ICDA)
IF $LENGTH(ICDI)
IF ICDI'>ICDA
Begin DoDot:1
+69 SET ICDR=$$ACTROOT(ICDG,ICDC,0,ICDI)
SET ICDIEN=$ORDER(@(ICDR_",1)"))
+70 SET X=$SELECT(+$ORDER(@(ICDR_",0)"))=0:"0^-1",1:"1^"_ICDIEN)
+71 if X'["-1"&(ICDA?7N)
SET X=X_"^"_ICDA
End DoDot:1
QUIT X
+72 ; Case 6: Fails Time Test 0^-1
+73 QUIT ("0^"_$SELECT(+($GET(ICDIEN))>0:+($GET(ICDIEN)),1:"-1"))
+74 ;
ACTROOT(ICDG,ICDC,ICDS,ICDD) ; Return "ACT" root
+1 QUIT (ICDG_"""ACT"","""_ICDC_" "","_ICDS_","_ICDD)
+2 ;
SEL(FILE,IEN) ; Entry is Selectable
+1 ;
+2 ; Input:
+3 ;
+4 ; FILE File number 80 or 80.1 (required)
+5 ; IEN Internal Entry Number (required)
+6 ;
+7 ; Output:
+8 ;
+9 ; $$SEL Boolean value
+10 ;
+11 ; 1 Selectable
+12 ; 0 Not Selectable
+13 ;
+14 ; -1 on error
+15 ;
+16 NEW ICDF,ICDI,ICDR,ICDS
+17 SET ICDF=$GET(FILE)
if "^80^80.1^"'[("^"_$GET(ICDF)_"^")
QUIT -1
+18 SET ICDR=$$ROOT^ICDEX(ICDF)
if '$LENGTH(ICDR)
QUIT -1
+19 SET ICDI=+($GET(IEN))
if ICDI'>0
QUIT -1
+20 if '$DATA(@(ICDR_ICDI_",0)"))
QUIT -1
+21 SET ICDS=+($$GET1^DIQ(ICDF,(+ICDI_","),1.8))
+22 QUIT $SELECT(ICDS>0:0,1:1)
