| 1 | YSDX3RUA ;SLC/DJP-Print Utilities for Diagnoses Reporting in MH - Continued ;12/14/93 09:17
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**16**;Dec 30, 1994
|
|---|
| 3 | ;D RECORD^YSDX0001("^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 4 | ;
|
|---|
| 5 | AX4 ; Called by routine YSDX3R
|
|---|
| 6 | ; Print latest Axis 4 information
|
|---|
| 7 | ;D RECORD^YSDX0001("AX4^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 8 | Q:'$D(^YSD(627.8,"AX4",YSDFN)) S A1=0 F I=1:1:1 S A1=$O(^YSD(627.8,"AX4",YSDFN,A1)) Q:'A1 S A2=0 F S A2=$O(^YSD(627.8,"AX4",YSDFN,A1,A2)) Q:'A2 D AX4P
|
|---|
| 9 | Q
|
|---|
| 10 | AX4P ;
|
|---|
| 11 | ;D RECORD^YSDX0001("AX4P^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 12 | S YSPS=$P($G(^YSD(627.8,A2,60)),U) S:YSPS']"" YSPS="None given" S A3=$P(^(60),U,2),Y=$P(^(0),U,3) D DD^%DT S A9=$P(Y,"@")
|
|---|
| 13 | S TOTSET=";"_$P(^DD(627.8,61,0),U,3),SUBSET=$F(TOTSET,";"_A3_":") I SUBSET S YSAX4=$E($P($E(TOTSET,SUBSET,999),";"),1,50) I $Y+YSSL+4>IOSL D CK^YSDX3RU Q:YSTOUT!YSUOUT!YSLFT
|
|---|
| 14 | W !!,"AXIS IV: Psychosocial stressors: ",YSPS,!?10,"Severity: ",A3_"--"_YSAX4,!?10,"Dated: ",A9
|
|---|
| 15 | Q
|
|---|
| 16 | AX5 ; Called by routine YSSP6
|
|---|
| 17 | ;
|
|---|
| 18 | ;D RECORD^YSDX0001("AX5^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 19 | Q:'$D(^YSD(627.8,"AX5",YSDFN)) S A5=$O(^YSD(627.8,"AX5",YSDFN,0)) Q:'A5 S A6=$O(^YSD(627.8,"AX5",YSDFN,A5,0)) Q:'A6 S A7=$P(^YSD(627.8,A6,60),U,3) D GAF^YSDX3UB
|
|---|
| 20 | S Y=$P(^YSD(627.8,A6,0),U,3) D DD^%DT S A8=$P(Y,"@")
|
|---|
| 21 | I $Y+YSSL+4>IOSL D CK^YSDX3RU Q:YSTOUT!YSUOUT!YSLFT
|
|---|
| 22 | W !!,"AXIS V: Current GAF: ",A7_" (as of "_A8_")",!?10,"Highest GAF past year: ",$S($D(G5):G5,1:"No other GAF for past year") I $D(G5) W " (dtd "_$S($D(G11):G11,1:"Date Missing")_")",!
|
|---|
| 23 | D FINISH^YSDX3RU
|
|---|
| 24 | QUIT
|
|---|
| 25 | ;
|
|---|
| 26 | DXLS ; Called by routines YSDX3R, YSPP6
|
|---|
| 27 | ; This subroutine looks up and displays the diagnosis for Length of Stay (DXLS)
|
|---|
| 28 | ;D RECORD^YSDX0001("DXLS^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 29 | Q:'$D(^YSD(627.8,"AD",YSDFN))
|
|---|
| 30 | S J=$O(^YSD(627.8,"AD",YSDFN,0)) ; Inverse date
|
|---|
| 31 | DXLS1 ;
|
|---|
| 32 | ;D RECORD^YSDX0001("DXLS1^YSDX3RUA") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 33 | S J1=$O(^YSD(627.8,"AD",YSDFN,J,0)) ; IEN
|
|---|
| 34 | S J2=$P(^YSD(627.8,+J1,1),U) ; Diag variable pointer
|
|---|
| 35 | S Y=$P(^YSD(627.8,+J1,0),U,3) D DD^%DT S YSDXLSD=Y ; Diag Date/time
|
|---|
| 36 | S J3=$P(J2,";",2) ; Global ref
|
|---|
| 37 | S J4=+$P(J2,";") ; IEN
|
|---|
| 38 | S J5="^"_J3_J4_","_0_")" ; Global ref of 0 node
|
|---|
| 39 | S J50=@J5 ; Data for 0 node
|
|---|
| 40 | ;
|
|---|
| 41 | ; DSM?
|
|---|
| 42 | I J3["YSD" D
|
|---|
| 43 | . S YSDXLSN=^YSD(627.7,+J4,"D") ; Diagnosis name
|
|---|
| 44 | . S YSDXLS=$P(J50,U,2) ; ICD9 #
|
|---|
| 45 | ;
|
|---|
| 46 | ; ICD9?
|
|---|
| 47 | I J3["ICD9(" D
|
|---|
| 48 | . S YSDXLSN=$P(J50,U,3) ; Diagnosis name
|
|---|
| 49 | . S YSDXLS=$P(J50,U) ; ICD9 #
|
|---|
| 50 | ;
|
|---|
| 51 | I $D(YSDXLS) D
|
|---|
| 52 | . W !!,"Principal Diagnosis (DXLS): ",!!?3
|
|---|
| 53 | . W YSDXLS_" "_$E(YSDXLSN,1,25),!?8," dated ",YSDXLSD
|
|---|
| 54 | ;
|
|---|
| 55 | ; Modifiers?
|
|---|
| 56 | I $D(^YSD(627.8,+J1,5)) D
|
|---|
| 57 | . S J6=$P(^YSD(627.8,+J1,5,0),U,3) ; Stands for
|
|---|
| 58 | . F I=1:1:J6 W !?3,"--- ",$P(^YSD(627.8,+J1,5,I,0),U,3)
|
|---|
| 59 | ;
|
|---|
| 60 | K J1,J2,J3,J4,J5,J50,J6,YSDXLSN,YSDXLS,YSDXLSD,YSCON
|
|---|
| 61 | QUIT
|
|---|
| 62 | ;
|
|---|
| 63 | EOR ;YSDX3RUA - Print Utilities for Diagnoses reporting - continued ;9/18/92 15:37
|
|---|
