| 1 | ICDGTDRG ;ALB/ADL/KER - COLLECTION OF DRG APIS ; 04/18/2004
|
|---|
| 2 | ;;18.0;DRG Grouper;**7,12,14,17**;Oct 20, 2000;Build 1
|
|---|
| 3 | ; Collection of API's for accessing new "DRG" level
|
|---|
| 4 | ; of files #80, #80.1, and #80.2. These new levels
|
|---|
| 5 | ; were added for the Code Set Versioning Project
|
|---|
| 6 | ;
|
|---|
| 7 | GETDRG(CODE,DGNDT,FILE) ; Get DRG or DRG string associated with a Code
|
|---|
| 8 | ; Input:
|
|---|
| 9 | ; CODE - IEN number
|
|---|
| 10 | ; DRGDT - Effective date of the Code
|
|---|
| 11 | ; FILE - File to check : 9 - ICD9 (file #80)
|
|---|
| 12 | ; 0 - ICD0 (file 80.1)
|
|---|
| 13 | ; Output:
|
|---|
| 14 | ; DRGS - DRG or string of DRG's (delimited
|
|---|
| 15 | ; by "^") or -1 if not defined
|
|---|
| 16 | ;
|
|---|
| 17 | ; Effective date or error message;
|
|---|
| 18 | ; status flag (1=Active;0=Inactive)
|
|---|
| 19 | ; Delimited by ";" because DRG's can be
|
|---|
| 20 | ; multiple and are already delimited by "^"
|
|---|
| 21 | ;
|
|---|
| 22 | N DRG0,D1,DCS,DCSINF,DRGS,DCSV,DAMDC,DRGFY,DRG,DRGS,DADRGFY,MDC
|
|---|
| 23 | S (DRG0,DRGFY,DRGS,DRG,MDC,DAMDC,DADRGFY,DRG0)=""
|
|---|
| 24 | I $G(CODE)="" S DRGS="-1;NO CODE SELECTED;0" G GETDRGQ
|
|---|
| 25 | I $G(FILE)="" S DRGS="-1;NO FILE INPUT;0" G GETDRGQ
|
|---|
| 26 | I $G(DGNDT)="" S DGNDT=DT
|
|---|
| 27 | I FILE'=9,FILE'=0 S DRGS="-1;INVALID FILE INPUT;0" G GETDRGQ
|
|---|
| 28 | S DGNDT=DGNDT+.001
|
|---|
| 29 | ; ICD Operations/Procedures
|
|---|
| 30 | I FILE=0 D
|
|---|
| 31 | . I CODE<1!'$D(^ICD0(CODE)) S DRGS="-1;NO SUCH ENTRY;0" Q
|
|---|
| 32 | . S DRGFY=$O(^ICD0(CODE,2,"B",+DGNDT),-1),DADRGFY=$O(^ICD0(CODE,2,"B",+$G(DRGFY),DADRGFY)),DAMDC=$O(^ICD0(CODE,2,+DADRGFY,1,"B",ICDMDC,DAMDC))
|
|---|
| 33 | . ;If no entry check previous FY
|
|---|
| 34 | . I DAMDC'>0 D GETPVMDC^ICDREF
|
|---|
| 35 | . F S DRG=$O(^ICD0(CODE,2,+DADRGFY,1,+DAMDC,1,"B",DRG)) Q:DRG="" S DRG0=DRG0_DRG_U
|
|---|
| 36 | . I DRG0="" S DRGS="-1;NO DRG LEVEL;0"
|
|---|
| 37 | . S DRGS=DRG0_";"_DRGFY
|
|---|
| 38 | ; ICD Diagnosis
|
|---|
| 39 | I FILE=9 D
|
|---|
| 40 | . I CODE<1!'$D(^ICD9(CODE)) S DRGS="-1;NO SUCH ENTRY;0" Q
|
|---|
| 41 | . S DRGFY=$O(^ICD9(CODE,3,"B",+DGNDT+.01),-1),DADRGFY=$O(^ICD9(CODE,3,"B",+$G(DRGFY),DADRGFY))
|
|---|
| 42 | . F S DRG=$O(^ICD9(CODE,3,+DADRGFY,1,"B",DRG)) Q:DRG="" S DRG0=DRG0_DRG_U
|
|---|
| 43 | . I DRG0="" S DRGS="-1;NO DRG LEVEL;0"
|
|---|
| 44 | . S DRGS=DRG0_";"_DRGFY
|
|---|
| 45 | ;
|
|---|
| 46 | GETDRGQ Q DRGS ; Exit API GETDRG
|
|---|
| 47 | ;
|
|---|
| 48 | DRG(CODE,EDT) ; Returns a string of information from the DRG file (#80.2)
|
|---|
| 49 | ; Input: CODE DRG code, internal or external format (Required)
|
|---|
| 50 | ; CDT Date to check status for, FileMan format (default = TODAY)
|
|---|
| 51 | ; If CDT < 10/1/1978, use 10/1/1978
|
|---|
| 52 | ; If CDT > DT, validate with In/Activation Dates
|
|---|
| 53 | ; If CDT is year only, use first of the year
|
|---|
| 54 | ; If CDT is year and month, use first of the month
|
|---|
| 55 | ;
|
|---|
| 56 | ; Output: Returns an 22 piece string delimited by the up-arrow (^), where the
|
|---|
| 57 | ; pieces are:
|
|---|
| 58 | ; 1 DRG name (field #.01)
|
|---|
| 59 | ; 2 Weight (field #2)
|
|---|
| 60 | ; 3 Low Trim (days) (field #3)
|
|---|
| 61 | ; 4 High Trim (days) (field #4)
|
|---|
| 62 | ; 5 MDC (field #5)
|
|---|
| 63 | ; 6 Surgery Flag (field #.06)
|
|---|
| 64 | ; 7 <null>
|
|---|
| 65 | ; 8 Avg Length of Stay (days) (field 10)
|
|---|
| 66 | ; 9 Local Low Trim Days (field #11)
|
|---|
| 67 | ; 10 Local High Trim Days (field #12)
|
|---|
| 68 | ; 11 <null>
|
|---|
| 69 | ; 12 Local Breakeven (field #13)
|
|---|
| 70 | ; 13 Activation Date (.01 field of the 66 multiple)
|
|---|
| 71 | ; 14 Status (.03 field of the 66 multiple)
|
|---|
| 72 | ; 15 Inactivation Date (.01 field of the 66 multiple)
|
|---|
| 73 | ; 16 Effective date (.01 field of the 66 multiple)
|
|---|
| 74 | ; 17 Internal Entry Number (IEN)
|
|---|
| 75 | ; 18 Effective date of CSV (.01 field of the 66 multiple)
|
|---|
| 76 | ; 19 Reference (field #900)
|
|---|
| 77 | ; 20 Weight (Non Affil) (field #7)
|
|---|
| 78 | ; 21 Weight (Int Affil) (field #7.5)
|
|---|
| 79 | ; 22 Message
|
|---|
| 80 | ;
|
|---|
| 81 | ; or
|
|---|
| 82 | ;
|
|---|
| 83 | ; -1^Error Description
|
|---|
| 84 | ;
|
|---|
| 85 | N D0,DCS,DFY,DFYINF,DCSINF,DMC1,D1,FYDT,FYMD,ICDFY
|
|---|
| 86 | I $G(CODE)="" S STR="-1^NO CODE SELECTED",$P(STR,"^",14)=0 G DRGQ
|
|---|
| 87 | I $G(EDT)="" S EDT=DT ; No date, use today
|
|---|
| 88 | S EDT=$$DTBR^ICDAPIU(EDT,2) ; Verify that date is not earlier that the earliest allowed date per the bus. rule
|
|---|
| 89 | S EDT=EDT+.001
|
|---|
| 90 | S CODE=$G(CODE),CODE=$S(CODE:+CODE,1:$$CODEN(CODE)) ; GET ien
|
|---|
| 91 | I CODE<1!'$D(^ICD(CODE)) S STR="-1^NO SUCH ENTRY",$P(STR,"^",14)=0 G DRGQ
|
|---|
| 92 | S D0=^ICD(CODE,0)
|
|---|
| 93 | S FYDT=$$DGY2K^DGPTOD0($$FY^DGPTOD0(EDT))+.001 ; get the correct FY in YYY0000 format for the effective date
|
|---|
| 94 | S DFY=$O(^ICD(CODE,"FY",FYDT),-1) S:DFY>0 DFYINF=^(DFY,0) I DFY'>0 D ;date stored in YYY0000 w/YYY = Fiscal Year
|
|---|
| 95 | . S DFYINF=U_$P(D0,U,2,4)_U_U_$P(D0,U,9)_U_$P(D0,U,12)_U_$P(D0,U,7)_U_$P(D0,U,8)_U_$P(D0,U,11)
|
|---|
| 96 | S DCS=$O(^ICD(CODE,66,"B",EDT),-1),D1=$S(DCS'="":$O(^ICD(CODE,66,"B",DCS,0)),1:0) S DCSINF=$S(D1>0:^ICD(CODE,66,D1,0),1:"")
|
|---|
| 97 | I DCSINF="" S DCSINF=U_U_"0"_U_U_$P(D0,U,5,6) ;if CSV level does not exist, default to info at .01 level with status = inactive
|
|---|
| 98 | ;Resolve reference table using "B" cross reference and fiscal year
|
|---|
| 99 | ;If ICDFY is not resolved set it to current fiscal year
|
|---|
| 100 | S ICDFY=$O(^ICD(CODE,2,"B",EDT+.01),-1),DMC1=""
|
|---|
| 101 | S DMC1=$O(^ICD(CODE,2,"B",+$G(ICDFY),DMC1)),DMC1=$P($G(^ICD(CODE,2,+DMC1,0)),U,3)
|
|---|
| 102 | S STR=$P(D0,U)_U_$P(DFYINF,U,2,4)_U_$P(DCSINF,U,5,6)_U_U_$P(DFYINF,U,9)_U_$P(DFYINF,U,6,7)
|
|---|
| 103 | S STR=STR_U_U_$P(D0,U,12)_U_$P(D0,U,13)_U_$P(DCSINF,U,3)_U_$P(D0,U,15)_U_$P(DCSINF,U)_U_CODE_U_DCS_U_$P(DMC1,U)_U_$P(DFYINF,U,8)_U_$P(DFYINF,U,10)
|
|---|
| 104 | ;
|
|---|
| 105 | DRGQ Q STR
|
|---|
| 106 | ;
|
|---|
| 107 | CODEI(CODE) ; Returns the IEN of an ICD code
|
|---|
| 108 | Q +$O(^ICD9("BA",+CODE,0))
|
|---|
| 109 | ;
|
|---|
| 110 | GETDATE(PATNUM) ; Find the correct "EFFECTIVE DATE" for locating the DRG/ICD/CPT codes
|
|---|
| 111 | ;
|
|---|
| 112 | ; Input: PATNUM - PTF Record Number
|
|---|
| 113 | ; Output: "effective date" to use
|
|---|
| 114 | ;
|
|---|
| 115 | N EFFD,PTR
|
|---|
| 116 | ; Census Date
|
|---|
| 117 | S PTR=$P($G(^DGPT(PATNUM,0)),U,13) I PTR'="" S EFFD=$P($G(^DG(45.86,PTR,0)),U,1) G:EFFD'="" GDOUT
|
|---|
| 118 | ; Discharge Date
|
|---|
| 119 | S EFFD=$P($G(^DGPT(PATNUM,70)),U,1) G:EFFD'="" GDOUT
|
|---|
| 120 | ; Surgery Date
|
|---|
| 121 | S EFFD=$P($G(^DGPT(PATNUM,"S",1,0)),U,1) G:EFFD'="" GDOUT
|
|---|
| 122 | ; Movement Date
|
|---|
| 123 | S EFFD=$P($G(^DGPT(PATNUM,"M",1,0)),U,10)
|
|---|
| 124 | ; Default TODAY
|
|---|
| 125 | I EFFD="" S EFFD=DT
|
|---|
| 126 | GDOUT Q EFFD
|
|---|
| 127 | ;
|
|---|
| 128 | ISVALID(CODE,EDATE,FILE) ; Is an ICD/CPT code Valid
|
|---|
| 129 | ; This is a function call to be used in DIC("S") FileMan
|
|---|
| 130 | ; calls to check the validation of a ICD/CPT code
|
|---|
| 131 | ; Input:
|
|---|
| 132 | ; CODE - ICD/CPT code (ien)
|
|---|
| 133 | ; EDATE - Effective date to be used
|
|---|
| 134 | ; FILE - File to use: 0 - ICD0; 9 - ICD9
|
|---|
| 135 | ;
|
|---|
| 136 | ; Output:
|
|---|
| 137 | ; OUT - 1 if valid; 0 if not
|
|---|
| 138 | ;
|
|---|
| 139 | N OUT,TEMP
|
|---|
| 140 | S OUT=0
|
|---|
| 141 | I FILE=0 S TEMP=$$ICDOP^ICDCODE(CODE,EDATE) I TEMP>0,$P(TEMP,U,10) S OUT=1
|
|---|
| 142 | I FILE=9 S TEMP=$$ICDDX^ICDCODE(CODE,EDATE) I TEMP>0,$P(TEMP,U,10) S OUT=1
|
|---|
| 143 | Q OUT
|
|---|
| 144 | ;
|
|---|
| 145 | DRGD(CODE,OUTARR,DFN,CDT) ; returns CPT description in array
|
|---|
| 146 | ; Input: CODE ICD Code, Internal or External Format (required)
|
|---|
| 147 | ; ARY Output Array Name for description
|
|---|
| 148 | ; e.g. "ABC" or "ABC("TEST")"
|
|---|
| 149 | ; Default = ^TMP("DRGD",$J)
|
|---|
| 150 | ; DFN Not in use but included in anticipation of future need
|
|---|
| 151 | ; CDT Date to screen against (default = TODAY)
|
|---|
| 152 | ; If CDT < 10/1/1978, use 10/1/1978
|
|---|
| 153 | ; If CDT > DT, use DT
|
|---|
| 154 | ; If CDT is year only, use first of the year
|
|---|
| 155 | ; If CDT is year and month only, use first of the month
|
|---|
| 156 | ;
|
|---|
| 157 | ; Output: # Number of lines in description output array
|
|---|
| 158 | ; @ARY(1:n) - Versioned Description (lines 1-n) (from the 68 multiple)
|
|---|
| 159 | ; @ARY(n+1) - Blank
|
|---|
| 160 | ; @ARY(n+1) - A message stating: CODE TEXT MAY BE INACCURATE
|
|---|
| 161 | ;
|
|---|
| 162 | ; or
|
|---|
| 163 | ;
|
|---|
| 164 | ; -1^Error Description
|
|---|
| 165 | ;
|
|---|
| 166 | ; ** NOTE - USER MUST INITIALIZE ^TMP("DRGD",$J), IF USED **
|
|---|
| 167 | ;
|
|---|
| 168 | N ARR,END,I,N,CTV,IEN
|
|---|
| 169 | I $G(CODE)="" S N="-1^NO CODE SELECTED" G DRGDQ
|
|---|
| 170 | I $G(OUTARR)="" S OUTARR="^TMP(""DRGD"",$J,"
|
|---|
| 171 | I OUTARR'["(" S OUTARR=OUTARR_"("
|
|---|
| 172 | I OUTARR[")" S OUTARR=$P(OUTARR,")")
|
|---|
| 173 | S END=$E(OUTARR,$L(OUTARR)) I END'="("&(END'=",") S OUTARR=OUTARR_","
|
|---|
| 174 | K:OUTARR="^TMP(""DRGD"",$J," ^TMP("DRGD",$J)
|
|---|
| 175 | S CODE=$G(CODE),IEN=$S(CODE:+CODE,1:$$CODEN(CODE)),I=0,N=0
|
|---|
| 176 | I +IEN<1!('$D(^ICD(IEN))) S N="-1^NO SUCH CODE" G DRGDQ
|
|---|
| 177 | S CDT=$S($G(CDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(CDT,2))
|
|---|
| 178 | D VLTDR(+IEN,CDT,.CTV) S (N,I)=0 F S I=$O(CTV(I)) Q:+I=0 D
|
|---|
| 179 | . S N=N+1,ARR=OUTARR_N_")",@ARR=$$TRIM($G(CTV(I)))
|
|---|
| 180 | I +N>0 S N=N+1,ARR=OUTARR_N_")",@ARR=" ",N=N+1,ARR=OUTARR_N_")",@ARR=$$MSG^ICDAPIU(CDT,2)
|
|---|
| 181 | I +N'>0 S N="-1^VERSIONED DESCRIPTION NOT FOUND FOR "_CODE
|
|---|
| 182 | DRGDQ Q N
|
|---|
| 183 | ;
|
|---|
| 184 | VLTDR(IEN,VDATE,ARY) ; Versioned Description - Long Text
|
|---|
| 185 | ; Input:
|
|---|
| 186 | ; IEN - Internal Entry Number file 80.2
|
|---|
| 187 | ; VDATE - Effective/Versioning date to be used
|
|---|
| 188 | ; .ARY - Array for output, passed by reference
|
|---|
| 189 | ;
|
|---|
| 190 | ; Output:
|
|---|
| 191 | ; ARY() - Local array containing versioned description
|
|---|
| 192 | ;
|
|---|
| 193 | N ICD0,ICDC,ICDI,ICDSTD,ICDSTI,ICDVDT,ICDTXT,ICDD,ICDT,ICDE
|
|---|
| 194 | S ICDI=+($G(IEN)) Q:+ICDI'>0 Q:'$D(^ICD(+ICDI))
|
|---|
| 195 | S ICDVDT=$G(VDATE) S:'$L(ICDVDT)!(+ICDVDT'>0) ICDVDT=$$DT^XLFDT Q:$P(ICDVDT,".",1)'?7N
|
|---|
| 196 | S ICD0=$G(^ICD(+ICDI,0)),ICDC=$P(ICD0,"^",1) Q:'$L(ICDC)
|
|---|
| 197 | S ICDSTD=$O(^ICD("ADS",(ICDC_" "),(ICDVDT+.000001)),-1)
|
|---|
| 198 | I +ICDSTD>0 D Q:+($O(ARY(0)))>0
|
|---|
| 199 | . S ICDSTI=$O(^ICD("ADS",(ICDC_" "),ICDSTD,+ICDI," "),-1)
|
|---|
| 200 | . S (ICDD,ICDT)=0 F S ICDD=$O(^ICD(+ICDI,68,ICDSTI,1,ICDD)) Q:+ICDD=0 D
|
|---|
| 201 | . . S ICDT=ICDT+1,ARY(ICDT)=$G(^ICD(+ICDI,68,+ICDSTI,1,+ICDD,0)),ARY(0)=ICDT
|
|---|
| 202 | S ICDSTD=$O(^ICD(+ICDI,68,"B"," "),-1) I +ICDSTD>0 D Q:+($O(ARY(0)))>0
|
|---|
| 203 | . S ICDSTI=$O(^ICD(+ICDI,68,"B",ICDSTD,0))
|
|---|
| 204 | . S (ICDD,ICDT)=0 F S ICDD=$O(^ICD(+ICDI,68,ICDSTI,1,ICDD)) Q:+ICDD=0 D
|
|---|
| 205 | . . S ICDT=ICDT+1,ARY(ICDT)=$G(^ICD(+ICDI,68,+ICDSTI,1,+ICDD,0)),ARY(0)=ICDT
|
|---|
| 206 | K ARY S (ICDD,ICDT)=0 F S ICDD=$O(^ICD(ICDI,1,ICDD)) Q:+ICDD=0 D
|
|---|
| 207 | . S ICDT=ICDT+1,ARY(ICDT)=$G(^ICD(ICDI,1,ICDD,0)),ARY(0)=ICDT
|
|---|
| 208 | Q
|
|---|
| 209 | TRIM(X) ; Trim Spaces
|
|---|
| 210 | S X=$G(X) Q:X="" X F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
|
|---|
| 211 | F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
|
|---|
| 212 | F Q:X'[" " S X=$P(X," ",1)_" "_$P(X," ",2,229)
|
|---|
| 213 | Q X
|
|---|
| 214 | CODEN(CODE) ; Return the IEN of DRG
|
|---|
| 215 | ; Input: DRG code
|
|---|
| 216 | ; Output: IEN of code
|
|---|
| 217 | ;
|
|---|
| 218 | Q:$G(CODE)="" -1 N COD S COD=+$O(^ICD("B",CODE,0)) Q $S(COD>0:COD,1:-1)
|
|---|
