LREPIXDG ;ALB/TJ/SS - ICD DIAGNOSIS DESCRIPTION LOOK UP;23 Apr 2013 4:35 PM
;;5.2;LAB SERVICE;**421**;Sep 27, 1994;Build 48
;;
;ICRs
; 5679 - supported ($$IMPDATE^LEXU)
; 5747 - $$CSI^ICDEX, $$SD^ICDEX, $$SNAM^ICDEX supported by this IA
;
LRDSCR(LRDATE) I '($G(LRDATE,"")]"") D
.N LRDATE D NOW^%DTC S LRDATE=X
N LRICDIEN,LRDSCR S LRICDIEN=^TMP("DDS",$J,$P(DDS,U),DDS3FN,DA_","_DA(1)_",",.01,"D")
S LRDSCR=$E($$SD^ICDEX(80,LRICDIEN,LRDATE),1,60) S:$P(LRDSCR,U,1)=-1 LRDSCR=""
I LRDSCR="" D
. S LRDATE=$$IMPDATE^LEXU("ICD")
. S LRDSCR=$E($$SD^ICDEX(80,LRICDIEN,LRDATE),1,60) S:$P(LRDSCR,U,1)=-1 LRDSCR=""
I LRDSCR="" D
. S LRDATE=$$IMPDATE^LEXU("10D")
. S LRDSCR=$E($$SD^ICDEX(80,LRICDIEN,LRDATE),1,60) S:$P(LRDSCR,U,1)=-1 LRDSCR=""
N LRCHBTWN,LRCSIEN,LRCSNAM S LRCSIEN=$$CSI^ICDEX(80,LRICDIEN)
S LRCSNAM=$$SNAM^ICDEX(LRCSIEN),LRCHBTWN=$S(LRCSIEN=1:" ",1:"")
Q $P(LRCSNAM,"-",1,2)_LRCHBTWN_" "_$$TITLE^XLFSTR(LRDSCR)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIXDG 961 printed Dec 13, 2024@02:14:38 Page 2
LREPIXDG ;ALB/TJ/SS - ICD DIAGNOSIS DESCRIPTION LOOK UP;23 Apr 2013 4:35 PM
+1 ;;5.2;LAB SERVICE;**421**;Sep 27, 1994;Build 48
+2 ;;
+3 ;ICRs
+4 ; 5679 - supported ($$IMPDATE^LEXU)
+5 ; 5747 - $$CSI^ICDEX, $$SD^ICDEX, $$SNAM^ICDEX supported by this IA
+6 ;
LRDSCR(LRDATE) IF '($GET(LRDATE,"")]"")
Begin DoDot:1
+1 NEW LRDATE
DO NOW^%DTC
SET LRDATE=X
End DoDot:1
+2 NEW LRICDIEN,LRDSCR
SET LRICDIEN=^TMP("DDS",$JOB,$PIECE(DDS,U),DDS3FN,DA_","_DA(1)_",",.01,"D")
+3 SET LRDSCR=$EXTRACT($$SD^ICDEX(80,LRICDIEN,LRDATE),1,60)
if $PIECE(LRDSCR,U,1)=-1
SET LRDSCR=""
+4 IF LRDSCR=""
Begin DoDot:1
+5 SET LRDATE=$$IMPDATE^LEXU("ICD")
+6 SET LRDSCR=$EXTRACT($$SD^ICDEX(80,LRICDIEN,LRDATE),1,60)
if $PIECE(LRDSCR,U,1)=-1
SET LRDSCR=""
End DoDot:1
+7 IF LRDSCR=""
Begin DoDot:1
+8 SET LRDATE=$$IMPDATE^LEXU("10D")
+9 SET LRDSCR=$EXTRACT($$SD^ICDEX(80,LRICDIEN,LRDATE),1,60)
if $PIECE(LRDSCR,U,1)=-1
SET LRDSCR=""
End DoDot:1
+10 NEW LRCHBTWN,LRCSIEN,LRCSNAM
SET LRCSIEN=$$CSI^ICDEX(80,LRICDIEN)
+11 SET LRCSNAM=$$SNAM^ICDEX(LRCSIEN)
SET LRCHBTWN=$SELECT(LRCSIEN=1:" ",1:"")
+12 QUIT $PIECE(LRCSNAM,"-",1,2)_LRCHBTWN_" "_$$TITLE^XLFSTR(LRDSCR)
+13 ;
