[628] | 1 | ICD1831A ;ALB/RBS - FY 2008 DRG UPDATE ; 11/13/07 3:37pm
|
---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 13, 2000;Build 7
|
---|
| 3 | ;
|
---|
| 4 | ;Update the (#80.2) DRG file with FY 2008 DRG Grouper MS-DRG codes.
|
---|
| 5 | ;The last DRG code filed for FY 2007 was DRG579.
|
---|
| 6 | ;
|
---|
| 7 | Q
|
---|
| 8 | ;
|
---|
| 9 | ;Routines ICD1831* contain each FY 2008 MS-DRG code update values
|
---|
| 10 | ;in a line of text delimited by up-arrow "^".
|
---|
| 11 | ; $TEXT line field names
|
---|
| 12 | ; MS-DRG^MDC^TYPE^MS-DRG TITLE^WEIGHTS^GEOMETRIC MEAN LOS^
|
---|
| 13 | ; routine MS-DRG codes
|
---|
| 14 | ; ICD1831B - 1 to 168
|
---|
| 15 | ; ICD1831C - 175 to 329
|
---|
| 16 | ; ICD1831D - 330 to 480
|
---|
| 17 | ; ICD1831E - 481 to 639
|
---|
| 18 | ; ICD1831F - 640 to 809
|
---|
| 19 | ; ICD1831G - 810 to 999
|
---|
| 20 | ;
|
---|
| 21 | ;The following nodes/fields will be updated or created:
|
---|
| 22 | ; .001 NUMBER (same as DRG Number)
|
---|
| 23 | ; 0 node - .01 NAME (composed of prefix "DRG"_Number... DRG579)
|
---|
| 24 | ; 5 MDC#
|
---|
| 25 | ; .06 SURGERY
|
---|
| 26 | ; 1 node - #1 DESCRIPTION *** don't update existing records ***
|
---|
| 27 | ; 80.21A, .01 DESCRIPTION Multiple
|
---|
| 28 | ; 2 node - #71 DRG GROUPER EFFECIVE DATE
|
---|
| 29 | ; 80.271D, .01 DRG GROUPER EFFECIVE DATE
|
---|
| 30 | ; 1 REFERENCE - MUMPS Routine name
|
---|
| 31 | ; 66 node - #66 EFFECTIVE DATE
|
---|
| 32 | ; 80.266D, .01 EFFECTIVE DATE
|
---|
| 33 | ; .03 STATUS
|
---|
| 34 | ; .05 MDC#
|
---|
| 35 | ; .06 SURGERY
|
---|
| 36 | ; 68 node - #68 DESCRIPTION (VERSIONED)
|
---|
| 37 | ; 80.268D, .01 EFFECTIVE DATE
|
---|
| 38 | ; 1 DESCRIPTION
|
---|
| 39 | ; 80.2681, .01 DESCRIPTION
|
---|
| 40 | ; "FY" node - #20 FISCAL YEAR WEIGHTS&TRIM
|
---|
| 41 | ; 80.22D, .01 FISCAL YEAR WEIGHTS&TRIMS
|
---|
| 42 | ; 2 WEIGHT
|
---|
| 43 | ; 3 LOW TRIM(days)
|
---|
| 44 | ; 4 HIGH TRIM(days)
|
---|
| 45 | ; 4.5 AVG LENGTH OF STAY(days)
|
---|
| 46 | ;
|
---|
| 47 | DRG ;post-install driver (#80.2) DRG updates
|
---|
| 48 | ;This procedure calls a series of routines that contain the data
|
---|
| 49 | ;element values used to create the FY 2008 MS-DRG updates.
|
---|
| 50 | ; Input:
|
---|
| 51 | ; ICDTMP - Temp file of error msg's
|
---|
| 52 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 53 | ; Output:
|
---|
| 54 | ; ICDTMP - Temp file of error msg's
|
---|
| 55 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 56 | ;
|
---|
| 57 | D BMES^XPDUTL(">>> Adding FY 2008 DRG Grouper updates to (#80.2) DRG file...")
|
---|
| 58 | N ICDRTN,ICDI,ICDSUB,ICDEDIT,ICDADD
|
---|
| 59 | S (ICDEDIT,ICDADD)=0
|
---|
| 60 | S ICDTOT=$G(ICDTOT) I ICDTOT']"" S ICDTOT=0
|
---|
| 61 | S ICDTMP=$G(ICDTMP)
|
---|
| 62 | I ICDTMP']"" S ICDTMP=$NA(^TMP("DRGFY2008",$J)) D
|
---|
| 63 | . K @ICDTMP
|
---|
| 64 | . S @ICDTMP@(0)="PATCH FY 2008 DRG UPDATE^"_$$NOW^XLFDT
|
---|
| 65 | ;
|
---|
| 66 | ;loop each sub-routine
|
---|
| 67 | S ICDSUB="BCDEFG"
|
---|
| 68 | F ICDI=1:1:6 S ICDRTN="^ICD1831"_$E(ICDSUB,ICDI) D
|
---|
| 69 | . Q:($T(@ICDRTN)="")
|
---|
| 70 | . D GETDRG(ICDRTN,ICDTMP,.ICDTOT,.ICDEDIT,.ICDADD)
|
---|
| 71 | ;
|
---|
| 72 | I '$D(@ICDTMP@("ERROR")) D
|
---|
| 73 | . D MES^XPDUTL(">>> DRG Updates Completed...")
|
---|
| 74 | . D MES^XPDUTL(" ...Total Codes Edited: "_ICDEDIT)
|
---|
| 75 | . D MES^XPDUTL(" ...Total Codes Added: "_ICDADD)
|
---|
| 76 | . D MES^XPDUTL(" ................Total: "_ICDTOT)
|
---|
| 77 | . D MES^XPDUTL("")
|
---|
| 78 | Q
|
---|
| 79 | ;
|
---|
| 80 | GETDRG(ICDRTN,ICDTMP,ICDTOT,ICDEDIT,ICDADD) ;get and file MS-DRG data
|
---|
| 81 | ; Input:
|
---|
| 82 | ; ICDRTN - Post Install routine to process MS-DRG codes
|
---|
| 83 | ; ICDTMP - Temp file of error msg's
|
---|
| 84 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 85 | ; Output:
|
---|
| 86 | ; ICDTMP - Temp file of error msg's
|
---|
| 87 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 88 | ;
|
---|
| 89 | N ICDLN,ICDLINE,ICDTAG,ICDDRG,ICDTEXT
|
---|
| 90 | ;
|
---|
| 91 | F ICDLN=1:1 S ICDTAG="MSDRG+"_ICDLN_ICDRTN,ICDTEXT=$T(@ICDTAG) S ICDLINE=$P(ICDTEXT,";;",2) Q:ICDLINE="EXIT" D
|
---|
| 92 | . ; check if DRG exists or is a new one
|
---|
| 93 | . I $D(^ICD(+$P(+ICDLINE,U),0)) D EDITDRG(ICDLINE,ICDTMP,.ICDTOT,.ICDEDIT)
|
---|
| 94 | . E D NEWDRG(ICDLINE,ICDTMP,.ICDTOT,.ICDADD)
|
---|
| 95 | Q
|
---|
| 96 | ;
|
---|
| 97 | EDITDRG(ICDLINE,ICDTMP,ICDTOT,ICDEDIT) ; edit existing (#80.2) DRG record
|
---|
| 98 | ; Input:
|
---|
| 99 | ; ICDLINE - $TEXT line of MS-DRG code data
|
---|
| 100 | ; ICDTMP - Temp file of error msg's
|
---|
| 101 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 102 | ; Output:
|
---|
| 103 | ; ICDTMP - Temp file of error msg's
|
---|
| 104 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 105 | ;
|
---|
| 106 | N X,Y,DA,DIE,DR,ICDDRG,ICDDESC,ICDMDC,ICDSURG,ICDFDA,ICDFY,ICDERR,ICDREF
|
---|
| 107 | ;
|
---|
| 108 | S ICDFY=3071001
|
---|
| 109 | S ICDDRG=+$P(ICDLINE,U)
|
---|
| 110 | S ICDDESC=$P(ICDLINE,U,4)
|
---|
| 111 | I '$D(^ICD(ICDDRG,0)) D Q
|
---|
| 112 | . S @ICDTMP@("ERROR",ICDDRG,0)="MISSING (#80.2) DRG FILE RECORD"
|
---|
| 113 | ;
|
---|
| 114 | ; check if already done in case patch being re-installed
|
---|
| 115 | Q:$D(^ICD(ICDDRG,66,"B",ICDFY))
|
---|
| 116 | ;
|
---|
| 117 | ;-- 80.271D subfile - #71 DRG GROUPER EFFECIVE DATE
|
---|
| 118 | ;S ICDREF="ICDTLB6D" ;*** REFERENCE routine not defined yet ???
|
---|
| 119 | ;S ICDREF="" ;*** ECF commented out-see next line
|
---|
| 120 | S ICDREF="ICDTBL"_$S(ICDDRG<100:"0",1:$E(ICDDRG,1)) ;ECF new line
|
---|
| 121 | D DRGEFFDT(ICDDRG,ICDFY,ICDREF,ICDTMP)
|
---|
| 122 | ;
|
---|
| 123 | ;-- 80.266D subfile - #66 EFFECTIVE DATE
|
---|
| 124 | S ICDMDC=$P(ICDLINE,U,2) S:ICDMDC="PRE" ICDMDC=98
|
---|
| 125 | I ICDMDC]"" S ICDMDC=+ICDMDC
|
---|
| 126 | S ICDSURG=$P(ICDLINE,U,3) S ICDSURG=$S(ICDSURG="SURG":1,1:0)
|
---|
| 127 | D EFFDATE(ICDDRG,ICDFY,ICDMDC,ICDSURG,ICDTMP)
|
---|
| 128 | ;
|
---|
| 129 | ;-- 80.268D subfile - #68 DESCRIPTION
|
---|
| 130 | D DESCA(ICDDRG,ICDFY,ICDTMP)
|
---|
| 131 | ;
|
---|
| 132 | ;-- 80.2681 subfile - #68 DESCRIPTION
|
---|
| 133 | D DESCB(ICDDRG,ICDFY,ICDDESC,ICDTMP)
|
---|
| 134 | ;
|
---|
| 135 | ;--80.22D subfile - #20 FISCAL YEAR WEIGHTS&TRIM
|
---|
| 136 | D WEIGHTS(ICDLINE,ICDTMP)
|
---|
| 137 | ;
|
---|
| 138 | S ICDTOT=ICDTOT+1,ICDEDIT=ICDEDIT+1
|
---|
| 139 | Q
|
---|
| 140 | ;
|
---|
| 141 | NEWDRG(ICDLINE,ICDTMP,ICDTOT,ICDADD) ; add new (#80.2) DRG record
|
---|
| 142 | ; Input:
|
---|
| 143 | ; ICDLINE - $TEXT line of MS-DRG code data
|
---|
| 144 | ; ICDTMP - Temp file of error msg's
|
---|
| 145 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 146 | ; Output:
|
---|
| 147 | ; ICDTMP - Temp file of error msg's
|
---|
| 148 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 149 | ;
|
---|
| 150 | N DA,DIC,DIE,DR,X,Y
|
---|
| 151 | N ICDDRG,ICDDESC,ICDMDC,ICDSURG,ICDFDA,ICDFY,ICDERR,ICDREF,ICDIEN
|
---|
| 152 | S ICDFY=3071001
|
---|
| 153 | S ICDDRG=+$P(ICDLINE,U)
|
---|
| 154 | ; check for duplicates in case install is being rerun
|
---|
| 155 | I $D(^ICD(ICDDRG,0)) Q
|
---|
| 156 | ;
|
---|
| 157 | S ICDMDC=$P(ICDLINE,U,2) I ICDMDC="PRE" S ICDMDC=98
|
---|
| 158 | I ICDMDC]"" S ICDMDC=+ICDMDC
|
---|
| 159 | S ICDSURG=$P(ICDLINE,U,3) S ICDSURG=$S(ICDSURG="SURG":1,1:"")
|
---|
| 160 | S ICDDESC=$P(ICDLINE,U,4)
|
---|
| 161 | ;
|
---|
| 162 | ;-- #.001 NUMBER and 0 node fields
|
---|
| 163 | K ICDFDA,ICDIEN,ICDERR
|
---|
| 164 | S ICDFDA(80.2,"+1,",.01)="DRG"_ICDDRG
|
---|
| 165 | S ICDFDA(80.2,"+1,",5)=ICDMDC
|
---|
| 166 | S ICDFDA(80.2,"+1,",.06)=ICDSURG
|
---|
| 167 | S ICDIEN(1)=ICDDRG
|
---|
| 168 | D UPDATE^DIE("","ICDFDA","ICDIEN","ICDERR") K ICDFDA,ICDIEN
|
---|
| 169 | I $D(ICDERR) D K ICDERR ;*** quit here if can't setup IEN ???
|
---|
| 170 | . S @ICDTMP@("ERROR",ICDDRG,.001)="FILING TO (#.001) NUMBER FIELD"
|
---|
| 171 | ;
|
---|
| 172 | ;-- 80.21A subfile - #1 DESCRIPTION
|
---|
| 173 | K DIC,DA
|
---|
| 174 | S DA(1)=ICDDRG
|
---|
| 175 | S DIC="^ICD("_DA(1)_",1,"
|
---|
| 176 | S DIC(0)="L"
|
---|
| 177 | S X=ICDDESC
|
---|
| 178 | K DO D FILE^DICN
|
---|
| 179 | K DIC,DA
|
---|
| 180 | I Y=-1 D
|
---|
| 181 | . S @ICDTMP@("ERROR",ICDDRG,1)="FILING TO (#1) DESCRIPTION FIELD"
|
---|
| 182 | ;
|
---|
| 183 | ;-- 80.271D subfile - #71 DRG GROUPER EFFECIVE DATE
|
---|
| 184 | ;S ICDREF="ICDTLB6D" ;*** REFERENCE routine not defined yet ???
|
---|
| 185 | ;S ICDREF="" ;ECF commented out - see next line
|
---|
| 186 | S ICDREF="ICDTBL"_$S(ICDDRG<100:"0",1:$E(ICDDRG,1)) ;ECF new line
|
---|
| 187 | D DRGEFFDT(ICDDRG,ICDFY,ICDREF,ICDTMP)
|
---|
| 188 | ;
|
---|
| 189 | ;-- 80.266D subfile - #66 EFFECTIVE DATE
|
---|
| 190 | I ICDSURG="" S ICDSURG=0
|
---|
| 191 | D EFFDATE(ICDDRG,ICDFY,ICDMDC,ICDSURG,ICDTMP)
|
---|
| 192 | ;
|
---|
| 193 | ;-- 80.268D subfile - #68 DESCRIPTION
|
---|
| 194 | D DESCA(ICDDRG,ICDFY,ICDTMP)
|
---|
| 195 | ;
|
---|
| 196 | ;-- 80.2681 subfile - #68 DESCRIPTION
|
---|
| 197 | D DESCB(ICDDRG,ICDFY,ICDDESC,ICDTMP)
|
---|
| 198 | ;
|
---|
| 199 | ;-- 80.22D subfile - update weights&trims/ALOS
|
---|
| 200 | D WEIGHTS(ICDLINE,ICDTMP)
|
---|
| 201 | ;
|
---|
| 202 | S ICDTOT=ICDTOT+1,ICDADD=ICDADD+1
|
---|
| 203 | Q
|
---|
| 204 | ;
|
---|
| 205 | DRGEFFDT(ICDDRG,ICDFY,ICDREF,ICDTMP) ;-- 80.271D - #71 DRG GROUPER EFFECIVE DATE
|
---|
| 206 | I '$G(ICDDRG)!'$G(ICDFY)!($G(ICDTMP)']"") Q
|
---|
| 207 | K ICDFDA,ICDERR
|
---|
| 208 | S ICDFDA(80.2,"?1,",.01)=ICDDRG
|
---|
| 209 | S ICDFDA(80.271,"+2,?1,",.01)=ICDFY
|
---|
| 210 | S ICDFDA(80.271,"+2,?1,",1)=ICDREF
|
---|
| 211 | D UPDATE^DIE("","ICDFDA","","ICDERR") K ICDFDA
|
---|
| 212 | I $D(ICDERR) D K ICDERR
|
---|
| 213 | . S @ICDTMP@("ERROR",ICDDRG,71)="FILING TO (#71) DRG GROUPER EFFECIVE DATE FIELD"
|
---|
| 214 | Q
|
---|
| 215 | ;
|
---|
| 216 | EFFDATE(ICDDRG,ICDFY,ICDMDC,ICDSURG,ICDTMP) ;-- 80.266D - #66 EFFECTIVE DATE
|
---|
| 217 | I '$G(ICDDRG)!'$G(ICDFY)!($G(ICDTMP)']"") Q
|
---|
| 218 | K ICDFDA,ICDERR
|
---|
| 219 | S ICDFDA(80.2,"?1,",.01)=ICDDRG
|
---|
| 220 | S ICDFDA(80.266,"+2,?1,",.01)=ICDFY
|
---|
| 221 | S ICDFDA(80.266,"+2,?1,",.03)=1
|
---|
| 222 | S ICDFDA(80.266,"+2,?1,",.05)=ICDMDC
|
---|
| 223 | S ICDFDA(80.266,"+2,?1,",.06)=ICDSURG
|
---|
| 224 | D UPDATE^DIE("","ICDFDA","","ICDERR") K ICDFDA
|
---|
| 225 | I $D(ICDERR) D K ICDERR
|
---|
| 226 | . S @ICDTMP@("ERROR",ICDDRG,66)="FILING TO (#66) EFFECTIVE DATE FIELD"
|
---|
| 227 | Q
|
---|
| 228 | ;
|
---|
| 229 | DESCA(ICDDRG,ICDFY,ICDTMP) ;-- 80.268D - #68 DESCRIPTION
|
---|
| 230 | I '$G(ICDDRG)!'$G(ICDFY)!($G(ICDTMP)']"") Q
|
---|
| 231 | K ICDFDA,ICDERR
|
---|
| 232 | S ICDFDA(80.2,"?1,",.01)=ICDDRG
|
---|
| 233 | S ICDFDA(80.268,"+2,?1,",.01)=ICDFY
|
---|
| 234 | D UPDATE^DIE("","ICDFDA","","ICDERR") K ICDFDA
|
---|
| 235 | I $D(ICDERR) D K ICDERR
|
---|
| 236 | . S @ICDTMP@("ERROR",ICDDRG,68)="FILING TO (#68) DESCRIPTION FIELD"
|
---|
| 237 | Q
|
---|
| 238 | ;
|
---|
| 239 | DESCB(ICDDRG,ICDFY,ICDDESC,ICDTMP) ;-- 80.2681 - #68 DESCRIPTION
|
---|
| 240 | I '$G(ICDDRG)!'$G(ICDFY)!($G(ICDDESC)']"")!($G(ICDTMP)']"") Q
|
---|
| 241 | K ICDFDA,ICDERR
|
---|
| 242 | S ICDFDA(80.2,"?1,",.01)=ICDDRG
|
---|
| 243 | S ICDFDA(80.268,"?2,?1,",.01)=ICDFY
|
---|
| 244 | S ICDFDA(80.2681,"+3,?2,?1,",.01)=ICDDESC
|
---|
| 245 | D UPDATE^DIE("","ICDFDA","","ICDERR") K ICDFDA
|
---|
| 246 | I $D(ICDERR) D K ICDERR
|
---|
| 247 | . S @ICDTMP@("ERROR",ICDDRG,68)="FILING TO (#68) DESCRIPTION SUB-FIELD"
|
---|
| 248 | Q
|
---|
| 249 | ;
|
---|
| 250 | WEIGHTS(ICDLINE,ICDTMP) ;--80.22D subfile - #20 FISCAL YEAR WEIGHTS&TRIM
|
---|
| 251 | ; Input:
|
---|
| 252 | ; ICDLINE - $TEXT line of MS-DRG code data
|
---|
| 253 | ; ICDTMP - Temp file of error msg's
|
---|
| 254 | ; Output:
|
---|
| 255 | ; ICDTMP - Temp file of error msg's
|
---|
| 256 | ;
|
---|
| 257 | I $G(ICDLINE)'[""!($G(ICDTMP)'["") Q
|
---|
| 258 | N ICDDRG,ICDWT,ICDLOS,ICDSTR,ICDX,ICDJ,ICDFYR,ICDLOW,ICDHIGH
|
---|
| 259 | S ICDFYR=3080000,ICDLOW=1,ICDHIGH=99 ; *** default Low/High ???
|
---|
| 260 | S ICDDRG=+$P(ICDLINE,U)
|
---|
| 261 | I '$D(^ICD(ICDDRG,0)) D Q
|
---|
| 262 | . S @ICDTMP@("ERROR",ICDDRG,0)="MISSING (#80.2) DRG FILE RECORD"
|
---|
| 263 | ;
|
---|
| 264 | ; check if being re-installed
|
---|
| 265 | Q:$D(^ICD(ICDDRG,"FY",ICDFYR))
|
---|
| 266 | ;
|
---|
| 267 | I ICDDRG=998!(ICDDRG=999) S (ICDLOW,ICDHIGH)=0
|
---|
| 268 | S ICDWT=$P(ICDLINE,U,5),ICDLOS=$P(ICDLINE,U,6)
|
---|
| 269 | I ICDLOS["*" S ICDLOS=0
|
---|
| 270 | S $P(ICDSTR,U)=ICDFYR,$P(ICDSTR,U,2)=ICDWT,$P(ICDSTR,U,3)=ICDLOW,$P(ICDSTR,U,4)=ICDHIGH,$P(ICDSTR,U,9)=ICDLOS
|
---|
| 271 | ;
|
---|
| 272 | S ^ICD(ICDDRG,"FY",ICDFYR,0)=ICDSTR
|
---|
| 273 | ;
|
---|
| 274 | I '$D(^ICD(ICDDRG,"FY",0)) S ^ICD(ICDDRG,"FY",0)="^80.22D^"_ICDFYR_"^1" Q
|
---|
| 275 | E D
|
---|
| 276 | . S ICDX=0 F ICDJ=0:1 S ICDX=$O(^ICD(ICDDRG,"FY",ICDX)) Q:ICDX=""
|
---|
| 277 | . S $P(^ICD(ICDDRG,"FY",0),"^",3,4)=ICDFYR_"^"_ICDJ
|
---|
| 278 | Q
|
---|