YSDX3UA0 ;DALISC/LJA - Continuation of YSDX3UA0 code... ;8/17/94 08:22
;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
;;
;
DXLS ;This subroutine looks up and displays the diagnosis for Length of Stay (DXLS)
;D RECORD^YSDX0001("DXLS^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
Q:'$D(^YSD(627.8,"AD",YSDFN)) ;->
S J=$O(^YSD(627.8,"AD",YSDFN,0)) ; Inverse date
S J1=$O(^YSD(627.8,"AD",YSDFN,J,0)) ; IEN
QUIT:$P(^YSD(627.8,J1,1),U,4)["I" ;-> Condition
S J2=$P(^YSD(627.8,J1,1),U) ; Diag variable pointer
N YSDXLSD2
S (Y,YSDXLSD2)=$P(^YSD(627.8,+J1,0),U,3) D DD^%DT S YSDXLSD=Y
;
S J3=$P(J2,";",2)
S J4=$P(J2,";")
S J5="^"_J3_J4_","_0_")"
S J50=@J5
;
; DSM?
I J3["YSD" D
. S YSDXLS=^YSD(627.7,+J4,"D") ; Code name
. S YSDXLSN=$P(J50,U,2) ; Code#
;
; ICD9?
I J3["ICD9(" D
. N YSDXDATA S YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",J4,YSDXLSD2,"I")
. S YSDXLS=$P(YSDXDATA,U,2) ; Code #
. S YSDXLSN=$P(YSDXDATA,U,4) ; Code name
;
I $D(YSDXLS) D
. W !!,"The following diagnosis has been noted as the DXLS: "
. W !!?3,YSDXLS_" "_$E(YSDXLSN,1,48)," dated ",YSDXLSD
QUIT
;
DXLSQ ;
;D RECORD^YSDX0001("DXLSQ^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
I C2["I" S YSDXLX="n" QUIT ;->
W !!,"Is "_YSW_" "_$E(YSWN,1,45),!?5," the DXLS"
S %=2
D YN^DICN
I %=-1!(%=2) S YSDXLX="n" QUIT ;->
I %=0 D G DXLSQ ;->
. W !!,"This is the diagnosis accounting the largest % of length of stay for this "
. W !,"admission. There may only be ONE DXLS (DSM or ICD) per admission."
S YSDXLX="y"
I $D(J1) D QUIT ;->
. S DIE="^YSD(627.8,",DA=J1,DR="10///^S X=""c"""
. L +^YSD(627.8,DA):0
. D ^DIE
. L -^YSD(627.8,DA)
QUIT
;
EOR ;YSDX3UA0 - Continuation of YSDX3UA0 code... ;8/17/94
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3UA0 1852 printed Dec 13, 2024@02:14:23 Page 2
YSDX3UA0 ;DALISC/LJA - Continuation of YSDX3UA0 code... ;8/17/94 08:22
+1 ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
+2 ;;
+3 ;
DXLS ;This subroutine looks up and displays the diagnosis for Length of Stay (DXLS)
+1 ;D RECORD^YSDX0001("DXLS^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
+2 ;->
if '$DATA(^YSD(627.8,"AD",YSDFN))
QUIT
+3 ; Inverse date
SET J=$ORDER(^YSD(627.8,"AD",YSDFN,0))
+4 ; IEN
SET J1=$ORDER(^YSD(627.8,"AD",YSDFN,J,0))
+5 ;-> Condition
if $PIECE(^YSD(627.8,J1,1),U,4)["I"
QUIT
+6 ; Diag variable pointer
SET J2=$PIECE(^YSD(627.8,J1,1),U)
+7 NEW YSDXLSD2
+8 SET (Y,YSDXLSD2)=$PIECE(^YSD(627.8,+J1,0),U,3)
DO DD^%DT
SET YSDXLSD=Y
+9 ;
+10 SET J3=$PIECE(J2,";",2)
+11 SET J4=$PIECE(J2,";")
+12 SET J5="^"_J3_J4_","_0_")"
+13 SET J50=@J5
+14 ;
+15 ; DSM?
+16 IF J3["YSD"
Begin DoDot:1
+17 ; Code name
SET YSDXLS=^YSD(627.7,+J4,"D")
+18 ; Code#
SET YSDXLSN=$PIECE(J50,U,2)
End DoDot:1
+19 ;
+20 ; ICD9?
+21 IF J3["ICD9("
Begin DoDot:1
+22 NEW YSDXDATA
SET YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",J4,YSDXLSD2,"I")
+23 ; Code #
SET YSDXLS=$PIECE(YSDXDATA,U,2)
+24 ; Code name
SET YSDXLSN=$PIECE(YSDXDATA,U,4)
End DoDot:1
+25 ;
+26 IF $DATA(YSDXLS)
Begin DoDot:1
+27 WRITE !!,"The following diagnosis has been noted as the DXLS: "
+28 WRITE !!?3,YSDXLS_" "_$EXTRACT(YSDXLSN,1,48)," dated ",YSDXLSD
End DoDot:1
+29 QUIT
+30 ;
DXLSQ ;
+1 ;D RECORD^YSDX0001("DXLSQ^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
+2 ;->
IF C2["I"
SET YSDXLX="n"
QUIT
+3 WRITE !!,"Is "_YSW_" "_$EXTRACT(YSWN,1,45),!?5," the DXLS"
+4 SET %=2
+5 DO YN^DICN
+6 ;->
IF %=-1!(%=2)
SET YSDXLX="n"
QUIT
+7 ;->
IF %=0
Begin DoDot:1
+8 WRITE !!,"This is the diagnosis accounting the largest % of length of stay for this "
+9 WRITE !,"admission. There may only be ONE DXLS (DSM or ICD) per admission."
End DoDot:1
GOTO DXLSQ
+10 SET YSDXLX="y"
+11 ;->
IF $DATA(J1)
Begin DoDot:1
+12 SET DIE="^YSD(627.8,"
SET DA=J1
SET DR="10///^S X=""c"""
+13 LOCK +^YSD(627.8,DA):0
+14 DO ^DIE
+15 LOCK -^YSD(627.8,DA)
End DoDot:1
QUIT
+16 QUIT
+17 ;
EOR ;YSDX3UA0 - Continuation of YSDX3UA0 code... ;8/17/94
