1 | YSDX3UA0 ;DALISC/LJA - Continuation of YSDX3UA0 code... ;8/17/94 08:22
|
---|
2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
---|
3 | ;;
|
---|
4 | ;
|
---|
5 | DXLS ;This subroutine looks up and displays the diagnosis for Length of Stay (DXLS)
|
---|
6 | ;D RECORD^YSDX0001("DXLS^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
|
---|
7 | Q:'$D(^YSD(627.8,"AD",YSDFN)) ;->
|
---|
8 | S J=$O(^YSD(627.8,"AD",YSDFN,0)) ; Inverse date
|
---|
9 | S J1=$O(^YSD(627.8,"AD",YSDFN,J,0)) ; IEN
|
---|
10 | QUIT:$P(^YSD(627.8,J1,1),U,4)["I" ;-> Condition
|
---|
11 | S J2=$P(^YSD(627.8,J1,1),U) ; Diag variable pointer
|
---|
12 | S Y=$P(^YSD(627.8,+J1,0),U,3) D DD^%DT S YSDXLSD=Y
|
---|
13 | ;
|
---|
14 | S J3=$P(J2,";",2)
|
---|
15 | S J4=$P(J2,";")
|
---|
16 | S J5="^"_J3_J4_","_0_")"
|
---|
17 | S J50=@J5
|
---|
18 | ;
|
---|
19 | ; DSM?
|
---|
20 | I J3["YSD" D
|
---|
21 | . S YSDXLS=^YSD(627.7,+J4,"D") ; Code name
|
---|
22 | . S YSDXLSN=$P(J50,U,2) ; Code#
|
---|
23 | ;
|
---|
24 | ; ICD9?
|
---|
25 | I J3["ICD9(" D
|
---|
26 | . S YSDXLS=$P(J50,U) ; Code #
|
---|
27 | . S YSDXLSN=$P(J50,U,3) ; Code name
|
---|
28 | ;
|
---|
29 | I $D(YSDXLS) D
|
---|
30 | . W !!,"The following diagnosis has been noted as the DXLS: "
|
---|
31 | . W !!?3,YSDXLS_" "_$E(YSDXLSN,1,25)," dated ",YSDXLSD
|
---|
32 | QUIT
|
---|
33 | ;
|
---|
34 | DXLSQ ;
|
---|
35 | ;D RECORD^YSDX0001("DXLSQ^YSDX3UA0") ;Used for testing. Inactivated in YSDX0001...
|
---|
36 | I C2["I" S YSDXLX="n" QUIT ;->
|
---|
37 | W !!,"Is "_YSW_" "_$E(YSWN,1,45),!?5," the DXLS"
|
---|
38 | S %=2
|
---|
39 | D YN^DICN
|
---|
40 | I %=-1!(%=2) S YSDXLX="n" QUIT ;->
|
---|
41 | I %=0 D G DXLSQ ;->
|
---|
42 | . W !!,"This is the diagnosis accounting the largest % of length of stay for this "
|
---|
43 | . W !,"admission. There may only be ONE DXLS (DSM or ICD9) per admission."
|
---|
44 | S YSDXLX="y"
|
---|
45 | I $D(J1) D QUIT ;->
|
---|
46 | . S DIE="^YSD(627.8,",DA=J1,DR="10///^S X=""c"""
|
---|
47 | . L +^YSD(627.8,DA)
|
---|
48 | . D ^DIE
|
---|
49 | . L -^YSD(627.8,DA)
|
---|
50 | QUIT
|
---|
51 | ;
|
---|
52 | EOR ;YSDX3UA0 - Continuation of YSDX3UA0 code... ;8/17/94
|
---|