ICD1811 ;DLS/DEK - ICD Patch Driver ; 10/22/2003
;;18.0;DRG Grouper;**11**;Oct 20, 2000
;
; NOIS calls addressed:
; Gender in wrong field
; IRO-1003-41917, LON-1003-62093
; Change needed to description
; DAN-1003-41641
;
; Quit if Protocol NOT found on the system
; XPDABORT Signals the KIDS system to abort the load
;
; External References
; DBIA 3990 CODEN^ICDCODE
; DBIA 2053 FILE^DIE
; DBIA 10141 BMES^XPDUTL, MES^XPDUTL
;
POST ;Post-Init
K ^TMP("DIERR",$J)
D IRO41917,DAN41641
Q
;
IRO41917 ; gender issue
N INFO,CODE,I,IEN,FDA,SEX,ALO,AHI
F I=2:1 S INFO=$P($T(IRO+I),";;",2) Q:INFO']"" D
. S CODE=$P(INFO,"^",1),IEN=(+$$CODEN^ICDCODE(CODE,80))_","
. I IEN<0 D SHO("INVALID ICD9 CODE: "_CODE) Q
. S SEX=$P(INFO,"^",2),FDA(80,IEN,9.5)=SEX
. S ALO=$P(INFO,"^",3),FDA(80,IEN,14)=ALO
. S AHI=$P(INFO,"^",4),FDA(80,IEN,15)=$S(AHI>99:"",1:AHI)
. D FILE^DIE("K","FDA")
. I $D(^TMP("DIERR",$J)) D
. . S $P(^ICD9(+IEN,0),"^",10)=SEX,$P(^(0),"^",14,15)=ALO_"^"_AHI
. . K ^TMP("DIERR",$J)
Q
;
DAN41641 ; description issue
N CODE,IEN,FDA
S CODE=491.21,IEN=(+$$CODEN^ICDCODE(CODE,80))_","
I IEN<0 D SHO("INVALID ICD9 CODE: "_CODE) Q
S FDA(80,IEN,10)="OBSTRUCTIVE CHRONIC BRONCHITIS, WITH (ACUTE) EXACERBATION"
D FILE^DIE("K","FDA")
I $D(^TMP("DIERR",$J)) D
. D BMES^XPDUTL("Unable to alter description for ICD9 Code: "_CODE)
. K ^TMP("DIERR",$J)
Q
;
SHO(M1,M2) ;show messages
N STARS
S STARS="<<< ************************************* >>>"
D BMES^XPDUTL(STARS)
D MES^XPDUTL(" "_M1)
D:$G(M2)]"" MES^XPDUTL(" "_M2)
D MES^XPDUTL(STARS)
Q
;
IRO ;data for IRO-1003-41917, LON-1003-62093
Q ;Not an entry point
;;600.00^M^15^124
;;600.01^M^15^124
;;600.10^M^15^124
;;600.11^M^15^124
;;600.20^M^15^124
;;600.21^M^15^124
;;600.90^M^15^124
;;600.91^M^15^124
;;607.85^M^15^124
;;674.50^F^12^55
;;674.51^F^12^55
;;674.52^F^12^55
;;674.53^F^12^55
;;674.54^F^12^55
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1811 2036 printed Dec 13, 2024@01:48:01 Page 2
ICD1811 ;DLS/DEK - ICD Patch Driver ; 10/22/2003
+1 ;;18.0;DRG Grouper;**11**;Oct 20, 2000
+2 ;
+3 ; NOIS calls addressed:
+4 ; Gender in wrong field
+5 ; IRO-1003-41917, LON-1003-62093
+6 ; Change needed to description
+7 ; DAN-1003-41641
+8 ;
+9 ; Quit if Protocol NOT found on the system
+10 ; XPDABORT Signals the KIDS system to abort the load
+11 ;
+12 ; External References
+13 ; DBIA 3990 CODEN^ICDCODE
+14 ; DBIA 2053 FILE^DIE
+15 ; DBIA 10141 BMES^XPDUTL, MES^XPDUTL
+16 ;
POST ;Post-Init
+1 KILL ^TMP("DIERR",$JOB)
+2 DO IRO41917
DO DAN41641
+3 QUIT
+4 ;
IRO41917 ; gender issue
+1 NEW INFO,CODE,I,IEN,FDA,SEX,ALO,AHI
+2 FOR I=2:1
SET INFO=$PIECE($TEXT(IRO+I),";;",2)
if INFO']""
QUIT
Begin DoDot:1
+3 SET CODE=$PIECE(INFO,"^",1)
SET IEN=(+$$CODEN^ICDCODE(CODE,80))_","
+4 IF IEN<0
DO SHO("INVALID ICD9 CODE: "_CODE)
QUIT
+5 SET SEX=$PIECE(INFO,"^",2)
SET FDA(80,IEN,9.5)=SEX
+6 SET ALO=$PIECE(INFO,"^",3)
SET FDA(80,IEN,14)=ALO
+7 SET AHI=$PIECE(INFO,"^",4)
SET FDA(80,IEN,15)=$SELECT(AHI>99:"",1:AHI)
+8 DO FILE^DIE("K","FDA")
+9 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:2
+10 SET $PIECE(^ICD9(+IEN,0),"^",10)=SEX
SET $PIECE(^(0),"^",14,15)=ALO_"^"_AHI
+11 KILL ^TMP("DIERR",$JOB)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
DAN41641 ; description issue
+1 NEW CODE,IEN,FDA
+2 SET CODE=491.21
SET IEN=(+$$CODEN^ICDCODE(CODE,80))_","
+3 IF IEN<0
DO SHO("INVALID ICD9 CODE: "_CODE)
QUIT
+4 SET FDA(80,IEN,10)="OBSTRUCTIVE CHRONIC BRONCHITIS, WITH (ACUTE) EXACERBATION"
+5 DO FILE^DIE("K","FDA")
+6 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+7 DO BMES^XPDUTL("Unable to alter description for ICD9 Code: "_CODE)
+8 KILL ^TMP("DIERR",$JOB)
End DoDot:1
+9 QUIT
+10 ;
SHO(M1,M2) ;show messages
+1 NEW STARS
+2 SET STARS="<<< ************************************* >>>"
+3 DO BMES^XPDUTL(STARS)
+4 DO MES^XPDUTL(" "_M1)
+5 if $GET(M2)]""
DO MES^XPDUTL(" "_M2)
+6 DO MES^XPDUTL(STARS)
+7 QUIT
+8 ;
IRO ;data for IRO-1003-41917, LON-1003-62093
+1 ;Not an entry point
QUIT
+2 ;;600.00^M^15^124
+3 ;;600.01^M^15^124
+4 ;;600.10^M^15^124
+5 ;;600.11^M^15^124
+6 ;;600.20^M^15^124
+7 ;;600.21^M^15^124
+8 ;;600.90^M^15^124
+9 ;;600.91^M^15^124
+10 ;;607.85^M^15^124
+11 ;;674.50^F^12^55
+12 ;;674.51^F^12^55
+13 ;;674.52^F^12^55
+14 ;;674.53^F^12^55
+15 ;;674.54^F^12^55
+16 ;;
