source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDXR.m@ 808

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1YSDXR ;SLC/DKG/RWF/ASF/LJA-(DSM-III) DIAGNOSIS REPORT ;12/14/93 12:34
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ;D RECORD^YSDX0001("^YSDXR") ;Used for testing. Inactivated in YSDX0001...
5 ; Called by routine YSDX3
61 ;
7 ;D RECORD^YSDX0001("1^YSDXR") ;Used for testing. Inactivated in YSDX0001...
8 R !,"SORT BY (D)IAGNOSIS or (C)HRONOLOGICALLY? D// ",A:DTIME
9 S YSTOUT='$T,YSUOUT=A["^"
10 QUIT:YSTOUT!YSUOUT ;->
11 S A=$TR($E(A_"D"),"cd","CD")
12 I "DC"'[A W:A'["?" " ?",$C(7) G 1 ;->
132 ;
14 ;D RECORD^YSDX0001("2^YSDXR") ;Used for testing. Inactivated in YSDX0001...
15 R !,"LIST ONLY ACTIVE DIAGNOSIS? N// ",A1:DTIME
16 S YSTOUT='$T,YSUOUT=A1["^"
17 QUIT:YSTOUT!YSUOUT ;->
18 S A1=$TR($E(A1_"N"),"yn","YN")
19 I "NY"'[A1 W:A1'["?" " ?",$C(7) G 2 ;->
20 K IOP S ZTSK="",%ZIS="Q" D ^%ZIS QUIT:POP ;->
21 I $D(IO("Q")) D QUIT
22 . S ZTRTN="ENPR^YSDXR"
23 . S (ZTSAVE("A"),ZTSAVE("A1"),ZTSAVE("YS*"))=""
24 . S ZTDESC="YS DSM3 PRINT"
25 . D ^%ZTLOAD
26 ;
27ENPR ;
28 ;D RECORD^YSDX0001("ENPR^YSDXR") ;Used for testing. Inactivated in YSDX0001...
29 S YSFHDR="Diagnosis List"
30 S YSFHDR(1)="W !,""DSM/ICD"",?8,""TITLE"" X YSFHDR(2),YSFHDR(3)",YSFHDR(2)="I $D(A1),A1?1""Y"".E W ?30,""**** ONLY ACTIVE DIAGNOSIS ****""",YSFHDR(3)="W !,""CODE"",?10,""DATE"""
31 S YSPP=0
32PR ;
33 ;D RECORD^YSDX0001("PR^YSDXR") ;Used for testing. Inactivated in YSDX0001...
34 U IO
35 D:'$D(YSNOFORM) ENHD^YSFORM
36 S Y1=0,T=0,YST=$S(IOST?1"P".E:1,1:0),YSSL=$S(YST:8,1:3),YSLFT=0
37 W !
38 ;
39 ; Principal DSM-III Diagnosis
40 I $D(^MR(YSDFN,"DX1")),+^("DX1")?7N.E,$P(^("DX1"),U,2)?1N.E D
41 . S X(1)=^MR(YSDFN,"DX1")
42 . W !,"DXLS (DSM-III): ",$P(^YSD(627.7,+$P(X(1),U,2),0),U,2)
43 . W " ON" S X=+X(1) D DAT
44 ;
45 ; Principal ICD9 Diagnosis
46 I $D(^MR(YSDFN,"DX2")),+^("DX2")?7N.E,$P(^("DX2"),U,2)?1N.E D
47 . S X(1)=^MR(YSDFN,"DX2")
48 . W !,"DXLS (ICD9): ",$P(^ICD9($P(X(1),U,2),0),U)
49 . W " ON" S X=+X(1) D DAT
50 ;
51 ; X DSM-III Diagnosis
52 I $D(^MR(YSDFN,"DX1")),$P(^("DX1"),U,3)?7N.E,$P(^("DX1"),U,4)?1N.E D
53 . S X(1)=^MR(YSDFN,"DX1")
54 . W !,"'X' DIAGNOSIS (DSM-III): ",$P(^YSD(627.7,$P(X(1),U,4),0),U,2)
55 . W " ON" S X=$P(^MR(YSDFN,"DX1"),U,3) D DAT
56 ;
57 ; X ICD9 Diagnosis
58 I $D(^MR(YSDFN,"DX2")),$P(^("DX2"),U,3)?7N.E,$P(^("DX2"),U,4)?1N.E D
59 . S X(1)=^MR(YSDFN,"DX2")
60 . W !,"'X' DIAGNOSIS (ICD9): ",$P(^ICD9($P(X(1),U,4),0),U)
61 . W " ON" S X=$P(^MR(YSDFN,"DX2"),U,3) D DAT
62 ;
63 ; DSM-III Diagnosis
64 I $D(^MR(YSDFN,"DX",1)) W !!,"DSM-III DIAGNOSES:"
65 I $D(A) G:A?1"C".E ^YSDXR1 ;->
66PRT ;
67 ;D RECORD^YSDX0001("PRT^YSDXR") ;Used for testing. Inactivated in YSDX0001...
68 S T=$O(^MR(YSDFN,"DX","B",T))
69 G PRE:'T ;->
70 S Y1=$O(^MR(+YSDFN,"DX","B",T,0))
71 G PRE:'Y1 ;->
72 S D2=^MR(YSDFN,"DX",+Y1,0),T1=0
73 G PRT:(D2<1) ;->
74 S Y2=^YSD(627.7,+D2,0)
75 I $D(A1),A1?1"Y".E G PRT:$P(D2,U,2)="I" ;->
76 I $Y+YSSL+2>IOSL D CK QUIT:YSLFT ;->
77 W !!,$P(Y2,U,2),?8
78 S Y2=$P(Y2,U)
79 F I=3:1:8 I $L($P(Y2," ",I))>70 QUIT
80 W $P(Y2," ",1,I-1) W:$L($P(Y2," ",I,99)) !?9,$P(Y2," ",I,99)
81 S C=$P(^MR(YSDFN,"DX",Y1,0),U,2)
82 S C=$S(C="A":"A C T I V E",C="I":"** INACTIVE",1:"")
83 W " ",C
84PT1 ;
85 ;D RECORD^YSDX0001("PT1^YSDXR") ;Used for testing. Inactivated in YSDX0001...
86 I $Y+YSSL+2>IOSL D CK QUIT:YSLFT ;->
87 S T1=$O(^MR(YSDFN,"DX",Y1,1,T1))
88 G PRT:'T1 ;->
89 S S2=^MR(YSDFN,"DX",Y1,1,T1,0)
90 W !?8 S X=+S2,Z=$P(S2,U,2) D DAT,ENS
91 S X=$P(S2,U,3)
92 I X>0,$D(^VA(200,X,0)) D
93 . W " ",$P(^VA(200,X,0),U)
94 . S X=$P(^VA(200,X,0),U,9)
95 . I X>0,$D(^DIC(3.1,X,0)) W ", ",^(0)
96 S X=$P(S2,U,4)
97 I $L(X) F I=4:1:10 IF $L($P(X," ",I))>50 QUIT
98 I $L(X) D
99 . W !?20,"COMMENT: ",$P(X," ",1,I)
100 . W:$L($P(X," ",I+1,99)) !?21,$P(X," ",I+1,99)
101 G PT1
102PRE ;
103 ;D RECORD^YSDX0001("PRE^YSDXR") ;Used for testing. Inactivated in YSDX0001...
104 D MULT
105 I '$D(^MR(YSDFN,"PHDX",1)) G END ;->
106 S T=0
107 G ^YSPDXR ;->
108 ;
109DAT D DAT^YSDXR000 ;->
110 QUIT
111 ;
112ENS D ENS^YSDXR000 ;->
113 QUIT
114 ;
115MULT D MULT^YSDXR000 ;->
116 QUIT
117 ;
118CK D CK^YSDXR000 ;->
119 QUIT
120 ;
121ENPP ;
122 ;D RECORD^YSDX0001("ENPP^YSDXR") ;Used for testing. Inactivated in YSDX0001...
123 S YSFHDR="DSM/ICDA9 Diagnosis List",YSPP=1
124 G PR ;->
125 ;
126END ;
127 ;D RECORD^YSDX0001("END^YSDXR") ;Used for testing. Inactivated in YSDX0001...
128 QUIT:$D(YSNOFORM) ;->
129 D ENFT^YSFORM:YST
130 D:'YSPP WAIT^YSUTL:'YST
131 QUIT:YSPP ;->
132 D ^%ZISC
133 S:$G(ZTSK) ZTREQ="@"
134 K:$G(ZTSK) YSCON
135 QUIT
136 ;
137EOR ;YSDXR - (DSM-III) DIAGNOSIS REPORT ;12/6/90 11:24
Note: See TracBrowser for help on using the repository browser.