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

ICD1811.m

Go to the documentation of this file.
  1. ICD1811 ;DLS/DEK - ICD Patch Driver ; 10/22/2003
  1. ;;18.0;DRG Grouper;**11**;Oct 20, 2000
  1. ;
  1. ; NOIS calls addressed:
  1. ; Gender in wrong field
  1. ; IRO-1003-41917, LON-1003-62093
  1. ; Change needed to description
  1. ; DAN-1003-41641
  1. ;
  1. ; Quit if Protocol NOT found on the system
  1. ; XPDABORT Signals the KIDS system to abort the load
  1. ;
  1. ; External References
  1. ; DBIA 3990 CODEN^ICDCODE
  1. ; DBIA 2053 FILE^DIE
  1. ; DBIA 10141 BMES^XPDUTL, MES^XPDUTL
  1. ;
  1. POST ;Post-Init
  1. K ^TMP("DIERR",$J)
  1. D IRO41917,DAN41641
  1. Q
  1. ;
  1. IRO41917 ; gender issue
  1. N INFO,CODE,I,IEN,FDA,SEX,ALO,AHI
  1. F I=2:1 S INFO=$P($T(IRO+I),";;",2) Q:INFO']"" D
  1. . S CODE=$P(INFO,"^",1),IEN=(+$$CODEN^ICDCODE(CODE,80))_","
  1. . I IEN<0 D SHO("INVALID ICD9 CODE: "_CODE) Q
  1. . S SEX=$P(INFO,"^",2),FDA(80,IEN,9.5)=SEX
  1. . S ALO=$P(INFO,"^",3),FDA(80,IEN,14)=ALO
  1. . S AHI=$P(INFO,"^",4),FDA(80,IEN,15)=$S(AHI>99:"",1:AHI)
  1. . D FILE^DIE("K","FDA")
  1. . I $D(^TMP("DIERR",$J)) D
  1. . . S $P(^ICD9(+IEN,0),"^",10)=SEX,$P(^(0),"^",14,15)=ALO_"^"_AHI
  1. . . K ^TMP("DIERR",$J)
  1. Q
  1. ;
  1. DAN41641 ; description issue
  1. N CODE,IEN,FDA
  1. S CODE=491.21,IEN=(+$$CODEN^ICDCODE(CODE,80))_","
  1. I IEN<0 D SHO("INVALID ICD9 CODE: "_CODE) Q
  1. S FDA(80,IEN,10)="OBSTRUCTIVE CHRONIC BRONCHITIS, WITH (ACUTE) EXACERBATION"
  1. D FILE^DIE("K","FDA")
  1. I $D(^TMP("DIERR",$J)) D
  1. . D BMES^XPDUTL("Unable to alter description for ICD9 Code: "_CODE)
  1. . K ^TMP("DIERR",$J)
  1. Q
  1. ;
  1. SHO(M1,M2) ;show messages
  1. N STARS
  1. S STARS="<<< ************************************* >>>"
  1. D BMES^XPDUTL(STARS)
  1. D MES^XPDUTL(" "_M1)
  1. D:$G(M2)]"" MES^XPDUTL(" "_M2)
  1. D MES^XPDUTL(STARS)
  1. Q
  1. ;
  1. IRO ;data for IRO-1003-41917, LON-1003-62093
  1. Q ;Not an entry point
  1. ;;600.00^M^15^124
  1. ;;600.01^M^15^124
  1. ;;600.10^M^15^124
  1. ;;600.11^M^15^124
  1. ;;600.20^M^15^124
  1. ;;600.21^M^15^124
  1. ;;600.90^M^15^124
  1. ;;600.91^M^15^124
  1. ;;607.85^M^15^124
  1. ;;674.50^F^12^55
  1. ;;674.51^F^12^55
  1. ;;674.52^F^12^55
  1. ;;674.53^F^12^55
  1. ;;674.54^F^12^55
  1. ;;