Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSDX3UA0

YSDX3UA0.m

Go to the documentation of this file.
  1. YSDX3UA0 ;DALISC/LJA - Continuation of YSDX3UA0 code... ;8/17/94 08:22
  1. ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
  1. ;;
  1. ;
  1. 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...
  1. Q:'$D(^YSD(627.8,"AD",YSDFN)) ;->
  1. S J=$O(^YSD(627.8,"AD",YSDFN,0)) ; Inverse date
  1. S J1=$O(^YSD(627.8,"AD",YSDFN,J,0)) ; IEN
  1. QUIT:$P(^YSD(627.8,J1,1),U,4)["I" ;-> Condition
  1. S J2=$P(^YSD(627.8,J1,1),U) ; Diag variable pointer
  1. N YSDXLSD2
  1. S (Y,YSDXLSD2)=$P(^YSD(627.8,+J1,0),U,3) D DD^%DT S YSDXLSD=Y
  1. ;
  1. S J3=$P(J2,";",2)
  1. S J4=$P(J2,";")
  1. S J5="^"_J3_J4_","_0_")"
  1. S J50=@J5
  1. ;
  1. ; DSM?
  1. I J3["YSD" D
  1. . S YSDXLS=^YSD(627.7,+J4,"D") ; Code name
  1. . S YSDXLSN=$P(J50,U,2) ; Code#
  1. ;
  1. ; ICD9?
  1. I J3["ICD9(" D
  1. . N YSDXDATA S YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",J4,YSDXLSD2,"I")
  1. . S YSDXLS=$P(YSDXDATA,U,2) ; Code #
  1. . S YSDXLSN=$P(YSDXDATA,U,4) ; Code name
  1. ;
  1. I $D(YSDXLS) D
  1. . W !!,"The following diagnosis has been noted as the DXLS: "
  1. . W !!?3,YSDXLS_" "_$E(YSDXLSN,1,48)," dated ",YSDXLSD
  1. QUIT
  1. ;
  1. DXLSQ ;
  1. ;D RECORD^YSDX0001("DXLSQ^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
  1. I C2["I" S YSDXLX="n" QUIT ;->
  1. W !!,"Is "_YSW_" "_$E(YSWN,1,45),!?5," the DXLS"
  1. S %=2
  1. D YN^DICN
  1. I %=-1!(%=2) S YSDXLX="n" QUIT ;->
  1. I %=0 D G DXLSQ ;->
  1. . W !!,"This is the diagnosis accounting the largest % of length of stay for this "
  1. . W !,"admission. There may only be ONE DXLS (DSM or ICD) per admission."
  1. S YSDXLX="y"
  1. I $D(J1) D QUIT ;->
  1. . S DIE="^YSD(627.8,",DA=J1,DR="10///^S X=""c"""
  1. . L +^YSD(627.8,DA):0
  1. . D ^DIE
  1. . L -^YSD(627.8,DA)
  1. QUIT
  1. ;
  1. EOR ;YSDX3UA0 - Continuation of YSDX3UA0 code... ;8/17/94