[628] | 1 | ICD1831J ; ALB/ECF - FY 2008 UPDATE; 8/27/07 14:50
|
---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 13,2000 2:30 pm;Build 7
|
---|
| 3 | Q
|
---|
| 4 | ;
|
---|
| 5 | DRG(ICDTMP) ;post-install driver for file ICD Diagnosis file(#80) DRG updates
|
---|
| 6 | ;This procedure creates and files the MSv25DRG updates
|
---|
| 7 | ;
|
---|
| 8 | ; Input:
|
---|
| 9 | ; ICDTMP - Temp file of error msg's
|
---|
| 10 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 11 | ; Output:
|
---|
| 12 | ; ICDTMP - Temp file of error msg's
|
---|
| 13 | ; ICDTOT - Total MS-DRG codes filed
|
---|
| 14 | ; ICDERTOT - Total error records of type "cannot file"
|
---|
| 15 | ;
|
---|
| 16 | N ICDI,ICDCRCD,ICDNWCD,ICDTOT,ICDETOT,ICDVAL,ICDXX,ICX1,ICDZZ ; This is a rough but growing list of variables
|
---|
| 17 | S U="^"
|
---|
| 18 | S (ICDI,ICDTOT,ICDETOT)=0
|
---|
| 19 | S ICDXX=""
|
---|
| 20 | S (ICDINAC,ICDAD)=0
|
---|
| 21 | ;
|
---|
| 22 | ;ANNOUNCE PROJECT
|
---|
| 23 | ;
|
---|
| 24 | D BMES^XPDUTL(">>> Adding FY 2008 DRG Grouper updates to ICD Diagnosis file (#80)...")
|
---|
| 25 | ;
|
---|
| 26 | ;Set up reference to error log
|
---|
| 27 | ;
|
---|
| 28 | S ICDTMP=$G(ICDTMP)
|
---|
| 29 | I ICDTMP']"" S ICDTMP=$NA(^TMP("ICDDGFY2008D",$J)) D
|
---|
| 30 | . K @ICDTMP
|
---|
| 31 | . S @ICDTMP@(0)="PATCH FY 2008 ICD DIAGNOSIS DRG UPDATE^"_$$NOW^XLFDT
|
---|
| 32 | ;
|
---|
| 33 | ;LOOP THROUGH FILE 80 - PROCESS EACH ENTRY
|
---|
| 34 | ;All except inactive entries may have new DRGs
|
---|
| 35 | ;
|
---|
| 36 | F S ICDI=$O(^ICD9(ICDI)) Q:ICDI=""!(ICDI'?.N) D
|
---|
| 37 | .;quit if no zero node
|
---|
| 38 | .Q:$G(^ICD9(ICDI,0))=""
|
---|
| 39 | .;quit if zero node corrupt
|
---|
| 40 | .Q:$P($G(^ICD9(ICDI,0)),U,1)']""
|
---|
| 41 | .;quit if code is inactive
|
---|
| 42 | .;
|
---|
| 43 | .S ICDVAL=$P($G(^ICD9(ICDI,0)),U)
|
---|
| 44 | .Q:ICDVAL=""
|
---|
| 45 | .;quit if code is inactive
|
---|
| 46 | .S ICDZZ=$$ICDDX^ICDCODE(ICDVAL,3071001)
|
---|
| 47 | .Q:$P($G(ICDZZ),U,10)=0
|
---|
| 48 | .;
|
---|
| 49 | .;check if already created in case patch being re-installed
|
---|
| 50 | .S:$D(^ICD9(ICDI,3,"B",3071001)) ICDAD=ICDAD+1
|
---|
| 51 | .Q:$D(^ICD9(ICDI,3,"B",3071001))
|
---|
| 52 | .;
|
---|
| 53 | .;Capture latest set of DRG codes (80.07) and latest MDC Effective Date's MDC (80.072)
|
---|
| 54 | .;
|
---|
| 55 | .S ICDCRCD=$$GETCRCD(ICDI)
|
---|
| 56 | .Q:ICDCRCD']""
|
---|
| 57 | .;
|
---|
| 58 | .;Codes are passed to converter in string ICDCRCD <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
|
---|
| 59 | .;Function returns one set of codes, format is <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
|
---|
| 60 | .;If no converion values, then return format is <.01_field>_^_<mdc_ien>
|
---|
| 61 | .;
|
---|
| 62 | .S ICDNWCD=$$CONV80^ICD1831L(ICDCRCD)
|
---|
| 63 | .Q:$P($G(ICDNWCD),U,1)']""
|
---|
| 64 | .Q:$P($G(ICDNWCD),U,2)']""
|
---|
| 65 | .Q:$P($G(ICDNWCD),U,3)']""
|
---|
| 66 | .;pass new codes to update procedure
|
---|
| 67 | .;
|
---|
| 68 | .D UPDDIAG(ICDI,ICDNWCD,ICDTMP,.ICDTOT)
|
---|
| 69 | ;
|
---|
| 70 | ;
|
---|
| 71 | ;HANDLE ERRORS
|
---|
| 72 | ;No errors present
|
---|
| 73 | ;
|
---|
| 74 | I '$D(@ICDTMP@("ERROR")) D
|
---|
| 75 | . D MES^XPDUTL(">>> ICD PROCEDURE File DRG Updates Completed...")
|
---|
| 76 | . D MES^XPDUTL(" ...Total Codes Edited: "_ICDTOT)
|
---|
| 77 | . D MES^XPDUTL("")
|
---|
| 78 | ;Q
|
---|
| 79 | ;Errors present
|
---|
| 80 | ;
|
---|
| 81 | I $D(@ICDTMP@("ERROR")) D
|
---|
| 82 | . F S ICDXX=$O(^TMP("ICDDGFY2008D",$J,ICDXX)) Q:ICDXX="" D
|
---|
| 83 | ..S ICDETOT=ICDETOT+1
|
---|
| 84 | . D MES^XPDUTL(">>> ...Total Errors "_ICDETOT_" ERRORS")
|
---|
| 85 | . D MES^XPDUTL("")
|
---|
| 86 | . D MES^XPDUTL("Error are in ^TMP(""ICDDGFY2008D"",$J)")
|
---|
| 87 | ;
|
---|
| 88 | K ICDCRCD,ICDVAL,ICDZZ
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | ;END OF DRIVER
|
---|
| 92 | ;
|
---|
| 93 | ;Start of helper functions and procedures
|
---|
| 94 | ;
|
---|
| 95 | GETCRCD(ICDI) ;
|
---|
| 96 | ;INPUT ICDI = ien in file 80.1 ICD Diagnosis Codes
|
---|
| 97 | ;OUTPUT ICCRCDS = string of current DRG Codes for latest DRG Grouper Effective Date
|
---|
| 98 | ; and the latest MDC (80.072, #1)
|
---|
| 99 | ;
|
---|
| 100 | N ICDLDGED,ICDLMDED,ICDDGD2,ICDDGD3,ICDMDD1,ICDX,ICDCRCDS,ICDMDC
|
---|
| 101 | ;LAST DRG EFFECTIVE DATE, LAST MDC EFFECTIVE DATE, IEN IN DRG EF DT, IEN IN DRG
|
---|
| 102 | ;IEN IN MDC EFF DATE, STRING OF RETURN CODES, SCRATCH VARIABLE
|
---|
| 103 | ;
|
---|
| 104 | ;RETURN IEN^MDC^DRG^DRG^DRG..... (values are pointers)
|
---|
| 105 | ;
|
---|
| 106 | S (ICDMDC,ICDCRCDS)=""
|
---|
| 107 | ;
|
---|
| 108 | ;START STRING WITH THE .01 FIELD OF THE ENTRY (ICDI)
|
---|
| 109 | ;
|
---|
| 110 | S ICDCRCDS=$P(^ICD9(ICDI,0),U,1)
|
---|
| 111 | ;
|
---|
| 112 | ;NEXT GET THE MDC ATTACHED TO THE LATEST MDC EFFECTIVE DATE
|
---|
| 113 | ;
|
---|
| 114 | S ICDLMDED=$O(^ICD9(ICDI,4,"B",9999999),-1)
|
---|
| 115 | I ICDLMDED]"" D
|
---|
| 116 | .S ICDMDD1=$O(^ICD9(ICDI,4,"B",ICDLMDED,0))
|
---|
| 117 | .S ICDMDC=$P($G(^ICD9(ICDI,4,ICDMDD1,0)),U,2)
|
---|
| 118 | S ICDCRCDS=ICDCRCDS_"^"_$S((ICDMDC)]"":ICDMDC,1:"")
|
---|
| 119 | ;
|
---|
| 120 | ;THEN GET THE DRG MULTIPLE CODES
|
---|
| 121 | ;
|
---|
| 122 | S ICDLDGED=$O(^ICD9(ICDI,3,"B",9999999),-1)
|
---|
| 123 | Q:ICDLDGED="" ICDCRCDS ; new record - is active but has no DRG entries
|
---|
| 124 | S ICDDGD2=$O(^ICD9(ICDI,3,"B",ICDLDGED,0)) ;GET IEN IN DRG MULTIPLE
|
---|
| 125 | Q:$G(^ICD9(ICDI,3,ICDDGD2,1,0))']"" "" ;QUIT, SOMETHING IS WRONG
|
---|
| 126 | S ICDDGD3=0
|
---|
| 127 | F S ICDDGD3=$O(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3)) Q:ICDDGD3="" D
|
---|
| 128 | .S ICDCRCDS=ICDCRCDS_"^"_$G(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3,0))
|
---|
| 129 | Q ICDCRCDS
|
---|
| 130 | ;
|
---|
| 131 | ;
|
---|
| 132 | UPDDIAG(ICDIP,ICDIAGP,ICDTMPP,ICDTOTP) ;
|
---|
| 133 | ;Add 80.071 and 80.711 records for DRG Effective Date 10/1/07
|
---|
| 134 | ;for both new and existing records
|
---|
| 135 | ;
|
---|
| 136 | ;Input ICDIP IEN in file 80
|
---|
| 137 | ; ICDIAGP DRG string from CONV80^ICD1831L function
|
---|
| 138 | ; format: <.01_field>^<mdc_ien>^<drg1_ien>^<drg2_ien>...
|
---|
| 139 | ; ICDTMPP Error tracker - ^TMP(""CDDGFY2008D",$J)
|
---|
| 140 | ; ICDTOT ICD Diagnosis Code File records sucessfully filed
|
---|
| 141 | ;
|
---|
| 142 | ;--------------------------------------------------------------------
|
---|
| 143 | ;
|
---|
| 144 | ; N ICDZ
|
---|
| 145 | ; F ICDZ=1:1:3 I $P(ICDIAGP,U,ICDZ)']"" D Q
|
---|
| 146 | ; .S @ICDTMP@("ERROR",ICDIP,68)="Missing field "_ICDZ_" filing "_ICDIAGP
|
---|
| 147 | ;
|
---|
| 148 | ;Add DRG FY08 Multiple
|
---|
| 149 | ;
|
---|
| 150 | K FDA(1831)
|
---|
| 151 | S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 152 | S FDA(1831,80.071,"+2,?1,",.01)=3071001
|
---|
| 153 | D UPDATE^DIE("","FDA(1831)")
|
---|
| 154 | K FDA(1831)
|
---|
| 155 | ;
|
---|
| 156 | I $P(ICDIAGP,U,3)]"" D
|
---|
| 157 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 158 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 159 | .S FDA(1831,80.711,"+3,?2,?1,",.01)=$P(ICDIAGP,U,3)
|
---|
| 160 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 161 | K FDA(1831)
|
---|
| 162 | ;
|
---|
| 163 | ;
|
---|
| 164 | I $P(ICDIAGP,U,4)]"" D
|
---|
| 165 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 166 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 167 | .S FDA(1831,80.711,"+4,?2,?1,",.01)=$P(ICDIAGP,U,4)
|
---|
| 168 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 169 | K FDA(1831)
|
---|
| 170 | ;
|
---|
| 171 | I $P(ICDIAGP,U,5)]"" D
|
---|
| 172 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 173 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 174 | .S FDA(1831,80.711,"+5,?2,?1,",.01)=$P(ICDIAGP,U,5)
|
---|
| 175 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 176 | K FDA(1831)
|
---|
| 177 | ;
|
---|
| 178 | I $P(ICDIAGP,U,6)]"" D
|
---|
| 179 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 180 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 181 | .S FDA(1831,80.711,"+6,?2,?1,",.01)=$P(ICDIAGP,U,6)
|
---|
| 182 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 183 | K FDA(1831)
|
---|
| 184 | ;
|
---|
| 185 | I $P(ICDIAGP,U,7)]"" D
|
---|
| 186 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 187 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 188 | .S FDA(1831,80.711,"+7,?2,?1,",.01)=$P(ICDIAGP,U,7)
|
---|
| 189 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 190 | K FDA(1831)
|
---|
| 191 | ;
|
---|
| 192 | ;
|
---|
| 193 | I $P(ICDIAGP,U,8)]"" D
|
---|
| 194 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 195 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 196 | .S FDA(1831,80.711,"+8,?2,?1,",.01)=$P(ICDIAGP,U,8)
|
---|
| 197 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 198 | K FDA(1831)
|
---|
| 199 | ;
|
---|
| 200 | I $P(ICDIAGP,U,9)]"" D
|
---|
| 201 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 202 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 203 | .S FDA(1831,80.711,"+9,?2,?1,",.01)=$P(ICDIAGP,U,9)
|
---|
| 204 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 205 | K FDA(1831)
|
---|
| 206 | ;
|
---|
| 207 | I $P(ICDIAGP,U,10)]"" D
|
---|
| 208 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 209 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 210 | .S FDA(1831,80.711,"+10,?2,?1,",.01)=$P(ICDIAGP,U,10)
|
---|
| 211 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 212 | K FDA(1831)
|
---|
| 213 | ;
|
---|
| 214 | I $P(ICDIAGP,U,11)]"" D
|
---|
| 215 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 216 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 217 | .S FDA(1831,80.711,"+11,?2,?1,",.01)=$P(ICDIAGP,U,11)
|
---|
| 218 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 219 | K FDA(1831)
|
---|
| 220 | ;
|
---|
| 221 | I $P(ICDIAGP,U,12)]"" D
|
---|
| 222 | .S FDA(1831,80,"?1,",.01)="`"_ICDIP
|
---|
| 223 | .S FDA(1831,80.071,"?2,?1,",.01)=3071001
|
---|
| 224 | .S FDA(1831,80.711,"+12,?2,?1,",.01)=$P(ICDIAGP,U,12)
|
---|
| 225 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 226 | K FDA(1831)
|
---|
| 227 | ;
|
---|
| 228 | I $O(^ICD9(ICDIP,4,0))="" D
|
---|
| 229 | .S FDA(1831,80,"?13,",.01)="`"_ICDIP
|
---|
| 230 | .S FDA(1831,80.072,"+14,?13,",.01)=3071001
|
---|
| 231 | .S FDA(1831,80.072,"+14,?13,",1)=$P(ICDIAGP,U,2)
|
---|
| 232 | .D UPDATE^DIE("","FDA(1831)")
|
---|
| 233 | .K FDA(1831)
|
---|
| 234 | K FDA(1831)
|
---|
| 235 | ;
|
---|
| 236 | ;for new Dx, place MDC in field #5
|
---|
| 237 | I $$GET1^DIQ(80,ICDIP_",",5,"I")="" D
|
---|
| 238 | .Q:($P(ICDIAGP,U,2)="")
|
---|
| 239 | .S FDA(1831,80,ICDIP_",",5)=$P(ICDIAGP,U,2)
|
---|
| 240 | .D FILE^DIE("","FDA(1831)")
|
---|
| 241 | .K FDA(1831)
|
---|
| 242 | ;
|
---|
| 243 | I '$D(^TMP("DIERR",$J)) S ICDTOTP=ICDTOTP+1
|
---|
| 244 | ;
|
---|
| 245 | I $D(^TMP("DIERR",$J)) D K ^TMP("DIERR",$J)
|
---|
| 246 | .S @ICDTMP@("ERROR",ICDIP,"80.1")="CANNOT FILE CODES FOR FY08 FOR IEN"_$P(ICDIAGP,U)_" CODES "_$P(ICDIAGP,3,99)
|
---|
| 247 | Q
|
---|