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

ICD1831K.m

Go to the documentation of this file. 
  1. ICD1831K   ; ALB/ECF - FY 2007 UPDATE; 10/23/07 2:50 pm;
  1.  ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
  1.  Q
  1.  ;
  1. DRG(ICDTMP) ;post-install driver for file ICD Operation/Procedure
  1.  ; file(#80.1) DRG updates
  1.  ;This procedure loops through the ICD OPERATION/PROCDURE file (80.1)
  1.  ;to create a DRG GROUPER EFFECTIVE DATE entry for FY08 
  1.  ; Input:
  1.  ;   ICDTMP - Temp file of error msg's
  1.  ; Output:
  1.  ;   ICDTMP - Temp file of error msg's
  1.  ;   ICDTOT - Total MS-DRG codes filed
  1.  ;   ICDERTOT - Total error records - cannot file
  1.  ;
  1.  N ICDI,ICDCRCD,ICDFOK,ICDNWCD,ICDTOT,ICDX,ICDY,ICDVAL,ICDETOT,ICDYY,ICDZZ
  1.  S U="^"
  1.  ;
  1.  D BMES^XPDUTL(">>> Adding FY08 DRG Grouper updates to ICD OP/PR file (#80.1)...")
  1.  ;Error log
  1.  S ICDTMP=$G(ICDTMP)
  1.  I ICDTMP']"" S ICDTMP=$NA(^TMP("ICDDGFY2008OP",$J)) D
  1.  . K @ICDTMP
  1.  . S @ICDTMP@(0)="PATCH #? FY08 ICD DIAG DRG UPDATE^"_$$NOW^XLFDT
  1.  ;
  1.  ;Skip inactive
  1.  S (ICDETOT,ICDI,ICDTOT,ICDYY)=0
  1.  ;
  1.  F  S ICDI=$O(^ICD0(ICDI)) Q:ICDI=""!(ICDI'?.N)  D
  1.  .;quit if no zero node
  1.  .Q:$G(^ICD0(ICDI,0))=""
  1.  .;quit if zero node corrupt
  1.  .Q:$P($G(^ICD0(ICDI,0)),U)']""
  1.  .S ICDVAL=$P($G(^ICD0(ICDI,0)),U)
  1.  .Q:ICDVAL=""
  1.  .;quit if code is inactive
  1.  .S ICDZZ=$$ICDOP^ICDCODE(ICDVAL,3071001) Q:$P($G(ICDZZ),U,10)=0
  1.  .;check if already created in case patch being re-installed
  1.  .Q:$D(^ICD0(ICDI,2,"B",3071001))
  1.  .;
  1.  .;Get ien of latest Grouper Effective Date
  1.  .S ICDX=$O(^ICD0(ICDI,2,"B",9999999),-1)
  1.  .;No Grp Eff Dt means this is a new code
  1.  .I ICDX']"" D
  1.  ..;Call API
  1.  ..K ICDNCDAR
  1.  ..D NEW801^ICD1831L(ICDVAL,.ICDNCDAR)
  1.  ..Q:'$D(ICDNCDAR)
  1.  ..;Build code array for UPDDIAG()
  1.  ..K ICDCONAR
  1.  ..D GETNCRCD(ICDI,.ICDNCDAR,.ICDCONAR)
  1.  ..Q:'$D(ICDCONAR(0))
  1.  ..D UPDDIAG(ICDI,.ICDCONAR,.ICDTOT)
  1.  .;
  1.  .I ICDX]"" D
  1.  ..;Old codes to convert
  1.  ..;Call will be $$CONV801^ICD1831L(<ien of code>)for each MDC/DRG set
  1.  ..S ICDLEDI=$O(^ICD0(ICDI,2,"B",ICDX,0))
  1.  ..S (ICDFYMI,ICDY)=0
  1.  ..;Loop through MDCs for this ICD PROC - DRG EFF DATE
  1.  ..F  S ICDFYMI=$O(^ICD0(ICDI,2,ICDLEDI,1,ICDFYMI)) Q:ICDFYMI=""!(ICDFYMI'?.N)  D
  1.  ...K ICDNWCD,ICDNWCDA
  1.  ...S ICDDGCD=$$GETCRCD(ICDI,ICDLEDI,ICDFYMI) ;Build code string for conversion API 
  1.  ...;If no code string for this MDC, nothing to convert
  1.  ...Q:ICDDGCD']""
  1.  ...;Code string is ok, pass to conversion function
  1.  ...S ICDNWCD=$$CONV801^ICD1831L(ICDDGCD)
  1.  ...;Return codes are in string ICDCRCD <.01>^<MDC ien>^<DRG ien)^<DRG ien>.........
  1.  ...;Filer requires an array - at least a zero node is needed
  1.  ...I ICDNWCD]"" K ICDNWCDA S ICDNWCDA(0)=ICDNWCD
  1.  ...;Now process the array of code strings for this ICD Proc IEN
  1.  ...Q:ICDNWCDA(0)']""
  1.  ...;pass new codes to update procedure
  1.  ...;D UPDDIAG(ICDI,"X",.ICDNWCDA,.ICDTOT)
  1.  ...D UPDDIAG(ICDI,.ICDNWCDA,.ICDTOT)
  1.  ...K ICDNWCDA
  1.  .
  1.  ;Back to top level - processing is over - do final tasks
  1.  K ICDCONAR,ICDDGCD,ICDETOT,ICDFYMI,ICDNCDAR,ICDNWCDA
  1.  ;HANDLE ERRORS
  1.  ;No errors present
  1.  ;
  1.  S (ICDTOT,ICDYY)=0
  1.  F  S ICDYY=$O(^TMP("ICDFILEOK",$J,ICDYY)) Q:ICDYY=""  I ^TMP("ICDFILEOK",$J,ICDYY)=1 S ICDTOT=ICDTOT+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("ICDDGFY2008OP",$J,"ERROR",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(""ICDDGFY2008OP"",$J)")
  1.  ;
  1.  K ICDCRCD,ICDVAL,ICDZZ
  1.  K ^TMP("ICDFILEOK")
  1.  Q
  1.  ;
  1.  ;END OF DRIVER
  1.  ;Start of helper functions and procedures
  1.  ;
  1. GETCRCD(ICDIEN,ICDDGIEN,ICDMDIEN) ;
  1.  ;Create input string for conversion API - only for non-New DRGs
  1.  ;
  1.  ;INPUT    ICDIEN   = ien in file 80.1 ICD OPERATION/PROCEDURE
  1.  ;         ICDDGIEN = ien of last DRG GROUPER EFFECTIVE DATE
  1.  ;         ICDMDIEN = ien of Major Diagnostic Category
  1.  ;OUTPUT   ICDCRDCS = string of codes formatted for API
  1.  ;                   
  1.  N ICDCRCDS,ICDXS
  1.  ;
  1.  S (ICDCRCD)=""
  1.  S (ICDX)=0
  1.  ;
  1.  ;START STRING WITH THE .01 FIELD
  1.  S ICDCRCDS=$P(^ICD0(ICDI,0),U)
  1.  ;
  1.  ;Add MDC ien to string
  1.  S ICDCRCDS=ICDCRCDS_"^"_$P($G(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,0)),U)
  1.  ;
  1.  ;Loop thru DRGs this ICD procedure, this eff date, this MDC
  1.  ;
  1.  F  S ICDX=$O(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,1,ICDX)) Q:ICDX=""!(ICDX'?.N)  D
  1.  .Q:$G(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,1,ICDX,0))=""
  1.  .S ICDCRCDS=ICDCRCDS_"^"_$P($G(^ICD0(ICDIEN,2,ICDDGIEN,1,ICDMDIEN,1,ICDX,0)),U)
  1.  Q ICDCRCDS
  1.  ;
  1. GETNCRCD(ICDIENP,ICDOAR,ICDCAR) ;
  1.  ;Quit if input not correct, passing back a null zero node
  1.  I '$D(ICDIENP) S ICDCAR(0)="" Q
  1.  ;
  1.  N ICDK,ICDJ,ICDL
  1.  S (ICDJ,ICDK,ICDL)=0
  1.  F  S ICDJ=$O(ICDOAR(ICDJ)) Q:ICDJ=""  D
  1.  .S ICDCAR(ICDL)=ICDIENP_"^"_ICDJ_"^"
  1.  .F  S ICDK=$O(ICDOAR(ICDJ,ICDK)) Q:ICDK=""  D
  1.  ..S ICDCAR(ICDL)=ICDCAR(ICDL)_ICDK_"^"
  1.  .S ICDL=ICDL+1
  1.  Q
  1.  ;
  1.  ;
  1. UPDDIAG(ICDIP,ICDNWCDA,ICDTOTP) ; 
  1.  ;File 80.1 updater
  1.  ;
  1.  N ICDX1
  1.  ; F ICDZ=1:1:3 I $P(ICDIAGP,U,ICDZ)']"" D Q
  1.  ; .S @ICDTMP@("ERROR",ICDIP,"80.1")="Missing field "_ICDZ_" filing "_ICDIAGP
  1.  ; 
  1.  ;Quit if complete data not passed
  1.  Q:'$D(ICDIP)
  1.  Q:'$D(ICDNWCDA(0))
  1.  Q:$P($G(ICDNWCDA(0)),U,1)']""
  1.  Q:$P($G(ICDNWCDA(0)),U,2)']""
  1.  Q:$P($G(ICDNWCDA(0)),U,3)']""
  1.  ;
  1.  S ^TMP("ICDFILEOK",$J,ICDIP)=1
  1.  ;
  1.  K FDA(1831)
  1.  ;
  1.  ;Passed in array will trigger DRG Effective Date Multiple ONLY IF NEEDED
  1.  ;
  1.  I '$D(^ICD0(ICDIP,2,"B",3071001)) D
  1.  .;DRG GROUPER EFFECTIVE DATE MULTIPLE
  1.  .S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  .S FDA(1831,80.171,"+2,?1,",.01)=3071001
  1.  .D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  ;
  1.  S ICDX1=""
  1.  ;
  1.  F  S ICDX1=$O(ICDNWCDA(ICDX1)) Q:ICDX1=""  D
  1.  .;ADD MDC MULTIPLE only if there are DRG codes for the MDC
  1.  .I $P(ICDNWCDA(ICDX1),U,2)]"" D  K FDA
  1.  ..Q:$P(ICDNWCDA(ICDX1),U,3)']""
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"+3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .;ADD DRG MULTIPLES - first code in Piece 3
  1.  .I $P(ICDNWCDA(ICDX1),U,3)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+4,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,3)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .;ADD DRG MULTIPLES - second code in piece 4
  1.  .I $P(ICDNWCDA(ICDX1),U,4)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+5,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,4)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .I $P(ICDNWCDA(ICDX1),U,5)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+6,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,5)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .; 
  1.  .I $P(ICDNWCDA(ICDX1),U,6)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+7,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,6)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .I $P(ICDNWCDA(ICDX1),U,7)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+8,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,7)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .I $P(ICDNWCDA(ICDX1),U,8)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+9,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,8)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .I $P(ICDNWCDA(ICDX1),U,9)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+10,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,9)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .; 
  1.  .I $P(ICDNWCDA(ICDX1),U,10)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+11,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,10)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.   .I $P(ICDNWCDA(ICDX1),U,11)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+12,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,11)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .I $P(ICDNWCDA(ICDX1),U,12)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+13,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,12)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .; 
  1.  .I $P(ICDNWCDA(ICDX1),U,13)]"" D
  1.  ..S FDA(1831,80.1,"?1,",.01)="`"_ICDIP
  1.  ..S FDA(1831,80.171,"?2,?1,",.01)=3071001
  1.  ..S FDA(1831,80.1711,"?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,2)
  1.  ..S FDA(1831,80.17111,"+14,?3,?2,?1,",.01)=$P(ICDNWCDA(ICDX1),U,13)
  1.  ..D UPDATE^DIE("","FDA(1831)")
  1.  .K FDA(1831)
  1.  .;
  1.  .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)
  1.  .I $D(^TMP("DIERR",$J,ICDIP)) S ^TMP("ICDFILEOK",$J,ICDIP)=0
  1.  Q