- 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 Jan 18, 2025@02:49:14 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 ;;