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  Sep 23, 2025@19:50:18                                                                                                                                                                                                     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      ;