source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3RUA.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1YSDX3RUA ;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 ;
5AX4 ; 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
10AX4P ;
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
16AX5 ; 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 ;
26DXLS ; 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
31DXLS1 ;
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 ;
63EOR ;YSDX3RUA - Print Utilities for Diagnoses reporting - continued ;9/18/92 15:37
Note: See TracBrowser for help on using the repository browser.