- 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 Feb 18, 2025@23:40:40 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