LREPIXDG.m

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 ---LREPIXDG   961     printed  Feb 18, 2025@23:40:31                                                                                                                                                                                                     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      ;