Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICD1831J

ICD1831J.m

Go to the documentation of this file. 
  1. ICD1831J   ; ALB/ECF - FY 2008 UPDATE; 8/27/07 14:50
  1.  ;;18.0;DRG Grouper;**31**;Oct 13,2000  2:30 pm;Build 7
  1.  Q
  1.  ;
  1. DRG(ICDTMP) ;post-install driver for file ICD Diagnosis file(#80) DRG updates
  1.  ;This procedure creates and files the MSv25DRG updates
  1.  ;
  1.  ; Input:
  1.  ;   ICDTMP - Temp file of error msg's
  1.  ;   ICDTOT - Total MS-DRG codes filed
  1.  ; Output:
  1.  ;   ICDTMP - Temp file of error msg's
  1.  ;   ICDTOT - Total MS-DRG codes filed
  1.  ;   ICDERTOT - Total error records of type "cannot file"
  1.  ;
  1.  N ICDI,ICDCRCD,ICDNWCD,ICDTOT,ICDETOT,ICDVAL,ICDXX,ICX1,ICDZZ  ; This is a rough but growing list of variables 
  1.  S U="^"
  1.  S (ICDI,ICDTOT,ICDETOT)=0
  1.  S ICDXX=""
  1.  S (ICDINAC,ICDAD)=0
  1.  ;
  1.  ;ANNOUNCE PROJECT
  1.  ;
  1.  D BMES^XPDUTL(">>> Adding FY 2008 DRG Grouper updates to ICD Diagnosis file (#80)...")
  1.  ;
  1.  ;Set up reference to error log
  1.  ;
  1.  S ICDTMP=$G(ICDTMP)
  1.  I ICDTMP']"" S ICDTMP=$NA(^TMP("ICDDGFY2008D",$J)) D
  1.  . K @ICDTMP
  1.  . S @ICDTMP@(0)="PATCH FY 2008 ICD DIAGNOSIS DRG UPDATE^"_$$NOW^XLFDT
  1.  ;
  1.  ;LOOP THROUGH FILE 80 - PROCESS EACH ENTRY
  1.  ;All except inactive entries may have new DRGs
  1.  ;
  1.  F  S ICDI=$O(^ICD9(ICDI)) Q:ICDI=""!(ICDI'?.N)  D
  1.  .;quit if no zero node
  1.  .Q:$G(^ICD9(ICDI,0))=""
  1.  .;quit if zero node corrupt
  1.  .Q:$P($G(^ICD9(ICDI,0)),U,1)']""
  1.  .;quit if code is inactive
  1.  .;
  1.  .S ICDVAL=$P($G(^ICD9(ICDI,0)),U)
  1.  .Q:ICDVAL=""
  1.  .;quit if code is inactive
  1.  .S ICDZZ=$$ICDDX^ICDCODE(ICDVAL,3071001)
  1.  .Q:$P($G(ICDZZ),U,10)=0
  1.  .;
  1.  .;check if already created in case patch being re-installed
  1.  .S:$D(^ICD9(ICDI,3,"B",3071001)) ICDAD=ICDAD+1
  1.  .Q:$D(^ICD9(ICDI,3,"B",3071001))
  1.  .;
  1.  .;Capture latest set of DRG codes (80.07) and latest MDC Effective Date's MDC (80.072)
  1.  .;
  1.  .S ICDCRCD=$$GETCRCD(ICDI)
  1.  .Q:ICDCRCD']""
  1.  .;
  1.  .;Codes are passed to converter in string ICDCRCD <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
  1.  .;Function returns one set of codes, format is <.01 field>^<MDC ien>^<DRG ien)^<DRG ien>...
  1.  .;If no converion values, then return format is  <.01_field>_^_<mdc_ien>
  1.  .;
  1.  .S ICDNWCD=$$CONV80^ICD1831L(ICDCRCD)
  1.  .Q:$P($G(ICDNWCD),U,1)']""
  1.  .Q:$P($G(ICDNWCD),U,2)']""
  1.  .Q:$P($G(ICDNWCD),U,3)']""
  1.  .;pass new codes to update procedure
  1.  .;
  1.  .D UPDDIAG(ICDI,ICDNWCD,ICDTMP,.ICDTOT)
  1.  ;
  1.  ;
  1.  ;HANDLE ERRORS
  1.  ;No errors present
  1.  ;
  1.  I '$D(@ICDTMP@("ERROR")) D
  1.  . D MES^XPDUTL(">>> ICD PROCEDURE File DRG Updates Completed...")
  1.  . D MES^XPDUTL("    ...Total Codes Edited: "_ICDTOT)
  1.  . D MES^XPDUTL("")
  1.  ;Q
  1.  ;Errors present
  1.  ;
  1.  I $D(@ICDTMP@("ERROR")) D
  1.  . F  S ICDXX=$O(^TMP("ICDDGFY2008D",$J,ICDXX)) Q:ICDXX=""  D
  1.  ..S ICDETOT=ICDETOT+1
  1.  . D MES^XPDUTL(">>> ...Total Errors "_ICDETOT_" ERRORS")
  1.  . D MES^XPDUTL("")
  1.  . D MES^XPDUTL("Error are in ^TMP(""ICDDGFY2008D"",$J)")
  1.  ;
  1.  K ICDCRCD,ICDVAL,ICDZZ
  1.  Q
  1.  ;
  1.  ;END OF DRIVER
  1.  ;
  1.  ;Start of helper functions and procedures
  1.  ;
  1. GETCRCD(ICDI) ;
  1.  ;INPUT    ICDI = ien in file 80.1 ICD Diagnosis Codes
  1.  ;OUTPUT   ICCRCDS = string of current DRG Codes for latest DRG Grouper Effective Date
  1.  ;                   and the latest MDC (80.072, #1)
  1.  ;                   
  1.  N ICDLDGED,ICDLMDED,ICDDGD2,ICDDGD3,ICDMDD1,ICDX,ICDCRCDS,ICDMDC
  1.  ;LAST DRG EFFECTIVE DATE, LAST MDC EFFECTIVE DATE, IEN IN DRG EF DT, IEN IN DRG
  1.  ;IEN IN MDC EFF DATE, STRING OF RETURN CODES, SCRATCH VARIABLE
  1.  ;
  1.  ;RETURN IEN^MDC^DRG^DRG^DRG..... (values are pointers)
  1.  ;
  1.  S (ICDMDC,ICDCRCDS)=""
  1.  ;
  1.  ;START STRING WITH THE .01 FIELD OF THE ENTRY (ICDI)
  1.  ;
  1.  S ICDCRCDS=$P(^ICD9(ICDI,0),U,1)
  1.  ;
  1.  ;NEXT GET THE MDC ATTACHED TO THE LATEST MDC EFFECTIVE DATE
  1.  ;
  1.  S ICDLMDED=$O(^ICD9(ICDI,4,"B",9999999),-1)
  1.  I ICDLMDED]"" D
  1.  .S ICDMDD1=$O(^ICD9(ICDI,4,"B",ICDLMDED,0))
  1.  .S ICDMDC=$P($G(^ICD9(ICDI,4,ICDMDD1,0)),U,2)
  1.  S ICDCRCDS=ICDCRCDS_"^"_$S((ICDMDC)]"":ICDMDC,1:"")
  1.  ;
  1.  ;THEN GET THE DRG MULTIPLE CODES
  1.  ;
  1.  S ICDLDGED=$O(^ICD9(ICDI,3,"B",9999999),-1)
  1.  Q:ICDLDGED="" ICDCRCDS  ; new record - is active but has no DRG entries
  1.  S ICDDGD2=$O(^ICD9(ICDI,3,"B",ICDLDGED,0)) ;GET IEN IN DRG MULTIPLE
  1.  Q:$G(^ICD9(ICDI,3,ICDDGD2,1,0))']"" ""  ;QUIT, SOMETHING IS WRONG
  1.  S ICDDGD3=0
  1.  F  S ICDDGD3=$O(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3)) Q:ICDDGD3=""  D
  1.  .S ICDCRCDS=ICDCRCDS_"^"_$G(^ICD9(ICDI,3,ICDDGD2,1,ICDDGD3,0))
  1.  Q ICDCRCDS
  1.  ;
  1.  ;
  1. UPDDIAG(ICDIP,ICDIAGP,ICDTMPP,ICDTOTP) ;
  1.  ;Add 80.071 and 80.711 records for DRG Effective Date 10/1/07
  1.  ;for both new and existing records
  1.  ;  
  1.  ;Input   ICDIP     IEN in file 80
  1.  ;        ICDIAGP   DRG string from CONV80^ICD1831L function
  1.  ;                  format: <.01_field>^<mdc_ien>^<drg1_ien>^<drg2_ien>...
  1.  ;        ICDTMPP   Error tracker - ^TMP(""CDDGFY2008D",$J)
  1.  ;        ICDTOT    ICD Diagnosis Code File records sucessfully filed
  1.  ;                  
  1.  ;--------------------------------------------------------------------                  
  1.  ;
  1.  ; N ICDZ
  1.  ; F ICDZ=1:1:3 I $P(ICDIAGP,U,ICDZ)']"" D  Q
  1.  ; .S @ICDTMP@("ERROR",ICDIP,68)="Missing field "_ICDZ_" filing "_ICDIAGP
  1.  ; 
  1.  ;Add DRG FY08 Multiple
  1.  ;
  1.  K FDA(1831)
  1.  S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  S FDA(1831,80.071,"+2,?1,",.01)=3071001
  1.  D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,3)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+3,?2,?1,",.01)=$P(ICDIAGP,U,3)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  ; 
  1.  I $P(ICDIAGP,U,4)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+4,?2,?1,",.01)=$P(ICDIAGP,U,4)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ; 
  1.  I $P(ICDIAGP,U,5)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+5,?2,?1,",.01)=$P(ICDIAGP,U,5)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,6)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+6,?2,?1,",.01)=$P(ICDIAGP,U,6)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,7)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+7,?2,?1,",.01)=$P(ICDIAGP,U,7)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  ; 
  1.  I $P(ICDIAGP,U,8)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+8,?2,?1,",.01)=$P(ICDIAGP,U,8)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,9)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+9,?2,?1,",.01)=$P(ICDIAGP,U,9)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,10)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+10,?2,?1,",.01)=$P(ICDIAGP,U,10)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,11)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+11,?2,?1,",.01)=$P(ICDIAGP,U,11)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $P(ICDIAGP,U,12)]"" D
  1.  .S FDA(1831,80,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.071,"?2,?1,",.01)=3071001
  1.  .S FDA(1831,80.711,"+12,?2,?1,",.01)=$P(ICDIAGP,U,12)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  K FDA(1831)
  1.  ;
  1.  I $O(^ICD9(ICDIP,4,0))="" D
  1.  .S FDA(1831,80,"?13,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.072,"+14,?13,",.01)=3071001
  1.  .S FDA(1831,80.072,"+14,?13,",1)=$P(ICDIAGP,U,2)
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  K FDA(1831)
  1.  ;
  1.  ;for new Dx, place MDC in field #5
  1.  I $$GET1^DIQ(80,ICDIP_",",5,"I")="" D
  1.  .Q:($P(ICDIAGP,U,2)="")
  1.  .S FDA(1831,80,ICDIP_",",5)=$P(ICDIAGP,U,2)
  1.  .D FILE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  ;
  1.  I '$D(^TMP("DIERR",$J)) S ICDTOTP=ICDTOTP+1
  1.  ; 
  1.  I $D(^TMP("DIERR",$J)) D  K ^TMP("DIERR",$J)
  1.  .S @ICDTMP@("ERROR",ICDIP,"80.1")="CANNOT FILE CODES FOR FY08 FOR IEN"_$P(ICDIAGP,U)_" CODES "_$P(ICDIAGP,3,99)
  1.  Q