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

BLRICDU0.m

Go to the documentation of this file. 
  1. BLRICDU0 ; IHS/MSC/MKK - IHS Laboratory ICD Utilities ; 17-Oct-2014 09:22 ; MKK
  1.  ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP2^BLRGMENU
  1.  Q
  1.  ;
  1.  ;
  1.  ; AICD 4.0 modified ICD9 global.  Need new functions/routines to retrieve data.
  1.  ;
  1. FINDER(BLRINP,RES) ; EP - Mimic FIND^DIC call
  1.  NEW ICD,ICDSTR
  1.  ;
  1.  K RES
  1.  ;
  1.  S ICDSTR=$$ICDDX^ICDEX(BLRINP)
  1.  Q:+ICDSTR<1
  1.  ;
  1.  S RES("DILIST",0)="1^*^0^"
  1.  S RES("DILIST",0,"MAP")=".01^10"
  1.  S RES("DILIST",1,1)=$P(ICDSTR,"^",2)
  1.  S RES("DILIST",2,1)=+ICDSTR
  1.  S RES("DILIST","ID",1,.01)=$P(ICDSTR,"^",2)
  1.  S ICD=+ICDSTR
  1.  S RES("DILIST","ID",1,10)=$$DESCICD(ICD)
  1.  Q
  1.  ;
  1.  ;
  1. DESCICD(ICD,BLRVDT) ; EP - DESCRIPTION is now a multiple
  1.  NEW DESCDATE,DESCNUM,DESCRIP
  1.  ;
  1.  S DESCRIP=$G(^ICD9(ICD,68,+$O(^ICD9(ICD,68,"A"),-1),1)) ; Most Current Description
  1.  ;
  1.  I +$G(BLRVDT) D   ; If there is date, retrieve description current as of that date
  1.  . S BLRVDT=$$FMADD^XLFDT(BLRVDT,-1)   ; "Back up" 1 day to account for $ORDER function
  1.  . S DESCDATE=$O(^ICD9(ICD,68,"B",BLRVDT))
  1.  . Q:DESCDATE<1
  1.  . ;
  1.  . S DESCNUM=$O(^ICD9(ICD,68,"B",DESCDATE,0))
  1.  . Q:DESCNUM<1
  1.  . ;
  1.  . S DESCRIP=$G(^ICD9(ICD,68,DESCNUM,1))
  1.  ;
  1.  Q DESCRIP
  1.  ;
  1.  ;
  1. DIAGICD(ICD,BLRVDT) ; EP - DIAGNOSIS is now a multiple
  1.  NEW DIAGDATE,DIAGNUM,DIAGDESC
  1.  ;
  1.  S DIAGDESC=$P($G(^ICD9(ICD,67,+$O(^ICD9(ICD,67,"A"),-1),0)),"^",2)  ; Most Current Diagnosis
  1.  ;
  1.  I +$G(BLRVDT) D   ; If there is date, retrieve diagnosis current as of that date
  1.  . S BLRVDT=$$FMADD^XLFDT(BLRVDT,-1)   ; "Back up" 1 day to account for $ORDER function
  1.  . S DIAGDATE=$O(^ICD9(ICD,67,"B",BLRVDT))
  1.  . Q:DIAGDATE<1
  1.  . ;
  1.  . S DIAGNUM=$O(^ICD9(ICD,67,"B",DIAGDATE,0))
  1.  . Q:DIAGNUM<1
  1.  . ;
  1.  . S DIAGDESC=$P($G(^ICD9(ICD,67,DIAGNUM,0)),"^",2)
  1.  ;
  1.  Q DIAGDESC
  1.  ;
  1.  ;
  1. INACTDT(ICD,BLRVDT)     ; EP - Determine if ICD is Inactive, given a date
  1.  NEW ICDDATE
  1.  ;
  1.  D ICD10IDT(.ICDDATE)
  1.  ;
  1.  Q:BLRVDT<ICDDATE&(+$G(^ICD9(ICD,1))>29) 1   ; "Inactive" if ICD-10 code and Date < ICD-10 Active
  1.  ;
  1.  Q:$G(BLRVDT)<1 0       ; If no date, then cannot check STATUS EFFECTIVE DATE ==> Not Inactive
  1.  ;
  1.  NEW STATUS,STSDATE,STSNUM
  1.  ;
  1.  S BLRVDT=$$FMADD^XLFDT(BLRVDT,-1)   ; "Back up" 1 day to account for $ORDER function
  1.  S STSDATE=$O(^ICD9(ICD,66,"B",BLRVDT))
  1.  Q:STSDATE<1 0          ; If no STATUS EFFECTIVE DATE ==> Not Inactive
  1.  ;
  1.  Q:STSDATE>BLRVDT 0     ; If STATUS EFFECTIVE DATE > BLRVDT, then cannot check STATUS ==> Not Inactive
  1.  ;
  1.  S STSNUM=$O(^ICD9(ICD,66,"B",STSDATE,0))
  1.  Q:STSNUM<1 0           ; If no STATUS ==> Not Inactive
  1.  ;
  1.  S STATUS=+$G(^ICD9(ICD,66,STSNUM,0))
  1.  Q $S(STATUS=1:0,1:1)   ; STATUS = 1 ==> ACTIVE; STATUS = 0 ==> INACTIVE
  1.  ;
  1.  ;
  1. CURINACT(ICD) ; EP - Determine if ICD is Currently Inactive
  1.  NEW ICDDATE,STATUS,STSDATE,STSNUM
  1.  ;
  1.  D ICD10IDT(.ICDDATE)
  1.  ;
  1.  Q:$$DT^XLFDT<ICDDATE&(+$G(^ICD9(ICD,1))>29) 1   ; "Inactive" if ICD-9 code and Date is < ICD-10 Date
  1.  ;
  1.  S STSDATE=$O(^ICD9(ICD,66,"B","A"),-1)
  1.  Q:STSDATE<1 0          ; If no STATUS EFFECTIVE DATE ==> Not Inactive
  1.  ;
  1.  S STSNUM=$O(^ICD9(ICD,66,"B",STSDATE,0))
  1.  Q:STSNUM<1 0           ; If no STATUS ==> Not Inactive
  1.  ;
  1.  S STATUS=+$G(^ICD9(ICD,66,STSNUM,0))
  1.  Q $S(STATUS=1:0,1:1)   ; STATUS = 1 ==> ACTIVE; STATUS = 0 ==> INACTIVE
  1.  ;
  1. SETDICS ; EP - Set the DIC("S") based on Today
  1.  NEW ICD10DT
  1.  ;
  1.  D ICD10IDT(.ICDDATE)
  1.  ;
  1.  ; Set DIC("S") to check just the status if Date >= ICD-10 date
  1.  I $$DT^XLFDT>=ICDDATE S DIC("S")="I $P($G(^ICD9(Y,66,+$O(^ICD9(Y,66,""A""),-1),0)),""^"",2)"  Q
  1.  ;
  1.  ; Set DIC("S") to check to make sure no ICD-10 codes are returned to the user if Date < ICD-10 Active
  1.  S DIC("S")="I $P($G(^ICD9(Y,66,+$O(^ICD9(Y,66,""A""),-1),0)),""^"",2)&(+$G(^ICD9(Y,1))<30)"
  1.  Q
  1.  ;
  1. SETDICSD(DT) ; EP - Set the DIC("S") based on DT
  1.  NEW ICD10DT
  1.  ;
  1.  D ICD10IDT(.ICDDATE)
  1.  ;
  1.  ; Set DIC("S") to check just the status if Date >= ICD-10 date
  1.  I DT>=ICDDATE S DIC("S")="I $P($G(^ICD9(Y,66,+$O(^ICD9(Y,66,""A""),-1),0)),""^"",2)"  Q
  1.  ;
  1.  ; Set DIC("S") to check to make sure no ICD-10 codes are returned to the user if Date < ICD-10 Active
  1.  S DIC("S")="I $P($G(^ICD9(Y,66,+$O(^ICD9(Y,66,""A""),-1),0)),""^"",2)&(+$G(^ICD9(Y,1))<30)"
  1.  Q
  1.  ;
  1. ICD10IDT(DATE,TYPE) ; EP - Return the Implementation Date for the ICD-10
  1.  NEW ICDSTR,IEN
  1.  ;
  1.  S ICDSTR="ICD-10-"_$G(TYPE,"CM")
  1.  S IEN=+$O(^ICDS("B",ICDSTR,0))
  1.  S DATE=$$GET1^DIQ(80.4,IEN,"IMPLEMENTATION DATE","I")
  1.  S:DATE<1 DATE=3151001  ; If no Date returned from 80.4, hard set to 10/1/2015.
  1.  Q