[628] | 1 | ICD1831K ; ALB/ECF - FY 2007 UPDATE; 10/23/07 2:50 pm;
|
---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | DRG(ICDTMP) ;post-install driver for file ICD Operation/Procedure
|
---|
| 6 | ; file(#80.1) DRG updates
|
---|
| 7 | ;This procedure loops through the ICD OPERATION/PROCDURE file (80.1)
|
---|
| 8 | ;to create a DRG GROUPER EFFECTIVE DATE entry for FY08
|
---|
| 9 | ; Input:
|
---|
| 10 | ; ICDTMP - Temp file of error msg's
|
---|
| 11 | ; Output:
|
---|
| 12 | ; ICDTMP - Temp file of error msg's
|
---|
| 13 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 14 | ; ICDERTOT - Total error records - cannot file
|
---|
| 15 | ;
|
---|
| 16 | N ICDI,ICDCRCD,ICDFOK,ICDNWCD,ICDTOT,ICDX,ICDY,ICDVAL,ICDETOT,ICDYY,ICDZZ
|
---|
| 17 | S U="^"
|
---|
| 18 | ;
|
---|
| 19 | D BMES^XPDUTL(">>> Adding FY08 DRG Grouper updates to ICD OP/PR file (#80.1)...")
|
---|
| 20 | ;Error log
|
---|
| 21 | S ICDTMP=$G(ICDTMP)
|
---|
| 22 | I ICDTMP']"" S ICDTMP=$NA(^TMP("ICDDGFY2008OP",$J)) D
|
---|
| 23 | . K @ICDTMP
|
---|
| 24 | . S @ICDTMP@(0)="PATCH #? FY08 ICD DIAG DRG UPDATE^"_$$NOW^XLFDT
|
---|
| 25 | ;
|
---|
| 26 | ;Skip inactive
|
---|
| 27 | S (ICDETOT,ICDI,ICDTOT,ICDYY)=0
|
---|
| 28 | ;
|
---|
| 29 | F S ICDI=$O(^ICD0(ICDI)) Q:ICDI=""!(ICDI'?.N) D
|
---|
| 30 | .;quit if no zero node
|
---|
| 31 | .Q:$G(^ICD0(ICDI,0))=""
|
---|
| 32 | .;quit if zero node corrupt
|
---|
| 33 | .Q:$P($G(^ICD0(ICDI,0)),U)']""
|
---|
| 34 | .S ICDVAL=$P($G(^ICD0(ICDI,0)),U)
|
---|
| 35 | .Q:ICDVAL=""
|
---|
| 36 | .;quit if code is inactive
|
---|
| 37 | .S ICDZZ=$$ICDOP^ICDCODE(ICDVAL,3071001) Q:$P($G(ICDZZ),U,10)=0
|
---|
| 38 | .;check if already created in case patch being re-installed
|
---|
| 39 | .Q:$D(^ICD0(ICDI,2,"B",3071001))
|
---|
| 40 | .;
|
---|
| 41 | .;Get ien of latest Grouper Effective Date
|
---|
| 42 | .S ICDX=$O(^ICD0(ICDI,2,"B",9999999),-1)
|
---|
| 43 | .;No Grp Eff Dt means this is a new code
|
---|
| 44 | .I ICDX']"" D
|
---|
| 45 | ..;Call API
|
---|
| 46 | ..K ICDNCDAR
|
---|
| 47 | ..D NEW801^ICD1831L(ICDVAL,.ICDNCDAR)
|
---|
| 48 | ..Q:'$D(ICDNCDAR)
|
---|
| 49 | ..;Build code array for UPDDIAG()
|
---|
| 50 | ..K ICDCONAR
|
---|
| 51 | ..D GETNCRCD(ICDI,.ICDNCDAR,.ICDCONAR)
|
---|
| 52 | ..Q:'$D(ICDCONAR(0))
|
---|
| 53 | ..D UPDDIAG(ICDI,.ICDCONAR,.ICDTOT)
|
---|
| 54 | .;
|
---|
| 55 | .I ICDX]"" D
|
---|
| 56 | ..;Old codes to convert
|
---|
| 57 | ..;Call will be $$CONV801^ICD1831L(<ien of code>)for each MDC/DRG set
|
---|
| 58 | ..S ICDLEDI=$O(^ICD0(ICDI,2,"B",ICDX,0))
|
---|
| 59 | ..S (ICDFYMI,ICDY)=0
|
---|
| 60 | ..;Loop through MDCs for this ICD PROC - DRG EFF DATE
|
---|
| 61 | ..F S ICDFYMI=$O(^ICD0(ICDI,2,ICDLEDI,1,ICDFYMI)) Q:ICDFYMI=""!(ICDFYMI'?.N) D
|
---|
| 62 | ...K ICDNWCD,ICDNWCDA
|
---|
| 63 | ...S ICDDGCD=$$GETCRCD(ICDI,ICDLEDI,ICDFYMI) ;Build code string for conversion API
|
---|
| 64 | ...;If no code string for this MDC, nothing to convert
|
---|
| 65 | ...Q:ICDDGCD']""
|
---|
| 66 | ...;Code string is ok, pass to conversion function
|
---|
| 67 | ...S ICDNWCD=$$CONV801^ICD1831L(ICDDGCD)
|
---|
| 68 | ...;Return codes are in string ICDCRCD <.01>^<MDC ien>^<DRG ien)^<DRG ien>.........
|
---|
| 69 | ...;Filer requires an array - at least a zero node is needed
|
---|
| 70 | ...I ICDNWCD]"" K ICDNWCDA S ICDNWCDA(0)=ICDNWCD
|
---|
| 71 | ...;Now process the array of code strings for this ICD Proc IEN
|
---|
| 72 | ...Q:ICDNWCDA(0)']""
|
---|
| 73 | ...;pass new codes to update procedure
|
---|
| 74 | ...;D UPDDIAG(ICDI,"X",.ICDNWCDA,.ICDTOT)
|
---|
| 75 | ...D UPDDIAG(ICDI,.ICDNWCDA,.ICDTOT)
|
---|
| 76 | ...K ICDNWCDA
|
---|
| 77 | .
|
---|
| 78 | ;Back to top level - processing is over - do final tasks
|
---|
| 79 | K ICDCONAR,ICDDGCD,ICDETOT,ICDFYMI,ICDNCDAR,ICDNWCDA
|
---|
| 80 | ;HANDLE ERRORS
|
---|
| 81 | ;No errors present
|
---|
| 82 | ;
|
---|
| 83 | S (ICDTOT,ICDYY)=0
|
---|
| 84 | F S ICDYY=$O(^TMP("ICDFILEOK",$J,ICDYY)) Q:ICDYY="" I ^TMP("ICDFILEOK",$J,ICDYY)=1 S ICDTOT=ICDTOT+1
|
---|
| 85 | I '$D(@ICDTMP@("ERROR")) D
|
---|
| 86 | . D MES^XPDUTL(">>> ICD PROCEDURE File DRG Updates Completed...")
|
---|
| 87 | . D MES^XPDUTL(" ...Total Codes Edited: "_ICDTOT)
|
---|
| 88 | . D MES^XPDUTL("")
|
---|
| 89 | Q
|
---|
| 90 | ;Errors present
|
---|
| 91 | ;
|
---|
| 92 | I $D(@ICDTMP@("ERROR")) D
|
---|
| 93 | . F S ICDXX=$O(^TMP("ICDDGFY2008OP",$J,"ERROR",ICDXX)) Q:ICDXX="" D
|
---|
| 94 | ..S ICDETOT=ICDETOT+1
|
---|
| 95 | . D MES^XPDUTL(">>> ...Total Errors "_ICDETOT_" ERRORS")
|
---|
| 96 | . D MES^XPDUTL("")
|
---|
| 97 | . D MES^XPDUTL("Error are in ^TMP(""ICDDGFY2008OP"",$J)")
|
---|
| 98 | ;
|
---|
| 99 | K ICDCRCD,ICDVAL,ICDZZ
|
---|
| 100 | K ^TMP("ICDFILEOK")
|
---|
| 101 | Q
|
---|
| 102 | ;
|
---|
| 103 | ;END OF DRIVER
|
---|
| 104 | ;Start of helper functions and procedures
|
---|
| 105 | ;
|
---|
| 106 | GETCRCD(ICDIEN,ICDDGIEN,ICDMDIEN) ;
|
---|
| 107 | ;Create input string for conversion API - only for non-New DRGs
|
---|
| 108 | ;
|
---|
| 109 | ;INPUT ICDIEN = ien in file 80.1 ICD OPERATION/PROCEDURE
|
---|
| 110 | ; ICDDGIEN = ien of last DRG GROUPER EFFECTIVE DATE
|
---|
| 111 | ; ICDMDIEN = ien of Major Diagnostic Category
|
---|
| 112 | ;OUTPUT ICDCRDCS = string of codes formatted for API
|
---|
| 113 | ;
|
---|
| 114 | N ICDCRCDS,ICDXS
|
---|
| 115 | ;
|
---|
| 116 | S (ICDCRCD)=""
|
---|
| 117 | S (ICDX)=0
|
---|
| 118 | ;
|
---|
| 119 | ;START STRING WITH THE .01 FIELD
|
---|
| 120 | S ICDCRCDS=$P(^ICD0(ICDI,0),U)
|
---|
| 121 | ;
|
---|
| 122 | ;Add MDC ien to string
|
---|
| 123 | S ICDCRCDS=ICDCRCDS_"^"_$P($G(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,0)),U)
|
---|
| 124 | ;
|
---|
| 125 | ;Loop thru DRGs this ICD procedure, this eff date, this MDC
|
---|
| 126 | ;
|
---|
| 127 | F S ICDX=$O(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,1,ICDX)) Q:ICDX=""!(ICDX'?.N) D
|
---|
| 128 | .Q:$G(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,1,ICDX,0))=""
|
---|
| 129 | .S ICDCRCDS=ICDCRCDS_"^"_$P($G(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,1,ICDX,0)),U)
|
---|
| 130 | Q ICDCRCDS
|
---|
| 131 | ;
|
---|
| 132 | GETNCRCD(ICDIENP,ICDOAR,ICDCAR) ;
|
---|
| 133 | ;Quit if input not correct, passing back a null zero node
|
---|
| 134 | I '$D(ICDIENP) S ICDCAR(0)="" Q
|
---|
| 135 | ;
|
---|
| 136 | N ICDK,ICDJ,ICDL
|
---|
| 137 | S (ICDJ,ICDK,ICDL)=0
|
---|
| 138 | F S ICDJ=$O(ICDOAR(ICDJ)) Q:ICDJ="" D
|
---|
| 139 | .S ICDCAR(ICDL)=ICDIENP_"^"_ICDJ_"^"
|
---|
| 140 | .F S ICDK=$O(ICDOAR(ICDJ,ICDK)) Q:ICDK="" D
|
---|
| 141 | ..S ICDCAR(ICDL)=ICDCAR(ICDL)_ICDK_"^"
|
---|
| 142 | .S ICDL=ICDL+1
|
---|
| 143 | Q
|
---|
| 144 | ;
|
---|
| 145 | ;
|
---|
| 146 | UPDDIAG(ICDIP,ICDNWCDA,ICDTOTP) ;
|
---|
| 147 | ;File 80.1 updater
|
---|
| 148 | ;
|
---|
| 149 | N ICDX1
|
---|
| 150 | ; F ICDZ=1:1:3 I $P(ICDIAGP,U,ICDZ)']"" D Q
|
---|
| 151 | ; .S @ICDTMP@("ERROR",ICDIP,"80.1")="Missing field "_ICDZ_" filing "_ICDIAGP
|
---|
| 152 | ;
|
---|
| 153 | ;Quit if complete data not passed
|
---|
| 154 | Q:'$D(ICDIP)
|
---|
| 155 | Q:'$D(ICDNWCDA(0))
|
---|
| 156 | Q:$P($G(ICDNWCDA(0)),U,1)']""
|
---|
| 157 | Q:$P($G(ICDNWCDA(0)),U,2)']""
|
---|
| 158 | Q:$P($G(ICDNWCDA(0)),U,3)']""
|
---|
| 159 | ;
|
---|
| 160 | S ^TMP("ICDFILEOK",$J,ICDIP)=1
|
---|
| 161 | ;
|
---|
| 162 | K FDA(1831)
|
---|
| 163 | ;
|
---|
| 164 | ;Passed in array will trigger DRG Effective Date Multiple ONLY IF NEEDED
|
---|
| 165 | ;
|
---|
| 166 | I '$D(^ICD0(ICDIP,2,"B",3071001)) D
|
---|
| 167 | .;DRG GROUPER EFFECTIVE DATE MULTIPLE
|
---|
| 168 | .S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 169 | .S FDA(1831,80.171,"+2,?1,",.01)=3071001
|
---|
| 170 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 171 | .K FDA(1831)
|
---|
| 172 | ;
|
---|
| 173 | S ICDX1=""
|
---|
| 174 | ;
|
---|
| 175 | F S ICDX1=$O(ICDNWCDA(ICDX1)) Q:ICDX1="" D
|
---|
| 176 | .;ADD MDC MULTIPLE only if there are DRG codes for the MDC
|
---|
| 177 | .I $P(ICDNWCDA(ICDX1),U,2)]"" D K FDA
|
---|
| 178 | ..Q:$P(ICDNWCDA(ICDX1),U,3)']""
|
---|
| 179 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 180 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 181 | ..S FDA(1831,80.1711,"+3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 182 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 183 | .K FDA(1831)
|
---|
| 184 | .;
|
---|
| 185 | .;ADD DRG MULTIPLES - first code in Piece 3
|
---|
| 186 | .I $P(ICDNWCDA(ICDX1),U,3)]"" D
|
---|
| 187 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 188 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 189 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 190 | ..S FDA(1831,80.17111,"+4,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,3)
|
---|
| 191 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 192 | .K FDA(1831)
|
---|
| 193 | .;
|
---|
| 194 | .;ADD DRG MULTIPLES - second code in piece 4
|
---|
| 195 | .I $P(ICDNWCDA(ICDX1),U,4)]"" D
|
---|
| 196 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 197 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 198 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 199 | ..S FDA(1831,80.17111,"+5,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,4)
|
---|
| 200 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 201 | .K FDA(1831)
|
---|
| 202 | .;
|
---|
| 203 | .I $P(ICDNWCDA(ICDX1),U,5)]"" D
|
---|
| 204 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 205 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 206 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 207 | ..S FDA(1831,80.17111,"+6,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,5)
|
---|
| 208 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 209 | .K FDA(1831)
|
---|
| 210 | .;
|
---|
| 211 | .I $P(ICDNWCDA(ICDX1),U,6)]"" D
|
---|
| 212 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 213 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 214 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 215 | ..S FDA(1831,80.17111,"+7,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,6)
|
---|
| 216 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 217 | .K FDA(1831)
|
---|
| 218 | .;
|
---|
| 219 | .I $P(ICDNWCDA(ICDX1),U,7)]"" D
|
---|
| 220 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 221 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 222 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 223 | ..S FDA(1831,80.17111,"+8,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,7)
|
---|
| 224 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 225 | .K FDA(1831)
|
---|
| 226 | .;
|
---|
| 227 | .I $P(ICDNWCDA(ICDX1),U,8)]"" D
|
---|
| 228 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 229 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 230 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 231 | ..S FDA(1831,80.17111,"+9,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,8)
|
---|
| 232 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 233 | .K FDA(1831)
|
---|
| 234 | .;
|
---|
| 235 | .I $P(ICDNWCDA(ICDX1),U,9)]"" D
|
---|
| 236 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 237 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 238 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 239 | ..S FDA(1831,80.17111,"+10,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,9)
|
---|
| 240 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 241 | .K FDA(1831)
|
---|
| 242 | .;
|
---|
| 243 | .I $P(ICDNWCDA(ICDX1),U,10)]"" D
|
---|
| 244 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 245 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 246 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 247 | ..S FDA(1831,80.17111,"+11,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,10)
|
---|
| 248 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 249 | .K FDA(1831)
|
---|
| 250 | .;
|
---|
| 251 | .I $P(ICDNWCDA(ICDX1),U,11)]"" D
|
---|
| 252 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 253 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 254 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 255 | ..S FDA(1831,80.17111,"+12,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,11)
|
---|
| 256 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 257 | .K FDA(1831)
|
---|
| 258 | .;
|
---|
| 259 | .I $P(ICDNWCDA(ICDX1),U,12)]"" D
|
---|
| 260 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 261 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 262 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 263 | ..S FDA(1831,80.17111,"+13,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,12)
|
---|
| 264 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 265 | .K FDA(1831)
|
---|
| 266 | .;
|
---|
| 267 | .I $P(ICDNWCDA(ICDX1),U,13)]"" D
|
---|
| 268 | ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
|
---|
| 269 | ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
|
---|
| 270 | ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
|
---|
| 271 | ..S FDA(1831,80.17111,"+14,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,13)
|
---|
| 272 | ..D UPDATE^DIE("","FDA(1831)")
|
---|
| 273 | .K FDA(1831)
|
---|
| 274 | .;
|
---|
| 275 | .I $D(^TMP("DIERR",$J)) S @ICDTMP@("ERROR",ICDIP,"80.1")="CAN'T FILE CODES FOR IEN"_$P(ICDNWCDA(ICDX1),U)_" CODES "_$P(ICDNWCDA(ICDX1),3,99)
|
---|
| 276 | .I $D(^TMP("DIERR",$J,ICDIP)) S ^TMP("ICDFILEOK",$J,ICDIP)=0
|
---|
| 277 | Q
|
---|