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