ICDEXD2 ;SLC/KER - ICD Extractor - DRG APIs (cont) ;12/19/2014
;;18.0;DRG Grouper;**57,67,82**;Oct 20, 2000;Build 21
;
; Global Variables
; ^ICDS( N/A
;
; External References
; $$DT^XLFDT ICR 10103
; $$FMADD^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; ^%DT ICR 10003
; ^DIR ICR 10026
;
Q
MD(FILE,IEN,CDT,ARY,FLAG) ; MDC DRGs
;
; Input
;
; FILE File Number/Identifier
; IEN Internal entry in file
; CDT Code Set Versioning Date
; .ARY Array name passed by reference
; FLAG Flag I=Internal (default)
; E=External
;
; Output
;
; ICD Procedures file 80.1 (multiple MDC)
;
; ARY(<fiscal year>,<MDC>)=DRG^;FY;STA
; ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA
;
; If Flag contains "E"
; ARY(<fiscal year>,"E",<MDC>)=MDC Name
; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
; ARY(<fiscal year>,"E",<MDC>)=MDC Name
; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
; ARY(<fiscal year>,"E","FY")=External FY
;
; ICD Diagnosis file 80 (single MDC)
;
; ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA
;
; If Flag contains "E"
; ARY(<fiscal year>,"E",<MDC>)=MDC Name
; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
; ARY(<fiscal year>,"E","FY")=External FY
;
; NOTE: If no Fiscal Year found for the input
; date then the first (earliest) Fiscal Year is
; used.
;
N DRG,FY,FYIEN,MDC,MDCIEN,MY,MYIEN,ROOT,STA,STR S FLAG=$G(FLAG) S:'$L(FLAG) FLAG="I"
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"
K ARY I FILE=80.1 D
. S STA=1,FY=$O(^ICD0(IEN,2,"B",(CDT+.001)),-1)
. S:FY'?7N STA=0,FY=$O(^ICD0(IEN,2,"B","")) Q:FY'?7N
. S FYIEN=$O(^ICD0(IEN,2,"B",+$G(FY),0)) Q:+FYIEN'>0
. S MDC=0 F S MDC=$O(^ICD0(IEN,2,FYIEN,1,"B",MDC)) Q:'$L(MDC) D
. . S MDCIEN=0 F S MDCIEN=$O(^ICD0(IEN,2,FYIEN,1,"B",MDC,MDCIEN)) Q:+MDCIEN'>0 D
. . . S STR="",DRG=""
. . . F S DRG=$O(^ICD0(IEN,2,FYIEN,1,MDCIEN,1,"B",DRG)) Q:'$L(DRG) S STR=STR_DRG_"^"
. . S ARY(FY,MDC)=STR_";"_FY_";"_STA
. . I FLAG["E" D
. . . N ED,EMDC,DRGI,IDRG,DRGOUT
. . . S ED=$$FMTE^XLFDT(FY,"5DZ"),EMDC=$P($G(^ICM(+MDC,0)),"^",1)
. . . S ARY(FY,"E","FY")=ED,ARY(FY,"E",MDC)=EMDC
. . . F DRGI=1:1 Q:'$L($P($G(STR),"^",DRGI)) D
. . . . N IDRG,DRGOUT S IDRG=$P($G(STR),"^",DRGI) Q:+IDRG'>0
. . . . K DRGOUT D DRGD^ICDGTDRG(IDRG,"DRGOUT",,$G(CDT))
. . . . S:$L($G(DRGOUT(1)))&(+DRGI>0) ARY(FY,"E",MDC,IDRG)=$G(DRGOUT(1))
I FILE=80 D
. S STA=1,FY=$O(^ICD9(IEN,3,"B",(CDT+.001)),-1)
. S:FY'?7N STA=0,FY=$O(^ICD9(IEN,3,"B","")) Q:FY'?7N
. S MY=$O(^ICD9(IEN,4,"B",(FY+.001)))
. S:MY'?7N MY=$O(^ICD9(IEN,4,"B",""))
. S MYIEN=$O(^ICD9(IEN,4,"B",+$G(MY),0))
. S MDC=$P($G(^ICD9(IEN,4,+MYIEN,0)),"^",2)
. S FYIEN=$O(^ICD9(IEN,3,"B",+$G(FY),0)) Q:+FYIEN'>0
. S STR="",DRG=""
. F S DRG=$O(^ICD9(IEN,3,FYIEN,1,"B",DRG)) Q:'$L(DRG) S STR=STR_DRG_"^"
. I +MDC'>0 S MDC=$$DRGMDC^ICDEXD(+STR)
. S ARY(FY,MDC)=STR_";"_FY_";"_STA
. I FLAG["E" D
. . N ED,EMDC,DRGI,IDRG,DRGOUT
. . S ED=$$FMTE^XLFDT(FY,"5DZ"),EMDC=$P($G(^ICM(+MDC,0)),"^",1)
. . S ARY(FY,"E","FY")=ED,ARY(FY,"E",MDC)=EMDC
. . F DRGI=1:1 Q:'$L($P($G(STR),"^",DRGI)) D
. . . N IDRG,DRGOUT S IDRG=$P($G(STR),"^",DRGI) Q:+IDRG'>0
. . . K DRGOUT D DRGD^ICDGTDRG(IDRG,"DRGOUT",,$G(CDT))
. . . S:$L($G(DRGOUT(1)))&(+DRGI>0) ARY(FY,"E",MDC,IDRG)=$G(DRGOUT(1))
Q
VMDCDX(IEN,CDT) ; Get versioned MDC for Diagnosis Code
;
; Input
;
; IEN Internal Entry Number file 80
; CDT Code Set Versioning Date
;
; Output
;
; $$VMDCDX Versioned MDC
;
N ICDI,ICDD,ICDS,ICDM,ICDY S ICDI=+($G(IEN)) Q:'$D(^ICD9(ICDI,4,"B")) ""
S ICDS=$P($G(^ICD9(+ICDI,1)),"^",1),ICDD=$$DTBR^ICDEX($G(CDT),0,ICDS)
S (ICDM,ICDY)="",ICDY=$O(^ICD9(+ICDI,4,"B",(ICDD+.0001)),-1)
S ICDM=$O(^ICD9(ICDI,4,"B",+ICDY,ICDM))
Q $P($G(^ICD9(ICDI,4,+ICDM,0)),U,2)
VMDCOP(IEN,MDC,CDT) ; Get versioned MDC for Op/Pro ICD code from previous years
;
; Input
;
; IEN Internal Entry Number file 80.1
; MDC Major Diagnostic Category
; CDT Code Set Versioning Date
;
; Output
;
; $$VMDCOP 4 piece "^" delimited string
;
; 1 Fiscal Year Fileman format
; 2 MDC Pointer to file 80.3
; 3 Fiscal Year pointer to sub-file 80.171
; (formerly known as DADRGFY)
; 4 MDC pointer to sub-file 80.1711
; (formerly known as DAMDC)
;
N ICDI,ICDC,ICDD,ICDO,ICDY,ICDM,ICDS S ICDI=+($G(IEN)) Q:'$D(^ICD0(ICDI,2,"B")) ""
S ICDC=$G(MDC) Q:'$L(MDC) "" S ICDS=$P($G(^ICD0(+ICDI,1)),"^",1)
S ICDD=$$DTBR^ICDEX($G(CDT),0,ICDS) S (ICDM,ICDY)=""
S ICDD=ICDD+.0001 F S ICDD=$O(^ICD0(ICDI,2,"B",ICDD),-1) Q:'ICDD!(ICDM>0) D
. S ICDY=$O(^ICD0(ICDI,2,"B",+$G(ICDD),ICDY)),ICDO=ICDD
. S ICDM=$O(^ICD0(ICDI,2,+ICDY,1,"B",ICDC,ICDM))
Q:'$L($G(ICDO)) ""
Q (ICDO_"^"_ICDC_"^"_ICDY_"^"_ICDM)
;
MDCG(IEN,CDT,ARY) ; Set up ICDMDC() array
;
; Input
;
; IEN ICD Diagnosis (IEN)
; CDT Code Set Versioning Date
; .ARY Array name passed by reference
;
; Output
;
; ARY Array listing MDCs for all DRGs
;
; ARY=MDC
; ARY(MDC)=""
;
N I,ICDC,ICDO,ICDTMP,ICDS,ICDD,DRGS S IEN=$G(IEN) Q:+IEN'>0 S ICDS=$P($G(^ICD9(+IEN,1)),"^",1)
S ICDD=$$DTBR^ICDEX($G(CDT),0,ICDS) Q:'$L(IEN) S ICDO=$G(ARY) K ARY S:$L(ICDO) ARY=ICDO
S ICDTMP=$$GETDRG^ICDEX(80,IEN,ICDD) Q:'$P(ICDTMP,";",3) S DRGS=$P(ICDTMP,";")
F I=1:1 Q:'$L($P(DRGS,"^",I)) Q:'$P(DRGS,"^",I) D
. N DRG,MDC S DRG=$P(DRGS,"^",I) Q:DRG="" S MDC=$P($$DRG^ICDGTDRG(DRG,ICDD),"^",5) Q:MDC="" S ARY(MDC)=""
Q
MDCT(IEN,CDT,ARY,FMT) ; For Multiple MDC DX Codes
;
; Input:
;
; IEN Internal Entry Number for file 80.1
; CDT Code Set Versioning Date
; .ARY Array of MDCs passed by reference (required)
; FMT Output Format (optional)
;
; 0 Boolean value only (default)
; 1 2 piece "^" delimited string
; 1 Boolean value
; 2 String of matching MDCs delimited by ";"
; Output:
;
; $$MDCT Boolean value
;
; 0 The ICD Procedure code identified by IEN
; does not include any of the MDCs passed
; in .ARY(MDC) on the date specified (CDT)
;
; 1 The ICD Procedure code identified by IEN
; includes one or more of the MDCs passed
; in .ARY(MDC) on the date specified (CDT)
;
N FY,FYI,I,MD,MDC,OK,STR
S IEN=+($G(IEN)) Q:'$D(^ICD0(+IEN,0)) 0
Q:$P($G(^ICD0(IEN,1)),"^",7)>0 0
S CDT=$G(CDT) S:CDT'?7N CDT=$$DT^XLFDT
S FMT=+($G(FMT)),(STR,MD)="",OK=0 F I=1:1 S MD=$O(ARY(MD)) Q:MD="" D
. N FY,FYI,MDC S FY=$O(^ICD0(IEN,2,"B",(+CDT+.001)),-1) Q:FY'?7N
. S FYI=$O(^ICD0(IEN,2,"B",+FY,0))
. S MDC=$D(^ICD0(IEN,2,+FYI,1,"B",MD))
. S:MDC>0 STR=STR_";"_MD
. S:MDC>0 OK=1
F Q:$E(STR,1)'=";" S STR=$E(STR,2,$L(STR))
S OK=+OK S:FMT>0&($L(STR)) OK=OK_"^"_STR
Q OK
MDCD(IEN,MDC,CDT) ; Check for default MDC
;
; Input:
;
; IEN Internal Entry Number for file 80.1
; MDC Major Diagnostic Category
; CDT Code Set Versioning Date (optional)
; If not passed, the first FY is used
;
; Output:
;
; $$MDCD Boolean value
;
; 0 MDC Does not exist
; 1 MDC Exist
;
N ICDY,ICDM,ICDD,ICDF S ICDY=+($G(IEN)) Q:'$D(^ICD0(+IEN,2,1,1)) 0 S ICDM=$G(MDC) Q:'$L(ICDM) 0
S ICDD=$G(CDT),ICDF=$O(^ICD0(+ICDY,2,"B",(ICDD+.001)),-1) S:ICDF'?7N ICDF=$O(^ICD0(+ICDY,2,"B",""))
S ICDF=$O(^ICD0(+ICDY,2,"B",+ICDF,0)) Q:ICDF'>0 $S($D(^ICD0(ICDY,2,1,1,"B",ICDM))>0:1,1:0)
Q:ICDF>0 $S($D(^ICD0(ICDY,2,+ICDF,1,"B",ICDM))>0:1,1:0)
MDCN(IEN) ; Major Diagnostic Category Name
;
; Input:
;
; IEN Internal Entry Number for file 80.3
;
; Output:
;
; $$MDCN Major Diagnostic Category Name
;
; Replaces ICR 1586
;
Q $P($G(^ICM(+($G(IEN)),0)),"^",1)
MOR(IEN) ; Major O.R. Procedure
;
; Input:
;
; IEN Internal Entry Number for file 80.1
;
; Output:
;
; $$MOR Major O.R. Procedure
;
Q $G(^ICD0(+($G(IEN)),"M"))
;
ISVALID(FILE,IEN,CDT) ; Is an ICD code Valid
;
; Input:
;
; FILE File or global root
; IEN Internal Entry Number
; CDT Effective date to use (default TODAY)
;
; Output:
;
; $$ISVALID This is a Boolean value
;
; 1 if the code is valid
; 0 if the code is not valid
;
N ICDO,ICDD,ICDF,ICDT,ICDX,ICDI,ICDR S ICDO=0
S FILE=$S(FILE="9":80,FILE="0":80.1,1:FILE)
S ICDD=$P($G(CDT),".",1) S:ICDD'?7N ICDD=$$DT^XLFDT
S ICDF=$$FILE^ICDEX(FILE) Q:"^80^80.1^"'[("^"_FILE_"^") ICDO
S ICDR=$$ROOT^ICDEX(FILE),ICDI=+($G(IEN)) Q:+ICDI'>0 ICDO
Q:'$D(@(ICDR_+ICDI_",0)")) ICDO S ICDX=$$EXC^ICDEX(ICDF,ICDI) Q:ICDX>0 ICDO
S ICDT=$$LS^ICDEX(ICDF,ICDI,ICDD) I ICDT>0 S ICDO=1
Q ICDO
REF(IEN,CDT) ; Return Reference Table
;
; Input:
;
; IEN Internal Entry Number
; CDT Effective date to use (default TODAY)
;
; Output:
;
; $$REF Table reference associated DRG entry
; or null if not found
;
N ICDI,ICDD,ICDR,ICDFY,ICDR
S ICDI=+($G(IEN)) Q:+IEN'>0!('$D(^ICD(IEN,2))) ""
S (ICDFY,ICDR)="",ICDD=$P($G(CDT),".",1)
S:ICDD'?7N ICDD=$$DT^XLFDT
S ICDFY=$O(^ICD(ICDI,2,"B",(+ICDD+.01)),-1)
S ICDR=$O(^ICD(ICDI,2,"B",+ICDFY,ICDR))
S ICDR=$P($G(^ICD(ICDI,2,+ICDR,0)),U,3)
Q ICDR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDEXD2 10093 printed Oct 16, 2024@17:51:18 Page 2
ICDEXD2 ;SLC/KER - ICD Extractor - DRG APIs (cont) ;12/19/2014
+1 ;;18.0;DRG Grouper;**57,67,82**;Oct 20, 2000;Build 21
+2 ;
+3 ; Global Variables
+4 ; ^ICDS( N/A
+5 ;
+6 ; External References
+7 ; $$DT^XLFDT ICR 10103
+8 ; $$FMADD^XLFDT ICR 10103
+9 ; $$FMTE^XLFDT ICR 10103
+10 ; ^%DT ICR 10003
+11 ; ^DIR ICR 10026
+12 ;
+13 QUIT
MD(FILE,IEN,CDT,ARY,FLAG) ; MDC DRGs
+1 ;
+2 ; Input
+3 ;
+4 ; FILE File Number/Identifier
+5 ; IEN Internal entry in file
+6 ; CDT Code Set Versioning Date
+7 ; .ARY Array name passed by reference
+8 ; FLAG Flag I=Internal (default)
+9 ; E=External
+10 ;
+11 ; Output
+12 ;
+13 ; ICD Procedures file 80.1 (multiple MDC)
+14 ;
+15 ; ARY(<fiscal year>,<MDC>)=DRG^;FY;STA
+16 ; ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA
+17 ;
+18 ; If Flag contains "E"
+19 ; ARY(<fiscal year>,"E",<MDC>)=MDC Name
+20 ; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
+21 ; ARY(<fiscal year>,"E",<MDC>)=MDC Name
+22 ; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
+23 ; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
+24 ; ARY(<fiscal year>,"E","FY")=External FY
+25 ;
+26 ; ICD Diagnosis file 80 (single MDC)
+27 ;
+28 ; ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA
+29 ;
+30 ; If Flag contains "E"
+31 ; ARY(<fiscal year>,"E",<MDC>)=MDC Name
+32 ; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
+33 ; ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name
+34 ; ARY(<fiscal year>,"E","FY")=External FY
+35 ;
+36 ; NOTE: If no Fiscal Year found for the input
+37 ; date then the first (earliest) Fiscal Year is
+38 ; used.
+39 ;
+40 NEW DRG,FY,FYIEN,MDC,MDCIEN,MY,MYIEN,ROOT,STA,STR
SET FLAG=$GET(FLAG)
if '$LENGTH(FLAG)
SET FLAG="I"
+41 SET FILE=$GET(FILE)
if FILE=9!(FILE["ICD9")
SET FILE=80
if FILE=0!(FILE["ICD0")
SET FILE=80.1
+42 if "^80^80.1^"'[("^"_FILE_"^")
QUIT "-1;Invalid file selected"
+43 SET IEN=+($GET(IEN))
SET CDT=$PIECE($GET(CDT),".",1)
+44 SET ROOT=$$ROOT^ICDEX(FILE)
if CDT'?7N
SET CDT=$$DT^XLFDT
+45 if '$LENGTH(ROOT)
QUIT "-1;Invalid file selected"
+46 KILL ARY
IF FILE=80.1
Begin DoDot:1
+47 SET STA=1
SET FY=$ORDER(^ICD0(IEN,2,"B",(CDT+.001)),-1)
+48 if FY'?7N
SET STA=0
SET FY=$ORDER(^ICD0(IEN,2,"B",""))
if FY'?7N
QUIT
+49 SET FYIEN=$ORDER(^ICD0(IEN,2,"B",+$GET(FY),0))
if +FYIEN'>0
QUIT
+50 SET MDC=0
FOR
SET MDC=$ORDER(^ICD0(IEN,2,FYIEN,1,"B",MDC))
if '$LENGTH(MDC)
QUIT
Begin DoDot:2
+51 SET MDCIEN=0
FOR
SET MDCIEN=$ORDER(^ICD0(IEN,2,FYIEN,1,"B",MDC,MDCIEN))
if +MDCIEN'>0
QUIT
Begin DoDot:3
+52 SET STR=""
SET DRG=""
+53 FOR
SET DRG=$ORDER(^ICD0(IEN,2,FYIEN,1,MDCIEN,1,"B",DRG))
if '$LENGTH(DRG)
QUIT
SET STR=STR_DRG_"^"
End DoDot:3
+54 SET ARY(FY,MDC)=STR_";"_FY_";"_STA
+55 IF FLAG["E"
Begin DoDot:3
+56 NEW ED,EMDC,DRGI,IDRG,DRGOUT
+57 SET ED=$$FMTE^XLFDT(FY,"5DZ")
SET EMDC=$PIECE($GET(^ICM(+MDC,0)),"^",1)
+58 SET ARY(FY,"E","FY")=ED
SET ARY(FY,"E",MDC)=EMDC
+59 FOR DRGI=1:1
if '$LENGTH($PIECE($GET(STR),"^",DRGI))
QUIT
Begin DoDot:4
+60 NEW IDRG,DRGOUT
SET IDRG=$PIECE($GET(STR),"^",DRGI)
if +IDRG'>0
QUIT
+61 KILL DRGOUT
DO DRGD^ICDGTDRG(IDRG,"DRGOUT",,$GET(CDT))
+62 if $LENGTH($GET(DRGOUT(1)))&(+DRGI>0)
SET ARY(FY,"E",MDC,IDRG)=$GET(DRGOUT(1))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+63 IF FILE=80
Begin DoDot:1
+64 SET STA=1
SET FY=$ORDER(^ICD9(IEN,3,"B",(CDT+.001)),-1)
+65 if FY'?7N
SET STA=0
SET FY=$ORDER(^ICD9(IEN,3,"B",""))
if FY'?7N
QUIT
+66 SET MY=$ORDER(^ICD9(IEN,4,"B",(FY+.001)))
+67 if MY'?7N
SET MY=$ORDER(^ICD9(IEN,4,"B",""))
+68 SET MYIEN=$ORDER(^ICD9(IEN,4,"B",+$GET(MY),0))
+69 SET MDC=$PIECE($GET(^ICD9(IEN,4,+MYIEN,0)),"^",2)
+70 SET FYIEN=$ORDER(^ICD9(IEN,3,"B",+$GET(FY),0))
if +FYIEN'>0
QUIT
+71 SET STR=""
SET DRG=""
+72 FOR
SET DRG=$ORDER(^ICD9(IEN,3,FYIEN,1,"B",DRG))
if '$LENGTH(DRG)
QUIT
SET STR=STR_DRG_"^"
+73 IF +MDC'>0
SET MDC=$$DRGMDC^ICDEXD(+STR)
+74 SET ARY(FY,MDC)=STR_";"_FY_";"_STA
+75 IF FLAG["E"
Begin DoDot:2
+76 NEW ED,EMDC,DRGI,IDRG,DRGOUT
+77 SET ED=$$FMTE^XLFDT(FY,"5DZ")
SET EMDC=$PIECE($GET(^ICM(+MDC,0)),"^",1)
+78 SET ARY(FY,"E","FY")=ED
SET ARY(FY,"E",MDC)=EMDC
+79 FOR DRGI=1:1
if '$LENGTH($PIECE($GET(STR),"^",DRGI))
QUIT
Begin DoDot:3
+80 NEW IDRG,DRGOUT
SET IDRG=$PIECE($GET(STR),"^",DRGI)
if +IDRG'>0
QUIT
+81 KILL DRGOUT
DO DRGD^ICDGTDRG(IDRG,"DRGOUT",,$GET(CDT))
+82 if $LENGTH($GET(DRGOUT(1)))&(+DRGI>0)
SET ARY(FY,"E",MDC,IDRG)=$GET(DRGOUT(1))
End DoDot:3
End DoDot:2
End DoDot:1
+83 QUIT
VMDCDX(IEN,CDT) ; Get versioned MDC for Diagnosis Code
+1 ;
+2 ; Input
+3 ;
+4 ; IEN Internal Entry Number file 80
+5 ; CDT Code Set Versioning Date
+6 ;
+7 ; Output
+8 ;
+9 ; $$VMDCDX Versioned MDC
+10 ;
+11 NEW ICDI,ICDD,ICDS,ICDM,ICDY
SET ICDI=+($GET(IEN))
if '$DATA(^ICD9(ICDI,4,"B"))
QUIT ""
+12 SET ICDS=$PIECE($GET(^ICD9(+ICDI,1)),"^",1)
SET ICDD=$$DTBR^ICDEX($GET(CDT),0,ICDS)
+13 SET (ICDM,ICDY)=""
SET ICDY=$ORDER(^ICD9(+ICDI,4,"B",(ICDD+.0001)),-1)
+14 SET ICDM=$ORDER(^ICD9(ICDI,4,"B",+ICDY,ICDM))
+15 QUIT $PIECE($GET(^ICD9(ICDI,4,+ICDM,0)),U,2)
VMDCOP(IEN,MDC,CDT) ; Get versioned MDC for Op/Pro ICD code from previous years
+1 ;
+2 ; Input
+3 ;
+4 ; IEN Internal Entry Number file 80.1
+5 ; MDC Major Diagnostic Category
+6 ; CDT Code Set Versioning Date
+7 ;
+8 ; Output
+9 ;
+10 ; $$VMDCOP 4 piece "^" delimited string
+11 ;
+12 ; 1 Fiscal Year Fileman format
+13 ; 2 MDC Pointer to file 80.3
+14 ; 3 Fiscal Year pointer to sub-file 80.171
+15 ; (formerly known as DADRGFY)
+16 ; 4 MDC pointer to sub-file 80.1711
+17 ; (formerly known as DAMDC)
+18 ;
+19 NEW ICDI,ICDC,ICDD,ICDO,ICDY,ICDM,ICDS
SET ICDI=+($GET(IEN))
if '$DATA(^ICD0(ICDI,2,"B"))
QUIT ""
+20 SET ICDC=$GET(MDC)
if '$LENGTH(MDC)
QUIT ""
SET ICDS=$PIECE($GET(^ICD0(+ICDI,1)),"^",1)
+21 SET ICDD=$$DTBR^ICDEX($GET(CDT),0,ICDS)
SET (ICDM,ICDY)=""
+22 SET ICDD=ICDD+.0001
FOR
SET ICDD=$ORDER(^ICD0(ICDI,2,"B",ICDD),-1)
if 'ICDD!(ICDM>0)
QUIT
Begin DoDot:1
+23 SET ICDY=$ORDER(^ICD0(ICDI,2,"B",+$GET(ICDD),ICDY))
SET ICDO=ICDD
+24 SET ICDM=$ORDER(^ICD0(ICDI,2,+ICDY,1,"B",ICDC,ICDM))
End DoDot:1
+25 if '$LENGTH($GET(ICDO))
QUIT ""
+26 QUIT (ICDO_"^"_ICDC_"^"_ICDY_"^"_ICDM)
+27 ;
MDCG(IEN,CDT,ARY) ; Set up ICDMDC() array
+1 ;
+2 ; Input
+3 ;
+4 ; IEN ICD Diagnosis (IEN)
+5 ; CDT Code Set Versioning Date
+6 ; .ARY Array name passed by reference
+7 ;
+8 ; Output
+9 ;
+10 ; ARY Array listing MDCs for all DRGs
+11 ;
+12 ; ARY=MDC
+13 ; ARY(MDC)=""
+14 ;
+15 NEW I,ICDC,ICDO,ICDTMP,ICDS,ICDD,DRGS
SET IEN=$GET(IEN)
if +IEN'>0
QUIT
SET ICDS=$PIECE($GET(^ICD9(+IEN,1)),"^",1)
+16 SET ICDD=$$DTBR^ICDEX($GET(CDT),0,ICDS)
if '$LENGTH(IEN)
QUIT
SET ICDO=$GET(ARY)
KILL ARY
if $LENGTH(ICDO)
SET ARY=ICDO
+17 SET ICDTMP=$$GETDRG^ICDEX(80,IEN,ICDD)
if '$PIECE(ICDTMP,";",3)
QUIT
SET DRGS=$PIECE(ICDTMP,";")
+18 FOR I=1:1
if '$LENGTH($PIECE(DRGS,"^",I))
QUIT
if '$PIECE(DRGS,"^",I)
QUIT
Begin DoDot:1
+19 NEW DRG,MDC
SET DRG=$PIECE(DRGS,"^",I)
if DRG=""
QUIT
SET MDC=$PIECE($$DRG^ICDGTDRG(DRG,ICDD),"^",5)
if MDC=""
QUIT
SET ARY(MDC)=""
End DoDot:1
+20 QUIT
MDCT(IEN,CDT,ARY,FMT) ; For Multiple MDC DX Codes
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number for file 80.1
+5 ; CDT Code Set Versioning Date
+6 ; .ARY Array of MDCs passed by reference (required)
+7 ; FMT Output Format (optional)
+8 ;
+9 ; 0 Boolean value only (default)
+10 ; 1 2 piece "^" delimited string
+11 ; 1 Boolean value
+12 ; 2 String of matching MDCs delimited by ";"
+13 ; Output:
+14 ;
+15 ; $$MDCT Boolean value
+16 ;
+17 ; 0 The ICD Procedure code identified by IEN
+18 ; does not include any of the MDCs passed
+19 ; in .ARY(MDC) on the date specified (CDT)
+20 ;
+21 ; 1 The ICD Procedure code identified by IEN
+22 ; includes one or more of the MDCs passed
+23 ; in .ARY(MDC) on the date specified (CDT)
+24 ;
+25 NEW FY,FYI,I,MD,MDC,OK,STR
+26 SET IEN=+($GET(IEN))
if '$DATA(^ICD0(+IEN,0))
QUIT 0
+27 if $PIECE($GET(^ICD0(IEN,1)),"^",7)>0
QUIT 0
+28 SET CDT=$GET(CDT)
if CDT'?7N
SET CDT=$$DT^XLFDT
+29 SET FMT=+($GET(FMT))
SET (STR,MD)=""
SET OK=0
FOR I=1:1
SET MD=$ORDER(ARY(MD))
if MD=""
QUIT
Begin DoDot:1
+30 NEW FY,FYI,MDC
SET FY=$ORDER(^ICD0(IEN,2,"B",(+CDT+.001)),-1)
if FY'?7N
QUIT
+31 SET FYI=$ORDER(^ICD0(IEN,2,"B",+FY,0))
+32 SET MDC=$DATA(^ICD0(IEN,2,+FYI,1,"B",MD))
+33 if MDC>0
SET STR=STR_";"_MD
+34 if MDC>0
SET OK=1
End DoDot:1
+35 FOR
if $EXTRACT(STR,1)'=";"
QUIT
SET STR=$EXTRACT(STR,2,$LENGTH(STR))
+36 SET OK=+OK
if FMT>0&($LENGTH(STR))
SET OK=OK_"^"_STR
+37 QUIT OK
MDCD(IEN,MDC,CDT) ; Check for default MDC
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number for file 80.1
+5 ; MDC Major Diagnostic Category
+6 ; CDT Code Set Versioning Date (optional)
+7 ; If not passed, the first FY is used
+8 ;
+9 ; Output:
+10 ;
+11 ; $$MDCD Boolean value
+12 ;
+13 ; 0 MDC Does not exist
+14 ; 1 MDC Exist
+15 ;
+16 NEW ICDY,ICDM,ICDD,ICDF
SET ICDY=+($GET(IEN))
if '$DATA(^ICD0(+IEN,2,1,1))
QUIT 0
SET ICDM=$GET(MDC)
if '$LENGTH(ICDM)
QUIT 0
+17 SET ICDD=$GET(CDT)
SET ICDF=$ORDER(^ICD0(+ICDY,2,"B",(ICDD+.001)),-1)
if ICDF'?7N
SET ICDF=$ORDER(^ICD0(+ICDY,2,"B",""))
+18 SET ICDF=$ORDER(^ICD0(+ICDY,2,"B",+ICDF,0))
if ICDF'>0
QUIT $SELECT($DATA(^ICD0(ICDY,2,1,1,"B",ICDM))>0:1,1:0)
+19 if ICDF>0
QUIT $SELECT($DATA(^ICD0(ICDY,2,+ICDF,1,"B",ICDM))>0:1,1:0)
MDCN(IEN) ; Major Diagnostic Category Name
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number for file 80.3
+5 ;
+6 ; Output:
+7 ;
+8 ; $$MDCN Major Diagnostic Category Name
+9 ;
+10 ; Replaces ICR 1586
+11 ;
+12 QUIT $PIECE($GET(^ICM(+($GET(IEN)),0)),"^",1)
MOR(IEN) ; Major O.R. Procedure
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number for file 80.1
+5 ;
+6 ; Output:
+7 ;
+8 ; $$MOR Major O.R. Procedure
+9 ;
+10 QUIT $GET(^ICD0(+($GET(IEN)),"M"))
+11 ;
ISVALID(FILE,IEN,CDT) ; Is an ICD code Valid
+1 ;
+2 ; Input:
+3 ;
+4 ; FILE File or global root
+5 ; IEN Internal Entry Number
+6 ; CDT Effective date to use (default TODAY)
+7 ;
+8 ; Output:
+9 ;
+10 ; $$ISVALID This is a Boolean value
+11 ;
+12 ; 1 if the code is valid
+13 ; 0 if the code is not valid
+14 ;
+15 NEW ICDO,ICDD,ICDF,ICDT,ICDX,ICDI,ICDR
SET ICDO=0
+16 SET FILE=$SELECT(FILE="9":80,FILE="0":80.1,1:FILE)
+17 SET ICDD=$PIECE($GET(CDT),".",1)
if ICDD'?7N
SET ICDD=$$DT^XLFDT
+18 SET ICDF=$$FILE^ICDEX(FILE)
if "^80^80.1^"'[("^"_FILE_"^")
QUIT ICDO
+19 SET ICDR=$$ROOT^ICDEX(FILE)
SET ICDI=+($GET(IEN))
if +ICDI'>0
QUIT ICDO
+20 if '$DATA(@(ICDR_+ICDI_",0)"))
QUIT ICDO
SET ICDX=$$EXC^ICDEX(ICDF,ICDI)
if ICDX>0
QUIT ICDO
+21 SET ICDT=$$LS^ICDEX(ICDF,ICDI,ICDD)
IF ICDT>0
SET ICDO=1
+22 QUIT ICDO
REF(IEN,CDT) ; Return Reference Table
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number
+5 ; CDT Effective date to use (default TODAY)
+6 ;
+7 ; Output:
+8 ;
+9 ; $$REF Table reference associated DRG entry
+10 ; or null if not found
+11 ;
+12 NEW ICDI,ICDD,ICDR,ICDFY,ICDR
+13 SET ICDI=+($GET(IEN))
if +IEN'>0!('$DATA(^ICD(IEN,2)))
QUIT ""
+14 SET (ICDFY,ICDR)=""
SET ICDD=$PIECE($GET(CDT),".",1)
+15 if ICDD'?7N
SET ICDD=$$DT^XLFDT
+16 SET ICDFY=$ORDER(^ICD(ICDI,2,"B",(+ICDD+.01)),-1)
+17 SET ICDR=$ORDER(^ICD(ICDI,2,"B",+ICDFY,ICDR))
+18 SET ICDR=$PIECE($GET(^ICD(ICDI,2,+ICDR,0)),U,3)
+19 QUIT ICDR
